diff options
Diffstat (limited to '2.3-1/src/fortran/lapack/dlapy2.f')
| -rw-r--r-- | 2.3-1/src/fortran/lapack/dlapy2.f | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/2.3-1/src/fortran/lapack/dlapy2.f b/2.3-1/src/fortran/lapack/dlapy2.f new file mode 100644 index 00000000..98ef81b6 --- /dev/null +++ b/2.3-1/src/fortran/lapack/dlapy2.f @@ -0,0 +1,53 @@ + DOUBLE PRECISION FUNCTION DLAPY2( X, Y ) +* +* -- LAPACK auxiliary routine (version 3.1) -- +* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +* November 2006 +* +* .. Scalar Arguments .. + DOUBLE PRECISION X, Y +* .. +* +* Purpose +* ======= +* +* DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary +* overflow. +* +* Arguments +* ========= +* +* X (input) DOUBLE PRECISION +* Y (input) DOUBLE PRECISION +* X and Y specify the values x and y. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER ( ZERO = 0.0D0 ) + DOUBLE PRECISION ONE + PARAMETER ( ONE = 1.0D0 ) +* .. +* .. Local Scalars .. + DOUBLE PRECISION W, XABS, YABS, Z +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, MIN, SQRT +* .. +* .. Executable Statements .. +* + XABS = ABS( X ) + YABS = ABS( Y ) + W = MAX( XABS, YABS ) + Z = MIN( XABS, YABS ) + IF( Z.EQ.ZERO ) THEN + DLAPY2 = W + ELSE + DLAPY2 = W*SQRT( ONE+( Z / W )**2 ) + END IF + RETURN +* +* End of DLAPY2 +* + END |