! !======================================================================= ! MODULE UTILITIES_2 ! USE ACCURACY_REAL ! ! It contains the following functions/subroutines: ! ! * SUBROUTINE IMAG_TO_REAL(IM,OM,NS,RE) ! * SUBROUTINE REAL_TO_IMAG(RE,OM,NS,RE_INF,IM) ! * SUBROUTINE EPSI_TO_EPSR(EPSI,OM,NS,EPSR) ! * SUBROUTINE EPSR_TO_EPSI(EPSR,OM,NS,EPSI) ! * SUBROUTINE GR_TO_SQ_3D(Q,NSIZE,MAX_R,T,RS,GR_TYPE,RH_TYPE,SQ) ! * SUBROUTINE SQ_TO_GR_3D(R,NSIZE,MAX_X,IN_MODE,T,RS,SQ_TYPE,& ! GQ_TYPE,EC_TYPE,GR) ! * SUBROUTINE SQ_TO_VA_3D(NSIZE,MAX_X,IN_MODE,T,SQ_TYPE, & ! GQ_TYPE,EC_TYPE,VA) ! CONTAINS ! !======================================================================= ! SUBROUTINE IMAG_TO_REAL(IM,OM,NS,RE) ! ! This subroutine computes the real part of the function F(omega) ! form the knowledge of the imaginary part, using the Kramers-Kronig ! relations. ! ! ! ! Input parameters: ! ! * IM : array containing Im[ F(omega) ] ! * OM : array containing omega ! * NS : size of arrays of OM, RE and IM ! ! ! Output variables : ! ! * RE : array containing Re[ F(omega) ] ! ! ! Author : D. Sébilleau ! ! Last modified : 23 Jun 2020 ! ! USE REAL_NUMBERS, ONLY : ZERO USE TRANSFORMS, ONLY : KK ! IMPLICIT NONE ! REAL (WP) :: IM(NS),OM(NS) REAL (WP) :: RE(NS),RE_INF ! INTEGER :: NS ! ! Calling the Kramers-Kronig subroutine ! RE_INF=ZERO ! unused inside KK CALL KK('I2R',NS,OM,RE,RE_INF,IM) ! for 'I2R' ! RETURN ! END ! !======================================================================= ! SUBROUTINE REAL_TO_IMAG(RE,OM,NS,RE_INF,IM) ! ! This subroutine computes the imaginary part of the function F(omega) ! form the knowledge of the real part, using the Kramers-Kronig ! relations. ! ! ! ! Input parameters: ! ! * RE : array containing Re[ F(omega) ] ! * OM : array containing omega ! * NS : size of arrays of OM, RE and IM ! * RE_INF : value of Re[ F(omega --> + infinity) ] ! ! ! Output variables : ! ! * IM : array containing Im[ F(omega) ] ! ! ! Author : D. Sébilleau ! ! Last modified : 23 Jun 2020 ! ! USE TRANSFORMS, ONLY : KK ! IMPLICIT NONE ! REAL (WP) :: RE(NS),OM(NS) REAL (WP) :: IM(NS),RE_INF ! INTEGER :: NS ! ! Calling the Kramers-Kronig subroutine ! CALL KK('R2I',NS,OM,RE,RE_INF,IM) ! ! END SUBROUTINE REAL_TO_IMAG ! !======================================================================= ! SUBROUTINE EPSI_TO_EPSR(EPSI,OM,NS,EPSR) ! ! This subroutine computes the real part of the dielectric function ! form the knowledge of the imaginary part, using the Kramers-Kronig ! relations. ! ! ! ! Input parameters: ! ! * EPSI : array containing Im[ EPS(q,omega) ] for a given q ! * OM : array containing omega ! * NS : size of arrays of OM, EPSR and EPSI ! ! ! Output variables : ! ! * EPSR : array containing Re[ EPS(q,omega) ] for a given q ! ! ! Author : D. Sébilleau ! ! Last modified : 4 Jun 2020 ! ! USE DIMENSION_CODE, ONLY : NSIZE USE REAL_NUMBERS, ONLY : ONE USE TRANSFORMS, ONLY : KK ! IMPLICIT NONE ! REAL (WP) :: EPSI(NSIZE),OM(NSIZE) REAL (WP) :: EPSR(NSIZE),EPSR_INF ! INTEGER :: NS ! ! Calling the Kramers-Kronig subroutine ! EPSR_INF=ONE ! value of EPSR at infinity ! CALL KK('I2R',NS,OM,EPSI,EPSR_INF,EPSR) ! ! END SUBROUTINE EPSI_TO_EPSR ! !======================================================================= ! SUBROUTINE EPSR_TO_EPSI(EPSR,OM,NS,EPSI) ! ! This subroutine computes the imaginary part of the dielectric function ! form the knowledge of the real part, using the Kramers-Kronig ! relations. ! ! ! ! Input parameters: ! ! * EPSR : array containing Re[ EPS(q,omega) ] for a given q ! * OM : array containing omega ! * NS : size of arrays of OM, EPSR and EPSI ! ! ! Output variables : ! ! * EPSI : array containing Im[ EPS(q,omega) ] for a given q ! ! ! Author : D. Sébilleau ! ! Last modified : 4 Jun 2020 ! USE DIMENSION_CODE, ONLY : NSIZE USE REAL_NUMBERS, ONLY : ONE USE TRANSFORMS, ONLY : KK ! IMPLICIT NONE ! REAL (WP) :: EPSR(NSIZE),OM(NSIZE) REAL (WP) :: EPSI(NSIZE),EPSR_INF ! INTEGER :: NS ! ! Calling the Kramers-Kronig subroutine ! EPSR_INF=ONE ! value of EPSR at infinity ! CALL KK('R2I',NS,OM,EPSR,EPSR_INF,EPSI) ! ! END SUBROUTINE EPSR_TO_EPSI ! !======================================================================= ! SUBROUTINE GR_TO_SQ_3D(Q,MAX_R,T,RS,GR_TYPE,RH_TYPE,SQ) ! ! This subroutine computes the 3D static structure factor S(q) ! from the pair correlation function g(r) according to ! ! / + inf ! | -i q.r ! S(q) = 1 + n | ( g(r)-1 ) e dr ! | ! / 0 ! ! / + inf ! 4 pi n | ! = 1 + -------- | r sin(qr) ( g(r)-1 ) dr ! q | ! / 0 ! ! ! Input parameters: ! ! * Q : point q where S(q) is computed ! * MAX_R : upper integration value ! * T : temperature in SI ! * RS : Wigner-Seitz radius (in units of a_0) ! * GR_TYPE : pair correlation function type (3D) ! * RH_TYPE : choice of pair distribution function rho_2(r) (3D) ! ! ! Output variables : ! ! * SQ : S(q) at point q ! ! ! Author : D. Sébilleau ! ! Last modified : 4 Jun 2020 ! ! USE DIMENSION_CODE, ONLY : NSIZE USE REAL_NUMBERS, ONLY : ONE,FOUR USE PI_ETC, ONLY : PI USE UTILITIES_1, ONLY : RS_TO_N0 USE INTEGRATION, ONLY : INTEGR_L USE PAIR_CORRELATION, ONLY : PAIR_CORRELATION_3D ! IMPLICIT NONE ! CHARACTER (LEN = 3) :: GR_TYPE,RH_TYPE ! REAL (WP), INTENT(IN) :: Q,T,RS,MAX_R REAL (WP) :: GR,SQ REAL (WP) :: N0,R REAL (WP) :: INTF(NSIZE),XA(NSIZE),H,IN ! INTEGER :: NMAX,K,N1,ID ! ! Computing the electron density ! N0=RS_TO_N0('3D',RS) ! ! ! Computing the integrand function ! N1=NMAX ! index of upper bound DO K=1,NMAX ! ! XA(K)=MAX_R*FLOAT(K-1)/FLOAT(NSIZE-1) ! R=XA(K) ! ! ! Computing the pair correlation factor g(r) ! CALL PAIR_CORRELATION_3D(R,RS,T,GR_TYPE,RH_TYPE,GR) ! ! INTF(K)=XA(K)*SIN(Q*XA(K))*(GR-ONE) ! ! END DO ! ! H=XA(2)-XA(1) ! step ID=1 ! ! ! Computing the integral ! CALL INTEGR_L(INTF,H,NMAX,N1,IN,ID) ! ! SQ=ONE + (FOUR*PI*N0/Q) * IN ! ! END SUBROUTINE GR_TO_SQ_3D ! !======================================================================= ! SUBROUTINE SQ_TO_GR_3D(R,NMAX,MAX_X,IN_MODE,T,RS,SQ_TYPE, & GQ_TYPE,GR) ! ! This subroutine computes the 3D pair correlation function g(r) ! from the static structure factor S(q) according to ! ! / + inf ! 1 1 | i q.r ! g(r) = 1 + --- ---------- | ( S(q)-1 ) e dq ! n (2 pi)^d | ! / 0 ! ! / + inf ! 1 1 | ! = 1 + + --- ------------ | q sin(qr) ( S(q)-1 ) dq ! n (2 pi)^2 r | ! / 0 ! ! ! Input parameters: ! ! * R : point r where g(r) is computed ! * NMAX : dimensioning of the arrays ! * MAX_X : upper integration value ! * IN_MODE : type of integral computed ! * T : temperature in SI ! * RS : Wigner-Seitz radius (in units of a_0) ! * SQ_TYPE : structure factor approximation (3D) ! * GQ_TYPE : local-field correction type (3D) ! ! ! Output variables : ! ! * GR : g(r) at point r ! ! ! Author : D. Sébilleau ! ! Last modified : 4 Jun 2020 ! USE REAL_NUMBERS, ONLY : ONE,TWO USE PI_ETC, ONLY : PI2 USE UTILITIES_1, ONLY : RS_TO_N0 USE SPECIFIC_INT_2, ONLY : INT_SQM1 ! IMPLICIT NONE ! CHARACTER (LEN = 4) :: GQ_TYPE CHARACTER (LEN = 3) :: SQ_TYPE ! REAL (WP) :: R,T,RS,MAX_X REAL (WP) :: GR REAL (WP) :: IN,N0 ! INTEGER :: NMAX,IN_MODE,LL ! IN_MODE=4 ! LL=0 ! ! ! Computing the integral ! CALL INT_SQM1(NMAX,MAX_X,IN_MODE,RS,T,R,LL,SQ_TYPE, & ! GQ_TYPE,IN) ! ! ! Computing the electron density ! N0=RS_TO_N0('3D',RS) ! ! GR=ONE + ONE/N0 * IN/(TWO*PI2*R) ! ! END SUBROUTINE SQ_TO_GR_3D ! !======================================================================= ! SUBROUTINE SQ_TO_VA_3D(NMAX,MAX_X,IN_MODE,RS,T,SQ_TYPE, & GQ_TYPE,VA) ! ! This subroutine computes the average potential energy per electron ! from the static structure factor S(q) according to ! ! / + inf ! e^2 | ! = ----- | ( S(q)-1 ) dq ! pi | ! / 0 ! ! ! Input parameters: ! ! * NMAX : dimensioning of the arrays ! * MAX_X : upper integration value ! * IN_MODE : type of integral computed ! * RS : Wigner-Seitz radius (in units of a_0) ! * T : temperature in SI ! * SQ_TYPE : structure factor approximation (3D) ! * GQ_TYPE : local-field correction type (3D) ! ! ! Output variables : ! ! * VA : per electron ! ! ! Author : D. Sébilleau ! ! Last modified : 4 Jun 2020 ! USE REAL_NUMBERS, ONLY : ZERO USE CONSTANTS_P1, ONLY : E USE PI_ETC, ONLY : PI USE SPECIFIC_INT_2, ONLY : INT_SQM1 ! IMPLICIT NONE ! CHARACTER (LEN = 4) :: GQ_TYPE CHARACTER (LEN = 3) :: SQ_TYPE ! REAL (WP) :: MAX_X,RS,T REAL (WP) :: VA REAL (WP) :: R,IN ! INTEGER :: NMAX,IN_MODE,LL ! IN_MODE=1 ! LL=0 ! unused R=ZERO ! parameters ! ! Computing the integral ! CALL INT_SQM1(NMAX,MAX_X,IN_MODE,RS,T,R,LL,SQ_TYPE, & ! GQ_TYPE,IN) ! ! VA=E*E/PI * IN ! ! END SUBROUTINE SQ_TO_VA_3D ! END MODULE UTILITIES_2