subroutine measure_double_occ_and_spin_diff(ilut, nI, real_sgn)
! routine to measure double occupancy and spin difference for each
! orbital
use UMatCache, only: gtid
integer(n_int), intent(in) :: ilut(0:niftot)
integer, intent(in) :: ni(nel)
real(dp), intent(in) :: real_sgn(lenof_sign)
character(*), parameter :: this_routine = "measure_double_occ_and_spin_diff"
integer :: i, spin_orb, spat_orb(nel)
real(dp) :: contrib
ASSERT(allocated(spin_diff))
ASSERT(allocated(double_occ_vec))
! i can calculate the C_i^2 at the beginning already since it is
! always the same and i guess i have atleast on contribution atleast
! for each occupied orbital
#if defined PROG_NUMRUNS_ || defined DOUBLERUN_
contrib = real_sgn(1) * real_sgn(2)
#else
contrib = abs(real_sgn(1))**2
#endif
spat_orb = gtid(nI)
i = 1
do while (i < nel + 1)
spin_orb = nI(i)
if (is_beta(spin_orb)) then
! check if it is a doubly occupied orb
if (IsDoub(ilut, spin_orb)) then
! then we want to add to the double_occ vector
inst_spatial_doub_occ(spat_orb(i)) = &
inst_spatial_doub_occ(spat_orb(i)) + contrib
! and we can skip the even alpha orbital in nI
i = i + 2
else
! beta spin contributes negatively!
inst_spin_diff(spat_orb(i)) = inst_spin_diff(spat_orb(i)) &
- contrib
i = i + 1
end if
else
! the way i plan to set it up, we check beta spins in the
! same orbital first.. so it can't be doubly occupied at
! this point!
inst_spin_diff(spat_orb(i)) = inst_spin_diff(spat_orb(i)) &
+ contrib
i = i + 1
end if
end do
! this should be it or?
end subroutine measure_double_occ_and_spin_diff