LCPQ/quack
4
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-10-20 06:48:21 +02:00
Code Releases Activity

more cleanup

Browse Source
This commit is contained in:
Pierre-Francois Loos 2024-09-10 09:40:22 +02:00
parent 65ba14706c
commit 826d80d594
6 changed files with 135 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/GW/RG0W0.f90
View File

@ -1,5 +1,5 @@
subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, & subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) linearize,eta,regularize,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform G0W0 calculation ! Perform G0W0 calculation
@ -28,6 +28,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
logical,intent(in) :: regularize logical,intent(in) :: regularize
integer,intent(in) :: nBas integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC integer,intent(in) :: nC
integer,intent(in) :: nO integer,intent(in) :: nO
integer,intent(in) :: nV integer,intent(in) :: nV
@ -35,9 +36,9 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
integer,intent(in) :: nS integer,intent(in) :: nS
double precision,intent(in) :: ENuc double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF double precision,intent(in) :: ERHF
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: dipole_int(nBas,nBas,ncart) double precision,intent(in) :: dipole_int(nOrb,nOrb,ncart)
double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: eHF(nOrb)
! Local variables ! Local variables
@ -88,15 +89,15 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
! Memory allocation ! Memory allocation
allocate(Aph(nS,nS),Bph(nS,nS),SigC(nBas),Z(nBas),Om(nS),XpY(nS,nS),XmY(nS,nS),rho(nBas,nBas,nS), & allocate(Aph(nS,nS),Bph(nS,nS),SigC(nOrb),Z(nOrb),Om(nS),XpY(nS,nS),XmY(nS,nS),rho(nOrb,nOrb,nS), &
eGW(nBas),eGWlin(nBas)) eGW(nOrb),eGWlin(nOrb))
!-------------------! !-------------------!
! Compute screening ! ! Compute screening !
!-------------------! !-------------------!
call phLR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS,lambda,eHF,ERI,Aph) call phLR_A(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,lambda,eHF,ERI,Aph)
if(.not.TDA_W) call phLR_B(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS,lambda,ERI,Bph) if(.not.TDA_W) call phLR_B(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,lambda,ERI,Bph)
call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY) call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
@ -106,15 +107,15 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
! Compute spectral weights ! ! Compute spectral weights !
!--------------------------! !--------------------------!
call RGW_excitation_density(nBas,nC,nO,nR,nS,ERI,XpY,rho) call RGW_excitation_density(nOrb,nC,nO,nR,nS,ERI,XpY,rho)
!------------------------! !------------------------!
! Compute GW self-energy ! ! Compute GW self-energy !
!------------------------! !------------------------!
if(regularize) call GW_regularization(nBas,nC,nO,nV,nR,nS,eHF,Om,rho) if(regularize) call GW_regularization(nOrb,nC,nO,nV,nR,nS,eHF,Om,rho)
call RGW_self_energy_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,EcGM,SigC,Z) call RGW_self_energy_diag(eta,nOrb,nC,nO,nV,nR,nS,eHF,Om,rho,EcGM,SigC,Z)
!-----------------------------------! !-----------------------------------!
! Solve the quasi-particle equation ! ! Solve the quasi-particle equation !
@ -136,24 +137,24 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
write(*,*) ' *** Quasiparticle energies obtained by root search *** ' write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*) write(*,*)
call RGW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eHF,eGW,Z) call RGW_QP_graph(eta,nOrb,nC,nO,nV,nR,nS,eHF,Om,rho,eGWlin,eHF,eGW,Z)
end if end if
! Plot self-energy, renormalization factor, and spectral function ! Plot self-energy, renormalization factor, and spectral function
if(plot_self) call RGW_plot_self_energy(nBas,eta,nC,nO,nV,nR,nS,eHF,eHF,Om,rho) if(plot_self) call RGW_plot_self_energy(nOrb,eta,nC,nO,nV,nR,nS,eHF,eHF,Om,rho)
!--------------------! !--------------------!
! Cumulant expansion ! ! Cumulant expansion !
!--------------------! !--------------------!
! call RGWC(dotest,eta,nBas,nC,nO,nV,nR,nS,Om,rho,eHF,eHF,eGW,Z) ! call RGWC(dotest,eta,nOrb,nC,nO,nV,nR,nS,Om,rho,eHF,eHF,eGW,Z)
! Compute the RPA correlation energy ! Compute the RPA correlation energy
call phLR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS,lambda,eGW,ERI,Aph) call phLR_A(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,lambda,eGW,ERI,Aph)
if(.not.TDA_W) call phLR_B(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS,lambda,ERI,Bph) if(.not.TDA_W) call phLR_B(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,lambda,ERI,Bph)
call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY) call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
@ -161,14 +162,14 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
! Dump results ! ! Dump results !
!--------------! !--------------!
call print_RG0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM) call print_RG0W0(nOrb,nO,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM)
! Perform BSE calculation ! Perform BSE calculation
if(dophBSE) then if(dophBSE) then
call RGW_phBSE(dophBSE2,exchange_kernel,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta, & call RGW_phBSE(dophBSE2,exchange_kernel,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta, &
nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGW,EcBSE) nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGW,EcBSE)
write(*,*) write(*,*)
write(*,*)'-------------------------------------------------------------------------------' write(*,*)'-------------------------------------------------------------------------------'
@ -188,7 +189,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
write(*,*) '-------------------------------------------------------------' write(*,*) '-------------------------------------------------------------'
write(*,*) write(*,*)
call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGW,EcBSE) call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,eHF,eGW,EcBSE)
write(*,*) write(*,*)
write(*,*)'-------------------------------------------------------------------------------' write(*,*)'-------------------------------------------------------------------------------'
@ -205,7 +206,7 @@ subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA
if(doppBSE) then if(doppBSE) then
call RGW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGW,EcBSE) call RGW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGW,EcBSE)
write(*,*) write(*,*)
write(*,*)'-------------------------------------------------------------------------------' write(*,*)'-------------------------------------------------------------------------------'

8
src/GW/RGW.f90
View File

@ -77,7 +77,7 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
call wall_time(start_GW) call wall_time(start_GW)
call RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, & call RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,regularize,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF) linearize,eta,regularize,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
call wall_time(end_GW) call wall_time(end_GW)
t_GW = end_GW - start_GW t_GW = end_GW - start_GW
@ -94,7 +94,7 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
call wall_time(start_GW) call wall_time(start_GW)
call evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, & call evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF) singlet,triplet,linearize,eta,regularize,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF)
call wall_time(end_GW) call wall_time(end_GW)
t_GW = end_GW - start_GW t_GW = end_GW - start_GW
@ -150,7 +150,7 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
call wall_time(start_GW) call wall_time(start_GW)
! TODO ! TODO
call ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) call ufG0W0(dotest,TDA_W,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF)
call wall_time(end_GW) call wall_time(end_GW)
t_GW = end_GW - start_GW t_GW = end_GW - start_GW
@ -167,7 +167,7 @@ subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thre
call wall_time(start_GW) call wall_time(start_GW)
! TODO ! TODO
call ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) call ufRGW(dotest,TDA_W,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF)
call wall_time(end_GW) call wall_time(end_GW)
t_GW = end_GW - start_GW t_GW = end_GW - start_GW

39
src/GW/evRGW.f90
View File

@ -1,5 +1,5 @@
subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, & subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) singlet,triplet,linearize,eta,regularize,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform self-consistent eigenvalue-only GW calculation ! Perform self-consistent eigenvalue-only GW calculation
@ -32,14 +32,15 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
logical,intent(in) :: regularize logical,intent(in) :: regularize
integer,intent(in) :: nBas integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC integer,intent(in) :: nC
integer,intent(in) :: nO integer,intent(in) :: nO
integer,intent(in) :: nV integer,intent(in) :: nV
integer,intent(in) :: nR integer,intent(in) :: nR
integer,intent(in) :: nS integer,intent(in) :: nS
double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: eHF(nOrb)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: dipole_int(nBas,nBas,ncart) double precision,intent(in) :: dipole_int(nOrb,nOrb,ncart)
! Local variables ! Local variables
@ -89,8 +90,8 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
! Memory allocation ! Memory allocation
allocate(Aph(nS,nS),Bph(nS,nS),eGW(nBas),eOld(nBas),Z(nBas),SigC(nBas), & allocate(Aph(nS,nS),Bph(nS,nS),eGW(nOrb),eOld(nOrb),Z(nOrb),SigC(nOrb), &
Om(nS),XpY(nS,nS),XmY(nS,nS),rho(nBas,nBas,nS),error_diis(nBas,max_diis),e_diis(nBas,max_diis)) Om(nS),XpY(nS,nS),XmY(nS,nS),rho(nOrb,nOrb,nS),error_diis(nOrb,max_diis),e_diis(nOrb,max_diis))
! Initialization ! Initialization
@ -113,20 +114,20 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
! Compute screening ! Compute screening
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,Aph) call phLR_A(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,eGW,ERI,Aph)
if(.not.TDA_W) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) if(.not.TDA_W) call phLR_B(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph)
call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY) call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
! Compute spectral weights ! Compute spectral weights
call RGW_excitation_density(nBas,nC,nO,nR,nS,ERI,XpY,rho) call RGW_excitation_density(nOrb,nC,nO,nR,nS,ERI,XpY,rho)
! Compute correlation part of the self-energy ! Compute correlation part of the self-energy
if(regularize) call GW_regularization(nBas,nC,nO,nV,nR,nS,eGW,Om,rho) if(regularize) call GW_regularization(nOrb,nC,nO,nV,nR,nS,eGW,Om,rho)
call RGW_self_energy_diag(eta,nBas,nC,nO,nV,nR,nS,eGW,Om,rho,EcGM,SigC,Z) call RGW_self_energy_diag(eta,nOrb,nC,nO,nV,nR,nS,eGW,Om,rho,EcGM,SigC,Z)
! Solve the quasi-particle equation ! Solve the quasi-particle equation
@ -142,7 +143,7 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
write(*,*) ' *** Quasiparticle energies obtained by root search *** ' write(*,*) ' *** Quasiparticle energies obtained by root search *** '
write(*,*) write(*,*)
call RGW_QP_graph(eta,nBas,nC,nO,nV,nR,nS,eHF,Om,rho,eOld,eOld,eGW,Z) call RGW_QP_graph(eta,nOrb,nC,nO,nV,nR,nS,eHF,Om,rho,eOld,eOld,eGW,Z)
end if end if
@ -152,7 +153,7 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
! Print results ! Print results
call print_evRGW(nBas,nO,nSCF,Conv,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM) call print_evRGW(nOrb,nO,nSCF,Conv,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM)
! Linear mixing or DIIS extrapolation ! Linear mixing or DIIS extrapolation
@ -164,7 +165,7 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
n_diis = min(n_diis+1,max_diis) n_diis = min(n_diis+1,max_diis)
if(abs(rcond) > 1d-7) then if(abs(rcond) > 1d-7) then
call DIIS_extrapolation(rcond,nBas,nBas,n_diis,error_diis,e_diis,eGW-eOld,eGW) call DIIS_extrapolation(rcond,nOrb,nOrb,n_diis,error_diis,e_diis,eGW-eOld,eGW)
else else
n_diis = 0 n_diis = 0
end if end if
@ -203,8 +204,8 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
!--------------------! !--------------------!
! TODO ! TODO
!call RGWC(dotest, eta, nBas, nC, nO, nV, nR, nS, Om, rho, eHF, eGW, eGW, Z) !call RGWC(dotest, eta, nOrb, nC, nO, nV, nR, nS, Om, rho, eHF, eGW, eGW, Z)
call RGWC(dotest, eta, nBas, nC, nO, nV, nR, nS, Om, rho, eHF, eHF, eGW, Z) call RGWC(dotest, eta, nOrb, nC, nO, nV, nR, nS, Om, rho, eHF, eHF, eGW, Z)
! Deallocate memory ! Deallocate memory
@ -215,7 +216,7 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
if(dophBSE) then if(dophBSE) then
call RGW_phBSE(dophBSE2,exchange_kernel,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta, & call RGW_phBSE(dophBSE2,exchange_kernel,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta, &
nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eGW,eGW,EcBSE) nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eGW,eGW,EcBSE)
write(*,*) write(*,*)
write(*,*)'-------------------------------------------------------------------------------' write(*,*)'-------------------------------------------------------------------------------'
@ -235,7 +236,7 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
write(*,*) '-----------------------------------------------------------' write(*,*) '-----------------------------------------------------------'
write(*,*) write(*,*)
call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eGW,eGW,EcBSE) call RGW_phACFDT(exchange_kernel,doXBS,TDA_W,TDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,eGW,eGW,EcBSE)
write(*,*) write(*,*)
write(*,*)'-------------------------------------------------------------------------------' write(*,*)'-------------------------------------------------------------------------------'
@ -252,7 +253,7 @@ subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dop
if(doppBSE) then if(doppBSE) then
call RGW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGW,EcBSE) call RGW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nOrb,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGW,EcBSE)
write(*,*) write(*,*)
write(*,*)'-------------------------------------------------------------------------------' write(*,*)'-------------------------------------------------------------------------------'

27
src/GW/ufBSE.f90
View File

@ -1,4 +1,4 @@
subroutine ufBSE(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eGW) subroutine ufBSE(nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eGW)
! Unfold BSE@GW equations ! Unfold BSE@GW equations
@ -8,6 +8,7 @@ subroutine ufBSE(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eGW)
! Input variables ! Input variables
integer,intent(in) :: nBas integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC integer,intent(in) :: nC
integer,intent(in) :: nO integer,intent(in) :: nO
integer,intent(in) :: nV integer,intent(in) :: nV
@ -15,9 +16,9 @@ subroutine ufBSE(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eGW)
integer,intent(in) :: nS integer,intent(in) :: nS
double precision,intent(in) :: ENuc double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF double precision,intent(in) :: ERHF
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: eHF(nOrb)
double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: eGW(nOrb)
! Local variables ! Local variables
@ -84,12 +85,12 @@ subroutine ufBSE(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eGW)
ia = 0 ia = 0
do i=nC+1,nO do i=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
ia = ia + 1 ia = ia + 1
jb = 0 jb = 0
do j=nC+1,nO do j=nC+1,nO
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
jb = jb + 1 jb = jb + 1
H(ia,jb) = (eGW(a) - eGW(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & H(ia,jb) = (eGW(a) - eGW(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) &
@ -107,14 +108,14 @@ subroutine ufBSE(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eGW)
iajb=0 iajb=0
do i=nC+1,nO do i=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
do j=nC+1,nO do j=nC+1,nO
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iajb = iajb + 1 iajb = iajb + 1
kc = 0 kc = 0
do k=nC+1,nO do k=nC+1,nO
do c=nO+1,nBas-nR do c=nO+1,nOrb-nR
kc = kc + 1 kc = kc + 1
tmp = sqrt(2d0)*Kronecker_delta(k,j)*ERI(b,a,c,i) tmp = sqrt(2d0)*Kronecker_delta(k,j)*ERI(b,a,c,i)
@ -139,16 +140,16 @@ subroutine ufBSE(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eGW)
iajb = 0 iajb = 0
do i=nC+1,nO do i=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
do j=nC+1,nO do j=nC+1,nO
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iajb = iajb + 1 iajb = iajb + 1
kcld = 0 kcld = 0
do k=nC+1,nO do k=nC+1,nO
do c=nO+1,nBas-nR do c=nO+1,nOrb-nR
do l=nC+1,nO do l=nC+1,nO
do d=nO+1,nBas-nR do d=nO+1,nOrb-nR
kcld = kcld + 1 kcld = kcld + 1
tmp = ((eHF(a) + eGW(b) - eHF(i) - eGW(j))*Kronecker_delta(i,k)*Kronecker_delta(a,c) & tmp = ((eHF(a) + eGW(b) - eHF(i) - eGW(j))*Kronecker_delta(i,k)*Kronecker_delta(a,c) &

45
src/GW/ufG0W0.f90
View File

@ -1,4 +1,4 @@
subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) subroutine ufG0W0(dotest,TDA_W,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Unfold G0W0 equations ! Unfold G0W0 equations
@ -11,6 +11,7 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
logical,intent(in) :: TDA_W logical,intent(in) :: TDA_W
integer,intent(in) :: nBas integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC integer,intent(in) :: nC
integer,intent(in) :: nO integer,intent(in) :: nO
integer,intent(in) :: nV integer,intent(in) :: nV
@ -18,8 +19,8 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
integer,intent(in) :: nS integer,intent(in) :: nS
double precision,intent(in) :: ENuc double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF double precision,intent(in) :: ERHF
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: eHF(nOrb)
! Local variables ! Local variables
@ -93,10 +94,10 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Memory allocation ! Memory allocation
allocate(Om(nS),Aph(nS,nS),Bph(nS,nS),XpY(nS,nS),XmY(nS,nS),rho(nBas,nBas,nS)) allocate(Om(nS),Aph(nS,nS),Bph(nS,nS),XpY(nS,nS),XmY(nS,nS),rho(nOrb,nOrb,nS))
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph) call phLR_A(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph)
call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) call phLR_B(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph)
call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY) call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
@ -106,7 +107,7 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Compute spectral weights ! ! Compute spectral weights !
!--------------------------! !--------------------------!
call RGW_excitation_density(nBas,nC,nO,nR,nS,ERI,XpY,rho) call RGW_excitation_density(nOrb,nC,nO,nR,nS,ERI,XpY,rho)
deallocate(Aph,Bph,XpY,XmY) deallocate(Aph,Bph,XpY,XmY)
@ -154,7 +155,7 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
ija = 0 ija = 0
do i=nC+1,nO do i=nC+1,nO
do j=nC+1,nO do j=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
ija = ija + 1 ija = ija + 1
H(1 ,1+ija) = sqrt(2d0)*ERI(p,a,i,j) H(1 ,1+ija) = sqrt(2d0)*ERI(p,a,i,j)
@ -170,8 +171,8 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
iab = 0 iab = 0
do i=nC+1,nO do i=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
H(1 ,1+n2h1p+iab) = sqrt(2d0)*ERI(p,i,b,a) H(1 ,1+n2h1p+iab) = sqrt(2d0)*ERI(p,i,b,a)
@ -188,13 +189,13 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
ija = 0 ija = 0
do i=nC+1,nO do i=nC+1,nO
do j=nC+1,nO do j=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
ija = ija + 1 ija = ija + 1
klc = 0 klc = 0
do k=nC+1,nO do k=nC+1,nO
do l=nC+1,nO do l=nC+1,nO
do c=nO+1,nBas-nR do c=nO+1,nOrb-nR
klc = klc + 1 klc = klc + 1
H(1+ija,1+klc) & H(1+ija,1+klc) &
@ -215,14 +216,14 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
iab = 0 iab = 0
do i=nC+1,nO do i=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
kcd = 0 kcd = 0
do k=nC+1,nO do k=nC+1,nO
do c=nO+1,nBas-nR do c=nO+1,nOrb-nR
do d=nO+1,nBas-nR do d=nO+1,nOrb-nR
kcd = kcd + 1 kcd = kcd + 1
H(1+n2h1p+iab,1+n2h1p+kcd) & H(1+n2h1p+iab,1+n2h1p+kcd) &
@ -304,7 +305,7 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
iab = 0 iab = 0
do ia=1,nS do ia=1,nS
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
H(1+n2h1p+iab,1+n2h1p+iab) = eHF(b) + Om(ia) H(1+n2h1p+iab,1+n2h1p+iab) = eHF(b) + Om(ia)
@ -318,7 +319,7 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
iab = 0 iab = 0
do ia=1,nS do ia=1,nS
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
H(1 ,1+n2h1p+iab) = sqrt(2d0)*rho(p,b,ia) H(1 ,1+n2h1p+iab) = sqrt(2d0)*rho(p,b,ia)
@ -409,7 +410,7 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
ija = 0 ija = 0
do i=nC+1,nO do i=nC+1,nO
do j=nC+1,nO do j=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
ija = ija + 1 ija = ija + 1
if(abs(H(1+ija,s)) > cutoff2) & if(abs(H(1+ija,s)) > cutoff2) &
@ -422,8 +423,8 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
iab = 0 iab = 0
do i=nC+1,nO do i=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
if(abs(H(1+n2h1p+iab,s)) > cutoff2) & if(abs(H(1+n2h1p+iab,s)) > cutoff2) &
@ -478,7 +479,7 @@ subroutine ufG0W0(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
iab = 0 iab = 0
do ia=1,nS do ia=1,nS
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
if(abs(H(1+n2h1p+iab,s)) > cutoff2) & if(abs(H(1+n2h1p+iab,s)) > cutoff2) &

105
src/GW/ufGW.f90
View File

@ -1,4 +1,4 @@
subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) subroutine ufRGW(dotest,TDA_W,nBas,nOrb,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Unfold GW equations ! Unfold GW equations
@ -11,6 +11,7 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
logical,intent(in) :: TDA_W logical,intent(in) :: TDA_W
integer,intent(in) :: nBas integer,intent(in) :: nBas
integer,intent(in) :: nOrb
integer,intent(in) :: nC integer,intent(in) :: nC
integer,intent(in) :: nO integer,intent(in) :: nO
integer,intent(in) :: nV integer,intent(in) :: nV
@ -18,8 +19,8 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
integer,intent(in) :: nS integer,intent(in) :: nS
double precision,intent(in) :: ENuc double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF double precision,intent(in) :: ERHF
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI(nOrb,nOrb,nOrb,nOrb)
double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: eHF(nOrb)
! Local variables ! Local variables
@ -68,7 +69,7 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
n2h1p = nO*nO*nV n2h1p = nO*nO*nV
n2p1h = nV*nV*nO n2p1h = nV*nV*nO
nH = nBas + n2h1p + n2p1h nH = nOrb + n2h1p + n2p1h
! Memory allocation ! Memory allocation
@ -89,14 +90,14 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Memory allocation ! Memory allocation
allocate(Om(nS),Aph(nS,nS),Bph(nS,nS),XpY(nS,nS),XmY(nS,nS),rho(nBas,nBas,nS)) allocate(Om(nS),Aph(nS,nS),Bph(nS,nS),XpY(nS,nS),XmY(nS,nS),rho(nOrb,nOrb,nS))
! Spin manifold ! Spin manifold
ispin = 1 ispin = 1
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph) call phLR_A(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph)
call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) call phLR_B(ispin,dRPA,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph)
call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY) call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
@ -106,7 +107,7 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Compute spectral weights ! ! Compute spectral weights !
!--------------------------! !--------------------------!
call RGW_excitation_density(nBas,nC,nO,nR,nS,ERI,XpY,rho) call RGW_excitation_density(nOrb,nC,nO,nR,nS,ERI,XpY,rho)
deallocate(Aph,Bph,XpY,XmY) deallocate(Aph,Bph,XpY,XmY)
@ -141,7 +142,7 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Block F ! ! Block F !
!---------! !---------!
do p=nC+1,nBas-nR do p=nC+1,nOrb-nR
H(p,p) = eHF(p) H(p,p) = eHF(p)
end do end do
@ -149,16 +150,16 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Block V2h1p ! ! Block V2h1p !
!-------------! !-------------!
do p=nC+1,nBas-nR do p=nC+1,nOrb-nR
ija = 0 ija = 0
do i=nC+1,nO do i=nC+1,nO
do j=nC+1,nO do j=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
ija = ija + 1 ija = ija + 1
H(p ,nBas+ija) = sqrt(2d0)*ERI(p,a,i,j) H(p ,nOrb+ija) = sqrt(2d0)*ERI(p,a,i,j)
H(nBas+ija,p ) = sqrt(2d0)*ERI(p,a,i,j) H(nOrb+ija,p ) = sqrt(2d0)*ERI(p,a,i,j)
end do end do
end do end do
@ -170,16 +171,16 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Block V2p1h ! ! Block V2p1h !
!-------------! !-------------!
do p=nC+1,nBas-nR do p=nC+1,nOrb-nR
iab = 0 iab = 0
do i=nC+1,nO do i=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
H(p ,nBas+n2h1p+iab) = sqrt(2d0)*ERI(p,i,b,a) H(p ,nOrb+n2h1p+iab) = sqrt(2d0)*ERI(p,i,b,a)
H(nBas+n2h1p+iab,p ) = sqrt(2d0)*ERI(p,i,b,a) H(nOrb+n2h1p+iab,p ) = sqrt(2d0)*ERI(p,i,b,a)
end do end do
end do end do
@ -194,16 +195,16 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
ija = 0 ija = 0
do i=nC+1,nO do i=nC+1,nO
do j=nC+1,nO do j=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
ija = ija + 1 ija = ija + 1
klc = 0 klc = 0
do k=nC+1,nO do k=nC+1,nO
do l=nC+1,nO do l=nC+1,nO
do c=nO+1,nBas-nR do c=nO+1,nOrb-nR
klc = klc + 1 klc = klc + 1
H(nBas+ija,nBas+klc) & H(nOrb+ija,nOrb+klc) &
= ((eHF(i) + eHF(j) - eHF(a))*Kronecker_delta(j,l)*Kronecker_delta(a,c) & = ((eHF(i) + eHF(j) - eHF(a))*Kronecker_delta(j,l)*Kronecker_delta(a,c) &
- 2d0*ERI(j,c,a,l))*Kronecker_delta(i,k) - 2d0*ERI(j,c,a,l))*Kronecker_delta(i,k)
@ -221,17 +222,17 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
iab = 0 iab = 0
do i=nC+1,nO do i=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
kcd = 0 kcd = 0
do k=nC+1,nO do k=nC+1,nO
do c=nO+1,nBas-nR do c=nO+1,nOrb-nR
do d=nO+1,nBas-nR do d=nO+1,nOrb-nR
kcd = kcd + 1 kcd = kcd + 1
H(nBas+n2h1p+iab,nBas+n2h1p+kcd) & H(nOrb+n2h1p+iab,nOrb+n2h1p+kcd) &
= ((eHF(a) + eHF(b) - eHF(i))*Kronecker_delta(i,k)*Kronecker_delta(a,c) & = ((eHF(a) + eHF(b) - eHF(i))*Kronecker_delta(i,k)*Kronecker_delta(a,c) &
+ 2d0*ERI(a,k,i,c))*Kronecker_delta(b,d) + 2d0*ERI(a,k,i,c))*Kronecker_delta(b,d)
@ -275,7 +276,7 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Block F ! ! Block F !
!---------! !---------!
do p=nC+1,nBas-nR do p=nC+1,nOrb-nR
H(p,p) = eHF(p) H(p,p) = eHF(p)
end do end do
@ -283,15 +284,15 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Block W2h1p ! ! Block W2h1p !
!-------------! !-------------!
do p=nC+1,nBas-nR do p=nC+1,nOrb-nR
ija = 0 ija = 0
do i=nC+1,nO do i=nC+1,nO
do ja=1,nS do ja=1,nS
ija = ija + 1 ija = ija + 1
H(p ,nBas+ija) = sqrt(2d0)*rho(p,i,ja) H(p ,nOrb+ija) = sqrt(2d0)*rho(p,i,ja)
H(nBas+ija,p ) = sqrt(2d0)*rho(p,i,ja) H(nOrb+ija,p ) = sqrt(2d0)*rho(p,i,ja)
end do end do
end do end do
@ -302,15 +303,15 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Block W2p1h ! ! Block W2p1h !
!-------------! !-------------!
do p=nC+1,nBas-nR do p=nC+1,nOrb-nR
iab = 0 iab = 0
do ia=1,nS do ia=1,nS
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
H(p ,nBas+n2h1p+iab) = sqrt(2d0)*rho(p,b,ia) H(p ,nOrb+n2h1p+iab) = sqrt(2d0)*rho(p,b,ia)
H(nBas+n2h1p+iab,p ) = sqrt(2d0)*rho(p,b,ia) H(nOrb+n2h1p+iab,p ) = sqrt(2d0)*rho(p,b,ia)
end do end do
end do end do
@ -326,7 +327,7 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
do ja=1,nS do ja=1,nS
ija = ija + 1 ija = ija + 1
H(nBas+ija,nBas+ija) = eHF(i) - Om(ja) H(nOrb+ija,nOrb+ija) = eHF(i) - Om(ja)
end do end do
end do end do
@ -337,10 +338,10 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
iab = 0 iab = 0
do ia=1,nS do ia=1,nS
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
H(nBas+n2h1p+iab,nBas+n2h1p+iab) = eHF(b) + Om(ia) H(nOrb+n2h1p+iab,nOrb+n2h1p+iab) = eHF(b) + Om(ia)
end do end do
end do end do
@ -375,7 +376,7 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
Z(:) = 0d0 Z(:) = 0d0
do s=1,nH do s=1,nH
do p=nC+1,nBas-nR do p=nC+1,nOrb-nR
Z(s) = Z(s) + H(p,s)**2 Z(s) = Z(s) + H(p,s)**2
end do end do
end do end do
@ -425,7 +426,7 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
write(*,'(1X,A7,I3,A16,1X,F15.6,1X,F15.6)') & write(*,'(1X,A7,I3,A16,1X,F15.6,1X,F15.6)') &
' (',p,') ',H(p,s),H(p,s)**2 ' (',p,') ',H(p,s),H(p,s)**2
end do end do
do p=nO+1,nBas-nR do p=nO+1,nOrb-nR
if(abs(H(p,s)) > cutoff2) & if(abs(H(p,s)) > cutoff2) &
write(*,'(1X,A16,I3,A7,1X,F15.6,1X,F15.6)') & write(*,'(1X,A16,I3,A7,1X,F15.6,1X,F15.6)') &
' (',p,') ',H(p,s),H(p,s)**2 ' (',p,') ',H(p,s),H(p,s)**2
@ -434,12 +435,12 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
ija = 0 ija = 0
do i=nC+1,nO do i=nC+1,nO
do j=nC+1,nO do j=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
ija = ija + 1 ija = ija + 1
if(abs(H(nBas+ija,s)) > cutoff2) & if(abs(H(nOrb+ija,s)) > cutoff2) &
write(*,'(1X,A3,I3,A1,I3,A6,I3,A7,1X,F15.6,1X,F15.6)') & write(*,'(1X,A3,I3,A1,I3,A6,I3,A7,1X,F15.6,1X,F15.6)') &
' (',i,',',j,') -> (',a,') ',H(nBas+ija,s),H(nBas+ija,s)**2 ' (',i,',',j,') -> (',a,') ',H(nOrb+ija,s),H(nOrb+ija,s)**2
end do end do
end do end do
@ -447,13 +448,13 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
iab = 0 iab = 0
do i=nC+1,nO do i=nC+1,nO
do a=nO+1,nBas-nR do a=nO+1,nOrb-nR
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
if(abs(H(nBas+n2h1p+iab,s)) > cutoff2) & if(abs(H(nOrb+n2h1p+iab,s)) > cutoff2) &
write(*,'(1X,A7,I3,A6,I3,A1,I3,A3,1X,F15.6,1X,F15.6)') & write(*,'(1X,A7,I3,A6,I3,A1,I3,A3,1X,F15.6,1X,F15.6)') &
' (',i,') -> (',a,',',b,') ',H(nBas+n2h1p+iab,s),H(nBas+n2h1p+iab,s)**2 ' (',i,') -> (',a,',',b,') ',H(nOrb+n2h1p+iab,s),H(nOrb+n2h1p+iab,s)**2
end do end do
end do end do
@ -487,7 +488,7 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
write(*,'(1X,A7,I3,A16,1X,F15.6,1X,F15.6)') & write(*,'(1X,A7,I3,A16,1X,F15.6,1X,F15.6)') &
' (',p,' ) ',H(p,s),H(p,s)**2 ' (',p,' ) ',H(p,s),H(p,s)**2
end do end do
do p=nO+1,nBas-nR do p=nO+1,nOrb-nR
if(abs(H(p,s)) > cutoff2) & if(abs(H(p,s)) > cutoff2) &
write(*,'(1X,A7,I3,A16,1X,F15.6,1X,F15.6)') & write(*,'(1X,A7,I3,A16,1X,F15.6,1X,F15.6)') &
' (',p,' ) ',H(p,s),H(p,s)**2 ' (',p,' ) ',H(p,s),H(p,s)**2
@ -498,21 +499,21 @@ subroutine ufRGW(dotest,TDA_W,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
do ja=1,nS do ja=1,nS
ija = ija + 1 ija = ija + 1
if(abs(H(nBas+ija,s)) > cutoff2) & if(abs(H(nOrb+ija,s)) > cutoff2) &
write(*,'(1X,A7,I3,A1,I3,A12,1X,F15.6,1X,F15.6)') & write(*,'(1X,A7,I3,A1,I3,A12,1X,F15.6,1X,F15.6)') &
' (',i,',',ja,') ',H(nBas+ija,s),H(nBas+ija,s)**2 ' (',i,',',ja,') ',H(nOrb+ija,s),H(nOrb+ija,s)**2
end do end do
end do end do
iab = 0 iab = 0
do ia=1,nS do ia=1,nS
do b=nO+1,nBas-nR do b=nO+1,nOrb-nR
iab = iab + 1 iab = iab + 1
if(abs(H(nBas+n2h1p+iab,s)) > cutoff2) & if(abs(H(nOrb+n2h1p+iab,s)) > cutoff2) &
write(*,'(1X,A7,I3,A1,I3,A12,1X,F15.6,1X,F15.6)') & write(*,'(1X,A7,I3,A1,I3,A12,1X,F15.6,1X,F15.6)') &
' (',ia,',',b,') ',H(nBas+n2h1p+iab,s),H(nBas+n2h1p+iab,s)**2 ' (',ia,',',b,') ',H(nOrb+n2h1p+iab,s),H(nOrb+n2h1p+iab,s)**2
end do end do
end do end do