pickRandomOrb_forced Subroutine

public subroutine pickRandomOrb_forced(csf_i, occRes, pgen, orb, orbRes1)

Arguments

Type IntentOptional Attributes Name
type(CSF_Info_t), intent(in) :: csf_i
integer, intent(in) :: occRes
real(kind=dp), intent(inout) :: pgen
integer, intent(out) :: orb
integer, intent(in), optional :: orbRes1

Contents

Source Code


Source Code

    subroutine pickRandomOrb_forced(csf_i, occRes, pgen, orb, orbRes1)
        ! the version where an orbitals has to have certain occupation.
        ! this never occurs in combination with orbital restrictions!
        ! yes it does!! for fullstart-> fullstop mixed, where i need
        ! n = 1 for both orbitals
        type(CSF_Info_t), intent(in) :: csf_i
        integer, intent(in) :: occRes
        real(dp), intent(inout) :: pgen
        integer, intent(out) :: orb
        integer, intent(in), optional :: orbRes1
        character(*), parameter :: this_routine = "pickRandomOrb_forced"

        integer :: r, nOrbs, ierr
        logical :: mask(nSpatOrbs)
        integer, allocatable :: resOrbs(:)

        ASSERT(occRes >= 0 .and. occRes <= 2)

        mask = (csf_i%Occ_int == occRes)

        if (present(orbRes1)) then
            ASSERT(orbRes1 > 0 .and. orbRes1 <= nSpatOrbs)

            mask = (mask .and. orbitalIndex /= orbRes1)
        end if

        nOrbs = count(mask)

        if (nOrbs > 0) then
            allocate(resOrbs(nOrbs), stat=ierr)
            resOrbs = pack(orbitalIndex, mask)

            r = 1 + floor(genrand_real2_dSFMT() * real(nOrbs, dp))

            orb = resOrbs(r)

            pgen = pgen / real(nOrbs, dp)
            deallocate(resOrbs)
        else
            orb = 0
            pgen = 0.0_dp
        end if

    end subroutine pickRandomOrb_forced