calc_pgen_back_spawn_ueg_new Function

public function calc_pgen_back_spawn_ueg_new(nI, ilutI, ex, ic, part_type) result(pgen)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilutI(0:niftot)
integer, intent(in) :: ex(2,2)
integer, intent(in) :: ic
integer, intent(in) :: part_type

Return Value real(kind=dp)


Contents


Source Code

    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