1 *> \brief \b DLAPY3 2 * 3 * =========== DOCUMENTATION =========== 4 * 5 * Online html documentation available at 6 * http://www.netlib.org/lapack/explore-html/ 7 * 8 *> \htmlonly 9 *> Download DLAPY3 + dependencies 10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy3.f"> 11 *> [TGZ]</a> 12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy3.f"> 13 *> [ZIP]</a> 14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy3.f"> 15 *> [TXT]</a> 16 *> \endhtmlonly 17 * 18 * Definition: 19 * =========== 20 * 21 * DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z ) 22 * 23 * .. Scalar Arguments .. 24 * DOUBLE PRECISION X, Y, Z 25 * .. 26 * 27 * 28 *> \par Purpose: 29 * ============= 30 *> 31 *> \verbatim 32 *> 33 *> DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause 34 *> unnecessary overflow. 35 *> \endverbatim 36 * 37 * Arguments: 38 * ========== 39 * 40 *> \param[in] X 41 *> \verbatim 42 *> X is DOUBLE PRECISION 43 *> \endverbatim 44 *> 45 *> \param[in] Y 46 *> \verbatim 47 *> Y is DOUBLE PRECISION 48 *> \endverbatim 49 *> 50 *> \param[in] Z 51 *> \verbatim 52 *> Z is DOUBLE PRECISION 53 *> X, Y and Z specify the values x, y and z. 54 *> \endverbatim 55 * 56 * Authors: 57 * ======== 58 * 59 *> \author Univ. of Tennessee 60 *> \author Univ. of California Berkeley 61 *> \author Univ. of Colorado Denver 62 *> \author NAG Ltd. 63 * 64 *> \date November 2011 65 * 66 *> \ingroup auxOTHERauxiliary 67 * 68 * ===================================================================== 69 DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z ) 70 * 71 * -- LAPACK auxiliary routine (version 3.4.0) -- 72 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 73 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 74 * November 2011 75 * 76 * .. Scalar Arguments .. 77 DOUBLE PRECISION X, Y, Z 78 * .. 79 * 80 * ===================================================================== 81 * 82 * .. Parameters .. 83 DOUBLE PRECISION ZERO 84 PARAMETER ( ZERO = 0.0D0 ) 85 * .. 86 * .. Local Scalars .. 87 DOUBLE PRECISION W, XABS, YABS, ZABS 88 * .. 89 * .. Intrinsic Functions .. 90 INTRINSIC ABS, MAX, SQRT 91 * .. 92 * .. Executable Statements .. 93 * 94 XABS = ABS( X ) 95 YABS = ABS( Y ) 96 ZABS = ABS( Z ) 97 W = MAX( XABS, YABS, ZABS ) 98 IF( W.EQ.ZERO ) THEN 99 * W can be zero for max(0,nan,0) 100 * adding all three entries together will make sure 101 * NaN will not disappear. 102 DLAPY3 = XABS + YABS + ZABS 103 ELSE 104 DLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+ 105 $ ( ZABS / W )**2 ) 106 END IF 107 RETURN 108 * 109 * End of DLAPY3 110 * 111 END 112
