2020-03-22 15:20:42 +01:00
|
|
|
subroutine pCCD(maxSCF,thresh,max_diis,nBas,nO,nV,ERI,ENuc,ERHF,eHF)
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-21 22:50:43 +01:00
|
|
|
! pair CCD module
|
2019-10-15 23:13:00 +02:00
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
! Input variables
|
|
|
|
|
|
|
|
integer,intent(in) :: maxSCF
|
|
|
|
integer,intent(in) :: max_diis
|
|
|
|
double precision,intent(in) :: thresh
|
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
integer,intent(in) :: nBas,nO,nV
|
2019-10-15 23:13:00 +02:00
|
|
|
double precision,intent(in) :: ENuc,ERHF
|
|
|
|
double precision,intent(in) :: eHF(nBas)
|
|
|
|
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
|
|
|
|
|
|
|
! Local variables
|
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
integer :: i,j,a,b
|
|
|
|
|
2019-10-15 23:13:00 +02:00
|
|
|
integer :: nSCF
|
|
|
|
double precision :: Conv
|
|
|
|
double precision :: ECCD,EcCCD
|
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
double precision,allocatable :: delta_OOVV(:,:)
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
double precision,allocatable :: OOOO(:,:)
|
|
|
|
double precision,allocatable :: OOVV(:,:)
|
|
|
|
double precision,allocatable :: OVOV(:,:)
|
|
|
|
double precision,allocatable :: OVVO(:,:)
|
|
|
|
double precision,allocatable :: VVVV(:,:)
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
double precision,allocatable :: X(:,:)
|
|
|
|
double precision,allocatable :: Y(:,:)
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
double precision,allocatable :: r(:,:)
|
|
|
|
double precision,allocatable :: t(:,:)
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
double precision,external :: trace_matrix
|
|
|
|
|
2019-10-15 23:13:00 +02:00
|
|
|
! Hello world
|
|
|
|
|
|
|
|
write(*,*)
|
|
|
|
write(*,*)'**************************************'
|
2020-03-22 15:20:42 +01:00
|
|
|
write(*,*)'| pair CCD calculation |'
|
2019-10-15 23:13:00 +02:00
|
|
|
write(*,*)'**************************************'
|
|
|
|
write(*,*)
|
|
|
|
|
|
|
|
! Form energy denominator
|
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
allocate(delta_OOVV(nO,nV))
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
do i=1,nO
|
|
|
|
do a=1,nV
|
|
|
|
delta_OOVV(i,a) = 2d0*(eHF(nO+a) - eHF(i))
|
|
|
|
enddo
|
|
|
|
enddo
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
! Create integral batches
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
allocate(OOOO(nO,nO),OOVV(nO,nV),OVOV(nO,nV),OVVO(nO,nV),VVVV(nV,nV))
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
do i=1,nO
|
|
|
|
do j=1,nO
|
|
|
|
OOOO(i,j) = ERI(i,i,j,j)
|
|
|
|
end do
|
|
|
|
end do
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
do i=1,nO
|
|
|
|
do a=1,nV
|
|
|
|
OOVV(i,a) = ERI(i,i,nO+a,nO+a)
|
|
|
|
OVOV(i,a) = ERI(i,nO+a,i,nO+a)
|
|
|
|
OVVO(i,a) = ERI(i,nO+a,nO+a,i)
|
|
|
|
end do
|
|
|
|
end do
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
do a=1,nV
|
|
|
|
do b=1,nV
|
|
|
|
VVVV(a,b) = ERI(nO+a,nO+a,nO+b,nO+b)
|
|
|
|
end do
|
|
|
|
end do
|
2019-10-15 23:13:00 +02:00
|
|
|
|
|
|
|
! MP2 guess amplitudes
|
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
allocate(t(nO,nV))
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
t(:,:) = - OOVV(:,:)/delta_OOVV(:,:)
|
2019-10-15 23:13:00 +02:00
|
|
|
|
|
|
|
! Initialization
|
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
allocate(r(nO,nV),X(nV,nV),Y(nO,nO))
|
2019-10-15 23:13:00 +02:00
|
|
|
|
|
|
|
Conv = 1d0
|
|
|
|
nSCF = 0
|
|
|
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Main SCF loop
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
write(*,*)
|
|
|
|
write(*,*)'----------------------------------------------------'
|
2020-03-21 22:50:43 +01:00
|
|
|
write(*,*)'| pair CCD calculation |'
|
2019-10-15 23:13:00 +02:00
|
|
|
write(*,*)'----------------------------------------------------'
|
|
|
|
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
|
2020-03-21 22:50:43 +01:00
|
|
|
'|','#','|','E(pCCD)','|','Ec(pCCD)','|','Conv','|'
|
2019-10-15 23:13:00 +02:00
|
|
|
write(*,*)'----------------------------------------------------'
|
|
|
|
|
|
|
|
do while(Conv > thresh .and. nSCF < maxSCF)
|
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
! Increment
|
2019-10-15 23:13:00 +02:00
|
|
|
|
|
|
|
nSCF = nSCF + 1
|
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
! Form intermediate array
|
|
|
|
|
|
|
|
X(:,:) = matmul(transpose(OOVV(:,:)),t(:,:))
|
|
|
|
Y(:,:) = matmul(t(:,:),transpose(OOVV(:,:)))
|
|
|
|
|
|
|
|
! Compute residual
|
2020-03-21 22:50:43 +01:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
do i=1,nO
|
|
|
|
do a=1,nV
|
|
|
|
r(i,a) = - 2d0*(X(a,a) + Y(i,i))*t(i,a)
|
|
|
|
end do
|
|
|
|
end do
|
2020-03-21 22:50:43 +01:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
r(:,:) = r(:,:) + OOVV(:,:) + delta_OOVV(:,:)*t(:,:) &
|
|
|
|
- 2d0*(2d0*OVOV(:,:) - OVVO(:,:) - OOVV(:,:)*t(:,:))*t(:,:) &
|
|
|
|
+ matmul(t(:,:),transpose(VVVV(:,:))) &
|
|
|
|
+ matmul(transpose(OOOO(:,:)),t(:,:)) &
|
|
|
|
+ matmul(Y(:,:),t)
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
! Check convergence
|
2020-03-21 22:50:43 +01:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
Conv = maxval(abs(r(:,:)))
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
! Update amplitudes
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
t(:,:) = t(:,:) - r(:,:)/delta_OOVV(:,:)
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
! Compute correlation energy
|
2019-10-15 23:13:00 +02:00
|
|
|
|
2020-03-22 15:20:42 +01:00
|
|
|
EcCCD = trace_matrix(nO,matmul(t(:,:),transpose(OOVV(:,:))))
|
2019-10-15 23:13:00 +02:00
|
|
|
|
|
|
|
! Dump results
|
|
|
|
|
|
|
|
ECCD = ERHF + EcCCD
|
|
|
|
|
|
|
|
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
|
|
|
|
'|',nSCF,'|',ECCD+ENuc,'|',EcCCD,'|',Conv,'|'
|
|
|
|
|
|
|
|
enddo
|
|
|
|
write(*,*)'----------------------------------------------------'
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! End of SCF loop
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
|
|
|
! Did it actually converge?
|
|
|
|
|
|
|
|
if(nSCF == maxSCF) then
|
|
|
|
|
|
|
|
write(*,*)
|
|
|
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
|
|
|
write(*,*)' Convergence failed '
|
|
|
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
|
|
|
write(*,*)
|
|
|
|
|
|
|
|
stop
|
|
|
|
|
|
|
|
endif
|
|
|
|
|
2020-03-21 22:50:43 +01:00
|
|
|
end subroutine pCCD
|