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
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