scemama/qp_plugins_scemama
1
0
Fork 0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-08-30 07:53:39 +02:00
Code Issues Releases Wiki Activity
3e6b874f9e
qp_plugins_scemama/devel/cc/form_r2_nc.irp.f
Anthony Scemama 3e6b874f9e Removed tau
2019-09-14 14:32:41 +02:00

351 lines
7.8 KiB
Fortran
Raw Blame History

subroutine form_r2_nc(cFoo,cFov,cFvv,cWoooo,cWvvvv,cWovvo,r2)
! Form t2 residues in non-canonical CCSD
implicit none
! Input variables
double precision,intent(in) :: cFoo(spin_occ_num,spin_occ_num)
double precision,intent(in) :: cFov(spin_occ_num,spin_vir_num)
double precision,intent(in) :: cFvv(spin_vir_num,spin_vir_num)
double precision,intent(in) :: cWoooo(spin_occ_num,spin_occ_num,spin_occ_num,spin_occ_num)
double precision,intent(in) :: cWvvvv(spin_vir_num,spin_vir_num,spin_vir_num,spin_vir_num)
double precision,intent(in) :: cWovvo(spin_occ_num,spin_vir_num,spin_vir_num,spin_occ_num)
double precision :: x
! Local variables
integer :: i,j,m,n
integer :: a,b,e,f
! Output variables
double precision,intent(out) :: r2(spin_occ_num,spin_occ_num,spin_vir_num,spin_vir_num)
r2(:,:,:,:) = OOVV(:,:,:,:)
do e=1,spin_vir_num
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + t2_cc(i,j,a,e)*cFvv(b,e)
end do
end do
end do
end do
end do
do e=1,spin_vir_num
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) - t2_cc(i,j,b,e)*cFvv(a,e)
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do e=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
x = 0.5d0*t2_cc(i,j,a,e)
if (x /= 0.d0) then
do m=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) - x*t1_cc(m,b)*cFov(m,e)
end do
endif
end do
end do
end do
end do
end do
do e=1,spin_vir_num
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
x = 0.5d0*t2_cc(i,j,b,e)
if (x /= 0.d0) then
do m=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + x*t1_cc(m,a)*cFov(m,e)
end do
endif
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do m=1,spin_occ_num
x = cFoo(m,j)
do i=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) - t2_cc(i,m,a,b)*x
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
do m=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + t2_cc(j,m,a,b)*cFoo(m,i)
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do e=1,spin_vir_num
do m=1,spin_occ_num
x = 0.5d0*cFov(m,e)
if (x == 0.d0) cycle
do j=1,spin_occ_num
do i=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) - x*t2_cc(i,m,a,b)*t1_cc(j,e)
end do
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do e=1,spin_vir_num
do m=1,spin_occ_num
x = 0.5d0*cFov(m,e)
do j=1,spin_occ_num
do i=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + x*t2_cc(j,m,a,b)*t1_cc(i,e)
end do
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
do n=1,spin_occ_num
do m=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + 0.5d0*tau_cc(m,n,a,b)*cWoooo(m,n,i,j)
end do
end do
end do
end do
end do
end do
do f=1,spin_vir_num
do e=1,spin_vir_num
do b=1,spin_vir_num
do a=1,spin_vir_num
x = 0.5d0*cWvvvv(a,b,e,f)
do j=1,spin_occ_num
do i=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + x*tau_cc(i,j,e,f)
end do
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do e=1,spin_vir_num
do m=1,spin_occ_num
do i=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + t2_cc(i,m,a,e)*cWovvo(m,b,e,j)
end do
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do e=1,spin_vir_num
do m=1,spin_occ_num
x = t1_cc(m,a)*OVVO(m,b,e,j)
do i=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) - t1_cc(i,e)*x
end do
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do e=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
do m=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) - t2_cc(j,m,a,e)*cWovvo(m,b,e,i)
end do
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do e=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
do m=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + t1_cc(j,e)*t1_cc(m,a)*OVVO(m,b,e,i)
end do
end do
end do
end do
end do
end do
do e=1,spin_vir_num
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do m=1,spin_occ_num
do i=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) - t2_cc(i,m,b,e)*cWovvo(m,a,e,j)
end do
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do e=1,spin_vir_num
do i=1,spin_occ_num
do m=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + t1_cc(i,e)*t1_cc(m,b)*OVVO(m,a,e,j)
end do
end do
end do
end do
end do
end do
do e=1,spin_vir_num
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
do m=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + t2_cc(j,m,b,e)*cWovvo(m,a,e,i)
end do
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do e=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
do m=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) - t1_cc(j,e)*t1_cc(m,b)*OVVO(m,a,e,i)
end do
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do e=1,spin_vir_num
do i=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + t1_cc(i,e)*VVVO(a,b,e,j)
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do e=1,spin_vir_num
do i=1,spin_occ_num
do j=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) - t1_cc(j,e)*VVVO(a,b,e,i)
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
do m=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) - t1_cc(m,a)*OVOO(m,b,i,j)
end do
end do
end do
end do
end do
do b=1,spin_vir_num
do a=1,spin_vir_num
do j=1,spin_occ_num
do i=1,spin_occ_num
do m=1,spin_occ_num
r2(i,j,a,b) = r2(i,j,a,b) + t1_cc(m,b)*OVOO(m,a,i,j)
end do
end do
end do
end do
end do
! Final expression of the t2 residue
r2(:,:,:,:) = delta_oovv(:,:,:,:)*t2_cc(:,:,:,:) - r2(:,:,:,:)
end subroutine form_r2_nc
Reference in New Issue View Git Blame Copy Permalink