cc_singles_factor Function

public function cc_singles_factor() result(factor)

Arguments

None

Return Value real(kind=dp)


Contents

Source Code


Source Code

    function cc_singles_factor() result(factor)
        ! this function should provide the correct factor to the
        ! cepa-shift for the singles.. if the correct variable are not
        ! yet set or sampled as 0 it should default to 1
        real(dp) :: factor

        real(dp) :: fac_triples, fac_doubles, weight

        weight = 1.0_dp / 4.0_dp

        ! the singles should be influenced by the triples and doubles..
        ! but this i have not figured out correctly..
        ! so for now return 1 always
!         factor = 1.0_dp
!         return

        if (cc_amp_norm(norm_comp, 3) < EPS) then
            fac_triples = 0.0_dp

            ! fix the weight in this case
            weight = 1.0_dp

        else
            ! for now just deal with the L^0 norm of the triples
            fac_triples = min(AllEXLEVEL_WNorm(norm_comp, 3, 1) &
                              / cc_amp_norm(norm_comp, 3), 1.0_dp)

        end if

        ! with the doubles i am scared that the estimated number of
        ! doubles could actually be lower then the sampled ones..
        if (cc_amp_norm(norm_comp, 2) < EPS) then

            fac_doubles = 0.0_dp

            weight = 0.0_dp

        else
            ! but 1 should be the maximum..
            fac_doubles = min(AllEXLEVEL_WNorm(0, 2, 1) &
                              / cc_amp_norm(norm_comp, 2), 1.0_dp)
        end if

        ! and then we have to combine the two factors with some weighting
        factor = 1.0_dp - (weight * fac_doubles + (1.0_dp - weight) * fac_triples)

    end function cc_singles_factor