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

change print HOMO LUMO in UHF and G0W0

This commit is contained in:
Pierre-Francois Loos 2023-12-26 12:37:56 +01:00
parent ec9426005a
commit 39edb33dcb
3 changed files with 26 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/GW/print_RG0W0.f90
View File

@ -15,14 +15,14 @@ subroutine print_RG0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM)
double precision,intent(in) :: Z(nBas)
double precision,intent(in) :: eGW(nBas)
integer :: p,HOMO,LUMO
double precision :: Gap
integer :: p
double precision :: eHOMO,eLUMO,Gap
! HOMO and LUMO
HOMO = nO
LUMO = HOMO + 1
Gap = eGW(LUMO)-eGW(HOMO)
eHOMO = maxval(eGW(1:nO))
eLUMO = minval(eGW(nO+1:nBas))
Gap = eLUMO-eHOMO
! Dump results
@ -39,8 +39,8 @@ subroutine print_RG0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM)
end do
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') 'G0W0@RHF HOMO energy = ',eGW(HOMO)*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'G0W0@RHF LUMO energy = ',eGW(LUMO)*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'G0W0@RHF HOMO energy = ',eHOMO*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'G0W0@RHF LUMO energy = ',eLUMO*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'G0W0@RHF HOMO-LUMO gap = ',Gap*HaToeV,' eV'
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') 'phRPA@G0W0@RHF total energy = ',ENuc + ERHF + EcRPA,' au'

24
src/GW/print_UG0W0.f90
View File

@ -18,23 +18,17 @@ subroutine print_UG0W0(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGW,EcRPA,EcGM)
integer :: p
integer :: ispin
double precision :: HOMO(nspin)
double precision :: LUMO(nspin)
double precision :: Gap(nspin)
double precision :: eHOMO(nspin)
double precision :: eLUMO(nspin)
double precision :: Gap
! HOMO and LUMO
do ispin=1,nspin
if(nO(ispin) > 0) then
HOMO(ispin) = eGW(nO(ispin),ispin)
LUMO(ispin) = eGW(nO(ispin)+1,ispin)
Gap(ispin) = LUMO(ispin) - HOMO(ispin)
else
HOMO(ispin) = 0d0
LUMO(ispin) = eGW(1,ispin)
Gap(ispin) = 0d0
end if
eHOMO(ispin) = maxval(eGW(1:nO(ispin),ispin))
eLUMO(ispin) = minval(eGW(nO(ispin)+1:nBas,ispin))
end do
Gap = minval(eLUMO) -maxval(eHOMO)
! Dump results
@ -58,9 +52,9 @@ subroutine print_UG0W0(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGW,EcRPA,EcGM)
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') 'G0W0@UHF HOMO energy = ',maxval(HOMO)*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'G0W0@UHF LUMO energy = ',minval(LUMO)*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'G0W0@UHF HOMO-LUMO gap = ',(minval(LUMO)-maxval(HOMO))*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'G0W0@UHF HOMO energy = ',maxval(eHOMO)*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'G0W0@UHF LUMO energy = ',minval(eLUMO)*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'G0W0@UHF HOMO-LUMO gap = ',Gap*HaToeV,' eV'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') 'phRPA@G0W0@UHF total energy = ',ENuc + EUHF + EcRPA,' au'

33
src/HF/print_UHF.f90
View File

@ -25,9 +25,9 @@ subroutine print_UHF(nBas,nO,S,eHF,c,P,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
integer :: ixyz
integer :: ispin
double precision :: HOMO(nspin)
double precision :: LUMO(nspin)
double precision :: Gap(nspin)
double precision :: eHOMO(nspin)
double precision :: eLUMO(nspin)
double precision :: Gap
double precision :: Sz
double precision :: Sx2,Sy2,Sz2
integer :: mu,nu
@ -37,21 +37,12 @@ subroutine print_UHF(nBas,nO,S,eHF,c,P,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
! HOMO and LUMO
do ispin=1,nspin
if(nO(ispin) > 0) then
HOMO(ispin) = eHF(nO(ispin),ispin)
if(nO(ispin) < nBas) then
LUMO(ispin) = eHF(nO(ispin)+1,ispin)
else
LUMO(ispin) = 0d0
end if
Gap(ispin) = LUMO(ispin) - HOMO(ispin)
else
HOMO(ispin) = 0d0
LUMO(ispin) = eHF(1,ispin)
Gap(ispin) = 0d0
end if
eHOMO(ispin) = maxval(eHF(1:nO(ispin),ispin))
eLUMO(ispin) = minval(eHF(nO(ispin)+1:nBas,ispin))
end do
Gap = minval(eLUMO) -maxval(eHOMO)
Sz = 0.5d0*dble(nO(1) - nO(2))
Sx2 = 0.25d0*dble(nO(1) - nO(2)) + 0.5d0*nO(2) - 0.5d0*sum(matmul(transpose(c(:,1:nO(1),1)),matmul(S,c(:,1:nO(2),2)))**2)
@ -90,13 +81,9 @@ subroutine print_UHF(nBas,nO,S,eHF,c,P,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion = ',ENuc,' au'
write(*,'(A40,1X,F16.10,A3)') ' UHF energy = ',EUHF + ENuc,' au'
write(*,'(A60)') '---------------------------------------------'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMO a energy = ' ,HOMO(1)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF LUMO a energy = ' ,LUMO(1)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMOa-LUMOa gap = ' ,Gap(1)*HatoeV,' eV'
write(*,'(A60)') '---------------------------------------------'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMO b energy = ',HOMO(2)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF LUMO b energy = ',LUMO(2)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMOb-LUMOb gap = ',Gap(2)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMO energy = ' ,maxval(eHOMO)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF LUMO energy = ' ,minval(eLUMO)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMO-LUMO gap = ' ,Gap*HatoeV,' eV'
write(*,'(A60)') '---------------------------------------------'
write(*,'(A40,1X,F10.6)') ' <Sz> = ',Sz
write(*,'(A40,1X,F10.6)') ' <S^2> = ',Sx2+Sy2+Sz2