From 354afba78643c6dcc275d27638ea85bd3ac092bb Mon Sep 17 00:00:00 2001 From: pfloos Date: Mon, 2 Oct 2023 21:41:37 +0200 Subject: [PATCH] fix QP graph everywhere --- src/GT/G0T0eh.f90 | 2 +- src/GT/G0T0pp.f90 | 2 +- src/GT/GTeh_QP_graph.f90 | 7 ++++--- src/GT/GTpp_QP_graph.f90 | 7 ++++--- src/GT/evGTeh.f90 | 2 +- src/GT/evGTpp.f90 | 2 +- src/GW/GW_QP_graph.f90 | 2 +- 7 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/GT/G0T0eh.f90 b/src/GT/G0T0eh.f90 index 1f1c74d..ee6ce17 100644 --- a/src/GT/G0T0eh.f90 +++ b/src/GT/G0T0eh.f90 @@ -148,7 +148,7 @@ subroutine G0T0eh(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE, write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** ' write(*,*) - call GTeh_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rhoL,rhoR,eGTlin,eGT,Z) + call GTeh_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rhoL,rhoR,eGTlin,eHF,eGT,Z) end if diff --git a/src/GT/G0T0pp.f90 b/src/GT/G0T0pp.f90 index 7093be8..648b1f1 100644 --- a/src/GT/G0T0pp.f90 +++ b/src/GT/G0T0pp.f90 @@ -195,7 +195,7 @@ subroutine G0T0pp(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,dopp write(*,*) call GTpp_QP_graph(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,Om1s,rho1s,Om2s,rho2s, & - Om1t,rho1t,Om2t,rho2t,eGTlin,eGT,Z) + Om1t,rho1t,Om2t,rho2t,eGTlin,eHF,eGT,Z) end if diff --git a/src/GT/GTeh_QP_graph.f90 b/src/GT/GTeh_QP_graph.f90 index 4f963cf..14a7c09 100644 --- a/src/GT/GTeh_QP_graph.f90 +++ b/src/GT/GTeh_QP_graph.f90 @@ -1,4 +1,4 @@ -subroutine GTeh_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rhoL,rhoR,eGTlin,eGT,Z) +subroutine GTeh_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rhoL,rhoR,eGTlin,eOld,eGT,Z) ! Compute the graphical solution of the QP equation @@ -22,6 +22,7 @@ subroutine GTeh_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rhoL,rhoR,eGTlin,eGT,Z) double precision,intent(in) :: rhoR(nBas,nBas,nS) double precision,intent(in) :: eGTlin(nBas) + double precision,intent(in) :: eOld(nBas) ! Local variables @@ -55,8 +56,8 @@ subroutine GTeh_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rhoL,rhoR,eGTlin,eGT,Z) nIt = nIt + 1 - SigC = GTeh_SigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eGTlin,Om,rhoL,rhoR) - dSigC = GTeh_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eGTlin,Om,rhoL,rhoR) + SigC = GTeh_SigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eOld,Om,rhoL,rhoR) + dSigC = GTeh_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eOld,Om,rhoL,rhoR) f = w - eHF(p) - SigC df = 1d0/(1d0 - dSigC) w = w - df*f diff --git a/src/GT/GTpp_QP_graph.f90 b/src/GT/GTpp_QP_graph.f90 index b94a780..bc53745 100644 --- a/src/GT/GTpp_QP_graph.f90 +++ b/src/GT/GTpp_QP_graph.f90 @@ -1,5 +1,5 @@ subroutine GTpp_QP_graph(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,Om1s,rho1s,Om2s,rho2s, & - Om1t,rho1t,Om2t,rho2t,eGTlin,eGT,Z) + Om1t,rho1t,Om2t,rho2t,eGTlin,eOld,eGT,Z) ! Compute the graphical solution of the QP equation @@ -24,6 +24,7 @@ subroutine GTpp_QP_graph(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,Om1s,rho1s double precision,intent(in) :: rho2s(nBas,nBas,nOOs),rho2t(nBas,nBas,nOOt) double precision,intent(in) :: eGTlin(nBas) + double precision,intent(in) :: eOld(nBas) ! Local variables @@ -60,8 +61,8 @@ subroutine GTpp_QP_graph(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,Om1s,rho1s nIt = nIt + 1 - SigC = GTpp_SigC(p,w,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eGTlin,Om1s,rho1s,Om2s,rho2s,Om1t,rho1t,Om2t,rho2t) - dSigC = GTpp_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eGTlin,Om1s,rho1s,Om2s,rho2s,Om1t,rho1t,Om2t,rho2t) + SigC = GTpp_SigC(p,w,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eOld,Om1s,rho1s,Om2s,rho2s,Om1t,rho1t,Om2t,rho2t) + dSigC = GTpp_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eOld,Om1s,rho1s,Om2s,rho2s,Om1t,rho1t,Om2t,rho2t) f = w - eHF(p) - SigC df = 1d0/(1d0 - dSigC) w = w - df*f diff --git a/src/GT/evGTeh.f90 b/src/GT/evGTeh.f90 index 59f5a4c..b316755 100644 --- a/src/GT/evGTeh.f90 +++ b/src/GT/evGTeh.f90 @@ -153,7 +153,7 @@ subroutine evGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** ' write(*,*) - call GTeh_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rhoL,rhoR,eOld,eGT,Z) + call GTeh_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rhoL,rhoR,eOld,eOld,eGT,Z) end if diff --git a/src/GT/evGTpp.f90 b/src/GT/evGTpp.f90 index 2c40455..c33bf4b 100644 --- a/src/GT/evGTpp.f90 +++ b/src/GT/evGTpp.f90 @@ -210,7 +210,7 @@ subroutine evGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_T write(*,*) call GTpp_QP_graph(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,Om1s,rho1s,Om2s,rho2s, & - Om1t,rho1t,Om2t,rho2t,eOld,eGT,Z) + Om1t,rho1t,Om2t,rho2t,eOld,eOld,eGT,Z) end if diff --git a/src/GW/GW_QP_graph.f90 b/src/GW/GW_QP_graph.f90 index a69d49c..2bbf26c 100644 --- a/src/GW/GW_QP_graph.f90 +++ b/src/GW/GW_QP_graph.f90 @@ -20,6 +20,7 @@ subroutine GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eOld,eGW,Z) double precision,intent(in) :: rho(nBas,nBas,nS) double precision,intent(in) :: eGWlin(nBas) + double precision,intent(in) :: eOld(nBas) ! Local variables @@ -34,7 +35,6 @@ subroutine GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eOld,eGW,Z) ! Output variables - double precision,intent(out) :: eOld(nBas) double precision,intent(out) :: eGW(nBas) double precision,intent(out) :: Z(nBas)