MsSpec-DFM/New_libraries/DFM_library/CALCULATORS_LIBRARY/calculators_1.f90

533 lines
19 KiB
Fortran
Raw Normal View History

2022-02-02 16:19:10 +01:00
!
!=======================================================================
!
MODULE CALCULATORS_1
!
USE ACCURACY_REAL
!
! This module contains the subroutines allowing to compute
! various properties of the electron/plasma liquids:
!
! * dielectric function : CALC_EPS
! * polarization function : CALC_POL
! * susceptibility function : CALC_SUS
! * electrical conductivity : CALC_CDV
!
!
CONTAINS
!
!=======================================================================
!
SUBROUTINE CALC_EPS(X,E,EPSR,EPSI)
!
! This subroutine computes the dielectric function 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:
!
! * E : energy array
! * EPSR : real part of the dielectric function
! * EPSI : imaginary part of the dielectric function
!
!
!
!
! Author : D. Sébilleau
!
! Last modified : 30 Apr 2021
!
!
USE DIMENSION_CODE, ONLY : NSIZE
USE REAL_NUMBERS, ONLY : ZERO,FOURTH,SMALL
USE MATERIAL_PROP, ONLY : RS
USE EXT_FIELDS, ONLY : T,H
!
USE E_GRID
!
USE OUT_VALUES_1, ONLY : I_DF
USE PRINT_FILES, ONLY : IO_DF
!
USE DF_VALUES, ONLY : ESTDY,EPS_T,D_FUNC
USE DFUNC_STATIC
USE DFUNCT_STAN_DYNAMIC
USE DFUNCL_STAN_DYNAMIC
USE DFUNCL_MAGN_DYNAMIC
!
IMPLICIT NONE
!
CHARACTER (LEN = 4) :: D_FUNCL,D_FUNCT
!
REAL (WP), INTENT(IN) :: X
REAL (WP) :: EPSR(NSIZE),EPSI(NSIZE),E(NSIZE)
REAL (WP) :: Y
REAL (WP) :: REPS,IEPS
REAL (WP) :: Z,EN,KS,A,NU
!
REAL (WP) :: FLOAT
!
INTEGER :: IE
!
Y = X + X ! q / k_F
!
IF(ESTDY == ' STATIC') THEN !
!
! Static dielectric function
!
IF(EPS_T == 'LONG') THEN !
!
D_FUNCL = D_FUNC !
CALL DFUNCL_STATIC(X,D_FUNCL,REPS,IEPS) ! longitudinal eps
EPSR(1) = REPS !
EPSI(1) = IEPS !
!
IF(I_DF == 1) THEN !
WRITE(IO_DF,*) Y,REPS,IEPS !
END IF !
!
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 = 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,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 !
!
IF(I_DF == 1) THEN ! writing to
WRITE(IO_DF,*) Y,EN,REPS,IEPS ! file
END IF !
!
END DO ! end of energy loop
!
END IF !
!
END SUBROUTINE CALC_EPS
!
!=======================================================================
!
SUBROUTINE CALC_POL(X)
!
! This subroutine computes the polarisation function Pi(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
! * DIM : problem dimension
!
!
! Output parameters:
!
! * E : energy array
! * POLR : real part of the dielectric function
! * POLI : imaginary part of the dielectric function
!
!
!
!
! Author : D. Sébilleau
!
! Last modified : 30 Apr 2021
!
!
USE DIMENSION_CODE, ONLY : NSIZE
USE EXT_FIELDS, ONLY : T,H
USE REAL_NUMBERS, ONLY : ZERO,TWO,FOURTH,SMALL
USE FERMI_SI, ONLY : KF_SI
USE DF_VALUES, ONLY : ESTDY,EPS_T,D_FUNC
USE MATERIAL_PROP, ONLY : RS,DMN
USE UTILITIES_3, ONLY : EPS_TO_PI
USE COULOMB_K, ONLY : COULOMB_FF
!
USE E_GRID
USE UNITS, ONLY : UNIT
!
USE DFUNC_STATIC
USE DFUNCT_STAN_DYNAMIC
USE DFUNCL_STAN_DYNAMIC
USE DFUNCL_MAGN_DYNAMIC
!
USE OUT_VALUES_1, ONLY : I_PZ
USE PRINT_FILES, ONLY : IO_PZ
!
IMPLICIT NONE
!
CHARACTER (LEN = 4) :: D_FUNCL,D_FUNCT
!
REAL (WP), INTENT(IN) :: X
REAL (WP) :: REPS,IEPS,RPOL,IPOL
REAL (WP) :: Z,EN,Q,VC,KS,A,NU
REAL (WP) :: Y
!
REAL (WP) :: FLOAT
!
INTEGER :: IE
!
Y = X + X ! q / k_F
Q = TWO * X * KF_SI ! q in SI
!
! Computing the Coulomb potential
!
CALL COULOMB_FF(DMN,UNIT,Q,ZERO,VC) !
!
IF(ESTDY == ' STATIC') THEN !
!
! Static polarisation function
!
IF(EPS_T == 'LONG') THEN !
!
D_FUNCL = D_FUNC !
CALL DFUNCL_STATIC(X,D_FUNCL,REPS,IEPS) ! longitudinal eps
!
CALL EPS_TO_PI(REPS,IEPS,VC,RPOL,IPOL) !
!
IF(I_PZ == 1) THEN !
WRITE(IO_PZ,*) Y,RPOL,IPOL !
END IF !
!
ELSE !
D_FUNCT = D_FUNC !
CONTINUE ! transverse eps
END IF !
!
ELSE !
!
! Dynamic polarisation function
!
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(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,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 !
!
CALL EPS_TO_PI(REPS,IEPS,VC,RPOL,IPOL) !
!
IF(I_PZ == 1) THEN ! writing to
WRITE(IO_PZ,*) Y,EN,RPOL,IPOL ! file
END IF !
!
END DO ! end of energy loop
!
END IF !
!
END SUBROUTINE CALC_POL
!
!=======================================================================
!
SUBROUTINE CALC_SUS(X)
!
! This subroutine computes the susceptibility function chi(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
! * DIM : problem dimension
!
!
! Output parameters:
!
! * E : energy array
! * SUSR : real part of the susceptibility function
! * SUSI : imaginary part of the susceptibility function
!
!
!
!
! Author : D. Sébilleau
!
! Last modified : 30 Apr 2021
!
!
USE DIMENSION_CODE, ONLY : NSIZE
USE REAL_NUMBERS, ONLY : ZERO,TWO,FOURTH,SMALL
USE FERMI_SI, ONLY : KF_SI
USE DF_VALUES, ONLY : ESTDY,EPS_T,D_FUNC
USE MATERIAL_PROP, ONLY : RS,DMN
USE EXT_FIELDS, ONLY : T,H
USE UTILITIES_3, ONLY : EPS_TO_CHI
USE COULOMB_K, ONLY : COULOMB_FF
!
USE E_GRID
USE UNITS, ONLY : UNIT
!
USE DFUNC_STATIC
USE DFUNCT_STAN_DYNAMIC
USE DFUNCL_STAN_DYNAMIC
USE DFUNCL_MAGN_DYNAMIC
!
USE OUT_VALUES_1, ONLY : I_SU
USE PRINT_FILES, ONLY : IO_SU
!
IMPLICIT NONE
!
CHARACTER (LEN = 4) :: D_FUNCL,D_FUNCT
!
REAL (WP), INTENT(IN) :: X
REAL (WP) :: REPS,IEPS,RSUS,ISUS
REAL (WP) :: Z,EN,Q,VC,KS,A,NU
REAL (WP) :: Y
!
REAL (WP) :: FLOAT
!
INTEGER :: IE
!
Y = X + X ! q / k_F
Q = TWO * X * KF_SI ! q in SI
!
! Computing the Coulomb potential
!
CALL COULOMB_FF(DMN,UNIT,Q,ZERO,VC) !
!
IF(ESTDY == ' STATIC') THEN !
!
! Static susceptibility function
!
IF(EPS_T == 'LONG') THEN !
!
D_FUNCL = D_FUNC !
CALL DFUNCL_STATIC(X,D_FUNCL,REPS,IEPS) ! longitudinal eps
!
CALL EPS_TO_CHI(REPS,IEPS,VC,RSUS,ISUS) !
!
IF(I_SU == 1) THEN !
WRITE(IO_SU,*) Y,RSUS,ISUS !
END IF !
!
ELSE !
D_FUNCT = D_FUNC !
CONTINUE ! transverse eps
END IF !
!
ELSE !
!
! Dynamic suceptibility function
!
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(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,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 !
!
CALL EPS_TO_CHI(REPS,IEPS,VC,RSUS,ISUS) !
!
IF(I_SU == 1) THEN ! writing to
WRITE(IO_SU,*) Y,EN,RSUS,ISUS ! file
END IF !
!
END DO ! end of energy loop
!
END IF !
!
END SUBROUTINE CALC_SUS
!
!=======================================================================
!
SUBROUTINE CALC_CDV(X)
!
! This subroutine computes the conductivity function sigma(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
! * CDVR : real part of the conductivity function
! * CDVI : imaginary part of the conductivity function
!
!
!
!
! Author : D. Sébilleau
!
! Last modified : 30 Apr 2021
!
!
USE DIMENSION_CODE, ONLY : NSIZE
USE REAL_NUMBERS, ONLY : ZERO,TWO,FOURTH,SMALL
USE FERMI_SI, ONLY : KF_SI
USE DF_VALUES, ONLY : ESTDY,EPS_T,D_FUNC
USE MATERIAL_PROP, ONLY : RS
USE EXT_FIELDS, ONLY : T,H
USE UTILITIES_3, ONLY : EPS_TO_SIGMA
!
USE E_GRID
!
USE DFUNC_STATIC
USE DFUNCT_STAN_DYNAMIC
USE DFUNCL_STAN_DYNAMIC
USE DFUNCL_MAGN_DYNAMIC
!
USE OUT_VALUES_1, ONLY : I_CD
USE PRINT_FILES, ONLY : IO_CD
!
IMPLICIT NONE
!
CHARACTER (LEN = 4) :: D_FUNCL,D_FUNCT
!
REAL (WP), INTENT(IN) :: X
REAL (WP) :: REPS,IEPS,EPSR,EPSI,RCDV,ICDV
REAL (WP) :: Z,EN,KS,A,NU
REAL (WP) :: Y
!
REAL (WP) :: FLOAT
!
INTEGER :: IE
!
Y = X + X ! q / k_F
!
IF(ESTDY == ' STATIC') THEN !
!
! Static susceptibility function
!
IF(EPS_T == 'LONG') THEN !
!
D_FUNCL = D_FUNC !
CALL DFUNCL_STATIC(X,D_FUNCL,REPS,IEPS) ! longitudinal eps
!
CALL EPS_TO_SIGMA(X,ZERO,REPS,IEPS,RCDV,ICDV) !
!
IF(I_CD == 1) THEN !
WRITE(IO_CD,*) Y,RCDV,ICDV !
END IF !
!
ELSE !
D_FUNCT = D_FUNC !
CONTINUE ! transverse eps
END IF !
!
ELSE !
!
! Dynamic suceptibility function
!
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(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,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 !
!
CALL EPS_TO_SIGMA(X,Z,REPS,IEPS,RCDV,ICDV) !
!
IF(I_CD == 1) THEN ! writing to
WRITE(IO_CD,*) Y,EN,RCDV,ICDV ! file
END IF !
!
END DO ! end of energy loop
!
END IF !
!
END SUBROUTINE CALC_CDV
!
END MODULE CALCULATORS_1