Annotation of rpl/lapack/lapack/dlapy3.f, revision 1.1
1.1 ! bertrand 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
CVSweb interface <joel.bertrand@systella.fr>