LCPQ/quack
4
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-12-22 20:35:36 +01:00
Code Releases Activity

ufGW

Browse Source
This commit is contained in:
Pierre-Francois Loos 2021-10-18 10:10:54 +02:00
parent 90a3570323
commit d038594640
4 changed files with 214 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/MBPT/G0W0.f90
View File

@ -26,7 +26,12 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
logical,intent(in) :: linearize logical,intent(in) :: linearize
double precision,intent(in) :: eta double precision,intent(in) :: eta
integer,intent(in) :: nBas,nC,nO,nV,nR,nS integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF double precision,intent(in) :: ERHF
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)

7
src/MBPT/evGW.f90
View File

@ -30,7 +30,12 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
logical,intent(in) :: singlet logical,intent(in) :: singlet
logical,intent(in) :: triplet logical,intent(in) :: triplet
double precision,intent(in) :: eta double precision,intent(in) :: eta
integer,intent(in) :: nBas,nC,nO,nV,nR,nS integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: PHF(nBas,nBas) double precision,intent(in) :: PHF(nBas,nBas)
double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: cHF(nBas,nBas) double precision,intent(in) :: cHF(nBas,nBas)

7
src/MBPT/qsGW.f90
View File

@ -34,7 +34,12 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE
double precision,intent(in) :: rNuc(nNuc,ncart) double precision,intent(in) :: rNuc(nNuc,ncart)
double precision,intent(in) :: ENuc double precision,intent(in) :: ENuc
integer,intent(in) :: nBas,nC,nO,nV,nR,nS integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ERHF double precision,intent(in) :: ERHF
double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: cHF(nBas,nBas) double precision,intent(in) :: cHF(nBas,nBas)

196
src/MBPT/ufGW.f90 Normal file
View File

@ -0,0 +1,196 @@
subroutine ufGW(eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Unfold GW equations
implicit none
include 'parameters.h'
! Input variables
double precision,intent(in) :: eta
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
double precision,intent(in) :: eHF(nBas)
! Local variables
integer :: p
integer :: i,j,k,l
integer :: a,b,c,d
integer :: klc,kcd,ija,iab
integer :: n2h1p,n2p1h,nH
double precision,external :: Kronecker_delta
double precision,allocatable :: H(:,:)
double precision,allocatable :: eGW(:)
! Output variables
! Hello world
write(*,*)
write(*,*)'**********************************************'
write(*,*)'| Unfolded GW calculation |'
write(*,*)'**********************************************'
write(*,*)
! TDA for W
write(*,*) 'Tamm-Dancoff approximation for dynamic screening by default!'
write(*,*)
! Dimension of the supermatrix
n2h1p = nBas*nO*nS
n2p1h = nBas*nV*nS
nH = nBas + n2h1p + n2p1h
! Memory allocation
allocate(H(nH,nH),eGW(nH))
! Initialization
H(:,:) = 0d0
!---------------------------!
! Compute GW supermatrix !
!---------------------------!
! !
! | F V2h1p V2p1h | !
! | | !
! H = | V2h1p C2h1p 0 | !
! | | !
! | V2p1h 0 C2p1h | !
! !
!---------------------------!
!---------!
! Block F !
!---------!
do p=nC+1,nBas-nV
H(p,p) = eHF(p)
end do
!-------------!
! Block V2h1p !
!-------------!
do p=nC+1,nBas-nV
klc = 0
do k=nC+1,nO
do l=nC+1,nO
do c=nO+1,nBas-nV
klc = klc + 1
H(p ,nBas+klc) = sqrt(2d0)*ERI(p,c,k,l)
H(nBas+klc,p ) = sqrt(2d0)*ERI(p,c,k,l)
end do
end do
end do
end do
!-------------!
! Block V2p1h !
!-------------!
do p=nC+1,nBas-nV
kcd = 0
do k=nC+1,nO
do c=nO+1,nBas-nV
do d=nO+1,nBas-nV
kcd = kcd + 1
H(p ,nBas+kcd) = sqrt(2d0)*ERI(p,k,d,c)
H(nBas+kcd,p ) = sqrt(2d0)*ERI(p,k,d,c)
end do
end do
end do
end do
!-------------!
! Block C2h1p !
!-------------!
ija = 0
do i=nC+1,nO
do j=nC+1,nO
do a=nO+1,nBas-nV
ija = ija + 1
klc = 0
do k=nC+1,nO
do l=nC+1,nO
do c=nO+1,nBas-nV
klc = klc + 1
H(nBas+ija,nBas+klc) = ((eHF(i) + eHF(j) - eHF(a))*Kronecker_delta(j,l)*Kronecker_delta(a,c) &
- ERI(j,c,a,l))**Kronecker_delta(i,k)
end do
end do
end do
end do
end do
end do
!-------------!
! Block C2p1h !
!-------------!
iab = 0
do i=nC+1,nO
do a=nO+1,nBas-nV
do b=nO+1,nBas-nV
iab = iab + 1
kcd = 0
do k=nC+1,nO
do c=nO+1,nBas-nV
do d=nO+1,nBas-nV
kcd = kcd + 1
H(nBas+iab,nBas+kcd) = ((eHF(a) + eHF(b) - eHF(i))*Kronecker_delta(i,k)*Kronecker_delta(a,c) &
- ERI(j,c,a,l))**Kronecker_delta(b,d)
end do
end do
end do
end do
end do
end do
!-------------------------!
! Diagonalize supermatrix !
!-------------------------!
call diagonalize_matrix(nH,H,eGW)
!--------------!
! Dump results !
!--------------!
write(*,*) '---------------------------------------'
write(*,*) ' GW supermatrix quasiparticle energies '
write(*,*) '---------------------------------------'
write(*,*)
call matout(nH,1,eGW)
write(*,*)
end subroutine ufGW