!
!=======================================================================
!
MODULE XC_ENERGIES
!
      USE ACCURACY_REAL
!
CONTAINS
!
!------ 1) 3D case --------------------------------------------
!
!=======================================================================
!
      FUNCTION EXC_3D(EXC_TYPE,RS,T)
!
!  This subroutine computes the exchange and correlation energy EXC
!    at a given value RS
!
!
!  Input parameters:
!
!       * EXC_TYPE : type of correlation energy functional
!                       EXC_TYPE = 'GT'   --> Goedeker-Tetter-Hutter
!                       EXC_TYPE = 'ST'   --> 
!                       EXC_TYPE = 'BD'   --> Brown-DuBois-Holzmann-Ceperley
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!       * T        : temperature (SI)     
!
!  Output parameters:
!
!       * EXC      : value at RS
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 2)   ::  EXC_TYPE
!
      REAL (WP)             ::  EXC_3D,RS,T
!
      INTEGER               ::  IMODE
!
      IF(EXC_TYPE == 'GT') THEN                                     !
        EXC_3D=EXC_GT_W(RS)                                         !
      ELSE IF(EXC_TYPE == 'ST') THEN                                !
        EXC_3D=EXC_ST_S(RS)                                         !
      ELSE IF(EXC_TYPE == 'BD') THEN                                !
        EXC_3D=EXC_BD_T(RS,T)                                       !
      END IF
!
      END FUNCTION EXC_3D
!
!=======================================================================
!
!             Exchange and Correlation energy functionals (in Ryd)
!
!  Different regimes:  * weak coupling          : r_s << 1
!                      * metallic state         : 2 <= r_s  <= 6
!                      * Wigner crystallization : r_s >= 100
!
!
!  (1) Weak coupling regime: _W
!
!=======================================================================
!
      FUNCTION EXC_GT_W(RS)
!
!  Exchange and correlation energy for 3D systems
!    as derived by Goedeker-Tetter-Hutter
!
!
!  Reference: S. Goedeker, M. Teter and J. Hutter, Phys. Rev. B 54, 
!                1704-1710 (1996)
!
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 14 Sep 2020
!
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS,RS2,RS3,RS4
      REAL (WP)             ::  EXC_GT_W
      REAL (WP)             ::  A(0:3),B(1:4)
      REAL (WP)             ::  NUM,DEN
!
      DATA A /  0.4581652932831429E0_WP   ,   &
                2.217058676663745E0_WP    ,   &
                0.7405551735357053E0_WP   ,   &
                0.01968227878617998E0_WP  /
!
      DATA B /  1.0000000000000000E0_WP   ,   &
                4.504130959426697E0_WP    ,   &
                1.110667363742916E0_WP    ,   &
                0.02359291751427506E0_WP  /
!
      RS2 = RS  * RS                                                !
      RS3 = RS2 * RS                                                !
      RS4 = RS3 * RS                                                !
!
      NUM = A(0)    + A(1)*RS  + A(2)*RS2 + A(3)*RS3                !
      DEN = B(1)*RS + B(2)*RS2 + B(3)*RS3 + B(4)*RS4                !
!
      EXC_GT_W =  NUM / DEN                                         ! Ref. 1, Appendix
!
      END FUNCTION EXC_GT_W
!
!=======================================================================
!
!  (2) Strong coupling regime (r_s small): _S
!
!=======================================================================
!
      FUNCTION EXC_ST_S(RS)
!
!  Exchange and correlation energy for 3D systems in the standard model
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN)   ::  RS
      REAL (WP)               ::  EXC_ST_S
      REAL (WP)               ::  RS2,XS
      REAL (WP)               ::  A1,A2,A3,A4
!
      A1 = - 1.79186E0_WP                                           !
      A2 =   2.65E0_WP                                              !
      A3 = - 0.73E0_WP                                              !
      A4 = - 0.8E0_WP                                               !
!
      EXC_ST_S=A1/RS + A2/(RS*XS) + A3/RS2 + A4/(RS2*XS)            !
!
      END FUNCTION EXC_ST_S
!
!=======================================================================
!
!  (4) Temperature dependence: _T
!
!=======================================================================
!
      FUNCTION EXC_BD_T(RS,T)
!
!  Temperature-dependent exchange and correlation energy for 3D systems
!    as derived by Brown-DuBois-Holzmann-Ceperley
!
!  Validity: RS < 40 and T/T_F > 0.0625
!              
!  References: (1) E. W. Brown, J. L. DuBois, M. Holzmann and D. M. Ceperley,
!                     Phys. Rev. B 88, 081102 (2013)
!              (2) E. W. Brown, J. L. DuBois, M. Holzmann and D. M. Ceperley,
!                     Phys. Rev. B 88, 199901 (2013)          --> erratum
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!       * T        : temperature (SI)     
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,SIX
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS,T,T2
      REAL (WP)             ::  EXC_BD_T
      REAL (WP)             ::  E_XC_0
      REAL (WP)             ::  A_1(3),B_1(3),C_1(3),D_1(3)
      REAL (WP)             ::  A_2(3),B_2(3),C_2(3),D_2(3)
      REAL (WP)             ::  A1,A2,A3,P1,P2,U1,U2
!
      DATA A_1 /  6.94759E0_WP,  7.70107E0_WP, 12.68820E0_WP /      !
      DATA B_1 / -0.34608E0_WP, -0.95154E0_WP, -1.59703E0_WP /      ! case r_s < 10
      DATA C_1 / -1.97251E0_WP, -1.80401E0_WP, -4.74435E0_WP /      !
      DATA D_1 /  0.53700E0_WP,  0.49086E0_WP,  1.23569E0_WP /      !
!
      DATA A_2 /  1.54712E0_WP,  2.65068E0_WP,  3.07192E0_WP /      !
      DATA B_2 / -1.97814E0_WP, -2.45160E0_WP, -4.65269E0_WP /      ! case r_s > 10
      DATA C_2 /  1.42976E0_WP,  1.36907E0_WP,  1.36324E0_WP /      !
      DATA D_2 / -0.32967E0_WP, -0.31701E0_WP, -0.32247E0_WP /       
!
      T2=T*T                                                        !
!
      IF(RS <= 10.0E0_WP) THEN                                      !
!
        A1=DEXP(A_1(1)*DLOG(RS)+B_1(1)+C_1(1)*RS+D_1(1)*RS*DLOG(RS))!
        A2=DEXP(A_1(2)*DLOG(RS)+B_1(2)+C_1(2)*RS+D_1(2)*RS*DLOG(RS))! ref. (2) eq. (6)
        A3=DEXP(A_1(3)*DLOG(RS)+B_1(3)+C_1(3)*RS+D_1(3)*RS*DLOG(RS))!
!
      ELSE                                                          !
!
        A1=DEXP(A_2(1)*DLOG(RS)+B_2(1)+C_2(1)*RS+D_2(1)*RS*DLOG(RS))!
        A2=DEXP(A_2(2)*DLOG(RS)+B_2(2)+C_2(2)*RS+D_2(2)*RS*DLOG(RS))! ref. (2) eq. (6)
        A3=DEXP(A_2(3)*DLOG(RS)+B_2(3)+C_2(3)*RS+D_2(3)*RS*DLOG(RS))!
!
      END IF                                                        !
!
      U1=1.5E0_WP/(RS*RS*RS)                                        ! ref. (2) eq. (4) 
      U2=DSQRT(SIX/RS)/RS                                           ! ref. (2) eq. (5)
!
      P1=(A2*U1+A3*U2)*T2 + A2*U2*T2*DSQRT(T)                       ! ref. (2) eq. (2)
      P2=ONE + A1*T2 + A3*T2*DSQRT(T) +A2*T2*T                      ! ref. (2) eq. (3)
!
      EXC_BD_T=(E_XC_0 - P1)/P2                                     ! ref. (2) eq. (1)
!
      END FUNCTION EXC_BD_T
!
!------>     FXC-Based functionals
!
!=======================================================================
!
      FUNCTION FXC_3D(FXC_TYPE,RS,T)
!
!  This subroutine computes the XC free energy FXC
!    at a given value RS
!
!
!  Input parameters:
!
!       * FXC_TYPE : type of XC free energy functional
!                       FXC_TYPE = 'EB'   --> Ebeling et al
!                       FXC_TYPE = 'IC'   --> Ichimaru et al
!                       FXC_TYPE = 'KS'   --> Karasiev et al
!                       FXC_TYPE = 'VS'   --> Vashishta and Singwi
!                       FXC_TYPE = 'PD'   --> Perrot and Dharma-Wardana
!                       FXC_TYPE = 'EK'   --> Ebeling-Kraeft-Kremp-Röpke
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!       * T        : temperature (SI)     
!
!  Output parameters:
!
!       * FXC_3D   : value at RS
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
      IMPLICIT NONE
!
      CHARACTER*2 FXC_TYPE
!
      REAL (WP)             :: FXC_3D,RS,T
!
      IF(FXC_TYPE == 'EB') THEN                                     !
        FXC_3D=FXC_EB_T(RS,T)                                       !
      ELSE IF(FXC_TYPE == 'IC') THEN                                !
        FXC_3D=FXC_IC_T(RS,T)                                       !
      ELSE IF(FXC_TYPE == 'VS') THEN                                !
        FXC_3D=FXC_VS_T(RS,T)                                       !
      ELSE IF(FXC_TYPE == 'PD') THEN                                !
        FXC_3D=FXC_PD_T(RS,T)                                       !
      ELSE IF(FXC_TYPE == 'KS') THEN                                !
        FXC_3D=FXC_KS_T(RS,T)                                       !
      ELSE IF(FXC_TYPE == 'EK') THEN                                !
        FXC_3D=FXC_EK_T(RS,T)                                       !
      END IF                                                        !
!
      END FUNCTION FXC_3D
!
!=======================================================================
!
      SUBROUTINE DERIVE_FXC_3D(FXC_TYPE,IDERIV,RS,TE,D_FXC)
!
!  This subroutine computes the first derivative of the 
!    exchange and correlation free energy F_xc with repect to Theta
!
!  Input parameters:
!
!       * FXC_TYPE : type of XC free energy functional
!                       FXC_TYPE = 'EB'   --> Ebeling et al
!                       FXC_TYPE = 'IC'   --> Ichimaru et al
!                       FXC_TYPE = 'KS'   --> Karasiev et al
!                       FXC_TYPE = 'VS'   --> Vashishta and Singwi
!                       FXC_TYPE = 'PD'   --> Perrot and Dharma-Wardana
!                       FXC_TYPE = 'EK'   --> Ebeling-Kraeft-Kremp-Röpke
!       * IDERIV   : type of n_point formula used for derivation (n = IDERIV)
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!       * TE       : temperature (SI)     
!
!  Output parameters:
!
!       * D_FXC    : first derivative at TH
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE DIMENSION_CODE,   ONLY : ND_MAX
      USE CONSTANTS_P1,     ONLY : K_B
      USE FERMI_SI,         ONLY : EF_SI
      USE DERIVATION  
      USE INTERPOLATION,    ONLY : INTERP_NR,SPLINE,SPLINT
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 2)   ::  FXC_TYPE
!
      INTEGER               ::  IDERIV,I,LOGF
!
      REAL (WP)             ::  RS,TI,TE,TH
      REAL (WP)             ::  D_FXC
!
      REAL (WP)             ::  T(ND_MAX),FXC(ND_MAX)
      REAL (WP)             ::  D_FXC_1(ND_MAX)
      REAL (WP)             ::  R_MIN,R_MAX,T_MIN,T_MAX,STEP
!
      TH=K_B*TE/EF_SI                                               !
!
      R_MIN=0.01E0_WP                                               ! min value of TH
      R_MAX=50.01E0_WP                                              ! max value of TH
!
      T_MIN=EF_SI*R_MIN/K_B                                         ! min value of T
      T_MAX=EF_SI*R_MAX/K_B                                         ! max value of T
      STEP=(T_MAX-T_MIN)/DFLOAT(ND_MAX-1)                           ! step in T
!
      LOGF=6                                                        !
!
!  Storing the exchange and correlation free energy FXC as a function of RS
!
      DO I=1,ND_MAX                                                 !
!
        T(I)=T_MIN+DFLOAT(I-1)*STEP                                 !
        TI=T(I)                                                     !
!
        IF(FXC_TYPE.EQ.'EB') THEN                                   !
          FXC(I)=FXC_EB_T(RS,TI)                                    !
        ELSEIF(FXC_TYPE.EQ.'IC') THEN                               !
          FXC(I)=FXC_IC_T(RS,TI)                                    !
        ELSEIF(FXC_TYPE.EQ.'VS') THEN                               !
          FXC(I)=FXC_VS_T(RS,TI)                                    !
        ELSEIF(FXC_TYPE.EQ.'PD') THEN                               !
          FXC(I)=FXC_PD_T(RS,TI)                                    !
        ELSEIF(FXC_TYPE.EQ.'KS') THEN                               !
          FXC(I)=FXC_KS_T(RS,TI)                                    !
        ELSEIF(FXC_TYPE.EQ.'EK') THEN                               !
          FXC(I)=FXC_EK_T(RS,TI)                                    !
        ENDIF                                                       !
!
      ENDDO                                                         !
!
!  Computing the first derivatives with respect to T
!    with a IDERIV-point formula
!  
      CALL DERIV_1(FXC,ND_MAX,IDERIV,STEP,D_FXC_1)                  !
!
!  Interpolation of derivative at TH
!
      CALL INTERP_NR(LOGF,T,D_FXC_1,ND_MAX,TE,D_FXC)                !
!
!  Transforming d FXC / dt into d FXC / dTH 
!
      D_FXC=D_FXC*K_B/EF_SI                                         !
!
      END SUBROUTINE DERIVE_FXC_3D
!
!=======================================================================
!
      SUBROUTINE FXC_TO_EXC_3D(FXC_TYPE,RS,T,EXC)
!
!  This subroutine transforms a XC free energy into an XC energy
!              
!  References: (1) S. Groth, T. Dornheim and M. Bonitz, 
!                     Contrib. Plasma Phys. 57, 137-146 (2017)
!
!  Input parameters:
!
!       * FXC_TYPE : type of XC free energy functional
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!       * T        : temperature (SI)  
!
!  Output parameters:
!
!       * EXC      : exchange and correlation energy (in Ryd)
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE CONSTANTS_P1,     ONLY : K_B
      USE FERMI_SI,         ONLY : EF_SI
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 2)   ::  FXC_TYPE
!
      REAL (WP)             ::  RS,T
      REAL (WP)             ::  TH,FXC_3D_T,FXC,D_FXC,EXC
!
      TH=K_B*T/EF_SI                                                !
!
! Computing the XC free energy functional
!
      FXC=FXC_3D(FXC_TYPE,RS,T)                                     !
!
!  Calling the derivative of FXC with respect to theta
!
      CALL DERIVE_FXC_3D(FXC_TYPE,5,RS,T,D_FXC)                     !
!
      EXC=FXC - TH*D_FXC                                            ! ref. (1) eq. (20)
!
      END SUBROUTINE FXC_TO_EXC_3D
!
!=======================================================================
!
      FUNCTION FXC_EB_T(RS,T)
!
!  Temperature-dependent exchange and correlation free energy 
!    for 3D systems as derived by Ebeling et al.
!              
!  References: (1) S. Groth, T. Dornheim and M. Bonitz, 
!                     Contrib. Plasma Phys. 57, 137-146 (2017)
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!       * T        : temperature (SI)     
!
!  Output parameters:
!
!       * FXC_EB_T : exchange and correlation free energy (in Ryd)
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,FOUR,EIGHT, & 
                                   HALF,THIRD,FOURTH
      USE CONSTANTS_P1,     ONLY : K_B
      USE FERMI_SI,         ONLY : EF_SI
      USE PI_ETC,           ONLY : PI_INV,SQR_PI
      USE UTILITIES_1,      ONLY : ALFA
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS,T
      REAL (WP)             ::  FXC_EB_T
      REAL (WP)             ::  TH,ALPHA
      REAL (WP)             ::  TH1,TH3,XS
      REAL (WP)             ::  EXC
      REAL (WP)             ::  A,B,C,D
      REAL (WP)             ::  NUM,DEN
!
      ALPHA=ALFA('3D')                                              !
!
      TH=K_B*T/EF_SI                                                !
      TH1=ONE/TH                                                    ! 1 / TH
      TH3=TH1*TH1*TH1                                               ! 1 / TH^3
      XS=DSQRT(RS)                                                  !
!
!  Ground-state parametrization of the XC energy
!
      EXC=0.9163E0_WP/RS + 0.1244E0_WP*DLOG(                       &!
                                             ONE + (2.117E0_WP/XS)/&! ref. (1) eq. (4)
                                            (ONE + 0.3008E0_WP*XS) &!
                                           )                        ! 
!
      A=TWO*THIRD/SQR_PI * DSQRT(EIGHT*THIRD) / (ALPHA*ALPHA)       ! ref. (1) eq. (6)
      B=TWO*THIRD*PI_INV/ALPHA                                      ! ref. (1) eq. (6)
      C=64.0E0_WP*THIRD*PI_INV                                      ! ref. (1) eq. (6)
      D=FOURTH*(ONE+DLOG(TWO))*DSQRT(THREE)*ALPHA*ALPHA             ! ref. (1) eq. (6)
!
      NUM=A*DSQRT(TH1)/XS + B*TH1/RS + C*TH3*EXC                    ! ref. (1) eq. (5)
      DEN=ONE + D*TH1*XS + C*TH3                                    ! ref. (1) eq. (5)
!
      FXC_EB_T=-HALF*NUM/DEN                                        ! ref. (1) eq. (5) 
!
      END FUNCTION FXC_EB_T
!
!=======================================================================
!
      FUNCTION FXC_IC_T(RS,T)
!
!  Temperature-dependent exchange and correlation free energy 
!    for 3D systems as derived by Ichimaru et al.
!              
!  References: (1) S. Groth, T. Dornheim and M. Bonitz, 
!                     Contrib. Plasma Phys. 57, 137-146 (2017)
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!       * T        : temperature (SI)     
!
!  Output parameters:
!
!       * FXC_IC_T : exchange and correlation free energy (in Ryd)
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,FOUR,HALF,THIRD
      USE CONSTANTS_P1,     ONLY : K_B
      USE FERMI_SI,         ONLY : EF_SI
      USE UTILITIES_1,      ONLY : ALFA
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS,T
      REAL (WP)             ::  FXC_IC_T
      REAL (WP)             ::  SQ2
      REAL (WP)             ::  TH1,TH2,TH3,TH4,XH1,XH2
      REAL (WP)             ::  RS2,XS
      REAL (WP)             ::  A,B,C,D,E,L,L2
      REAL (WP)             ::  BB,CC,DD,EE
      REAL (WP)             ::  NUM,DEN
      REAL (WP)             ::  X(17)
      REAL (WP)             ::  BCDE,ACE,SQED
!
      DATA X / 3.4130800E-1_WP, 1.2070873E+1_WP,   1.148889E0_WP, & !
               1.0495346E+1_WP,  1.3266230E0_WP,   8.72496E-1_WP, & !
                  2.5248E-2_WP,   6.14925E-1_WP, 1.6996055E+1_WP, & !
                 1.489056E0_WP,  1.010935E+1_WP,    1.22184E0_WP, & ! ref. (1) table 1
                 5.39409E-1_WP,   2.522206E0_WP,   1.78484E-1_WP, & ! 
                 2.555501E0_WP,   1.46319E-1_WP /                   !
!
      SQ2=DSQRT(TWO)                                                !
!
      L=ALFA('3D')                                                  !
      L2=L*L                                                        !
!
      RS2=RS*RS                                                     !
      XS=DSQRT(RS)                                                  !
!
      TH1=K_B*T/EF_SI                                               !
      TH2=TH1*TH1                                                   !   
      TH3=TH2*TH1                                                   !
      TH4=TH3*TH1                                                   !
      XH1=DSQRT(TH1)                                                !
      XH2=ONE/XH1                                                   !
!
      NUM=0.75E0_WP + 3.4363E0_WP*TH2  - 0.09227E0_WP*TH3 +      &  !
                      1.7035E0_WP*TH4                               !
      DEN=ONE      + 8.31051E0_WP*TH2  +  5.1105E0_WP*TH4           ! ref. (1) eq. (11)
      A=0.610887E0_WP*TANH(ONE/TH1)*NUM/DEN                         ! 
!
      NUM=X(1) + X(2)*TH2 + X(3)*TH4                                !
      DEN=ONE  + X(4)*TH2 + X(5)*TH4                                ! ref. (1) eq. (12)
      B=NUM/DEN                                                     !
!
      C=X(6) + X(7)*DEXP(-ONE/TH1)                                  ! ref. (1) eq. (12)
!
      NUM=X(8) +  X(9)*TH2 + X(10)*TH4                              !
      DEN=ONE  + X(11)*TH2 + X(12)*TH4                              ! ref. (1) eq. (13)
      D=NUM/DEN                                                     !
!
      NUM=X(13) + X(14)*TH2 + X(15)*TH4                             !
      DEN=ONE   + X(16)*TH2 + X(17)*TH4                             ! ref. (1) eq. (13)
      E=NUM/DEN                                                     !
!
      BB=XH1*TANH(XH2)*B                                            !
      DD=XH1*TANH(XH2)*D                                            ! ref. (1) eq. (17)
      EE=TH1*TANH(ONE/TH1)*E                                        !
      CC=EE*C                                                       !
!
      ACE = A - CC/EE                                               !
      BCDE=BB - CC*DD/EE                                            !
      SQED=DSQRT(FOUR*EE-DD*DD)                                     !
!
      FXC_IC_T=-CC/(RS*EE)                                         &!
               -HALF*TH1/(EE*RS2*L2) * (ACE - DD*BCDE/EE)          &!
               *DLOG(DABS(TWO*EE*L2*RS/TH1 + SQ2*DD*L*XS*XH2+ONE)) &!
               -SQ2*BCDE*XH1/(EE*XS*L)                             &!
               +TH1*(DD*ACE+(TWO-DD*DD/EE)*BCDE)/(RS2*L2*EE*SQED)  &!
               *( DATAN((TWO**1.5E0_WP * EE*L*XS*XH2 + DD)/SQED) - &!
                  DATAN(DD/SQED)                                   &!
                )                                                   !
!
      END FUNCTION FXC_IC_T
!
!=======================================================================
!
      FUNCTION FXC_VS_T(RS,T)
!
!  Temperature-dependent exchange and correlation free energy 
!    for 3D systems as derived by Vashishta-Singwi.
!              
!  References: (1) S. Groth, T. Dornheim and M. Bonitz, 
!                     Contrib. Plasma Phys. 57, 137-146 (2017)
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!       * T        : temperature (SI)     
!
!  Output parameters:
!
!       * FXC_VS_T : exchange and correlation free energy (in Ryd)
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,FOUR,HALF,THIRD
      USE CONSTANTS_P1,     ONLY : K_B
      USE FERMI_SI,         ONLY : EF_SI
      USE SQUARE_ROOTS,     ONLY : SQR2
      USE UTILITIES_1,      ONLY : ALFA
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS,T
      REAL (WP)             ::  FXC_VS_T
      REAL (WP)             ::  Q2
      REAL (WP)             ::  TH1,TH2,TH3,TH4,XH1,XH2
      REAL (WP)             ::  RS2,XS
      REAL (WP)             ::  A,B,C,D,E,L,L2 
      REAL (WP)             ::  BB,CC,DD,EE
      REAL (WP)             ::  NUM,DEN
      REAL (WP)             ::  X(17)
      REAL (WP)             ::  BCDE,ACE,SQED
!
      DATA X / 1.8871493E-1_WP, 1.0684788E+1_WP, 1.1088191E+2_WP,  &!
               1.8015380E+1_WP, 1.2803540E+2_WP, 8.3331352E-1_WP,  &!
              -1.1179213E-1_WP, 6.1492503E-1_WP, 1.6428929E+1_WP,  &! ref. (1) table 2
               2.5963096E+1_WP, 1.0905162E+1_WP, 2.9942171E+1_WP,  &!
               5.3940898E-1_WP, 5.8869626E+4_WP, 3.1165052E+3_WP,  &!
               3.8887108E+4_WP, 2.1774472E+3_WP                  /  !
!
      L=ALFA('3D')                                                  !
      L2=L*L                                                        !
!
      RS2=RS*RS                                                     !
      XS=DSQRT(RS)                                                  !
!
      TH1=K_B*T/EF_SI                                               !
      TH2=TH1*TH1                                                   !   
      TH3=TH2*TH1                                                   !
      TH4=TH3*TH1                                                   !
      XH1=DSQRT(TH1)                                                !
      XH2=ONE/XH1                                                   !
!
      NUM=0.75E0_WP +  3.4363E0_WP*TH2  - 0.09227E0_WP*TH3 +     &  !
                       1.7035E0_WP*TH4                              !
      DEN=ONE       + 8.31051E0_WP*TH2  +  5.1105E0_WP*TH4          ! ref. (1) eq. (11)
      A=0.610887E0_WP*TANH(ONE/TH1)*NUM/DEN                         ! 
!
      NUM=X(1) + X(2)*TH2 + X(3)*TH4                                !
      DEN=ONE  + X(4)*TH2 + X(5)*TH4                                ! ref. (1) eq. (12)
      B=NUM/DEN                                                     !
!
      C=X(6) + X(7)*DEXP(-ONE/TH1)                                  ! ref. (1) eq. (12)
!
      NUM=X(8) + X(9)*TH2  + X(10)*TH4                              !
      DEN=ONE  + X(11)*TH2 + X(12)*TH4                              ! ref. (1) eq. (13)
      D=NUM/DEN                                                     !
!
      NUM=X(13) + X(14)*TH2 + X(15)*TH4                             !
      DEN=ONE   + X(16)*TH2 + X(17)*TH4                             ! ref. (1) eq. (13)
      E=NUM/DEN                                                     !
!
      BB=XH1*TANH(XH2)*B                                            !
      DD=XH1*TANH(XH2)*D                                            ! ref. (1) eq. (17)
      EE=TH1*TANH(ONE/TH1)*E                                        !
      CC=EE*C                                                       !
!
      ACE = A - CC/EE                                               !
      BCDE=BB - CC*DD/EE                                            !
      SQED=DSQRT(FOUR*EE-DD*DD)                                     !
!
      FXC_VS_T=-CC/(RS*EE)                                         &!
               -HALF*TH1/(EE*RS2*L2) * (ACE - DD*BCDE/EE)          &!
               *DLOG(DABS(TWO*EE*L2*RS/TH1 + SQR2*DD*L*XS*XH2+ONE))&!
               -SQR2*BCDE*XH1/(EE*XS*L)                            &!
               +TH1*(DD*ACE+(TWO-DD*DD/EE)*BCDE)/(RS2*L2*EE*SQED)  &!
               *( DATAN((TWO**1.5E0_WP * EE*L*XS*XH2 + DD)/SQED) - &!
                  DATAN(DD/SQED)                                   &!
                )                                                   !
!
      END FUNCTION FXC_VS_T
!
!=======================================================================
!
      FUNCTION FXC_PD_T(RS,T)
!
!  Temperature-dependent exchange and correlation free energy 
!    for 3D systems as derived by Perrot and Dharma-Wardana.
!              
!  References: (1) S. Groth, T. Dornheim and M. Bonitz, 
!                     Contrib. Plasma Phys. 57, 137-146 (2017)
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!       * T        : temperature (SI)     
!
!  Output parameters:
!
!       * FXC_PD_T : exchange and correlation free energy (in Ryd)
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,THREE,FOUR,FIVE,HALF,THIRD
      USE CONSTANTS_P1,     ONLY : K_B
      USE FERMI_SI,         ONLY : EF_SI
      USE PI_ETC,           ONLY : PI
      USE UTILITIES_1,      ONLY : ALFA
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS,RS2,T,XS
      REAL (WP)             ::  FXC_PD_T
      REAL (WP)             ::  A1(3),B1(3),C1(3),A2(3),B2(3),C2(3)
      REAL (WP)             ::  V(3),R(3)
      REAL (WP)             ::  Y(3),Z(3),A(3),B(3)
      REAL (WP)             ::  TH1,TH2,TH3,XH1
      REAL (WP)             ::  Q1,Q2,Q3,XQ
      REAL (WP)             ::  N0,U1,U2,L,L2
      REAL (WP)             ::  NUM,DEN
      REAL (WP)             ::  P1,P2,EXC
!
      INTEGER I
!
      DATA A1 /  5.6304E0_WP,  5.2901E0_WP,   3.6854E0_WP   /       !
      DATA B1 / -2.2308E0_WP, -2.0512E0_WP,  -1.5385E0_WP   /       !
      DATA C1 /  1.7624E0_WP,  1.6185E0_WP,   1.2629E0_WP   /       !
      DATA A2 /  2.6083E0_WP, -15.076E0_WP,   2.4071E0_WP   /       ! ref. (1) table 3
      DATA B2 /  1.2782E0_WP,  24.929E0_WP,  0.78293E0_WP   /       !
      DATA C2 / 0.16625E0_WP,  2.0261E0_WP, 0.095869E0_WP   /       !
      DATA V  /     1.5E0_WP,     3.0E0_WP,      3.0E0_WP   /       !
      DATA R  /  4.4467E0_WP,  4.5581E0_WP,   4.3909E0_WP   /       !
!
      L=ALFA('3D')                                                  !
      L2=L*L                                                        !
!
      RS2=RS*RS                                                     !
      XS=DSQRT(RS)                                                  !
!
      TH1=K_B*T/EF_SI                                               !
      TH2=TH1*TH1                                                   !   
      TH3=TH2*TH1                                                   !
      XH1=DSQRT(TH1)                                                !
!
      Q1=HALF/(RS2*L2)                                              !
      Q2=Q1*Q1                                                      !
      Q3=Q2*Q1                                                      !
      XQ=DSQRT(Q1)                                                  !
!
      N0=THREE/(FOUR*PI*RS*RS2)                                     ! electron density
      U1=HALF*PI*N0                                                 !
      U2=TWO*THIRD*DSQRT(PI*N0)                                     !
!
!  Ground-state parametrization of the XC energy
!
      EXC=0.9163E0_WP/RS + 0.1244E0_WP*DLOG(                       &!
                                             ONE + (2.117E0_WP/XS)/&! ref. (1) eq. (4)
                                            (ONE + 0.3008E0_WP*XS) &!
                                           )                        ! 
!
      DO I=1,3
        B(I)=DEXP(FIVE*(RS-R(I)))                                   !
        NUM=A1(I) + B1(I)*RS + C1(I)*RS2                            !
        DEN=ONE + RS2/FIVE                                          !
        Y(I)=V(I)*DLOG(RS) + NUM/DEN                                !
        NUM=A2(I) + B2(I)*RS                                        !
        DEN=ONE + C2(I)*RS2                                         !
        Z(I)=RS*NUM/DEN                                             !
        NUM=Y(I) + B(I)*Z(I)                                        !
        DEN=ONE + B(I)                                              !
        A(I)=DEXP(NUM/DEN)                                          !
      ENDDO
!
      P1=(A(2)*U1 + A(3)*U2)*TH2*Q2 + A(2)*U2*TH2*XH1*Q2*XQ         !
      P2=ONE + A(1)*TH2*Q2 + A(3)*TH2*XH1*Q2*XQ + A(2)*TH3*Q3       !
!
      FXC_PD_T=(EXC-P1)/P2                                          ! ref. (1) eq. (18)
!
      END FUNCTION FXC_PD_T
!
!=======================================================================
!
      FUNCTION FXC_KS_T(RS,T)
!
!  Temperature-dependent exchange and correlation free energy 
!    for 3D systems as derived by Karasiev et al.
!              
!  References: (1) S. Groth, T. Dornheim and M. Bonitz, 
!                     Contrib. Plasma Phys. 57, 137-146 (2017)
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!       * T        : temperature (SI)     
!
!  Output parameters:
!
!       * FXC_KS_T : exchange and correlation free energy (in Ryd)
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE
      USE CONSTANTS_P1,     ONLY : K_B
      USE FERMI_SI,         ONLY : EF_SI
      USE UTILITIES_1,      ONLY : ALFA
!
      IMPLICIT NONE
!
      REAL (WP)             ::  RS,T
      REAL (WP)             ::  FXC_KS_T
      REAL (WP)             ::  TH1,TH2,TH3,TH4,XH1,XH2,XS,L 
      REAL (WP)             ::  B(4),C(3),D(5),E(5)
      REAL (WP)             ::  AA,BB,CC,DD,EE
      REAL (WP)             ::  NUM,DEN
!
      DATA B / 0.283997E0_WP,48.932154E0_WP,                      & ! 
               0.370919E0_WP,61.095357E0_WP/                        !
      DATA C / 0.870089E0_WP, 0.193077E0_WP, 2.414644E0_WP  /       !
      DATA D / 0.579824E0_WP,94.537454E0_WP,97.839603E0_WP,       & !
              59.939999E0_WP,24.388037E0_WP                 /       !
      DATA E / 0.212036E0_WP,16.731249E0_WP,28.485792E0_WP,       & !
              34.028876E0_WP,17.235515E0_WP                 /       ! 
!
      XS=DSQRT(RS)                                                  !
!
      TH1=K_B*T/EF_SI                                               !
      TH2=TH1*TH1                                                   !   
      TH3=TH2*TH1                                                   !
      TH4=TH3*TH1                                                   !
      XH1=DSQRT(TH1)                                                !
      XH2=ONE/XH1                                                   !
!
      L=ALFA('3D')                                                  !
!
      NUM=0.75E0_WP +  3.4363E0_WP*TH2  - 0.09227E0_WP*TH3 +      & !
                       1.7035E0_WP*TH4                              !
      DEN=ONE       + 8.31051E0_WP*TH2  +  5.1105E0_WP*TH4          ! ref. (1) eq. (11)
      AA=0.610887E0_WP*TANH(ONE/TH1)*NUM/DEN                        ! 
!
      NUM=B(1) + B(2)*TH2 + B(3)*TH4                                !
      DEN=ONE  + B(4)*TH2 + B(3)*TH4*DSQRT(1.5E0_WP)/L              !
      BB=TANH(XH2)*NUM/DEN                                          !
!
      NUM=D(1) + D(2)*TH2 + D(3)*TH4                                !
      DEN=ONE  + D(4)*TH2 + D(5)*TH4                                !
      DD=TANH(XH2)*NUM/DEN                                          !
!
      NUM=E(1) + E(2)*TH2 + E(3)*TH4                                !
      DEN=ONE  + E(4)*TH2 + E(5)*TH4                                !
      EE=TANH(ONE/TH1)*NUM/DEN                                      !
!
      CC=(C(1) + C(2)*DEXP(-C(3)/TH1))*EE                           !
!
      NUM=AA + BB*XS + CC*RS                                        !
      DEN=ONE+ DD*XS + EE*RS                                        !
!
      FXC_KS_T=-NUM/(DEN*RS)                                        ! ref. (1) eq. (19) 
!
      END FUNCTION FXC_KS_T
!
!=======================================================================
!
      FUNCTION FXC_EK_T(RS,T)
!
!  Temperature-dependent exchange and correlation free energy 
!    for 3D systems as derived by Ebeling et al.
!              
!  References: (1) W. Ebeling, W. D. Kraeft, D. Kremp and G. Röpke,
!                     Physica 140A, 160-168 (1986)
!
!  Input parameters:
!
!       * RS       : Wigner-Seitz radius of electron (in units of a_0)
!       * T        : temperature (SI)     
!
!  Output parameters:
!
!       * FXC_EB_T : exchange and correlation free energy (in Ryd)
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  9 Jun 2020
!
!
      USE REAL_NUMBERS,     ONLY : ONE,TWO,SIX,HALF,THIRD
      USE CONSTANTS_P1,     ONLY : K_B
      USE CONSTANTS_P2,     ONLY : HARTREE
!
      IMPLICIT NONE
!
      REAL*8 RS,T
      REAL*8 FXC_EK_T
      REAL*8 RS2,RS3,RS4,RS5,RS6,RS7,XS
      REAL*8 SQ6
      REAL*8 TAU,TA2,TA3,XTA
      REAL*8 D0,D1,DH,AH,AW,B0,B1,C1,C2
      REAL*8 AWR,NUM,DEN
!
      SQ6=DSQRT(SIX)                                                !
!
      RS2=RS*RS                                                     !
      RS3=RS2*RS                                                    !
      RS4=RS3*RS                                                    ! powers of RS
      RS5=RS4*RS                                                    !
      RS6=RS5*RS                                                    !
      RS7=RS6*RS                                                    !
      XS=DSQRT(RS)                                                  !
!
      TAU=HALF*K_B*T/HARTREE                                        ! ref. (1) eq. (21)
      TA2=TAU*TAU                                                   !
      TA3=TA2*TAU                                                   !
      XTA=DSQRT(TAU)                                                !
!
      D0=THIRD                                                      !
      D1= 0.3979E0_WP                                               !
      DH= 0.0625E0_WP                                               !
      AH=0.91633E0_WP                                               ! ref. (1) table I
      AW=0.87553E0_WP                                               !
      B0=0.06218E0_WP                                               !
      B1= 0.0933E0_WP                                               !
!
      C1=50.0E0_WP + RS3                                            !
      C2= 2.3E0_WP                                                  !
!
      AWR=TWO*B0*RS*DLOG( ONE + ONE/( XS*DEXP(-HALF*B1/B0) +     &  !
                                      TWO*B0*RS/AW               &  ! ref. (1) eq. (26)
                                    )                            &  !
                        )                                           !
!
      NUM=C1*(AH+AWR) + TWO*SQ6*D0*RS5*XS*TA2*XTA +              &  !
                        24.0E0_WP*DH*RS4*TA2                        !
      DEN=C1*RS + C2*RS4*TA2 + TWO*SQ6*D1*RS5*XS*TA2 + RS7*TA3      !
!
      FXC_EK_T=-NUM/DEN                                             ! ref. (1) eq. (25)
!
      END FUNCTION FXC_EK_T
!
END MODULE XC_ENERGIES
