int
gsl_sf_legendre_H3d_array(const int lmax, const double lambda, const double eta, double * result_array)
{
/* CHECK_POINTER(result_array) */
if(eta < 0.0 || lmax < 0) {
int ell;
for(ell=0; ell<=lmax; ell++) result_array[ell] = 0.0;
GSL_ERROR ("domain error", GSL_EDOM);
}
else if(eta > GSL_LOG_DBL_MAX) {
/* cosh(eta) is too big. */
int ell;
for(ell=0; ell<=lmax; ell++) result_array[ell] = 0.0;
GSL_ERROR ("overflow", GSL_EOVRFLW);
}
else if(lmax == 0) {
gsl_sf_result H0;
int stat = gsl_sf_legendre_H3d_e(0, lambda, eta, &H0);
result_array[0] = H0.val;
return stat;
}
else {
/* Not the most efficient method. But what the hell... it's simple.
*/
gsl_sf_result r_Hlp1;
gsl_sf_result r_Hl;
int stat_lmax = gsl_sf_legendre_H3d_e(lmax, lambda, eta, &r_Hlp1);
int stat_lmaxm1 = gsl_sf_legendre_H3d_e(lmax-1, lambda, eta, &r_Hl);
int stat_max = GSL_ERROR_SELECT_2(stat_lmax, stat_lmaxm1);
const double coth_eta = 1.0/tanh(eta);
int stat_recursion = GSL_SUCCESS;
double Hlp1 = r_Hlp1.val;
double Hl = r_Hl.val;
double Hlm1;
int ell;
result_array[lmax] = Hlp1;
result_array[lmax-1] = Hl;
for(ell=lmax-1; ell>0; ell--) {
double root_term_0 = sqrt(lambda*lambda + (double)ell*ell);
double root_term_1 = sqrt(lambda*lambda + (ell+1.0)*(ell+1.0));
Hlm1 = ((2.0*ell + 1.0)*coth_eta*Hl - root_term_1 * Hlp1)/root_term_0;
result_array[ell-1] = Hlm1;
if(!(Hlm1 < GSL_DBL_MAX)) stat_recursion = GSL_EOVRFLW;
Hlp1 = Hl;
Hl = Hlm1;
}
return GSL_ERROR_SELECT_2(stat_recursion, stat_max);
}
}
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);
}
}
static
int
bessel_J_recur_asymp(const double nu, const double x,
gsl_sf_result * Jnu, gsl_sf_result * Jnup1)
{
const double nu_cut = 25.0;
int n;
int steps = ceil(nu_cut - nu) + 1;
gsl_sf_result r_Jnp1;
gsl_sf_result r_Jn;
int stat_O1 = gsl_sf_bessel_Jnu_asymp_Olver_e(nu + steps + 1.0, x, &r_Jnp1);
int stat_O2 = gsl_sf_bessel_Jnu_asymp_Olver_e(nu + steps, x, &r_Jn);
double r_fe = fabs(r_Jnp1.err/r_Jnp1.val) + fabs(r_Jn.err/r_Jn.val);
double Jnp1 = r_Jnp1.val;
double Jn = r_Jn.val;
double Jnm1;
double Jnp1_save;
for(n=steps; n>0; n--) {
Jnm1 = 2.0*(nu+n)/x * Jn - Jnp1;
Jnp1 = Jn;
Jnp1_save = Jn;
Jn = Jnm1;
}
Jnu->val = Jn;
Jnu->err = (r_fe + GSL_DBL_EPSILON * (steps + 1.0)) * fabs(Jn);
Jnup1->val = Jnp1_save;
Jnup1->err = (r_fe + GSL_DBL_EPSILON * (steps + 1.0)) * fabs(Jnp1_save);
return GSL_ERROR_SELECT_2(stat_O1, stat_O2);
}
int gsl_sf_bessel_yl_array(const int lmax, const double x, double * result_array)
{
/* CHECK_POINTER(result_array) */
if(lmax < 0 || x <= 0.0) {
GSL_ERROR ("error", GSL_EDOM);
} else if (lmax == 0) {
gsl_sf_result result;
int stat = gsl_sf_bessel_y0_e(x, &result);
result_array[0] = result.val;
return stat;
} else {
gsl_sf_result r_yell;
gsl_sf_result r_yellm1;
int stat_1 = gsl_sf_bessel_y1_e(x, &r_yell);
int stat_0 = gsl_sf_bessel_y0_e(x, &r_yellm1);
double yellp1;
double yell = r_yell.val;
double yellm1 = r_yellm1.val;
int ell;
result_array[0] = yellm1;
result_array[1] = yell;
for(ell = 1; ell < lmax; ell++) {
yellp1 = (2*ell+1)/x * yell - yellm1;
result_array[ell+1] = yellp1;
yellm1 = yell;
yell = yellp1;
}
return GSL_ERROR_SELECT_2(stat_0, stat_1);
}
}
/* 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_hydrogenicR_e(const int n, const int l,
const double Z, const double r,
gsl_sf_result * result)
{
if(n < 1 || l > n-1 || Z <= 0.0 || r < 0.0) {
DOMAIN_ERROR(result);
}
else {
double A = 2.0*Z/n;
gsl_sf_result norm;
int stat_norm = R_norm(n, l, Z, &norm);
double rho = A*r;
double ea = exp(-0.5*rho);
double pp = gsl_sf_pow_int(rho, l);
gsl_sf_result lag;
int stat_lag = gsl_sf_laguerre_n_e(n-l-1, 2*l+1, rho, &lag);
double W_val = norm.val * ea * pp;
double W_err = norm.err * ea * pp;
W_err += norm.val * ((0.5*rho + 1.0) * GSL_DBL_EPSILON) * ea * pp;
W_err += norm.val * ea * ((l+1.0) * GSL_DBL_EPSILON) * pp;
result->val = W_val * lag.val;
result->err = W_val * lag.err + W_err * fabs(lag.val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
if ((l == 0 || (r > 0 && l > 0)) && lag.val != 0.0
&& stat_lag == GSL_SUCCESS && stat_norm == GSL_SUCCESS) {
CHECK_UNDERFLOW(result);
};
return GSL_ERROR_SELECT_2(stat_lag, stat_norm);
}
}
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);
}
}
/* x >> nu*nu+1
*/
int
gsl_sf_bessel_Ynu_asympx_e(const double nu, const double x, gsl_sf_result * result)
{
double ampl;
double theta;
double alpha = x;
double beta = -0.5*nu*M_PI;
int stat_a = gsl_sf_bessel_asymp_Mnu_e(nu, x, &l);
int stat_t = gsl_sf_bessel_asymp_thetanu_corr_e(nu, x, &theta);
double sin_alpha = sin(alpha);
double cos_alpha = cos(alpha);
double sin_chi = sin(beta + theta);
double cos_chi = cos(beta + theta);
double sin_term = sin_alpha * cos_chi + sin_chi * cos_alpha;
double sin_term_mag = fabs(sin_alpha * cos_chi) + fabs(sin_chi * cos_alpha);
result->val = ampl * sin_term;
result->err = fabs(ampl) * GSL_DBL_EPSILON * sin_term_mag;
result->err += fabs(result->val) * 2.0 * GSL_DBL_EPSILON;
if(fabs(alpha) > 1.0/GSL_DBL_EPSILON) {
result->err *= 0.5 * fabs(alpha);
}
else if(fabs(alpha) > 1.0/GSL_SQRT_DBL_EPSILON) {
result->err *= 256.0 * fabs(alpha) * GSL_SQRT_DBL_EPSILON;
}
return GSL_ERROR_SELECT_2(stat_t, stat_a);
}
/* [Carlson, Numer. Math. 33 (1979) 1, (4.6)] */
int
gsl_sf_ellint_Ecomp_e(double k, gsl_mode_t mode, gsl_sf_result * result)
{
if(k*k >= 1.0) {
DOMAIN_ERROR(result);
}
else if(k*k >= 1.0 - GSL_SQRT_DBL_EPSILON) {
/* [Abramowitz+Stegun, 17.3.36] */
const double y = 1.0 - k*k;
const double a[] = { 0.44325141463, 0.06260601220, 0.04757383546 };
const double b[] = { 0.24998368310, 0.09200180037, 0.04069697526 };
const double ta = 1.0 + y*(a[0] + y*(a[1] + a[2]*y));
const double tb = -y*log(y) * (b[0] + y*(b[1] + b[2]*y));
result->val = ta + tb;
result->err = 2.0 * GSL_DBL_EPSILON * result->val;
return GSL_SUCCESS;
}
else {
gsl_sf_result rf;
gsl_sf_result rd;
const double y = 1.0 - k*k;
const int rfstatus = gsl_sf_ellint_RF_e(0.0, y, 1.0, mode, &rf);
const int rdstatus = gsl_sf_ellint_RD_e(0.0, y, 1.0, mode, &rd);
result->val = rf.val - k*k/3.0 * rd.val;
result->err = rf.err + k*k/3.0 * rd.err;
return GSL_ERROR_SELECT_2(rfstatus, rdstatus);
}
}
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);
}
}
/* 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);
}
}
int gsl_sf_bessel_il_scaled_array(const int lmax, const double x, double * result_array)
{
if(x == 0.0) {
int ell;
result_array[0] = 1.0;
for (ell = lmax; ell >= 1; ell--) {
result_array[ell] = 0.0;
};
return GSL_SUCCESS;
} else {
int ell;
gsl_sf_result r_iellp1;
gsl_sf_result r_iell;
int stat_0 = gsl_sf_bessel_il_scaled_e(lmax+1, x, &r_iellp1);
int stat_1 = gsl_sf_bessel_il_scaled_e(lmax, x, &r_iell);
double iellp1 = r_iellp1.val;
double iell = r_iell.val;
double iellm1;
result_array[lmax] = iell;
for(ell = lmax; ell >= 1; ell--) {
iellm1 = iellp1 + (2*ell + 1)/x * iell;
iellp1 = iell;
iell = iellm1;
result_array[ell-1] = iellm1;
}
return GSL_ERROR_SELECT_2(stat_0, stat_1);
}
}
int gsl_sf_Ci_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x <= 0.0) {
DOMAIN_ERROR(result);
}
else if(x <= 4.0) {
const double lx = log(x);
const double y = (x*x-8.0)*0.125;
gsl_sf_result result_c;
cheb_eval_e(&ci_cs, y, &result_c);
result->val = lx - 0.5 + result_c.val;
result->err = 2.0 * GSL_DBL_EPSILON * (fabs(lx) + 0.5) + result_c.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
gsl_sf_result sin_result;
gsl_sf_result cos_result;
int stat_sin = gsl_sf_sin_e(x, &sin_result);
int stat_cos = gsl_sf_cos_e(x, &cos_result);
gsl_sf_result f;
gsl_sf_result g;
fg_asymp(x, &f, &g);
result->val = f.val*sin_result.val - g.val*cos_result.val;
result->err = fabs(f.err*sin_result.val);
result->err += fabs(g.err*cos_result.val);
result->err += fabs(f.val*sin_result.err);
result->err += fabs(g.val*cos_result.err);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_sin, stat_cos);
}
}
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_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_yl_e(int l, const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(l < 0 || x <= 0.0) {
DOMAIN_ERROR(result);
}
else if(l == 0) {
return gsl_sf_bessel_y0_e(x, result);
}
else if(l == 1) {
return gsl_sf_bessel_y1_e(x, result);
}
else if(l == 2) {
return gsl_sf_bessel_y2_e(x, result);
}
else if(x < 3.0) {
return bessel_yl_small_x(l, x, result);
}
else if(GSL_ROOT3_DBL_EPSILON * x > (l*l + l + 1.0)) {
int status = gsl_sf_bessel_Ynu_asympx_e(l + 0.5, x, result);
double pre = sqrt((0.5*M_PI)/x);
result->val *= pre;
result->err *= pre;
return status;
}
else if(l > 40) {
int status = gsl_sf_bessel_Ynu_asymp_Olver_e(l + 0.5, x, result);
double pre = sqrt((0.5*M_PI)/x);
result->val *= pre;
result->err *= pre;
return status;
}
else {
/* recurse upward */
gsl_sf_result r_by;
gsl_sf_result r_bym;
int stat_1 = gsl_sf_bessel_y1_e(x, &r_by);
int stat_0 = gsl_sf_bessel_y0_e(x, &r_bym);
double bym = r_bym.val;
double by = r_by.val;
double byp;
int j;
for(j=1; j<l; j++) {
byp = (2*j+1)/x*by - bym;
bym = by;
by = byp;
}
result->val = by;
result->err = fabs(result->val) * (GSL_DBL_EPSILON + fabs(r_by.err/r_by.val) + fabs(r_bym.err/r_bym.val));
return GSL_ERROR_SELECT_2(stat_1, stat_0);
}
}
int gsl_sf_bessel_kl_scaled_e(int l, const double x, gsl_sf_result * result)
{
if(l < 0 || x <= 0.0) {
DOMAIN_ERROR(result);
}
else if(l == 0) {
return gsl_sf_bessel_k0_scaled_e(x, result);
}
else if(l == 1) {
return gsl_sf_bessel_k1_scaled_e(x, result);
}
else if(l == 2) {
return gsl_sf_bessel_k2_scaled_e(x, result);
}
else if(x < 3.0) {
return bessel_kl_scaled_small_x(l, x, result);
}
else if(GSL_ROOT3_DBL_EPSILON * x > (l*l + l + 1)) {
int status = gsl_sf_bessel_Knu_scaled_asympx_e(l + 0.5, x, result);
double pre = sqrt((0.5*M_PI)/x);
result->val *= pre;
result->err *= pre;
return status;
}
else if(GSL_MIN(0.29/(l*l+1.0), 0.5/(l*l+1.0+x*x)) < GSL_ROOT3_DBL_EPSILON) {
int status = gsl_sf_bessel_Knu_scaled_asymp_unif_e(l + 0.5, x, result);
double pre = sqrt((0.5*M_PI)/x);
result->val *= pre;
result->err *= pre;
return status;
}
else {
/* recurse upward */
gsl_sf_result r_bk;
gsl_sf_result r_bkm;
int stat_1 = gsl_sf_bessel_k1_scaled_e(x, &r_bk);
int stat_0 = gsl_sf_bessel_k0_scaled_e(x, &r_bkm);
double bkp;
double bk = r_bk.val;
double bkm = r_bkm.val;
int j;
for(j=1; j<l; j++) {
bkp = (2*j+1)/x*bk + bkm;
bkm = bk;
bk = bkp;
}
result->val = bk;
result->err = fabs(bk) * (fabs(r_bk.err/r_bk.val) + fabs(r_bkm.err/r_bkm.val));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_1, stat_0);
}
}
int
gsl_sf_bessel_K_scaled_temme(const double nu, const double x,
double * K_nu, double * K_nup1, double * Kp_nu)
{
const int max_iter = 15000;
const double half_x = 0.5 * x;
const double ln_half_x = log(half_x);
const double half_x_nu = exp(nu*ln_half_x);
const double pi_nu = M_PI * nu;
const double sigma = -nu * ln_half_x;
const double sinrat = (fabs(pi_nu) < GSL_DBL_EPSILON ? 1.0 : pi_nu/sin(pi_nu));
const double sinhrat = (fabs(sigma) < GSL_DBL_EPSILON ? 1.0 : sinh(sigma)/sigma);
const double ex = exp(x);
double sum0, sum1;
double fk, pk, qk, hk, ck;
int k = 0;
int stat_iter;
double g_1pnu, g_1mnu, g1, g2;
int stat_g = gsl_sf_temme_gamma(nu, &g_1pnu, &g_1mnu, &g1, &g2);
fk = sinrat * (cosh(sigma)*g1 - sinhrat*ln_half_x*g2);
pk = 0.5/half_x_nu * g_1pnu;
qk = 0.5*half_x_nu * g_1mnu;
hk = pk;
ck = 1.0;
sum0 = fk;
sum1 = hk;
while(k < max_iter) {
double del0;
double del1;
k++;
fk = (k*fk + pk + qk)/(k*k-nu*nu);
ck *= half_x*half_x/k;
pk /= (k - nu);
qk /= (k + nu);
hk = -k*fk + pk;
del0 = ck * fk;
del1 = ck * hk;
sum0 += del0;
sum1 += del1;
if(fabs(del0) < 0.5*fabs(sum0)*GSL_DBL_EPSILON) break;
}
*K_nu = sum0 * ex;
*K_nup1 = sum1 * 2.0/x * ex;
*Kp_nu = - *K_nup1 + nu/x * *K_nu;
stat_iter = ( k == max_iter ? GSL_EMAXITER : GSL_SUCCESS );
return GSL_ERROR_SELECT_2(stat_iter, stat_g);
}
int
gsl_sf_bessel_In_scaled_array(const int nmin, const int nmax, const double x, double * result_array)
{
/* CHECK_POINTER(result_array) */
if(nmax < nmin || nmin < 0) {
int j;
for(j=0; j<=nmax-nmin; j++) result_array[j] = 0.0;
GSL_ERROR ("domain error", GSL_EDOM);
}
else if(x == 0.0) {
int j;
for(j=0; j<=nmax-nmin; j++) result_array[j] = 0.0;
if(nmin == 0) result_array[0] = 1.0;
return GSL_SUCCESS;
}
else if(nmax == 0) {
gsl_sf_result I0_scaled;
int stat = gsl_sf_bessel_I0_scaled_e(x, &I0_scaled);
result_array[0] = I0_scaled.val;
return stat;
}
else {
const double ax = fabs(x);
const double two_over_x = 2.0/ax;
/* starting values */
gsl_sf_result r_Inp1;
gsl_sf_result r_In;
int stat_0 = gsl_sf_bessel_In_scaled_e(nmax+1, ax, &r_Inp1);
int stat_1 = gsl_sf_bessel_In_scaled_e(nmax, ax, &r_In);
double Inp1 = r_Inp1.val;
double In = r_In.val;
double Inm1;
int n;
for(n=nmax; n>=nmin; n--) {
result_array[n-nmin] = In;
Inm1 = Inp1 + n * two_over_x * In;
Inp1 = In;
In = Inm1;
}
/* deal with signs */
if(x < 0.0) {
for(n=nmin; n<=nmax; n++) {
if(GSL_IS_ODD(n)) result_array[n-nmin] = -result_array[n-nmin];
}
}
return GSL_ERROR_SELECT_2(stat_0, stat_1);
}
}
/* series for small a and x, but not defined for a == 0 */
static int
gamma_inc_series(double a, double x, gsl_sf_result * result)
{
gsl_sf_result Q;
gsl_sf_result G;
const int stat_Q = gamma_inc_Q_series(a, x, &Q);
const int stat_G = gsl_sf_gamma_e(a, &G);
result->val = Q.val * G.val;
result->err = fabs(Q.val * G.err) + fabs(Q.err * G.val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_Q, stat_G);
}
int gsl_sf_bessel_Kn_scaled_array(const int nmin, const int nmax, const double x, double * result_array)
{
/* CHECK_POINTER(result_array) */
if(nmin < 0 || nmax < nmin || x <= 0.0) {
int j;
for(j=0; j<=nmax-nmin; j++) result_array[j] = 0.0;
GSL_ERROR ("domain error", GSL_EDOM);
}
else if(nmax == 0) {
gsl_sf_result b;
int stat = gsl_sf_bessel_K0_scaled_e(x, &b);
result_array[0] = b.val;
return stat;
}
else {
double two_over_x = 2.0/x;
gsl_sf_result r_Knm1;
gsl_sf_result r_Kn;
int stat_0 = gsl_sf_bessel_Kn_scaled_e(nmin, x, &r_Knm1);
int stat_1 = gsl_sf_bessel_Kn_scaled_e(nmin+1, x, &r_Kn);
int stat = GSL_ERROR_SELECT_2(stat_0, stat_1);
double Knp1;
double Kn = r_Kn.val;
double Knm1 = r_Knm1.val;
int n;
for(n=nmin+1; n<=nmax+1; n++) {
if(Knm1 < GSL_DBL_MAX) {
result_array[n-1-nmin] = Knm1;
Knp1 = Knm1 + n * two_over_x * Kn;
Knm1 = Kn;
Kn = Knp1;
}
else {
/* Overflow. Set the rest of the elements to
* zero and bug out.
* FIXME: Note: this relies on the convention
* that the test x < DBL_MIN fails for x not
* a number. This may be only an IEEE convention,
* so the portability is unclear.
*/
int j;
for(j=n; j<=nmax+1; j++) result_array[j-1-nmin] = 0.0;
GSL_ERROR ("overflow", GSL_EOVRFLW);
}
}
return stat;
}
}
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);
}
}
/* 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);
}
static int
gamma_inc_CF(double a, double x, gsl_sf_result * result)
{
gsl_sf_result F;
gsl_sf_result pre;
const int stat_F = gamma_inc_F_CF(a, x, &F);
const int stat_E = gsl_sf_exp_e((a-1.0)*log(x) - x, &pre);
result->val = F.val * pre.val;
result->err = fabs(F.err * pre.val) + fabs(F.val * pre.err);
result->err += (2.0 + fabs(a)) * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_F, stat_E);
}
int gsl_sf_bessel_Kn_scaled_e(int n, const double x, gsl_sf_result * result)
{
n = abs(n); /* K(-n, z) = K(n, z) */
/* CHECK_POINTER(result) */
if(x <= 0.0) {
DOMAIN_ERROR(result);
}
else if(n == 0) {
return gsl_sf_bessel_K0_scaled_e(x, result);
}
else if(n == 1) {
return gsl_sf_bessel_K1_scaled_e(x, result);
}
else if(x <= 5.0) {
return bessel_Kn_scaled_small_x(n, x, result);
}
else if(GSL_ROOT3_DBL_EPSILON * x > 0.25 * (n*n + 1)) {
return gsl_sf_bessel_Knu_scaled_asympx_e((double)n, x, result);
}
else if(GSL_MIN(0.29/(n*n), 0.5/(n*n + x*x)) < GSL_ROOT3_DBL_EPSILON) {
return gsl_sf_bessel_Knu_scaled_asymp_unif_e((double)n, x, result);
}
else {
/* Upward recurrence. [Gradshteyn + Ryzhik, 8.471.1] */
double two_over_x = 2.0/x;
gsl_sf_result r_b_jm1;
gsl_sf_result r_b_j;
int stat_0 = gsl_sf_bessel_K0_scaled_e(x, &r_b_jm1);
int stat_1 = gsl_sf_bessel_K1_scaled_e(x, &r_b_j);
double b_jm1 = r_b_jm1.val;
double b_j = r_b_j.val;
double b_jp1;
int j;
for(j=1; j<n; j++) {
b_jp1 = b_jm1 + j * two_over_x * b_j;
b_jm1 = b_j;
b_j = b_jp1;
}
result->val = b_j;
result->err = n * (fabs(b_j) * (fabs(r_b_jm1.err/r_b_jm1.val) + fabs(r_b_j.err/r_b_j.val)));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_0, stat_1);
}
}
int
gsl_sf_bessel_Jn_array(int nmin, int nmax, double x, double * result_array)
{
/* CHECK_POINTER(result_array) */
if(nmin < 0 || nmax < nmin) {
int n;
for(n=nmax; n>=nmin; n--) {
result_array[n-nmin] = 0.0;
}
GSL_ERROR ("domain error", GSL_EDOM);
}
else if(x == 0.0) {
int n;
for(n=nmax; n>=nmin; n--) {
result_array[n-nmin] = 0.0;
}
if(nmin == 0) result_array[0] = 1.0;
return GSL_SUCCESS;
}
else {
gsl_sf_result r_Jnp1;
gsl_sf_result r_Jn;
int stat_np1 = gsl_sf_bessel_Jn_e(nmax+1, x, &r_Jnp1);
int stat_n = gsl_sf_bessel_Jn_e(nmax, x, &r_Jn);
int stat = GSL_ERROR_SELECT_2(stat_np1, stat_n);
double Jnp1 = r_Jnp1.val;
double Jn = r_Jn.val;
double Jnm1;
int n;
if(stat == GSL_SUCCESS) {
for(n=nmax; n>=nmin; n--) {
result_array[n-nmin] = Jn;
Jnm1 = -Jnp1 + 2.0*n/x * Jn;
Jnp1 = Jn;
Jn = Jnm1;
}
}
else {
for(n=nmax; n>=nmin; n--) {
result_array[n-nmin] = 0.0;
}
}
return stat;
}
}
static int
gamma_inc_a_gt_0(double a, double x, gsl_sf_result * result)
{
/* x > 0 and a > 0; use result for Q */
gsl_sf_result Q;
gsl_sf_result G;
const int stat_Q = gsl_sf_gamma_inc_Q_e(a, x, &Q);
const int stat_G = gsl_sf_gamma_e(a, &G);
result->val = G.val * Q.val;
result->err = fabs(G.val * Q.err) + fabs(G.err * Q.val);
result->err += 2.0*GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_G, stat_Q);
}
int
gsl_sf_dilog_e(const double x, gsl_sf_result * result)
{
if(x >= 0.0) {
return dilog_xge0(x, result);
}
else {
gsl_sf_result d1, d2;
int stat_d1 = dilog_xge0( -x, &d1);
int stat_d2 = dilog_xge0(x*x, &d2);
result->val = -d1.val + 0.5 * d2.val;
result->err = d1.err + 0.5 * d2.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_d1, stat_d2);
}
}
/* [Carlson, Numer. Math. 33 (1979) 1, (4.3)] */
int
gsl_sf_ellint_P_e(double phi, double k, double n, gsl_mode_t mode, gsl_sf_result * result)
{
const double sin_phi = sin(phi);
const double sin2_phi = sin_phi * sin_phi;
const double sin3_phi = sin2_phi * sin_phi;
const double x = 1.0 - sin2_phi;
const double y = 1.0 - k*k*sin2_phi;
gsl_sf_result rf;
gsl_sf_result rj;
const int rfstatus = gsl_sf_ellint_RF_e(x, y, 1.0, mode, &rf);
const int rjstatus = gsl_sf_ellint_RJ_e(x, y, 1.0, 1.0 + n*sin2_phi, mode, &rj);
result->val = sin_phi * rf.val - n/3.0*sin3_phi * rj.val;
result->err = GSL_DBL_EPSILON * fabs(sin_phi * rf.val);
result->err += n/3.0 * fabs(sin3_phi*rj.err);
return GSL_ERROR_SELECT_2(rfstatus, rjstatus);
}
int gsl_sf_bessel_j2_e(const double x, gsl_sf_result * result)
{
double ax = fabs(x);
/* CHECK_POINTER(result) */
if(x == 0.0) {
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(ax < 4.0*GSL_SQRT_DBL_MIN) {
UNDERFLOW_ERROR(result);
}
else if(ax < 1.3) {
const double y = x*x;
const double c1 = -1.0/14.0;
const double c2 = 1.0/504.0;
const double c3 = -1.0/33264.0;
const double c4 = 1.0/3459456.0;
const double c5 = -1.0/518918400;
const double c6 = 1.0/105859353600.0;
const double c7 = -1.0/28158588057600.0;
const double c8 = 1.0/9461285587353600.0;
const double c9 = -1.0/3916972233164390400.0;
const double sum = 1.0+y*(c1+y*(c2+y*(c3+y*(c4+y*(c5+y*(c6+y*(c7+y*(c8+y*c9))))))));
result->val = y/15.0 * sum;
result->err = 2.0 * 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 cos_x = cos_result.val;
const double sin_x = sin_result.val;
const double f = (3.0/(x*x) - 1.0);
result->val = (f * sin_x - 3.0*cos_x/x)/x;
result->err = fabs(f * sin_result.err/x) + fabs((3.0*cos_result.err/x)/x);
result->err += 2.0 * GSL_DBL_EPSILON * (fabs(f*sin_x/x) + 3.0*fabs(cos_x/(x*x)));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_cos, stat_sin);
}
}
