PC_SinglesFullyWeighted_get_pgen Function

private function PC_SinglesFullyWeighted_get_pgen(this, nI, ilutI, ex, ic, ClassCount2, ClassCountUnocc2) result(p_gen)

Type Bound

PC_SinglesFullyWeighted_t

Arguments

Type IntentOptional Attributes Name
class(PC_SinglesFullyWeighted_t), intent(inout) :: this
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilutI(0:NIfTot)
integer, intent(in) :: ex(2,maxExcit)
integer, intent(in) :: ic
integer, intent(in) :: ClassCount2(ScratchSize)
integer, intent(in) :: ClassCountUnocc2(ScratchSize)

Return Value real(kind=dp)


Contents


Source Code

    function PC_SinglesFullyWeighted_get_pgen(this, nI, ilutI, ex, ic, ClassCount2, ClassCountUnocc2) result(p_gen)
        class(PC_SinglesFullyWeighted_t), intent(inout) :: this
        integer, intent(in) :: nI(nel)
        integer(n_int), intent(in) :: ilutI(0:NIfTot)
        integer, intent(in) :: ex(2, maxExcit), ic
        integer, intent(in) :: ClassCount2(ScratchSize), ClassCountUnocc2(ScratchSize)
        debug_function_name("get_pgen")
        real(dp) :: p_gen
        integer :: i_sg

        integer :: unoccupied(nBasis - nEl)
        integer(n_int) :: ilut_unoccupied(0 : nIfD)

#ifdef DEBUG_
    block
        use util_mod, only: stop_all
        use constants, only: stderr
        if (.not. (ic == 1)) then
            write(stderr, *) ""
            write(stderr, *) "Assertion ic == 1"
            write(stderr, *) "failed in /scratch/jenkins/jobs/existing_branch_doc/workspace/build_config/gfortran-doc/src/gasci_sin&
                &gles_pc_weighted.fpp:382"
            call stop_all (this_routine, "Assert fail: ic == 1")
        end if
    end block
#endif
#ifdef WARNING_WORKAROUND_
        associate(ClassCount2 => ClassCount2); end associate
        associate(ClassCountUnocc2 => ClassCountUnocc2); end associate
#endif
        i_sg = this%indexer%idx_nI(nI)
        call this%get_unoccupied(ilutI, ilut_unoccupied, unoccupied)
        associate (src => ex(1, 1), tgt => ex(2, 1))
            p_gen = this%I_sampler%get_prob(i_sg, src) &
                        / sum(this%I_sampler%get_prob(i_sg, nI)) &
                    * this%A_sampler%get_prob(src, i_sg, tgt) &
                        / sum(this%A_sampler%get_prob(src, i_sg, unoccupied))
        end associate
    end function PC_SinglesFullyWeighted_get_pgen