home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / lapack / dlapy3.f < prev    next >
Text File  |  1996-09-28  |  1KB  |  55 lines
  1.       DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
  2. *
  3. *  -- LAPACK auxiliary routine (version 2.0) --
  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
  55.