exp rot in UHF search as well

This commit is contained in:
Pierre-Francois Loos 2023-11-07 16:47:34 +01:00
parent b794290c96
commit 9fcd61c62e
5 changed files with 70 additions and 44 deletions

View File

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

View File

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

View File

@ -159,30 +159,30 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
step = 1d0
do mu=1,nBas
ia = 0
do i=nC+1,nO
kick = 0d0
do a=nO+1,nBas-nR
ia = ia + 1
kick = kick + AB(ia,eig)*c(mu,a)
end do
c(mu,i) = c(mu,i) + step*kick
end do
end do
! R(:,:) = 0d0
! ia = 0
! do i=nC+1,nO
! do a=nO+1,nBas-nR
! ia = ia + 1
! R(a,i) = +AB(ia,eig)
! R(i,a) = -AB(ia,eig)
! do mu=1,nBas
! ia = 0
! do i=nC+1,nO
! kick = 0d0
! do a=nO+1,nBas-nR
! ia = ia + 1
! kick = kick + AB(ia,eig)*c(mu,a)
! end do
! c(mu,i) = c(mu,i) + step*kick
! end do
! end do
! call matrix_exponential(nBas,R,ExpR)
! c = matmul(c,ExpR)
R(:,:) = 0d0
ia = 0
do i=nC+1,nO
do a=nO+1,nBas-nR
ia = ia + 1
R(a,i) = +AB(ia,eig)
R(i,a) = -AB(ia,eig)
end do
end do
call matrix_exponential(nBas,R,ExpR)
c = matmul(c,ExpR)
else

View File

@ -53,6 +53,8 @@ subroutine UHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
double precision,allocatable :: A_sc(:,:)
double precision,allocatable :: B_sc(:,:)
double precision,allocatable :: AB_sc(:,:)
double precision,allocatable :: R(:,:)
double precision,allocatable :: ExpR(:,:)
integer :: eig
double precision :: kick,step
@ -83,7 +85,7 @@ subroutine UHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
nS_sc = nS_aa + nS_bb
allocate(ERI_aaaa(nBas,nBas,nBas,nBas),ERI_aabb(nBas,nBas,nBas,nBas),ERI_bbbb(nBas,nBas,nBas,nBas))
allocate(Om_sc(nS_sc),A_sc(nS_sc,nS_sc),B_sc(nS_sc,nS_sc),AB_sc(nS_sc,nS_sc))
allocate(Om_sc(nS_sc),A_sc(nS_sc,nS_sc),B_sc(nS_sc,nS_sc),AB_sc(nS_sc,nS_sc),R(nBas,nBas),ExpR(nBas,nBas))
!------------------!
! Search algorithm !
@ -179,31 +181,57 @@ subroutine UHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
! Spin-up kick
do mu=1,nBas
ia = 0
do i=nC(1)+1,nO(1)
kick = 0d0
do a=nO(1)+1,nBas-nR(1)
ia = ia + 1
kick = kick + AB_sc(ia,eig)*c(mu,a,1)
end do
c(mu,i,1) = c(mu,i,1) + step*kick
! do mu=1,nBas
! ia = 0
! do i=nC(1)+1,nO(1)
! kick = 0d0
! do a=nO(1)+1,nBas-nR(1)
! ia = ia + 1
! kick = kick + AB_sc(ia,eig)*c(mu,a,1)
! end do
! c(mu,i,1) = c(mu,i,1) + step*kick
! end do
! end do
R(:,:) = 0d0
ia = 0
do i=nC(1)+1,nO(1)
do a=nO(1)+1,nBas-nR(1)
ia = ia + 1
R(a,i) = +AB_sc(ia,eig)
R(i,a) = -AB_sc(ia,eig)
end do
end do
call matrix_exponential(nBas,R,ExpR)
c(:,:,1) = matmul(c(:,:,1),ExpR)
! Spin-down kick
do mu=1,nBas
ia = nS_aa
do i=nC(2)+1,nO(2)
kick = 0d0
do a=nO(2)+1,nBas-nR(2)
ia = ia + 1
kick = kick + AB_sc(ia,eig)*c(mu,a,2)
end do
c(mu,i,2) = c(mu,i,2) + step*kick
! do mu=1,nBas
! ia = nS_aa
! do i=nC(2)+1,nO(2)
! kick = 0d0
! do a=nO(2)+1,nBas-nR(2)
! ia = ia + 1
! kick = kick + AB_sc(ia,eig)*c(mu,a,2)
! end do
! c(mu,i,2) = c(mu,i,2) + step*kick
! end do
! end do
R(:,:) = 0d0
ia = nS_aa
do i=nC(2)+1,nO(2)
do a=nO(2)+1,nBas-nR(2)
ia = ia + 1
R(a,i) = +AB_sc(ia,eig)
R(i,a) = -AB_sc(ia,eig)
end do
end do
call matrix_exponential(nBas,R,ExpR)
c(:,:,2) = matmul(c(:,:,2),ExpR)
else

View File

@ -92,12 +92,10 @@ subroutine matrix_exponential(N,A,ExpA)
W(:,:) = - matmul(A,A)
call diagonalize_matrix(N,W,tau)
call matout(N,1,tau)
! do i=1,N
! tau(i) = max(abs(tau(i)),1d-14)
! end do
tau(:) = sqrt(abs(tau(:)))
call matout(N,1,tau)
! Construct cos part