4
1
mirror of https://github.com/pfloos/quack synced 2024-06-25 06:32:19 +02:00

clean up unrestricted code for one electron

This commit is contained in:
Pierre-Francois Loos 2020-09-25 15:05:06 +02:00
parent 875b53b7d0
commit 435d44391d
11 changed files with 69 additions and 78 deletions

View File

@ -1,33 +1,4 @@
1 6
S 8
1 6665.0000000 0.0006920
2 1000.0000000 0.0053290
3 228.0000000 0.0270770
4 64.7100000 0.1017180
5 21.0600000 0.2747400
6 7.4950000 0.4485640
7 2.7970000 0.2850740
8 0.5215000 0.0152040
S 8
1 6665.0000000 -0.0001460
2 1000.0000000 -0.0011540
3 228.0000000 -0.0057250
4 64.7100000 -0.0233120
5 21.0600000 -0.0639550
6 7.4950000 -0.1499810
7 2.7970000 -0.1272620
8 0.5215000 0.5445290
S 1
1 0.1596000 1.0000000
P 3
1 9.4390000 0.0381090
2 2.0020000 0.2094800
3 0.5456000 0.5085570
P 1
1 0.1517000 1.0000000
D 1
1 0.5500000 1.0000000
2 3
1 3
S 3
1 13.0100000 0.0196850
2 1.9620000 0.1379770

View File

@ -1,7 +1,7 @@
# RHF UHF MOM
F T F
# MP2* MP3 MP2-F12
F F F
T F F
# CCD CCSD CCSD(T)
F F F
# drCCD rCCD lCCD pCCD
@ -13,7 +13,7 @@
# G0F2 evGF2 G0F3 evGF3
F F F F
# G0W0* evGW* qsGW
T T F
F F F
# G0T0 evGT qsGT
F F F
# MCMP2

View File

@ -1,5 +1,4 @@
# nAt nEla nElb nCore nRyd
2 4 3 0 0
1 1 0 0 0
# Znuc x y z
C 0. 0. -0.16245872
H 0. 0. 1.93436816
H 0. 0. 0.

View File

@ -1,4 +1,3 @@
2
1
C 0.0000000000 0.0000000000 -0.0859694585
H 0.0000000000 0.0000000000 1.0236236215
H 0.0000000000 0.0000000000 0.0000000000

View File

@ -802,9 +802,8 @@ program QuAcK
ENuc,EUHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,PHF,cHF,eHF,eG0W0)
else
call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, &
dBSE,dTDA,evDyn,singlet,triplet,linGW,eta_GW, &
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_MO,PHF,cHF,eHF,eG0W0)
call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, &
linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_MO,PHF,cHF,eHF,eG0W0)
end if

View File

@ -118,7 +118,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev
call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, &
eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA)
if(print_W) call print_excitation('RPA@UHF',5,nS_sc,OmRPA)
if(print_W) call print_excitation('RPA@UHF ',5,nS_sc,OmRPA)
!----------------------!
! Excitation densities !

View File

@ -127,9 +127,8 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE
nS_bb = nS(2)
nS_sc = nS_aa + nS_bb
allocate(eGW(nBas,nspin),eOld(nBas,nspin),Z(nBas,nspin),SigC(nBas,nspin),OmRPA(nS_sc), &
XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin), &
error_diis(nBas,max_diis,nspin),e_diis(nBas,max_diis,nspin))
allocate(eGW(nBas,nspin),eOld(nBas,nspin),Z(nBas,nspin),SigC(nBas,nspin),OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc), &
XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin),error_diis(nBas,max_diis,nspin),e_diis(nBas,max_diis,nspin))
! Initialization

View File

@ -16,15 +16,24 @@ subroutine print_UG0W0(nBas,nO,e,ENuc,EHF,SigC,Z,eGW,EcRPA)
double precision,intent(in) :: eGW(nBas,nspin)
integer :: p
double precision :: HOMO
double precision :: LUMO
double precision :: Gap
integer :: ispin
double precision :: HOMO(nspin)
double precision :: LUMO(nspin)
double precision :: Gap(nspin)
! HOMO and LUMO
HOMO = max(eGW(nO(1),1),eGW(nO(2),2))
LUMO = min(eGW(nO(1)+1,1),eGW(nO(2)+1,2))
Gap = LUMO - HOMO
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) = e(1,ispin)
Gap(ispin) = 0d0
end if
end do
! Dump results
@ -34,7 +43,7 @@ subroutine print_UG0W0(nBas,nO,e,ENuc,EHF,SigC,Z,eGW,EcRPA)
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') &
'|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|'
'|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|'
write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') &
'|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|'
write(*,*)'-------------------------------------------------------------------------------&
@ -48,9 +57,9 @@ subroutine print_UG0W0(nBas,nO,e,ENuc,EHF,SigC,Z,eGW,EcRPA)
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,'(2X,A30,F15.6)') 'G0W0 HOMO energy (eV):',HOMO*HaToeV
write(*,'(2X,A30,F15.6)') 'G0W0 LUMO energy (eV):',LUMO*HaToeV
write(*,'(2X,A30,F15.6)') 'G0W0 HOMO-LUMO gap (eV):',Gap*HaToeV
write(*,'(2X,A30,F15.6)') 'G0W0 HOMO energy (eV):',maxval(HOMO(:))*HaToeV
write(*,'(2X,A30,F15.6)') 'G0W0 LUMO energy (eV):',minval(LUMO(:))*HaToeV
write(*,'(2X,A30,F15.6)') 'G0W0 HOMO-LUMO gap (eV):',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,'(2X,A30,F15.6)') 'RPA@G0W0 total energy =',ENuc + EHF + EcRPA

View File

@ -16,18 +16,24 @@ subroutine print_UHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EUHF)
double precision,intent(in) :: Ex(nspin)
double precision,intent(in) :: EUHF
integer :: HOMO(nspin)
integer :: LUMO(nspin)
integer :: ispin
double precision :: HOMO(nspin)
double precision :: LUMO(nspin)
double precision :: Gap(nspin)
! HOMO and LUMO
HOMO(:) = nO(:)
LUMO(:) = HOMO(:) + 1
Gap(1) = e(LUMO(1),1) - e(HOMO(1),1)
Gap(2) = e(LUMO(2),2) - e(HOMO(2),2)
do ispin=1,nspin
if(nO(ispin) > 0) then
HOMO(ispin) = e(nO(ispin),ispin)
LUMO(ispin) = e(nO(ispin)+1,ispin)
Gap(ispin) = LUMO(ispin) - HOMO(ispin)
else
HOMO(ispin) = 0d0
LUMO(ispin) = e(1,ispin)
Gap(ispin) = 0d0
end if
end do
! Dump results
@ -62,12 +68,12 @@ subroutine print_UHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EUHF)
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,F13.6,A3)') ' UHF HOMO a energy:',e(HOMO(1),1)*HatoeV,' eV'
write(*,'(A40,F13.6,A3)') ' UHF LUMO a energy:',e(LUMO(1),1)*HatoeV,' eV'
write(*,'(A40,F13.6,A3)') ' UHF HOMO a energy:',HOMO(1)*HatoeV,' eV'
write(*,'(A40,F13.6,A3)') ' UHF LUMO a energy:',LUMO(1)*HatoeV,' eV'
write(*,'(A40,F13.6,A3)') ' UHF HOMOa-LUMOa gap:',Gap(1)*HatoeV,' eV'
write(*,'(A60)') '-------------------------------------------------'
write(*,'(A40,F13.6,A3)') ' UHF HOMO b energy:',e(HOMO(2),2)*HatoeV,' eV'
write(*,'(A40,F13.6,A3)') ' UHF LUMO b energy:',e(LUMO(2),2)*HatoeV,' eV'
write(*,'(A40,F13.6,A3)') ' UHF HOMO b energy:',HOMO(2)*HatoeV,' eV'
write(*,'(A40,F13.6,A3)') ' UHF LUMO b energy:',LUMO(2)*HatoeV,' eV'
write(*,'(A40,F13.6,A3)') ' UHF HOMOb-LUMOb gap :',Gap(2)*HatoeV,' eV'
write(*,'(A60)') '-------------------------------------------------'
write(*,*)

View File

@ -18,15 +18,24 @@ subroutine print_evUGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigC,Z,eGW,EcRPA)
double precision,intent(in) :: eGW(nBas,nspin)
integer :: p
double precision :: HOMO
double precision :: LUMO
double precision :: Gap
integer :: ispin
double precision :: HOMO(nspin)
double precision :: LUMO(nspin)
double precision :: Gap(nspin)
! HOMO and LUMO
HOMO = max(eGW(nO(1),1),eGW(nO(2),2))
LUMO = min(eGW(nO(1)+1,1),eGW(nO(2)+1,2))
Gap = LUMO - HOMO
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) = e(1,ispin)
Gap(ispin) = 0d0
end if
end do
! Dump results
@ -40,7 +49,7 @@ subroutine print_evUGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigC,Z,eGW,EcRPA)
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') &
'|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|'
'|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|'
write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') &
'|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|'
write(*,*)'-------------------------------------------------------------------------------&
@ -58,9 +67,9 @@ subroutine print_evUGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigC,Z,eGW,EcRPA)
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,'(2X,A30,F15.6)') 'evGW HOMO energy (eV):',HOMO*HaToeV
write(*,'(2X,A30,F15.6)') 'evGW LUMO energy (eV):',LUMO*HaToeV
write(*,'(2X,A30,F15.6)') 'evGW HOMO-LUMO gap (eV):',Gap*HaToeV
write(*,'(2X,A30,F15.6)') 'evGW HOMO energy (eV):',maxval(HOMO(:))*HaToeV
write(*,'(2X,A30,F15.6)') 'evGW LUMO energy (eV):',minval(LUMO(:))*HaToeV
write(*,'(2X,A30,F15.6)') 'evGW HOMO-LUMO gap (eV):',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,'(2X,A30,F15.6)') 'RPA@evGW total energy =',ENuc + EHF + EcRPA

View File

@ -7,7 +7,7 @@ subroutine print_excitation(method,ispin,nS,Omega)
! Input variables
character*12,intent(in) :: method
character*12,intent(in) :: method
integer,intent(in) :: ispin,nS
double precision,intent(in) :: Omega(nS)