pickRandomOrb_restricted Subroutine

public subroutine pickRandomOrb_restricted(csf_i, start, ende, pgen, orb, occRes)

Arguments

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

Contents


Source Code

    subroutine pickRandomOrb_restricted(csf_i, start, ende, pgen, orb, occRes)
        ! picks a random orbital from a restricted range start + 1, ende - 1
        ! with optional additional occupation restrictions
        type(CSF_Info_t), intent(in) :: csf_i
        integer, intent(in) :: start, ende
        real(dp), intent(inout) :: pgen
        integer, intent(out) :: orb
        integer, intent(in), optional :: occRes
        character(*), parameter :: this_routine = "pickRandomOrb_restricted"

        integer :: r, nOrbs, ierr
        logical :: mask(nSpatOrbs)
        integer, allocatable :: resOrbs(:)
!         ASSERT(start > 0 .and. start <= nBasis/2)
!         ASSERT(ende > 0 .and. ende <= nBasis/2)

        mask = .true.
        if (present(occRes)) then
            ASSERT(occRes >= 0 .and. occRes <= 2)

            mask = (csf_i%Occ_int /= occRes)

        end if

        mask = (mask .and. (orbitalIndex > start .and. orbitalIndex < ende))

        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_restricted