LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
slapy2.f
Go to the documentation of this file.
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
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 lapy2
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, hugeval
82 LOGICAL x_is_nan, y_is_nan
83* ..
84* .. External Functions ..
85 LOGICAL sisnan
86 EXTERNAL sisnan
87* ..
88* .. External Subroutines ..
89 REAL slamch
90* ..
91* .. Intrinsic Functions ..
92 INTRINSIC abs, max, min, sqrt
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 hugeval = slamch( 'Overflow' )
101*
102 IF ( .NOT.( x_is_nan.OR.y_is_nan ) ) THEN
103 xabs = abs( x )
104 yabs = abs( y )
105 w = max( xabs, yabs )
106 z = min( xabs, yabs )
107 IF( z.EQ.zero .OR. w.GT.hugeval ) THEN
108 slapy2 = w
109 ELSE
110 slapy2 = w*sqrt( one+( z / w )**2 )
111 END IF
112 END IF
113 RETURN
114*
115* End of SLAPY2
116*
117 END
logical function sisnan(sin)
SISNAN tests input for NaN.
Definition sisnan.f:59
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
real function slapy2(x, y)
SLAPY2 returns sqrt(x2+y2).
Definition slapy2.f:63