function calc_pgen_back_spawn_ueg_new(nI, ilutI, ex, ic, part_type) result(pgen)
! i also need immmidiately a calc_pgen function!
integer, intent(in) :: nI(nel), ex(2, 2), ic, part_type
integer(n_int), intent(in) :: ilutI(0:niftot)
real(dp) :: pgen
integer :: elecs(2), src(2), ispn, sum_ml, dummy_src(2), dumm_iSpn
integer :: orb_a, tgt(2), loc
real(dp) :: p_elec, p_orb, dummy, cum_arr(nBasis), cum_sum
if (ic /= 2) then
pgen = 0.0_dp
return
end if
! and maybe i should also enable that i call this outside of
! knowledge of the initator status..
if (test_flag(ilutI, get_initiator_flag(part_type))) then
pgen = calc_pgen_ueg(ilutI, ex, ic)
else
src = get_src(ex)
tgt = get_tgt(ex)
ispn = get_ispn(src)
if (t_back_spawn) then
call pick_virtual_electrons_double(nI, part_type, elecs, dummy_src, &
dumm_iSpn, sum_ml, p_elec, .true.)
loc = -1
else
p_elec = 1.0_dp / real(ElecPairs, dp)
loc = check_electron_location(src, 2, part_type)
end if
if ((loc == 2) .or. (loc == 1 .and. occ_virt_level /= -1) .or. &
(loc == 0 .and. occ_virt_level >= 1)) then
! argh.. wait a minute.. i have to ensure that i only do that
! for back-spawn flex!
call pick_occupied_orbital_ueg(ilutI, src, iSpn, part_type, p_orb, &
dummy, orb_a, .true.)
! do i need to multiply if both are in the reference?
! i guess so.. since then i could have picked it in both
! orders..
if (is_in_ref(tgt(1), part_type) .and. is_in_ref(tgt(2), part_type)) then
p_orb = 2.0_dp * p_orb
end if
else
! i could refactor that in a smaller function:
call create_ab_list_ueg(ilutI, src, cum_arr, cum_sum)
tgt = get_tgt(ex)
orb_a = tgt(1)
if (orb_a == 1) then
p_orb = cum_arr(orb_a) / cum_sum
else
p_orb = (cum_arr(orb_a) - cum_arr(orb_a - 1)) / cum_sum
end if
end if
pgen = p_orb * p_elec
end if
end function calc_pgen_back_spawn_ueg_new