mirror of
https://github.com/pfloos/quack
synced 2024-12-23 04:43:42 +01:00
fix scf convergence issues in RHF, UHF, ROHF and GHF
This commit is contained in:
parent
3e8b3ab6da
commit
d5e7be1500
@ -182,52 +182,7 @@ subroutine GHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
|
||||
if(nSCF > 1) Conv = maxval(abs(err))
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
if(max_diis > 1) then
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
call DIIS_extrapolation(rcond,nBas2Sq,nBas2Sq,n_diis,err_diis(:,1:n_diis),F_diis(:,1:n_diis),err,F)
|
||||
end if
|
||||
|
||||
! Level-shifting
|
||||
|
||||
if(level_shift > 0d0 .and. Conv > thresh) then
|
||||
call level_shifting(level_shift,nBas,nO,S,C,F)
|
||||
end if
|
||||
|
||||
! Transform Fock matrix in orthogonal basis
|
||||
|
||||
Fp(:,:) = matmul(transpose(X),matmul(F,X))
|
||||
|
||||
! Diagonalize Fock matrix to get eigenvectors and eigenvalues
|
||||
|
||||
Cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas2,Cp,eHF)
|
||||
|
||||
! Back-transform eigenvectors in non-orthogonal basis
|
||||
|
||||
C(:,:) = matmul(X,Cp)
|
||||
|
||||
! Mix guess for UHF solution in singlet states
|
||||
|
||||
! if(nSCF == 1) call mix_guess(nBas,nO,mix,c)
|
||||
|
||||
! Form super density matrix
|
||||
|
||||
P(:,:) = matmul(C(:,1:nO),transpose(C(:,1:nO)))
|
||||
|
||||
! Compute individual density matrices
|
||||
|
||||
Paa(:,:) = P( 1:nBas , 1:nBas )
|
||||
Pab(:,:) = P( 1:nBas ,nBas+1:nBas2)
|
||||
Pba(:,:) = P(nBas+1:nBas2, 1:nBas )
|
||||
Pbb(:,:) = P(nBas+1:nBas2,nBas+1:nBas2)
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute UHF energy
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Kinetic energy
|
||||
! Kinetic energy
|
||||
|
||||
ETaa = trace_matrix(nBas,matmul(Paa,T))
|
||||
ETbb = trace_matrix(nBas,matmul(Pbb,T))
|
||||
@ -263,9 +218,48 @@ subroutine GHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
|
||||
EGHF = ET + EV + EJ + EK
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
if(max_diis > 1) then
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
call DIIS_extrapolation(rcond,nBas2Sq,nBas2Sq,n_diis,err_diis,F_diis,err,F)
|
||||
end if
|
||||
|
||||
! Level-shifting
|
||||
|
||||
if(level_shift > 0d0 .and. Conv > thresh) call level_shifting(level_shift,nBas,nO,S,C,F)
|
||||
|
||||
! Transform Fock matrix in orthogonal basis
|
||||
|
||||
Fp(:,:) = matmul(transpose(X),matmul(F,X))
|
||||
|
||||
! Diagonalize Fock matrix to get eigenvectors and eigenvalues
|
||||
|
||||
Cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas2,Cp,eHF)
|
||||
|
||||
! Back-transform eigenvectors in non-orthogonal basis
|
||||
|
||||
C(:,:) = matmul(X,Cp)
|
||||
|
||||
! Mix guess for UHF solution in singlet states
|
||||
|
||||
! if(nSCF == 1) call mix_guess(nBas,nO,mix,c)
|
||||
|
||||
! Form super density matrix
|
||||
|
||||
P(:,:) = matmul(C(:,1:nO),transpose(C(:,1:nO)))
|
||||
|
||||
! Compute individual density matrices
|
||||
|
||||
Paa(:,:) = P( 1:nBas , 1:nBas )
|
||||
Pab(:,:) = P( 1:nBas ,nBas+1:nBas2)
|
||||
Pba(:,:) = P(nBas+1:nBas2, 1:nBas )
|
||||
Pbb(:,:) = P(nBas+1:nBas2,nBas+1:nBas2)
|
||||
|
||||
! Dump results
|
||||
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X)') &
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,E10.2,1X,A1,1X)') &
|
||||
'|',nSCF,'|',EGHF + ENuc,'|',EJ,'|',EK,'|',Conv,'|'
|
||||
|
||||
end do
|
||||
|
||||
@ -211,6 +211,8 @@ subroutine GHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
call matrix_exponential(nBas2,R,ExpR)
|
||||
c = matmul(c,ExpR)
|
||||
|
||||
! call matout(nBas2,nBas2,matmul(transpose(ExpR),ExpR))
|
||||
|
||||
else
|
||||
|
||||
write(*,'(1X,A40,1X)') 'Well done, GHF solution is stable!'
|
||||
|
||||
@ -42,7 +42,6 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
double precision :: dipole(ncart)
|
||||
|
||||
double precision :: Conv
|
||||
double precision :: Gap
|
||||
double precision :: rcond
|
||||
double precision,external :: trace_matrix
|
||||
double precision,allocatable :: error(:,:)
|
||||
@ -87,21 +86,20 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
|
||||
F_diis(:,:) = 0d0
|
||||
error_diis(:,:) = 0d0
|
||||
Conv = 1d0
|
||||
n_diis = 0
|
||||
nSCF = 0
|
||||
rcond = 0d0
|
||||
|
||||
Conv = 1d0
|
||||
nSCF = 0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Main SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)'| RHF calculation |'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
|
||||
'|','#','|','HF energy','|','Conv','|','HL Gap','|'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)'-----------------------------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X)') &
|
||||
'|','#','|','E(RHF)','|','EJ(RHF)','|','EK(RHF)','|','Conv','|'
|
||||
write(*,*)'-----------------------------------------------------------------------------'
|
||||
|
||||
do while(Conv > thresh .and. nSCF < maxSCF)
|
||||
|
||||
@ -121,6 +119,26 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F)
|
||||
Conv = maxval(abs(error))
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
ET = trace_matrix(nBas,matmul(P,T))
|
||||
|
||||
! Potential energy
|
||||
|
||||
EV = trace_matrix(nBas,matmul(P,V))
|
||||
|
||||
! Hartree energy
|
||||
|
||||
EJ = 0.5d0*trace_matrix(nBas,matmul(P,J))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
EK = 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
|
||||
! Total energy
|
||||
|
||||
ERHF = ET + EV + EJ + EK
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
if(max_diis > 1) then
|
||||
@ -145,31 +163,13 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
|
||||
P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO)))
|
||||
|
||||
! Compute HF energy
|
||||
|
||||
ERHF = trace_matrix(nBas,matmul(P,Hc)) &
|
||||
+ 0.5d0*trace_matrix(nBas,matmul(P,J)) &
|
||||
+ 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
|
||||
! Compute HOMO-LUMO gap
|
||||
|
||||
if(nBas > nO) then
|
||||
|
||||
Gap = eHF(nO+1) - eHF(nO)
|
||||
|
||||
else
|
||||
|
||||
Gap = 0d0
|
||||
|
||||
end if
|
||||
|
||||
! Dump results
|
||||
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
|
||||
'|',nSCF,'|',ERHF+ENuc,'|',Conv,'|',Gap,'|'
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,E10.2,1X,A1,1X)') &
|
||||
'|',nSCF,'|',ERHF + ENuc,'|',EJ,'|',EK,'|',Conv,'|'
|
||||
|
||||
end do
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)'-----------------------------------------------------------------------------'
|
||||
!------------------------------------------------------------------------
|
||||
! End of SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
@ -188,14 +188,6 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
|
||||
|
||||
end if
|
||||
|
||||
! Compute HF energy
|
||||
|
||||
ET = trace_matrix(nBas,matmul(P,T))
|
||||
EV = trace_matrix(nBas,matmul(P,V))
|
||||
EJ = 0.5d0*trace_matrix(nBas,matmul(P,J))
|
||||
EK = 0.25d0*trace_matrix(nBas,matmul(P,K))
|
||||
ERHF = ET + EV + EJ + EK
|
||||
|
||||
! Compute dipole moments
|
||||
|
||||
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int,dipole)
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
|
||||
nBas,nO,S,T,V,Hc,ERI,dipole_int,X,EHF,e,c,Ptot)
|
||||
nBas,nO,S,T,V,Hc,ERI,dipole_int,X,EROHF,eHF,c,Ptot)
|
||||
|
||||
! Perform restricted open-shell Hartree-Fock calculation
|
||||
|
||||
@ -42,7 +42,7 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
double precision :: ET(nspin)
|
||||
double precision :: EV(nspin)
|
||||
double precision :: EJ(nsp)
|
||||
double precision :: Ex(nspin)
|
||||
double precision :: EK(nspin)
|
||||
double precision :: dipole(ncart)
|
||||
|
||||
double precision,allocatable :: cp(:,:)
|
||||
@ -61,9 +61,9 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
|
||||
! Output variables
|
||||
|
||||
double precision,intent(out) :: EHF
|
||||
double precision,intent(out) :: e(nBas)
|
||||
double precision,intent(out) :: c(nBas,nBas)
|
||||
double precision,intent(out) :: EROHF
|
||||
double precision,intent(out) :: eHF(nBas)
|
||||
double precision,intent(inout):: c(nBas,nBas)
|
||||
double precision,intent(out) :: Ptot(nBas,nBas)
|
||||
|
||||
! Hello world
|
||||
@ -80,8 +80,8 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(J(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas),Ftot(nBas,nBas), &
|
||||
P(nBas,nBas,nspin),K(nBas,nBas,nspin),err(nBas,nBas),cp(nBas,nBas), &
|
||||
allocate(J(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas),Ftot(nBas,nBas), &
|
||||
P(nBas,nBas,nspin),K(nBas,nBas,nspin),err(nBas,nBas),cp(nBas,nBas), &
|
||||
err_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
|
||||
|
||||
! Guess coefficients and demsity matrices
|
||||
@ -90,6 +90,7 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
do ispin=1,nspin
|
||||
P(:,:,ispin) = matmul(c(:,1:nO(ispin)),transpose(c(:,1:nO(ispin))))
|
||||
end do
|
||||
Ptot(:,:) = P(:,:,1) + P(:,:,2)
|
||||
|
||||
! Initialization
|
||||
|
||||
@ -106,10 +107,10 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'----------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X)') &
|
||||
'|','#','|','E(ROHF)','|','Ex(ROHF)','|','Conv','|'
|
||||
write(*,*)'----------------------------------------------------------'
|
||||
write(*,*)'-----------------------------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X)') &
|
||||
'|','#','|','E(ROHF)','|','EJ(ROHF)','|','EK(ROHF)','|','Conv','|'
|
||||
write(*,*)'-----------------------------------------------------------------------------'
|
||||
|
||||
do while(Conv > thresh .and. nSCF < maxSCF)
|
||||
|
||||
@ -139,15 +140,43 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
|
||||
! Check convergence
|
||||
|
||||
err(:,:) = matmul(Ftot(:,:),matmul(Ptot(:,:),S(:,:))) - matmul(matmul(S(:,:),Ptot(:,:)),Ftot(:,:))
|
||||
err(:,:) = matmul(Ftot,matmul(Ptot,S)) - matmul(matmul(S,Ptot),Ftot)
|
||||
if(nSCF > 1) Conv = maxval(abs(err(:,:)))
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
do ispin=1,nspin
|
||||
ET(ispin) = trace_matrix(nBas,matmul(P(:,:,ispin),T(:,:)))
|
||||
end do
|
||||
|
||||
! Potential energy
|
||||
|
||||
do ispin=1,nspin
|
||||
EV(ispin) = trace_matrix(nBas,matmul(P(:,:,ispin),V(:,:)))
|
||||
end do
|
||||
|
||||
! Hartree energy
|
||||
|
||||
EJ(1) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,1)))
|
||||
EJ(2) = trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2)))
|
||||
EJ(3) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,2)))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
do ispin=1,nspin
|
||||
EK(ispin) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,ispin),K(:,:,ispin)))
|
||||
end do
|
||||
|
||||
! Total energy
|
||||
|
||||
EROHF = sum(ET) + sum(EV) + sum(EJ) + sum(EK)
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
if(max_diis > 1) then
|
||||
|
||||
n_diis = min(n_diis+1,max_diis)
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis(:,1:n_diis),F_diis(:,1:n_diis),err,Ftot)
|
||||
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis,F_diis,err,Ftot)
|
||||
|
||||
end if
|
||||
|
||||
@ -168,7 +197,7 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
! Diagonalize Fock matrix to get eigenvectors and eigenvalues
|
||||
|
||||
cp(:,:) = Fp(:,:)
|
||||
call diagonalize_matrix(nBas,cp,e)
|
||||
call diagonalize_matrix(nBas,cp,eHF)
|
||||
|
||||
! Back-transform eigenvectors in non-orthogonal basis
|
||||
|
||||
@ -181,45 +210,13 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
end do
|
||||
Ptot(:,:) = P(:,:,1) + P(:,:,2)
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute ROHF energy
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
do ispin=1,nspin
|
||||
ET(ispin) = trace_matrix(nBas,matmul(P(:,:,ispin),T(:,:)))
|
||||
end do
|
||||
|
||||
! Potential energy
|
||||
|
||||
do ispin=1,nspin
|
||||
EV(ispin) = trace_matrix(nBas,matmul(P(:,:,ispin),V(:,:)))
|
||||
end do
|
||||
|
||||
! Hartree energy
|
||||
|
||||
EJ(1) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,1)))
|
||||
EJ(2) = trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2)))
|
||||
EJ(3) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,2)))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
do ispin=1,nspin
|
||||
Ex(ispin) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,ispin),K(:,:,ispin)))
|
||||
end do
|
||||
|
||||
! Total energy
|
||||
|
||||
EHF = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:))
|
||||
|
||||
! Dump results
|
||||
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X)') &
|
||||
'|',nSCF,'|',EHF + ENuc,'|',sum(Ex(:)),'|',Conv,'|'
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,E10.2,1X,A1,1X)') &
|
||||
'|',nSCF,'|',EROHF + ENuc,'|',sum(EJ),'|',sum(EK),'|',Conv,'|'
|
||||
|
||||
end do
|
||||
write(*,*)'----------------------------------------------------------'
|
||||
write(*,*)'-----------------------------------------------------------------------------'
|
||||
!------------------------------------------------------------------------
|
||||
! End of SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
@ -241,13 +238,13 @@ subroutine ROHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZN
|
||||
! Compute final UHF energy
|
||||
|
||||
call dipole_moment(nBas,Ptot,nNuc,ZNuc,rNuc,dipole_int,dipole)
|
||||
call print_ROHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EHF,dipole)
|
||||
call print_ROHF(nBas,nO,eHF,c,ENuc,ET,EV,EJ,EK,EROHF,dipole)
|
||||
|
||||
! Print test values
|
||||
|
||||
if(dotest) then
|
||||
|
||||
call dump_test_value('R','ROHF energy',EHF)
|
||||
call dump_test_value('R','ROHF energy',EROHF)
|
||||
|
||||
end if
|
||||
|
||||
|
||||
@ -42,7 +42,7 @@ subroutine UHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
double precision :: ET(nspin)
|
||||
double precision :: EV(nspin)
|
||||
double precision :: EJ(nsp)
|
||||
double precision :: Ex(nspin)
|
||||
double precision :: EK(nspin)
|
||||
double precision :: dipole(ncart)
|
||||
|
||||
double precision,allocatable :: cp(:,:,:)
|
||||
@ -91,22 +91,22 @@ subroutine UHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
|
||||
! Initialization
|
||||
|
||||
nSCF = 0
|
||||
Conv = 1d0
|
||||
|
||||
n_diis = 0
|
||||
F_diis(:,:,:) = 0d0
|
||||
err_diis(:,:,:) = 0d0
|
||||
|
||||
nSCF = 0
|
||||
Conv = 1d0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Main SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'----------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X)') &
|
||||
'|','#','|','E(UHF)','|','Ex(UHF)','|','Conv','|'
|
||||
write(*,*)'----------------------------------------------------------'
|
||||
write(*,*)'-----------------------------------------------------------------------------'
|
||||
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X)') &
|
||||
'|','#','|','E(UHF)','|','EJ(UHF)','|','EK(UHF)','|','Conv','|'
|
||||
write(*,*)'-----------------------------------------------------------------------------'
|
||||
|
||||
do while(Conv > thresh .and. nSCF < maxSCF)
|
||||
|
||||
@ -140,6 +140,34 @@ subroutine UHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
|
||||
if(nSCF > 1) Conv = maxval(abs(err(:,:,:)))
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
do ispin=1,nspin
|
||||
ET(ispin) = trace_matrix(nBas,matmul(P(:,:,ispin),T(:,:)))
|
||||
end do
|
||||
|
||||
! Potential energy
|
||||
|
||||
do ispin=1,nspin
|
||||
EV(ispin) = trace_matrix(nBas,matmul(P(:,:,ispin),V(:,:)))
|
||||
end do
|
||||
|
||||
! Hartree energy
|
||||
|
||||
EJ(1) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,1)))
|
||||
EJ(2) = trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2)))
|
||||
EJ(3) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,2)))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
do ispin=1,nspin
|
||||
EK(ispin) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,ispin),K(:,:,ispin)))
|
||||
end do
|
||||
|
||||
! Total energy
|
||||
|
||||
EUHF = sum(ET) + sum(EV) + sum(EJ) + sum(EK)
|
||||
|
||||
! DIIS extrapolation
|
||||
|
||||
if(max_diis > 1) then
|
||||
@ -191,45 +219,13 @@ subroutine UHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
P(:,:,ispin) = matmul(c(:,1:nO(ispin),ispin),transpose(c(:,1:nO(ispin),ispin)))
|
||||
end do
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute UHF energy
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
! Kinetic energy
|
||||
|
||||
do ispin=1,nspin
|
||||
ET(ispin) = trace_matrix(nBas,matmul(P(:,:,ispin),T(:,:)))
|
||||
end do
|
||||
|
||||
! Potential energy
|
||||
|
||||
do ispin=1,nspin
|
||||
EV(ispin) = trace_matrix(nBas,matmul(P(:,:,ispin),V(:,:)))
|
||||
end do
|
||||
|
||||
! Hartree energy
|
||||
|
||||
EJ(1) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,1)))
|
||||
EJ(2) = trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2)))
|
||||
EJ(3) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,2)))
|
||||
|
||||
! Exchange energy
|
||||
|
||||
do ispin=1,nspin
|
||||
Ex(ispin) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,ispin),K(:,:,ispin)))
|
||||
end do
|
||||
|
||||
! Total energy
|
||||
|
||||
EUHF = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:))
|
||||
|
||||
! Dump results
|
||||
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X)') &
|
||||
'|',nSCF,'|',EUHF + ENuc,'|',sum(Ex(:)),'|',Conv,'|'
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,E10.2,1X,A1,1X)') &
|
||||
'|',nSCF,'|',EUHF + ENuc,'|',sum(EJ),'|',sum(EK),'|',Conv,'|'
|
||||
|
||||
end do
|
||||
write(*,*)'----------------------------------------------------------'
|
||||
write(*,*)'-----------------------------------------------------------------------------'
|
||||
!------------------------------------------------------------------------
|
||||
! End of SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
@ -251,7 +247,7 @@ subroutine UHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
|
||||
! Compute final UHF energy
|
||||
|
||||
call dipole_moment(nBas,P(:,:,1)+P(:,:,2),nNuc,ZNuc,rNuc,dipole_int,dipole)
|
||||
call print_UHF(nBas,nO,S,eHF,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
|
||||
call print_UHF(nBas,nO,S,eHF,c,ENuc,ET,EV,EJ,EK,EUHF,dipole)
|
||||
|
||||
|
||||
! Print test values
|
||||
|
||||
@ -24,6 +24,8 @@ subroutine print_ROHF(nBas,nO,eHF,c,ENuc,ET,EV,EJ,Ex,EROHF,dipole)
|
||||
double precision :: Gap(nspin)
|
||||
double precision :: S,S2
|
||||
|
||||
logical :: dump_orb = .false.
|
||||
|
||||
! HOMO and LUMO
|
||||
|
||||
do ispin=1,nspin
|
||||
@ -96,11 +98,13 @@ subroutine print_ROHF(nBas,nO,eHF,c,ENuc,ET,EV,EJ,Ex,EROHF,dipole)
|
||||
|
||||
! Print results
|
||||
|
||||
write(*,'(A50)') '-----------------------------------------'
|
||||
write(*,'(A50)') 'ROHF orbital coefficients '
|
||||
write(*,'(A50)') '-----------------------------------------'
|
||||
call matout(nBas,nBas,c)
|
||||
write(*,*)
|
||||
if(dump_orb) then
|
||||
write(*,'(A50)') '-----------------------------------------'
|
||||
write(*,'(A50)') 'ROHF orbital coefficients '
|
||||
write(*,'(A50)') '-----------------------------------------'
|
||||
call matout(nBas,nBas,c)
|
||||
write(*,*)
|
||||
end if
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
write(*,'(A50)') ' ROHF orbital energies (au) '
|
||||
write(*,'(A50)') '---------------------------------------'
|
||||
|
||||
@ -9,11 +9,15 @@ subroutine DIIS_extrapolation(rcond,n_err,n_e,n_diis,error,e,error_in,e_inout)
|
||||
! Input variables
|
||||
|
||||
integer,intent(in) :: n_err,n_e
|
||||
double precision,intent(in) :: error_in(n_err),error(n_err,n_diis),e(n_e,n_diis)
|
||||
double precision,intent(in) :: error_in(n_err)
|
||||
double precision,intent(in) :: error(n_err,n_diis)
|
||||
double precision,intent(in) :: e(n_e,n_diis)
|
||||
|
||||
! Local variables
|
||||
|
||||
double precision,allocatable :: A(:,:),b(:),w(:)
|
||||
double precision,allocatable :: A(:,:)
|
||||
double precision,allocatable :: b(:)
|
||||
double precision,allocatable :: w(:)
|
||||
|
||||
! Output variables
|
||||
|
||||
@ -45,7 +49,6 @@ subroutine DIIS_extrapolation(rcond,n_err,n_e,n_diis,error,e,error_in,e_inout)
|
||||
|
||||
! Solve linear system
|
||||
|
||||
! call easy_linear_solve(n_diis+1,A,b,w)
|
||||
call linear_solve(n_diis+1,A,b,w,rcond)
|
||||
|
||||
! Extrapolate
|
||||
|
||||
@ -175,7 +175,16 @@ subroutine linear_solve(N,A,b,x,rcond)
|
||||
integer,allocatable :: ipiv(:),iwork(:)
|
||||
double precision,allocatable :: AF(:,:),work(:)
|
||||
|
||||
lwork = 3*N
|
||||
! Find optimal size for temporary arrays
|
||||
|
||||
allocate(work(1))
|
||||
|
||||
lwork = -1
|
||||
call dsysvx('N','U',N,1,A,N,AF,N,ipiv,b,N,x,N,rcond,ferr,berr,work,lwork,iwork,info)
|
||||
lwork = int(work(1))
|
||||
|
||||
deallocate(work)
|
||||
|
||||
allocate(AF(N,N),ipiv(N),work(lwork),iwork(N))
|
||||
|
||||
call dsysvx('N','U',N,1,A,N,AF,N,ipiv,b,N,x,N,rcond,ferr,berr,work,lwork,iwork,info)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user