pick_orbitals_pure_uniform_singles Subroutine

public subroutine pick_orbitals_pure_uniform_singles(ilut, nI, csf_i, excitInfo, pgen)

Type Bound

GugaAliasSampler_t

Arguments

Type IntentOptional Attributes Name
integer(kind=n_int), intent(in) :: ilut(0:GugaBits%len_tot)
integer, intent(in) :: nI(nel)
type(CSF_Info_t), intent(in) :: csf_i
type(ExcitationInformation_t), intent(out) :: excitInfo
real(kind=dp), intent(out) :: pgen

Contents


Source Code

    subroutine pick_orbitals_pure_uniform_singles(ilut, nI, csf_i, excitInfo, pgen)
        debug_function_name("pick_orbitals_pure_uniform_singles")
        integer(n_int), intent(in) :: ilut(0:GugaBits%len_tot)
        integer, intent(in) :: nI(nel)
        type(CSF_Info_t), intent(in) :: csf_i
        type(ExcitationInformation_t), intent(out) :: excitInfo
        real(dp), intent(out) :: pgen

        integer :: src_orb, tgt_orb, i
        real(dp) :: pgen_hole
        integer, allocatable :: occ_spat_orbs(:)
            !! The occupied spatial orbitals
        unused_var(ilut); unused_var(nI)

        occ_spat_orbs = pack([(i, i = 1, size(csf_i%Occ_int))], csf_i%stepvector /= 0)
        src_orb = occ_spat_orbs(1 + int(genrand_real2_dSFMT() * size(occ_spat_orbs)))

        call pick_uniform_spatial_hole(csf_i, src_orb, tgt_orb, pgen_hole)

        if (near_zero(pgen_hole) .or. tgt_orb == 0) then
            pgen = 0.0_dp
            tgt_orb = 0
            excitInfo%valid = .false.
        else
            pgen = 1._dp / real(size(occ_spat_orbs), dp) * pgen_hole
            if (tgt_orb < src_orb) then
                excitInfo = assign_excitinfo_values_single(&
                                gen_type%R, tgt_orb, src_orb, tgt_orb, src_orb)
            else
                excitInfo = assign_excitinfo_values_single(&
                                gen_type%L, tgt_orb, src_orb, src_orb, tgt_orb)
            end if
            excitInfo%valid = checkCompatibility_single(csf_i, excitInfo)
            if (excitInfo%valid) then
                ASSERT(pgen .isclose. calc_orb_pgen_uniform_singles(csf_i, excitInfo))
            else
                pgen = 0._dp
            end if
        end if

    end subroutine pick_orbitals_pure_uniform_singles