10
1
mirror of https://github.com/pfloos/quack synced 2024-12-25 05:43:41 +01:00
QuAcK/src/CC/drCCD.f90

199 lines
5.3 KiB
Fortran
Raw Normal View History

2020-03-26 16:57:46 +01:00
subroutine drCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
2019-10-15 23:13:00 +02:00
2020-03-21 22:50:43 +01:00
! Direct ring 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-26 16:57:46 +01:00
integer,intent(in) :: nBasin
integer,intent(in) :: nCin
integer,intent(in) :: nOin
integer,intent(in) :: nVin
integer,intent(in) :: nRin
2019-10-15 23:13:00 +02:00
double precision,intent(in) :: ENuc,ERHF
2020-03-26 16:57:46 +01:00
double precision,intent(in) :: eHF(nBasin)
double precision,intent(in) :: ERI(nBasin,nBasin,nBasin,nBasin)
2019-10-15 23:13:00 +02:00
! Local variables
2020-03-26 16:57:46 +01:00
integer :: nBas
integer :: nC
2019-10-15 23:13:00 +02:00
integer :: nO
integer :: nV
2020-03-26 16:57:46 +01:00
integer :: nR
2019-10-15 23:13:00 +02:00
integer :: nSCF
double precision :: Conv
2020-03-26 16:57:46 +01:00
double precision :: EcMP2
2019-10-15 23:13:00 +02:00
double precision :: ECCD,EcCCD
double precision,allocatable :: seHF(:)
double precision,allocatable :: sERI(:,:,:,:)
double precision,allocatable :: eO(:)
double precision,allocatable :: eV(:)
double precision,allocatable :: delta_OOVV(:,:,:,:)
double precision,allocatable :: OOVV(:,:,:,:)
double precision,allocatable :: OVVO(:,:,:,:)
double precision,allocatable :: r2(:,:,:,:)
double precision,allocatable :: t2(:,:,:,:)
2020-03-22 23:01:36 +01:00
integer :: n_diis
double precision :: rcond
double precision,allocatable :: error_diis(:,:)
double precision,allocatable :: t_diis(:,:)
2019-10-15 23:13:00 +02:00
! Hello world
write(*,*)
write(*,*)'**************************************'
2020-03-21 22:50:43 +01:00
write(*,*)'| direct ring CCD calculation |'
2019-10-15 23:13:00 +02:00
write(*,*)'**************************************'
write(*,*)
! Spatial to spin orbitals
2020-03-26 16:57:46 +01:00
nBas = 2*nBasin
nC = 2*nCin
nO = 2*nOin
nV = 2*nVin
nR = 2*nRin
2019-10-15 23:13:00 +02:00
2020-03-26 16:57:46 +01:00
allocate(seHF(nBas),sERI(nBas,nBas,nBas,nBas))
2019-10-15 23:13:00 +02:00
2020-03-26 16:57:46 +01:00
call spatial_to_spin_MO_energy(nBasin,eHF,nBas,seHF)
call spatial_to_spin_ERI(nBasin,ERI,nBas,sERI)
2019-10-15 23:13:00 +02:00
! Form energy denominator
allocate(eO(nO),eV(nV))
allocate(delta_OOVV(nO,nO,nV,nV))
eO(:) = seHF(1:nO)
2020-03-26 16:57:46 +01:00
eV(:) = seHF(nO+1:nBas)
2019-10-15 23:13:00 +02:00
2020-03-26 16:57:46 +01:00
call form_delta_OOVV(nC,nO,nV,nR,eO,eV,delta_OOVV)
2019-10-15 23:13:00 +02:00
deallocate(seHF)
! Create integral batches
2021-11-10 14:47:26 +01:00
allocate(OOVV(nO,nO,nV,nV),OVVO(nO,nV,nV,nO))
2019-10-15 23:13:00 +02:00
2020-03-26 16:57:46 +01:00
OOVV(:,:,:,:) = sERI( 1:nO , 1:nO ,nO+1:nBas,nO+1:nBas)
OVVO(:,:,:,:) = sERI( 1:nO ,nO+1:nBas,nO+1:nBas, 1:nO )
2019-10-15 23:13:00 +02:00
2020-03-21 22:50:43 +01:00
deallocate(sERI)
2019-10-15 23:13:00 +02:00
! MP2 guess amplitudes
allocate(t2(nO,nO,nV,nV))
t2(:,:,:,:) = -OOVV(:,:,:,:)/delta_OOVV(:,:,:,:)
2020-03-26 16:57:46 +01:00
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcMP2)
2019-10-15 23:13:00 +02:00
2020-03-22 23:01:36 +01:00
! Memory allocation for DIIS
allocate(error_diis(nO*nO*nV*nV,max_diis),t_diis(nO*nO*nV*nV,max_diis))
2019-10-15 23:13:00 +02:00
! Initialization
2020-03-26 16:57:46 +01:00
allocate(r2(nO,nO,nV,nV))
2019-10-15 23:13:00 +02:00
Conv = 1d0
nSCF = 0
2020-03-22 23:01:36 +01:00
n_diis = 0
t_diis(:,:) = 0d0
error_diis(:,:) = 0d0
2019-10-15 23:13:00 +02:00
!------------------------------------------------------------------------
! Main SCF loop
!------------------------------------------------------------------------
write(*,*)
write(*,*)'----------------------------------------------------'
2020-03-21 22:50:43 +01:00
write(*,*)'| direct ring 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)') &
'|','#','|','E(CCD)','|','Ec(CCD)','|','Conv','|'
write(*,*)'----------------------------------------------------'
do while(Conv > thresh .and. nSCF < maxSCF)
! Increment
nSCF = nSCF + 1
! Compute residual
2021-11-10 14:47:26 +01:00
call form_ring_r(nC,nO,nV,nR,OVVO,OOVV,t2,r2)
2019-10-15 23:13:00 +02:00
r2(:,:,:,:) = OOVV(:,:,:,:) + delta_OOVV(:,:,:,:)*t2(:,:,:,:) + r2(:,:,:,:)
! Check convergence
2020-03-26 16:57:46 +01:00
Conv = maxval(abs(r2(nC+1:nO,nC+1:nO,1:nV-nR,1:nV-nR)))
2019-10-15 23:13:00 +02:00
! Update amplitudes
t2(:,:,:,:) = t2(:,:,:,:) - r2(:,:,:,:)/delta_OOVV(:,:,:,:)
! Compute correlation energy
2020-03-26 16:57:46 +01:00
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCCD)
EcCCD = 2d0*EcCCD
2019-10-15 23:13:00 +02:00
! Dump results
ECCD = ERHF + EcCCD
2020-03-22 23:01:36 +01:00
! DIIS extrapolation
n_diis = min(n_diis+1,max_diis)
call DIIS_extrapolation(rcond,nO*nO*nV*nV,nO*nO*nV*nV,n_diis,error_diis,t_diis,-r2/delta_OOVV,t2)
! Reset DIIS if required
if(abs(rcond) < 1d-15) n_diis = 0
2019-10-15 23:13:00 +02:00
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
write(*,*)
2020-01-14 14:44:01 +01:00
write(*,*)'----------------------------------------------------'
2020-03-21 22:50:43 +01:00
write(*,*)' direct ring CCD energy '
2020-01-14 14:44:01 +01:00
write(*,*)'----------------------------------------------------'
2020-03-21 22:50:43 +01:00
write(*,'(1X,A30,1X,F15.10)')' E(drCCD) = ',ECCD
write(*,'(1X,A30,1X,F15.10)')' Ec(drCCD) = ',EcCCD
2020-01-14 14:44:01 +01:00
write(*,*)'----------------------------------------------------'
2019-10-15 23:13:00 +02:00
write(*,*)
2020-03-21 22:50:43 +01:00
end subroutine drCCD