1
0
mirror of https://gitlab.com/scemama/qp_plugins_scemama.git synced 2024-11-07 22:53:42 +01:00
qp_plugins_scemama/devel/cc/form_r1_nc.irp.f

73 lines
1.6 KiB
FortranFixed
Raw Normal View History

2019-09-14 14:20:55 +02:00
subroutine form_r1_nc(Fov,cFoo,cFov,cFvv,r1)
2019-09-11 17:09:30 +02:00
! Form residues for t1 in non-canonical CCSD
implicit none
! Input variables
2019-09-14 14:15:25 +02:00
double precision,intent(in) :: Fov(spin_occ_num,spin_vir_num)
2019-09-11 17:09:30 +02:00
2019-09-14 14:15:25 +02:00
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)
2019-09-11 17:09:30 +02:00
! Local variables
integer :: i,j,m,n
integer :: a,b,e,f
! Output variables
2019-09-14 14:15:25 +02:00
double precision,intent(out) :: r1(spin_occ_num,spin_vir_num)
2019-09-11 17:09:30 +02:00
r1(:,:) = Fov(:,:)
2019-09-14 14:15:25 +02:00
do i=1,spin_occ_num
do a=1,spin_vir_num
2019-09-11 17:09:30 +02:00
2019-09-14 14:15:25 +02:00
do e=1,spin_vir_num
2019-09-14 14:20:55 +02:00
r1(i,a) = r1(i,a) + t1_cc(i,e)*cFvv(a,e)
2019-09-11 17:09:30 +02:00
end do
2019-09-14 14:15:25 +02:00
do m=1,spin_occ_num
2019-09-14 14:20:55 +02:00
r1(i,a) = r1(i,a) - t1_cc(m,a)*cFoo(m,i)
2019-09-11 17:09:30 +02:00
end do
2019-09-14 14:15:25 +02:00
do m=1,spin_occ_num
do e=1,spin_vir_num
2019-09-14 14:20:55 +02:00
r1(i,a) = r1(i,a) + t2_cc(i,m,a,e)*cFov(m,e)
2019-09-11 17:09:30 +02:00
end do
end do
2019-09-14 14:15:25 +02:00
do n=1,spin_occ_num
do f=1,spin_vir_num
2019-09-14 14:20:55 +02:00
r1(i,a) = r1(i,a) - t1_cc(n,f)*OVOV(n,a,i,f)
2019-09-11 17:09:30 +02:00
end do
end do
2019-09-14 14:15:25 +02:00
do m=1,spin_occ_num
do e=1,spin_vir_num
do f=1,spin_vir_num
2019-09-14 14:20:55 +02:00
r1(i,a) = r1(i,a) - 0.5d0*t2_cc(i,m,e,f)*OVVV(m,a,e,f)
2019-09-11 17:09:30 +02:00
end do
end do
end do
2019-09-14 14:15:25 +02:00
do m=1,spin_occ_num
do n=1,spin_occ_num
do e=1,spin_vir_num
2019-09-14 14:20:55 +02:00
r1(i,a) = r1(i,a) - 0.5d0*t2_cc(m,n,a,e)*OOVO(n,m,e,i)
2019-09-11 17:09:30 +02:00
end do
end do
end do
end do
end do
! Final expression for t1 residue
2019-09-14 14:20:55 +02:00
r1(:,:) = delta_ov(:,:)*t1_cc(:,:) - r1(:,:)
2019-09-11 17:09:30 +02:00
end subroutine form_r1_nc