int
gsl_sf_hyperg_2F1_renorm_e(const double a, const double b, const double c,
const double x,
gsl_sf_result * result
)
{
const double rinta = floor(a + 0.5);
const double rintb = floor(b + 0.5);
const double rintc = floor(c + 0.5);
const int a_neg_integer = ( a < 0.0 && fabs(a - rinta) < locEPS );
const int b_neg_integer = ( b < 0.0 && fabs(b - rintb) < locEPS );
const int c_neg_integer = ( c < 0.0 && fabs(c - rintc) < locEPS );
if(c_neg_integer) {
if((a_neg_integer && a > c+0.1) || (b_neg_integer && b > c+0.1)) {
/* 2F1 terminates early */
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else {
/* 2F1 does not terminate early enough, so something survives */
/* [Abramowitz+Stegun, 15.1.2] */
gsl_sf_result g1, g2, g3, g4, g5;
double s1, s2, s3, s4, s5;
int stat = 0;
stat += gsl_sf_lngamma_sgn_e(a-c+1, &g1, &s1);
stat += gsl_sf_lngamma_sgn_e(b-c+1, &g2, &s2);
stat += gsl_sf_lngamma_sgn_e(a, &g3, &s3);
stat += gsl_sf_lngamma_sgn_e(b, &g4, &s4);
stat += gsl_sf_lngamma_sgn_e(-c+2, &g5, &s5);
if(stat != 0) {
DOMAIN_ERROR(result);
}
else {
gsl_sf_result F;
int stat_F = gsl_sf_hyperg_2F1_e(a-c+1, b-c+1, -c+2, x, &F);
double ln_pre_val = g1.val + g2.val - g3.val - g4.val - g5.val;
double ln_pre_err = g1.err + g2.err + g3.err + g4.err + g5.err;
double sg = s1 * s2 * s3 * s4 * s5;
int stat_e = gsl_sf_exp_mult_err_e(ln_pre_val, ln_pre_err,
sg * F.val, F.err,
result);
return GSL_ERROR_SELECT_2(stat_e, stat_F);
}
}
}
else {
/* generic c */
gsl_sf_result F;
gsl_sf_result lng;
double sgn;
int stat_g = gsl_sf_lngamma_sgn_e(c, &lng, &sgn);
int stat_F = gsl_sf_hyperg_2F1_e(a, b, c, x, &F);
int stat_e = gsl_sf_exp_mult_err_e(-lng.val, lng.err,
sgn*F.val, F.err,
result);
return GSL_ERROR_SELECT_3(stat_e, stat_F, stat_g);
}
}
int
gsl_sf_hyperg_2F1_conj_renorm_e(const double aR, const double aI, const double c,
const double x,
gsl_sf_result * result
)
{
const double rintc = floor(c + 0.5);
const double rinta = floor(aR + 0.5);
const int a_neg_integer = ( aR < 0.0 && fabs(aR-rinta) < locEPS && aI == 0.0);
const int c_neg_integer = ( c < 0.0 && fabs(c - rintc) < locEPS );
if(c_neg_integer) {
if(a_neg_integer && aR > c+0.1) {
/* 2F1 terminates early */
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else {
/* 2F1 does not terminate early enough, so something survives */
/* [Abramowitz+Stegun, 15.1.2] */
gsl_sf_result g1, g2;
gsl_sf_result g3;
gsl_sf_result a1, a2;
int stat = 0;
stat += gsl_sf_lngamma_complex_e(aR-c+1, aI, &g1, &a1);
stat += gsl_sf_lngamma_complex_e(aR, aI, &g2, &a2);
stat += gsl_sf_lngamma_e(-c+2.0, &g3);
if(stat != 0) {
DOMAIN_ERROR(result);
}
else {
gsl_sf_result F;
int stat_F = gsl_sf_hyperg_2F1_conj_e(aR-c+1, aI, -c+2, x, &F);
double ln_pre_val = 2.0*(g1.val - g2.val) - g3.val;
double ln_pre_err = 2.0 * (g1.err + g2.err) + g3.err;
int stat_e = gsl_sf_exp_mult_err_e(ln_pre_val, ln_pre_err,
F.val, F.err,
result);
return GSL_ERROR_SELECT_2(stat_e, stat_F);
}
}
}
else {
/* generic c */
gsl_sf_result F;
gsl_sf_result lng;
double sgn;
int stat_g = gsl_sf_lngamma_sgn_e(c, &lng, &sgn);
int stat_F = gsl_sf_hyperg_2F1_conj_e(aR, aI, c, x, &F);
int stat_e = gsl_sf_exp_mult_err_e(-lng.val, lng.err,
sgn*F.val, F.err,
result);
return GSL_ERROR_SELECT_3(stat_e, stat_F, stat_g);
}
}
int gsl_sf_bessel_K0_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x <= 0.0) {
DOMAIN_ERROR(result);
}
else if(x <= 2.0) {
const double lx = log(x);
int stat_I0;
gsl_sf_result I0;
gsl_sf_result c;
cheb_eval_e(&bk0_cs, 0.5*x*x-1.0, &c);
stat_I0 = gsl_sf_bessel_I0_e(x, &I0);
result->val = (-lx+M_LN2)*I0.val - 0.25 + c.val;
result->err = (fabs(lx) + M_LN2) * I0.err + c.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_I0;
}
else {
gsl_sf_result K0_scaled;
int stat_K0 = gsl_sf_bessel_K0_scaled_e(x, &K0_scaled);
int stat_e = gsl_sf_exp_mult_err_e(-x, GSL_DBL_EPSILON*fabs(x),
K0_scaled.val, K0_scaled.err,
result);
return GSL_ERROR_SELECT_2(stat_e, stat_K0);
}
}
int gsl_sf_bessel_K1_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x <= 0.0) {
DOMAIN_ERROR(result);
}
else if(x < 2.0*GSL_DBL_MIN) {
OVERFLOW_ERROR(result);
}
else if(x <= 2.0) {
const double lx = log(x);
int stat_I1;
gsl_sf_result I1;
gsl_sf_result c;
cheb_eval_e(&bk1_cs, 0.5*x*x-1.0, &c);
stat_I1 = gsl_sf_bessel_I1_e(x, &I1);
result->val = (lx-M_LN2)*I1.val + (0.75 + c.val)/x;
result->err = c.err/x + fabs(lx)*I1.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_I1;
}
else {
gsl_sf_result K1_scaled;
int stat_K1 = gsl_sf_bessel_K1_scaled_e(x, &K1_scaled);
int stat_e = gsl_sf_exp_mult_err_e(-x, 0.0,
K1_scaled.val, K1_scaled.err,
result);
result->err = fabs(result->val) * (GSL_DBL_EPSILON*fabs(x) + K1_scaled.err/K1_scaled.val);
return GSL_ERROR_SELECT_2(stat_e, stat_K1);
}
}
int
gsl_sf_result_smash_e(const gsl_sf_result_e10 * re, gsl_sf_result * r)
{
if(re->e10 == 0) {
/* nothing to smash */
r->val = re->val;
r->err = re->err;
return GSL_SUCCESS;
}
else {
const double av = fabs(re->val);
const double ae = fabs(re->err);
if( GSL_SQRT_DBL_MIN < av && av < GSL_SQRT_DBL_MAX
&& GSL_SQRT_DBL_MIN < ae && ae < GSL_SQRT_DBL_MAX
&& 0.49*GSL_LOG_DBL_MIN < re->e10 && re->e10 < 0.49*GSL_LOG_DBL_MAX
) {
const double scale = exp(re->e10 * M_LN10);
r->val = re->val * scale;
r->err = re->err * scale;
return GSL_SUCCESS;
}
else {
return gsl_sf_exp_mult_err_e(re->e10*M_LN10, 0.0, re->val, re->err, r);
}
}
/*
int stat_v;
int stat_e;
if(re->val == 0.0) {
r->val = 0.0;
stat_v = GSL_SUCCESS;
}
else {
gsl_sf_result r_val;
const double s = GSL_SIGN(re->val);
const double x_v = re->e10*M_LN10 + log(fabs(re->val));
stat_v = gsl_sf_exp_e(x_v, &r_val);
r->val = s * r_val.val;
}
if(re->err == 0.0) {
r->err = 0.0;
stat_e = GSL_SUCCESS;
}
else if(re->val != 0.0) {
r->err = fabs(r->val * re->err/re->val);
stat_e = GSL_SUCCESS;
}
else {
gsl_sf_result r_err;
const double x_e = re->e10*M_LN10 + log(fabs(re->err));
stat_e = gsl_sf_exp_e(x_e, &r_err);
r->err = r_err.val;
}
return GSL_ERROR_SELECT_2(stat_v, stat_e);
*/
}
int gsl_sf_psi_n_e(const int n, const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(n == 0)
{
return gsl_sf_psi_e(x, result);
}
else if(n == 1)
{
return gsl_sf_psi_1_e(x, result);
}
else if(n < 0 || x <= 0.0) {
DOMAIN_ERROR(result);
}
else {
gsl_sf_result ln_nf;
gsl_sf_result hzeta;
int stat_hz = gsl_sf_hzeta_e(n+1.0, x, &hzeta);
int stat_nf = gsl_sf_lnfact_e((unsigned int) n, &ln_nf);
int stat_e = gsl_sf_exp_mult_err_e(ln_nf.val, ln_nf.err,
hzeta.val, hzeta.err,
result);
if(GSL_IS_EVEN(n)) result->val = -result->val;
return GSL_ERROR_SELECT_3(stat_e, stat_nf, stat_hz);
}
}
int
gsl_sf_bessel_Knu_e(const double nu, const double x, gsl_sf_result * result)
{
gsl_sf_result b;
int stat_K = gsl_sf_bessel_Knu_scaled_e(nu, x, &b);
int stat_e = gsl_sf_exp_mult_err_e(-x, 0.0, b.val, b.err, result);
return GSL_ERROR_SELECT_2(stat_e, stat_K);
}
int
gsl_sf_airy_Bi_deriv_e(const double x, gsl_mode_t mode, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x < -1.0) {
gsl_sf_result a;
gsl_sf_result p;
int status_ap = airy_deriv_mod_phase(x, mode, &a, &p);
double s = sin(p.val);
result->val = a.val * s;
result->err = fabs(result->val * p.err) + fabs(s * a.err);
result->err += GSL_DBL_EPSILON * fabs(result->val);
return status_ap;
}
else if(x < 1.0) {
const double x3 = x*x*x;
const double x2 = x*x;
gsl_sf_result result_c1;
gsl_sf_result result_c2;
cheb_eval_mode_e(&bif_cs, x3, mode, &result_c1);
cheb_eval_mode_e(&big_cs, x3, mode, &result_c2);
result->val = x2 * (result_c1.val + 0.25) + result_c2.val + 0.5;
result->err = x2 * result_c1.err + result_c2.err;
result->err += GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < 2.0) {
const double z = (2.0*x*x*x - 9.0) / 7.0;
gsl_sf_result result_c1;
gsl_sf_result result_c2;
cheb_eval_mode_e(&bif2_cs, z, mode, &result_c1);
cheb_eval_mode_e(&big2_cs, z, mode, &result_c2);
result->val = x*x * (result_c1.val + 0.25) + result_c2.val + 0.5;
result->err = x*x * result_c1.err + result_c2.err;
result->err += GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < GSL_ROOT3_DBL_MAX*GSL_ROOT3_DBL_MAX) {
gsl_sf_result result_bps;
const double arg = 2.0*(x*sqrt(x)/3.0);
int stat_b = gsl_sf_airy_Bi_deriv_scaled_e(x, mode, &result_bps);
int stat_e = gsl_sf_exp_mult_err_e(arg, 1.5*fabs(arg*GSL_DBL_EPSILON),
result_bps.val, result_bps.err,
result);
return GSL_ERROR_SELECT_2(stat_e, stat_b);
}
else {
OVERFLOW_ERROR(result);
}
}
/* generic polygamma; assumes n >= 0 and x > 0
*/
static int
psi_n_xg0(const int n, const double x, gsl_sf_result * result)
{
if(n == 0) {
return gsl_sf_psi_e(x, result);
}
else {
/* Abramowitz + Stegun 6.4.10 */
gsl_sf_result ln_nf;
gsl_sf_result hzeta;
int stat_hz = gsl_sf_hzeta_e(n+1.0, x, &hzeta);
int stat_nf = gsl_sf_lnfact_e((unsigned int) n, &ln_nf);
int stat_e = gsl_sf_exp_mult_err_e(ln_nf.val, ln_nf.err,
hzeta.val, hzeta.err,
result);
if(GSL_IS_EVEN(n)) result->val = -result->val;
return GSL_ERROR_SELECT_3(stat_e, stat_nf, stat_hz);
}
}
/* Calculate series for small eta*lambda.
* Assumes eta > 0, lambda != 0.
*
* This is just the defining hypergeometric for the Legendre function.
*
* P^{mu}_{-1/2 + I lam}(z) = 1/Gamma(l+3/2) ((z+1)/(z-1)^(mu/2)
* 2F1(1/2 - I lam, 1/2 + I lam; l+3/2; (1-z)/2)
* We use
* z = cosh(eta)
* (z-1)/2 = sinh^2(eta/2)
*
* And recall
* H3d = sqrt(Pi Norm /(2 lam^2 sinh(eta))) P^{-l-1/2}_{-1/2 + I lam}(cosh(eta))
*/
static
int
legendre_H3d_series(const int ell, const double lambda, const double eta,
gsl_sf_result * result)
{
const int nmax = 5000;
const double shheta = sinh(0.5*eta);
const double ln_zp1 = M_LN2 + log(1.0 + shheta*shheta);
const double ln_zm1 = M_LN2 + 2.0*log(shheta);
const double zeta = -shheta*shheta;
gsl_sf_result lg_lp32;
double term = 1.0;
double sum = 1.0;
double sum_err = 0.0;
gsl_sf_result lnsheta;
double lnN;
double lnpre_val, lnpre_err, lnprepow;
int stat_e;
int n;
gsl_sf_lngamma_e(ell + 3.0/2.0, &lg_lp32);
gsl_sf_lnsinh_e(eta, &lnsheta);
legendre_H3d_lnnorm(ell, lambda, &lnN);
lnprepow = 0.5*(ell + 0.5) * (ln_zm1 - ln_zp1);
lnpre_val = lnprepow + 0.5*(lnN + M_LNPI - M_LN2 - lnsheta.val) - lg_lp32.val - log(fabs(lambda));
lnpre_err = lnsheta.err + lg_lp32.err + GSL_DBL_EPSILON * fabs(lnpre_val);
lnpre_err += 2.0*GSL_DBL_EPSILON * (fabs(lnN) + M_LNPI + M_LN2);
lnpre_err += 2.0*GSL_DBL_EPSILON * (0.5*(ell + 0.5) * (fabs(ln_zm1) + fabs(ln_zp1)));
for(n=1; n<nmax; n++) {
double aR = n - 0.5;
term *= (aR*aR + lambda*lambda)*zeta/(ell + n + 0.5)/n;
sum += term;
sum_err += 2.0*GSL_DBL_EPSILON*fabs(term);
if(fabs(term/sum) < 2.0 * GSL_DBL_EPSILON) break;
}
stat_e = gsl_sf_exp_mult_err_e(lnpre_val, lnpre_err, sum, fabs(term)+sum_err, result);
return GSL_ERROR_SELECT_2(stat_e, (n==nmax ? GSL_EMAXITER : GSL_SUCCESS));
}
int
gsl_sf_airy_Ai_deriv_e(const double x, gsl_mode_t mode, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x < -1.0) {
gsl_sf_result a;
gsl_sf_result p;
int status_ap = airy_deriv_mod_phase(x, mode, &a, &p);
double c = cos(p.val);
result->val = a.val * c;
result->err = fabs(result->val * p.err) + fabs(c * a.err);
result->err += GSL_DBL_EPSILON * fabs(result->val);
return status_ap;
}
else if(x < 1.0) {
const double x3 = x*x*x;
gsl_sf_result result_c1;
gsl_sf_result result_c2;
cheb_eval_mode_e(&aif_cs, x3, mode, &result_c1);
cheb_eval_mode_e(&aig_cs, x3, mode, &result_c2);
result->val = (x*x*(0.125 + result_c1.val) - result_c2.val) - 0.25;
result->err = fabs(x*x*result_c1.err) + result_c2.err;
result->err += GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x*x*x < 9.0/4.0 * GSL_LOG_DBL_MIN*GSL_LOG_DBL_MIN) {
gsl_sf_result result_aps;
const double arg = -2.0*x*sqrt(x)/3.0;
const int stat_a = gsl_sf_airy_Ai_deriv_scaled_e(x, mode, &result_aps);
const int stat_e = gsl_sf_exp_mult_err_e(arg, 1.5*fabs(arg*GSL_DBL_EPSILON),
result_aps.val, result_aps.err,
result);
return GSL_ERROR_SELECT_2(stat_e, stat_a);
}
else {
UNDERFLOW_ERROR(result);
}
}
int
gsl_sf_hyperg_0F1_e(double c, double x, gsl_sf_result * result)
{
const double rintc = floor(c + 0.5);
const int c_neg_integer = (c < 0.0 && fabs(c - rintc) < locEPS);
/* CHECK_POINTER(result) */
if(c == 0.0 || c_neg_integer) {
DOMAIN_ERROR(result);
}
else if(x < 0.0) {
gsl_sf_result Jcm1;
gsl_sf_result lg_c;
double sgn;
int stat_g = gsl_sf_lngamma_sgn_e(c, &lg_c, &sgn);
int stat_J = hyperg_0F1_bessel_J(c-1.0, 2.0*sqrt(-x), &Jcm1);
if(stat_g != GSL_SUCCESS) {
result->val = 0.0;
result->err = 0.0;
return stat_g;
}
else if(Jcm1.val == 0.0) {
result->val = 0.0;
result->err = 0.0;
return stat_J;
}
else {
const double tl = log(-x)*0.5*(1.0-c);
double ln_pre_val = lg_c.val + tl;
double ln_pre_err = lg_c.err + 2.0 * GSL_DBL_EPSILON * fabs(tl);
return gsl_sf_exp_mult_err_e(ln_pre_val, ln_pre_err,
sgn*Jcm1.val, Jcm1.err,
result);
}
}
else if(x == 0.0) {
result->val = 1.0;
result->err = 1.0;
return GSL_SUCCESS;
}
else {
gsl_sf_result Icm1;
gsl_sf_result lg_c;
double sgn;
int stat_g = gsl_sf_lngamma_sgn_e(c, &lg_c, &sgn);
int stat_I = hyperg_0F1_bessel_I(c-1.0, 2.0*sqrt(x), &Icm1);
if(stat_g != GSL_SUCCESS) {
result->val = 0.0;
result->err = 0.0;
return stat_g;
}
else if(Icm1.val == 0.0) {
result->val = 0.0;
result->err = 0.0;
return stat_I;
}
else {
const double tl = log(x)*0.5*(1.0-c);
const double ln_pre_val = lg_c.val + tl;
const double ln_pre_err = lg_c.err + 2.0 * GSL_DBL_EPSILON * fabs(tl);
return gsl_sf_exp_mult_err_e(ln_pre_val, ln_pre_err,
sgn*Icm1.val, Icm1.err,
result);
}
}
}
/* series of hypergeometric functions for integer j > 0, x > 0
* [Goano (7)]
*/
static
int
fd_UMseries_int(const int j, const double x, gsl_sf_result * result)
{
const int nmax = 2000;
double pre;
double lnpre_val;
double lnpre_err;
double sum_even_val = 1.0;
double sum_even_err = 0.0;
double sum_odd_val = 0.0;
double sum_odd_err = 0.0;
int stat_sum;
int stat_e;
int stat_h = GSL_SUCCESS;
int n;
if(x < 500.0 && j < 80) {
double p = gsl_sf_pow_int(x, j+1);
gsl_sf_result g;
gsl_sf_fact_e(j+1, &g); /* Gamma(j+2) */
lnpre_val = 0.0;
lnpre_err = 0.0;
pre = p/g.val;
}
else {
double lnx = log(x);
gsl_sf_result lg;
gsl_sf_lngamma_e(j + 2.0, &lg);
lnpre_val = (j+1.0)*lnx - lg.val;
lnpre_err = 2.0 * GSL_DBL_EPSILON * fabs((j+1.0)*lnx) + lg.err;
pre = 1.0;
}
/* Add up the odd terms of the sum.
*/
for(n=1; n<nmax; n+=2) {
double del_val;
double del_err;
gsl_sf_result U;
gsl_sf_result M;
int stat_h_U = gsl_sf_hyperg_U_int_e(1, j+2, n*x, &U);
int stat_h_F = gsl_sf_hyperg_1F1_int_e(1, j+2, -n*x, &M);
stat_h = GSL_ERROR_SELECT_3(stat_h, stat_h_U, stat_h_F);
del_val = ((j+1.0)*U.val - M.val);
del_err = (fabs(j+1.0)*U.err + M.err);
sum_odd_val += del_val;
sum_odd_err += del_err;
if(fabs(del_val/sum_odd_val) < GSL_DBL_EPSILON) break;
}
/* Add up the even terms of the sum.
*/
for(n=2; n<nmax; n+=2) {
double del_val;
double del_err;
gsl_sf_result U;
gsl_sf_result M;
int stat_h_U = gsl_sf_hyperg_U_int_e(1, j+2, n*x, &U);
int stat_h_F = gsl_sf_hyperg_1F1_int_e(1, j+2, -n*x, &M);
stat_h = GSL_ERROR_SELECT_3(stat_h, stat_h_U, stat_h_F);
del_val = ((j+1.0)*U.val - M.val);
del_err = (fabs(j+1.0)*U.err + M.err);
sum_even_val -= del_val;
sum_even_err += del_err;
if(fabs(del_val/sum_even_val) < GSL_DBL_EPSILON) break;
}
stat_sum = ( n >= nmax ? GSL_EMAXITER : GSL_SUCCESS );
stat_e = gsl_sf_exp_mult_err_e(lnpre_val, lnpre_err,
pre*(sum_even_val + sum_odd_val),
pre*(sum_even_err + sum_odd_err),
result);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_3(stat_e, stat_h, stat_sum);
}
int
gsl_sf_legendre_H3d_e(const int ell, const double lambda, const double eta,
gsl_sf_result * result)
{
const double abs_lam = fabs(lambda);
const double lsq = abs_lam*abs_lam;
const double xi = abs_lam * eta;
const double cosh_eta = cosh(eta);
/* CHECK_POINTER(result) */
if(eta < 0.0) {
DOMAIN_ERROR(result);
}
else if(eta > GSL_LOG_DBL_MAX) {
/* cosh(eta) is too big. */
OVERFLOW_ERROR(result);
}
else if(ell == 0) {
return gsl_sf_legendre_H3d_0_e(lambda, eta, result);
}
else if(ell == 1) {
return gsl_sf_legendre_H3d_1_e(lambda, eta, result);
}
else if(eta == 0.0) {
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(xi < 1.0) {
return legendre_H3d_series(ell, lambda, eta, result);
}
else if((ell*ell+lsq)/sqrt(1.0+lsq)/(cosh_eta*cosh_eta) < 5.0*GSL_ROOT3_DBL_EPSILON) {
/* Large argument.
*/
gsl_sf_result P;
double lm;
int stat_P = gsl_sf_conicalP_large_x_e(-ell-0.5, lambda, cosh_eta, &P, &lm);
if(P.val == 0.0) {
result->val = 0.0;
result->err = 0.0;
return stat_P;
}
else {
double lnN;
gsl_sf_result lnsh;
double ln_abslam;
double lnpre_val, lnpre_err;
int stat_e;
gsl_sf_lnsinh_e(eta, &lnsh);
legendre_H3d_lnnorm(ell, lambda, &lnN);
ln_abslam = log(abs_lam);
lnpre_val = 0.5*(M_LNPI + lnN - M_LN2 - lnsh.val) - ln_abslam;
lnpre_err = lnsh.err;
lnpre_err += 2.0 * GSL_DBL_EPSILON * (0.5*(M_LNPI + M_LN2 + fabs(lnN)) + fabs(ln_abslam));
lnpre_err += 2.0 * GSL_DBL_EPSILON * fabs(lnpre_val);
stat_e = gsl_sf_exp_mult_err_e(lnpre_val + lm, lnpre_err, P.val, P.err, result);
return GSL_ERROR_SELECT_2(stat_e, stat_P);
}
}
else if(abs_lam > 1000.0*ell*ell) {
/* Large degree.
*/
gsl_sf_result P;
double lm;
int stat_P = gsl_sf_conicalP_xgt1_neg_mu_largetau_e(ell+0.5,
lambda,
cosh_eta, eta,
&P, &lm);
if(P.val == 0.0) {
result->val = 0.0;
result->err = 0.0;
return stat_P;
}
else {
double lnN;
gsl_sf_result lnsh;
double ln_abslam;
double lnpre_val, lnpre_err;
int stat_e;
gsl_sf_lnsinh_e(eta, &lnsh);
legendre_H3d_lnnorm(ell, lambda, &lnN);
ln_abslam = log(abs_lam);
lnpre_val = 0.5*(M_LNPI + lnN - M_LN2 - lnsh.val) - ln_abslam;
lnpre_err = lnsh.err;
lnpre_err += GSL_DBL_EPSILON * (0.5*(M_LNPI + M_LN2 + fabs(lnN)) + fabs(ln_abslam));
lnpre_err += 2.0 * GSL_DBL_EPSILON * fabs(lnpre_val);
stat_e = gsl_sf_exp_mult_err_e(lnpre_val + lm, lnpre_err, P.val, P.err, result);
return GSL_ERROR_SELECT_2(stat_e, stat_P);
}
}
else {
/* Backward recurrence.
*/
const double coth_eta = 1.0/tanh(eta);
const double coth_err_mult = fabs(eta) + 1.0;
gsl_sf_result rH;
int stat_CF1 = legendre_H3d_CF1_ser(ell, lambda, coth_eta, &rH);
double Hlm1;
double Hl = GSL_SQRT_DBL_MIN;
double Hlp1 = rH.val * Hl;
int lp;
for(lp=ell; lp>0; lp--) {
double root_term_0 = sqrt(lambda*lambda + (double)lp*lp);
double root_term_1 = sqrt(lambda*lambda + (lp+1.0)*(lp+1.0));
Hlm1 = ((2.0*lp + 1.0)*coth_eta*Hl - root_term_1 * Hlp1)/root_term_0;
Hlp1 = Hl;
Hl = Hlm1;
}
if(fabs(Hl) > fabs(Hlp1)) {
gsl_sf_result H0;
int stat_H0 = gsl_sf_legendre_H3d_0_e(lambda, eta, &H0);
result->val = GSL_SQRT_DBL_MIN/Hl * H0.val;
result->err = GSL_SQRT_DBL_MIN/fabs(Hl) * H0.err;
result->err += fabs(rH.err/rH.val) * (ell+1.0) * coth_err_mult * fabs(result->val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_H0, stat_CF1);
}
else {
gsl_sf_result H1;
int stat_H1 = gsl_sf_legendre_H3d_1_e(lambda, eta, &H1);
result->val = GSL_SQRT_DBL_MIN/Hlp1 * H1.val;
result->err = GSL_SQRT_DBL_MIN/fabs(Hlp1) * H1.err;
result->err += fabs(rH.err/rH.val) * (ell+1.0) * coth_err_mult * fabs(result->val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_H1, stat_CF1);
}
}
}
/**
* C++ version of gsl_sf_exp_mult_err_e().
* Exponentiate and multiply by a given factor: y * Exp(x),
* for quantities with associated errors.
* @param x A real number
* @param dx A real number
* @param y A real number
* @param dy A real number
* @param result The result as a @c gsl::sf::result object
* @return GSL_SUCCESS or GSL_EUNDRFLW or GSL_EOVRFLW
*/
inline int exp_mult_err_e( double const x, double const dx,
double const y, double const dy, result& result ){
return gsl_sf_exp_mult_err_e( x, dx, y, dy, &result ); }
/* Do the reflection described in [Moshier, p. 334].
* Assumes a,b,c != neg integer.
*/
static
int
hyperg_2F1_reflect(const double a, const double b, const double c,
const double x, gsl_sf_result * result)
{
const double d = c - a - b;
const int intd = floor(d+0.5);
const int d_integer = ( fabs(d - intd) < locEPS );
if(d_integer) {
const double ln_omx = log(1.0 - x);
const double ad = fabs(d);
int stat_F2 = GSL_SUCCESS;
double sgn_2;
gsl_sf_result F1;
gsl_sf_result F2;
double d1, d2;
gsl_sf_result lng_c;
gsl_sf_result lng_ad2;
gsl_sf_result lng_bd2;
int stat_c;
int stat_ad2;
int stat_bd2;
if(d >= 0.0) {
d1 = d;
d2 = 0.0;
}
else {
d1 = 0.0;
d2 = d;
}
stat_ad2 = gsl_sf_lngamma_e(a+d2, &lng_ad2);
stat_bd2 = gsl_sf_lngamma_e(b+d2, &lng_bd2);
stat_c = gsl_sf_lngamma_e(c, &lng_c);
/* Evaluate F1.
*/
if(ad < GSL_DBL_EPSILON) {
/* d = 0 */
F1.val = 0.0;
F1.err = 0.0;
}
else {
gsl_sf_result lng_ad;
gsl_sf_result lng_ad1;
gsl_sf_result lng_bd1;
int stat_ad = gsl_sf_lngamma_e(ad, &lng_ad);
int stat_ad1 = gsl_sf_lngamma_e(a+d1, &lng_ad1);
int stat_bd1 = gsl_sf_lngamma_e(b+d1, &lng_bd1);
if(stat_ad1 == GSL_SUCCESS && stat_bd1 == GSL_SUCCESS && stat_ad == GSL_SUCCESS) {
/* Gamma functions in the denominator are ok.
* Proceed with evaluation.
*/
int i;
double sum1 = 1.0;
double term = 1.0;
double ln_pre1_val = lng_ad.val + lng_c.val + d2*ln_omx - lng_ad1.val - lng_bd1.val;
double ln_pre1_err = lng_ad.err + lng_c.err + lng_ad1.err + lng_bd1.err + GSL_DBL_EPSILON * fabs(ln_pre1_val);
int stat_e;
/* Do F1 sum.
*/
for(i=1; i<ad; i++) {
int j = i-1;
term *= (a + d2 + j) * (b + d2 + j) / (1.0 + d2 + j) / i * (1.0-x);
sum1 += term;
}
stat_e = gsl_sf_exp_mult_err_e(ln_pre1_val, ln_pre1_err,
sum1, GSL_DBL_EPSILON*fabs(sum1),
&F1);
if(stat_e == GSL_EOVRFLW) {
OVERFLOW_ERROR(result);
}
}
else {
/* Gamma functions in the denominator were not ok.
* So the F1 term is zero.
*/
F1.val = 0.0;
F1.err = 0.0;
}
} /* end F1 evaluation */
/* Evaluate F2.
*/
if(stat_ad2 == GSL_SUCCESS && stat_bd2 == GSL_SUCCESS) {
/* Gamma functions in the denominator are ok.
* Proceed with evaluation.
*/
const int maxiter = 2000;
double psi_1 = -M_EULER;
gsl_sf_result psi_1pd;
gsl_sf_result psi_apd1;
gsl_sf_result psi_bpd1;
int stat_1pd = gsl_sf_psi_e(1.0 + ad, &psi_1pd);
int stat_apd1 = gsl_sf_psi_e(a + d1, &psi_apd1);
int stat_bpd1 = gsl_sf_psi_e(b + d1, &psi_bpd1);
int stat_dall = GSL_ERROR_SELECT_3(stat_1pd, stat_apd1, stat_bpd1);
double psi_val = psi_1 + psi_1pd.val - psi_apd1.val - psi_bpd1.val - ln_omx;
double psi_err = psi_1pd.err + psi_apd1.err + psi_bpd1.err + GSL_DBL_EPSILON*fabs(psi_val);
double fact = 1.0;
double sum2_val = psi_val;
double sum2_err = psi_err;
double ln_pre2_val = lng_c.val + d1*ln_omx - lng_ad2.val - lng_bd2.val;
double ln_pre2_err = lng_c.err + lng_ad2.err + lng_bd2.err + GSL_DBL_EPSILON * fabs(ln_pre2_val);
int stat_e;
int j;
/* Do F2 sum.
*/
for(j=1; j<maxiter; j++) {
/* values for psi functions use recurrence; Abramowitz+Stegun 6.3.5 */
double term1 = 1.0/(double)j + 1.0/(ad+j);
double term2 = 1.0/(a+d1+j-1.0) + 1.0/(b+d1+j-1.0);
double delta = 0.0;
psi_val += term1 - term2;
psi_err += GSL_DBL_EPSILON * (fabs(term1) + fabs(term2));
fact *= (a+d1+j-1.0)*(b+d1+j-1.0)/((ad+j)*j) * (1.0-x);
delta = fact * psi_val;
sum2_val += delta;
sum2_err += fabs(fact * psi_err) + GSL_DBL_EPSILON*fabs(delta);
if(fabs(delta) < GSL_DBL_EPSILON * fabs(sum2_val)) break;
}
if(j == maxiter) stat_F2 = GSL_EMAXITER;
if(sum2_val == 0.0) {
F2.val = 0.0;
F2.err = 0.0;
}
else {
stat_e = gsl_sf_exp_mult_err_e(ln_pre2_val, ln_pre2_err,
sum2_val, sum2_err,
&F2);
if(stat_e == GSL_EOVRFLW) {
result->val = 0.0;
result->err = 0.0;
GSL_ERROR ("error", GSL_EOVRFLW);
}
}
stat_F2 = GSL_ERROR_SELECT_2(stat_F2, stat_dall);
}
else {
/* Gamma functions in the denominator not ok.
* So the F2 term is zero.
*/
F2.val = 0.0;
F2.err = 0.0;
} /* end F2 evaluation */
sgn_2 = ( GSL_IS_ODD(intd) ? -1.0 : 1.0 );
result->val = F1.val + sgn_2 * F2.val;
result->err = F1.err + F2. err;
result->err += 2.0 * GSL_DBL_EPSILON * (fabs(F1.val) + fabs(F2.val));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_F2;
}
else {
/* d not an integer */
gsl_sf_result pre1, pre2;
double sgn1, sgn2;
gsl_sf_result F1, F2;
int status_F1, status_F2;
/* These gamma functions appear in the denominator, so we
* catch their harmless domain errors and set the terms to zero.
*/
gsl_sf_result ln_g1ca, ln_g1cb, ln_g2a, ln_g2b;
double sgn_g1ca, sgn_g1cb, sgn_g2a, sgn_g2b;
int stat_1ca = gsl_sf_lngamma_sgn_e(c-a, &ln_g1ca, &sgn_g1ca);
int stat_1cb = gsl_sf_lngamma_sgn_e(c-b, &ln_g1cb, &sgn_g1cb);
int stat_2a = gsl_sf_lngamma_sgn_e(a, &ln_g2a, &sgn_g2a);
int stat_2b = gsl_sf_lngamma_sgn_e(b, &ln_g2b, &sgn_g2b);
int ok1 = (stat_1ca == GSL_SUCCESS && stat_1cb == GSL_SUCCESS);
int ok2 = (stat_2a == GSL_SUCCESS && stat_2b == GSL_SUCCESS);
gsl_sf_result ln_gc, ln_gd, ln_gmd;
double sgn_gc, sgn_gd, sgn_gmd;
gsl_sf_lngamma_sgn_e( c, &ln_gc, &sgn_gc);
gsl_sf_lngamma_sgn_e( d, &ln_gd, &sgn_gd);
gsl_sf_lngamma_sgn_e(-d, &ln_gmd, &sgn_gmd);
sgn1 = sgn_gc * sgn_gd * sgn_g1ca * sgn_g1cb;
sgn2 = sgn_gc * sgn_gmd * sgn_g2a * sgn_g2b;
if(ok1 && ok2) {
double ln_pre1_val = ln_gc.val + ln_gd.val - ln_g1ca.val - ln_g1cb.val;
double ln_pre2_val = ln_gc.val + ln_gmd.val - ln_g2a.val - ln_g2b.val + d*log(1.0-x);
double ln_pre1_err = ln_gc.err + ln_gd.err + ln_g1ca.err + ln_g1cb.err;
double ln_pre2_err = ln_gc.err + ln_gmd.err + ln_g2a.err + ln_g2b.err;
if(ln_pre1_val < GSL_LOG_DBL_MAX && ln_pre2_val < GSL_LOG_DBL_MAX) {
gsl_sf_exp_err_e(ln_pre1_val, ln_pre1_err, &pre1);
gsl_sf_exp_err_e(ln_pre2_val, ln_pre2_err, &pre2);
pre1.val *= sgn1;
pre2.val *= sgn2;
}
else {
OVERFLOW_ERROR(result);
}
}
else if(ok1 && !ok2) {
double ln_pre1_val = ln_gc.val + ln_gd.val - ln_g1ca.val - ln_g1cb.val;
double ln_pre1_err = ln_gc.err + ln_gd.err + ln_g1ca.err + ln_g1cb.err;
if(ln_pre1_val < GSL_LOG_DBL_MAX) {
gsl_sf_exp_err_e(ln_pre1_val, ln_pre1_err, &pre1);
pre1.val *= sgn1;
pre2.val = 0.0;
pre2.err = 0.0;
}
else {
OVERFLOW_ERROR(result);
}
}
else if(!ok1 && ok2) {
double ln_pre2_val = ln_gc.val + ln_gmd.val - ln_g2a.val - ln_g2b.val + d*log(1.0-x);
double ln_pre2_err = ln_gc.err + ln_gmd.err + ln_g2a.err + ln_g2b.err;
if(ln_pre2_val < GSL_LOG_DBL_MAX) {
pre1.val = 0.0;
pre1.err = 0.0;
gsl_sf_exp_err_e(ln_pre2_val, ln_pre2_err, &pre2);
pre2.val *= sgn2;
}
else {
OVERFLOW_ERROR(result);
}
}
else {
pre1.val = 0.0;
pre2.val = 0.0;
UNDERFLOW_ERROR(result);
}
status_F1 = hyperg_2F1_series( a, b, 1.0-d, 1.0-x, &F1);
status_F2 = hyperg_2F1_series(c-a, c-b, 1.0+d, 1.0-x, &F2);
result->val = pre1.val*F1.val + pre2.val*F2.val;
result->err = fabs(pre1.val*F1.err) + fabs(pre2.val*F2.err);
result->err += fabs(pre1.err*F1.val) + fabs(pre2.err*F2.val);
result->err += 2.0 * GSL_DBL_EPSILON * (fabs(pre1.val*F1.val) + fabs(pre2.val*F2.val));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
}
