diff --git a/src/GF/evGGF2.f90 b/src/GF/evGGF2.f90 index 568423f..986a130 100644 --- a/src/GF/evGGF2.f90 +++ b/src/GF/evGGF2.f90 @@ -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) diff --git a/src/GF/evRGF2.f90 b/src/GF/evRGF2.f90 index b10c514..4dc2610 100644 --- a/src/GF/evRGF2.f90 +++ b/src/GF/evRGF2.f90 @@ -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) diff --git a/src/GT/RG0T0eh.f90 b/src/GT/RG0T0eh.f90 index 1b96ad7..c6b7ec2 100644 --- a/src/GT/RG0T0eh.f90 +++ b/src/GT/RG0T0eh.f90 @@ -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) diff --git a/src/GT/RG0T0pp.f90 b/src/GT/RG0T0pp.f90 index 2c4ce09..b1158e6 100644 --- a/src/GT/RG0T0pp.f90 +++ b/src/GT/RG0T0pp.f90 @@ -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, & diff --git a/src/GT/evRGTeh.f90 b/src/GT/evRGTeh.f90 index 1e6cb92..508cb63 100644 --- a/src/GT/evRGTeh.f90 +++ b/src/GT/evRGTeh.f90 @@ -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) diff --git a/src/GT/evRGTpp.f90 b/src/GT/evRGTpp.f90 index 010005c..0eee598 100644 --- a/src/GT/evRGTpp.f90 +++ b/src/GT/evRGTpp.f90 @@ -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, & diff --git a/src/GW/GG0W0.f90 b/src/GW/GG0W0.f90 index 972dce8..9d4556d 100644 --- a/src/GW/GG0W0.f90 +++ b/src/GW/GG0W0.f90 @@ -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) diff --git a/src/GW/RG0W0.f90 b/src/GW/RG0W0.f90 index 19f2cb9..052ec26 100644 --- a/src/GW/RG0W0.f90 +++ b/src/GW/RG0W0.f90 @@ -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) diff --git a/src/GW/UG0W0.f90 b/src/GW/UG0W0.f90 index b6b1f60..3674a54 100644 --- a/src/GW/UG0W0.f90 +++ b/src/GW/UG0W0.f90 @@ -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 diff --git a/src/GW/evGGW.f90 b/src/GW/evGGW.f90 index 5780298..1c52699 100644 --- a/src/GW/evGGW.f90 +++ b/src/GW/evGGW.f90 @@ -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) diff --git a/src/GW/evRGW.f90 b/src/GW/evRGW.f90 index 7d15040..1bb4a0e 100644 --- a/src/GW/evRGW.f90 +++ b/src/GW/evRGW.f90 @@ -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) diff --git a/src/GW/evUGW.f90 b/src/GW/evUGW.f90 index 2110f75..71cb933 100644 --- a/src/GW/evUGW.f90 +++ b/src/GW/evUGW.f90 @@ -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 diff --git a/src/GW/ufG0W0.f90 b/src/GW/ufG0W0.f90 index e222a2a..12e2d1f 100644 --- a/src/GW/ufG0W0.f90 +++ b/src/GW/ufG0W0.f90 @@ -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) & diff --git a/src/GW/ufGW.f90 b/src/GW/ufGW.f90 index 718ffab..806dc72 100644 --- a/src/GW/ufGW.f90 +++ b/src/GW/ufGW.f90 @@ -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) &