/* Q large x asymptotic
*/
static
int
gamma_inc_Q_large_x(const double a, const double x, gsl_sf_result * result)
{
const int nmax = 5000;
gsl_sf_result D;
const int stat_D = gamma_inc_D(a, x, &D);
double sum = 1.0;
double term = 1.0;
double last = 1.0;
int n;
for(n=1; n<nmax; n++) {
term *= (a-n)/x;
if(fabs(term/last) > 1.0) break;
if(fabs(term/sum) < GSL_DBL_EPSILON) break;
sum += term;
last = term;
}
result->val = D.val * (a/x) * sum;
result->err = D.err * fabs((a/x) * sum);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
if(n == nmax)
GSL_ERROR ("error", GSL_EMAXITER);
else
return stat_D;
}
/* P series representation.
*/
static
int
gamma_inc_P_series(const double a, const double x, gsl_sf_result * result)
{
const int nmax = 5000;
gsl_sf_result D;
int stat_D = gamma_inc_D(a, x, &D);
double sum = 1.0;
double term = 1.0;
int n;
for(n=1; n<nmax; n++) {
term *= x/(a+n);
sum += term;
if(fabs(term/sum) < GSL_DBL_EPSILON) break;
}
result->val = D.val * sum;
result->err = D.err * fabs(sum);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
if(n == nmax)
GSL_ERROR ("error", GSL_EMAXITER);
else
return stat_D;
}
/* Continued fraction for Q.
*
* Q(a,x) = D(a,x) a/x F(a,x)
* 1 (1-a)/x 1/x (2-a)/x 2/x (3-a)/x
* F(a.x) = ---- ------- ----- -------- ----- -------- ...
* 1 + 1 + 1 + 1 + 1 + 1 +
*
* Uses Gautschi equivalent series method for the CF evaluation.
*
* Assumes a != x + 1, so that the first term of the
* CF recursion is not undefined. This is why we need
* gamma_inc_Q_CF_protected() below. Based on a problem
* report by Teemu Ikonen [Tue Oct 10 12:17:19 MDT 2000].
*/
static
int
gamma_inc_Q_CF(const double a, const double x, gsl_sf_result * result)
{
const int kmax = 5000;
gsl_sf_result D;
const int stat_D = gamma_inc_D(a, x, &D);
double sum = 1.0;
double tk = 1.0;
double rhok = 0.0;
int k;
for(k=1; k<kmax; k++) {
double ak;
if(GSL_IS_ODD(k))
ak = (0.5*(k+1.0)-a)/x;
else
ak = 0.5*k/x;
rhok = -ak*(1.0 + rhok)/(1.0 + ak*(1.0 + rhok));
tk *= rhok;
sum += tk;
if(fabs(tk/sum) < GSL_DBL_EPSILON) break;
}
result->val = D.val * (a/x) * sum;
result->err = D.err * fabs((a/x) * sum);
result->err += GSL_DBL_EPSILON * (2.0 + 0.5*k) * fabs(result->val);
if(k == kmax)
GSL_ERROR ("error", GSL_EMAXITER);
else
return stat_D;
}
/* See note above for gamma_inc_Q_CF(). */
static
int
gamma_inc_Q_CF_protected(const double a, const double x, gsl_sf_result * result)
{
if(fabs(1.0 - a + x) < 2.0*GSL_DBL_EPSILON) {
/*
* This is a problem region because when
* 1.0 - a + x = 0 the first term of the
* CF recursion is undefined.
*
* I missed this condition when I first
* implemented gamma_inc_Q_CF() function,
* so now I have to fix it by side-stepping
* this point, using the recursion relation
* Q(a,x) = Q(a-1,x) + x^(a-1) e^(-z) / Gamma(a)
* = Q(a-1,x) + D(a-1,x)
* to lower 'a' by one, giving an a=x point,
* which is fine.
*/
gsl_sf_result D;
gsl_sf_result tmp_CF;
const int stat_tmp_CF = gamma_inc_Q_CF(a-1.0, x, &tmp_CF);
const int stat_D = gamma_inc_D(a-1.0, x, &D);
result->val = tmp_CF.val + D.val;
result->err = tmp_CF.err + D.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_tmp_CF, stat_D);
}
else {
return gamma_inc_Q_CF(a, x, result);
}
}
/* Continued fraction for Q.
*
* Q(a,x) = D(a,x) a/x F(a,x)
*
* Hans E. Plesser, 2002-01-22 (hans dot plesser at itf dot nlh dot no):
*
* Since the Gautschi equivalent series method for CF evaluation may lead
* to singularities, I have replaced it with the modified Lentz algorithm
* given in
*
* I J Thompson and A R Barnett
* Coulomb and Bessel Functions of Complex Arguments and Order
* J Computational Physics 64:490-509 (1986)
*
* In consequence, gamma_inc_Q_CF_protected() is now obsolete and has been
* removed.
*
* Identification of terms between the above equation for F(a, x) and
* the first equation in the appendix of Thompson&Barnett is as follows:
*
* b_0 = 0, b_n = 1 for all n > 0
*
* a_1 = 1
* a_n = (n/2-a)/x for n even
* a_n = (n-1)/(2x) for n odd
*
*/
static
int
gamma_inc_Q_CF(const double a, const double x, gsl_sf_result * result)
{
gsl_sf_result D;
gsl_sf_result F;
const int stat_D = gamma_inc_D(a, x, &D);
const int stat_F = gamma_inc_F_CF(a, x, &F);
result->val = D.val * (a/x) * F.val;
result->err = D.err * fabs((a/x) * F.val) + fabs(D.val * a/x * F.err);
return GSL_ERROR_SELECT_2(stat_F, stat_D);
}
