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