1 DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
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
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
16 * overflow.
17 *
18 * Arguments
19 * =========
20 *
21 * X (input) DOUBLE PRECISION
22 * Y (input) DOUBLE PRECISION
23 * X and Y specify the values x and y.
24 *
25 * =====================================================================
26 *
27 * .. Parameters ..
28 DOUBLE PRECISION ZERO
29 PARAMETER ( ZERO = 0.0D0 )
30 DOUBLE PRECISION ONE
31 PARAMETER ( ONE = 1.0D0 )
32 * ..
33 * .. Local Scalars ..
34 DOUBLE PRECISION W, XABS, YABS, Z
35 * ..
36 * .. Intrinsic Functions ..
37 INTRINSIC ABS, MAX, MIN, SQRT
38 * ..
39 * .. Executable Statements ..
40 *
41 XABS = ABS( X )
42 YABS = ABS( Y )
43 W = MAX( XABS, YABS )
44 Z = MIN( XABS, YABS )
45 IF( Z.EQ.ZERO ) THEN
46 DLAPY2 = W
47 ELSE
48 DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
49 END IF
50 RETURN
51 *
52 * End of DLAPY2
53 *
54 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
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
16 * overflow.
17 *
18 * Arguments
19 * =========
20 *
21 * X (input) DOUBLE PRECISION
22 * Y (input) DOUBLE PRECISION
23 * X and Y specify the values x and y.
24 *
25 * =====================================================================
26 *
27 * .. Parameters ..
28 DOUBLE PRECISION ZERO
29 PARAMETER ( ZERO = 0.0D0 )
30 DOUBLE PRECISION ONE
31 PARAMETER ( ONE = 1.0D0 )
32 * ..
33 * .. Local Scalars ..
34 DOUBLE PRECISION W, XABS, YABS, Z
35 * ..
36 * .. Intrinsic Functions ..
37 INTRINSIC ABS, MAX, MIN, SQRT
38 * ..
39 * .. Executable Statements ..
40 *
41 XABS = ABS( X )
42 YABS = ABS( Y )
43 W = MAX( XABS, YABS )
44 Z = MIN( XABS, YABS )
45 IF( Z.EQ.ZERO ) THEN
46 DLAPY2 = W
47 ELSE
48 DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
49 END IF
50 RETURN
51 *
52 * End of DLAPY2
53 *
54 END