1: DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
2: *
3: * -- LAPACK auxiliary routine (version 3.2) --
4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6: * November 2006
7: *
8: * .. Scalar Arguments ..
9: DOUBLE PRECISION X, Y, Z
10: * ..
11: *
12: * Purpose
13: * =======
14: *
15: * DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
16: * unnecessary overflow.
17: *
18: * Arguments
19: * =========
20: *
21: * X (input) DOUBLE PRECISION
22: * Y (input) DOUBLE PRECISION
23: * Z (input) DOUBLE PRECISION
24: * X, Y and Z specify the values x, y and z.
25: *
26: * =====================================================================
27: *
28: * .. Parameters ..
29: DOUBLE PRECISION ZERO
30: PARAMETER ( ZERO = 0.0D0 )
31: * ..
32: * .. Local Scalars ..
33: DOUBLE PRECISION W, XABS, YABS, ZABS
34: * ..
35: * .. Intrinsic Functions ..
36: INTRINSIC ABS, MAX, SQRT
37: * ..
38: * .. Executable Statements ..
39: *
40: XABS = ABS( X )
41: YABS = ABS( Y )
42: ZABS = ABS( Z )
43: W = MAX( XABS, YABS, ZABS )
44: IF( W.EQ.ZERO ) THEN
45: * W can be zero for max(0,nan,0)
46: * adding all three entries together will make sure
47: * NaN will not disappear.
48: DLAPY3 = XABS + YABS + ZABS
49: ELSE
50: DLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
51: $ ( ZABS / W )**2 )
52: END IF
53: RETURN
54: *
55: * End of DLAPY3
56: *
57: END
CVSweb interface <joel.bertrand@systella.fr>