MsSpec-DFM/New_libraries/DFM_library/SPECTRAL_FUNCTION_LIBRARY/spectral_function.f90

254 lines
12 KiB
Fortran
Raw Normal View History

2022-02-02 16:19:10 +01:00
!
!=======================================================================
!
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