subroutine mrsfqrorhs(rhs, xhxa, xhxb, hpta, hptb, tab, tij, fa, fb, noca, &
nocb)
use precision, only: dp
implicit none
real(kind=dp), intent(out), dimension(:) :: rhs
real(kind=dp), intent(inout), dimension(:,:) :: xhxa, xhxb
real(kind=dp), intent(in), dimension(:,:) :: hpta
real(kind=dp), intent(in), dimension(:,:) :: hptb
real(kind=dp), intent(in), dimension(:,:) :: tij
real(kind=dp), intent(in), dimension(:,:) :: tab
real(kind=dp), intent(in), dimension(:,:) :: fa, fb
integer, intent(in) :: noca, nocb
real(kind=dp), allocatable, dimension(:,:) :: scr
integer :: nbf, i, j, ij, a, x, nconf
nbf = ubound(fa, 1)
allocate(scr(nbf,nbf), &
source=0.0_dp)
! Alpha
! hxa+= 2*fa(p+,a+)*ta(a+,b+)
do j = noca+1, nbf
do i = noca+1, nbf
scr(i,j) = tab(i-noca,j-noca)
end do
end do
call dgemm('n', 'n', nbf, nbf, nbf, &
2.0_dp, fa, nbf, &
scr, nbf, &
1.0_dp, xhxa, nbf)
! Beta
! xhxb+= 2*fb(p-, i-)*tb(i-, j-)
call dgemm('n', 'n', nbf, nocb, nocb, &
2.0_dp, fb, nbf, &
tij, nocb, &
1.0_dp, xhxb, nbf)
rhs = 0.0_dp
! doc-socc
ij = 0
do x = nocb+1, noca
do i = 1, nocb
ij = ij+1
rhs(ij) = hptb(i,x-nocb)+xhxb(x,i)
end do
end do
! doc-virt
do a = noca+1, nbf
do i = 1, nocb
ij = ij+1
rhs(ij) = hpta(i,a-noca)+hptb(i,a-nocb) &
+ xhxb(a,i)-xhxa(i,a)
end do
end do
! soc-virt
do a = noca+1, nbf
do x = nocb+1, noca
ij = ij+1
rhs(ij) = hpta(x,a-noca)-xhxa(x,a)
end do
end do
nconf = ij
rhs(1:nconf) = -rhs(1:nconf)
return
end subroutine mrsfqrorhs