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