int gsl_sf_mathieu_b(int order, double qq, gsl_sf_result *result)
{
int even_odd, nterms = 50, ii, counter = 0, maxcount = 1000;
int dir = 0; /* step direction for new search */
double a1, a2, fa, fa1, dela, aa_orig, da = 0.025, aa;
double aa_approx; /* current approximation for solution */
even_odd = 0;
if (order % 2 != 0)
even_odd = 1;
/* The order cannot be 0. */
if (order == 0)
{
GSL_ERROR("Characteristic value undefined for order 0", GSL_EFAILED);
}
/* If the argument is 0, then the coefficient is simply the square of
the order. */
if (qq == 0)
{
result->val = order*order;
result->err = 0.0;
return GSL_SUCCESS;
}
/* Use symmetry characteristics of the functions to handle cases with
negative order and/or argument q. See Abramowitz & Stegun, 20.8.3. */
if (order < 0)
order *= -1;
if (qq < 0.0)
{
if (even_odd == 0)
return gsl_sf_mathieu_b(order, -qq, result);
else
return gsl_sf_mathieu_a(order, -qq, result);
}
/* Compute an initial approximation for the characteristic value. */
aa_approx = approx_s(order, qq);
/* Save the original approximation for later comparison. */
aa_orig = aa = aa_approx;
/* Loop as long as the final value is not near the approximate value
(with a max limit to avoid potential infinite loop). */
while (counter < maxcount)
{
a1 = aa + 0.001;
ii = 0;
if (even_odd == 0)
fa1 = seer(order, qq, a1, nterms);
else
fa1 = seor(order, qq, a1, nterms);
for (;;)
{
if (even_odd == 0)
fa = seer(order, qq, aa, nterms);
else
fa = seor(order, qq, aa, nterms);
a2 = a1;
a1 = aa;
if (fa == fa1)
{
result->err = GSL_DBL_EPSILON;
break;
}
aa -= (aa - a2)/(fa - fa1)*fa;
dela = fabs(aa - a2);
if (dela < 1e-18)
{
result->err = GSL_DBL_EPSILON;
break;
}
if (ii > 40)
{
result->err = dela;
break;
}
fa1 = fa;
ii++;
}
/* If the solution found is not near the original approximation,
tweak the approximate value, and try again. */
if (fabs(aa - aa_orig) > (3 + 0.01*order*fabs(aa_orig)) ||
(order > 10 && fabs(aa - aa_orig) > 1.5*order))
{
counter++;
if (counter == maxcount)
{
result->err = fabs(aa - aa_orig);
break;
}
if (aa > aa_orig)
{
if (dir == 1)
da /= 2;
dir = -1;
}
else
{
if (dir == -1)
da /= 2;
dir = 1;
}
aa_approx += dir*da*counter;
aa = aa_approx;
continue;
}
else
break;
}
result->val = aa;
/* If we went through the maximum number of retries and still didn't
find the solution, let us know. */
if (counter == maxcount)
{
GSL_ERROR("Wrong characteristic Mathieu value", GSL_EFAILED);
}
return GSL_SUCCESS;
}
int gsl_sf_mathieu_se(int order, double qq, double zz, gsl_sf_result *result)
{
int even_odd, ii, status;
double coeff[GSL_SF_MATHIEU_COEFF], norm, fn, factor;
gsl_sf_result aa;
norm = 0.0;
even_odd = 0;
if (order % 2 != 0)
even_odd = 1;
/* Handle the trivial cases where order = 0 and/or q = 0. */
if (order == 0)
{
result->val = 0.0;
result->err = 0.0;
return GSL_SUCCESS;
}
if (qq == 0.0)
{
norm = 1.0;
fn = sin(order*zz);
result->val = fn;
result->err = 2.0*GSL_DBL_EPSILON;
factor = fabs(fn);
if (factor > 1.0)
result->err *= factor;
return GSL_SUCCESS;
}
/* Use symmetry characteristics of the functions to handle cases with
negative order. */
if (order < 0)
order *= -1;
/* Compute the characteristic value. */
status = gsl_sf_mathieu_b(order, qq, &aa);
if (status != GSL_SUCCESS)
{
return status;
}
/* Compute the series coefficients. */
status = gsl_sf_mathieu_b_coeff(order, qq, aa.val, coeff);
if (status != GSL_SUCCESS)
{
return status;
}
if (even_odd == 0)
{
fn = 0.0;
for (ii=0; ii<GSL_SF_MATHIEU_COEFF; ii++)
{
norm += coeff[ii]*coeff[ii];
fn += coeff[ii]*sin(2.0*(ii + 1)*zz);
}
}
else
{
fn = 0.0;
for (ii=0; ii<GSL_SF_MATHIEU_COEFF; ii++)
{
norm += coeff[ii]*coeff[ii];
fn += coeff[ii]*sin((2.0*ii + 1)*zz);
}
}
norm = sqrt(norm);
fn /= norm;
result->val = fn;
result->err = 2.0*GSL_DBL_EPSILON;
factor = fabs(fn);
if (factor > 1.0)
result->err *= factor;
return GSL_SUCCESS;
}
int gsl_sf_mathieu_Ms(int kind, int order, double qq, double zz,
gsl_sf_result *result)
{
int even_odd, kk, mm, status;
double maxerr = 1e-14, amax, pi = M_PI, fn, factor;
double coeff[GSL_SF_MATHIEU_COEFF], fc;
double j1c, z2c, j1mc, z2mc, j1pc, z2pc;
double u1, u2;
gsl_sf_result aa;
/* Check for out of bounds parameters. */
if (qq <= 0.0)
{
GSL_ERROR("q must be greater than zero", GSL_EINVAL);
}
if (kind < 1 || kind > 2)
{
GSL_ERROR("kind must be 1 or 2", GSL_EINVAL);
}
mm = 0;
amax = 0.0;
fn = 0.0;
u1 = sqrt(qq)*exp(-1.0*zz);
u2 = sqrt(qq)*exp(zz);
even_odd = 0;
if (order % 2 != 0)
even_odd = 1;
/* Compute the characteristic value. */
status = gsl_sf_mathieu_b(order, qq, &aa);
if (status != GSL_SUCCESS)
{
return status;
}
/* Compute the series coefficients. */
status = gsl_sf_mathieu_b_coeff(order, qq, aa.val, coeff);
if (status != GSL_SUCCESS)
{
return status;
}
if (even_odd == 0)
{
for (kk=0; kk<GSL_SF_MATHIEU_COEFF; kk++)
{
amax = GSL_MAX(amax, fabs(coeff[kk]));
if (fabs(coeff[kk])/amax < maxerr)
break;
j1mc = gsl_sf_bessel_Jn(kk, u1);
j1pc = gsl_sf_bessel_Jn(kk+2, u1);
if (kind == 1)
{
z2mc = gsl_sf_bessel_Jn(kk, u2);
z2pc = gsl_sf_bessel_Jn(kk+2, u2);
}
else /* kind = 2 */
{
z2mc = gsl_sf_bessel_Yn(kk, u2);
z2pc = gsl_sf_bessel_Yn(kk+2, u2);
}
fc = pow(-1.0, 0.5*order+kk+1)*coeff[kk];
fn += fc*(j1mc*z2pc - j1pc*z2mc);
}
fn *= sqrt(pi/2.0)/coeff[0];
}
else
{
for (kk=0; kk<GSL_SF_MATHIEU_COEFF; kk++)
{
amax = GSL_MAX(amax, fabs(coeff[kk]));
if (fabs(coeff[kk])/amax < maxerr)
break;
j1c = gsl_sf_bessel_Jn(kk, u1);
j1pc = gsl_sf_bessel_Jn(kk+1, u1);
if (kind == 1)
{
z2c = gsl_sf_bessel_Jn(kk, u2);
z2pc = gsl_sf_bessel_Jn(kk+1, u2);
}
else /* kind = 2 */
{
z2c = gsl_sf_bessel_Yn(kk, u2);
z2pc = gsl_sf_bessel_Yn(kk+1, u2);
}
fc = pow(-1.0, 0.5*(order-1)+kk)*coeff[kk];
fn += fc*(j1c*z2pc - j1pc*z2c);
}
fn *= sqrt(pi/2.0)/coeff[0];
}
result->val = fn;
result->err = 2.0*GSL_DBL_EPSILON;
factor = fabs(fn);
if (factor > 1.0)
result->err *= factor;
return GSL_SUCCESS;
}