blob: d172efc7565129780f9aa86261063e18845c4178 [file] [log] [blame]
Elliott Hughesa0ee0782013-01-30 19:06:37 -08001/*-
Elliott Hughes8da8ca42018-05-08 13:35:33 -07002 * SPDX-License-Identifier: BSD-2-Clause-FreeBSD
3 *
Elliott Hughesa0ee0782013-01-30 19:06:37 -08004 * Copyright (c) 2007 David Schultz <das@FreeBSD.ORG>
5 * All rights reserved.
6 *
7 * Redistribution and use in source and binary forms, with or without
8 * modification, are permitted provided that the following conditions
9 * are met:
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 * 2. Redistributions in binary form must reproduce the above copyright
13 * notice, this list of conditions and the following disclaimer in the
14 * documentation and/or other materials provided with the distribution.
15 *
16 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
17 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
18 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
19 * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
20 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
21 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
22 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
23 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
24 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
25 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
26 * SUCH DAMAGE.
27 */
28
29#include <sys/cdefs.h>
Elliott Hughesbac0ebb2021-01-26 14:17:20 -080030__FBSDID("$FreeBSD$");
Elliott Hughesa0ee0782013-01-30 19:06:37 -080031
32#include <complex.h>
33#include <float.h>
34#include <math.h>
35
36#include "math_private.h"
37
Elliott Hughesab528072018-07-24 00:01:52 +000038/* For avoiding overflow for components >= DBL_MAX / (1 + sqrt(2)). */
Elliott Hughesa0ee0782013-01-30 19:06:37 -080039#define THRESH 0x1.a827999fcef32p+1022
40
41double complex
42csqrt(double complex z)
43{
44 double complex result;
Elliott Hughesab528072018-07-24 00:01:52 +000045 double a, b, rx, ry, scale, t;
Elliott Hughesa0ee0782013-01-30 19:06:37 -080046
47 a = creal(z);
48 b = cimag(z);
49
50 /* Handle special cases. */
51 if (z == 0)
Elliott Hughes8cff2f92015-08-28 20:21:43 -070052 return (CMPLX(0, b));
Elliott Hughesa0ee0782013-01-30 19:06:37 -080053 if (isinf(b))
Elliott Hughes8cff2f92015-08-28 20:21:43 -070054 return (CMPLX(INFINITY, b));
Elliott Hughesa0ee0782013-01-30 19:06:37 -080055 if (isnan(a)) {
56 t = (b - b) / (b - b); /* raise invalid if b is not a NaN */
Elliott Hughesab528072018-07-24 00:01:52 +000057 return (CMPLX(a + 0.0L + t, a + 0.0L + t)); /* NaN + NaN i */
Elliott Hughesa0ee0782013-01-30 19:06:37 -080058 }
59 if (isinf(a)) {
60 /*
61 * csqrt(inf + NaN i) = inf + NaN i
62 * csqrt(inf + y i) = inf + 0 i
63 * csqrt(-inf + NaN i) = NaN +- inf i
64 * csqrt(-inf + y i) = 0 + inf i
65 */
66 if (signbit(a))
Elliott Hughes8cff2f92015-08-28 20:21:43 -070067 return (CMPLX(fabs(b - b), copysign(a, b)));
Elliott Hughesa0ee0782013-01-30 19:06:37 -080068 else
Elliott Hughes8cff2f92015-08-28 20:21:43 -070069 return (CMPLX(a, copysign(b - b, b)));
Elliott Hughesa0ee0782013-01-30 19:06:37 -080070 }
Elliott Hughesab528072018-07-24 00:01:52 +000071 if (isnan(b)) {
72 t = (a - a) / (a - a); /* raise invalid */
73 return (CMPLX(b + 0.0L + t, b + 0.0L + t)); /* NaN + NaN i */
74 }
Elliott Hughesa0ee0782013-01-30 19:06:37 -080075
76 /* Scale to avoid overflow. */
77 if (fabs(a) >= THRESH || fabs(b) >= THRESH) {
Elliott Hughesab528072018-07-24 00:01:52 +000078 /*
79 * Don't scale a or b if this might give (spurious)
80 * underflow. Then the unscaled value is an equivalent
81 * infinitesmal (or 0).
82 */
83 if (fabs(a) >= 0x1p-1020)
84 a *= 0.25;
85 if (fabs(b) >= 0x1p-1020)
86 b *= 0.25;
87 scale = 2;
Andreas Gampe253a8302018-07-21 12:08:26 -070088 } else {
Elliott Hughesab528072018-07-24 00:01:52 +000089 scale = 1;
90 }
91
92 /* Scale to reduce inaccuracies when both components are denormal. */
93 if (fabs(a) < 0x1p-1022 && fabs(b) < 0x1p-1022) {
94 a *= 0x1p54;
95 b *= 0x1p54;
96 scale = 0x1p-27;
Elliott Hughesa0ee0782013-01-30 19:06:37 -080097 }
98
99 /* Algorithm 312, CACM vol 10, Oct 1967. */
100 if (a >= 0) {
101 t = sqrt((a + hypot(a, b)) * 0.5);
Elliott Hughesab528072018-07-24 00:01:52 +0000102 rx = scale * t;
103 ry = scale * b / (2 * t);
Elliott Hughesa0ee0782013-01-30 19:06:37 -0800104 } else {
105 t = sqrt((-a + hypot(a, b)) * 0.5);
Elliott Hughesab528072018-07-24 00:01:52 +0000106 rx = scale * fabs(b) / (2 * t);
107 ry = copysign(scale * t, b);
Elliott Hughesa0ee0782013-01-30 19:06:37 -0800108 }
109
Elliott Hughesab528072018-07-24 00:01:52 +0000110 return (CMPLX(rx, ry));
Elliott Hughesa0ee0782013-01-30 19:06:37 -0800111}
112
113#if LDBL_MANT_DIG == 53
114__weak_reference(csqrt, csqrtl);
115#endif