/* the L=0 normalization constant
* [Abramowitz+Stegun 14.1.8]
*/
static
double
C0sq(double eta)
{
double twopieta = 2.0*M_PI*eta;
if(fabs(eta) < GSL_DBL_EPSILON) {
return 1.0;
}
else if(twopieta > GSL_LOG_DBL_MAX) {
return 0.0;
}
else {
gsl_sf_result scale;
gsl_sf_expm1_e(twopieta, &scale);
return twopieta/scale.val;
}
}
double gsl_sf_expm1(const double x)
{
EVAL_RESULT(gsl_sf_expm1_e(x, &result));
}
/*
C When ABS(X) is so small that substantial cancellation will occur if
C the straightforward formula is used, we use an expansion due
C to Fields and discussed by Y. L. Luke, The Special Functions and Their
C Approximations, Vol. 1, Academic Press, 1969, page 34.
C
C The ratio POCH(A,X) = GAMMA(A+X)/GAMMA(A) is written by Luke as
C (A+(X-1)/2)**X * polynomial in (A+(X-1)/2)**(-2) .
C In order to maintain significance in POCH1, we write for positive a
C (A+(X-1)/2)**X = EXP(X*LOG(A+(X-1)/2)) = EXP(Q)
C = 1.0 + Q*EXPREL(Q) .
C Likewise the polynomial is written
C POLY = 1.0 + X*POLY1(A,X) .
C Thus,
C POCH1(A,X) = (POCH(A,X) - 1) / X
C = EXPREL(Q)*(Q/X + Q*POLY1(A,X)) + POLY1(A,X)
C
*/
static
int
pochrel_smallx(const double a, const double x, gsl_sf_result * result)
{
/*
SQTBIG = 1.0D0/SQRT(24.0D0*D1MACH(1))
ALNEPS = LOG(D1MACH(3))
*/
const double SQTBIG = 1.0/(2.0*M_SQRT2*M_SQRT3*GSL_SQRT_DBL_MIN);
const double ALNEPS = GSL_LOG_DBL_EPSILON - M_LN2;
if(x == 0.0) {
return gsl_sf_psi_e(a, result);
}
else {
const double bp = ( (a < -0.5) ? 1.0-a-x : a );
const int incr = ( (bp < 10.0) ? 11.0-bp : 0 );
const double b = bp + incr;
double dpoch1;
gsl_sf_result dexprl;
int stat_dexprl;
int i;
double var = b + 0.5*(x-1.0);
double alnvar = log(var);
double q = x*alnvar;
double poly1 = 0.0;
if(var < SQTBIG) {
const int nterms = (int)(-0.5*ALNEPS/alnvar + 1.0);
const double var2 = (1.0/var)/var;
const double rho = 0.5 * (x + 1.0);
double term = var2;
double gbern[24];
int k, j;
gbern[1] = 1.0;
gbern[2] = -rho/12.0;
poly1 = gbern[2] * term;
if(nterms > 20) {
/* NTERMS IS TOO BIG, MAYBE D1MACH(3) IS BAD */
/* nterms = 20; */
result->val = 0.0;
result->err = 0.0;
GSL_ERROR ("error", GSL_ESANITY);
}
for(k=2; k<=nterms; k++) {
double gbk = 0.0;
for(j=1; j<=k; j++) {
gbk += bern[k-j+1]*gbern[j];
}
gbern[k+1] = -rho*gbk/k;
term *= (2*k-2-x)*(2*k-1-x)*var2;
poly1 += gbern[k+1]*term;
}
}
stat_dexprl = gsl_sf_expm1_e(q, &dexprl);
if(stat_dexprl != GSL_SUCCESS) {
result->val = 0.0;
result->err = 0.0;
return stat_dexprl;
}
dexprl.val = dexprl.val/q;
poly1 *= (x - 1.0);
dpoch1 = dexprl.val * (alnvar + q * poly1) + poly1;
for(i=incr-1; i >= 0; i--) {
/*
C WE HAVE DPOCH1(B,X), BUT BP IS SMALL, SO WE USE BACKWARDS RECURSION
C TO OBTAIN DPOCH1(BP,X).
*/
double binv = 1.0/(bp+i);
dpoch1 = (dpoch1 - binv) / (1.0 + x*binv);
}
if(bp == a) {
result->val = dpoch1;
result->err = 2.0 * GSL_DBL_EPSILON * (fabs(incr) + 1.0) * fabs(result->val);
return GSL_SUCCESS;
}
else {
/*
C WE HAVE DPOCH1(BP,X), BUT A IS LT -0.5. WE THEREFORE USE A
C REFLECTION FORMULA TO OBTAIN DPOCH1(A,X).
*/
double sinpxx = sin(M_PI*x)/x;
double sinpx2 = sin(0.5*M_PI*x);
double t1 = sinpxx/tan(M_PI*b);
double t2 = 2.0*sinpx2*(sinpx2/x);
double trig = t1 - t2;
result->val = dpoch1 * (1.0 + x*trig) + trig;
result->err = (fabs(dpoch1*x) + 1.0) * GSL_DBL_EPSILON * (fabs(t1) + fabs(t2));
result->err += 2.0 * GSL_DBL_EPSILON * (fabs(incr) + 1.0) * fabs(result->val);
return GSL_SUCCESS;
}
}
}
/**
* C++ version of gsl_sf_expm1_e().
* exp(x)-1
* @param x A real number
* @param result The result as a @c gsl::sf::result object
* @return GSL_SUCCESS or GSL_EOVRFLW
*/
inline int expm1_e( double const x, result& result ){
return gsl_sf_expm1_e( x, &result ); }
