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 / dlapy2.f < prev    next >
Text File  |  1996-09-28  |  1KB  |  55 lines
  1.       DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
  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
  10. *     ..
  11. *
  12. *  Purpose
  13. *  =======
  14. *
  15. *  DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
  16. *  overflow.
  17. *
  18. *  Arguments
  19. *  =========
  20. *
  21. *  X       (input) DOUBLE PRECISION
  22. *  Y       (input) DOUBLE PRECISION
  23. *          X and Y specify the values x and y.
  24. *
  25. *  =====================================================================
  26. *
  27. *     .. Parameters ..
  28.       DOUBLE PRECISION   ZERO
  29.       PARAMETER          ( ZERO = 0.0D0 )
  30.       DOUBLE PRECISION   ONE
  31.       PARAMETER          ( ONE = 1.0D0 )
  32. *     ..
  33. *     .. Local Scalars ..
  34.       DOUBLE PRECISION   W, XABS, YABS, Z
  35. *     ..
  36. *     .. Intrinsic Functions ..
  37.       INTRINSIC          ABS, MAX, MIN, SQRT
  38. *     ..
  39. *     .. Executable Statements ..
  40. *
  41.       XABS = ABS( X )
  42.       YABS = ABS( Y )
  43.       W = MAX( XABS, YABS )
  44.       Z = MIN( XABS, YABS )
  45.       IF( Z.EQ.ZERO ) THEN
  46.          DLAPY2 = W
  47.       ELSE
  48.          DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
  49.       END IF
  50.       RETURN
  51. *
  52. *     End of DLAPY2
  53. *
  54.       END
  55.