! !======================================================================= ! MODULE SPECTRAL_FUNCTION ! USE ACCURACY_REAL ! ! CONTAINS ! !======================================================================= ! SUBROUTINE SPEC_FUNC_3D(X,Z,RS,T,SPF_TYPE,AQ) ! ! This subroutine computes a spectral function A(q,omega) ! for 3D systems ! ! Input parameters: ! ! * X : dimensionless factor --> X = q / (2 * k_F) ! * Z : dimensionless factor --> Z = omega / omega()_q ! * RS : Wigner-Seitz radius (in units of a_0) ! * SPF_TYPE : spectral function type ! SPF_TYPE = 'NAIC' Nakano-Ichimaru approximation ! ! ! Author : D. Sébilleau ! ! Last modified : 23 Sep 2020 ! ! IMPLICIT NONE ! CHARACTER (LEN = 4) :: SPF_TYPE ! REAL (WP), INTENT(IN) :: X,Z,RS,T REAL (WP), INTENT(OUT) :: AQ ! IF(SPF_TYPE == 'NAIC') THEN ! AQ = NAIC_SP(X,Z,T) ! END IF ! ! END SUBROUTINE SPEC_FUNC_3D ! !======================================================================= ! FUNCTION NAIC_SP(X,Z,T) ! ! This function computes the Nakano-Ichimaru approximation for ! the dynamical structure factor S(q,omega) for 3D systems ! ! References: ! ! Input parameters: (1) A. Nakano and S. Ichimaru, Phys. Rev. B 39, ! 4938-4944 (1989) ! ! * X : dimensionless factor --> X = q / (2 * k_F) ! * Z : omega / omega_q --> dimensionless ! * T : temperature in SI ! ! ! Author : D. Sébilleau ! ! Last modified : 23 Sep 2020 ! ! USE MATERIAL_PROP, ONLY : RS USE REAL_NUMBERS, ONLY : ZERO,ONE,TWO,THREE,FOUR, & HALF,THIRD,FOURTH USE PI_ETC, ONLY : PI,PI_INV USE UTILITIES_1, ONLY : ALFA ! IMPLICIT NONE ! REAL (WP), INTENT(IN) :: X,Z,T REAL (WP) :: NAIC_SP REAL (WP) :: Y,Y2,ALPHA,OMP,OMG REAL (WP) :: MB,G1,G2,G3,G4 REAL (WP) :: Z1,Z2,OPH,GPH,CPH REAL (WP) :: QC REAL (WP) :: R1,R2,R3,R4,R5,R6,R7,R8 REAL (WP) :: A(0:5),B(0:4),C(0:8),D(0:8) REAL (WP) :: E(0:4),F(0:4),G(0:4),H(0:4) REAL (WP) :: I(0:5),J(0:6),K(0:4),L(0:8) REAL (WP) :: ZQPK,ZPHK,ZBGS,ZBGI,OQPK REAL (WP) :: GQPK,OPHK,GPHK,OBGS,OBGI REAL (WP) :: KC,K5,K6 REAL (WP) :: YOKC,YOK1,ZQP1 REAL (WP) :: A_QP,A_PH,A_BG ! REAL (WP) :: SQRT,LOG,EXP ! DATA A / 0.95566E0_WP , - 0.015485E0_WP , 0.012991E0_WP , & ! mb polynomial - 0.0042626E0_WP , 0.00048299E0_WP ,- 1.8255E-05_WP / ! coefficients ! DATA B / 0.14694E0_WP , 0.09893E0_WP ,- 0.01982E0_WP , & ! gamma_1 polynomial 0.0035589E0_WP , - 0.0001342E0_WP / ! coefficients ! DATA C / 11.217E0_WP , -19.345E0_WP , 17.044E0_WP , & ! gamma_2 polynomial - 8.0637E0_WP , 2.239E0_WP ,- 0.37438E0_WP , & ! coefficients 0.0370160_WP , - 0.0019907E0_WP , 4.4836E-05_WP / ! ! DATA D / 84.0E0_WP ,- 158.99E0_WP ,133.44E0_WP , & ! gamma_3 polynomial - 60.994E0_WP , 16.449E0_WP ,- 2.6852E0_WP , & ! coefficients 0.26036E0_WP , - 0.013781E0_WP , 0.00030639E0_WP / ! ! DATA E / 2.4276E0_WP , - 0.78543E0_WP , 0.19432E0_WP , & ! gamma_4 polynomial - 0.019369E0_WP , 0.00068405E0_WP / ! coefficients ! DATA F / 0.0016811E0_WP , 0.16429E0_WP ,- 0.025994E0_WP , & ! z1 polynomial 0.002031E0_WP , - 6.6367E-05_WP / ! coefficients ! DATA G / 0.077768E0_WP , 0.10837E0_WP ,- 0.019335E0_WP , & ! z2 polynomial 0.0032477E0_WP , - 0.00014138E0_WP / ! coefficients ! DATA H / - 1.5992E0_WP , - 0.67358E0_WP , 0.053912E0_WP , & ! omega_ph polynomial - 0.0031731E0_WP , 8.8869E-05_WP / ! coefficients ! DATA I / 0.086133E0_WP , - 0.086136E0_WP , 0.03301E0_WP , & ! gamma_ph polynomial - 0.0056481E0_WP , 0.00046469E0_WP ,- 1.4487E-05_WP / ! coefficients ! DATA J / 10.161E0_WP , - 11.071E0_WP , 5.3875E0_WP , & ! c_ph polynomial - 1.327E0_WP , 0.17581E0_WP ,- 0.011883E0_WP , & ! coefficients 0.00032153E0_WP / ! ! DATA K / 0.25244E0_WP , 0.23827E0_WP ,- 0.045418E0_WP , & ! qc polynomial 0.0042734E0_WP , - 0.00015059E0_WP / ! coefficients ! DATA L / 0.26548E0_WP , - 1.1141E0_WP , 1.5208E0_WP , & ! k6 polynomial - 0.82343E0_WP , 0.24225E0_WP ,- 0.041703E0_WP , & ! coefficients 0.004191E0_WP , - 0.00022763E0_WP , 5.1593E-06_WP / ! ! Y = X + X ! Y = q / k_F Y2 = Y * Y ! ! ALPHA = ALFA('3D') ! ! OMP = SQRT(16.0E0_WP * ALPHA * RS * PI_INV * THIRD) ! h_bar omega_p / E_F ! OMG = FOUR * Z * X * X ! h_bar omega / E_F ! ! Powers of RS ! R1 = RS ! R2 = R1 * R1 ! R3 = R2 * R1 ! R4 = R3 * R1 ! R5 = R4 * R1 ! R6 = R5 * R1 ! R7 = R6 * R1 ! R8 = R7 * R1 ! ! ! Fitting parameters as a function of RS ! MB = A(0) + A(1) * R1 + A(2) * R2 + A(3) * R3 + & ! A(4) * R4 + A(5) * R5 ! G1 = B(0) + B(1) * R1 + B(2) * R2 + B(3) * R3 + & ! B(4) * R4 ! G2 = C(0) + C(1) * R1 + C(2) * R2 + C(3) * R3 + & ! C(4) * R4 + C(5) * R5 + C(6) * R6 + & ! C(7) * R7 + C(8) ! G3 = D(0) + D(1) * R1 + D(2) * R2 + D(3) * R3 + & ! D(4) * R4 + D(5) * R5 + D(6) * R6 + & ! D(7) * R7 + D(8) ! G4 = E(0) + E(1) * R1 + E(2) * R2 + E(3) * R3 + & ! E(4) * R4 ! Z1 = F(0) + F(1) * R1 + F(2) * R2 + F(3) * R3 + & ! F(4) * R4 ! Z2 = G(0) + G(1) * R1 + G(2) * R2 + G(3) * R3 + & ! G(4) * R4 ! OPH = H(0) + H(1) * R1 + H(2) * R2 + H(3) * R3 + & ! H(4) * R4 ! GPH = I(0) + I(1) * R1 + I(2) * R2 + I(3) * R3 + & ! I(4) * R4 + I(5) * R5 ! CPH = J(0) + J(1) * R1 + J(2) * R2 + J(3) * R3 + & ! J(4) * R4 + J(5) * R5 + J(6) * R6 ! QC = K(0) + K(1) * R1 + K(2) * R2 + K(3) * R3 + & ! K(4) * R4 ! K6 = L(0) + L(1) * R1 + L(2) * R2 + L(3) * R3 + & ! L(4) * R4 + L(5) * R5 + L(6) * R6 + & ! L(7) * R7 + L(8) ! ! KC = QC + ONE ! K5 = (FOUR * THIRD / SQRT(PI))**THIRD ! ! YOKC = Y / KC ! YOK1 = ONE / KC ! ! ZQPK = (Z1 + Z2 * YOKC * YOKC) * ( HALF + & ! (ONE - YOKC * YOKC) * LOG( & ! ABS((ONE + YOKC) / (ONE - YOKC)) ) & ! ref. (1) eq. (30) ) / & ! (ONE + YOKC * YOKC) ! ZQP1 = (Z1 + Z2 * YOK1 * YOK1) * ( HALF + & ! (ONE - YOK1 * YOK1) * LOG( & ! case Y = 1 ABS((ONE + YOK1) / (ONE - YOK1)) ) & ! ) / & ! (ONE + YOK1 * YOK1) ZPHK = (ONE - ZQP1) * EXP(- (Y / K5)**2 - (Y / K6)**2) ! ref. (1) eq. (31) ZBGS = ONE - ZQPK - (ONE - ZQP1) * (ONE - EXP(- (Y / K5)**2)) ! ref. (1) eq. (32) ZBGI = (ONE - ZQP1) * EXP(- (Y / K5)**2) * ( & ! ONE - EXP(- (Y / K6)**6) & ! ref. (1) eq. (33) ) ! OQPK = (Y2 - ONE) / MB ! ref. (1) eq. (34) IF(Y <= ONE) THEN ! GQPK = G1 * (Y - ONE)**2 / (ONE + G2 * (Y - ONE)**2) ! ref. (1) eq. (35a) ELSE ! GQPK = ONE / & ! ( G3 * (QC / (Y - ONE))**2 + & ! 32.0E0_WP * G4 * (Y - ONE) / & ! ref. (1) eq. (35b) ( THREE * PI * OMP**3 * & ! LOG(ABS(TWO * (Y - ONE) / OMP + ONE)) & ! ) & ! ) ! END IF ! OPHK = OPH - (OPH + OMP) * Y2 ! ref. (1) eq. (36) GPHK = GPH + CPH * Y2 ! ref. (1) eq. (37) IF(Y <= ONE) THEN ! OBGS = OMP * (ONE - Y) ! ref. (1) eq. (38a) ELSE ! OBGS = OQPK + OMP ! ref. (1) eq. (38b) END IF ! IF(Y <= ONE) THEN ! OBGI = OPHK ! ref. (1) eq. (39a) ELSE ! OBGI = - OMP * (Y - ONE) ! ref. (1) eq. (39b) END IF ! ! ! Quasiparticle peak ! A_QP = ZQPK * EXP(- (OMG - OQPK)**2 / GQPK**2) / & ! ref. (1) eq. (27) (SQRT(PI) * GQPK) ! ! ! Plasmon-hole resonant peak ! A_PH = ZPHK * EXP(- (OMG - OPHK)**2 / GPHK**2) / & ! ref. (1) eq. (28) (SQRT(PI) * GPHK) ! ! ! Background contribution ! IF(OMG >= ZERO) THEN ! A_BG = FOUR * ZBGS * OMG**2 * EXP( - OMG**2 / OBGS**2) / & ! (SQRT(PI) * OBGS**3) ! ELSE ! ref. (1) eq. (28) A_BG = FOUR * ZBGI * OMG**2 * EXP( - OMG**2 / OBGI**2) / & ! (SQRT(PI) * OBGI**3) ! END IF ! ! NAIC_SP = A_QP + A_PH + A_BG ! ! END FUNCTION NAIC_SP ! END MODULE SPECTRAL_FUNCTION