2019-09-09 16:51:15 +02:00
|
|
|
subroutine CCSD
|
|
|
|
|
|
|
|
! CCSD module
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
! Input variables (provided by IRP)
|
|
|
|
|
|
|
|
integer :: maxscf
|
|
|
|
double precision :: thresh
|
|
|
|
|
|
|
|
logical :: doCCSDT
|
|
|
|
integer :: nBas,nEl
|
|
|
|
double precision :: ERHF
|
|
|
|
|
|
|
|
! Local variables
|
|
|
|
|
|
|
|
integer :: p,q,r,s
|
|
|
|
double precision :: start_CCSDT,end_CCSDT,t_CCSDT
|
|
|
|
integer :: nBas2
|
|
|
|
integer :: nSCF
|
|
|
|
double precision :: Conv
|
|
|
|
double precision :: EcMP2
|
|
|
|
double precision :: ECCSD,EcCCSD
|
|
|
|
double precision :: EcCCT
|
|
|
|
double precision :: get_two_e_integral,u_dot_v
|
|
|
|
|
2019-09-11 17:09:30 +02:00
|
|
|
double precision,allocatable :: cFvv(:,:)
|
|
|
|
double precision,allocatable :: cFoo(:,:)
|
|
|
|
double precision,allocatable :: cFov(:,:)
|
|
|
|
|
|
|
|
double precision,allocatable :: cWoooo(:,:,:,:)
|
|
|
|
double precision,allocatable :: cWvvvv(:,:,:,:)
|
|
|
|
double precision,allocatable :: cWovvo(:,:,:,:)
|
2019-09-09 16:51:15 +02:00
|
|
|
|
|
|
|
double precision,allocatable :: r1(:,:)
|
|
|
|
double precision,allocatable :: r2(:,:,:,:)
|
|
|
|
|
|
|
|
double precision,allocatable :: tau(:,:,:,:)
|
2019-09-11 17:09:30 +02:00
|
|
|
double precision,allocatable :: taus(:,:,:,:)
|
2019-09-09 16:51:15 +02:00
|
|
|
|
|
|
|
! Hello world
|
|
|
|
|
|
|
|
write(*,*)
|
|
|
|
write(*,*)'**************************************'
|
|
|
|
write(*,*)'| CCSD calculation |'
|
|
|
|
write(*,*)'**************************************'
|
|
|
|
write(*,*)
|
|
|
|
|
|
|
|
! IRP init
|
|
|
|
provide cc_mode
|
|
|
|
maxSCF=cc_n_it_max
|
|
|
|
thresh=cc_thresh
|
|
|
|
|
|
|
|
doCCSDT = trim(cc_mode)=='CCSD(T)'
|
|
|
|
|
|
|
|
nBas=mo_num
|
|
|
|
nEl=elec_num
|
|
|
|
ERHF=hf_energy
|
|
|
|
|
|
|
|
! Spatial to spin orbitals
|
|
|
|
|
|
|
|
nBas2 = spin_mo_num
|
|
|
|
|
|
|
|
|
|
|
|
! Guess amplitudes
|
|
|
|
|
2019-09-14 14:20:55 +02:00
|
|
|
allocate(tau(spin_occ_num,spin_occ_num,spin_vir_num,spin_vir_num),taus(spin_occ_num,spin_occ_num,spin_vir_num,spin_vir_num))
|
2019-09-09 16:51:15 +02:00
|
|
|
|
|
|
|
! Initialization
|
|
|
|
|
2019-09-14 14:15:25 +02:00
|
|
|
allocate(cFvv(spin_vir_num,spin_vir_num),cFoo(spin_occ_num,spin_occ_num),cFov(spin_occ_num,spin_vir_num), &
|
|
|
|
cWoooo(spin_occ_num,spin_occ_num,spin_occ_num,spin_occ_num),cWvvvv(spin_vir_num,spin_vir_num,spin_vir_num,spin_vir_num),cWovvo(spin_occ_num,spin_vir_num,spin_vir_num,spin_occ_num), &
|
|
|
|
r1(spin_occ_num,spin_vir_num),r2(spin_occ_num,spin_occ_num,spin_vir_num,spin_vir_num))
|
2019-09-09 16:51:15 +02:00
|
|
|
|
|
|
|
Conv = 1d0
|
|
|
|
nSCF = 0
|
|
|
|
|
2019-09-14 14:20:55 +02:00
|
|
|
call form_taus_nc(taus)
|
|
|
|
call form_tau_nc (tau)
|
2019-09-11 17:09:30 +02:00
|
|
|
|
|
|
|
EcMP2 = 0.25d0*u_dot_v(OOVV,tau,size(OOVV))
|
|
|
|
write(*,'(1X,A10,1X,F10.6)') 'Ec(MP2) = ',EcMP2
|
|
|
|
write(*,'(1X,A10,1X,F10.6)') 'E (MP2) = ',EcMP2 + ERHF
|
|
|
|
|
2019-09-09 16:51:15 +02:00
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! Main SCF loop
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
write(*,*)
|
|
|
|
write(*,*)'----------------------------------------------------'
|
|
|
|
write(*,*)'| CCSD calculation |'
|
|
|
|
write(*,*)'----------------------------------------------------'
|
|
|
|
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
|
|
|
|
'|','#','|','E(CCSD)','|','Ec(CCSD)','|','Conv','|'
|
|
|
|
write(*,*)'----------------------------------------------------'
|
|
|
|
|
|
|
|
do while(Conv > thresh .and. nSCF < maxSCF)
|
|
|
|
|
2019-09-11 17:09:30 +02:00
|
|
|
! Excrement
|
2019-09-09 16:51:15 +02:00
|
|
|
|
|
|
|
nSCF = nSCF + 1
|
|
|
|
|
2019-09-14 14:20:55 +02:00
|
|
|
call form_cf_nc (taus, &
|
2019-09-11 17:09:30 +02:00
|
|
|
spin_fock_matrix_mo_oo, &
|
|
|
|
spin_fock_matrix_mo_ov, &
|
|
|
|
spin_fock_matrix_mo_vv, &
|
|
|
|
cFoo,cFov,cFvv)
|
2019-09-09 16:51:15 +02:00
|
|
|
|
2019-09-14 14:20:55 +02:00
|
|
|
call form_cw_nc (tau, &
|
2019-09-11 17:09:30 +02:00
|
|
|
cWoooo,cWovvo,cWvvvv)
|
2019-09-09 16:51:15 +02:00
|
|
|
|
|
|
|
! Compute residuals
|
|
|
|
|
2019-09-14 14:20:55 +02:00
|
|
|
call form_r1_nc(spin_fock_matrix_mo_ov, &
|
2019-09-11 17:09:30 +02:00
|
|
|
cFoo,cFov,cFvv,r1)
|
2019-09-09 16:51:15 +02:00
|
|
|
|
2019-09-14 14:20:55 +02:00
|
|
|
call form_r2_nc(tau,cFoo,cFov,cFvv, &
|
2019-09-11 17:09:30 +02:00
|
|
|
cWoooo,cWvvvv,cWovvo,r2)
|
2019-09-09 16:51:15 +02:00
|
|
|
|
|
|
|
! Check convergence
|
|
|
|
|
|
|
|
Conv = max(maxval(abs(r1(:,:))),maxval(abs(r2(:,:,:,:))))
|
|
|
|
|
|
|
|
! Update
|
|
|
|
|
2019-09-14 14:20:55 +02:00
|
|
|
t1_cc(:,:) = t1_cc(:,:) - r1(:,:) /delta_OV (:,:)
|
|
|
|
t2_cc(:,:,:,:) = t2_cc(:,:,:,:) - r2(:,:,:,:)/delta_OOVV(:,:,:,:)
|
|
|
|
TOUCH t1_cc t2_cc
|
2019-09-09 16:51:15 +02:00
|
|
|
|
2019-09-14 14:20:55 +02:00
|
|
|
call form_taus_nc(taus)
|
|
|
|
call form_tau_nc (tau)
|
2019-09-11 17:09:30 +02:00
|
|
|
|
2019-09-09 16:51:15 +02:00
|
|
|
! Compute correlation energy
|
|
|
|
|
2019-09-14 14:20:55 +02:00
|
|
|
call CCSD_Ec_nc(spin_fock_matrix_mo_ov,EcCCSD)
|
2019-09-09 16:51:15 +02:00
|
|
|
|
|
|
|
! Dump results
|
|
|
|
|
|
|
|
ECCSD = ERHF + EcCCSD
|
|
|
|
|
|
|
|
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
|
|
|
|
'|',nSCF,'|',ECCSD,'|',EcCCSD,'|',Conv,'|'
|
|
|
|
|
|
|
|
end do
|
|
|
|
write(*,*)'----------------------------------------------------'
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! End of SCF loop
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
|
|
|
|
! Did it actually converge?
|
|
|
|
|
|
|
|
if(nSCF == maxSCF) then
|
|
|
|
|
|
|
|
write(*,*)
|
|
|
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
|
|
|
write(*,*)' Convergence failed '
|
|
|
|
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
|
|
|
|
write(*,*)
|
|
|
|
|
|
|
|
stop
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
! Deallocate memory
|
|
|
|
|
2019-09-11 17:09:30 +02:00
|
|
|
deallocate( &
|
|
|
|
cFvv,cFoo,cFov, &
|
|
|
|
cWoooo,cWvvvv,cWovvo, &
|
|
|
|
tau,taus, &
|
|
|
|
r1,r2)
|
2019-09-09 16:51:15 +02:00
|
|
|
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
! (T) correction
|
|
|
|
!------------------------------------------------------------------------
|
|
|
|
if(doCCSDT) then
|
|
|
|
write(*,*) "Starting (T) calculation"
|
|
|
|
! call cpu_time(start_CCSDT)V
|
2019-09-14 14:20:55 +02:00
|
|
|
call CCSDT(EcCCT)
|
2019-09-09 16:51:15 +02:00
|
|
|
! call cpu_time(end_CCSDT)
|
|
|
|
call write_time(6)
|
|
|
|
|
|
|
|
! t_CCSDT = end_CCSDT - start_CCSDT
|
|
|
|
! write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for (T) = ',t_CCSDT,' seconds'
|
|
|
|
write(*,*)
|
|
|
|
|
|
|
|
write(*,*)
|
|
|
|
write(*,*)'----------------------------------------------------'
|
|
|
|
write(*,*)' CCSDT(T) energy '
|
|
|
|
write(*,*)'----------------------------------------------------'
|
|
|
|
write(*,'(1X,A20,1X,F15.10)')' E(CCSD(T)) = ',ECCSD + EcCCT
|
|
|
|
write(*,'(1X,A20,1X,F10.6)') ' Ec(CCSD(T)) = ',EcCCSD + EcCCT
|
|
|
|
write(*,*)'----------------------------------------------------'
|
|
|
|
write(*,*)
|
|
|
|
|
|
|
|
call save_energy(ECCSD + EcCCT)
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
call save_energy(ECCSD)
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
end subroutine CCSD
|