| Type | Intent | Optional | 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 |
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