1 /* mpc_asin -- arcsine of a complex number. 2 3 Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2020, 2022 INRIA 4 5 This file is part of GNU MPC. 6 7 GNU MPC is free software; you can redistribute it and/or modify it under 8 the terms of the GNU Lesser General Public License as published by the 9 Free Software Foundation; either version 3 of the License, or (at your 10 option) any later version. 11 12 GNU MPC is distributed in the hope that it will be useful, but WITHOUT ANY 13 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 14 FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for 15 more details. 16 17 You should have received a copy of the GNU Lesser General Public License 18 along with this program. If not, see http://www.gnu.org/licenses/ . 19 */ 20 21 #include <stdio.h> 22 #include <limits.h> /* for ULONG_MAX */ 23 #include "mpc-impl.h" 24 25 /* Special case op = 1 + i*y for tiny y (see algorithms.tex). 26 Return 0 if special formula fails, otherwise put in z1 the approximate 27 value which needs to be converted to rop. 28 z1 is a temporary variable with enough precision. 29 */ 30 static int 31 mpc_asin_special (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd, mpc_ptr z1) 32 { 33 mpfr_exp_t ey = mpfr_get_exp (mpc_imagref (op)); 34 mpfr_t abs_y; 35 mpfr_prec_t p; 36 int inex; 37 38 /* |Re(asin(1+i*y)) - pi/2| <= y^(1/2) */ 39 if (ey >= 0 || ((-ey) / 2 < mpfr_get_prec (mpc_realref (z1)))) 40 return 0; 41 42 mpfr_const_pi (mpc_realref (z1), MPFR_RNDN); 43 mpfr_div_2exp (mpc_realref (z1), mpc_realref (z1), 1, MPFR_RNDN); /* exact */ 44 p = mpfr_get_prec (mpc_realref (z1)); 45 /* if z1 has precision p, the error on z1 is 1/2*ulp(z1) = 2^(-p) so far, 46 and since ey <= -2p, then y^(1/2) <= 1/2*ulp(z1) too, thus the total 47 error is bounded by ulp(z1) */ 48 if (!mpfr_can_round (mpc_realref(z1), p, MPFR_RNDN, MPFR_RNDZ, 49 mpfr_get_prec (mpc_realref(rop)) + 50 (MPC_RND_RE(rnd) == MPFR_RNDN))) 51 return 0; 52 53 /* |Im(asin(1+i*y)) - y^(1/2)| <= (1/12) * y^(3/2) for y >= 0 (err >= 0) 54 |Im(asin(1-i*y)) + y^(1/2)| <= (1/12) * y^(3/2) for y >= 0 (err <= 0) */ 55 abs_y[0] = mpc_imagref (op)[0]; 56 if (mpfr_signbit (mpc_imagref (op))) 57 MPFR_CHANGE_SIGN (abs_y); 58 inex = mpfr_sqrt (mpc_imagref (z1), abs_y, MPFR_RNDN); /* error <= 1/2 ulp */ 59 if (mpfr_signbit (mpc_imagref (op))) 60 MPFR_CHANGE_SIGN (mpc_imagref (z1)); 61 /* If z1 has precision p, the error on z1 is 1/2*ulp(z1) = 2^(-p) so far, 62 and (1/12) * y^(3/2) <= (1/8) * y * y^(1/2) <= 2^(ey-3)*2^p*ulp(y^(1/2)) 63 thus for p+ey-3 <= -1 we have (1/12) * y^(3/2) <= (1/2) * ulp(y^(1/2)), 64 and the total error is bounded by ulp(z1). 65 Note: if y^(1/2) is exactly representable, and ends with many zeroes, 66 then mpfr_can_round below will fail; however in that case we know that 67 Im(asin(1+i*y)) is away from +/-y^(1/2) wrt zero. */ 68 if (inex == 0) /* enlarge im(z1) so that the inexact flag is correct */ 69 { 70 if (mpfr_signbit (mpc_imagref (op))) 71 mpfr_nextbelow (mpc_imagref (z1)); 72 else 73 mpfr_nextabove (mpc_imagref (z1)); 74 return 1; 75 } 76 p = mpfr_get_prec (mpc_imagref (z1)); 77 if (!mpfr_can_round (mpc_imagref(z1), p - 1, MPFR_RNDA, MPFR_RNDZ, 78 mpfr_get_prec (mpc_imagref(rop)) + 79 (MPC_RND_IM(rnd) == MPFR_RNDN))) 80 return 0; 81 return 1; 82 } 83 84 /* Put in s an approximation of asin(z) using: 85 asin z = z + 1/2*z^3/3 + (1*3)/(2*4)*z^5/5 + ... 86 Assume |Re(z)|, |Im(z)| < 1/2. 87 Return non-zero if we can get the correct result by rounding s: 88 mpc_set (rop, s, ...) */ 89 static int 90 mpc_asin_series (mpc_srcptr rop, mpc_ptr s, mpc_srcptr z, mpc_rnd_t rnd) 91 { 92 mpc_t w, t; 93 unsigned long k, err, kx, ky; 94 mpfr_prec_t p; 95 mpfr_exp_t ex, ey, e; 96 97 /* assume z = (x,y) with |x|,|y| < 2^(-e) with e >= 1, see the error 98 analysis in algorithms.tex */ 99 ex = mpfr_get_exp (mpc_realref (z)); 100 MPC_ASSERT(ex <= -1); 101 ey = mpfr_get_exp (mpc_imagref (z)); 102 MPC_ASSERT(ey <= -1); 103 e = (ex >= ey) ? ex : ey; 104 e = -e; 105 /* now e >= 1 */ 106 107 p = mpfr_get_prec (mpc_realref (s)); /* working precision */ 108 MPC_ASSERT(mpfr_get_prec (mpc_imagref (s)) == p); 109 110 mpc_init2 (w, p); 111 mpc_init2 (t, p); 112 mpc_set (s, z, MPC_RNDNN); 113 mpc_sqr (w, z, MPC_RNDNN); 114 mpc_set (t, z, MPC_RNDNN); 115 for (k = 1; ;k++) 116 { 117 mpfr_exp_t exp_x, exp_y; 118 mpc_mul (t, t, w, MPC_RNDNN); 119 mpc_mul_ui (t, t, (2 * k - 1) * (2 * k - 1), MPC_RNDNN); 120 mpc_div_ui (t, t, (2 * k) * (2 * k + 1), MPC_RNDNN); 121 exp_x = mpfr_get_exp (mpc_realref (s)); 122 exp_y = mpfr_get_exp (mpc_imagref (s)); 123 if (mpfr_get_exp (mpc_realref (t)) < exp_x - p && 124 mpfr_get_exp (mpc_imagref (t)) < exp_y - p) 125 /* Re(t) < 1/2 ulp(Re(s)) and Im(t) < 1/2 ulp(Im(s)), 126 thus adding t to s will not change s */ 127 break; 128 mpc_add (s, s, t, MPC_RNDNN); 129 } 130 mpc_clear (w); 131 mpc_clear (t); 132 /* check (2k-1)^2 is exactly representable */ 133 MPC_ASSERT(2 * k - 1 <= ULONG_MAX / (2 * k - 1)); 134 /* maximal absolute error on Re(s),Im(s) is: 135 (5k-3)k/2*2^(-1-p) for e=1 136 5k/2*2^(-e-p) for e >= 2 */ 137 if (e == 1) 138 { 139 MPC_ASSERT(5 * k - 3 <= ULONG_MAX / k); 140 kx = (5 * k - 3) * k; 141 } 142 else 143 kx = 5 * k; 144 kx = (kx + 1) / 2; /* takes into account the 1/2 factor in both cases */ 145 /* now (5k-3)k/2 <= kx for e=1, and 5k/2 <= kx for e >= 2, thus 146 the maximal absolute error on Re(s),Im(s) is bounded by kx*2^(-e-p) */ 147 148 e = -e; 149 ky = kx; 150 151 /* for the real part, convert the maximal absolute error kx*2^(e-p) into 152 relative error */ 153 ex = mpfr_get_exp (mpc_realref (s)); 154 /* ulp(Re(s)) = 2^(ex+1-p) */ 155 err = 0; 156 /* invariant: the error will be kx*2^err */ 157 if (ex + 1 > e) /* divide kx by 2^(ex+1-e) */ 158 while (ex + 1 > e) 159 { 160 kx = (kx + 1) / 2; 161 ex--; 162 } 163 else /* multiply the error by 2^(e-(ex+1)), thus add e-(ex+1) to err */ 164 err += e - (ex + 1); 165 /* now the rounding error is bounded by kx*2^err*ulp(Re(s)), add the 166 mathematical error which is bounded by ulp(Re(s)): the first neglected 167 term is less than 1/2*ulp(Re(s)), and each term decreases by at least 168 a factor 2, since |z^2| <= 1/2. */ 169 kx++; 170 for (; kx > 2; err++, kx = (kx + 1) / 2); 171 /* can we round Re(s) with error less than 2^(EXP(Re(s))-err) ? */ 172 if (!mpfr_can_round (mpc_realref (s), p - err, MPFR_RNDN, MPFR_RNDZ, 173 mpfr_get_prec (mpc_realref (rop)) + 174 (MPC_RND_RE(rnd) == MPFR_RNDN))) 175 return 0; 176 177 /* same for the imaginary part */ 178 ey = mpfr_get_exp (mpc_imagref (s)); 179 /* we take for e the exponent of Im(z), which amounts to divide the error by 180 2^delta where delta is the exponent difference between Re(z) and Im(z) 181 (see algorithms.tex) */ 182 e = mpfr_get_exp (mpc_imagref (z)); 183 /* ulp(Im(s)) = 2^(ey+1-p) */ 184 if (ey + 1 > e) /* divide ky by 2^(ey+1-e) */ 185 while (ey + 1 > e) 186 { 187 ky = (ky + 1) / 2; 188 ey--; 189 } 190 else /* multiply ky by 2^(e-(ey+1)) */ 191 ky <<= e - (ey + 1); 192 /* now the rounding error is bounded by ky*ulp(Im(s)), add the 193 mathematical error which is bounded by ulp(Im(s)): the first neglected 194 term is less than 1/2*ulp(Im(s)), and each term decreases by at least 195 a factor 2, since |z^2| <= 1/2. */ 196 ky++; 197 for (err = 0; ky > 2; err++, ky = (ky + 1) / 2); 198 /* can we round Im(s) with error less than 2^(EXP(Im(s))-err) ? */ 199 return mpfr_can_round (mpc_imagref (s), p - err, MPFR_RNDN, MPFR_RNDZ, 200 mpfr_get_prec (mpc_imagref (rop)) + 201 (MPC_RND_IM(rnd) == MPFR_RNDN)); 202 } 203 204 205 static int /* bool */ 206 asin_taylor1 (int *inex, mpc_ptr rop, mpc_srcptr z, mpc_rnd_t rnd) 207 /* Write z = x + i*y and assume |x| < 1/2 and |y| < 1/4, that is, 208 Exp (x) <= -1 and Exp (y) <= -2; this also implies |z| < 1. 209 The function computes the Taylor series of order 1 around x 210 asin (z) \approx asin (x) + i * y / sqrt (1 - x^2) 211 with error term bounded above by Pi/2 * beta^2 / (1 - beta) 212 where beta = |y| / (1 - |x|), see algorithms.tex. 213 If the result can be rounded in direction rnd to rop, the value is 214 stored in rop, the inexact value is stored in inex, and true is 215 returned; otherwise rop and inex are not changed, and false 216 is returned. */ 217 { 218 mpfr_exp_t ex, ey, es, err; 219 mpfr_prec_t prec_re, prec_im, prec; 220 mpfr_srcptr x, y; 221 mpfr_t s, t; 222 int inex_re, inex_im, ok; 223 224 /* We have asin (x) ~ x, 225 |y| <= |y| / sqrt (1 - x^2) <= sqrt (4/3) * |y|, 226 beta <= 2 * |y| < 1/2, 1 / 1 - beta < 2 and the error term is bounded 227 above by 4 * Pi * |y|^2 < 13 * |y|^2 < 16 * |y|^2. 228 So to have a chance to round the imaginary part, we need roughly 229 log_2 (error term) \approx 2 * Exp (y) + 4 230 <= log_2 (ulp (y)) \approx Exp (y) - prec (imag (rop)), or 231 Exp (y) <= -prec (imag (rop)) - 4. 232 For the real part, we need 233 2 * Exp (y) + 4 <= Exp (x) - prec (real (rop)), or 234 Exp (x) >= 2 * Exp (y) + 4 + prec (real (rop)). 235 Check this first. */ 236 x = mpc_realref (z); 237 y = mpc_imagref (z); 238 ex = mpfr_get_exp (x); 239 ey = mpfr_get_exp (y); 240 prec_re = mpfr_get_prec (mpc_realref (rop)); 241 prec_im = mpfr_get_prec (mpc_imagref (rop)); 242 if (ey > - prec_im - 4 || ex < 2 * ey + 4 + prec_re) 243 return 0; 244 245 /* Real part. */ 246 prec = prec_re + 7; 247 mpfr_init2 (s, prec); 248 mpfr_asin (s, x, MPFR_RNDN); 249 /* The error is bounded above by 13*|y|^2 + 1/2 * 2^(Exp (s) - prec) 250 <= 2^(max (2 * Exp (y) + 5, Exp (s) - prec)). */ 251 es = mpfr_get_exp (s); 252 err = MPC_MAX (2 * ey + 5, es - prec); 253 ok = mpfr_can_round (s, es - err, MPFR_RNDN, MPFR_RNDZ, 254 mpfr_get_prec (mpc_realref (rop)) 255 + (MPC_RND_RE (rnd) == MPFR_RNDN)); 256 257 if (ok) { 258 /* Imaginary part. */ 259 prec = prec_im + 7; 260 mpfr_init2 (t, prec); 261 mpfr_mul (t, x, x, MPFR_RNDU); /* 0 < t <= 1/4, error 1 ulp */ 262 mpfr_ui_sub (t, 1, t, MPFR_RNDD); 263 /* 3/4 <= t < 1, error 2 ulp, epsilon- = 0 since rounded down */ 264 mpfr_sqrt (t, t, MPFR_RNDD); 265 /* error 3 ulp: propagation error stable since epsilon- = 0, 266 1 ulp for rounding; see ssec:proprealsqrt in algorithms.tex */ 267 mpfr_div (t, y, t, MPFR_RNDA); 268 /* error 7 ulp: since denominator rounded down, previous error 269 multiplied by 2, 1 ulp additional rounding error */ 270 ok = mpfr_can_round (t, prec - 3, MPFR_RNDA, MPFR_RNDZ, 271 mpfr_get_prec (mpc_imagref (rop)) 272 + (MPC_RND_IM (rnd) == MPFR_RNDN)); 273 274 if (ok) { 275 inex_re = mpfr_set (mpc_realref (rop), s, MPC_RND_RE (rnd)); 276 inex_im = mpfr_set (mpc_imagref (rop), t, MPC_RND_IM (rnd)); 277 *inex = MPC_INEX (inex_re, inex_im); 278 } 279 280 mpfr_clear (t); 281 } 282 283 mpfr_clear (s); 284 285 return ok; 286 } 287 288 289 int 290 mpc_asin (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd) 291 { 292 mpfr_prec_t p, p_re, p_im; 293 mpfr_rnd_t rnd_re, rnd_im; 294 mpc_t z1; 295 int inex, inex_re, inex_im, loop = 0; 296 mpfr_exp_t saved_emin, saved_emax, err, olderr; 297 298 /* special values */ 299 if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op))) 300 { 301 if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op))) 302 { 303 mpfr_set_nan (mpc_realref (rop)); 304 mpfr_set_inf (mpc_imagref (rop), mpfr_signbit (mpc_imagref (op)) ? -1 : +1); 305 } 306 else if (mpfr_zero_p (mpc_realref (op))) 307 { 308 mpfr_set (mpc_realref (rop), mpc_realref (op), MPFR_RNDN); 309 mpfr_set_nan (mpc_imagref (rop)); 310 } 311 else 312 { 313 mpfr_set_nan (mpc_realref (rop)); 314 mpfr_set_nan (mpc_imagref (rop)); 315 } 316 317 return 0; 318 } 319 320 if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op))) 321 { 322 if (mpfr_inf_p (mpc_realref (op))) 323 { 324 int inf_im = mpfr_inf_p (mpc_imagref (op)); 325 326 inex_re = set_pi_over_2 (mpc_realref (rop), 327 (mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd)); 328 mpfr_set_inf (mpc_imagref (rop), (mpfr_signbit (mpc_imagref (op)) ? -1 : 1)); 329 330 if (inf_im) 331 mpfr_div_2ui (mpc_realref (rop), mpc_realref (rop), 1, MPFR_RNDN); 332 } 333 else 334 { 335 mpfr_set_zero (mpc_realref (rop), (mpfr_signbit (mpc_realref (op)) ? -1 : 1)); 336 inex_re = 0; 337 mpfr_set_inf (mpc_imagref (rop), (mpfr_signbit (mpc_imagref (op)) ? -1 : 1)); 338 } 339 340 return MPC_INEX (inex_re, 0); 341 } 342 343 /* pure real argument */ 344 if (mpfr_zero_p (mpc_imagref (op))) 345 { 346 int s_im; 347 s_im = mpfr_signbit (mpc_imagref (op)); 348 349 if (mpfr_cmp_ui (mpc_realref (op), 1) > 0) 350 { 351 if (s_im) 352 inex_im = -mpfr_acosh (mpc_imagref (rop), mpc_realref (op), 353 INV_RND (MPC_RND_IM (rnd))); 354 else 355 inex_im = mpfr_acosh (mpc_imagref (rop), mpc_realref (op), 356 MPC_RND_IM (rnd)); 357 inex_re = set_pi_over_2 (mpc_realref (rop), 358 (mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd)); 359 if (s_im) 360 mpc_conj (rop, rop, MPC_RNDNN); 361 } 362 else if (mpfr_cmp_si (mpc_realref (op), -1) < 0) 363 { 364 mpfr_t minus_op_re; 365 minus_op_re[0] = mpc_realref (op)[0]; 366 MPFR_CHANGE_SIGN (minus_op_re); 367 368 if (s_im) 369 inex_im = -mpfr_acosh (mpc_imagref (rop), minus_op_re, 370 INV_RND (MPC_RND_IM (rnd))); 371 else 372 inex_im = mpfr_acosh (mpc_imagref (rop), minus_op_re, 373 MPC_RND_IM (rnd)); 374 inex_re = set_pi_over_2 (mpc_realref (rop), 375 (mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd)); 376 if (s_im) 377 mpc_conj (rop, rop, MPC_RNDNN); 378 } 379 else 380 { 381 inex_im = mpfr_set_ui (mpc_imagref (rop), 0, MPC_RND_IM (rnd)); 382 if (s_im) 383 mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), MPFR_RNDN); 384 inex_re = mpfr_asin (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd)); 385 } 386 387 return MPC_INEX (inex_re, inex_im); 388 } 389 390 /* pure imaginary argument */ 391 if (mpfr_zero_p (mpc_realref (op))) 392 { 393 int s; 394 s = mpfr_signbit (mpc_realref (op)); 395 mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN); 396 if (s) 397 mpfr_neg (mpc_realref (rop), mpc_realref (rop), MPFR_RNDN); 398 inex_im = mpfr_asinh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd)); 399 400 return MPC_INEX (0, inex_im); 401 } 402 403 /* Try special code for |x| < 1/2 and |y| < 1/4. */ 404 if (mpfr_get_exp (mpc_realref (op)) <= -1 405 && mpfr_get_exp (mpc_imagref (op)) <= -2) { 406 if (asin_taylor1 (&inex, rop, op, rnd)) 407 return inex; 408 } 409 410 saved_emin = mpfr_get_emin (); 411 saved_emax = mpfr_get_emax (); 412 mpfr_set_emin (mpfr_get_emin_min ()); 413 mpfr_set_emax (mpfr_get_emax_max ()); 414 415 /* regular complex: asin(z) = -i*log(i*z+sqrt(1-z^2)) */ 416 p_re = mpfr_get_prec (mpc_realref(rop)); 417 p_im = mpfr_get_prec (mpc_imagref(rop)); 418 rnd_re = MPC_RND_RE(rnd); 419 rnd_im = MPC_RND_IM(rnd); 420 p = p_re >= p_im ? p_re : p_im; 421 mpc_init2 (z1, p); 422 olderr = err = 0; /* number of lost bits */ 423 while (1) 424 { 425 mpfr_exp_t ex, ey; 426 427 loop ++; 428 p += err - olderr; /* add extra number of lost bits in previous loop */ 429 olderr = err; 430 p += (loop <= 2) ? mpc_ceil_log2 (p) + 3 : p / 2; 431 mpc_set_prec (z1, p); 432 433 /* try special code for 1+i*y with tiny y */ 434 if (loop == 1 && mpfr_cmp_ui (mpc_realref(op), 1) == 0 && 435 mpc_asin_special (rop, op, rnd, z1)) 436 break; 437 438 /* try special code for small z */ 439 if (mpfr_get_exp (mpc_realref (op)) <= -1 && 440 mpfr_get_exp (mpc_imagref (op)) <= -1 && 441 mpc_asin_series (rop, z1, op, rnd)) 442 break; 443 444 /* z1 <- z^2 */ 445 mpc_sqr (z1, op, MPC_RNDNN); 446 /* err(x) <= 1/2 ulp(x), err(y) <= 1/2 ulp(y) */ 447 /* z1 <- 1-z1 */ 448 ex = mpfr_get_exp (mpc_realref(z1)); 449 mpfr_ui_sub (mpc_realref(z1), 1, mpc_realref(z1), MPFR_RNDN); 450 mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), MPFR_RNDN); 451 /* if Re(z1) = 0, we can't determine the relative error */ 452 if (mpfr_zero_p (mpc_realref(z1))) 453 continue; 454 ex = ex - mpfr_get_exp (mpc_realref(z1)); 455 ex = (ex <= 0) ? 0 : ex; 456 /* err(x) <= 2^ex * ulp(x) */ 457 ex = ex + mpfr_get_exp (mpc_realref(z1)) - p; 458 /* err(x) <= 2^ex */ 459 ey = mpfr_get_exp (mpc_imagref(z1)) - p - 1; 460 /* err(y) <= 2^ey */ 461 ex = (ex >= ey) ? ex : ey; /* err(x), err(y) <= 2^ex, i.e., the norm 462 of the error is bounded by |h|<=2^(ex+1/2) */ 463 /* z1 <- sqrt(z1): if z1 = z + h, then sqrt(z1) = sqrt(z) + h/2/sqrt(t) */ 464 ey = mpfr_get_exp (mpc_realref(z1)) >= mpfr_get_exp (mpc_imagref(z1)) 465 ? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1)); 466 /* we have |z1| >= 2^(ey-1) thus 1/|z1| <= 2^(1-ey) */ 467 mpc_sqrt (z1, z1, MPC_RNDNN); 468 ex = (2 * ex + 1) - 2 - (ey - 1); /* |h^2/4/|t| <= 2^ex */ 469 ex = (ex + 1) / 2; /* ceil(ex/2) */ 470 /* express ex in terms of ulp(z1) */ 471 ey = mpfr_get_exp (mpc_realref(z1)) <= mpfr_get_exp (mpc_imagref(z1)) 472 ? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1)); 473 ex = ex - ey + p; 474 /* take into account the rounding error in the mpc_sqrt call */ 475 err = (ex <= 0) ? 1 : ex + 1; 476 /* err(x) <= 2^err * ulp(x), err(y) <= 2^err * ulp(y) */ 477 /* z1 <- i*z + z1 */ 478 ex = mpfr_get_exp (mpc_realref(z1)); 479 ey = mpfr_get_exp (mpc_imagref(z1)); 480 mpfr_sub (mpc_realref(z1), mpc_realref(z1), mpc_imagref(op), MPFR_RNDN); 481 mpfr_add (mpc_imagref(z1), mpc_imagref(z1), mpc_realref(op), MPFR_RNDN); 482 if (mpfr_zero_p (mpc_realref(z1)) || mpfr_zero_p (mpc_imagref(z1))) 483 continue; 484 ex -= mpfr_get_exp (mpc_realref(z1)); /* cancellation in x */ 485 ey -= mpfr_get_exp (mpc_imagref(z1)); /* cancellation in y */ 486 ex = (ex >= ey) ? ex : ey; /* maximum cancellation */ 487 err += ex; 488 err = (err <= 0) ? 1 : err + 1; /* rounding error in sub/add */ 489 /* z1 <- log(z1): if z1 = z + h, then log(z1) = log(z) + h/t with 490 |t| >= min(|z1|,|z|) */ 491 ex = mpfr_get_exp (mpc_realref(z1)); 492 ey = mpfr_get_exp (mpc_imagref(z1)); 493 ex = (ex >= ey) ? ex : ey; 494 err += ex - p; /* revert to absolute error <= 2^err */ 495 mpc_log (z1, z1, MPFR_RNDN); 496 err -= ex - 1; /* 1/|t| <= 1/|z| <= 2^(1-ex) */ 497 /* express err in terms of ulp(z1) */ 498 ey = mpfr_get_exp (mpc_realref(z1)) <= mpfr_get_exp (mpc_imagref(z1)) 499 ? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1)); 500 err = err - ey + p; 501 /* take into account the rounding error in the mpc_log call */ 502 err = (err <= 0) ? 1 : err + 1; 503 /* z1 <- -i*z1 */ 504 mpfr_swap (mpc_realref(z1), mpc_imagref(z1)); 505 mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), MPFR_RNDN); 506 if (mpfr_can_round (mpc_realref(z1), p - err, MPFR_RNDN, MPFR_RNDZ, 507 p_re + (rnd_re == MPFR_RNDN)) && 508 mpfr_can_round (mpc_imagref(z1), p - err, MPFR_RNDN, MPFR_RNDZ, 509 p_im + (rnd_im == MPFR_RNDN))) 510 break; 511 } 512 513 inex = mpc_set (rop, z1, rnd); 514 mpc_clear (z1); 515 516 /* restore the exponent range, and check the range of results */ 517 mpfr_set_emin (saved_emin); 518 mpfr_set_emax (saved_emax); 519 inex_re = mpfr_check_range (mpc_realref (rop), MPC_INEX_RE (inex), 520 MPC_RND_RE (rnd)); 521 inex_im = mpfr_check_range (mpc_imagref (rop), MPC_INEX_IM (inex), 522 MPC_RND_IM (rnd)); 523 524 return MPC_INEX (inex_re, inex_im); 525 } 526