LCPQ
/
quack
mirror of https://github.com/pfloos/quack
4
1
Fork 0
Code Releases Activity

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

This commit is contained in:
3950 2023-11-27 10:49:27 +01:00
parent 59789d873c f7373f571b
commit e6427bdc05
14 changed files with 51 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/GF/evGGF2.f90
View File

@ -96,7 +96,7 @@ subroutine evGGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis, &
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call GGF2_QP_graph(eta,nBas,nC,nO,nV,nR,eHF,ERI,eOld,eOld,eGF,Z)

2
src/GF/evRGF2.f90
View File

@ -99,7 +99,7 @@ subroutine evRGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,si
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call GF2_QP_graph(eta,nBas,nC,nO,nV,nR,eHF,ERI,eOld,eOld,eGF,Z)

2
src/GT/RG0T0eh.f90
View File

@ -146,7 +146,7 @@ subroutine RG0T0eh(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,T
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call GTeh_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rhoL,rhoR,eGTlin,eHF,eGT,Z)

2
src/GT/RG0T0pp.f90
View File

@ -193,7 +193,7 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call GTpp_QP_graph(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,Om1s,rho1s,Om2s,rho2s, &

2
src/GT/evRGTeh.f90
View File

@ -152,7 +152,7 @@ subroutine evRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,d
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call GTeh_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rhoL,rhoR,eOld,eOld,eGT,Z)

2
src/GT/evRGTpp.f90
View File

@ -208,7 +208,7 @@ subroutine evRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,B
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call GTpp_QP_graph(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,Om1s,rho1s,Om2s,rho2s, &

2
src/GW/GG0W0.f90
View File

@ -136,7 +136,7 @@ subroutine GG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call GGW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eHF,eGW,Z)

2
src/GW/RG0W0.f90
View File

@ -139,7 +139,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eHF,eGW,Z)

2
src/GW/UG0W0.f90
View File

@ -152,7 +152,7 @@ subroutine UG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTD
! Find graphical solution of the QP equation
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
do is=1,nspin

2
src/GW/evGGW.f90
View File

@ -144,7 +144,7 @@ subroutine evGGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call GGW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eOld,eOld,eGW,Z)

2
src/GW/evRGW.f90
View File

@ -146,7 +146,7 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
call GW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eOld,eOld,eGW,Z)

2
src/GW/evUGW.f90
View File

@ -175,7 +175,7 @@ subroutine evUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE
else
write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** '
write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*)
do is=1,nspin

12
src/GW/ufG0W0.f90
View File

@ -48,6 +48,8 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
logical :: verbose = .true.
double precision,parameter :: cutoff1 = 0.01d0
double precision,parameter :: cutoff2 = 0.01d0
double precision :: eF
double precision,parameter :: window = 2d0
double precision :: start_timing,end_timing,timing
@ -76,6 +78,8 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
dRPA = .true.
EcRPA = 0d0
eF = 0.5d0*(eHF(nO+1) + eHF(nO))
H(:,:) = 0d0
!-------------------------!
@ -361,7 +365,8 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
write(*,*)'-------------------------------------------'
do s=1,nH
if(Z(s) > cutoff1) then
if(eGW(s) < eF .and. eGW(s) > eF - window) then
! if(Z(s) > cutoff1) then
write(*,'(1X,A1,1X,I3,1X,A1,1X,F15.6,1X,A1,1X,F15.6,1X,A1,1X)') &
'|',s,'|',eGW(s)*HaToeV,'|',Z(s),'|'
end if
@ -374,7 +379,8 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
do s=1,nH
if(Z(s) > cutoff1) then
if(eGW(s) < eF .and. eGW(s) > eF - window) then
! if(Z(s) > cutoff1) then
write(*,*)'-------------------------------------------------------------'
write(*,'(1X,A7,1X,I3,A6,I3,A1,1X,A7,F12.6,A13,F6.4,1X)') &
@ -429,7 +435,7 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
ija = 0
do i=nC+1,nO
do ja=nC+1,nO
do ja=1,nS
ija = ija + 1
if(abs(H(1+ija,s)) > cutoff2) &

31
src/GW/ufGW.f90
View File

@ -49,6 +49,8 @@ subroutine ufGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
double precision,parameter :: cutoff1 = 0.01d0
double precision,parameter :: cutoff2 = 0.01d0
double precision :: start_timing,end_timing,timing
! Output variables
! Hello world
@ -92,6 +94,8 @@ subroutine ufGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! !
!---------------------------!
call wall_time(start_timing)
!---------!
! Block F !
!---------!
@ -198,6 +202,13 @@ subroutine ufGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
end do
end do
call wall_time(end_timing)
timing = end_timing - start_timing
write(*,*)
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for construction of supermatrix = ',timing,' seconds'
write(*,*)
else
! RPA for W
@ -240,6 +251,8 @@ subroutine ufGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
call GW_excitation_density(nBas,nC,nO,nR,nS,ERI,XpY,rho)
call wall_time(start_timing)
!---------!
! Block F !
!---------!
@ -314,14 +327,30 @@ subroutine ufGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
end do
end do
call wall_time(end_timing)
timing = end_timing - start_timing
write(*,*)
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for construction of supermatrix = ',timing,' seconds'
write(*,*)
end if
!-------------------------!
! Diagonalize supermatrix !
!-------------------------!
call wall_time(start_timing)
call diagonalize_matrix(nH,H,eGW)
call wall_time(end_timing)
timing = end_timing - start_timing
write(*,*)
write(*,'(A65,1X,F9.3,A8)') 'Total wall time for diagonalization of supermatrix = ',timing,' seconds'
write(*,*)
!-----------------!
! Compute weights !
!-----------------!
@ -411,7 +440,7 @@ subroutine ufGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
ija = 0
do i=nC+1,nO
do ja=nC+1,nO
do ja=1,nS
ija = ija + 1
if(abs(H(1+ija,s)) > cutoff2) &