/* Put in z the value of x^y, rounded according to 'rnd'.
Return the inexact flag in [0, 10]. */
int
mpc_pow (mpc_ptr z, mpc_srcptr x, mpc_srcptr y, mpc_rnd_t rnd)
{
int ret = -2, loop, x_real, x_imag, y_real, z_real = 0, z_imag = 0;
mpc_t t, u;
mpfr_prec_t p, pr, pi, maxprec;
int saved_underflow, saved_overflow;
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
x_real = mpfr_zero_p (mpc_imagref(x));
y_real = mpfr_zero_p (mpc_imagref(y));
if (y_real && mpfr_zero_p (mpc_realref(y))) /* case y zero */
{
if (x_real && mpfr_zero_p (mpc_realref(x)))
{
/* we define 0^0 to be (1, +0) since the real part is
coherent with MPFR where 0^0 gives 1, and the sign of the
imaginary part cannot be determined */
mpc_set_ui_ui (z, 1, 0, MPC_RNDNN);
return 0;
}
else /* x^0 = 1 +/- i*0 even for x=NaN see algorithms.tex for the
sign of zero */
{
mpfr_t n;
int inex, cx1;
int sign_zi;
/* cx1 < 0 if |x| < 1
cx1 = 0 if |x| = 1
cx1 > 0 if |x| > 1
*/
mpfr_init (n);
inex = mpc_norm (n, x, MPFR_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (mpc_imagref (y)) == 0)
|| (cx1 == 0
&& mpfr_signbit (mpc_imagref (x)) != mpfr_signbit (mpc_realref (y)))
|| (cx1 > 0 && mpfr_signbit (mpc_imagref (y)));
/* warning: mpc_set_ui_ui does not set Im(z) to -0 if Im(rnd)=RNDD */
ret = mpc_set_ui_ui (z, 1, 0, rnd);
if (MPC_RND_IM (rnd) == MPFR_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
mpfr_clear (n);
return ret;
}
}
if (!mpc_fin_p (x) || !mpc_fin_p (y))
{
/* special values: exp(y*log(x)) */
mpc_init2 (u, 2);
mpc_log (u, x, MPC_RNDNN);
mpc_mul (u, u, y, MPC_RNDNN);
ret = mpc_exp (z, u, rnd);
mpc_clear (u);
goto end;
}
if (x_real) /* case x real */
{
if (mpfr_zero_p (mpc_realref(x))) /* x is zero */
{
/* special values: exp(y*log(x)) */
mpc_init2 (u, 2);
mpc_log (u, x, MPC_RNDNN);
mpc_mul (u, u, y, MPC_RNDNN);
ret = mpc_exp (z, u, rnd);
mpc_clear (u);
goto end;
}
/* Special case 1^y = 1 */
if (mpfr_cmp_ui (mpc_realref(x), 1) == 0)
{
int s1, s2;
s1 = mpfr_signbit (mpc_realref (y));
s2 = mpfr_signbit (mpc_imagref (x));
ret = mpc_set_ui (z, +1, rnd);
/* the sign of the zero imaginary part is known in some cases (see
algorithm.tex). In such cases we have
(x +s*0i)^(y+/-0i) = x^y + s*sign(y)*0i
where s = +/-1. We extend here this rule to fix the sign of the
zero part.
Note that the sign must also be set explicitly when rnd=RNDD
because mpfr_set_ui(z_i, 0, rnd) always sets z_i to +0.
*/
if (MPC_RND_IM (rnd) == MPFR_RNDD || s1 != s2)
mpc_conj (z, z, MPC_RNDNN);
goto end;
}
/* x^y is real when:
(a) x is real and y is integer
(b) x is real non-negative and y is real */
if (y_real && (mpfr_integer_p (mpc_realref(y)) ||
mpfr_cmp_ui (mpc_realref(x), 0) >= 0))
{
int s1, s2;
s1 = mpfr_signbit (mpc_realref (y));
s2 = mpfr_signbit (mpc_imagref (x));
ret = mpfr_pow (mpc_realref(z), mpc_realref(x), mpc_realref(y), MPC_RND_RE(rnd));
ret = MPC_INEX(ret, mpfr_set_ui (mpc_imagref(z), 0, MPC_RND_IM(rnd)));
/* the sign of the zero imaginary part is known in some cases
(see algorithm.tex). In such cases we have (x +s*0i)^(y+/-0i)
= x^y + s*sign(y)*0i where s = +/-1.
We extend here this rule to fix the sign of the zero part.
Note that the sign must also be set explicitly when rnd=RNDD
because mpfr_set_ui(z_i, 0, rnd) always sets z_i to +0.
*/
if (MPC_RND_IM(rnd) == MPFR_RNDD || s1 != s2)
mpfr_neg (mpc_imagref(z), mpc_imagref(z), MPC_RND_IM(rnd));
goto end;
}
/* (-1)^(n+I*t) is real for n integer and t real */
if (mpfr_cmp_si (mpc_realref(x), -1) == 0 && mpfr_integer_p (mpc_realref(y)))
z_real = 1;
/* for x real, x^y is imaginary when:
(a) x is negative and y is half-an-integer
(b) x = -1 and Re(y) is half-an-integer
*/
if ((mpfr_cmp_ui (mpc_realref(x), 0) < 0) && is_odd (mpc_realref(y), 1)
&& (y_real || mpfr_cmp_si (mpc_realref(x), -1) == 0))
z_imag = 1;
}
else /* x non real */
/* I^(t*I) and (-I)^(t*I) are real for t real,
I^(n+t*I) and (-I)^(n+t*I) are real for n even and t real, and
I^(n+t*I) and (-I)^(n+t*I) are imaginary for n odd and t real
(s*I)^n is real for n even and imaginary for n odd */
if ((mpc_cmp_si_si (x, 0, 1) == 0 || mpc_cmp_si_si (x, 0, -1) == 0 ||
(mpfr_cmp_ui (mpc_realref(x), 0) == 0 && y_real)) &&
mpfr_integer_p (mpc_realref(y)))
{ /* x is I or -I, and Re(y) is an integer */
if (is_odd (mpc_realref(y), 0))
z_imag = 1; /* Re(y) odd: z is imaginary */
else
z_real = 1; /* Re(y) even: z is real */
}
else /* (t+/-t*I)^(2n) is imaginary for n odd and real for n even */
if (mpfr_cmpabs (mpc_realref(x), mpc_imagref(x)) == 0 && y_real &&
mpfr_integer_p (mpc_realref(y)) && is_odd (mpc_realref(y), 0) == 0)
{
if (is_odd (mpc_realref(y), -1)) /* y/2 is odd */
z_imag = 1;
else
z_real = 1;
}
pr = mpfr_get_prec (mpc_realref(z));
pi = mpfr_get_prec (mpc_imagref(z));
p = (pr > pi) ? pr : pi;
p += 12; /* experimentally, seems to give less than 10% of failures in
Ziv's strategy; probably wrong now since q is not computed */
if (p < 64)
p = 64;
mpc_init2 (u, p);
mpc_init2 (t, p);
pr += MPC_RND_RE(rnd) == MPFR_RNDN;
pi += MPC_RND_IM(rnd) == MPFR_RNDN;
maxprec = MPC_MAX_PREC (z);
x_imag = mpfr_zero_p (mpc_realref(x));
for (loop = 0;; loop++)
{
int ret_exp;
mpfr_exp_t dr, di;
mpfr_prec_t q;
mpc_log (t, x, MPC_RNDNN);
mpc_mul (t, t, y, MPC_RNDNN);
/* Compute q such that |Re (y log x)|, |Im (y log x)| < 2^q.
We recompute it at each loop since we might get different
bounds if the precision is not enough. */
q = mpfr_get_exp (mpc_realref(t)) > 0 ? mpfr_get_exp (mpc_realref(t)) : 0;
if (mpfr_get_exp (mpc_imagref(t)) > (mpfr_exp_t) q)
q = mpfr_get_exp (mpc_imagref(t));
mpfr_clear_overflow ();
mpfr_clear_underflow ();
ret_exp = mpc_exp (u, t, MPC_RNDNN);
if (mpfr_underflow_p () || mpfr_overflow_p ()) {
/* under- and overflow flags are set by mpc_exp */
mpc_set (z, u, MPC_RNDNN);
ret = ret_exp;
goto exact;
}
/* Since the error bound is global, we have to take into account the
exponent difference between the real and imaginary parts. We assume
either the real or the imaginary part of u is not zero.
*/
dr = mpfr_zero_p (mpc_realref(u)) ? mpfr_get_exp (mpc_imagref(u))
: mpfr_get_exp (mpc_realref(u));
di = mpfr_zero_p (mpc_imagref(u)) ? dr : mpfr_get_exp (mpc_imagref(u));
if (dr > di)
{
di = dr - di;
dr = 0;
}
else
{
dr = di - dr;
di = 0;
}
/* the term -3 takes into account the factor 4 in the complex error
(see algorithms.tex) plus one due to the exponent difference: if
z = a + I*b, where the relative error on z is at most 2^(-p), and
EXP(a) = EXP(b) + k, the relative error on b is at most 2^(k-p) */
if ((z_imag || (p > q + 3 + dr && mpfr_can_round (mpc_realref(u), p - q - 3 - dr, MPFR_RNDN, MPFR_RNDZ, pr))) &&
(z_real || (p > q + 3 + di && mpfr_can_round (mpc_imagref(u), p - q - 3 - di, MPFR_RNDN, MPFR_RNDZ, pi))))
break;
/* if Re(u) is not known to be zero, assume it is a normal number, i.e.,
neither zero, Inf or NaN, otherwise we might enter an infinite loop */
MPC_ASSERT (z_imag || mpfr_number_p (mpc_realref(u)));
/* idem for Im(u) */
MPC_ASSERT (z_real || mpfr_number_p (mpc_imagref(u)));
if (ret == -2) /* we did not yet call mpc_pow_exact, or it aborted
because intermediate computations had > maxprec bits */
{
/* check exact cases (see algorithms.tex) */
if (y_real)
{
maxprec *= 2;
ret = mpc_pow_exact (z, x, mpc_realref(y), rnd, maxprec);
if (ret != -1 && ret != -2)
goto exact;
}
p += dr + di + 64;
}
else
p += p / 2;
mpc_set_prec (t, p);
mpc_set_prec (u, p);
}
if (z_real)
{
/* When the result is real (see algorithm.tex for details),
Im(x^y) =
+ sign(imag(y))*0i, if |x| > 1
+ sign(imag(x))*sign(real(y))*0i, if |x| = 1
- sign(imag(y))*0i, if |x| < 1
*/
mpfr_t n;
int inex, cx1;
int sign_zi, sign_rex, sign_imx;
/* cx1 < 0 if |x| < 1
cx1 = 0 if |x| = 1
cx1 > 0 if |x| > 1
*/
sign_rex = mpfr_signbit (mpc_realref (x));
sign_imx = mpfr_signbit (mpc_imagref (x));
mpfr_init (n);
inex = mpc_norm (n, x, MPFR_RNDN);
cx1 = mpfr_cmp_ui (n, 1);
if (cx1 == 0 && inex != 0)
cx1 = -inex;
sign_zi = (cx1 < 0 && mpfr_signbit (mpc_imagref (y)) == 0)
|| (cx1 == 0 && sign_imx != mpfr_signbit (mpc_realref (y)))
|| (cx1 > 0 && mpfr_signbit (mpc_imagref (y)));
/* copy RE(y) to n since if z==y we will destroy Re(y) below */
mpfr_set_prec (n, mpfr_get_prec (mpc_realref (y)));
mpfr_set (n, mpc_realref (y), MPFR_RNDN);
ret = mpfr_set (mpc_realref(z), mpc_realref(u), MPC_RND_RE(rnd));
if (y_real && (x_real || x_imag))
{
/* FIXME: with y_real we assume Im(y) is really 0, which is the case
for example when y comes from pow_fr, but in case Im(y) is +0 or
-0, we might get different results */
mpfr_set_ui (mpc_imagref (z), 0, MPC_RND_IM (rnd));
fix_sign (z, sign_rex, sign_imx, n);
ret = MPC_INEX(ret, 0); /* imaginary part is exact */
}
else
{
ret = MPC_INEX (ret, mpfr_set_ui (mpc_imagref (z), 0, MPC_RND_IM (rnd)));
/* warning: mpfr_set_ui does not set Im(z) to -0 if Im(rnd) = RNDD */
if (MPC_RND_IM (rnd) == MPFR_RNDD || sign_zi)
mpc_conj (z, z, MPC_RNDNN);
}
mpfr_clear (n);
}
else if (z_imag)
{
ret = mpfr_set (mpc_imagref(z), mpc_imagref(u), MPC_RND_IM(rnd));
/* if z is imaginary and y real, then x cannot be real */
if (y_real && x_imag)
{
int sign_rex = mpfr_signbit (mpc_realref (x));
/* If z overlaps with y we set Re(z) before checking Re(y) below,
but in that case y=0, which was dealt with above. */
mpfr_set_ui (mpc_realref (z), 0, MPC_RND_RE (rnd));
/* Note: fix_sign only does something when y is an integer,
then necessarily y = 1 or 3 (mod 4), and in that case the
sign of Im(x) is irrelevant. */
fix_sign (z, sign_rex, 0, mpc_realref (y));
ret = MPC_INEX(0, ret);
}
else
ret = MPC_INEX(mpfr_set_ui (mpc_realref(z), 0, MPC_RND_RE(rnd)), ret);
}
else
ret = mpc_set (z, u, rnd);
exact:
mpc_clear (t);
mpc_clear (u);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
end:
return ret;
}
int
mpc_sqr (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int ok;
mpfr_t u, v;
mpfr_t x;
/* temporary variable to hold the real part of op,
needed in the case rop==op */
mpfr_prec_t prec;
int inex_re, inex_im, inexact;
mpfr_exp_t emin;
int saved_underflow;
/* special values: NaN and infinities */
if (!mpc_fin_p (op)) {
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op))) {
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
else if (mpfr_inf_p (mpc_realref (op))) {
if (mpfr_inf_p (mpc_imagref (op))) {
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_nan (mpc_realref (rop));
}
else {
if (mpfr_zero_p (mpc_imagref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), +1);
}
}
else /* IM(op) is infinity, RE(op) is not */ {
if (mpfr_zero_p (mpc_realref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), -1);
}
return MPC_INEX (0, 0); /* exact */
}
prec = MPC_MAX_PREC(rop);
/* Check for real resp. purely imaginary number */
if (mpfr_zero_p (mpc_imagref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = mpfr_sqr (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd));
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_zero_p (mpc_realref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = -mpfr_sqr (mpc_realref(rop), mpc_imagref(op), INV_RND (MPC_RND_RE(rnd)));
mpfr_neg (mpc_realref(rop), mpc_realref(rop), MPFR_RNDN);
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (rop == op)
{
mpfr_init2 (x, MPC_PREC_RE (op));
mpfr_set (x, op->re, MPFR_RNDN);
}
else
x [0] = op->re [0];
/* From here on, use x instead of op->re and safely overwrite rop->re. */
/* Compute real part of result. */
if (SAFE_ABS (mpfr_exp_t,
mpfr_get_exp (mpc_realref (op)) - mpfr_get_exp (mpc_imagref (op)))
> (mpfr_exp_t) MPC_MAX_PREC (op) / 2) {
/* If the real and imaginary parts of the argument have very different
exponents, it is not reasonable to use Karatsuba squaring; compute
exactly with the standard formulae instead, even if this means an
additional multiplication. Using the approach copied from mul, over-
and underflows are also handled correctly. */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
}
else {
/* Karatsuba squaring: we compute the real part as (x+y)*(x-y) and the
imaginary part as 2*x*y, with a total of 2M instead of 2S+1M for the
naive algorithm, which computes x^2-y^2 and 2*y*y */
mpfr_init (u);
mpfr_init (v);
emin = mpfr_get_emin ();
do
{
prec += mpc_ceil_log2 (prec) + 5;
mpfr_set_prec (u, prec);
mpfr_set_prec (v, prec);
/* Let op = x + iy. We need u = x+y and v = x-y, rounded away. */
/* The error is bounded above by 1 ulp. */
/* We first let inexact be 1 if the real part is not computed */
/* exactly and determine the sign later. */
inexact = mpfr_add (u, x, mpc_imagref (op), MPFR_RNDA)
| mpfr_sub (v, x, mpc_imagref (op), MPFR_RNDA);
/* compute the real part as u*v, rounded away */
/* determine also the sign of inex_re */
if (mpfr_sgn (u) == 0 || mpfr_sgn (v) == 0) {
/* as we have rounded away, the result is exact */
mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN);
inex_re = 0;
ok = 1;
}
else {
inexact |= mpfr_mul (u, u, v, MPFR_RNDA); /* error 5 */
if (mpfr_get_exp (u) == emin || mpfr_inf_p (u)) {
/* under- or overflow */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
ok = 1;
}
else {
ok = (!inexact) | mpfr_can_round (u, prec - 3,
MPFR_RNDA, MPFR_RNDZ,
MPC_PREC_RE (rop) + (MPC_RND_RE (rnd) == MPFR_RNDN));
if (ok) {
inex_re = mpfr_set (mpc_realref (rop), u, MPC_RND_RE (rnd));
if (inex_re == 0)
/* remember that u was already rounded */
inex_re = inexact;
}
}
}
}
while (!ok);
mpfr_clear (u);
mpfr_clear (v);
}
saved_underflow = mpfr_underflow_p ();
mpfr_clear_underflow ();
inex_im = mpfr_mul (rop->im, x, op->im, MPC_RND_IM (rnd));
if (!mpfr_underflow_p ())
inex_im |= mpfr_mul_2ui (rop->im, rop->im, 1, MPC_RND_IM (rnd));
/* We must not multiply by 2 if rop->im has been set to the smallest
representable number. */
if (saved_underflow)
mpfr_set_underflow ();
if (rop == op)
mpfr_clear (x);
return MPC_INEX (inex_re, inex_im);
}
int
mpc_div (mpc_ptr a, mpc_srcptr b, mpc_srcptr c, mpc_rnd_t rnd)
{
int ok_re = 0, ok_im = 0;
mpc_t res, c_conj;
mpfr_t q;
mpfr_prec_t prec;
int inex, inexact_prod, inexact_norm, inexact_re, inexact_im, loops = 0;
int underflow_norm, overflow_norm, underflow_prod, overflow_prod;
int underflow_re = 0, overflow_re = 0, underflow_im = 0, overflow_im = 0;
mpfr_rnd_t rnd_re = MPC_RND_RE (rnd), rnd_im = MPC_RND_IM (rnd);
int saved_underflow, saved_overflow;
int tmpsgn;
mpfr_exp_t e, emin, emax, emid; /* for scaling of exponents */
mpc_t b_scaled, c_scaled;
mpfr_t b_re, b_im, c_re, c_im;
/* According to the C standard G.3, there are three types of numbers: */
/* finite (both parts are usual real numbers; contains 0), infinite */
/* (at least one part is a real infinity) and all others; the latter */
/* are numbers containing a nan, but no infinity, and could reasonably */
/* be called nan. */
/* By G.5.1.4, infinite/finite=infinite; finite/infinite=0; */
/* all other divisions that are not finite/finite return nan+i*nan. */
/* Division by 0 could be handled by the following case of division by */
/* a real; we handle it separately instead. */
if (mpc_zero_p (c)) /* both Re(c) and Im(c) are zero */
return mpc_div_zero (a, b, c, rnd);
else if (mpc_inf_p (b) && mpc_fin_p (c)) /* either Re(b) or Im(b) is infinite
and both Re(c) and Im(c) are ordinary */
return mpc_div_inf_fin (a, b, c);
else if (mpc_fin_p (b) && mpc_inf_p (c))
return mpc_div_fin_inf (a, b, c);
else if (!mpc_fin_p (b) || !mpc_fin_p (c)) {
mpc_set_nan (a);
return MPC_INEX (0, 0);
}
else if (mpfr_zero_p(mpc_imagref(c)))
return mpc_div_real (a, b, c, rnd);
else if (mpfr_zero_p(mpc_realref(c)))
return mpc_div_imag (a, b, c, rnd);
prec = MPC_MAX_PREC(a);
mpc_init2 (res, 2);
mpfr_init (q);
/* compute scaling of exponents: none of Re(c) and Im(c) can be zero,
but one of Re(b) or Im(b) could be zero */
e = mpfr_get_exp (mpc_realref (c));
emin = emax = e;
e = mpfr_get_exp (mpc_imagref (c));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
if (!mpfr_zero_p (mpc_realref (b)))
{
e = mpfr_get_exp (mpc_realref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
if (!mpfr_zero_p (mpc_imagref (b)))
{
e = mpfr_get_exp (mpc_imagref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
/* all input exponents are in [emin, emax] */
emid = emin / 2 + emax / 2;
/* scale the inputs */
b_re[0] = mpc_realref (b)[0];
if (!mpfr_zero_p (mpc_realref (b)))
MPFR_EXP(b_re) = MPFR_EXP(mpc_realref (b)) - emid;
b_im[0] = mpc_imagref (b)[0];
if (!mpfr_zero_p (mpc_imagref (b)))
MPFR_EXP(b_im) = MPFR_EXP(mpc_imagref (b)) - emid;
c_re[0] = mpc_realref (c)[0];
MPFR_EXP(c_re) = MPFR_EXP(mpc_realref (c)) - emid;
c_im[0] = mpc_imagref (c)[0];
MPFR_EXP(c_im) = MPFR_EXP(mpc_imagref (c)) - emid;
/* create the scaled inputs without allocating new memory */
mpc_realref (b_scaled)[0] = b_re[0];
mpc_imagref (b_scaled)[0] = b_im[0];
mpc_realref (c_scaled)[0] = c_re[0];
mpc_imagref (c_scaled)[0] = c_im[0];
/* create the conjugate of c in c_conj without allocating new memory */
mpc_realref (c_conj)[0] = mpc_realref (c_scaled)[0];
mpc_imagref (c_conj)[0] = mpc_imagref (c_scaled)[0];
MPFR_CHANGE_SIGN (mpc_imagref (c_conj));
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
do {
loops ++;
prec += loops <= 2 ? mpc_ceil_log2 (prec) + 5 : prec / 2;
mpc_set_prec (res, prec);
mpfr_set_prec (q, prec);
/* first compute norm(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_norm = mpc_norm (q, c_scaled, MPFR_RNDU);
underflow_norm = mpfr_underflow_p ();
overflow_norm = mpfr_overflow_p ();
if (underflow_norm)
mpfr_set_ui (q, 0ul, MPFR_RNDN);
/* to obtain divisions by 0 later on */
/* now compute b_scaled*conjugate(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_prod = mpc_mul (res, b_scaled, c_conj, MPC_RNDZZ);
inexact_re = MPC_INEX_RE (inexact_prod);
inexact_im = MPC_INEX_IM (inexact_prod);
underflow_prod = mpfr_underflow_p ();
overflow_prod = mpfr_overflow_p ();
/* unfortunately, does not distinguish between under-/overflow
in real or imaginary parts
hopefully, the side-effects of mpc_mul do indeed raise the
mpfr exceptions */
if (overflow_prod) {
/* FIXME: in case overflow_norm is also true, the code below is wrong,
since the after division by the norm, we might end up with finite
real and/or imaginary parts. A workaround would be to scale the
inputs (in case the exponents are within the same range). */
int isinf = 0;
/* determine if the real part of res is the maximum or the minimum
representable number */
tmpsgn = mpfr_sgn (mpc_realref(res));
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextbelow (mpc_realref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextabove (mpc_realref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_realref(res), tmpsgn);
overflow_re = 1;
}
/* same for the imaginary part */
tmpsgn = mpfr_sgn (mpc_imagref(res));
isinf = 0;
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextbelow (mpc_imagref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextabove (mpc_imagref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_imagref(res), tmpsgn);
overflow_im = 1;
}
mpc_set (a, res, rnd);
goto end;
}
/* divide the product by the norm */
if (inexact_norm == 0 && (inexact_re == 0 || inexact_im == 0)) {
/* The division has good chances to be exact in at least one part. */
/* Since this can cause problems when not rounding to the nearest, */
/* we use the division code of mpfr, which handles the situation. */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_div (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_div (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
else {
/* The division is inexact, so for efficiency reasons we invert q */
/* only once and multiply by the inverse. */
if (mpfr_ui_div (q, 1ul, q, MPFR_RNDZ) || inexact_norm) {
/* if 1/q is inexact, the approximations of the real and
imaginary part below will be inexact, unless RE(res)
or IM(res) is zero */
inexact_re |= !mpfr_zero_p (mpc_realref (res));
inexact_im |= !mpfr_zero_p (mpc_imagref (res));
}
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_mul (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_mul (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
} while ((!ok_re || !ok_im) && !underflow_norm && !overflow_norm
&& !underflow_prod && !overflow_prod);
inex = mpc_set (a, res, rnd);
inexact_re = MPC_INEX_RE (inex);
inexact_im = MPC_INEX_IM (inex);
end:
/* fix values and inexact flags in case of overflow/underflow */
/* FIXME: heuristic, certainly does not cover all cases */
if (overflow_re || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_realref (a), mpfr_sgn (mpc_realref (res)));
inexact_re = mpfr_sgn (mpc_realref (res));
}
else if (underflow_re || (overflow_norm && !overflow_prod)) {
inexact_re = mpfr_signbit (mpc_realref (res)) ? 1 : -1;
mpfr_set_zero (mpc_realref (a), -inexact_re);
}
if (overflow_im || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_imagref (a), mpfr_sgn (mpc_imagref (res)));
inexact_im = mpfr_sgn (mpc_imagref (res));
}
else if (underflow_im || (overflow_norm && !overflow_prod)) {
inexact_im = mpfr_signbit (mpc_imagref (res)) ? 1 : -1;
mpfr_set_zero (mpc_imagref (a), -inexact_im);
}
mpc_clear (res);
mpfr_clear (q);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
return MPC_INEX (inexact_re, inexact_im);
}
int
mpc_log (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd){
int ok, underflow = 0;
mpfr_srcptr x, y;
mpfr_t v, w;
mpfr_prec_t prec;
int loops;
int re_cmp, im_cmp;
int inex_re, inex_im;
int err;
mpfr_exp_t expw;
int sgnw;
/* special values: NaN and infinities */
if (!mpc_fin_p (op)) {
if (mpfr_nan_p (mpc_realref (op))) {
if (mpfr_inf_p (mpc_imagref (op)))
mpfr_set_inf (mpc_realref (rop), +1);
else
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex_im = 0; /* Inf/NaN is exact */
}
else if (mpfr_nan_p (mpc_imagref (op))) {
if (mpfr_inf_p (mpc_realref (op)))
mpfr_set_inf (mpc_realref (rop), +1);
else
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex_im = 0; /* Inf/NaN is exact */
}
else /* We have an infinity in at least one part. */ {
inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
MPC_RND_IM (rnd));
mpfr_set_inf (mpc_realref (rop), +1);
}
return MPC_INEX(0, inex_im);
}
/* special cases: real and purely imaginary numbers */
re_cmp = mpfr_cmp_ui (mpc_realref (op), 0);
im_cmp = mpfr_cmp_ui (mpc_imagref (op), 0);
if (im_cmp == 0) {
if (re_cmp == 0) {
inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
MPC_RND_IM (rnd));
mpfr_set_inf (mpc_realref (rop), -1);
inex_re = 0; /* -Inf is exact */
}
else if (re_cmp > 0) {
inex_re = mpfr_log (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
inex_im = mpfr_set (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
}
else {
/* op = x + 0*y; let w = -x = |x| */
int negative_zero;
mpfr_rnd_t rnd_im;
negative_zero = mpfr_signbit (mpc_imagref (op));
if (negative_zero)
rnd_im = INV_RND (MPC_RND_IM (rnd));
else
rnd_im = MPC_RND_IM (rnd);
w [0] = *mpc_realref (op);
MPFR_CHANGE_SIGN (w);
inex_re = mpfr_log (mpc_realref (rop), w, MPC_RND_RE (rnd));
inex_im = mpfr_const_pi (mpc_imagref (rop), rnd_im);
if (negative_zero) {
mpc_conj (rop, rop, MPC_RNDNN);
inex_im = -inex_im;
}
}
return MPC_INEX(inex_re, inex_im);
}
else if (re_cmp == 0) {
if (im_cmp > 0) {
inex_re = mpfr_log (mpc_realref (rop), mpc_imagref (op), MPC_RND_RE (rnd));
inex_im = mpfr_const_pi (mpc_imagref (rop), MPC_RND_IM (rnd));
/* division by 2 does not change the ternary flag */
mpfr_div_2ui (mpc_imagref (rop), mpc_imagref (rop), 1, GMP_RNDN);
}
else {
w [0] = *mpc_imagref (op);
MPFR_CHANGE_SIGN (w);
inex_re = mpfr_log (mpc_realref (rop), w, MPC_RND_RE (rnd));
inex_im = mpfr_const_pi (mpc_imagref (rop), INV_RND (MPC_RND_IM (rnd)));
/* division by 2 does not change the ternary flag */
mpfr_div_2ui (mpc_imagref (rop), mpc_imagref (rop), 1, GMP_RNDN);
mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), GMP_RNDN);
inex_im = -inex_im; /* negate the ternary flag */
}
return MPC_INEX(inex_re, inex_im);
}
prec = MPC_PREC_RE(rop);
mpfr_init2 (w, 2);
/* let op = x + iy; log = 1/2 log (x^2 + y^2) + i atan2 (y, x) */
/* loop for the real part: 1/2 log (x^2 + y^2), fast, but unsafe */
/* implementation */
ok = 0;
for (loops = 1; !ok && loops <= 2; loops++) {
prec += mpc_ceil_log2 (prec) + 4;
mpfr_set_prec (w, prec);
mpc_abs (w, op, GMP_RNDN);
/* error 0.5 ulp */
if (mpfr_inf_p (w))
/* intermediate overflow; the logarithm may be representable.
Intermediate underflow is impossible. */
break;
mpfr_log (w, w, GMP_RNDN);
/* generic error of log: (2^(- exp(w)) + 0.5) ulp */
if (mpfr_zero_p (w))
/* impossible to round, switch to second algorithm */
break;
err = MPC_MAX (-mpfr_get_exp (w), 0) + 1;
/* number of lost digits */
ok = mpfr_can_round (w, prec - err, GMP_RNDN, GMP_RNDZ,
mpfr_get_prec (mpc_realref (rop)) + (MPC_RND_RE (rnd) == GMP_RNDN));
}
if (!ok) {
prec = MPC_PREC_RE(rop);
mpfr_init2 (v, 2);
/* compute 1/2 log (x^2 + y^2) = log |x| + 1/2 * log (1 + (y/x)^2)
if |x| >= |y|; otherwise, exchange x and y */
if (mpfr_cmpabs (mpc_realref (op), mpc_imagref (op)) >= 0) {
x = mpc_realref (op);
y = mpc_imagref (op);
}
else {
x = mpc_imagref (op);
y = mpc_realref (op);
}
do {
prec += mpc_ceil_log2 (prec) + 4;
mpfr_set_prec (v, prec);
mpfr_set_prec (w, prec);
mpfr_div (v, y, x, GMP_RNDD); /* error 1 ulp */
mpfr_sqr (v, v, GMP_RNDD);
/* generic error of multiplication:
1 + 2*1*(2+1*2^(1-prec)) <= 5.0625 since prec >= 6 */
mpfr_log1p (v, v, GMP_RNDD);
/* error 1 + 4*5.0625 = 21.25 , see algorithms.tex */
mpfr_div_2ui (v, v, 1, GMP_RNDD);
/* If the result is 0, then there has been an underflow somewhere. */
mpfr_abs (w, x, GMP_RNDN); /* exact */
mpfr_log (w, w, GMP_RNDN); /* error 0.5 ulp */
expw = mpfr_get_exp (w);
sgnw = mpfr_signbit (w);
mpfr_add (w, w, v, GMP_RNDN);
if (!sgnw) /* v is positive, so no cancellation;
error 22.25 ulp; error counts lost bits */
err = 5;
else
err = MPC_MAX (5 + mpfr_get_exp (v),
/* 21.25 ulp (v) rewritten in ulp (result, now in w) */
-1 + expw - mpfr_get_exp (w)
/* 0.5 ulp (previous w), rewritten in ulp (result) */
) + 2;
/* handle one special case: |x|=1, and (y/x)^2 underflows;
then 1/2*log(x^2+y^2) \approx 1/2*y^2 also underflows. */
if ( (mpfr_cmp_si (x, -1) == 0 || mpfr_cmp_ui (x, 1) == 0)
&& mpfr_zero_p (w))
underflow = 1;
} while (!underflow &&
!mpfr_can_round (w, prec - err, GMP_RNDN, GMP_RNDZ,
mpfr_get_prec (mpc_realref (rop)) + (MPC_RND_RE (rnd) == GMP_RNDN)));
mpfr_clear (v);
}
/* imaginary part */
inex_im = mpfr_atan2 (mpc_imagref (rop), mpc_imagref (op), mpc_realref (op),
MPC_RND_IM (rnd));
/* set the real part; cannot be done before if rop==op */
if (underflow)
/* create underflow in result */
inex_re = mpfr_set_ui_2exp (mpc_realref (rop), 1,
mpfr_get_emin_min () - 2, MPC_RND_RE (rnd));
else
inex_re = mpfr_set (mpc_realref (rop), w, MPC_RND_RE (rnd));
mpfr_clear (w);
return MPC_INEX(inex_re, inex_im);
}
int
mpc_tan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
mpc_t x, y;
mpfr_prec_t prec;
mpfr_exp_t err;
int ok = 0;
int inex;
/* special values */
if (!mpc_fin_p (op))
{
if (mpfr_nan_p (mpc_realref (op)))
{
if (mpfr_inf_p (mpc_imagref (op)))
/* tan(NaN -i*Inf) = +/-0 -i */
/* tan(NaN +i*Inf) = +/-0 +i */
{
/* exact unless 1 is not in exponent range */
inex = mpc_set_si_si (rop, 0,
(MPFR_SIGN (mpc_imagref (op)) < 0) ? -1 : +1,
rnd);
}
else
/* tan(NaN +i*y) = NaN +i*NaN, when y is finite */
/* tan(NaN +i*NaN) = NaN +i*NaN */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex = MPC_INEX (0, 0); /* always exact */
}
}
else if (mpfr_nan_p (mpc_imagref (op)))
{
if (mpfr_cmp_ui (mpc_realref (op), 0) == 0)
/* tan(-0 +i*NaN) = -0 +i*NaN */
/* tan(+0 +i*NaN) = +0 +i*NaN */
{
mpc_set (rop, op, rnd);
inex = MPC_INEX (0, 0); /* always exact */
}
else
/* tan(x +i*NaN) = NaN +i*NaN, when x != 0 */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex = MPC_INEX (0, 0); /* always exact */
}
}
else if (mpfr_inf_p (mpc_realref (op)))
{
if (mpfr_inf_p (mpc_imagref (op)))
/* tan(-Inf -i*Inf) = -/+0 -i */
/* tan(-Inf +i*Inf) = -/+0 +i */
/* tan(+Inf -i*Inf) = +/-0 -i */
/* tan(+Inf +i*Inf) = +/-0 +i */
{
const int sign_re = mpfr_signbit (mpc_realref (op));
int inex_im;
mpfr_set_ui (mpc_realref (rop), 0, MPC_RND_RE (rnd));
mpfr_setsign (mpc_realref (rop), mpc_realref (rop), sign_re, MPFR_RNDN);
/* exact, unless 1 is not in exponent range */
inex_im = mpfr_set_si (mpc_imagref (rop),
mpfr_signbit (mpc_imagref (op)) ? -1 : +1,
MPC_RND_IM (rnd));
inex = MPC_INEX (0, inex_im);
}
else
/* tan(-Inf +i*y) = tan(+Inf +i*y) = NaN +i*NaN, when y is
finite */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
inex = MPC_INEX (0, 0); /* always exact */
}
}
else
/* tan(x -i*Inf) = +0*sin(x)*cos(x) -i, when x is finite */
/* tan(x +i*Inf) = +0*sin(x)*cos(x) +i, when x is finite */
{
mpfr_t c;
mpfr_t s;
int inex_im;
mpfr_init (c);
mpfr_init (s);
mpfr_sin_cos (s, c, mpc_realref (op), MPFR_RNDN);
mpfr_set_ui (mpc_realref (rop), 0, MPC_RND_RE (rnd));
mpfr_setsign (mpc_realref (rop), mpc_realref (rop),
mpfr_signbit (c) != mpfr_signbit (s), MPFR_RNDN);
/* exact, unless 1 is not in exponent range */
inex_im = mpfr_set_si (mpc_imagref (rop),
(mpfr_signbit (mpc_imagref (op)) ? -1 : +1),
MPC_RND_IM (rnd));
inex = MPC_INEX (0, inex_im);
mpfr_clear (s);
mpfr_clear (c);
}
return inex;
}
if (mpfr_zero_p (mpc_realref (op)))
/* tan(-0 -i*y) = -0 +i*tanh(y), when y is finite. */
/* tan(+0 +i*y) = +0 +i*tanh(y), when y is finite. */
{
int inex_im;
mpfr_set (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
inex_im = mpfr_tanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
return MPC_INEX (0, inex_im);
}
if (mpfr_zero_p (mpc_imagref (op)))
/* tan(x -i*0) = tan(x) -i*0, when x is finite. */
/* tan(x +i*0) = tan(x) +i*0, when x is finite. */
{
int inex_re;
inex_re = mpfr_tan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
mpfr_set (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
return MPC_INEX (inex_re, 0);
}
/* ordinary (non-zero) numbers */
/* tan(op) = sin(op) / cos(op).
We use the following algorithm with rounding away from 0 for all
operations, and working precision w:
(1) x = A(sin(op))
(2) y = A(cos(op))
(3) z = A(x/y)
the error on Im(z) is at most 81 ulp,
the error on Re(z) is at most
7 ulp if k < 2,
8 ulp if k = 2,
else 5+k ulp, where
k = Exp(Re(x))+Exp(Re(y))-2min{Exp(Re(y)), Exp(Im(y))}-Exp(Re(x/y))
see proof in algorithms.tex.
*/
prec = MPC_MAX_PREC(rop);
mpc_init2 (x, 2);
mpc_init2 (y, 2);
err = 7;
do
{
mpfr_exp_t k, exr, eyr, eyi, ezr;
ok = 0;
/* FIXME: prevent addition overflow */
prec += mpc_ceil_log2 (prec) + err;
mpc_set_prec (x, prec);
mpc_set_prec (y, prec);
/* rounding away from zero: except in the cases x=0 or y=0 (processed
above), sin x and cos y are never exact, so rounding away from 0 is
rounding towards 0 and adding one ulp to the absolute value */
mpc_sin_cos (x, y, op, MPC_RNDZZ, MPC_RNDZZ);
MPFR_ADD_ONE_ULP (mpc_realref (x));
MPFR_ADD_ONE_ULP (mpc_imagref (x));
MPFR_ADD_ONE_ULP (mpc_realref (y));
MPFR_ADD_ONE_ULP (mpc_imagref (y));
MPC_ASSERT (mpfr_zero_p (mpc_realref (x)) == 0);
if ( mpfr_inf_p (mpc_realref (x)) || mpfr_inf_p (mpc_imagref (x))
|| mpfr_inf_p (mpc_realref (y)) || mpfr_inf_p (mpc_imagref (y))) {
/* If the real or imaginary part of x is infinite, it means that
Im(op) was large, in which case the result is
sign(tan(Re(op)))*0 + sign(Im(op))*I,
where sign(tan(Re(op))) = sign(Re(x))*sign(Re(y)). */
int inex_re, inex_im;
mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN);
if (mpfr_sgn (mpc_realref (x)) * mpfr_sgn (mpc_realref (y)) < 0)
{
mpfr_neg (mpc_realref (rop), mpc_realref (rop), MPFR_RNDN);
inex_re = 1;
}
else
inex_re = -1; /* +0 is rounded down */
if (mpfr_sgn (mpc_imagref (op)) > 0)
{
mpfr_set_ui (mpc_imagref (rop), 1, MPFR_RNDN);
inex_im = 1;
}
else
{
mpfr_set_si (mpc_imagref (rop), -1, MPFR_RNDN);
inex_im = -1;
}
inex = MPC_INEX(inex_re, inex_im);
goto end;
}
exr = mpfr_get_exp (mpc_realref (x));
eyr = mpfr_get_exp (mpc_realref (y));
eyi = mpfr_get_exp (mpc_imagref (y));
/* some parts of the quotient may be exact */
inex = mpc_div (x, x, y, MPC_RNDZZ);
/* OP is no pure real nor pure imaginary, so in theory the real and
imaginary parts of its tangent cannot be null. However due to
rouding errors this might happen. Consider for example
tan(1+14*I) = 1.26e-10 + 1.00*I. For small precision sin(op) and
cos(op) differ only by a factor I, thus after mpc_div x = I and
its real part is zero. */
if (mpfr_zero_p (mpc_realref (x)) || mpfr_zero_p (mpc_imagref (x)))
{
err = prec; /* double precision */
continue;
}
if (MPC_INEX_RE (inex))
MPFR_ADD_ONE_ULP (mpc_realref (x));
if (MPC_INEX_IM (inex))
MPFR_ADD_ONE_ULP (mpc_imagref (x));
MPC_ASSERT (mpfr_zero_p (mpc_realref (x)) == 0);
ezr = mpfr_get_exp (mpc_realref (x));
/* FIXME: compute
k = Exp(Re(x))+Exp(Re(y))-2min{Exp(Re(y)), Exp(Im(y))}-Exp(Re(x/y))
avoiding overflow */
k = exr - ezr + MPC_MAX(-eyr, eyr - 2 * eyi);
err = k < 2 ? 7 : (k == 2 ? 8 : (5 + k));
/* Can the real part be rounded? */
ok = (!mpfr_number_p (mpc_realref (x)))
|| mpfr_can_round (mpc_realref(x), prec - err, MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_RE(rop) + (MPC_RND_RE(rnd) == MPFR_RNDN));
if (ok)
{
/* Can the imaginary part be rounded? */
ok = (!mpfr_number_p (mpc_imagref (x)))
|| mpfr_can_round (mpc_imagref(x), prec - 6, MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_IM(rop) + (MPC_RND_IM(rnd) == MPFR_RNDN));
}
}
while (ok == 0);
inex = mpc_set (rop, x, rnd);
end:
mpc_clear (x);
mpc_clear (y);
return inex;
}
int
mpc_sin_cos (mpc_ptr rop_sin, mpc_ptr rop_cos, mpc_srcptr op,
mpc_rnd_t rnd_sin, mpc_rnd_t rnd_cos)
/* Feature not documented in the texinfo file: One of rop_sin or
rop_cos may be NULL, in which case it is not computed, and the
corresponding ternary inexact value is set to 0 (exact). */
{
if (!mpc_fin_p (op))
return mpc_sin_cos_nonfinite (rop_sin, rop_cos, op, rnd_sin, rnd_cos);
else if (mpfr_zero_p (MPC_IM (op)))
return mpc_sin_cos_real (rop_sin, rop_cos, op, rnd_sin, rnd_cos);
else if (mpfr_zero_p (MPC_RE (op)))
return mpc_sin_cos_imag (rop_sin, rop_cos, op, rnd_sin, rnd_cos);
else {
/* let op = a + i*b, then sin(op) = sin(a)*cosh(b) + i*cos(a)*sinh(b)
and cos(op) = cos(a)*cosh(b) - i*sin(a)*sinh(b).
For Re(sin(op)) (and analogously, the other parts), we use the
following algorithm, with rounding to nearest for all operations
and working precision w:
(1) x = o(sin(a))
(2) y = o(cosh(b))
(3) r = o(x*y)
then the error on r is at most 4 ulps, since we can write
r = sin(a)*cosh(b)*(1+t)^3 with |t| <= 2^(-w),
thus for w >= 2, r = sin(a)*cosh(b)*(1+4*t) with |t| <= 2^(-w),
thus the relative error is bounded by 4*2^(-w) <= 4*ulp(r).
*/
mpfr_t s, c, sh, ch, sch, csh;
mpfr_prec_t prec;
int ok;
int inex_re, inex_im, inex_sin, inex_cos;
prec = 2;
if (rop_sin != NULL)
prec = MPC_MAX (prec, MPC_MAX_PREC (rop_sin));
if (rop_cos != NULL)
prec = MPC_MAX (prec, MPC_MAX_PREC (rop_cos));
mpfr_init2 (s, 2);
mpfr_init2 (c, 2);
mpfr_init2 (sh, 2);
mpfr_init2 (ch, 2);
mpfr_init2 (sch, 2);
mpfr_init2 (csh, 2);
do {
ok = 1;
prec += mpc_ceil_log2 (prec) + 5;
mpfr_set_prec (s, prec);
mpfr_set_prec (c, prec);
mpfr_set_prec (sh, prec);
mpfr_set_prec (ch, prec);
mpfr_set_prec (sch, prec);
mpfr_set_prec (csh, prec);
mpfr_sin_cos (s, c, MPC_RE(op), GMP_RNDN);
mpfr_sinh_cosh (sh, ch, MPC_IM(op), GMP_RNDN);
if (rop_sin != NULL) {
/* real part of sine */
mpfr_mul (sch, s, ch, GMP_RNDN);
ok = (!mpfr_number_p (sch))
|| mpfr_can_round (sch, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_RE (rop_sin)
+ (MPC_RND_RE (rnd_sin) == GMP_RNDN));
if (ok) {
/* imaginary part of sine */
mpfr_mul (csh, c, sh, GMP_RNDN);
ok = (!mpfr_number_p (csh))
|| mpfr_can_round (csh, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_IM (rop_sin)
+ (MPC_RND_IM (rnd_sin) == GMP_RNDN));
}
}
if (rop_cos != NULL && ok) {
/* real part of cosine */
mpfr_mul (c, c, ch, GMP_RNDN);
ok = (!mpfr_number_p (c))
|| mpfr_can_round (c, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_RE (rop_cos)
+ (MPC_RND_RE (rnd_cos) == GMP_RNDN));
if (ok) {
/* imaginary part of cosine */
mpfr_mul (s, s, sh, GMP_RNDN);
mpfr_neg (s, s, GMP_RNDN);
ok = (!mpfr_number_p (s))
|| mpfr_can_round (s, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_IM (rop_cos)
+ (MPC_RND_IM (rnd_cos) == GMP_RNDN));
}
}
} while (ok == 0);
if (rop_sin != NULL) {
inex_re = mpfr_set (MPC_RE (rop_sin), sch, MPC_RND_RE (rnd_sin));
if (mpfr_inf_p (sch))
inex_re = mpfr_sgn (sch);
inex_im = mpfr_set (MPC_IM (rop_sin), csh, MPC_RND_IM (rnd_sin));
if (mpfr_inf_p (csh))
inex_im = mpfr_sgn (csh);
inex_sin = MPC_INEX (inex_re, inex_im);
}
else
inex_sin = MPC_INEX (0,0); /* return exact if not computed */
if (rop_cos != NULL) {
inex_re = mpfr_set (MPC_RE (rop_cos), c, MPC_RND_RE (rnd_cos));
if (mpfr_inf_p (c))
inex_re = mpfr_sgn (c);
inex_im = mpfr_set (MPC_IM (rop_cos), s, MPC_RND_IM (rnd_cos));
if (mpfr_inf_p (s))
inex_im = mpfr_sgn (s);
inex_cos = MPC_INEX (inex_re, inex_im);
}
else
inex_cos = MPC_INEX (0,0); /* return exact if not computed */
mpfr_clear (s);
mpfr_clear (c);
mpfr_clear (sh);
mpfr_clear (ch);
mpfr_clear (sch);
mpfr_clear (csh);
return (MPC_INEX12 (inex_sin, inex_cos));
}
}
