xref: /titanic_41/usr/src/lib/libm/common/complex/csqrt.c (revision a9d3dcd5820128b4f34bf38f447e47aa95c004e8)
15b2ba9d3SPiotr Jasiukajtis /*
25b2ba9d3SPiotr Jasiukajtis  * CDDL HEADER START
35b2ba9d3SPiotr Jasiukajtis  *
45b2ba9d3SPiotr Jasiukajtis  * The contents of this file are subject to the terms of the
55b2ba9d3SPiotr Jasiukajtis  * Common Development and Distribution License (the "License").
65b2ba9d3SPiotr Jasiukajtis  * You may not use this file except in compliance with the License.
75b2ba9d3SPiotr Jasiukajtis  *
85b2ba9d3SPiotr Jasiukajtis  * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
95b2ba9d3SPiotr Jasiukajtis  * or http://www.opensolaris.org/os/licensing.
105b2ba9d3SPiotr Jasiukajtis  * See the License for the specific language governing permissions
115b2ba9d3SPiotr Jasiukajtis  * and limitations under the License.
125b2ba9d3SPiotr Jasiukajtis  *
135b2ba9d3SPiotr Jasiukajtis  * When distributing Covered Code, include this CDDL HEADER in each
145b2ba9d3SPiotr Jasiukajtis  * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
155b2ba9d3SPiotr Jasiukajtis  * If applicable, add the following below this CDDL HEADER, with the
165b2ba9d3SPiotr Jasiukajtis  * fields enclosed by brackets "[]" replaced with your own identifying
175b2ba9d3SPiotr Jasiukajtis  * information: Portions Copyright [yyyy] [name of copyright owner]
185b2ba9d3SPiotr Jasiukajtis  *
195b2ba9d3SPiotr Jasiukajtis  * CDDL HEADER END
205b2ba9d3SPiotr Jasiukajtis  */
215b2ba9d3SPiotr Jasiukajtis 
225b2ba9d3SPiotr Jasiukajtis /*
235b2ba9d3SPiotr Jasiukajtis  * Copyright 2011 Nexenta Systems, Inc.  All rights reserved.
245b2ba9d3SPiotr Jasiukajtis  */
255b2ba9d3SPiotr Jasiukajtis /*
265b2ba9d3SPiotr Jasiukajtis  * Copyright 2006 Sun Microsystems, Inc.  All rights reserved.
275b2ba9d3SPiotr Jasiukajtis  * Use is subject to license terms.
285b2ba9d3SPiotr Jasiukajtis  */
295b2ba9d3SPiotr Jasiukajtis 
30*a9d3dcd5SRichard Lowe #pragma weak __csqrt = csqrt
315b2ba9d3SPiotr Jasiukajtis 
325b2ba9d3SPiotr Jasiukajtis /* INDENT OFF */
335b2ba9d3SPiotr Jasiukajtis /*
345b2ba9d3SPiotr Jasiukajtis  * dcomplex csqrt(dcomplex z);
355b2ba9d3SPiotr Jasiukajtis  *
365b2ba9d3SPiotr Jasiukajtis  *                                         2    2    2
375b2ba9d3SPiotr Jasiukajtis  * Let w=r+i*s = sqrt(x+iy). Then (r + i s)  = r  - s  + i 2sr = x + i y.
385b2ba9d3SPiotr Jasiukajtis  *
395b2ba9d3SPiotr Jasiukajtis  * Hence x = r*r-s*s, y = 2sr.
405b2ba9d3SPiotr Jasiukajtis  *
415b2ba9d3SPiotr Jasiukajtis  * Note that x*x+y*y = (s*s+r*r)**2. Thus, we have
425b2ba9d3SPiotr Jasiukajtis  *                        ________
435b2ba9d3SPiotr Jasiukajtis  *            2    2     / 2    2
445b2ba9d3SPiotr Jasiukajtis  *	(1) r  + s  = \/ x  + y  ,
455b2ba9d3SPiotr Jasiukajtis  *
465b2ba9d3SPiotr Jasiukajtis  *            2    2
475b2ba9d3SPiotr Jasiukajtis  *       (2) r  - s  = x
485b2ba9d3SPiotr Jasiukajtis  *
495b2ba9d3SPiotr Jasiukajtis  *	(3) 2sr = y.
505b2ba9d3SPiotr Jasiukajtis  *
515b2ba9d3SPiotr Jasiukajtis  * Perform (1)-(2) and (1)+(2), we obtain
525b2ba9d3SPiotr Jasiukajtis  *
535b2ba9d3SPiotr Jasiukajtis  *              2
545b2ba9d3SPiotr Jasiukajtis  *	(4) 2 r   = hypot(x,y)+x,
555b2ba9d3SPiotr Jasiukajtis  *
565b2ba9d3SPiotr Jasiukajtis  *              2
575b2ba9d3SPiotr Jasiukajtis  *       (5) 2*s   = hypot(x,y)-x
585b2ba9d3SPiotr Jasiukajtis  *                       ________
595b2ba9d3SPiotr Jasiukajtis  *                      / 2    2
605b2ba9d3SPiotr Jasiukajtis  * where hypot(x,y) = \/ x  + y  .
615b2ba9d3SPiotr Jasiukajtis  *
625b2ba9d3SPiotr Jasiukajtis  * In order to avoid numerical cancellation, we use formula (4) for
635b2ba9d3SPiotr Jasiukajtis  * positive x, and (5) for negative x. The other component is then
645b2ba9d3SPiotr Jasiukajtis  * computed by formula (3).
655b2ba9d3SPiotr Jasiukajtis  *
665b2ba9d3SPiotr Jasiukajtis  *
675b2ba9d3SPiotr Jasiukajtis  * ALGORITHM
685b2ba9d3SPiotr Jasiukajtis  * ------------------
695b2ba9d3SPiotr Jasiukajtis  *
705b2ba9d3SPiotr Jasiukajtis  * (assume x and y are of medium size, i.e., no over/underflow in squaring)
715b2ba9d3SPiotr Jasiukajtis  *
725b2ba9d3SPiotr Jasiukajtis  * If x >=0 then
735b2ba9d3SPiotr Jasiukajtis  *                       ________
745b2ba9d3SPiotr Jasiukajtis  *	               /  2    2
755b2ba9d3SPiotr Jasiukajtis  *	       2     \/  x  + y    +  x                y
765b2ba9d3SPiotr Jasiukajtis  *            r =   ---------------------,      s = -------;    (6)
775b2ba9d3SPiotr Jasiukajtis  *			       2                      2 r
785b2ba9d3SPiotr Jasiukajtis  *
795b2ba9d3SPiotr Jasiukajtis  * (note that we choose sign(s) = sign(y) to force r >=0).
805b2ba9d3SPiotr Jasiukajtis  * Otherwise,
815b2ba9d3SPiotr Jasiukajtis  *                       ________
825b2ba9d3SPiotr Jasiukajtis  *	               /  2    2
835b2ba9d3SPiotr Jasiukajtis  *	       2     \/  x  + y    -  x                y
845b2ba9d3SPiotr Jasiukajtis  *            s =   ---------------------,      r = -------;    (7)
855b2ba9d3SPiotr Jasiukajtis  *			       2                      2 s
865b2ba9d3SPiotr Jasiukajtis  *
875b2ba9d3SPiotr Jasiukajtis  * EXCEPTION:
885b2ba9d3SPiotr Jasiukajtis  *
895b2ba9d3SPiotr Jasiukajtis  * One may use the polar coordinate of a complex number to justify the
905b2ba9d3SPiotr Jasiukajtis  * following exception cases:
915b2ba9d3SPiotr Jasiukajtis  *
925b2ba9d3SPiotr Jasiukajtis  * EXCEPTION CASES (conform to ISO/IEC 9899:1999(E)):
935b2ba9d3SPiotr Jasiukajtis  *    csqrt(+-0+ i 0   ) =  0    + i 0
945b2ba9d3SPiotr Jasiukajtis  *    csqrt( x + i inf ) =  inf  + i inf for all x (including NaN)
955b2ba9d3SPiotr Jasiukajtis  *    csqrt( x + i NaN ) =  NaN  + i NaN with invalid for finite x
965b2ba9d3SPiotr Jasiukajtis  *    csqrt(-inf+ iy   ) =  0    + i inf for finite positive-signed y
975b2ba9d3SPiotr Jasiukajtis  *    csqrt(+inf+ iy   ) =  inf  + i 0   for finite positive-signed y
985b2ba9d3SPiotr Jasiukajtis  *    csqrt(-inf+ i NaN) =  NaN  +-i inf
995b2ba9d3SPiotr Jasiukajtis  *    csqrt(+inf+ i NaN) =  inf  + i NaN
1005b2ba9d3SPiotr Jasiukajtis  *    csqrt(NaN + i y  ) =  NaN  + i NaN for finite y
1015b2ba9d3SPiotr Jasiukajtis  *    csqrt(NaN + i NaN) =  NaN  + i NaN
1025b2ba9d3SPiotr Jasiukajtis  */
1035b2ba9d3SPiotr Jasiukajtis /* INDENT ON */
1045b2ba9d3SPiotr Jasiukajtis 
1055b2ba9d3SPiotr Jasiukajtis #include "libm.h"		/* fabs/sqrt */
1065b2ba9d3SPiotr Jasiukajtis #include "complex_wrapper.h"
1075b2ba9d3SPiotr Jasiukajtis 
1085b2ba9d3SPiotr Jasiukajtis /* INDENT OFF */
1095b2ba9d3SPiotr Jasiukajtis static const double
1105b2ba9d3SPiotr Jasiukajtis 	two300 = 2.03703597633448608627e+90,
1115b2ba9d3SPiotr Jasiukajtis 	twom300 = 4.90909346529772655310e-91,
1125b2ba9d3SPiotr Jasiukajtis 	two599 = 2.07475778444049647926e+180,
1135b2ba9d3SPiotr Jasiukajtis 	twom601 = 1.20495993255144205887e-181,
1145b2ba9d3SPiotr Jasiukajtis 	two = 2.0,
1155b2ba9d3SPiotr Jasiukajtis 	zero = 0.0,
1165b2ba9d3SPiotr Jasiukajtis 	half = 0.5;
1175b2ba9d3SPiotr Jasiukajtis /* INDENT ON */
1185b2ba9d3SPiotr Jasiukajtis 
1195b2ba9d3SPiotr Jasiukajtis dcomplex
csqrt(dcomplex z)1205b2ba9d3SPiotr Jasiukajtis csqrt(dcomplex z) {
1215b2ba9d3SPiotr Jasiukajtis 	dcomplex ans;
1225b2ba9d3SPiotr Jasiukajtis 	double x, y, t, ax, ay;
1235b2ba9d3SPiotr Jasiukajtis 	int n, ix, iy, hx, hy, lx, ly;
1245b2ba9d3SPiotr Jasiukajtis 
1255b2ba9d3SPiotr Jasiukajtis 	x = D_RE(z);
1265b2ba9d3SPiotr Jasiukajtis 	y = D_IM(z);
1275b2ba9d3SPiotr Jasiukajtis 	hx = HI_WORD(x);
1285b2ba9d3SPiotr Jasiukajtis 	lx = LO_WORD(x);
1295b2ba9d3SPiotr Jasiukajtis 	hy = HI_WORD(y);
1305b2ba9d3SPiotr Jasiukajtis 	ly = LO_WORD(y);
1315b2ba9d3SPiotr Jasiukajtis 	ix = hx & 0x7fffffff;
1325b2ba9d3SPiotr Jasiukajtis 	iy = hy & 0x7fffffff;
1335b2ba9d3SPiotr Jasiukajtis 	ay = fabs(y);
1345b2ba9d3SPiotr Jasiukajtis 	ax = fabs(x);
1355b2ba9d3SPiotr Jasiukajtis 	if (ix >= 0x7ff00000 || iy >= 0x7ff00000) {
1365b2ba9d3SPiotr Jasiukajtis 		/* x or y is Inf or NaN */
1375b2ba9d3SPiotr Jasiukajtis 		if (ISINF(iy, ly))
1385b2ba9d3SPiotr Jasiukajtis 			D_IM(ans) = D_RE(ans) = ay;
1395b2ba9d3SPiotr Jasiukajtis 		else if (ISINF(ix, lx)) {
1405b2ba9d3SPiotr Jasiukajtis 			if (hx > 0) {
1415b2ba9d3SPiotr Jasiukajtis 				D_RE(ans) = ax;
1425b2ba9d3SPiotr Jasiukajtis 				D_IM(ans) = ay * zero;
1435b2ba9d3SPiotr Jasiukajtis 			} else {
1445b2ba9d3SPiotr Jasiukajtis 				D_RE(ans) = ay * zero;
1455b2ba9d3SPiotr Jasiukajtis 				D_IM(ans) = ax;
1465b2ba9d3SPiotr Jasiukajtis 			}
1475b2ba9d3SPiotr Jasiukajtis 		} else
1485b2ba9d3SPiotr Jasiukajtis 			D_IM(ans) = D_RE(ans) = ax + ay;
1495b2ba9d3SPiotr Jasiukajtis 	} else if ((iy | ly) == 0) {	/* y = 0 */
1505b2ba9d3SPiotr Jasiukajtis 		if (hx >= 0) {
1515b2ba9d3SPiotr Jasiukajtis 			D_RE(ans) = sqrt(ax);
1525b2ba9d3SPiotr Jasiukajtis 			D_IM(ans) = zero;
1535b2ba9d3SPiotr Jasiukajtis 		} else {
1545b2ba9d3SPiotr Jasiukajtis 			D_IM(ans) = sqrt(ax);
1555b2ba9d3SPiotr Jasiukajtis 			D_RE(ans) = zero;
1565b2ba9d3SPiotr Jasiukajtis 		}
1575b2ba9d3SPiotr Jasiukajtis 	} else if (ix >= iy) {
1585b2ba9d3SPiotr Jasiukajtis 		n = (ix - iy) >> 20;
1595b2ba9d3SPiotr Jasiukajtis 		if (n >= 30) {	/* x >> y or y=0 */
1605b2ba9d3SPiotr Jasiukajtis 			t = sqrt(ax);
1615b2ba9d3SPiotr Jasiukajtis 		} else if (ix >= 0x5f300000) {	/* x > 2**500 */
1625b2ba9d3SPiotr Jasiukajtis 			ax *= twom601;
1635b2ba9d3SPiotr Jasiukajtis 			y *= twom601;
1645b2ba9d3SPiotr Jasiukajtis 			t = two300 * sqrt(ax + sqrt(ax * ax + y * y));
1655b2ba9d3SPiotr Jasiukajtis 		} else if (iy < 0x20b00000) {	/* y < 2**-500 */
1665b2ba9d3SPiotr Jasiukajtis 			ax *= two599;
1675b2ba9d3SPiotr Jasiukajtis 			y *= two599;
1685b2ba9d3SPiotr Jasiukajtis 			t = twom300 * sqrt(ax + sqrt(ax * ax + y * y));
1695b2ba9d3SPiotr Jasiukajtis 		} else
1705b2ba9d3SPiotr Jasiukajtis 			t = sqrt(half * (ax + sqrt(ax * ax + ay * ay)));
1715b2ba9d3SPiotr Jasiukajtis 		if (hx >= 0) {
1725b2ba9d3SPiotr Jasiukajtis 			D_RE(ans) = t;
1735b2ba9d3SPiotr Jasiukajtis 			D_IM(ans) = ay / (t + t);
1745b2ba9d3SPiotr Jasiukajtis 		} else {
1755b2ba9d3SPiotr Jasiukajtis 			D_IM(ans) = t;
1765b2ba9d3SPiotr Jasiukajtis 			D_RE(ans) = ay / (t + t);
1775b2ba9d3SPiotr Jasiukajtis 		}
1785b2ba9d3SPiotr Jasiukajtis 	} else {
1795b2ba9d3SPiotr Jasiukajtis 		n = (iy - ix) >> 20;
1805b2ba9d3SPiotr Jasiukajtis 		if (n >= 30) {	/* y >> x */
1815b2ba9d3SPiotr Jasiukajtis 			if (n >= 60)
1825b2ba9d3SPiotr Jasiukajtis 				t = sqrt(half * ay);
1835b2ba9d3SPiotr Jasiukajtis 			else if (iy >= 0x7fe00000)
1845b2ba9d3SPiotr Jasiukajtis 				t = sqrt(half * ay + half * ax);
1855b2ba9d3SPiotr Jasiukajtis 			else if (ix <= 0x00100000)
1865b2ba9d3SPiotr Jasiukajtis 				t = half * sqrt(two * (ay + ax));
1875b2ba9d3SPiotr Jasiukajtis 			else
1885b2ba9d3SPiotr Jasiukajtis 				t = sqrt(half * (ay + ax));
1895b2ba9d3SPiotr Jasiukajtis 		} else if (iy >= 0x5f300000) {	/* y > 2**500 */
1905b2ba9d3SPiotr Jasiukajtis 			ax *= twom601;
1915b2ba9d3SPiotr Jasiukajtis 			y *= twom601;
1925b2ba9d3SPiotr Jasiukajtis 			t = two300 * sqrt(ax + sqrt(ax * ax + y * y));
1935b2ba9d3SPiotr Jasiukajtis 		} else if (ix < 0x20b00000) {	/* x < 2**-500 */
1945b2ba9d3SPiotr Jasiukajtis 			ax *= two599;
1955b2ba9d3SPiotr Jasiukajtis 			y *= two599;
1965b2ba9d3SPiotr Jasiukajtis 			t = twom300 * sqrt(ax + sqrt(ax * ax + y * y));
1975b2ba9d3SPiotr Jasiukajtis 		} else
1985b2ba9d3SPiotr Jasiukajtis 			t = sqrt(half * (ax + sqrt(ax * ax + ay * ay)));
1995b2ba9d3SPiotr Jasiukajtis 		if (hx >= 0) {
2005b2ba9d3SPiotr Jasiukajtis 			D_RE(ans) = t;
2015b2ba9d3SPiotr Jasiukajtis 			D_IM(ans) = ay / (t + t);
2025b2ba9d3SPiotr Jasiukajtis 		} else {
2035b2ba9d3SPiotr Jasiukajtis 			D_IM(ans) = t;
2045b2ba9d3SPiotr Jasiukajtis 			D_RE(ans) = ay / (t + t);
2055b2ba9d3SPiotr Jasiukajtis 		}
2065b2ba9d3SPiotr Jasiukajtis 	}
2075b2ba9d3SPiotr Jasiukajtis 	if (hy < 0)
2085b2ba9d3SPiotr Jasiukajtis 		D_IM(ans) = -D_IM(ans);
2095b2ba9d3SPiotr Jasiukajtis 	return (ans);
2105b2ba9d3SPiotr Jasiukajtis }
211