PC_SinglesWeighted_get_pgen Function

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

Type Bound

PC_SinglesWeighted_t

Arguments

Type IntentOptional Attributes Name
class(PC_SinglesWeighted_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_SinglesWeighted_get_pgen(this, nI, ilutI, ex, ic, ClassCount2, ClassCountUnocc2) result(p_gen)
        class(PC_SinglesWeighted_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
        real(dp) :: p_src, p_tgt

        integer :: unoccupied(this%GAS_spec%n_spin_orbs() - 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:475"
            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)
        p_src = 1._dp / real(nEl, dp)
        associate (src => ex(1, 1), tgt => ex(2, 1))
            p_tgt = this%weights(tgt, src, i_sg) / sum(this%weights(unoccupied, src, i_sg))
        end associate
        p_gen = p_src * p_tgt
    end function PC_SinglesWeighted_get_pgen