1*> \brief \b SLAPY2 returns sqrt(x2+y2). 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 and unnecessary underflow. 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*> \ingroup OTHERauxiliary 60* 61* ===================================================================== 62 REAL FUNCTION SLAPY2( X, Y ) 63* 64* -- LAPACK auxiliary routine -- 65* -- LAPACK is a software package provided by Univ. of Tennessee, -- 66* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 67* 68* .. Scalar Arguments .. 69 REAL X, Y 70* .. 71* 72* ===================================================================== 73* 74* .. Parameters .. 75 REAL ZERO 76 PARAMETER ( ZERO = 0.0E0 ) 77 REAL ONE 78 PARAMETER ( ONE = 1.0E0 ) 79* .. 80* .. Local Scalars .. 81 REAL W, XABS, YABS, Z 82 LOGICAL X_IS_NAN, Y_IS_NAN 83* .. 84* .. External Functions .. 85 LOGICAL SISNAN 86 EXTERNAL SISNAN 87* .. 88* .. Intrinsic Functions .. 89 INTRINSIC ABS, MAX, MIN, SQRT 90* .. 91* .. Executable Statements .. 92* 93* .. 94* .. Executable Statements .. 95* 96 X_IS_NAN = SISNAN( X ) 97 Y_IS_NAN = SISNAN( Y ) 98 IF ( X_IS_NAN ) SLAPY2 = X 99 IF ( Y_IS_NAN ) SLAPY2 = Y 100* 101 IF ( .NOT.( X_IS_NAN.OR.Y_IS_NAN ) ) THEN 102 XABS = ABS( X ) 103 YABS = ABS( Y ) 104 W = MAX( XABS, YABS ) 105 Z = MIN( XABS, YABS ) 106 IF( Z.EQ.ZERO ) THEN 107 SLAPY2 = W 108 ELSE 109 SLAPY2 = W*SQRT( ONE+( Z / W )**2 ) 110 END IF 111 END IF 112 RETURN 113* 114* End of SLAPY2 115* 116 END 117