subroutine sfromcal(xm,xminv,energy,fa,fb,noca,nocb)
use precision, only: dp
implicit none
real(kind=dp), intent(out), dimension(:) :: xm
real(kind=dp), intent(out), dimension(:) :: xminv
real(kind=dp), intent(in), dimension(:) :: energy
real(kind=dp), intent(in), dimension(:,:) :: fa
real(kind=dp), intent(in), dimension(:,:) :: fb
integer, intent(in) :: noca, nocb
integer :: ij, i, j, k, nbf, nsoc, lzdim, nvira
nbf = ubound(fa, 1)
nvira = nbf-noca
nsoc = noca-nocb
lzdim = nocb*(nsoc+nvira)+nsoc*nvira
! doc-socc
ij = 0
do i = nocb+1, noca
do j = 1, nocb
ij = ij+1
xm(ij) = (fb(i,i)-fb(j,j))*0.5_dp
end do
end do
! DOC-VIRT
do k = noca+1, nbf
do j = 1, nocb
ij = ij+1
xm(ij) = energy(k)-energy(j)
end do
end do
! SOCC-VIRT
do k = noca+1, nbf
do i = nocb+1, noca
ij = ij+1
xm(ij) = (fa(k,k)-fa(i,i))*0.5_dp
end do
end do
do j = 1, lzdim
xminv(j)=1.0_dp/xm(j)
end do
end subroutine sfromcal