pick_source_el_single_excit Function

private function pick_source_el_single_excit(nI, ilut, iElec, pGen, pool) result(source)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilut(0:NIfTot)
integer, intent(out) :: iElec
real(kind=dp), intent(inout) :: pGen
integer, intent(out), allocatable :: pool(:)

Return Value integer


Contents


Source Code

    function pick_source_el_single_excit(nI, ilut, iElec, pGen, pool) result(source)
        integer, intent(in) :: nI(nel)
        integer(n_int), intent(in) :: ilut(0:NIfTot)
        integer, intent(out) :: iElec
        real(dp), intent(inout) :: pGen
        integer, allocatable, intent(out) :: pool(:)
        integer :: source

        logical :: tAvail(nel)
        integer :: i, j, nAvail
        integer :: nIPick(nel), poolsize(nel), pools(nel, nbasis)
        real(dp) :: r

        ! check for each electron, if there is some space to excite to
        tAvail = .false.
        nAvail = 0
        pools = 0
        poolsize = 0
        do i = 1, nel
            do j = 1, nConnects(nI(i))
                if (IsNotOcc(ilut, connections(nI(i), j))) then
                    tAvail(i) = .true.
                    poolsize(i) = poolsize(i) + 1
                    pools(i, poolsize(i)) = connections(nI(i), j)
                end if
            end do
        end do
        nAvail = count(poolsize /= 0)

        nIPick = pack(nI, tAvail, vector=nI)
        r = genrand_real2_dSFMT()
        source = nIPick(int(r * nAvail) + 1)
        ! each pickable electron has the same probability to be chosen
        pGen = pGen / nAvail
        ! get the electron index
        iElec = binary_search_first_ge(nI, source)
        ! return the coupled, unoccupied orbitals
        allocate(pool(1:poolsize(iElec)))
        pool = pools(iElec, 1:poolsize(iElec))

    end function pick_source_el_single_excit