static
int
m_selection_fails(int two_ja, int two_jb, int two_jc,
int two_ma, int two_mb, int two_mc)
{
return (
abs(two_ma) > two_ja
|| abs(two_mb) > two_jb
|| abs(two_mc) > two_jc
|| GSL_IS_ODD(two_ja + two_ma)
|| GSL_IS_ODD(two_jb + two_mb)
|| GSL_IS_ODD(two_jc + two_mc)
|| (two_ma + two_mb + two_mc) != 0
);
}
/* [Abramowitz+Stegun, 9.6.11]
* assumes n >= 1
*/
static
int
bessel_Kn_scaled_small_x(const int n, const double x, gsl_sf_result * result)
{
int k;
double y = 0.25 * x * x;
double ln_x_2 = log(0.5*x);
double ex = exp(x);
gsl_sf_result ln_nm1_fact;
double k_term;
double term1, sum1, ln_pre1;
double term2, sum2, pre2;
gsl_sf_lnfact_e((unsigned int)(n-1), &ln_nm1_fact);
ln_pre1 = -n*ln_x_2 + ln_nm1_fact.val;
if(ln_pre1 > GSL_LOG_DBL_MAX - 3.0) GSL_ERROR ("error", GSL_EOVRFLW);
sum1 = 1.0;
k_term = 1.0;
for(k=1; k<=n-1; k++) {
k_term *= -y/(k * (n-k));
sum1 += k_term;
}
term1 = 0.5 * exp(ln_pre1) * sum1;
pre2 = 0.5 * exp(n*ln_x_2);
if(pre2 > 0.0) {
const int KMAX = 20;
gsl_sf_result psi_n;
gsl_sf_result npk_fact;
double yk = 1.0;
double k_fact = 1.0;
double psi_kp1 = -M_EULER;
double psi_npkp1;
gsl_sf_psi_int_e(n, &psi_n);
gsl_sf_fact_e((unsigned int)n, &npk_fact);
psi_npkp1 = psi_n.val + 1.0/n;
sum2 = (psi_kp1 + psi_npkp1 - 2.0*ln_x_2)/npk_fact.val;
for(k=1; k<KMAX; k++) {
psi_kp1 += 1.0/k;
psi_npkp1 += 1.0/(n+k);
k_fact *= k;
npk_fact.val *= n+k;
yk *= y;
k_term = yk*(psi_kp1 + psi_npkp1 - 2.0*ln_x_2)/(k_fact*npk_fact.val);
sum2 += k_term;
}
term2 = ( GSL_IS_ODD(n) ? -1.0 : 1.0 ) * pre2 * sum2;
}
else {
term2 = 0.0;
}
result->val = ex * (term1 + term2);
result->err = ex * GSL_DBL_EPSILON * (fabs(ln_pre1)*fabs(term1) + fabs(term2));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
int gsl_sf_zetam1_int_e(const int n, gsl_sf_result * result)
{
if(n < 0) {
if(!GSL_IS_ODD(n)) {
result->val = -1.0; /* at even negative integers zetam1 == -1 since zeta is exactly zero */
result->err = 0.0;
return GSL_SUCCESS;
}
else if(n > -ZETA_NEG_TABLE_NMAX) {
result->val = zeta_neg_int_table[-(n+1)/2] - 1.0;
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
/* could use gsl_sf_zetam1_e here but subtracting 1 makes no difference
for such large values, so go straight to the result */
return gsl_sf_zeta_e((double)n, result);
}
}
else if(n == 1){
DOMAIN_ERROR(result);
}
else if(n <= ZETA_POS_TABLE_NMAX){
result->val = zetam1_pos_int_table[n];
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
return gsl_sf_zetam1_e(n, result);
}
}
int gsl_sf_zeta_int_e(const int n, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(n < 0) {
if(!GSL_IS_ODD(n)) {
result->val = 0.0; /* exactly zero at even negative integers */
result->err = 0.0;
return GSL_SUCCESS;
}
else if(n > -ZETA_NEG_TABLE_NMAX) {
result->val = zeta_neg_int_table[-(n+1)/2];
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
return gsl_sf_zeta_e((double)n, result);
}
}
else if(n == 1){
DOMAIN_ERROR(result);
}
else if(n <= ZETA_POS_TABLE_NMAX){
result->val = 1.0 + zetam1_pos_int_table[n];
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
result->val = 1.0;
result->err = GSL_DBL_EPSILON;
return GSL_SUCCESS;
}
}
/* Continued fraction for Q.
*
* Q(a,x) = D(a,x) a/x F(a,x)
* 1 (1-a)/x 1/x (2-a)/x 2/x (3-a)/x
* F(a.x) = ---- ------- ----- -------- ----- -------- ...
* 1 + 1 + 1 + 1 + 1 + 1 +
*
* Uses Gautschi equivalent series method for the CF evaluation.
*
* Assumes a != x + 1, so that the first term of the
* CF recursion is not undefined. This is why we need
* gamma_inc_Q_CF_protected() below. Based on a problem
* report by Teemu Ikonen [Tue Oct 10 12:17:19 MDT 2000].
*/
static
int
gamma_inc_Q_CF(const double a, const double x, gsl_sf_result * result)
{
const int kmax = 5000;
gsl_sf_result D;
const int stat_D = gamma_inc_D(a, x, &D);
double sum = 1.0;
double tk = 1.0;
double rhok = 0.0;
int k;
for(k=1; k<kmax; k++) {
double ak;
if(GSL_IS_ODD(k))
ak = (0.5*(k+1.0)-a)/x;
else
ak = 0.5*k/x;
rhok = -ak*(1.0 + rhok)/(1.0 + ak*(1.0 + rhok));
tk *= rhok;
sum += tk;
if(fabs(tk/sum) < GSL_DBL_EPSILON) break;
}
result->val = D.val * (a/x) * sum;
result->err = D.err * fabs((a/x) * sum);
result->err += GSL_DBL_EPSILON * (2.0 + 0.5*k) * fabs(result->val);
if(k == kmax)
GSL_ERROR ("error", GSL_EMAXITER);
else
return stat_D;
}
int
gsl_sf_coupling_RacahW_e(int two_ja, int two_jb, int two_jc,
int two_jd, int two_je, int two_jf,
gsl_sf_result * result)
{
int status = gsl_sf_coupling_6j_e(two_ja, two_jb, two_je, two_jd, two_jc, two_jf, result);
int phase_sum = (two_ja + two_jb + two_jc + two_jd)/2;
result->val *= ( GSL_IS_ODD(phase_sum) ? -1.0 : 1.0 );
return status;
}
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);
}
}
int
gsl_sf_legendre_Pl_deriv_array(const int lmax, const double x, double * result_array, double * result_deriv_array)
{
int stat_array = gsl_sf_legendre_Pl_array(lmax, x, result_array);
if(lmax >= 0) result_deriv_array[0] = 0.0;
if(lmax >= 1) result_deriv_array[1] = 1.0;
if(stat_array == GSL_SUCCESS)
{
int ell;
if(fabs(x - 1.0)*(lmax+1.0)*(lmax+1.0) < GSL_SQRT_DBL_EPSILON)
{
/* x is near 1 */
for(ell = 2; ell <= lmax; ell++)
{
const double pre = 0.5 * ell * (ell+1.0);
result_deriv_array[ell] = pre * (1.0 - 0.25 * (1.0-x) * (ell+2.0)*(ell-1.0));
}
}
else if(fabs(x + 1.0)*(lmax+1.0)*(lmax+1.0) < GSL_SQRT_DBL_EPSILON)
{
/* x is near -1 */
for(ell = 2; ell <= lmax; ell++)
{
const double sgn = ( GSL_IS_ODD(ell) ? 1.0 : -1.0 ); /* derivative is odd in x for even ell */
const double pre = sgn * 0.5 * ell * (ell+1.0);
result_deriv_array[ell] = pre * (1.0 - 0.25 * (1.0+x) * (ell+2.0)*(ell-1.0));
}
}
else
{
const double diff_a = 1.0 + x;
const double diff_b = 1.0 - x;
for(ell = 2; ell <= lmax; ell++)
{
result_deriv_array[ell] = - ell * (x * result_array[ell] - result_array[ell-1]) / (diff_a * diff_b);
}
}
return GSL_SUCCESS;
}
else
{
return stat_array;
}
}
/* Continued fraction which occurs in evaluation
* of Q(a,x) or Gamma(a,x).
*
* 1 (1-a)/x 1/x (2-a)/x 2/x (3-a)/x
* F(a,x) = ---- ------- ----- -------- ----- -------- ...
* 1 + 1 + 1 + 1 + 1 + 1 +
*
* Hans E. Plesser, 2002-01-22 (hans dot plesser at itf dot nlh dot no).
*
* Split out from gamma_inc_Q_CF() by GJ [Tue Apr 1 13:16:41 MST 2003].
* See gamma_inc_Q_CF() below.
*
*/
static int
gamma_inc_F_CF(const double a, const double x, gsl_sf_result * result)
{
const int nmax = 5000;
const double small = gsl_pow_3 (GSL_DBL_EPSILON);
double hn = 1.0; /* convergent */
double Cn = 1.0 / small;
double Dn = 1.0;
int n;
/* n == 1 has a_1, b_1, b_0 independent of a,x,
so that has been done by hand */
for ( n = 2 ; n < nmax ; n++ )
{
double an;
double delta;
if(GSL_IS_ODD(n))
an = 0.5*(n-1)/x;
else
an = (0.5*n-a)/x;
Dn = 1.0 + an * Dn;
if ( fabs(Dn) < small )
Dn = small;
Cn = 1.0 + an/Cn;
if ( fabs(Cn) < small )
Cn = small;
Dn = 1.0 / Dn;
delta = Cn * Dn;
hn *= delta;
if(fabs(delta-1.0) < GSL_DBL_EPSILON) break;
}
result->val = hn;
result->err = 2.0*GSL_DBL_EPSILON * fabs(hn);
result->err += GSL_DBL_EPSILON * (2.0 + 0.5*n) * fabs(result->val);
if(n == nmax)
GSL_ERROR ("error in CF for F(a,x)", GSL_EMAXITER);
else
return GSL_SUCCESS;
}
int
gsl_sf_sin_pi_x_e(const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(-100.0 < x && x < 100.0) {
result->val = sin(M_PI * x) / (M_PI * x);
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
const double N = floor(x + 0.5);
const double f = x - N;
if(N < INT_MAX && N > INT_MIN) {
/* Make it an integer if we can. Saves another
* call to floor().
*/
const int intN = (int)N;
const double sign = ( GSL_IS_ODD(intN) ? -1.0 : 1.0 );
result->val = sign * sin(M_PI * f);
result->err = GSL_DBL_EPSILON * fabs(result->val);
}
else if(N > 2.0/GSL_DBL_EPSILON || N < -2.0/GSL_DBL_EPSILON) {
/* All integer-valued floating point numbers
* bigger than 2/eps=2^53 are actually even.
*/
result->val = 0.0;
result->err = 0.0;
}
else {
const double resN = N - 2.0*floor(0.5*N); /* 0 for even N, 1 for odd N */
const double sign = ( fabs(resN) > 0.5 ? -1.0 : 1.0 );
result->val = sign * sin(M_PI*f);
result->err = 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_eta_int_e(int n, gsl_sf_result * result)
{
if(n > ETA_POS_TABLE_NMAX) {
result->val = 1.0;
result->err = GSL_DBL_EPSILON;
return GSL_SUCCESS;
}
else if(n >= 0) {
result->val = eta_pos_int_table[n];
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
/* n < 0 */
if(!GSL_IS_ODD(n)) {
/* exactly zero at even negative integers */
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(n > -ETA_NEG_TABLE_NMAX) {
result->val = eta_neg_int_table[-(n+1)/2];
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else {
gsl_sf_result z;
gsl_sf_result p;
int stat_z = gsl_sf_zeta_int_e(n, &z);
int stat_p = gsl_sf_exp_e((1.0-n)*M_LN2, &p);
int stat_m = gsl_sf_multiply_e(-p.val, z.val, result);
result->err = fabs(p.err * (M_LN2*(1.0-n)) * z.val) + z.err * fabs(p.val);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_3(stat_m, stat_p, stat_z);
}
}
}
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_pow_int_e(double x, int n, gsl_sf_result * result)
{
double value = 1.0;
int count = 0;
/* CHECK_POINTER(result) */
if(n < 0) {
n = -n;
if(x == 0.0) {
double u = 1.0 / x;
result->val = (n % 2) ? u : (u * u) ; /* correct sign of infinity */
result->err = GSL_POSINF;
GSL_ERROR ("overflow", GSL_EOVRFLW);
}
x = 1.0/x;
}
/* repeated squaring method
* returns 0.0^0 = 1.0, so continuous in x
*/
do {
if(GSL_IS_ODD(n)) value *= x;
n >>= 1;
x *= x;
++count;
} while (n);
result->val = value;
result->err = 2.0 * GSL_DBL_EPSILON * (count + 1.0) * fabs(value);
return GSL_SUCCESS;
}
int
gsl_integration_glfixed_point (
double a,
double b,
size_t i,
double *xi,
double *wi,
const gsl_integration_glfixed_table * t)
{
const double A = (b - a) / 2; /* Length of [a,b] */
const double B = (a + b) / 2; /* Midpoint of [a,b] */
if (i >= t->n) {
GSL_ERROR ("i must be less than t->n", GSL_EINVAL);
}
/* See comments above gsl_integration_glfixed for struct's x, w layout. */
/* Simply unpack that layout into a sorted set of points, weights. */
if (GSL_IS_ODD(t->n)) {
const int k = ((int) i) - ((int) t->n) / 2;
const int s = k < 0 ? -1 : 1;
*xi = B + s*A*t->x[s*k];
*wi = A*t->w[s*k];
} else if (/* GSL_IS_EVEN(t->n) && */ i < t->n / 2) {
i = (t->n / 2) - 1 - i;
*xi = B - A*t->x[i];
*wi = A*t->w[i];
} else /* GSL_IS_EVEN(t->n) && i >= n / 2 */ {
i -= t->n / 2;
*xi = B + A*t->x[i];
*wi = A*t->w[i];
}
return GSL_SUCCESS;
}
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;
}
}
static VALUE rb_GSL_IS_ODD2(VALUE obj, VALUE n)
{
CHECK_FIXNUM(n);
if (GSL_IS_ODD(FIX2INT(n))) return Qtrue;
else return Qfalse;
}
int
gsl_sf_coupling_6j_e(int two_ja, int two_jb, int two_jc,
int two_jd, int two_je, int two_jf,
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
) {
DOMAIN_ERROR(result);
}
else if( triangle_selection_fails(two_ja, two_jb, two_jc)
|| triangle_selection_fails(two_ja, two_je, two_jf)
|| triangle_selection_fails(two_jb, two_jd, two_jf)
|| triangle_selection_fails(two_je, two_jd, two_jc)
) {
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else {
gsl_sf_result n1;
gsl_sf_result d1, d2, d3, d4, d5, d6;
double norm;
int tk, tkmin, tkmax;
double phase;
double sum_pos = 0.0;
double sum_neg = 0.0;
double sumsq_err = 0.0;
int status = 0;
status += delta(two_ja, two_jb, two_jc, &d1);
status += delta(two_ja, two_je, two_jf, &d2);
status += delta(two_jb, two_jd, two_jf, &d3);
status += delta(two_je, two_jd, two_jc, &d4);
if(status != GSL_SUCCESS) {
OVERFLOW_ERROR(result);
}
norm = sqrt(d1.val) * sqrt(d2.val) * sqrt(d3.val) * sqrt(d4.val);
tkmin = locMax3(0,
two_ja + two_jd - two_jc - two_jf,
two_jb + two_je - two_jc - two_jf);
tkmax = locMin5(two_ja + two_jb + two_je + two_jd + 2,
two_ja + two_jb - two_jc,
two_je + two_jd - two_jc,
two_ja + two_je - two_jf,
two_jb + two_jd - two_jf);
phase = GSL_IS_ODD((two_ja + two_jb + two_je + two_jd + tkmin)/2)
? -1.0
: 1.0;
for(tk=tkmin; tk<=tkmax; tk += 2) {
double term;
double term_err;
gsl_sf_result den_1, den_2;
gsl_sf_result d1_a, d1_b;
status = 0;
status += gsl_sf_fact_e((two_ja + two_jb + two_je + two_jd - tk)/2 + 1, &n1);
status += gsl_sf_fact_e(tk/2, &d1_a);
status += gsl_sf_fact_e((two_jc + two_jf - two_ja - two_jd + tk)/2, &d1_b);
status += gsl_sf_fact_e((two_jc + two_jf - two_jb - two_je + tk)/2, &d2);
status += gsl_sf_fact_e((two_ja + two_jb - two_jc - tk)/2, &d3);
status += gsl_sf_fact_e((two_je + two_jd - two_jc - tk)/2, &d4);
status += gsl_sf_fact_e((two_ja + two_je - two_jf - tk)/2, &d5);
status += gsl_sf_fact_e((two_jb + two_jd - two_jf - tk)/2, &d6);
if(status != GSL_SUCCESS) {
OVERFLOW_ERROR(result);
}
d1.val = d1_a.val * d1_b.val;
d1.err = d1_a.err * fabs(d1_b.val) + fabs(d1_a.val) * d1_b.err;
den_1.val = d1.val*d2.val*d3.val;
den_1.err = d1.err * fabs(d2.val*d3.val);
den_1.err += d2.err * fabs(d1.val*d3.val);
den_1.err += d3.err * fabs(d1.val*d2.val);
den_2.val = d4.val*d5.val*d6.val;
den_2.err = d4.err * fabs(d5.val*d6.val);
den_2.err += d5.err * fabs(d4.val*d6.val);
den_2.err += d6.err * fabs(d4.val*d5.val);
term = phase * n1.val / den_1.val / den_2.val;
phase = -phase;
term_err = n1.err / fabs(den_1.val) / fabs(den_2.val);
term_err += fabs(term / den_1.val) * den_1.err;
term_err += fabs(term / den_2.val) * den_2.err;
if(term >= 0.0) {
sum_pos += norm*term;
}
else {
sum_neg -= norm*term;
}
sumsq_err += norm*norm * term_err*term_err;
}
result->val = 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;
}
}
void forwardMap(double q[2], double qdot[2], double t, double x[2], double v[2]) {
// maps from (q, qdot) -> (x(t), v(t)) (forward in time)
// to go backward, let t -> -t
// first step: find auxiliary variables
// eta0 is between 0 and pi but extends to between 0 and 2pi based on the sign of the initial r-velocity
double eta0 = etaZero(q,qdot);
if (qdot[0]<0.0) {
eta0 = 2.0 * M_PI - eta0;
}
// etabase is between 0 and pi
double etabase = eta(q,qdot,t, eta0);
double omega3 = Omega3(q,qdot);
double omega2 = Omega2(q,qdot);
double J2 = Lmag(q,qdot);
double ham = H(q,qdot);
double e = eccentricity(q, qdot);
double c = c_aux(q, qdot);
// compute number of pis to add for correct branch (theta2 and theta3 must increase continuously)
double Tr = 2.0 * M_PI / omega3;
double tperi = (theta3(0.0, q, qdot) - theta3(eta0,q, qdot))/omega3;
double tapo = (theta3(M_PI, q, qdot) - theta3(eta0,q, qdot))/omega3;
// both these should be larger than 0 (time of *next* pericenter and apocenter)
while (tperi<0) {
tperi += Tr;
}
while (tapo<0) {
tapo += Tr;
}
// calculate number of half-periods (no. of peri- or apocenter passages)
int nstar = ((int) floor((t - GSL_MIN(tapo, tperi))/(Tr/2.0))) + 1;
// get r
double base = (1.0 + c/B_ISO * (1.0 - e * cos(etabase)));
x[0] = B_ISO * sqrt(base * base - 1.0);
// get phi
double tan1 = atan(sqrt((1.0 + e)/(1.0 - e)) * tan(etabase/2.0)) + M_PI * floor((etabase+M_PI)/(2.0 * M_PI));
double tan2 = (atan(sqrt((1.0 + e + 2.0 * B_ISO / c)/(1.0 - e + 2.0 * B_ISO / c)) * tan(etabase/2.0)) + M_PI * floor((etabase+M_PI)/(2.0 * M_PI)))/sqrt(1 + 4.0 * M_PI * B_ISO / (J2 * J2));
double th20 = theta2(eta0, q[1], q, qdot);
double th3 = theta3(etabase, q, qdot);
// fprintf(stdout, "%lg %lg %lg %lg\n", t, tan1, tan2,th3);
x[1] = th20 + omega2 * t - omega2/omega3 * th3 + tan1 + tan2;
// conservation of angular momentum gives phidot
v[1] = J2 / (x[0] * x[0]);
// conservation of energy gives magnitude of rdot
v[0] = M_SQRT2 * sqrt(ham - J2 * J2 / (2.0 * x[0] * x[0]) - Phi(x[0]));
// figure out the sign - if it started heading toward pericenter
// and has gone thru an even number of half-periods since then, vr<0
// likewise if it started heading toward apo and has gone thru an odd nm
// of half-periods, vr<0
if((GSL_IS_EVEN(nstar) && (tperi<tapo)) || (GSL_IS_ODD(nstar) && (tapo<tperi)))
v[0] *= -1.0;
}
int
gsl_sf_legendre_Plm_deriv_array(
const int lmax, const int m, const double x,
double * result_array,
double * result_deriv_array)
{
if(m < 0 || m > lmax)
{
GSL_ERROR("m < 0 or m > lmax", GSL_EDOM);
}
else if(m == 0)
{
/* It is better to do m=0 this way, so we can more easily
* trap the divergent case which can occur when m == 1.
*/
return gsl_sf_legendre_Pl_deriv_array(lmax, x, result_array, result_deriv_array);
}
else
{
int stat_array = gsl_sf_legendre_Plm_array(lmax, m, x, result_array);
if(stat_array == GSL_SUCCESS)
{
int ell;
if(m == 1 && (1.0 - fabs(x) < GSL_DBL_EPSILON))
{
/* This divergence is real and comes from the cusp-like
* behaviour for m = 1. For example, P[1,1] = - Sqrt[1-x^2].
*/
GSL_ERROR("divergence near |x| = 1.0 since m = 1", GSL_EOVRFLW);
}
else if(m == 2 && (1.0 - fabs(x) < GSL_DBL_EPSILON))
{
/* m = 2 gives a finite nonzero result for |x| near 1 */
if(fabs(x - 1.0) < GSL_DBL_EPSILON)
{
for(ell = m; ell <= lmax; ell++) result_deriv_array[ell-m] = -0.25 * x * (ell - 1.0)*ell*(ell+1.0)*(ell+2.0);
}
else if(fabs(x + 1.0) < GSL_DBL_EPSILON)
{
for(ell = m; ell <= lmax; ell++)
{
const double sgn = ( GSL_IS_ODD(ell) ? 1.0 : -1.0 );
result_deriv_array[ell-m] = -0.25 * sgn * x * (ell - 1.0)*ell*(ell+1.0)*(ell+2.0);
}
}
return GSL_SUCCESS;
}
else
{
/* m > 2 is easier to deal with since the endpoints always vanish */
if(1.0 - fabs(x) < GSL_DBL_EPSILON)
{
for(ell = m; ell <= lmax; ell++) result_deriv_array[ell-m] = 0.0;
return GSL_SUCCESS;
}
else
{
const double diff_a = 1.0 + x;
const double diff_b = 1.0 - x;
result_deriv_array[0] = - m * x / (diff_a * diff_b) * result_array[0];
if(lmax-m >= 1) result_deriv_array[1] = (2.0 * m + 1.0) * (x * result_deriv_array[0] + result_array[0]);
for(ell = m+2; ell <= lmax; ell++)
{
result_deriv_array[ell-m] = - (ell * x * result_array[ell-m] - (ell+m) * result_array[ell-1-m]) / (diff_a * diff_b);
}
return GSL_SUCCESS;
}
}
}
else
{
return stat_array;
}
}
}
int
gsl_sf_coupling_3j_e (int two_ja, int two_jb, int two_jc,
int two_ma, int two_mb, int two_mc,
gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(two_ja < 0 || two_jb < 0 || two_jc < 0) {
DOMAIN_ERROR(result);
}
else if ( triangle_selection_fails(two_ja, two_jb, two_jc)
|| m_selection_fails(two_ja, two_jb, two_jc, two_ma, two_mb, two_mc)
) {
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else {
int jca = (-two_ja + two_jb + two_jc) / 2,
jcb = ( two_ja - two_jb + two_jc) / 2,
jcc = ( two_ja + two_jb - two_jc) / 2,
jmma = ( two_ja - two_ma) / 2,
jmmb = ( two_jb - two_mb) / 2,
jmmc = ( two_jc - two_mc) / 2,
jpma = ( two_ja + two_ma) / 2,
jpmb = ( two_jb + two_mb) / 2,
jpmc = ( two_jc + two_mc) / 2,
jsum = ( two_ja + two_jb + two_jc) / 2,
kmin = locMax3 (0, jpmb - jmmc, jmma - jpmc),
kmax = locMin3 (jcc, jmma, jpmb),
k, sign = GSL_IS_ODD (kmin - jpma + jmmb) ? -1 : 1,
status = 0;
double sum_pos = 0.0, sum_neg = 0.0, norm, term;
gsl_sf_result bc1, bc2, bc3, bcn1, bcn2, bcd1, bcd2, bcd3, bcd4;
status += gsl_sf_choose_e (two_ja, jcc , &bcn1);
status += gsl_sf_choose_e (two_jb, jcc , &bcn2);
status += gsl_sf_choose_e (jsum+1, jcc , &bcd1);
status += gsl_sf_choose_e (two_ja, jmma, &bcd2);
status += gsl_sf_choose_e (two_jb, jmmb, &bcd3);
status += gsl_sf_choose_e (two_jc, jpmc, &bcd4);
if (status != 0) {
OVERFLOW_ERROR (result);
}
norm = sqrt (bcn1.val * bcn2.val)
/ sqrt (bcd1.val * bcd2.val * bcd3.val * bcd4.val * ((double) two_jc + 1.0));
for (k = kmin; k <= kmax; k++) {
status += gsl_sf_choose_e (jcc, k, &bc1);
status += gsl_sf_choose_e (jcb, jmma - k, &bc2);
status += gsl_sf_choose_e (jca, jpmb - k, &bc3);
if (status != 0) {
OVERFLOW_ERROR (result);
}
term = bc1.val * bc2.val * bc3.val;
if (sign < 0) {
sum_neg += norm * term;
} else {
sum_pos += norm * term;
}
sign = -sign;
}
result->val = sum_pos - sum_neg;
result->err = 2.0 * GSL_DBL_EPSILON * (sum_pos + sum_neg);
result->err += 2.0 * GSL_DBL_EPSILON * (kmax - kmin) * fabs(result->val);
return GSL_SUCCESS;
}
}
int
gsl_sf_bessel_Yn_e(int n, const double x, gsl_sf_result * result)
{
int sign = 1;
if(n < 0) {
/* reduce to case n >= 0 */
n = -n;
if(GSL_IS_ODD(n)) sign = -1;
}
/* CHECK_POINTER(result) */
if(n == 0) {
int status = gsl_sf_bessel_Y0_e(x, result);
result->val *= sign;
return status;
}
else if(n == 1) {
int status = gsl_sf_bessel_Y1_e(x, result);
result->val *= sign;
return status;
}
else {
if(x <= 0.0) {
DOMAIN_ERROR(result);
}
if(x < 5.0) {
int status = bessel_Yn_small_x(n, x, result);
result->val *= sign;
return status;
}
else if(GSL_ROOT3_DBL_EPSILON * x > (n*n + 1.0)) {
int status = gsl_sf_bessel_Ynu_asympx_e((double)n, x, result);
result->val *= sign;
return status;
}
else if(n > 50) {
int status = gsl_sf_bessel_Ynu_asymp_Olver_e((double)n, x, result);
result->val *= sign;
return status;
}
else {
double two_over_x = 2.0/x;
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<n; j++) {
byp = j*two_over_x*by - bym;
bym = by;
by = byp;
}
result->val = sign * by;
result->err = fabs(result->val) * (fabs(r_by.err/r_by.val) + fabs(r_bym.err/r_bym.val));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_1, stat_0);
}
}
}
/* Evaluate the continued fraction for exprel.
* [Abramowitz+Stegun, 4.2.41]
*/
static
int
exprel_n_CF(const int N, const double x, gsl_sf_result * result)
{
const double RECUR_BIG = GSL_SQRT_DBL_MAX;
const int maxiter = 5000;
int n = 1;
double Anm2 = 1.0;
double Bnm2 = 0.0;
double Anm1 = 0.0;
double Bnm1 = 1.0;
double a1 = 1.0;
double b1 = 1.0;
double a2 = -x;
double b2 = N+1;
double an, bn;
double fn;
double An = b1*Anm1 + a1*Anm2; /* A1 */
double Bn = b1*Bnm1 + a1*Bnm2; /* B1 */
/* One explicit step, before we get to the main pattern. */
n++;
Anm2 = Anm1;
Bnm2 = Bnm1;
Anm1 = An;
Bnm1 = Bn;
An = b2*Anm1 + a2*Anm2; /* A2 */
Bn = b2*Bnm1 + a2*Bnm2; /* B2 */
fn = An/Bn;
while(n < maxiter) {
double old_fn;
double del;
n++;
Anm2 = Anm1;
Bnm2 = Bnm1;
Anm1 = An;
Bnm1 = Bn;
an = ( GSL_IS_ODD(n) ? ((n-1)/2)*x : -(N+(n/2)-1)*x );
bn = N + n - 1;
An = bn*Anm1 + an*Anm2;
Bn = bn*Bnm1 + an*Bnm2;
if(fabs(An) > RECUR_BIG || fabs(Bn) > RECUR_BIG) {
An /= RECUR_BIG;
Bn /= RECUR_BIG;
Anm1 /= RECUR_BIG;
Bnm1 /= RECUR_BIG;
Anm2 /= RECUR_BIG;
Bnm2 /= RECUR_BIG;
}
old_fn = fn;
fn = An/Bn;
del = old_fn/fn;
if(fabs(del - 1.0) < 2.0*GSL_DBL_EPSILON) break;
}
result->val = fn;
result->err = 2.0*(n+1.0)*GSL_DBL_EPSILON*fabs(fn);
if(n == maxiter)
GSL_ERROR ("error", GSL_EMAXITER);
else
return GSL_SUCCESS;
}
int
gsl_sf_bessel_In_scaled_e(int n, const double x, gsl_sf_result * result)
{
const double ax = fabs(x);
n = abs(n); /* I(-n, z) = I(n, z) */
/* CHECK_POINTER(result) */
if(n == 0) {
return gsl_sf_bessel_I0_scaled_e(x, result);
}
else if(n == 1) {
return gsl_sf_bessel_I1_scaled_e(x, result);
}
else if(x == 0.0) {
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(x*x < 10.0*(n+1.0)/M_E) {
gsl_sf_result t;
double ex = exp(-ax);
int stat_In = gsl_sf_bessel_IJ_taylor_e((double)n, ax, 1, 50, GSL_DBL_EPSILON, &t);
result->val = t.val * ex;
result->err = t.err * ex;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
if(x < 0.0 && GSL_IS_ODD(n)) result->val = -result->val;
return stat_In;
}
else if(n < 150 && ax < 1e7) {
gsl_sf_result I0_scaled;
int stat_I0 = gsl_sf_bessel_I0_scaled_e(ax, &I0_scaled);
double rat;
int stat_CF1 = gsl_sf_bessel_I_CF1_ser((double)n, ax, &rat);
double Ikp1 = rat * GSL_SQRT_DBL_MIN;
double Ik = GSL_SQRT_DBL_MIN;
double Ikm1;
int k;
for(k=n; k >= 1; k--) {
Ikm1 = Ikp1 + 2.0*k/ax * Ik;
Ikp1 = Ik;
Ik = Ikm1;
}
result->val = I0_scaled.val * (GSL_SQRT_DBL_MIN / Ik);
result->err = I0_scaled.err * (GSL_SQRT_DBL_MIN / Ik);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
if(x < 0.0 && GSL_IS_ODD(n)) result->val = -result->val;
return GSL_ERROR_SELECT_2(stat_I0, stat_CF1);
}
else if( GSL_MIN( 0.29/(n*n), 0.5/(n*n + x*x) ) < 0.5*GSL_ROOT3_DBL_EPSILON) {
int stat_as = gsl_sf_bessel_Inu_scaled_asymp_unif_e((double)n, ax, result);
if(x < 0.0 && GSL_IS_ODD(n)) result->val = -result->val;
return stat_as;
}
else {
const int nhi = 2 + (int) (1.2 / GSL_ROOT6_DBL_EPSILON);
gsl_sf_result r_Ikp1;
gsl_sf_result r_Ik;
int stat_a1 = gsl_sf_bessel_Inu_scaled_asymp_unif_e(nhi+1.0, ax, &r_Ikp1);
int stat_a2 = gsl_sf_bessel_Inu_scaled_asymp_unif_e((double)nhi, ax, &r_Ik);
double Ikp1 = r_Ikp1.val;
double Ik = r_Ik.val;
double Ikm1;
int k;
for(k=nhi; k > n; k--) {
Ikm1 = Ikp1 + 2.0*k/ax * Ik;
Ikp1 = Ik;
Ik = Ikm1;
}
result->val = Ik;
result->err = Ik * (r_Ikp1.err/r_Ikp1.val + r_Ik.err/r_Ik.val);
if(x < 0.0 && GSL_IS_ODD(n)) result->val = -result->val;
return GSL_ERROR_SELECT_2(stat_a1, stat_a2);
}
}
int gsl_sf_bessel_il_scaled_e(const int l, double x, gsl_sf_result * result)
{
double sgn = 1.0;
double ax = fabs(x);
if(x < 0.0) {
/* i_l(-x) = (-1)^l i_l(x) */
sgn = ( GSL_IS_ODD(l) ? -1.0 : 1.0 );
x = -x;
}
if(l < 0) {
DOMAIN_ERROR(result);
}
else if(x == 0.0) {
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(l == 0) {
gsl_sf_result il;
int stat_il = gsl_sf_bessel_i0_scaled_e(x, &il);
result->val = sgn * il.val;
result->err = il.err;
return stat_il;
}
else if(l == 1) {
gsl_sf_result il;
int stat_il = gsl_sf_bessel_i1_scaled_e(x, &il);
result->val = sgn * il.val;
result->err = il.err;
return stat_il;
}
else if(l == 2) {
gsl_sf_result il;
int stat_il = gsl_sf_bessel_i2_scaled_e(x, &il);
result->val = sgn * il.val;
result->err = il.err;
return stat_il;
}
else if(x*x < 10.0*(l+1.5)/M_E) {
gsl_sf_result b;
int stat = gsl_sf_bessel_IJ_taylor_e(l+0.5, x, 1, 50, GSL_DBL_EPSILON, &b);
double pre = exp(-ax) * sqrt((0.5*M_PI)/x);
result->val = sgn * pre * b.val;
result->err = pre * b.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat;
}
else if(l < 150) {
gsl_sf_result i0_scaled;
int stat_i0 = gsl_sf_bessel_i0_scaled_e(ax, &i0_scaled);
double rat;
int stat_CF1 = bessel_il_CF1(l, ax, GSL_DBL_EPSILON, &rat);
double iellp1 = rat * GSL_SQRT_DBL_MIN;
double iell = GSL_SQRT_DBL_MIN;
double iellm1;
int ell;
for(ell = l; ell >= 1; ell--) {
iellm1 = iellp1 + (2*ell + 1)/x * iell;
iellp1 = iell;
iell = iellm1;
}
result->val = sgn * i0_scaled.val * (GSL_SQRT_DBL_MIN / iell);
result->err = i0_scaled.err * (GSL_SQRT_DBL_MIN / iell);
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_i0, stat_CF1);
}
else if(GSL_MIN(0.29/(l*l+1.0), 0.5/(l*l+1.0+x*x)) < 0.5*GSL_ROOT3_DBL_EPSILON) {
int status = gsl_sf_bessel_Inu_scaled_asymp_unif_e(l + 0.5, x, result);
double pre = sqrt((0.5*M_PI)/x);
result->val *= sgn * pre;
result->err *= pre;
return status;
}
else {
/* recurse down from safe values */
double rt_term = sqrt((0.5*M_PI)/x);
const int LMAX = 2 + (int) (1.2 / GSL_ROOT6_DBL_EPSILON);
gsl_sf_result r_iellp1;
gsl_sf_result r_iell;
int stat_a1 = gsl_sf_bessel_Inu_scaled_asymp_unif_e(LMAX + 1 + 0.5, x, &r_iellp1);
int stat_a2 = gsl_sf_bessel_Inu_scaled_asymp_unif_e(LMAX + 0.5, x, &r_iell);
double iellp1 = r_iellp1.val;
double iell = r_iell.val;
double iellm1 = 0.0;
int ell;
iellp1 *= rt_term;
iell *= rt_term;
for(ell = LMAX; ell >= l+1; ell--) {
iellm1 = iellp1 + (2*ell + 1)/x * iell;
iellp1 = iell;
iell = iellm1;
}
result->val = sgn * iellm1;
result->err = fabs(result->val)*(GSL_DBL_EPSILON + fabs(r_iellp1.err/r_iellp1.val) + fabs(r_iell.err/r_iell.val));
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_a1, stat_a2);
}
}
int
gsl_sf_cos_e(double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
{
const double P1 = 7.85398125648498535156e-1;
const double P2 = 3.77489470793079817668e-8;
const double P3 = 2.69515142907905952645e-15;
const double abs_x = fabs(x);
if(abs_x < GSL_ROOT4_DBL_EPSILON) {
const double x2 = x*x;
result->val = 1.0 - 0.5*x2;
result->err = fabs(x2*x2/12.0);
return GSL_SUCCESS;
}
else {
double sgn_result = 1.0;
double y = floor(abs_x/(0.25*M_PI));
int octant = y - ldexp(floor(ldexp(y,-3)),3);
int stat_cs;
double z;
if(GSL_IS_ODD(octant)) {
octant += 1;
octant &= 07;
y += 1.0;
}
if(octant > 3) {
octant -= 4;
sgn_result = -sgn_result;
}
if(octant > 1) {
sgn_result = -sgn_result;
}
z = ((abs_x - y * P1) - y * P2) - y * P3;
if(octant == 0) {
gsl_sf_result cos_cs_result;
const double t = 8.0*fabs(z)/M_PI - 1.0;
stat_cs = cheb_eval_e(&cos_cs, t, &cos_cs_result);
result->val = 1.0 - 0.5*z*z * (1.0 - z*z * cos_cs_result.val);
}
else { /* octant == 2 */
gsl_sf_result sin_cs_result;
const double t = 8.0*fabs(z)/M_PI - 1.0;
stat_cs = cheb_eval_e(&sin_cs, t, &sin_cs_result);
result->val = z * (1.0 + z*z * sin_cs_result.val);
}
result->val *= sgn_result;
if(abs_x > 1.0/GSL_DBL_EPSILON) {
result->err = fabs(result->val);
}
else if(abs_x > 100.0/GSL_SQRT_DBL_EPSILON) {
result->err = 2.0 * abs_x * GSL_DBL_EPSILON * fabs(result->val);
}
else if(abs_x > 0.1/GSL_SQRT_DBL_EPSILON) {
result->err = 2.0 * GSL_SQRT_DBL_EPSILON * fabs(result->val);
}
else {
result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
}
return stat_cs;
}
}
}
int
gsl_sf_legendre_Pl_e(const int l, const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(l < 0 || x < -1.0 || x > 1.0) {
DOMAIN_ERROR(result);
}
else if(l == 0) {
result->val = 1.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(l == 1) {
result->val = x;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(l == 2) {
result->val = 0.5 * (3.0*x*x - 1.0);
result->err = 3.0 * GSL_DBL_EPSILON * fabs(result->val);
return GSL_SUCCESS;
}
else if(x == 1.0) {
result->val = 1.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else if(x == -1.0) {
result->val = ( GSL_IS_ODD(l) ? -1.0 : 1.0 );
result->err = 0.0;
return GSL_SUCCESS;
}
else if(l < 100000) {
/* Compute by upward recurrence on l.
*/
double p_mm = 1.0; /* P_0(x) */
double p_mmp1 = x; /* P_1(x) */
double p_ell = p_mmp1;
int ell;
for(ell=2; ell <= l; ell++){
p_ell = (x*(2*ell-1)*p_mmp1 - (ell-1)*p_mm) / ell;
p_mm = p_mmp1;
p_mmp1 = p_ell;
}
result->val = p_ell;
result->err = (0.5 * ell + 1.0) * GSL_DBL_EPSILON * fabs(p_ell);
return GSL_SUCCESS;
}
else {
/* Asymptotic expansion.
* [Olver, p. 473]
*/
double u = l + 0.5;
double th = acos(x);
gsl_sf_result J0;
gsl_sf_result Jm1;
int stat_J0 = gsl_sf_bessel_J0_e(u*th, &J0);
int stat_Jm1 = gsl_sf_bessel_Jn_e(-1, u*th, &Jm1);
double pre;
double B00;
double c1;
/* B00 = 1/8 (1 - th cot(th) / th^2
* pre = sqrt(th/sin(th))
*/
if(th < GSL_ROOT4_DBL_EPSILON) {
B00 = (1.0 + th*th/15.0)/24.0;
pre = 1.0 + th*th/12.0;
}
else {
double sin_th = sqrt(1.0 - x*x);
double cot_th = x / sin_th;
B00 = 1.0/8.0 * (1.0 - th * cot_th) / (th*th);
pre = sqrt(th/sin_th);
}
c1 = th/u * B00;
result->val = pre * (J0.val + c1 * Jm1.val);
result->err = pre * (J0.err + fabs(c1) * Jm1.err);
result->err += GSL_SQRT_DBL_EPSILON * fabs(result->val);
return GSL_ERROR_SELECT_2(stat_J0, stat_Jm1);
}
}
int
gsl_sf_legendre_sphPlm_array(const int lmax, int m, const double x, double * result_array)
{
/* CHECK_POINTER(result_array) */
if(m < 0 || lmax < m || x < -1.0 || x > 1.0) {
GSL_ERROR ("error", GSL_EDOM);
}
else if(m > 0 && (x == 1.0 || x == -1.0)) {
int ell;
for(ell=m; ell<=lmax; ell++) result_array[ell-m] = 0.0;
return GSL_SUCCESS;
}
else {
double y_mm;
double y_mmp1;
if(m == 0) {
y_mm = 0.5/M_SQRTPI; /* Y00 = 1/sqrt(4pi) */
y_mmp1 = x * M_SQRT3 * y_mm;
}
else {
/* |x| < 1 here */
gsl_sf_result lncirc;
gsl_sf_result lnpoch;
double lnpre;
const double sgn = ( GSL_IS_ODD(m) ? -1.0 : 1.0);
gsl_sf_log_1plusx_e(-x*x, &lncirc);
gsl_sf_lnpoch_e(m, 0.5, &lnpoch); /* Gamma(m+1/2)/Gamma(m) */
lnpre = -0.25*M_LNPI + 0.5 * (lnpoch.val + m*lncirc.val);
y_mm = sqrt((2.0+1.0/m)/(4.0*M_PI)) * sgn * exp(lnpre);
y_mmp1 = x * sqrt(2.0*m + 3.0) * y_mm;
}
if(lmax == m){
result_array[0] = y_mm;
return GSL_SUCCESS;
}
else if(lmax == m + 1) {
result_array[0] = y_mm;
result_array[1] = y_mmp1;
return GSL_SUCCESS;
}
else{
double y_ell;
int ell;
result_array[0] = y_mm;
result_array[1] = y_mmp1;
/* Compute Y_l^m, l > m+1, upward recursion on l. */
for(ell=m+2; ell <= lmax; ell++){
const double rat1 = (double)(ell-m)/(double)(ell+m);
const double rat2 = (ell-m-1.0)/(ell+m-1.0);
const double factor1 = sqrt(rat1*(2*ell+1)*(2*ell-1));
const double factor2 = sqrt(rat1*rat2*(2*ell+1)/(2*ell-3));
y_ell = (x*y_mmp1*factor1 - (ell+m-1)*y_mm*factor2) / (ell-m);
y_mm = y_mmp1;
y_mmp1 = y_ell;
result_array[ell-m] = y_ell;
}
}
return GSL_SUCCESS;
}
}
int
gsl_sf_legendre_sphPlm_e(const int l, int m, const double x, gsl_sf_result * result)
{
/* CHECK_POINTER(result) */
if(m < 0 || l < m || x < -1.0 || x > 1.0) {
DOMAIN_ERROR(result);
}
else if(m == 0) {
gsl_sf_result P;
int stat_P = gsl_sf_legendre_Pl_e(l, x, &P);
double pre = sqrt((2.0*l + 1.0)/(4.0*M_PI));
result->val = pre * P.val;
result->err = pre * P.err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
return stat_P;
}
else if(x == 1.0 || x == -1.0) {
/* m > 0 here */
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
else {
/* m > 0 and |x| < 1 here */
/* Starting value for recursion.
* Y_m^m(x) = sqrt( (2m+1)/(4pi m) gamma(m+1/2)/gamma(m) ) (-1)^m (1-x^2)^(m/2) / pi^(1/4)
*/
gsl_sf_result lncirc;
gsl_sf_result lnpoch;
double lnpre_val;
double lnpre_err;
gsl_sf_result ex_pre;
double sr;
const double sgn = ( GSL_IS_ODD(m) ? -1.0 : 1.0);
const double y_mmp1_factor = x * sqrt(2.0*m + 3.0);
double y_mm, y_mm_err;
double y_mmp1;
gsl_sf_log_1plusx_e(-x*x, &lncirc);
gsl_sf_lnpoch_e(m, 0.5, &lnpoch); /* Gamma(m+1/2)/Gamma(m) */
lnpre_val = -0.25*M_LNPI + 0.5 * (lnpoch.val + m*lncirc.val);
lnpre_err = 0.25*M_LNPI*GSL_DBL_EPSILON + 0.5 * (lnpoch.err + fabs(m)*lncirc.err);
gsl_sf_exp_err_e(lnpre_val, lnpre_err, &ex_pre);
sr = sqrt((2.0+1.0/m)/(4.0*M_PI));
y_mm = sgn * sr * ex_pre.val;
y_mmp1 = y_mmp1_factor * y_mm;
y_mm_err = 2.0 * GSL_DBL_EPSILON * fabs(y_mm) + sr * ex_pre.err;
y_mm_err *= 1.0 + 1.0/(GSL_DBL_EPSILON + fabs(1.0-x));
if(l == m){
result->val = y_mm;
result->err = y_mm_err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(y_mm);
return GSL_SUCCESS;
}
else if(l == m + 1) {
result->val = y_mmp1;
result->err = fabs(y_mmp1_factor) * y_mm_err;
result->err += 2.0 * GSL_DBL_EPSILON * fabs(y_mmp1);
return GSL_SUCCESS;
}
else{
double y_ell = 0.0;
int ell;
/* Compute Y_l^m, l > m+1, upward recursion on l. */
for(ell=m+2; ell <= l; ell++){
const double rat1 = (double)(ell-m)/(double)(ell+m);
const double rat2 = (ell-m-1.0)/(ell+m-1.0);
const double factor1 = sqrt(rat1*(2*ell+1)*(2*ell-1));
const double factor2 = sqrt(rat1*rat2*(2*ell+1)/(2*ell-3));
y_ell = (x*y_mmp1*factor1 - (ell+m-1)*y_mm*factor2) / (ell-m);
y_mm = y_mmp1;
y_mmp1 = y_ell;
}
result->val = y_ell;
result->err = (0.5*(l-m) + 1.0) * GSL_DBL_EPSILON * fabs(y_ell);
result->err += fabs(y_mm_err/y_mm) * fabs(y_ell);
return GSL_SUCCESS;
}
}
}
static VALUE rb_GSL_IS_ODD(VALUE obj, VALUE n)
{
CHECK_FIXNUM(n);
return INT2FIX(GSL_IS_ODD(FIX2INT(n)));
}
