933 lines
39 KiB
Fortran
933 lines
39 KiB
Fortran
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
MODULE BESSEL
|
||
|
|
!
|
||
|
|
! This module provides the standard Bessel functions and the
|
||
|
|
! exponential integral
|
||
|
|
!
|
||
|
|
! It contains the following functions:
|
||
|
|
!
|
||
|
|
! * FUNCTION BESSJ0(X) --> J_0(X)
|
||
|
|
! * FUNCTION BESSJ1(X) --> J_1(X)
|
||
|
|
! * FUNCTION BESSY0(X) --> Y_0(X)
|
||
|
|
! * FUNCTION BESSY1(X) --> Y_1(X)
|
||
|
|
! * FUNCTION BESSI0(X) --> I_0(X)
|
||
|
|
! * FUNCTION BESSI1(X) --> I_1(X)
|
||
|
|
! * FUNCTION BESSK0(X) --> K_0(X)
|
||
|
|
! * FUNCTION BESSK1(X) --> K_1(X)
|
||
|
|
! * FUNCTION BESSJ(N,X) --> J_N(x)
|
||
|
|
! * FUNCTION BESSY(N,X) --> Y_N(x)
|
||
|
|
! * FUNCTION BESSK(N,X) --> K_N(x)
|
||
|
|
! * FUNCTION BESSI(N,X) --> I_N(x)
|
||
|
|
! * FUNCTION EXPINT(N,X) --> E_N(X)
|
||
|
|
!
|
||
|
|
!
|
||
|
|
USE ACCURACY_REAL
|
||
|
|
!
|
||
|
|
CONTAINS
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSJ0(X)
|
||
|
|
!
|
||
|
|
! This function calculates the first kind Bessel function of order 0
|
||
|
|
! J0(x), for any real number x. The polynomial approximation by
|
||
|
|
! a series of Chebyshev polynomials is used for 0 < X < 8 and 0 < 8/X < 1
|
||
|
|
!
|
||
|
|
! References:
|
||
|
|
!
|
||
|
|
! M. Abramowitz, I.A. Stegun, Handbook of MathematicaL Functions, 1965.
|
||
|
|
! C.W. Clenshaw, National Physical Laboratory Mathematical Tables,
|
||
|
|
! Vol.5, 1962.
|
||
|
|
!
|
||
|
|
! Authors: From Numath Library by Tuan Dang Trong. F90 release 1.0 By J-P Moreau
|
||
|
|
!
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL (WP), INTENT(IN) :: X
|
||
|
|
REAL (WP) :: BESSJ0
|
||
|
|
REAL (WP) :: AX,Y,FR,FS,Z,XX,FP,FQ
|
||
|
|
REAL (WP) :: P1,P2,P3,P4,P5
|
||
|
|
REAL (WP) :: R1,R2,R3,R4,R5,R6
|
||
|
|
REAL (WP) :: Q1,Q2,Q3,Q4,Q5
|
||
|
|
REAL (WP) :: S1,S2,S3,S4,S5,S6
|
||
|
|
!
|
||
|
|
REAL (WP) :: DABS,DSQRT,DCOS,DSIN
|
||
|
|
!
|
||
|
|
DATA P1,P2,P3,P4,P5 / 1.0E0_WP, &
|
||
|
|
-0.1098628627E-2_WP, 0.2734510407E-4_WP, &
|
||
|
|
-0.2073370639E-5_WP, 0.2093887211E-6_WP /
|
||
|
|
DATA Q1,Q2,Q3,Q4,Q5 /-0.1562499995E-1_WP, 0.1430488765E-3_WP, &
|
||
|
|
-0.6911147651E-5_WP, 0.7621095161E-6_WP, &
|
||
|
|
-0.9349451520E-7_WP /
|
||
|
|
DATA R1,R2,R3,R4,R5,R6 / 57568490574.E0_WP,-13362590354.E0_WP, &
|
||
|
|
651619640.7E0_WP, -11214424.18E0_WP, &
|
||
|
|
77392.33017E0_WP, -184.9052456E0_WP /
|
||
|
|
DATA S1,S2,S3,S4,S5,S6 / 57568490411.E0_WP, 1029532985.E0_WP, &
|
||
|
|
9494680.718E0_WP, 59272.64853E0_WP, &
|
||
|
|
267.8532712E0_WP, 1.0E0_WP /
|
||
|
|
!
|
||
|
|
IF(X == 0.E0_WP) GO TO 1 !
|
||
|
|
!
|
||
|
|
AX = DABS (X) !
|
||
|
|
!
|
||
|
|
IF (AX < 8.0E0_WP) THEN !
|
||
|
|
Y = X*X
|
||
|
|
FR = R1 + Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6)))) !
|
||
|
|
FS = S1 + Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6)))) !
|
||
|
|
BESSJ0 = FR/FS !
|
||
|
|
ELSE !
|
||
|
|
Z = 8.E0_WP/AX !
|
||
|
|
Y = Z*Z !
|
||
|
|
XX = AX - 0.785398164E0_WP !
|
||
|
|
FP = P1 + Y*(P2+Y*(P3+Y*(P4+Y*P5))) !
|
||
|
|
FQ = Q1 + Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5))) !
|
||
|
|
BESSJ0 = DSQRT(0.636619772E0_WP/AX) * & !
|
||
|
|
(FP*DCOS(XX)-Z*FQ*DSIN(XX)) !
|
||
|
|
END IF
|
||
|
|
!
|
||
|
|
RETURN
|
||
|
|
!
|
||
|
|
1 BESSJ0 = 1.E0_WP !
|
||
|
|
!
|
||
|
|
RETURN
|
||
|
|
!
|
||
|
|
END FUNCTION BESSJ0
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSJ1(X)
|
||
|
|
!
|
||
|
|
! This function calculates the first kind Bessel function of order 1
|
||
|
|
! J1(x), for any real number x. The polynomial approximation by
|
||
|
|
! a series of Chebyshev polynomials is used for 0 < X < 8 and 0 < 8/X < 1
|
||
|
|
!
|
||
|
|
! References:
|
||
|
|
!
|
||
|
|
! M. Abramowitz, I.A. Stegun, Handbook of MathematicaL Functions, 1965.
|
||
|
|
! C.W. Clenshaw, National Physical Laboratory Mathematical Tables,
|
||
|
|
! Vol.5, 1962.
|
||
|
|
!
|
||
|
|
! Authors: From Numath Library by Tuan Dang Trong. F90 release 1.0 By J-P Moreau
|
||
|
|
!
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL (WP), INTENT(IN) :: X
|
||
|
|
REAL (WP) :: BESSJ1
|
||
|
|
REAL (WP) :: AX,Y,FR,FS,Z,XX,FP,FQ
|
||
|
|
REAL (WP) :: P1,P2,P3,P4,P5,P6
|
||
|
|
REAL (WP) :: R1,R2,R3,R4,R5,R6
|
||
|
|
REAL (WP) :: Q1,Q2,Q3,Q4,Q5
|
||
|
|
REAL (WP) :: S1,S2,S3,S4,S5,S6
|
||
|
|
!
|
||
|
|
REAL (WP) :: SIGN,DSQRT,DCOS,DSIN,DABS
|
||
|
|
!
|
||
|
|
DATA P1,P2,P3,P4,P5,P6 /1.0E0_WP, &
|
||
|
|
0.183105E-2_WP, -0.3516396496E-4_WP, &
|
||
|
|
0.2457520174E-5_WP, -0.240337019E-6_WP, &
|
||
|
|
0.636619772E0_WP /
|
||
|
|
DATA Q1,Q2,Q3,Q4,Q5 /0.04687499995E0_WP,-0.2002690873E-3_WP, &
|
||
|
|
0.8449199096E-5_WP,-0.88228987E-6_WP, &
|
||
|
|
0.105787412E-6_WP /
|
||
|
|
DATA R1,R2,R3,R4,R5,R6 /72362614232.E0_WP, -7895059235.E0_WP, &
|
||
|
|
242396853.1E0_WP, -2972611.439E0_WP, &
|
||
|
|
15704.48260E0_WP, -30.16036606E0_WP /
|
||
|
|
DATA S1,S2,S3,S4,S5,S6 /144725228442.E0_WP, 2300535178.E0_WP, &
|
||
|
|
18583304.74E0_WP, 99447.43394E0_WP, &
|
||
|
|
376.9991397E0_WP, 1.0E0_WP /
|
||
|
|
!
|
||
|
|
AX = DABS(X) !
|
||
|
|
!
|
||
|
|
IF (AX < 8.0E0_WP) THEN !
|
||
|
|
!
|
||
|
|
Y = X*X !
|
||
|
|
FR = R1 + Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6)))) !
|
||
|
|
FS = S1 + Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6)))) !
|
||
|
|
BESSJ1 = X*(FR/FS) !
|
||
|
|
ELSE !
|
||
|
|
Z = 8.0E0_WP / AX !
|
||
|
|
Y = Z*Z !
|
||
|
|
XX = AX - 2.35619491E0_WP !
|
||
|
|
FP = P1 + Y*(P2+Y*(P3+Y*(P4+Y*P5))) !
|
||
|
|
FQ = Q1 + Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5))) !
|
||
|
|
BESSJ1 = DSQRT(P6/AX)*(DCOS(XX)*FP-Z*DSIN(XX)*FQ)*SIGN(S6,X)!
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
END FUNCTION BESSJ1
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSY0(X)
|
||
|
|
!
|
||
|
|
! This function calculates the second kind Bessel function of order 0
|
||
|
|
! Y0(x), for any real number x. The polynomial approximation by
|
||
|
|
! a series of Chebyshev polynomials is used for 0 < X < 8 and 0 < 8/X < 1
|
||
|
|
!
|
||
|
|
! References:
|
||
|
|
!
|
||
|
|
! M. Abramowitz, I.A. Stegun, Handbook of MathematicaL Functions, 1965.
|
||
|
|
! C.W. Clenshaw, National Physical Laboratory Mathematical Tables,
|
||
|
|
! Vol.5, 1962.
|
||
|
|
!
|
||
|
|
! Authors: From Numath Library by Tuan Dang Trong. F90 release 1.0 By J-P Moreau
|
||
|
|
!
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL (WP), INTENT(IN) :: X
|
||
|
|
REAL (WP) :: BESSY0
|
||
|
|
REAL (WP) :: AX,Y,FR,FS,Z,XX,FP,FQ
|
||
|
|
REAL (WP) :: P1,P2,P3,P4,P5
|
||
|
|
REAL (WP) :: R1,R2,R3,R4,R5,R6
|
||
|
|
REAL (WP) :: Q1,Q2,Q3,Q4,Q5
|
||
|
|
REAL (WP) :: S1,S2,S3,S4,S5,S6
|
||
|
|
!
|
||
|
|
REAL (WP) :: DLOG,DSQRT,DCOS,DSIN
|
||
|
|
!
|
||
|
|
DATA P1,P2,P3,P4,P5 / 1.0E0_WP, &
|
||
|
|
-0.1098628627E-2_WP, 0.2734510407E-4_WP, &
|
||
|
|
-0.2073370639E-5_WP, 0.2093887211E-6_WP /
|
||
|
|
DATA Q1,Q2,Q3,Q4,Q5 / -0.1562499995E-1_WP, 0.1430488765E-3_WP, &
|
||
|
|
-0.6911147651E-5_WP, 0.7621095161E-6_WP, &
|
||
|
|
-0.9349451520E-7_WP /
|
||
|
|
DATA R1,R2,R3,R4,R5,R6 / -2957821389.E0_WP, 7062834065.E0_WP, &
|
||
|
|
-512359803.6E0_WP, 10879881.29E0_WP, &
|
||
|
|
-86327.92757E0_WP, 228.4622733E0_WP /
|
||
|
|
DATA S1,S2,S3,S4,S5,S6 / 40076544269.E0_WP, 745249964.8E0_WP, &
|
||
|
|
7189466.438E0_WP, 47447.26470E0_WP, &
|
||
|
|
226.1030244E0_WP, 1.0E0_WP /
|
||
|
|
!
|
||
|
|
IF (X == 0.0E0_WP) THEN !
|
||
|
|
BESSY0 = -1.0E30_WP !
|
||
|
|
RETURN !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
IF (X < 8.0E0_WP) THEN !
|
||
|
|
Y = X*X !
|
||
|
|
FR = R1 + Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6)))) !
|
||
|
|
FS = S1 + Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*S6)))) !
|
||
|
|
BESSY0 = FR/FS + 0.636619772E0_WP*BESSJ0(X)*DLOG(X) !
|
||
|
|
ELSE !
|
||
|
|
Z = 8.0E0_WP/X !
|
||
|
|
Y = Z*Z !
|
||
|
|
XX = X - 0.785398164E0_WP !
|
||
|
|
FP = P1 + Y*(P2+Y*(P3+Y*(P4+Y*P5))) !
|
||
|
|
FQ = Q1 + Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5))) !
|
||
|
|
BESSY0 = DSQRT(0.636619772E0_WP/X) * & !
|
||
|
|
(FP*DSIN(XX)+Z*FQ*DCOS(XX)) !
|
||
|
|
END IF
|
||
|
|
!
|
||
|
|
RETURN
|
||
|
|
!
|
||
|
|
END FUNCTION BESSY0
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSY1(X)
|
||
|
|
!
|
||
|
|
! This function calculates the second kind Bessel function of order 1
|
||
|
|
! Y1(x), for any real number x. The polynomial approximation by
|
||
|
|
! a series of Chebyshev polynomials is used for 0 < X < 8 and 0 < 8/X < 1
|
||
|
|
!
|
||
|
|
! References:
|
||
|
|
!
|
||
|
|
! M. Abramowitz, I.A. Stegun, Handbook of MathematicaL Functions, 1965.
|
||
|
|
! C.W. Clenshaw, National Physical Laboratory Mathematical Tables,
|
||
|
|
! Vol.5, 1962.
|
||
|
|
!
|
||
|
|
! Authors: From Numath Library by Tuan Dang Trong. F90 release 1.0 By J-P Moreau
|
||
|
|
!
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL (WP), INTENT(IN) :: X
|
||
|
|
REAL (WP) :: BESSY1
|
||
|
|
REAL (WP) :: AX,Y,FR,FS,Z,XX,FP,FQ
|
||
|
|
REAL (WP) :: P1,P2,P3,P4,P5
|
||
|
|
REAL (WP) :: R1,R2,R3,R4,R5,R6
|
||
|
|
REAL (WP) :: Q1,Q2,Q3,Q4,Q5
|
||
|
|
REAL (WP) :: S1,S2,S3,S4,S5,S6,S7
|
||
|
|
!
|
||
|
|
REAL (WP) :: DLOG,DSQRT,DCOS,DSIN
|
||
|
|
!
|
||
|
|
DATA P1,P2,P3,P4,P5 / 1.0E0_WP, &
|
||
|
|
0.183105E-2_WP, -0.3516396496E-4_WP, &
|
||
|
|
0.2457520174E-5_WP, -0.240337019E-6_WP /
|
||
|
|
DATA Q1,Q2,Q3,Q4,Q5 / 0.04687499995E0_WP, -0.2002690873E-3_WP, &
|
||
|
|
0.8449199096E-5_WP, -0.88228987E-6_WP, &
|
||
|
|
0.105787412E-6_WP /
|
||
|
|
DATA R1,R2,R3,R4,R5,R6 / -0.4900604943E13_WP, 0.1275274390E13_WP, &
|
||
|
|
-0.5153438139E11_WP, 0.7349264551E9_WP, &
|
||
|
|
-0.4237922726E7_WP, 0.8511937935E4_WP /
|
||
|
|
DATA S1,S2,S3,S4,S5,S6,S7 / 0.2499580570E14_WP, 0.4244419664E12_WP, &
|
||
|
|
0.3733650367E10_WP, 0.2245904002E8_WP, &
|
||
|
|
0.1020426050E6_WP, 0.3549632885E3_WP, &
|
||
|
|
1.0E0_WP /
|
||
|
|
!
|
||
|
|
IF (X == 0.0E0_WP) THEN !
|
||
|
|
BESSY1 = -1.E30_WP !
|
||
|
|
RETURN !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
IF (X < 8.0E0_WP) THEN !
|
||
|
|
Y = X*X !
|
||
|
|
FR = R1 + Y*(R2+Y*(R3+Y*(R4+Y*(R5+Y*R6)))) !
|
||
|
|
FS = S1 + Y*(S2+Y*(S3+Y*(S4+Y*(S5+Y*(S6+Y*S7))))) !
|
||
|
|
BESSY1 = X*(FR/FS)+0.636619772E0_WP*(BESSJ1(X)*DLOG(X)-1./X)!
|
||
|
|
ELSE !
|
||
|
|
Z = 8.0E0_WP/X !
|
||
|
|
Y = Z*Z !
|
||
|
|
XX = X - 2.356194491E0_WP !
|
||
|
|
FP = P1 + Y*(P2+Y*(P3+Y*(P4+Y*P5))) !
|
||
|
|
FQ = Q1 + Y*(Q2+Y*(Q3+Y*(Q4+Y*Q5))) !
|
||
|
|
BESSY1 = DSQRT(0.636619772E0_WP/X) * & !
|
||
|
|
(DSIN(XX)*FP+Z*DCOS(XX)*FQ) !
|
||
|
|
END IF
|
||
|
|
!
|
||
|
|
RETURN
|
||
|
|
!
|
||
|
|
END FUNCTION BESSY1
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSI0(X)
|
||
|
|
!
|
||
|
|
! This function calculates the first kind modified Bessel function of order 0
|
||
|
|
! Y1(x), for any real number x. The polynomial approximation by
|
||
|
|
! a series of Chebyshev polynomials is used for 0 < X < 8 and 0 < 8/X < 1
|
||
|
|
!
|
||
|
|
! References:
|
||
|
|
!
|
||
|
|
! M. Abramowitz, I.A. Stegun, Handbook of MathematicaL Functions, 1965.
|
||
|
|
! C.W. Clenshaw, National Physical Laboratory Mathematical Tables,
|
||
|
|
! Vol.5, 1962.
|
||
|
|
!
|
||
|
|
! Authors: From Numath Library by Tuan Dang Trong. F90 release 1.0 By J-P Moreau
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Input parameters:
|
||
|
|
!
|
||
|
|
! * X : argument of the Bessel function I0
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Output :
|
||
|
|
!
|
||
|
|
! * BESSI0 : I0(x)
|
||
|
|
!
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Last modified : 5 Jun 2020
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL (WP) :: BESSI0,X,Y,AX
|
||
|
|
REAL (WP) :: P1,P2,P3,P4,P5,P6,P7
|
||
|
|
REAL (WP) :: Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9
|
||
|
|
REAL (WP) :: CMP
|
||
|
|
!
|
||
|
|
REAL (WP) :: DABS,DEXP,DSQRT
|
||
|
|
!
|
||
|
|
DATA P1,P2,P3,P4,P5,P6,P7 / 1.0E0_WP, 3.5156229E0_WP, & !
|
||
|
|
3.0899424E0_WP, 1.2067492E0_WP, & !
|
||
|
|
0.2659732E0_WP, 0.360768E-1_WP, & !
|
||
|
|
0.45813E-02_WP / !
|
||
|
|
DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9 / 0.39894228E0_WP, & !
|
||
|
|
0.1328592E-1_WP,0.225319E-02_WP, & !
|
||
|
|
-0.157565E-02_WP,0.916281E-02_WP, & !
|
||
|
|
-0.2057706E-1_WP,0.2635537E-1_WP, & !
|
||
|
|
-0.1647633E-1_WP,0.392377E-02_WP / !
|
||
|
|
!
|
||
|
|
CMP = 3.750E0_WP !
|
||
|
|
!
|
||
|
|
IF (DABS(X) < CMP) THEN !
|
||
|
|
Y = (X/CMP)**2 !
|
||
|
|
BESSI0 = P1+Y*(P2+Y*(P3+Y*(P4+Y*(P5+Y*(P6+Y*P7))))) !
|
||
|
|
ELSE !
|
||
|
|
AX = DABS(X) !
|
||
|
|
Y = CMP/AX !
|
||
|
|
BESSI0 = (DEXP(AX)/DSQRT(AX))*(Q1+Y*(Q2+Y*(Q3+Y*(Q4 & !
|
||
|
|
+Y*(Q5+Y*(Q6+Y*(Q7+Y*(Q8+Y*Q9)))))))) !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
END FUNCTION BESSI0
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSI1(X)
|
||
|
|
!
|
||
|
|
! This function calculates the first kind modified Bessel function of order 1
|
||
|
|
! Y1(x), for any real number x. The polynomial approximation by
|
||
|
|
! a series of Chebyshev polynomials is used for 0 < X < 8 and 0 < 8/X < 1
|
||
|
|
!
|
||
|
|
! References:
|
||
|
|
!
|
||
|
|
! M. Abramowitz, I.A. Stegun, Handbook of MathematicaL Functions, 1965.
|
||
|
|
! C.W. Clenshaw, National Physical Laboratory Mathematical Tables,
|
||
|
|
! Vol.5, 1962.
|
||
|
|
!
|
||
|
|
! Authors: From Numath Library by Tuan Dang Trong. F90 release 1.0 By J-P Moreau
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Input parameters:
|
||
|
|
!
|
||
|
|
! * X : argument of the Bessel function I1
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Output :
|
||
|
|
!
|
||
|
|
! * BESSI1 : I1(x)
|
||
|
|
!
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Last modified : 5 Jun 2020
|
||
|
|
!
|
||
|
|
!
|
||
|
|
USE REAL_NUMBERS, ONLY : ZERO
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL (WP) :: BESSI1,X,Y,AX
|
||
|
|
REAL (WP) :: P1,P2,P3,P4,P5,P6,P7
|
||
|
|
REAL (WP) :: Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9
|
||
|
|
REAL (WP) :: CMP
|
||
|
|
!
|
||
|
|
REAL (WP) :: DABS,DEXP,DSQRT
|
||
|
|
!
|
||
|
|
DATA P1,P2,P3,P4,P5,P6,P7 / 0.5E0_WP, 0.87890594E0_WP, & !
|
||
|
|
0.51498869E0_WP, 0.15084934E0_WP, & !
|
||
|
|
0.2658733E-1_WP, 0.301532E-02_WP, & !
|
||
|
|
0.32411E-003_WP / !
|
||
|
|
DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9 / 0.39894228E0_WP, & !
|
||
|
|
-0.3988024E-1_WP, -0.362018E-02_WP, & !
|
||
|
|
0.163801E-02_WP, -0.1031555E-1_WP, & !
|
||
|
|
0.2282967E-1_WP, -0.2895312E-1_WP, & !
|
||
|
|
0.1787654E-1_WP, -0.420059E-02_WP / !
|
||
|
|
!
|
||
|
|
CMP = 3.750E0_WP !
|
||
|
|
!
|
||
|
|
IF (DABS(X) < CMP) THEN ! polynomial fit
|
||
|
|
Y=(X/CMP)**2 !
|
||
|
|
BESSI1=X*(P1+Y*(P2+Y*(P3+Y*(P4+Y*(P5+Y*(P6+Y*P7)))))) !
|
||
|
|
ELSE !
|
||
|
|
AX=DABS(X) !
|
||
|
|
Y=CMP/AX !
|
||
|
|
BESSI1=(DEXP(AX)/DSQRT(AX))*(Q1+Y*(Q2+Y*(Q3+Y*(Q4+ &!
|
||
|
|
Y*(Q5+Y*(Q6+Y*(Q7+Y*(Q8+Y*Q9)))))))) !
|
||
|
|
IF(X < ZERO) BESSI1 = -BESSI1 !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
END FUNCTION BESSI1
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSK0(X)
|
||
|
|
!
|
||
|
|
! This function calculates the third kind modified Bessel function of order 0
|
||
|
|
! Y1(x), for any real number x. The polynomial approximation by
|
||
|
|
! a series of Chebyshev polynomials is used for 0 < X < 8 and 0 < 8/X < 1
|
||
|
|
!
|
||
|
|
! References:
|
||
|
|
!
|
||
|
|
! M. Abramowitz, I.A. Stegun, Handbook of MathematicaL Functions, 1965.
|
||
|
|
! C.W. Clenshaw, National Physical Laboratory Mathematical Tables,
|
||
|
|
! Vol.5, 1962.
|
||
|
|
!
|
||
|
|
! Authors: From Numath Library by Tuan Dang Trong. F90 release 1.0 By J-P Moreau
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Input parameters:
|
||
|
|
!
|
||
|
|
! * X : argument of the Bessel function K0 (X > 0)
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Output :
|
||
|
|
!
|
||
|
|
! * BESSK0 : K0(x)
|
||
|
|
!
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Last modified : 5 Jun 2020
|
||
|
|
!
|
||
|
|
!
|
||
|
|
USE REAL_NUMBERS, ONLY : TWO,FOUR
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL (WP) :: BESSK0,X,Y
|
||
|
|
REAL (WP) :: P1,P2,P3,P4,P5,P6,P7
|
||
|
|
REAL (WP) :: Q1,Q2,Q3,Q4,Q5,Q6,Q7
|
||
|
|
!
|
||
|
|
REAL (WP) :: DLOG,DEXP,DSQRT
|
||
|
|
!
|
||
|
|
DATA P1,P2,P3,P4,P5,P6,P7 / -0.57721566E0_WP,0.42278420E0_WP,&!
|
||
|
|
0.23069756E0_WP,0.3488590E-1_WP,&!
|
||
|
|
0.262698E-02_WP,0.10750E-003_WP,&!
|
||
|
|
0.74E-5_WP / !
|
||
|
|
DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7/1.25331414E0_WP,-0.7832358E-1_WP, &!
|
||
|
|
0.2189568E-1_WP,-0.1062446E-1_WP, &!
|
||
|
|
0.587872E-02_WP,-0.251540E-02_WP, &!
|
||
|
|
0.53208E-003_WP / !
|
||
|
|
!
|
||
|
|
IF (X <= TWO) THEN ! polynomial fit
|
||
|
|
Y=X*X/FOUR !
|
||
|
|
BESSK0=(-DLOG(X/TWO)*BESSI0(X))+(P1+Y*(P2+Y*(P3+ &!
|
||
|
|
Y*(P4+Y*(P5+Y*(P6+Y*P7)))))) !
|
||
|
|
ELSE !
|
||
|
|
Y=(TWO/X) !
|
||
|
|
BESSK0=(DEXP(-X)/DSQRT(X))*(Q1+Y*(Q2+Y*(Q3+ &!
|
||
|
|
Y*(Q4+Y*(Q5+Y*(Q6+Y*Q7)))))) !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
END FUNCTION BESSK0
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSK1(X)
|
||
|
|
!
|
||
|
|
! This function calculates the third kind modified Bessel function of order 1
|
||
|
|
! Y1(x), for any real number x. The polynomial approximation by
|
||
|
|
! a series of Chebyshev polynomials is used for 0 < X < 8 and 0 < 8/X < 1
|
||
|
|
!
|
||
|
|
! References:
|
||
|
|
!
|
||
|
|
! M. Abramowitz, I.A. Stegun, Handbook of MathematicaL Functions, 1965.
|
||
|
|
! C.W. Clenshaw, National Physical Laboratory Mathematical Tables,
|
||
|
|
! Vol.5, 1962.
|
||
|
|
!
|
||
|
|
! Authors: From Numath Library by Tuan Dang Trong. F90 release 1.0 By J-P Moreau
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Input parameters:
|
||
|
|
!
|
||
|
|
! * X : argument of the Bessel function K1
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Output :
|
||
|
|
!
|
||
|
|
! * BESSK1 : K1(x)
|
||
|
|
!
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Last modified : 5 Jun 2020
|
||
|
|
!
|
||
|
|
!
|
||
|
|
USE REAL_NUMBERS, ONLY : ONE,TWO,FOUR
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL (WP) :: BESSK1,X,Y
|
||
|
|
REAL (WP) :: P1,P2,P3,P4,P5,P6,P7
|
||
|
|
REAL (WP) :: Q1,Q2,Q3,Q4,Q5,Q6,Q7
|
||
|
|
!
|
||
|
|
REAL (WP) :: DLOG,DEXP,DSQRT
|
||
|
|
!
|
||
|
|
DATA P1,P2,P3,P4,P5,P6,P7 / 1.0E0_WP, 0.15443144E0_WP,&!
|
||
|
|
-0.67278579E0_WP,-0.18156897E0_WP,&!
|
||
|
|
-0.1919402E-1_WP,-0.110404E-02_WP,&!
|
||
|
|
-0.4686E-4_WP / !
|
||
|
|
DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7 / 1.25331414E0_WP, 0.23498619E0_WP,&!
|
||
|
|
-0.3655620E-1_WP, 0.1504268E-1_WP,&!
|
||
|
|
-0.780353E-02_WP, 0.325614E-02_WP,&!
|
||
|
|
-0.68245E-003_WP / !
|
||
|
|
!
|
||
|
|
IF (X <= TWO) THEN ! polynomial fit
|
||
|
|
Y=X*X/FOUR !
|
||
|
|
BESSK1=(DLOG(X/TWO)*BESSI1(X))+(ONE/X)*(P1+Y*(P2+ &!
|
||
|
|
Y*(P3+Y*(P4+Y*(P5+Y*(P6+Y*P7)))))) !
|
||
|
|
ELSE !
|
||
|
|
Y=TWO/X !
|
||
|
|
BESSK1=(DEXP(-X)/DSQRT(X))*(Q1+Y*(Q2+Y*(Q3+ &!
|
||
|
|
Y*(Q4+Y*(Q5+Y*(Q6+Y*Q7)))))) !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
END FUNCTION BESSK1
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSJ (N,X)
|
||
|
|
|
||
|
|
! This subroutine calculates the first kind modified Bessel function
|
||
|
|
! of integer order N, for any REAL X. We use here the classical
|
||
|
|
! recursion formula, when X > N. For X < N, the Miller's algorithm
|
||
|
|
! is used to avoid overflows.
|
||
|
|
!
|
||
|
|
! References:
|
||
|
|
!
|
||
|
|
! M. Abramowitz, I.A. Stegun, Handbook of MathematicaL Functions, 1965.
|
||
|
|
! C.W. Clenshaw, National Physical Laboratory Mathematical Tables,
|
||
|
|
! Vol.5, 1962.
|
||
|
|
!
|
||
|
|
! Authors: From Numath Library by Tuan Dang Trong. F90 release 1.0 By J-P Moreau
|
||
|
|
!
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL (WP), INTENT(IN) :: X
|
||
|
|
REAL (WP) :: BESSJ,TOX,BJM,BJ,BJP,SUM
|
||
|
|
!
|
||
|
|
REAL (WP) :: DFLOAT,DSQRT,DABS
|
||
|
|
!
|
||
|
|
REAL*8, PARAMETER :: BIGNO = 1.E10_WP, BIGNI = 1.E-10_WP
|
||
|
|
!
|
||
|
|
INTEGER :: M,N,J,JSUM
|
||
|
|
!
|
||
|
|
INTEGER :: INT
|
||
|
|
!
|
||
|
|
INTEGER, PARAMETER :: IACC = 40
|
||
|
|
!
|
||
|
|
IF (N == 0) THEN !
|
||
|
|
BESSJ = BESSJ0(X) !
|
||
|
|
RETURN !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
IF (N == 1) THEN !
|
||
|
|
BESSJ = BESSJ1(X) !
|
||
|
|
RETURN !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
IF (X == 0.0E0_WP) THEN !
|
||
|
|
BESSJ = 0.0E0_WP !
|
||
|
|
RETURN !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
TOX = 2.0E0_WP/X !
|
||
|
|
IF (X > DFLOAT(N)) THEN !
|
||
|
|
!
|
||
|
|
BJM = BESSJ0(X) !
|
||
|
|
BJ = BESSJ1(X) !
|
||
|
|
!
|
||
|
|
DO J = 1,N-1 !
|
||
|
|
BJP = J*TOX*BJ-BJM !
|
||
|
|
BJM = BJ !
|
||
|
|
BJ = BJP !
|
||
|
|
END DO !
|
||
|
|
BESSJ = BJ !
|
||
|
|
!
|
||
|
|
ELSE
|
||
|
|
!
|
||
|
|
M = 2*((N+INT(DSQRT(DFLOAT(IACC*N))))/2) !
|
||
|
|
BESSJ = 0.0E0_WP !
|
||
|
|
JSUM = 0 !
|
||
|
|
SUM = 0.0E0_WP !
|
||
|
|
BJP = 0.0E0_WP !
|
||
|
|
BJ = 1.0E0_WP !
|
||
|
|
!
|
||
|
|
DO J = M,1,-1 !
|
||
|
|
BJM = J*TOX*BJ-BJP !
|
||
|
|
BJP = BJ !
|
||
|
|
BJ = BJM !
|
||
|
|
IF (DABS(BJ) > BIGNO) THEN !
|
||
|
|
BJ = BJ*BIGNI !
|
||
|
|
BJP = BJP*BIGNI !
|
||
|
|
BESSJ = BESSJ*BIGNI !
|
||
|
|
SUM = SUM*BIGNI !
|
||
|
|
END IF !
|
||
|
|
IF (JSUM /= 0) SUM = SUM+BJ !
|
||
|
|
JSUM = 1-JSUM !
|
||
|
|
IF (J.EQ.N) BESSJ = BJP !
|
||
|
|
END DO
|
||
|
|
!
|
||
|
|
SUM = 2.0E0_WP *SUM-BJ !
|
||
|
|
BESSJ = BESSJ/SUM !
|
||
|
|
!
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
RETURN !
|
||
|
|
!
|
||
|
|
END FUNCTION BESSJ
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSY (N,X)
|
||
|
|
! ------------------------------------------------------------------
|
||
|
|
!
|
||
|
|
! This subroutine calculates the second kind Bessel Function of
|
||
|
|
! integer order N, for any real X. We use here the classical
|
||
|
|
! recursive formula.
|
||
|
|
! ------------------------------------------------------------------
|
||
|
|
!
|
||
|
|
! References:
|
||
|
|
!
|
||
|
|
! M. Abramowitz, I.A. Stegun, Handbook of MathematicaL Functions, 1965.
|
||
|
|
! C.W. Clenshaw, National Physical Laboratory Mathematical Tables,
|
||
|
|
! Vol.5, 1962.
|
||
|
|
!
|
||
|
|
! Authors: From Numath Library by Tuan Dang Trong. F90 release 1.0 By J-P Moreau
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
REAL (WP), INTENT(IN) :: X
|
||
|
|
REAL (WP) :: BESSY,TOX,BY,BYM,BYP
|
||
|
|
!
|
||
|
|
INTEGER :: N,J
|
||
|
|
!
|
||
|
|
IF (N == 0) THEN !
|
||
|
|
BESSY = BESSY0(X) !
|
||
|
|
RETURN !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
IF (N == 1) THEN !
|
||
|
|
BESSY = BESSY1(X) !
|
||
|
|
RETURN !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
IF (X == 0.0E0_WP) THEN !
|
||
|
|
BESSY = -1.E30_WP !
|
||
|
|
RETURN !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
TOX = 2.0E0_WP/X !
|
||
|
|
BY = BESSY1(X) !
|
||
|
|
BYM = BESSY0(X) !
|
||
|
|
!
|
||
|
|
DO J = 1,N-1 !
|
||
|
|
BYP = J*TOX*BY-BYM !
|
||
|
|
BYM = BY !
|
||
|
|
BY = BYP !
|
||
|
|
END DO !
|
||
|
|
!
|
||
|
|
BESSY = BY !
|
||
|
|
!
|
||
|
|
RETURN !
|
||
|
|
!
|
||
|
|
END FUNCTION BESSY
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSK(N,X)
|
||
|
|
!
|
||
|
|
! This function computes the modified Bessel function Kn(x) for
|
||
|
|
! any real x positive and n >= 2. Taken from "Numerical Recipes"
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Input parameters:
|
||
|
|
!
|
||
|
|
! * N : order of the Bessel function Kn
|
||
|
|
! * X : argument of the Bessel function Kn
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Output :
|
||
|
|
!
|
||
|
|
! * BESSK : Kn(x)
|
||
|
|
!
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Last modified : 5 Jun 2020
|
||
|
|
!
|
||
|
|
!
|
||
|
|
USE REAL_NUMBERS, ONLY : TWO
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
INTEGER :: N,J,LOGF
|
||
|
|
!
|
||
|
|
REAL (WP) :: BESSK,X
|
||
|
|
REAL (WP) :: BK,BKM,BKP,TOX
|
||
|
|
!
|
||
|
|
LOGF=6 !
|
||
|
|
!
|
||
|
|
IF(N < 2) THEN !
|
||
|
|
WRITE(LOGF,10) !
|
||
|
|
STOP !
|
||
|
|
ENDIF !
|
||
|
|
!
|
||
|
|
TOX=TWO/X ! upward
|
||
|
|
BKM=BESSK0(X) ! recurrence
|
||
|
|
BK=BESSK1(X) ! for all x
|
||
|
|
!
|
||
|
|
DO J=1,N-1 !
|
||
|
|
BKP=BKM+J*TOX*BK !
|
||
|
|
BKM=BK !
|
||
|
|
BK=BKP !
|
||
|
|
END DO !
|
||
|
|
!
|
||
|
|
BESSK=BK !
|
||
|
|
!
|
||
|
|
! Format
|
||
|
|
!
|
||
|
|
10 FORMAT(5X,'<<<<< Bad argument N in BESSK >>>>>',//)
|
||
|
|
!
|
||
|
|
END FUNCTION BESSK
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION BESSI(N,X)
|
||
|
|
!
|
||
|
|
! This function computes the modified Bessel function Kn(x) for
|
||
|
|
! any real x positive and n >=2. Taken from "Numerical Recipes"
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Input parameters:
|
||
|
|
!
|
||
|
|
! * N : order of the Bessel function In
|
||
|
|
! * X : argument of the Bessel function In
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Output :
|
||
|
|
!
|
||
|
|
! * BESSK : In(x)
|
||
|
|
!
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Last modified : 5 Jun 2020
|
||
|
|
!
|
||
|
|
!
|
||
|
|
USE REAL_NUMBERS, ONLY : ZERO,ONE,TWO
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
INTEGER :: N,IACC,J,M,K,LOGF
|
||
|
|
!
|
||
|
|
INTEGER :: INT
|
||
|
|
!
|
||
|
|
REAL (WP) :: BESSI,X,BIGNO,BIGNI
|
||
|
|
REAL (WP) :: BI,BIM,BIP,TOX
|
||
|
|
!
|
||
|
|
REAL (WP) :: DABS,DSQRT,DFLOAT
|
||
|
|
!
|
||
|
|
PARAMETER(IACC=40,BIGNO=1.0E10_WP,BIGNI=1.0E10_WP) !
|
||
|
|
!
|
||
|
|
LOGF=6 !
|
||
|
|
!
|
||
|
|
IF(N < 2) THEN !
|
||
|
|
WRITE(LOGF,10) !
|
||
|
|
STOP !
|
||
|
|
ENDIF
|
||
|
|
!
|
||
|
|
IF(X == ZERO) THEN !
|
||
|
|
BESSI=ZERO !
|
||
|
|
ELSE !
|
||
|
|
TOX=TWO/DABS(X) !
|
||
|
|
BIP=ZERO !
|
||
|
|
BI=ONE !
|
||
|
|
BESSI=ZERO !
|
||
|
|
K=INT(DSQRT(DFLOAT(IACC*N))) !
|
||
|
|
M=2*(N+K) ! downward recurrence from even m
|
||
|
|
DO J=M,1,-1 ! make IACC larger to increase accuracy
|
||
|
|
BIM=BIP+DFLOAT(J)*TOX*BI ! the downward recurrence.
|
||
|
|
BIP=BI !
|
||
|
|
BI=BIM !
|
||
|
|
IF(DABS(BI) > BIGNO) THEN ! renormalize to prevent overflows
|
||
|
|
BESSI=BESSI*BIGNI !
|
||
|
|
BI=BI*BIGNI !
|
||
|
|
BIP=BIP*BIGNI !
|
||
|
|
END IF !
|
||
|
|
IF(J == N) BESSI=BIP !
|
||
|
|
END DO !
|
||
|
|
!
|
||
|
|
BESSI=BESSI*BESSI0(X)/BI ! normalize with bessi0
|
||
|
|
!
|
||
|
|
IF(X < ZERO .AND. MOD(N,2) == 1) BESSI=-BESSI !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
! Format
|
||
|
|
!
|
||
|
|
10 FORMAT(5X,'<<<<< Bad argument N in BESSI >>>>>',//)
|
||
|
|
!
|
||
|
|
END FUNCTION BESSI
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
FUNCTION EXPINT(N,X)
|
||
|
|
!
|
||
|
|
! This function computes the exponential integral function E_n(x)
|
||
|
|
! . Taken from "Numerical Recipes"
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Input parameters:
|
||
|
|
!
|
||
|
|
! * N : order of the Bessel function In
|
||
|
|
! * X : argument of the Bessel function In
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Output :
|
||
|
|
!
|
||
|
|
! * EXPINT : expint(x)
|
||
|
|
!
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Last modified : 23 Jun 2020
|
||
|
|
!
|
||
|
|
!
|
||
|
|
USE REAL_NUMBERS, ONLY : ZERO,ONE,TWO
|
||
|
|
USE EULER_CONST, ONLY : EUMAS
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
INTEGER :: N,MAXIT
|
||
|
|
INTEGER :: I,II,NM1,LOGF
|
||
|
|
!
|
||
|
|
REAL (WP) :: EXPINT,X,EPS,FPMIN
|
||
|
|
REAL (WP) :: A,B,C,D,DEL,FACT,H,PSI
|
||
|
|
!
|
||
|
|
REAL (WP) :: DEXP,DABS,DLOG
|
||
|
|
!
|
||
|
|
PARAMETER(MAXIT=100,EPS=1.0E-7_WP,FPMIN=1.0E-30_WP) !
|
||
|
|
!
|
||
|
|
LOGF=6 !
|
||
|
|
!
|
||
|
|
NM1=N-1 !
|
||
|
|
IF( N.LT.0 .OR. X.LT.ZERO .OR. & !
|
||
|
|
( X.EQ.ZERO .AND. (N.EQ.0 .OR. N.EQ.1) ) & !
|
||
|
|
) THEN !
|
||
|
|
WRITE(LOGF,10) !
|
||
|
|
STOP !
|
||
|
|
ELSE IF(N == 0) THEN !
|
||
|
|
EXPINT=DEXP(-X)/X !
|
||
|
|
ELSE IF(X == ZERO) THEN !
|
||
|
|
EXPINT=ONE/NM1 !
|
||
|
|
ELSE IF(X > ONE) THEN !
|
||
|
|
B=X+N !
|
||
|
|
C=ONE/FPMIN !
|
||
|
|
D=ONE/B !
|
||
|
|
H=D !
|
||
|
|
DO I=1,MAXIT !
|
||
|
|
A=-I*(NM1+I) !
|
||
|
|
B=B+TWO !
|
||
|
|
D=ONE/(A*D+B) !
|
||
|
|
C=B+A/C !
|
||
|
|
DEL=C*D !
|
||
|
|
H=H*DEL !
|
||
|
|
IF(DABS(DEL-ONE) < EPS) THEN !
|
||
|
|
EXPINT=H*DEXP(-X) !
|
||
|
|
RETURN !
|
||
|
|
END IF !
|
||
|
|
END DO !
|
||
|
|
WRITE(LOGF,20) !
|
||
|
|
ELSE !
|
||
|
|
IF(NM1 /= 0) THEN !
|
||
|
|
EXPINT=ONE/NM1 !
|
||
|
|
ELSE !
|
||
|
|
EXPINT=-DLOG(X)-EUMAS !
|
||
|
|
END IF !
|
||
|
|
FACT=ONE !
|
||
|
|
DO I=1,MAXIT !
|
||
|
|
FACT=-FACT*X/I !
|
||
|
|
IF(I /= NM1) THEN !
|
||
|
|
DEL=-FACT/(I-NM1) !
|
||
|
|
ELSE !
|
||
|
|
PSI=-EUMAS !
|
||
|
|
DO II=1,NM1 !
|
||
|
|
PSI=PSI+ONE/II !
|
||
|
|
END DO !
|
||
|
|
DEL=FACT*(-DLOG(X)+PSI) !
|
||
|
|
END IF !
|
||
|
|
EXPINT=EXPINT+DEL !
|
||
|
|
IF(DABS(DEL) < DABS(EXPINT)*EPS) RETURN !
|
||
|
|
ENDDO !
|
||
|
|
WRITE(LOGF,30) !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
! Format
|
||
|
|
!
|
||
|
|
10 FORMAT(5X,'<<<<< Bad argument N in EXPINT >>>>>',//)
|
||
|
|
20 FORMAT(5X,'<<<<< Continued fraction failed in EXPINT >>>>>',//)
|
||
|
|
30 FORMAT(5X,'<<<<< Series failed in EXPINT >>>>>',//)
|
||
|
|
!
|
||
|
|
END FUNCTION EXPINT
|
||
|
|
!
|
||
|
|
END MODULE BESSEL
|