diff --git a/src/GW/RG0W0.f90 b/src/GW/RG0W0.f90 index cba3ac9..d55cb46 100644 --- a/src/GW/RG0W0.f90 +++ b/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 diff --git a/src/GW/RGWC.f90 b/src/GW/RGWC.f90 new file mode 100644 index 0000000..37ed75f --- /dev/null +++ b/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 diff --git a/src/HF/RHF_search.f90 b/src/HF/RHF_search.f90 index 27393a4..b0bdb30 100644 --- a/src/HF/RHF_search.f90 +++ b/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' diff --git a/src/HF/UHF_search.f90 b/src/HF/UHF_search.f90 index 0f597ee..30ae0e2 100644 --- a/src/HF/UHF_search.f90 +++ b/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'