1 /* 2 * Copyright (c) 1985 Regents of the University of California. 3 * All rights reserved. 4 * 5 * %sccs.include.redist.c% 6 */ 7 8 #ifndef lint 9 static char sccsid[] = "@(#)cabs.c 5.6 (Berkeley) 10/09/90"; 10 #endif /* not lint */ 11 12 /* HYPOT(X,Y) 13 * RETURN THE SQUARE ROOT OF X^2 + Y^2 WHERE Z=X+iY 14 * DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS) 15 * CODED IN C BY K.C. NG, 11/28/84; 16 * REVISED BY K.C. NG, 7/12/85. 17 * 18 * Required system supported functions : 19 * copysign(x,y) 20 * finite(x) 21 * scalb(x,N) 22 * sqrt(x) 23 * 24 * Method : 25 * 1. replace x by |x| and y by |y|, and swap x and 26 * y if y > x (hence x is never smaller than y). 27 * 2. Hypot(x,y) is computed by: 28 * Case I, x/y > 2 29 * 30 * y 31 * hypot = x + ----------------------------- 32 * 2 33 * sqrt ( 1 + [x/y] ) + x/y 34 * 35 * Case II, x/y <= 2 36 * y 37 * hypot = x + -------------------------------------------------- 38 * 2 39 * [x/y] - 2 40 * (sqrt(2)+1) + (x-y)/y + ----------------------------- 41 * 2 42 * sqrt ( 1 + [x/y] ) + sqrt(2) 43 * 44 * 45 * 46 * Special cases: 47 * hypot(x,y) is INF if x or y is +INF or -INF; else 48 * hypot(x,y) is NAN if x or y is NAN. 49 * 50 * Accuracy: 51 * hypot(x,y) returns the sqrt(x^2+y^2) with error less than 1 ulps (units 52 * in the last place). See Kahan's "Interval Arithmetic Options in the 53 * Proposed IEEE Floating Point Arithmetic Standard", Interval Mathematics 54 * 1980, Edited by Karl L.E. Nickel, pp 99-128. (A faster but less accurate 55 * code follows in comments.) In a test run with 500,000 random arguments 56 * on a VAX, the maximum observed error was .959 ulps. 57 * 58 * Constants: 59 * The hexadecimal values are the intended ones for the following constants. 60 * The decimal values may be used, provided that the compiler will convert 61 * from decimal to binary accurately enough to produce the hexadecimal values 62 * shown. 63 */ 64 #include "mathimpl.h" 65 66 vc(r2p1hi, 2.4142135623730950345E0 ,8279,411a,ef32,99fc, 2, .9A827999FCEF32) 67 vc(r2p1lo, 1.4349369327986523769E-17 ,597d,2484,754b,89b3, -55, .84597D89B3754B) 68 vc(sqrt2, 1.4142135623730950622E0 ,04f3,40b5,de65,33f9, 1, .B504F333F9DE65) 69 70 ic(r2p1hi, 2.4142135623730949234E0 , 1, 1.3504F333F9DE6) 71 ic(r2p1lo, 1.2537167179050217666E-16 , -53, 1.21165F626CDD5) 72 ic(sqrt2, 1.4142135623730951455E0 , 0, 1.6A09E667F3BCD) 73 74 #ifdef vccast 75 #define r2p1hi vccast(r2p1hi) 76 #define r2p1lo vccast(r2p1lo) 77 #define sqrt2 vccast(sqrt2) 78 #endif 79 80 double 81 hypot(x,y) 82 double x, y; 83 { 84 static const double zero=0, one=1, 85 small=1.0E-18; /* fl(1+small)==1 */ 86 static const ibig=30; /* fl(1+2**(2*ibig))==1 */ 87 double t,r; 88 int exp; 89 90 if(finite(x)) 91 if(finite(y)) 92 { 93 x=copysign(x,one); 94 y=copysign(y,one); 95 if(y > x) 96 { t=x; x=y; y=t; } 97 if(x == zero) return(zero); 98 if(y == zero) return(x); 99 exp= logb(x); 100 if(exp-(int)logb(y) > ibig ) 101 /* raise inexact flag and return |x| */ 102 { one+small; return(x); } 103 104 /* start computing sqrt(x^2 + y^2) */ 105 r=x-y; 106 if(r>y) { /* x/y > 2 */ 107 r=x/y; 108 r=r+sqrt(one+r*r); } 109 else { /* 1 <= x/y <= 2 */ 110 r/=y; t=r*(r+2.0); 111 r+=t/(sqrt2+sqrt(2.0+t)); 112 r+=r2p1lo; r+=r2p1hi; } 113 114 r=y/r; 115 return(x+r); 116 117 } 118 119 else if(y==y) /* y is +-INF */ 120 return(copysign(y,one)); 121 else 122 return(y); /* y is NaN and x is finite */ 123 124 else if(x==x) /* x is +-INF */ 125 return (copysign(x,one)); 126 else if(finite(y)) 127 return(x); /* x is NaN, y is finite */ 128 #if !defined(vax)&&!defined(tahoe) 129 else if(y!=y) return(y); /* x and y is NaN */ 130 #endif /* !defined(vax)&&!defined(tahoe) */ 131 else return(copysign(y,one)); /* y is INF */ 132 } 133 134 /* CABS(Z) 135 * RETURN THE ABSOLUTE VALUE OF THE COMPLEX NUMBER Z = X + iY 136 * DOUBLE PRECISION (VAX D format 56 bits, IEEE DOUBLE 53 BITS) 137 * CODED IN C BY K.C. NG, 11/28/84. 138 * REVISED BY K.C. NG, 7/12/85. 139 * 140 * Required kernel function : 141 * hypot(x,y) 142 * 143 * Method : 144 * cabs(z) = hypot(x,y) . 145 */ 146 147 double 148 cabs(z) 149 struct { double x, y;} z; 150 { 151 return hypot(z.x,z.y); 152 } 153 154 double 155 z_abs(z) 156 struct { double x,y;} *z; 157 { 158 return hypot(z->x,z->y); 159 } 160 161 /* A faster but less accurate version of cabs(x,y) */ 162 #if 0 163 double hypot(x,y) 164 double x, y; 165 { 166 static const double zero=0, one=1; 167 small=1.0E-18; /* fl(1+small)==1 */ 168 static const ibig=30; /* fl(1+2**(2*ibig))==1 */ 169 double temp; 170 int exp; 171 172 if(finite(x)) 173 if(finite(y)) 174 { 175 x=copysign(x,one); 176 y=copysign(y,one); 177 if(y > x) 178 { temp=x; x=y; y=temp; } 179 if(x == zero) return(zero); 180 if(y == zero) return(x); 181 exp= logb(x); 182 x=scalb(x,-exp); 183 if(exp-(int)logb(y) > ibig ) 184 /* raise inexact flag and return |x| */ 185 { one+small; return(scalb(x,exp)); } 186 else y=scalb(y,-exp); 187 return(scalb(sqrt(x*x+y*y),exp)); 188 } 189 190 else if(y==y) /* y is +-INF */ 191 return(copysign(y,one)); 192 else 193 return(y); /* y is NaN and x is finite */ 194 195 else if(x==x) /* x is +-INF */ 196 return (copysign(x,one)); 197 else if(finite(y)) 198 return(x); /* x is NaN, y is finite */ 199 else if(y!=y) return(y); /* x and y is NaN */ 200 else return(copysign(y,one)); /* y is INF */ 201 } 202 #endif 203