!
!=======================================================================
!
MODULE CALCULATORS_3
!
      USE ACCURACY_REAL
!
!  This module contains the subroutines allowing to compute
!    various properties of the electron/plasma liquids:
!
!          * local field corrections    : CALC_LFC
!          * I(q) function              : CALC_IQF
!          * structure factor           : CALC_SFC
!          * pair correlation function  : CALC_PCF
!
!          * pair distribution function : CALC_PDF
!          * vertex function            : CALC_VTX
!          * plasmon damping coefficient: CALC_DMP
!
!          * q bounds                   : CALC_QBD
!          * relaxation time            : CALC_RLX
!          * screening wave number      : CALC_SCR
!          * omega = q * v_F            : CALC_QVF
!
!          * moments of Im[epsilon]     : CALC_MEP
!          * moments of S(q,omega)      : CALC_MSF
!          * moments of loss function   : CALC_MLO
!
!          * zeros of Re [epsilon]      : CALC_RE0
!
!          * inelastic mean free path   : CALC_MFP
!
!          * Fourier-space Nevalinna    : CALC_NEV
!          * time-space memory function : CALC_MEM
!
CONTAINS
!
!=======================================================================
!
      SUBROUTINE CALC_LFC(X)
!
!  This subroutine computes the local field correction G(q, omega)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Intermediate parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!  Output parameters:
!
!       * E        : energy array
!       * LFCR     : real part of local field correction
!       * LFCI     : imaginary part of local field correction
!
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  3 Dec 2020
!
      USE DIMENSION_CODE,     ONLY : NSIZE
      USE REAL_NUMBERS,       ONLY : ZERO
      USE MATERIAL_PROP,      ONLY : RS
      USE EXT_FIELDS,         ONLY : T
      USE LF_VALUES,          ONLY : GSTDY,GQ_TYPE,GQO_TYPE
      USE SF_VALUES,          ONLY : SQ_TYPE
!
      USE E_GRID
!
      USE LOCAL_FIELD_STATIC
      USE LOCAL_FIELD_STATIC_2
      USE LOCAL_FIELD_DYNAMIC
!
      USE OUT_VALUES_3,       ONLY : I_LF
      USE PRINT_FILES,        ONLY : IO_LF
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X
      REAL (WP)             ::  LFCR(NSIZE),LFCI(NSIZE),E(NSIZE)
      REAL (WP)             ::  RLFC,ILFC
      REAL (WP)             ::  EN,ETA
      REAL (WP)             ::  Y
!
      INTEGER               ::  IE,LOGF
!
      LOGF = 6                                                      !
!
      Y = X + X                                                     ! q/k_F
!
      IF(GSTDY == ' STATIC') THEN                                   !
!
!  Static local field correction:
!
!      1) G(q) not based on S(q)
!
        IF(GQ_TYPE /= 'HNCA' .AND. GQ_TYPE /= 'IKPA') THEN          !
          CALL LFIELD_STATIC(X,RS,T,GQ_TYPE,RLFC)                   !
        ELSE
!
!      1) G(q) based on S(q)
!
          IF(SQ_TYPE /= 'GEA' .AND. SQ_TYPE /= 'ICH' .AND.        & !
             SQ_TYPE /= 'PKA' .AND. SQ_TYPE /= 'SIN' .AND.        & !
             SQ_TYPE /= 'SPA') THEN          !
            CALL LFIELD_STATIC_2(X,RS,T,GQ_TYPE,RLFC)               !
          ELSE                                                      !
            WRITE(LOGF,10)                                          !
            STOP                                                    !
          END IF                                                    !
!
        END IF                                                      !
!
        LFCR(1) = RLFC                                              !
        LFCI(1) = ZERO                                              !
!
        IF(I_LF == 1) THEN                                          !  writing to
          WRITE(IO_LF,*)  Y,ZERO,RLFC,ZERO                          !  file
        END IF                                                      !
!
      ELSE                                                          !
!
!  Dynamic local field correction
!
        CALL LFIELD_DYNAMIC(X,RS,E_MIN,E_MAX,N_E,T,ETA,          &  !
                            GQO_TYPE,E,LFCR,LFCI)                   !
!
        IF(I_LF == 1) THEN                                          !
          DO IE = 1, N_E                                            ! writing to
            WRITE(IO_LF,*)  Y,E(IE),LFCR(IE),LFCI(IE)               !  file
          END DO                                                    !
        END IF                                                      !
!
      END IF                                                        !
!
!  Format:
!
  10  FORMAT(//,10X,'<<<<<  ERROR IN CALCULATOR_3 :: CALC_LFC  >>>>>', &
              /,10X,'<<<<<  WRONG CHOICE OF GQ_TYPE :: SQ_TYPE >>>>>', &
             //,10X,' -->  G(q) choice uses S(q) which uses G(q) <--',//)
!
      END SUBROUTINE CALC_LFC
!
!=======================================================================
!
      SUBROUTINE CALC_IQF(X)
!
!  This subroutine computes the local field correction I(q) = G(q,inf)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Intermediate parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!  Output parameters:
!
!       * IQR      : real part of I(q)
!       * IQI      : imaginary of I(q)
!
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 15 Sep 2020
!
      USE MATERIAL_PROP,      ONLY : RS,DMN
      USE EXT_FIELDS,         ONLY : T
!
      USE REAL_NUMBERS,       ONLY : ZERO
      USE LF_VALUES,          ONLY : GQ_TYPE,IQ_TYPE
      USE SF_VALUES,          ONLY : SQ_TYPE
      USE ENERGIES,           ONLY : EC_TYPE
      USE IQ_FUNCTIONS_1
!
      USE OUT_VALUES_3,       ONLY : I_IQ
      USE PRINT_FILES,        ONLY : IO_IQ
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN)  ::  X
      REAL (WP)              ::  IQ
      REAL (WP)              ::  Y
!
      Y = X + X                                                     ! q/k_F
!
      IF(DMN == '3D') THEN                                          !
        CALL IQ_3D(X,RS,IQ_TYPE,IQ)                                 !
      ELSE IF(DMN == '2D') THEN                                     !
        CONTINUE                                                    ! not implemented yet
      ELSE IF(DMN == '1D') THEN                                     !
        CONTINUE                                                    ! not implemented yet
      END IF                                                        !
!
      IF(I_IQ == 1) THEN                                            !  writing to
        WRITE(IO_IQ,*)  Y,IQ                                        !  file
      END IF                                                        !
!
      END SUBROUTINE CALC_IQF
!
!=======================================================================
!
      SUBROUTINE CALC_SFC(X)
!
!  This subroutine computes the structure factor S(q, omega)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Intermediate parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!  Output parameters:
!
!       * E        : energy array
!       * SFCR     : real part of the structure factor
!       * SFCI     : imaginary part of structure factor
!
!
!  Note: as S(q,omega) is proportional to the inverse of a
!        frequency, we renormalize it by multiplicating it
!        by E_F / h_bar to obtain a dimensionless quantity
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 21 Dec 2020
!
      USE DIMENSION_CODE,     ONLY : NSIZE
!
      USE MATERIAL_PROP,      ONLY : DMN,RS
      USE EXT_FIELDS,         ONLY : T
!
      USE REAL_NUMBERS,       ONLY : ZERO,ONE,FOURTH
      USE CONSTANTS_P1,       ONLY : H_BAR
      USE FERMI_SI,           ONLY : EF_SI
!
      USE E_GRID
!
      USE LF_VALUES,          ONLY : GQ_TYPE,IQ_TYPE
      USE SF_VALUES
      USE STRUCTURE_FACTOR_STATIC
      USE STRUCTURE_FACTOR_STATIC_2
      USE STRUCTURE_FACTOR_DYNAMIC
      USE STRUCTURE_FACTOR_DYNAMIC_2
!
      USE UTIC_VALUES
      USE RELAXATION_TIME_STATIC
      USE PLASMON_ENE_SI
      USE PLASMON_DISP_REAL
      USE DECAY_RATE
      USE UTIC_PARAMETERS
!
      USE OUT_VALUES_3,       ONLY : I_SF
      USE PRINT_FILES,        ONLY : IO_SF
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X
      REAL (WP)             ::  RSFC,ISFC
      REAL (WP)             ::  Z,EN,SQ,SQ_RN
      REAL (WP)             ::  Y
      REAL (WP)             ::  HOM_Q
      REAL (WP)             ::  E1,E2,E3,E4,E5,E6
!
      REAL (WP)             ::  FLOAT
!
      INTEGER               ::  IE,LOGF
!
      LOGF = 6                                                      !
!
      Y = X + X                                                     ! q/k_F
!
!  Storing the omega-independent UTIC parameters whenever necessary
!
      IF(SQO_TYPE == 'UTI') THEN                                    !
        IF(DMN == '3D') THEN                                        !
          TAU_Q = UTIC_RT_3D(X,RS,T,SQ_TYPE,GQ_TYPE)                ! tau(q)
          CALL PLASMON_DISP_3D_2(X,RS,T,'UTI_MOD',HOM_Q)            !
          OM_Q  = HOM_Q / H_BAR                                     ! omega(q)
          GAM_Q = UTIC_DR_3D(X,RS,T,SQ_TYPE,GQ_TYPE,IQ_TYPE)        ! gamma(q)
          CALL UTIC_PARAM(X,RS,T,MO_Q,MO_0)                         ! Omega(q), Omega(0)
!
          E1 = H_BAR / (TAU_Q * EF_SI)                              !
          E2 = ENE_P_SI /     EF_SI                                 !
          E3 = H_BAR * OM_Q / EF_SI                                 !
          E4 = ABS(H_BAR * GAM_Q  / EF_SI)                          !
          E5 = H_BAR * MO_Q / EF_SI                                 !
          E6 = H_BAR * MO_0 / EF_SI                                 !
!
          WRITE(1,*) Y,E1,E2,E3,E4,E5,E6                            !
        END IF
      END IF                                                        !
!
      IF(SSTDY == ' STATIC') THEN                                   !
!
!  Static structure factor
!
!      1) S(q) not based on G(q)
!
        IF(SQ_TYPE /= 'GEA' .AND. SQ_TYPE /= 'ICH' .AND.          & !
           SQ_TYPE /= 'PKA' .AND. SQ_TYPE /= 'SIN' .AND.          & !
           SQ_TYPE /= 'SPA') THEN                                   !
          CALL STFACT_STATIC(X,RS,T,SQ_TYPE,RSFC)                   !
!
!      2) S(q) based on G(q)
!
        ELSE                                                        !
!
          IF(GQ_TYPE /= 'HNCA' .AND. GQ_TYPE /= 'IKPA') THEN        !
            CALL STFACT_STATIC_2(X,RS,T,SQ_TYPE,RSFC)               !
          ELSE
            WRITE(LOGF,10)                                          !
            STOP                                                    !
          END IF                                                    !
!
        END IF                                                      !
        IF(I_SF == 1) THEN                                          !  writing to
          WRITE(IO_SF,*)  Y,ZERO,RSFC,ZERO                          !  file
        END IF                                                      !
!
      ELSE                                                          !
!
!  Dynamic structure factor
!
        DO IE = 1, N_E                                              ! energy loop
!
          EN = E_MIN + FLOAT(IE - 1) * E_STEP                       ! E = hbar omega / E_F
!
          Z = FOURTH * EN / (X * X)                                 ! Z = omega / omega_q
!
          IF(SQO_TYPE /= 'EPS') THEN                                !
            CALL STFACT_DYNAMIC(X,Z,RS,T,SQO_TYPE,SQ_TYPE,SQ)       !
          ELSE
            CALL STFACT_DYNAMIC_FROM_EPS(X,Z,RS,T,SQ)               !
          END IF                                                    !
!
          SQ_RN = SQ * EF_SI / H_BAR                                ! renormalized S(q,omega)
!
          IF(I_SF == 1) THEN                                        !  writing to
            WRITE(IO_SF,*)  Y,EN,SQ_RN,ZERO                         !  file
          END IF                                                    !
!
        END DO                                                      !
!
      END IF                                                        !
!
!  Format:
!
  10  FORMAT(//,10X,'<<<<<  ERROR IN CALCULATOR_3 :: CALC_SFC  >>>>>', &
              /,10X,'<<<<<  WRONG CHOICE OF SQ_TYPE :: GQ_TYPE >>>>>', &
             //,10X,' -->  S(q) choice uses G(q) which uses S(q) <--',//)
!
      END SUBROUTINE CALC_SFC
!
!=======================================================================
!
      SUBROUTINE CALC_PCF
!
!  This subroutine computes the pair correlation function g(r)
!
!
!
!  Intermediate parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * DMN      : problem dimension
!
!
!  Output parameters:
!
!       * GR       : g(r) ar r
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 29 Jul 2020
!
!
      USE MATERIAL_PROP,            ONLY : RS,DMN
      USE EXT_FIELDS,               ONLY : T
      USE PC_VALUES,                ONLY : GR_TYPE
      USE PD_VALUES,                ONLY : RH_TYPE
      USE PAIR_CORRELATION
!
      USE R_GRID
!
      USE OUT_VALUES_3,             ONLY : I_PC
      USE PRINT_FILES,              ONLY : IO_PC
!
      IMPLICIT NONE
!
      REAL (WP)             ::  R,GR
!
      REAL (WP)             ::  FLOAT
!
      INTEGER               ::  IR
!
      DO IR = 1, N_R                                                ! r loop
!
        R = R_MIN + FLOAT(IR - 1) * R_STEP                          ! r/a0 point
!
        IF(DMN == '3D') THEN                                        !
          CALL PAIR_CORRELATION_3D(R,RS,T,GR_TYPE,RH_TYPE,GR)       !
        ELSE IF(DMN == '2D') THEN                                   !
          CONTINUE                                                  !
        ELSE IF(DMN == '1D') THEN                                   !
          CONTINUE                                                  !
        END IF                                                      !
!
        IF(I_PC == 1) THEN                                          !
          WRITE(IO_PC,*) R,GR                                       !
        END IF                                                      !
!
      ENDDO                                                         !
!
      END SUBROUTINE CALC_PCF
!
!=======================================================================
!
      SUBROUTINE CALC_PDF
!
!  This subroutine computes the pair distribution function rho2(r)
!
!
!
!  Intermediate parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!       * DMN      : problem dimension
!
!
!  Output parameters:
!
!       * R2       : rho2(r) ar r
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 29 Jul 2020
!
!
      USE MATERIAL_PROP,            ONLY : RS,DMN
      USE EXT_FIELDS,               ONLY : T
      USE PD_VALUES,                ONLY : RH_TYPE
      USE PAIR_DISTRIBUTION
!
      USE R_GRID
!
      USE OUT_VALUES_3,             ONLY : I_P2
      USE PRINT_FILES,              ONLY : IO_P2
!
      IMPLICIT NONE
!
      REAL (WP)             ::  R,R2
!
      REAL (WP)             ::  FLOAT
!
      INTEGER               ::  IR
!
      DO IR = 1, N_R                                                ! r loop
!
        R = R_MIN + FLOAT(IR - 1) * R_STEP                          ! r/a0 point
!
        IF(DMN == '3D') THEN                                        !
          CALL PAIR_DISTRIBUTION_3D(R,RS,T,RH_TYPE,R2)              !
        ELSE IF(DMN == '2D') THEN                                   !
          CONTINUE                                                  !
        ELSE IF(DMN == '1D') THEN                                   !
          CONTINUE                                                  !
        END IF                                                      !
!
        IF(I_P2 == 1) THEN                                          !
          WRITE(IO_P2,*) R,R2                                       !
        END IF                                                      !
!
      END DO                                                        !
!
      END SUBROUTINE CALC_PDF
!
!=======================================================================
!
      SUBROUTINE CALC_VTX(X)
!
!  This subroutine computes the vertex function Gamma(q, omega)
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Intermediate parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!  Output parameters:
!
!       * E        : energy array
!       * VTXR     : real part of vertex function
!       * VTXI     : imaginary part vertex function
!
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 30 Apr 2020
!
      USE DIMENSION_CODE,     ONLY : NSIZE
      USE REAL_NUMBERS,       ONLY : ZERO,ONE,FOURTH,SMALL,INF
      USE COMPLEX_NUMBERS,    ONLY : IC
      USE MATERIAL_PROP,      ONLY : DMN,RS
      USE EXT_FIELDS,         ONLY : T,H
      USE LF_VALUES,          ONLY : GSTDY,GQ_TYPE,GQO_TYPE
      USE DF_VALUES,          ONLY : ESTDY,EPS_T,D_FUNC
!
      USE E_GRID
!
      USE SCREENING_TYPE
      USE SCREENING_VEC
!
      USE LOCAL_FIELD_STATIC
      USE LOCAL_FIELD_DYNAMIC
      USE DFUNC_STATIC
      USE DFUNCT_STAN_DYNAMIC
      USE DFUNCL_STAN_DYNAMIC
      USE DFUNCL_MAGN_DYNAMIC
!
      USE OUT_VALUES_3,       ONLY : I_VX
      USE PRINT_FILES,        ONLY : IO_VX
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  D_FUNCL,D_FUNCT
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  E(NSIZE)
      REAL (WP)             ::  LFCR(NSIZE),LFCI(NSIZE)
      REAL (WP)             ::  EPSR(NSIZE),EPSI(NSIZE)
      REAL (WP)             ::  VTXR,VTXI
      REAL (WP)             ::  RLFC,ILFC
      REAL (WP)             ::  REPS,IEPS
      REAL (WP)             ::  ETA
      REAL (WP)             ::  Z,EN
      REAL (WP)             ::  Y
!
      REAL (WP)             ::  A,NU,KS_SI
!
      REAL (WP)             ::  FLOAT
!
      COMPLEX (WP)          ::  EPS,LFC,VTX
!
      INTEGER               ::  IE
!
      A   = ZERO                                                    ! temporary
      NU  = ZERO                                                    !
!
      Y = X + X                                                     ! q / k_F
!
!  Computing the screening wave vector
!
      CALL SCREENING_VECTOR(SC_TYPE,DMN,X,RS,T,KS_SI)
!
!  1) Computing the local field correction
!
      IF(GSTDY == ' STATIC') THEN                                   !
!
!  Static local field correction
!
        CALL LFIELD_STATIC(X,RS,T,GQ_TYPE,RLFC)                     !
!
        LFCR(1) = RLFC                                              !
        LFCI(1) = ZERO                                              !
!
      ELSE                                                          !
!
!  Dynamic local field correction
!
        CALL LFIELD_DYNAMIC(X,RS,E_MIN,E_MAX,N_E,T,ETA,          &  !
                            GQO_TYPE,E,LFCR,LFCI)                   !
!
      END IF                                                        !
!
!  2) Computing the dielectric function
!
      IF(ESTDY == ' STATIC') THEN                                   !
!
!  Static dielectric function
!
        IF(EPS_T == 'LONG') THEN                                    !
!
          D_FUNCL = 'RPA1'                                          !
          CALL DFUNCL_STATIC(X,D_FUNCL,REPS,IEPS)                   ! longitudinal eps
          EPSR(1) = REPS                                            !
          EPSI(1) = IEPS                                            !
!
        ELSE                                                        !
          D_FUNCT = D_FUNC                                          !
          CONTINUE                                                  ! transverse eps
        END IF                                                      !
!
      ELSE                                                          !
!
!  Dynamic dielectric function
!
        DO IE = 1, N_E                                              ! energy loop
!
          EN = E_MIN + FLOAT(IE - 1) * E_STEP                       ! EN = hbar omega / E_F
!
          Z = FOURTH * EN / (X * X)                                 ! Z = omega / omega_q
!
          IF(EPS_T == 'LONG') THEN                                  ! longitudinal eps
!
            D_FUNCL = 'RPA1'                                        !
            IF(H < SMALL) THEN                                      !
              CALL DFUNCL_DYNAMIC(X,Z,RS,T,D_FUNCL,IE,REPS,IEPS)    ! no magnetic field
            ELSE                                                    !
              CALL DFUNCL_DYNAMIC_M(X,Z,KS_SI,A,NU,D_FUNCL,REPS,IEPS) ! magnetic field
            END IF                                                  !
          ELSE                                                      ! transverse eps
            D_FUNCT = D_FUNC                                        !
            IF(H < SMALL) THEN                                      !
              CALL DFUNCT_DYNAMIC(X,Z,D_FUNCT,REPS,IEPS)            ! no magnetic field
            ELSE                                                    !
              CONTINUE                                              ! magnetic field
            END IF                                                  !
          END IF                                                    !
!
          EPSR(IE) = REPS                                           !
          EPSI(IE) = IEPS                                           !
          E(IE)    = EN                                             !
!
        END DO                                                      ! end of energy loop
!
      END IF                                                        !
!
!  3) Computing the vertex function and writing to file
!
!      As we have chosen D_FUNCL='RPA1', PI = PI0 and the
!      vertex function is:
!
!                             1
!                    ---------------------
!                     1 + LFC * (EPS - 1)
!
!
      IF(I_VX == 1) THEN                                            !
        DO IE = 1, N_E                                              !
!
          LFC  = LFCR(IE) + IC * LFCI(IE)                           !
          EPS  = EPSR(IE) + IC * EPSI(IE)                           !
          VTX  = ONE / (ONE + LFC * (EPS - ONE))                    !
          VTXR =  REAL(VTX,KIND=WP)                                 !
          VTXI = AIMAG(VTX)                                         !

          WRITE(IO_VX,*)  Y,E(IE),VTXR,VTXI                         !
!
        END DO                                                      !
      END IF                                                        !
!
      END SUBROUTINE CALC_VTX
!
!=======================================================================
!
      SUBROUTINE CALC_DMP(IX,X)
!
!  This subroutine computes the plasmon damping coefficient gamma_q
!
!
!                            Im[ epsilon ]    |
!        gamma_q    =    -   _______________  |
!                                             |
!                     d Re[ epsilon ]/d omega | omega=Omega_q
!
!     where epsilon is the dielectric function.
!
!
!  Input parameters:
!
!       * IX       : index of X-point
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Intermediate parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!  Output parameters:
!
!       * E        : energy array
!       * VTXR     : real part of vertex function
!       * VTXI     : imaginary part vertex function
!
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 30 Apr 2021
!
!
      USE DIMENSION_CODE,     ONLY : NSIZE
      USE MATERIAL_PROP,      ONLY : RS
      USE EXT_FIELDS,         ONLY : T
!
      USE REAL_NUMBERS,       ONLY : ZERO,TWO,FOURTH,TTINY,INF
      USE FERMI_SI,           ONLY : KF_SI
!
      USE E_GRID
!
      USE DF_VALUES,           ONLY : D_FUNC
!
      USE INTEGRATION,         ONLY : INTEGR_L
      USE DFUNCL_STAN_DYNAMIC
!
      USE FIND_ZERO,           ONLY : FIND_ZERO_FUNC
      USE PLASMON_DAMPING,     ONLY : EXACT_DAMPING
!
      USE OUT_VALUES_3,        ONLY : I_DC
      USE PRINT_FILES,         ONLY : IO_DC
!
      IMPLICIT NONE
!
      INTEGER,INTENT(IN)    ::  IX
      INTEGER               ::  IE
      INTEGER               ::  IDERIV
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  D,TAU
      REAL (WP)             ::  Y,E,V,Z
      REAL (WP)             ::  REPS,IEPS
      REAL (WP)             ::  EN(NSIZE)
      REAL (WP)             ::  EPSR(NSIZE),EPSI(NSIZE)
      REAL (WP)             ::  ZEROF,GAMMA_Q
!
      REAL (WP)             ::  FLOAT
!
      IDERIV = 5                                                    !
!
      Y = X + X                                                     ! q/k_F
!
!  Constructing the e-grid
!
      DO IE = 1, N_E                                                ! E_F
!
        E = E_MIN + FLOAT(IE - 1) * E_STEP                          ! in units of
        V = E                                                       ! hbar * omega / E_F
        Z = FOURTH * V / (X * X)                                    ! omega / omega_q
!
!  Computing the dielectric function epsilon(q,E)
!
        CALL DFUNCL_DYNAMIC(X,Z,RS,T,D_FUNC,IE,REPS,IEPS)           !
!
        EN(IE)   = E                                                !
        EPSR(IE) = REPS                                             !
        EPSI(IE) = IEPS                                             !
!
      END DO                                                        !
!
!  Computing the plasmon energy at q:
!    Only the highest energy zero is kept
!
      CALL FIND_ZERO_FUNC(EN,EPSR,N_E,ZEROF)                        !
!
!  Computing the damping coefficient
!
      CALL EXACT_DAMPING(IX,IDERIV,N_E,EN,EPSR,EPSI,ZEROF,GAMMA_Q)  !
!
      IF(I_DC == 1) THEN                                            !
        WRITE(IO_DC,*) Y,GAMMA_Q                                    !
      END IF                                                        !
!
      END SUBROUTINE CALC_DMP
!
!=======================================================================
!
      SUBROUTINE CALC_QBD
!
!  This subroutine computes the plasmon q-bounds
!
!
!  Output parameters:
!
!       * Q_MIN    : plasmon lower q-bound
!       * Q_MAX    : plasmon upper q-bound
!
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  6 Oct 2020
!
!
      USE Q_BOUNDS
!
      USE OUT_VALUES_3,       ONLY : I_QC
      USE PRINT_FILES,        ONLY : IO_QC
!
      IMPLICIT NONE
!
      REAL (WP)              :: Q_MIN,Q_MAX
!
      CALL QBOUNDS(Q_MIN,Q_MAX)
!
      IF(I_QC == 1) THEN                                            !
        WRITE(IO_QC,*) Q_MIN,Q_MAX                                  !
      END IF                                                        !
!
      END SUBROUTINE CALC_QBD
!
!=======================================================================
!
      SUBROUTINE CALC_RLX(X)
!
!  This subroutine computes the relaxation time
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Output parameters:
!
!       * TAU      : relaxation time
!
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  7 Oct 2020
!
!
      USE MATERIAL_PROP,          ONLY : DMN,RS
      USE EXT_FIELDS,             ONLY : T
      USE PLASMA,                 ONLY : ZION
!
      USE SCREENING_VEC,          ONLY : DEBYE_VECTOR
      USE DAMPING_VALUES,         ONLY : VI_TYPE
      USE RELAXATION_TIME_STATIC
      USE VISCOSITY
!
      USE EL_PHO_INTER
!
      USE REAL_NUMBERS,           ONLY : ZERO
!
      USE OUT_VALUES_3,           ONLY : I_RL
      USE PRINT_FILES,            ONLY : IO_RL
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  Y,ETA,KD_SI,TAU
      REAL (WP)             ::  LR,S_L
!
      Y = X + X                                                     ! q/k_F
!
      LR     = ZERO                                                 ! residual mfp (temporary)
      S_L    = ZERO                                                 ! scattering length (temporary)
!
!  Computing the Debye momentum
!
      CALL DEBYE_VECTOR('3D',T,RS,KD_SI)                            !
!
!  Computation of the viscosity
!
      IF(DMN == '3D') THEN                                          !
        CALL VISCOSITY_3D(RS,T,ZION,KD_SI,X,ZERO,NA,MA,RA,        & !
                          DEBYE_T,EP_C,LR,VI_TYPE,ETA)              !
      ELSE IF(DMN == '2D') THEN                                     !
        CALL VISCOSITY_2D(T,S_L,VI_TYPE,ETA)                        !
      ELSE IF(DMN == '1D') THEN                                     !
        ETA = ZERO                                                  ! not yet implemented
      END IF                                                        !
!
!  Computing the relaxation time
!
      CALL RELAXATION_TIME(X,TAU)                                   !
!
      IF(I_RL == 1) THEN                                            !
        WRITE(IO_RL,*) Y,TAU                                        !
      END IF                                                        !
!
      END SUBROUTINE CALC_RLX
!
!=======================================================================
!
      SUBROUTINE CALC_SCR(X)
!
!  This subroutine computes the screening wave number
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Output parameters:
!
!       * KS       : screening wave number
!
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 13 Oct 2020
!
!
      USE MATERIAL_PROP,          ONLY : DMN,RS
      USE EXT_FIELDS,             ONLY : T
!
      USE CONSTANTS_P1,           ONLY : BOHR
      USE SCREENING_TYPE
      USE SCREENING_VEC
      USE SCREENING_VEC2
!
      USE OUT_VALUES_3,           ONLY : I_KS
      USE PRINT_FILES,            ONLY : IO_KS
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  Y
      REAL (WP)             ::  KS_SI,KS
!
      Y = X + X                                                     ! q / k_F
!
      IF(SC_TYPE == 'DH' .OR. SC_TYPE == 'TF') THEN                 !
        CALL SCREENING_VECTOR(SC_TYPE,DMN,X,RS,T,KS_SI)             !
      ELSE                                                          !
        CALL SCREENING_VECTOR2(SC_TYPE,DMN,X,RS,T,KS_SI)            !
      END IF                                                        !
!
      KS = KS_SI * BOHR                                             ! KS in units of a_0
!
      IF(I_KS == 1) THEN                                            !
        WRITE(IO_KS,*) Y,KS                                         !
      END IF                                                        !
!
      END SUBROUTINE CALC_SCR
!
!=======================================================================
!
      SUBROUTINE CALC_QVF(X)
!
!  This subroutine computes the omega = q * v_F (U = 1) equation, as well
!    as  U + X = 1  and U - X = 1
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Output parameters:
!
!       * OM       : omega
!
!
!                                       hbar omega
!  Note: We use here the fact that V = ------------ = 4 * U * X
!                                          E_F
!
!
!        Therefore    U     =  1   <==>  V = 4 * X
!                     U + X =  1   <==>  V = 4 * (1 - X) * X
!                     U - X =  1   <==>  V = 4 * (1 + X) * X
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 25 Nox 2020
!
!
      USE REAL_NUMBERS,           ONLY : ONE,FOUR
!
      USE OUT_VALUES_3,           ONLY : I_OQ
      USE PRINT_FILES,            ONLY : IO_OQ
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  Y,OM0,OM1,OM2
!
      Y = X + X                                                     ! q / k_F
!
      OM0 = FOUR * X                                                !
      OM1 = FOUR * (ONE - X) * X                                    !
      OM2 = FOUR * (ONE + X) * X                                    !
!
      IF(I_OQ == 1) THEN                                            !
        WRITE(IO_OQ,*) Y,OM0,OM1,OM2                                !
      END IF                                                        !
!
      END SUBROUTINE CALC_QVF
!
!=======================================================================
!
      SUBROUTINE CALC_MEP(X)
!
!  This subroutine computes the moments of the
!     imaginary part of the dielectric function
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Output parameters:
!
!       * MEP      : moment of S(q,omega) function in reduced units
!
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 21 Oct 2020
!
!
      USE MOMENTS
      USE MOMENTS_CALC
!
      USE OUT_VALUES_3,       ONLY : I_ME
      USE PRINT_FILES,        ONLY : IO_ME
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  Y,MEP
!
      Y = X + X                                                     ! q/k_F
!
      CALL MOMENTS_EPSILON(X,N_M,MEP)                               !
!
      IF(I_ME == 1) THEN                                            !  writing to
        WRITE(IO_ME,*)  Y,MEP                                       !  file
      END IF                                                        !
!
      END SUBROUTINE CALC_MEP
!
!=======================================================================
!
      SUBROUTINE CALC_MSF(X)
!
!  This subroutine computes the moments of the
!     dynamical structure factor
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Output parameters:
!
!       * MSF      : moment of S(q,omega) function in reduced units
!
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 20 Oct 2020
!
!
      USE MOMENTS
      USE MOMENTS_CALC
!
      USE OUT_VALUES_3,       ONLY : I_MS
      USE PRINT_FILES,        ONLY : IO_MS
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  Y,MSF
!
      Y = X + X                                                     ! q/k_F
!
      CALL MOMENTS_STRUCT_FACTOR(X,N_M,MSF)                         !
!
      IF(I_MS == 1) THEN                                            !  writing to
        WRITE(IO_MS,*)  Y,MSF                                       !  file
      END IF                                                        !
!
      END SUBROUTINE CALC_MSF
!
!=======================================================================
!
      SUBROUTINE CALC_MLO(X)
!
!  This subroutine computes the moments of the loss function
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Output parameters:
!
!       * MLO      : moment of loss function in reduced units
!
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 20 Oct 2020
!
!
      USE MOMENTS
      USE MOMENTS_CALC
!
      USE OUT_VALUES_3,       ONLY : I_ML
      USE PRINT_FILES,        ONLY : IO_ML
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  Y,MLO
!
      Y = X + X                                                     ! q/k_F
!
      CALL MOMENTS_LOSS_FUNCTION(X,N_M,MLO)                         !
!
      IF(I_ML == 1) THEN                                            !  writing to
        WRITE(IO_ML,*)  Y,MLO                                       !  file
      END IF                                                        !
!
      END SUBROUTINE CALC_MLO
!
!=======================================================================
!
      SUBROUTINE CALC_RE0(X)
!
!  This subroutine computes the zeros of the real part of
!    the dielectric function: Re[ epsilon(q,omega) ]
!
!
!  Input parameters:
!
!       * X        : dimensionless factor   --> X = q / (2 * k_F)
!
!
!  Intermediate parameters:
!
!       * RS       : Wigner-Seitz radius (in units of a_0)
!       * T        : temperature in SI
!
!
!  Output parameters:
!
!       * Y        : q / k_F
!       * RE0      : zeros of real part dielectric function
!
!
!  Note: By setting a non-zero value to variable SHF, the subroutine
!          will solve Re[ epsilon(q,omega) ] = - SHF
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 30 Apr 2021
!
!
      USE MATERIAL_PROP,      ONLY : DMN,RS
      USE EXT_FIELDS,         ONLY : T,H
      USE DF_VALUES,          ONLY : ESTDY,EPS_T,D_FUNC
!
      USE DIMENSION_CODE,     ONLY : NSIZE
      USE REAL_NUMBERS,       ONLY : ZERO,FOURTH,SMALL,INF
!
      USE E_GRID
!
      USE SCREENING_TYPE
      USE SCREENING_VEC
!
      USE DFUNC_STATIC
      USE DFUNCT_STAN_DYNAMIC
      USE DFUNCL_STAN_DYNAMIC
      USE DFUNCL_MAGN_DYNAMIC
!
      USE FIND_ZERO
!
      USE OUT_VALUES_3,       ONLY : I_ZE
      USE PRINT_FILES,        ONLY : IO_ZE
!
      IMPLICIT NONE
!
      CHARACTER (LEN = 4)   ::  D_FUNCL,D_FUNCT
!
      REAL (WP), INTENT(IN) ::  X
      REAL (WP)             ::  EN
      REAL (WP)             ::  Y,Z
      REAL (WP)             ::  REPS,IEPS
      REAL (WP)             ::  E(NSIZE)
      REAL (WP)             ::  EPSR(NSIZE)
      REAL (WP)             ::  ZEROF
!
      REAL (WP)             ::  A,NU,KS_SI
      REAL (WP)             ::  LFT,TAU,DR,D,ETA
!
      REAL (WP), PARAMETER  ::  SHF = 0.0E0_WP
!
      REAL (WP)             ::  FLOAT
!
      INTEGER               ::  IE
!
      A   = ZERO                                                    ! temporary
      NU  = ZERO                                                    !
!
      Y = X + X                                                     ! q / k_F
!
!  Computing the screening wave vector
!
      CALL SCREENING_VECTOR(SC_TYPE,DMN,X,RS,T,KS_SI)
!
!  Computing the dynamic dielectric function
!
      DO IE = 1, N_E                                                ! energy loop
!
        EN = E_MIN + FLOAT(IE - 1) * E_STEP                         ! EN = hbar omega / E_F
!
        Z = FOURTH * EN / (X * X)                                   ! Z = omega / omega_q
!
        IF(EPS_T == 'LONG') THEN                                    ! longitudinal eps
!
          D_FUNCL = D_FUNC                                          !
          IF(H < SMALL) THEN                                        !
            CALL DFUNCL_DYNAMIC(X,Z,RS,T,D_FUNCL,IE,REPS,IEPS)      ! no magnetic field
          ELSE                                                      !
            CALL DFUNCL_DYNAMIC_M(X,Z,KS_SI,A,NU,D_FUNCL,REPS,IEPS) ! magnetic field
          END IF                                                    !
        ELSE                                                        ! transverse eps
          D_FUNCT = D_FUNC                                          !
          IF(H < SMALL) THEN                                        !
            CALL DFUNCT_DYNAMIC(X,Z,D_FUNCT,REPS,IEPS)              ! no magnetic field
          ELSE                                                      !
            CONTINUE                                                ! magnetic field
          END IF                                                    !
        END IF                                                      !
!
        EPSR(IE) = REPS  +  SHF                                     !
        E(IE)    = EN                                               !
!
      END DO                                                        ! end of energy loop
!
!  Computing the zeros of EPSR
!
      IF(I_ZE == 1) THEN                                            !
        CALL PRINT_ZERO_FUNC(Y,E,EPSR,N_E)                          !
      END IF                                                        !
!
      END SUBROUTINE CALC_RE0
!
!=======================================================================
!
      SUBROUTINE CALC_MFP
!
!  This subroutine computes the inelastic mean free path
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 19 Oct 2020
!
!
      USE REAL_NUMBERS,           ONLY : SMALL
      USE FERMI_SI,               ONLY : EF_SI
      USE ENE_CHANGE,             ONLY : EV,ANG
!
      USE ELECTRON_MEAN_FREE_PATH
      USE IMFP
!
      USE OUT_VALUES_3,           ONLY : I_MF
      USE PRINT_FILES,            ONLY : IO_MF
!
      IMPLICIT NONE
!
      INTEGER               ::  IE
      INTEGER, PARAMETER    ::  NE_MAX = 1480     ! max. number of energy points
!
      REAL (WP)             ::  LAMBDA
      REAL (WP)             ::  E_STEP
      REAL (WP)             ::  E,EK
      REAL (WP)             ::  E_MIN,E_MAX
!
      REAL (WP)             ::  FLOAT
!
      E_MIN = EK_INI                                                ! lower value in eV
      E_MAX = EK_FIN                                                ! upper value in eV
!
      E_STEP = (E_MAX - E_MIN) / FLOAT(NE_MAX - 1)                  ! e-step in eV
!
      DO IE = 1, NE_MAX                                             !
!
        E  = E_MIN + FLOAT(IE - 1) * E_STEP                         ! E in eV
        EK = E * EV                                                 ! E in SI
!
        CALL MEAN_FREE_PATH(EK,LAMBDA)                              ! IMFP in SI
        LAMBDA = LAMBDA / ANG                                       ! IMFP in Angström
!
        IF(I_MF == 1) THEN                                          !
          WRITE(IO_MF,*) E,LAMBDA                                   !
        END IF                                                      !
!
      END DO                                                        ! end of energy loop
!
      END SUBROUTINE CALC_MFP
!
!=======================================================================
!
      SUBROUTINE CALC_NEV(X)
!
!  This subroutine computes the Fourier space  Nevalinna/memory function
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 28 Jan 2021
!
!
      USE MATERIAL_PROP,          ONLY : RS
      USE EXT_FIELDS,             ONLY : T
!
      USE E_GRID
!
      USE REAL_NUMBERS,           ONLY : FOURTH
!
      USE RELAXATION_TIME_STATIC
      USE MEMORY_FUNCTIONS_F
      USE NEVALINNA_FUNCTIONS
!
      USE DF_VALUES,              ONLY : D_FUNC,NEV_TYPE,MEM_TYPE,ALPHA,BETA
      USE DAMPING_SI
      USE DAMPING_VALUES,         ONLY : PCT
!
      USE OUT_VALUES_3,           ONLY : I_NV
      USE PRINT_FILES,            ONLY : IO_NV
!
      IMPLICIT NONE
!
      INTEGER               ::  IE,I_F
!
      REAL (WP), INTENT(IN) ::  X
!
      REAL (WP)             ::  Y,Z
      REAL (WP)             ::  E
      REAL (WP)             ::  NEVR,NEVI
!
      REAL (WP)             ::  FLOAT,REAL,AIMAG
!
      COMPLEX (WP)          ::  FUNC
!
      Y = X + X                                                     ! q / k_F
!
!  Check for Nevanlinna or memory function --> switch I_F
!
      IF(D_FUNC(1:3) == 'NEV') THEN                                 !
        I_F = 1                                                     !
      ELSE IF(D_FUNC(1:3) == 'MEM') THEN                            !
        I_F = 2                                                     !
      ELSE                                                          !
        I_F = 0                                                     !
      END IF                                                        !
!
      DO IE = 1, N_E                                                ! energy loop
!
        E = E_MIN + FLOAT(IE - 1) * E_STEP                          ! E = hbar omega / E_F
!
        Z = FOURTH * E / (X * X)                                    ! Z = omega / omega_q
!
        IF(I_F == 1) THEN                                           !
          FUNC = NEVAN2(X,Z,RS,T,TAU,NEV_TYPE)                      !
        ELSE IF(I_F == 2) THEN                                      !
          FUNC = MEMORY_F(E,TAU,TAU2,PCT,ALPHA,BETA,MEM_TYPE)       !
        END IF                                                      !
!
        NEVR =  REAL(FUNC,KIND=WP)                                  !
        NEVI = AIMAG(FUNC)                                          !
!
        IF(I_NV == 1) THEN                                          !
          WRITE(IO_NV,*) Y,E,NEVR,NEVI                              !
        END IF                                                      !
!
      END DO                                                        ! end of energy loop
!
      END SUBROUTINE CALC_NEV
!
!=======================================================================
!
      SUBROUTINE CALC_MEM
!
!  This subroutine computes the time-domain memory function
!   as a function of t / tau
!
!  When tau is q-dependent, the only vamue considered is the first one
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 28 Jan 2021
!
!
      USE REAL_NUMBERS,           ONLY : ZERO,TEN,HALF
!
      USE Q_GRID,                 ONLY : Q_MIN
!
      USE DF_VALUES,              ONLY : ALPHA,BETA,MEM_TYPE
      USE DAMPING_SI
      USE DAMPING_VALUES,         ONLY : PCT
!
      USE RELAXATION_TIME_STATIC
      USE MEMORY_FUNCTIONS_T
!
      USE OUT_VALUES_3,           ONLY : I_MT
      USE PRINT_FILES,            ONLY : IO_MT
!
      IMPLICIT NONE
!
      INTEGER               ::  IT
      INTEGER, PARAMETER    ::  NT_MAX = 200      ! max. number of time points
!
      REAL (WP)             ::  MEMR
      REAL (WP)             ::  T                 ! t / tau
      REAL (WP)             ::  T1                !  t
      REAL (WP)             ::  T_MIN,T_MAX,T_STEP
      REAL (WP)             ::  X
!
      REAL (WP)             ::  FLOAT
!
      T_MIN = ZERO                                                  ! lower time value
      T_MAX = TEN                                                   ! upper time value
      X     = Q_MIN * HALF                                          ! initial value of q / 2 k_F
!
      T_STEP = (T_MAX - T_MIN) / FLOAT(NT_MAX - 1)                  ! t-step in units of tau
!
      DO IT = 1, NT_MAX                                             !
!
        T  = T_MIN + FLOAT(IT - 1) * T_STEP                         ! t in units of tau
!
        T1 = T * TAU                                                ! time is SI
!
        MEMR = MEMORY_T(T1,TAU,TAU2,PCT,ALPHA,BETA,MEM_TYPE) *    & !
               TAU * TAU                                            ! in units of 1 / tau^2
!
        IF(I_MT == 1) THEN                                          !
          WRITE(IO_MT,*) T,MEMR                                     !
        END IF                                                      !
!
      END DO                                                        ! end of time loop
!
      END SUBROUTINE CALC_MEM
!
END MODULE CALCULATORS_3
