!
!=======================================================================
!
MODULE IQ_FUNCTIONS_1
!
!  This modules provides subroutines/functions to compute
!            static local-field factors I(q) = G(q,inf)
!
!  These I(q) DOES NOT DEPEND of the static structure factor S(q)
!
!
      USE ACCURACY_REAL
!
CONTAINS
!
!
!=======================================================================
!
      SUBROUTINE IQ_3D(X,RS,IQ_TYPE,IQ) 
!
!  This function computes the function I(q) = G(q,infinity) 
!    for 3D systems
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * IQ_TYPE  : type of approximation for I(q)
!                       IQ_TYPE  = 'NON' set to zero
!                       IQ_TYPE  = 'IKP' Iwamoto-Krotscheck-Pines parametrization
!                       IQ_TYPE  = 'KU1' Kugler 1
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 20 Nov 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 3)   ::  IQ_TYPE
!
      REAL (WP)             ::  X,RS
      REAL (WP)             ::  IQ
!
      IF(IQ_TYPE == 'NON') THEN                                     !
        IQ = ZERO                                                   !
      ELSE IF(IQ_TYPE == 'IKP') THEN                                !
        IQ=IQ_IKP_3D(X,RS)                                          !
      ELSE IF(IQ_TYPE == 'KU1') THEN                                !                                
        IQ=IQ_KU1_3D(X)                                             !
      END IF                                                        !
!
      END SUBROUTINE IQ_3D  
!
!=======================================================================
!
      FUNCTION IQ_IKP_3D(X,RS)
!
!  This function computes the Iwamoto-Krotscheck-Pines 
!    parametrization for the calculation of the I(q) function
!
!  We use a fourth-degree polynomial to fit the data of 
!    table II reference (1):  r_s = 1 --> A1
!                             r_s = 2 --> A2
!                             r_s = 5 --> A5
!
!  For a given value of (q / k_F), this gives 3 values of I(q / k_F).
!  Then, we use Lagrange interpolation to find  I(q / k_F) for the 
!    input value r_s
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!  Reference: (1) N. Iwamoto, E. Krotscheck and D. Pines, 
!                    Phys. Rev. B 28, 3936-3951 (1984)
!             (2) https://en.wikipedia.org/wiki/Lagrange_polynomial
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,FIVE,THIRD,FOURTH
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,RS
      REAL (WP)             ::  IQ_IKP_3D
      REAL (WP)             ::  Y,Y2,Y3,Y4
      REAL (WP)             ::  A1(0:4),A2(0:4),A5(0:4)
      REAL (WP)             ::  I1,I2,I5,L1,L2,L5
!
      DATA A1 / 0.0039314E0_WP, - 0.03844E0_WP , 0.29126E0_WP,   &  ! coefficients of 
                - 0.13488E0_WP,   0.018838E0_WP               /     ! the 4th-degree
      DATA A2 / 0.005127E0_WP , - 0.048227E0_WP, 0.32508E0_WP,   &  ! polynomials 
              - 0.14552E0_WP  ,   0.019639E0_WP               /     ! used to fit
      DATA A5 / 0.0077247E0_WP, - 0.068004E0_WP, 0.3837E0_WP ,   &  ! table II 
              - 0.15996E0_WP  ,   0.019756E0_WP               /     ! data
!
      Y  = X  + X                                                   ! q / k_F
      Y2 = Y  * Y                                                   !
      Y3 = Y2 * Y                                                   ! powers of Y
      Y4 = Y3 * Y                                                   !
!
!  Computing I(q) for r_s = 1,2 and 5
!
      I1 = A1(0) + A1(1) * Y + A1(2) * Y2 + A1(3) * Y3 + A1(4) * Y4 ! 
      I2 = A2(0) + A2(1) * Y + A2(2) * Y2 + A2(3) * Y3 + A2(4) * Y4 ! 
      I5 = A5(0) + A5(1) * Y + A5(2) * Y2 + A5(3) * Y3 + A5(4) * Y4 ! 
!
!  Performing Lagrange interpolation between I1, I2 and I5: 
!
!     I(r_s) = I1 * L1(r_s) + I2 * L2(r_s) + I5 * L5(r_s)
!
      L1 =   FOURTH * (RS - TWO) * (RS - FIVE)                      !
      L2 = - THIRD  * (RS - ONE) * (RS - FIVE)                      !
      L5 =   FOURTH * THIRD  * (RS - ONE) * (RS - TWO)              !
!
      IQ_IKP_3D = I1 * L1 + I2 * L2 + I5 * L5                       !
!
      END FUNCTION IQ_IKP_3D
!
!=======================================================================
!
      FUNCTION IQ_KU1_3D(X)
!
!  This function computes G(q,infinity), the value of the dynamic 
!    local-field correction for omega = infinity, for 3D systems 
!    in the Kugler approximation
!
!  References: (1) A. Kugler, J. Stat. Phys. 12, 35-87 (1975)
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!  Warning note: Here, we use the variable Y =  q / k_F =  2 * X 
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,FOUR,FIVE,SIX
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X
      REAL (WP)             ::  IQ_KU1_3D
      REAL (WP)             ::  Y,Y2,Y4,YM1,YM2
!
      REAL (WP)             ::  LOG,ABS
!
      Y   = X + X                                                   ! Y = q / k_F = eta
      Y2  = Y * Y                                                   ! Y^2         = eta^2
      Y4  = Y2 * Y2                                                 ! Y^4         = eta^4
      YM1 = ONE / Y                                                 ! 1 / Y       = 1/eta
      YM2 = ONE / Y2                                                ! 1 / Y^2     = 1/eta^2
!
      IQ_KU1_3D = - THREE / 16.0E0_WP * (                         & !
                  32.0E0_WP * YM2 / 63.0E0_WP  -                  & !
                 608.0E0_WP / 945.0E0_WP       -                  & !
                 142.0E0_WP * Y2 / 315.0E0_WP  -                  & !
                 TWO * Y4 / 315.0E0_WP         +                  & !
                 Y4 * (TWO - Y2 / 18.0E0_WP)   *                  & !
                 LOG(ABS(ONE - FOUR * YM2)) / 35.0E0_WP   +       & ! ref. (1) eq. (D6)
               ( -32.0E0_WP * YM2 / 63.0E0_WP  +                  & !
                  24.0E0_WP / 35.0E0_WP        -                  & !
                  TWO * Y2 / FIVE              +                  & !
                  Y4 / SIX                                        & !   
               )  * YM1 * LOG(ABS((Y + TWO) / (Y - TWO)))         & !
                                        )                           !
!
      END FUNCTION IQ_KU1_3D    
!
END MODULE IQ_FUNCTIONS_1
