| 17277 | } /* dlapy2_ */ |
| 17278 | |
| 17279 | doublereal dlapy3_(doublereal *x, doublereal *y, doublereal *z__) |
| 17280 | { |
| 17281 | /* System generated locals */ |
| 17282 | doublereal ret_val, d__1, d__2, d__3; |
| 17283 | |
| 17284 | /* Local variables */ |
| 17285 | static doublereal w, xabs, yabs, zabs; |
| 17286 | |
| 17287 | |
| 17288 | /* |
| 17289 | -- LAPACK auxiliary routine (version 3.2) -- |
| 17290 | -- LAPACK is a software package provided by Univ. of Tennessee, -- |
| 17291 | -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
| 17292 | November 2006 |
| 17293 | |
| 17294 | |
| 17295 | Purpose |
| 17296 | ======= |
| 17297 | |
| 17298 | DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause |
| 17299 | unnecessary overflow. |
| 17300 | |
| 17301 | Arguments |
| 17302 | ========= |
| 17303 | |
| 17304 | X (input) DOUBLE PRECISION |
| 17305 | Y (input) DOUBLE PRECISION |
| 17306 | Z (input) DOUBLE PRECISION |
| 17307 | X, Y and Z specify the values x, y and z. |
| 17308 | |
| 17309 | ===================================================================== |
| 17310 | */ |
| 17311 | |
| 17312 | |
| 17313 | xabs = abs(*x); |
| 17314 | yabs = abs(*y); |
| 17315 | zabs = abs(*z__); |
| 17316 | /* Computing MAX */ |
| 17317 | d__1 = max(xabs,yabs); |
| 17318 | w = max(d__1,zabs); |
| 17319 | if (w == 0.) { |
| 17320 | /* |
| 17321 | W can be zero for max(0,nan,0) |
| 17322 | adding all three entries together will make sure |
| 17323 | NaN will not disappear. |
| 17324 | */ |
| 17325 | ret_val = xabs + yabs + zabs; |
| 17326 | } else { |
| 17327 | /* Computing 2nd power */ |
| 17328 | d__1 = xabs / w; |
| 17329 | /* Computing 2nd power */ |
| 17330 | d__2 = yabs / w; |
| 17331 | /* Computing 2nd power */ |
| 17332 | d__3 = zabs / w; |
| 17333 | ret_val = w * sqrt(d__1 * d__1 + d__2 * d__2 + d__3 * d__3); |
| 17334 | } |
| 17335 | return ret_val; |
| 17336 | |