! !======================================================================= ! 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