!
!=======================================================================
!
MODULE LOCAL_FIELD_STATIC 
!
!  This modules provides subroutines/functions to compute
!            static local-field factors G(q) 
!
!  These G(q) DOES NOT DEPEND of the static structure factor S(q)
!
!
      USE ACCURACY_REAL
!
CONTAINS
!
!=======================================================================
!
      SUBROUTINE LFIELD_STATIC(X,RS,T,GQ_TYPE,GQ)
!
!  This subroutine computes static local-field factors G(q) 
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * GQ_TYPE  : local-field correction type (3D)
!
!
!  Output parameters:
!
!       * GQ       : static local field correction
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 19 Jun 2020
!
!
      USE MATERIAL_PROP,    ONLY : DMN
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  GQ_TYPE
!
      REAL (WP)             ::  X,RS,T
      REAL (WP)             ::  GQ
!
      IF(DMN == '3D') THEN                                          !
        CALL LOCAL_FIELD_STATIC_3D(X,RS,T,GQ_TYPE,GQ)               !
      ELSE IF(DMN == '2D') THEN                                     !
        CALL LOCAL_FIELD_STATIC_2D(X,RS,GQ_TYPE,GQ)                 !
      ELSE IF(DMN == '1D') THEN                                     !
        CALL LOCAL_FIELD_STATIC_1D(X,RS,GQ_TYPE,GQ)                 !
      END IF                                                        !
!
      END SUBROUTINE LFIELD_STATIC
!
!------ 1) 3D case --------------------------------------------
!
!=======================================================================
!
      SUBROUTINE LOCAL_FIELD_STATIC_3D(X,RS,T,GQ_TYPE,GQ)
!
!  This subroutine computes static local-field factors G(q) 
!    for 3D systems.
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * GQ_TYPE  : local-field correction type (3D)
!                       GQ_TYPE = 'NONE' no local field correction
!                       GQ_TYPE = 'ALDA' adiabatic local density
!                       GQ_TYPE = 'ALFL' Alvarellos-Flores
!                       GQ_TYPE = 'BEBR' Bedell-Brown
!                       GQ_TYPE = 'CDOP' TDDFT Corradini et al correction
!                       GQ_TYPE = 'GEVO' Geldart-Vosko correction
!                       GQ_TYPE = 'GEV2' Geldart-Vosko 2
!                       GQ_TYPE = 'GOCA' Gold-Calmels
!                       GQ_TYPE = 'HORA' Holas-Rahman
!                       GQ_TYPE = 'HUBB' Hubbard correction (only exchange)
!                       GQ_TYPE = 'ICUT' Ichimaru-Utsumi correction
!                       GQ_TYPE = 'IWA1' Iwamoto G_{-1}
!                       GQ_TYPE = 'IWA2' Iwamoto G_{3} approx.
!  temperature-dep. --> GQ_TYPE = 'IWA3' Iwamoto G_{-1}  
!                       GQ_TYPE = 'IWA4' Iwamoto G_{3} exact
!                       GQ_TYPE = 'JGDG' Jung-Garcia-Gonzalez-Dobson-Godby
!                       GQ_TYPE = 'KLLA' Kleinman-Langreth correction
!                       GQ_TYPE = 'KUGL' Kugler
!                       GQ_TYPE = 'LDAC' LDA correction
!                       GQ_TYPE = 'MCSC' Moroni-Ceperley-Senatore correction
!                       GQ_TYPE = 'NAGY' Nagy correction
!                       GQ_TYPE = 'NEV1' Nevalinna two-moment approximation
!                       GQ_TYPE = 'PGGA' Petersilka-Gossmann-Gross
!                       GQ_TYPE = 'PVHF' Pavas-Vashishta Hartree-Fock correction
!                       GQ_TYPE = 'RICE' Rice correction
!                       GQ_TYPE = 'SHAW' Shaw correction
!                       GQ_TYPE = 'SLAT' Slater correction
!                       GQ_TYPE = 'STLS' Singwi et al correction
!                       GQ_TYPE = 'UTI1' Utsumi-Ichimaru correction (only exchange)
!                       GQ_TYPE = 'TOUL' Toulouse parametrization of CDOP
!                       GQ_TYPE = 'TRMA' Tripathy-Mandal
!  temperature-dep. --> GQ_TYPE = 'TKAC' Tkachenko correction
!                       GQ_TYPE = 'VASI' Vashishta-Singwi correction
!
!  Intermediate parameters:
!
!       * EC_TYPE  : type of correlation energy functional
!                       EC_TYPE = 'GEBR_W'   --> Gell-Mann and Brueckner
!                       EC_TYPE = 'CAMA_W'   --> Carr and Maradudin
!                       EC_TYPE = 'HELU_W'   --> Hedin and Lundqvist
!                       EC_TYPE = 'VBLU_W'   --> von Barth and Lundqvist
!                       EC_TYPE = 'PEZU_W'   --> Perdew and Zunger
!                       EC_TYPE = 'WIGN_S'   --> Wigner
!                       EC_TYPE = 'NOPI_S'   --> Nozières and Pines
!                       EC_TYPE = 'LIRO_S'   --> Lindgren and Rosen
!                       EC_TYPE = 'PEZU_S'   --> Perdew and Zunger
!                       EC_TYPE = 'VWNU_G'   --> Vosko, Wilk and Nusair
!                       EC_TYPE = 'PEWA_G'   --> Perdew and Wang
!       * SQ_TYPE   : structure factor approximation (3D)
!                       SQ_TYPE  = 'HFA' Hartree-Fock approximation (only exchange)
!                       SQ_TYPE  = 'RPA' RPA approximation
!                       SQ_TYPE  = 'TWA' Toigo-Woodruff approximation
!                       SQ_TYPE  = 'GOR' Gorobchenko approximation
!                       SQ_TYPE  = 'SPA' Singh-Pathak
!                       SQ_TYPE  = 'PKA' Pietiläinen-Kallio
!                       SQ_TYPE  = 'MSA' mean spherical approximation
!                       SQ_TYPE  = 'GEA' generalized approximation
!
!
!  Output parameters:
!
!       * GQ       : static local field correction
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 22 Jul 2020
!
!
      USE REAL_NUMBERS,        ONLY : ZERO
      USE SF_VALUES,           ONLY : SQ_TYPE
      USE ENERGIES,            ONLY : EC_TYPE
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  GQ_TYPE
!
      REAL (WP)             ::  X,RS,T
      REAL (WP)             ::  GQ
!
      IF(GQ_TYPE == 'NONE') THEN                                    !
        GQ=ZERO                                                     !
      ELSE IF(GQ_TYPE == 'SLAT') THEN                               !
        GQ=SLAT_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'HUBB') THEN                               ! 
        GQ=HUBB_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'UTI1') THEN                               ! 
        GQ=UTI1_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'GEVO') THEN                               ! 
        GQ=GEVO_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'RICE') THEN                               !
        GQ=RICE_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'KLLA') THEN                               ! 
        GQ=KLLA_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'LDAC') THEN                               ! 
        GQ=LDAC_LFC(X,RS,T,EC_TYPE )                                !
      ELSE IF(GQ_TYPE == 'MCSC') THEN                               ! 
        GQ=MCSC_LFC(X,RS,T,EC_TYPE)                                 !
      ELSE IF(GQ_TYPE == 'CDOP') THEN                               !
        GQ=CDOP_LFC(X,RS,T,EC_TYPE)                                 !
      ELSE IF(GQ_TYPE == 'TOUL') THEN                               !
        GQ=TOUL_LFC(X,RS,T,EC_TYPE)                                 !
      ELSE IF(GQ_TYPE == 'STLS') THEN                               !
        GQ=STLS_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'PVHF') THEN                               !
        GQ=PVHF_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'VASI') THEN                               !
        GQ=VASI_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'GOCA') THEN                               !
        GQ=GOCA_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'ICUT') THEN                               ! 
        GQ=ICUT_LFC(X,RS,T)                                         !
      ELSE IF(GQ_TYPE == 'IWA1') THEN                               !
        GQ=IWA1_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'IWA2') THEN                               !
        GQ=IWA2_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'IWA4') THEN                               !
        GQ=IWA4_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'SHAW') THEN                               !
        GQ=SHAW_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'NAGY') THEN                               !
        GQ=NAGY_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'NEV1') THEN                               !
        GQ=NEV1_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'ALFL') THEN                               ! 
        GQ=ALFL_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'HORA') THEN                               ! 
        GQ=HORA_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'ALDA') THEN                               !
        GQ=ALDA_LFC(X,RS,T,EC_TYPE)                                 !
      ELSE IF(GQ_TYPE == 'JGDG') THEN                               !
        GQ=JGDG_LFC(X,RS,T,EC_TYPE)                                 !
      ELSE IF(GQ_TYPE == 'PGGA') THEN                               !
        GQ=PGGA_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'TRMA') THEN                               !
        GQ=TRMA_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'BEBR') THEN                               !
        GQ=BEBR_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'GEV2') THEN                               !
        GQ=GEV2_LFC(X,RS,T,EC_TYPE)                                 !
      ELSE IF(GQ_TYPE == 'TKAC') THEN                               !
        GQ=TKAC_LFC(X,RS,T)                                         !
      ELSE IF(GQ_TYPE == 'IWA3') THEN                               !
        GQ=IWA3_LFC(X,RS,T)                                         !
      END IF                                                        !
!
      END SUBROUTINE LOCAL_FIELD_STATIC_3D  
!
!=======================================================================
!
      FUNCTION SLAT_LFC(X)
!
!  This function computes the Slater local-field correction 
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
!
      IMPLICIT NONE
!
      REAL (WP),INTENT(IN)  ::  X
      REAL (WP)             ::  SLAT_LFC
      REAL (WP)             ::  Y
!
      Y = X + X                                                     ! Y = q / k_F
!
      SLAT_LFC = 0.3750E0_WP * Y * Y                                ! 
!
      END FUNCTION SLAT_LFC  
!
!=======================================================================
!
      FUNCTION HUBB_LFC(X)
!
!  This function computes the Hubbard local-field correction 
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS, ONLY : ONE,HALF
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  HUBB_LFC
      REAL (WP)             ::  Y,Y2
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      HUBB_LFC = HALF * Y2 / (ONE + Y2)                             ! 
!
      END FUNCTION HUBB_LFC    
!
!=======================================================================
!
      FUNCTION UTI1_LFC(X)
!
!  This function computes the exchange Utsumi-Ichimaru local-field correction 
!  Input parameters:
!
!
!  Reference:  (1) K. Utsumi and S. Ichimaru, Phys. Rev. B 22, 
!                     5203-5212 (1980)
!  
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 23 Sep 2020
!
!
      USE REAL_NUMBERS, ONLY : TWO,THREE,FOUR,FIVE,FOURTH
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  UTI1_LFC
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  NUM,DEN,LGA
!
      REAL (WP)             ::  LOG
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      NUM = THREE * (FOUR - Y2) * (28.0E0_WP + FIVE * Y2)           !
      DEN = 16.0E0_WP * Y                                           !
      LGA = LOG(ABS((TWO + Y) / (TWO - Y)))                         !
!
      UTI1_LFC = Y2 / 128.0E0_WP * (                              & !
                                     11.0E0_WP +                  & !
                                     15.0E0_WP * Y2 * FOURTH +    & !
                                     NUM * LGA / DEN              & !
                                   )                                !
                                     
!
      END FUNCTION UTI1_LFC
!
!=======================================================================
!
      FUNCTION GEVO_LFC(X)
!
!  This function computes the Geldart-Vosko local-field correction 
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS, ONLY : TWO,HALF
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  GEVO_LFC
      REAL (WP)             ::  Y,Y2
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      GEVO_LFC = HALF * Y2 / (TWO + Y2)                             ! 
!
      END FUNCTION GEVO_LFC  
!
!=======================================================================
!
      FUNCTION RICE_LFC(X)
!
!  This function computes the Rice local-field correction 
!  Input parameters:
!
!  Reference:  (1) L. Kleinman, Phys. Rev. 160, 585-590 (1967)
!  
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,FOUR,HALF
      USE FERMI_AU,         ONLY : KF_AU
      USE PI_ETC,           ONLY : PI_INV
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  RICE_LFC
      REAL (WP)             ::  Y,Y2,Z2
!
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      Z2 = FOUR * PI_INV  / KF_AU                                   ! (k_TF/k_F)^2
!
      RICE_LFC = HALF * Y2 / (ONE + Y2 + Z2)                        ! ref. 1 eq. (3)
!
      END FUNCTION RICE_LFC  
!
!=======================================================================
!
      FUNCTION KLLA_LFC(X)
!
!  This function computes the Kleinman-Langreth local-field correction 
!
!  Reference: L. Kleinman, Phys. Rev. 160, 585-590 (1967)
!  
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,FOUR,FOURTH
      USE FERMI_AU,         ONLY : KF_AU
      USE PI_ETC,           ONLY : PI_INV
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  KLLA_LFC
      REAL (WP)             ::  Y,Y2,Z2
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    !
!
      Z2 = FOUR * PI_INV / KF_AU                                    ! (k_TF/k_F)^2
!
      KLLA_LFC = FOURTH * (Y2 / (ONE + Y2 + Z2) + Y2 / (ONE + Z2))  ! ref. 1 eq. (25)
!
      END FUNCTION KLLA_LFC  
!
!=======================================================================
!
      FUNCTION LDAC_LFC(X,RS,T,EC_TYPE)
!
!  This function computes the LDA local-field correction 
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature (SI)     
!       * EC_TYPE  : type of correlation energy functional
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 22 Jul 2020
!
!
      USE REAL_NUMBERS,        ONLY : TWO,FOURTH
      USE PI_ETC,              ONLY : PI
      USE UTILITIES_1,         ONLY : ALFA
      USE CORRELATION_ENERGIES 
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 6)   ::  EC_TYPE
!
      REAL (WP)             ::  X,RS,T,LDAC_LFC
      REAL (WP)             ::  Y,Y2,D_EC_1,D_EC_2
      REAL (WP)             ::  ALPHA,GAMMA_0
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    ! Y^2
!
      ALPHA = ALFA('3D')                                            ! 
!
!  Correlation energy and its derivatives
!
      CALL DERIVE_EC_3D(EC_TYPE,1,5,RS,T,D_EC_1,D_EC_2)             ! 
!
!  Calculation of coefficient gamma_0
!
      GAMMA_0 = FOURTH - PI * ALPHA / 24.0E0_WP*(                 & !
                RS * RS * RS * D_EC_2 - TWO  * RS * RS * D_EC_1)    !
!
      LDAC_LFC = GAMMA_0 * Y2                                       ! 
!
      END FUNCTION LDAC_LFC  
!
!=======================================================================
!
      FUNCTION ALDA_LFC(X,RS,T,EC_TYPE)
!
!  This function computes the adiabatic local density approximation (ALDA)
!     local-field correction
!
!  References: (1) K. Tatarczyk, A. Schindlmayr and M. Scheffler,
!                     Phys. Rev. B 63, 235106 (2001)
!
!  Note: we have G(q) = - f_{xc} / Vc(q)
!
!  In terms of derivatives with respect to r_s -->  n = (3 / 4 pi) / r_s^3
!     we find
!
!  f_{xc}   = [ (4 / 9a^2) - 2 / 3a) *r_s^4 * d E_xc / d r_s +
!               (1 / 9a^2) *r_s^5 * d^2 d E_xc / d r_s^2 ] 
!
!  1/Vc(q)  = q^2 = X*X * 4 * k_F^2 = 4*X*X * (1 / alpha r_s)^2
!
!
!  Note: Energies are calculated in Ry units: 
!                                              a_0   = 1
!                                              e^2   = 2
!                                              m     = 1/2
!                                              h_bar = 1
!
!
!  We write E_xc = E_x + E_c and E_x(LDA) = - 3/4*pi * (3*pi^3*n)^{1/3}
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature (SI)     
!       * EC_TYPE  : type of correlation energy functional
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 30 Oct 2020
!
!
      USE REAL_NUMBERS,        ONLY : ONE,TWO,FOUR,EIGHT,NINE,HALF,THIRD
      USE PI_ETC,              ONLY : PI,PI_INV
      USE CORRELATION_ENERGIES 
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 6)   ::  EC_TYPE
!
      REAL (WP)             ::  X,RS,T
      REAL (WP)             ::  ALDA_LFC
      REAL (WP)             ::  A,R1,R2,R4,C1,C2,Q2
      REAL (WP)             ::  D_EC_1,D_EC_2
      REAL (WP)             ::  COR,EXC
      REAL (WP)             ::  VC
!
      A = 0.75E0_WP * PI_INV                                        ! 3 / (4 pi)
!
      R1 = RS                                                       ! 
      R2 = R1 * R1                                                  ! powers of RS
      R4 = R2 * R2                                                  !
!
      Q2 = FOUR * X * X                                             ! q^2 
      VC = EIGHT * PI / Q2                                          ! e^2 = 2 in Ryd
!
      C1 = - (TWO / (NINE * A)) * R4                                !
      C2 = - HALF * C1 * R1                                         ! see notes.pdf
!
!  Computing the exchange-correlation energy derivatives (in Ryd)
!
      CALL DERIVE_EC_3D(EC_TYPE,1,5,RS,T,D_EC_1,D_EC_2)             !
!
!  Correlation contribution
!
      COR = C1 * D_EC_1 + C2 * D_EC_2                               ! see notes.pdf
!
!  Exchange contribution  
!
      EXC = - (TWO / THIRD) * (ONE / (A + A))**THIRD * R2           ! see notes.pdf
!
!  Computing the local-field correction
!
      ALDA_LFC = - (COR + EXC) / VC                                 !
!
      END FUNCTION ALDA_LFC   
!
!=======================================================================
!
      FUNCTION JGDG_LFC(X,RS,T,EC_TYPE)
!
!  This function computes the Jung-Garcia-Gonzalez-Dobson-Godby
!     local-field correction
!
!  References: (1) J. Jung, P. García-González, J. F. Dobson and R. W. Godby,
!                     Phys. Rev. B 70, 205107, (2004)
!
!  Note: we have G(q)  = - f_{xc} / Vc(q)
!
!           and 
!                                    K_{xc} 
!               f_{xc} = ------------------------------   eq. (6)
!                         ( 1 + alpha(rs) * (q/k_F)^2)
!
!           with
!                         d^2 [ n * E_{xc}(n) ]
!               K_{xc} =  ---------------------
!                                 d n^2
!
!  In terms of derivatives with respect to r_s -->  n = (3 / 4 pi) / r_s^3
!     we find
!
!  K_{xc}   = [ (4 / 9a^2) - 2 / 3a) *r_s^4 * d E_xc / d r_s +
!               (1 / 9a^2) *r_s^5 * d^2 d E_xc / d r_s^2 ] 
!
!  1/Vc(q)  = q^2 = X*X * 4 * k_F^2 = 4*X*X * (1 / alpha r_s)^2
!
!
!  We write E_xc = E_x + E_c and E_x(LDA) = - 3/4*pi * (3*pi^3*n)^{1/3}
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature (SI)     
!       * EC_TYPE  : type of correlation energy functional
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 25 Sep 2020
!
!
      USE REAL_NUMBERS,        ONLY : ONE,TWO,FOUR,FIVE,NINE,HALF,THIRD
      USE PI_ETC,              ONLY : PI,PI_INV
      USE CORRELATION_ENERGIES 
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 6)   ::  EC_TYPE
!
      REAL (WP)             ::  X,RS,T
      REAL (WP)             ::  JGDG_LFC
      REAL (WP)             ::  Y
      REAL (WP)             ::  A,R1,R2,R4,C1,C2,Q2
      REAL (WP)             ::  D_EC_1,D_EC_2
      REAL (WP)             ::  COR,EXC
      REAL (WP)             ::  KXC,EMF
!
      Y  = X + X                                                    ! Y = q / k_F
!
!  Computation of the empirical function EMF = alpha(rs)
!
      EMF = (8.26E0_WP + RS) / (100.0E0_WP + FIVE * RS)             ! ref. (1) eq. (7)
!
      A = 0.75E0_WP * PI_INV                                        ! 3 / (4 pi)
!
      R1 = RS                                                       ! 
      R2 = R1 * R1                                                  ! powers of RS
      R4 = R2 * R2                                                  !
!
      Q2 = FOUR * X * X                                             ! q^2 
!
      C1 = - (TWO / (NINE * A)) * R4                                !
      C2 = - HALF * C1 * R1                                         ! see notes.pdf
!
!  Computing the exchange-correlation energy derivatives  
!
      CALL DERIVE_EC_3D(EC_TYPE,1,5,RS,T,D_EC_1,D_EC_2)             !
!
!  Correlation contribution
!
      COR = C1 * D_EC_1 + C2 * D_EC_2                               ! see notes.pdf
!
!  Exchange contribution  
!
      EXC = - (TWO / THIRD) * (ONE / (A + A))**THIRD * R2           ! see notes.pdf
!
!  Computing the local-field correction K_XC
!
      KXC = - Q2 * (COR + EXC) / (FOUR * PI)                        !
!
      JGDG_LFC = KXC / (ONE + EMF * Y * Y)                          ! ref. (1) eq. (6)
!
      END FUNCTION JGDG_LFC
!
!=======================================================================
!
      FUNCTION ALFL_LFC(X)
!
!  This function computes the Alvarellos-Flores
!      local-field correction
!
!  References: (1) J. E. Alvarellos and F. Flores, 
!                     J. Phys. F: Met.Phys. 14, 1673-1683 (1984)
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!  Note: in order to fit with a polynomial the data provided in table 1,
!         we have divided the q / k_F range into three intervals: 
!
!                         [0.1,1.5], [1.5,3] and [3,inf[
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Sep 2020
!
!
      USE REAL_NUMBERS,        ONLY : THREE
!
      IMPLICIT NONE
!
      REAL*8 X,Y,ALFL_LFC
      REAL*8 Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10,Y11,Y12
!
      REAL*8 A(0:4),B(0:12),C(0:12)
!
      DATA A    / -0.00232814185814185791E0_WP,       & !
                   0.02957060876859638210E0_WP,       & ! Alvarellos-Flores
                   0.26322613203360108073E0_WP,       & ! parametrization q 
                   0.18806277528800747964E0_WP,       & ! in [0.1,1.5]
                  -0.10804001854698448924E0_WP        / !
!
      DATA B    / 1602873.31450051144290982293E0_WP,  & !
                 -8878402.26517064151352730944E0_WP,  & !
                 22368820.63709011917824002483E0_WP,  & !
                -33895716.59478186008112667038E0_WP,  & !
                 34405106.67965708984160299577E0_WP,  & !
                -24644195.23964148249074776392E0_WP,  & !
                 12773812.11115474100423665142E0_WP,  & ! Alvarellos-Flores
                 -4827670.95479111073609401600E0_WP,  & ! parametrization q
                  1320409.84284274222863391708E0_WP,  & ! in [1.5,3]
                  -254900.07720880570664342685E0_WP,  & !
                    32969.67519994204849073546E0_WP,  & !
                    -2565.55962024807576633976E0_WP,  & ! 
                       90.83704034662135794196E0_WP   / !
!
      DATA C    /  0.99589822749632385541E0_WP,       & !
                  -0.37069025316863586226E0_WP,       & !
                   0.10927126349814184349E0_WP,       & !
                  -0.01842929651333115907E0_WP,       & !
                   0.00196933466633664192E0_WP,       & !
                  -0.00014089343299951851E0_WP,       & ! Alvarellos-Flores
                   0.00000695535076739875E0_WP,       & ! parametrization q
                  -0.00000023991362786543E0_WP,       & ! in [3,50]
                   0.00000000576407117368E0_WP,       & !
                  -0.00000000009442676563E0_WP,       & !
                   0.00000000000100445750E0_WP,       & !
                  -0.00000000000000624700E0_WP,       & !
                   0.00000000000000001722E0_WP        / !
!
      Y=X+X                                                         ! Y = q / k_F
!
      Y2=Y*Y                                                        ! 
      Y3=Y2*Y                                                       !
      Y4=Y3*Y                                                       !
      Y5=Y4*Y                                                       !
      Y6=Y5*Y                                                       ! powers of Y
      Y7=Y6*Y                                                       !
      Y8=Y7*Y                                                       !
      Y9=Y8*Y                                                       !
      Y10=Y9*Y                                                      !
      Y11=Y10*Y                                                     !
      Y12=Y11*Y                                                     !
!
!  Fitted values:
!
      IF(Y <= 1.5E0_WP) THEN                                        !
        ALFL_LFC=A(0)+A(1)*Y+A(2)*Y2+A(3)*Y3+A(4)*Y4                ! 4th-degree polynomial
      ELSE                                                          !
        IF(Y < THREE) THEN                                          !
          ALFL_LFC=B(0)+B(1)*Y+B(2)*Y2+B(3)*Y3+B(4)*Y4+          &  !
                   B(5)*Y5+B(6)*Y6+B(7)*Y7+B(8)*Y8+              &  ! 12th-degree polynomial
                   B(9)*Y9+B(10)*Y10+B(11)*Y11 +B(12)*Y12           !
        ELSE                                                        !
          ALFL_LFC=C(0)+C(1)*Y+C(2)*Y2+C(3)*Y3+C(4)*Y4+          &  ! 
                   C(5)*Y5+C(6)*Y6+C(7)*Y7+C(8)*Y8+              &  ! 12th-degree polynomial
                   C(9)*Y9+C(10)*Y10+C(11)*Y11 +C(12)*Y12           !
        END IF                                                      !
      END IF                                                        !
!
      END FUNCTION ALFL_LFC  
!
!=======================================================================
!
      FUNCTION BEBR_LFC(X,RS)
!
!  This subroutine computes the Gorobchenko-Kohn-Makismov 
!    parametrization of the Bedell-Brown static 
!    local-field correction G(q)
!
!  We use a 10-degree polynomial to fit the data of 
!    table 13 p. 202 reference (1):  r_s = 1 --> A1
!                                    r_s = 2 --> A2
!                                    r_s = 3 --> A3
!                                    r_s = 4 --> A4
!                                    r_s = 5 --> A5
!
!  For a given value of (q / k_F), this gives 5 values of G(q / k_F).
!  Then, we use Lagrange interpolation to find  G(q / k_F) for the 
!    input value r_s
!
!  Reference: (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)
!             (2) K. Bedell and G. E. Brown, Phys. Rev. B 17, 
!                    4512-4526 (1978)
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  4 Sep 2020
!
!
      USE INTERPOLATION,     ONLY : LAG_5P_INTERP
!
      IMPLICIT NONE
!
      INTEGER               ::  I
!
      REAL (WP)             ::  X,BEBR_LFC
      REAL (WP)             ::  Y,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9,Y10
      REAL (WP)             ::  A1(0:10),A2(0:10),A3(0:10),A4(0:10),A5(0:10)
      REAL (WP)             ::  XX(5),G(5)
      REAL (WP)             ::  GQ
      REAL (WP)             ::  RS
!
      REAL (WP)             ::  FLOAT
!
      DATA A1  / 0.05665675302924973487E0_WP, - 0.98831786405830883053E0_WP, & !
                 5.71954869216605636168E0_WP, -11.66292418214004375562E0_WP, & !
                14.39634044260440374493E0_WP, -11.11349419853768050130E0_WP, & ! r_s = 1
                 5.41506188302421610518E0_WP, - 1.66403119967215497295E0_WP, & !
                 0.31307098570298832050E0_WP, - 0.03296633943677430225E0_WP, & !
                 0.00148977432192336107E0_WP /                                 !
!
      DATA A2  / 0.09615453465136963087E0_WP, - 1.68845504199024126849E0_WP, & !
                 9.58638897670232869993E0_WP, -20.14220993548459161920E0_WP, & !
                24.84488446234967641433E0_WP, -19.08578084736209803670E0_WP, & ! r_s = 2
                 9.30607703069127278674E0_WP, - 2.87840456993250278340E0_WP, & !
                 0.54728271452439117930E0_WP, - 0.05837908431520891572E0_WP, & !
                 0.00267579536376397662E0_WP /                                 !
!
      DATA A3 /  0.12489537639285344973E0_WP, - 2.19227250101889576367E0_WP, & !
                12.31553072981137928772E0_WP, -26.10326007988353482451E0_WP, & !
                32.21209258443127872400E0_WP, -24.74352965527718617954E0_WP, & ! r_s = 3
                12.08871426471608460444E0_WP, - 3.75352185666137399318E0_WP, & !
                 0.71726641930779769185E0_WP, - 0.07694135948329880508E0_WP, & !
                 0.00354705841080042429E0_WP  /                                !
!
      DATA A4 /  0.13845553558660167957E0_WP, - 2.40703111904318554141E0_WP, & !
                13.25313366188360966866E0_WP, -27.12342892703660083282E0_WP, & !
                32.07267146613116132363E0_WP, -23.65420157903910060017E0_WP, & ! r_s = 4
                11.14339308619566914286E0_WP, - 3.34944213997448196331E0_WP, & !
                 0.62156353952937566618E0_WP, - 0.06491444468410050654E0_WP, & !
                 0.00291971543613746805E0_WP  /                                !
!
       DATA A5 / 0.16492523750906023169E0_WP, - 2.89272457288247751551E0_WP, & !
                16.13741748584924269111E0_WP, -34.56490422254182103290E0_WP, & !
                42.80211125382114047548E0_WP, -32.95766092086370111126E0_WP, & ! r_s = 5
                16.15651875212909104597E0_WP, - 5.03812068154871323281E0_WP, & !
                 0.96728844784358881200E0_WP, - 0.10425567298196395386E0_WP, & !
                 0.00482824566192623949E0_WP  /                                !
!
!  Storing the r_s
!
      DO I=1,5                                                      !
        XX(I) = FLOAT(I)                                            !
      END DO                                                        !
!
      Y  = X  + X                                                   ! q / k_F
      Y2 = Y  * Y                                                   !
      Y3 = Y2 * Y                                                   ! 
      Y4 = Y3 * Y                                                   !
      Y5 = Y4 * Y                                                   ! powers of Y
      Y6 = Y5 * Y                                                   !
      Y7 = Y6 * Y                                                   !
      Y8 = Y7 * Y                                                   !
      Y9 = Y8 * Y                                                   !
      Y10= Y9 * Y                                                   !
!
!  Computing G(q) for r_s = 1,2,3,4 and 5
!
      G(1)=A1(0) + A1(1)*Y  + A1(2)*Y2 + A1(3)*Y3 + A1(4)*Y4 +  &   !
                 A1(5)*Y5 + A1(6)*Y6 + A1(7)*Y7 + A1(8)*Y8   +  &   ! 
                 A1(9)*Y9 + A1(10)*Y10                              !
      G(2)=A2(0) + A2(1)*Y  + A2(2)*Y2 + A2(3)*Y3 + A2(4)*Y4 +  &   ! 
                 A2(5)*Y5 + A2(6)*Y6 + A2(7)*Y7 + A2(8)*Y8   +  &   ! 
                 A2(9)*Y9 + A2(10)*Y10                              !
      G(3)=A3(0) + A3(1)*Y  + A3(2)*Y2 + A3(3)*Y3 + A3(4)*Y4 +  &   ! 
                 A3(5)*Y5 + A3(6)*Y6 + A3(7)*Y7 + A3(8)*Y8   +  &   ! 
                 A3(9)*Y9 + A3(10)*Y10                              !
      G(2)=A4(0) + A4(1)*Y  + A4(2)*Y2 + A4(3)*Y3 + A4(4)*Y4 +  &   ! 
                 A4(5)*Y5 + A4(6)*Y6 + A4(7)*Y7 + A4(8)*Y8   +  &   ! 
                 A4(9)*Y9 + A4(10)*Y10                              !
      G(5)=A5(0) + A5(1)*Y  + A5(2)*Y2 + A5(3)*Y3 + A5(4)*Y4 +  &   ! 
                 A5(5)*Y5 + A5(6)*Y6 + A5(7)*Y7 + A5(8)*Y8   +  &   ! 
                 A5(9)*Y9 + A5(10)*Y10                              !
!
!  Performing the Langrange interpolation
!
      BEBR_LFC=LAG_5P_INTERP(XX,G,RS)                               !
!
      END FUNCTION BEBR_LFC
!
!=======================================================================
!
      FUNCTION CDOP_LFC(X,RS,T,EC_TYPE)
!
!  This function computes the Corradini-Del Sole-Onida-Palummo 
!      local-field correction
!
!  References: (1) M. Corradini, R. Del Sole, G. Onida and M. Palummo, 
!                     Phys. Rev. B 57, 14569-14571 (1998)
!              (2) D. Emfietzoglou et al, Nucl. Instr. and Meth. B 
!                     267, 45-52 (2009)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature (SI)     
!       * EC_TYPE  : type of correlation energy functional
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 30 Oct 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,FOUR,NINE, &
                                   HALF,THIRD,FOURTH,NINTH
      USE FERMI_AU,         ONLY : KF_AU
      USE PI_ETC,           ONLY : PI,PI2
      USE CORRELATION_ENERGIES
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 6)   ::  EC_TYPE
!
      REAL (WP), INTENT(IN) ::  X,RS,T
      REAL (WP)             ::  CDOP_LFC
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  U,U2,U3,U4,U5,U6
      REAL (WP)             ::  COEF
      REAL (WP)             ::  A,B,C,G,AL,BE
      REAL (WP)             ::  A1,A2,B1,B2
      REAL (WP)             ::  RS2,RS3
      REAL (WP)             ::  EC,D_EC_1,D_EC_2
!
      REAL (WP)             ::  SQRT,EXP
!
!      COEF = (FOUR * PI2 / NINE)**THIRD / 24.0E0_WP                 ! in ref. (2) eq. (17a)
      COEF = HALF * NINTH * (THREE * PI2 / TWO)**THIRD              !
!
      Y  = X + X                                                    ! Y = q / k_F = Q in ref. 1
      Y2 = Y*Y                                                      ! Q^2             in ref. 1
!
      U  = SQRT(RS)                                                 ! x               in ref. 1
      U2 = U * U                                                    ! x^2             in ref. 1
      U3 = U2 * U                                                   ! x^3             in ref. 1
      U4 = U3 * U                                                   ! x^4             in ref. 1
      U5 = U4 * U                                                   ! x^5             in ref. 1
      U6 = U5 * U                                                   ! x^6             in ref. 1
!
      RS2 = RS  * RS                                                !
      RS3 = RS2 * RS                                                !
!
      A1 = 2.15E0_WP                                                !
      A2 = 0.435E0_WP                                               ! for CDOP
      B1 = 1.57E0_WP                                                ! coefficients (6)-(8)
      B2 = 0.409E0_WP                                               !
!
!  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)             ! 
!
!  CDOP coeffcients:
!
      A  = FOURTH - COEF * HALF * (RS3 * D_EC_2 - TWO * RS2 * D_EC_1)! eq.17a ref (2) + e^2 = 2
      B  = (ONE + A1 * U + A2 * U3) / (THREE + B1 * U + B2 * U3)    ! eq.19  ref (2)
      C  = - FOURTH * PI* (EC + RS * D_EC_1) / KF_AU                ! eq.6   ref (1) + e^2 = 2
      G  = B / (A - C)                                              !        ref (1)
      AL = 1.50E0_WP * A / (SQRT(U) * B * G)                        ! eq.9   ref (1)
      BE = 1.20E0_WP / (B * G)                                      ! eq.10  ref (1)
!
!  Computation of the local-field formula                           ! (x 4 pi to be in SI)
!
      CDOP_LFC = C * Y2 + B * Y2 / (G  + Y2) +                    & !
                 AL * Y2 * Y2 * EXP(- BE  *Y2)                      ! ref. (2) eq. (15), (8)
!
      END FUNCTION CDOP_LFC   
!
!=======================================================================
!
      FUNCTION TOUL_LFC(X,RS,T,EC_TYPE)
!
!  This function computes the Toulouse fit of the 
!    Corradini-Del Sole-Onida-Palummo local-field correction
!
!  References: (1) M. Corradini, R. Del Sole, G. Onida and M. Palummo, 
!                     Phys. Rev. B 57, 14569-14571 (1998)
!              (2) J. Toulouse, Phys. Rev. B 72, 035117 (2005)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature (SI)     
!       * EC_TYPE  : type of correlation energy functional
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 30 Oct 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,FOUR,NINE, &
                                   HALF,THIRD,FOURTH
      USE FERMI_AU,         ONLY : KF_AU
      USE PI_ETC,           ONLY : PI,PI2
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 6)   ::  EC_TYPE
!
      REAL (WP)             ::  X,RS,T,Y,Y2
      REAL (WP)             ::  TOUL_LFC
      REAL (WP)             ::  U,U2,U3,U4,U5,U6
      REAL (WP)             ::  COEF
      REAL (WP)             ::  A,B,C,G,AL,BE
      REAL (WP)             ::  EC,D_EC_1,D_EC_2
      REAL (WP)             ::  AT(0:6),BT(4)
      REAL (WP)             ::  C1(6),C2(4)
      REAL (WP)             ::  NUM,DEN
!
      REAL (WP)             ::  SQRT,EXP
!
      DATA AT /  0.250019E0_WP, -0.000162E0_WP,  0.013441E0_WP, & ! \
                -0.003591E0_WP,  0.000380E0_WP, -0.000002E0_WP, & !  \
                -0.000003E0_WP                                  / !   \
!                                                                 !    \
      DATA BT /  0.721543E0_WP,  0.317320E0_WP, -0.133379E0_WP, & !     \
                 0.269494E0_WP                                  / !      > ref. (2) appendix D
!                                                                 !     /
      DATA C1 /  0.002127E0_WP,  0.169597E0_WP,  0.450771E0_WP, & !    /
                -0.023265E0_WP,  0.001855E0_WP, -0.000069E0_WP  / !   /
      DATA C2 /  7.062604E0_WP,  8.589773E0_WP,  2.747407E0_WP, & !  / 
                 0.648920E0_WP                                  / ! / 
!
      COEF = (FOUR * PI2 / NINE)**THIRD / 24.0E0_WP                  ! in ref. (2) eq. (17a)
!
      Y  = X + X                                                    ! Y = q / k_F = Q in ref. 1
      Y2 = Y*Y                                                      ! Q^2             in ref. 1
!
      U  = SQRT(RS)                                                 ! x               in ref. 1
      U2 = U * U                                                    ! x^2             in ref. 1
      U3 = U2 * U                                                   ! x^3             in ref. 1
      U4 = U3 * U                                                   ! x^4             in ref. 1
      U5 = U4 * U                                                   ! x^5             in ref. 1
      U6 = U5 * U                                                   ! x^6             in ref. 1
!
!  CDOP coeffcients:
!
      A = AT(0) + AT(1) * U  + AT(2) * U2 + AT(3) * U3 +          & ! ref. (2) eq. (D1)
                  AT(4) * U4 + AT(5) * U5 + AT(6) * U6              !
!
      B = ( ONE   + BT(1) * U  + BT(2) * U3 ) /                   & ! ref. (2) eq. (D2)
          ( THREE + BT(3) * U  + BT(4) * U3 )                       !
!
      NUM = C1(1) * U  + C1(2) * U2 + C1(3) * U3 +                & !
            C1(4) * U4 + C1(5) * U5 + C1(6) * U6                    !
      DEN = C2(1) * U  + C2(2) * U2 + C2(3) * U3 +                & !
            C2(4) * U4 + ONE                                        !
      C   = NUM / DEN                                               ! ref. (2) eq. (D3)
!
      G  = B / (A - C)                                              !        ref (1)
      AL = 1.50E0_WP * A / (SQRT(U) * B * G)                        ! eq.9   ref (1)
      BE = 1.20E0_WP / (B * G)                                      ! eq.10  ref (1)
!
!  Computation of the local-field formula                           !
!
      TOUL_LFC = C * Y2 + B * Y2 / (G + Y2) +                     & !
                 AL * Y2 * Y2 * EXP(- BE * Y2)                      ! ref. (1) eq. (8)
!
      END FUNCTION TOUL_LFC   
!
!=======================================================================
!
      FUNCTION GEV2_LFC(X,RS,T,EC_TYPE)
!
!  This function computes the Geldart-Vosko local-field correction,
!    as parametrized by Gorobchenko-Kohn-Makismov
!
!  Reference: (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)
!             (2) N. Iwamoto, Phys. Rev. A 30, 3289-3304 (1984)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature (SI)     
!       * EC_TYPE  : type of correlation energy functional
!
!  Intermediate parameters:
!
!       * XI       : dimensionless factor  
!
!  Note: XI is given in reference (1) in terms of the ratio of compressibilities: 
!
!                              RAT = (1 - K_0/K_T)  
!
!        We compute it using eq. (2.18) of ref. (2)
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 22 Jul 2020
!
!
      USE REAL_NUMBERS,     ONLY : TWO,HALF,THIRD
      USE PI_ETC,           ONLY : PI_INV
      USE UTILITIES_1,      ONLY : ALFA
      USE CORRELATION_ENERGIES
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 6)   ::  EC_TYPE
!
      REAL (WP), INTENT(IN) ::  X,RS,T
      REAL (WP)             ::  GEV2_LFC
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  ALPHA,XI
      REAL (WP)             ::  D_EC_1,D_EC_2
      REAL (WP)             ::  RAT
!
      ALPHA=ALFA('3D')                                              !
!
      Y=X+X                                                         ! Y = q / k_F
      Y2=Y*Y
!
!  Computing the exchange-correlation energy derivatives  
!
      CALL DERIVE_EC_3D(EC_TYPE,1,5,RS,T,D_EC_1,D_EC_2)             !
!
!  Computing Xi(r_s)
!
      RAT=ALPHA*PI_INV*RS + THIRD*ALPHA*ALPHA*RS*RS*RS*D_EC_1 -   & ! ref. (2) eq. (2.18)
          HALF*THIRD*ALPHA*ALPHA*RS*RS*RS*RS*D_EC_2                 !
!
      XI=TWO*PI_INV*ALPHA*RS/RAT                                    ! ref. (1) eq. (4.70)
!
      GEV2_LFC=HALF*Y2/(XI+Y2)                                      ! ref. (1) eq. (4.69) 
!
      END FUNCTION GEV2_LFC  
!
!=======================================================================
!
      FUNCTION GOCA_LFC(X,RS)
!
!  This function computes the Gold-Calmels 
!      local-field correction
!
!  References: (1) A. Gold and L. Calmels, Phys. Rev. B 48, 
!                     11622-11637 (1993)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,SIX,NINE,TEN,THIRD,FOURTH
      USE PI_ETC,           ONLY : PI
!
      IMPLICIT NONE
!
      INTEGER               ::  IND
!
      REAL (WP), INTENT(IN) ::  X,RS
      REAL (WP)             ::  GOCA_LFC
      REAL (WP)             ::  Y
      REAL (WP)             ::  NUM,KFOQ0,QQ0
      REAL (WP)             ::  A1GC(3),B1GC(3),A2GC(3),B2GC(3)
      REAL (WP)             ::  C13,C23
!
      DATA A1GC   /0.918E0_WP,0.916E0_WP,0.921E0_WP/                ! Gold-Calmels coefficients
      DATA B1GC   /0.190E0_WP,0.134E0_WP,0.129E0_WP/                ! for C13 and C23
      DATA A2GC   /1.108E0_WP,1.076E0_WP,0.782E0_WP/                ! eq. (12)-(13)
      DATA B2GC   /0.580E0_WP,0.550E0_WP,0.725E0_WP/                ! 
!
      Y = X + X                                                     ! Y = q / k_F
!
      IF(RS < ONE) THEN                                             !
        IND = 1                                                     !
      ELSE                                                          !
        IF(RS < TEN) THEN                                           !
          IND = 2                                                   !
        ELSE                                                        !
          IF(RS < 50.0E0_WP) THEN                                   !
            IND = 3                                                 !
          END IF                                                    !
        END IF                                                      !
      END IF                                                        !
!
      C13 = A1GC(IND) * (RS**B1GC(IND))                             !
!
      IF(RS < ONE) THEN                                             !
        IND = 1                                                     !
      ELSE                                                          !
        IF(RS <  SIX) THEN                                          !
          IND = 2                                                   !
        ELSE                                                        !
          IF(RS < 50.0E0_WP) THEN                                   !
            IND = 3                                                 !
          END IF                                                    !
        END IF                                                      !
      END IF                                                        !
!
      C23 = A2GC(IND) * (RS**B2GC(IND))                             !
!
      NUM   = (NINE * PI * FOURTH)**THIRD / 12.0E0_WP**FOURTH       !
      KFOQ0 = NUM / (RS**FOURTH)                                    ! k_F / q_0
      QQ0 = Y * KFOQ0                                               !
!
      GOCA_LFC = RS**0.75E0_WP * (0.846E0_WP * QQ0 * QQ0) /      &  !
                 (2.188E0_WP * C13 + QQ0 * QQ0 * C23)               !
!
      END FUNCTION GOCA_LFC  
!
!=======================================================================
!
      FUNCTION HORA_LFC(X,RS)
!
!  This function computes the Holas-Rahman
!      local-field correction
!
!  References: (1) A. Holas and S. Rahman, Phys. Rev. B 35, 
!                     2720-2731 (1987)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!  Note: we make an polynomial interpolation of table I
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 11 Nov 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,FOUR,EIGHT,HALF,THIRD
      USE PI_ETC,           ONLY : PI_INV
      USE UTILITIES_1,      ONLY : ALFA
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,RS
      REAL (WP)             ::  HORA_LFC
      REAL (WP)             ::  Y
      REAL (WP)             ::  A0,A2,A4,B2,B4,B6,B8
      REAL (WP)             ::  Q0,NUM,DEN,IAQ
      REAL (WP)             ::  Y2,Y4,Y6,Y8
      REAL (WP)             ::  ALPHA
!
      REAL (WP)             ::  LOG,ABS
!
      ALPHA = ALFA('3D')                                            !
!
      Y = X + X                                                     ! Y = q / k_F
!
      Y2 = Y  *  Y                                                  !
      Y4 = Y2 * Y2                                                  !
      Y6 = Y4 * Y2                                                  !
      Y8 = Y6 * Y2                                                  !
!  
      CALL HR_PARAMETRIZATION_3D(RS,A0,A2,A4,B2,B4,B6,B8)           ! interpolation
!
      IF(Y /= TWO) THEN
        Q0 = FOUR * ALPHA * RS * PI_INV * (                       & !
                 HALF + (FOUR - Y2) / (EIGHT * Y) *               & ! eq. (47)
                 LOG(ABS((TWO + Y) / (TWO - Y)))                  & !
                                          ) / Y2                    !
      ELSE                                                          !
        Q0 = TWO * ALPHA * RS * PI_INV / Y2                         !
      END IF                                                        !
!  
      NUM = A0  + A2 * Y2 + A4 * Y4                                 !
      DEN = ONE + B2 * Y2 + B4 * Y4 + B6 * Y6 + B8 * Y8             !
      IAQ = NUM / DEN                                               ! eq. (48)
!
      HORA_LFC = IAQ / Q0                                           ! eq. (46)
!
      END FUNCTION HORA_LFC  
!
!=======================================================================
!
      SUBROUTINE HR_PARAMETRIZATION_3D(RS,AA0,AA2,AA4,BB2,BB4,BB6,BB8)
!
!  This subroutine computes the Holas-Rahman parametrization for the 
!    calculation of the static 3D local-field correction G(q)
!
!  References: (1) A. Holas and S. Rahman, Phys. Rev. B 35, 2720-2731 (1987)
! 
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!  Output parameters:
!
!       * The Holas-Rahman parameters A0,A2,A4,B2,B4,B6 and B8
!
!  Table I of ref. (1) is used and the parameters are fitted with a 
!     4-th order polynomial in r_s
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 26 Jul 2019
!
!
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN)  ::  RS
      REAL (WP), INTENT(OUT) ::  AA0,AA2,AA4,BB2,BB4,BB6,BB8
      REAL (WP)              ::  A0(0:4),A2(0:4),A4(0:4)
      REAL (WP)              ::  B2(0:4),B4(0:4),B6(0:4),B8(0:4)
      REAL (WP)              ::  X1,X2,X3,X4 
!
      DATA A0   /-0.00048E0_WP   , 0.16727E0_WP, 0.0061571E0_WP,  & !
                 -0.00041917E0_WP, 1.7917E-5_WP                   / !
      DATA A2   /-0.002098E0_WP  , 0.012257E0_WP,-0.013308E0_WP , & !
                  0.0023196E0_WP ,-0.00018303E0_WP                / !
      DATA A4   /-0.002224E0_WP  ,0.0077895E0_WP,-0.0030371E0_WP, & !
                  0.00054148E0_WP,-3.4888E-5_WP                   / !
!
      DATA B2   / 0.52865E0_WP   ,-0.37039E0_WP  , 0.11503E0_WP,  & !
                 -0.018194E0_WP  , 0.0010798E0_WP                 / !
      DATA B4   / 0.04892E0_WP   , 0.093157E0_WP ,-0.04843E0_WP,  & !
                  0.0098533E0_WP ,-0.00069E0_WP                   / !
      DATA B6   / 1.4624E0_WP    ,-2.6294E0_WP   , 1.4481E0_WP ,  & !
                 -0.31884E0_WP   , 0.024511E0_WP                  / !
      DATA B8   / 0.0057882E0_WP,-0.0009743E0_WP,-0.00042365E0_WP,& !
                  0.0001619E0_WP ,-1.445E-5_WP                    / !
!
      X1 = RS                                                       !
      X2 = X1 * X1                                                  !
      X3 = X2 * X1                                                  !
      X4 = X3 * X1                                                  !
!
      AA0 = A0(0) + A0(1) * X1 + A0(2) * X2 + A0(3) * X3 + A0(4) * X4 !
      AA2 = A2(0) + A2(1) * X1 + A2(2) * X2 + A2(3) * X3 + A2(4) * X4 !
      AA4 = A4(0) + A4(1) * X1 + A4(2) * X2 + A4(3) * X3 + A4(4) * X4 !
!
      BB2 = B2(0) + B2(1) * X1 + B2(2) * X2 + B2(3) * X3 + B2(4) * X4 !
      BB4 = B4(0) + B4(1) * X1 + B4(2) * X2 + B4(3) * X3 + B4(4) * X4 !
      BB6 = B6(0) + B6(1) * X1 + B6(2) * X2 + B6(3) * X3 + B6(4) * X4 !
      BB8 = B8(0) + B8(1) * X1 + B8(2) * X2 + B8(3) * X3 + B8(4) * X4 !
!
      END SUBROUTINE HR_PARAMETRIZATION_3D  
!
!=======================================================================
!
      FUNCTION UTIC_LFC(X,RS)
!
!  This function computes the TABULATED Utsumi-Ichimaru
!      local-field correction in the range:
!
!          q   = [0,150]
!          r_s = [1,6]
!
!  References: (1) K. Utsumi and S. Ichimaru, Phys. Rev. B 22, 
!                     5203-5212 (1980) 
! 
! 
!  Note: Uses a 6-point Lagrange interpolation for q and r_s
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 20 Sep 2021
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TEN,HALF,TENTH
      USE INTERPOLATION,    ONLY : LAG_6P_INTERP
!
      IMPLICIT NONE
!
      INTEGER               ::  I,J
!
      INTEGER, PARAMETER    ::  N = 46                              ! size of q-grid
!
      REAL (WP), INTENT(IN) ::  X,RS
!
      REAL (WP)             ::  UTIC_LFC
      REAL (WP)             ::  Y
!
      REAL (WP)             ::  QQ(N)                               ! q-grid
      REAL (WP)             ::  GQ1(N),GQ2(N),GQ3(N)                ! G(q) for r_s = 1,2 3
      REAL (WP)             ::  GQ4(N),GQ5(N),GQ6(N)                ! G(q) for r_s = 4,5,6
!
      REAL (WP)             ::  RR(6)                               ! r-grid
      REAL (WP)             ::  R1(6),R2(6),R3(6)                   ! \
      REAL (WP)             ::  R4(6),R5(6),R6(6)                   ! /  Lagrange 6-q-grid
!
      REAL (WP)             ::  XL(6),AL(6)
!

      REAL (WP)             ::  STEP_1,STEP_2,STEP_3,STEP_4         ! various q-steps
!
!  Tabulated values of r_s (r-grid)
!
      DATA  RR  / 1.0E0_WP, 2.0E0_WP, 3.0E0_WP ,                 & ! RS values
                  4.0E0_WP, 5.0E0_WP, 6.0E0_WP                   / ! in table I
!
!  GQn : Tabulated values of G(q) for r_s = n
!
      DATA GQ1 /  0.0029_WP, 0.0117_WP, 0.0265_WP, 0.0476_WP,    & ! r_s = 1 values
                  0.0752_WP, 0.1096_WP, 0.1510_WP, 0.1996_WP,    & !
                  0.2553_WP, 0.3180_WP, 0.3875_WP, 0.4633_WP,    & !
                  0.5444_WP, 0.6295_WP, 0.7166_WP, 0.8023_WP,    & !
                  0.8816_WP, 0.9461_WP, 0.9796_WP, 0.9217_WP,    & !
                  0.8279_WP, 0.7897_WP, 0.7659_WP, 0.7494_WP,    & !
                  0.7374_WP, 0.7283_WP, 0.7213_WP, 0.7159_WP,    & !
                  0.7116_WP, 0.7081_WP, 0.6986_WP, 0.6956_WP,    & !
                  0.6950_WP, 0.6955_WP, 0.6977_WP, 0.7001_WP,    & !
                  0.7023_WP, 0.7042_WP, 0.7059_WP, 0.7147_WP,    & !
                  0.7181_WP, 0.7198_WP, 0.7209_WP, 0.7221_WP,    & !
                  0.7230_WP, 0.7237_WP                           / !

!
      DATA GQ2 /  0.0031_WP, 0.0123_WP, 0.0280_WP, 0.0504_WP,    & ! r_s = 2 values
                  0.0797_WP, 0.1163_WP, 0.1603_WP, 0.2119_WP,    & !
                  0.2710_WP, 0.3375_WP, 0.4110_WP, 0.4909_WP,    & !
                  0.5761_WP, 0.6653_WP, 0.7562_WP, 0.8455_WP,    & !
                  0.9282_WP, 0.9958_WP, 1.0321_WP, 0.9767_WP,    & !
                  0.8853_WP, 0.8493_WP, 0.8275_WP, 0.8129_WP,    & !
                  0.8027_WP, 0.7954_WP, 0.7900_WP, 0.7860_WP,    & !
                  0.7831_WP, 0.7810_WP, 0.7774_WP, 0.7788_WP,    & !
                  0.7817_WP, 0.7850_WP, 0.7911_WP, 0.7962_WP,    & !
                  0.8003_WP, 0.8037_WP, 0.8065_WP, 0.8198_WP,    & !
                  0.8243_WP, 0.8267_WP, 0.8280_WP, 0.8296_WP,    & !
                  0.8308_WP, 0.8316_WP                           / !

      DATA GQ3 /  0.0032_WP, 0.0128_WP, 0.0290_WP, 0.0521_WP,    & ! r_s = 3 values
                  0.0825_WP, 0.1203_WP, 0.1660_WP, 0.2195_WP,    & !
                  0.2808_WP, 0.3497_WP, 0.4257_WP, 0.5083_WP,    & !
                  0.5962_WP, 0.6881_WP, 0.7815_WP, 0.8732_WP,    & !
                  0.9580_WP, 1.0276_WP, 1.0657_WP, 1.0119_WP,    & !
                  0.9220_WP, 0.8873_WP, 0.8667_WP, 0.8533_WP,    & !
                  0.8441_WP, 0.8377_WP, 0.8333_WP, 0.8302_WP,    & !
                  0.8281_WP, 0.8268_WP, 0.8265_WP, 0.8304_WP,    & !
                  0.8352_WP, 0.8399_WP, 0.8480_WP, 0.8543_WP,    & !
                  0.8593_WP, 0.8632_WP, 0.8664_WP, 0.8809_WP,    & !
                  0.8856_WP, 0.8880_WP, 0.8893_WP, 0.8909_WP,    & !
                  0.8920_WP, 0.8928_WP                           / !

!
      DATA GQ4 /  0.0032_WP, 0.0131_WP, 0.0296_WP, 0.0533_WP,    & ! r_s = 4 values
                  0.0844_WP, 0.1232_WP, 0.1700_WP, 0.2249_WP,    & !
                  0.2877_WP, 0.3584_WP, 0.4363_WP, 0.5208_WP,    & !
                  0.6107_WP, 0.7045_WP, 0.7997_WP, 0.8931_WP,    & !
                  0.9795_WP, 1.0504_WP, 1.0897_WP, 1.0370_WP,    & !
                  0.9480_WP, 0.9141_WP, 0.8943_WP, 0.8815_WP,    & !
                  0.8730_WP, 0.8672_WP, 0.8633_WP, 0.8608_WP,    & !
                  0.8592_WP, 0.8583_WP, 0.8599_WP, 0.8653_WP,    & !
                  0.8711_WP, 0.8765_WP, 0.8855_WP, 0.8923_WP,    & !
                  0.8976_WP, 0.9016_WP, 0.9049_WP, 0.9190_WP,    & !
                  0.9234_WP, 0.9256_WP, 0.9268_WP, 0.9282_WP,    & !
                  0.9291_WP, 0.9298_WP                           / !
!
      DATA GQ5 /  0.0033_WP, 0.0132_WP, 0.0301_WP, 0.0541_WP,    & ! r_s = 5 values
                  0.0857_WP, 0.1251_WP, 0.1726_WP, 0.2284_WP,    & !
                  0.2923_WP, 0.3641_WP, 0.4433_WP, 0.5291_WP,    & !
                  0.6204_WP, 0.7155_WP, 0.8120_WP, 0.9066_WP,    & !
                  0.9941_WP, 1.0660_WP, 1.1061_WP, 1.0541_WP,    & !
                  0.9657_WP, 0.9323_WP, 0.9130_WP, 0.9006_WP,    & !
                  0.8925_WP, 0.8871_WP, 0.8835_WP, 0.8813_WP,    & !
                  0.8800_WP, 0.8795_WP, 0.8823_WP, 0.8886_WP,    & !
                  0.8951_WP, 0.9009_WP, 0.9105_WP, 0.9175_WP,    & !
                  0.9228_WP, 0.9269_WP, 0.9301_WP, 0.9437_WP,    & !
                  0.9477_WP, 0.9496_WP, 0.9507_WP, 0.9519_WP,    & !
                  0.9528_WP, 0.9534_WP                           / !
!
      DATA GQ6 /  0.0033_WP, 0.0134_WP, 0.0305_WP, 0.0548_WP,    & ! r_s = 6 values
                  0.0868_WP, 0.1268_WP, 0.1750_WP, 0.2315_WP,    & !
                  0.2964_WP, 0.3692_WP, 0.4495_WP, 0.5365_WP,    & !
                  0.6290_WP, 0.7253_WP, 0.8290_WP, 0.9185_WP,    & !
                  1.0068_WP, 1.0794_WP, 1.1201_WP, 1.0685_WP,    & !
                  0.9805_WP, 0.9475_WP, 0.9284_WP, 0.9163_WP,    & !
                  0.9084_WP, 0.9031_WP, 0.8998_WP, 0.8977_WP,    & !
                  0.8966_WP, 0.8962_WP, 0.8997_WP, 0.9064_WP,    & !
                  0.9132_WP, 0.9192_WP, 0.9289_WP, 0.9359_WP,    & !
                  0.9410_WP, 0.9450_WP, 0.9480_WP, 0.9605_WP,    & !
                  0.9640_WP, 0.9657_WP, 0.9666_WP, 0.9676_WP,    & !
                  0.9683_WP, 0.9688_WP                           / !
!
      Y = X + X                                                     ! Y = q / k_F
!
!  different q-steps
!
      STEP_1 = TENTH                                                ! between 0  and 3
      STEP_2 = HALF                                                 ! between 3  and 5
      STEP_3 = ONE                                                  ! between 5  and 10
      STEP_4 = TEN                                                  ! between 10 and 50
!
!  Generating the q-grid points
!
      DO I = 1,30                                                   !
        QQ(I) = FLOAT(I) * STEP_1                                   ! between 0 and 3
      END DO                                                        !
      DO I = 31,34                                                  !
        QQ(I) = QQ(30) + FLOAT(I) * STEP_2                          ! between 3 and 5
      END DO                                                        !
      DO I = 35,39                                                  !
        QQ(I) = QQ(34) + FLOAT(I) * STEP_3                          ! between 5 and 10
      END DO                                                        !
      DO I = 40,43                                                  !
        QQ(I) = QQ(39) + FLOAT(I) * STEP_4                          ! between 10 and 50
      END DO                                                        !
!
      QQ(44) =  70.0E0_WP                                           !
      QQ(45) = 100.0E0_WP                                           !
      QQ(46) = 150.0E0_WP                                           !
!
!  Locating q/k_F within the UTIC q-grid --> Y = q/k_F near QQ(J)
!
      CALL LOCATE(QQ,N,Y,J)                                         !
!
!  6-point Lagrange interpolation for each value of r_s:
!
!        XL(I) : the 6 values of q/k_F used to find Y
!        Rn(I) : the 6 corresponding values of GQn
!
      IF(J == 1) THEN                                               !
!
!  Y is near 1st point of q-grid
!
        DO I = 1,6                                                  !
          XL(I) = QQ(I)                                             !
          R1(I) = GQ1(I)                                            !
          R2(I) = GQ2(I)                                            !
          R3(I) = GQ3(I)                                            !
          R4(I) = GQ4(I)                                            !
          R5(I) = GQ5(I)                                            !
          R6(I) = GQ6(I)                                            !
        END DO                                                      !
!
      ELSE IF(J == 2) THEN                                          !
!
!  Y is near 2nd point of q-grid
!
        DO I = 1,6                                                  !
          XL(I) = QQ(I)                                             !
          R1(I) = GQ1(I)                                            !
          R2(I) = GQ2(I)                                            !
          R3(I) = GQ3(I)                                            !
          R4(I) = GQ4(I)                                            !
          R5(I) = GQ5(I)                                            !
          R6(I) = GQ6(I)                                            !
        END DO                                                      !
!
      ELSE IF(J == N) THEN                                          !
!
!  Y is near last point of q-grid (point N)
!
        DO I = 6,1,-1                                               !
          XL(I) = QQ(N+I-6)                                         !
          R1(I) = GQ1(N+I-6)                                        !
          R2(I) = GQ2(N+I-6)                                        !
          R3(I) = GQ3(N+I-6)                                        !
          R4(I) = GQ4(N+I-6)                                        !
          R5(I) = GQ5(N+I-6)                                        !
          RR(I) = GQ6(N+I-6)                                        !
        END DO                                                      !
!
      ELSE IF(J == N-1) THEN                                        !
!
!  Y is near last but one point of q-grid (point N-1)
!
        DO I = 6,1,-1                                               !
          XL(I) = QQ(N+I-6)                                         !
          R1(I) = GQ1(N+I-6)                                        !
          R2(I) = GQ2(N+I-6)                                        !
          R3(I) = GQ3(N+I-6)                                        !
          R4(I) = GQ4(N+I-6)                                        !
          R5(I) = GQ5(N+I-6)                                        !
          R6(I) = GQ6(N+I-6)                                        !
        END DO                                                      !
!
      ELSE                                                          !
!
!  General case: 6 points used from J-2 to J+3
!
        DO I = 1,6                                                  !
          XL(I) = QQ(J+I-3)                                         !
          R1(I) = GQ1(J+I-3)                                        !
          R2(I) = GQ2(J+I-3)                                        !
          R3(I) = GQ3(J+I-3)                                        !
          R4(I) = GQ4(J+I-3)                                        !
          R5(I) = GQ5(J+I-3)                                        !
          R6(I) = GQ6(J+I-3)                                        !
        END DO                                                      !
!
      END IF                                                        !
!
!  for each r-grid point K: q-interpolation to obtain AL(K) = GQk(Y)
!
      AL(1) = LAG_6P_INTERP(XL,R1,Y)                                ! GQ(Y) for rs = 1 set
      AL(2) = LAG_6P_INTERP(XL,R2,Y)                                ! GQ(Y) for rs = 2 set
      AL(3) = LAG_6P_INTERP(XL,R3,Y)                                ! GQ(Y) for rs = 3 set
      AL(4) = LAG_6P_INTERP(XL,R4,Y)                                ! GQ(Y) for rs = 4 set
      AL(5) = LAG_6P_INTERP(XL,R5,Y)                                ! GQ(Y) for rs = 5 set
      AL(6) = LAG_6P_INTERP(XL,R6,Y)                                ! GQ(Y) for rs = 6 set
!
!  Locating r_s within the UTIC rs-grid
!
      UTIC_LFC = LAG_6P_INTERP(RR,AL,RS)                            !
!
Contains
!
!-----------------------------------------------------------------------
!
      SUBROUTINE LOCATE(XX,N,X,J)
!
!
!            This subroutine is taken from the book :
!          "Numerical Recipes : The Art of Scientific
!           Computing" par W.H. PRESS, B.P. FLANNERY,
!               S.A. TEUKOLSKY et W.T. VETTERLING 
!               (Cambridge University Press 1992)
!
!    It performs a search in an ordered table using a bisection method.
!    Given a monotonic array XX(1:N) and a value X, it returns J such 
!                  that X is between XX(J) and XX(J+1). 
!
      INTEGER, INTENT(IN)   ::  N
      INTEGER, INTENT(OUT)  ::  J
!
      INTEGER               ::  JL,JM,JU
!
      REAL (WP), INTENT(IN) ::  XX(N),X
!
      JL = 0                                                        !
      JU = N + 1                                                    !
!
  10  IF(JU-JL > 1)THEN                                             !
        JM = (JU+JL) / 2                                            !
        IF((XX(N) > XX(1)) .EQV. (X > XX(JM)))THEN                  !
          JL = JM                                                   !
        ELSE
          JU = JM                                                   !
        END IF                                                      !
      GO TO 10                                                      !
      END IF                                                        !
      J = JL                                                        !
!
      END SUBROUTINE LOCATE
!
!-----------------------------------------------------------------------
!
      END FUNCTION UTIC_LFC
!
!=======================================================================
!
      FUNCTION ICUT_LFC(X,RS,T)
!
!  This function computes Ichimaru-Utsumi 
!      local-field correction
!
!  References: (1) S. Ichimaru and K. Utsumi, Phys. Rev. B 24, 7
!                     385-7388 (1981) 
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature (SI)     
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,FOUR,FIVE,EIGHT, & 
                                   NINE,THIRD,FOURTH
      USE PI_ETC,           ONLY : PI
      USE UTILITIES_1,      ONLY : ALFA
      USE ASYMPT,           ONLY : G0
      USE BESSEL,           ONLY : BESSI1
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X,RS,T,Y,Z,Y_INV,ICUT_LFC
      REAL (WP)             ::  Y2,Y3,Y4
      REAL (WP)             ::  ALPHA,G_0,D_EC_1,D_EC_2
      REAL (WP)             ::  A,B,C
!
      REAL (WP)             ::  SQRT,LOG,ABS
!
      ALPHA=ALFA('3D')                                              !
!
      Y=X+X                                                         ! Y = q / k_F
      Y2=Y*Y                                                        ! 
      Y3=Y2*Y                                                       !
      Y4=Y3*Y                                                       !
!
      Y_INV=ONE/Y                                                   ! 1 / Y
!
!  Calculation of g(0)
!
      Z=FOUR*SQRT(ALPHA*RS/PI)                                      !
      G_0=0.1250E0_WP*(Z/BESSI1(Z))**2                              ! eq.7  ref (1
!
      A=0.029E0_WP                                                  ! eq.9  ref (1)
      B=NINE*G0/16.0E0_WP - THREE*(ONE-G_0)/64.0E0_WP -     &  ! eq.10 ref (1)
                              16.0E0_WP*A/15.0E0_WP                 !
      C=-0.750E0_WP*G0     + NINE*(ONE-G_0)/16.0E0_WP -     &  ! eq.11 ref (1)
                              16.0E0_WP*A/FIVE                      !
!
      ICUT_LFC=A*Y4+B*Y2+C+(A*Y4+(B+EIGHT*A/THREE)*Y2-C)*        &  !
               (Y_INV-FOURTH*Y)*LOG(ABS((TWO+Y)/(TWO-Y)))           !
!
      END FUNCTION ICUT_LFC  
!
!=======================================================================
!
      FUNCTION IWA1_LFC(X,RS)
!
!  This function computes the Iwamoto G_{-1}
!      local-field correction
!
!  References: (1) N. Iwamoto, Phys. Rev. A 30, 3289-3304 (1984)
! 
! 
!  Note: valid for (q/k_F) --> 0
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THIRD,FOURTH
      USE PI_ETC,           ONLY : PI_INV
      USE UTILITIES_1,      ONLY : ALFA
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,RS
      REAL (WP)             ::  IWA1_LFC
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  ALPHA
!
      REAL (WP)             ::  LOG
!
      ALPHA=ALFA('3D')                                              !
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    ! Y^2
!
      IWA1_LFC=( FOURTH + FOURTH * PI_INV *                      &  !
                 (ONE - LOG(TWO)) * ALPHA * RS                   &  ! ref. (1) eq. (3.8a)
               ) * Y2                                               !
!
      END FUNCTION IWA1_LFC  
!
!=======================================================================
!
      FUNCTION IWA2_LFC(X,RS)
!
!  This function computes the Iwamoto G_{3} 
!      local-field correction
!
!  References: (1) N. Iwamoto, Phys. Rev. A 30, 3289-3304 (1984)
! 
! 
!  Note: valid for (q/k_F) --> 0
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,THIRD
      USE PI_ETC,           ONLY : PI_INV
      USE UTILITIES_1,      ONLY : ALFA
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,RS
      REAL (WP)             ::  IWA2_LFC
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  ALPHA
!
      REAL (WP)             ::  LOG
!
      ALPHA = ALFA('3D')                                            !
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    ! 
!
      IWA2_LFC = (THREE + 22.0E0_WP * PI_INV * (ONE - LOG(TWO)) * & ! ref. (1) eq. (4.19a)
                 ALPHA * RS * LOG(RS)) * Y2 / 20.0E0_WP             !
!
      END FUNCTION IWA2_LFC  
!
!=======================================================================
!
      FUNCTION IWA3_LFC(X,RS,T)
!
!  This function computes the temperature-dependent Iwamoto G_{-1}
!      local-field correction
!
!  References: (1) N. Iwamoto, Phys. Rev. A 30, 3289-3304 (1984)
! 
! 
!  Note: valid for (q/k_F) --> 0
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 25 Sep 2020
!
!
      USE REAL_NUMBERS,     ONLY : THREE,FOUR,FOURTH
      USE SQUARE_ROOTS,     ONLY : SQR3
      USE CONSTANTS_P1,     ONLY : H_BAR,BOHR,E,M_E,EPS_0,K_B
      USE FERMI_SI,         ONLY : KF_SI
      USE PI_ETC,           ONLY : PI
      USE EULER_CONST,      ONLY : EUMAS
      USE SCREENING_VEC,    ONLY : DEBYE_VECTOR
      USE PLASMON_SCALE_P,  ONLY : DEGEN
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,RS,T
      REAL (WP)             ::  IWA3_LFC
      REAL (WP)             ::  Y
      REAL (WP)             ::  Q_D,Q_SI,R
      REAL (WP)             ::  GAMMA
!
      REAL (WP)             ::  SQRT,LOG
!
      Y = X + X                                                     ! Y = q / k_F
!
      Q_SI = Y * KF_SI                                              ! q   in SI
      CALL DEBYE_VECTOR('3D',T,RS,Q_D)                              ! q_D in SI
!
      R = Q_SI / Q_D                                                !
!  
      GAMMA = E * E / (K_B * T * RS * BOHR)                         ! ref. (1) eq. (6.6a)
      GAMMA =DEGEN                                                  ! 
!                                                                   ! 
      IWA3_LFC = ( FOURTH * SQR3 * GAMMA**1.5E0_WP +              & !
                   GAMMA**THREE *  (                              & !
                   0.75E0_WP * LOG(THREE * GAMMA) + EUMAS -       & !  eq. (6.17a)
                   13.0E0_WP / 24.0E0_WP )                        & !
                 ) * R * R                                          !
!
      END FUNCTION IWA3_LFC  
!
!=======================================================================
!
      FUNCTION IWA4_LFC(X,RS)
!
!  This function computes the Iwamoto G_{3} 
!      local-field correction
!
!  References: (1) N. Iwamoto, Phys. Rev. A 30, 3289-3304 (1984)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!  Note: The formula used is based on eq. (4.13) and reads
!
!         G_{3} = I(q) + 4 * om_q / h_bar om_p^2) * (E_C + r_s * d Ec / d rs)
!                        \                      /
!                         ----------------------
!                                 \    /
!                                  COEF
!
!  Warning: Ec is calculated in Ryd --> has to be converted into SI
!
!           COnversion coefficient: RY2SI (or 1/2 HARTREE)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 12 Nov 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO,FOUR,HALF
      USE FERMI_SI,         ONLY : KF_SI
      USE CONSTANTS_P1,     ONLY : H_BAR,M_E
      USE ENE_CHANGE,       ONLY : RY2SI
      USE PLASMON_ENE_SI
      USE ENERGIES,         ONLY : EC_TYPE
      USE CORRELATION_ENERGIES
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,RS
      REAL (WP)             ::  IWA4_LFC
!
      REAL (WP)             ::  Y
      REAL (WP)             ::  Q_SI,COEF
      REAL (WP)             ::  OM_P,OM_Q
      REAL (WP)             ::  I_Q
      REAL (WP)             ::  E_C,D_EC_1,D_EC_2
!
      Y = X + X                                                     ! Y = q / k_F
!
      Q_SI = Y * KF_SI                                              ! q in SI
!
      OM_P = ENE_P_SI / H_BAR                                       ! omega_p
      OM_Q = HALF * H_BAR * Q_SI * Q_SI / M_E                       ! omega_q
!
      COEF = FOUR * OM_Q / (H_BAR * OM_P * OM_P)                    !
!
!  Calculation of I(q)
!
      I_Q =  IQ(X,RS)                                               !
!
!  Calculation of Ec and d Ec / d rs
!
      E_C = EC_3D(EC_TYPE,1,RS,ZERO)                                !
      CALL DERIVE_EC_3D(EC_TYPE,1,5,RS,ZERO,D_EC_1,D_EC_2)          !
!
      IWA4_LFC = I_Q + COEF * (E_C + RS * D_EC_1) * RY2SI           ! ref. (1) eq. (4.13)
!                                                                   ! and (4.16)
CONTAINS
!
!-----------------------------------------------------------------------
!
      FUNCTION IQ(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 
      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 = I1 * L1 + I2 * L2 + I5 * L5                              !
!
      END FUNCTION IQ
!
!-----------------------------------------------------------------------
!
      END FUNCTION IWA4_LFC
!
!=======================================================================
!
      FUNCTION KUGL_LFC(X,RS,T)
!
!  This function computes the Kugler local-field correction,
!
!
!  Reference: (1) A. 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
!
!       so that
!
!       chi_0 = - (q_TF / q)^2 * LINDHARD_FUNCTION / V_C
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  19 Sep 2020
!
      USE REAL_NUMBERS,             ONLY : ZERO,ONE,TWO,THREE,FOUR,FIVE,SIX, &
                                           EIGHT,HALF,THIRD,FOURTH
      USE PI_ETC,                   ONLY : PI2
      USE CONSTANTS_P1,             ONLY : M_E,H_BAR
      USE FERMI_SI,                 ONLY : KF_SI
      USE LINDHARD_FUNCTION,        ONLY : LINDHARD_S
      USE COULOMB_K,                ONLY : COULOMB_FF
      USE SCREENING_VEC,            ONLY : THOMAS_FERMI_VECTOR
!
      USE UNITS,                    ONLY : UNIT
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,RS,T
      REAL (WP)             ::  KUGL_LFC
      REAL (WP)             ::  Y,Y2,Y3,Y4
      REAL (WP)             ::  EP2,EM2,OM2
      REAL (WP)             ::  Q_SI,K_TF,VC
      REAL (WP)             ::  CHI_0
      REAL (WP)             ::  LR,LI
      REAL (WP)             ::  KOEF
      REAL (WP)             ::  PM1
      REAL (WP)             ::  INTGR_1,INTGR_2
      REAL (WP)             ::  INTGR_3,INTGR_4
      REAL (WP)             ::  INTGR_5,INTGR_6
!
      REAL (WP)             ::  LOG,ABS
!
      Y   = X + X                                                   ! Y = q / k_F = eta
      Y2  = Y * Y                                                   ! Y^2         = eta^2
      Y3  = Y2 * Y                                                  ! Y^3         = eta^3
      Y4  = Y2 * Y2                                                 ! Y^4         = eta^4
!
      EP2 = Y + TWO                                                 !
      EM2 = Y - TWO                                                 !
      OM2 = ABS(ONE - Y)                                            !
!
      Q_SI = TWO * X* KF_SI                                         ! q in SI
!
      CALL COULOMB_FF('3D',UNIT,Q_SI,ZERO,VC)                       ! Coulomb potential
      CALL THOMAS_FERMI_VECTOR('3D',K_TF)                           ! k_TF
      CALL LINDHARD_S(X,'3D',LR,LI)                                 !
!
!  Computing chi_0
!
      CHI_0 = - (KF_SI / Q_SI)**2 * LR / VC                          !
!
      KOEF = M_E * KF_SI / (16.0E0_WP * PI2 * H_BAR * H_BAR)        !
!
      IF(X < ONE) THEN                                              !
        PM1 = - 24.0E0_WP / FIVE + 23.0E0_WP * Y2 / 30.0E0_WP +   & !
              EIGHT * (ONE - HALF * Y) * LOG(ABS(ONE - TWO / Y))  & !
              + (- EIGHT + TWO * Y - TWO * Y2 + THIRD * Y4) *     & !
              LOG(ABS(ONE - FOUR / Y2)) +                         & !
              ( FOUR * LOG(TWO) + FOUR * LOG(Y) +                 & !
                LOG(ABS(ONE - FOUR / Y2)) ) * Y * LOG(EP2 / EM2)  & !
              + ( 12.0E0_WP / (FIVE * Y) + FOUR - SIX * Y +       & !
                  0.75E0_WP * Y3 ) * LOG(EP2 / EM2) +             & !
              ( 12.0E0_WP / (FIVE * Y) + EIGHT / FIVE +           & !
                41.0E0_WP  * Y  / 15.0E0_WP           -           & !
                11.0E0_WP * Y2 / 15.0E0_WP            -           & !  
                FOUR * Y3 / 15.0E0_WP ) * (ONE + Y) *             & ! ref. (1) eq. (D11a)
              LOG(ABS(ONE + TWO / Y))                 -           & !
              ( 12.0E0_WP / (FIVE * Y) - EIGHT / FIVE +           & !
                41.0E0_WP  * Y  / 15.0E0_WP           +           & !
                11.0E0_WP * Y2 / 15.0E0_WP            -           & !   
                FOUR * Y3 / 15.0E0_WP ) * ABS(ONE - Y) *          & !
              LOG(ABS((ONE + OM2) / (ONE - OM2)))     +           & !
              Y * ( LOG(ABS((ONE + OM2) / (ONE - OM2))) *         & !
                    LOG(ABS((ONE + OM2) / (ONE - OM2))) -         & !
                    LOG(ABS(ONE + TWO / Y))             *         & !
                    LOG(ABS(ONE + TWO / Y)) )           -         & !
              TWO * Y * (INTGR_1 + INTGR_2)             +         & !
              1.5E0_WP * (ONE + HALF * Y2 - Y4 / 48.0E0_WP) *     & !
              INTGR_3 - INTGR_4                                     !
      ELSE                                                          !
        PM1 = - 24.0E0_WP / FIVE + 23.0E0_WP * Y2 / 30.0E0_WP +   & !
              Y4 * LOG(ABS(ONE - FOUR / Y2))            +         & !
              (- FOURTH * Y2 + THIRD + 24.0E0_WP / (FIVE * Y2))*  & !
              Y *  LOG(EP2 / EM2)                       +         & ! ref. (1) eq. (D11b)
              FOUR * Y * (LOG(TWO) + LOG(Y)) * LOG(EP2 / EM2) -   & !
              TWO * Y * INTGR_5                               +   & !
              1.5E0_WP * (ONE + HALF * Y2 - Y4 / 48.0E0_WP) *     & !
              INTGR_6                                               !
        
      END IF                                                        !
!
      KUGL_LFC = PM1 / CHI_0                                        ! ref. (1) eq. (D.9)
!
      END FUNCTION KUGL_LFC
!
!=======================================================================
!
      FUNCTION MCSC_LFC(X,RS,T,EC_TYPE)
!
!  This function computes the Corradini-Del Sole-Onida-Palummo 
!      local-field correction
!
!  References: (1) S. Moroni, D. M. Ceperley and G. Senatore, Phys. Rev. Lett. 75, 689-692 (1995)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature (SI)     
!       * EC_TYPE  : type of correlation energy functional
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 16 Sep 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,FOUR,FIVE,EIGHT,NINE, & 
                                   HALF,THIRD,FOURTH
      USE FERMI_AU,         ONLY : KF_AU
      USE PI_ETC,           ONLY : PI,PI2
      USE CORRELATION_ENERGIES
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 6)   ::  EC_TYPE
!
      REAL (WP), INTENT(IN) ::  X,RS,T
      REAL (WP)             ::  MCSC_LFC
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  U,U3
      REAL (WP)             ::  A,B,C
      REAL (WP)             ::  COEF
      REAL (WP)             ::  RS2,RS3
      REAL (WP)             ::  A1,A2,B1,B2
      REAL (WP)             ::  EC,D_EC_1,D_EC_2
      REAL (WP)             ::  N,NN
!
      REAL (WP)             ::  SQRT,FLOAT
!
      COEF = (FOUR * PI2 / NINE)**THIRD / 24.0E0_WP                 ! 
!
      Y  = X + X                                                    ! Y = q / k_F = Q in ref. 1
      Y2 = Y*Y                                                      ! Q^2             in ref. 1
      U  = SQRT(RS)                                                 ! x               in ref. 1
      U3 = U * U * U                                                ! x^3             in ref. 1
!
      RS2 = RS  * RS                                                !
      RS3 = RS2 * RS                                                !
!
      A1 = 2.15E0_WP                                                !
      A2 = 0.435E0_WP                                               ! for MCSC
      B1 = 1.57E0_WP                                                ! coefficients
      B2 = 0.409E0_WP                                               !
!
!  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)             ! 
!
      A  = FOURTH - COEF * (RS3 * D_EC_2 - TWO * RS2 * D_EC_1)      ! 
      B  = (ONE + A1 * U + A2 * U3) / (THREE + B1 * U + B2 * U3)    ! 
      C  = - HALF * PI* (EC + RS * D_EC_1) / KF_AU                  ! 
!
!  value of the exponent n                                          !
!
      IF(RS <= FIVE) THEN                                           !
        N = EIGHT                                                   !
      ELSE                                                          !
        N = FOUR                                                    !
      END IF                                                        !
      NN = ONE / N                                                  !
!
      MCSC_LFC = (((A - C)**(-N) + (Y2 / B)**N)**(- NN) + C) * Y2   ! ref (1) eq. (7)
!
      END  FUNCTION MCSC_LFC 
!
!=======================================================================
!
      FUNCTION NAGY_LFC(X,RS)
!
!  This function computes the NAGY 
!      local-field correction
!
!  References: (1) I. Nagy, J. Phys. C: Solid State Phys. 19, 
!                     L481-L484 (1986)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 11 Nov 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,HALF,THIRD,FOURTH
      USE FERMI_AU,         ONLY : KF_AU
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,RS
      REAL (WP)             ::  NAGY_LFC
      REAL (WP)             ::  Y,RS3
      REAL (WP)             ::  NUM,DEN,G0N
      REAL (WP)             ::  AM,A,B,AN,BN,R,CM,BM
      REAL (WP)             ::  Q_AU
!
      REAL (WP)             ::  EXP,SQRT,ATAN
!
      Y = X + X                                                     ! Y = q / k_F
!
      RS3 = RS * RS * RS                                            !
!
      Q_AU = Y * KF_AU                                              ! q in atomic units
! 
      NUM = ONE + TWO * EXP(- 0.6E0_WP * RS)                        ! 
      DEN = NUM + TWO * RS                                          !
      G0N = HALF * NUM / DEN                                        ! ref. (1) eq. (7)
!
      AM  = G0N - ONE                                               ! a
      A   = 24.0E0_WP * AM / RS3                                    ! A
      B   = 18.0E0_WP * G0N / RS3                                   ! B
!
      AN  = FOURTH * A                                              ! A/4
      BN  = THIRD * B                                               ! B/3
      R   = (AN**2 + SQRT(AN**4 - BN**3))**THIRD +                & !
            (AN**2 - SQRT(AN**4 - BN**3))**THIRD                    ! R
!
      CM  = SQRT(HALF * R) *                                      & !
            (ONE + SQRT(- ONE - TWO * A / ((TWO * R)**1.5E0_WP)))   ! c
      BM  = G0N * (ONE + CM) - CM                                   ! b
!
      NAGY_LFC = ONE - G0N + CM * BM / (CM * CM + Q_AU * Q_AU) -  & !  
                       G0N * ATAN(Q_AU / CM) / Q_AU                 !
!
      END FUNCTION NAGY_LFC  
!
!=======================================================================
!
      FUNCTION NEV1_LFC(X,RS)
!
!  This function computes the Nevanlinna two-moment 
!      local-field correction
!
!  References: (1) D. Yu. Dubovtsev, PhD Thesis, 
!                     Universitat Politècnica de València (2019)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 27 Nov 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE
      USE CONSTANTS_P1,     ONLY : H_BAR
      USE LOSS_MOMENTS,     ONLY : LOSS_MOMENTS_AN
      USE PLASMON_ENE_SI
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,RS
!
      REAL (WP)             ::  NEV1_LFC
      REAL (WP)             ::  C0,C2,C4
      REAL (WP)             ::  OM12
      REAL (WP)             ::  EPSR
      REAL (WP)             ::  OMP,OMP2
!
!  Computing the moments of the loss function
!
      CALL LOSS_MOMENTS_AN(X,C0,C2,C4)
!
!  Computing eps_{RPA}(q) from the moment C0
!
      EPSR = ONE / (ONE - C0)                                       !
!
      OM12 = C2 / C0                                                !
      OMP  = ENE_P_SI / H_BAR                                       ! omega_p
      OMP2 = OMP * OMP
!
      NEV1_LFC = ONE + ONE / (ONE - EPSR) - OM12 / OMP2             ! ref. (1) eq. (4.15)
!
      END FUNCTION NEV1_LFC  
!
!=======================================================================
!
      FUNCTION PVHF_LFC(X)
!
!  This function computes Pathak-Vashishta Hartree-Fock
!      local-field correction
!
!  References: (1) A. Holas, P.K. Aravind and K.S. Singwi, 
!                    Phys. Rev. B 20, 4912 (1979) 
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,FOUR,FIVE,SIX, & 
                                   HALF,THIRD,SMALL
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  PVHF_LFC
      REAL (WP)             ::  Y,Y2,Y4,Y6,Y_INV,Y2_INV
      REAL (WP)             ::  P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11
      REAL (WP)             ::  F4,F5
      REAL (WP)             ::  LN1,LN2
      REAL (WP)             ::  G2,DIFF
!
      REAL (WP)             ::  LOG,ABS
!
      Y      = X + X                                                ! Y = q / k_F
      Y2     = Y * Y                                                ! Y^2 
      Y4     = Y2 * Y2                                              ! Y^4 
      Y6     = Y4 * Y2                                              ! Y^6 
      Y_INV  = ONE / Y                                              ! 1 / Y
      Y2_INV = ONE / Y2                                             ! 1 / Y^2
!
      DIFF = ABS(Y - TWO)                                           !
!
      P1  = - THREE / 16.0E0_WP                                     !
      P2  = - 32.0E0_WP / 63.0E0_WP                                 !
      P3  =   24.0E0_WP / 35.0E0_WP                                 !
      P4  = - TWO / FIVE                                            !
      P5  =   ONE / SIX                                             ! Pathak and
      P6  =   TWO / 35.0E0_WP                                       ! Vashishta  
      P7  = - ONE / 630.0E0_WP                                      ! coefficients 
      P8  = - TWO / 21.0E0_WP                                       !  
      P9  =   38.0E0_WP / 315.0E0_WP                                !
      P10 =   71.0E0_WP / 840.0E0_WP                                !
      P11 =   ONE / 840.0E0_WP                                      !
!
      F4 = P2 + P3 * Y2 + P4 * Y4 + P5 * Y6                         ! Pathak and
      F5 = Y * Y6 *(P6 + P7 * Y2)                                   ! Vashishta factors
!                                                                   !
!  Pathological case: value of G for x=2 
!                                                                   !
      G2 = (143.0E0_WP * THIRD - 32.0E0_WP * LOG(TWO) )/ 105.0E0_WP !
!
      IF(DIFF >= SMALL) THEN                                        !
        LN1 = LOG(ABS((Y + TWO)/(Y - TWO)))                         !
        LN2 = LOG(ABS(ONE - FOUR * Y2_INV))                         !
!
        PVHF_LFC = P1 * Y_INV *Y2_INV * (LN1 * F4 + LN2 * F5)+    & !
                   P8 * Y2_INV + P9 + P10 * Y2 + P11 * Y4           !
      ELSE                                                          !
        PVHF_LFC = G2                                               !
      END IF                                                        !
!
      END FUNCTION PVHF_LFC  
!
!=======================================================================
!
      FUNCTION PGGA_LFC(X)
!
!  This function computes the Petersilka-Gossmann-Gross local-field correction
!
!  References: (1) K. Tatarczyk, A. Schindlmayr and M. Scheffler,
!                     Phys. Rev. B 63, 235106 (2001)
!
!  Note: we have G(q) = - f_{xc} / Vc(q)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  4 Sep 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,TEN
      USE PI_ETC,           ONLY : PI
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X,PGGA_LFC
      REAL (WP)             ::  COEF,Q,Q2,Q4
!
      REAL (WP)             ::  LOG,ABS
!
      Q    = X                                                      !  q / (2 * k_F) 
      Q2   = Q  * Q                                                 !
      Q4   = Q2 * Q2                                                !
!                                                                         3 pi         1
      COEF = THREE * Q2 / TEN                                       !  ---------- * -------
!                                                                       10 k_F^2     Vc(q)
!
!  Computation of the local-field formula  
!
      IF(Q == ONE) THEN                                             !
        PGGA_LFC = COEF * ( 13.0E0_WP - 16.0E0_WP * LOG(TWO) )      ! pathological case
      ELSE                                                          !
        PGGA_LFC = COEF * (                                       & !
                   11.0E0_WP + TWO * Q2 +                         & !
                   (TWO / Q - TEN * Q) *                          & !  ref. (1) eq. (12)
                   LOG(ABS((ONE + Q) / (ONE - Q)))   +            & !
                   (TWO * Q4 - TEN * Q2)*LOG(ABS(ONE - ONE / Q2)) & !
                         )                                          !
      END IF                                                        !
!
      END FUNCTION PGGA_LFC  
!
!=======================================================================
!
      FUNCTION SHAW_LFC(X)
!
!  This function computes the Shaw 
!      local-field correction
!
!  References: (1) R. W. Shaw, J. Phys. C: Solid State Phys. 3, 
!                     1140-1158 (1970)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,HALF
      USE UTILITIES_1,      ONLY : ALFA
      USE EXT_FUNCTIONS,    ONLY : DAWSON                           ! Dawson function D(x)
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  SHAW_LFC
      REAL (WP)             ::  Y
      REAL (WP)             ::  ALPHA,U
!
      ALPHA = ALFA('3D')                                            ! 
!
      Y = X + X                                                     ! Y = q / k_F
!
      U = HALF * Y / ALPHA                                          ! U = q / (2 k_F * ALPHA)
!
      SHAW_LFC = ONE - DAWSON(U) / U                                !
!
      END FUNCTION SHAW_LFC  
!
!=======================================================================
!
      FUNCTION STLS_LFC(X)
!
!  This function computes the Singwi-Tosi-Land-Sjölander
!      local-field correction
!
!  References: (1) K.S. Singwi, M.P. Tosi, R.H. Land and A. Sjölander,
!                    Phys. Rev. 176, 589 (1968)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,FOUR,SIX,EIGHT,NINE, & 
                                   HALF,SMALL
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  STLS_LFC
      REAL (WP)             ::  Y,Y2,Y_INV,Y2_INV
      REAL (WP)             ::  S1,S2,S3,S4,S5,S6
      REAL (WP)             ::  F1,F2,F3
      REAL (WP)             ::  LN1,LN2
      REAL (WP)             ::  G1,DIFF
!
      REAL (WP)             ::  ABS,LOG
!
      Y      = X + X                                                ! Y = q / k_F
      Y2     = Y * Y                                                ! Y^2 
      Y_INV  = ONE / Y                                              ! 1 / Y
      Y2_INV = ONE / Y2                                             ! 1 / Y^2
!
      DIFF = ABS(Y - TWO)                                           !
!
      S1 = NINE / 32.0E0_WP                                         !
      S2 = TWO / 105.0E0_WP                                         !
      S3 = EIGHT / 35.0E0_WP                                        !     STLS
      S4 = FOUR / 15.0E0_WP                                         ! coefficients 
      S5 = ONE / 210.0E0_WP                                         !
      S6 = HALF * S4                                                !
!
      F1 = 24.0E0_WP * Y2_INV + 44.0E0_WP + Y2                      ! \  
      F2 = S3 * Y2_INV - S4 + (Y2 / SIX)                            !  > STLS factors 
      F3 = S5 * Y2 - S6                                             ! /
!
!  Pathological case: value of G for x = 2  
!                           
      G1 = NINE * (4.50E0_WP - FOUR * LOG(TWO)) / 35.0E0_WP         ! 
!
      IF(DIFF >= SMALL) THEN                                        !
        LN1 = LOG(ABS((Y + TWO)/(Y - TWO)))                         !
        LN2 = LOG(ABS(ONE - FOUR * Y2_INV))                         !
!
        STLS_LFC = S1 * Y2 * ( S2 * F1 -                          & !
                               TWO * Y_INV * F2 * LN1 +           & !
                               Y2 * F3 * LN2                      & !
                             )                                      ! 
      ELSE                                                          !
        STLS_LFC = G1                                               ! 
      END IF                                                        !
!
      END FUNCTION STLS_LFC  
!
!=======================================================================
!
      FUNCTION TRMA_LFC(X)
!
!  This function computes the Tripathy-Mandal local-field correction
!
!
!  References: (1) D. N. Tripathy and S. S. Mandal, Phys. Rev. B 16, 
!                     231-243 (1977)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 17 Sep 2020
!
!
      USE REAL_NUMBERS,         ONLY : ZERO,ONE,TWO,FOUR,HALF,FOURTH, & 
                                       SMALL,TTINY
      USE DIMENSION_CODE,       ONLY : NZ_MAX
      USE INTEGRATION,          ONLY : INTEGR_L
!
      IMPLICIT NONE
!
      INTEGER               ::  IQ1,IQ2,IX2
      INTEGER               ::  NK_STEP,NX_STEP
      INTEGER               ::  ID
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  TRMA_LFC
      REAL (WP)             ::  K,K2
      REAL (WP)             ::  G1,G2,G12
      REAL (WP)             ::  A1,B1,C1
      REAL (WP)             ::  X_STEP
      REAL (WP)             ::  Q_INI,Q_MAX,Q_STEP
      REAL (WP)             ::  R1(NZ_MAX),R2(NZ_MAX),R3(NZ_MAX)
      REAL (WP)             ::  Q1,Q2,X2
      REAL (WP)             ::  Q12,Q22,CC1,CC2
      REAL (WP)             ::  NUM1,NUM2,NUM3,NUM4
      REAL (WP)             ::  DEN1,DEN2,DEN3,DEN4
      REAL (WP)             ::  I,A,B
      REAL (WP)             ::  F
      REAL (WP)             ::  SMALL_Q,SMALL_X
!
!  Number of steps for K-integration
!
      NK_STEP = 100                                                 !
!
!  Number of steps for X-integration
!
      NX_STEP = 100                                                 !
!
      K  = X + X                                                    ! K = q / k_F
      K2 = K * K                                                    !
! 
      IF(K <= TWO) THEN                                             ! 
        Q_INI  = ONE - HALF * K                                     ! initial,  
        Q_MAX  = ONE + HALF * K                                     ! final values
      ELSE                                                          ! for q-integrations
        Q_INI = HALF * K - ONE                                      ! ( see eq. (4.32) and 
        Q_MAX = HALF * K + ONE                                      !   (4.33) )
      ENDIF                                                         !
!
       Q_STEP  = (Q_MAX - Q_INI) / FLOAT(NK_STEP - 1)               ! q-step 
       SMALL_Q = HALF * Q_STEP                                      ! 
!
!  Starting loop over q2
!
      DO IQ2 = 1,NK_STEP                                            !
        Q2      = Q_INI + FLOAT(IQ2 - 1) * Q_STEP                   ! q2 
        Q22     = Q2 * Q2                                           ! q2^2
        G2      = (Q22 + FOURTH * K2 - ONE) / (Q2 * K)              ! initial value for x-integration (4.31)
!
        IF(ABS(G2 - ONE) > SMALL) GO TO 10                          ! integral = 0 when G2 = 1
!
        X_STEP  = (ONE - G2) / FLOAT(NX_STEP - 1)                   ! x-step 
        SMALL_X = HALF * X_STEP                                     ! 
!
!  Starting loop over q1
!
        DO IQ1 = 1,NK_STEP                                          !
          Q1      = Q_INI + FLOAT(IQ1 - 1) * Q_STEP                 ! q1 
          Q12     = Q1 * Q1                                         ! q1^2
          G1      = (Q12 + FOURTH * K2 - ONE) / (Q1 * K)            ! ref. (1) eq. (4.28)
          G12     = G1 * G1                                         ! 
          A1      = FOUR * Q12 * Q22                                ! a1 coefficient (4.27)
!
!  Starting loop over x2
!
          DO IX2 = 1,NX_STEP                                        !
            X2      = G2 + FLOAT(IX2 - 1) * X_STEP                  ! x2 array
            B1      = - FOUR * Q1 * Q2 * X2 * (Q12 + Q22)           ! b1 coefficient (4.27)
            C1      = A1 * X2 * X2 + (Q12 - Q22) * (Q12 - Q22)      ! c1 coefficient (4.27)
!
!  Computing R(q2,q1,x2)  
!
            IF(ABS(Q2 - Q1) > SMALL_Q) THEN                         !
!
              IF(ABS(X2 - ONE) > SMALL_X) THEN                      !  case q1 /= q2, x2 /= 1
!
                CC1 = Q1  * Q2 / (X2 * SQRT(C1))                    ! 
                CC2 = Q12 / (X2 * X2 * SQRT(A1))                    ! 
!
                NUM1 = TWO * SQRT( C1 * (A1*G12 + B1*G1 + C1) ) + & ! 
                       TWO * C1 + B1 * G1                           ! 
                DEN1 = TWO * SQRT( C1 * (A1 + B1 + C1) ) +        & !
                       TWO * C1 + B1                                !
                NUM2 = TWO * SQRT( C1 * (A1*G12 - B1*G1 + C1) ) + & ! 
                       TWO * C1 - B1 * G1                           ! 
                DEN2 = TWO * SQRT( C1 * (A1 - B1 + C1) ) +        & !
                       TWO * C1 - B1                                !
                NUM3 = TWO * SQRT( A1 * (A1*G12 + B1*G1 + C1) ) + & ! 
                       TWO * A1 * G1 + B1                           !
                DEN3 = TWO * SQRT( A1 * (A1 + B1 + C1) ) +        & !
                       TWO * A1 + B1                                !
                NUM4 = TWO * SQRT( A1 * (A1*G12 - B1*G1 + C1) ) + & ! 
                       TWO * A1 * G1 - B1                           !
                DEN4 = TWO * SQRT( A1 * (A1 - B1 + C1) ) +        & !
                       TWO * A1 - B1                                !
!
!  Pathological cases
!
                IF(NUM1 == ZERO) NUM1 = TTINY                       !
                IF(DEN1 == ZERO) DEN1 = TWO * TTINY                 !
                IF(NUM2 == ZERO) NUM2 = TTINY                       !
                IF(DEN2 == ZERO) DEN2 = TWO * TTINY                 !
                IF(NUM3 == ZERO) NUM3 = TTINY                       !
                IF(DEN3 == ZERO) DEN3 = TWO * TTINY                 !
                IF(NUM4 == ZERO) NUM4 = TTINY                       !
                IF(DEN4 == ZERO) DEN4 = TWO * TTINY                 !
                R1(IX2) = CC1 * ( LOG(ABS(NUM1 / DEN1)) +         & !  
                                  LOG(ABS(NUM2 / DEN2)) -         & ! 
                                  TWO * LOG(DABS(G1))             & !
                                )                       +         & ! ref. (1) eq. (4.34a)
                          CC2 * ( LOG(ABS(NUM3 / DEN3)) -         & ! 
                                  LOG(ABS(NUM4 / DEN4))           & !
                                )                                   ! 
!
              ELSE                                                  !  case q1 /= q2, x2 = 1
!
                CC1 = Q1 * Q2 / SQRT(C1)                            ! 
                CC2 = Q12 /  SQRT(A1)                               ! 
!
                NUM1 = B1 * G1 + TWO * C1                           !
                DEN1 = B1 + TWO * C1                                !
                NUM2 = B1 * G1 - TWO * C1                           !
                DEN2 = B1 - TWO * C1                                !
                NUM3 = TWO * A1 * G1 + B1                           !
                DEN3 = TWO * A1 + B1                                !
                NUM4 = TWO * A1 * G1 - B1                           !
                DEN4 = TWO * A1 - B1                                !
!
!  Pathological cases
!
                IF(NUM1 == ZERO) NUM1 = TTINY                       !
                IF(DEN1 == ZERO) DEN1 = TWO * TTINY                 !
                IF(NUM2 == ZERO) NUM2 = TTINY                       !
                IF(DEN2 == ZERO) DEN2 = TWO * TTINY                 !
                IF(NUM3 == ZERO) NUM3 = TTINY                       !
                IF(DEN3 == ZERO) DEN3 = TWO * TTINY                 !
                IF(NUM4 == ZERO) NUM4 = TTINY                       !
                IF(DEN4 == ZERO) DEN4 = TWO * TTINY                 !
!
                R1(IX2) = CC1 * ( LOG(ABS(NUM1 / DEN1)) +         & !  
                                  LOG(ABS(NUM2 / DEN2)) -         & ! 
                                  TWO * LOG(ABS(G1))              & !
                                )                       -         & ! ref. (1) eq. (4.34b)
                          CC2 * ( LOG(ABS(NUM3 / DEN3)) +         & ! 
                                  LOG(ABS(NUM4 / DEN4))           & !
                                )                                   ! 
!
              END IF                                                !
!
            ELSE                                                    ! case q1 = q2
!
            IF(ABS(X2 - ONE) > SMALL_X) THEN                        ! case x2 /= 1
!
                R1(IX2) = LOG(ABS(X2/G1)) / (X2 * X2)               ! ref. (1) eq. (4.34c)
!
              ELSE                                                  ! case x2 = 1
!
                R1(IX2) = -LOG(ABS(G1))                             ! ref. (1) eq. (4.34d)
!
              END IF                                                !
!
            END IF                                                  !
!
          END DO                                                    ! end of loop on X2
!
!  Performing the integration over X2
!
          A       = G2                                              ! integration 
          B       = ONE                                             !   bounds
          ID      = 1                                               !
!
          CALL INTEGR_L(R1,X_STEP,NZ_MAX,NX_STEP,I,ID)              !
!
          R2(IQ1) = I                                               ! new function
!                                                                   ! to integrate
        END DO                                                      ! end of loop on Q1
!                                                                   !
!  Performing the integration over Q1
!
        A       = Q_INI                                             ! integration 
        B       = Q_INI + ONE                                       !   bounds
        ID = 1                                                      !
!
        CALL INTEGR_L(R2,Q_STEP,NZ_MAX,NK_STEP,I,ID)                !
!                                                                   !
        R3(IQ2) = I                                                 ! new function
!                                                                   ! to integrate
        GO TO 20                                                    !
!
  10    R3(IQ2) =  ZERO                                             !
!  
  20    CONTINUE                                                    !
!  

      END DO                                                        ! end of loop on Q2
!
!  Performing the integration over Q2
!
      A       = Q_INI                                               ! integration 
      B       = Q_INI + ONE                                         !   bounds
      ID = 1                                                        !
!
      CALL INTEGR_L(R3,Q_STEP,NZ_MAX,NK_STEP,I,ID)                  !
!
!  Computing the F(k) function
!
      IF(K < SMALL) THEN                                            ! k = 0
        F = TWO                                                     !
      ELSEIF(ABS(K - TWO) < SMALL) THEN                             ! k = 2
        F = ONE                                                     !
      ELSE                                                          !
        F = ONE + (ONE - FOURTH * K2) *                           & ! ref. (1) eq. (4.23)
                  LOG(ABS((K + TWO) / (K - TWO))) / K               !
      END IF                                                        !
!
      TRMA_LFC = I / (F * F)                                        ! ref. (1) eq. (4.25)
!
      END FUNCTION TRMA_LFC  
!
!=======================================================================
!
      FUNCTION TKAC_LFC(X,RS,T)
!
!  This function computes the temperature-dependent Tkachenko 
!     local-field correction
!
!  References: (1)  I. M. Tkachenko, Europhys. Lett. 9, 351-354 (1989)
! 
!
!  Note: Valid in the domain 0 <= Gamma <= 1
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F) 
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 11 Nov 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,THREE,FOUR,NINE,HALF,THIRD,FOURTH
      USE CONSTANTS_P1,     ONLY : H_BAR,M_E,K_B
      USE FERMI_SI,         ONLY : EF_SI,KF_SI
      USE PLASMON_ENE_SI
      USE PLASMON_SCALE_P,  ONLY : DEGEN
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,RS,T
      REAL (WP)             ::  TKAC_LFC
      REAL (WP)             ::  Y
      REAL (WP)             ::  GAMMA,Q_SI
      REAL (WP)             ::  C1,C2,C3,C4
      REAL (WP)             ::  EQ,KBT
      REAL (WP)             ::  A12,G14,AAA,R
!
      Y = X + X                                                     ! Y = q / k_F
!
      Q_SI = Y * KF_SI                                              ! q   in SI
!                                                                   ! plasma
      EQ  = HALF * H_BAR * H_BAR * Q_SI * Q_SI / M_E                ! E_q
      KBT = K_B * T                                                 !
!                                                                   ! plasma
      GAMMA = DEGEN                                                 ! non ideality
!                                                                   ! parameter
!
!  Tkachenko coefficients
!                                                                   ! plasma
      C1 = - 0.89752E0_WP                                           !
      C2 =   0.94544E0_WP                                           !
      C3 =   0.17954E0_WP                                           !
      C4 = - 0.80049E0_WP                                           !
!                                                                   !   
      A12 = HALF * ENE_P_SI * ENE_P_SI / (EQ * KBT)                 !
      G14 = GAMMA**FOURTH                                           !
      AAA = 13.0E0_WP * C2 * G14 + 11.0E0_WP * C3 / G14             !
!                                                                   !   
      R = HALF / ( - FOUR * C1 * GAMMA / NINE - AAA / 36.0E0_WP - & ! 
                     THIRD * (C4 + THREE)                         & !
                 )                                                  !
!  
      TKAC_LFC = HALF * (ONE + R * A12)                             ! eq. (10)
!
      END FUNCTION TKAC_LFC  
!
!=======================================================================
!
      FUNCTION VASI_LFC(X,RS)
!
!  This function computes the Vashishta-Singwi 
!      local-field correction
!
!  References: (1) P. Vashishta and K. S. Singwi, Phys. Rev. B 6, 875-887 (1972)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,SMALL
      USE INTERPOLATION,    ONLY : INTERP_NR,SPLINE,SPLINT
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X,RS
      REAL (WP)             ::  VASI_LFC
      REAL (WP)             ::  Y,Y2
      REAL (WP)             ::  A,B
!
      REAL (WP)             ::  XVS(6),AVS(6),BVS(6)
!
      REAL (WP)             ::  ABS,EXP
!
      INTEGER               ::  INTERP
!
      INTEGER               ::  INT
!
      DATA AVS    /0.70853E0_WP, 0.85509E0_WP, 0.97805E0_WP,     &  ! Vashishta-Singwi
                   1.08482E0_WP, 1.17987E0_WP, 1.26569E0_WP/        ! coefficients A and B
      DATA BVS    /0.36940E0_WP, 0.33117E0_WP, 0.30440E0_WP,     &  ! (see table V)
                   0.28430E0_WP, 0.26850E0_WP, 0.25561E0_WP/        !
      DATA XVS    /1.00000E0_WP, 2.00000E0_WP, 3.00000E0_WP,     &  !
                   4.00000E0_WP, 5.00000E0_WP, 6.00000E0_WP/        !
!
      Y  = X + X                                                    ! Y = q / k_F
      Y2 = Y * Y                                                    ! 
!
!  Checking if interpolation of AVS and BVS is necessary for 'VASI'
!
      INTERP = 0                                                    !
      IF(ABS(RS - INT(RS)) < SMALL) INTERP = 1                      !
!
      IF(INTERP == 0) THEN                                          !
        A = AVS(INT(RS + SMALL))                                    !
        B = BVS(INT(RS + SMALL))                                    !
      ELSE                                                          !
        CALL INTERP_NR(6,XVS,AVS,6,RS,A)                            !
        CALL INTERP_NR(6,XVS,BVS,6,RS,B)                            !
      END IF                                                        !
!
      VASI_LFC = A * (ONE - EXP(- B * Y2))                          !
!
      END FUNCTION VASI_LFC    
!
!------ 1) 2D case --------------------------------------------
!
!=======================================================================
!
      SUBROUTINE LOCAL_FIELD_STATIC_2D(X,RS,GQ_TYPE,GQ)
!
!  This subroutine computes static local-field factors G(q) 
!    for 2D systems.
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * GQ_TYPE  : local-field correction type
!                       GQ_TYPE = 'NONE' no local field correction
!                       GQ_TYPE = 'HUBB' Hubbard correction (only exchange)
!                       GQ_TYPE = 'GOCA' Gold-Calmels
!                       GQ_TYPE = 'IWA1' Iwamoto G_{-1}
!                       GQ_TYPE = 'IWA2' Iwamoto G_{3}
!                       GQ_TYPE = 'DPGT' Davoudi-Giuliani-Giuliani-Tosi
!                       GQ_TYPE = 'BUTO' Bulutay-Tomak
!                       GQ_TYPE = 'SAIC' Sato-Ichimaru correction
!
!  Output parameters:
!
!       * GQ       : value of local field correction
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS, ONLY : ZERO
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  GQ_TYPE
!
      REAL (WP)             ::  X,RS
      REAL (WP)             ::  GQ
!
      IF(GQ_TYPE == 'NONE') THEN                                    !
        GQ=ZERO                                                     !
      ELSE IF(GQ_TYPE == 'HUBB') THEN                               !
        GQ=HUB2_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'GOCA') THEN                               ! 
        GQ=GOC2_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'IWA1') THEN                               ! 
        GQ=IW21_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'IWA2') THEN                               !
        GQ=IW22_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'DPGT') THEN                               ! 
        GQ=DPGT_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'BUTO') THEN                               ! 
        GQ=BUTO_LFC(X,RS)                                           !
      ELSE IF(GQ_TYPE == 'SAIC') THEN                               ! 
        GQ=SAIC_LFC(X)                                              !
      END IF                                                        !
!
      END SUBROUTINE LOCAL_FIELD_STATIC_2D  
!
!=======================================================================
!
      FUNCTION BUTO_LFC(X,RS)
!
!  This function computes the Bulutay-Tomak
!      local-field correction for 2D systems
!
!  References: (1) C. Bulutay and M. Tomak, Phys. Rev. B 53, 7317-7321 (1996)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,SMALL
      USE INTERPOLATION,    ONLY : INTERP_NR,SPLINE,SPLINT
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X,RS,Y,BUTO_LFC
      REAL (WP)             ::  A,B
!
      REAL (WP)             ::  XBT(0:6),ABT(0:6),BBT(0:6)
!
      REAL (WP)             ::  DABS,DEXP
!
      INTEGER               ::  INTERP
!
      INTEGER               ::  INT
!
      DATA ABT    /0.4999E0_WP,0.8128E0_WP,0.9214E0_WP,0.9752E0_WP,&! 0 value: result of 6th degree fit
                   1.0004E0_WP,1.0165E0_WP,1.0296E0_WP/             ! on values of ref. (5) table II
      DATA BBT    /0.6195E0_WP,0.7322E0_WP,0.8075E0_WP,0.8585E0_WP,&! 0 value: result of 6th degree fit
                   0.9121E0_WP,0.9444E0_WP,0.9583E0_WP/             ! on values of ref. (5) table II
      DATA XBT    /0.0000E0_WP,1.0000E0_WP,2.0000E0_WP,3.0000E0_WP,&!
                   4.0000E0_WP,5.0000E0_WP,6.0000E0_WP/             !
!
      Y=X+X                                                        ! Y = q / k_F
!
!  Checking if interpolation of ABT and BBT is necessary
!
      INTERP=0                                                     !
      IF(DABS(RS-INT(RS)).LT.SMALL) INTERP=1                       !
!
      IF(INTERP == 0) THEN                                         !
        A=ABT(INT(RS+SMALL))                                       !
        B=BBT(INT(RS+SMALL))                                       !
      ELSE
        CALL INTERP_NR(7,XBT,ABT,7,RS,A)                           !
        CALL INTERP_NR(7,XBT,BBT,7,RS,B)                           !
      END IF                                                       !
!
      BUTO_LFC=A*(ONE-DEXP(-B*Y/A))                                !                                  
!
      END FUNCTION BUTO_LFC  
!
!=======================================================================
!
      FUNCTION DPGT_LFC(X,RS)
!
!  This function computes the Davoudi-Polini-Giuliani-Tosi 
!      local-field correction for 2D systems
!
!  References: (1) B. Davoudi, M. Polini, G. F. Giuliani and M. P. Tosi,
!                     Phys.Rev. B 64, 153101 (2001)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,TEN,HALF,FOURTH
      USE SQUARE_ROOTS,     ONLY : SQR2
      USE PI_ETC,           ONLY : PI,PI_INV
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X,RS,Y,Y2,Y4,Y6,Y8,DPGT_LFC
      REAL (WP)             ::  R10,E
      REAL (WP)             ::  G0,G2,G4,G6,G8
      REAL (WP)             ::  NUM,DEN,ALPH
      REAL (WP)             ::  A,B,C,P
!
      REAL (WP)             ::  DLOG,DSQRT,DEXP
!
      Y=X+X                                                         ! Y = q / k_F
      Y2=Y*Y                                                        !
      Y4=Y2*Y2                                                      !
      Y6=Y4*Y2                                                      !
      Y8=Y6*Y2                                                      !
!
      R10=RS/TEN                                                    !
      E=DEXP(R10)                                                   !
!
      G0=HALF / (ONE + 1.372E0_WP*RS + 0.0830E0_WP*RS*RS)           ! ref. (1) eq. (9)
!
      G2= 0.5824E0_WP*R10*R10 - 0.4272E0_WP*R10                     !
      G4= 0.2960E0_WP*R10-1.003E0_WP*(R10**2.5E0_WP)+             & !
          0.9466E0_WP*R10*R10*R10                                   ! 
      G6=-0.0585E0_WP*R10*R10                                       ! ref. (1) eq. (11)
      G8= 0.0131E0_WP*R10*R10                                       !
      NUM=0.1598E0_WP + 0.8931E0_WP*(R10**0.9218E0_WP)              !
      DEN=ONE         + 0.8793E0_WP*(R10**0.9218E0_WP)              !
      ALPH=NUM/DEN                                                  !
!
!  For A, we use the value of (1 - K0/K) from eq. (3.8b) of ref. (1)
!    and for C the value of Ec in  eq. (3.7b) of ref. (1)
! 
      A=(ONE/(RS*SQR2) * PI_INV*( ONE -                           & ! ref. (1) eq. (5)
           (TEN-THREE*PI)*RS*RS*DLOG(RS)/12.0E0_WP))                !
      B= ONE-G0                                                     !
      C=0.17E0_WP*RS/SQR2 + PI_INV*RS*RS*(TEN/THREE -PI) *        & ! ref. (1) eq. (8)
                           (TWO*DLOG(RS)+ONE)                       !
      P= G2*Y2 + G4*Y4 + G6*Y6 + G8*Y8                              !
!                                                                  
      DPGT_LFC=A*Y*( E/DSQRT(ONE+(A*E*Y/B)**2) +                  & !
                     (ONE-E)*DEXP(-FOURTH*Y2)                     & !
                   ) + C*Y*(ONE-DEXP(-Y2)) + P*DEXP(-ALPH*Y2)       !                   
!
      END FUNCTION DPGT_LFC  
!
!=======================================================================
!
      FUNCTION GOC2_LFC(X,RS)
!
!  This function computes the Gold-Calmels 
!      local-field correction for 2D systems
!
!  References: (1) A. Gold and L. Calmels, Phys. Rev. B 48, 
!                     11622-11637 (1993)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TEN,THIRD
      USE SQUARE_ROOTS,     ONLY : SQR2
      USE PI_ETC,           ONLY : PI_INV
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X,RS,Y,GOC2_LFC
      REAL (WP)             ::  NUM,DEN,KFOQ0,QQ0
!
      REAL (WP)             ::  A1GC(3),B1GC(3),A2GC(3),B2GC(3),C12,C22
!
      REAL (WP)             ::  DSQRT
!
      INTEGER               ::  IND
!
      DATA A1GC   /1.135E0_WP,1.120E0_WP,1.127E0_WP/                ! Gold-Calmels coefficients
      DATA B1GC   /0.248E0_WP,0.216E0_WP,0.215E0_WP/                ! for C12 and C22
      DATA A2GC   /1.687E0_WP,1.640E0_WP,1.314E0_WP/                ! eq. (26)-(27)
      DATA B2GC   /0.494E0_WP,0.530E0_WP,0.667E0_WP/                ! ref. (1)
!
      Y=X+X                                                         ! Y = q / k_F
!
      IF(RS < ONE) THEN                                             !
        IND=1                                                       !
      ELSE                                                          !
        IF(RS < TEN) THEN                                           !
          IND=2                                                     !
        ELSE                                                        !
          IF(RS < 100.0E0_WP) THEN                                  !
            IND=3                                                   !
          END IF                                                    !
        END IF                                                      !
      END IF                                                        !
!
      C12=A1GC(IND)*(RS**B1GC(IND))                                 !
!
      IF(RS < ONE) THEN                                             !
        IND=1                                                       !
      ELSE                                                          !
        IF(RS < TEN) THEN                                           !
          IND=2                                                     !
        ELSE                                                        !
          IF(RS < 1000.0E0_WP) THEN                                 !
            IND=3                                                   !
          END IF                                                    !
        END IF                                                      !
      END IF                                                        !
!
      C22=A2GC(IND)*(RS**B2GC(IND))                                 !
!
      KFOQ0=ONE / (SQR2* RS**THIRD)                                 ! k_F / q_0
      QQ0=Y*KFOQ0                                                   !
!
      NUM=RS**(THIRD+THIRD) * 1.402E0_WP* QQ0                       !
      DEN=DSQRT(2.644E0_WP*C12*C12 + QQ0*QQ0*C22)                   !
!
      GOC2_LFC=NUM/DEN                                              !
!
      END FUNCTION GOC2_LFC  
!
!=======================================================================
!
      FUNCTION HUB2_LFC(X)
!
!  This function computes the Hubbard exchange-only  
!      local-field correction
!
!  References: (1) A. Gold and L. Calmels, Phys. Rev. B 52, 10841-10857 (1995)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,HALF
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X,Y,HUB2_LFC
!
      REAL (WP)             ::  DSQRT
!
      Y=X+X                                                         ! Y = q / k_F
!
      HUB2_LFC=HALF*Y/DSQRT(ONE+Y*Y)                                !
!
      END FUNCTION HUB2_LFC  
!
!=======================================================================
!
      FUNCTION IW21_LFC(X,RS)
!
!  This function computes the Iwamoto G_{-1}
!      local-field correction for 2D systems
!
!  References: (1) N. Iwamoto, Phys. Rev. A 30, 3289-3304 (1984)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,THREE,TEN
      USE PI_ETC,           ONLY : PI,PI_INV
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X,RS,Y,IW21_LFC
!
      REAL (WP)             ::  DLOG
!
      Y=X+X                                                         ! Y = q / k_F
!
      IW21_LFC=PI_INV*(ONE-(TEN-THREE*PI)*RS*RS*                 &  !
                       DLOG(RS)/12.0E0_WP)*Y                        !
!
      END FUNCTION IW21_LFC  
!
!=======================================================================
!
      FUNCTION IW22_LFC(X,RS)
!
!  This function computes the Iwamoto G_{3}
!      local-field correction for 2D systems
!
!  References: (1) N. Iwamoto, Phys. Rev. A 30, 3289-3304 (1984)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : THREE,FIVE,SIX,TEN
      USE PI_ETC,           ONLY : PI,PI_INV
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X,RS,Y,IW22_LFC
!
      REAL (WP)             ::  DLOG
!
      Y=X+X                                                         ! Y = q / k_F
!
      IW22_LFC=( FIVE*PI_INV/SIX - 0.240E0_WP*RS -                & !
                 33.0E0_WP*PI_INV*(TEN-THREE*PI)*RS*RS*           & !
                 DLOG(RS)/24.0E0_WP                               & !
               )*Y                                                  !
!
      END FUNCTION IW22_LFC  
!
!=======================================================================
!
      FUNCTION SAIC_LFC(X)
!
!  This function computes the Sato-Ichimaru
!      local-field correction for 2D systems
!
!  References: (1) H. K. Schweng and H. M. Böhm, Int. J. Quantum. Chem. 56,
!                        791-799 (1995)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 25 Sep 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,THREE,FOUR,HALF
      USE PI_ETC,           ONLY : PI_INV
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  SAIC_LFC
      REAL (WP)             ::  Y,Y2,Y4,Y6
!
      REAL (WP), PARAMETER  ::  AA = 0.009E0_WP      !  A
      REAL (WP), PARAMETER  ::  BB = 0.00038E0_WP    !  B
      REAL (WP), PARAMETER  ::  CC = 0.965E0_WP      !  C
      REAL (WP), PARAMETER  ::  DD = 0.078E0_WP      !  D
      REAL (WP), PARAMETER  ::  A  = 0.0475E0_WP     !  a
      REAL (WP), PARAMETER  ::  B  = 1.66E0_WP       !  b
      REAL (WP), PARAMETER  ::  C  = 0.09E0_WP       !  c
      REAL (WP), PARAMETER  ::  D  = THREE           !  d
!
      Y  = X  +  X                                                  ! Y = q / k_F
      Y2 = Y  *  Y                                                  !
      Y4 = Y2 * Y2                                                  !
      Y6 = Y4 * Y2                                                  !
!
      IF(X <= ONE) THEN                                             !
        SAIC_LFC = (Y * PI_INV + AA * Y4 + BB * Y6) * ( CC +      & !
                            (ONE - CC) * TANH((FOUR - Y2) / DD)   & !
                                                      )             ! ref. (1) eq. (8b)
      ELSE                                                          !
        SAIC_LFC = HALF + A / (Y - B) + C / (Y2 - D)                !
      END IF                                                        !
!
      END FUNCTION SAIC_LFC  
!
!------ 1) 1D case --------------------------------------------
!
!=======================================================================
!
      SUBROUTINE LOCAL_FIELD_STATIC_1D(X,RS,GQ_TYPE,GQ)
!
!  This subroutine computes static local-field factors G(q) 
!    for 1D systems.
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * GQ_TYPE  : local-field correction type
!                       GQ_TYPE = 'NONE' no local field correction
!                       GQ_TYPE = 'HUBB' Hubbard correction (only exchange)
!                       GQ_TYPE = 'GOCA' Gold-Calmels
!
!  Output parameters:
!
!       * GQ       : value of local field correction
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS, ONLY : ZERO
!
      IMPLICIT NONE
!
      CHARACTER*4 GQ_TYPE
!
      REAL*8 X,RS
      REAL*8 GQ
!
      IF(GQ_TYPE == 'NONE') THEN                                    !
        GQ=ZERO                                                     !
      ELSE IF(GQ_TYPE == 'HUB1') THEN                               !
        GQ=HUBB_LFC(X)                                              !
      ELSE IF(GQ_TYPE == 'GOCA') THEN                               ! 
        GQ=GOC1_LFC(X,RS)                                           !
      END IF                                                        !
!
      END SUBROUTINE LOCAL_FIELD_STATIC_1D 
!
!
!=======================================================================
!
      FUNCTION HUB1_LFC(X)
!
!  This function computes the Hubbard exchange-only  
!      local-field correction for 1D systems
!
!  References: (1) A. Gold and L. Calmels, Phys. Rev. B 52, 10841-10857 (1995)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO,HALF
      USE FERMI_SI,         ONLY : KF_SI
      USE CONFINEMENT_FF
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X,Y,HUB1_LFC
      REAL (WP)             ::  Q_SI,Q,XX
      REAL (WP)             ::  VC1,VC2
!
      REAL (WP)             ::  DSQRT
!
      Y=X+X                                                         ! Y = q / k_F
      Q_SI=Y*KF_SI                                                  ! q in SI
!
      Q=DSQRT(Q_SI*Q_SI + KF_SI*KF_SI)                              !
      XX=HALF*Q/KF_SI                                               !
!
      VC1=CONFIN_FF(XX)                                             !
      VC2=CONFIN_FF(X)                                              !
!
      HUB1_LFC=HALF*VC1/VC2                                         ! ref. (1) eq. (4)
!
      END FUNCTION HUB1_LFC  
!
!=======================================================================
!
      FUNCTION GOC1_LFC(X,RS)
!
!  This function computes the Gold-Calmels 
!      local-field correction for 1D systems
!
!  References: (1) A. Gold and L. Calmels, Phys. Rev. B 52, 
!                     10841-10857 (1995)
! 
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)  
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : FOUR,HALF
      USE FERMI_SI,         ONLY : KF_SI
      USE PI_ETC,           ONLY : PI_INV
      USE CONFINEMENT_FF
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X,RS,Y,GOC1_LFC
      REAL (WP)             ::  Q_SI,KS,COEF,Q,XX
      REAL (WP)             ::  VC1,VC2
      REAL (WP)             ::  C11,C21
!
      REAL (WP)             ::  DSQRT
!
      Y=X+X                                                         ! Y = q / k_F
      Q_SI=Y*KF_SI                                                  ! q

      CALL CG_PARAMETRIZATION_1D(RS,C11,C21)                        !
!
      COEF=RS*PI_INV/C21
!
      Q=DSQRT(Q_SI*Q_SI + FOUR/(RS*C11*C11))                        ! unit of q0^2/C11^2 ?
      XX=HALF*Q/KF_SI                                               !
!
      VC1=CONFIN_FF(XX)                                             !
      VC2=CONFIN_FF(X)                                              !
!
      GOC1_LFC=COEF*VC1/VC2                                         ! 
!
      END  FUNCTION GOC1_LFC 
!
!=======================================================================
!
      SUBROUTINE CG_PARAMETRIZATION_1D(RS,C11,C21)
!
!  This subroutine computes the Calmels-Gold parametrization for the 
!    calculation of the static 1D local-field correction G(q)
!
!  References: (1) L. Calmels and A. Gold, Phys. Rev. B 52, 10841-10857 (1995)
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!
!  Internal parameters:
!
!       * parameters C11 and C21
!
!
!  Output parameters:
!
!       * RS       : electron-electron distance in a.u.
!       * R0       : 1D confinement parameter (= wire radius) in a.u.
!
!  Table I, II and II of ref. (1) are used and the parameters 
!     are fitted with:
!
!           1) C11(rs) for different values of a* with a 10th-order polynomial
!           2) C21(rs) for different values of a* with a 6th-order polynomial
!
!  Then, the coefficients of the polynomials as a function of R0=f(a*) are fitted
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 10 Jun 2020
!
      USE CONFIN_VAL,      ONLY : R0
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS
!                                                                   ! coefficients of the
      REAL (WP)             ::  A11(0:10),A21(0:6)                  ! polynomials fitted to 
!                                                                   ! 5 values of R0
      REAL (WP)             ::  C11,C21
      REAL (WP)             ::  RS2,RS3,RS4,RS5,RS6,RS7,RS8,RS9,RS10
      REAL (WP)             ::  R02,R03,R04
!
      RS2=RS*RS                                                     !
      RS3=RS2*RS                                                    !
      RS4=RS3*RS                                                    !
      RS5=RS4*RS                                                    !
      RS6=RS5*RS                                                    !
      RS7=RS6*RS                                                    !
      RS8=RS7*RS                                                    !
      RS9=RS8*RS                                                    !
      RS10=RS9*RS                                                   !
!
      R02=R0*R0                                                     !
      R03=R02*R0                                                    !
      R04=R03*R0                                                    !
!
      A11(0)=0.21684E0_WP  +    0.09359E0_WP*R0  - 0.0087353E0_WP*R02 &! 
                           -  0.0061566E0_WP*R03 +0.00090189E0_WP*R04  !
      A11(1)=6.159E0_WP    +    0.34573E0_WP*R0  +    0.8188E0_WP*R02 &!
                           -    0.29423E0_WP*R03 +  0.027191E0_WP*R04  !
      A11(2)=-25.041E0_WP  +     13.261E0_WP*R0  -    14.975E0_WP*R02 &! 
                           +     4.5402E0_WP*R03 -   0.40242E0_WP*R04  !
      A11(3)= 51.186E0_WP  -    42.4867E0_WP*R0  +    45.346E0_WP*R02 &!
                           -     13.703E0_WP*R03 +    1.2149E0_WP*R04  !
      A11(4)=-56.749E0_WP  +     56.697E0_WP*R0  -     60.08E0_WP*R02 &! 
                           +     18.259E0_WP*R03 -    1.6235E0_WP*R04  !
      A11(5)= 36.271E0_WP  -     39.508E0_WP*R0  +    42.195E0_WP*R02 &!
                           -     12.888E0_WP*R03 +    1.1487E0_WP*R04  !
      A11(6)= 13.765E0_WP  -     15.728E0_WP*R0  +    16.911E0_WP*R02 &!
                           -     5.1841E0_WP*R03 +   0.46284E0_WP*R04  !
      A11(7)=  3.1137E0_WP -     3.6605E0_WP*R0  +    3.9552E0_WP*R02 &!
                           -     1.2155E0_WP*R03 +   0.10865E0_WP*R04  !
      A11(8)=-0.40794E0_WP +    0.48829E0_WP*R0  -   0.52945E0_WP*R02 &!
                           +    0.16299E0_WP*R03 -   0.01458E0_WP*R04  !
      A11(9)=0.028331E0_WP -   0.034316E0_WP*R0  +  0.037301E0_WP*R02 &!
                           -   0.011497E0_WP*R03 +  0.001029E0_WP*R04  !
      A11(10)=-0.00080196E0_WP+0.0009793E0_WP*R0 - 0.0010663E0_WP*R02 &!
                            + 0.00032895E0_WP*R03 - 2.9453E-05_WP*R04  !
! 
      A21(0)=0.091552E0_WP -   0.17832E0_WP*R0  +    0.11774E0_WP*R02 &!
                           -  0.030277E0_WP*R03 +  0.0024971E0_WP*R04  !
      A21(1)=4.0647E0_WP   -    6.1695E0_WP*R0  +     3.9346E0_WP*R02 &! 
                           -    1.0082E0_WP*R03 +   0.083221E0_WP*R04  !
      A21(2)=-1.4144E0_WP  +    1.7798E0_WP*R0  -     1.0403E0_WP*R02 &!
                           +   0.25756E0_WP*R03 -   0.020951E0_WP*R04  !
      A21(3)=0.55871E0_WP  -   0.73394E0_WP*R0  +    0.42973E0_WP*R02 &!
                           -    0.1062E0_WP*R03 +  0.0086274E0_WP*R04  !
      A21(4)=-0.10394E0_WP +   0.14008E0_WP*R0  -   0.082217E0_WP*R02 &!
                           +  0.020308E0_WP*R03 -  0.0016487E0_WP*R04  !
      A21(5)=0.0091324E0_WP-  0.012508E0_WP*R0  +  0.0073577E0_WP*R02 &!
                           - 0.0018173E0_WP*R03 +  0.0001475E0_WP*R04  !
      A21(6)=-0.00030448E0_WP+0.0004215E0_WP*R0 - 0.00024838E0_WP*R02 &!
                           +  6.1355E-05_WP*R03 -   4.9795E-06_WP*R04  !
!
      C11=A11(0) + A11(1)*RS  + A11(2)*RS2 + A11(2)*RS2 + A11(3)*RS3 +&!
                   A11(4)*RS4 + A11(5)*RS5 + A11(6)*RS6 + A11(7)*RS7 +&!
                   A11(8)*RS8 + A11(9)*RS9 + A11(10)*RS10              !
!
      C21=A21(0) + A21(1)*RS  + A21(2)*RS2 + A21(2)*RS2 + A21(3)*RS3 +&!
                   A21(4)*RS4 + A21(5)*RS5 + A21(6)*RS6                !
!
      END SUBROUTINE CG_PARAMETRIZATION_1D  
!
END MODULE LOCAL_FIELD_STATIC
