!
!=======================================================================
!
MODULE LANDAU_PARAM 
!
!  This module provides the standard dimensionless Landau parameters
!
      USE ACCURACY_REAL
!
CONTAINS
!
!
!=======================================================================
!
      SUBROUTINE LANDAU_PARAMETERS_3D(X,XC,U0,W,D,RS,LANDAU,     &
                                      F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the standard dimensionless Landau parameters
!    as a function of the Hubbard-like bare coupling constant, or the 
!    hard-sphere radius, in the 3D case 
!                             
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X  = q    / (2 * k_F)  
!       * XC       : dimensionless cut-off  --> XC = q_c  / (2 * k_F) 
!       * U0 / A   : bare interaction constant / hard sphere radius (in SI) 
!       * W        : half bandwidth for bare particle (ref. 7)
!       * D        : filling (dopant concentration) in ref. 7
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * LANDAU   : model chosen for the calculation of the parameters
!                       LANDAU = 'ANBR' Anderson-Brinkman model
!                       LANDAU = 'CHEN' Chen's approach
!                       LANDAU = 'GUTZ' Gutzwiller model
!                       LANDAU = 'GVYO' Giuliani-Vignale parametrization of 
!                       LANDAU = 'IWPI' Iwamoto-Pines model (hard-sphere)
!                                       Yasuhara-Ousaka approach
!                       LANDAU = 'RASC' Rayleigh-Schrödinger expansion
!                       LANDAU = 'SBOH' slave-boson one-band Hubbard model
!                             
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A 
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  LANDAU
!
      REAL (WP)             ::  X,XC,U0,A,W,D,RS
      REAL (WP)             ::  F0S,F0A,F1S,F1A,F2S,F2A
!
      IF(LANDAU == 'ANBR') THEN                                     !
!
        CALL ANBR_LP_3D(U0,F0S,F0A,F1S,F1A,F2S,F2A)                 !
!
      ELSE IF(LANDAU == 'CHEN') THEN                                !
!
        CALL CHEN_LP_3D(U0,F0S,F0A,F1S,F1A,F2S,F2A)                 !
!
      ELSE IF(LANDAU == 'GUTZ') THEN                                !
!
        CALL GUTZ_LP_3D(U0,F0S,F0A,F1S,F1A,F2S,F2A)                 !       
!
      ELSE IF(LANDAU == 'GVYO') THEN                                !
!
        CALL GVYO_LP_3D(RS,F0S,F0A,F1S,F1A,F2S,F2A)                 !
!
      ELSE IF(LANDAU == 'IWPI') THEN                                !
!
        A=U0                                                        !
        CALL IPWI_LP_3D(A,F0S,F0A,F1S,F1A,F2S,F2A)                  !
!
      ELSE IF(LANDAU == 'RASC') THEN                                !
!
        CALL RASC_LP_3D(X,XC,U0,F0S,F0A,F1S,F1A,F2S,F2A)            !
!
      ELSE IF(LANDAU == 'SBOH') THEN                                !
!
        CALL SBOH_LP_3D(U0,W,D,F0S,F0A,F1S,F1A,F2S,F2A)             !
!
      END IF                                                        !
!
      END SUBROUTINE LANDAU_PARAMETERS_3D  
!
!=======================================================================
!
      SUBROUTINE LANDAU_PARAMETERS_2D(RS,LANDAU,X,IX,             &
                                      F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the standard dimensionless Landau parameters
!    in the 2D case.
!                             
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * LANDAU   : model chosen for the calculation of the parameters
!                       LANDAU = 'ERZA' Engelbrecht-Randeria-Zhang approach
!                       LANDAU = 'GVYO' Giuliani-Vignale parametrization of 
!                                        Yasuhara-Ousaka approach
!                       LANDAU = 'KCMP' Kwoon-Ceperley-Martin parametrization
!       * X        : either MU or EG              (for 'ERZA' only)
!       * IX       : switch for input value X     (for 'ERZA' only)
!                       IX = 1 --> X = chemical potential MU  in SI
!                       IX = 2 --> X = ground state energy EG in SI
!                             
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  LANDAU
!
      REAL (WP)             ::  RS,X,G
      REAL (WP)             ::  F0S,F0A,F1S,F1A,F2S,F2A
!
      INTEGER               :: IX
!
      IF(LANDAU == 'ERZA') THEN                                     !
!
        CALL ERZA_LP_2D(X,IX,F0S,F0A,F1S,F1A,F2S,F2A)               !
!
      ELSE IF(LANDAU == 'GVYO') THEN                                !
!
        CALL GVYO_LP_2D(RS,F0S,F0A,F1S,F1A,F2S,F2A)                 !
!
      ELSE IF(LANDAU == 'KCMP') THEN                                !
!
        CALL KCMP_LP_2D(RS,F0S,F0A,F1S,F1A,F2S,F2A)                 !
! 
      END IF                                                        !
!
      END SUBROUTINE LANDAU_PARAMETERS_2D    
!
!=======================================================================
!
      SUBROUTINE ANBR_LP_3D(U0,F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the standard dimensionless Landau parameters
!    for the Anderson-Brinkman model in the 3D case 
!
!  References: (1) D. Volhardt, Rev. Mod. Phys. 58, 99-120 (1984)
!                             
!
!  Input parameters:
!
!       * U0       : bare interaction constant 
!                             
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO,ONE,TWO,THREE,EIGHT,FOURTH
      USE CONSTANTS_P1,     ONLY : H_BAR,M_E
      USE FERMI_SI,         ONLY : EF_SI,KF_SI
      USE PI_ETC,           ONLY : PI2
!
      IMPLICIT NONE
!
      REAL (WP)             :: U0,UC,XU
      REAL (WP)             :: NF_SI
      REAL (WP)             :: F0S,F0A,F1S,F1A,F2S,F2A
!
!  Initialization
!
      F0S=ZERO                                                      !
      F0A=ZERO                                                      !
      F1S=ZERO                                                      !
      F1A=ZERO                                                      !
      F2S=ZERO                                                      !
      F2A=ZERO                                                      !
!
      NF_SI=M_E*KF_SI/(PI2*H_BAR*H_BAR)                             ! n(E_F) in SI
!
!  Cut-off interaction
!
      UC=EIGHT*EF_SI                                                !
      XU=U0/UC                                                      !
!
      F1S=THREE*(ONE/(ONE-XU*XU)) - ONE                             ! ref. (1) eq. (24)
      F0A=-FOURTH*NF_SI*U0*(TWO+XU)/((ONE*XU)*(ONE*XU))             ! ref. (41) eq. (25)
!
      END SUBROUTINE ANBR_LP_3D   
!
!=======================================================================
!
      SUBROUTINE CHEN_LP_3D(U0,F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the standard dimensionless Landau parameters
!    in Chen's approach, in the 3D case 
!
!  References: (1) V. A. Belyakov, Soviet Phys. JETP 13, 850-851 (1961)
!              (2) J.-S. Chen, J. Stat. Mech. L08002 (2009)
!                             
!                             
!
!  Input parameters:
!
!       * U0       : bare interaction constant
!                             
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A 
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO,ONE,TWO,THREE,FOUR,EIGHT, &
                                   NINE,THIRD,FOURTH
      USE CONSTANTS_P1,     ONLY : H_BAR,M_E
      USE FERMI_SI,         ONLY : KF_SI
      USE PI_ETC,           ONLY : PI,PI_INV
!
      IMPLICIT NONE
!
      REAL (WP)             :: U0
      REAL (WP)             :: A,AKF,P2AKF
      REAL (WP)             :: F0S,F0A,F1S,F1A,F2S,F2A
!
!  Initialization
!
      F0S=ZERO                                                      !
      F0A=ZERO                                                      !
      F1S=ZERO                                                      !
      F1A=ZERO                                                      !
      F2S=ZERO                                                      !
      F2A=ZERO                                                      !
!
!  Scattering amplitude from Fermi pseudopotential
!
      A= FOURTH*PI_INV*U0 * (M_E/(H_BAR*H_BAR))                     ! ref. 1 eq. (3)
!
      AKF=A*KF_SI                                                   !
      P2AKF=PI-TWO * AKF                                            !
!
      F1S=FOUR*AKF*AKF/(THREE * P2AKF**2)                           ! ref. (2) eq. (28)
      F0S=(ONE+THIRD*F1S)*(ONE + TWO*AKF/P2AKF +                  & !
                       20.0E0_WP*AKF*AKF/(NINE*P2AKF*P2AKF) +     & ! ref. (2) eq. (25)
                       EIGHT*AKF*AKF*AKF/(NINE*(P2AKF**3)))         !
!
      END SUBROUTINE CHEN_LP_3D    
!
!=======================================================================
!
      SUBROUTINE ERZA_LP_2D(X,IX,F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the standard dimensionless Landau parameters
!    in the 2D case.
!
!  References: (1) J. R. Engelbrecht, M. Randeria and L. Zhang, 
!                        Phys. Rev. B 45, 10135-10138 (1992)
!                             
!
!  Input parameters:
!
!       * X        : either MU or EG 
!       * IX       : switch for input value X
!                       IX = 1 --> X = chemical potential MU  in SI
!                       IX = 2 --> X = ground state energy EG in SI
!
!  Intermediate parameters:
!
!       * G        : low-density expansion parameter (ref. 1) 
!                             
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO,TWO,FOUR
!
      IMPLICIT NONE
!
      INTEGER               :: IX
!
      REAL (WP)             :: X,G
      REAL (WP)             :: LN2
      REAL (WP)             :: F0S,F0A,F1S,F1A,F2S,F2A
!
      LN2=DLOG(TWO)                                                 !
! 
!  Initialization
!
      F0S=ZERO                                                      !
      F0A=ZERO                                                      !
      F1S=ZERO                                                      !
      F1A=ZERO                                                      !
      F2S=ZERO                                                      !
      F2A=ZERO                                                      !
!
!  Computing the expansion parameter G
!
      CALL MU_EG_TO_G(X,IX,G)                                       !
!
      F0S=TWO*G+FOUR*G*G*(TWO-LN2)                                  !
      F0A=-FOUR*G*G*LN2                                             !
      F1S=  TWO*G*G                                                 !
      F1A=- TWO*G*G                                                 !
!
      END SUBROUTINE ERZA_LP_2D 
!
!=======================================================================
!
      SUBROUTINE MU_EG_TO_G(X,IX,G)
!
!  This subroutine computes the low-density expansion parameter g 
!    from the knowledge of either the chemical potential mu or 
!    from the ground state energy EG
!
!  References: (1) J. R. Engelbrecht, M. Randeria and L. Zhang, 
!                        Phys. Rev. B 45, 10135-10138 (1992)
!
!
!  Input parameters:
!
!       * X        : either MU or EG 
!       * IX       : switch for input value X
!                       IX = 1 --> X = chemical potential MU  in SI
!                       IX = 2 --> X = ground state energy EG in SI
!                             
!
!  Output parameters:
!
!       * G        : low-density expansion parameter (ref. 1) 
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,FOUR
      USE FERMI_SI,         ONLY : EF_SI
      USE POLYNOMIAL_EQ,    ONLY : QUADRATIC_EQUATION,CHECK_ROOTS2 
!
      IMPLICIT NONE
!
      INTEGER               :: IX
!
      REAL (WP)             :: X,G
      REAL (WP)             :: MU,EG
      REAL (WP)             :: LN2
!
      COMPLEX (WP)          :: AA,BB,CC
      COMPLEX (WP)          :: X1,X2
!
      LN2=DLOG(TWO)                                                 !
!
      IF(IX == 1) THEN                                              !
!
        MU=X                                                        !
!
        AA=DCMPLX(FOUR*(ONE-LN2))                                   !
        BB=DCMPLX(TWO)                                              !
        CC=DCMPLX(ONE-MU/EF_SI)                                     !
!
        CALL QUADRATIC_EQUATION(AA,BB,CC,X1,X2)                     !
!
        CALL CHECK_ROOTS2(X1,X2,G)                                  !
!
      ELSE IF(IX == 2) THEN                                         !
!
        EG=X                                                        !
!
        AA=DCMPLX(THREE-FOUR*LN2)                                   !
        BB=DCMPLX(TWO)                                              !
        CC=DCMPLX(ONE-TWO*EG/EF_SI)                                 !
!
        CALL QUADRATIC_EQUATION(AA,BB,CC,X1,X2)                     !
!
        CALL CHECK_ROOTS2(X1,X2,G)                                  !
!
      END IF                                                        !
!
      END SUBROUTINE MU_EG_TO_G 
!
!=======================================================================
!
      SUBROUTINE GUTZ_LP_3D(U0,F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the standard dimensionless Landau parameters
!    for the Gutzwiller approach, in the 3D case 
!
!  References: (1) D. Volhardt, Rev. Mod. Phys. 58, 99-120 (1984)
!                             
!                             
!
!  Input parameters:
!
!       * U0       : bare interaction constant
!                             
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO,ONE,TWO,THREE,FOUR,EIGHT, & 
                                   THIRD,FOURTH
      USE CONSTANTS_P1,     ONLY : H_BAR,M_E
      USE FERMI_SI,         ONLY : EF_SI,KF_SI
      USE PI_ETC,           ONLY : PI2
!
      IMPLICIT NONE
!
      REAL (WP)             :: U0,UC,XU
      REAL (WP)             :: NF_SI,P,I,AA,BB
      REAL (WP)             :: NUM,DEN
      REAL (WP)             :: F0S,F0A,F1S,F1A,F2S,F2A
!
!  Initialization
!
      F0S=ZERO                                                      !
      F0A=ZERO                                                      !
      F1S=ZERO                                                      !
      F1A=ZERO                                                      !
      F2S=ZERO                                                      !
      F2A=ZERO                                                      !
!
      NF_SI=M_E*KF_SI/(PI2*H_BAR*H_BAR)                             ! n(E_F) in SI
!
!  Cut-off interaction
!
      UC=EIGHT*EF_SI                                                !
      XU=U0/UC                                                      !
!
      P=FOURTH*UC*NF_SI                                             !
      I=XU                                                          !
      AA=-ONE + (FOUR - I*I)*(ONE - P)                              !                      
      BB=( ONE + I*I*(ONE-P) )**2                                   !
      NUM=BB + TWO*THIRD*P*AA                                       !
      DEN=BB*(ONE+I*I) + TWO*THIRD*P*AA                             !
!
      F0A=-P*(ONE - ONE/((ONE+I)*(ONE+I)))                          ! ref. (1) eq. (50) 
      F0S= P*(ONE/((ONE+I)*(ONE+I) - ONE) )                         ! ref. (1) eq. (54)  
      F1A=-THREE*I*I * NUM/DEN                                      ! ref. (1) eq. (71)  
!
      END SUBROUTINE GUTZ_LP_3D  
!
!=======================================================================
!
      SUBROUTINE GVYO_LP_3D(RS,F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the Yasuhara-Ousaka 
!    parametrization of Landau parameters F0s,F0a,
!    F1s,F1a,F2s,F2a.
!
!  We use a 4-degree polynomial to fit the data of 
!    table 8.1 and table 8.6 of reference (1)  
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A
!
!
!  Reference: (1) G. F. Giuliani and G. Vignale, 
!                    "Quantum Theory of the Electron Liquid",
!                    (Cambridge University Press 2005)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
!
      IMPLICIT NONE
!
      REAL (WP)             :: RS,F0S,F0A,F1S,F1A,F2S,F2A
      REAL (WP)             :: Y,Y2,Y3,Y4
      REAL (WP)             :: A1(0:4),A2(0:4),A3(0:4),A4(0:4),A5(0:4),A6(0:4)
!
      DATA A1 / -0.066667E0_WP  , -0.13392E0_WP  , -0.0094444E0_WP ,&! F0s
                 0.00018519E0_WP, 6.8305E-18_WP              /       !
      DATA A2 / -0.10833E0_WP   , -0.039854E0_WP , -0.029514E0_WP  ,&! F0a
                 0.008287E0_WP  , -0.000625E0_WP             /       !     
      DATA A3 / -0.07E0_WP      ,  0.049167E0_WP , -0.024583E0_WP  ,&! F1s 
                 0.0058333E0_WP , -0.00041667E0_WP           /       ! 
      DATA A4 / -0.0242E0_WP    ,  0.0066333E0_WP, -0.00068333E0_WP,&! F1a
                 0.00016667E0_WP, -1.6667E-05_WP             /       ! 
      DATA A5 / -0.0221E0_WP    , -0.00265E0_WP  ,  0.00395E0_WP   ,&! F2s
                -0.00075E0_WP   ,  5.0E-05_WP                /       !
      DATA A6 / -0.0242E0_WP    ,  0.0066333E0_WP, -0.00068333E0_WP,&! F2a
                 0.00016667E0_WP, -1.6667E-05_WP             /       !
!
!  Powers of RS
!
      Y  = RS                                                       ! 
      Y2 = Y*Y                                                      !
      Y3 = Y2*Y                                                     ! 
      Y4 = Y3*Y                                                     !
!
!  Computing the Landau parameters
!
      F0S=A1(0) + A1(1)*Y  + A1(2)*Y2 + A1(3)*Y3 + A1(4)*Y4         ! F0s
      F0A=A2(0) + A2(1)*Y  + A2(2)*Y2 + A2(3)*Y3 + A2(4)*Y4         ! F0a 
      F1S=A3(0) + A3(1)*Y  + A3(2)*Y2 + A3(3)*Y3 + A3(4)*Y4         ! F1s 
      F1A=A4(0) + A4(1)*Y  + A4(2)*Y2 + A4(3)*Y3 + A4(4)*Y4         ! F1a 
      F2S=A5(0) + A5(1)*Y  + A5(2)*Y2 + A5(3)*Y3 + A5(4)*Y4         ! F2s
      F2A=A6(0) + A6(1)*Y  + A6(2)*Y2 + A6(3)*Y3 + A6(4)*Y4         ! F2a
!
      END SUBROUTINE GVYO_LP_3D
!
!=======================================================================
!
      SUBROUTINE GVYO_LP_2D(RS,F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the Yasuhara-Ousaka 
!    parametrization of Landau parameters F0s,F0a,
!    F1s.
!
!  We use a 4-degree polynomial to fit the data of 
!    table 8.5 of reference (1)  
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A
!
!
!  Reference: (1) G. F. Giuliani and G. Vignale, 
!                    "Quantum Theory of the Electron Liquid",
!                    (Cambridge University Press 2005)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO
!
      IMPLICIT NONE
!
      REAL (WP)             :: RS,F0S,F0A,F1S,F1A,F2S,F2A
      REAL (WP)             :: Y,Y2,Y3,Y4
      REAL (WP)             :: A1(0:4),A2(0:4),A3(0:4)
!
      DATA A1 / -0.13E0_WP     , -0.19917E0_WP   , -0.12958E0_WP ,& ! F0s
                 0.0091667E0_WP, -0.00041667E0_WP               /   !
      DATA A2 / -0.1019E0_WP   , -0.24296E0_WP   ,  0.063813E0_WP,& ! F0a
                -0.0094683E0_WP,  0.00051984E0_WP               /   !     
      DATA A3 / -0.087143E0_WP ,  0.10986E0_WP   ,  0.010738E0_WP,& ! F1s 
                -0.0037143E0_WP,  0.0002619E0_WP                /   !
!
!  Initialization
!
      F0S=ZERO                                                      !
      F0A=ZERO                                                      !
      F1S=ZERO                                                      !
      F1A=ZERO                                                      !
      F2S=ZERO                                                      !
      F2A=ZERO                                                      !
! 
!  Powers of RS
!
      Y  = RS                                                       ! 
      Y2 = Y*Y                                                      !
      Y3 = Y2*Y                                                     ! 
      Y4 = Y3*Y                                                     !
!
!  Computing the Landau parameters
!
      F0S=A1(0) + A1(1)*Y  + A1(2)*Y2 + A1(3)*Y3 + A1(4)*Y4         ! F0s
      F0A=A2(0) + A2(1)*Y  + A2(2)*Y2 + A2(3)*Y3 + A2(4)*Y4         ! F0a 
      F1S=A3(0) + A3(1)*Y  + A3(2)*Y2 + A3(3)*Y3 + A3(4)*Y4         ! F1s
!
      END SUBROUTINE GVYO_LP_2D
!
!=======================================================================
!
      SUBROUTINE IPWI_LP_3D(A,F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the standard dimensionless Landau parameters
!    for the Iwamoto-Pines hard-sphere model, in the 3D case 
!
!  References: (1) N. Iwamoto and D. Pines, Phys. Rev. B 29, 3924 (1984)
!                             
!                             
!
!  Input parameters:
!
!       * A        : hard sphere radius (in SI) 
!                             
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO,ONE,TWO,FOUR,SEVEN,THIRD
      USE CONSTANTS_P1,     ONLY : H_BAR,M_E
      USE FERMI_SI,         ONLY : KF_SI
      USE PI_ETC,           ONLY : PI_INV
!
      IMPLICIT NONE
!
      REAL*8 A,AKF
      REAL*8 LN2
      REAL*8 F0S,F0A,F1S,F1A,F2S,F2A
!
      LN2=DLOG(TWO)                                                 !
!
!  Initialization
!
      F0S=ZERO                                                      !
      F0A=ZERO                                                      !
      F1S=ZERO                                                      !
      F1A=ZERO                                                      !
      F2S=ZERO                                                      !
      F2A=ZERO                                                      !
!
      AKF=A*KF_SI                                                   !
!
      F0S= TWO*PI_INV*AKF*(                                      &  ! 
                            ONE+FOUR*THIRD*PI_INV*               &  !
                            (TWO+LN2)*AKF                        &  !
                          )                                         ! ref. (1) eq. (B1)
      F0A=-TWO*PI_INV*AKF*(                                      &  ! 
                            ONE+FOUR*THIRD*PI_INV*               &  !
                            (ONE-LN2)*AKF                        &  !
                          )                                         ! ref. (1) eq. (B2)   
      F1A= 1.6E0_WP*PI_INV*PI_INV*(SEVEN*LN2-ONE)*AKF*AKF           ! ref. (1) eq. (B3) 
      F1S=-1.6E0_WP*PI_INV*PI_INV*(TWO+LN2)*AKF*AKF                 ! ref. (1) eq. (B4) 
!
      END SUBROUTINE IPWI_LP_3D  
!
!=======================================================================
!
      SUBROUTINE KCMP_LP_2D(RS,F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the Kwoon-Ceperley-Martin 
!    parametrization of Landau parameters F0s,F0a,
!    F1s,F1a,F2s and F2a.
!
!  We use a 4-point Lagrange interpolation to fit the data of 
!    table VIII of reference (1)  
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A
!
!  Reference: (1) Y. Kwoon, D. M. Ceperley and R. M. Martin,
!                    Phys. Rev. B 50, 1684-1694 (1994)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,FIVE
      USE INTERPOLATION,    ONLY : LAG_4P_INTERP
!
      IMPLICIT NONE
!
      REAL (WP)             :: RS,F0S,F0A,F1S,F1A,F2S,F2A
      REAL (WP)             :: A1(4),A2(4),A3(4),A4(4),A5(4),A6(4)
      REAL (WP)             :: X(4)
!
!  Data of table VIII
!
      DATA A1 / -0.60E0_WP, -0.99E0_WP, -1.63E0_WP, -3.70E0_WP /    ! F0s
      DATA A2 / -0.34E0_WP, -0.41E0_WP, -0.49E0_WP, -0.51E0_WP /    ! F0a
      DATA A3 / -0.14E0_WP, -0.10E0_WP, -0.03E0_WP,  0.12E0_WP /    ! F1s
      DATA A4 / -0.19E0_WP, -0.24E0_WP, -0.26E0_WP, -0.27E0_WP /    ! F1a
      DATA A5 / -0.07E0_WP, -0.16E0_WP, -0.27E0_WP, -0.50E0_WP/     ! F2s
      DATA A6 /  0.01E0_WP,  0.07E0_WP,  0.14E0_WP,  0.32E0_WP/     ! F2a
!
!  RS values un table VIII
!
      X(1)=ONE                                                      !
      X(2)=TWO                                                      !
      X(3)=THREE                                                    !
      X(4)=FIVE                                                     !
!
!  F0s --> A1 data
!
      F0S=LAG_4P_INTERP(X,A1,RS)                                    !
!
!  F0a --> A2 data
!
      F0A=LAG_4P_INTERP(X,A2,RS)                                    !
!
!  F1s --> A3 data
!
      F1S=LAG_4P_INTERP(X,A3,RS)                                    !
!
!  F1a --> A4 data
!
      F1A=LAG_4P_INTERP(X,A4,RS)                                    !
!
!  F2s --> A5 data
!
      F2S=LAG_4P_INTERP(X,A5,RS)                                    !
!
!  F2a --> A6 data
!
      F2A=LAG_4P_INTERP(X,A6,RS)                                    !
!
      END SUBROUTINE KCMP_LP_2D
!
!=======================================================================
!
      SUBROUTINE RASC_LP_3D(X,XC,U0,F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the standard dimensionless Landau parameters
!    using a Rayleigh-Schrödinger expansion  in the 3D case 
!
!  References: (1) Slides
!                             
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X  = q    / (2 * k_F)  
!       * XC       : dimensionless cut-off  --> XC = q_c  / (2 * k_F) 
!       * U0       : bare interaction constant  
!                             
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A 
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO,ONE,TWO,THREE,SEVEN, & 
                                   HALF,THIRD,FOURTH
      USE CONSTANTS_P1,     ONLY : M_E
      USE FERMI_SI,         ONLY : KF_SI
      USE PI_ETC,           ONLY : PI2
!
      IMPLICIT NONE
!
      REAL (WP)             :: X,XC,U0,UB
      REAL (WP)             :: Q_SI,Q_CO
      REAL (WP)             :: LN2
      REAL (WP)             :: F0S,F0A,F1S,F1A,F2S,F2A
!
      LN2=DLOG(TWO)                                                 !
!
!  Initialization
!
      F0S=ZERO                                                      !
      F0A=ZERO                                                      !
      F1S=ZERO                                                      !
      F1A=ZERO                                                      !
      F2S=ZERO                                                      !
      F2A=ZERO                                                      !
!
      Q_SI=TWO*X*KF_SI                                              ! q   in SI
      Q_CO=TWO*XC*KF_SI                                             ! q_c in SI
!                                                                   
!  Screened interaction
!
      UB=U0*(ONE - U0*FOURTH*M_E/PI2 * HALF*( Q_CO +               &!
                                (Q_SI*Q_SI-Q_CO*Q_CO)*             &! ref. 1 p. 
                                DLOG(DABS(Q_CO-Q_SI)/(Q_CO+Q_SI))/ &!
                                Q_SI))                              !
!
      F0S= UB * (ONE + UB*(ONE+HALF*THIRD*(TWO+LN2)))               ! 
      F0A=-UB * (ONE + UB*(ONE-TWO*THIRD*(ONE-LN2)))                ! ref. (1) p. 22
      F1S= UB*UB * TWO*(SEVEN*LN2-ONE)/15.0E0_WP                    !
!
      END SUBROUTINE RASC_LP_3D  
!
!=======================================================================
!
      SUBROUTINE SBOH_LP_3D(U0,W,D,F0S,F0A,F1S,F1A,F2S,F2A)
!
!  This subroutine computes the standard dimensionless Landau parameters
!    of the slave-boson one-band Hubbard model in the 3D case 
!
!  References: (1) T. Li and P. Bénard, Phys. Rev. B 50, 17837 (1994)
!              (2) Slides
!                             
!                             
!
!  Input parameters:
!
!       * U0       : bare interaction constant 
!       * W        : half bandwidth for bare particle (ref. 7)
!       * D        : filling (dopant concentration) in ref. 7
!                             
!
!  Output parameters:
!
!       * F0S,F0A,F1S,F1A,F2S,F2A
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  5 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO,ONE,TWO,THREE,FOUR,FIVE, & 
                                   SIX,EIGHT,NINE,TEN
      USE COMPLEX_NUMBERS,  ONLY : ZEROC,ONEC
      USE CONSTANTS_P1,     ONLY : M_E
      USE FERMI_SI,         ONLY : KF_SI
      USE PI_ETC,           ONLY : PI2
      USE POLYNOMIAL_EQ,    ONLY : CUBIC_EQUATION,CHECK_ROOTS3 
!
      IMPLICIT NONE
!
      REAL*8 U0
      REAL*8 W,D,U
      REAL*8 D2,D4,D6
      REAL*8 Y,Y2,Y3,Y4,Y5,Y6,Y7
      REAL*8 NUM,DEN
      REAL*8 F0S,F0A,F1S,F1A,F2S,F2A
!
      COMPLEX*16 AC,BC,CC,DC
      COMPLEX*16 X1,X2,X3
!
!  Initialization
!
      F0S=ZERO                                                      !
      F0A=ZERO                                                      !
      F1S=ZERO                                                      !
      F1A=ZERO                                                      !
      F2S=ZERO                                                      !
      F2A=ZERO                                                      !
!
!  Scaled interaction
!
      U=U0/(FOUR*W)                                                 ! ref. 7 eq. (59c)
!
!
!  Computing Y, solution of:
!
!           (1-Y)*Y^2
!           --------- = U              ref. (3) eq. (11)
!             Y^2-D2
!
      AC=ONEC                                                       !
      BC=DCMPLX(U-ONE)                                              !
      CC=ZEROC                                                      !
      DC=DCMPLX(-U*D*D)                                             !
!
      CALL CUBIC_EQUATION(AC,BC,CC,DC,X1,X2,X3)                     !
!
!  Looking for a real and positive solution Y = x^2             
!
      CALL CHECK_ROOTS3(X1,X2,X3,Y)                                 !
!
      D2=D*D                                                        !
      D4=D2*D2                                                      !
      D6=D4*D2                                                      !
      Y2=Y*Y                                                        !
      Y3=Y2*Y                                                       !
      Y4=Y3*Y                                                       !
      Y5=Y4*Y                                                       !
      Y6=Y5*Y                                                       !
      Y7=Y6*Y                                                       !
!
      NUM=(ONE-Y)*(TWO*D2-FIVE*D2*Y+TWO*Y2+D2*Y2+Y3-Y4)             !
      DEN=(D2-TWO*Y+Y2)*(-TWO*D2+THREE*D2*Y-Y3)                     !
      F0S=NUM/DEN                                                   ! ref. (1) eq. (61)
!
      NUM=(ONE-D2)*(Y2-D2)                                          !
      DEN=(TWO*Y-Y2-D2)**2                                          !
      F0A=-ONE + NUM/DEN                                            ! ref. (1) eq. (60)
!
      NUM=THREE*(Y-ONE)**2 * (    -TEN*D4    + 19.0E0_WP*D4*Y -    &!
                                 EIGHT*D2*Y2 -                     &!
                                   TWO*D2*Y3+TWO*Y4-Y5             &!
                             )                                      !
      DEN=( 16.0E0_WP*D4    -       SIX*D6     - 48.0E0_WP*D4*Y  + &!
                 NINE*D6*Y  +     EIGHT*D2*Y2  + 48.0E0_WP*D4*Y2 - &!
                EIGHT*D2*Y3 - 25.0E0_WP*D4*Y3  -        EIGHT*Y4 + &!
                  TEN*D2*Y4 +  EIGHT*Y5-D2*Y5  -         FOUR*Y6 + &!
                         Y7                                        &!
          )                                                         !
      F1A=NUM/DEN                                                   ! ref. (1) eq. (65)
!
      NUM=THREE*(ONE-Y2)**2                                         !
      DEN=(TWO*Y-Y2-D2)                                             !
      F1S=NUM/DEN                                                   ! ref. (1) eq. (23)
!
      END SUBROUTINE SBOH_LP_3D  
!
END MODULE LANDAU_PARAM
