From cf3b2cba5834fdd1627fd850a5f12a5012c3595f Mon Sep 17 00:00:00 2001 From: pfloos Date: Mon, 2 Oct 2023 21:37:25 +0200 Subject: [PATCH] fix QP graph in GW --- input/methods | 2 +- src/CC/CC.f90 | 30 ++++++++++++++++-------------- src/GW/G0W0.f90 | 2 +- src/GW/GW_QP_graph.f90 | 9 +++++---- src/GW/evGW.f90 | 2 +- 5 files changed, 24 insertions(+), 21 deletions(-) diff --git a/input/methods b/input/methods index be4004a..8706d7f 100644 --- a/input/methods +++ b/input/methods @@ -13,7 +13,7 @@ # G0F2* evGF2* qsGF2* G0F3 evGF3 F F F F F # G0W0* evGW* qsGW* SRG-qsGW ufG0W0 ufGW - T F F F F F + T T F F F F # G0T0pp* evGTpp* qsGTpp* G0T0eh evGTeh qsGTeh F F F F F F # * unrestricted version available diff --git a/src/CC/CC.f90 b/src/CC/CC.f90 index 2a90da6..1f5a584 100644 --- a/src/CC/CC.f90 +++ b/src/CC/CC.f90 @@ -1,4 +1,4 @@ -subroutine CC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,do_drCCD,do_rCCD,do_crCCD,do_lCCD, & +subroutine CC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, & maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF) ! Coupled-cluster module @@ -13,20 +13,20 @@ subroutine CC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,do_drCCD,do_rCCD,do_crCCD,do_lCC logical :: doDCD logical :: doCCSD logical :: doCCSDT - logical :: do_drCCD - logical :: do_rCCD - logical :: do_crCCD - logical :: do_lCCD + logical :: dodrCCD + logical :: dorCCD + logical :: docrCCD + logical :: dolCCD integer,intent(in) :: maxSCF integer,intent(in) :: max_diis double precision,intent(in) :: thresh integer,intent(in) :: nBas - integer,intent(in) :: nC - integer,intent(in) :: nO - integer,intent(in) :: nV - integer,intent(in) :: nR + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) double precision,intent(in) :: ENuc double precision,intent(in) :: EHF double precision,intent(in) :: epsHF(nBas) @@ -91,7 +91,7 @@ subroutine CC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,do_drCCD,do_rCCD,do_crCCD,do_lCC ! Perform direct ring CCD calculation !------------------------------------------------------------------------ - if(do_drCCD) then + if(dodrCCD) then call wall_time(start_CC) call drCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF) @@ -107,7 +107,7 @@ subroutine CC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,do_drCCD,do_rCCD,do_crCCD,do_lCC ! Perform ring CCD calculation !------------------------------------------------------------------------ - if(do_rCCD) then + if(dorCCD) then call wall_time(start_CC) call rCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF,epsHF) @@ -123,7 +123,7 @@ subroutine CC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,do_drCCD,do_rCCD,do_crCCD,do_lCC ! Perform crossed-ring CCD calculation !------------------------------------------------------------------------ - if(do_crCCD) then + if(docrCCD) then call wall_time(start_CC) call crCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF) @@ -139,7 +139,7 @@ subroutine CC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,do_drCCD,do_rCCD,do_crCCD,do_lCC ! Perform ladder CCD calculation !------------------------------------------------------------------------ - if(do_lCCD) then + if(dolCCD) then call wall_time(start_CC) call lCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF) @@ -158,7 +158,9 @@ subroutine CC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,do_drCCD,do_rCCD,do_crCCD,do_lCC if(dopCCD) then call wall_time(start_CC) - call pCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF) +! call pCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF) + call ROpCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF) + call wall_time(end_CC) t_CC = end_CC - start_CC diff --git a/src/GW/G0W0.f90 b/src/GW/G0W0.f90 index aa8e43c..c2f4b60 100644 --- a/src/GW/G0W0.f90 +++ b/src/GW/G0W0.f90 @@ -140,7 +140,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dT write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** ' write(*,*) - call GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eGW,Z) + call GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eHF,eGW,Z) end if diff --git a/src/GW/GW_QP_graph.f90 b/src/GW/GW_QP_graph.f90 index 8e77bf7..a69d49c 100644 --- a/src/GW/GW_QP_graph.f90 +++ b/src/GW/GW_QP_graph.f90 @@ -1,4 +1,4 @@ -subroutine GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eGW,Z) +subroutine GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eOld,eGW,Z) ! Compute the graphical solution of the QP equation @@ -34,11 +34,12 @@ subroutine GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eGW,Z) ! Output variables + double precision,intent(out) :: eOld(nBas) double precision,intent(out) :: eGW(nBas) double precision,intent(out) :: Z(nBas) ! Run Newton's algorithm to find the root - + write(*,*)'-----------------------------------------------------' write(*,'(A5,1X,A3,1X,A15,1X,A15,1X,A10)') 'Orb.','It.','e_GWlin (eV)','e_GW (eV)','Z' write(*,*)'-----------------------------------------------------' @@ -53,8 +54,8 @@ subroutine GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eGW,Z) nIt = nIt + 1 - SigC = GW_SigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eGWlin,Om,rho) - dSigC = GW_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eGWlin,Om,rho) + SigC = GW_SigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eOld,Om,rho) + dSigC = GW_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eOld,Om,rho) f = w - eHF(p) - SigC df = 1d0/(1d0 - dSigC) diff --git a/src/GW/evGW.f90 b/src/GW/evGW.f90 index 641680d..7e2d51e 100644 --- a/src/GW/evGW.f90 +++ b/src/GW/evGW.f90 @@ -147,7 +147,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dop write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** ' write(*,*) - call GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eOld,eGW,Z) + call GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eOld,eOld,eGW,Z) end if