385 lines
18 KiB
Fortran
385 lines
18 KiB
Fortran
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
MODULE LINDHARD_FUNCTION
|
||
|
|
!
|
||
|
|
! This module provides the static and dynamic Lindhard functions
|
||
|
|
!
|
||
|
|
USE ACCURACY_REAL
|
||
|
|
!
|
||
|
|
CONTAINS
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
SUBROUTINE LINDHARD_S(X,DMN,LR,LI)
|
||
|
|
!
|
||
|
|
! This subroutine calculates the (RPA) static Lindhard function F(x)
|
||
|
|
! for x = q / 2 k_F
|
||
|
|
!
|
||
|
|
! References: (1) J. Solyom, "Fundamental of the Physics of Solids", Vol3, Chap. 29
|
||
|
|
! p. 61-138, Springer
|
||
|
|
!
|
||
|
|
! Note: The Lindhard function L(x) is defined as
|
||
|
|
!
|
||
|
|
! eps = 1 + q^2_TF / q^ 2 * L(x) (3D)
|
||
|
|
!
|
||
|
|
! eps = 1 + q_TF / q * L(x) (2D)
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Input parameters:
|
||
|
|
!
|
||
|
|
! * X : dimensionless factor --> X = q / (2 * k_F)
|
||
|
|
! * DMN : problem dimension
|
||
|
|
!
|
||
|
|
! Output parameters:
|
||
|
|
!
|
||
|
|
! * LR : real part of the Lindhard function
|
||
|
|
! * LI : imaginary part of the Lindhard function
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Author : D. Sébilleau
|
||
|
|
!
|
||
|
|
! Last modified : 3 Jun 2020
|
||
|
|
!
|
||
|
|
!
|
||
|
|
USE REAL_NUMBERS, ONLY : ZERO,ONE,HALF,FOURTH,SMALL
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
CHARACTER (LEN = 2) :: DMN
|
||
|
|
!
|
||
|
|
REAL (WP), INTENT(IN) :: X
|
||
|
|
REAL (WP), INTENT(OUT) :: LR,LI
|
||
|
|
REAL (WP) :: X_INV,X2_INV,COEF
|
||
|
|
!
|
||
|
|
REAL (WP) :: LOG,ABS,SQRT
|
||
|
|
!
|
||
|
|
X_INV = ONE / X !
|
||
|
|
X2_INV = X_INV * X_INV !
|
||
|
|
COEF = FOURTH * X_INV ! 1 / (4 * X)
|
||
|
|
!
|
||
|
|
IF(X < SMALL) THEN !
|
||
|
|
!
|
||
|
|
LR = ONE !
|
||
|
|
LI = ZERO !
|
||
|
|
!
|
||
|
|
ELSE !
|
||
|
|
!
|
||
|
|
IF(DMN == '3D') THEN !
|
||
|
|
!
|
||
|
|
!.......... 3D case ..........
|
||
|
|
!
|
||
|
|
LR = HALF + COEF * (ONE - X * X) * & !
|
||
|
|
LOG(ABS((X + ONE) / (X - ONE))) ! equation (29.2.53)
|
||
|
|
LI = ZERO !
|
||
|
|
!
|
||
|
|
ELSE IF(DMN == '2D') THEN !
|
||
|
|
!
|
||
|
|
!.......... 2D case ..........
|
||
|
|
!
|
||
|
|
IF(X <= ONE) THEN !
|
||
|
|
LR = ONE !
|
||
|
|
LI = ZERO !
|
||
|
|
ELSE
|
||
|
|
LR = ONE - SQRT(ONE - X2_INV) ! equation (29.5.15)
|
||
|
|
LI = ZERO !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
ELSE IF(DMN == '1D') THEN !
|
||
|
|
!
|
||
|
|
!.......... 1D case ..........
|
||
|
|
!
|
||
|
|
LR = HALF * X_INV * LOG(ABS((X + ONE) / (X - ONE))) ! equation (29.5.22)
|
||
|
|
LI = ZERO !
|
||
|
|
!
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
END SUBROUTINE LINDHARD_S
|
||
|
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
SUBROUTINE LINDHARD_D(X,Z,DMN,LR,LI)
|
||
|
|
!
|
||
|
|
! This subroutine computes the (RPA) dynamic Lindhard function.
|
||
|
|
! The real part LR and the imaginary part LI are
|
||
|
|
! computed separately.
|
||
|
|
!
|
||
|
|
! References: (1) J. Solyom, "Fundamental of the Physics of Solids",
|
||
|
|
! Vol3, Chap. 29, p. 61-138, Springer
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Note: The Lindhard function L(x) is defined as
|
||
|
|
!
|
||
|
|
! eps = 1 + q^2_TF / q^ 2 * L(q,omega) (3D)
|
||
|
|
!
|
||
|
|
! eps = 1 + q_TF / q * L(q,omega) (2D)
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Notation: hbar omega_q = hbar^2 q^2 / 2m
|
||
|
|
!
|
||
|
|
! Input parameters:
|
||
|
|
!
|
||
|
|
! * X : dimensionless factor --> X = q / (2 * k_F)
|
||
|
|
! * Z : dimensionless factor --> Z = omega / omega_q
|
||
|
|
! * DMN : problem dimension
|
||
|
|
!
|
||
|
|
! Output parameters:
|
||
|
|
!
|
||
|
|
! * LR : real part of the Lindhard function
|
||
|
|
! * LI : imaginary part of the Lindhard function
|
||
|
|
!
|
||
|
|
! Intermediate parameters:
|
||
|
|
!
|
||
|
|
! * X_INV : q * v_F / omega_q = 2 * k_F / q = 1 / X
|
||
|
|
! * U = X * Z: omega / (q * v_F)
|
||
|
|
!
|
||
|
|
! Warning note: The real part of the Lindhard function is not
|
||
|
|
! always computable. Noting a = U +/- X, the
|
||
|
|
! pathological cases are
|
||
|
|
!
|
||
|
|
! (U + X - 1) = 0 --> (1 - a^2) Log| (a + 1)/(a - 1)| = 0
|
||
|
|
!
|
||
|
|
! (U - X - 1) = 0 --> (1 - a^2) Log| (a - 1)/(a + 1)| = 0
|
||
|
|
!
|
||
|
|
! (U - X + 1) = 0 --> (1 - a^2) Log| (a - 1)/(a + 1)| = 0
|
||
|
|
!
|
||
|
|
!
|
||
|
|
! Author : D. Sébilleau
|
||
|
|
!
|
||
|
|
! Last modified : 19 Oct 2020
|
||
|
|
!
|
||
|
|
!
|
||
|
|
USE REAL_NUMBERS, ONLY : ZERO,ONE,HALF,EIGHTH,LARGE
|
||
|
|
USE PI_ETC, ONLY : PI
|
||
|
|
!
|
||
|
|
IMPLICIT NONE
|
||
|
|
!
|
||
|
|
CHARACTER (LEN = 2) :: DMN
|
||
|
|
!
|
||
|
|
REAL (WP), INTENT(IN) :: X,Z
|
||
|
|
REAL (WP), INTENT(OUT) :: LR,LI
|
||
|
|
REAL (WP) :: Y,U,X_INV,X2_INV,COEF
|
||
|
|
REAL (WP) :: A1,A2,A1L1,A2L2
|
||
|
|
REAL (WP) :: DIFF1,DIFF2,DIFF3
|
||
|
|
REAL (WP) :: NUM,DEN
|
||
|
|
REAL (WP) :: GP,GM,FP,FM,RP,RM
|
||
|
|
REAL (WP) :: SMALL
|
||
|
|
!
|
||
|
|
REAL (WP) :: ABS,LOG,SQRT
|
||
|
|
!
|
||
|
|
SMALL = 1.0E-30_WP
|
||
|
|
!
|
||
|
|
Y = X + X ! q / k_F
|
||
|
|
X_INV = ONE / X ! q * v_F / omega_q = 1 / X
|
||
|
|
X2_INV = X_INV * X_INV ! 1/ X^2
|
||
|
|
COEF = EIGHTH * X_INV ! 1 / (8 * X)
|
||
|
|
U = X * Z ! omega / q * v_F)
|
||
|
|
!
|
||
|
|
! 3D case
|
||
|
|
!
|
||
|
|
IF(DMN == '3D') THEN ! ref. pp. 81-82
|
||
|
|
!
|
||
|
|
A1 = ONE - (U + X) * (U + X) !
|
||
|
|
A2 = ONE - (U - X) * (U - X) !
|
||
|
|
!
|
||
|
|
! Checking the pathological cases for the real part
|
||
|
|
!
|
||
|
|
DIFF1 = ABS(U + X - ONE) ! |U + X - 1|
|
||
|
|
DIFF2 = ABS(U - X - ONE) ! |U - X - 1|
|
||
|
|
DIFF3 = ABS(U - X + ONE) ! |U - X + 1|
|
||
|
|
!
|
||
|
|
IF(DIFF1 < SMALL) THEN !
|
||
|
|
A1L1 = ZERO ! <-- pathological case: U + X = 1
|
||
|
|
ELSE !
|
||
|
|
A1L1 = A1 * LOG(ABS((U + X + ONE) / (U + X - ONE))) !
|
||
|
|
END IF !
|
||
|
|
IF(DIFF2 < SMALL .OR. DIFF3 < SMALL) THEN !
|
||
|
|
IF(DIFF2 < SMALL) THEN !
|
||
|
|
A2L2 = ZERO ! <-- pathological case: U - X = 1
|
||
|
|
END IF !
|
||
|
|
IF(DIFF3 < SMALL) THEN !
|
||
|
|
A2L2 = LARGE**5 ! <-- pathological case: U - X = -1
|
||
|
|
END IF !
|
||
|
|
ELSE !
|
||
|
|
A2L2 = A2 * LOG(ABS((U - X - ONE) / (U - X + ONE))) !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
!.......... Real part ..........
|
||
|
|
!
|
||
|
|
LR = HALF + COEF * (A1L1 + A2L2) ! equation (29.2.52)
|
||
|
|
!
|
||
|
|
!.......... Imaginary part ..........
|
||
|
|
!
|
||
|
|
IF(X < ONE) THEN ! q < 2 k_F --> equation (29.2.56)
|
||
|
|
! !
|
||
|
|
IF(U < (ONE - X)) THEN ! OMEGA < Q * V_F - OMEGA_Q
|
||
|
|
LI = PI * HALF *U ! equation (29.2.56a)
|
||
|
|
ELSE !
|
||
|
|
IF(U <= (ONE + X)) THEN ! OMEGA < or = Q * V_F + OMEGA_Q
|
||
|
|
LI = PI * COEF * A2 ! equation (29.2.56b)
|
||
|
|
ELSE !
|
||
|
|
LI = ZERO ! equation (29.2.56c)
|
||
|
|
END IF !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
ELSE ! q > 2 k_F --> equation (29.2.57)
|
||
|
|
! !
|
||
|
|
IF(U < (X - ONE)) THEN ! OMEGA < OMEGA_Q - Q * V_F
|
||
|
|
LI = ZERO ! equation (29.2.57a)
|
||
|
|
ELSE !
|
||
|
|
IF(U <= (X + ONE)) THEN ! OMEGA < or = Q * V_F + OMEGA_Q
|
||
|
|
LI = PI * COEF * A2 ! equation (29.2.57b)
|
||
|
|
ELSE !
|
||
|
|
LI = ZERO ! equation (29.2.57c)
|
||
|
|
END IF !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
! 2D case
|
||
|
|
!
|
||
|
|
ELSE IF(DMN == '2D') THEN ! ref. pp. 98-99
|
||
|
|
!
|
||
|
|
IF(X < ONE) THEN ! q < 2 k_F
|
||
|
|
! !
|
||
|
|
IF(U <= (ONE - X)) THEN ! OMEGA < or = Q * V_F - OMEGA_Q
|
||
|
|
! !
|
||
|
|
A1 = HALF * SQRT(ONE - (X - U) * (X - U)) / X !
|
||
|
|
A2 = HALF * SQRT(ONE - (X + U) * (X + U)) / X !
|
||
|
|
! !
|
||
|
|
LR = ONE ! equation (29.5.3)
|
||
|
|
LI = A1 - A2 ! equation (29.5.4)
|
||
|
|
! !
|
||
|
|
ELSE !
|
||
|
|
! !
|
||
|
|
IF(U <= (ONE + X)) THEN ! OMEGA < or = Q * V_F + OMEGA_Q
|
||
|
|
! !
|
||
|
|
A1 = HALF * SQRT((X + U) * (X + U) - ONE) / X !
|
||
|
|
A2 = HALF * SQRT(ONE - (X - U) * (X - U)) / X !
|
||
|
|
! !
|
||
|
|
LR = ONE - A1 ! equation (29.5.5)
|
||
|
|
LI = A2 ! equation (29.5.6)
|
||
|
|
! !
|
||
|
|
ELSE !
|
||
|
|
! !
|
||
|
|
A1 = HALF * SQRT((X + U) * (X + U) - ONE) / X !
|
||
|
|
A2 = HALF * SQRT((U - X) * (U - X) - ONE) / X !
|
||
|
|
! !
|
||
|
|
LR = ONE - A1 + A2 ! equation (29.5.7)
|
||
|
|
LI = ZERO ! equation (29.5.8)
|
||
|
|
! !
|
||
|
|
END IF !
|
||
|
|
! !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
ELSE ! q > 2 k_F
|
||
|
|
! !
|
||
|
|
IF(U <= (X - ONE)) THEN ! OMEGA < or = Q * V_F - OMEGA_Q
|
||
|
|
! !
|
||
|
|
A1 = HALF * SQRT((X + U) * (X + U) - ONE) / X !
|
||
|
|
A2 = HALF * SQRT((X - U) * (X - U) - ONE) / X !
|
||
|
|
! !
|
||
|
|
LR = ONE - A1 - A2 ! equation (29.5.9)
|
||
|
|
!
|
||
|
|
IF(Z < SMALL) LR = ONE !
|
||
|
|
LI = ZERO ! equation (29.5.10)
|
||
|
|
! !
|
||
|
|
ELSE !
|
||
|
|
! !
|
||
|
|
IF(U <= (X + ONE)) THEN ! OMEGA < or = Q * V_F + OMEGA_Q
|
||
|
|
! !
|
||
|
|
A1 = HALF * SQRT((X + U) * (X + U) - ONE) / X !
|
||
|
|
A2 = HALF * SQRT(ONE - (X - U) * (X - U)) / X !
|
||
|
|
! !
|
||
|
|
LR = ONE - A1 ! equation (29.5.11)
|
||
|
|
LI = A2 ! equation (29.5.12)
|
||
|
|
! !
|
||
|
|
ELSE !
|
||
|
|
! !
|
||
|
|
A1 = HALF * SQRT((X + U) * (X + U) - ONE) / X !
|
||
|
|
A2 = HALF * SQRT((X - U) * (X - U) - ONE) / X !
|
||
|
|
! !
|
||
|
|
LR = ONE - A1 + A2 ! equation (29.5.13)
|
||
|
|
LI = ZERO ! equation (29.5.14)
|
||
|
|
! !
|
||
|
|
END IF !
|
||
|
|
! !
|
||
|
|
END IF !
|
||
|
|
! !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
ELSE IF(DMN == 'D2') THEN ! Isihara's approach
|
||
|
|
!
|
||
|
|
GP = X + U !
|
||
|
|
GM = X - U !
|
||
|
|
FP = ONE - GP * GP !
|
||
|
|
FM = ONE - GM * GM !
|
||
|
|
RP = (ONE - GP) / (ONE + GP) !
|
||
|
|
RM = (ONE - GM) / (ONE + GM) !
|
||
|
|
!
|
||
|
|
IF(FP >= ZERO .AND. FM >= ZERO) THEN !
|
||
|
|
!
|
||
|
|
LR = ONE !
|
||
|
|
LI = (SQRT(FM) - SQRT(FP)) / Y ! ref. (2) eq. (2.1.14a)
|
||
|
|
!
|
||
|
|
ELSE IF(FP <= ZERO .AND. FM >= ZERO) THEN !
|
||
|
|
!
|
||
|
|
LR = ONE - SQRT(-FP) / Y ! ref. (2) eq. (2.1.14b)
|
||
|
|
LI = SQRT( FM) / Y !
|
||
|
|
!
|
||
|
|
ELSE IF(FP >= ZERO .AND. FM <= ZERO) THEN !
|
||
|
|
!
|
||
|
|
LR = ONE - (GM + ONE) * SQRT(ABS(RM)) / Y ! ref. (2) eq. (2.1.14c)
|
||
|
|
LI = - (ONE + GP) * SQRT(ABS(RP)) / Y !
|
||
|
|
!
|
||
|
|
ELSE IF(FP <= ZERO .AND. FM <= ZERO) THEN !
|
||
|
|
!
|
||
|
|
LR = ONE - ( (ONE + GM)* SQRT(ABS(RM)) - & !
|
||
|
|
(ONE + GP)* SQRT(ABS(RP)) & ! ref. (2) eq. (2.1.14d)
|
||
|
|
) / Y !
|
||
|
|
LI = ZERO
|
||
|
|
!
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
! 1D case
|
||
|
|
!
|
||
|
|
ELSE IF(DMN == '1D') THEN ! ref. p. 100
|
||
|
|
!
|
||
|
|
IF(X < ONE) THEN ! q < 2 k_F
|
||
|
|
!
|
||
|
|
NUM = (ONE + X) * (ONE + X) - U * U !
|
||
|
|
DEN = (ONE - X) * (ONE - X) - U * U !
|
||
|
|
! !
|
||
|
|
LR = HALF * HALF * LOG(ABS(NUM / DEN)) / X ! equation (29.5.16)
|
||
|
|
LI = ZERO !
|
||
|
|
!
|
||
|
|
ELSE ! q > 2 k_F
|
||
|
|
! !
|
||
|
|
NUM = (ONE + X) * (ONE + X) - U * U !
|
||
|
|
DEN = (ONE - X) * (ONE - X) - U * U !
|
||
|
|
! !
|
||
|
|
LR = HALF * HALF * LOG(ABS(NUM / DEN)) / X ! equation (29.5.21)
|
||
|
|
! ! Q * V_F - OMEGA_Q
|
||
|
|
IF( U <= (ONE + X) .AND. Z >= (ONE - X) ) THEN ! < or = OMEGA < or =
|
||
|
|
! ! Q * V_F + OMEGA_Q
|
||
|
|
IF(DIFF1 > SMALL) THEN !
|
||
|
|
LI = HALF * PI ! equation (29.5.18)
|
||
|
|
ELSE !
|
||
|
|
LI = ZERO !
|
||
|
|
END IF !
|
||
|
|
! !
|
||
|
|
END IF !
|
||
|
|
! !
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
END IF !
|
||
|
|
!
|
||
|
|
10 RETURN
|
||
|
|
!
|
||
|
|
END SUBROUTINE LINDHARD_D
|
||
|
|
|
||
|
|
!
|
||
|
|
END MODULE LINDHARD_FUNCTION
|