void
mpc_log_level_set(int level)
{
mpc_logger_t *l = &mpc_logger;
l->level = MPC_MAX(MPC_LOG_EMERG, MPC_MIN(level, MPC_LOG_DEBUG));
}
/* res <- x[0]*y[0] + ... + x[n-1]*y[n-1] */
int
mpc_dot (mpc_ptr res, const mpc_ptr *x, const mpc_ptr *y,
unsigned long n, mpc_rnd_t rnd)
{
int inex_re, inex_im;
mpfr_ptr *t;
mpfr_t *z;
unsigned long i;
z = (mpfr_t *) malloc (2 * n * sizeof (mpfr_t));
MPC_ASSERT(z != NULL);
t = (mpfr_ptr *) malloc (2 * n * sizeof(mpfr_ptr));
MPC_ASSERT(t != NULL);
for (i = 0; i < 2 * n; i++)
t[i] = z[i];
/* we first store in z[i] the value of Re(x[i])*Re(y[i])
and in z[n+i] that of -Im(x[i])*Im(y[i]) */
for (i = 0; i < n; i++)
{
mpfr_prec_t prec_x_re = mpfr_get_prec (mpc_realref (x[i]));
mpfr_prec_t prec_x_im = mpfr_get_prec (mpc_imagref (x[i]));
mpfr_prec_t prec_y_re = mpfr_get_prec (mpc_realref (y[i]));
mpfr_prec_t prec_y_im = mpfr_get_prec (mpc_imagref (y[i]));
mpfr_prec_t prec_y_max = MPC_MAX (prec_y_re, prec_y_im);
/* we allocate z[i] with prec_x_re + prec_y_max bits
so that the second loop below does not reallocate */
mpfr_init2 (z[i], prec_x_re + prec_y_max);
mpfr_set_prec (z[i], prec_x_re + prec_y_re);
mpfr_mul (z[i], mpc_realref (x[i]), mpc_realref (y[i]), MPFR_RNDZ);
/* idem for z[n+i]: we allocate with prec_x_im + prec_y_max bits */
mpfr_init2 (z[n+i], prec_x_im + prec_y_max);
mpfr_set_prec (z[n+i], prec_x_im + prec_y_im);
mpfr_mul (z[n+i], mpc_imagref (x[i]), mpc_imagref (y[i]), MPFR_RNDZ);
mpfr_neg (z[n+i], z[n+i], MPFR_RNDZ);
}
inex_re = mpfr_sum (mpc_realref (res), t, 2 * n, MPC_RND_RE (rnd));
/* we then store in z[i] the value of Re(x[i])*Im(y[i])
and in z[n+i] that of Im(x[i])*Re(y[i]) */
for (i = 0; i < n; i++)
{
mpfr_prec_t prec_x_re = mpfr_get_prec (mpc_realref (x[i]));
mpfr_prec_t prec_x_im = mpfr_get_prec (mpc_imagref (x[i]));
mpfr_prec_t prec_y_re = mpfr_get_prec (mpc_realref (y[i]));
mpfr_prec_t prec_y_im = mpfr_get_prec (mpc_imagref (y[i]));
mpfr_set_prec (z[i], prec_x_re + prec_y_im);
mpfr_mul (z[i], mpc_realref (x[i]), mpc_imagref (y[i]), MPFR_RNDZ);
mpfr_set_prec (z[n+i], prec_x_im + prec_y_re);
mpfr_mul (z[n+i], mpc_imagref (x[i]), mpc_realref (y[i]), MPFR_RNDZ);
}
inex_im = mpfr_sum (mpc_imagref (res), t, 2 * n, MPC_RND_IM (rnd));
for (i = 0; i < 2 * n; i++)
mpfr_clear (z[i]);
free (t);
free (z);
return MPC_INEX(inex_re, inex_im);
}
int
mpc_log_init(int level, char *name)
{
mpc_logger_t *l = &mpc_logger;
l->level = MPC_MAX(MPC_LOG_EMERG, MPC_MIN(level, MPC_LOG_DEBUG));
l->name = name;
if (name == NULL || !strlen(name)) {
l->fd = STDERR_FILENO;
} else {
l->fd = open(name, O_WRONLY|O_APPEND|O_CREAT, 0644);
if (l->fd < 0) {
mpc_log_stderr(errno, "opening log file '%s' failed: %s", name,
strerror(errno));
return -1;
}
}
return 0;
}
/* return mpfr_cmp (mpc_abs (a), mpc_abs (b)) */
int
mpc_cmp_abs (mpc_srcptr a, mpc_srcptr b)
{
mpc_t z1, z2;
mpfr_t n1, n2;
mpfr_prec_t prec;
int inex1, inex2, ret;
/* Handle numbers containing one NaN as mpfr_cmp. */
if ( mpfr_nan_p (mpc_realref (a)) || mpfr_nan_p (mpc_imagref (a))
|| mpfr_nan_p (mpc_realref (b)) || mpfr_nan_p (mpc_imagref (b)))
{
mpfr_t nan;
mpfr_init (nan);
mpfr_set_nan (nan);
ret = mpfr_cmp (nan, nan);
mpfr_clear (nan);
return ret;
}
/* Handle infinities. */
if (mpc_inf_p (a))
if (mpc_inf_p (b))
return 0;
else
return 1;
else if (mpc_inf_p (b))
return -1;
/* Replace all parts of a and b by their absolute values, then order
them by size. */
z1 [0] = a [0];
z2 [0] = b [0];
if (mpfr_signbit (mpc_realref (a)))
MPFR_CHANGE_SIGN (mpc_realref (z1));
if (mpfr_signbit (mpc_imagref (a)))
MPFR_CHANGE_SIGN (mpc_imagref (z1));
if (mpfr_signbit (mpc_realref (b)))
MPFR_CHANGE_SIGN (mpc_realref (z2));
if (mpfr_signbit (mpc_imagref (b)))
MPFR_CHANGE_SIGN (mpc_imagref (z2));
if (mpfr_cmp (mpc_realref (z1), mpc_imagref (z1)) > 0)
mpfr_swap (mpc_realref (z1), mpc_imagref (z1));
if (mpfr_cmp (mpc_realref (z2), mpc_imagref (z2)) > 0)
mpfr_swap (mpc_realref (z2), mpc_imagref (z2));
/* Handle cases in which only one part differs. */
if (mpfr_cmp (mpc_realref (z1), mpc_realref (z2)) == 0)
return mpfr_cmp (mpc_imagref (z1), mpc_imagref (z2));
if (mpfr_cmp (mpc_imagref (z1), mpc_imagref (z2)) == 0)
return mpfr_cmp (mpc_realref (z1), mpc_realref (z2));
/* Implement the algorithm in algorithms.tex. */
mpfr_init (n1);
mpfr_init (n2);
prec = MPC_MAX (50, MPC_MAX (MPC_MAX_PREC (z1), MPC_MAX_PREC (z2)) / 100);
do {
mpfr_set_prec (n1, prec);
mpfr_set_prec (n2, prec);
inex1 = mpc_norm (n1, z1, MPFR_RNDD);
inex2 = mpc_norm (n2, z2, MPFR_RNDD);
ret = mpfr_cmp (n1, n2);
if (ret != 0)
goto end;
else
if (inex1 == 0) /* n1 = norm(z1) */
if (inex2) /* n2 < norm(z2) */
{
ret = -1;
goto end;
}
else /* n2 = norm(z2) */
{
ret = 0;
goto end;
}
else /* n1 < norm(z1) */
if (inex2 == 0)
{
ret = 1;
goto end;
}
prec *= 2;
} while (1);
end:
mpfr_clear (n1);
mpfr_clear (n2);
return ret;
}
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_exp (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
mpfr_t x, y, z;
mpfr_prec_t prec;
int ok = 0;
int inex_re, inex_im;
int saved_underflow, saved_overflow;
/* special values */
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
/* NaNs
exp(nan +i*y) = nan -i*0 if y = -0,
nan +i*0 if y = +0,
nan +i*nan otherwise
exp(x+i*nan) = +/-0 +/-i*0 if x=-inf,
+/-inf +i*nan if x=+inf,
nan +i*nan otherwise */
{
if (mpfr_zero_p (mpc_imagref (op)))
return mpc_set (rop, op, MPC_RNDNN);
if (mpfr_inf_p (mpc_realref (op)))
{
if (mpfr_signbit (mpc_realref (op)))
return mpc_set_ui_ui (rop, 0, 0, MPC_RNDNN);
else
{
mpfr_set_inf (mpc_realref (rop), +1);
mpfr_set_nan (mpc_imagref (rop));
return MPC_INEX(0, 0); /* Inf/NaN are exact */
}
}
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
return MPC_INEX(0, 0); /* NaN is exact */
}
if (mpfr_zero_p (mpc_imagref(op)))
/* special case when the input is real
exp(x-i*0) = exp(x) -i*0, even if x is NaN
exp(x+i*0) = exp(x) +i*0, even if x is NaN */
{
inex_re = mpfr_exp (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd));
inex_im = mpfr_set (mpc_imagref(rop), mpc_imagref(op), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_zero_p (mpc_realref (op)))
/* special case when the input is imaginary */
{
inex_re = mpfr_cos (mpc_realref (rop), mpc_imagref (op), MPC_RND_RE(rnd));
inex_im = mpfr_sin (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM(rnd));
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_inf_p (mpc_realref (op)))
/* real part is an infinity,
exp(-inf +i*y) = 0*(cos y +i*sin y)
exp(+inf +i*y) = +/-inf +i*nan if y = +/-inf
+inf*(cos y +i*sin y) if 0 < |y| < inf */
{
mpfr_t n;
mpfr_init2 (n, 2);
if (mpfr_signbit (mpc_realref (op)))
mpfr_set_ui (n, 0, GMP_RNDN);
else
mpfr_set_inf (n, +1);
if (mpfr_inf_p (mpc_imagref (op)))
{
inex_re = mpfr_set (mpc_realref (rop), n, GMP_RNDN);
if (mpfr_signbit (mpc_realref (op)))
inex_im = mpfr_set (mpc_imagref (rop), n, GMP_RNDN);
else
{
mpfr_set_nan (mpc_imagref (rop));
inex_im = 0; /* NaN is exact */
}
}
else
{
mpfr_t c, s;
mpfr_init2 (c, 2);
mpfr_init2 (s, 2);
mpfr_sin_cos (s, c, mpc_imagref (op), GMP_RNDN);
inex_re = mpfr_copysign (mpc_realref (rop), n, c, GMP_RNDN);
inex_im = mpfr_copysign (mpc_imagref (rop), n, s, GMP_RNDN);
mpfr_clear (s);
mpfr_clear (c);
}
mpfr_clear (n);
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_inf_p (mpc_imagref (op)))
/* real part is finite non-zero number, imaginary part is an infinity */
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
return MPC_INEX(0, 0); /* NaN is exact */
}
/* from now on, both parts of op are regular numbers */
prec = MPC_MAX_PREC(rop)
+ MPC_MAX (MPC_MAX (-mpfr_get_exp (mpc_realref (op)), 0),
-mpfr_get_exp (mpc_imagref (op)));
/* When op is close to 0, then exp is close to 1+Re(op), while
cos is close to 1-Im(op); to decide on the ternary value of exp*cos,
we need a high enough precision so that none of exp or cos is
computed as 1. */
mpfr_init2 (x, 2);
mpfr_init2 (y, 2);
mpfr_init2 (z, 2);
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
do
{
prec += mpc_ceil_log2 (prec) + 5;
mpfr_set_prec (x, prec);
mpfr_set_prec (y, prec);
mpfr_set_prec (z, prec);
/* FIXME: x may overflow so x.y does overflow too, while Re(exp(op))
could be represented in the precision of rop. */
mpfr_clear_overflow ();
mpfr_clear_underflow ();
mpfr_exp (x, mpc_realref(op), GMP_RNDN); /* error <= 0.5ulp */
mpfr_sin_cos (z, y, mpc_imagref(op), GMP_RNDN); /* errors <= 0.5ulp */
mpfr_mul (y, y, x, GMP_RNDN); /* error <= 2ulp */
ok = mpfr_overflow_p () || mpfr_zero_p (x)
|| mpfr_can_round (y, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_RE(rop) + (MPC_RND_RE(rnd) == GMP_RNDN));
if (ok) /* compute imaginary part */
{
mpfr_mul (z, z, x, GMP_RNDN);
ok = mpfr_overflow_p () || mpfr_zero_p (x)
|| mpfr_can_round (z, prec - 2, GMP_RNDN, GMP_RNDZ,
MPC_PREC_IM(rop) + (MPC_RND_IM(rnd) == GMP_RNDN));
}
}
while (ok == 0);
inex_re = mpfr_set (mpc_realref(rop), y, MPC_RND_RE(rnd));
inex_im = mpfr_set (mpc_imagref(rop), z, MPC_RND_IM(rnd));
if (mpfr_overflow_p ()) {
/* overflow in real exponential, inex is sign of infinite result */
inex_re = mpfr_sgn (y);
inex_im = mpfr_sgn (z);
}
else if (mpfr_underflow_p ()) {
/* underflow in real exponential, inex is opposite of sign of 0 result */
inex_re = (mpfr_signbit (y) ? +1 : -1);
inex_im = (mpfr_signbit (z) ? +1 : -1);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
return MPC_INEX(inex_re, inex_im);
}
int
mpc_atan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int s_re;
int s_im;
int inex_re;
int inex_im;
int inex;
inex_re = 0;
inex_im = 0;
s_re = mpfr_signbit (mpc_realref (op));
s_im = mpfr_signbit (mpc_imagref (op));
/* special values */
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
{
if (mpfr_nan_p (mpc_realref (op)))
{
mpfr_set_nan (mpc_realref (rop));
if (mpfr_zero_p (mpc_imagref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, MPC_RNDNN);
}
else
mpfr_set_nan (mpc_imagref (rop));
}
else
{
if (mpfr_inf_p (mpc_realref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
}
else
{
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
}
return MPC_INEX (inex_re, 0);
}
if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
{
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, GMP_RNDN);
return MPC_INEX (inex_re, 0);
}
/* pure real argument */
if (mpfr_zero_p (mpc_imagref (op)))
{
inex_re = mpfr_atan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
if (s_im)
mpc_conj (rop, rop, GMP_RNDN);
return MPC_INEX (inex_re, 0);
}
/* pure imaginary argument */
if (mpfr_zero_p (mpc_realref (op)))
{
int cmp_1;
if (s_im)
cmp_1 = -mpfr_cmp_si (mpc_imagref (op), -1);
else
cmp_1 = mpfr_cmp_ui (mpc_imagref (op), +1);
if (cmp_1 < 0)
{
/* atan(+0+iy) = +0 +i*atanh(y), if |y| < 1
atan(-0+iy) = -0 +i*atanh(y), if |y| < 1 */
mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
if (s_re)
mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN);
inex_im = mpfr_atanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
}
else if (cmp_1 == 0)
{
/* atan(+/-0+i) = NaN +i*inf
atan(+/-0-i) = NaN -i*inf */
mpfr_set_nan (mpc_realref (rop));
mpfr_set_inf (mpc_imagref (rop), s_im ? -1 : +1);
}
else
{
/* atan(+0+iy) = +pi/2 +i*atanh(1/y), if |y| > 1
atan(-0+iy) = -pi/2 +i*atanh(1/y), if |y| > 1 */
mpfr_rnd_t rnd_im, rnd_away;
mpfr_t y;
mpfr_prec_t p, p_im;
int ok;
rnd_im = MPC_RND_IM (rnd);
mpfr_init (y);
p_im = mpfr_get_prec (mpc_imagref (rop));
p = p_im;
/* a = o(1/y) with error(a) < 1 ulp(a)
b = o(atanh(a)) with error(b) < (1+2^{1+Exp(a)-Exp(b)}) ulp(b)
As |atanh (1/y)| > |1/y| we have Exp(a)-Exp(b) <=0 so, at most,
2 bits of precision are lost.
We round atanh(1/y) away from 0.
*/
do
{
p += mpc_ceil_log2 (p) + 2;
mpfr_set_prec (y, p);
rnd_away = s_im == 0 ? GMP_RNDU : GMP_RNDD;
inex_im = mpfr_ui_div (y, 1, mpc_imagref (op), rnd_away);
/* FIXME: should we consider the case with unreasonably huge
precision prec(y)>3*exp_min, where atanh(1/Im(op)) could be
representable while 1/Im(op) underflows ?
This corresponds to |y| = 0.5*2^emin, in which case the
result may be wrong. */
/* atanh cannot underflow: |atanh(x)| > |x| for |x| < 1 */
inex_im |= mpfr_atanh (y, y, rnd_away);
ok = inex_im == 0
|| mpfr_can_round (y, p - 2, rnd_away, GMP_RNDZ,
p_im + (rnd_im == GMP_RNDN));
} while (ok == 0);
inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
inex_im = mpfr_set (mpc_imagref (rop), y, rnd_im);
mpfr_clear (y);
}
return MPC_INEX (inex_re, inex_im);
}
/* regular number argument */
{
mpfr_t a, b, x, y;
mpfr_prec_t prec, p;
mpfr_exp_t err, expo;
int ok = 0;
mpfr_t minus_op_re;
mpfr_exp_t op_re_exp, op_im_exp;
mpfr_rnd_t rnd1, rnd2;
mpfr_inits2 (MPFR_PREC_MIN, a, b, x, y, (mpfr_ptr) 0);
/* real part: Re(arctan(x+i*y)) = [arctan2(x,1-y) - arctan2(-x,1+y)]/2 */
minus_op_re[0] = mpc_realref (op)[0];
MPFR_CHANGE_SIGN (minus_op_re);
op_re_exp = mpfr_get_exp (mpc_realref (op));
op_im_exp = mpfr_get_exp (mpc_imagref (op));
prec = mpfr_get_prec (mpc_realref (rop)); /* result precision */
/* a = o(1-y) error(a) < 1 ulp(a)
b = o(atan2(x,a)) error(b) < [1+2^{3+Exp(x)-Exp(a)-Exp(b)}] ulp(b)
= kb ulp(b)
c = o(1+y) error(c) < 1 ulp(c)
d = o(atan2(-x,c)) error(d) < [1+2^{3+Exp(x)-Exp(c)-Exp(d)}] ulp(d)
= kd ulp(d)
e = o(b - d) error(e) < [1 + kb*2^{Exp(b}-Exp(e)}
+ kd*2^{Exp(d)-Exp(e)}] ulp(e)
error(e) < [1 + 2^{4+Exp(x)-Exp(a)-Exp(e)}
+ 2^{4+Exp(x)-Exp(c)-Exp(e)}] ulp(e)
because |atan(u)| < |u|
< [1 + 2^{5+Exp(x)-min(Exp(a),Exp(c))
-Exp(e)}] ulp(e)
f = e/2 exact
*/
/* p: working precision */
p = (op_im_exp > 0 || prec > SAFE_ABS (mpfr_prec_t, op_im_exp)) ? prec
: (prec - op_im_exp);
rnd1 = mpfr_sgn (mpc_realref (op)) > 0 ? GMP_RNDD : GMP_RNDU;
rnd2 = mpfr_sgn (mpc_realref (op)) < 0 ? GMP_RNDU : GMP_RNDD;
do
{
p += mpc_ceil_log2 (p) + 2;
mpfr_set_prec (a, p);
mpfr_set_prec (b, p);
mpfr_set_prec (x, p);
/* x = upper bound for atan (x/(1-y)). Since atan is increasing, we
need an upper bound on x/(1-y), i.e., a lower bound on 1-y for
x positive, and an upper bound on 1-y for x negative */
mpfr_ui_sub (a, 1, mpc_imagref (op), rnd1);
if (mpfr_sgn (a) == 0) /* y is near 1, thus 1+y is near 2, and
expo will be 1 or 2 below */
{
MPC_ASSERT (mpfr_cmp_ui (mpc_imagref(op), 1) == 0);
/* check for intermediate underflow */
err = 2; /* ensures err will be expo below */
}
else
err = mpfr_get_exp (a); /* err = Exp(a) with the notations above */
mpfr_atan2 (x, mpc_realref (op), a, GMP_RNDU);
/* b = lower bound for atan (-x/(1+y)): for x negative, we need a
lower bound on -x/(1+y), i.e., an upper bound on 1+y */
mpfr_add_ui (a, mpc_imagref(op), 1, rnd2);
/* if a is exactly zero, i.e., Im(op) = -1, then the error on a is 0,
and we can simply ignore the terms involving Exp(a) in the error */
if (mpfr_sgn (a) == 0)
{
MPC_ASSERT (mpfr_cmp_si (mpc_imagref(op), -1) == 0);
/* check for intermediate underflow */
expo = err; /* will leave err unchanged below */
}
else
expo = mpfr_get_exp (a); /* expo = Exp(c) with the notations above */
mpfr_atan2 (b, minus_op_re, a, GMP_RNDD);
err = err < expo ? err : expo; /* err = min(Exp(a),Exp(c)) */
mpfr_sub (x, x, b, GMP_RNDU);
err = 5 + op_re_exp - err - mpfr_get_exp (x);
/* error is bounded by [1 + 2^err] ulp(e) */
err = err < 0 ? 1 : err + 1;
mpfr_div_2ui (x, x, 1, GMP_RNDU);
/* Note: using RND2=RNDD guarantees that if x is exactly representable
on prec + ... bits, mpfr_can_round will return 0 */
ok = mpfr_can_round (x, p - err, GMP_RNDU, GMP_RNDD,
prec + (MPC_RND_RE (rnd) == GMP_RNDN));
} while (ok == 0);
/* Imaginary part
Im(atan(x+I*y)) = 1/4 * [log(x^2+(1+y)^2) - log (x^2 +(1-y)^2)] */
prec = mpfr_get_prec (mpc_imagref (rop)); /* result precision */
/* a = o(1+y) error(a) < 1 ulp(a)
b = o(a^2) error(b) < 5 ulp(b)
c = o(x^2) error(c) < 1 ulp(c)
d = o(b+c) error(d) < 7 ulp(d)
e = o(log(d)) error(e) < [1 + 7*2^{2-Exp(e)}] ulp(e) = ke ulp(e)
f = o(1-y) error(f) < 1 ulp(f)
g = o(f^2) error(g) < 5 ulp(g)
h = o(c+f) error(h) < 7 ulp(h)
i = o(log(h)) error(i) < [1 + 7*2^{2-Exp(i)}] ulp(i) = ki ulp(i)
j = o(e-i) error(j) < [1 + ke*2^{Exp(e)-Exp(j)}
+ ki*2^{Exp(i)-Exp(j)}] ulp(j)
error(j) < [1 + 2^{Exp(e)-Exp(j)} + 2^{Exp(i)-Exp(j)}
+ 7*2^{3-Exp(j)}] ulp(j)
< [1 + 2^{max(Exp(e),Exp(i))-Exp(j)+1}
+ 7*2^{3-Exp(j)}] ulp(j)
k = j/4 exact
*/
err = 2;
p = prec; /* working precision */
do
{
p += mpc_ceil_log2 (p) + err;
mpfr_set_prec (a, p);
mpfr_set_prec (b, p);
mpfr_set_prec (y, p);
/* a = upper bound for log(x^2 + (1+y)^2) */
ROUND_AWAY (mpfr_add_ui (a, mpc_imagref (op), 1, MPFR_RNDA), a);
mpfr_sqr (a, a, GMP_RNDU);
mpfr_sqr (y, mpc_realref (op), GMP_RNDU);
mpfr_add (a, a, y, GMP_RNDU);
mpfr_log (a, a, GMP_RNDU);
/* b = lower bound for log(x^2 + (1-y)^2) */
mpfr_ui_sub (b, 1, mpc_imagref (op), GMP_RNDZ); /* round to zero */
mpfr_sqr (b, b, GMP_RNDZ);
/* we could write mpfr_sqr (y, mpc_realref (op), GMP_RNDZ) but it is
more efficient to reuse the value of y (x^2) above and subtract
one ulp */
mpfr_nextbelow (y);
mpfr_add (b, b, y, GMP_RNDZ);
mpfr_log (b, b, GMP_RNDZ);
mpfr_sub (y, a, b, GMP_RNDU);
if (mpfr_zero_p (y))
/* FIXME: happens when x and y have very different magnitudes;
could be handled more efficiently */
ok = 0;
else
{
expo = MPC_MAX (mpfr_get_exp (a), mpfr_get_exp (b));
expo = expo - mpfr_get_exp (y) + 1;
err = 3 - mpfr_get_exp (y);
/* error(j) <= [1 + 2^expo + 7*2^err] ulp(j) */
if (expo <= err) /* error(j) <= [1 + 2^{err+1}] ulp(j) */
err = (err < 0) ? 1 : err + 2;
else
err = (expo < 0) ? 1 : expo + 2;
mpfr_div_2ui (y, y, 2, GMP_RNDN);
MPC_ASSERT (!mpfr_zero_p (y));
/* FIXME: underflow. Since the main term of the Taylor series
in y=0 is 1/(x^2+1) * y, this means that y is very small
and/or x very large; but then the mpfr_zero_p (y) above
should be true. This needs a proof, or better yet,
special code. */
ok = mpfr_can_round (y, p - err, GMP_RNDU, GMP_RNDD,
prec + (MPC_RND_IM (rnd) == GMP_RNDN));
}
} while (ok == 0);
inex = mpc_set_fr_fr (rop, x, y, rnd);
mpfr_clears (a, b, x, y, (mpfr_ptr) 0);
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));
}
}
