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