Annotation of rpl/lapack/lapack/dlapy2.f, revision 1.19
1.11 bertrand 1: *> \brief \b DLAPY2 returns sqrt(x2+y2).
1.8 bertrand 2: *
3: * =========== DOCUMENTATION ===========
4: *
1.15 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.8 bertrand 7: *
8: *> \htmlonly
1.15 bertrand 9: *> Download DLAPY2 + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy2.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy2.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy2.f">
1.8 bertrand 15: *> [TXT]</a>
1.15 bertrand 16: *> \endhtmlonly
1.8 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
1.15 bertrand 22: *
1.8 bertrand 23: * .. Scalar Arguments ..
24: * DOUBLE PRECISION X, Y
25: * ..
1.15 bertrand 26: *
1.8 bertrand 27: *
28: *> \par Purpose:
29: * =============
30: *>
31: *> \verbatim
32: *>
33: *> DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
1.19 ! bertrand 34: *> overflow and unnecessary underflow.
1.8 bertrand 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: *> X and Y specify the values x and y.
49: *> \endverbatim
50: *
51: * Authors:
52: * ========
53: *
1.15 bertrand 54: *> \author Univ. of Tennessee
55: *> \author Univ. of California Berkeley
56: *> \author Univ. of Colorado Denver
57: *> \author NAG Ltd.
1.8 bertrand 58: *
1.15 bertrand 59: *> \ingroup OTHERauxiliary
1.8 bertrand 60: *
61: * =====================================================================
1.1 bertrand 62: DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
63: *
1.19 ! bertrand 64: * -- LAPACK auxiliary routine --
1.1 bertrand 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: DOUBLE PRECISION X, Y
70: * ..
71: *
72: * =====================================================================
73: *
74: * .. Parameters ..
75: DOUBLE PRECISION ZERO
76: PARAMETER ( ZERO = 0.0D0 )
77: DOUBLE PRECISION ONE
78: PARAMETER ( ONE = 1.0D0 )
79: * ..
80: * .. Local Scalars ..
1.19 ! bertrand 81: DOUBLE PRECISION W, XABS, YABS, Z, HUGEVAL
1.17 bertrand 82: LOGICAL X_IS_NAN, Y_IS_NAN
83: * ..
84: * .. External Functions ..
85: LOGICAL DISNAN
86: EXTERNAL DISNAN
1.1 bertrand 87: * ..
1.19 ! bertrand 88: * .. External Subroutines ..
! 89: DOUBLE PRECISION DLAMCH
! 90: * ..
1.1 bertrand 91: * .. Intrinsic Functions ..
92: INTRINSIC ABS, MAX, MIN, SQRT
93: * ..
94: * .. Executable Statements ..
95: *
1.17 bertrand 96: X_IS_NAN = DISNAN( X )
97: Y_IS_NAN = DISNAN( Y )
98: IF ( X_IS_NAN ) DLAPY2 = X
99: IF ( Y_IS_NAN ) DLAPY2 = Y
1.19 ! bertrand 100: HUGEVAL = DLAMCH( 'Overflow' )
1.17 bertrand 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 )
1.19 ! bertrand 107: IF( Z.EQ.ZERO .OR. W.GT.HUGEVAL ) THEN
1.17 bertrand 108: DLAPY2 = W
109: ELSE
110: DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
111: END IF
1.1 bertrand 112: END IF
113: RETURN
114: *
115: * End of DLAPY2
116: *
117: END
CVSweb interface <joel.bertrand@systella.fr>