LCPQ/quack
4
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-06-02 03:15:31 +02:00
Code Releases Activity

modifs HF prints

Browse Source
This commit is contained in:
Pierre-Francois Loos 2023-11-08 10:48:54 +01:00
parent 9fcd61c62e
commit 9aa5891f60
6 changed files with 49 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
input/methods
View File

@ -1,5 +1,5 @@
# RHF UHF GHF ROHF # RHF UHF GHF ROHF
F T F F F F T F
# MP2 MP3 # MP2 MP3
F F F F
# CCD pCCD DCD CCSD CCSD(T) # CCD pCCD DCD CCSD CCSD(T)
@ -13,6 +13,6 @@
# G0F2 evGF2 qsGF2 G0F3 evGF3 # G0F2 evGF2 qsGF2 G0F3 evGF3
F F F F F F F F F F
# G0W0 evGW qsGW SRG-qsGW ufG0W0 ufGW # G0W0 evGW qsGW SRG-qsGW ufG0W0 ufGW
F F F F F F T F F F F F
# G0T0pp evGTpp qsGTpp G0T0eh evGTeh qsGTeh # G0T0pp evGTpp qsGTpp G0T0eh evGTeh qsGTeh
F F F F F F F F F F F F

2
input/options
View File

@ -1,5 +1,5 @@
# HF: maxSCF thresh DIIS guess mix shift stab search # HF: maxSCF thresh DIIS guess mix shift stab search
10000 0.00001 5 1 0.0 1.0 F T 10000 0.0000001 5 2 0.0 0.0 T T
# MP: reg # MP: reg
F F
# CC: maxSCF thresh DIIS # CC: maxSCF thresh DIIS

2
src/HF/RHF_search.f90
View File

@ -123,7 +123,7 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
call phLR_A(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,e,ERI_MO,Aph) call phLR_A(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,e,ERI_MO,Aph)
call phLR_B(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph) call phLR_B(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
AB(:,:) = Aph(:,:) - Bph(:,:) AB(:,:) = Aph(:,:) + Bph(:,:)
call diagonalize_matrix(nS,AB,Om) call diagonalize_matrix(nS,AB,Om)
Om(:) = 2d0*Om(:) Om(:) = 2d0*Om(:)

16
src/HF/print_GHF.f90
View File

@ -37,7 +37,9 @@ subroutine print_GHF(nBas,nBas2,nO,e,C,P,ENuc,ET,EV,EJ,EK,EHF,dipole)
double precision,allocatable :: Pba(:,:) double precision,allocatable :: Pba(:,:)
double precision,allocatable :: Pbb(:,:) double precision,allocatable :: Pbb(:,:)
double precision,external :: trace_matrix double precision,external :: trace_matrix
logical :: dump_orb = .false.
! HOMO and LUMO ! HOMO and LUMO
@ -117,13 +119,15 @@ subroutine print_GHF(nBas,nBas2,nO,e,C,P,ENuc,ET,EV,EJ,EK,EHF,dipole)
! Print results ! Print results
write(*,'(A50)') '---------------------------------------' if(dump_orb) then
write(*,'(A32)') 'MO coefficients' write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') '---------------------------------------' write(*,'(A32)') ' GHF orbital coefficients'
call matout(nBas2,nBas2,c) write(*,'(A50)') '---------------------------------------'
call matout(nBas2,nBas2,c)
end if
write(*,*) write(*,*)
write(*,'(A50)') '---------------------------------------' write(*,'(A50)') '---------------------------------------'
write(*,'(A32)') 'MO energies' write(*,'(A32)') ' GHF orbital energies'
write(*,'(A50)') '---------------------------------------' write(*,'(A50)') '---------------------------------------'
call matout(nBas2,1,e) call matout(nBas2,1,e)
write(*,*) write(*,*)

24
src/HF/print_RHF.f90
View File

@ -25,6 +25,9 @@ subroutine print_RHF(nBas,nO,eHF,cHF,ENuc,ET,EV,EJ,EK,ERHF,dipole)
integer :: HOMO integer :: HOMO
integer :: LUMO integer :: LUMO
double precision :: Gap double precision :: Gap
double precision :: S,S2
logical :: dump_orb = .false.
! HOMO and LUMO ! HOMO and LUMO
@ -32,8 +35,10 @@ subroutine print_RHF(nBas,nO,eHF,cHF,ENuc,ET,EV,EJ,EK,ERHF,dipole)
LUMO = HOMO + 1 LUMO = HOMO + 1
Gap = eHF(LUMO)-eHF(HOMO) Gap = eHF(LUMO)-eHF(HOMO)
! Dump results S2 = 0d0
S = 0d0
! Dump results
write(*,*) write(*,*)
write(*,'(A50)') '-----------------------------------------' write(*,'(A50)') '-----------------------------------------'
@ -55,21 +60,26 @@ subroutine print_RHF(nBas,nO,eHF,cHF,ENuc,ET,EV,EJ,EK,ERHF,dipole)
write(*,'(A32,1X,F16.6,A3)') ' HF LUMO energy: ',eHF(LUMO)*HaToeV,' eV' write(*,'(A32,1X,F16.6,A3)') ' HF LUMO energy: ',eHF(LUMO)*HaToeV,' eV'
write(*,'(A32,1X,F16.6,A3)') ' HF HOMO-LUMO gap : ',Gap*HaToeV,' eV' write(*,'(A32,1X,F16.6,A3)') ' HF HOMO-LUMO gap : ',Gap*HaToeV,' eV'
write(*,'(A50)') '-----------------------------------------' write(*,'(A50)') '-----------------------------------------'
write(*,'(A32,1X,F16.6)') ' S :',2d0*S+ 1d0
write(*,'(A32,1X,F16.6)') ' <S**2> :',S2
write(*,'(A50)') '-----------------------------------------'
write(*,'(A35)') ' Dipole moment (Debye) ' write(*,'(A35)') ' Dipole moment (Debye) '
write(*,'(10X,4A10)') 'X','Y','Z','Tot.' write(*,'(10X,4A10)') 'X','Y','Z','Tot.'
write(*,'(10X,4F10.6)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD write(*,'(10X,4F10.4)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD
write(*,'(A50)') '-----------------------------------------' write(*,'(A50)') '-----------------------------------------'
write(*,*) write(*,*)
! Print results ! Print results
write(*,'(A50)') '---------------------------------------' if(dump_orb) then
write(*,'(A32)') 'MO coefficients' write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') '---------------------------------------' write(*,'(A32)') ' RHF orbital coefficients'
call matout(nBas,nBas,cHF) write(*,'(A50)') '---------------------------------------'
call matout(nBas,nBas,cHF)
end if
write(*,*) write(*,*)
write(*,'(A50)') '---------------------------------------' write(*,'(A50)') '---------------------------------------'
write(*,'(A32)') 'MO energies' write(*,'(A32)') ' RHF orbital energies'
write(*,'(A50)') '---------------------------------------' write(*,'(A50)') '---------------------------------------'
call matout(nBas,1,eHF) call matout(nBas,1,eHF)
write(*,*) write(*,*)

28
src/HF/print_UHF.f90
View File

@ -5,6 +5,8 @@ subroutine print_UHF(nBas,nO,Ov,e,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
implicit none implicit none
include 'parameters.h' include 'parameters.h'
! Input variables
integer,intent(in) :: nBas integer,intent(in) :: nBas
integer,intent(in) :: nO(nspin) integer,intent(in) :: nO(nspin)
double precision,intent(in) :: Ov(nBas,nBas) double precision,intent(in) :: Ov(nBas,nBas)
@ -18,6 +20,8 @@ subroutine print_UHF(nBas,nO,Ov,e,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
double precision,intent(in) :: EUHF double precision,intent(in) :: EUHF
double precision,intent(in) :: dipole(ncart) double precision,intent(in) :: dipole(ncart)
! Local variables
integer :: ixyz integer :: ixyz
integer :: ispin integer :: ispin
double precision :: HOMO(nspin) double precision :: HOMO(nspin)
@ -26,6 +30,8 @@ subroutine print_UHF(nBas,nO,Ov,e,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
double precision :: S_exact,S2_exact double precision :: S_exact,S2_exact
double precision :: S,S2 double precision :: S,S2
logical :: dump_orb = .false.
! HOMO and LUMO ! HOMO and LUMO
do ispin=1,nspin do ispin=1,nspin
@ -97,21 +103,23 @@ subroutine print_UHF(nBas,nO,Ov,e,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
write(*,'(A60)') '-------------------------------------------------' write(*,'(A60)') '-------------------------------------------------'
write(*,'(A45)') ' Dipole moment (Debye) ' write(*,'(A45)') ' Dipole moment (Debye) '
write(*,'(19X,4A10)') 'X','Y','Z','Tot.' write(*,'(19X,4A10)') 'X','Y','Z','Tot.'
write(*,'(19X,4F10.6)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD write(*,'(19X,4F10.4)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD
write(*,'(A60)') '-------------------------------------------------' write(*,'(A60)') '-------------------------------------------------'
write(*,*) write(*,*)
! Print results ! Print results
write(*,'(A50)') '-----------------------------------------' if(dump_orb) then
write(*,'(A50)') 'UHF spin-up orbital coefficients ' write(*,'(A50)') '-----------------------------------------'
write(*,'(A50)') '-----------------------------------------' write(*,'(A50)') 'UHF spin-up orbital coefficients '
call matout(nBas,nBas,c(:,:,1)) write(*,'(A50)') '-----------------------------------------'
write(*,*) call matout(nBas,nBas,c(:,:,1))
write(*,'(A50)') '-----------------------------------------' write(*,*)
write(*,'(A50)') 'UHF spin-down orbital coefficients ' write(*,'(A50)') '-----------------------------------------'
write(*,'(A50)') '-----------------------------------------' write(*,'(A50)') 'UHF spin-down orbital coefficients '
call matout(nBas,nBas,c(:,:,2)) write(*,'(A50)') '-----------------------------------------'
call matout(nBas,nBas,c(:,:,2))
end if
write(*,*) write(*,*)
write(*,'(A50)') '---------------------------------------' write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') ' UHF spin-up orbital energies ' write(*,'(A50)') ' UHF spin-up orbital energies '