4
1
mirror of https://github.com/pfloos/quack synced 2024-06-23 13:42:19 +02:00
quack/src/eDFT/US51_lda_exchange_individual_energy.f90

63 lines
1.3 KiB
Fortran
Raw Normal View History

2020-09-29 11:47:18 +02:00
subroutine US51_lda_exchange_individual_energy(nGrid,weight,rhow,rho,doNcentered,kappa,Ex)
2020-07-02 14:27:38 +02:00
! Compute the restricted version of Slater's LDA exchange individual energy
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nGrid
double precision,intent(in) :: weight(nGrid)
double precision,intent(in) :: rhow(nGrid)
double precision,intent(in) :: rho(nGrid)
2020-09-29 11:47:18 +02:00
logical,intent(in) :: doNcentered
double precision,intent(in) :: kappa
2020-07-02 14:27:38 +02:00
! Local variables
integer :: iG
2021-02-15 17:27:06 +01:00
double precision :: r,rI
2020-07-02 14:27:38 +02:00
double precision :: e,dedr
2020-09-29 11:47:18 +02:00
double precision :: Exrr,ExrI,ExrrI
2020-07-02 14:27:38 +02:00
! Output variables
double precision,intent(out) :: Ex
! Compute LDA exchange matrix in the AO basis
2020-09-29 11:47:18 +02:00
Exrr = 0d0
ExrI = 0d0
ExrrI = 0d0
2020-07-02 14:27:38 +02:00
do iG=1,nGrid
r = max(0d0,rhow(iG))
rI = max(0d0,rho(iG))
2020-07-06 15:42:21 +02:00
if(r > threshold) then
2020-07-02 14:27:38 +02:00
2021-02-15 17:27:06 +01:00
e = CxLSDA*r**(1d0/3d0)
dedr = 1d0/3d0*CxLSDA*r**(-2d0/3d0)
2020-07-02 14:27:38 +02:00
2020-09-29 11:47:18 +02:00
Exrr = Exrr - weight(iG)*dedr*r*r
2020-07-06 15:42:21 +02:00
if(rI > threshold) then
2020-09-29 11:47:18 +02:00
ExrI = ExrI + weight(iG)*e*rI
ExrrI = ExrrI + weight(iG)*dedr*r*rI
2020-07-06 15:42:21 +02:00
endif
2020-07-02 14:27:38 +02:00
endif
enddo
2020-09-29 11:47:18 +02:00
Exrr = kappa*Exrr
ExrI = kappa*ExrI
Ex = Exrr + ExrI + ExrrI
2020-07-02 14:27:38 +02:00
end subroutine US51_lda_exchange_individual_energy