| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer(kind=n_int), | intent(in) | :: | ilut(0:niftot) | |||
| integer, | intent(in) | :: | ni(nel) | |||
| real(kind=dp), | intent(in) | :: | real_sgn(lenof_sign) |
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