calc_pgen_rs_hubbard_transcorr_uniform Function

public function calc_pgen_rs_hubbard_transcorr_uniform(ex, ic) result(pgen)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: ex(2,2)
integer, intent(in) :: ic

Return Value real(kind=dp)


Contents


Source Code

    function calc_pgen_rs_hubbard_transcorr_uniform(ex, ic) result(pgen)
        integer, intent(in) :: ex(2, 2), ic
        real(dp) :: pgen
#ifdef DEBUG_
        character(*), parameter :: this_routine = "calc_pgen_rs_hubbard_transcorr_uniform"
#endif

        if (ic == 1) then

            ASSERT(same_spin(ex(1, 1), ex(2, 1)))

            if (is_beta(ex(1, 1))) then
                pgen = 1.0_dp / real(nel * (nBasis / 2 - nOccBeta), dp)
            else
                pgen = 1.0_dp / real(nel * (nBasis / 2 - nOccAlpha), dp)
            end if

            pgen = pgen * (1.0_dp - pDoubles)

        else if (ic == 2) then

            ASSERT(.not. same_spin(ex(1, 1), ex(1, 2)))
            ASSERT(.not. same_spin(ex(2, 1), ex(2, 2)))

            pgen = 1.0_dp / real(nOccAlpha * nOccBeta * &
                                 (nBasis / 2 - nOccAlpha) * (nBasis / 2 - nOccBeta), dp)

            pgen = pgen * pDoubles
        else

            pgen = 0.0_dp

        end if

    end function calc_pgen_rs_hubbard_transcorr_uniform