int gsl_sf_erf_Q_e(double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
{
gsl_sf_result result_erfc;
int stat = gsl_sf_erfc_e(x / M_SQRT2, &result_erfc);
result->val = 0.5 * result_erfc.val;
result->err = 0.5 * result_erfc.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat;
}
}
/* Uniform asymptotic for x near a, a and x large.
* See [Temme, p. 285]
*/
static
int
gamma_inc_Q_asymp_unif(const double a, const double x, gsl_sf_result * result)
{
const double rta = sqrt(a);
const double eps = (x-a)/a;
gsl_sf_result ln_term;
const int stat_ln = gsl_sf_log_1plusx_mx_e(eps, &ln_term); /* log(1+eps) - eps */
const double eta = GSL_SIGN(eps) * sqrt(-2.0*ln_term.val);
gsl_sf_result erfc;
double R;
double c0, c1;
/* This used to say erfc(eta*M_SQRT2*rta), which is wrong.
* The sqrt(2) is in the denominator. Oops.
* Fixed: [GJ] Mon Nov 15 13:25:32 MST 2004
*/
gsl_sf_erfc_e(eta*rta/M_SQRT2, &erfc);
if(fabs(eps) < GSL_ROOT5_DBL_EPSILON) {
c0 = -1.0/3.0 + eps*(1.0/12.0 - eps*(23.0/540.0 - eps*(353.0/12960.0 - eps*589.0/30240.0)));
c1 = -1.0/540.0 - eps/288.0;
}
else {
const double rt_term = sqrt(-2.0 * ln_term.val/(eps*eps));
const double lam = x/a;
c0 = (1.0 - 1.0/rt_term)/eps;
c1 = -(eta*eta*eta * (lam*lam + 10.0*lam + 1.0) - 12.0 * eps*eps*eps) / (12.0 * eta*eta*eta*eps*eps*eps);
}
R = exp(-0.5*a*eta*eta)/(M_SQRT2*M_SQRTPI*rta) * (c0 + c1/a);
result->val = 0.5 * erfc.val + R;
result->err = GSL_DBL_EPSILON * fabs(R * 0.5 * a*eta*eta) + 0.5 * erfc.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_ln;
}
/* Uniform asymptotic for x near a, a and x large.
* See [Temme, p. 285]
* FIXME: need c1 coefficient
*/
static
int
gamma_inc_Q_asymp_unif(const double a, const double x, gsl_sf_result * result)
{
const double rta = sqrt(a);
const double eps = (x-a)/a;
gsl_sf_result ln_term;
const int stat_ln = gsl_sf_log_1plusx_mx_e(eps, &ln_term); /* log(1+eps) - eps */
const double eta = eps * sqrt(-2.0*ln_term.val/(eps*eps));
gsl_sf_result erfc;
double R;
double c0, c1;
gsl_sf_erfc_e(eta*M_SQRT2*rta, &erfc);
if(fabs(eps) < GSL_ROOT5_DBL_EPSILON) {
c0 = -1.0/3.0 + eps*(1.0/12.0 - eps*(23.0/540.0 - eps*(353.0/12960.0 - eps*589.0/30240.0)));
c1 = 0.0;
}
else {
double rt_term;
rt_term = sqrt(-2.0 * ln_term.val/(eps*eps));
c0 = (1.0 - 1.0/rt_term)/eps;
c1 = 0.0;
}
R = exp(-0.5*a*eta*eta)/(M_SQRT2*M_SQRTPI*rta) * (c0 + c1/a);
result->val = 0.5 * erfc.val + R;
result->err = GSL_DBL_EPSILON * fabs(R * 0.5 * a*eta*eta) + 0.5 * erfc.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_ln;
}
static VALUE Error_erfc_e(VALUE self, VALUE x) {
int ret;
gsl_sf_result r;
ret = gsl_sf_erfc_e(NUM2DBL(x), &r);
return RESULT(&r);
}
double gsl_sf_erfc (double x)
{
EVAL_RESULT (gsl_sf_erfc_e (x, &result));
}
