this repo has no description
at fixPythonPipStalling 1963 lines 63 kB view raw
1/* 2 * Copyright (c) 2002 Apple Computer, Inc. All rights reserved. 3 * 4 * @APPLE_LICENSE_HEADER_START@ 5 * 6 * The contents of this file constitute Original Code as defined in and 7 * are subject to the Apple Public Source License Version 1.1 (the 8 * "License"). You may not use this file except in compliance with the 9 * License. Please obtain a copy of the License at 10 * http://www.apple.com/publicsource and read it before using this file. 11 * 12 * This Original Code and all software distributed under the License are 13 * distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, EITHER 14 * EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES, 15 * INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY, 16 * FITNESS FOR A PARTICULAR PURPOSE OR NON-INFRINGEMENT. Please see the 17 * License for the specific language governing rights and limitations 18 * under the License. 19 * 20 * @APPLE_LICENSE_HEADER_END@ 21 */ 22/**************************************************************************** 23** File: complex.c 24** 25** Contains: C source code for implementations of floating-point 26** (double) complex functions defined in header file 27** "complex.h" for PowerPC Macintoshes in native mode. 28** Transcendental function algorithms are based on the 29** paper "Branch Cuts for Complex Elementary Functions" 30** by W. Kahan, May 17, 1987, and on Pascal and C source 31** code for the SANE 80-/96-bit extended type by Kenton 32** Hanson and Paul Finlayson, respectively. 33** 34** 35** Written by: Jon Okada, SANEitation Engineer, ext. 4-4838 36** 37** Copyright: c 1987-1993 by Apple Computer, Inc., all rights reserved. 38** 39** Change History (most recent first): 40** 41** 25 Aug 93 ali Changed clog to cLog to avoid clashing with the 42** stream i/o definition clog. 43** 14 Jul 93 ali Added #pragma fenv_access on 44** 22 Feb 93 ali Added a nomaf #pragma. 45** 05 Feb 93 JPO Modified calls to feclearexcept and feraiseexcept 46** to reflect changes in "fenv.h". 47** 18 Dec 92 JPO First created. 48** 49****************************************************************************/ 50 51#include "math.h" 52#include "complex.h" 53#include <stdint.h> 54 55#define Real(z) (__real__ z) 56#define Imag(z) (__imag__ z) 57 58/**************************************************************************** 59 CONSTANTS used by complex functions 60 61#include <stdio.h> 62#include <math.h> 63#include <float.h> 64main() 65{ 66 67float FPKASINHOM4f = asinhf(nextafterf(INFINITY,0.0f))/4.0f; 68float FPKTHETAf = sqrtf(nextafterf(INFINITY,0.0f))/4.0f; 69float FPKRHOf = 1.0f/FPKTHETAf; 70float FPKLOVEREf = FLT_MIN/FLT_EPSILON; 71 72printf("FPKASINHOM4 %16.7e %x\n", FPKASINHOM4f, *(int *)(&FPKASINHOM4f)); 73printf("FPKTHETA %16.7e %x\n", FPKTHETAf, *(int *)(&FPKTHETAf)); 74printf("FPKRHO %16.7e %x\n", FPKRHOf, *(int *)(&FPKRHOf)); 75printf("FPKLOVERE %16.7e %x\n", FPKLOVEREf, *(int *)(&FPKLOVEREf)); 76} 77 78static const // underflow threshold / round threshold 79 hexdouble FPKLOVERE = HEXDOUBLE(0x03600000,0x00000000); 80 81static const // underflow threshold / round threshold 82 hexsingle FPKLOVEREf = { 0xc000000 }; 83 84static const // exp(709.0) 85 hexdouble FPKEXP709 = HEXDOUBLE(0x7fdd422d,0x2be5dc9b); 86 87static const // asinh(nextafterd(+infinity,0.0))/4.0 88 hexdouble FPKASINHOM4 = HEXDOUBLE(0x406633ce,0x8fb9f87e); 89 90static const // asinh(nextafterf(+infinity,0.0))/4.0 91 hexsingle FPKASINHOM4f = { 0x41b2d4fc }; 92 93static const // sqrt(nextafterd(+infinity,0.0))/4.0 94 hexdouble FPKTHETA = HEXDOUBLE(0x5fcfffff,0xffffffff); 95 96static const // sqrt(nextafterf(+infinity,0.0))/4.0 97 hexsingle FPKTHETAf = { 0x5e7fffff }; 98 99static const // 4.0/sqrt(nextafterd(+infinity,0.0)) 100 hexdouble FPKRHO = HEXDOUBLE(0x20100000,0x00000000); 101 102static const // 4.0/sqrt(nextafterf(+infinity,0.0)) 103 hexsingle FPKRHOf = { 0x20800001 }; 104 105****************************************************************************/ 106 107static const double expOverflowThreshold_d = 0x1.62e42fefa39efp+9; 108static const double expOverflowValue_d = 0x1.fffffffffff2ap+1023; // exp(overflowThreshold) 109static const double twiceExpOverflowThresh_d = 0x1.62e42fefa39efp+10; 110 111static const double FPKASINHOM4 = 0x1.633ce8fb9f87ep+7; 112static const float FPKASINHOM4f = 0x1.65a9f8p+4f; 113static const double FPKTHETA = 0x1.fffffffffffffp+509; 114static const float FPKTHETAf = 0x1.fffffep+61f; 115static const double FPKRHO = 0x1p-510; 116static const float FPKRHOf = 0x1.000002p-62f; 117 118static void cosisin(double x, double complex *z); 119static void cosisinf(float x, float complex *z); 120 121static 122double complex xdivc( double x, double complex y ) /* returns (real x) / (complex y) */ 123{ 124 double complex z; 125 double r, denom; 126 127 if ( fabs(Real(y)) >= fabs(Imag(y)) ) { /* |Real(y)| >= |Imag(y)| */ 128 if (fabs(Real(y)) == INFINITY) { /* Imag(y) and Real(y) are infinite */ 129 Real(z) = copysign(0.0,Real(y)); 130 Imag(z) = copysign(0.0,-Imag(y)); 131 } 132 else { /* |Real(y)| >= finite |Imag(y)| */ 133 r = Imag(y)/Real(y); 134 denom = Real(y) + Imag(y)*r; 135 Real(z) = x/denom; 136 Imag(z) = (-x*r)/denom; 137 } 138 } 139 140 else { /* |Real(y)| !>= |Imag(y)| */ 141 r = Real(y)/Imag(y); 142 denom = r*Real(y) + Imag(y); 143 Real(z) = (r*x)/denom; 144 Imag(z) = -x/denom; 145 } 146 147 return z; 148} 149 150static 151float complex xdivcf( float x, float complex y ) /* returns (real x) / (complex y) */ 152{ 153 float complex z; 154 float r, denom; 155 156 if ( fabsf(Real(y)) >= fabsf(Imag(y)) ) { /* |Real(y)| >= |Imag(y)| */ 157 if (fabsf(Real(y)) == INFINITY) { /* Imag(y) and Real(y) are infinite */ 158 Real(z) = copysignf(0.0f,Real(y)); 159 Imag(z) = copysignf(0.0f,-Imag(y)); 160 } 161 else { /* |Real(y)| >= finite |Imag(y)| */ 162 r = Imag(y)/Real(y); 163 denom = Real(y) + Imag(y)*r; 164 Real(z) = x/denom; 165 Imag(z) = (-x*r)/denom; 166 } 167 } 168 169 else { /* |Real(y)| !>= |Imag(y)| */ 170 r = Real(y)/Imag(y); 171 denom = r*Real(y) + Imag(y); 172 Real(z) = (r*x)/denom; 173 Imag(z) = -x/denom; 174 } 175 176 return z; 177} 178 179/**************************************************************************** 180 double cabs(double complex z) returns the absolute value (magnitude) of its 181 complex argument z, avoiding spurious overflow, underflow, and invalid 182 exceptions. The code is identical to hypot[fl]. 183****************************************************************************/ 184 185double cabs( double complex z ) { return hypot(Real(z), Imag(z)); } 186 187float cabsf( float complex z ) { return hypotf(Real(z), Imag(z)); } 188 189/**************************************************************************** 190 double carg(double complex z) returns the argument (in radians) of its 191 complex argument z. The algorithm is from Kahan's paper. 192 193 The argument of a complex number z = x + i*y is defined as atan2(y,x) 194 for finite x and y. 195 196 CONSTANTS: FPKPI2 = pi/2.0 to double precision 197 FPKPI = pi to double precision 198 199 Calls: fpclassify, copysign, fabs, atan 200****************************************************************************/ 201 202double carg ( double complex z ) { return atan2(Imag(z), Real(z)); } 203 204float cargf ( float complex z ) { return atan2f(Imag(z), Real(z)); } 205 206/**************************************************************************** 207 double complex csqrt(double complex z) returns the complex square root of its argument. 208 The algorithm, which is from the Kahan paper, uses the following 209 identities: 210 211 sqrt(x + i*y) = sqrt((|z| + Real(z))/2) + i*sqrt((|z| - Real(z))/2) and 212 sqrt(x - i*y) = sqrt((|z| + Real(z))/2) - i*sqrt((|z| - Real(z))/2), 213 214 where y is positive and x may be positive or negative. 215 216 CONSTANTS: FPKINF = +infinity 217 218 Calls: cssqs, scalb, fabs, sqrt, copysign. 219****************************************************************************/ 220 221/* New Intel code written 9/26/06 by scanon 222 * Uses extra precision to compute |z| instead of cssqs(), saving environment calls. 223 * Note that we could also rescale using bits of the SSE2 code from ian's original intel hypot() routine, and will probably 224 * want to do exactly that in the future, to move away from using x87 for this. 225 */ 226 227double complex csqrt ( double complex z ) 228{ 229 static const double inf = __builtin_inf(); 230 double u,v; 231 232 // Special case for infinite y: 233 if (__builtin_fabs(Imag(z)) == inf) 234 return inf + I*Imag(z); // csqrt(x ± i∞) = ∞ ± i∞ for all x, including NaN. 235 236 // Special cases for y = NaN: 237 if (Imag(z) != Imag(z)) { 238 if (Real(z) != Real(z)) // csqrt(NaN + iNaN) = NaN + iNaN, quietly. 239 return z; 240 else if (Real(z) == inf) // csqrt(∞ + iNaN) = ∞ + iNaN 241 return z; 242 else if (Real(z) == -inf) // csqrt(-∞ ± iNaN) = NaN ± i∞. 243 return Imag(z) + I*copysign(inf,Imag(z)); 244 else { // csqrt(x + iNaN) = NaN + iNaN if x is finite. 245 return Imag(z) + I*Imag(z); 246 } 247 } 248 249 // At this point, we know that y is finite. Deal with special cases for x: 250 // Special case for x = NaN: 251 if (Real(z) != Real(z)) { // csqrt(NaN + ix) = NaN + iNaN. 252 return Real(z) + I*copysign(Real(z),Imag(z)); 253 } 254 255 // Special cases for x = 0: 256 if (Real(z) == 0.0) { 257 if (Imag(z) == 0.0) // csqrt(±0 + i0) = 0 + i0, csqrt(±0 - i0) = 0 - i0. 258 return I*Imag(z); 259 else { // csqrt(0 ± iy) = sqrt(y/2) ± i sqrt(y/2). 260 u = __builtin_sqrt(0.5*__builtin_fabs(Imag(z))); 261 return u + I*copysign(u, Imag(z) ); 262 } 263 } 264 265 // Special cases for infinte x: 266 if (Real(z) == inf) // csqrt(∞ ± iy) = ∞ ± i0 for finite y. 267 return inf + I*copysign(0.0,Imag(z)); 268 if (Real(z) == -inf) // csqrt(-∞ ± iy) = 0 ± i∞ for finite y. 269 return I*copysign(inf,Imag(z)); 270 271 // At this point, we know that x is finite, non-zero and y is finite. 272 else { 273 // We use extended (80-bit) precision to avoid over- or under-flow in computing |z|. 274 long double x = __builtin_fabsl(Real(z)); 275 long double y = Imag(z); 276 277 /* Compute 278 * +---------------- +---------------- 279 * | |z| + |Re z| Im z | |z| - |Re z| 280 * u = | -------------- v = ------ = ± | -------------- 281 * \| 2 2u \| 2 282 * 283 * There is no risk of drastic loss of precision due to cancellation using these formulas, 284 * as there would be if we used the second expression (involving the square root) for v. 285 * 286 * Overflow or Underflow is possible, but only if the actual result does not fit in double width. 287 */ 288 u = (double)__builtin_sqrtl(0.5L*(__builtin_sqrtl(x*x + y*y) + x)); 289 v = 0.5 * (Imag(z) / u); 290 291 /* If x < 0, then sqrt(z) = |v| + I*copysign(u, Im z). 292 * Otherwise, sqrt(z) = u + I*v. 293 */ 294 if (Real(z) < 0.0) { 295 return __builtin_fabs(v) + I*copysign(u,Imag(z)); 296 } else { 297 return u + I*v; 298 } 299 } 300} 301 302 303float complex csqrtf ( float complex z ) 304{ 305 static const float inf = __builtin_inff(); 306 float u,v; 307 308 // Special case for infinite y: 309 if (__builtin_fabsf(Imag(z)) == inf) 310 return inf + I*Imag(z); // csqrt(x ± i∞) = ∞ ± i∞ for all x, including NaN. 311 312 // Special cases for y = NaN: 313 if (Imag(z) != Imag(z)) { 314 if (Real(z) != Real(z)) // csqrt(NaN + iNaN) = NaN + iNaN, quietly. 315 return z; 316 else if (Real(z) == inf) // csqrt(∞ + iNaN) = ∞ + iNaN 317 return z; 318 else if (Real(z) == -inf) // csqrt(-∞ ± iNaN) = NaN ± i∞. 319 return Imag(z) + I*copysignf(inf,Imag(z)); 320 else { // csqrt(x + iNaN) = NaN + iNaN if x is finite. 321 return Imag(z) + I*Imag(z); 322 } 323 } 324 325 // At this point, we know that y is finite. Deal with special cases for x: 326 // Special case for x = NaN: 327 if (Real(z) != Real(z)) { // csqrt(NaN + ix) = NaN + iNaN. 328 return Real(z) + I*copysignf(Real(z),Imag(z)); 329 } 330 331 // Special cases for x = 0: 332 if (Real(z) == 0.0f) { 333 if (Imag(z) == 0.0f) // csqrt(±0 + i0) = 0 + i0, csqrt(±0 - i0) = 0 - i0. 334 return I*Imag(z); 335 else { // csqrt(0 ± iy) = sqrt(y/2) ± i sqrt(y/2). 336 u = __builtin_sqrtf(0.5f*__builtin_fabsf(Imag(z))); 337 return u + I*copysign(u, Imag(z) ); 338 } 339 } 340 341 // Special cases for infinte x: 342 if (Real(z) == inf) // csqrt(∞ ± iy) = ∞ ± i0 for finite y. 343 return inf + I*copysign(0.0f,Imag(z)); 344 if (Real(z) == -inf) // csqrt(-∞ ± iy) = 0 ± i∞ for finite y. 345 return I*copysign(inf,Imag(z)); 346 347 // At this point, we know that x is finite, non-zero and y is finite. 348 else { 349 // We use double (64-bit) precision to avoid over- or under-flow in computing |z|. 350 double x = __builtin_fabs(Real(z)); 351 double y = Imag(z); 352 353 /* Compute 354 * +---------------- +---------------- 355 * | |z| + |Re z| Im z | |z| - |Re z| 356 * u = | -------------- v = ------ = ± | -------------- 357 * \| 2 2u \| 2 358 * 359 * There is no risk of drastic loss of precision due to cancellation using these formulas, 360 * as there would be if we used the second expression (involving the square root) for v. 361 * 362 * Overflow or Underflow is possible, but only if the actual result does not fit in double width. 363 */ 364 u = (float)__builtin_sqrt(0.5*(__builtin_sqrt(x*x + y*y) + x)); 365 v = 0.5f * (Imag(z) / u); 366 367 /* If x < 0, then sqrt(z) = |v| + I*copysign(u, Im z). 368 * Otherwise, sqrt(z) = u + I*v. 369 */ 370 if (Real(z) < 0.0f) { 371 return __builtin_fabsf(v) + I*copysignf(u,Imag(z)); 372 } else { 373 return u + I*v; 374 } 375 } 376} 377 378/**************************************************************************** 379 double complex clog(double complex z) returns the complex natural logarithm of its 380 argument, using: 381 382 clog(x + iy) = [ log(x) + 0.5 * log1p(y^2/x^2) ] + I*carg(x + iy) if x > y 383 = [ log(y) + 0.5 * log1p(x^2/y^2) ] + I*carg(x + iy) otherwise 384 385 the real part is "mathematically" equivalent to log |z|, but the alternative form 386 is used to avoid spurious under/overflow. 387 388 Calls: fabs, log1p, log, carg. 389****************************************************************************/ 390 391double complex clog ( double complex z ) 392{ 393 static const double inf = __builtin_inf(); 394 double large, small, temp; 395 double complex w; 396 long double ratio; 397 398 Imag(w) = carg(z); 399 400 // handle x,y = ∞ 401 if ((__builtin_fabs(Real(z)) == inf) || (__builtin_fabs(Imag(z)) == inf)) { 402 Real(w) = inf; 403 return w; 404 } 405 406 // handle x,y = NaN 407 if (Real(z) != Real(z)) return Real(z) + I*copysign(Real(z),Imag(z)); 408 if (Imag(z) != Imag(z)) return Imag(z) + I*Imag(z); 409 410 large = __builtin_fabs(Real(z)); 411 small = __builtin_fabs(Imag(z)); 412 if (large < small) { 413 temp = large; 414 large = small; 415 small = temp; 416 } 417 418 Real(w) = log(large); 419 420 // if small == 0, then Re(clog(z)) = log(large). This sets div-by-zero when appropriate (if large is also 0). 421 if (small == 0.0) return w; 422 423 // if large == 1 424 if (large == 1.0) { 425 Real(w) = 0.5*log1p(small*small); // any underflow here is deserved. 426 return w; 427 } 428 429 // compute small/large in long double to avoid undue underflow. 430 ratio = (long double)small / (long double)large; 431 if (ratio > 0x1.0p-53L) { 432 /* if ratio is smaller than 2^-53, then 433 * 1/2 log1p(ratio^2) ~ 2^-106 < 1/2 an ulp of log(large), so it can't affect the final result. 434 */ 435 Real(w) += 0.5*log1p((double)(ratio*ratio)); 436 } 437 438 return w; 439} 440 441float complex clogf ( float complex z ) 442{ 443 static const float inf = __builtin_inff(); 444 float large, small, temp; 445 float complex w; 446 double ratio; 447 448 Imag(w) = cargf(z); 449 450 // handle x,y = ∞ 451 if ((__builtin_fabsf(Real(z)) == inf) || (__builtin_fabsf(Imag(z)) == inf)) { 452 Real(w) = inf; 453 return w; 454 } 455 456 // handle x,y = NaN 457 if (Real(z) != Real(z)) return Real(z) + I*copysignf(Real(z),Imag(z)); 458 if (Imag(z) != Imag(z)) return Imag(z) + I*Imag(z); 459 460 large = __builtin_fabsf(Real(z)); 461 small = __builtin_fabsf(Imag(z)); 462 if (large < small) { 463 temp = large; 464 large = small; 465 small = temp; 466 } 467 468 Real(w) = logf(large); 469 470 // if small == 0, then Re(clog(z)) = log(large). This sets div-by-zero when appropriate (if large is also 0). 471 if (small == 0.0f) return w; 472 473 // if large == 1 474 if (large == 1.0f) { 475 Real(w) = 0.5f*log1pf(small*small); // underflow here is deserved. 476 return w; 477 } 478 479 // compute small/large in double to avoid undue underflow. 480 ratio = (double)small / (double)large; 481 if (ratio > 0x1.0p-24) { 482 Real(w) += 0.5f*log1pf((float)(ratio*ratio)); 483 } 484 485 return w; 486} 487 488/**************************************************************************** 489 void cosisin(x, complex *z) 490 returns cos(x) + i sin(x) computed using the x87 fsincos instruction. 491 492 Called by: cexp, csin, ccos, csinh, and ccosh. 493 ****************************************************************************/ 494static void cosisin(double x, double complex *z) { 495 Real(*z) = cos(x); 496 Imag(*z) = sin(x); 497} 498 499static void cosisinf(float x, float complex *z) { 500 Real(*z) = cosf(x); 501 Imag(*z) = sinf(x); 502} 503 504/**************************************************************************** 505 double complex csin(double complex z) returns the complex sine of its argument. 506 507 sin(z) = -i sinh(iz) 508 509 Calls: csinh 510****************************************************************************/ 511 512double complex csin ( double complex z ) 513{ 514 double complex iz, iw, w; 515 Real(iz) = -Imag(z); 516 Imag(iz) = Real(z); 517 iw = csinh(iz); 518 Real(w) = Imag(iw); 519 Imag(w) = -Real(iw); 520 return w; 521} 522 523float complex csinf ( float complex z ) 524{ 525 float complex iz, iw, w; 526 Real(iz) = -Imag(z); 527 Imag(iz) = Real(z); 528 iw = csinhf(iz); 529 Real(w) = Imag(iw); 530 Imag(w) = -Real(iw); 531 return w; 532} 533 534/**************************************************************************** 535 double complex ccos(double complex z) returns the complex cosine of its argument. 536 537 cos(z) = cosh(iz) 538 539 Calls: ccosh 540****************************************************************************/ 541 542double complex ccos ( double complex z ) 543{ 544 double complex iz; 545 Real(iz) = -Imag(z); 546 Imag(iz) = Real(z); 547 return ccosh(iz); 548} 549 550float complex ccosf ( float complex z ) 551{ 552 float complex iz; 553 Real(iz) = -Imag(z); 554 Imag(iz) = Real(z); 555 return ccoshf(iz); 556} 557 558/**************************************************************************** 559 double complex csinh(double complex z) returns the complex hyperbolic sine of its 560 argument. The algorithm is based upon the identity: 561 562 sinh(x + i*y) = cos(y)*sinh(x) + i*sin(y)*cosh(x). 563 564 Signaling of spurious overflows, underflows, and invalids is avoided where 565 possible. 566 567 Calls: expm1, cosisin 568****************************************************************************/ 569 570double complex csinh ( double complex z ) 571{ 572 static const double INF = __builtin_inf(); 573 double complex w; 574 575 // Handle x = NaN first 576 if (Real(z) != Real(z)) { 577 Real(w) = Real(z); 578 if (Imag(z) == 0.0) // cexp(NaN + 0i) = NaN + 0i 579 Imag(w) = Imag(z); 580 else // cexp(NaN + yi) = NaN + NaNi, for y ≠ 0 581 Imag(w) = copysign(Real(z), Imag(z)); 582 return w; 583 } 584 585 // At this stage, x ≠ NaN. 586 double absx = __builtin_fabs(Real(z)); 587 double reducedx = absx; 588 589 cosisin(Imag(z), &w); // set w = cos y + i sin y. 590 Real(w) *= copysign(1.0, Real(z)); // w = signof(x) cos y + i sin y 591 592 // Handle x = ±∞ cases. 593 if ((absx == INF) && ((Imag(z) == INF) || (Imag(z) != Imag(z)) || (Imag(z) == 0.0))) { 594 Real(w) = copysign(INF, Real(z)); 595 return w; 596 } 597 598 // Handle x = 0 cases. 599 if (absx == 0.0) { 600 Real(w) = Real(z); // sign of zero needs to be right. 601 return w; 602 } 603 604 // Argument reduction, if need be. (x is now a finite non-zero number) 605 if ((reducedx < twiceExpOverflowThresh_d) && (reducedx > expOverflowThreshold_d)) { 606 reducedx -= expOverflowThreshold_d; // argument reduction, this is exact. 607 Real(w) *= expOverflowValue_d; // not exact, but good enough. 608 Imag(w) *= expOverflowValue_d; // ditto. 609 } 610 611 double exm1 = expm1(reducedx); // any overflow here is deserved. 612 613 if (absx < 0x1p-27) { // |x|^2 is less than an ulp of 1, so only the leading terms of the series for 614 Real(w) *= absx; // cosh = 1 + .... and sinh = x + .... has any effect on the result. 615 } 616 617 else if (absx > 19.0) { // if |x| > 19, then e^-x is less than an ulp of e^x, so the smaller term in 618 double halfExpX = 0.5 * (exm1 + 1.0); // cosh = (e^x + e^-x) / 2 has no effect, and similarly for 619 Real(w) *= halfExpX; // sinh = (e^x - e^-x) / 2. 620 // only scale the imag part if non-zero (to prevent NaN in overflow*zero) 621 if (Imag(z) != 0.0) Imag(w) *= halfExpX; 622 } 623 624 else { // the "normal" case, we need to be careful. 625 double twiceExpX = 2.0 * (exm1 + 1.0); 626 /* we use the following to get cosh(x): 627 * 628 * expm1(x)*expm1(x) 2e^x + e^(2x) - 2e^x + 1 e^x + e^-x 629 * 1 + ------------------- = -------------------------- = ------------ = cosh(x) 630 * 2*(1 + expm1(x)) 2e^x 2 631 */ 632 Imag(w) *= 1.0 + (exm1*exm1)/twiceExpX; 633 /* we use the following to get sinh(x) (up to sign): 634 * 635 * 1 / expm1(x) \ e^(2x) - e^x + e^x - 1 e^x - e^-x 636 * --- | expm1(x) + ------------- | = ------------------------ = ------------ = sinh(x) 637 * 2 \ 1 + expm1(x) / 2e^x 2 638 */ 639 Real(w) *= 0.5*exm1 + exm1/twiceExpX; 640 } 641 642 return w; 643} 644 645float complex csinhf ( float complex z ) 646{ 647 static const float INFf = __builtin_inff(); 648 static const double INF = __builtin_inf(); 649 float complex w; 650 double complex wd; 651 652 // Handle x = NaN first 653 if (Real(z) != Real(z)) { 654 Real(w) = Real(z); 655 if (Imag(z) == 0.0f) // cexp(NaN + 0i) = NaN + 0i 656 Imag(w) = Imag(z); 657 else // cexp(NaN + yi) = NaN + NaNi, for y ≠ 0 658 Imag(w) = copysignf(Real(z), Imag(z)); 659 return w; 660 } 661 662 // At this stage, x ≠ NaN. 663 double absx = (double)__builtin_fabsf(Real(z)); 664 665 cosisin((double)Imag(z), &wd); // set w = cos y + i sin y. 666 Real(wd) *= copysign(1.0, (double)Real(z)); // w = signof(x) cos y + i sin y 667 668 // Handle x = ±∞ cases. 669 if ((absx == INF) && ((Imag(z) == INFf) || (Imag(z) != Imag(z)) || (Imag(z) == 0.0f))) { 670 Real(w) = copysignf(INFf, Real(z)); 671 Imag(w) = (float)Imag(wd); 672 return w; 673 } 674 675 // Handle x = 0 cases. 676 if (absx == 0.0) { 677 Real(w) = Real(z); // sign of zero needs to be right. 678 Imag(w) = (float)Imag(wd); 679 return w; 680 } 681 682 double exm1 = expm1(absx); // any overflow here is deserved. 683 684 if (absx < 0x1p-27) { // |x|^2 is less than an ulp of 1, so only the leading terms of the series for 685 Real(wd) *= absx; // cosh = 1 + .... and sinh = x + .... has any effect on the result. 686 } 687 688 else if (absx > 19.0) { // if |x| > 19, then e^-x is less than an ulp of e^x, so the smaller term in 689 double halfExpX = 0.5 * (exm1 + 1.0); // cosh = (e^x + e^-x) / 2 has no effect, and similarly for 690 Real(wd) *= halfExpX; // sinh = (e^x - e^-x) / 2. 691 // only scale the imag part if non-zero (to prevent NaN in overflow*zero) 692 if (Imag(z) != 0.0f) Imag(wd) *= halfExpX; 693 } 694 695 else { // the "normal" case, we need to be careful. 696 double twiceExpX = 2.0 * (exm1 + 1.0); 697 /* we use the following to get cosh(x): 698 * 699 * expm1(x)*expm1(x) 2e^x + e^(2x) - 2e^x + 1 e^x + e^-x 700 * 1 + ------------------- = -------------------------- = ------------ = cosh(x) 701 * 2*(1 + expm1(x)) 2e^x 2 702 */ 703 Imag(wd) *= 1.0 + (exm1*exm1)/twiceExpX; 704 /* we use the following to get sinh(x) (up to sign): 705 * 706 * 1 / expm1(x) \ e^(2x) - e^x + e^x - 1 e^x - e^-x 707 * --- | expm1(x) + ------------- | = ------------------------ = ------------ = sinh(x) 708 * 2 \ 1 + expm1(x) / 2e^x 2 709 */ 710 Real(wd) *= 0.5*exm1 + exm1/twiceExpX; 711 } 712 713 Real(w) = (float)Real(wd); 714 Imag(w) = (float)Imag(wd); 715 return w; 716} 717 718/**************************************************************************** 719 double complex ccosh(double complex z) returns the complex hyperbolic cosine of its 720 argument. The algorithm is based upon the identity: 721 722 cosh(x + i*y) = cos(y)*cosh(x) + i*sin(y)*sinh(x). 723 724 Signaling of spurious overflows, underflows, and invalids is avoided where 725 possible. 726 727 Calls: expm1, cosisin 728****************************************************************************/ 729 730double complex ccosh ( double complex z ) 731{ 732 static const double INF = __builtin_inf(); 733 double complex w; 734 735 // Handle x = NaN first 736 if (Real(z) != Real(z)) { 737 Real(w) = Real(z); 738 if (Imag(z) == 0.0) // cexp(NaN + 0i) = NaN + 0i 739 Imag(w) = Imag(z); 740 else // cexp(NaN + yi) = NaN + NaNi, for y ≠ 0 741 Imag(w) = copysign(Real(z), Imag(z)); 742 return w; 743 } 744 745 // At this stage, x ≠ NaN. 746 double absx = __builtin_fabs(Real(z)); 747 double reducedx = absx; 748 749 cosisin(Imag(z), &w); // set w = cos y + i sin y. 750 Imag(w) *= copysign(1.0, Real(z)); // w = cos y + i sin y * signof(x) 751 752 // Handle x = ±∞ cases. 753 if ((absx == INF) && ((Imag(z) == INF) || (Imag(z) != Imag(z)) || (Imag(z) == 0.0))) { 754 Real(w) = INF; 755 return w; 756 } 757 758 // Handle x = 0 cases. 759 if (absx == 0.0) { 760 Imag(w) = Real(z) * copysign(1.0, Imag(z)); // finesse the sign of zero. 761 return w; 762 } 763 764 // Argument reduction, if need be. (x is now a finite non-zero number) 765 if ((reducedx < twiceExpOverflowThresh_d) && (reducedx > expOverflowThreshold_d)) { 766 reducedx -= expOverflowThreshold_d; // argument reduction, this is exact. 767 Real(w) *= expOverflowValue_d; // not exact, but good enough. 768 Imag(w) *= expOverflowValue_d; // ditto. 769 } 770 771 double exm1 = expm1(reducedx); // any overflow here is deserved. 772 773 if (absx < 0x1p-27) { // |x|^2 is less than an ulp of 1, so only the leading terms of the series for 774 Imag(w) *= absx; // cosh = 1 + .... and sinh = x + .... has any effect on the result. 775 } 776 777 else if (absx > 19.0) { // if |x| > 19, then e^-x is less than an ulp of e^x, so the smaller term in 778 double halfExpX = 0.5 * (exm1 + 1.0); // cosh = (e^x + e^-x) / 2 has no effect, and similarly for 779 Real(w) *= halfExpX; // sinh = (e^x - e^-x) / 2. 780 // only scale the imag part if non-zero (to prevent NaN in overflow*zero) 781 if (Imag(z) != 0.0) Imag(w) *= halfExpX; 782 } 783 784 else { // the "normal" case, we need to be careful. 785 double twiceExpX = 2.0 * (exm1 + 1.0); 786 /* we use the following to get cosh(x): 787 * 788 * expm1(x)*expm1(x) 2e^x + e^(2x) - 2e^x + 1 e^x + e^-x 789 * 1 + ------------------- = -------------------------- = ------------ = cosh(x) 790 * 2*(1 + expm1(x)) 2e^x 2 791 */ 792 Real(w) *= 1.0 + (exm1*exm1)/twiceExpX; 793 /* we use the following to get sinh(x) (up to sign): 794 * 795 * 1 / expm1(x) \ e^(2x) - e^x + e^x - 1 e^x - e^-x 796 * --- | expm1(x) + ------------- | = ------------------------ = ------------ = sinh(x) 797 * 2 \ 1 + expm1(x) / 2e^x 2 798 */ 799 Imag(w) *= 0.5*exm1 + exm1/twiceExpX; 800 } 801 802 return w; 803} 804 805float complex ccoshf ( float complex z ) 806{ 807 static const float INFf = __builtin_inff(); 808 static const double INF = __builtin_inf(); 809 double complex wd; 810 float complex w; 811 812 // Handle x = NaN first 813 if (Real(z) != Real(z)) { 814 Real(w) = Real(z); 815 if (Imag(z) == 0.0f) // cexp(NaN + 0i) = NaN + 0i 816 Imag(w) = Imag(z); 817 else // cexp(NaN + yi) = NaN + NaNi, for y ≠ 0 818 Imag(w) = copysignf(Real(z), Imag(z)); 819 return w; 820 } 821 822 // At this stage, x ≠ NaN. 823 double absx = (double)__builtin_fabsf(Real(z)); 824 825 cosisin((double)Imag(z), &wd); // set w = cos y + i sin y. 826 Imag(wd) *= copysign(1.0, (double)Real(z)); // w = cos y + i sin y * signof(x) 827 828 // Handle x = ±∞ cases. 829 if ((absx == INF) && ((Imag(z) == INFf) || (Imag(z) != Imag(z)) || (Imag(z) == 0.0f))) { 830 Real(w) = INFf; 831 Imag(w) = (float)Imag(wd); 832 return w; 833 } 834 835 // Handle x = 0 cases. 836 if (absx == 0.0) { 837 Imag(w) = Real(z) * copysignf(1.0f, Imag(z)); // finesse the sign of zero. 838 Real(w) = (float)Real(wd); 839 return w; 840 } 841 842 double exm1 = expm1(absx); // any overflow here is deserved. 843 844 if (absx < 0x1p-27) { // |x|^2 is less than an ulp of 1, so only the leading terms of the series for 845 Imag(wd) *= absx; // cosh = 1 + .... and sinh = x + .... has any effect on the result. 846 } 847 848 else if (absx > 19.0) { // if |x| > 19, then e^-x is less than an ulp of e^x, so the smaller term in 849 double halfExpX = 0.5 * (exm1 + 1.0); // cosh = (e^x + e^-x) / 2 has no effect, and similarly for 850 Real(wd) *= halfExpX; // sinh = (e^x - e^-x) / 2. 851 // only scale the imag part if non-zero (to prevent NaN in overflow*zero) 852 if (Imag(z) != 0.0) Imag(wd) *= halfExpX; 853 } 854 855 else { // the "normal" case, we need to be careful. 856 double twiceExpX = 2.0 * (exm1 + 1.0); 857 /* we use the following to get cosh(x): 858 * 859 * expm1(x)*expm1(x) 2e^x + e^(2x) - 2e^x + 1 e^x + e^-x 860 * 1 + ------------------- = -------------------------- = ------------ = cosh(x) 861 * 2*(1 + expm1(x)) 2e^x 2 862 */ 863 Real(wd) *= 1.0 + (exm1*exm1)/twiceExpX; 864 /* we use the following to get sinh(x) (up to sign): 865 * 866 * 1 / expm1(x) \ e^(2x) - e^x + e^x - 1 e^x - e^-x 867 * --- | expm1(x) + ------------- | = ------------------------ = ------------ = sinh(x) 868 * 2 \ 1 + expm1(x) / 2e^x 2 869 */ 870 Imag(wd) *= 0.5*exm1 + exm1/twiceExpX; 871 } 872 873 Real(w) = (float)Real(wd); 874 Imag(w) = (float)Imag(wd); 875 return w; 876} 877 878/**************************************************************************** 879 double complex cexp(double complex z) returns the complex exponential of its 880 argument. The algorithm is based upon the identity: 881 882 exp(x + i*y) = cos(y)*exp(x) + i*sin(y)*exp(x). 883 884 Signaling of spurious overflows and invalids is avoided where 885 possible. 886 887 CONSTANTS: expOverflowValue_d = exp(709.0) to double precision 888 889 Calls: cosisin and exp. 890****************************************************************************/ 891 892double complex cexp ( double complex z ) 893{ 894 static const double INF = __builtin_inf(); 895 double complex w; 896 897 // Handle x = NaN first 898 if (Real(z) != Real(z)) { 899 Real(w) = Real(z); 900 if (Imag(z) == 0.0) // cexp(NaN + 0i) = NaN + 0i 901 Imag(w) = Imag(z); 902 else // cexp(NaN + yi) = NaN + NaNi, for y ≠ 0 903 Imag(w) = copysign(Real(z), Imag(z)); 904 return w; 905 } 906 907 // Handle x = -∞, y = ∞ or NaN: 908 if ((Real(z) == -INF) && ((__builtin_fabs(Imag(z)) == INF) || (Imag(z) != Imag(z)))) { 909 Real(w) = 0.0; 910 Imag(w) = copysign(0.0, Imag(z)); 911 return w; 912 } 913 914 if (Imag(z) == 0.0) { // exact exp(x + 0i) case. 915 Real(w) = exp(Real(z)); 916 Imag(w) = 0.0; 917 return w; 918 } 919 920 // At this stage, x ≠ NaN, and extraordinary x = -∞ cases are sorted. y ≠ 0. 921 cosisin(Imag(z), &w); // set w = cos(y) + i sin(y) 922 923 // Handle x = +∞ cases. 924 if ((Real(z) == INF) && ((Imag(z) == INF) || (Imag(z) != Imag(z)))) { 925 Real(w) = INF; // cexp(∞ + yi) = ∞ + NaNi for y = NaN or ∞. 926 return w; // cexp(∞ + yi) for finite y falls through. 927 } 928 929 // At this point, x ≠ NaN, +inf, y ≠ 0, and all remaining cases fall through 930 double x = Real(z); 931 932 if ((x < twiceExpOverflowThresh_d) && (x > expOverflowThreshold_d)) { 933 x -= expOverflowThreshold_d; // argument reduction, this is exact. 934 Real(w) *= expOverflowValue_d; // not exact, but good enough. 935 Imag(w) *= expOverflowValue_d; // ditto. 936 } 937 938 double scale = exp(x); 939 Real(w) *= scale; 940 Imag(w) *= scale; 941 return w; 942} 943 944float complex cexpf ( float complex z ) 945{ 946 static const float INFf = __builtin_inff(); 947 float complex w; 948 949 // Handle x = NaN first 950 if (Real(z) != Real(z)) { 951 Real(w) = Real(z); 952 if (Imag(z) == 0.0f) // cexp(NaN + 0i) = NaN + 0i 953 Imag(w) = Imag(z); 954 else // cexp(NaN + yi) = NaN + NaNi, for y ≠ 0 955 Imag(w) = copysignf(Real(z), Imag(z)); 956 return w; 957 } 958 959 // Handle x = -∞, y = ∞ or NaN: 960 if ((Real(z) == -INFf) && ((__builtin_fabsf(Imag(z)) == INFf) || (Imag(z) != Imag(z)))) { 961 Real(w) = 0.0f; 962 Imag(w) = copysignf(0.0f, Imag(z)); 963 return w; 964 } 965 966 if (Imag(z) == 0.0f) { // exact exp(x + 0i) case. 967 Real(w) = expf(Real(z)); 968 Imag(w) = 0.0f; 969 return w; 970 } 971 972 double complex wd; 973 // At this stage, x ≠ NaN, and extraordinary x = -∞ cases are sorted. y ≠ 0. 974 cosisin((double)Imag(z), &wd); // set w = cos(y) + i sin(y) 975 976 // Handle x = +∞ cases. 977 if ((Real(z) == INFf) && ((Imag(z) == INFf) || (Imag(z) != Imag(z)))) { 978 Real(w) = INFf; // cexp(∞ + yi) = ∞ + NaNi for y = NaN or ∞. 979 Imag(w) = (float)Imag(wd); 980 return w; // cexp(∞ + yi) for finite y falls through. 981 } 982 983 // At this point, x ≠ NaN, +inf, y ≠ 0, and all remaining cases fall through 984 985 double scale = exp((double)Real(z)); 986 Real(w) = (float)(scale*Real(wd)); 987 Imag(w) = (float)(scale*Imag(wd)); 988 return w; 989} 990 991/**************************************************************************** 992 double complex cpow(double complex x, double complex y) returns the complex result of x^y. 993 The algorithm is based upon the identity: 994 995 x^y = cexp(y*clog(x)). 996 997 Calls: clog, cexp. 998****************************************************************************/ 999 1000double complex cpow ( double complex x, double complex y ) /* (complex x)^(complex y) */ 1001{ 1002 double complex logval,z; 1003 1004 logval = clog(x); /* complex logarithm of x */ 1005 Real(z) = Real(y)*Real(logval) - Imag(y)*Imag(logval); /* multiply by y */ 1006 Imag(z) = Real(y)*Imag(logval) + Imag(y)*Real(logval); 1007 return (cexp(z)); /* return complex exponential */ 1008} 1009 1010float complex cpowf ( float complex x, float complex y ) /* (complex x)^(complex y) */ 1011{ 1012 float complex logval,z; 1013 1014 logval = clogf(x); /* complex logarithm of x */ 1015 Real(z) = Real(y)*Real(logval) - Imag(y)*Imag(logval); /* multiply by y */ 1016 Imag(z) = Real(y)*Imag(logval) + Imag(y)*Real(logval); 1017 return (cexpf(z)); /* return complex exponential */ 1018} 1019 1020/**************************************************************************** 1021 double complex ctanh(double complex x) returns the complex hyperbolic tangent of its 1022 argument. The algorithm is from Kahan's paper and is based on the 1023 identity: 1024 1025 tanh(x+i*y) = (sinh(2*x) + i*sin(2*y))/(cosh(2*x) + cos(2*y)) 1026 = (cosh(x)*sinh(x)*cscsq + i*tan(y))/(1+cscsq*sinh(x)*sinh(x)), 1027 1028 where cscsq = 1/(cos(y)*cos(y). For large values of ze.re, spurious 1029 overflow and invalid signaling is avoided. 1030 1031 CONSTANTS: FPKASINHOM4 = asinh(nextafterd(+infinity,0.0))/4.0 to double 1032 precision 1033 FPKINF = +infinity 1034 1035 Calls: tan, sinh, sqrt, fabs, feholdexcept, feraiseexcept, feclearexcept, 1036 and feupdateenv. 1037****************************************************************************/ 1038 1039double complex ctanh( double complex z ) 1040{ 1041 static const double INF = __builtin_inf(); 1042 double x = __builtin_fabs(Real(z)); 1043 double y = __builtin_fabs(Imag(z)); 1044 double sinhval, coshval, tanval, exm1, cscsq; 1045 double complex w; 1046 1047 if (x == INF) { 1048 w = 1.0 + I*copysign(0.0, sin(2.0*y)); // ctanh(∞ + iy) = 1.0 ± i0 1049 } 1050 1051 else if (Imag(z) != Imag(z) || Real(z) != Real(z)) { 1052 if (Imag(z) == 0.0) { 1053 w = Real(z) + I*0.0; // ctanh(NaN + i0) = NaN + i0 1054 } else { 1055 Real(w) = Real(z) + Imag(z); // ctanh(NaN) = NaN + iNaN 1056 Imag(w) = Real(w); 1057 } 1058 } 1059 1060 else if (y == INF) { 1061 Real(w) = y - y; // ctanh(x + i∞) = NaN + iNaN (invalid) 1062 Imag(w) = Real(w); 1063 } 1064 1065 else if (x > 19.0) { 1066 w = 1.0 + I*copysign(0.0, sin(2.0*y)); // if x is big, tanh(z) = 1 ± i0 1067 } 1068 1069 else { // edge case free! 1070 tanval = tan(y); 1071 cscsq = 1.0 + tanval*tanval; // cscsq = 1/cos^2(y) 1072 1073 if (x < 0x1p-27) { 1074 coshval = 1.0; 1075 sinhval = x; 1076 } else { 1077 exm1 = expm1(x); 1078 coshval = 1.0 + 0.5*(exm1*exm1)/(exm1 + 1.0); 1079 sinhval = 0.5*(exm1 + exm1/(exm1 + 1.0)); 1080 } 1081 1082 Real(w) = cscsq * coshval * sinhval / (1.0 + cscsq * sinhval * sinhval); 1083 Imag(w) = tanval / (1.0 + cscsq * sinhval * sinhval); 1084 } 1085 1086 // Patch up signs of return value 1087 Real(w) = copysign(Real(w),Real(z)); 1088 Imag(w) *= copysign(1.0,Imag(z)); 1089 1090 return w; 1091} 1092 1093float complex ctanhf( float complex z ) 1094{ 1095 static const float INFf = __builtin_inff(); 1096 float x = __builtin_fabsf(Real(z)); 1097 float y = __builtin_fabsf(Imag(z)); 1098 double sinhval, coshval, tanval, exm1, cscsq; 1099 float complex w; 1100 1101 if (x == INFf) { 1102 w = 1.0f + I*copysignf(0.0f, sinf(2.0f*y)); // ctanh(∞ + iy) = 1.0 ± i0 1103 } 1104 1105 else if (Imag(z) != Imag(z) || Real(z) != Real(z)) { 1106 if (Imag(z) == 0.0f) { 1107 w = Real(z) + I*0.0f; // ctanh(NaN + i0) = NaN + i0 1108 } else { 1109 Real(w) = Real(z) + Imag(z); // ctanh(NaN) = NaN + iNaN 1110 Imag(w) = Real(w); 1111 } 1112 } 1113 1114 else if (y == INFf) { 1115 Real(w) = y - y; // ctanh(x + i∞) = NaN + iNaN (invalid) 1116 Imag(w) = Real(w); 1117 } 1118 1119 else if (x > 19.0f) { 1120 w = 1.0f + I*copysignf(0.0f, sinf(2.0f*y)); // if x is big, tanh(z) = 1 ± i0 1121 } 1122 1123 else { // edge case free! 1124 tanval = (double)tanf(y); 1125 cscsq = 1.0 + tanval*tanval; // cscsq = 1/cos^2(y) 1126 1127 if (x < 0x1p-13f) { 1128 coshval = 1.0; 1129 sinhval = x; 1130 } else { 1131 exm1 = (double)expm1f(x); 1132 coshval = 1.0 + 0.5*(exm1*exm1)/(exm1 + 1.0); 1133 sinhval = 0.5*(exm1 + exm1/(exm1 + 1.0)); 1134 } 1135 1136 Real(w) = (float)(cscsq * coshval * sinhval / (1.0 + cscsq * sinhval * sinhval)); 1137 Imag(w) = (float)(tanval / (1.0 + cscsq * sinhval * sinhval)); 1138 } 1139 1140 // Patch up signs of return value 1141 Real(w) = copysignf(Real(w),Real(z)); 1142 Imag(w) *= copysignf(1.0f,Imag(z)); 1143 1144 return w; 1145} 1146 1147/**************************************************************************** 1148 double complex ctan(double complex x) returns the complex hyperbolic tangent of its 1149 argument. Per C99, 1150 1151 i ctan(z) = ctanh(iz) 1152 1153 Calls: ctanh 1154****************************************************************************/ 1155 1156double complex ctan( double complex z ) 1157{ 1158 double complex iz, iw, w; 1159 Real(iz) = -Imag(z); 1160 Imag(iz) = Real(z); 1161 iw = ctanh(iz); 1162 Real(w) = Imag(iw); 1163 Imag(w) = -Real(iw); 1164 return w; 1165} 1166 1167float complex ctanf( float complex z ) 1168{ 1169 float complex iz, iw, w; 1170 Real(iz) = -Imag(z); 1171 Imag(iz) = Real(z); 1172 iw = ctanhf(iz); 1173 Real(w) = Imag(iw); 1174 Imag(w) = -Real(iw); 1175 return w; 1176} 1177 1178/**************************************************************************** 1179 double complex casin(double complex z) returns the complex inverse sine of its 1180 argument. The algorithm is from Kahan's paper and is based on the 1181 formulae: 1182 1183 real(casin(z)) = atan (real(z)/real(csqrt(1.0-z)*csqrt(1.0+z))) 1184 imag(casin(z)) = arcsinh(imag(csqrt(1.0-cconj(z))*csqrt(1.0+z))) 1185 1186 Calls: arcsinh, csqrt, atan, feholdexcept, feclearexcept, feupdateenv. 1187****************************************************************************/ 1188 1189double complex casin ( double complex z ) 1190{ 1191 double complex iz, iw, w; 1192 Real(iz) = -Imag(z); 1193 Imag(iz) = Real(z); 1194 iw = casinh(iz); 1195 Real(w) = Imag(iw); 1196 Imag(w) = -Real(iw); 1197 return w; 1198} 1199 1200float complex casinf ( float complex z ) 1201{ 1202 float complex iz, iw, w; 1203 Real(iz) = -Imag(z); 1204 Imag(iz) = Real(z); 1205 iw = casinhf(iz); 1206 Real(w) = Imag(iw); 1207 Imag(w) = -Real(iw); 1208 return w; 1209} 1210 1211/**************************************************************************** 1212 double complex casinh(double complex z) returns the complex inverse hyperbolic sine of 1213 its argument. We compute the function only in the upper-right quadrant of the complex 1214 plane, and use the facts that casinh(conj(z)) = conj(casinh(z)) and casinh is odd to 1215 get the values on the rest of the plane. 1216 1217 within the upper-right quadrant, we use: 1218 1219 casinh(z) = z if |z| is small, 1220 ln(2z) if |z| is big, 1221 and a rather complicated expression for other values of z. 1222 1223 Calls: asinh, csqrt, atan2. 1224****************************************************************************/ 1225 1226double complex casinh ( double complex z ) 1227{ 1228 static const double INF = __builtin_inf(); 1229 static const double ln2 = 0x1.62e42fefa39ef358p-1; 1230 static const double sqrt1_2 = 0x1.6a09e667f3bcc908p-1; 1231 double complex w; 1232 double x = __builtin_fabs(Real(z)); 1233 double y = __builtin_fabs(Imag(z)); 1234 double u, xSquared, tmp; 1235 double complex sqrt1Plusiz, sqrt1PlusizBar; 1236 1237 // If |z| == inf, then casinh(z) = inf + carg(z) 1238 if ((x == INF) || (y == INF)) { 1239 Real(w) = INF; 1240 Imag(w) = atan2(y,x); 1241 } 1242 1243 // If z = NaN, casinh(z) = NaN, with the special case that casinh(NaN + i0) = NaN + i0. 1244 else if ((x != x) || (y != y)) { 1245 if (y == 0.0) 1246 w = z; 1247 else { 1248 Real(w) = x + y; 1249 Imag(w) = x + y; 1250 } 1251 } 1252 1253 // at this point x,y are finite, non-nan. 1254 else { 1255 // If z is small, then casinh(z) = z - z^3/6 + ... = z within half an ulp 1256 if ((x < 0x1p-27) && (y < 0x1p-27)) { 1257 Real(w) = x; 1258 Imag(w) = y; 1259 } 1260 1261 // If z is big, then casinh(z) = log2 + log(z) + terms smaller than half an ulp 1262 else if ((x > 0x1p27) || (y > 0x1p27)) { 1263 w = clog(x + I*y); 1264 Real(w) += ln2; 1265 } 1266 1267 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 1268 * 1269 * Derivation of these formulats boggles the mind, but they are easily verified with the 1270 * Monodromy theorem. 1271 */ 1272 else { 1273 // Compute sqrt1Plusiz = sqrt(1-y + ix) 1274 u = 1.0 - y; 1275 xSquared = (x < 0x1p-106 ? 0.0 : x*x); // Avoid underflows. Faster via mask? 1276 1277 if (u == 0.0) { 1278 Real(sqrt1Plusiz) = sqrt1_2 * __builtin_sqrt(x); // Avoid spurious underflows in this case 1279 Imag(sqrt1Plusiz) = Real(sqrt1Plusiz); // by using the simpler formula. 1280 } 1281 1282 else { // No underflow or overflow is possible. 1283 Real(sqrt1Plusiz) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + xSquared) + __builtin_fabs(u))); 1284 tmp = 0.5 * (x / Real(sqrt1Plusiz)); 1285 1286 if (u < 0.0) { 1287 Imag(sqrt1Plusiz) = Real(sqrt1Plusiz); 1288 Real(sqrt1Plusiz) = tmp; 1289 } else { 1290 Imag(sqrt1Plusiz) = tmp; 1291 } 1292 } 1293 1294 // Compute sqrt1PlusizBar = sqrt(1+y + ix). No underflow or overflow is possible. 1295 u = 1.0 + y; 1296 Real(sqrt1PlusizBar) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + xSquared) + u)); 1297 Imag(sqrt1PlusizBar) = x / (2.0*Real(sqrt1PlusizBar)); 1298 1299 // Magic formulas from Kahan. 1300 Real(w) = asinh(Real(sqrt1Plusiz)*Imag(sqrt1PlusizBar) + Imag(sqrt1Plusiz)*Real(sqrt1PlusizBar)); 1301 Imag(w) = atan2(y, Real(sqrt1Plusiz)*Real(sqrt1PlusizBar) + Imag(sqrt1Plusiz)*Imag(sqrt1PlusizBar)); 1302 } 1303 } 1304 1305 // Patch up signs to handle z in quadrants II - IV, using symmetry. 1306 Real(w) = copysign(Real(w), Real(z)); 1307 Imag(w) = copysign(Imag(w), Imag(z)); 1308 1309 return w; 1310} 1311 1312float complex casinhf ( float complex z ) 1313{ 1314 static const float INFf = __builtin_inff(); 1315 static const float ln2f = 0x1.62e42fefa39ef358p-1f; 1316 static const float sqrt1_2f = 0x1.6a09e667f3bcc908p-1f; 1317 float complex w; 1318 float x = __builtin_fabsf(Real(z)); 1319 float y = __builtin_fabsf(Imag(z)); 1320 float u, xSquared, tmp; 1321 float complex sqrt1Plusiz, sqrt1PlusizBar; 1322 1323 // If |z| == inf, then casinh(z) = inf + carg(z) 1324 if ((x == INFf) || (y == INFf)) { 1325 Real(w) = INFf; 1326 Imag(w) = atan2f(y,x); 1327 } 1328 1329 // If z = NaN, casinh(z) = NaN, with the special case that casinh(NaN + i0) = NaN + i0. 1330 else if ((x != x) || (y != y)) { 1331 if (y == 0.0f) 1332 w = z; 1333 else { 1334 Real(w) = x + y; 1335 Imag(w) = x + y; 1336 } 1337 } 1338 1339 // at this point x,y are finite, non-nan. 1340 else { 1341 // If z is small, then casinhf(z) = z - z^3/6 + ... = z within half an ulp 1342 if ((x < 0x1p-13f) && (y < 0x1p-13f)) { 1343 Real(w) = x; 1344 Imag(w) = y; 1345 } 1346 1347 // If z is big, then casinh(z) = log2 + log(z) + terms smaller than half an ulp 1348 else if ((x > 0x1p13f) || (y > 0x1p13f)) { 1349 w = clogf(x + I*y); 1350 Real(w) += ln2f; 1351 } 1352 1353 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 1354 * 1355 * Derivation of these formulats boggles the mind, but they are easily verified with the 1356 * Monodromy theorem. 1357 */ 1358 else { 1359 // Compute sqrt1Plusiz = sqrt(1-y + ix) 1360 u = 1.0f - y; 1361 xSquared = (x < 0x1p-52f ? 0.0f : x*x); // Avoid underflows. Faster via mask? 1362 1363 if (u == 0.0f) { 1364 Real(sqrt1Plusiz) = sqrt1_2f * __builtin_sqrtf(x); // Avoid spurious underflows in this case 1365 Imag(sqrt1Plusiz) = Real(sqrt1Plusiz); // by using the simpler formula. 1366 } 1367 1368 else { // No underflow or overflow is possible. 1369 Real(sqrt1Plusiz) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + xSquared) + __builtin_fabsf(u))); 1370 tmp = 0.5f * (x / Real(sqrt1Plusiz)); 1371 1372 if (u < 0.0f) { 1373 Imag(sqrt1Plusiz) = Real(sqrt1Plusiz); 1374 Real(sqrt1Plusiz) = tmp; 1375 } else { 1376 Imag(sqrt1Plusiz) = tmp; 1377 } 1378 } 1379 1380 // Compute sqrt1PlusizBar = sqrt(1+y + ix). No underflow or overflow is possible. 1381 u = 1.0f + y; 1382 Real(sqrt1PlusizBar) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + xSquared) + u)); 1383 Imag(sqrt1PlusizBar) = x / (2.0f*Real(sqrt1PlusizBar)); 1384 1385 // Magic formulas from Kahan. 1386 Real(w) = asinhf(Real(sqrt1Plusiz)*Imag(sqrt1PlusizBar) + Imag(sqrt1Plusiz)*Real(sqrt1PlusizBar)); 1387 Imag(w) = atan2f(y, Real(sqrt1Plusiz)*Real(sqrt1PlusizBar) + Imag(sqrt1Plusiz)*Imag(sqrt1PlusizBar)); 1388 } 1389 } 1390 1391 // Patch up signs to handle z in quadrants II - IV, using symmetry. 1392 Real(w) = copysignf(Real(w), Real(z)); 1393 Imag(w) = copysignf(Imag(w), Imag(z)); 1394 1395 return w; 1396} 1397 1398/**************************************************************************** 1399 double complex cacos(double complex z) returns the complex inverse cosine of its 1400 argument. The algorithm is from Kahan's paper and is based on the 1401 formulae: 1402 1403 real(cacos(z)) = 2.0*atan(real(csqrt(1.0-z)/real(csqrt(1.0+z)))) 1404 imag(cacos(z)) = arcsinh(imag(csqrt(1.0-z)*csqrt(cconj(1.0+z)))) 1405 1406 Calls: arcsinh, csqrt, atan, feholdexcept, feclearexcept, feupdateenv. 1407****************************************************************************/ 1408 1409double complex cacos ( double complex z ) 1410{ 1411 static const double INF = __builtin_inf(); 1412 static const double ln2 = 0x1.62e42fefa39ef358p-1; 1413 static const double sqrt1_2 = 0x1.6a09e667f3bcc908p-1; 1414 static const double pi2 = 0x1.921fb54442d1846ap0; 1415 1416 double complex w; 1417 double x = __builtin_fabs(Real(z)); 1418 double y = __builtin_fabs(Imag(z)); 1419 double u, ySquared, tmp; 1420 double complex sqrt1Plusz, sqrt1Minusz; 1421 1422 // If |z| == inf, then cacos(z) = carg(z) - inf * I 1423 if ((x == INF) || (y == INF)) { 1424 Imag(w) = -INF; 1425 Real(w) = atan2(y,x); 1426 } 1427 1428 // If z = NaN, cacos(z) = NaN, with the special case that cacos(0 + iNaN) = π/2 + iNaN. 1429 else if ((x != x) || (y != y)) { 1430 if (x == 0.0) 1431 Real(w) = pi2; 1432 else 1433 Real(w) = x + y; 1434 Imag(w) = x + y; 1435 } 1436 1437 // at this point x,y are finite, non-nan. 1438 else { 1439 // If z is small, then cacos(z) = π/2 - z + z^3/6 + ... = π/2 - z within half an ulp 1440 if ((x < 0x1p-27) && (y < 0x1p-27)) { 1441 Real(w) = pi2 - x; 1442 Imag(w) = -y; 1443 } 1444 1445 // If z is big, then cacos(z) = -i * (log2 + log(z)) + terms smaller than half an ulp 1446 else if ((x > 0x1p27) || (y > 0x1p27)) { 1447 w = -I*(clog(x + I*y) + ln2); 1448 } 1449 1450 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 1451 * 1452 * Real(w) = 2*atan2( Re(sqrt(1-z)), Re(sqrt(1+z)) ) 1453 * Imag(w) = asinh( Im( sqrt(1-z)*sqrt(1+conj(z)) ) ) 1454 * 1455 * Derivation of these formulats boggles the mind, but they are easily verified with the 1456 * Monodromy theorem. Analysis of roundoff is a bit harder, but goes though just fine. 1457 */ 1458 else { 1459 ySquared = (y < 0x1p-106 ? 0.0 : y*y); // Avoid underflows. Faster via mask? 1460 1461 // Compute sqrt1Plusz = sqrt(1+x + iy) 1462 u = 1.0 + x; 1463 Real(sqrt1Plusz) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + ySquared) + u)); 1464 Imag(sqrt1Plusz) = 0.5 * (y / Real(sqrt1Plusz)); 1465 1466 // Compute sqrt1Minusz = sqrt(1-x - iy) 1467 u = 1.0 - x; 1468 1469 if (u == 0.0) { 1470 Real(sqrt1Minusz) = sqrt1_2 * __builtin_sqrt(y); // Avoid spurious underflows in this case 1471 Imag(sqrt1Minusz) = -Real(sqrt1Minusz); // by using the simpler formula. 1472 } 1473 1474 else { // No underflow or overflow is possible. 1475 Real(sqrt1Minusz) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + ySquared) + __builtin_fabs(u))); 1476 tmp = 0.5 * (y / Real(sqrt1Minusz)); 1477 1478 if (u < 0.0) { 1479 Imag(sqrt1Minusz) = -Real(sqrt1Minusz); 1480 Real(sqrt1Minusz) = tmp; 1481 } else { 1482 Imag(sqrt1Minusz) = -tmp; 1483 } 1484 } 1485 1486 // Magic formulas from Kahan. 1487 Real(w) = 2.0 * atan2(Real(sqrt1Minusz), Real(sqrt1Plusz)); 1488 Imag(w) = asinh( Real(sqrt1Plusz)*Imag(sqrt1Minusz) - Imag(sqrt1Plusz)*Real(sqrt1Minusz) ); 1489 } 1490 } 1491 1492 // Patch up signs to handle z in quadrants II, III & IV, using symmetry. 1493 Imag(w) = copysign(Imag(w), -Imag(z)); 1494 1495 if (Real(z) < 0.0) 1496 Real(w) = 2.0 * pi2 - Real(w); // No undue cancellation is possible here - Real(w) < π/2. 1497 1498 return w; 1499} 1500 1501float complex cacosf ( float complex z ) 1502{ 1503 static const float INFf = __builtin_inff(); 1504 static const float ln2f = 0x1.62e42fefa39ef358p-1f; 1505 static const float pi2f = 0x1.921fb54442d1846ap0f; 1506 static const float sqrt1_2f = 0x1.6a09e667f3bcc908p-1f; 1507 1508 float complex w; 1509 float x = __builtin_fabsf(Real(z)); 1510 float y = __builtin_fabsf(Imag(z)); 1511 float u, ySquared, tmp; 1512 float complex sqrt1Plusz, sqrt1Minusz; 1513 1514 // If |z| == inf, then cacos(z) = carg(z) - inf i 1515 if ((x == INFf) || (y == INFf)) { 1516 Imag(w) = -INFf; 1517 Real(w) = atan2f(y,x); 1518 } 1519 1520 // If z = NaN, cacos(z) = NaN, with the special case that cacos(0 + iNaN) = π/2 + iNaN. 1521 else if ((x != x) || (y != y)) { 1522 1523 if (x == 0.0f) 1524 Real(w) = pi2f; 1525 else 1526 Real(w) = x + y; 1527 1528 Imag(w) = x + y; 1529 } 1530 1531 // at this point x,y are finite, non-nan. 1532 else { 1533 // If z is small, then cacos(z) = π/2 - z + z^3/6 + ... = π/2 - z within half an ulp 1534 if ((x < 0x1p-13f) && (y < 0x1p-13f)) { 1535 Real(w) = pi2f - x; 1536 Imag(w) = -y; 1537 } 1538 1539 // If z is big, then cacos(z) = -i * (log2 + log(z)) + terms smaller than half an ulp 1540 else if ((x > 0x1p13f) || (y > 0x1p13f)) { 1541 w = -I*(clogf(x + I*y) + ln2f); 1542 } 1543 1544 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 1545 * 1546 * Real(w) = 2*atan2( Re(sqrt(1-z)), Re(sqrt(1+z)) ) 1547 * Imag(w) = asinh( Im( sqrt(1-z)*sqrt(1+conj(z)) ) ) 1548 * 1549 * Derivation of these formulats boggles the mind, but they are easily verified with the 1550 * Monodromy theorem. Analysis of roundoff is a bit harder, but goes though just fine. 1551 */ 1552 else { 1553 ySquared = (y < 0x1p-52f ? 0.0f : y*y); // Avoid underflows. Faster via mask? 1554 1555 // Compute sqrt1Plusz = sqrt(1+x + iy) 1556 u = 1.0f + x; 1557 Real(sqrt1Plusz) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + ySquared) + u)); 1558 Imag(sqrt1Plusz) = 0.5f * (y / Real(sqrt1Plusz)); 1559 1560 // Compute sqrt1Minusz = sqrt(1-x - iy) 1561 u = 1.0f - x; 1562 1563 if (u == 0.0f) { 1564 Real(sqrt1Minusz) = sqrt1_2f * __builtin_sqrtf(y); 1565 Imag(sqrt1Minusz) = -Real(sqrt1Minusz); 1566 } 1567 1568 else { 1569 Real(sqrt1Minusz) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + ySquared) + __builtin_fabsf(u))); 1570 tmp = 0.5f * (y / Real(sqrt1Minusz)); 1571 1572 if (u < 0.0f) { 1573 Imag(sqrt1Minusz) = -Real(sqrt1Minusz); 1574 Real(sqrt1Minusz) = tmp; 1575 } else { 1576 Imag(sqrt1Minusz) = -tmp; 1577 } 1578 } 1579 1580 // Magic formulas from Kahan. 1581 Real(w) = 2.0f * atan2f(Real(sqrt1Minusz),Real(sqrt1Plusz)); 1582 Imag(w) = asinhf( Real(sqrt1Plusz)*Imag(sqrt1Minusz) - Imag(sqrt1Plusz)*Real(sqrt1Minusz) ); 1583 } 1584 } 1585 1586 // Patch up signs to handle z in quadrants II, III & IV, using symmetry. 1587 Imag(w) = copysignf(Imag(w), -Imag(z)); 1588 1589 if (Real(z) < 0.0f) 1590 Real(w) = 2.0f * pi2f - Real(w); // No undue cancellation is possible here - Real(w) < π/2. 1591 1592 return w; 1593} 1594 1595/**************************************************************************** 1596 double complex cacosh(double complex z) returns the complex inverse hyperbolic`cosine 1597 of its argument. The algorithm is from Kahan's paper and is based on the 1598 formulae: 1599 1600 real(cacosh(z)) = arcsinh(real(csqrt(cconj(z)-1.0)*csqrt(z+1.0))) 1601 imag(cacosh(z)) = 2.0*atan(imag(csqrt(z-1.0)/real(csqrt(z+1.0)))) 1602 1603 Calls: arcsinh, csqrt, atan, feholdexcept, feclearexcept, feupdateenv. 1604****************************************************************************/ 1605 1606double complex cacosh ( double complex z ) 1607{ 1608 static const double INF = __builtin_inf(); 1609 static const double ln2 = 0x1.62e42fefa39ef358p-1; 1610 static const double sqrt1_2 = 0x1.6a09e667f3bcc908p-1; 1611 static const double pi2 = 0x1.921fb54442d1846ap0; 1612 1613 double complex w; 1614 double x = __builtin_fabs(Real(z)); 1615 double y = __builtin_fabs(Imag(z)); 1616 double u, ySquared, tmp; 1617 double complex sqrtzPlus1, sqrtzMinus1; 1618 1619 // If |z| == inf, then cacosh(z) = inf + carg(z) * I 1620 if ((x == INF) || (y == INF)) { 1621 Imag(w) = atan2(y,x); 1622 Real(w) = INF; 1623 } 1624 1625 // If z = NaN, cacosh(z) = NaN. 1626 else if ((x != x) || (y != y)) { 1627 Real(w) = x + y; 1628 Imag(w) = x + y; 1629 } 1630 1631 // at this point x,y are finite, non-nan. 1632 else { 1633 // If z is small, then cacosh(z) = I*(π/2 - z + z^3/6 + ...) = I*(π/2 - z) within half an ulp 1634 if ((x < 0x1p-27) && (y < 0x1p-27)) { 1635 Real(w) = y; 1636 Imag(w) = pi2 - x; 1637 } 1638 1639 // If z is big, then cacosh(z) = (log2 + log(z)) + terms smaller than half an ulp 1640 else if ((x > 0x1p27) || (y > 0x1p27)) { 1641 w = clog(x + I*y) + ln2; 1642 } 1643 1644 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 1645 * 1646 * Real(w) = asinh(real(csqrt(cconj(z)-1.0)*csqrt(z+1.0))) 1647 * Imag(w) = 2.0*atan2(imag(csqrt(z-1.0))/real(csqrt(z+1.0))) 1648 * 1649 * Derivation of these formulats boggles the mind, but they are easily verified with the 1650 * Monodromy theorem. Analysis of roundoff is a bit harder, but goes though just fine. 1651 */ 1652 else { 1653 ySquared = (y < 0x1p-106 ? 0.0 : y*y); // Avoid underflows. Faster via mask? 1654 1655 // Compute sqrt1Plusz = sqrt(x+1 + iy) 1656 u = x + 1.0; 1657 Real(sqrtzPlus1) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + ySquared) + u)); 1658 Imag(sqrtzPlus1) = 0.5 * (y / Real(sqrtzPlus1)); 1659 1660 // Compute sqrt1Minusz = sqrt(x-1 + iy) 1661 u = x - 1.0; 1662 1663 if (u == 0.0) { 1664 Real(sqrtzMinus1) = sqrt1_2 * __builtin_sqrt(y); // Avoid spurious underflows in this case 1665 Imag(sqrtzMinus1) = Real(sqrtzMinus1); // by using the simpler formula. 1666 } 1667 1668 else { // No underflow or overflow is possible. 1669 Real(sqrtzMinus1) = __builtin_sqrt(0.5*(__builtin_sqrt(u*u + ySquared) + __builtin_fabs(u))); 1670 tmp = 0.5 * (y / Real(sqrtzMinus1)); 1671 1672 if (u < 0.0) { 1673 Imag(sqrtzMinus1) = Real(sqrtzMinus1); 1674 Real(sqrtzMinus1) = tmp; 1675 } else { 1676 Imag(sqrtzMinus1) = tmp; 1677 } 1678 } 1679 1680 // Magic formulas from Kahan. 1681 Real(w) = asinh( Real(sqrtzPlus1)*Real(sqrtzMinus1) + Imag(sqrtzPlus1)*Imag(sqrtzMinus1) ); 1682 Imag(w) = 2.0*atan2( Imag(sqrtzMinus1) , Real(sqrtzPlus1) ); 1683 } 1684 } 1685 1686 // Patch up signs to handle z in quadrants II, III & IV, using symmetry. 1687 if (Real(z) < 0.0) 1688 Imag(w) = 2.0 * pi2 - Imag(w); // No undue cancellation is possible here - Real(w) < π/2. 1689 1690 Imag(w) = copysign(Imag(w), Imag(z)); 1691 1692 return w; 1693} 1694 1695float complex cacoshf ( float complex z ) 1696{ 1697 static const float INFf = __builtin_inff(); 1698 static const float ln2f = 0x1.62e42fefa39ef358p-1f; 1699 static const float sqrt1_2f = 0x1.6a09e667f3bcc908p-1f; 1700 static const float pi2f = 0x1.921fb54442d1846ap0f; 1701 1702 float complex w; 1703 float x = __builtin_fabsf(Real(z)); 1704 float y = __builtin_fabsf(Imag(z)); 1705 float u, ySquared, tmp; 1706 float complex sqrtzPlus1, sqrtzMinus1; 1707 1708 // If |z| == inf, then cacosh(z) = inf + carg(z) * I 1709 if ((x == INFf) || (y == INFf)) { 1710 Imag(w) = atan2f(y,x); 1711 Real(w) = INFf; 1712 } 1713 1714 // If z = NaN, cacosh(z) = NaN. 1715 else if ((x != x) || (y != y)) { 1716 Real(w) = x + y; 1717 Imag(w) = x + y; 1718 } 1719 1720 // at this point x,y are finite, non-nan. 1721 else { 1722 // If z is small, then cacosh(z) = I*(π/2 - z + z^3/6 + ...) = I*(π/2 - z) within half an ulp 1723 if ((x < 0x1p-13f) && (y < 0x1p-13f)) { 1724 Real(w) = y; 1725 Imag(w) = pi2f - x; 1726 } 1727 1728 // If z is big, then cacosh(z) = (log2 + log(z)) + terms smaller than half an ulp 1729 else if ((x > 0x1p13f) || (y > 0x1p13f)) { 1730 w = clogf(x + I*y) + ln2f; 1731 } 1732 1733 /* Otherwise, use the expressions from Kahan's "Much ado about nothing's sign bit..." 1734 * 1735 * Real(w) = asinh(real(csqrt(cconj(z)-1.0)*csqrt(z+1.0))) 1736 * Imag(w) = 2.0*atan2(imag(csqrt(z-1.0))/real(csqrt(z+1.0))) 1737 * 1738 * Derivation of these formulats boggles the mind, but they are easily verified with the 1739 * Monodromy theorem. Analysis of roundoff is a bit harder, but goes though just fine. 1740 */ 1741 else { 1742 ySquared = (y < 0x1p-52f ? 0.0f : y*y); // Avoid underflows. Faster via mask? 1743 1744 // Compute sqrt1Plusz = sqrt(x+1 + iy) 1745 u = x + 1.0f; 1746 Real(sqrtzPlus1) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + ySquared) + u)); 1747 Imag(sqrtzPlus1) = 0.5f * (y / Real(sqrtzPlus1)); 1748 1749 // Compute sqrt1Minusz = sqrt(x-1 + iy) 1750 u = x - 1.0f; 1751 1752 if (u == 0.0f) { 1753 Real(sqrtzMinus1) = sqrt1_2f * __builtin_sqrtf(y); // Avoid spurious underflows in this case 1754 Imag(sqrtzMinus1) = Real(sqrtzMinus1); // by using the simpler formula. 1755 } 1756 1757 else { // No underflow or overflow is possible. 1758 Real(sqrtzMinus1) = __builtin_sqrtf(0.5f*(__builtin_sqrtf(u*u + ySquared) + __builtin_fabsf(u))); 1759 tmp = 0.5f * (y / Real(sqrtzMinus1)); 1760 1761 if (u < 0.0f) { 1762 Imag(sqrtzMinus1) = Real(sqrtzMinus1); 1763 Real(sqrtzMinus1) = tmp; 1764 } else { 1765 Imag(sqrtzMinus1) = tmp; 1766 } 1767 } 1768 1769 // Magic formulas from Kahan. 1770 Real(w) = asinhf( Real(sqrtzPlus1)*Real(sqrtzMinus1) + Imag(sqrtzPlus1)*Imag(sqrtzMinus1) ); 1771 Imag(w) = 2.0f*atan2f( Imag(sqrtzMinus1) , Real(sqrtzPlus1) ); 1772 } 1773 } 1774 1775 // Patch up signs to handle z in quadrants II, III & IV, using symmetry. 1776 if (Real(z) < 0.0f) 1777 Imag(w) = 2.0f * pi2f - Imag(w); // No undue cancellation is possible here - Real(w) < π/2. 1778 1779 Imag(w) = copysignf(Imag(w), Imag(z)); 1780 1781 return w; 1782} 1783 1784/**************************************************************************** 1785 double complex catan(double complex z) returns the complex inverse tangent 1786 of its argument. The algorithm is from Kahan's paper and is based on 1787 the formula: 1788 1789 catan(z) = i*(clog(1.0-i*z) - clog(1+i*z))/2.0. 1790 1791 CONSTANTS: FPKTHETA = sqrt(nextafterd(+INF,0.0))/4.0 1792 FPKRHO = 1.0/FPKTHETA 1793 FPKPI2 = pi/2.0 1794 FPKPI = pi 1795 1796 Calls: copysign, fabs, xdivc, sqrt, log, atan, log1p, and carg. 1797****************************************************************************/ 1798 1799double complex catan ( double complex z ) 1800{ 1801 double complex iz, iw, w; 1802 Real(iz) = -Imag(z); 1803 Imag(iz) = Real(z); 1804 iw = catanh(iz); 1805 Real(w) = Imag(iw); 1806 Imag(w) = -Real(iw); 1807 return w; 1808} 1809 1810float complex catanf ( float complex z ) 1811{ 1812 float complex iz, iw, w; 1813 Real(iz) = -Imag(z); 1814 Imag(iz) = Real(z); 1815 iw = catanhf(iz); 1816 Real(w) = Imag(iw); 1817 Imag(w) = -Real(iw); 1818 return w; 1819} 1820 1821/**************************************************************************** 1822 double complex catanh(double complex z) returns the complex inverse hyperbolic tangent 1823 of its argument. The algorithm is from Kahan's paper and is based on 1824 the formula: 1825 1826 catanh(z) = (clog(1.0 + z) - clog(1 - z))/2.0. 1827 1828 CONSTANTS: FPKTHETA = sqrt(nextafterd(+INF,0.0))/4.0 1829 FPKRHO = 1.0/FPKTHETA 1830 FPKPI2 = pi/2.0 1831 FPKPI = pi 1832 1833 Calls: copysign, fabs, xdivc, sqrt, log, atan, log1p, and carg. 1834****************************************************************************/ 1835 1836double complex catanh( double complex z ) 1837{ 1838 double complex ctemp, w; 1839 double t1, t2, xi, eta, beta; 1840 1841 beta = copysign(1.0,Real(z)); /* copes with unsigned zero */ 1842 1843 Imag(z) = -beta*Imag(z); /* transform real & imag components */ 1844 Real(z) = beta*Real(z); 1845 1846 if ((Real(z) > FPKTHETA) || (fabs(Imag(z)) > FPKTHETA)) { 1847 eta = copysign(M_PI_2,Imag(z)); /* avoid overflow */ 1848 ctemp = xdivc(1.0,z); 1849 xi = Real(ctemp); 1850 } 1851 1852 else if (Real(z) == 1.0) { 1853 t1 = fabs(Imag(z)) + FPKRHO; 1854 xi = log(sqrt(sqrt(4.0 + t1*t1))/sqrt(fabs(Imag(z)))); 1855 eta = 0.5*copysign(M_PI-atan(2.0/(fabs(Imag(z))+FPKRHO)),Imag(z)); 1856 } 1857 1858 else { /* usual case */ 1859 t2 = fabs(Imag(z)) + FPKRHO; 1860 t1 = 1.0 - Real(z); 1861 t2 = t2*t2; 1862 xi = 0.25*log1p(4.0*Real(z)/(t1*t1 + t2)); 1863 Real(ctemp) = (1.0 - Real(z))*(1.0 + Real(z)) - t2; 1864 Imag(ctemp) = Imag(z) + Imag(z); 1865 eta = 0.5*carg(ctemp); 1866 } 1867 1868 Real(w) = beta*xi; /* fix up signs of result */ 1869 Imag(w) = -beta*eta; 1870 return w; 1871} 1872 1873float complex catanhf( float complex z ) 1874{ 1875 float complex ctemp, w; 1876 float t1, t2, xi, eta, beta; 1877 1878 beta = copysignf(1.0f,Real(z)); /* copes with unsigned zero */ 1879 1880 Imag(z) = -beta*Imag(z); /* transform real & imag components */ 1881 Real(z) = beta*Real(z); 1882 1883 if ((Real(z) > FPKTHETAf) || (fabsf(Imag(z)) > FPKTHETAf)) { 1884 eta = copysignf((float) M_PI_2,Imag(z)); /* avoid overflow */ 1885 ctemp = xdivcf(1.0f,z); 1886 xi = Real(ctemp); 1887 } 1888 1889 else if (Real(z) == 1.0f) { 1890 t1 = fabsf(Imag(z)) + FPKRHOf; 1891 xi = logf(sqrtf(sqrtf(4.0f + t1*t1))/sqrtf(fabsf(Imag(z)))); 1892 eta = 0.5f*copysignf((float)( M_PI-atan(2.0f/(fabsf(Imag(z))+FPKRHOf))),Imag(z)); 1893 } 1894 1895 else { /* usual case */ 1896 t2 = fabsf(Imag(z)) + FPKRHOf; 1897 t1 = 1.0f - Real(z); 1898 t2 = t2*t2; 1899 xi = 0.25f*log1pf(4.0f*Real(z)/(t1*t1 + t2)); 1900 Real(ctemp) = (1.0f - Real(z))*(1.0f + Real(z)) - t2; 1901 Imag(ctemp) = Imag(z) + Imag(z); 1902 eta = 0.5f*cargf(ctemp); 1903 } 1904 1905 Real(w) = beta*xi; /* fix up signs of result */ 1906 Imag(w) = -beta*eta; 1907 return w; 1908} 1909 1910/* conj(), creal(), and cimag() are gcc built ins. */ 1911double creal( double complex z ) 1912{ 1913 return __builtin_creal(z); 1914} 1915 1916float crealf( float complex z ) 1917{ 1918 return __builtin_crealf(z); 1919} 1920 1921double cimag( double complex z ) 1922{ 1923 return __builtin_cimag(z); 1924} 1925 1926float cimagf( float complex z ) 1927{ 1928 return __builtin_cimagf(z); 1929} 1930 1931double complex conj( double complex z ) 1932{ 1933 return __builtin_conj(z); 1934} 1935 1936float complex conjf( float complex z ) 1937{ 1938 return __builtin_conjf(z); 1939} 1940 1941double complex cproj( double complex z ) 1942{ 1943 static const double inf = __builtin_inf(); 1944 double u = __builtin_fabs(Real(z)); 1945 double v = __builtin_fabs(Imag(z)); 1946 1947 if ((u == inf) || (v == inf)) 1948 return inf + I*copysign(0.0, Imag(z)); 1949 else 1950 return z; 1951} 1952 1953float complex cprojf( float complex z ) 1954{ 1955 static const double inf = __builtin_inff(); 1956 float u = __builtin_fabsf(Real(z)); 1957 float v = __builtin_fabsf(Imag(z)); 1958 1959 if ((u == inf) || (v == inf)) 1960 return inf + I*copysignf(0.0f, Imag(z)); 1961 else 1962 return z; 1963}