*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.21
*IF DEF,A01_3A,OR,DEF,A02_3A E3A013A.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.13229
C GTS2F400.13230
C Use, duplication or disclosure of this code is subject to the GTS2F400.13231
C restrictions as set forth in the contract. GTS2F400.13232
C GTS2F400.13233
C Meteorological Office GTS2F400.13234
C London Road GTS2F400.13235
C BRACKNELL GTS2F400.13236
C Berkshire UK GTS2F400.13237
C RG12 2SZ GTS2F400.13238
C GTS2F400.13239
C If no contract has been raised with this copy of the code, the use, GTS2F400.13240
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.13241
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.13242
C Modelling at the above address. GTS2F400.13243
C ******************************COPYRIGHT****************************** GTS2F400.13244
C GTS2F400.13245
!+ Function to calculate third expoential integral. E3A013A.3
! E3A013A.4
! Method: E3A013A.5
! For small arguments a power series is used. For larger E3A013A.6
! arguments a Pade approximant derived from the asymptotic E3A013A.7
! expansion is used. E3A013A.8
! E3A013A.9
! Current Owner of Code: J. M. Edwards E3A013A.10
! E3A013A.11
! History: E3A013A.12
! Version Date Comment E3A013A.13
! 4.0 27-07-95 Original Code E3A013A.14
! (J. M. Edwards) E3A013A.15
! (J. M. Edwards) E3A013A.16
! E3A013A.17
! Description of Code: E3A013A.18
! FORTRAN 77 with extensions listed in documentation. E3A013A.19
! E3A013A.20
!- --------------------------------------------------------------------- E3A013A.21
FUNCTION E3_ACC01(X) 4E3A013A.22
! E3A013A.23
! E3A013A.24
IMPLICIT NONE E3A013A.25
! E3A013A.26
! E3A013A.27
! DUMMY ARGUMENTS E3A013A.28
REAL E3A013A.29
& X E3A013A.30
! POINT OF EVALUATION E3A013A.31
& , E3_ACC01 E3A013A.32
! NAME OF FUNCTION E3A013A.33
! E3A013A.34
! LOCAL VARIABLES E3A013A.35
REAL E3A013A.36
& EULER E3A013A.37
! EULER'S CONSTANT E3A013A.38
! E3A013A.39
PARAMETER(EULER=0.5772156E+00) E3A013A.40
! E3A013A.41
! E3A013A.42
IF (X.LT.1.0E-06) THEN E3A013A.43
E3_ACC01=0.5E+00 E3A013A.44
ELSE IF (X.LT.2.0E+00) THEN E3A013A.45
E3_ACC01=-0.5E+00*X*X*LOG(X)+0.5E+00 E3A013A.46
& +X*(-1.0E+00+X*(0.75E+00-0.5E+00*EULER E3A013A.47
& +X*(1.0E+00/6.0E+00-X*(1.0E+00/48.0E+00 E3A013A.48
& -X*(1.0E+00/3.60E+02-X*(1.0E+00/2.880E+03 E3A013A.49
& -X*(1.0E+00/2.5200E+04))))))) E3A013A.50
ELSE E3A013A.51
! WE USE A DOUBLY CUBIC PADE APPROXIMANT DERIVED FROM THE E3A013A.52
! ASYMPTOTIC EXPRESSION. E3A013A.53
E3_ACC01=(EXP(-X)/X) E3A013A.54
& *(6.0E+00+X*(48.0E+00+X*(15.0E+00+X))) E3A013A.55
& /(120.0E+00+X*(90.0E+00+X*(18.0E+00+X))) E3A013A.56
ENDIF E3A013A.57
! E3A013A.58
! E3A013A.59
RETURN E3A013A.60
END E3A013A.61
*ENDIF DEF,A01_3A,OR,DEF,A02_3A E3A013A.62
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.22