From 39edb33dcb34afd4107a46e2596c9d4616d4ed64 Mon Sep 17 00:00:00 2001 From: pfloos Date: Tue, 26 Dec 2023 12:37:56 +0100 Subject: [PATCH] change print HOMO LUMO in UHF and G0W0 --- src/GW/print_RG0W0.f90 | 14 +++++++------- src/GW/print_UG0W0.f90 | 24 +++++++++--------------- src/HF/print_UHF.f90 | 33 ++++++++++----------------------- 3 files changed, 26 insertions(+), 45 deletions(-) diff --git a/src/GW/print_RG0W0.f90 b/src/GW/print_RG0W0.f90 index a786d26..0bae48c 100644 --- a/src/GW/print_RG0W0.f90 +++ b/src/GW/print_RG0W0.f90 @@ -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' diff --git a/src/GW/print_UG0W0.f90 b/src/GW/print_UG0W0.f90 index 9ec1c25..71c007d 100644 --- a/src/GW/print_UG0W0.f90 +++ b/src/GW/print_UG0W0.f90 @@ -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' diff --git a/src/HF/print_UHF.f90 b/src/HF/print_UHF.f90 index d985b76..e48e963 100644 --- a/src/HF/print_UHF.f90 +++ b/src/HF/print_UHF.f90 @@ -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 write(*,'(A40,1X,F10.6)') ' = ',Sx2+Sy2+Sz2