GAS_doubles_PCHB_get_pgen Function

private function GAS_doubles_PCHB_get_pgen(this, nI, ilutI, ex, ic, ClassCount2, ClassCountUnocc2) result(pgen)

@brief Calculate the probability of drawing a given double excitation ex

@param[in] ex 2x2 excitation matrix

@return pgen probability of generating this double with the pchb double excitgen

Type Bound

GAS_PCHB_DoublesSpatOrbFastWeightedExcGenerator_t

Arguments

Type IntentOptional Attributes Name
class(GAS_PCHB_DoublesSpatOrbFastWeightedExcGenerator_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 GAS_doubles_PCHB_get_pgen(this, nI, ilutI, ex, ic, ClassCount2, ClassCountUnocc2) result(pgen)
        class(GAS_PCHB_DoublesSpatOrbFastWeightedExcGenerator_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)
        real(dp) :: pgen
        character(*), parameter :: this_routine = 'GAS_doubles_PCHB_get_pgen'

        integer :: ab, ij, nex(2, 2), samplerIndex, i_sg

#ifdef WARNING_WORKAROUND_
        associate(ilutI => ilutI); end associate
        associate(ClassCount2 => ClassCount2); end associate
        associate(ClassCountUnocc2 => ClassCountUnocc2); end associate
#endif
#ifdef DEBUG_
    block
        use util_mod, only: stop_all
        use constants, only: stderr
        if (.not. (ic == 2)) then
            write(stderr, *) ""
            write(stderr, *) "Assertion ic == 2"
            write(stderr, *) "failed in /scratch/jenkins/jobs/existing_branch_doc/workspace/build_config/gfortran-doc/src/gasci_pch&
                &b_doubles_spatorb_fastweighted.fpp:298"
            call stop_all (this_routine, "Assert fail: ic == 2")
        end if
    end block
#endif

        nex = gtID(ex(:, : ic))
        ij = fuseIndex(nex(1, 1), nex(1, 2))
        ab = fuseIndex(nex(2, 1), nex(2, 2))
        i_sg = this%indexer%idx_nI(nI)

        pgen = this%particle_selector%get_pgen(nI, i_sg, ex(1, 1), ex(1, 2))

        ! the probability of picking the two electrons: they are chosen uniformly
        ! check which sampler was used
        if (is_beta(ex(1, 1)) .eqv. is_beta(ex(1, 2))) then
            ! same-spin case
            samplerIndex = SAME_SPIN
        else
            ! excitations without spin-exchange OR to the same spatial orb
            if ((is_beta(ex(1, 1)) .eqv. is_beta(ex(2, 1))) .or. (nex(2, 1) == nex(2, 2))) then
                ! opp spin case without exchange
                samplerIndex = OPP_SPIN_NO_EXCH
                pGen = pGen * (1.0_dp - this%pExch(ij, i_sg))
            else
                ! opp spin case with exchange
                samplerIndex = OPP_SPIN_EXCH
                pGen = pGen * this%pExch(ij, i_sg)
            end if
        end if

        pgen = pgen * this%pchb_samplers%get_prob(ij, samplerIndex, i_sg, ab)
    end function GAS_doubles_PCHB_get_pgen