54 lines
1.3 KiB
Fortran
54 lines
1.3 KiB
Fortran
DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
|
|
*
|
|
* -- LAPACK auxiliary routine (version 2.0) --
|
|
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
|
|
* Courant Institute, Argonne National Lab, and Rice University
|
|
* October 31, 1992
|
|
*
|
|
* .. 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
|