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

RHF, UHF, and GHF search seem to work

This commit is contained in:
Pierre-Francois Loos 2023-11-04 15:43:01 +01:00
parent 7847710059
commit 925dc64bc8
4 changed files with 27 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
input/methods
View File

@ -1,5 +1,5 @@
# RHF UHF GHF ROHF
F T F F
F F T F
# MP2 MP3
F F
# CCD pCCD DCD CCSD CCSD(T)

22
src/HF/GHF_search.f90
View File

@ -85,6 +85,7 @@ subroutine GHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
unstab = .true.
guess = 0
mix = 0d0
do while(unstab)
@ -128,8 +129,9 @@ subroutine GHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
call AOtoMO_integral_transform_GHF(nBas,nBas2,Cb,Cb,Cb,Cb,ERI_AO,ERI_tmp)
ERI_MO(:,:,:,:) = ERI_MO(:,:,:,:) + ERI_tmp(:,:,:,:)
deallocate(Ca,Cb,ERI_tmp)
call wall_time(end_AOtoMO)
t_AOtoMO = end_AOtoMO - start_AOtoMO
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for AO to MO transformation = ',t_AOtoMO,' seconds'
@ -141,8 +143,8 @@ subroutine GHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
ispin = 3
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_A(ispin,.false.,nBas2,nC,nO,nV,nR,nS,1d0,e,ERI_MO,Aph)
call phLR_B(ispin,.false.,nBas2,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph)
AB(:,:) = Aph(:,:) + Bph(:,:)
@ -163,14 +165,15 @@ subroutine GHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
if(minval(Om(:)) < 0d0) then
write(*,'(1X,A40,1X)') 'Too bad, GHF solution is unstable!'
write(*,'(1X,A40,1X)') 'Too bad, GHF solution is unstable!'
write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue:',Om(1),' au'
write(*,'(1X,A40,1X,F15.10,A3)') 'E(GHF) = ',EHF,' au'
write(*,*)
write(*,'(1X,A40,1X,A10)') 'Which one would you like to follow?','[Exit:0]'
write(*,'(1X,A40,1X,A10)') 'Which one would you like to follow?','[Exit:0]'
read(*,*) eig
if(eig < 0 .or. eig > nS) then
write(*,'(1X,A40,1X,A10)') 'Invalid option...','Stop...'
write(*,'(1X,A40,1X,A10)') 'Invalid option...','Stop...'
write(*,*)
stop
end if
@ -179,11 +182,11 @@ subroutine GHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
step = 1d0
do mu=1,nBas
do mu=1,nBas2
ia = 0
do i=nC+1,nO
kick = 0d0
do a=nO+1,nBas-nR
do a=nO+1,nBas2-nR
ia = ia + 1
kick = kick + AB(ia,eig)*c(mu,a)
end do
@ -193,8 +196,9 @@ subroutine GHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
else
write(*,'(1X,A40,1X)') 'Well done, GHF solution is stable!'
write(*,'(1X,A40,1X)') 'Well done, GHF solution is stable!'
write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om(1),' au'
write(*,'(1X,A40,1X,F15.10,A3)') 'E(GHF) = ',EHF,' au'
unstab = .false.

10
src/HF/RHF_search.f90
View File

@ -139,14 +139,15 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
if(minval(Om(:)) < 0d0) then
write(*,'(1X,A40,1X)') 'Too bad, RHF solution is unstable!'
write(*,'(1X,A40,1X)') 'Too bad, RHF solution is unstable!'
write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue:',Om(1),' au'
write(*,'(1X,A40,1X,F15.10,A3)') 'E(RHF) = ',EHF,' au'
write(*,*)
write(*,'(1X,A40,1X,A10)') 'Which one would you like to follow?','[Exit:0]'
write(*,'(1X,A40,1X,A10)') 'Which one would you like to follow?','[Exit:0]'
read(*,*) eig
if(eig < 0 .or. eig > nS) then
write(*,'(1X,A40,1X,A10)') 'Invalid option...','Stop...'
write(*,'(1X,A40,1X,A10)') 'Invalid option...','Stop...'
write(*,*)
stop
end if
@ -169,8 +170,9 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
else
write(*,'(1X,A40,1X)') 'Well done, RHF solution is stable!'
write(*,'(1X,A40,1X)') 'Well done, RHF solution is stable!'
write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om(1),' au'
write(*,'(1X,A40,1X,F15.10,A3)') 'E(RHF) = ',EHF,' au'
unstab = .false.

12
src/HF/UHF_search.f90
View File

@ -160,14 +160,15 @@ subroutine UHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
if(minval(Om_sc(:)) < 0d0) then
write(*,'(1X,A40,1X)') 'Too bad, UHF solution is unstable!'
write(*,'(1X,A40,1X,F10.6,A3)') 'Largest negative eigenvalue:',Om_sc(1),' au'
write(*,'(1X,A40,1X)') 'Too bad, UHF solution is unstable!'
write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue:',Om_sc(1),' au'
write(*,'(1X,A40,1X,F15.10,A3)') 'E(UHF) = ',EHF,' au'
write(*,*)
write(*,'(1X,A40,1X,A10)') 'Which one would you like to follow?','[Exit:0]'
write(*,'(1X,A40,1X,A10)') 'Which one would you like to follow?','[Exit:0]'
read(*,*) eig
if(eig < 0 .or. eig > nS_sc) then
write(*,'(1X,A40,1X,A10)') 'Invalid option...','Stop...'
write(*,'(1X,A40,1X,A10)') 'Invalid option...','Stop...'
write(*,*)
stop
end if
@ -206,8 +207,9 @@ subroutine UHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
else
write(*,'(1X,A40,1X)') 'Well done, UHF solution is stable!'
write(*,'(1X,A40,1X)') 'Well done, UHF solution is stable!'
write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om_sc(1),' au'
write(*,'(1X,A40,1X,F15.10,A3)') 'E(UHF) = ',EHF,' au'
unstab = .false.