10
1
mirror of https://github.com/pfloos/quack synced 2024-12-22 20:34:46 +01:00

GW correction

This commit is contained in:
Pierre-Francois Loos 2019-07-09 23:10:22 +02:00
parent 2feb62101d
commit ab7a4609b7

View File

@ -0,0 +1,90 @@
subroutine basis_correction(nBas,nO,nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell, &
ERI,e,c,P,eG0W0)
! Compute the basis set incompleteness error
implicit none
include 'parameters.h'
! Input variables
integer,intent(in) :: nBas
integer,intent(in) :: nO
integer,intent(in) :: nShell
integer,intent(in) :: TotAngMomShell(maxShell),KShell(maxShell)
double precision,intent(in) :: CenterShell(maxShell,ncart),DShell(maxShell,maxK),ExpShell(maxShell,maxK)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: c(nBas,nBas)
double precision,intent(in) :: P(nBas,nBas)
double precision,intent(in) :: eG0W0(nBas)
! Local variables
integer :: SGn
integer :: nRad
integer :: nAng
integer :: nGrid
double precision,allocatable :: root(:,:)
double precision,allocatable :: weight(:)
double precision,allocatable :: AO(:,:)
double precision,allocatable :: dAO(:,:,:)
double precision,allocatable :: MO(:,:)
double precision,allocatable :: dMO(:,:,:)
double precision,allocatable :: rho(:)
double precision,allocatable :: f(:)
double precision,allocatable :: mu(:)
! Output variables
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| Basis set incompleteness correction |'
write(*,*)'************************************************'
write(*,*)
! Set quadrature grid
SGn = 0
call read_grid(SGn,nRad,nAng,nGrid)
! Memory allocation
allocate(root(ncart,nGrid),weight(nGrid))
allocate(AO(nBas,nGrid),dAO(ncart,nBas,nGrid),MO(nBas,nGrid),dMO(ncart,nBas,nGrid))
allocate(rho(nGrid),f(nGrid),mu(nGrid))
call quadrature_grid(nRad,nAng,nGrid,root,weight)
! Calculate AO values at grid points
call AO_values_grid(nBas,nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell,nGrid,root,AO,dAO)
! Calculate MO values at grid points
call MO_values_grid(nBas,nGrid,c,AO,dAO,MO,dMO)
! Compute one-electron density at grid points
call density(nGrid,nBas,P,AO,rho)
! Compute range-sepration function
call f_grid(nBas,nO,nGrid,MO,ERI,f)
call mu_grid(nGrid,rho,f,mu)
! Compute energy correction
call ec_srlda(nGrid,weight,rho,mu)
! Compute orbital corrections
call fc_srlda(nBas,nGrid,weight,MO,rho,mu,eG0W0)
end subroutine basis_correction