PTEROSOR/QuAcK
10
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-11-03 12:43:48 +01:00
Code Releases Activity

GW+C

Browse Source
This commit is contained in:
Pierre-Francois Loos 2024-01-17 18:40:21 +01:00
parent 1230938316
commit 3d5f60139e
4 changed files with 77 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/GW/RG0W0.f90
View File

@ -56,8 +56,6 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
double precision,allocatable :: XmY(:,:)
double precision,allocatable :: rho(:,:,:)
double precision,allocatable :: W(:,:,:,:)
double precision,allocatable :: eGWlin(:)
double precision,allocatable :: eGW(:)
@ -163,6 +161,8 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
call print_RG0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM)
call RGWC(dotest,nBas,eGW,Z)
! Perform BSE calculation
if(dophBSE) then
@ -233,13 +233,6 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
end if
! if(.true.) then
! allocate(W(nBas,nBas,nBas,nBas))
! call GW_phBSE_static_kernel(eta,nBas,nC,nO,nV,nR,nS,1d0,ERI,Om,rho,W)
! call pCCD(dotest,264,1d-7,5,nBas,nC,nO,nV,nR,ERI,W,ERHF,eGW)
! deallocate(W)
! end if
! Testing zone

73
src/GW/RGWC.f90 Normal file
View File

@ -0,0 +1,73 @@
subroutine RGWC(dotest,nBas,eGW,Z)
! Perform GW+C calculation
implicit none
include 'parameters.h'
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: nBas
double precision,intent(in) :: eGW(nBas)
double precision,intent(in) :: Z(nBas)
! Local variables
integer :: p
double precision,allocatable :: eGWC(:)
double precision,allocatable :: ZC(:)
! Output variables
! Hello world
write(*,*)
write(*,*)'*******************************'
write(*,*)'* Restricted GW+C Calculation *'
write(*,*)'*******************************'
write(*,*)
! Memory allocation
allocate(eGWC(nBas),ZC(nBas))
! GW+C weights
ZC(:) = exp(1d0 - 1d0/Z(:))
! GW+C quasiparticles
eGWC(:) = eGW(:)
! Dump results
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)' GW+C calculation '
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X,A15,1X,A1,1X)') &
'|','#','|','e_GW (eV)','|','e_GW+C (eV)','|','Z','|','ZC','|'
write(*,*)'-------------------------------------------------------------------------------'
do p=1,nBas
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',p,'|',eGW(p)*HaToeV,'|',eGWC(p)*HaToeV,'|',Z(p),'|',ZC(p),'|'
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
! Testing zone
! if(dotest) then
! call dump_test_value('R','G0W0 correlation energy',EcRPA)
! call dump_test_value('R','G0W0 HOMO energy',eGW(nO))
! call dump_test_value('R','G0W0 LUMO energy',eGW(nO+1))
! end if
end subroutine

2
src/HF/RHF_search.f90
View File

@ -144,7 +144,7 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
end do
write(*,*)'-------------------------------------------------------------'
if(minval(Om(:)) < 0d0) then
if(minval(Om(:)) < 1d-7) then
write(*,'(1X,A40,1X)') 'Too bad, RHF solution is unstable!'
write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue:',Om(1),' au'

2
src/HF/UHF_search.f90
View File

@ -169,7 +169,7 @@ subroutine UHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
end do
write(*,*)'-------------------------------------------------------------'
if(minval(Om_sc(:)) < 0d0) then
if(minval(Om_sc(:)) < 1d-7) then
write(*,'(1X,A40,1X)') 'Too bad, UHF solution is unstable!'
write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue:',Om_sc(1),' au'