int gsl_sf_bessel_I0_e(const double x, gsl_sf_result * result)
{
double y = fabs(x);
/* CHECK_POINTER(result) */
if(y < 2.0 * GSL_SQRT_DBL_EPSILON) {
result->val = 1.0;
result->err = 0.5*y*y;
return GSL_SUCCESS;
}
else if(y <= 3.0) {
gsl_sf_result c;
cheb_eval_e(&bi0_cs, y*y/4.5-1.0, &c);
result->val = 2.75 + c.val;
result->err = GSL_DBL_EPSILON * (2.75 + fabs(c.val));
result->err += c.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(y < GSL_LOG_DBL_MAX - 1.0) {
const double ey = exp(y);
gsl_sf_result b_scaled;
gsl_sf_bessel_I0_scaled_e(x, &b_scaled);
result->val = ey * b_scaled.val;
result->err = ey * b_scaled.err + y*GSL_DBL_EPSILON*fabs(result->val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
OVERFLOW_ERROR(result);
}
}
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);
}
}
/* Evaluate bessel_I(nu, x), allowing nu < 0.
* This is fine here because we do not not allow
* nu to be a negative integer.
* x > 0.
*/
static
int
hyperg_0F1_bessel_I(const double nu, const double x, gsl_sf_result * result)
{
if(x > GSL_LOG_DBL_MAX) {
OVERFLOW_ERROR(result);
}
if(nu < 0.0) {
const double anu = -nu;
const double s = 2.0/M_PI * sin(anu*M_PI);
const double ex = exp(x);
gsl_sf_result I;
gsl_sf_result K;
int stat_I = gsl_sf_bessel_Inu_scaled_e(anu, x, &I);
int stat_K = gsl_sf_bessel_Knu_scaled_e(anu, x, &K);
result->val = ex * I.val + s * (K.val / ex);
result->err = ex * I.err + fabs(s * K.err/ex);
result->err += fabs(s * (K.val/ex)) * GSL_DBL_EPSILON * anu * M_PI;
return GSL_ERROR_SELECT_2(stat_K, stat_I);
}
else {
const double ex = exp(x);
gsl_sf_result I;
int stat_I = gsl_sf_bessel_Inu_scaled_e(nu, x, &I);
result->val = ex * I.val;
result->err = ex * I.err + GSL_DBL_EPSILON * fabs(result->val);
return stat_I;
}
}
int
gsl_sf_hypot_e(const double x, const double y, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x == 0.0 && y == 0.0) {
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else {
const double a = fabs(x);
const double b = fabs(y);
const double min = GSL_MIN_DBL(a,b);
const double max = GSL_MAX_DBL(a,b);
const double rat = min/max;
const double root_term = sqrt(1.0 + rat*rat);
if(max < GSL_DBL_MAX/root_term) {
result->val = max * root_term;
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
OVERFLOW_ERROR(result);
}
}
}
int gsl_sf_hzeta_e(const double s, const double q, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(s <= 1.0 || q <= 0.0) {
DOMAIN_ERROR(result);
}
else {
const double max_bits = 54.0;
const double ln_term0 = -s * log(q);
if(ln_term0 < GSL_LOG_DBL_MIN + 1.0) {
UNDERFLOW_ERROR(result);
}
else if(ln_term0 > GSL_LOG_DBL_MAX - 1.0) {
OVERFLOW_ERROR (result);
}
else if((s > max_bits && q < 1.0) || (s > 0.5*max_bits && q < 0.25)) {
result->val = pow(q, -s);
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(s > 0.5*max_bits && q < 1.0) {
const double p1 = pow(q, -s);
const double p2 = pow(q/(1.0+q), s);
const double p3 = pow(q/(2.0+q), s);
result->val = p1 * (1.0 + p2 + p3);
result->err = GSL_DBL_EPSILON * (0.5*s + 2.0) * fabs(result->val);
return GSL_SUCCESS;
}
else {
/* Euler-Maclaurin summation formula
* [Moshier, p. 400, with several typo corrections]
*/
const int jmax = 12;
const int kmax = 10;
int j, k;
const double pmax = pow(kmax + q, -s);
double scp = s;
double pcp = pmax / (kmax + q);
double ans = pmax*((kmax+q)/(s-1.0) + 0.5);
for(k=0; k<kmax; k++) {
ans += pow(k + q, -s);
}
for(j=0; j<=jmax; j++) {
double delta = hzeta_c[j+1] * scp * pcp;
ans += delta;
if(fabs(delta/ans) < 0.5*GSL_DBL_EPSILON) break;
scp *= (s+2*j+1)*(s+2*j+2);
pcp /= (kmax + q)*(kmax + q);
}
result->val = ans;
result->err = 2.0 * (jmax + 1.0) * GSL_DBL_EPSILON * fabs(ans);
return GSL_SUCCESS;
}
}
}
/* [Abramowitz+Stegun, 10.1.3]
* with lmax=15, precision ~ 15D for x < 3
*
* checked OK [GJ] Wed May 13 15:41:25 MDT 1998
*/
static int bessel_yl_small_x(int l, const double x, gsl_sf_result * result)
{
gsl_sf_result num_fact;
double den = gsl_sf_pow_int(x, l+1);
int stat_df = gsl_sf_doublefact_e(2*l-1, &num_fact);
if(stat_df != GSL_SUCCESS || den == 0.0) {
OVERFLOW_ERROR(result);
}
else {
const int lmax = 200;
double t = -0.5*x*x;
double sum = 1.0;
double t_coeff = 1.0;
double t_power = 1.0;
double delta;
int i;
for(i=1; i<=lmax; i++) {
t_coeff /= i*(2*(i-l) - 1);
t_power *= t;
delta = t_power*t_coeff;
sum += delta;
if(fabs(delta/sum) < 0.5*GSL_DBL_EPSILON) break;
}
result->val = -num_fact.val/den * sum;
result->err = GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
}
int
gsl_sf_pochrel_e(const double a, const double x, gsl_sf_result * result)
{
const double absx = fabs(x);
const double absa = fabs(a);
/* CHECK_POINTER(result) */
if(absx > 0.1*absa || absx*log(GSL_MAX(absa,2.0)) > 0.1) {
gsl_sf_result lnpoch;
double sgn;
int stat_poch = gsl_sf_lnpoch_sgn_e(a, x, &lnpoch, &sgn);
if(lnpoch.val > GSL_LOG_DBL_MAX) {
OVERFLOW_ERROR(result);
}
else {
const double el = exp(lnpoch.val);
result->val = (sgn*el - 1.0)/x;
result->err = fabs(result->val) * (lnpoch.err + 2.0 * GSL_DBL_EPSILON);
result->err += 2.0 * GSL_DBL_EPSILON * (fabs(sgn*el) + 1.0) / fabs(x);
return stat_poch;
}
}
else {
return pochrel_smallx(a, x, result);
}
}
int gsl_sf_expm1_e(const double x, gsl_sf_result * result)
{
const double cut = 0.002;
if(x < GSL_LOG_DBL_MIN) {
result->val = -1.0;
result->err = GSL_DBL_EPSILON;
return GSL_SUCCESS;
}
else if(x < -cut) {
result->val = exp(x) - 1.0;
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < cut) {
result->val = x * (1.0 + 0.5*x*(1.0 + x/3.0*(1.0 + 0.25*x*(1.0 + 0.2*x))));
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < GSL_LOG_DBL_MAX) {
result->val = exp(x) - 1.0;
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
OVERFLOW_ERROR(result);
}
}
int gsl_sf_exprel_2_e(double x, gsl_sf_result * result)
{
const double cut = 0.002;
if(x < GSL_LOG_DBL_MIN) {
result->val = -2.0/x*(1.0 + 1.0/x);
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < -cut) {
result->val = 2.0*(exp(x) - 1.0 - x)/(x*x);
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < cut) {
result->val = (1.0 + 1.0/3.0*x*(1.0 + 0.25*x*(1.0 + 0.2*x*(1.0 + 1.0/6.0*x))));
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < GSL_LOG_DBL_MAX) {
result->val = 2.0*(exp(x) - 1.0 - x)/(x*x);
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
OVERFLOW_ERROR(result);
}
}
int
gsl_sf_multiply_e(const double x, const double y, gsl_sf_result * result)
{
const double ax = fabs(x);
const double ay = fabs(y);
if(x == 0.0 || y == 0.0) {
/* It is necessary to eliminate this immediately.
*/
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else if((ax <= 1.0 && ay >= 1.0) || (ay <= 1.0 && ax >= 1.0)) {
/* Straddling 1.0 is always safe.
*/
result->val = x*y;
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
const double f = 1.0 - 2.0 * GSL_DBL_EPSILON;
const double min = GSL_MIN_DBL(fabs(x), fabs(y));
const double max = GSL_MAX_DBL(fabs(x), fabs(y));
if(max < 0.9 * GSL_SQRT_DBL_MAX || min < (f * DBL_MAX)/max) {
result->val = GSL_COERCE_DBL(x*y);
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
CHECK_UNDERFLOW(result);
return GSL_SUCCESS;
}
else {
OVERFLOW_ERROR(result);
}
}
}
int gsl_sf_fermi_dirac_2_e(const double x, gsl_sf_result * result)
{
if(x < GSL_LOG_DBL_MIN) {
UNDERFLOW_ERROR(result);
}
else if(x < -1.0) {
/* series [Goano (6)]
*/
double ex = exp(x);
double term = ex;
double sum = term;
int n;
for(n=2; n<100 ; n++) {
double rat = (n-1.0)/n;
term *= -ex * rat * rat * rat;
sum += term;
if(fabs(term/sum) < GSL_DBL_EPSILON) break;
}
result->val = sum;
result->err = 2.0 * GSL_DBL_EPSILON * fabs(sum);
return GSL_SUCCESS;
}
else if(x < 1.0) {
return cheb_eval_e(&fd_2_a_cs, x, result);
}
else if(x < 4.0) {
double t = 2.0/3.0*(x-1.0) - 1.0;
return cheb_eval_e(&fd_2_b_cs, t, result);
}
else if(x < 10.0) {
double t = 1.0/3.0*(x-4.0) - 1.0;
return cheb_eval_e(&fd_2_c_cs, t, result);
}
else if(x < 30.0) {
double t = 0.1*x - 2.0;
gsl_sf_result c;
cheb_eval_e(&fd_2_d_cs, t, &c);
result->val = c.val * x*x*x;
result->err = c.err * x*x*x + 3.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < 1.0/GSL_ROOT3_DBL_EPSILON) {
double t = 60.0/x - 1.0;
gsl_sf_result c;
cheb_eval_e(&fd_2_e_cs, t, &c);
result->val = c.val * x*x*x;
result->err = c.err * x*x*x + 3.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < GSL_ROOT3_DBL_MAX) {
result->val = 1.0/6.0 * x*x*x;
result->err = 3.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
OVERFLOW_ERROR(result);
}
}
int gsl_sf_bessel_Y1_e(const double x, gsl_sf_result * result)
{
const double two_over_pi = 2.0/M_PI;
const double xmin = 1.571*GSL_DBL_MIN; /*exp ( amax1(alog(r1mach(1)), -alog(r1mach(2)))+.01) */
const double x_small = 2.0 * GSL_SQRT_DBL_EPSILON;
const double xmax = 1.0/GSL_DBL_EPSILON;
/* CHECK_POINTER(result) */
if(x <= 0.0) {
DOMAIN_ERROR(result);
}
else if(x < xmin) {
OVERFLOW_ERROR(result);
}
else if(x < x_small) {
const double lnterm = log(0.5*x);
gsl_sf_result J1;
gsl_sf_result c;
int status = gsl_sf_bessel_J1_e(x, &J1);
cheb_eval_e(&by1_cs, -1.0, &c);
result->val = two_over_pi * lnterm * J1.val + (0.5 + c.val)/x;
result->err = fabs(lnterm) * (fabs(GSL_DBL_EPSILON * J1.val) + J1.err) + c.err/x;
return status;
}
else if(x < 4.0) {
const double lnterm = log(0.5*x);
int status;
gsl_sf_result J1;
gsl_sf_result c;
cheb_eval_e(&by1_cs, 0.125*x*x-1.0, &c);
status = gsl_sf_bessel_J1_e(x, &J1);
result->val = two_over_pi * lnterm * J1.val + (0.5 + c.val)/x;
result->err = fabs(lnterm) * (fabs(GSL_DBL_EPSILON * J1.val) + J1.err) + c.err/x;
return status;
}
else if(x < xmax) {
const double z = 32.0/(x*x) - 1.0;
gsl_sf_result ca;
gsl_sf_result ct;
gsl_sf_result cp;
const int stat_ca = cheb_eval_e(&_gsl_sf_bessel_amp_phase_bm1_cs, z, &ca);
const int stat_ct = cheb_eval_e(&_gsl_sf_bessel_amp_phase_bth1_cs, z, &ct);
const int stat_cp = gsl_sf_bessel_cos_pi4_e(x, ct.val/x, &cp);
const double sqrtx = sqrt(x);
const double ampl = (0.75 + ca.val) / sqrtx;
result->val = -ampl * cp.val;
result->err = fabs(cp.val) * ca.err/sqrtx + fabs(ampl) * cp.err;
result->err += GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_3(stat_ca, stat_ct, stat_cp);
}
else {
UNDERFLOW_ERROR(result);
}
}
static
int expint_E2_impl(const double x, gsl_sf_result * result, const int scale)
{
const double xmaxt = -GSL_LOG_DBL_MIN;
const double xmax = xmaxt - log(xmaxt);
/* CHECK_POINTER(result) */
if(x < -xmax && !scale) {
OVERFLOW_ERROR(result);
}
else if (x == 0.0) {
result->val = 1.0;
result->err = 0.0;
return GSL_SUCCESS;
} else if(x < 100.0) {
const double ex = ( scale ? 1.0 : exp(-x) );
gsl_sf_result result_E1;
int stat_E1 = expint_E1_impl(x, &result_E1, scale);
result->val = ex - x*result_E1.val;
result->err = GSL_DBL_EPSILON*ex + fabs(x) * result_E1.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_E1;
}
else if(x < xmax || scale) {
const double s = ( scale ? 1.0 : exp(-x) );
const double c1 = -2.0;
const double c2 = 6.0;
const double c3 = -24.0;
const double c4 = 120.0;
const double c5 = -720.0;
const double c6 = 5040.0;
const double c7 = -40320.0;
const double c8 = 362880.0;
const double c9 = -3628800.0;
const double c10 = 39916800.0;
const double c11 = -479001600.0;
const double c12 = 6227020800.0;
const double c13 = -87178291200.0;
const double y = 1.0/x;
const double sum6 = c6+y*(c7+y*(c8+y*(c9+y*(c10+y*(c11+y*(c12+y*c13))))));
const double sum = y*(c1+y*(c2+y*(c3+y*(c4+y*(c5+y*sum6)))));
result->val = s * (1.0 + sum)/x;
result->err = 2.0 * (x + 1.0) * GSL_DBL_EPSILON * result->val;
if(result->val == 0.0)
UNDERFLOW_ERROR(result);
else
return GSL_SUCCESS;
}
else {
UNDERFLOW_ERROR(result);
}
}
static PyObject *
Pyxmpz_inplace_rshift(PyObject *a, PyObject *b)
{
mpir_si temp_si;
int overflow;
if (PyIntOrLong_Check(b)) {
temp_si = PyLong_AsSIAndOverflow(b, &overflow);
if (overflow) {
OVERFLOW_ERROR("outrageous shift count");
return NULL;
}
else if(temp_si >= 0) {
mpz_fdiv_q_2exp(Pyxmpz_AS_MPZ(a), Pyxmpz_AS_MPZ(a), temp_si);
Py_INCREF(a);
return a;
}
else {
VALUE_ERROR("negative shift count");
return NULL;
}
}
if (CHECK_MPZANY(b)) {
if (mpz_sgn(Pyxmpz_AS_MPZ(b)) < 0) {
VALUE_ERROR("negative shift count");
return NULL;
}
if (!mpz_fits_si_p(Pyxmpz_AS_MPZ(b))) {
OVERFLOW_ERROR("outrageous shift count");
return NULL;
}
temp_si = mpz_get_si(Pyxmpz_AS_MPZ(b));
mpz_fdiv_q_2exp(Pyxmpz_AS_MPZ(a), Pyxmpz_AS_MPZ(a), temp_si);
Py_INCREF(a);
return a;
}
Py_RETURN_NOTIMPLEMENTED;
}
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);
}
}
int gsl_sf_exp_e(const double x, gsl_sf_result * result)
{
if(x > GSL_LOG_DBL_MAX) {
OVERFLOW_ERROR(result);
}
else if(x < GSL_LOG_DBL_MIN) {
UNDERFLOW_ERROR(result);
}
else {
result->val = exp(x);
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
}
int gsl_sf_exp_mult_err_e(const double x, const double dx,
const double y, const double dy,
gsl_sf_result * result)
{
const double ay = fabs(y);
if(y == 0.0) {
result->val = 0.0;
result->err = fabs(dy * exp(x));
return GSL_SUCCESS;
}
else if( ( x < 0.5*GSL_LOG_DBL_MAX && x > 0.5*GSL_LOG_DBL_MIN)
&& (ay < 0.8*GSL_SQRT_DBL_MAX && ay > 1.2*GSL_SQRT_DBL_MIN)
) {
double ex = exp(x);
result->val = y * ex;
result->err = ex * (fabs(dy) + fabs(y*dx));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
const double ly = log(ay);
const double lnr = x + ly;
if(lnr > GSL_LOG_DBL_MAX - 0.01) {
OVERFLOW_ERROR(result);
}
else if(lnr < GSL_LOG_DBL_MIN + 0.01) {
UNDERFLOW_ERROR(result);
}
else {
const double sy = GSL_SIGN(y);
const double M = floor(x);
const double N = floor(ly);
const double a = x - M;
const double b = ly - N;
const double eMN = exp(M+N);
const double eab = exp(a+b);
result->val = sy * eMN * eab;
result->err = eMN * eab * 2.0*GSL_DBL_EPSILON;
result->err += eMN * eab * fabs(dy/y);
result->err += eMN * eab * fabs(dx);
return GSL_SUCCESS;
}
}
}
int gsl_sf_bessel_k1_scaled_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x <= 0.0) {
DOMAIN_ERROR(result);
}
else if(x < (M_SQRTPI+1.0)/(M_SQRT2*GSL_SQRT_DBL_MAX)) {
OVERFLOW_ERROR(result);
}
else {
result->val = M_PI/(2.0*x) * (1.0 + 1.0/x);
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
CHECK_UNDERFLOW(result);
return GSL_SUCCESS;
}
}
static
int
delta(int ta, int tb, int tc, gsl_sf_result * d)
{
gsl_sf_result f1, f2, f3, f4;
int status = 0;
status += gsl_sf_fact_e((ta + tb - tc)/2, &f1);
status += gsl_sf_fact_e((ta + tc - tb)/2, &f2);
status += gsl_sf_fact_e((tb + tc - ta)/2, &f3);
status += gsl_sf_fact_e((ta + tb + tc)/2 + 1, &f4);
if(status != 0) {
OVERFLOW_ERROR(d);
}
d->val = f1.val * f2.val * f3.val / f4.val;
d->err = 4.0 * GSL_DBL_EPSILON * fabs(d->val);
return GSL_SUCCESS;
}
int gsl_sf_expint_E2_e(const double x, gsl_sf_result * result)
{
const double xmaxt = -GSL_LOG_DBL_MIN;
const double xmax = xmaxt - log(xmaxt);
/* CHECK_POINTER(result) */
if(x < -xmax) {
OVERFLOW_ERROR(result);
}
else if(x < 100.0) {
const double ex = exp(-x);
gsl_sf_result result_E1;
int stat_E1 = gsl_sf_expint_E1_e(x, &result_E1);
result->val = ex - x*result_E1.val;
result->err = fabs(x) * (GSL_DBL_EPSILON*ex + result_E1.err);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_E1;
}
else if(x < xmax) {
const double c1 = -2.0;
const double c2 = 6.0;
const double c3 = -24.0;
const double c4 = 120.0;
const double c5 = -720.0;
const double c6 = 5040.0;
const double c7 = -40320.0;
const double c8 = 362880.0;
const double c9 = -3628800.0;
const double c10 = 39916800.0;
const double c11 = -479001600.0;
const double c12 = 6227020800.0;
const double c13 = -87178291200.0;
const double y = 1.0/x;
const double sum6 = c6+y*(c7+y*(c8+y*(c9+y*(c10+y*(c11+y*(c12+y*c13))))));
const double sum = y*(c1+y*(c2+y*(c3+y*(c4+y*(c5+y*sum6)))));
result->val = exp(-x) * (1.0 + sum)/x;
result->err = 2.0 * (x + 1.0) * GSL_DBL_EPSILON * result->val;
return GSL_SUCCESS;
}
else {
UNDERFLOW_ERROR(result);
}
}
int gsl_sf_bessel_y0_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x <= 0.0) {
DOMAIN_ERROR(result);
}
else if(1.0/GSL_DBL_MAX > 0.0 && x < 1.0/GSL_DBL_MAX) {
OVERFLOW_ERROR(result);
}
else {
gsl_sf_result cos_result;
const int stat = gsl_sf_cos_e(x, &cos_result);
result->val = -cos_result.val/x;
result->err = fabs(cos_result.err/x);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat;
}
}
int gsl_sf_bessel_I1_e(const double x, gsl_sf_result * result)
{
const double xmin = 2.0 * GSL_DBL_MIN;
const double x_small = ROOT_EIGHT * GSL_SQRT_DBL_EPSILON;
const double y = fabs(x);
/* CHECK_POINTER(result) */
if(y == 0.0) {
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(y < xmin) {
UNDERFLOW_ERROR(result);
}
else if(y < x_small) {
result->val = 0.5*x;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(y <= 3.0) {
gsl_sf_result c;
cheb_eval_e(&bi1_cs, y*y/4.5-1.0, &c);
result->val = x * (0.875 + c.val);
result->err = y * c.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(y < GSL_LOG_DBL_MAX) {
const double ey = exp(y);
gsl_sf_result I1_scaled;
gsl_sf_bessel_I1_scaled_e(x, &I1_scaled);
result->val = ey * I1_scaled.val;
result->err = ey * I1_scaled.err + y * GSL_DBL_EPSILON * fabs(result->val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
OVERFLOW_ERROR(result);
}
}
int gsl_sf_bessel_K1_scaled_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);
const double ex = exp(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 = ex * ((lx-M_LN2)*I1.val + (0.75 + c.val)/x);
result->err = ex * (c.err/x + fabs(lx)*I1.err);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_I1;
}
else if(x <= 8.0) {
const double sx = sqrt(x);
gsl_sf_result c;
cheb_eval_e(&ak1_cs, (16.0/x-5.0)/3.0, &c);
result->val = (1.25 + c.val) / sx;
result->err = c.err / sx;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
const double sx = sqrt(x);
gsl_sf_result c;
cheb_eval_e(&ak12_cs, 16.0/x-1.0, &c);
result->val = (1.25 + c.val) / sx;
result->err = c.err / sx;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
}
int
gsl_sf_exp_err_e(const double x, const double dx, gsl_sf_result * result)
{
const double adx = fabs(dx);
/* CHECK_POINTER(result) */
if(x + adx > GSL_LOG_DBL_MAX) {
OVERFLOW_ERROR(result);
}
else if(x - adx < GSL_LOG_DBL_MIN) {
UNDERFLOW_ERROR(result);
}
else {
const double ex = exp(x);
const double edx = exp(adx);
result->val = ex;
result->err = ex * GSL_MAX_DBL(GSL_DBL_EPSILON, edx - 1.0/edx);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
}
/* [Abramowitz+Stegun, 10.2.4 + 10.2.6]
* with lmax=15, precision ~ 15D for x < 3
*
* assumes l >= 1
*/
static int bessel_kl_scaled_small_x(int l, const double x, gsl_sf_result * result)
{
gsl_sf_result num_fact;
double den = gsl_sf_pow_int(x, l+1);
int stat_df = gsl_sf_doublefact_e((unsigned int) (2*l-1), &num_fact);
if(stat_df != GSL_SUCCESS || den == 0.0) {
OVERFLOW_ERROR(result);
}
else {
const int lmax = 50;
gsl_sf_result ipos_term;
double ineg_term;
double sgn = (GSL_IS_ODD(l) ? -1.0 : 1.0);
double ex = exp(x);
double t = 0.5*x*x;
double sum = 1.0;
double t_coeff = 1.0;
double t_power = 1.0;
double delta;
int stat_il;
int i;
for(i=1; i<lmax; i++) {
t_coeff /= i*(2*(i-l) - 1);
t_power *= t;
delta = t_power*t_coeff;
sum += delta;
if(fabs(delta/sum) < GSL_DBL_EPSILON) break;
}
stat_il = gsl_sf_bessel_il_scaled_e(l, x, &ipos_term);
ineg_term = sgn * num_fact.val/den * sum;
result->val = -sgn * 0.5*M_PI * (ex*ipos_term.val - ineg_term);
result->val *= ex;
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_il;
}
}
int gsl_sf_Chi_e(const double x, gsl_sf_result * result)
{
gsl_sf_result result_Ei;
gsl_sf_result result_E1;
int status_Ei = gsl_sf_expint_Ei_e(x, &result_Ei);
int status_E1 = gsl_sf_expint_E1_e(x, &result_E1);
if(status_Ei == GSL_EDOM || status_E1 == GSL_EDOM) {
DOMAIN_ERROR(result);
}
else if(status_Ei == GSL_EUNDRFLW && status_E1 == GSL_EUNDRFLW) {
UNDERFLOW_ERROR(result);
}
else if(status_Ei == GSL_EOVRFLW || status_E1 == GSL_EOVRFLW) {
OVERFLOW_ERROR(result);
}
else {
result->val = 0.5 * (result_Ei.val - result_E1.val);
result->err = 0.5 * (result_Ei.err + result_E1.err);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
}
int gsl_sf_bessel_y2_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x <= 0.0) {
DOMAIN_ERROR(result);
}
else if(x < 1.0/GSL_ROOT3_DBL_MAX) {
OVERFLOW_ERROR(result);
}
else if(x < 0.5) {
const double y = x*x;
const double c1 = 1.0/6.0;
const double c2 = 1.0/24.0;
const double c3 = -1.0/144.0;
const double c4 = 1.0/3456.0;
const double c5 = -1.0/172800.0;
const double c6 = 1.0/14515200.0;
const double c7 = -1.0/1828915200.0;
const double sum = 1.0 + y*(c1 + y*(c2 + y*(c3 + y*(c4 + y*(c5 + y*(c6 + y*c7))))));
result->val = -3.0/(x*x*x) * sum;
result->err = GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
gsl_sf_result cos_result;
gsl_sf_result sin_result;
const int stat_cos = gsl_sf_cos_e(x, &cos_result);
const int stat_sin = gsl_sf_sin_e(x, &sin_result);
const double sx = sin_result.val;
const double cx = cos_result.val;
const double a = 3.0/(x*x);
result->val = (1.0 - a)/x * cx - a * sx;
result->err = cos_result.err * fabs((1.0 - a)/x) + sin_result.err * fabs(a);
result->err += GSL_DBL_EPSILON * (fabs(cx/x) + fabs(sx/(x*x)));
return GSL_ERROR_SELECT_2(stat_cos, stat_sin);
}
}
int
gsl_sf_bessel_In_e(const int n_in, const double x, gsl_sf_result * result)
{
const double ax = fabs(x);
const int n = abs(n_in); /* I(-n, z) = I(n, z) */
gsl_sf_result In_scaled;
const int stat_In_scaled = gsl_sf_bessel_In_scaled_e(n, ax, &In_scaled);
/* In_scaled is always less than 1,
* so this overflow check is conservative.
*/
if(ax > GSL_LOG_DBL_MAX - 1.0) {
OVERFLOW_ERROR(result);
}
else {
const double ex = exp(ax);
result->val = ex * In_scaled.val;
result->err = ex * In_scaled.err;
result->err += ax * GSL_DBL_EPSILON * fabs(result->val);
if(x < 0.0 && GSL_IS_ODD(n)) result->val = -result->val;
return stat_In_scaled;
}
}
int gsl_sf_bessel_y1_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x <= 0.0) {
DOMAIN_ERROR(result);
}
else if(x < 1.0/GSL_SQRT_DBL_MAX) {
OVERFLOW_ERROR(result);
}
else if(x < 0.25) {
const double y = x*x;
const double c1 = 1.0/2.0;
const double c2 = -1.0/8.0;
const double c3 = 1.0/144.0;
const double c4 = -1.0/5760.0;
const double c5 = 1.0/403200.0;
const double c6 = -1.0/43545600.0;
const double sum = 1.0 + y*(c1 + y*(c2 + y*(c3 + y*(c4 + y*(c5 + y*c6)))));
result->val = -sum/y;
result->err = GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
gsl_sf_result cos_result;
gsl_sf_result sin_result;
const int stat_cos = gsl_sf_cos_e(x, &cos_result);
const int stat_sin = gsl_sf_sin_e(x, &sin_result);
const double cx = cos_result.val;
const double sx = sin_result.val;
result->val = -(cx/x + sx)/x;
result->err = (fabs(cos_result.err/x) + sin_result.err)/fabs(x);
result->err += GSL_DBL_EPSILON * (fabs(sx/x) + fabs(cx/(x*x)));
return GSL_ERROR_SELECT_2(stat_cos, stat_sin);
}
}
int
gsl_sf_coupling_9j_e(int two_ja, int two_jb, int two_jc,
int two_jd, int two_je, int two_jf,
int two_jg, int two_jh, int two_ji,
gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if( two_ja < 0 || two_jb < 0 || two_jc < 0
|| two_jd < 0 || two_je < 0 || two_jf < 0
|| two_jg < 0 || two_jh < 0 || two_ji < 0
) {
DOMAIN_ERROR(result);
}
else if( triangle_selection_fails(two_ja, two_jb, two_jc)
|| triangle_selection_fails(two_jd, two_je, two_jf)
|| triangle_selection_fails(two_jg, two_jh, two_ji)
|| triangle_selection_fails(two_ja, two_jd, two_jg)
|| triangle_selection_fails(two_jb, two_je, two_jh)
|| triangle_selection_fails(two_jc, two_jf, two_ji)
) {
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else {
int tk;
int tkmin = locMax3(abs(two_ja-two_ji), abs(two_jh-two_jd), abs(two_jb-two_jf));
int tkmax = locMin3(two_ja + two_ji, two_jh + two_jd, two_jb + two_jf);
double sum_pos = 0.0;
double sum_neg = 0.0;
double sumsq_err = 0.0;
double phase;
for(tk=tkmin; tk<=tkmax; tk += 2) {
gsl_sf_result s1, s2, s3;
double term;
double term_err;
int status = 0;
status += gsl_sf_coupling_6j_e(two_ja, two_ji, tk, two_jh, two_jd, two_jg, &s1);
status += gsl_sf_coupling_6j_e(two_jb, two_jf, tk, two_jd, two_jh, two_je, &s2);
status += gsl_sf_coupling_6j_e(two_ja, two_ji, tk, two_jf, two_jb, two_jc, &s3);
if(status != GSL_SUCCESS) {
OVERFLOW_ERROR(result);
}
term = s1.val * s2.val * s3.val;
term_err = s1.err * fabs(s2.val*s3.val);
term_err += s2.err * fabs(s1.val*s3.val);
term_err += s3.err * fabs(s1.val*s2.val);
if(term >= 0.0) {
sum_pos += (tk + 1) * term;
}
else {
sum_neg -= (tk + 1) * term;
}
sumsq_err += ((tk+1) * term_err) * ((tk+1) * term_err);
}
phase = GSL_IS_ODD(tkmin) ? -1.0 : 1.0;
result->val = phase * (sum_pos - sum_neg);
result->err = 2.0 * GSL_DBL_EPSILON * (sum_pos + sum_neg);
result->err += sqrt(sumsq_err / (0.5*(tkmax-tkmin)+1.0));
result->err += 2.0 * GSL_DBL_EPSILON * (tkmax-tkmin + 2.0) * fabs(result->val);
return GSL_SUCCESS;
}
}