!
!=======================================================================
!
MODULE LOCAL_FIELD_DYNAMIC
!
      USE ACCURACY_REAL
!
CONTAINS
!
!=======================================================================
!
      SUBROUTINE LFIELD_DYNAMIC(X,RS,OM0,OM1,N_OM,T,ETA, &
                                GQO_TYPE,OM,GR,GI)
!
!  This subroutine compute the dynamic local-field correction function
!    G(omega) -- for a given value of q -- from the the knwoledge
!    of the imaginary par of this function
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * OM0      : starting value of h_bar*omega / E_F
!       * OM1      : final value of h_bar*omega / E_F
!       * N_OM     : number of values of h_bar*omega / E_F
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * ETA      : viscosity   in SI
!       * GQO_TYPE : dynamic local-field correction type
!                       GQO_TYPE = 'NONE' no local field correction
!                       GQO_TYPE = 'ALFL' Alvarellos-Flores correction
!                       GQO_TYPE = 'BACA' Barriga-Carrasco correction
!                       GQO_TYPE = 'BBSA' Bachlechner-Böhm-Schinner
!                       GQO_TYPE = 'COPI' Constantin-Pitarke
!                       GQO_TYPE = 'DABR' Dabrowski
!                       GQO_TYPE = 'FWRA' Forstmann-Wierling-Röpke
!                       GQO_TYPE = 'HOK1' Hong-Kim correction
!                       GQO_TYPE = 'HOK2' Hong-Kim correction
!                       GQO_TYPE = 'JEWS' Jewsbury approximation
!                       GQO_TYPE = 'KUG1' Kugler q --> 0 approximation
!                       GQO_TYPE = 'KUG2' Kugler approximation
!                       GQO_TYPE = 'MDGA' Mithen-Daligault-Gregori
!                       GQO_TYPE = 'NEV2' Nevanlinna three-moment approximation
!                       GQO_TYPE = 'NLGA' Nagy-Laszlo-Giber approximation
!                       GQO_TYPE = 'RIA1' Richardson-Ashcroft G_s
!                       GQO_TYPE = 'RIA2' Richardson-Ashcroft G_n
!                       GQO_TYPE = 'RIA3' Richardson-Ashcroft G_a
!                       GQO_TYPE = 'SHMU' Shah-Mukhopadhyay
!                       GQO_TYPE = 'STGU' Sturm-Gusarov
!                       GQO_TYPE = 'TOWO' Toigo-Woodruff
!                       GQO_TYPE = 'UTI2' Utsumi-Ichimaru approximation
!                       GQO_TYPE = 'VISC' viscosity approximation
!
!
!  Output parameters:
!
!       * OM       : array containing omega
!       * GR       : array containing Re[G(omega)]
!       * GI       : array containing Im[G(omega)]
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 19 Jun 2020
!
!
      USE MATERIAL_PROP,    ONLY : DMN
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  GQO_TYPE
!
      INTEGER               ::  N_OM
!
      REAL (WP)             ::  X,Z,OM0,OM1,RS,T,ETA
      REAL (WP)             ::  OM(N_OM),GR(N_OM),GI(N_OM)
!
      IF(DMN == '3D') THEN                                          !
        CALL LOCAL_FIELD_DYNAMIC_3D(X,RS,OM0,OM1,N_OM,T,ETA,      & !
                                    GQO_TYPE,OM,GR,GI)              !
      ELSE IF(DMN == '2D') THEN                                     !
        CONTINUE                                                    !
      ELSE IF(DMN == '1D') THEN                                     !
        CONTINUE                                                    !
      END IF                                                        !
!
      END SUBROUTINE LFIELD_DYNAMIC
!
!------ 1) 3D case --------------------------------------------
!
!
!=======================================================================
!
      SUBROUTINE LOCAL_FIELD_DYNAMIC_3D(X,RS,OM0,OM1,N_OM,T,ETA,   &
                                        GQO_TYPE,OM,GR,GI)
!
!  This subroutine compute the dynamic local-field correction function
!    G(omega) -- for a given value of q -- from the the knwoledge
!    of the imaginary par of this function
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * OM0      : starting value of h_bar*omega / E_F
!       * OM1      : final value of h_bar*omega / E_F
!       * N_OM     : number of values of h_bar*omega / E_F
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * ETA      : viscosity   in SI
!       * GQO_TYPE : dynamic local-field correction type
!                       GQO_TYPE = 'NONE' no local field correction
!                       GQO_TYPE = 'ALFL' Alvarellos-Flores correction
!                       GQO_TYPE = 'BACA' Barriga-Carrasco correction
!                       GQO_TYPE = 'BBSA' Bachlechner-Böhm-Schinner
!                       GQO_TYPE = 'COPI' Constantin-Pitarke
!                       GQO_TYPE = 'DABR' Dabrowski
!                       GQO_TYPE = 'FWRA' Forstmann-Wierling-Röpke
!                       GQO_TYPE = 'HOK1' Hong-Kim correction
!                       GQO_TYPE = 'HOK2' Hong-Kim correction
!                       GQO_TYPE = 'JEWS' Jewsbury approximation
!                       GQO_TYPE = 'KUG1' Kugler q --> 0 approximation
!                       GQO_TYPE = 'KUG2' Kugler approximation
!                       GQO_TYPE = 'MDGA' Mithen-Daligault-Gregori
!                       GQO_TYPE = 'NEV2' Nevanlinna three-moment approximation
!                       GQO_TYPE = 'NLGA' Nagy-Laszlo-Giber approximation
!                       GQO_TYPE = 'RIA1' Richardson-Ashcroft G_s
!                       GQO_TYPE = 'RIA2' Richardson-Ashcroft G_n
!                       GQO_TYPE = 'RIA3' Richardson-Ashcroft G_a
!                       GQO_TYPE = 'SHMU' Shah-Mukhopadhyay
!                       GQO_TYPE = 'STGU' Sturm-Gusarov
!                       GQO_TYPE = 'TOWO' Toigo-Woodruff
!                       GQO_TYPE = 'UTI2' Utsumi-Ichimaru approximation
!                       GQO_TYPE = 'VISC' viscosity approximation
!
!
!  Internal parameters:
!
!       * GQ_TYPE  : local-field correction type (3D)
!       * EC_TYPE  : type of correlation energy functional
!       * SQ_TYPE  : structure factor approximation (3D)
!
!
!  Output parameters:
!
!       * OM       : array containing omega
!       * GR       : array containing Re[G(omega)]
!       * GI       : array containing Im[G(omega)]
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 27 Nov 2020
!
!
      USE REAL_NUMBERS,        ONLY : ZERO,ONE,TWO,FOUR
      USE COMPLEX_NUMBERS,     ONLY : ZEROC,ONEC,IC
      USE CONSTANTS_P1,        ONLY : H_BAR,M_E,E,EPS_0
      USE FERMI_SI,            ONLY : EF_SI,KF_SI
      USE PI_ETC,              ONLY : PI,PI3
      USE COULOMB_K,           ONLY : COULOMB_FF
      USE SF_VALUES,           ONLY : SQ_TYPE
      USE LF_VALUES,           ONLY : GQ_TYPE
      USE ENERGIES,            ONLY : EC_TYPE
      USE UTILITIES_1,         ONLY : RS_TO_N0
      USE UTILITIES_2,         ONLY : IMAG_TO_REAL
      USE UTILITIES_3,         ONLY : EPS_TO_PI
      USE CONFINEMENT_FF,      ONLY : CONFIN_FF
      USE DFUNCL_STAN_DYNAMIC, ONLY : RPA1_EPS_D_LG_3D
!
      USE UNITS,               ONLY : UNIT
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  GQO_TYPE
!
      INTEGER               ::  N_OM,K,IM
!
      REAL (WP)             ::  X,OM0,OM1,RS,T,ETA,Z
      REAL (WP)             ::  OM(N_OM),GR(N_OM),GI(N_OM)
      REAL (WP)             ::  N0,Q_SI,Q2
      REAL (WP)             ::  KOEF,K1,VC
      REAL (WP)             ::  EPSR,EPSI,PIR,PII
!
      REAL (WP)             ::  FLOAT,REAL,AIMAG
!
      COMPLEX (WP)          ::  GQO
      COMPLEX (WP)          ::  K0,K2
!
      Q_SI = TWO * X* KF_SI                                         ! q in SI
      Q2   = Q_SI * Q_SI                                            ! q^2
      KOEF = TWO * M_E * EF_SI / (H_BAR * H_BAR * Q2)               ! E_F / h_bar*omega_q
      N0   = RS_TO_N0('3D',RS)                                      !
!
      CALL COULOMB_FF('3D',UNIT,Q_SI,ZERO,VC)                       ! Coulomb potential
!
!  Checking for need to compute Re[G(omega)]
!    through Kramers-Kronig (IM = 1) or not (IM = 0)                   Re[G(omega)]
!                                                                         needed:
      IF(GQO_TYPE == 'NONE') THEN                                   !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'ALFL') THEN                              !
        IM = 1                                                      !     <--
      ELSE IF(GQO_TYPE == 'BACA') THEN                              !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'BBSA') THEN                              !
        IM = 1                                                      !     <--
      ELSE IF(GQO_TYPE == 'COPI') THEN                              !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'DABR') THEN                              !
        IM = 1                                                      !     <--
      ELSE IF(GQO_TYPE == 'FWRA') THEN                              !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'HOK1') THEN                              !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'HOK2') THEN                              !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'JEWS') THEN                              !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'KUG1') THEN                              !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'KUG2') THEN                              !
        IM = 1                                                      !     <--
      ELSE IF(GQO_TYPE == 'MDGA') THEN                              !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'NEV2') THEN                              !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'NLGA') THEN                              !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'SHMU') THEN                              !
        IM = 1                                                      !     <--
      ELSE IF(GQO_TYPE == 'STGU') THEN                              !
        IM = 1                                                      !     <--
      ELSE IF(GQO_TYPE == 'TOWO') THEN                              !
        IM = 1                                                      !     <-- Re[P(omega)]
      ELSE IF(GQO_TYPE == 'UTI2') THEN                              !
        IM = 0                                                      !
      ELSE IF(GQO_TYPE == 'VISC') THEN                              !
        IM = 0                                                      !
      END IF                                                        !
!
      IF(IM == 1) THEN                                              !
!
!  Loop on omega for IM = 1
!
        DO K=1,N_OM                                                 !
!
          OM(K) = OM0 + FLOAT(K - 1) * (OM1 - OM0) / FLOAT(N_OM - 1)!
          Z     = OM(K) * KOEF                                      ! omega / omega_q
!
!  Calculation of Im[G(omega)]
!
          IF(GQO_TYPE == 'ALFL') THEN                               !
!
            GI(K) = ALFL_LFC(X,Z)                                   !
!
          ELSE IF(GQO_TYPE == 'BBSA') THEN                          !
!
            GI(K) = BBSA_LFC(X,Z,RS,T)                              !
!
          ELSE IF(GQO_TYPE == 'DABR') THEN                          !
!
            GI(K) = DABR_LFC(X,Z,RS,T)                              !
!
          ELSE IF(GQO_TYPE == 'KUG2') THEN                          !
!
            GI(K) = KUG2_LFC(X,Z)                                   !
!
          ELSE IF(GQO_TYPE == 'SHMU') THEN                          !
!
            GI(K) = SHMU_LFC(X,Z,RS)                                !
!
          ELSE IF(GQO_TYPE == 'STGU') THEN                          !
!
            GI(K) = STGU_LFC(X,Z,RS,T)                              !
!
          ELSE IF(GQO_TYPE == 'TOWO') THEN                          !
!
            GI(K) = TOWO_LFC(X,Z,RS)                                !
!
          END IF                                                    !
!
        END DO                                                      !
!
!  Computing the real part
!
        CALL IMAG_TO_REAL(GI,OM,N_OM,GR)                            !
!
      END IF                                                        !
!
!  Loop on omega for all cases
!
      DO K= 1, N_OM                                                 !
!
        OM(K) =OM0 + FLOAT(K - 1) * (OM1 - OM0)/FLOAT(N_OM - 1)     !
        Z     = OM(K) * KOEF                                        ! omega / omega_q
!
!  Computing the RPA dielectric function, the Coulomb potential,
!    the polarization function, and the electron density
!
        CALL RPA1_EPS_D_LG_3D(X,Z,EPSR,EPSI)                        !
        CALL EPS_TO_PI(EPSR,EPSI,VC,PIR,PII)                        ! RPA polarizability
!
        K0 =(EPSR - ONE + IC * EPSI) / VC                           ! Chi_0
        K1 = - Q2 * KF_SI * KF_SI * KF_SI /                       & !
               (8.0E0_WP * PI3 * N0 * N0)                           ! 'ALFL' eq. (2)
        K2 = - Q2 / (FOUR * PI * N0 * K0)                           ! 'ALFL' eq. (2)
!
!  --> direct calculation of G(omega)
!
          IF(GQO_TYPE == 'NONE') THEN                               !
            GQO = ZEROC                                             !
          ELSE IF(GQO_TYPE == 'ALFL') THEN                          !
            GQO = K1 + K2 * (GR(K) + IC * GI(K))                    ! 'ALFL' eq. (2)
          ELSE IF(GQO_TYPE == 'BACA') THEN                          !
            GQO = BACA_LFC(X,Z,RS,T)                                !
          ELSE IF(GQO_TYPE == 'BBSA') THEN                          !
            GQO = GR(K) + IC * GI(K)                                !
          ELSE IF(GQO_TYPE == 'COPI') THEN                          !
            GQO = COPI_LFC(X,Z,RS,T,EC_TYPE)                        !
          ELSE IF(GQO_TYPE == 'DABR') THEN                          !
            GQO = GR(K) + IC * GI(K)                                !
          ELSE IF(GQO_TYPE == 'FWRA') THEN                          !
            GQO = FWRA_LFC(X,Z,RS,T,GQ_TYPE)                        !
          ELSE IF(GQO_TYPE == 'HOK1') THEN                          !
            GQO = HOK1_LFC(X,Z,RS,T)                                !
          ELSE IF(GQO_TYPE == 'HOK2') THEN                          !
            GQO = HOK2_LFC(X,Z,RS,T)                                !
          ELSE IF(GQO_TYPE == 'JEWS') THEN                          !
            GQO = JEWS_LFC(X,Z,RS,T,GQ_TYPE)                        !
          ELSE IF(GQO_TYPE == 'KUG1') THEN                          !
            GQO = KUG1_LFC(X,Z)                                     !
          ELSE IF(GQO_TYPE == 'KUG2') THEN                          !
            GQO = (GR(K) + IC * GI(K)) / K0                         ! 'KUG2' eq. (92)
          ELSE IF(GQO_TYPE == 'MDGA') THEN                          !
            GQO = MDGA_LFC(X,Z,RS,T,EC_TYPE)                        !
          ELSE IF(GQO_TYPE == 'NEV2') THEN                          !
            GQO = NEV2_LFC(X,Z,RS,T)                                !
          ELSE IF(GQO_TYPE == 'NLGA') THEN                          !
            GQO = NLGA_LFC(X,Z,RS,T)                                !
          ELSE IF(GQO_TYPE == 'SHMU') THEN                          !
            GQO = GR(K) + IC * GI(K)                                !
          ELSE IF(GQO_TYPE == 'STGU') THEN                          !
            GQO = GR(K) + IC * GI(K)                                !
          ELSE IF(GQO_TYPE == 'TOWO') THEN                          !
            GQO = (GR(K) + IC * GI(K)) / (VC * K0)                  ! 'TOWO' eq. (4.20)
          ELSE IF(GQO_TYPE == 'UTI2') THEN                          !
            GQO = UTI2_LFC(X,Z,RS,T,GQ_TYPE,SQ_TYPE)                !
          ELSE IF(GQO_TYPE == 'VISC') THEN                          !
            GQO = VISC_LFC(X,Z,RS,T,ETA,EC_TYPE)                    !
          END IF                                                    !
!
        GR(K) =  REAL(GQO,KIND=WP)                                  !
        GI(K) = AIMAG(GQO)                                          !
!
      END DO                                                        !
!
      END SUBROUTINE LOCAL_FIELD_DYNAMIC_3D
!
!=======================================================================
!
      FUNCTION ALFL_LFC(X,Z)
!
!  This function computes imaginary part of the Alvarellos-Flores
!      K+ part of the dynamic local-field correction in 3D
!
!  References: (1) J. E. Alvarellos and F. Flores,
!                     J. Phys. F: Met. Phys. 15, 1929-1939 (1985)
!
!
!  Warning : only the imagainary part is computed
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!
!
!  Output parameters:
!
!       * ALFL_LFC : Im[K+] for a given X (--> q) and Z (--> omega)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 17 Sep 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,FOURTH
      USE FERMI_SI,         ONLY : KF_SI
      USE PI_ETC,           ONLY : PI2
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,Z
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  ALFL_LFC
      REAL (WP)             ::  U,V
      REAL (WP)             ::  Q_SI
      REAL (WP)             ::  COEF1,OMEGA_P,OMEGA_M
      REAL (WP)             ::  KP1,KP2,KP
      REAL (WP)             ::  UMX,UPX,UMX2,UPX2
!
      REAL (WP)             ::  ABS,SQRT
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      U = X * Z                                                     ! omega / (q * v_F)
      V = Z * Y2                                                    ! omega / omega_{k_F}
!
      UPX   = ABS(U + X)                                            !
      UMX   = ABS(U - X)                                            !
      UPX2 = UPX * UPX                                              !
      UMX2 = UMX * UMX                                              !
!
      Q_SI = Y * KF_SI                                              !
!
      COEF1   = - FOURTH / (PI2 * Q_SI)                             !
!
      OMEGA_P = ONE / Z + ONE / U                                   ! omega+ / omega
      OMEGA_M = ABS(ONE / Z - ONE / U)                              ! omega- / omega
!
      KP1 = F_AF(ONE) - F_AF(UMX) + SQRT(F_AF(ONE + V)) -         & !
                                    SQRT(F_AF(UMX2 + V))            !
!                                                                   ! ref. (1) eq. (8)
      KP2 = F_AF(ONE) - F_AF(UPX) + SQRT(F_AF(ONE + V)) -         & !
                                    SQRT(F_AF(UPX2 + V))            !
!
      IF((OMEGA_M <= ONE) .AND. (OMEGA_P > ONE)) THEN               !
        KP = COEF1 * KP1                                            !
      ELSE                                                          !
        KP = COEF1 * (KP1 - KP2)                                    !
      END IF                                                        !
!
      ALFL_LFC = KP                                                 !
!
      END FUNCTION ALFL_LFC
!
!=======================================================================
!
      FUNCTION F_AF(X)
!
!  This function computes the Alvarellos-Flores function F(x).
!
!
!  References: (1) J. E. Alvarellos and F. Flores,
!                     J. Phys. F: Met. Phys. 15, 1929-1939 (1985)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,HALF,THIRD
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  X2,X3
      REAL (WP)             ::  F_AF
!
      REAL (WP)             ::  LOG,ABS
!
      X2 = X * X                                                    !
      X3 = X * X2                                                   !
!
      F_AF =   HALF * X2 +                                        & !
               HALF * ( (X + ONE) * LOG(ABS(X + ONE)) -           & !
                        (X - ONE) * LOG(ABS(X - ONE))             & !
                      )                                           & ! ref. (1) eq. (6)
             - HALF * THIRD *( (X3 + ONE) * LOG(ABS(X + ONE)) -   & !
                               (X3 - ONE) * LOG(ABS(X - ONE)) +   & !
                               X2                                 & !
                             )
!
      END FUNCTION F_AF
!
!=======================================================================
!
      FUNCTION BACA_LFC(X,Z,RS,T)
!
!  This function computes the Barriga-Carrasco dynamic
!      local-field correction in 3D
!
!  References: (1) M. D. Barriga-Carrasco, Laser Part. Beams 26,
!                     389-395 (2008)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * EC_TYPE  : type of correlation energy functional
!       * SQ_TYPE   : structure factor approximation (3D)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 17 Sep 2020
!
!
      USE REAL_NUMBERS,         ONLY : ONE,TWO,HALF
      USE COMPLEX_NUMBERS,      ONLY : IC
      USE CONSTANTS_P1,         ONLY : H_BAR,M_E
      USE FERMI_SI,             ONLY : KF_SI
      USE PLASMON_ENE_SI
      USE LOCAL_FIELD_STATIC,   ONLY : LOCAL_FIELD_STATIC_3D,PVHF_LFC,ICUT_LFC
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  Q_SI,EQ_SI,EP_SI
      REAL (WP)             ::  GQ1,GQ2
      REAL (WP)             ::  W
!
      REAL (WP)             ::  SQRT
!
      COMPLEX (WP)          ::  BACA_LFC
!
      Q_SI = TWO * X * KF_SI                                        !
!
      EQ_SI = HALF * H_BAR * H_BAR * Q_SI * Q_SI / M_E              ! h_bar omega_q in SI
!
      W = ENE_P_SI / (Z * EQ_SI)                                    ! omega_p / omega
!
      CALL LOCAL_FIELD_STATIC_3D(X,RS,T,'PVHF',GQ1)                 ! G_PV(q)
      CALL LOCAL_FIELD_STATIC_3D(X,RS,T,'ICUT',GQ2)                 ! G_IU(q)
!
      BACA_LFC = (GQ1 + IC * W * GQ2) / (ONE + IC * W )             ! ref. (1) eq. (20)
!
      END FUNCTION BACA_LFC
!
!=======================================================================
!
      FUNCTION BBSA_LFC(X,Z,RS,T)
!
!  This function computes the Bachlechner-Böhm-Schinner dynamic
!      local-field correction in 3D
!
!  References: (1) M. E. Bachlechner, H. M. Böhm and A. Schinner,
!                     Physica B 183, 293-302 (1993)
!
!  Warning : only the imaginary part is computed
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
!    -------->      + check if q is Q_SI or Y
!
      USE REAL_NUMBERS,        ONLY : ONE,FOUR,HALF,THIRD
      USE GAMMA_FUNC,          ONLY : GAM_1_4TH
      USE CONSTANTS_P1,        ONLY : H_BAR,M_E
      USE FERMI_SI,            ONLY : KF_SI
      USE PI_ETC,              ONLY : PI
      USE UTILITIES_1,         ONLY : ALFA
      USE GAMMA_ASYMPT,        ONLY : GAMMA_0_3D,GAMMA_I_3D
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  Y,Y2,V
      REAL (WP)             ::  G0,G1
      REAL (WP)             ::  C,D,ALPHA,BETA,OMEGA,Q_SI
      REAL (WP)             ::  GR,GI
      REAL (WP)             ::  BBSA_LFC
!
      REAL (WP)             ::  SQRT
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      V = Z * Y2                                                    ! omega / omega_{k_F}
!
      ALPHA = ALFA('3D')                                            !
!
      OMEGA = V * HALF * H_BAR * KF_SI * KF_SI / M_E                ! omega
      Q_SI  = Y * KF_SI                                             ! q in SI
!
!  Computing the asymtotic parameters gamma_0 and gamma_inf
!
      G0 = GAMMA_0_3D(RS,T)                                         !
      G1 = GAMMA_I_3D(RS,T)                                         !
!
      C    = 23.0E0_WP * ALPHA / 60.0E0_WP                          !
      D    = SQRT(32.0E0_WP * PI) / GAM_1_4TH                       ! ref. (1) eq. (B3b)
      BETA = ( (G0 - G1) / (C * D * RS) )**(FOUR * THIRD)           ! ref. (1) eq. (B3b)
!
      GI= C * RS * OMEGA * Q_SI * Q_SI  *                         & !
              ( BETA / (ONE + BETA * OMEGA * OMEGA) )**1.25E0_WP    ! ref. (1) eq. (B3a)
!
      BBSA_LFC = GI                                                 !
!
      END FUNCTION BBSA_LFC
!
!=======================================================================
!
      FUNCTION COPI_LFC(X,Z,RS,T,EC_TYPE)
!
!  This function computes the Constantin-Pitarke dynamic
!      local-field correction in 3D
!
!  References: (1) L. A. Constantin and J. M. Pitarke,
!                     Phys. Rev. B 75, 245127 (2007)
!              (2) M. Corradini, R. Del SOle, G. Onida and M. Palummo,
!                     Phys. Rev. B 57, 14569-14571 (1998)
!
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * EC_TYPE  : type of correlation energy functional
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  6 Oct 2020
!
!
      USE REAL_NUMBERS,        ONLY : ONE,THREE,FOUR,HALF
      USE COMPLEX_NUMBERS,     ONLY : IC
      USE PI_ETC,              ONLY : PI,PI2
      USE FERMI_AU,            ONLY : KF_AU
      USE CORRELATION_ENERGIES
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 6)   ::  EC_TYPE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  Y,Y2,Q_AU,Q2,OM
      REAL (WP)             ::  BB,CC,AN,CN
      REAL (WP)             ::  A1,A2,B1,B2
      REAL (WP)             ::  XR,X3
      REAL (WP)             ::  AL,BE,N,F00
      REAL (WP)             ::  EC,D_EC_1,D_EC_2
!
      REAL (WP)             ::  SQRT
!
      COMPLEX (WP)          ::  COPI_LFC
      COMPLEX (WP)          ::  U,KN
      COMPLEX (WP)          ::  NUM,DEN
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      Q_AU  = Y * KF_AU                                             ! q     in a.u.
      Q2    = Q_AU * Q_AU                                           ! q^2   in a.u.
      OM    = HALF * Z * Q2                                         ! omega in a.u.
!
!  Computing the correlation energy and its derivatives
!
      EC = EC_3D(EC_TYPE,1,RS,T)                                    !
      CALL DERIVE_EC_3D(EC_TYPE,1,5,RS,T,D_EC_1,D_EC_2)             !
!
      AN = EXP(10.5E0_WP / (ONE + RS)**6.5E0_WP) + HALF             ! ref. (1) eq. (A4)
      CN = AN * AN / 36.0E0_WP                                      ! ref. (1) eq. (11)
!
      U  = - IC * OM                                                !
!
      A1 = 2.15E0_WP                                                ! \
      A2 = 0.435E0_WP                                               !  |
      B1 = 1.57E0_WP                                                !   > ref. (2)
      B2 = 0.409E0_WP                                               !  |
      XR = SQRT(RS)                                                 ! /
!
      X3 = XR * XR * XR                                             !
!
      AL  = -0.0255184916E0_WP                                      !
      BE  = -0.691590707E0_WP                                       !
      N   = KF_AU * KF_AU * KF_AU / (THREE * PI2)                   ! electron density in a.u.
      F00 = FOUR * PI * AL * N**BE                                  ! ref. (1) eq. (6)
!
      BB = (ONE + A1 * XR + A2 * X3) / (THREE + B1 * XR + B2 * X3)  ! ref. (2) eq. (7)
      CC = - PI * HALF * (EC + RS * D_EC_1) / KF_AU                 ! ref. (1) eq. (A2)
!
      NUM = F00 * (ONE + AN * U + CN * U * U)                       ! \
      DEN = FOUR * PI * BB * (ONE + U * U)                          !  > ref. (1) eq. (A3)
      KN  = NUM / DEN                                               ! /
      print *,'EC,D_EC_1=',EC,D_EC_1
      print *,'BB,KN,Q2 =',BB,KN,Q2
      print *,'KF_AU',KF_AU
      print *,'Y2',Y2
      print *,'CC',CC
      print *,'  '
!
      COPI_LFC = BB * (ONE - EXP(- KN * Q2)) +                    & ! ref. (1) eq. (12)
                 Y2 * CC / (ONE + ONE / Q2)                         !
!
      END FUNCTION COPI_LFC
!
!=======================================================================
!
      FUNCTION DABR_LFC(X,Z,RS,T)
!
!  This function computes the Dabrowski dynamic
!      local-field correction in 3D
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!  References: (1) B. Dabrowski, Phys. Rev. B 34, 4989-4995 (1986)
!
!  Warning : only the imaginary part is computed
!
!
!  Note: In ref. (1), q is in unit of k_F and h_bar omega in units of 2 E_F
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  8 Oct 2020
!
!
      USE REAL_NUMBERS,        ONLY : ONE,TWO,FOUR,FIVE, &
                                      HALF,THIRD
      USE GAMMA_FUNC,          ONLY : GAM_1_4TH,GAM_3_4TH
      USE PI_ETC,              ONLY : SQR_PI
      USE CONSTANTS_P1,        ONLY : H_BAR,M_E
      USE FERMI_SI,            ONLY : EF_SI,KF_SI
      USE UTILITIES_1,         ONLY : ALFA
      USE LOCAL_FIELD_STATIC
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  GQ_TYPE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  DABR_LFC
      REAL (WP)             ::  GQ1,GQ2
      REAL (WP)             ::  AQ,BQ
      REAL (WP)             ::  C
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  Q_SI,Q2,EQ_SI,OM
      REAL (WP)             ::  NUM,DEN
!
      REAL (WP), PARAMETER  ::  D = FOUR * GAM_3_4TH / (SQR_PI * GAM_1_4TH)
!
      Y     = X + X                                                 ! q / k_F
      Y2    = Y * Y                                                 ! q^2 in reduced units
      Q_SI  = TWO * X * KF_SI                                       ! q   in SI
      Q2    = Q_SI * Q_SI                                           ! q^2 in SI
      EQ_SI = HALF * H_BAR * H_BAR * Q2 / M_E                       ! h_bar omega_q in SI
!
      OM = Z * EQ_SI * HALF * EF_SI / H_BAR                         ! omega in reduced units
!
      C = 23.0E0_WP * ALFA('3D') * RS / 60.0E0_WP                   !
!
      CALL LOCAL_FIELD_STATIC_3D(X,RS,T,'PVHF',GQ1)                 ! Pathak-Vashishta LFC
      CALL LOCAL_FIELD_STATIC_3D(X,RS,T,'VASI',GQ2)                 ! Vashishta-Singwi LFC
!
      NUM = GQ2 - GQ1                                               !
      DEN = C * D * Y2                                              !
!
      AQ = C * Y2 * (NUM / DEN)**(FIVE * THIRD)                     ! ref. (1) eq. (8)
      BQ = (NUM / DEN)**(FOUR * THIRD)                              ! ref. (1) eq. (9)
!
      DABR_LFC = AQ * OM / (ONE + BQ * OM * OM)**(FIVE / FOUR)      ! ref. (1) eq. (6)
!
      END FUNCTION DABR_LFC
!
!=======================================================================
!
      FUNCTION FWRA_LFC(X,Z,RS,T,GQ_TYPE)
!
!  This function computes the Forstmann-Wierling-Röpke dynamic
!      local-field correction in 3D
!
!  References: (1) C. Forstmann, A. Wierling and G. Röpke,
!                     Phys. Rev. E 81, 026405 (2010)
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * GQ_TYPE  : local-field correction type (3D)
!
!
!  Note: in the notations of ref. (1), we have:
!
!       * u = Z / X
!       * z = X
!
!    and
!
!                 LINDHARD_S(x)
!        g(x) =  ---------------
!                    2 * x
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 17 Sep 2020
!
!
      USE REAL_NUMBERS,        ONLY : ZERO,ONE,TWO,FIVE
      USE COMPLEX_NUMBERS,     ONLY : IC
      USE PI_ETC,              ONLY : PI_INV
      USE CONSTANTS_P1,        ONLY : H_BAR
      USE FERMI_SI,            ONLY : EF_SI,KF_SI
      USE IQ_FUNCTIONS_1,      ONLY : IQ_KU1_3D
      USE PLASMON_ENE_SI
      USE UTILITIES_1,         ONLY : ALFA
      USE COULOMB_K,           ONLY : COULOMB_FF
      USE DFUNC_STATIC,        ONLY : RPA1_EPS_S_LG
      USE DFUNCL_STAN_DYNAMIC, ONLY : RPA1_EPS_D_LG_3D
      USE LOCAL_FIELD_STATIC
!
      USE UNITS,               ONLY : UNIT
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  GQ_TYPE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  Y,Y2,Y4
      REAL (WP)             ::  EPSR0,EPSI0
      REAL (WP)             ::  EPSR1,EPSI1
      REAL (WP)             ::  Q_SI,COEF1,GQ1,GQ2
      REAL (WP)             ::  GQ_INF_3D
      REAL (WP)             ::  EP_SI,V_C
      REAL (WP)             ::  UPZ,UMZ
      REAL (WP)             ::  OP2,CHI_02,ALPHA
!
      COMPLEX (WP)          ::  FWRA_LFC
      COMPLEX (WP)          ::  CHI0,CHI1
      COMPLEX (WP)          ::  D10,D20,C20
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y  *  Y                                                  ! Y^2
      Y4 = Y2 * Y2                                                  ! Y^4
!
      Q_SI = TWO * X * KF_SI                                        !
!
      ALPHA = ALFA('3D')                                            !
!
      OP2 = (ENE_P_SI / H_BAR)**2                                   ! omega_p^2
!
      UPZ = Z / X + X                                               ! u + z
      UMZ = Z / X - X                                               ! u - z
!
!  Computing chi_o(q) and chi_0(q, omega)
!
      CALL RPA1_EPS_S_LG(X,'3D',EPSR0,EPSI0)                        !
      CALL RPA1_EPS_D_LG_3D(X,Z,EPSR1,EPSI1)                        !
      CALL COULOMB_FF('3D',UNIT,Q_SI,ZERO,V_C)                      !
!
      CHI0 = (ONE - EPSR0  - IC * EPSI0) / V_C                      !
      CHI1 = (ONE - EPSR1  - IC * EPSI1) / V_C                      !
!
      CHI_02 = PI_INV * ALPHA * RS                                  ! a_0 * k_F = 1/ (alpha * rs)
!
      D10 = OP2 / (EPSR0 - ONE + IC * EPSI0)                        ! ref. (1) eq. (25)
      D20 = ( 12.0E0_WP * Y2 / FIVE + Y4) *                       & !
            (EF_SI / H_BAR)**2 - D10                                ! ref. (1) eq. (25)
      C20 = D10 * (CHI0 / CHI1 - ONE) / D20 + X * X / D20           ! ref. (1) eq. (24)
!
      CALL LOCAL_FIELD_STATIC_3D(X,RS,T,GQ_TYPE,GQ1)                ! G(q,0)
      GQ2 = IQ_KU1_3D(X)                                            ! G(q,inf)
!
      FWRA_LFC = GQ1 + (GQ2 - GQ1) * C20                            ! ref. (1) eq. (23)
!
      END FUNCTION FWRA_LFC
!
!=======================================================================
!
      FUNCTION HOK1_LFC(X,Z,RS,T)
!
!  This function computes the Hong-Kim dynamic
!      local-field correction in 3D
!
!  References: (1) J. Hong and C. Kim, Phys. Rev. A 43, 1965-1971 (1991)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!  Note: q in units of 1/a0 and omega in units of omega_p
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  7 Oct 2020
!
!
      USE REAL_NUMBERS,            ONLY : ONE,TWO,THREE,HALF,THIRD
      USE CONSTANTS_P1,            ONLY : BOHR,H_BAR,E,M_E,K_B
      USE FERMI_SI,                ONLY : KF_SI,VF_SI
      USE LOCAL_FIELD_STATIC,      ONLY : LOCAL_FIELD_STATIC_3D,ICUT_LFC
      USE STRUCTURE_FACTOR_STATIC, ONLY : STFACT_STATIC_3D
      USE IQ_FUNCTIONS_1,          ONLY : IQ_KU1_3D
      USE PLASMON_ENE_SI
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  GAMMA,XX,SQ,GQ1,ETA2
      REAL (WP)             ::  Q_SI,Q1,Q2,EQ,OM
!
      REAL (WP)             ::  SQRT
!
      COMPLEX (WP)          ::  HOK1_LFC
!
      Q_SI = TWO * X * KF_SI                                        ! q   in SI
      Q1   = Q_SI * BOHR                                            ! q   in units of 1/a0
      Q2   = Q1 * Q1                                                ! q^2 in units of 1/a0
!
      EQ = HALF * H_BAR * H_BAR * Q_SI * Q_SI / M_E                 ! h_bar omega_q in SI
      OM = Z * EQ / ENE_P_SI                                        ! omega in units of omega_p
!
      GAMMA = E * E / (RS * BOHR * K_B * T)                         ! plasma coupling strength
      XX    = SQRT(THREE * GAMMA) * OM / Q1                         !
!
      CALL STFACT_STATIC_3D(X,RS,T,'TWA','ICUT',SQ)                 !
!
      GQ1  = ONE + (ONE - ONE / SQ) * Q2 * THIRD / GAMMA            !
      ETA2 = 1.5E0_WP * GAMMA * (ONE - IQ_KU1_3D(X)) / Q2 +       & ! ref. (1) eq. (28)
                                HALF * (ONE - ONE / SQ)             !
!
      HOK1_LFC = GQ1 - ETA2 * THIRD * Q2 * Q(XX) / GAMMA            ! ref. (1) eq. (29)
!
      END FUNCTION HOK1_LFC
!
!=======================================================================
!
      FUNCTION Q(X)
!
!  This function computes Q(x) as given by Hong and Kim for
!    the calculation of their dynamical 3D local-field corrections
!
!  References: (1) J. Hong and C. Kim, Phys. Rev. A 43, 1965-1971 (1991)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
!
      USE REAL_NUMBERS,        ONLY : ONE
      USE EXT_FUNCTIONS,       ONLY : W                             ! Vlasov function W(x)
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X
!
      COMPLEX (WP)          ::  Q
!
      Q = X * X - ONE + ONE / W(X)                                  !
!
      END FUNCTION Q
!
!=======================================================================
!
      FUNCTION HOK2_LFC(X,Z,RS,T)
!
!  This function computes the Hong-Kim dynamic
!      local-field correction in 3D
!
!  References: (1) J. Hong and C. Kim, Phys. Rev. A 43, 1965-1971 (1991)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
!
      USE REAL_NUMBERS,            ONLY : ONE,TWO,THREE,HALF,THIRD
      USE COMPLEX_NUMBERS,         ONLY : IC
      USE CONSTANTS_P1,            ONLY : BOHR,H_BAR,E,M_E,K_B
      USE FERMI_SI,                ONLY : KF_SI,VF_SI
      USE PI_ETC,                  ONLY : PI
      USE STRUCTURE_FACTOR_STATIC, ONLY : STFACT_STATIC_3D
      USE IQ_FUNCTIONS_1,          ONLY : IQ_KU1_3D
      USE EXT_FUNCTIONS,           ONLY : DAWSON                    ! Dawson function D(x)
      USE PLASMON_ENE_SI
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  XX,GQ1,GQ2,SQ
      REAL (WP)             ::  Q_SI,Q1,Q2,GAMMA
      REAL (WP)             ::  EQ,OM
!
      REAL (WP)             ::  SQRT,EXP
!
      COMPLEX (WP)          ::  HOK2_LFC,Q,ZZ,QQ
!
      COMPLEX (WP)          ::  CMPLX
!
      Q_SI = TWO * X * KF_SI                                        !
      Q1   = Q_SI * BOHR                                            ! q   in units of 1/a0
      Q2   = Q1 * Q1                                                ! q^2 in units of 1/a0
!
      EQ = HALF * H_BAR * H_BAR * Q_SI * Q_SI / M_E                 ! h_bar omega_q in SI
      OM = Z * EQ / ENE_P_SI                                        ! omega in units of omega_p
!
      GAMMA = E * E / (RS * BOHR * K_B * T)                         ! plasma coupling strength
      XX    = SQRT(THREE * GAMMA) * OM / Q1                         !
      ZZ    = ONE - TWO * XX * DAWSON(XX) + IC * SQRT(PI) * XX    & !
                                               * EXP(XX * XX)       !
      QQ    = ONE / ZZ + TWO * XX - ONE                             !
!
      CALL STFACT_STATIC_3D(X,RS,T,'TWA','ICUT',SQ)                 !
!
      GQ1  = ONE + (ONE - ONE / SQ) * Q2 * THIRD / GAMMA            !
      GQ2 = IQ_KU1_3D(X)                                            !
!
      HOK2_LFC=CMPLX(GQ1 - HALF * (GQ1 - GQ2) * QQ,KIND=WP)         ! ref. (1) eq. (29)
!
      END FUNCTION HOK2_LFC
!
!=======================================================================
!
      FUNCTION JEWS_LFC(X,Z,RS,T,GQ_TYPE)
!
!  This function computes the Jewsbury dynamic
!      local-field correction in 3D
!
!  References: (1) P. Jewsbury, Aust. J. Phys. 32, 361-368 (1979)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * GQ_TYPE  : local-field correction type (3D)
!       * EC_TYPE  : type of correlation energy functional
!       * SQ_TYPE  : structure factor approximation (3D)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
!
      USE REAL_NUMBERS,        ONLY : FOUR,HALF
      USE COMPLEX_NUMBERS,     ONLY : IC
      USE CONSTANTS_P1,        ONLY : H_BAR,M_E
      USE FERMI_SI,            ONLY : KF_SI
      USE PLASMON_ENE_SI
      USE LOCAL_FIELD_STATIC
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  GQ_TYPE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  GAM0,GAM1,GQ1,GQ2
      REAL (WP)             ::  Q_SI,EQ_SI,EP_SI,W
!
      REAL (WP)             ::  SQRT
!
      COMPLEX (WP)          ::  JEWS_LFC
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      Q_SI = Y * KF_SI                                              !
!
      EQ_SI = HALF * H_BAR * H_BAR * Q_SI * Q_SI / M_E              ! h_bar omega_q in SI
!
      W = (Z * EQ_SI) /  ENE_P_SI                                   ! omega / omega_p
!
      GAM0 = 0.033E0_WP * RS                                        !
      GAM1 = 0.15E0_WP * SQRT(RS)                                   !
!
      CALL LOCAL_FIELD_STATIC_3D(X,RS,T,GQ_TYPE,GQ1)                !
!
      GQ2 = GAM0 + GAM1 * Y2                                        ! ref. (1) eq. (23)
!
      JEWS_LFC = GQ1 + IC * GQ2 * W                                 ! ref. (1) eq. (20)
!
      END FUNCTION JEWS_LFC
!
!=======================================================================
!
      FUNCTION KUG1_LFC(X,Z)
!
!  This function computes the Kugler dynamic
!      local-field correction in 3D
!
!  References: (1) A. Kugler, J. Stat. Phys. 12, 35-87 (1975)
!
!  Note: Here, we have used the fact that
!
!       eps = 1 - V_C * chi_0 = 1 + (q_TF / q)^2 * LINDHARD_FUNCTION
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
!
!
      USE REAL_NUMBERS,        ONLY : ZERO,ONE,THREE,FOUR
      USE COMPLEX_NUMBERS,     ONLY : IC
      USE CONSTANTS_P1,        ONLY : H_BAR,M_E
      USE FERMI_SI,            ONLY : KF_SI,VF_SI
      USE PI_ETC,              ONLY : PI,PI2
      USE LINDHARD_FUNCTION,   ONLY : LINDHARD_D
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,Z
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  U,U2
      REAL (WP)             ::  Q_SI
      REAL (WP)             ::  COEF1,COEF2,COEF3
      REAL (WP)             ::  PPR,PPI,LR0,LI0
!
      REAL (WP)             ::  LOG
!
      COMPLEX (WP)          ::  KUG1_LFC
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    ! Y^2
!
      U  = X * Z                                                    ! omega / (q * v_F)
      U2 = U * U                                                    !
!
      Q_SI = Y * KF_SI                                              !
!
      COEF1 = M_E * KF_SI / (FOUR * PI2 * H_BAR * H_BAR) * Y2       ! ref. (1) eq. (108)
      COEF2 = THREE * M_E * M_E * VF_SI * U * Y2 /                & !
              (16.0E0_WP * PI * H_BAR * H_BAR * H_BAR)              !
!
      PPR = COEF1 * (                                             & !
              ONE - 1.5E0_WP * U2 - 0.75E0_WP * U * (ONE - U2) *  & ! ref. (1) eq. (108)
              LOG( ABS((U + ONE) / (U - ONE)) )                   & !
                    )                                               !
      PPI = COEF2 * (ONE - U2)                                      ! ref. (1) eq. (106)
!
      IF(U >= ONE) PPI = ZERO                                       !
!
      CALL LINDHARD_D(X,Z,'3D',LR0,LI0)                             !
!
      COEF3 = - PI2 * H_BAR / (M_E * KF_SI)                         ! - (q_TF / q)^2 / V_C
!
      KUG1_LFC = COEF3 * (PPR + IC * PPI) / (LR0 + IC * LI0)        ! ref. (1) eq. (92)
!
      END FUNCTION KUG1_LFC
!
!=======================================================================
!
      FUNCTION KUG2_LFC(X,Z)
!
!  This function computes the Kugler dynamic
!      local-field correction in 3D
!
!  Warning : only the imaginary part is computed
!
!  References: (1) A. Kugler, J. Stat. Phys. 12, 35-87 (1975)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
!    --> UNFINISHED: real part missing !!!
!
!
      USE REAL_NUMBERS,        ONLY : ZERO,ONE,TWO,FOUR,EIGHT,  &
                                      HALF,THIRD
      USE COMPLEX_NUMBERS,     ONLY : IC
      USE CONSTANTS_P1,        ONLY : H_BAR,M_E
      USE FERMI_SI,            ONLY : KF_SI,VF_SI
      USE PI_ETC,              ONLY : PI,PI2
      USE LINDHARD_FUNCTION,   ONLY : LINDHARD_D
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,Z
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  U,V,V2
      REAL (WP)             ::  COEF1,COEF2,COEF3,COEF4
      REAL (WP)             ::  UMX,UPX,OMV,OPV
      REAL (WP)             ::  PP1,PP2,PPI
      REAL (WP)             ::  LR0,LI0
      REAL (WP)             ::  KUG2_LFC
!
      REAL (WP)             ::  LOG,ABS,SQRT
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      U  = X * Z                                                    ! omega / (q * v_F)
      V  = Z * Y2                                                   ! omega / omega_{k_F}
      V2 = V * V                                                    !
!
      COEF1 = M_E * KF_SI / (64.0E0_WP * PI * H_BAR * H_BAR) * Y    !
      COEF2 = M_E * KF_SI / (32.0E0_WP * PI * H_BAR * H_BAR)        !
      COEF3 = COEF2 * U                                             !
!
      UMX = U - X                                                   !
      UPX = U + X                                                   !
      OMV = ONE - V                                                 !
      OPV = ONE + V                                                 !
!
      PP1 = COEF1 * (                                             & !
                      TWO * V + OPV**(-HALF) *                    & !
                      (FOUR + TWO * V - HALF * V * V) *           & !
                      LOG(ABS((ONE + SQRT(V) + ONE) /             & !
                              (ONE + SQRT(V) - ONE))) -           & !
                                OMV**(-HALF) *                    & !
                      (FOUR - TWO * V - HALF * V * V) *           & !
                      LOG(ABS((ONE - SQRT(V) + ONE) /             & !
                              (ONE - SQRT(V) - ONE)))             & !
                    )                                 +           & ! ref. (1) eq. (104a)
            COEF3 * (                                             & !
                      EIGHT * LOG(V) - 16.0E0_WP * LOG(TWO) +     & !
                                OPV**(-HALF) *                    & !
                      (FOUR + TWO * V - HALF * V * V) *           & !
                      LOG(ABS((ONE + SQRT(V) + ONE) /             & !
                              (ONE + SQRT(V) - ONE))) -           & !
                                OMV**(-HALF) *                    & !
                      (FOUR - TWO * V - HALF * V * V) *           & !
                      LOG(ABS((ONE - SQRT(V) + ONE) /             & !
                              (ONE - SQRT(V) - ONE)))             & !
                    )                                               !
!
      PP2 = COEF2 * UMX * ( UMX**2 - ONE +                        & !
                            FOUR * LOG(UMX**2 - ONE)              & !
                          )     -                                 & !
            COEF2 * UPX * ( UPX**2 - ONE +                        & !
                            FOUR * LOG(UPX**2 - ONE)              & !
                          )     +                                 & !
            COEF2 * (                                             & !
                      UPX * (V + FOUR * LOG(V)) -                 & !
                      EIGHT * UMX * LOG(TWO)    +                 & !
                      UPX * (ONE + V)**1.5E0_WP *                 & !
                      (FOUR + TWO * V - HALF * V2) *              & !
                      LOG((SQRT(ONE + V) + ONE) /                 & !
                          (SQRT(ONE + V) - ONE))   +              & !
                      1.5E0_WP * (ONE + TWO * UMX**2 -            & !
                      THIRD * UMX**4) *                           & !
                      LOG(ABS((V - ONE + U) / (V - ONE - U))) -   & !
                      1.5E0_WP * (ONE + TWO * UPX**2 -            & !
                      THIRD * UPX**4) *                           & !
                      LOG(ABS((V + ONE + U) / (V + ONE - U)))     & !
                    )                                                !
!
      IF(U <= (ONE - U / Z)) THEN                                   !
        IF(X <= ONE) THEN                                           !
          PPI = PP1                                                 !
        ELSE                                                        !
          PPI = ZERO                                                !
        END IF                                                      !
      ELSE                                                          !
        IF(U <= (ONE + U / Z)) THEN                                 !
          PPI = PP2                                                 !
        ELSE                                                        !
          PPI = ZERO                                                !
        END IF                                                      !
      END IF                                                        !
!
      CALL LINDHARD_D(X,Z,'3D',LR0,LI0)                             !
!
      COEF4 = - PI2 * H_BAR / (M_E * KF_SI)                         ! - (q_TF / q)^2 / V_C
!
      KUG2_LFC = COEF4 * PPI  / (LR0 + IC  *LI0)                    ! ref. (1) eq. (92)
!
      END FUNCTION KUG2_LFC
!
!=======================================================================
!
      FUNCTION MDGA_LFC(X,Z,RS,T,EC_TYPE)
!
!  This function computes the Mithen-Daligault-Gregori dynamic
!      local-field correction in 3D
!
!  References: (1) J. P. Mithen, J. Daligault and G. Gregori,
!                     Phys. Rev. E 85, 056407 (2012)
!              (2) S. Ichimaru, "Statistical Plasma Physics", Vol1,
!                     p. 72, (CRC Press, 2018)
!
!  Note: the coefficient in ref. (1) eq. (11) is misprinted.
!        Ref. (2) eq. (3.77) gives the correct one
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * EC_TYPE  : type of correlation energy functional
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Dec 2020
!
!
      USE REAL_NUMBERS,            ONLY : ZERO,ONE,TWO,THREE,HALF
      USE COMPLEX_NUMBERS,         ONLY : IC
      USE CONSTANTS_P1,            ONLY : BOHR,H_BAR,E,M_E,K_B
      USE FERMI_SI,                ONLY : KF_SI
      USE STRUCTURE_FACTOR_STATIC, ONLY : STFACT_STATIC_3D
      USE RELAXATION_TIME_STATIC,  ONLY : TAIQ_RT_3D
      USE IQ_FUNCTIONS_1,          ONLY : IQ_KU1_3D
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 6)   ::  EC_TYPE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  Y,Y2,V,R_S
      REAL (WP)             ::  Q_SI,Q2,SQ,GQ1,GQ2
      REAL (WP)             ::  GAMMA,OMEGA,COEF
      REAL (WP)             ::  TAU_M
!
      COMPLEX (WP)          ::  MDGA_LFC
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      V = Z * Y2                                                    ! omega / omega_{k_F}
!
      Q_SI = TWO * X * KF_SI                                        ! q in SI
      Q2   = Q_SI * Q_SI                                            ! q^2
!
      R_S = RS * BOHR                                               ! r_s in SI
!
      TAU_M = TAIQ_RT_3D(X,RS,T)                                    !
!
      GAMMA = E * E / (R_S * K_B * T)                               ! plasma coupling parameter
      OMEGA = V * HALF * H_BAR * KF_SI * KF_SI / M_E                ! omega in SI
      COEF  = THREE * GAMMA / (R_S * R_S * Q2)                      ! n * V(q) / (k_b * T)
!
      CALL STFACT_STATIC_3D(X,RS,T,'TWA','ICUT',SQ)                 !
!
      GQ1 = ONE + (ONE - ONE / SQ) * COEF                           ! ref. (1) eq. (11)
      GQ2 = TWO * IQ_KU1_3D(X)                                      ! ref. (1) eq. (12)
!
      MDGA_LFC = (GQ1 - IC * OMEGA * TAU_M * GQ2) /               & ! ref. (1) eq. (13)
                 (ONE - IC * OMEGA * TAU_M)                         !
!
      END FUNCTION MDGA_LFC
!
!=======================================================================
!
      FUNCTION NEV2_LFC(X,Z,RS,T)
!
!  This function computes the Nevalinna three-moment dynamic
!      local-field correction in 3D
!
!
!  References: (1) D. Yu. Dubovtsev, PhD Thesis,
!                     Universitat Politècnica de València (2019)
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 30 Apr 2021
!
!
      USE COMPLEX_NUMBERS,         ONLY : ONEC,IC
      USE CONSTANTS_P1,            ONLY : H_BAR
      USE FERMI_SI,                ONLY : KF_SI,VF_SI
      USE PLASMON_ENE_SI
      USE DFUNCL_STAN_DYNAMIC,     ONLY : RPA1_EPS_D_LG_3D
      USE LOSS_MOMENTS
      USE DF_VALUES,               ONLY : NEV_TYPE
      USE DAMPING_SI
      USE NEVALINNA_FUNCTIONS
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  U,Q_SI
      REAL (WP)             ::  C0,C2,C4
      REAL (WP)             ::  OM12,OM22
      REAL (WP)             ::  EPSR,EPSI
      REAL (WP)             ::  OM,OM2,OMP,OMP2
      REAL (WP)             ::  Q2
!
      COMPLEX (WP)          ::  NEV2_LFC
      COMPLEX (WP)          ::  EPS,NUM,DEN
!
      U    = X * Z                                                  ! omega / (q * v_F)
      OM   = U * Q_SI * VF_SI                                       ! omega in SI
      OM2  = OM * OM                                                !
      OMP  = ENE_P_SI / H_BAR                                       ! omega_p
      OMP2 = OMP * OMP                                              !
!
!  Computing the moments of the loss function
!
      CALL LOSS_MOMENTS_AN(X,C0,C2,C4)                              !
!
      OM12 = C2 / C0                                                !
      OM22 = C4 / C2                                                !
!
!  Computing the RPA dielectric function
!
      CALL RPA1_EPS_D_LG_3D(X,Z,EPSR,EPSI)                          !
      EPS = EPSR + IC * EPSI                                        !
!
!  Computing the Nevanlinna function Q2
!
      Q2 = NEVAN2(X,Z,RS,T,TAU,NEV_TYPE)                            !
!
      NUM = OM * (OM2 - OM22) + Q2 * (OM2 - OM12)                   !
      DEN = OMP2 * (OM + Q2)                                        !
!
      NEV2_LFC = ONEC + ONEC / (ONEC - EPS) + NUM / DEN             ! ref. (1) eq. (4.13)
!
      END FUNCTION NEV2_LFC
!
!=======================================================================
!
      FUNCTION NLGA_LFC(X,Z,RS,T)
!
!  This function computes the Nagy-Laszlo-Giber dynamic
!      local-field correction in 3D
!
!
!  References: (1) I. Nagy, J. Laszlo and J. Giber,
!                  Z. Phys. A - Atoms and Nuclei 321, 221-223 (1985)
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  6 Oct 2020
!
!
      USE REAL_NUMBERS,            ONLY : THREE,HALF
      USE COMPLEX_NUMBERS,         ONLY : IC
      USE PI_ETC,                  ONLY : PI
      USE LF_VALUES,               ONLY : GQ_TYPE
      USE LOCAL_FIELD_STATIC,      ONLY : LOCAL_FIELD_STATIC_3D
      USE LINDHARD_FUNCTION,       ONLY : LINDHARD_S
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  U,X2
      REAL (WP)             ::  GQR,GQI,LR,LI
!
      COMPLEX (WP)          ::  NLGA_LFC
!
      U  = X * Z                                                    ! omega / (q * v_F)
      X2 = X * X                                                    !
!
!  Computing the static local field correction G(q)
!
      CALL LOCAL_FIELD_STATIC_3D(X,RS,T,GQ_TYPE,GQR)                ! G(q)
!
!  Computing the static Lindhard function L(q)
!
      CALL LINDHARD_S(X,'3D',LR,LI)                                 ! L(X)
!
      GQI = HALF * PI * U * X2 * (THREE * HALF - GQR / X2) / LR     ! ref. (1)
!
      NLGA_LFC = GQR + IC * GQI                                     !
!
      END FUNCTION NLGA_LFC
!
!=======================================================================
!
      FUNCTION RIA1_LFC(X,Z,RS,T,EC_TYPE)
!
!  This function computes the Richardson-Ashcroft dynamic
!      local-field correction in 3D
!
!
!             -->   COMPUTES G_s(q,i omega)   <--
!
!
!  References: (1)  C. F. Richardson and N. W. Ashcroft, Phys. Rev. B 50,
!                      8170-8181 (1994)
!              (2)  S. H. Vosko, L. Wilk and M. Nusair, Can. J. Phys. 58
!                      1200-1211 (1980)
!              (3)  M. Lein, E. K. U. Gross and J. P. Perdew, Phys. Rev. B 61,
!                      13431-13437 (2000)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * EC_TYPE  : type of correlation energy functional
!
!
!  Output parameters:
!
!       * RIA1_LFC : G_s(q,i omega) + G_n(q, i omega)
!
!                         2
!                        d E_c
!  Note 1: The function   -------- in ref. (1) eq. (39) is the spin stiffness.
!                        d zeta^2
!
!          We calculate it using ref. (2) eq. (4.9)
!
!  Note 2: Reference (3) contains corrections of misprints in ref. (1)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Oct 2020
!
!
      USE REAL_NUMBERS,            ONLY : ONE,TWO,THREE,FOUR,EIGHT,NINE, &
                                          HALF,THIRD,FOURTH,FIFTH,SIXTH
      USE COMPLEX_NUMBERS,         ONLY :
      USE PI_ETC,                  ONLY : PI,PI2
      USE CONSTANTS_P1,            ONLY : H_BAR,M_E
      USE FERMI_SI,                ONLY : KF_SI
      USE UTILITIES_1,             ONLY : ALFA
      USE PC_VALUES,               ONLY : GR0_MODE
      USE GR_0,                    ONLY : GR_0_3D
      USE CORRELATION_ENERGIES
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 6)   ::  EC_TYPE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  RIA1_LFC
      REAL (WP)             ::  Y,Y2,Y4,Y6,Y8
      REAL (WP)             ::  Q_SI,Q2,EQ_SI,OM
      REAL (WP)             ::  ALPHA,AL
      REAL (WP)             ::  LS0,LSI,GR0,GS
      REAL (WP)             ::  LN0,LNI
      REAL (WP)             ::  EC,D_EC_1,D_EC_2
      REAL (WP)             ::  LPL,A,C,SSN
      REAL (WP)             ::  AS,BS,CS
      REAL (WP)             ::  NUM,DEN
      REAL (WP)             ::  GN,AN,BN,CN
      REAL (WP)             ::  G_S,G_N
!
      REAL (WP)             ::  LOG,SQRT
!
      ALPHA = ALFA('3D')                                            !
      AL    = 0.9E0_WP                                              !
!
!  Computation of the spin stiffness alpha_c = SSN
!
      A   = - THIRD / PI2                                           !
      C   = - A * ( LOG(16.0E0_WP * PI / ALPHA) -                 & ! ref. (2) eq. (4.10)
                    THREE + 0.531504E0_WP )                         !
      SSN = A * LOG(RS) + C                                         ! ref. (2) eq. (4.9)
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
      Y4 = Y2 * Y2                                                  !
      Y6 = Y4 * Y2                                                  !
      Y8 = Y6 * Y2                                                  !
!
      Q_SI  = TWO * X * KF_SI                                       ! q   in SI
      Q2    = Q_SI * Q_SI                                           ! q^2 in SI
      EQ_SI = HALF * H_BAR * H_BAR * Q2 / M_E                       ! h_bar omega_q in SI
!
      OM = Z * EQ_SI                                                ! omega
!
!  Computing the correlation energy and its derivatives
!
      EC = EC_3D(EC_TYPE,1,RS,T)                                    !
      CALL DERIVE_EC_3D(EC_TYPE,1,5,RS,T,D_EC_1,D_EC_2)             !
!
!  Computing the asymptotic lambda functions
!
      LSI = THREE * FIFTH - TWO * PI * ALPHA * FIFTH * (          & !
                   RS * RS * D_EC_1 + TWO * RS * EC               & ! ref. (3) eq. (RA:40)
                                                       )            !
      LNI = THREE * PI * ALPHA * RS * (EC + RS * D_EC_1)            ! ref. (1) eq. (43)
!
      LPL = ONE - THREE * HALF *                                  & !
                  (TWO * THIRD * PI)**(TWO * THIRD) * RS * SSN      ! ref. (3) eq. (RA:39)
      LN0 = - LPL * 0.11E0_WP * RS / (ONE + 0.33E0_WP * RS)         ! ref. (1) eq. (44)
      LS0 = ONE + THIRD * PI * ALPHA * RS * RS * D_EC_1 -         & !
                  SIXTH * PI * ALPHA * RS * RS * RS * D_EC_2 -    & ! ref. (1) eq. (38)
                  LN0                                               !
!
!  Computing the a_s, b_s and c_s coefficients
!
      GR0 = GR_0_3D(RS,GR0_MODE)                                    ! g(0)
      GS  = NINE / (16.0E0_WP * (ONE - GR0)) * LSI + FOURTH +     & !
            THREE * FOURTH * (ONE - ONE / AL)                       !
!
      AS  = LSI + (LS0 - LSI) / (ONE + GS * GS * OM * OM)           ! ref. (1) eq. (56)
      NUM = FOUR * THIRD - ONE / AL + THREE * FOURTH * LSI /      & !
            (ONE - GR0)
      DEN = ONE + GS * OM                                           ! ref. (1) eq. (55)
      CS  = THREE * FOURTH * LSI / (ONE - GR0) - NUM / DEN         !
      BS  = AS / ( THREE * AS * (ONE + OM)**4 -                   & !
                   EIGHT * THIRD * (ONE - GR0) * (ONE + OM)**3 -  & ! ref. (1) eq. (54)
                   TWO * CS * (ONE - GR0) * (ONE + OM)**4         & !
                 )                                                  !
!
!  Computing G_s
!
      NUM = AS * Y2 + BS * TWO * THIRD * (ONE - GR0) * Y8           !
      DEN = ONE + CS * Y2 + BS * Y8                                 !
!
      G_S = NUM / DEN                                               ! ref. (1) eq. (53)
!
!  Computing the a_n, b_n and c_n coefficients
!
      GN = 0.68E0_WP                                                !
      AN = LNI + (LN0 - LNI) / (ONE + GN * GN * OM * OM)            ! ref. (1) eq. (65)
      CN = THREE * GN / ( 1.18E0_WP * (ONE + GN * OM) ) -         & !
           ONE / (ONE + GN * GN * OM * OM) * (                    & !
           (LN0 + THIRD * LNI) / (LN0 + TWO * THIRD * LNI) +      & ! ref. (1) eq. (64)
           THREE * GN / ( 1.18E0_WP * (ONE + GN * OM) )           & !
                                             )                      !
      BN = - THREE * ( AN + LNI +                                 & !
                       TWO * THIRD * LNI * CN * (ONE + GN * OM) + & !
                       SQRT( AN + LNI +                           & !
                             TWO * THIRD * LNI * CN *             & !
                             (ONE + GN * OM)**2 +                 & !
                             FOUR * THIRD * AN * LNI              & !
                           )                                      & !
                     ) / ( TWO * LNI * (ONE + GN * OM)**2 )         !
!
      NUM = AN * Y2 - THIRD * BN * LNI * Y6                         !
      DEN = ONE + CN * Y2 + BN * Y4                                 !
!
      G_N = NUM / DEN                                               ! ref. (1) eq. (62)
!
      RIA1_LFC = G_S + G_N                                          ! ref. (1) eq. (31)
!
      END FUNCTION RIA1_LFC
!
!=======================================================================
!
      FUNCTION SHMU_LFC(X,Z,RS)
!
!  This function computes the Shah-Mukhopadhyay dynamic
!      local-field correction in 3D
!
!
!  References: (1)  C. Shah and G. Mukhopadhyay, Pramana 26,
!                      441-458 (1986)
!
!
!  Warning : only the imaginary part is computed
!
!
!
!  Intermediate parameters:
!
!       * Y        : dimensionless factor   --> Y = X+X  =  q / k_F
!       * U        : dimensionless factor   --> U = X*Z  = omega / (q * v_F)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!                             r''                        RPA
!  Note: In order to compute Q   (q,omega) = Im [ epsilon   (q,omega) ],
!          we use the fact that
!
!                  omega          1     omega
!               ----------   =  ----  ----------
!               (q * v_F)        4X    omega_F
!
!
!                 omega_q
!               -----------  =   X
!                (q * v_F)
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  6 Sep 2020
!
!
      USE REAL_NUMBERS,        ONLY : ZERO,ONE,TWO,FOUR,SIX,NINE, &
                                      HALF,SMALL
      USE PI_ETC,              ONLY : PI
      USE FERMI_SI,            ONLY : KF_SI
      USE FERMI_AU,            ONLY : KF_AU,VF_AU
      USE SCREENING_VEC,       ONLY : THOMAS_FERMI_VECTOR
      USE UTILITIES_1,         ONLY : ALFA
      USE INTEGRATION,         ONLY : INTEGR_L
!
      IMPLICIT NONE
!
      INTEGER               ::  IQ,IT,IO        ! indices for integration loops
      INTEGER               ::  ID
      INTEGER, PARAMETER    ::  N_MAX = 200     ! max. number of points for integrations
!
      REAL (WP), INTENT(IN) ::  X,Z,RS
      REAL (WP)             ::  SHMU_LFC
      REAL (WP)             ::  Y,Y2,U,OM
      REAL (WP)             ::  K_TF_SI
      REAL (WP)             ::  Q_SI,Q_AU,Q1,Q2,R2
      REAL (WP)             ::  QQO(N_MAX),QQT(N_MAX),QQQ(N_MAX)
      REAL (WP)             ::  QR1,QR2
      REAL (WP)             ::  T2,U1,U2,XP,XS,TP,TS
      REAL (WP)             ::  QP,QS,T,O1,OO
      REAL (WP)             ::  Q_STEP,T_STEP,O_STEP
      REAL (WP)             ::  AO,AT,AQ
      REAL (WP)             ::  ALPHA
!
      REAL (WP),PARAMETER   ::  Q_MAX = SIX
!
      REAL (WP)             ::  FLOAT,SQRT
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      Q_SI = Y * KF_SI                                              ! q   in SI
      Q_AU = Y * KF_AU                                              ! q   in a.u.
      Q2   = Q_AU * Q_AU                                            ! q^2 in a.u.
      R2   =  KF_AU *  KF_AU / (KF_SI * KF_SI)                      ! for unit change
!
      U  = X * Z                                                    ! omega / (q * v_F)
      OM = U * Q_AU * VF_AU                                         ! omega
!
      ALPHA = ALFA('3D')                                            !
!
!  Computing the Thomas_Fermi screening vector
!
      CALL THOMAS_FERMI_VECTOR('3D',K_TF_SI)
!
!  Loop on q' for q'-integration
!
      Q_STEP = (Q_MAX - SMALL) / FLOAT(N_MAX-1)                     ! q-step
      DO IQ = 1, N_MAX                                              ! start of q' loop
!
        QP = SMALL + FLOAT(IQ-1) * Q_STEP                           ! q'
!
!  Loop on t for t-integration
!
        T_STEP = TWO / FLOAT(N_MAX-1)                               !
        DO IT = 1, N_MAX                                            ! start of t loop
!
          T  = - ONE +  FLOAT(IT-1) * T_STEP                        ! t
          QS = SQRT(Q2 + QP * QP - TWO * Q_AU * QP * T)             ! q"
!
!  Loop on omega1 for omega1-integration
!
          O_STEP = OM / FLOAT(N_MAX-1)                              !
          DO IO  = 1, N_MAX                                         ! start of omega-1 loop
!
            O1 = FLOAT(IO-1) * O_STEP                               ! omega_1
            OO = OM - O1                                            ! omega - omega_1
!
!              r''                r''
!  Computing  Q (q',omega_1) and Q (q",omega - omega_1)
!
            U1 = O1 / (Q_AU * VF_AU)                                !
            U2 = OO / (Q_AU * VF_AU)                                !
            XP = QP * HALF / KF_AU                                  ! X for q'
            XS = QS * HALF / KF_AU                                  ! X for q"
            TP = K_TF_SI * K_TF_SI * T2 / (QP * QP)                 ! (K_TF_SI / QP_SI)^2
            TS = K_TF_SI * K_TF_SI * T2 / (QS * QS)                 ! (K_TF_SI / QS_SI)^2
!
!           r''
!  1) Q1 = Q (q',omega_1)
!
            IF(U1 <= ONE - XP) THEN                                 !
              Q1 = HALF * PI * U1 * TP                              !
            ELSE IF(ONE - XP > U1 .AND. U1 <= ONE + XP)  THEN       !
              Q1 = PI * ( ONE - (ONE - XP)**2 )* TP / (FOUR * XP)   !
            ELSE                                                    !
              Q1 = ZERO                                             !
            END IF                                                  !
!
!           r''
!  2) Q2 = Q (q",omega - omega_1)
!
            IF(U2 <= ONE - XS) THEN                                 !
              Q2 = HALF * PI * U2 * TS                              !
            ELSE IF(ONE - XS > U2 .AND. U2 <= ONE + XS)  THEN       !
              Q2 = PI * ( ONE - (ONE - XS)**2 )* TS / (FOUR * XS)   !
            ELSE                                                    !
              Q2 = ZERO                                             !
            END IF                                                  !
!
!  Storing integrand function
!
            QQO(IO) = Q1 * Q2                                       !
!
          END DO                                                    ! end of omega-1 loop
!
!  Performing the omega-1 integration
!
          ID = 2                                                    !
          CALL INTEGR_L(QQO,Q_STEP,N_MAX,N_MAX,AO,ID)               !
!
!  Storing integrand function
!
          QQT(IT) = Q_AU * QS * T * AO                              !
!
        END DO                                                      ! end of t loop
!
!  Performing the t integration
!
        ID = 2                                                      !
        CALL INTEGR_L(QQT,T_STEP,N_MAX,N_MAX,AT,ID)                 !
!
!  Storing integrand function
!
        QQQ(IQ) = QP * QP * AT                                      !
!
      END DO                                                        ! end of q' loop
!
!  Performing the q' integration
!
      ID = 2                                                        !
      CALL INTEGR_L(QQQ,Q_STEP,N_MAX,N_MAX,AQ,ID)                   !
!
      SHMU_LFC = NINE * AQ / (32.0E0_WP * ALPHA * RS)               ! ref. (1) eq. (41)
!
      END FUNCTION SHMU_LFC
!
!=======================================================================
!
      FUNCTION STGU_LFC(X,Z,RS,T)
!
!  This function computes the Sturm-Gusarov dynamic
!      local-field correction in 3D
!
!
!  References: (1)  K. Sturm and A. Gusarov, Phys. Rev. B 62,
!                      16474-16491 (2000)
!
!
!  Warning : only the imaginary part is computed
!
!
!  Note: In ref. (1), q is in unit of k_F and h_bar omega in units of E_F
!
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!  Intermediate parameters:
!
!       * Y        : dimensionless factor   --> Y = X + X     =  q / k_F
!       * U        : dimensionless factor   --> U = X * Z     = omega / (q * v_F)
!       * V        : dimensionless factor   --> V = 2 * U * Y = h_bar omga / E_F
!
!
!  Warning : only the imaginary part is computed
!
!
!  Note: From ref. (1) eq. (3.22), we have
!
!                                 Im [ epsilon (q,omega) ]
!                                             ABC
!          Im [ G(q,omega) ] = -------------------------------
!                                                           2
!                               [ epsilon   (q,omega)  - 1 ]
!                                        RPA
!
!        We use then the HIGH FREQUENCY approximation eq. (3.4)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 30 Apr 2021
!
!
      USE REAL_NUMBERS,        ONLY : ONE,TWO,INF
      USE SQUARE_ROOTS,        ONLY : SQR2
      USE PI_ETC,              ONLY : PI
      USE FERMI_SI,            ONLY : EF_SI
      USE DF_VALUES,           ONLY : D_FUNC
      USE PLASMON_ENE_SI
      USE DFUNCL_STAN_DYNAMIC
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  STGU_LFC
      REAL (WP)             ::  Y,Y2,U,V
      REAL (WP)             ::  OM,OP
      REAL (WP)             ::  EPSR,EPSI
      REAL (WP)             ::  NUM,DEN,EABC
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    ! q^2 in reduced input
      U  = X * Z                                                    ! omega / (q * v_F)
      V  = TWO * U * Y                                              ! h_bar omega / E_F
!
      OP = ENE_P_SI / EF_SI                                         ! omega_p in reduced unit
      OM = V                                                        ! omega   in reduced unit
!
!  Computing the dielectric function epsilon(q,E)
!
      CALL DFUNCL_DYNAMIC(X,Z,RS,T,D_FUNC,1,EPSR,EPSI)              !
!
      NUM  = 23.0E0_WP * PI * OP**6 * Y2                            !
      DEN  = 40.0E0_WP * SQR2 * OM**5.5E0_WP                        !
      EABC = NUM / DEN                                              ! ref. (1) eq. (3.4)
!
      DEN      = ( (EPSR - ONE) * (EPSR - ONE) + EPSI * EPSI )      ! | epsilon - 1|^2
      STGU_LFC = EABC / DEN                                         ! ref. 1 eq. (3.22)
!
      END FUNCTION STGU_LFC
!
!=======================================================================
!
      FUNCTION TOWO_LFC(X,Z,RS)
!
!  This function computes the Toigo-Woodruff dynamic
!      local-field correction in 3D
!
!
!  References: (1)  V. D. Gorobchenko, V. N. Kohn and E. G. Maksimov,
!                    in "Modern Problems in Condensed Matter" Vol. 24,
!                    L. V. Keldysh, D. A. Kirzhnitz and A. A. Maradudin ed.
!                    pp. 87-219 (North-Holland, 1989)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Notations: We have     h_bar omega / E_F = 2 * U * Y = Z * Y2
!
!   Note: q in units of k_F and omega in units of E_F / h_bar
!
!   Warning : >>> This subroutine computes Im[ P ] <<<
!             >>>   where P is related to G by     <<<
!
!
!                             P(q,omega)
!         G(q, omega) = --------------------------      eq. (4.20)
!                        V_C(q) * Chi_0(q,omega)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
      USE REAL_NUMBERS,        ONLY : ZERO,ONE,TWO,THREE,EIGHT,HALF
      USE COMPLEX_NUMBERS,     ONLY : IC
      USE UTILITIES_1,         ONLY : ALFA
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS
      REAL (WP)             ::  Y,Y2,U
      REAL (WP)             ::  ZZ1,ZZ2,YY1,YY2
      REAL (WP)             ::  ALPHA,COEF
      REAL (WP)             ::  OM
      REAL (WP)             ::  PPI,PPR,EPSR,EPSI
      REAL (WP)             ::  TOWO_LFC
!
      REAL (WP)             ::  SQRT
!
      ALPHA = ALFA('3D')                                            !
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      U = X * Z                                                     ! omega / (q * v_F)
!
      OM = TWO * U * Y                                              ! omega in reduced unit
!
      ZZ1 = X + HALF * OM / Y                                       ! ref. (1) eq. (3.4)
      ZZ2 = X - HALF * OM / Y                                       ! ref. (1) eq. (3.4)
!
      YY1 = SQRT(ONE + OM)                                          ! ref. (1) eq. (4.22)
      YY2 = SQRT(ONE - OM)                                          ! ref. (1) eq. (4.22)
!
      COEF = THREE * ALPHA * RS / (EIGHT * Y2)                      !
!
      IF(U < (ONE - Y)) THEN                                        !
        PPI = - COEF * ( ZZ1 * (F_TW(YY1) - F_TW(ONE)) +          & ! ref. (1) eq. (4.21)
                         ZZ2 * (F_TW(ONE) - F_TW(YY2))            & !
                       )                                            !
      ELSE                                                          !
        IF( ((ONE - Y) <= U) .AND.  (U <= (ONE + Y)) ) THEN         !
          PPI = - COEF * ( ZZ1 * (F_TW(YY1) - F_TW(ZZ1)) +        & ! ref. (1) eq. (4.21)
                           ZZ2 * (F_TW(ONE) - F_TW(ZZ2))          & !
                         )                                          !
        ELSE                                                        !
          PPI = ZERO                                                ! ref. (1) eq. (4.21)
        END IF                                                      !
      END IF                                                        !
!
      TOWO_LFC = PPI                                                !
!
      END FUNCTION TOWO_LFC
!
!=======================================================================
!
      FUNCTION F_TW(X)
!
!  This function computes the Toigo-Woodruff function used for
!    the calculation of the dynamic local-field correction
!
!  References: (1)  V. D. Gorobchenko, V. N. Kohn and E. G. Maksimov,
!                    in "Modern Problems in Condensed Matter" Vol. 24,
!                    L. V. Keldysh, D. A. Kirzhnitz and A. A. Maradudin ed.
!                    pp. 87-219 (North-Holland, 1989)
!
!
!  Input parameters:
!
!       * X        : dimensionless parameter
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 18 Sep 2020
!
!
      USE REAL_NUMBERS,        ONLY : ONE,THREE,HALF,THIRD
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  F_TW
      REAL (WP)             ::  OPX,OMX
      REAL (WP)             ::  TPX,TMX
!
      REAL (WP)             ::  LOG,ABS
!
      OPX =   ONE + X                                               !
      OMX =   ONE - X                                               !
      TPX = THREE + X                                               !
      TMX = THREE - X                                               !
!
      F_TW = THIRD * ( X*X +                                      & !
                       HALF * TMX * OPX**THREE *                  & !
                       LOG(ABS(OPX)) / X           -              & ! ref. (1) eq. (4.22)
                       HALF * TPX * OMX**THREE *                  & !
                       LOG(ABS(OMX)) / X                          & !
                     )                                              !
!
      END FUNCTION F_TW
!
!=======================================================================
!
      FUNCTION UTI2_LFC(X,Z,RS,T,GQ_TYPE,SQ_TYPE)
!
!  This function computes the Utsumi-Ichimaru dynamic
!      local-field correction in 3D
!
!  References: (1) K. Utsumi and S. Ichimaru, Phys. Rev. B 22,
!                     1522-1533 (1980)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * GQ_TYPE  : local-field correction type (3D)
!       * SQ_TYPE  : structure factor approximation (3D)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
!
      USE REAL_NUMBERS,           ONLY : ONE,TWO,THREE,FOUR,EIGHT, &
                                         HALF,FOURTH
      USE COMPLEX_NUMBERS,        ONLY : ONEC,IC
      USE CONSTANTS_P1,           ONLY : H_BAR,M_E
      USE FERMI_SI,               ONLY : KF_SI,VF_SI
      USE PI_ETC,                 ONLY : PI,PI2
      USE LOCAL_FIELD_STATIC,     ONLY : LOCAL_FIELD_STATIC_3D
      USE IQ_FUNCTIONS_1,         ONLY : IQ_KU1_3D
      USE RELAXATION_TIME_STATIC, ONLY : UTIC_RT_3D
      USE PLASMON_ENE_SI
      USE LOCAL_FIELD_STATIC
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  GQ_TYPE
      CHARACTER (LEN = 3)   ::  SQ_TYPE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  Y,Y2,V
      REAL (WP)             ::  OMEGA,FACT,ZETA1,ZETA2
      REAL (WP)             ::  Q_SI,TAU,GQ
!
      COMPLEX (WP)          ::  UTI2_LFC
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
      V  = Z * Y2                                                   ! omega / omega_{k_F}
!
      Q_SI = Y * KF_SI                                              !
!
      CALL LOCAL_FIELD_STATIC_3D(X,RS,T,GQ_TYPE,GQ)                 !
      TAU = UTIC_RT_3D(X,RS,T,SQ_TYPE,GQ_TYPE)                      !
!
      OMEGA = V * HALF * H_BAR * KF_SI * KF_SI / M_E                ! omega in SI
!
      FACT  = THREE * ENE_P_SI * ENE_P_SI * TAU / (H_BAR * H_BAR)   ! 3 * omega_p^2 * tau
!
      ZETA1 = (PI2 / EIGHT - ONE) * TWO / FACT                      ! ref. (1) eq. (5.9)
      ZETA2 = (FOURTH * PI2 + FOUR) * PI * Q_SI / (FACT * VF_SI)    ! ref. (1) eq. (5.10)
!
      UTI2_LFC = GQ + IC * ZETA1 * OMEGA + ZETA2 * (OMEGA / Q_SI)**2! ref. (1) eq. (5.8)
!
      END FUNCTION UTI2_LFC
!
!=======================================================================
!
      FUNCTION VISC_LFC(X,Z,RS,T,ETA,EC_TYPE)
!
!  This function computes the viscosity dynamic
!      local-field correction in 3D
!
!  References: (1) S. Tanaka and S. Ichimaru, Phys. Rev. A 35,
!                  4743-4754 (1987)
!              (2) N. Iwamoto, Phys. Rev. A 30, 3289-3304 (1984)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!       * Z        : omega / omega_q        --> dimensionless
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * ETA      : viscosity   in SI
!       * EC_TYPE  : type of correlation energy functional
!
!
!  Notes: (1) In order to solve dp / dn in eq. (17) of ref. (1),
!             we make use of eq. (2.15a) of ref. (2) and express
!             1 / K_T acoording to (2.15c) of ref. (2)
!
!         (2) From eq. (1), we have
!
!             eta_l(q,omega) = eta_l(q) / [ 1 - i omega tau_m(q) ]
!
!              etal_(q)
!            -----------    =   tau_m(q) [ G(q) - I(q) ] ( q_D / q )^2   eq. (21)
!              n k_B T
!
!             tau_m(q)      =   tau_m(q) * Y(q)                          eq. (26)
!
!                                           |
!                                           |------------------------->  eq. (27)-(28)
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 18 Sep 2020
!
!
      USE REAL_NUMBERS,           ONLY : ONE,TWO,FOUR,SIX,HALF,THIRD
      USE COMPLEX_NUMBERS,        ONLY : IC
      USE CONSTANTS_P1,           ONLY : H_BAR,M_E,K_B
      USE FERMI_SI,               ONLY : KF_SI
      USE PI_ETC,                 ONLY : PI_INV
      USE UTILITIES_1,            ONLY : ALFA,RS_TO_N0
      USE SCREENING_VEC,          ONLY : DEBYE_VECTOR
      USE LOCAL_FIELD_STATIC,     ONLY : LOCAL_FIELD_STATIC_3D
      USE IQ_FUNCTIONS_1,         ONLY : IQ_KU1_3D
      USE RELAXATION_TIME_STATIC, ONLY : TAIQ_RT_3D
      USE CORRELATION_ENERGIES
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 6)   ::  EC_TYPE
!
      REAL (WP), INTENT(IN) ::  X,Z,RS,T
      REAL (WP)             ::  ETA
      REAL (WP)             ::  Q_SI,KD_SI,OMEGA
      REAL (WP)             ::  ALPHA,N0,KBT
      REAL (WP)             ::  DPDN,D_EC_1,D_EC_2
      REAL (WP)             ::  TAU_M,GQ1,GQ2
!
      REAL (WP)             ::  EXP
!
      COMPLEX (WP)          ::  VISC_LFC
      COMPLEX (WP)          ::  ENKT
!
      ALPHA = ALFA('3D')                                            !
      N0    = RS_TO_N0('3D',RS)                                     !
!
      Q_SI  = TWO * X * KF_SI                                       ! q in SI
      OMEGA = Z * HALF * H_BAR * Q_SI * Q_SI / M_E                  ! omega in SI
!
      KBT = K_B * T                                                 !
!
      ETA   = FOUR * THIRD * ETA                                    !
!
!  Computing the Debye momentum
!
      CALL DEBYE_VECTOR('3D',T,RS,KD_SI)                            !
!
!  Computing the derivatives of the correlation energy
!
      CALL DERIVE_EC_3D(EC_TYPE,1,5,RS,T,D_EC_1,D_EC_2)             !
!
!  Computing dp / dn
!
      DPDN = THIRD * THIRD * RS * (                               & !
                        SIX / (ALPHA * ALPHA * RS * RS * RS) -    & !
                        SIX * PI_INV / (ALPHA * RS * RS)     -    & ! ref. (2) eq. (2.15c)
                        TWO * D_EC_1 + RS * D_EC_2                & !
                                  )
!
!  Computing the G(q) and I(q)
!
      CALL LOCAL_FIELD_STATIC_3D(X,RS,T,'ICUT',GQ1)                 ! G(q)
      GQ2 = IQ_KU1_3D(X)                                            ! I(q)
!
!  Computing the static relaxation time tau(q)
!
      TAU_M = TAIQ_RT_3D(X,RS,T)                                    !
!
      ENKT = (KD_SI / Q_SI)**2 * (GQ1 - GQ2) * TAU_M /            & !
             (ONE - IC * OMEGA * TAU_M)                             !
!
      VISC_LFC = (Q_SI / KD_SI)**2 * (                            & !
                                   ONE - DPDN / KBT +             & ! ref. (1) eq. (17)
                                   IC * OMEGA * ETA / (N0 * KBT)  & !
                                     )                              !
!
      END FUNCTION VISC_LFC
!
END MODULE LOCAL_FIELD_DYNAMIC

