gen_excit_uniform_k_space_hub Subroutine

public subroutine gen_excit_uniform_k_space_hub(nI, ilutI, nJ, ilutJ, exFlag, ic, ex, tParity, pGen, hel, store, run)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilutI(0:NIfTot)
integer, intent(out) :: nJ(nel)
integer(kind=n_int), intent(out) :: ilutJ(0:NifTot)
integer, intent(in) :: exFlag
integer, intent(out) :: ic
integer, intent(out) :: ex(2,maxExcit)
logical, intent(out) :: tParity
real(kind=dp), intent(out) :: pGen
real(kind=dp), intent(out) :: hel
type(excit_gen_store_type), intent(inout), target :: store
integer, intent(in), optional :: run

Contents


Source Code

    subroutine gen_excit_uniform_k_space_hub(nI, ilutI, nJ, ilutJ, exFlag, ic, ex, &
                                             tParity, pGen, hel, store, run)
        integer, intent(in) :: nI(nel), exFlag
        integer(n_int), intent(in) :: ilutI(0:NIfTot)
        integer, intent(out) :: nJ(nel), ic, ex(2, maxExcit)
        real(dp), intent(out) :: pGen
        logical, intent(out) :: tParity
        type(excit_gen_store_type), intent(inout), target :: store
        integer, intent(in), optional :: run

        ! not used
        HElement_t(dp), intent(out) :: hel
        integer(n_int), intent(out) :: ilutJ(0:NifTot)

        real(dp) :: p_elec, r
        integer :: a, b, i, elecs(2)
        integer, parameter :: maxTrials = 1000

        unused_var(store)
        unused_var(exFlag)

        if (present(run)) then
            unused_var(run)
        end if

        hel = h_cast(0.0_dp)

        ilutJ = 0
        ic = 0

        nJ = nI

        ! first, get two electrons
        call pick_spin_opp_elecs(nI, elecs, p_elec)

        ! uniform random excit gen probability
        pGen = 1.0_dp / (nbasis - nel) * 2.0_dp / (nOccAlpha * nOccBeta)

        ! try finding an allowed excitation
        do i = 1, maxTrials
            ! we do this by picking random momenta and checking if the targets are
            ! empty
            r = genrand_real2_dSFMT()
            ! this is our random orb
            a = INT(nBasis * r) + 1
            ! only empty targets are of interest
            if (IsOcc(ilutI, a)) cycle

            ! now, get the missing momentum
            b = get_orb_from_kpoints(nI(elecs(1)), nI(elecs(2)), a)
            ! and check if its empty and differs from a
            if (IsOcc(ilutI, b) .or. a == b) then
                ! if not, the excitation is rejected (!)
                nJ(1) = 0
                return
            end if

            call make_double(nI, nJ, elecs(1), elecs(2), a, b, ex, tParity)
            ic = 2
            exit
        end do

    end subroutine gen_excit_uniform_k_space_hub