]> git.ipfire.org Git - thirdparty/glibc.git/blob - math/s_ctanhl.c
64e448baa84895cde0776d9a48e81fa6b6eed437
[thirdparty/glibc.git] / math / s_ctanhl.c
1 /* Complex hyperbole tangent for long double.
2 Copyright (C) 1997-2014 Free Software Foundation, Inc.
3 This file is part of the GNU C Library.
4 Contributed by Ulrich Drepper <drepper@cygnus.com>, 1997.
5
6 The GNU C Library is free software; you can redistribute it and/or
7 modify it under the terms of the GNU Lesser General Public
8 License as published by the Free Software Foundation; either
9 version 2.1 of the License, or (at your option) any later version.
10
11 The GNU C Library is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 Lesser General Public License for more details.
15
16 You should have received a copy of the GNU Lesser General Public
17 License along with the GNU C Library; if not, see
18 <http://www.gnu.org/licenses/>. */
19
20 #include <complex.h>
21 #include <fenv.h>
22 #include <math.h>
23 #include <math_private.h>
24 #include <float.h>
25
26 __complex__ long double
27 __ctanhl (__complex__ long double x)
28 {
29 __complex__ long double res;
30
31 if (__glibc_unlikely (!isfinite (__real__ x) || !isfinite (__imag__ x)))
32 {
33 if (__isinf_nsl (__real__ x))
34 {
35 __real__ res = __copysignl (1.0, __real__ x);
36 __imag__ res = __copysignl (0.0, __imag__ x);
37 }
38 else if (__imag__ x == 0.0)
39 {
40 res = x;
41 }
42 else
43 {
44 __real__ res = __nanl ("");
45 __imag__ res = __nanl ("");
46
47 if (__isinf_nsl (__imag__ x))
48 feraiseexcept (FE_INVALID);
49 }
50 }
51 else
52 {
53 long double sinix, cosix;
54 long double den;
55 const int t = (int) ((LDBL_MAX_EXP - 1) * M_LN2l / 2);
56 int icls = fpclassify (__imag__ x);
57
58 /* tanh(x+iy) = (sinh(2x) + i*sin(2y))/(cosh(2x) + cos(2y))
59 = (sinh(x)*cosh(x) + i*sin(y)*cos(y))/(sinh(x)^2 + cos(y)^2). */
60
61 if (__glibc_likely (icls != FP_SUBNORMAL))
62 {
63 __sincosl (__imag__ x, &sinix, &cosix);
64 }
65 else
66 {
67 sinix = __imag__ x;
68 cosix = 1.0;
69 }
70
71 if (fabsl (__real__ x) > t)
72 {
73 /* Avoid intermediate overflow when the imaginary part of
74 the result may be subnormal. Ignoring negligible terms,
75 the real part is +/- 1, the imaginary part is
76 sin(y)*cos(y)/sinh(x)^2 = 4*sin(y)*cos(y)/exp(2x). */
77 long double exp_2t = __ieee754_expl (2 * t);
78
79 __real__ res = __copysignl (1.0, __real__ x);
80 __imag__ res = 4 * sinix * cosix;
81 __real__ x = fabsl (__real__ x);
82 __real__ x -= t;
83 __imag__ res /= exp_2t;
84 if (__real__ x > t)
85 {
86 /* Underflow (original real part of x has absolute value
87 > 2t). */
88 __imag__ res /= exp_2t;
89 }
90 else
91 __imag__ res /= __ieee754_expl (2 * __real__ x);
92 }
93 else
94 {
95 long double sinhrx, coshrx;
96 if (fabsl (__real__ x) > LDBL_MIN)
97 {
98 sinhrx = __ieee754_sinhl (__real__ x);
99 coshrx = __ieee754_coshl (__real__ x);
100 }
101 else
102 {
103 sinhrx = __real__ x;
104 coshrx = 1.0L;
105 }
106
107 if (fabsl (sinhrx) > fabsl (cosix) * LDBL_EPSILON)
108 den = sinhrx * sinhrx + cosix * cosix;
109 else
110 den = cosix * cosix;
111 __real__ res = sinhrx * coshrx / den;
112 __imag__ res = sinix * cosix / den;
113 }
114 }
115
116 return res;
117 }
118 weak_alias (__ctanhl, ctanhl)