33 lines
1.1 KiB
Fortran
33 lines
1.1 KiB
Fortran
FUNCTION XK2DOP(TAU)
|
|
C ====================
|
|
C
|
|
C KERNEL FUNCTION K2
|
|
C AFTER HUMMER, 1981, J.Q.S.R.T. 26, 187
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
PARAMETER (PI2SQ=2.506628275D0, PISQ=1.772453851D0, UN=1.D0,
|
|
* A1= -1.117897000D-1, A2= -1.249099917D-1,
|
|
* A3= -9.136358767D-3, A4= -3.370280896D-4,
|
|
* B1= 1.566124168D-1, B2= 9.013261660D-3,
|
|
* B3= 1.908481163D-4, B4= -1.547417750D-7,
|
|
* B5= -6.657439727D-9,
|
|
* C1= 1.915049608D01, C2= 1.007986843D02,
|
|
* C3= 1.295307533D02, C4= -3.143372468D01,
|
|
* D1= 1.968910391D01, D2= 1.102576321D02,
|
|
* D3= 1.694911399D02, D4= -1.669969409D01,
|
|
* D5= -3.666448000D01)
|
|
XK2DOP=UN
|
|
IF(TAU.LE.0.) RETURN
|
|
IF(TAU.LE.11.) THEN
|
|
P=UN+TAU*(A1+TAU*(A2+TAU*(A3+TAU*A4)))
|
|
Q=UN+TAU*(B1+TAU*(B2+TAU*(B3+TAU*(B4+TAU*B5))))
|
|
XK2DOP=TAU/PI2SQ*LOG(TAU/PISQ)+P/Q
|
|
ELSE
|
|
X=UN/LOG(TAU/PISQ)
|
|
P=UN+X*(C1+X*(C2+X*(C3+X*C4)))
|
|
Q=UN+X*(D1+X*(D2+X*(D3+X*(D4+X*D5))))
|
|
XK2DOP=P/Q/2.D0/TAU/SQRT(LOG(TAU/PISQ))
|
|
END IF
|
|
RETURN
|
|
END
|