double exp2(double x)
{
double px, xx;
short n;
if (cephes_isnan(x))
return (x);
if (x > MAXL2) {
return (NPY_INFINITY);
}
if (x < MINL2) {
return (0.0);
}
xx = x; /* save x */
/* separate into integer and fractional parts */
px = floor(x + 0.5);
n = px;
x = x - px;
/* rational approximation
* exp2(x) = 1 + 2xP(xx)/(Q(xx) - P(xx))
* where xx = x**2
*/
xx = x * x;
px = x * polevl(xx, P, 2);
x = px / (p1evl(xx, Q, 2) - px);
x = 1.0 + ldexp(x, 1);
/* scale by power of 2 */
x = ldexp(x, n);
return (x);
}
double erfc(double a)
{
double p, q, x, y, z;
if (cephes_isnan(a)) {
mtherr("erfc", DOMAIN);
return (NPY_NAN);
}
if (a < 0.0)
x = -a;
else
x = a;
if (x < 1.0)
return (1.0 - erf(a));
z = -a * a;
if (z < -MAXLOG) {
under:
mtherr("erfc", UNDERFLOW);
if (a < 0)
return (2.0);
else
return (0.0);
}
z = exp(z);
if (x < 8.0) {
p = polevl(x, P, 8);
q = p1evl(x, Q, 8);
}
else {
p = polevl(x, R, 5);
q = p1evl(x, S, 6);
}
y = (z * p) / q;
if (a < 0)
y = 2.0 - y;
if (y == 0.0)
goto under;
return (y);
}
double erf(double x)
{
double y, z;
if (cephes_isnan(x)) {
mtherr("erf", DOMAIN);
return (NPY_NAN);
}
if (fabs(x) > 1.0)
return (1.0 - erfc(x));
z = x * x;
y = x * polevl(z, T, 4) / p1evl(z, U, 5);
return (y);
}
double expm1(double x)
{
double r, xx;
if (!cephes_isfinite(x)) {
if (cephes_isnan(x)) {
return x;
}
else if (x > 0) {
return x;
}
else {
return -1.0;
}
}
if ((x < -0.5) || (x > 0.5))
return (exp(x) - 1.0);
xx = x * x;
r = x * polevl(xx, EP, 2);
r = r / (polevl(xx, EQ, 3) - r);
return (r + r);
}
double ndtr(double a)
{
double x, y, z;
if (cephes_isnan(a)) {
mtherr("ndtr", DOMAIN);
return (NPY_NAN);
}
x = a * SQRTH;
z = fabs(x);
if (z < SQRTH)
y = 0.5 + 0.5 * erf(x);
else {
y = 0.5 * erfc(z);
if (x > 0)
y = 1.0 - y;
}
return (y);
}
double expn(int n, double x)
{
double ans, r, t, yk, xk;
double pk, pkm1, pkm2, qk, qkm1, qkm2;
double psi, z;
int i, k;
static double big = BIG;
if (cephes_isnan(x)) {
return CEPHES_NAN;
}
else if (n < 0 || x < 0) {
mtherr("expn", DOMAIN);
return CEPHES_INFINITY;
}
if (x > MAXLOG) {
return (0.0);
}
if (x == 0.0) {
if (n < 2) {
mtherr("expn", SING);
return (CEPHES_INFINITY);
}
else {
return (1.0 / (n - 1.0));
}
}
if (n == 0) {
return (exp(-x) / x);
}
/* Asymptotic expansion for large n, DLMF 8.20(ii) */
if (n > 50) {
ans = expn_large_n(n, x);
goto done;
}
if (x > 1.0) {
goto cfrac;
}
/* Power series expansion, DLMF 8.19.8 */
psi = -EUL - log(x);
for (i = 1; i < n; i++) {
psi = psi + 1.0 / i;
}
z = -x;
xk = 0.0;
yk = 1.0;
pk = 1.0 - n;
if (n == 1) {
ans = 0.0;
} else {
ans = 1.0 / pk;
}
do {
xk += 1.0;
yk *= z / xk;
pk += 1.0;
if (pk != 0.0) {
ans += yk / pk;
}
if (ans != 0.0)
t = fabs(yk / ans);
else
t = 1.0;
} while (t > MACHEP);
k = xk;
t = n;
r = n - 1;
ans = (pow(z, r) * psi / Gamma(t)) - ans;
goto done;
/* Continued fraction, DLMF 8.19.17 */
cfrac:
k = 1;
pkm2 = 1.0;
qkm2 = x;
pkm1 = 1.0;
qkm1 = x + n;
ans = pkm1 / qkm1;
do {
k += 1;
if (k & 1) {
yk = 1.0;
xk = n + (k - 1) / 2;
} else {
yk = x;
xk = k / 2;
}
pk = pkm1 * yk + pkm2 * xk;
qk = qkm1 * yk + qkm2 * xk;
if (qk != 0) {
r = pk / qk;
t = fabs((ans - r) / r);
ans = r;
} else {
t = 1.0;
}
pkm2 = pkm1;
pkm1 = pk;
qkm2 = qkm1;
qkm1 = qk;
if (fabs(pk) > big) {
pkm2 /= big;
pkm1 /= big;
qkm2 /= big;
qkm1 /= big;
}
} while (t > MACHEP);
ans *= exp(-x);
done:
return (ans);
}
int ellpj(double u, double m, double *sn, double *cn, double *dn, double *ph)
{
double ai, b, phi, t, twon, dnfac;
double a[9], c[9];
int i;
/* Check for special cases */
if (m < 0.0 || m > 1.0 || cephes_isnan(m)) {
mtherr("ellpj", DOMAIN);
*sn = CEPHES_NAN;
*cn = CEPHES_NAN;
*ph = CEPHES_NAN;
*dn = CEPHES_NAN;
return (-1);
}
if (m < 1.0e-9) {
t = sin(u);
b = cos(u);
ai = 0.25 * m * (u - t * b);
*sn = t - ai * b;
*cn = b + ai * t;
*ph = u - ai;
*dn = 1.0 - 0.5 * m * t * t;
return (0);
}
if (m >= 0.9999999999) {
ai = 0.25 * (1.0 - m);
b = cosh(u);
t = tanh(u);
phi = 1.0 / b;
twon = b * sinh(u);
*sn = t + ai * (twon - u) / (b * b);
*ph = 2.0 * atan(exp(u)) - CEPHES_PI_2 + ai * (twon - u) / b;
ai *= t * phi;
*cn = phi - ai * (twon - u);
*dn = phi + ai * (twon + u);
return (0);
}
/* A. G. M. scale. See DLMF 20.20(ii) */
a[0] = 1.0;
b = sqrt(1.0 - m);
c[0] = sqrt(m);
twon = 1.0;
i = 0;
while (fabs(c[i] / a[i]) > MACHEP) {
if (i > 7) {
mtherr("ellpj", OVERFLOW);
goto done;
}
ai = a[i];
++i;
c[i] = (ai - b) / 2.0;
t = sqrt(ai * b);
a[i] = (ai + b) / 2.0;
b = t;
twon *= 2.0;
}
done:
/* backward recurrence */
phi = twon * a[i] * u;
do {
t = c[i] * sin(phi) / a[i];
b = phi;
phi = (asin(t) + phi) / 2.0;
}
while (--i);
*sn = sin(phi);
t = cos(phi);
*cn = t;
dnfac = cos(phi - b);
/* See discussion after DLMF 22.20.5 */
if (fabs(dnfac) < 0.1) {
*dn = sqrt(1 - m*(*sn)*(*sn));
} else {
*dn = t / dnfac;
}
*ph = phi;
return (0);
}
double ellie(double phi, double m)
{
double a, b, c, e, temp;
double lphi, t, E, denom, npio2;
int d, mod, sign;
if (cephes_isnan(phi) || cephes_isnan(m))
return NPY_NAN;
if (m > 1.0)
return NPY_NAN;
if (cephes_isinf(phi))
return phi;
if (cephes_isinf(m))
return -m;
if (m == 0.0)
return (phi);
lphi = phi;
npio2 = floor(lphi / NPY_PI_2);
if (fmod(fabs(npio2), 2.0) == 1.0)
npio2 += 1;
lphi = lphi - npio2 * NPY_PI_2;
if (lphi < 0.0) {
lphi = -lphi;
sign = -1;
}
else {
sign = 1;
}
a = 1.0 - m;
E = ellpe(m);
if (a == 0.0) {
temp = sin(lphi);
goto done;
}
if (a > 1.0) {
temp = ellie_neg_m(lphi, m);
goto done;
}
if (lphi < 0.135) {
double m11= (((((-7.0/2816.0)*m + (5.0/1056.0))*m - (7.0/2640.0))*m
+ (17.0/41580.0))*m - (1.0/155925.0))*m;
double m9 = ((((-5.0/1152.0)*m + (1.0/144.0))*m - (1.0/360.0))*m
+ (1.0/5670.0))*m;
double m7 = ((-m/112.0 + (1.0/84.0))*m - (1.0/315.0))*m;
double m5 = (-m/40.0 + (1.0/30))*m;
double m3 = -m/6.0;
double p2 = lphi * lphi;
temp = ((((m11*p2 + m9)*p2 + m7)*p2 + m5)*p2 + m3)*p2*lphi + lphi;
goto done;
}
t = tan(lphi);
b = sqrt(a);
/* Thanks to Brian Fitzgerald <*****@*****.**>
* for pointing out an instability near odd multiples of pi/2. */
if (fabs(t) > 10.0) {
/* Transform the amplitude */
e = 1.0 / (b * t);
/* ... but avoid multiple recursions. */
if (fabs(e) < 10.0) {
e = atan(e);
temp = E + m * sin(lphi) * sin(e) - ellie(e, m);
goto done;
}
}
c = sqrt(m);
a = 1.0;
d = 1;
e = 0.0;
mod = 0;
while (fabs(c / a) > MACHEP) {
temp = b / a;
lphi = lphi + atan(t * temp) + mod * NPY_PI;
denom = 1 - temp * t * t;
if (fabs(denom) > 10*MACHEP) {
t = t * (1.0 + temp) / denom;
mod = (lphi + NPY_PI_2) / NPY_PI;
}
else {
t = tan(lphi);
mod = (int)floor((lphi - atan(t))/NPY_PI);
}
c = (a - b) / 2.0;
temp = sqrt(a * b);
a = (a + b) / 2.0;
b = temp;
d += d;
e += c * sin(lphi);
}
temp = E / ellpk(1.0 - m);
temp *= (atan(t) + mod * NPY_PI) / (d * a);
temp += e;
done:
if (sign < 0)
temp = -temp;
temp += npio2 * E;
return (temp);
}
