GW+C

src/GW/RG0W0.f90

@@ -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

src/GW/RGWC.f90

@@ -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 

src/HF/RHF_search.f90

@@ -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'

src/HF/UHF_search.f90

@@ -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'