2329
|
1 DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z ) |
|
2 * |
3333
|
3 * -- LAPACK auxiliary routine (version 3.0) -- |
2329
|
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
|
5 * Courant Institute, Argonne National Lab, and Rice University |
|
6 * October 31, 1992 |
|
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 DLAPY3 = ZERO |
|
46 ELSE |
|
47 DLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+ |
|
48 $ ( ZABS / W )**2 ) |
|
49 END IF |
|
50 RETURN |
|
51 * |
|
52 * End of DLAPY3 |
|
53 * |
|
54 END |