/* [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_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);
}
}
/* Handle case of integer j <= -2.
*/
static
int
fd_nint(const int j, const double x, gsl_sf_result * result)
{
/* const int nsize = 100 + 1; */
enum {
nsize = 100+1
};
double qcoeff[nsize];
if(j >= -1) {
result->val = 0.0;
result->err = 0.0;
GSL_ERROR ("error", GSL_ESANITY);
}
else if(j < -(nsize)) {
result->val = 0.0;
result->err = 0.0;
GSL_ERROR ("error", GSL_EUNIMPL);
}
else {
double a, p, f;
int i, k;
int n = -(j+1);
qcoeff[1] = 1.0;
for(k=2; k<=n; k++) {
qcoeff[k] = -qcoeff[k-1];
for(i=k-1; i>=2; i--) {
qcoeff[i] = i*qcoeff[i] - (k-(i-1))*qcoeff[i-1];
}
}
if(x >= 0.0) {
a = exp(-x);
f = qcoeff[1];
for(i=2; i<=n; i++) {
f = f*a + qcoeff[i];
}
}
else {
a = exp(x);
f = qcoeff[n];
for(i=n-1; i>=1; i--) {
f = f*a + qcoeff[i];
}
}
p = gsl_sf_pow_int(1.0+a, j);
result->val = f*a*p;
result->err = 3.0 * GSL_DBL_EPSILON * fabs(f*a*p);
return GSL_SUCCESS;
}
}
int gsl_sf_synchrotron_2_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x < 0.0) {
DOMAIN_ERROR(result);
}
else if(x < 2.0*M_SQRT2*GSL_SQRT_DBL_EPSILON) {
/* BJG: added first order correction term. The taylor series
is S2(x) = ((2pi)/(sqrt(3)*gamma(1/3))) * (x/2)^(1/3)
* (1 - (gamma(1/3)/gamma(4/3))*(x/2)^(4/3) + (gamma(1/3)/gamma(4/3))*(x/2)^2...) */
double z = pow(x, 1.0/3.0);
double cf = 1 - 1.17767156510235e+00 * z * x;
result->val = 1.07476412076723931836 * z * cf ;
result->err = 2.0 * GSL_DBL_EPSILON * result->val;
return GSL_SUCCESS;
}
else if(x <= 4.0) {
const double px = pow(x, 1.0/3.0);
const double px5 = gsl_sf_pow_int(px,5);
const double t = x*x/8.0 - 1.0;
gsl_sf_result cheb1;
gsl_sf_result cheb2;
cheb_eval_e(&synchrotron21_cs, t, &cheb1);
cheb_eval_e(&synchrotron22_cs, t, &cheb2);
result->val = px * cheb1.val - px5 * cheb2.val;
result->err = px * cheb1.err + px5 * cheb2.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < -8.0*GSL_LOG_DBL_MIN/7.0) {
const double c0 = 0.22579135264472743236; /* log(sqrt(pi/2)) */
const double t = (10.0 - x) / (x + 2.0);
gsl_sf_result cheb1;
cheb_eval_e(&synchrotron2a_cs, t, &cheb1);
result->val = sqrt(x) * exp(c0-x) * cheb1.val;
result->err = GSL_DBL_EPSILON * result->val * (fabs(c0-x)+1.0);
return GSL_SUCCESS;
}
else {
UNDERFLOW_ERROR(result);
}
}
int gsl_sf_synchrotron_1_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x < 0.0) {
DOMAIN_ERROR(result);
}
else if(x < 2.0*M_SQRT2 * GSL_SQRT_DBL_EPSILON) {
/* BJG: added first order correction term. The taylor series
is S1(x) = ((4pi)/(sqrt(3)gamma(1/3))) * (x/2)^(1/3)
* (1 - (gamma(1/3)/2)*(x/2)^2/3 + (3/4) * (x/2)^2 ....) */
double z = pow(x, 1.0/3.0);
double cf = 1 - 8.43812762813205e-01 * z * z;
result->val = 2.14952824153447863671 * z * cf;
result->err = GSL_DBL_EPSILON * result->val;
return GSL_SUCCESS;
}
else if(x <= 4.0) {
const double c0 = M_PI/M_SQRT3;
const double px = pow(x,1.0/3.0);
const double px11 = gsl_sf_pow_int(px,11);
const double t = x*x/8.0 - 1.0;
gsl_sf_result result_c1;
gsl_sf_result result_c2;
cheb_eval_e(&synchrotron1_cs, t, &result_c1);
cheb_eval_e(&synchrotron2_cs, t, &result_c2);
result->val = px * result_c1.val - px11 * result_c2.val - c0 * x;
result->err = px * result_c1.err + px11 * result_c2.err + c0 * x * GSL_DBL_EPSILON;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < -8.0*GSL_LOG_DBL_MIN/7.0) {
const double c0 = 0.2257913526447274323630976; /* log(sqrt(pi/2)) */
const double t = (12.0 - x) / (x + 4.0);
gsl_sf_result result_c1;
cheb_eval_e(&synchrotron1a_cs, t, &result_c1);
result->val = sqrt(x) * result_c1.val * exp(c0 - x);
result->err = 2.0 * GSL_DBL_EPSILON * result->val * (fabs(c0-x)+1.0);
return GSL_SUCCESS;
}
else {
UNDERFLOW_ERROR(result);
}
}
/* [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_synchrotron_1_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x < 0.0) {
DOMAIN_ERROR(result);
}
else if(x < 2.0*M_SQRT2 * GSL_SQRT_DBL_EPSILON) {
result->val = 2.14952824153447863671 * pow(x, 1.0/3.0);
result->err = GSL_DBL_EPSILON * result->val;
return GSL_SUCCESS;
}
else if(x <= 4.0) {
const double c0 = M_PI/M_SQRT3;
const double px = pow(x,1.0/3.0);
const double px11 = gsl_sf_pow_int(px,11);
const double t = x*x/8.0 - 1.0;
gsl_sf_result result_c1;
gsl_sf_result result_c2;
cheb_eval_e(&synchrotron1_cs, t, &result_c1);
cheb_eval_e(&synchrotron2_cs, t, &result_c2);
result->val = px * result_c1.val - px11 * result_c2.val - c0 * x;
result->err = px * result_c1.err + px11 * result_c2.err + c0 * x * GSL_DBL_EPSILON;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < -8.0*GSL_LOG_DBL_MIN/7.0) {
const double c0 = 0.2257913526447274323630976; /* log(sqrt(pi/2)) */
const double t = (12.0 - x) / (x + 4.0);
gsl_sf_result result_c1;
cheb_eval_e(&synchrotron1a_cs, t, &result_c1);
result->val = sqrt(x) * result_c1.val * exp(c0 - x);
result->err = 2.0 * GSL_DBL_EPSILON * result->val * (fabs(c0-x)+1.0);
return GSL_SUCCESS;
}
else {
UNDERFLOW_ERROR(result);
}
}
int gsl_sf_synchrotron_2_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(x < 0.0) {
DOMAIN_ERROR(result);
}
else if(x < 2.0*M_SQRT2*GSL_SQRT_DBL_EPSILON) {
result->val = 1.07476412076723931836 * pow(x, 1.0/3.0);
result->err = 2.0 * GSL_DBL_EPSILON * result->val;
return GSL_SUCCESS;
}
else if(x <= 4.0) {
const double px = pow(x, 1.0/3.0);
const double px5 = gsl_sf_pow_int(px,5);
const double t = x*x/8.0 - 1.0;
gsl_sf_result cheb1;
gsl_sf_result cheb2;
cheb_eval_e(&synchrotron21_cs, t, &cheb1);
cheb_eval_e(&synchrotron22_cs, t, &cheb2);
result->val = px * cheb1.val - px5 * cheb2.val;
result->err = px * cheb1.err + px5 * cheb2.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x < -8.0*GSL_LOG_DBL_MIN/7.0) {
const double c0 = 0.22579135264472743236; /* log(sqrt(pi/2)) */
const double t = (10.0 - x) / (x + 2.0);
gsl_sf_result cheb1;
cheb_eval_e(&synchrotron2a_cs, t, &cheb1);
result->val = sqrt(x) * exp(c0-x) * cheb1.val;
result->err = GSL_DBL_EPSILON * result->val * (fabs(c0-x)+1.0);
return GSL_SUCCESS;
}
else {
UNDERFLOW_ERROR(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);
}
/* Series evaluation for small x > 0, integer j > 0; x < Pi.
* [Goano (8)]
*/
static
int
fd_series_int(const int j, const double x, gsl_sf_result * result)
{
int n;
double sum = 0.0;
double del;
double pow_factor = 1.0;
gsl_sf_result eta_factor;
gsl_sf_eta_int_e(j + 1, &eta_factor);
del = pow_factor * eta_factor.val;
sum += del;
/* Sum terms where the argument
* of eta() is positive.
*/
for(n=1; n<=j+2; n++) {
gsl_sf_eta_int_e(j+1-n, &eta_factor);
pow_factor *= x/n;
del = pow_factor * eta_factor.val;
sum += del;
if(fabs(del/sum) < GSL_DBL_EPSILON) break;
}
/* Now sum the terms where eta() is negative.
* The argument of eta() must be odd as well,
* so it is convenient to transform the series
* as follows:
*
* Sum[ eta(j+1-n) x^n / n!, {n,j+4,Infinity}]
* = x^j / j! Sum[ eta(1-2m) x^(2m) j! / (2m+j)! , {m,2,Infinity}]
*
* We do not need to do this sum if j is large enough.
*/
if(j < 32) {
int m;
gsl_sf_result jfact;
double sum2;
double pre2;
gsl_sf_fact_e((unsigned int)j, &jfact);
pre2 = gsl_sf_pow_int(x, j) / jfact.val;
gsl_sf_eta_int_e(-3, &eta_factor);
pow_factor = x*x*x*x / ((j+4)*(j+3)*(j+2)*(j+1));
sum2 = eta_factor.val * pow_factor;
for(m=3; m<24; m++) {
gsl_sf_eta_int_e(1-2*m, &eta_factor);
pow_factor *= x*x / ((j+2*m)*(j+2*m-1));
sum2 += eta_factor.val * pow_factor;
}
sum += pre2 * sum2;
}
result->val = sum;
result->err = 2.0 * GSL_DBL_EPSILON * fabs(sum);
return GSL_SUCCESS;
}
/* Assumes a>0 and a+x>0.
*/
static
int
lnpoch_pos(const double a, const double x, gsl_sf_result * result)
{
double absx = fabs(x);
if(absx > 0.1*a || absx*log(GSL_MAX_DBL(a,2.0)) > 0.1) {
if(a < GSL_SF_GAMMA_XMAX && a+x < GSL_SF_GAMMA_XMAX) {
/* If we can do it by calculating the gamma functions
* directly, then that will be more accurate than
* doing the subtraction of the logs.
*/
gsl_sf_result g1;
gsl_sf_result g2;
gsl_sf_gammainv_e(a, &g1);
gsl_sf_gammainv_e(a+x, &g2);
result->val = -log(g2.val/g1.val);
result->err = g1.err/fabs(g1.val) + g2.err/fabs(g2.val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
/* Otherwise we must do the subtraction.
*/
gsl_sf_result lg1;
gsl_sf_result lg2;
int stat_1 = gsl_sf_lngamma_e(a, &lg1);
int stat_2 = gsl_sf_lngamma_e(a+x, &lg2);
result->val = lg2.val - lg1.val;
result->err = lg2.err + lg1.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_1, stat_2);
}
}
else if(absx < 0.1*a && a > 15.0) {
/* Be careful about the implied subtraction.
* Note that both a+x and and a must be
* large here since a is not small
* and x is not relatively large.
* So we calculate using Stirling for Log[Gamma(z)].
*
* Log[Gamma(a+x)/Gamma(a)] = x(Log[a]-1) + (x+a-1/2)Log[1+x/a]
* + (1/(1+eps) - 1) / (12 a)
* - (1/(1+eps)^3 - 1) / (360 a^3)
* + (1/(1+eps)^5 - 1) / (1260 a^5)
* - (1/(1+eps)^7 - 1) / (1680 a^7)
* + ...
*/
const double eps = x/a;
const double den = 1.0 + eps;
const double d3 = den*den*den;
const double d5 = d3*den*den;
const double d7 = d5*den*den;
const double c1 = -eps/den;
const double c3 = -eps*(3.0+eps*(3.0+eps))/d3;
const double c5 = -eps*(5.0+eps*(10.0+eps*(10.0+eps*(5.0+eps))))/d5;
const double c7 = -eps*(7.0+eps*(21.0+eps*(35.0+eps*(35.0+eps*(21.0+eps*(7.0+eps))))))/d7;
const double p8 = gsl_sf_pow_int(1.0+eps,8);
const double c8 = 1.0/p8 - 1.0; /* these need not */
const double c9 = 1.0/(p8*(1.0+eps)) - 1.0; /* be very accurate */
const double a4 = a*a*a*a;
const double a6 = a4*a*a;
const double ser_1 = c1 + c3/(30.0*a*a) + c5/(105.0*a4) + c7/(140.0*a6);
const double ser_2 = c8/(99.0*a6*a*a) - 691.0/360360.0 * c9/(a6*a4);
const double ser = (ser_1 + ser_2)/ (12.0*a);
double term1 = x * log(a/M_E);
double term2;
gsl_sf_result ln_1peps;
gsl_sf_log_1plusx_e(eps, &ln_1peps); /* log(1 + x/a) */
term2 = (x + a - 0.5) * ln_1peps.val;
result->val = term1 + term2 + ser;
result->err = GSL_DBL_EPSILON*fabs(term1);
result->err += fabs((x + a - 0.5)*ln_1peps.err);
result->err += fabs(ln_1peps.val) * GSL_DBL_EPSILON * (fabs(x) + fabs(a) + 0.5);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
gsl_sf_result poch_rel;
int stat_p = pochrel_smallx(a, x, &poch_rel);
double eps = x*poch_rel.val;
int stat_e = gsl_sf_log_1plusx_e(eps, result);
result->err = 2.0 * fabs(x * poch_rel.err / (1.0 + eps));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_e, stat_p);
}
}
