9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-09 23:13:38 +01:00
qp2/src/dft_utils_func/ecmd_pbe_ueg.irp.f
2020-04-07 12:25:00 +02:00

195 lines
7.1 KiB
Fortran

subroutine ecmd_pbe_ueg_at_r(mu,r,eps_c_md_PBE)
implicit none
BEGIN_DOC
! provides the integrand of Eq. (13) of Phys.Chem.Lett.2019, 10, 2931 2937
!
! !!! WARNING !!! This is the total integrand of Eq. (13), which is e_cmd * n
!
! such a function is based on the exact behaviour of the Ecmd at large mu
!
! but with the exact on-top estimated with that of the UEG
!
! You enter with r(3), you get out with eps_c_md_PBE(1:N_states)
END_DOC
double precision, intent(in) :: mu , r(3)
double precision, intent(out) :: eps_c_md_PBE(N_states)
double precision :: pi, e_PBE, beta
double precision :: aos_array(ao_num), grad_aos_array(3,ao_num)
double precision :: rho_a(N_states),rho_b(N_states)
double precision :: grad_rho_a(3,N_states),grad_rho_b(3,N_states)
double precision :: grad_rho_a_2(N_states),grad_rho_b_2(N_states),grad_rho_a_b(N_states)
double precision :: rhoc,rhoo,sigmacc,sigmaco,sigmaoo,vrhoc,vrhoo,vsigmacc,vsigmaco,vsigmaoo
double precision :: g0_UEG_mu_inf, denom
integer :: m, istate
pi = 4.d0 * datan(1.d0)
eps_c_md_PBE = 0.d0
call density_and_grad_alpha_beta_and_all_aos_and_grad_aos_at_r(r,rho_a,rho_b, grad_rho_a, grad_rho_b, aos_array, grad_aos_array)
grad_rho_a_2 = 0.d0
grad_rho_b_2 = 0.d0
grad_rho_a_b = 0.d0
do istate = 1, N_states
do m = 1, 3
grad_rho_a_2(istate) += grad_rho_a(m,istate)*grad_rho_a(m,istate)
grad_rho_b_2(istate) += grad_rho_b(m,istate)*grad_rho_b(m,istate)
grad_rho_a_b(istate) += grad_rho_a(m,istate)*grad_rho_b(m,istate)
enddo
enddo
do istate = 1, N_states
! convertion from (alpha,beta) formalism to (closed, open) formalism
call rho_ab_to_rho_oc(rho_a(istate),rho_b(istate),rhoo,rhoc)
call grad_rho_ab_to_grad_rho_oc(grad_rho_a_2(istate),grad_rho_b_2(istate),grad_rho_a_b(istate),sigmaoo,sigmacc,sigmaco)
call ec_pbe_only(0.d0,rhoc,rhoo,sigmacc,sigmaco,sigmaoo,e_PBE)
if(mu == 0.d0) then
eps_c_md_PBE(istate)=e_PBE
else
! note: the on-top pair density is (1-zeta^2) rhoc^2 g0 = 4 rhoa * rhob * g0
denom = (-2.d0+sqrt(2d0))*sqrt(2.d0*pi) * 4.d0*rho_a(istate)*rho_b(istate)*g0_UEG_mu_inf(rho_a(istate),rho_b(istate))
if (dabs(denom) > 1.d-12) then
beta = (3.d0*e_PBE)/denom
eps_c_md_PBE(istate)=e_PBE/(1.d0+beta*mu**3)
else
eps_c_md_PBE(istate)=0.d0
endif
endif
enddo
end
subroutine eps_c_md_PBE_from_density(mu,rho_a,rho_b, grad_rho_a, grad_rho_b,eps_c_md_PBE) ! EG
implicit none
BEGIN_DOC
! provides the integrand of Eq. (13) of Phys.Chem.Lett.2019, 10, 2931 2937
!
! !!! WARNING !!! This is the total integrand of Eq. (13), which is e_cmd * n
!
! such a function is based on the exact behaviour of the Ecmd at large mu
!
! but with the exact on-top estimated with that of the UEG
!
! You enter with the alpha/beta density and density gradients
!
! You get out with eps_c_md_PBE(1:N_states)
END_DOC
double precision, intent(in) :: mu(N_states) , rho_a(N_states),rho_b(N_states), grad_rho_a(3,N_states),grad_rho_b(3,N_states)
double precision, intent(out) :: eps_c_md_PBE(N_states)
double precision :: pi, e_PBE, beta
double precision :: aos_array(ao_num), grad_aos_array(3,ao_num)
double precision :: grad_rho_a_2(N_states),grad_rho_b_2(N_states),grad_rho_a_b(N_states)
double precision :: rhoc,rhoo,sigmacc,sigmaco,sigmaoo,vrhoc,vrhoo,vsigmacc,vsigmaco,vsigmaoo
double precision :: g0_UEG_mu_inf, denom
integer :: m, istate
pi = 4.d0 * datan(1.d0)
eps_c_md_PBE = 0.d0
grad_rho_a_2 = 0.d0
grad_rho_b_2 = 0.d0
grad_rho_a_b = 0.d0
do istate = 1, N_states
do m = 1, 3
grad_rho_a_2(istate) += grad_rho_a(m,istate)*grad_rho_a(m,istate)
grad_rho_b_2(istate) += grad_rho_b(m,istate)*grad_rho_b(m,istate)
grad_rho_a_b(istate) += grad_rho_a(m,istate)*grad_rho_b(m,istate)
enddo
enddo
do istate = 1, N_states
! convertion from (alpha,beta) formalism to (closed, open) formalism
call rho_ab_to_rho_oc(rho_a(istate),rho_b(istate),rhoo,rhoc)
call grad_rho_ab_to_grad_rho_oc(grad_rho_a_2(istate),grad_rho_b_2(istate),grad_rho_a_b(istate),sigmaoo,sigmacc,sigmaco)
call ec_pbe_only(0.d0,rhoc,rhoo,sigmacc,sigmaco,sigmaoo,e_PBE)
if(mu(istate) == 0.d0) then
eps_c_md_PBE(istate)=e_PBE
else
! note: the on-top pair density is (1-zeta^2) rhoc^2 g0 = 4 rhoa * rhob * g0
denom = (-2.d0+sqrt(2d0))*sqrt(2.d0*pi) * 4.d0*rho_a(istate)*rho_b(istate)*g0_UEG_mu_inf(rho_a(istate),rho_b(istate))
if (dabs(denom) > 1.d-12) then
beta = (3.d0*e_PBE)/denom
eps_c_md_PBE(istate)=e_PBE/(1.d0+beta*mu(istate)**3)
else
eps_c_md_PBE(istate)=0.d0
endif
endif
enddo
end
subroutine eps_c_md_PBE_at_grid_pt(mu,i_point,eps_c_md_PBE)
implicit none
BEGIN_DOC
! provides the integrand of Eq. (13) of Phys.Chem.Lett.2019, 10, 2931 2937
!
! !!! WARNING !!! This is the total integrand of Eq. (13), which is e_cmd * n
!
! such a function is based on the exact behaviour of the Ecmd at large mu
!
! but with the exact on-top estimated with that of the UEG
!
! You enter with the alpha/beta density and density gradients
!
! You get out with eps_c_md_PBE(1:N_states)
END_DOC
double precision, intent(in) :: mu
double precision, intent(out) :: eps_c_md_PBE(N_states)
integer, intent(in) :: i_point
double precision :: two_dm, pi, e_pbe,beta,mu_correction_of_on_top
double precision :: grad_rho_a(3),grad_rho_b(3)
double precision :: grad_rho_a_2,grad_rho_b_2,grad_rho_a_b
double precision :: rhoc,rhoo,ec_pbe_88
double precision :: delta,two_dm_corr,rho_a,rho_b
double precision :: grad_rho_2,denom,g0_UEG_mu_inf
double precision :: sigmacc,sigmaco,sigmaoo
integer :: m, istate
pi = 4.d0 * datan(1.d0)
eps_c_md_PBE = 0.d0
do istate = 1, N_states
! total and spin density
rhoc = one_e_dm_and_grad_alpha_in_r(4,i_point,istate) + one_e_dm_and_grad_beta_in_r(4,i_point,istate)
rhoo = one_e_dm_and_grad_alpha_in_r(4,i_point,istate) - one_e_dm_and_grad_beta_in_r(4,i_point,istate)
! gradients of the effective spin density
grad_rho_a_2 = 0.D0
grad_rho_b_2 = 0.D0
grad_rho_a_b = 0.D0
do m = 1, 3
grad_rho_a_2 += one_e_dm_and_grad_alpha_in_r(m,i_point,istate)**2.d0
grad_rho_b_2 += one_e_dm_and_grad_beta_in_r(m,i_point,istate) **2.d0
grad_rho_a_b += one_e_dm_and_grad_alpha_in_r(m,i_point,istate) * one_e_dm_and_grad_beta_in_r(m,i_point,istate)
enddo
sigmacc = grad_rho_a_2 + grad_rho_b_2 + 2.d0 * grad_rho_a_b
sigmaco = 0.d0
sigmaoo = 0.d0
rho_a = one_e_dm_and_grad_alpha_in_r(4,i_point,istate)
rho_b = one_e_dm_and_grad_beta_in_r(4,i_point,istate)
call ec_pbe_only(0.d0,rhoc,rhoo,sigmacc,sigmaco,sigmaoo,e_PBE)
if(e_PBE.gt.0.d0)then
print*,'PBE gt 0 with regular dens'
endif
if(mu == 0.d0) then
eps_c_md_PBE(istate)=e_PBE
else
! note: the on-top pair density is (1-zeta^2) rhoc^2 g0 = 4 rhoa * rhob * g0
denom = (-2.d0+dsqrt(2d0))*sqrt(2.d0*pi) * 4.d0*rho_a*rho_b*g0_UEG_mu_inf(rho_a,rho_b)
if (dabs(denom) > 1.d-12) then
beta = (3.d0*e_PBE)/denom
! Ecmd functional with the UEG ontop pair density when mu -> infty
! and the usual PBE correlation energy when mu = 0
eps_c_md_PBE(istate)=e_PBE/(1.d0+beta*mu**3)
else
eps_c_md_PBE(istate)=0.d0
endif
endif
enddo
end