mirror of
https://github.com/pfloos/quack
synced 2024-10-06 08:16:15 +02:00
saving work in pCCD
This commit is contained in:
Pierre-Francois Loos
parent
9910e6e889
commit
08bf6632df
@ -1,5 +1,5 @@
|
||||
subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, &
|
||||
maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,eHF,cHF)
|
||||
maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI_AO,ERI_MO,ENuc,ERHF,eHF,cHF)
|
||||
|
||||
! Coupled-cluster module
|
||||
|
||||
@ -34,7 +34,8 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
@ -47,7 +48,7 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(doCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call CCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call CCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
@ -64,7 +65,7 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
|
||||
call wall_time(start_CC)
|
||||
call DCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR, &
|
||||
ERI,ENuc,ERHF,eHF)
|
||||
ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
@ -82,7 +83,7 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(doCCSD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call CCSD(dotest,maxSCF,thresh,max_diis,doCCSDT,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call CCSD(dotest,maxSCF,thresh,max_diis,doCCSDT,nBas,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
@ -98,7 +99,7 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(dodrCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call drCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call drCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
@ -114,7 +115,7 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(dorCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call rCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call rCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
@ -130,7 +131,7 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(docrCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call crCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call crCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
@ -146,7 +147,7 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(dolCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call lCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
|
||||
call lCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
@ -162,7 +163,8 @@ subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,d
|
||||
if(dopCCD) then
|
||||
|
||||
call wall_time(start_CC)
|
||||
call pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,eHF,cHF)
|
||||
call pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI_AO,ENuc,ERHF,eHF,cHF)
|
||||
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
|
||||
291
src/CC/pCCD.f90
291
src/CC/pCCD.f90
@ -1,4 +1,4 @@
|
||||
subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,eHF,cHF)
|
||||
subroutine pCCD(dotest,maxIt,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI_AO,ENuc,ERHF,eHF,cHF)
|
||||
|
||||
! pair CCD module
|
||||
|
||||
@ -8,25 +8,32 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
|
||||
logical,intent(in) :: dotest
|
||||
|
||||
integer,intent(in) :: maxSCF
|
||||
integer,intent(in) :: maxIt
|
||||
integer,intent(in) :: max_diis
|
||||
double precision,intent(in) :: thresh
|
||||
|
||||
integer,intent(in) :: nBas,nC,nO,nV,nR
|
||||
double precision,intent(in) :: ENuc,ERHF
|
||||
integer,intent(in) :: nBas
|
||||
integer,intent(in) :: nC
|
||||
integer,intent(in) :: nO
|
||||
integer,intent(in) :: nV
|
||||
integer,intent(in) :: nR
|
||||
double precision,intent(in) :: ENuc
|
||||
double precision,intent(in) :: ERHF
|
||||
double precision,intent(in) :: eHF(nBas)
|
||||
double precision,intent(in) :: cHF(nBas,nBas)
|
||||
double precision,intent(in) :: Hc(nBas,nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
|
||||
integer :: p,q,r,s,t,u
|
||||
integer :: p,q,r,s,t,u,w
|
||||
integer :: pq,rs
|
||||
integer :: i,j,a,b
|
||||
|
||||
integer :: nSCF
|
||||
double precision :: Conv
|
||||
integer :: nItAmp
|
||||
integer :: nItOrb
|
||||
double precision :: CvgAmp
|
||||
double precision :: CvgOrb
|
||||
double precision :: ECC
|
||||
double precision :: EcCC
|
||||
|
||||
@ -56,14 +63,15 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
double precision :: tr_2rdm
|
||||
|
||||
double precision :: E1,E2
|
||||
double precision,allocatable :: h(:,:)
|
||||
double precision,allocatable :: c(:,:)
|
||||
double precision,allocatable :: h(:,:)
|
||||
double precision,allocatable :: ERI_MO(:,:,:,:)
|
||||
double precision,allocatable :: grad(:)
|
||||
double precision,allocatable :: tmp(:,:,:,:)
|
||||
double precision,allocatable :: hess(:,:)
|
||||
double precision,allocatable :: hessInv(:,:)
|
||||
double precision,allocatable :: kappa(:,:)
|
||||
double precision,allocatable :: ekappa(:,:)
|
||||
double precision,allocatable :: Kap(:,:)
|
||||
double precision,allocatable :: ExpKap(:,:)
|
||||
|
||||
integer :: O,V,N
|
||||
integer :: n_diis
|
||||
@ -77,9 +85,9 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
! Hello world
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'**************************************'
|
||||
write(*,*)'| pair CCD calculation |'
|
||||
write(*,*)'**************************************'
|
||||
write(*,*)'*******************************'
|
||||
write(*,*)'* Restricted pCCD Calculation *'
|
||||
write(*,*)'*******************************'
|
||||
write(*,*)
|
||||
|
||||
! Useful quantities
|
||||
@ -88,60 +96,76 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
V = nV - nR
|
||||
N = O + V
|
||||
|
||||
! Form energy denominator
|
||||
!------------------------------------!
|
||||
! Star Loop for orbital optimization !
|
||||
!------------------------------------!
|
||||
|
||||
allocate(ERI_MO(N,N,N,N))
|
||||
allocate(c(N,N),h(N,N))
|
||||
allocate(eO(O),eV(V),delta_OV(O,V))
|
||||
allocate(OOOO(O,O),OOVV(O,V),OVOV(O,V),OVVO(O,V),VVVV(V,V))
|
||||
|
||||
c(:,:) = cHF(nC+1:nBas-nR,nC+1:nBas-nR)
|
||||
|
||||
CvgOrb = 1d0
|
||||
nItOrb = 0
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)'| Orbital Optimization for pCCD |'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
|
||||
do while(CvgOrb > thresh .and. nItOrb < 1)
|
||||
|
||||
nItOrb = nItOrb + 1
|
||||
|
||||
! Transform integrals
|
||||
|
||||
h = matmul(transpose(c),matmul(Hc(nC+1:nBas-nR,nC+1:nBas-nR),c))
|
||||
call AOtoMO_ERI_RHF(N,c,ERI_AO(nC+1:nBas-nR,nC+1:nBas-nR,nC+1:nBas-nR,nC+1:nBas-nR),ERI_MO)
|
||||
|
||||
! Form energy denominator
|
||||
|
||||
eO(:) = eHF(nC+1:nO)
|
||||
eV(:) = eHF(nO+1:nBas-nR)
|
||||
|
||||
call form_delta_OV(nC,nO,nV,nR,eO,eV,delta_OV)
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
delta_OV(i,a) = eV(a) - eO(i)
|
||||
end do
|
||||
end do
|
||||
|
||||
! Create integral batches
|
||||
|
||||
allocate(OOOO(O,O),OOVV(O,V),OVOV(O,V),OVVO(O,V),VVVV(V,V))
|
||||
|
||||
do i=1,O
|
||||
do j=1,O
|
||||
OOOO(i,j) = ERI(nC+i,nC+i,nC+j,nC+j)
|
||||
OOOO(i,j) = ERI_MO(i,i,j,j)
|
||||
end do
|
||||
end do
|
||||
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
OOVV(i,a) = ERI(nC+i,nC+i,nO+a,nO+a)
|
||||
OVOV(i,a) = ERI(nC+i,nO+a,nC+i,nO+a)
|
||||
OVVO(i,a) = ERI(nC+i,nO+a,nO+a,nC+i)
|
||||
OOVV(i,a) = ERI_MO(i,i,O+a,O+a)
|
||||
OVOV(i,a) = ERI_MO(i,O+a,i,O+a)
|
||||
OVVO(i,a) = ERI_MO(i,O+a,O+a,i)
|
||||
end do
|
||||
end do
|
||||
|
||||
do a=1,V
|
||||
do b=1,V
|
||||
VVVV(a,b) = ERI(nO+a,nO+a,nO+b,nO+b)
|
||||
VVVV(a,b) = ERI_MO(O+a,O+a,O+b,O+b)
|
||||
end do
|
||||
end do
|
||||
|
||||
! Initialization
|
||||
|
||||
allocate(t2(O,V),r2(O,V),yO(O,O),yV(V,V))
|
||||
|
||||
! Memory allocation for DIIS
|
||||
!----------------------------!
|
||||
! Star Loop for t amplitudes !
|
||||
!----------------------------!
|
||||
|
||||
allocate(t2(O,V),r2(O,V),yO(O,O))
|
||||
allocate(err_diis(O*V,max_diis),t2_diis(O*V,max_diis))
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Start orbital optimization
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
allocate(c(N,N))
|
||||
c(:,:) = cHF(:,:)
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute t ampltiudes
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
Conv = 1d0
|
||||
nSCF = 0
|
||||
CvgAmp = 1d0
|
||||
nItAmp = 0
|
||||
ECC = ERHF
|
||||
EcCC = 0d0
|
||||
|
||||
@ -150,9 +174,6 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
t2_diis(:,:) = 0d0
|
||||
err_diis(:,:) = 0d0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Main SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
write(*,*)
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)'| pCCD calculation: t amplitudes |'
|
||||
@ -161,11 +182,11 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
'|','#','|','E(pCCD)','|','Ec(pCCD)','|','Conv','|'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
|
||||
do while(Conv > thresh .and. nSCF < maxSCF)
|
||||
do while(CvgAmp > thresh .and. nItAmp < maxIt)
|
||||
|
||||
! Increment
|
||||
|
||||
nSCF = nSCF + 1
|
||||
nItAmp = nItAmp + 1
|
||||
|
||||
! Form intermediate array
|
||||
|
||||
@ -173,7 +194,6 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
|
||||
! Compute residual
|
||||
|
||||
|
||||
r2(:,:) = OOVV(:,:) + 2d0*delta_OV(:,:)*t2(:,:) &
|
||||
- 2d0*(2d0*OVOV(:,:) - OVVO(:,:) - OOVV(:,:)*t2(:,:))*t2(:,:)
|
||||
|
||||
@ -193,7 +213,7 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
|
||||
! Check convergence
|
||||
|
||||
Conv = maxval(abs(r2(:,:)))
|
||||
CvgAmp = maxval(abs(r2(:,:)))
|
||||
|
||||
! Update amplitudes
|
||||
|
||||
@ -201,7 +221,12 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
|
||||
! Compute correlation energy
|
||||
|
||||
EcCC = trace_matrix(V,matmul(transpose(OOVV),t2))
|
||||
EcCC = 0d0
|
||||
do i=1,O
|
||||
do a=1,V
|
||||
EcCC = EcCC + OOVV(i,a)*t2(i,a)
|
||||
end do
|
||||
end do
|
||||
|
||||
! Dump results
|
||||
|
||||
@ -217,53 +242,45 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
end if
|
||||
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
|
||||
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
|
||||
'|',nItAmp,'|',ECC+ENuc,'|',EcCC,'|',CvgAmp,'|'
|
||||
|
||||
end do
|
||||
write(*,*)'----------------------------------------------------'
|
||||
!------------------------------------------------------------------------
|
||||
! End of SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
!---------------------------!
|
||||
! End Loop for t amplitudes !
|
||||
!---------------------------!
|
||||
|
||||
deallocate(r2,yO)
|
||||
deallocate(err_diis,t2_diis)
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nSCF == maxSCF) then
|
||||
if(nItAmp == maxIt) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)' Convergence failed for t ampitudes '
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)'! Convergence failed for t ampitudes !'
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(err_diis,t2_diis)
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(z2(O,V))
|
||||
|
||||
! Memory allocation for DIIS
|
||||
!-----------------------------!
|
||||
! Start Loop for z amplitudes !
|
||||
!-----------------------------!
|
||||
|
||||
allocate(z2(O,V),r2(O,V),yO(O,O),yV(V,V))
|
||||
allocate(err_diis(O*V,max_diis),z2_diis(O*V,max_diis))
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Compute z ampltiudes
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
Conv = 1d0
|
||||
nSCF = 0
|
||||
CvgAmp = 1d0
|
||||
nItAmp = 0
|
||||
|
||||
n_diis = 0
|
||||
z2_diis(:,:) = 0d0
|
||||
err_diis(:,:) = 0d0
|
||||
|
||||
!------------------------------------------------------------------------
|
||||
! Main SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
write(*,*)
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)'| pCCD calculation: z amplitudes |'
|
||||
@ -272,11 +289,11 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
'|','#','|','E(pCCD)','|','Ec(pCCD)','|','Conv','|'
|
||||
write(*,*)'----------------------------------------------------'
|
||||
|
||||
do while(Conv > thresh .and. nSCF < maxSCF)
|
||||
do while(CvgAmp > thresh .and. nItAmp < maxIt)
|
||||
|
||||
! Increment
|
||||
|
||||
nSCF = nSCF + 1
|
||||
nItAmp = nItAmp + 1
|
||||
|
||||
! Form intermediate array
|
||||
|
||||
@ -306,7 +323,7 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
|
||||
! Check convergence
|
||||
|
||||
Conv = maxval(abs(r2(:,:)))
|
||||
CvgAmp = maxval(abs(r2(:,:)))
|
||||
|
||||
! Update amplitudes
|
||||
|
||||
@ -322,36 +339,37 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
end if
|
||||
|
||||
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
|
||||
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
|
||||
'|',nItAmp,'|',ECC+ENuc,'|',EcCC,'|',CvgAmp,'|'
|
||||
|
||||
end do
|
||||
write(*,*)'----------------------------------------------------'
|
||||
write(*,*)
|
||||
!------------------------------------------------------------------------
|
||||
! End of SCF loop
|
||||
!------------------------------------------------------------------------
|
||||
|
||||
!---------------------------!
|
||||
! End Loop for z ampltiudes !
|
||||
!---------------------------!
|
||||
|
||||
deallocate(r2,yO,yV)
|
||||
deallocate(err_diis,z2_diis)
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nSCF == maxSCF) then
|
||||
if(nItAmp == maxIt) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)' Convergence failed '
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)'! Convergence failed for z ampltiudes !'
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Deallocate memory
|
||||
|
||||
deallocate(err_diis,z2_diis,r2)
|
||||
|
||||
!--------------------------!
|
||||
! Compute density matrices !
|
||||
!--------------------------!
|
||||
|
||||
allocate(rdm1(N,N),rdm2(N,N,N,N))
|
||||
allocate(xOO(O,O),xVV(V,V),xOV(O,V))
|
||||
|
||||
xOO(:,:) = matmul(t2,transpose(z2))
|
||||
@ -360,8 +378,6 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
|
||||
! Form 1RDM
|
||||
|
||||
allocate(rdm1(N,N))
|
||||
|
||||
rdm1(:,:) = 0d0
|
||||
|
||||
do i=1,O
|
||||
@ -386,8 +402,6 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
|
||||
! Form 2RM
|
||||
|
||||
allocate(rdm2(N,N,N,N))
|
||||
|
||||
rdm2(:,:,:,:) = 0d0
|
||||
|
||||
! iijj
|
||||
@ -494,10 +508,10 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
! write(*,*) '2RDM is not diagonal at the pCCD level:'
|
||||
! call matout(N**2,N**2,rdm2)
|
||||
|
||||
! Compute electronic energy
|
||||
deallocate(xOO,xVV,xOV)
|
||||
deallocate(t2,z2)
|
||||
|
||||
allocate(h(N,N))
|
||||
h = matmul(transpose(cHF),matmul(Hc,cHF))
|
||||
! Compute electronic energy
|
||||
|
||||
E1 = 0d0
|
||||
E2 = 0d0
|
||||
@ -507,7 +521,7 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
E1 = E1 + rdm1(p,q)*h(p,q)
|
||||
do r=1,N
|
||||
do s=1,N
|
||||
E2 = E2 + rdm2(p,q,r,s)*ERI(p,q,r,s)
|
||||
E2 = E2 + rdm2(p,q,r,s)*ERI_MO(p,q,r,s)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
@ -521,7 +535,9 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
write(*,'(A25,F16.10)') ' Total energy = ',E1 + E2 + ENuc
|
||||
write(*,*)
|
||||
|
||||
! Compute gradient
|
||||
!--------------------------!
|
||||
! Compute orbital gradient !
|
||||
!--------------------------!
|
||||
|
||||
allocate(grad(N**2))
|
||||
|
||||
@ -540,7 +556,7 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
do r=1,N
|
||||
do s=1,N
|
||||
do t=1,N
|
||||
grad(pq) = grad(pq) + (ERI(r,s,p,t)*rdm2(r,s,q,t) - ERI(q,t,r,s)*rdm2(p,t,r,s))
|
||||
grad(pq) = grad(pq) + (ERI_MO(r,s,p,t)*rdm2(r,s,q,t) - ERI_MO(q,t,r,s)*rdm2(p,t,r,s))
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
@ -552,13 +568,16 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
call matout(N,N,grad)
|
||||
write(*,*)
|
||||
|
||||
! Convergence
|
||||
! Check convergence of orbital optimization
|
||||
|
||||
Conv = maxval(abs(grad))
|
||||
write(*,*) ' Convergence of orbtial gradient = ',Conv
|
||||
CvgOrb = maxval(abs(grad))
|
||||
write(*,*) ' Iteration',nItOrb,'for pCCD orbital optimization'
|
||||
write(*,*) ' Convergence of orbital gradient = ',CvgOrb
|
||||
write(*,*)
|
||||
|
||||
! Compute Hessian
|
||||
!-------------------------!
|
||||
! Compute orbital Hessian !
|
||||
!-------------------------!
|
||||
|
||||
allocate(hess(N**2,N**2),tmp(N,N,N,N))
|
||||
|
||||
@ -581,9 +600,9 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
end do
|
||||
|
||||
do u=1,N
|
||||
do v=1,N
|
||||
do w=1,N
|
||||
|
||||
tmp(p,q,r,s) = tmp(p,q,r,s) + ERI(u,v,p,r)*rdm2(u,v,q,s) + ERI(q,s,u,v)*rdm2(p,r,u,v)
|
||||
tmp(p,q,r,s) = tmp(p,q,r,s) + ERI_MO(u,w,p,r)*rdm2(u,w,q,s) + ERI_MO(q,s,u,w)*rdm2(p,r,u,w)
|
||||
|
||||
end do
|
||||
end do
|
||||
@ -592,19 +611,19 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
do u=1,N
|
||||
|
||||
tmp(p,q,r,s) = tmp(p,q,r,s) - ( &
|
||||
ERI(s,t,p,u)*rdm2(r,t,q,u) + ERI(t,s,p,u)*rdm2(t,r,q,u) &
|
||||
+ ERI(q,u,r,t)*rdm2(p,u,s,t) + ERI(q,u,t,r)*rdm2(p,u,t,s) )
|
||||
ERI_MO(s,t,p,u)*rdm2(r,t,q,u) + ERI_MO(t,s,p,u)*rdm2(t,r,q,u) &
|
||||
+ ERI_MO(q,u,r,t)*rdm2(p,u,s,t) + ERI_MO(q,u,t,r)*rdm2(p,u,t,s) )
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
do t=1,N
|
||||
do u=1,N
|
||||
do v=1,N
|
||||
do w=1,N
|
||||
|
||||
tmp(p,q,r,s) = tmp(p,q,r,s) + 0.5d0*( &
|
||||
Kronecker_delta(q,r)*(ERI(u,v,p,t)*rdm2(u,v,s,t) + ERI(s,t,u,v)*rdm2(p,t,u,v)) &
|
||||
+ Kronecker_delta(p,s)*(ERI(q,t,u,v)*rdm2(r,t,u,v) + ERI(u,v,r,t)*rdm2(u,v,q,t)) )
|
||||
Kronecker_delta(q,r)*(ERI_MO(u,w,p,t)*rdm2(u,w,s,t) + ERI_MO(s,t,u,w)*rdm2(p,t,u,w)) &
|
||||
+ Kronecker_delta(p,s)*(ERI_MO(q,t,u,w)*rdm2(r,t,u,w) + ERI_MO(u,w,r,t)*rdm2(u,w,q,t)) )
|
||||
|
||||
end do
|
||||
end do
|
||||
@ -631,7 +650,7 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
rs = rs + 1
|
||||
|
||||
hess(pq,rs) = tmp(p,r,q,s) - tmp(r,p,q,s) - tmp(p,r,s,q) + tmp(r,p,s,q)
|
||||
! hess(pq,rs) = tmp(p,q,r,s) - tmp(q,p,r,s) - tmp(p,q,s,r) + tmp(q,p,s,r)
|
||||
!! hess(pq,rs) = tmp(p,q,r,s) - tmp(q,p,r,s) - tmp(p,q,s,r) + tmp(q,p,s,r)
|
||||
|
||||
end do
|
||||
end do
|
||||
@ -639,21 +658,17 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
end do
|
||||
end do
|
||||
|
||||
call matout(N**2,N**2,hess)
|
||||
|
||||
! allocate(eig(N**2))
|
||||
|
||||
! call diagonalize_matrix(N**2,hess,eig)
|
||||
|
||||
! call vecout(N**2,eig)
|
||||
deallocate(rdm1,rdm2,tmp)
|
||||
|
||||
allocate(hessInv(N**2,N**2))
|
||||
|
||||
call inverse_matrix(N**2,hess,hessInv)
|
||||
|
||||
allocate(kappa(N,N),ekappa(N,N))
|
||||
deallocate(hess)
|
||||
|
||||
kappa(:,:) = 0d0
|
||||
allocate(Kap(N,N))
|
||||
|
||||
Kap(:,:) = 0d0
|
||||
|
||||
pq = 0
|
||||
do p=1,N
|
||||
@ -667,7 +682,7 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
|
||||
rs = rs + 1
|
||||
|
||||
kappa(p,q) = kappa(p,q) + hessInv(pq,rs)*grad(rs)
|
||||
Kap(p,q) = Kap(p,q) - hessInv(pq,rs)*grad(rs)
|
||||
|
||||
end do
|
||||
end do
|
||||
@ -675,26 +690,50 @@ subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,Hc,ERI,ENuc,ERHF,
|
||||
end do
|
||||
end do
|
||||
|
||||
deallocate(hessInv,grad)
|
||||
|
||||
write(*,*) 'kappa'
|
||||
call matout(N,N,kappa)
|
||||
call matout(N,N,Kap)
|
||||
write(*,*)
|
||||
|
||||
call matrix_exponential(N,kappa,ekappa)
|
||||
allocate(ExpKap(N,N))
|
||||
call matrix_exponential(N,Kap,ExpKap)
|
||||
deallocate(Kap)
|
||||
|
||||
write(*,*) 'e^kappa'
|
||||
call matout(N,N,ekappa)
|
||||
call matout(N,N,ExpKap)
|
||||
write(*,*)
|
||||
|
||||
write(*,*) 'Old orbitals'
|
||||
call matout(N,N,c)
|
||||
write(*,*)
|
||||
|
||||
c = matmul(c,ekappa)
|
||||
c = matmul(c,ExpKap)
|
||||
deallocate(ExpKap)
|
||||
|
||||
write(*,*) 'Rotated orbitals'
|
||||
call matout(N,N,c)
|
||||
write(*,*)
|
||||
|
||||
end do
|
||||
|
||||
!-----------------------------------!
|
||||
! End Loop for orbital optimization !
|
||||
!-----------------------------------!
|
||||
|
||||
! Did it actually converge?
|
||||
|
||||
if(nItOrb == maxIt) then
|
||||
|
||||
write(*,*)
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
write(*,*)'! Convergence failed for orbital optimization !'
|
||||
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
||||
|
||||
stop
|
||||
|
||||
end if
|
||||
|
||||
! Testing zone
|
||||
|
||||
if(dotest) then
|
||||
|
||||
@ -228,7 +228,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
|
||||
|
||||
call wall_time(start_CC)
|
||||
call RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, &
|
||||
maxSCF_CC,thresh_CC,max_diis_CC,nBas,nC,nO,nV,nR,Hc,ERI_MO,ENuc,ERHF,eHF,cHF)
|
||||
maxSCF_CC,thresh_CC,max_diis_CC,nBas,nC,nO,nV,nR,Hc,ERI_AO,ERI_MO,ENuc,ERHF,eHF,cHF)
|
||||
call wall_time(end_CC)
|
||||
|
||||
t_CC = end_CC - start_CC
|
||||
|
||||
Loading…
Reference in New Issue
Block a user