PTEROSOR/QuAcK
10
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-11-03 20:53:53 +01:00
Code Releases Activity

change update of GF2 denominator

Browse Source
This commit is contained in:
Pierre-Francois Loos 2023-09-07 15:37:19 +02:00
parent 40c36b1af3
commit a3bff66372
12 changed files with 57 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
input/methods
View File

@ -11,9 +11,9 @@
# phRPA* phRPAx* crRPA ppRPA
F F F F
# G0F2* evGF2* qsGF2* G0F3 evGF3
F F F F F
F T F F F
# G0W0* evGW* qsGW* SRG-qsGW ufG0W0 ufGW
T F F F F F
F F F F F F
# G0T0pp* evGTpp* qsGTpp* G0T0eh evGTeh qsGTeh
T F F T F F
F F F F F F
# * unrestricted version available

22
src/GF/G0F2.f90
View File

@ -34,6 +34,7 @@ subroutine G0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regu
double precision :: Ec
double precision :: EcBSE(nspin)
double precision,allocatable :: eGFlin(:)
double precision,allocatable :: eGF(:)
double precision,allocatable :: SigC(:)
double precision,allocatable :: Z(:)
@ -48,37 +49,34 @@ subroutine G0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regu
! Memory allocation
allocate(SigC(nBas),Z(nBas),eGF(nBas))
if(linearize) then
write(*,*) '*** Quasiparticle equation will be linearized ***'
write(*,*)
end if
allocate(SigC(nBas),Z(nBas),eGFlin(nBas),eGF(nBas))
! Frequency-dependent second-order contribution
if(regularize) then
call GF2_reg_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eHF,ERI,SigC,Z)
call GF2_reg_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,ERI,SigC,Z)
else
call GF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eHF,ERI,SigC,Z)
call GF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,ERI,SigC,Z)
end if
eGFlin(:) = eHF(:) + Z(:)*SigC(:)
if(linearize) then
eGF(:) = eHF(:) + Z(:)*SigC(:)
write(*,*) '*** Quasiparticle energies obtained by linearization ***'
eGF(:) = eGFlin(:)
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*)
call GF2_QP_graph(eta,nBas,nC,nO,nV,nR,eHF,ERI,eGF,Z)
call GF2_QP_graph(eta,nBas,nC,nO,nV,nR,eHF,ERI,eGFlin,eGF,Z)
end if

37
src/GF/GF2_QP_graph.f90
View File

@ -1,4 +1,4 @@
subroutine GF2_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,ERI,eGF,Z)
subroutine GF2_QP_graph(eta,nBas,nC,nO,nV,nR,eHF,ERI,eGFlin,eGF,Z)
! Compute the graphical solution of the GF2 QP equation
@ -8,8 +8,13 @@ subroutine GF2_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,ERI,eGF,Z)
! Input variables
double precision,intent(in) :: eta
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: eGFlin(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
@ -30,47 +35,43 @@ subroutine GF2_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,ERI,eGF,Z)
! Run Newton's algorithm to find the root
write(*,*)'-----------------------------------------------------'
write(*,'(A5,1X,A3,1X,A15,1X,A15,1X,A10)') 'Orb.','It.','e_GFlin (eV)','e_GF (eV)','Z'
write(*,*)'-----------------------------------------------------'
do p=nC+1,nBas-nR
write(*,*) '-----------------'
write(*,'(A10,I3)') 'Orbital ',p
write(*,*) '-----------------'
w = eHF(p)
w = eGFlin(p)
nIt = 0
f = 1d0
write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,f
do while (abs(f) > thresh .and. nIt < maxIt)
nIt = nIt + 1
SigC = GF2_SigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,ERI)
dSigC = GF2_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,ERI)
SigC = GF2_SigC(p,w,eta,nBas,nC,nO,nV,nR,eHF,ERI)
dSigC = GF2_dSigC(p,w,eta,nBas,nC,nO,nV,nR,eHF,ERI)
f = w - eHF(p) - SigC
df = 1d0/(1d0 - dSigC)
w = w - df*f
write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,df,f
end do
if(nIt == maxIt) then
write(*,*) 'Newton root search has not converged!'
eGF(p) = eHF(p)
eGF(p) = eGFlin(p)
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6,1X,A12)') p,nIt,eGFlin(p)*HaToeV,eGF(p)*HaToeV,Z(p),'Cvg Failed!'
else
eGF(p) = w
Z(p) = df
write(*,'(A32,F16.10)') 'Quasiparticle energy (eV) ',eGF(p)*HaToeV
write(*,*)
write(*,'(I5,1X,I3,1X,F15.9,1X,F15.9,1X,F10.6)') p,nIt,eGFlin(p)*HaToeV,eGF(p)*HaToeV,Z(p)
end if
end if
end do
end do
end subroutine

4
src/GF/GF2_SigC.f90
View File

@ -1,4 +1,4 @@
double precision function GF2_SigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,ERI)
double precision function GF2_SigC(p,w,eta,nBas,nC,nO,nV,nR,eHF,ERI)
! Compute diagonal of the correlation part of the self-energy
@ -10,7 +10,7 @@ double precision function GF2_SigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,ERI)
integer,intent(in) :: p
double precision,intent(in) :: w
double precision,intent(in) :: eta
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
integer,intent(in) :: nBas,nC,nO,nV,nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)

4
src/GF/GF2_dSigC.f90
View File

@ -1,4 +1,4 @@
double precision function GF2_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,ERI)
double precision function GF2_dSigC(p,w,eta,nBas,nC,nO,nV,nR,eHF,ERI)
! Compute diagonal of the correlation part of the self-energy
@ -10,7 +10,7 @@ double precision function GF2_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,ERI)
integer,intent(in) :: p
double precision,intent(in) :: w
double precision,intent(in) :: eta
integer,intent(in) :: nBas,nC,nO,nV,nR,nS
integer,intent(in) :: nBas,nC,nO,nV,nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)

9
src/GF/GF2_reg_self_energy.f90
View File

@ -1,4 +1,4 @@
subroutine GF2_reg_self_energy(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
subroutine GF2_reg_self_energy(eta,nBas,nC,nO,nV,nR,e,ERI,SigC,Z)
! Compute GF2 self-energy and its renormalization factor
@ -13,8 +13,7 @@ subroutine GF2_reg_self_energy(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: eGF2(nBas)
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
@ -53,7 +52,7 @@ subroutine GF2_reg_self_energy(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j)
eps = e(p) + e(a) - e(i) - e(j)
kappa = 1d0 - exp(-2d0*eps**2*s)
num = kappa*(2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j)
@ -72,7 +71,7 @@ subroutine GF2_reg_self_energy(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b)
eps = e(p) + e(i) - e(a) - e(b)
kappa = 1d0 - exp(-2d0*eps**2*s)
num = kappa*(2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b)

9
src/GF/GF2_reg_self_energy_diag.f90
View File

@ -1,4 +1,4 @@
subroutine GF2_reg_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
subroutine GF2_reg_self_energy_diag(eta,nBas,nC,nO,nV,nR,e,ERI,SigC,Z)
! Compute diagonal part of the GF2 self-energy and its renormalization factor
@ -13,8 +13,7 @@ subroutine GF2_reg_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: eGF2(nBas)
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
@ -52,7 +51,7 @@ subroutine GF2_reg_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j)
eps = e(p) + e(a) - e(i) - e(j)
kappa = 1d0 - exp(-2d0*eps**2*s)
num = kappa*(2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)
@ -69,7 +68,7 @@ subroutine GF2_reg_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b)
eps = e(p) + e(i) - e(a) - e(b)
kappa = 1d0 - exp(-2d0*eps**2*s)
num = kappa*(2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)

9
src/GF/GF2_self_energy.f90
View File

@ -1,4 +1,4 @@
subroutine GF2_self_energy(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
subroutine GF2_self_energy(eta,nBas,nC,nO,nV,nR,e,ERI,SigC,Z)
! Compute GF2 self-energy and its renormalization factor
@ -13,8 +13,7 @@ subroutine GF2_self_energy(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: eGF2(nBas)
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
@ -42,7 +41,7 @@ subroutine GF2_self_energy(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j)
eps = e(p) + e(a) - e(i) - e(j)
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j)
SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2)
@ -60,7 +59,7 @@ subroutine GF2_self_energy(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b)
eps = e(p) + e(i) - e(a) - e(b)
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b)
SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2)

9
src/GF/GF2_self_energy_diag.f90
View File

@ -1,4 +1,4 @@
subroutine GF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
subroutine GF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,e,ERI,SigC,Z)
! Compute diagonal part of the GF2 self-energy and its renormalization factor
@ -13,8 +13,7 @@ subroutine GF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
integer,intent(in) :: nO
integer,intent(in) :: nV
integer,intent(in) :: nR
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: eGF2(nBas)
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
@ -41,7 +40,7 @@ subroutine GF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
do j=nC+1,nO
do a=nO+1,nBas-nR
eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j)
eps = e(p) + e(a) - e(i) - e(j)
num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j)
SigC(p) = SigC(p) + num*eps/(eps**2 + eta**2)
@ -57,7 +56,7 @@ subroutine GF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eGF2,ERI,SigC,Z)
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b)
eps = e(p) + e(i) - e(a) - e(b)
num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b)
SigC(p) = SigC(p) + num*eps/(eps**2 + eta**2)

8
src/GF/evGF2.f90
View File

@ -82,11 +82,11 @@ subroutine evGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,singlet,tr
if(regularize) then
call GF2_reg_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eGF,ERI,SigC,Z)
call GF2_reg_self_energy_diag(eta,nBas,nC,nO,nV,nR,eGF,ERI,SigC,Z)
else
call GF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,eHF,eGF,ERI,SigC,Z)
call GF2_self_energy_diag(eta,nBas,nC,nO,nV,nR,eGF,ERI,SigC,Z)
end if
@ -94,14 +94,12 @@ subroutine evGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,singlet,tr
if(linearize) then
eGF(:) = eHF(:) + SigC(:)
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*)
call GF2_QP_graph(eta,nBas,nC,nO,nV,nR,eHF,ERI,eGF,Z)
call GF2_QP_graph(eta,nBas,nC,nO,nV,nR,eHF,ERI,eOld,eGF,Z)
end if

4
src/GF/qsGF2.f90
View File

@ -147,11 +147,11 @@ subroutine qsGF2(maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,tr
if(regularize) then
call GF2_reg_self_energy(eta,nBas,nC,nO,nV,nR,eHF,eGF,ERI_MO,SigC,Z)
call GF2_reg_self_energy(eta,nBas,nC,nO,nV,nR,eGF,ERI_MO,SigC,Z)
else
call GF2_self_energy(eta,nBas,nC,nO,nV,nR,eHF,eGF,ERI_MO,SigC,Z)
call GF2_self_energy(eta,nBas,nC,nO,nV,nR,eGF,ERI_MO,SigC,Z)
end if

3
src/GW/GW_QP_graph.f90
View File

@ -78,7 +78,4 @@ subroutine GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eGW,Z)
end do
write(*,*)'-----------------------------------------------------'
write(*,*)
end subroutine