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