! !======================================================================= ! 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