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