!
!=======================================================================
!
MODULE GRAND_PARTITION 
!
      USE ACCURACY_REAL
!
CONTAINS
!
!
!=======================================================================
!
      SUBROUTINE GRAND_PARTITION_FUNCTION_3D(RS,T,A,GP_TYPE,LXI) 
!
!  This subroutine computes the grand partition function  
!    for 3D systems.
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : system temperature in SI
!       * A        : sqrt(mu_B * B) : magnitude of the magnetic field
!       * GP_TYPE  : grand partition function type (3D)
!                       GP_TYPE = 'IK0' Isihara-Kojima formulation
!                       GP_TYPE = 'RH0' Rebei-Hitchon formulation
!                       GP_TYPE = 'IKM' Isihara-Kojima with magnetic field
!
!
!  Output parameters:
!
!       * LXI      : logarithm of grand partition function        in SI
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 11 Jun 2020
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 3)   ::  GP_TYPE
!
      REAL (WP)             ::  RS,T,A
      REAL (WP)             ::  LXI
! 
      IF(GP_TYPE == 'IK0') THEN                                     !
        LXI=LXI_IK_3D(RS,T)                                         !
      ELSE IF(GP_TYPE == 'RH0') THEN                                !
        LXI=LXI_RH_3D(RS,T)                                         !
      ELSE IF(GP_TYPE == 'IKM') THEN                                !
        LXI=LXI_IK_M_3D(RS,T,A)                                     !
      END IF                                                        !
!
      END SUBROUTINE GRAND_PARTITION_FUNCTION_3D
!
!=======================================================================
!
      FUNCTION LXI_IK_3D(RS,T) 
!
!  This function computes the logarithm of the grand partition function
!    (per electron) in 3D system in the Isihara-Kojima approach
!
!  Note: This is the NO MAGNETIC FIELD result
!
!
!  More precisely, 
!
!      LXI = 1/V * DLOG(XI)   where V is the volume
!
!  References: (1) A. Isihara and D. Y. Kojima, Z. Physik B 21,
!                     33-45 (1975)
!              (2) A. Isihara and D. Y. Kojima, Phys. Cond. Matter 18,
!                     249-262 (1974)
!              (3) D. Y. Kojima and A. Isihara, in 
!                     "Physics of Condensed Matter", Vol. 17, G. Busch ed.,
!                     179-181 (1974)
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : system temperature in SI
!
!
!  Output parameters:
!
!       * LXI_IK_3D: logarithm of grand partition function        in SI
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 11 Jun 2020
!
!
      USE REAL_NUMBERS,        ONLY : ONE,TWO,THREE,FOUR,FIVE,SIX, & 
                                      SEVEN,EIGHT,NINE,TEN,        &
                                      HALF,THIRD,FOURTH
      USE CONSTANTS_P1,        ONLY : E,K_B
      USE FERMI_SI,            ONLY : EF_SI
      USE PI_ETC,              ONLY : PI,PI2,PI3,PI_INV
      USE EULER_CONST,         ONLY : EUMAS
      USE UTILITIES_1,         ONLY : ALFA
      USE CHEMICAL_POTENTIAL,  ONLY : MU
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS,T
      REAL (WP)             ::  LXI_IK_3D
      REAL (WP)             ::  LX00,LX1X,LX1R,LR2X,LA2X
      REAL (WP)             ::  BETA,ETA,ET2,ET4,PF2,LNE,LNE2
      REAL (WP)             ::  E2,E4
      REAL (WP)             ::  A11,AP11,A12,A13,A14
      REAL (WP)             ::  A21,AP21,A22,A23,A24
      REAL (WP)             ::  A32,A31
      REAL (WP)             ::  XI,XI2,XI4
      REAL (WP)             ::  G,LNG,LNG0
      REAL (WP)             ::  COEF
      REAL (WP)             ::  C1,C2
      REAL (WP)             ::  C
      REAL (WP)             ::  I,J,I1,I2,I3,K0,K1
      REAL (WP)             ::  TH2,TH3,TH4,TH5
      REAL (WP)             ::  A,A0,A1,A2,AA,DD
      REAL (WP)             ::  ZETA_3,LN2,ALPHA
!
      ZETA_3=1.202056903159594285399738E0_WP                        ! Apéry's constant
      LN2=DLOG(TWO)                                                 !
!
      ALPHA=ALFA('3D')                                              !
!
      E2=E*E
      E4=E2*E2
!
      BETA=ONE/(K_B*T)                                              !
      PF2=MU('3D',T)                                                ! chemical potential --> check units
      ETA=BETA*PF2                                                  !
      ET2=ETA*ETA                                                   !
      ET4=ET2*ET2                                                   !
      LNE=DLOG(ETA)                                                 !
      LNE2=LNE*LNE                                                  !
      G=TWO*E*E*PI_INV/DSQRT(PF2)                                   ! ref. (2) eq. (B4) 
      LNG=DLOG(G)                                                   !
      LNG0=DLOG(TWO*E*E*PI_INV/DSQRT(EF_SI))                        ! --> check consitency of units
!
!  Cut-off parameter
!
      XI=TWO                                                        !
      XI2=XI*XI                                                     !
      XI4=XI2*XI2                                                   !
!
!  Coefficients of ref. (2) Table 1                                 !
!
      A11=THIRD*PI*(ONE-LN2)                                        !
      AP11=-0.1769447E0_WP                                          !
      A12=-PI/96.0E0_WP                                             !
      A13=-0.0006136E0_WP                                           !
      A14=-0.0034088E0_WP                                            
      A21=FOURTH*PI*(ONE-DLOG(FOUR))                                !
      AP21=0.0716913E0_WP                                           !
      A22=A12                                                       !
      A23=-A22                                                      !
      A24=0.0009204E0_WP                                            !
      A32=-0.0039884E0_WP                                           !
      A31=0.0030680E0_WP                                            !
!
      C1=HALF*A11 - AP11 + TWO*XI2*A12 + XI4*(A13+HALF*A14) +     & ! ref. (2) eq. (B5)
                           TWO*A11*DLOG(XI)                         !
      C2=AP21 - TWO*A21*DLOG(XI) - XI2*(A22+A23) -                & ! ref. (2) eq. (B6)
                HALF*XI4*(A24+A32+A31)                              !
!
      C=EUMAS                                                       !
      I=THIRD*LN2 - 1.5E0_WP*ZETA_3/PI2                             ! ref. (2) eq. (2.26)
      I1=DLOG(HALF*PI)-C                                            !
      I2=1.1268676E0_WP                                             !
      I3=2.9418144E0_WP                                             !
      K0=FOUR*LN2*LN2 - 1.5E0_WP - TWO*LN2*(ONE+TWO*I2)+I1+I3       !
      K1=FOUR*LN2-ONE+TWO*I2                                        !
!
      A=-0.50166E0_WP                                               ! ref. (1) eq. (B2)
!
      J=TWO*ET2*( ONE + THIRD*PI2/ET2 *(ONE + 1.5E0_WP*A/PI2 -    & !
                                         HALF*LNE) +              & !
                   FIVE*PI3*PI/(144.0E0_WP*ET4) -                 & ! ref. (3) eq. (16)
                   PI2/(NINE*(ETA**3.5E0_WP)) *                   & !
                   (ONE-THREE/(TEN*ETA))                          & !
                )                                                   !
!
      TH2=0.014858E0_WP - 0.20457E0_WP*LNG0                         !
      TH3=7.93829E0_WP - LNG0                                       ! ref. (1) app. D table 2
      TH4=-4.05265E0_WP                                             !
      TH5=-TWO                                                      !
      A2=1.5E0_WP*(TH5+TWO)/PI2                                     ! ref. (1) eq. (D3)
      A1=TWO*( A2 - 0.75E0_WP*(FOUR*(ONE-HALF*K1)-TH4)/PI2 )        ! ref. (1) eq. (D3)
      DD=TWO*PI_INV*(A11+THREE*C1 +TWO*C2 +                       & !
                        (TWO*A21-THREE*A11)*LNG0)                   !
      AA=DD-TH3-SIX+(THREE*J-PI2*I)+THREE*(K1-K0)                   !
      A0=A1-1.5E0_WP*AA/PI2                                         ! ref. (1) eq. (D3)
!
!
!  Different contributions to Ln(Xi):
!
!  1) free electron contribution
!
      COEF=TWO*(ETA**2.5E0_WP) / (15.0E0_WP*PI2*(BETA**1.5E0_WP))   !
      LX00=COEF*( ONE + FIVE*PI2/(EIGHT*ET2) -                    & ! ref. (2) eq. (2.7)
                  SEVEN*PI2* PI2/(EIGHT*48.0E0_WP*ET4) )            !
!
!  2) first-order exchange graphs
!
      COEF=FOURTH*E2*ET2 / (PI3*BETA)                               !
      LX1X=COEF*(  ONE + THIRD*PI2/ET2 *(ONE + 1.5E0_WP*A/PI2 -   & !
                                         HALF*LNE) +              & !
                   FIVE*PI3*PI/(144.0E0_WP*ET4) -                 & ! ref. (2) eq. (2.13)
                   PI2/(NINE*(ETA**3.5E0_WP)) *                   & !
                   (ONE-THREE/(TEN*ETA))                          & !
                )                                                   !
!
!  3) ring diagrams contributions
!
      COEF=HALF*E4*(ETA**1.5E0_WP) / (PI3*PI*DSQRT(BETA))           !
      LX1R=COEF*( C1*PI_INV - A11*LNG*PI_INV - PI/(12.0E0_WP*ET2)*& ! ref. (2) eq. (2.22)
                              (C2-A21*LNG)                        & !
                )                                                   !
!
!  4) regular second-order exchange graphs
!
      COEF=FOURTH*THIRD*E4*(ETA**1.5E0_WP) / (PI2*DSQRT(BETA))      !
      LR2X=-COEF*( I + PI2/(12.0E0_WP*ET2) * (A0+A1*LNE+A2*LNE2) )  ! ref. (2) eq. (2.25)
!
!  5) anomalous second-order exchange graphs
!
      COEF=FOURTH*E4*(ETA**1.5E0_WP) / (PI3*PI*DSQRT(BETA))         !
      LA2X=COEF*(  ONE + PI2/(12.0E0_WP*ET2) * (K0+K1*LNE+LNE2) )   ! ref. (2) eq. (2.28) 
!
!  Summation of the results
!
      LXI_IK_3D=LX00+LX1X+LX1R+LR2X+LA2X                            !
!
      END FUNCTION LXI_IK_3D
!
!=======================================================================
!
      FUNCTION LXI_RH_3D(RS,T) 
!
!  This function computes the logarithm of the grand partition function
!    (per electron) in 3D system in the Rebei-Hitchon approach
!
!  More precisely, 
!
!      LXI = 1/V * DLOG(XI)   where V is the volume
!
!  References: (4) A. Rebei and W. N. G. Hitchon, Physics Letters A 224,
!                     127-132 (1996)
!              (5) A. Rebei and W. N. G. Hitchon, Int. J. Mod. Phys. B 13,
!                     3357-3367 (1999)
!                     179-181 (1974)
!              (6) A. Rebei and W. N. G. Hitchon, 
!                     https://arxiv.org/pdf/cond-mat/9907025.pdf
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : system temperature in SI
!
!
!  Output parameters:
!
!       * LXI_RH_3D: logarithm of grand partition function        in SI
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 11 Jun 2020
!
!
      USE REAL_NUMBERS,        ONLY : ZERO,ONE,TWO,THREE,FOUR,FIVE, & 
                                      SEVEN,EIGHT,                  & 
                                      HALF,THIRD,FOURTH
      USE CONSTANTS_P1,        ONLY : BOHR,H_BAR,M_E,E,K_B
      USE FERMI_SI,            ONLY : KF_SI
      USE PI_ETC,              ONLY : PI,PI2,PI_INV
      USE EULER_CONST,         ONLY : EUMAS
      USE UTILITIES_1,         ONLY : ALFA
      USE CHEMICAL_POTENTIAL,  ONLY : MU
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS,T
      REAL (WP)             ::  LXI_RH_3D
      REAL (WP)             ::  OM0,OME,R,G,LX00
      REAL (WP)             ::  ALPHA,BETA,MMU,ETA,ET2,ET4,LNE
      REAL (WP)             ::  A1,A2,B1,B2,C1,BB,EE
      REAL (WP)             ::  RT,NT
      REAL (WP)             ::  COEF,K1,K2,K3
      REAL (WP)             ::  LN2
!
      LN2=DLOG(TWO)                                                 !
!
      ALPHA=ALFA('3D')                                              !
!
      BETA=ONE/(K_B*T)                                              !
      MMU=MU('3D',T)                                                ! chemical potential --> check units
      ETA=BETA*MMU                                                  !
      ET2=ETA*ETA                                                   !
      ET4=ET2*ET2                                                   !
      LNE=DLOG(ETA)                                                 !
!
      K1=HALF*KF_SI*KF_SI*KF_SI/PI2                                 !
      K2=-TWO*E*E*KF_SI*PI_INV                                      !
      K3=PI2/(12.0E0_WP*ET2)                                        !
!
! Constants for R
!
      RT=M_E*E*E/(ALPHA*H_BAR*H_BAR*KF_SI)                          ! ref. (5) eq. (32)
      NT=ONE/(FOUR*THIRD*PI*RT*RT*RT*BOHR*BOHR*BOHR)                !
!
! Constants for G --> note: g(1) = 1 (for BB)
!
      A1=ONE-TWO*LN2                                                !
      C1=ONE-LN2-HALF*EUMAS+0.0616E0_WP+HALF                        !
      BB=TWO*KF_SI*PI_INV*(ONE + PI2/(24.0E0_WP*ET2))               !
      B2=(ONE+BB+BB)**2.5E0_WP                                      !
      B1=-TWO/15.0E0_WP -TWO*THIRD*BB + TWO*B2/15.0E0_WP            !
      A2=-HALF + HALF*(ONE-EUMAS)                                   !
      EE=ZERO                                                       ! --> to be computed
!
!
!  Different contributions to Omega:
!
!  1) free electron contribution
!
      COEF=TWO*(ETA**2.5E0_WP) / (15.0E0_WP*PI2*(BETA**1.5E0_WP))   !
      LX00=COEF*( ONE + FIVE*PI2/(EIGHT*ET2) -                    & ! ref. (2) eq. (2.7)
                  SEVEN*PI2*PI2 /(EIGHT*48.0E0_WP*ET4) )            !
      OM0=-BETA*LX00
!
!  2) first-order exchange graphs
!
      OME=-HALF*E*E*M_E*M_E/PI2 * (  TWO*PI_INV*MMU*MMU -         & !
                THIRD*PI/(BETA*BETA) * (ONE+DLOG(BETA*MMU)-EUMAS) & ! ref. (6) eq. (67)
                                  )                                 !
!
!  3) ring diagrams contributions
!
      R=0.0622E0_WP*DLOG(RS) - 0.142E0_WP +                       & ! ref. (5) eq. (31)
                            0.0181E0_WP*NT*MMU*(ALPHA*RT/ETA)**2    ! in Ryd
!
!  4) new contribution
!
      G=K1*( K2*( HALF + K3*(HALF*(A1-LNE)+A2) -                  & !
                  HALF*K3*(EUMAS+LNE) + K3*(ONE-LN2) -            & !
                  FOURTH*LN2*LN2/ET2 + (EE+PI2/24.0E0_WP)/ET2     & ! ref. (4) eq. (18) 
                ) + MMU*(B1+K3*(B2-ONE))                          & !
                  -K2*(HALF+K3*(C1-HALF*LNE))                     & !
           )                                                        !
!
!  Summation of the results
!
      LXI_RH_3D=-(OM0+OME+R-G)/BETA                                 ! ref. (4) eq. (8)
!
      END FUNCTION LXI_RH_3D
!
!=======================================================================
!
      FUNCTION LXI_IK_M_3D(RS,T,A) 
!
!  This function computes the logarithm of the grand partition function
!    (per electron) in 3D system in the Isihara-Kojima approach, in the 
!    presence of an external magnetic field
!
!  More precisely, 
!
!      LXI = 1/V * DLOG(XI)   where V is the volume
!
!  References: (7) A. Isihara and D. Y. Kojima, Phys. Rev. B 10, 
!                     4925-4931 (1974)
!              (8) A. Isihara and D. Y. Kojima, Phys. Rev. B 11, 
!                     710-727 (1975)
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : system temperature in SI
!       * A        : sqrt(mu_B * B) : magnitude of the magnetic field
!
!
!  Output parameters:
!
!       * LXI_IK_M_3D: logarithm of grand partition function        in AU
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 11 Jun 2020
!
!
      USE REAL_NUMBERS,        ONLY : ONE,TWO,FOUR,FIVE,  &
                                      SEVEN,EIGHT,NINE,   & 
                                      THIRD,FOURTH
      USE CONSTANTS_P1,        ONLY : E,K_B
      USE FERMI_VALUES_M,      ONLY : KF_M_3D    
      USE PI_ETC,              ONLY : PI,PI2,PI3
      USE G_FACTORS,           ONLY : G_E
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS,T,A
      REAL (WP)             ::  LXI_IK_M_3D
      REAL (WP)             ::  LXI_IK_M
      REAL (WP)             ::  LX00,LXA0,LXA1
      REAL (WP)             ::  BETA,ETA,ET2,ET4,KFAU
      REAL (WP)             ::  EE,E4,A4,PIE,PIE2
      REAL (WP)             ::  G,LNG
      REAL (WP)             ::  COEF
      REAL (WP)             ::  KG,K1
      REAL (WP)             ::  C11,A21,C2(2),D1(2),D2,E1(2),E2(2)
      REAL (WP)             ::  E3,F1,F2(2),F3
!
      INTEGER               ::  X
!
      X=1                                                           ! cut-off for q-integration (1 or 2)
!
      BETA=ONE/(K_B*T)                                              !
      KFAU=KF_M_3D(RS,T,A)                                          ! (T,A)-dependent Fermi energy 
      ETA=BETA*KFAU*KFAU                                            !
      ET2=ETA*ETA                                                   !
      ET4=ET2*ET2                                                   !
!
      EE=E*E                                                        !
      E4=EE*EE                                                      !
      A4=A*A*A*A                                                    !
      PIE=PI/ETA                                                    !
      PIE2=PIE*PIE                                                  !
      KG=FOURTH*G_E*G_E - THIRD                                     !
      G=TWO*EE/(PI*KFAU)                                            !
      LNG=DLOG(G)                                                   !
!
!  Coefficients for correlations
!
      C11  = 0.19635E0_WP                                           !
      A21  =FOURTH*PI*(ONE-DLOG(FOUR))                              !
      C2(1)= 0.07169E0_WP                                           !
      C2(2)= 0.49229E0_WP                                           !
      D1(1)= 0.04632E0_WP                                           !
      D1(2)= 0.92605E0_WP                                           !
      D2   = 0.82699E0_WP                                           !
      E1(1)= 0.35282E0_WP                                           !
      E1(2)= 0.92701E0_WP                                           ! ref. (8) table I
      E2(1)= 0.04336E0_WP                                           !
      E2(2)=-0.00797E0_WP                                           !
      E3   =-0.01023E0_WP                                           !
      F1   =-0.14124E0_WP                                           !
      F2(1)= 0.06124E0_WP                                           !
      F2(2)= 0.15916E0_WP                                           !
      F3   =-0.02250E0_WP                                           !
!
!  No magnetic field contribution
!
!  1) free electron contribution
!
      COEF=TWO*(ETA**2.5E0_WP) / (15.0E0_WP*PI2*(BETA**1.5E0_WP))   !
      LX00=COEF*( ONE + FIVE*PI2/(EIGHT*ET2) -                    & ! ref. (2) eq. (2.7)
                  SEVEN*PI2* PI2/(EIGHT*48.0E0_WP*ET4) )            !
!
!  Non interacting electrons + magnetic field
!
      LXA0=KG*DSQRT(BETA/PI)*A4/(8.0E0_WP*PI) * (                 & !
              TWO/(PIE**1.5E0_WP) - (PIE**1.5E0_WP)/12.0E0_WP -   & ! ref. (7) eq. (4.1)
              SEVEN*(PIE**3.5E0_WP)/192.0E0_WP                    & !
                                             )                      !
!
!  Interacting electrons + magnetic field
!
      K1=BETA*A4/PI2                                                !
      LXA1=K1*FOURTH*KFAU*KG *(ONE-PIE2/24.0E0_WP) +              & !
           K1*FOURTH*EE/PI *  (ONE-PIE2/12.0E0_WP) +              & !
           K1*E4/(EIGHT*PI3*KFAU)*KG* (                           & ! ref. (8) eq. (3.1)
                  -C2(X)-A21*LNG + PIE2/EIGHT * (D1(X)+D2*LNG)    & !
                                      ) +                         & !
           K1*EE/(NINE*PI2) * (E1(X)-C11*LNG+G*(E2(X)+E3*LNG) +   & !
                           PIE2/EIGHT * (F1+G*(F2(X)+F3*LNG))     & !
                               )                                    !
!
!  Summation of the results
!
      LXI_IK_M_3D=LX00+LXA0+LXA1                                    ! ref. (8) eq. (2.12)
!
      END FUNCTION LXI_IK_M_3D
!
!=======================================================================
!
      SUBROUTINE GRAND_PARTITION_FUNCTION_2D(RS,T,A,FLD,LXI) 
!
!  This subroutine computes the grand partition function  
!    for 2D systems.
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : system temperature in SI
!       * A        : sqrt(mu_B * B) : magnitude of the magnetic field
!       * GP_TYPE  : grand partition function type (2D)
!                       GP_TYPE = 'I20' Isihara-Kojima formulation
!                       GP_TYPE = 'I2M' Isihara-Kojima with magnetic field
!       * FLD      : strength of the field
!                       FLD = 'WF' weak field          --> ref. (2)
!                       FLD = 'IF' intermediate field  --> ref. (3)
!
!
!  Output parameters:
!
!       * LXI      : logarithm of grand partition function        in SI
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 11 Jun 2020
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 3)   ::  GP_TYPE
      CHARACTER (LEN = 2)   ::  FLD
!
      REAL (WP)             ::  RS,T,A
      REAL (WP)             ::  LXI
! 
      IF(GP_TYPE == 'I20') THEN                                     !
        LXI=LXI_IK_2D(RS,T)                                         !
      ELSE IF(GP_TYPE == 'I2M') THEN                                !
        LXI=LXI_IK_M_2D(RS,T,A,FLD)                                 !
      END IF                                                        !
! 
      END SUBROUTINE GRAND_PARTITION_FUNCTION_2D
!
!=======================================================================
!
      FUNCTION LXI_IK_2D(RS,T) 
!
!  This function computes the grand partition function
!    (per electron) in the 2D system according to the 
!    Isihara-Toyoda model
!
!  References: (1) A. Isihara and T. Toyoda, Phys. Rev. B 21,
!                  3358-3365 (1980)  
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : system temperature in SI
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 11 Jun 2020
!
!
      USE REAL_NUMBERS,        ONLY : ONE,TWO,HALF,THIRD,FOURTH
      USE CONSTANTS_P1,        ONLY : E,K_B
      USE PI_ETC,              ONLY : PI,PI2,PI3,PI_INV
      USE EULER_CONST,         ONLY : EUMAS
      USE UTILITIES_1,         ONLY : ALFA
      USE CHEMICAL_POTENTIAL,  ONLY : MU
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS,T
      REAL (WP)             ::  LXI_IK_2D
      REAL (WP)             ::  A,C,C1,C2,I,J,A0,A1,A2,K0,K1,A11,A21
      REAL (WP)             ::  I1,I2,I3,TH2,TH3,TH5,LNG,LNG0,ALPHA
      REAL (WP)             ::  D1,D2,E0,EP1,ES1,EP2,ES2,ET2
      REAL (WP)             ::  BETA,PF2,PF3,PF4,ETA,X 
      REAL (WP)             ::  E2,E4,LNE,LNE2,DD,AA
      REAL (WP)             ::  ZETA_3,LN2
!
      ZETA_3=1.202056903159594285399738E0_WP                        ! Apéry's constant
      LN2=DLOG(TWO)                                                 !
!  
      ALPHA=ALFA('2D')                                              !
!
      E2=E*E
      E4=E2*E2
!
      BETA=ONE/(K_B*T)                                              !
      PF2=MU('2D',T)                                                ! chemical potential
      PF3=PF2*DSQRT(PF2)                                            !
      PF4=PF2*PF2                                                   !
      ETA=BETA*PF2                                                  !
      ET2=ETA*ETA                                                   !
      LNE=DLOG(ETA)                                                 !
      LNE2=LNE*LNE                                                  !
!
      D1=TWO*THIRD/(PI2)                                            !
      D2=FOURTH*(ONE-LN2)*PI_INV + ONE/PI3 -                      & !
                    (27.3E0_WP + 1.3E0_WP)/(32.0E0_WP*PI*PI3)       !                         
      E0=PI/12.0E0_WP                                               ! 
      EP1=-0.02553E0_WP                                             !
      ES1=-ONE/24.0E0_WP                                            !
      EP2=-0.05508E0_WP                                             !
      ES2=0.018316E0_WP                                             !
      ET2=PI_INV/48.0E0_WP                                          !
!
      LXI_IK_2D=BETA*( FOURTH*PF4*PI_INV + D1*E2*PF3 + D2*E4*PF2 +& !
                   (E0*PF4 + (EP1+ES1*DLOG(ETA))*E2*PF3 +         & !
                    (EP2+ES2*DLOG(ETA)+ET2*DLOG(ETA)*DLOG(ETA))*  & ! ref. (1) eq. (6.1)
                    E4*PF2                                        & !
                   )/(ETA*ETA)                                    & !
                     )                                              !
!
      END FUNCTION LXI_IK_2D
!
!=======================================================================
!
      FUNCTION LXI_IK_M_2D(RS,T,A,FLD) 
!
!  This function computes the logarithm of the grand partition function
!    (per electron) in 2D system in the Isihara-Kojima approach, in the 
!    presence of an external magnetic field:
!
!      (i)  weak field         --> ref. (2)
!      (ii) intermediate field --> ref. (3)
!
!  More precisely, 
!
!      LXI = 1/V * DLOG(XI)   where V is the volume
!
!  References: (2) A. Isihara and T. Toyoda, Phys. Rev. B 19,
!                     831-845 (1979)
!              (3) A. Isihara and D. Y. Kojima, Phys. Rev. B 19,
!                     846-855 (1979)
!
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : system temperature in SI
!       * A        : sqrt(mu_B * B) : magnitude of the magnetic field
!       * FLD      : strength of the field
!                       FLD = 'WF' weak field          --> ref. (2)
!                       FLD = 'IF' intermediate field  --> ref. (3)
!
!
!  Output parameters:
!
!       * LXI_IK_M_2D: logarithm of grand partition function        in AU
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 11 Jun 2020
!
!
      USE REAL_NUMBERS,        ONLY : ZERO,ONE,TWO,FOUR,SEVEN, & 
                                      HALF,THIRD,FOURTH
      USE CONSTANTS_P1,        ONLY : E,K_B
      USE FERMI_VALUES_M,      ONLY : KF_M_2D    
      USE PI_ETC,              ONLY : PI,PI2,PI_INV
      USE G_FACTORS,           ONLY : G_E
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 2)   ::  FLD
!
      REAL (WP)             ::  RS,T,A
      REAL (WP)             ::  LXI_IK_M_2D
      REAL (WP)             ::  ALPHA,BETA,GAMMA,ETA,ET2
      REAL (WP)             ::  KFAU,G2,KG,I
      REAL (WP)             ::  LN0,LNA
      REAL (WP)             ::  E2,CC,A2,A4,SL1,SL2,SI
      REAL (WP)             ::  XL,AL,BL,CL,ZZL
!
      INTEGER               ::  L,LMAX
!
      LMAX=100                                                      ! max. value of l-sum
!
      G2=G_E*G_E                                                    !
!
      BETA=ONE/(K_B*T)                                              !
      ALPHA=BETA*A*A                                                !
      KFAU=KF_M_2D(RS,T,A)                                          ! (T,A)-dependent Fermi energy 
      ETA=BETA*KFAU*KFAU                                            !
      ET2=ETA*ETA                                                   !
      GAMMA=A*A/(KFAU*KFAU)                                         !
!
      E2=E*E                                                        !
      A2=A*A                                                        !
      A4=A2*A2                                                      !
      CC=E2/KFAU                                                    !
      KG=0.75E0_WP*G2 - ONE                                         !
!
      IF(FLD == 'WF') THEN                                          !
!
!  No magnetic field contribution
!
        ZZL=ONE
        SL1=ZERO                                                    !
        DO L=1,LMAX                                                 !
          XL=DFLOAT(L)                                              !
          ZZL=-ZZL*L                                                !
          AL=XL*BETA*A2                                             !
          BL=HALF*G_E*AL                                            !
          SL1=SL1+ZZL*COSH(AL)/(DSINH(BL)*XL)                       !
        END DO                                                      !
        LN0=-HALF*A2*SL1*PI_INV                                     !
!
!  Magnetic field
!
        LNA=BETA*A4*( PI_INV/12.0E0_WP * KG + CC*(                 &!
                      ONE/(12.0E0_WP*PI2) * KG +                   &!
                      ONE/(48.0E0_WP*PI2) * (26.0E0_WP/15.0E0_WP + &!
                                             SEVEN*PI/16.0E0_WP)   &! ref. (2) eq. (6.1)
                                                 ) -               &!
                      ONE/(48.0E0_WP*PI2)*CC*DLOG(FOURTH*CC) +     &!
                      ( -ONE/(96.0E0_WP*PI)*KG +                   &!
                         11.0E0_WP/(2304.0E0_WP*PI)                &!
                      ) * CC*CC                                    &!
                    )
!
!  Summing up
!
        LXI_IK_M_2D=LN0+LNA                                         !
!
      ELSE IF(FLD == 'IF') THEN                                     !
!
        I=0.8149E0_WP                                               ! ref. (3) eq. (5.19)
!
!  Calculation of l-sums
!
        SI=-ONE                                                     ! init. of sign
        SL1=ZERO                                                    !
        SL2=ZERO                                                    !
        DO L=1,LMAX                                                 !
          SI=-SI                                                    !
          XL=DFLOAT(L)                                              !
          AL=XL*PI/GAMMA                                            !
          BL=HALF*G_E-TWO*XL*PI                                     !
          CL=XL*PI2/ALPHA                                           !
          SL1=SL1+SI*DCOS(AL)*DCOS(BL)/(XL*DSINH(CL))               !
          SL2=SL2+SI*DSIN(AL)*DCOS(BL)/DSINH(CL)                    !
        END DO                                                      !
        LXI_IK_M_2D=FOURTH*BETA*KFAU*KFAU*KFAU*KFAU*PI_INV*(      & !
                       ONE + THIRD*PI2/ET2 +                      & !
                       ((HALF*G2)**2 -THIRD)*GAMMA*GAMMA +        & ! ref. (3) eq. (5.21)
                       FOUR*ALPHA/ET2 * SL1 +                     & !
                       I*(CC**(FOUR*THIRD))*                      & !
                       (ONE + TWO*PI/ETA *SL2 )**(FOUR*THIRD)     & !
                                                           )        !
!
      END IF                                                        !
!
      END FUNCTION LXI_IK_M_2D
!
END MODULE GRAND_PARTITION
