4
1
mirror of https://github.com/pfloos/quack synced 2024-11-06 22:24:03 +01:00
quack/src/QuAcK/renormalization_factor.f90

102 lines
2.2 KiB
Fortran
Raw Normal View History

2019-09-22 21:15:53 +02:00
subroutine renormalization_factor(SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,rhox,Z)
2019-03-19 10:13:33 +01:00
! Compute renormalization factor for GW
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: SOSEX
2019-09-22 21:15:53 +02:00
double precision,intent(in) :: eta
2019-03-19 10:13:33 +01:00
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
2019-09-22 21:15:53 +02:00
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: Omega(nS)
double precision,intent(in) :: rho(nBas,nBas,nS)
double precision,intent(in) :: rhox(nBas,nBas,nS)
2019-03-19 10:13:33 +01:00
! Local variables
integer :: i,j,a,b,x,jb
double precision :: eps
! Output variables
double precision,intent(out) :: Z(nBas)
2019-09-22 21:15:53 +02:00
! Initialize
2019-03-19 10:13:33 +01:00
2019-09-22 21:15:53 +02:00
Z(:) = 0d0
2019-03-19 10:13:33 +01:00
! Occupied part of the correlation self-energy
do x=nC+1,nBas-nR
do i=nC+1,nO
jb = 0
do j=nC+1,nO
do b=nO+1,nBas-nR
jb = jb + 1
2019-09-22 21:15:53 +02:00
eps = e(x) - e(i) + Omega(jb)
Z(x) = Z(x) - 2d0*rho(x,i,jb)**2*(eps/(eps**2 + eta**2))**2
2019-03-19 10:13:33 +01:00
enddo
enddo
enddo
enddo
! Virtual part of the correlation self-energy
do x=nC+1,nBas-nR
do a=nO+1,nBas-nR
jb = 0
do j=nC+1,nO
do b=nO+1,nBas-nR
jb = jb + 1
2019-09-22 21:15:53 +02:00
eps = e(x) - e(a) - Omega(jb)
Z(x) = Z(x) - 2d0*rho(x,a,jb)**2*(eps/(eps**2 + eta**2))**2
2019-03-19 10:13:33 +01:00
enddo
enddo
enddo
enddo
! SOSEX correction
if(SOSEX) then
! Occupied part of the correlation self-energy
do x=nC+1,nBas-nR
do i=nC+1,nO
jb = 0
do j=nC+1,nO
do b=nO+1,nBas-nR
jb = jb + 1
2019-09-22 21:15:53 +02:00
eps = e(x) - e(i) + Omega(jb)
Z(x) = Z(x) - (rho(x,i,jb)/eps)*(rhox(x,i,jb)/eps)
2019-03-19 10:13:33 +01:00
enddo
enddo
enddo
enddo
! Virtual part of the correlation self-energy
do x=nC+1,nBas-nR
do a=nO+1,nBas-nR
jb = 0
do j=nC+1,nO
do b=nO+1,nBas-nR
jb = jb + 1
2019-09-22 21:15:53 +02:00
eps = e(x) - e(a) - Omega(jb)
Z(x) = Z(x) - (rho(x,a,jb)/eps)*(rhox(x,a,jb)/eps)
2019-03-19 10:13:33 +01:00
enddo
enddo
enddo
enddo
endif
! Compute renormalization factor from derivative of SigC
2019-09-22 21:15:53 +02:00
Z(:) = 1d0/(1d0 - Z(:))
2019-03-19 10:13:33 +01:00
end subroutine renormalization_factor