PTEROSOR/QuAcK
10
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-12-31 16:45:49 +01:00
Code Releases Activity

Merge branch 'master' of github.com:pfloos/QuAcK

Browse Source
This commit is contained in:
Antoine Marie 2023-12-03 21:07:41 +01:00
commit dac467ede9
158 changed files with 1040 additions and 1092 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
src/AOtoMO/AOtoMO_ERI_GHF.f90
View File

@ -36,63 +36,4 @@ subroutine AOtoMO_ERI_GHF(nBas,nBas2,c1,c2,ERI_AO,ERI_MO)
call dgemm('T','N',nBas2**3,nBas2,nBas,1d0,scr,nBas,c2(1,1),nBas,0d0,ERI_MO,nBas2**3)
! Four-index transform via semi-direct O(N^5) algorithm
! scr(:,:,:,:) = 0d0
! do l=1,nBas2
! do si=1,nBas
! do la=1,nBas
! do nu=1,nBas
! do mu=1,nBas
! scr(mu,nu,la,l) = scr(mu,nu,la,l) + ERI_AO(mu,nu,la,si)*c2(si,l)
! enddo
! enddo
! enddo
! enddo
! enddo
! ERI_MO(:,:,:,:) = 0d0
! do l=1,nBas2
! do la=1,nBas
! do nu=1,nBas
! do i=1,nBas2
! do mu=1,nBas
! ERI_MO(i,nu,la,l) = ERI_MO(i,nu,la,l) + c1(mu,i)*scr(mu,nu,la,l)
! enddo
! enddo
! enddo
! enddo
! enddo
! scr(:,:,:,:) = 0d0
! do l=1,nBas2
! do k=1,nBas2
! do la=1,nBas
! do nu=1,nBas
! do i=1,nBas2
! scr(i,nu,k,l) = scr(i,nu,k,l) + ERI_MO(i,nu,la,l)*c1(la,k)
! enddo
! enddo
! enddo
! enddo
! enddo
! ERI_MO(:,:,:,:) = 0d0
! do l=1,nBas2
! do k=1,nBas2
! do j=1,nBas2
! do i=1,nBas2
! do nu=1,nBas
! ERI_MO(i,j,k,l) = ERI_MO(i,j,k,l) + c2(nu,j)*scr(i,nu,k,l)
! enddo
! enddo
! enddo
! enddo
! enddo
end subroutine

40
src/AOtoMO/AOtoMO_oooa.f90
View File

@ -35,11 +35,11 @@ subroutine AOtoMO_oooa(nBas,nO,nA,cO,cA,O,ooOoa)
do si=1,nBas
do x=1,nA
scr1(mu,nu,la,x) = scr1(mu,nu,la,x) + O(mu,nu,la,si)*cA(si,x)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
scr2 = 0d0
do mu=1,nBas
@ -48,11 +48,11 @@ subroutine AOtoMO_oooa(nBas,nO,nA,cO,cA,O,ooOoa)
do i=1,nO
do x=1,nA
scr2(i,nu,la,x) = scr2(i,nu,la,x) + cO(mu,i)*scr1(mu,nu,la,x)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
scr1 = 0d0
do nu=1,nBas
@ -61,11 +61,11 @@ subroutine AOtoMO_oooa(nBas,nO,nA,cO,cA,O,ooOoa)
do k=1,nO
do x=1,nA
scr1(i,nu,k,x) = scr1(i,nu,k,x) + scr2(i,nu,la,x)*cO(la,k)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
ooOoa = 0d0
do nu=1,nBas
@ -74,11 +74,11 @@ subroutine AOtoMO_oooa(nBas,nO,nA,cO,cA,O,ooOoa)
do k=1,nO
do x=1,nA
ooOoa(i,j,k,x) = ooOoa(i,j,k,x) + cO(nu,j)*scr1(i,nu,k,x)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
deallocate(scr1,scr2)

40
src/AOtoMO/AOtoMO_oooo.f90
View File

@ -35,11 +35,11 @@ subroutine AOtoMO_oooo(nBas,nO,cO,O,ooOoo)
do si=1,nBas
do l=1,nO
scr1(mu,nu,la,l) = scr1(mu,nu,la,l) + O(mu,nu,la,si)*cO(si,l)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
scr2 = 0d0
do mu=1,nBas
@ -48,11 +48,11 @@ subroutine AOtoMO_oooo(nBas,nO,cO,O,ooOoo)
do i=1,nO
do l=1,nO
scr2(i,nu,la,l) = scr2(i,nu,la,l) + cO(mu,i)*scr1(mu,nu,la,l)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
scr1 = 0d0
do nu=1,nBas
@ -61,11 +61,11 @@ subroutine AOtoMO_oooo(nBas,nO,cO,O,ooOoo)
do k=1,nO
do l=1,nO
scr1(i,nu,k,l) = scr1(i,nu,k,l) + scr2(i,nu,la,l)*cO(la,k)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
ooOoo = 0d0
do nu=1,nBas
@ -74,11 +74,11 @@ subroutine AOtoMO_oooo(nBas,nO,cO,O,ooOoo)
do k=1,nO
do l=1,nO
ooOoo(i,j,k,l) = ooOoo(i,j,k,l) + cO(nu,j)*scr1(i,nu,k,l)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
deallocate(scr1,scr2)

40
src/AOtoMO/AOtoMO_oovv.f90
View File

@ -29,11 +29,11 @@ subroutine AOtoMO_oovv(nBas,nO,nV,cO,cV,O,ooOvv)
do si=1,nBas
do b=1,nV
scr1(mu,nu,la,b) = scr1(mu,nu,la,b) + O(mu,nu,la,si)*cV(si,b)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
scr2 = 0d0
do mu=1,nBas
@ -42,11 +42,11 @@ subroutine AOtoMO_oovv(nBas,nO,nV,cO,cV,O,ooOvv)
do i=1,nO
do b=1,nV
scr2(i,nu,la,b) = scr2(i,nu,la,b) + cO(mu,i)*scr1(mu,nu,la,b)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
scr1 = 0d0
do nu=1,nBas
@ -55,11 +55,11 @@ subroutine AOtoMO_oovv(nBas,nO,nV,cO,cV,O,ooOvv)
do a=1,nV
do b=1,nV
scr1(i,nu,a,b) = scr1(i,nu,a,b) + scr2(i,nu,la,b)*cV(la,a)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
ooOvv = 0d0
do nu=1,nBas
@ -68,10 +68,10 @@ subroutine AOtoMO_oovv(nBas,nO,nV,cO,cV,O,ooOvv)
do a=1,nV
do b=1,nV
ooOvv(i,j,a,b) = ooOvv(i,j,a,b) + cO(nu,j)*scr1(i,nu,a,b)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end subroutine

8
src/AOtoMO/Hartree_matrix_AO_basis.f90
View File

@ -26,9 +26,9 @@ subroutine Hartree_matrix_AO_basis(nBas,P,G,H)
do la=1,nBas
do si=1,nBas
H(mu,nu) = H(mu,nu) + P(la,si)*G(mu,la,nu,si)
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

8
src/AOtoMO/exchange_matrix_AO_basis.f90
View File

@ -25,9 +25,9 @@ subroutine exchange_matrix_AO_basis(nBas,P,ERI,K)
do la=1,nBas
do mu=1,nBas
K(mu,nu) = K(mu,nu) - P(la,si)*ERI(mu,la,si,nu)
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

4
src/CC/CCD.f90
View File

@ -213,7 +213,7 @@ subroutine CCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -231,7 +231,7 @@ subroutine CCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc
stop
endif
end if
write(*,*)
write(*,*)'----------------------------------------------------'

8
src/CC/CCD_correlation_energy.f90
View File

@ -26,10 +26,10 @@ subroutine CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCCD)
EcCCD = EcCCD + OOVV(i,j,a,b)*t2(i,j,a,b)
enddo
enddo
enddo
enddo
end do
end do
end do
end do
EcCCD = 0.25d0*EcCCD

6
src/CC/CCGW.f90
View File

@ -316,7 +316,7 @@ subroutine CCGW(maxSCF,thresh,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,e)
write(*,'(1X,A1,1X,I3,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',eGW(nO)*HaToeV,'|',eGW(nO+1)*HaToeV,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -334,7 +334,7 @@ subroutine CCGW(maxSCF,thresh,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,e)
stop
endif
end if
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)' CCGW calculation '
@ -346,7 +346,7 @@ subroutine CCGW(maxSCF,thresh,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,e)
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,'|',e(p)*HaToeV,'|',(eGW(p)-e(p))*HaToeV,'|',Z(p),'|',eGW(p)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
end subroutine

8
src/CC/CCSD_correlation_energy.f90
View File

@ -26,10 +26,10 @@ subroutine CCSD_correlation_energy(nC,nO,nV,nR,OOVV,tau,EcCCSD)
EcCCSD = EcCCSD + OOVV(i,j,a,b)*tau(i,j,a,b)
enddo
enddo
enddo
enddo
end do
end do
end do
end do
EcCCSD = 0.5d0*EcCCSD

20
src/CC/DCD.f90
View File

@ -133,10 +133,10 @@ subroutine DCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
EcCC = EcCC + (2d0*OOVV(i,j,a,b) - OOVV(i,j,b,a))*t(i,j,a,b)
enddo
enddo
enddo
enddo
end do
end do
end do
end do
! Dump results
@ -156,10 +156,10 @@ subroutine DCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
do a=1,nV-nR
do b=1,nV-nR
tt(i,j,a,b) = 2d0*t(i,j,a,b) - t(i,j,b,a)
enddo
enddo
enddo
enddo
end do
end do
end do
end do
xV(:,:) = 0d0
do a=1,nV-nR
@ -262,7 +262,7 @@ subroutine DCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
if(abs(rcond) < 1d-15) n_diis = 0
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -280,7 +280,7 @@ subroutine DCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
stop
endif
end if
! Testing zone

4
src/CC/GCCD.f90
View File

@ -190,7 +190,7 @@ subroutine GCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -208,7 +208,7 @@ subroutine GCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF
stop
endif
end if
write(*,*)
write(*,*)'----------------------------------------------------'

8
src/CC/MP3_correlation_energy.f90
View File

@ -28,10 +28,10 @@ subroutine MP3_correlation_energy(nC,nO,nV,nR,OOVV,t2,v,delta_OOVV,EcMP3)
EcMP3 = EcMP3 + OOVV(i,j,a,b)*(t2(i,j,a,b) + v(i,j,a,b)/delta_OOVV(i,j,a,b))
enddo
enddo
enddo
enddo
end do
end do
end do
end do
EcMP3 = 0.25d0*EcMP3

18
src/CC/antisymmetrize_ERI.f90
View File

@ -24,10 +24,10 @@ subroutine antisymmetrize_ERI(ispin,nBas,ERI,db_ERI)
do k=1,nBas
do l=1,nBas
db_ERI(i,j,k,l) = 2d0*ERI(i,j,k,l) - ERI(i,j,l,k)
enddo
enddo
enddo
enddo
end do
end do
end do
end do
elseif(ispin == 2) then
@ -36,11 +36,11 @@ subroutine antisymmetrize_ERI(ispin,nBas,ERI,db_ERI)
do k=1,nBas
do l=1,nBas
db_ERI(i,j,k,l) = ERI(i,j,k,l) - ERI(i,j,l,k)
enddo
enddo
enddo
enddo
end do
end do
end do
end do
endif
end if
end subroutine

4
src/CC/crCCD.f90
View File

@ -175,7 +175,7 @@ subroutine crCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,EN
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -193,7 +193,7 @@ subroutine crCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,EN
stop
endif
end if
write(*,*)
write(*,*)'----------------------------------------------------'

4
src/CC/crGCCD.f90
View File

@ -151,7 +151,7 @@ subroutine crGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,e
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -169,7 +169,7 @@ subroutine crGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,e
stop
endif
end if
write(*,*)
write(*,*)'----------------------------------------------------'

4
src/CC/drCCD.f90
View File

@ -168,7 +168,7 @@ subroutine drCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,EN
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -186,7 +186,7 @@ subroutine drCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,EN
stop
endif
end if
write(*,*)
write(*,*)'----------------------------------------------------'

4
src/CC/drGCCD.f90
View File

@ -143,7 +143,7 @@ subroutine drGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,e
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -161,7 +161,7 @@ subroutine drGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,e
stop
endif
end if
write(*,*)
write(*,*)'----------------------------------------------------'

4
src/CC/form_EOM_one_body.f90
View File

@ -72,8 +72,8 @@ subroutine form_EOM_one_body(nO,nV,foo,fov,fvv,t1,t2,OOOV,OOVV,OVVV,cFoo,cFov,cF
end do
end do
enddo
enddo
end do
end do
! OO block

40
src/CC/form_FB.f90
View File

@ -34,11 +34,11 @@ subroutine form_FB(nC,nO,nV,nR,foo,fvv,fov,OOOV,OOVV,OVVV,t,FooB,FvvB,FovB)
do a=1,nV-nR
do b=1,nV-nR
FooB(i,k) = FooB(i,k) + 0.5d0*OOVV(k,j,a,b)*t(i,j,a,b)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
! Virtual-virtual block
@ -49,11 +49,11 @@ subroutine form_FB(nC,nO,nV,nR,foo,fvv,fov,OOOV,OOVV,OVVV,t,FooB,FvvB,FovB)
do j=1,nO-nC
do c=1,nV-nR
FvvB(a,c) = FvvB(a,c) - 0.5d0*OOVV(i,j,c,b)*t(i,j,a,b)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
! Occupied-virtual block
@ -64,26 +64,26 @@ subroutine form_FB(nC,nO,nV,nR,foo,fvv,fov,OOOV,OOVV,OVVV,t,FooB,FvvB,FovB)
do j=1,nO-nC
do b=1,nV-nR
FovB(i,a) = FovB(i,a) - fov(j,b)*t(i,j,a,b)
enddo
enddo
end do
end do
do j=1,nO-nC
do b=1,nV-nR
do c=1,nV-nR
FovB(i,a) = FovB(i,a) + 0.5d0*OVVV(j,a,b,c)*t(i,j,b,c)
enddo
enddo
enddo
end do
end do
end do
do j=1,nO-nC
do k=1,nO-nC
do b=1,nV-nR
FovB(i,a) = FovB(i,a) - 0.5d0*OOOV(j,k,i,b)*t(j,k,a,b)
enddo
enddo
enddo
end do
end do
end do
enddo
enddo
end do
end do
end subroutine

44
src/CC/form_X.f90
View File

@ -38,12 +38,12 @@ subroutine form_X(nC,nO,nV,nR,OOVV,t2,X1,X2,X3,X4)
do c=1,nV-nR
do d=1,nV-nR
X1(k,l,i,j) = X1(k,l,i,j) + OOVV(k,l,c,d)*t2(i,j,c,d)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
! Build X2
@ -53,11 +53,11 @@ subroutine form_X(nC,nO,nV,nR,OOVV,t2,X1,X2,X3,X4)
do l=1,nO-nC
do d=1,nV-nR
X2(b,c) = X2(b,c) + OOVV(k,l,c,d)*t2(k,l,b,d)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
! Build X3
@ -67,11 +67,11 @@ subroutine form_X(nC,nO,nV,nR,OOVV,t2,X1,X2,X3,X4)
do c=1,nV-nR
do d=1,nV-nR
X3(k,j) = X3(k,j) + OOVV(k,l,c,d)*t2(j,l,c,d)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
! Build X4
@ -82,11 +82,11 @@ subroutine form_X(nC,nO,nV,nR,OOVV,t2,X1,X2,X3,X4)
do k=1,nO-nC
do c=1,nV-nR
X4(i,l,a,d) = X4(i,l,a,d) + OOVV(k,l,c,d)*t2(i,k,a,c)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
end subroutine

12
src/CC/form_delta_OOOVVV.f90
View File

@ -27,11 +27,11 @@ subroutine form_delta_OOOVVV(nC,nO,nV,nR,eO,eV,delta)
delta(i,j,k,a,b,c) = eV(a) + eV(b) + eV(c) - eO(i) - eO(j) - eO(k)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
end subroutine

8
src/CC/form_delta_OOVV.f90
View File

@ -25,9 +25,9 @@ subroutine form_delta_OOVV(nC,nO,nV,nR,eO,eV,delta)
delta(i,j,a,b) = eV(a) + eV(b) - eO(i) - eO(j)
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

4
src/CC/form_delta_OV.f90
View File

@ -24,7 +24,7 @@ subroutine form_delta_OV(nC,nO,nV,nR,eO,eV,delta)
do i=1,nO-nC
do a=1,nV-nR
delta(i,a) = eV(a) - eO(i)
enddo
enddo
end do
end do
end subroutine

8
src/CC/form_tau.f90
View File

@ -26,9 +26,9 @@ subroutine form_tau(nC,nO,nV,nR,t1,t2,tau)
tau(i,j,a,b) = 0.5d0*t2(i,j,a,b) + t1(i,a)*t1(j,b)
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

8
src/CC/form_tau_nc.f90
View File

@ -26,9 +26,9 @@ subroutine form_tau_nc(nO,nV,t1,t2,tau)
tau(i,j,a,b) = t2(i,j,a,b) + t1(i,a)*t1(j,b) - t1(i,b)*t1(j,a)
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

8
src/CC/form_taus_nc.f90
View File

@ -26,9 +26,9 @@ subroutine form_taus_nc(nO,nV,t1,t2,taus)
taus(i,j,a,b) = t2(i,j,a,b) + 0.5d0*(t1(i,a)*t1(j,b) - t1(i,b)*t1(j,a))
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

36
src/CC/form_u.f90
View File

@ -30,12 +30,12 @@ subroutine form_u(nC,nO,nV,nR,OOOO,VVVV,OVOV,t2,u)
do c=1,nV-nR
do d=1,nV-nR
u(i,j,a,b) = u(i,j,a,b) + 0.5d0*VVVV(a,b,c,d)*t2(i,j,c,d)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
do i=1,nO-nC
do j=1,nO-nC
@ -44,12 +44,12 @@ subroutine form_u(nC,nO,nV,nR,OOOO,VVVV,OVOV,t2,u)
do a=1,nV-nR
do b=1,nV-nR
u(i,j,a,b) = u(i,j,a,b) + 0.5d0*OOOO(k,l,i,j)*t2(k,l,a,b)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
do i=1,nO-nC
do j=1,nO-nC
@ -61,11 +61,11 @@ subroutine form_u(nC,nO,nV,nR,OOOO,VVVV,OVOV,t2,u)
+ OVOV(k,a,j,c)*t2(i,k,b,c) &
- OVOV(k,a,i,c)*t2(j,k,b,c) &
+ OVOV(k,b,i,c)*t2(j,k,a,c)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
end subroutine

44
src/CC/form_v.f90
View File

@ -31,12 +31,12 @@ subroutine form_v(nC,nO,nV,nR,X1,X2,X3,X4,t2,v)
do k=1,nO-nC
do l=1,nO-nC
v(i,j,a,b) = v(i,j,a,b) + 0.25d0*X1(k,l,i,j)*t2(k,l,a,b)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
do i=1,nO-nC
do j=1,nO-nC
@ -44,11 +44,11 @@ subroutine form_v(nC,nO,nV,nR,X1,X2,X3,X4,t2,v)
do b=1,nV-nR
do c=1,nV-nR
v(i,j,a,b) = v(i,j,a,b) - 0.5d0*(X2(b,c)*t2(i,j,a,c) + X2(a,c)*t2(i,j,c,b))
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
do i=1,nO-nC
do j=1,nO-nC
@ -56,11 +56,11 @@ subroutine form_v(nC,nO,nV,nR,X1,X2,X3,X4,t2,v)
do b=1,nV-nR
do k=1,nO-nC
v(i,j,a,b) = v(i,j,a,b) - 0.5d0*(X3(k,j)*t2(i,k,a,b) + X3(k,i)*t2(k,j,a,b))
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
do i=1,nO-nC
do j=1,nO-nC
@ -69,11 +69,11 @@ subroutine form_v(nC,nO,nV,nR,X1,X2,X3,X4,t2,v)
do k=1,nO-nC
do c=1,nV-nR
v(i,j,a,b) = v(i,j,a,b) + (X4(i,k,a,c)*t2(j,k,b,c) + X4(i,k,b,c)*t2(k,j,a,c))
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
end subroutine

4
src/CC/lCCD.f90
View File

@ -188,7 +188,7 @@ subroutine lCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENu
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -206,7 +206,7 @@ subroutine lCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENu
stop
endif
end if
write(*,*)
write(*,*)'----------------------------------------------------'

4
src/CC/lGCCD.f90
View File

@ -164,7 +164,7 @@ subroutine lGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eH
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -182,7 +182,7 @@ subroutine lGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eH
stop
endif
end if
write(*,*)
write(*,*)'----------------------------------------------------'

4
src/CC/pCCD.f90
View File

@ -195,7 +195,7 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -212,7 +212,7 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF
stop
endif
end if
if(dotest) then

4
src/CC/rCCD.f90
View File

@ -178,7 +178,7 @@ subroutine rCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENu
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -196,7 +196,7 @@ subroutine rCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENu
stop
endif
end if
write(*,*)
write(*,*)'----------------------------------------------------'

4
src/CC/rGCCD.f90
View File

@ -154,7 +154,7 @@ subroutine rGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eH
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
@ -172,7 +172,7 @@ subroutine rGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eH
stop
endif
end if
write(*,*)
write(*,*)'----------------------------------------------------'

2
src/CI/CID.f90
View File

@ -215,6 +215,6 @@ subroutine CID(dotest,singlet,triplet,nBasin,nCin,nOin,nVin,nRin,ERIin,eHFin,E0)
print*,'Singlet CID transition vectors'
call matout(nH,nH,H)
write(*,*)
endif
end if
end subroutine

2
src/CI/CISD.f90
View File

@ -303,6 +303,6 @@ subroutine CISD(dotest,singlet,triplet,nBasin,nCin,nOin,nVin,nRin,ERIin,eHFin,E0
print*,'Singlet CISD transition vectors'
call matout(nH,nH,H)
write(*,*)
endif
end if
end subroutine

8
src/CI/CIS_D.f90
View File

@ -257,11 +257,11 @@ subroutine CIS_D(ispin,nBasin,nCin,nOin,nVin,nRin,nSin,maxS,eHF,ERI,w,X)
wD = wD - 0.25d0*u(i,j,a,b)**2/(delta(i,j,a,b) - w(m))
enddo
enddo
end do
end do
wD = wD + r(i,a)*v(i,a)
enddo
enddo
end do
end do
wD = 0.5d0*wD
! Flush results

12
src/CI/RCIS.f90
View File

@ -54,7 +54,7 @@ subroutine RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_in
print*,'CIS matrix (singlet state)'
call matout(nS,nS,A)
write(*,*)
endif
end if
call diagonalize_matrix(nS,A,Om)
call print_excitation_energies('CIS@RHF','singlet',nS,Om)
@ -64,7 +64,7 @@ subroutine RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_in
print*,'Singlet CIS transition vectors'
call matout(nS,nS,A)
write(*,*)
endif
end if
! Compute CIS(D) correction
@ -79,7 +79,7 @@ subroutine RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_in
end if
endif
end if
if(triplet) then
@ -90,7 +90,7 @@ subroutine RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_in
print*,'CIS matrix (triplet state)'
call matout(nS,nS,A)
write(*,*)
endif
end if
call diagonalize_matrix(nS,A,Om)
call print_excitation_energies('CIS@RHF','triplet',nS,Om)
@ -100,7 +100,7 @@ subroutine RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_in
print*,'Triplet CIS transition vectors'
call matout(nS,nS,A)
write(*,*)
endif
end if
! Compute CIS(D) correction
@ -115,6 +115,6 @@ subroutine RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_in
end if
endif
end if
end subroutine

12
src/CI/UCIS.f90
View File

@ -76,7 +76,7 @@ subroutine UCIS(dotest,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI
print*,'CIS matrix (spin-conserved transitions)'
call matout(nS_sc,nS_sc,A_sc)
write(*,*)
endif
end if
call diagonalize_matrix(nS_sc,A_sc,Om_sc)
A_sc(:,:) = transpose(A_sc)
@ -88,7 +88,7 @@ subroutine UCIS(dotest,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI
print*,'Spin-conserved CIS transition vectors'
call matout(nS_sc,nS_sc,A_sc)
write(*,*)
endif
end if
! Testing zone
@ -100,7 +100,7 @@ subroutine UCIS(dotest,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI
deallocate(A_sc,Om_sc)
endif
end if
!-----------------------!
! Spin-flip transitions !
@ -124,7 +124,7 @@ subroutine UCIS(dotest,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI
print*,'CIS matrix (spin-conserved transitions)'
call matout(nS_sf,nS_sf,A_sf)
write(*,*)
endif
end if
call diagonalize_matrix(nS_sf,A_sf,Om_sf)
A_sf(:,:) = transpose(A_sf)
@ -136,7 +136,7 @@ subroutine UCIS(dotest,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI
print*,'Spin-flip CIS transition vectors'
call matout(nS_sf,nS_sf,A_sf)
write(*,*)
endif
end if
! Testing zone
@ -148,6 +148,6 @@ subroutine UCIS(dotest,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI
deallocate(A_sf,Om_sf)
endif
end if
end subroutine

162
src/GF/RG0F3.f90
View File

@ -54,12 +54,12 @@
App(p,1) = App(p,1) &
- (2d0*V(p,k,p,j) - V(p,k,j,p))*(2d0*V(j,i,a,b) - V(j,i,b,a))*V(a,b,k,i)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
@ -74,12 +74,12 @@
App(p,2) = App(p,2) &
+ (2d0*V(p,c,p,b) - V(p,c,b,p))*(2d0*V(j,i,a,b) - V(j,i,b,a))*V(j,i,c,a)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
@ -94,12 +94,12 @@
App(p,3) = App(p,3) &
+ (2d0*V(p,c,p,j) - V(p,c,j,p))*(2d0*V(j,i,a,b) - V(j,i,b,a))*V(a,b,c,i)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
App(:,4) = App(:,3)
@ -116,12 +116,12 @@
App(p,5) = App(p,5) &
- (2d0*V(p,b,p,k) - V(p,b,k,p))*(2d0*V(j,i,a,b) - V(j,i,b,a))*V(i,j,k,a)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
App(:,6) = App(:,5)
@ -143,10 +143,10 @@
Bpp(p,1) = Bpp(p,1) &
+ (2d0*V(p,a,i,j) - V(p,a,j,i))*V(p,a,i,j)/eps
enddo
enddo
enddo
enddo
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
@ -158,10 +158,10 @@
Bpp(p,2) = Bpp(p,2) &
+ (2d0*V(p,i,a,b) - V(p,i,b,a))*V(p,i,a,b)/eps
enddo
enddo
enddo
enddo
end do
end do
end do
end do
! Total second-order Green function
@ -184,12 +184,12 @@
Cpp(p,1) = Cpp(p,1) &
+ (2d0*V(p,i,a,b) - V(p,i,b,a))*V(a,b,c,d)*V(p,i,c,d)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
@ -204,12 +204,12 @@
Cpp(p,2) = Cpp(p,2) &
+ (2d0*V(p,i,a,b) - V(p,i,b,a))*V(a,b,j,k)*V(p,i,j,k)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
Cpp(:,3) = Cpp(:,2)
@ -225,12 +225,12 @@
Cpp(p,4) = Cpp(p,4) &
+ (2d0*V(p,a,i,j) - V(p,a,j,i))*V(i,j,b,c)*V(p,a,b,c)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
Cpp(:,5) = Cpp(:,4)
@ -246,12 +246,12 @@
Cpp(p,6) = Cpp(p,6) &
- (2d0*V(p,a,k,l) - V(p,a,l,k))*V(k,l,i,j)*V(p,a,i,j)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
! Frequency-dependent third-order contribution: "D" terms
@ -275,12 +275,12 @@
+ V(p,i,b,a)*(V(a,j,i,c)*(4d0*V(p,j,b,c) - 2d0*V(p,j,c,b)) &
+ V(a,j,c,i)*( V(p,j,c,b) - 2d0*V(p,j,b,c)))/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
@ -300,12 +300,12 @@
+ V(p,i,a,c)*(V(a,b,i,j)*( V(p,b,j,c) - 2d0*V(p,b,c,j)) &
+ V(a,b,j,i)*( V(p,b,c,j) - 2d0*V(p,b,j,c)))/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
Dpp(:,3) = Dpp(:,2)
@ -327,12 +327,12 @@
+ V(p,a,j,k)*(V(j,i,a,b)*( V(p,i,b,k) - 2d0*V(p,i,k,b)) &
+ V(j,i,b,a)*( V(p,i,k,b) - 2d0*V(p,i,b,k)))/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
Dpp(:,5) = Dpp(:,4)
@ -354,12 +354,12 @@
- V(p,a,i,k)*(V(i,b,a,j)*( V(p,b,j,k) - 2d0*V(p,b,k,j)) &
+ V(i,b,j,a)*( V(p,b,k,j) - 2d0*V(p,b,j,k)))/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
! Compute renormalization factor (if required)
@ -421,7 +421,7 @@
Sig3(:) = Z(:)*Sig3(:)
endif
end if
! Total third-order Green function

56
src/GF/UGF2_reg_self_energy.f90
View File

@ -69,9 +69,9 @@ subroutine UGF2_reg_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eG
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Addition part: ab
@ -87,9 +87,9 @@ subroutine UGF2_reg_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eG
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: aa
@ -106,9 +106,9 @@ subroutine UGF2_reg_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eG
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: ab
@ -124,12 +124,12 @@ subroutine UGF2_reg_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eG
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
enddo
enddo
end do
end do
!------------------!
! Spin-down sector !
@ -153,9 +153,9 @@ subroutine UGF2_reg_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eG
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Addition part: ab
@ -171,9 +171,9 @@ subroutine UGF2_reg_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eG
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: bb
@ -190,9 +190,9 @@ subroutine UGF2_reg_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eG
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: ab
@ -208,12 +208,12 @@ subroutine UGF2_reg_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eG
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
enddo
enddo
end do
end do
Z(:,:) = 1d0/(1d0 - Z(:,:))

52
src/GF/UGF2_reg_self_energy_diag.f90
View File

@ -67,9 +67,9 @@ subroutine UGF2_reg_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,e
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Addition part: ab
@ -85,9 +85,9 @@ subroutine UGF2_reg_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,e
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: aa
@ -104,9 +104,9 @@ subroutine UGF2_reg_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,e
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: ab
@ -122,11 +122,11 @@ subroutine UGF2_reg_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,e
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
enddo
end do
!------------------!
! Spin-down sector !
@ -149,9 +149,9 @@ subroutine UGF2_reg_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,e
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Addition part: ab
@ -167,9 +167,9 @@ subroutine UGF2_reg_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,e
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: bb
@ -186,9 +186,9 @@ subroutine UGF2_reg_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,e
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: ab
@ -204,11 +204,11 @@ subroutine UGF2_reg_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,e
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
enddo
end do
Z(:,:) = 1d0/(1d0 - Z(:,:))

56
src/GF/UGF2_self_energy.f90
View File

@ -58,9 +58,9 @@ subroutine UGF2_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,S
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Addition part: ab
@ -74,9 +74,9 @@ subroutine UGF2_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,S
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: aa
@ -91,9 +91,9 @@ subroutine UGF2_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,S
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: ab
@ -107,12 +107,12 @@ subroutine UGF2_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,S
SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
enddo
enddo
end do
end do
!------------------!
! Spin-down sector !
@ -134,9 +134,9 @@ subroutine UGF2_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,S
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Addition part: ab
@ -150,9 +150,9 @@ subroutine UGF2_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,S
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: bb
@ -167,9 +167,9 @@ subroutine UGF2_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,S
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: ab
@ -183,12 +183,12 @@ subroutine UGF2_self_energy(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,S
SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
enddo
enddo
end do
end do
Z(:,:) = 1d0/(1d0 - Z(:,:))

52
src/GF/UGF2_self_energy_diag.f90
View File

@ -56,9 +56,9 @@ subroutine UGF2_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,e
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Addition part: ab
@ -72,9 +72,9 @@ subroutine UGF2_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,e
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: aa
@ -89,9 +89,9 @@ subroutine UGF2_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,e
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: ab
@ -105,11 +105,11 @@ subroutine UGF2_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,e
SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2)
Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
enddo
end do
!------------------!
! Spin-down sector !
@ -130,9 +130,9 @@ subroutine UGF2_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,e
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Addition part: ab
@ -146,9 +146,9 @@ subroutine UGF2_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,e
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: bb
@ -163,9 +163,9 @@ subroutine UGF2_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,e
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
! Removal part: ab
@ -179,11 +179,11 @@ subroutine UGF2_self_energy_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,e
SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2)
Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
enddo
end do
end do
end do
enddo
end do
Z(:,:) = 1d0/(1d0 - Z(:,:))

166
src/GF/evRGF3.f90
View File

@ -62,12 +62,12 @@
App(p,1) = App(p,1) &
- (2d0*V(p,k,p,j) - V(p,k,j,p))*(2d0*V(j,i,a,b) - V(j,i,b,a))*V(a,b,k,i)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
@ -82,12 +82,12 @@
App(p,2) = App(p,2) &
+ (2d0*V(p,c,p,b) - V(p,c,b,p))*(2d0*V(j,i,a,b) - V(j,i,b,a))*V(j,i,c,a)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
@ -102,12 +102,12 @@
App(p,3) = App(p,3) &
+ (2d0*V(p,c,p,j) - V(p,c,j,p))*(2d0*V(j,i,a,b) - V(j,i,b,a))*V(a,b,c,i)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
App(:,4) = App(:,3)
@ -124,12 +124,12 @@
App(p,5) = App(p,5) &
- (2d0*V(p,b,p,k) - V(p,b,k,p))*(2d0*V(j,i,a,b) - V(j,i,b,a))*V(i,j,k,a)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
App(:,6) = App(:,5)
@ -167,10 +167,10 @@
Bpp(p,1) = Bpp(p,1) &
+ (2d0*V(p,a,i,j) - V(p,a,j,i))*V(p,a,i,j)/eps
enddo
enddo
enddo
enddo
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
@ -182,10 +182,10 @@
Bpp(p,2) = Bpp(p,2) &
+ (2d0*V(p,i,a,b) - V(p,i,b,a))*V(p,i,a,b)/eps
enddo
enddo
enddo
enddo
end do
end do
end do
end do
! Total second-order Green function
@ -208,12 +208,12 @@
Cpp(p,1) = Cpp(p,1) &
+ (2d0*V(p,i,a,b) - V(p,i,b,a))*V(a,b,c,d)*V(p,i,c,d)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
@ -228,12 +228,12 @@
Cpp(p,2) = Cpp(p,2) &
+ (2d0*V(p,i,a,b) - V(p,i,b,a))*V(a,b,j,k)*V(p,i,j,k)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
Cpp(:,3) = Cpp(:,2)
@ -249,12 +249,12 @@
Cpp(p,4) = Cpp(p,4) &
+ (2d0*V(p,a,i,j) - V(p,a,j,i))*V(i,j,b,c)*V(p,a,b,c)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
Cpp(:,5) = Cpp(:,4)
@ -270,12 +270,12 @@
Cpp(p,6) = Cpp(p,6) &
- (2d0*V(p,a,k,l) - V(p,a,l,k))*V(k,l,i,j)*V(p,a,i,j)/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
! Frequency-dependent third-order contribution: "D" terms
@ -299,12 +299,12 @@
+ V(p,i,b,a)*(V(a,j,i,c)*(4d0*V(p,j,b,c) - 2d0*V(p,j,c,b)) &
+ V(a,j,c,i)*( V(p,j,c,b) - 2d0*V(p,j,b,c)))/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
do p=nC+1,nBas-nR
do i=nC+1,nO
@ -324,12 +324,12 @@
+ V(p,i,a,c)*(V(a,b,i,j)*( V(p,b,j,c) - 2d0*V(p,b,c,j)) &
+ V(a,b,j,i)*( V(p,b,c,j) - 2d0*V(p,b,j,c)))/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
Dpp(:,3) = Dpp(:,2)
@ -351,12 +351,12 @@
+ V(p,a,j,k)*(V(j,i,a,b)*( V(p,i,b,k) - 2d0*V(p,i,k,b)) &
+ V(j,i,b,a)*( V(p,i,k,b) - 2d0*V(p,i,b,k)))/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
Dpp(:,5) = Dpp(:,4)
@ -378,12 +378,12 @@
- V(p,a,i,k)*(V(i,b,a,j)*( V(p,b,j,k) - 2d0*V(p,b,k,j)) &
+ V(i,b,j,a)*( V(p,b,k,j) - 2d0*V(p,b,j,k)))/(eps1*eps2)
enddo
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
end do
! Compute renormalization factor (if required)
@ -445,7 +445,7 @@
Sig3(:) = Z(:)*Sig3(:)
endif
end if
! Total third-order Green function
@ -474,7 +474,7 @@
nSCF = nSCF + 1
enddo
end do
!------------------------------------------------------------------------
! End main SCF loop
!------------------------------------------------------------------------
@ -491,6 +491,6 @@
stop
endif
end if
end subroutine

8
src/GF/evUGF2.f90
View File

@ -160,7 +160,7 @@ subroutine evUGF2(dotest,maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved
if(minval(rcond(:)) < 1d-15) n_diis = 0
endif
end if
! Save quasiparticles energy for next cycle
@ -170,7 +170,7 @@ subroutine evUGF2(dotest,maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved
nSCF = nSCF + 1
enddo
end do
!------------------------------------------------------------------------
! End main loop
!------------------------------------------------------------------------
@ -187,7 +187,7 @@ subroutine evUGF2(dotest,maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved
stop
endif
end if
! Deallocate memory
@ -199,6 +199,6 @@ subroutine evUGF2(dotest,maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved
print*,'!!! BSE2 NYI for evUGF2 !!!'
endif
end if
end subroutine

2
src/GF/print_G0F3.f90
View File

@ -29,7 +29,7 @@ subroutine print_G0F3(nBas,nO,eHF,Z,eGF3)
do x=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)') &
'|',x,'|',eHF(x)*HaToeV,'|',Z(x),'|',eGF3(x)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------'
write(*,'(2X,A27,F15.6)') 'G0F3 HOMO energy (eV):',eGF3(HOMO)*HaToeV

2
src/GF/print_RG0F2.f90
View File

@ -38,7 +38,7 @@ subroutine print_RG0F2(nBas,nO,eHF,Sig,eGF,Z,ENuc,ERHF,Ec)
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,'|',eHF(p)*HaToeV,'|',Sig(p)*HaToeV,'|',Z(p),'|',eGF(p)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') 'G0F2 HOMO energy =',eGF(HOMO)*HaToeV,' eV'

2
src/GF/print_UG0F2.f90
View File

@ -53,7 +53,7 @@ subroutine print_UG0F2(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
'|',p,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigC(p,1)*HaToeV,SigC(p,2)*HaToeV,'|', &
Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|'
enddo
end do
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'

2
src/GF/print_evGF3.f90
View File

@ -29,7 +29,7 @@ subroutine print_evGF3(nBas,nO,nSCF,Conv,eHF,Z,eGF3)
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)') &
'|',p,'|',eHF(p)*HaToeV,'|',Z(p),'|',eGF3(p)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF

2
src/GF/print_evGGF2.f90
View File

@ -40,7 +40,7 @@ subroutine print_evGGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF,ENuc,ERHF,Ec)
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,'|',eHF(p)*HaToeV,'|',Sig(p)*HaToeV,'|',Z(p),'|',eGF(p)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF

2
src/GF/print_evRGF2.f90
View File

@ -40,7 +40,7 @@ subroutine print_evRGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF,ENuc,ERHF,Ec)
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,'|',eHF(p)*HaToeV,'|',Sig(p)*HaToeV,'|',Z(p),'|',eGF(p)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF

4
src/GF/print_evUGF2.f90
View File

@ -45,7 +45,7 @@ subroutine print_evUGF2(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
write(*,'(1X,A21,I1,A2,A12)')' Self-consistent evG',nSCF,'F2',' calculation'
else
write(*,'(1X,A21,I2,A2,A12)')' Self-consistent evG',nSCF,'F2',' calculation'
endif
end if
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') &
@ -59,7 +59,7 @@ subroutine print_evUGF2(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
'|',p,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigC(p,1)*HaToeV,SigC(p,2)*HaToeV,'|', &
Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|'
enddo
end do
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'

6
src/GF/print_qsRGF2.f90
View File

@ -47,7 +47,7 @@ subroutine print_qsRGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigC,Z,ENuc,ET,EV,EJ,
write(*,'(1X,A21,I1,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation'
else
write(*,'(1X,A21,I2,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation'
endif
end if
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_HF (eV)','|','Sig_c (eV)','|','Z','|','e_QP (eV)','|'
@ -56,7 +56,7 @@ subroutine print_qsRGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigC,Z,ENuc,ET,EV,EJ,
do q=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)') &
'|',q,'|',eHF(q)*HaToeV,'|',SigC(q,q)*HaToeV,'|',Z(q),'|',eGF(q)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
@ -110,7 +110,7 @@ subroutine print_qsRGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigC,Z,ENuc,ET,EV,EJ,
call matout(nBas,1,eGF)
write(*,*)
endif
end if
end subroutine

6
src/GF/print_qsUGF2.f90
View File

@ -72,7 +72,7 @@ subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K,
write(*,'(1X,A21,I1,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation'
else
write(*,'(1X,A21,I2,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation'
endif
end if
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') &
@ -86,7 +86,7 @@ subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K,
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
'|',p,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigC(p,p,1)*HaToeV,SigC(p,p,2)*HaToeV,'|', &
Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|'
enddo
end do
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
@ -173,6 +173,6 @@ subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K,
call matout(nBas,nBas,cGF2(:,:,2))
write(*,*)
endif
end if
end subroutine

4
src/GF/qsRGF2.f90
View File

@ -233,7 +233,7 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
call print_qsRGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigCp,Z,ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,dipole)
enddo
end do
!------------------------------------------------------------------------
! End main loop
!------------------------------------------------------------------------
@ -250,7 +250,7 @@ subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,si
stop
endif
end if
! Deallocate memory

4
src/GF/qsUGF2.f90
View File

@ -306,7 +306,7 @@ subroutine qsUGF2(dotest,maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved
call dipole_moment(nBas,P(:,:,1)+P(:,:,2),nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
call print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,P,S,T,V,J,K,ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,SigCp,Z,dipole)
enddo
end do
!------------------------------------------------------------------------
! End main loop
!------------------------------------------------------------------------
@ -323,7 +323,7 @@ subroutine qsUGF2(dotest,maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved
stop
endif
end if
! Deallocate memory

8
src/GT/GTeh_SigC.f90
View File

@ -37,8 +37,8 @@ double precision function GTeh_SigC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Om,rhoL,rhoR)
eps = w - e(i) + Om(m)
num = rhoL(i,p,m)*rhoR(i,p,m)
GTeh_SigC = GTeh_SigC + num*eps/(eps**2 + eta**2)
enddo
enddo
end do
end do
! Virtual part of the correlation self-energy
@ -47,7 +47,7 @@ double precision function GTeh_SigC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Om,rhoL,rhoR)
eps = w - e(a) - Om(m)
num = rhoL(p,a,m)*rhoR(p,a,m)
GTeh_SigC = GTeh_SigC + num*eps/(eps**2 + eta**2)
enddo
enddo
end do
end do
end function

8
src/GT/GTeh_dSigC.f90
View File

@ -37,8 +37,8 @@ double precision function GTeh_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Om,rhoL,rhoR)
eps = w - e(i) + Om(m)
num = rhoL(i,p,m)*rhoR(i,p,m)
GTeh_dSigC = GTeh_dSigC - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
end do
end do
! Virtual part of the correlation self-energy
@ -47,7 +47,7 @@ double precision function GTeh_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Om,rhoL,rhoR)
eps = w - e(a) - Om(m)
num = rhoL(p,a,m)*rhoR(p,a,m)
GTeh_dSigC = GTeh_dSigC - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
enddo
end do
end do
end function

10
src/GT/GTeh_excitation_density.f90
View File

@ -46,11 +46,11 @@ subroutine GTeh_excitation_density(nBas,nC,nO,nR,nS,ERI,XpY,XmY,rhoL,rhoR)
rhoR(p,q,m) = rhoR(p,q,m) + (2d0*ERI(p,j,b,q) - ERI(p,j,q,b))*X + (2d0*ERI(p,b,j,q) - ERI(p,b,q,j))*Y
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL

8
src/GT/GTeh_plot_self_energy.f90
View File

@ -53,7 +53,7 @@ subroutine GTeh_plot_self_energy(nBas,nC,nO,nV,nR,nS,eHF,eGT,Om,rhoL,rhoR)
do g=1,nGrid
w(g) = wmin + dble(g)*dw
enddo
end do
! Occupied part of the self-energy and renormalization factor
@ -73,8 +73,8 @@ subroutine GTeh_plot_self_energy(nBas,nC,nO,nV,nR,nS,eHF,eGT,Om,rhoL,rhoR)
do g=1,nGrid
do p=nC+1,nBas-nR
S(p,g) = eta/((w(g) - eHF(p) - SigC(p,g))**2 + eta**2)
enddo
enddo
end do
end do
S(:,:) = S(:,:)/pi
@ -90,7 +90,7 @@ subroutine GTeh_plot_self_energy(nBas,nC,nO,nV,nR,nS,eHF,eGT,Om,rhoL,rhoR)
write(9 ,*) w(g)*HaToeV,((w(g)-eHF(p))*HaToeV,p=nC+1,nBas-nR)
write(10,*) w(g)*HaToeV,(Z(p,g),p=nC+1,nBas-nR)
write(11,*) w(g)*HaToeV,(S(p,g),p=nC+1,nBas-nR)
enddo
end do
! Closing files

8
src/GT/GTeh_regularization.f90
View File

@ -41,16 +41,16 @@ subroutine GTeh_regularization(nBas,nC,nO,nV,nR,nS,e,Om,rhoL,rhoR)
kappa = 1d0 - exp(-Dpim*Dpim*s)
rhoL(i,p,m) = kappa*rhoL(i,p,m)
rhoR(i,p,m) = kappa*rhoR(i,p,m)
enddo
end do
do a=nO+1,nBas-nR
Dpam = e(p) - e(a) - Om(m)
kappa = 1d0 - exp(-Dpam*Dpam*s)
rhoL(p,a,m) = kappa*rhoL(p,a,m)
rhoR(p,a,m) = kappa*rhoR(p,a,m)
enddo
end do
enddo
enddo
end do
end do
end subroutine

12
src/GT/GTpp_SigC.f90
View File

@ -43,14 +43,14 @@ double precision function GTpp_SigC(p,w,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt
do cd=1,nVVs
eps = w + e(i) - Om1s(cd)
GTpp_SigC = GTpp_SigC + rho1s(p,i,cd)**2*eps/(eps**2 + eta**2)
enddo
end do
do cd=1,nVVt
eps = w + e(i) - Om1t(cd)
GTpp_SigC = GTpp_SigC + rho1t(p,i,cd)**2*eps/(eps**2 + eta**2)
enddo
end do
enddo
end do
!----------------------------------------------
! Virtual part of the T-matrix self-energy
@ -61,13 +61,13 @@ double precision function GTpp_SigC(p,w,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt
do kl=1,nOOs
eps = w + e(a) - Om2s(kl)
GTpp_SigC = GTpp_SigC + rho2s(p,a,kl)**2*eps/(eps**2 + eta**2)
enddo
end do
do kl=1,nOOt
eps = w + e(a) - Om2t(kl)
GTpp_SigC = GTpp_SigC + rho2t(p,a,kl)**2*eps/(eps**2 + eta**2)
enddo
end do
enddo
end do
end function

12
src/GT/GTpp_dSigC.f90
View File

@ -43,14 +43,14 @@ double precision function GTpp_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVV
do cd=1,nVVs
eps = w + e(i) - Om1s(cd)
GTpp_dSigC = GTpp_dSigC - rho1s(p,i,cd)**2*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
do cd=1,nVVt
eps = w + e(i) - Om1t(cd)
GTpp_dSigC = GTpp_dSigC - rho1t(p,i,cd)**2*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
enddo
end do
!----------------------------------------------
! Virtual part of the T-matrix self-energy
@ -62,13 +62,13 @@ double precision function GTpp_dSigC(p,w,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVV
do kl=1,nOOs
eps = w + e(a) - Om2s(kl)
GTpp_dSigC = GTpp_dSigC - rho2s(p,a,kl)**2*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
do kl=1,nOOt
eps = w + e(a) - Om2t(kl)
GTpp_dSigC = GTpp_dSigC - rho2t(p,a,kl)**2*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
enddo
end do
end function

12
src/GT/GTpp_phBSE_static_kernel_A.f90
View File

@ -51,19 +51,19 @@ subroutine GTpp_phBSE_static_kernel_A(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,Ome
eps = + Omega1(cd)
chi = chi + rho1(i,b,cd)*rho1(a,j,cd)*eps/(eps**2 + eta**2)
enddo
end do
do kl=1,nOO
eps = - Omega2(kl)
chi = chi + rho2(i,b,kl)*rho2(a,j,kl)*eps/(eps**2 + eta**2)
enddo
end do
KA(ia,jb) = lambda*chi
enddo
enddo
enddo
enddo
end do
end do
end do
end do
!$omp end parallel do

12
src/GT/GTpp_phBSE_static_kernel_B.f90
View File

@ -48,18 +48,18 @@ subroutine GTpp_phBSE_static_kernel_B(eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda,Ome
do cd=1,nVV
eps = + Omega1(cd)
chi = chi + rho1(i,j,cd)*rho1(a,b,cd)*eps/(eps**2 + eta**2)
enddo
end do
do kl=1,nOO
eps = - Omega2(kl)
chi = chi + rho2(i,j,kl)*rho2(a,b,kl)*eps/(eps**2 + eta**2)
enddo
end do
KB(ia,jb) = lambda*chi
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

8
src/GT/GTpp_plot_self_energy.f90
View File

@ -57,7 +57,7 @@ subroutine GTpp_plot_self_energy(nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,eGT,Om
do g=1,nGrid
w(g) = wmin + dble(g)*dw
enddo
end do
! Occupied part of the self-energy and renormalization factor
@ -77,8 +77,8 @@ subroutine GTpp_plot_self_energy(nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,eGT,Om
do g=1,nGrid
do p=nC+1,nBas-nR
S(p,g) = eta/((w(g) - eHF(p) - SigC(p,g))**2 + eta**2)
enddo
enddo
end do
end do
S(:,:) = S(:,:)/pi
@ -94,7 +94,7 @@ subroutine GTpp_plot_self_energy(nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,eGT,Om
write(9 ,*) w(g)*HaToeV,((w(g)-eHF(p))*HaToeV,p=nC+1,nBas-nR)
write(10,*) w(g)*HaToeV,(Z(p,g),p=nC+1,nBas-nR)
write(11,*) w(g)*HaToeV,(S(p,g),p=nC+1,nBas-nR)
enddo
end do
! Closing files

2
src/GT/GTpp_regularization.f90
View File

@ -54,6 +54,6 @@ subroutine GTpp_regularization(nBas,nC,nO,nV,nR,nOO,nVV,e,Om1,rho1,Om2,rho2)
end do
end do
enddo
end do
end subroutine

36
src/GT/GTpp_self_energy.f90
View File

@ -51,18 +51,18 @@ subroutine GTpp_self_energy(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,e,Om1s,rho1
num = rho1s(p,i,cd)*rho1s(q,i,cd)
Sig(p,q) = Sig(p,q) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
do cd=1,nVVt
eps = e(p) + e(i) - Om1t(cd)
num = rho1t(p,i,cd)*rho1t(q,i,cd)
Sig(p,q) = Sig(p,q) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
enddo
enddo
enddo
end do
end do
end do
!----------------------------------------------
! Virtual part of the T-matrix self-energy
@ -77,18 +77,18 @@ subroutine GTpp_self_energy(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,e,Om1s,rho1
num = rho2s(p,a,kl)*rho2s(q,a,kl)
Sig(p,q) = Sig(p,q) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
do kl=1,nOOt
eps = e(p) + e(a) - Om2t(kl)
num = rho2t(p,a,kl)*rho2t(q,a,kl)
Sig(p,q) = Sig(p,q) + num*eps/(eps**2 + eta**2)
if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
enddo
enddo
enddo
end do
end do
end do
!----------------------------------------------
! Galitskii-Migdal correlation energy
@ -101,16 +101,16 @@ subroutine GTpp_self_energy(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,e,Om1s,rho1
eps = e(i) + e(j) - Om1s(cd)
num = rho1s(i,j,cd)*rho1s(i,j,cd)
EcGM = EcGM + num*eps/(eps**2 + eta**2)
enddo
end do
do cd=1,nVVt
eps = e(i) + e(j) - Om1t(cd)
num = rho1t(i,j,cd)*rho1t(i,j,cd)
EcGM = EcGM + num*eps/(eps**2 + eta**2)
enddo
end do
enddo
enddo
end do
end do
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
@ -119,16 +119,16 @@ subroutine GTpp_self_energy(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,e,Om1s,rho1
eps = e(a) + e(b) - Om2s(kl)
num = rho2s(a,b,kl)*rho2s(a,b,kl)
EcGM = EcGM - num*eps/(eps**2 + eta**2)
enddo
end do
do kl=1,nOOt
eps = e(a) + e(b) - Om2t(kl)
num = rho2t(a,b,kl)*rho2t(a,b,kl)
EcGM = EcGM - num*eps/(eps**2 + eta**2)
enddo
end do
enddo
enddo
end do
end do
Z(:) = 1d0/(1d0 - Z(:))

32
src/GT/GTpp_self_energy_diag.f90
View File

@ -51,17 +51,17 @@ subroutine GTpp_self_energy_diag(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,e,Om1s
num = rho1s(p,i,cd)**2
Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2)
Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
do cd=1,nVVt
eps = e(p) + e(i) - Om1t(cd)
num = rho1t(p,i,cd)**2
Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2)
Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
enddo
enddo
end do
end do
!----------------------------------------------
! Virtual part of the T-matrix self-energy
@ -75,17 +75,17 @@ subroutine GTpp_self_energy_diag(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,e,Om1s
num = rho2s(p,a,kl)**2
Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2)
Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
do kl=1,nOOt
eps = e(p) + e(a) - Om2t(kl)
num = rho2t(p,a,kl)**2
Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2)
Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
enddo
enddo
end do
end do
!----------------------------------------------
! Galitskii-Migdal correlation energy
@ -98,16 +98,16 @@ subroutine GTpp_self_energy_diag(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,e,Om1s
eps = e(i) + e(j) - Om1s(cd)
num = rho1s(i,j,cd)**2
EcGM = EcGM + num*eps/(eps**2 + eta**2)
enddo
end do
do cd=1,nVVt
eps = e(i) + e(j) - Om1t(cd)
num = rho1t(i,j,cd)**2
EcGM = EcGM + num*eps/(eps**2 + eta**2)
enddo
end do
enddo
enddo
end do
end do
do a=nO+1,nBas-nR
do b=nO+1,nBas-nR
@ -116,16 +116,16 @@ subroutine GTpp_self_energy_diag(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,e,Om1s
eps = e(a) + e(b) - Om2s(kl)
num = rho2s(a,b,kl)**2
EcGM = EcGM - num*eps/(eps**2 + eta**2)
enddo
end do
do kl=1,nOOt
eps = e(a) + e(b) - Om2t(kl)
num = rho2t(a,b,kl)**2
EcGM = EcGM - num*eps/(eps**2 + eta**2)
enddo
end do
enddo
enddo
end do
end do
Z(:) = 1d0/(1d0 - Z(:))

2
src/GT/evRGTpp.f90
View File

@ -243,7 +243,7 @@ subroutine evRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,B
nSCF = nSCF + 1
enddo
end do
!------------------------------------------------------------------------
! End main loop
!------------------------------------------------------------------------

2
src/GT/evUGTpp.f90
View File

@ -275,7 +275,7 @@ subroutine evUGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,B
nSCF = nSCF + 1
enddo
end do
!------------------------------------------------------------------------
! End main loop

2
src/GT/print_RG0T0eh.f90
View File

@ -36,7 +36,7 @@ subroutine print_RG0T0eh(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eGT,EcRPA,EcGM)
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,'|',eHF(p)*HaToeV,'|',SigC(p)*HaToeV,'|',Z(p),'|',eGT(p)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') 'RG0T0eh HOMO energy =',eGT(HOMO)*HaToeV,' eV'

2
src/GT/print_RG0T0pp.f90
View File

@ -45,7 +45,7 @@ subroutine print_RG0T0pp(nBas,nO,eHF,ENuc,ERHF,SigT,Z,eGT,EcGM,EcRPA)
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,'|',eHF(p)*HaToeV,'|',SigT(p)*HaToeV,'|',Z(p),'|',eGT(p)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') 'G0T0pp@RHF HOMO energy = ',eGT(HOMO)*HaToeV,' eV'

2
src/GT/print_UG0T0.f90
View File

@ -48,7 +48,7 @@ subroutine print_UG0T0(nBas,nO,eHF,ENuc,EUHF,SigT,Z,eGT,EcGM,EcRPA)
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
'|',p,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigT(p,1)*HaToeV,SigT(p,2)*HaToeV,'|', &
Z(p,1),Z(p,2),'|',eGT(p,1)*HaToeV,eGT(p,2)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F15.6,A3)') 'UG0T0 HOMO energy (eV) =',maxval(HOMO(:))*HaToeV,' eV'

4
src/GT/print_evRGTeh.f90
View File

@ -32,7 +32,7 @@ subroutine print_evRGTeh(nBas,nO,nSCF,Conv,eHF,ENuc,ERHF,SigC,Z,eGT,EcRPA,EcGM)
write(*,'(1X,A21,I1,A3,I1,A12)')' Self-consistent evG',nSCF,'Teh',nSCF,' calculation'
else
write(*,'(1X,A21,I2,A3,I2,A12)')' Self-consistent evG',nSCF,'Teh',nSCF,' calculation'
endif
end if
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_HF (eV)','|','Sig_GTeh (eV)','|','Z','|','e_GTeh (eV)','|'
@ -41,7 +41,7 @@ subroutine print_evRGTeh(nBas,nO,nSCF,Conv,eHF,ENuc,ERHF,SigC,Z,eGT,EcRPA,EcGM)
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,'|',eHF(p)*HaToeV,'|',SigC(p)*HaToeV,'|',Z(p),'|',eGT(p)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF

4
src/GT/print_evRGTpp.f90
View File

@ -34,7 +34,7 @@ subroutine print_evRGTpp(nBas,nO,nSCF,Conv,eHF,ENuc,ERHF,SigT,Z,eGT,EcGM,EcRPA)
write(*,'(1X,A21,I1,A3,I1,A12)')' Self-consistent evG',nSCF,'Tpp',nSCF,' calculation'
else
write(*,'(1X,A21,I2,A3,I2,A12)')' Self-consistent evG',nSCF,'Tpp',nSCF,' calculation'
endif
end if
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_HF (eV)','|','Sig_GTpp (eV)','|','Z','|','e_GTpp (eV)','|'
@ -43,7 +43,7 @@ subroutine print_evRGTpp(nBas,nO,nSCF,Conv,eHF,ENuc,ERHF,SigT,Z,eGT,EcGM,EcRPA)
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,'|',eHF(p)*HaToeV,'|',SigT(p)*HaToeV,'|',Z(p),'|',eGT(p)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF

4
src/GT/print_evUGT.f90
View File

@ -44,7 +44,7 @@ subroutine print_evUGT(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigT,Z,eGT,EcGM,EcRPA)
write(*,'(1X,A21,I1,A1,I1,A12)')' Self-consistent evG',nSCF,'T',nSCF,' calculation'
else
write(*,'(1X,A21,I2,A1,I2,A12)')' Self-consistent evG',nSCF,'T',nSCF,' calculation'
endif
end if
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_HF (eV)','|','Sigma_T (eV)','|','Z','|','e_QP (eV)','|'
@ -54,7 +54,7 @@ subroutine print_evUGT(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigT,Z,eGT,EcGM,EcRPA)
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
'|',p,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigT(p,1)*HaToeV,SigT(p,2)*HaToeV,'|', &
Z(p,1),Z(p,2),'|',eGT(p,1)*HaToeV,eGT(p,2)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF

6
src/GT/print_qsRGTeh.f90
View File

@ -52,7 +52,7 @@ subroutine print_qsRGTeh(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
write(*,'(1X,A21,I1,A3,I1,A12)')' Self-consistent qsG',nSCF,'Teh',nSCF,' calculation'
else
write(*,'(1X,A21,I2,A3,I2,A12)')' Self-consistent qsG',nSCF,'Teh',nSCF,' calculation'
endif
end if
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_HF (eV)','|','Sig_GTeh (eV)','|','Z','|','e_GTeh (eV)','|'
@ -61,7 +61,7 @@ subroutine print_qsRGTeh(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
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,'|',eHF(p)*HaToeV,'|',SigC(p,p)*HaToeV,'|',Z(p),'|',eGT(p)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
@ -118,6 +118,6 @@ subroutine print_qsRGTeh(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
call vecout(nBas,eGT)
write(*,*)
endif
end if
end subroutine

6
src/GT/print_qsRGTpp.f90
View File

@ -52,7 +52,7 @@ subroutine print_qsRGTpp(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
write(*,'(1X,A21,I1,A3,I1,A12)')' Self-consistent qsG',nSCF,'Tpp',nSCF,' calculation'
else
write(*,'(1X,A21,I2,A3,I2,A12)')' Self-consistent qsG',nSCF,'Tpp',nSCF,' calculation'
endif
end if
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_HF (eV)','|','Sig_GTpp (eV)','|','Z','|','e_GTpp (eV)','|'
@ -61,7 +61,7 @@ subroutine print_qsRGTpp(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
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,'|',eHF(p)*HaToeV,'|',SigC(p,p)*HaToeV,'|',Z(p),'|',eGT(p)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
@ -118,6 +118,6 @@ subroutine print_qsRGTpp(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigC,Z,ENuc,ET,EV,EJ
call vecout(nBas,eGT)
write(*,*)
endif
end if
end subroutine

4
src/GT/print_qsUGT.f90
View File

@ -51,7 +51,7 @@ subroutine print_qsUGT(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigT,Z,ENuc,ET,EV,EJ,E
write(*,'(1X,A21,I1,A1,I1,A12)')' Self-consistent qsG',nSCF,'T',nSCF,' calculation'
else
write(*,'(1X,A21,I2,A1,I2,A12)')' Self-consistent qsG',nSCF,'T',nSCF,' calculation'
endif
end if
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_HF (eV)','|','Sigma_T (eV)','|','Z','|','e_QP (eV)','|'
@ -61,7 +61,7 @@ subroutine print_qsUGT(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigT,Z,ENuc,ET,EV,EJ,E
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
'|',p,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigT(p,p,1)*HaToeV,SigT(p,p,2)*HaToeV,'|', &
Z(p,1),Z(p,2),'|',eGT(p,1)*HaToeV,eGT(p,2)*HaToeV,'|'
enddo
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF

4
src/GT/qsRGTeh.f90
View File

@ -257,7 +257,7 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
call print_qsRGTeh(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,Sigp,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGT,dipole)
enddo
end do
!------------------------------------------------------------------------
! End main loop
!------------------------------------------------------------------------
@ -274,7 +274,7 @@ subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
stop
endif
end if
! Deallocate memory

4
src/GT/qsRGTpp.f90
View File

@ -300,7 +300,7 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
call print_qsRGTpp(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,Sigp,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGT,dipole)
enddo
end do
!------------------------------------------------------------------------
! End main loop
!------------------------------------------------------------------------
@ -317,7 +317,7 @@ subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
stop
endif
end if
! Deallocate memory

4
src/GT/qsUGTpp.f90
View File

@ -385,7 +385,7 @@ write(*,*) 'EcGM', EcGM(1)
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
call print_qsUGT(nBas,nO,nSCF,Conv,thresh,eHF,eGT,c,SigTp,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGT,dipole)
enddo
end do
!------------------------------------------------------------------------
! End main loop
!------------------------------------------------------------------------
@ -402,7 +402,7 @@ write(*,*) 'EcGM', EcGM(1)
stop
endif
end if
! Free memory

10
src/GW/GGW_phBSE_static_kernel_A.f90
View File

@ -44,13 +44,13 @@ subroutine GGW_phBSE_static_kernel_A(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Om,rho,K
do kc=1,nS
eps = Om(kc)**2 + eta**2
chi = chi + rho(i,j,kc)*rho(a,b,kc)*Om(kc)/eps
enddo
end do
KA(ia,jb) = 2d0*lambda*chi
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

10
src/GW/GGW_phBSE_static_kernel_B.f90
View File

@ -44,13 +44,13 @@ subroutine GGW_phBSE_static_kernel_B(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Om,rho,K
do kc=1,nS
eps = Om(kc)**2 + eta**2
chi = chi + rho(i,b,kc)*rho(a,j,kc)*Om(kc)/eps
enddo
end do
KB(ia,jb) = 2d0*lambda*chi
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

10
src/GW/GW_excitation_density.f90
View File

@ -36,11 +36,11 @@ subroutine GW_excitation_density(nBas,nC,nO,nR,nS,ERI,XpY,rho)
jb = jb + 1
do ia=1,nS
rho(p,q,ia) = rho(p,q,ia) + ERI(p,j,q,b)*XpY(ia,jb)
enddo
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end do
!$OMP END DO
!$OMP END PARALLEL

16
src/GW/GW_phBSE2_dynamic_kernel_A.f90
View File

@ -58,8 +58,8 @@ subroutine GW_phBSE2_dynamic_kernel_A(eta,nBas,nC,nO,nV,nR,nS,eGW,W,OmBSE,KA_dyn
KA_dyn(ia,jb) = KA_dyn(ia,jb) - num*dem/(dem**2 + eta**2)
ZA_dyn(ia,jb) = ZA_dyn(ia,jb) + num*(dem**2 - eta**2)/(dem**2 + eta**2)**2
enddo
enddo
end do
end do
do c=nO+1,nBas-nR
do d=nO+1,nBas-nR
@ -70,8 +70,8 @@ subroutine GW_phBSE2_dynamic_kernel_A(eta,nBas,nC,nO,nV,nR,nS,eGW,W,OmBSE,KA_dyn
KA_dyn(ia,jb) = KA_dyn(ia,jb) + num*dem/(dem**2 + eta**2)
ZA_dyn(ia,jb) = ZA_dyn(ia,jb) - num*(dem**2 - eta**2)/(dem**2 + eta**2)**2
enddo
enddo
end do
end do
do k=nC+1,nO
do l=nC+1,nO
@ -85,10 +85,10 @@ subroutine GW_phBSE2_dynamic_kernel_A(eta,nBas,nC,nO,nV,nR,nS,eGW,W,OmBSE,KA_dyn
end do
end do
enddo
enddo
enddo
enddo
end do
end do
end do
end do
!$omp end parallel do
end subroutine

16
src/GW/GW_phBSE2_dynamic_kernel_B.f90
View File

@ -54,8 +54,8 @@ subroutine GW_phBSE2_dynamic_kernel_B(eta,nBas,nC,nO,nV,nR,nS,eGW,W,KB_dyn)
KB_dyn(ia,jb) = KB_dyn(ia,jb) - num*dem/(dem**2 + eta**2)
enddo
enddo
end do
end do
do c=nO+1,nBas-nR
do d=nO+1,nBas-nR
@ -65,8 +65,8 @@ subroutine GW_phBSE2_dynamic_kernel_B(eta,nBas,nC,nO,nV,nR,nS,eGW,W,KB_dyn)
KB_dyn(ia,jb) = KB_dyn(ia,jb) + num*dem/(dem**2 + eta**2)
enddo
enddo
end do
end do
do k=nC+1,nO
do l=nC+1,nO
@ -79,10 +79,10 @@ subroutine GW_phBSE2_dynamic_kernel_B(eta,nBas,nC,nO,nV,nR,nS,eGW,W,KB_dyn)
end do
end do
enddo
enddo
enddo
enddo
end do
end do
end do
end do
!$omp end parallel do
end subroutine

12
src/GW/GW_phBSE_dynamic_kernel_A.f90
View File

@ -58,7 +58,7 @@ subroutine GW_phBSE_dynamic_kernel_A(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,rh
eps = + OmBSE - OmRPA(kc) - (eGW(b) - eGW(i))
chi = chi + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*eps/(eps**2 + eta**2)
enddo
end do
KA_dyn(ia,jb) = KA_dyn(ia,jb) - 2d0*lambda*chi
@ -71,14 +71,14 @@ subroutine GW_phBSE_dynamic_kernel_A(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,rh
eps = + OmBSE - OmRPA(kc) - (eGW(b) - eGW(i))
chi = chi + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*(eps**2 - eta**2)/(eps**2 + eta**2)**2
enddo
end do
ZA_dyn(ia,jb) = ZA_dyn(ia,jb) + 2d0*lambda*chi
enddo
enddo
enddo
enddo
end do
end do
end do
end do
!$omp end parallel do

10
src/GW/GW_phBSE_dynamic_kernel_B.f90
View File

@ -52,13 +52,13 @@ subroutine GW_phBSE_dynamic_kernel_B(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,rh
eps = - OmRPA(kc) - (eGW(a) - eGW(j))
chi = chi + rho(i,b,kc)*rho(j,a,kc)*eps/(eps**2 + eta**2)
enddo
end do
KB(ia,jb) = KB(ia,jb) - 2d0*lambda*chi
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

10
src/GW/GW_phBSE_static_kernel.f90
View File

@ -46,13 +46,13 @@ subroutine GW_phBSE_static_kernel(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Om,rho,W)
do m=1,nS
dem = Om(m)**2 + eta**2
chi = chi + rho(p,q,m)*rho(r,s,m)*Om(m)/dem
enddo
end do
W(p,s,q,r) = - lambda*ERI(p,s,q,r) + 4d0*lambda*chi
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

10
src/GW/GW_phBSE_static_kernel_A.f90
View File

@ -44,13 +44,13 @@ subroutine GW_phBSE_static_kernel_A(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Om,rho,KA
do kc=1,nS
eps = Om(kc)**2 + eta**2
chi = chi + rho(i,j,kc)*rho(a,b,kc)*Om(kc)/eps
enddo
end do
KA(ia,jb) = 4d0*lambda*chi
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

10
src/GW/GW_phBSE_static_kernel_B.f90
View File

@ -44,13 +44,13 @@ subroutine GW_phBSE_static_kernel_B(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Om,rho,KB
do kc=1,nS
eps = Om(kc)**2 + eta**2
chi = chi + rho(i,b,kc)*rho(a,j,kc)*Om(kc)/eps
enddo
end do
KB(ia,jb) = 4d0*lambda*chi
enddo
enddo
enddo
enddo
end do
end do
end do
end do
end subroutine

8
src/GW/GW_plot_self_energy.f90
View File

@ -52,7 +52,7 @@ subroutine GW_plot_self_energy(nBas,nC,nO,nV,nR,nS,eHF,eGW,Om,rho)
do g=1,nGrid
w(g) = wmin + dble(g)*dw
enddo
end do
! Occupied part of the self-energy and renormalization factor
@ -72,8 +72,8 @@ subroutine GW_plot_self_energy(nBas,nC,nO,nV,nR,nS,eHF,eGW,Om,rho)
do g=1,nGrid
do p=nC+1,nBas-nR
S(p,g) = eta/((w(g) - eHF(p) - SigC(p,g))**2 + eta**2)
enddo
enddo
end do
end do
S(:,:) = S(:,:)/pi
@ -89,7 +89,7 @@ subroutine GW_plot_self_energy(nBas,nC,nO,nV,nR,nS,eHF,eGW,Om,rho)
write(9 ,*) w(g)*HaToeV,((w(g)-eHF(p))*HaToeV,p=nC+1,nBas-nR)
write(10,*) w(g)*HaToeV,(Z(p,g),p=nC+1,nBas-nR)
write(11,*) w(g)*HaToeV,(S(p,g),p=nC+1,nBas-nR)
enddo
end do
! Closing files

6
src/GW/GW_ppBSE_static_kernel_B.f90
View File

@ -57,7 +57,7 @@ subroutine GW_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda
eps = Om(m)**2 + eta**2
chi = chi - rho(i,a,m)*rho(j,b,m)*Om(m)/eps &
+ rho(i,b,m)*rho(a,j,m)*Om(m)/eps
enddo
end do
KB(ab,ij) = 2d0*lambda*chi/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(i,j)))
@ -88,7 +88,7 @@ subroutine GW_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda
eps = Om(m)**2 + eta**2
chi = chi - rho(i,a,m)*rho(j,b,m)*Om(m)/eps &
+ rho(i,b,m)*rho(a,j,m)*Om(m)/eps
enddo
end do
KB(ab,ij) = 2d0*lambda*chi
@ -119,7 +119,7 @@ subroutine GW_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambda
eps = Om(m)**2 + eta**2
chi = chi - rho(i,a,m)*rho(j,b,m)*Om(m)/eps &
+ rho(i,b,m)*rho(a,j,m)*Om(m)/eps
enddo
end do
KB(ab,ij) = lambda*chi

6
src/GW/GW_ppBSE_static_kernel_C.f90
View File

@ -56,7 +56,7 @@ subroutine GW_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nS,nVV,lambda,ERI
eps = Om(m)**2 + eta**2
chi = chi - rho(a,c,m)*rho(b,d,m)*Om(m)/eps &
+ rho(a,d,m)*rho(b,c,m)*Om(m)/eps
enddo
end do
KC(ab,cd) = 2d0*lambda*chi/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
@ -87,7 +87,7 @@ subroutine GW_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nS,nVV,lambda,ERI
eps = Om(m)**2 + eta**2
chi = chi - rho(a,c,m)*rho(b,d,m)*Om(m)/eps &
+ rho(a,d,m)*rho(b,c,m)*Om(m)/eps
enddo
end do
KC(ab,cd) = 2d0*lambda*chi
@ -118,7 +118,7 @@ subroutine GW_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nS,nVV,lambda,ERI
eps = Om(m)**2 + eta**2
chi = chi - rho(a,c,m)*rho(b,d,m)*Om(m)/eps &
+ rho(a,d,m)*rho(b,c,m)*Om(m)/eps
enddo
end do
KC(ab,cd) = lambda*chi

6
src/GW/GW_ppBSE_static_kernel_D.f90
View File

@ -56,7 +56,7 @@ subroutine GW_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,lambda,ERI
eps = Om(m)**2 + eta**2
chi = chi - rho(i,k,m)*rho(j,l,m)*Om(m)/eps &
+ rho(i,l,m)*rho(j,k,m)*Om(m)/eps
enddo
end do
KD(ij,kl) = 2d0*lambda*chi/sqrt((1d0 + Kronecker_delta(i,j))*(1d0 + Kronecker_delta(k,l)))
@ -87,7 +87,7 @@ subroutine GW_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,lambda,ERI
eps = Om(m)**2 + eta**2
chi = chi - rho(i,k,m)*rho(j,l,m)*Om(m)/eps &
+ rho(i,l,m)*rho(j,k,m)*Om(m)/eps
enddo
end do
KD(ij,kl) = 2d0*lambda*chi
@ -118,7 +118,7 @@ subroutine GW_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,lambda,ERI
eps = Om(m)**2 + eta**2
chi = chi - rho(i,k,m)*rho(j,l,m)*Om(m)/eps &
+ rho(i,l,m)*rho(j,k,m)*Om(m)/eps
enddo
end do
KD(ij,kl) = lambda*chi

8
src/GW/GW_regularization.f90
View File

@ -39,15 +39,15 @@ subroutine GW_regularization(nBas,nC,nO,nV,nR,nS,e,Om,rho)
Dpim = e(p) - e(i) + Om(m)
kappa = 1d0 - exp(-Dpim*Dpim*s)
rho(p,i,m) = kappa*rho(p,i,m)
enddo
end do
do a=nO+1,nBas-nR
Dpam = e(p) - e(a) - Om(m)
kappa = 1d0 - exp(-Dpam*Dpam*s)
rho(p,a,m) = kappa*rho(p,a,m)
enddo
end do
enddo
enddo
end do
end do
end subroutine

15
src/GW/RG0W0.f90
View File

@ -56,6 +56,8 @@ 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(:)
@ -161,10 +163,6 @@ 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)
! Deallocate memory
deallocate(SigC,Z,Om,XpY,XmY,rho)
! Perform BSE calculation
if(dophBSE) then
@ -235,6 +233,15 @@ 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
if(dotest) then

Some files were not shown because too many files have changed in this diff Show More