254 lines
12 KiB
Fortran
254 lines
12 KiB
Fortran
|
!
|
||
|
!=======================================================================
|
||
|
!
|
||
|
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
|