From e2617c1113d6760ddcf16938e93412f36fedd9bb Mon Sep 17 00:00:00 2001 From: pfloos Date: Mon, 9 Sep 2024 20:49:35 +0200 Subject: [PATCH] debugging AC@BSE --- mol/H2.xyz | 4 ++-- mol/LiF.xyz | 2 +- mol/LiH.xyz | 2 +- src/GW/RG0W0.f90 | 8 +++----- src/GW/RGW_phACFDT.f90 | 14 +++++++++----- src/GW/RGW_phBSE_static_kernel_A.f90 | 1 + src/GW/RGW_phBSE_static_kernel_B.f90 | 1 + src/GW/SRG_qsRGW.f90 | 3 +-- src/GW/evRGW.f90 | 2 +- src/GW/qsRGW.f90 | 3 +-- 10 files changed, 21 insertions(+), 19 deletions(-) diff --git a/mol/H2.xyz b/mol/H2.xyz index 48f4296..78ebb0e 100644 --- a/mol/H2.xyz +++ b/mol/H2.xyz @@ -1,4 +1,4 @@ 2 -H 0.00000000 -0.37500000 0.00000000 -H 0.00000000 0.37500000 0.00000000 +H 0.00000000 0.0 0.0 +H 0.00000000 0.0 0.74031892 diff --git a/mol/LiF.xyz b/mol/LiF.xyz index 3dd0df2..b41b2e2 100644 --- a/mol/LiF.xyz +++ b/mol/LiF.xyz @@ -1,4 +1,4 @@ 2 Li 0.0000 0.0000 0.0000 -F 0.0000 0.0000 1.58753 +F 0.0000 0.0000 1.5732438 diff --git a/mol/LiH.xyz b/mol/LiH.xyz index 17ea054..aae43a1 100644 --- a/mol/LiH.xyz +++ b/mol/LiH.xyz @@ -1,4 +1,4 @@ 2 Li 0.0000 0.0000 0.0000 -H 0.0000 0.0000 1.5921 +H 0.0000 0.0000 1.5965276 diff --git a/src/GW/RG0W0.f90 b/src/GW/RG0W0.f90 index 0d61a0e..37162b3 100644 --- a/src/GW/RG0W0.f90 +++ b/src/GW/RG0W0.f90 @@ -102,8 +102,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA ! Compute screening ! !-------------------! - call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph) - + call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph) if(.not.TDA_W) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY) @@ -160,8 +159,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA ! Compute the RPA correlation energy - call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,Aph) - + call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,Aph) if(.not.TDA_W) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY) @@ -210,7 +208,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA end if - call RGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,dophBSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGW,EcBSE) + call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGW,EcBSE) write(*,*) write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/GW/RGW_phACFDT.f90 b/src/GW/RGW_phACFDT.f90 index 69c6aca..5268c88 100644 --- a/src/GW/RGW_phACFDT.f90 +++ b/src/GW/RGW_phACFDT.f90 @@ -1,4 +1,4 @@ -subroutine RGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eW,e,EcAC) +subroutine RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eW,eGW,EcAC) ! Compute the correlation energy via the adiabatic connection fluctuation dissipation theorem @@ -10,10 +10,8 @@ subroutine RGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet,triplet, logical,intent(in) :: doXBS logical,intent(in) :: exchange_kernel - logical,intent(in) :: dRPA logical,intent(in) :: TDA_W logical,intent(in) :: TDA - logical,intent(in) :: BSE logical,intent(in) :: singlet logical,intent(in) :: triplet @@ -25,11 +23,12 @@ subroutine RGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet,triplet, integer,intent(in) :: nR integer,intent(in) :: nS double precision,intent(in) :: eW(nBas) - double precision,intent(in) :: e(nBas) + double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) ! Local variables + logical :: dRPA = .false. logical :: dRPA_W = .true. integer :: ispin integer :: isp_W @@ -77,7 +76,6 @@ subroutine RGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet,triplet, ! Compute (singlet) RPA screening isp_W = 1 - EcRPA = 0d0 call phLR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS,1d0,eW,ERI,Aph) if(.not.TDA_W) call phLR_B(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) @@ -120,6 +118,9 @@ subroutine RGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet,triplet, end if + call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,eGW,ERI,Aph) + if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,ERI,Bph) + Aph(:,:) = Aph(:,:) + KA(:,:) if(.not.TDA) Bph(:,:) = Bph(:,:) + KB(:,:) @@ -174,6 +175,9 @@ subroutine RGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet,triplet, end if + call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,eGW,ERI,Aph) + if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,ERI,Bph) + Aph(:,:) = Aph(:,:) + KA(:,:) if(.not.TDA) Bph(:,:) = Bph(:,:) + KB(:,:) diff --git a/src/GW/RGW_phBSE_static_kernel_A.f90 b/src/GW/RGW_phBSE_static_kernel_A.f90 index dcac026..dc7434e 100644 --- a/src/GW/RGW_phBSE_static_kernel_A.f90 +++ b/src/GW/RGW_phBSE_static_kernel_A.f90 @@ -46,6 +46,7 @@ subroutine RGW_phBSE_static_kernel_A(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Om,rho,K chi = chi + rho(i,j,kc)*rho(a,b,kc)*Om(kc)/eps end do +! KA(ia,jb) = 4d0*chi KA(ia,jb) = 4d0*lambda*chi end do diff --git a/src/GW/RGW_phBSE_static_kernel_B.f90 b/src/GW/RGW_phBSE_static_kernel_B.f90 index 22aad26..e98c790 100644 --- a/src/GW/RGW_phBSE_static_kernel_B.f90 +++ b/src/GW/RGW_phBSE_static_kernel_B.f90 @@ -46,6 +46,7 @@ subroutine RGW_phBSE_static_kernel_B(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Om,rho,K chi = chi + rho(i,b,kc)*rho(a,j,kc)*Om(kc)/eps end do +! KB(ia,jb) = 4d0*chi KB(ia,jb) = 4d0*lambda*chi end do diff --git a/src/GW/SRG_qsRGW.f90 b/src/GW/SRG_qsRGW.f90 index 1bcbcfc..90cff7b 100644 --- a/src/GW/SRG_qsRGW.f90 +++ b/src/GW/SRG_qsRGW.f90 @@ -385,8 +385,7 @@ subroutine SRG_qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS end if - call RGW_phACFDT(exchange_kernel, doXBS, .true., TDA_W, TDA, BSE, singlet, triplet, & - eta, nOrb, nC, nO, nV, nR, nS, ERI_MO, eGW, eGW, EcBSE) + call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI_MO,eGW,eGW,EcBSE) write(*,*) write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/GW/evRGW.f90 b/src/GW/evRGW.f90 index adb1883..6de0efc 100644 --- a/src/GW/evRGW.f90 +++ b/src/GW/evRGW.f90 @@ -255,7 +255,7 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop end if - call RGW_phACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,dophBSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eGW,eGW,EcBSE) + call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eGW,eGW,EcBSE) write(*,*) write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/GW/qsRGW.f90 b/src/GW/qsRGW.f90 index 73e9d46..4990da1 100644 --- a/src/GW/qsRGW.f90 +++ b/src/GW/qsRGW.f90 @@ -351,8 +351,7 @@ subroutine qsRGW(dotest, maxSCF, thresh, max_diis, doACFDT, exchange_kernel, doX end if - call RGW_phACFDT(exchange_kernel, doXBS, .true., TDA_W, TDA, dophBSE, singlet, triplet, & - eta, nOrb, nC, nO, nV, nR, nS, ERI_MO, eGW, eGW, EcBSE) + call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI_MO,eGW,eGW,EcBSE) write(*,*) write(*,*)'-------------------------------------------------------------------------------'