SRC/slapy2.f

   1 *> \brief \b SLAPY2 returns sqrt(x2+y2).
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download SLAPY2 + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapy2.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapy2.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapy2.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       REAL             FUNCTION SLAPY2( X, Y )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       REAL               X, Y
  25 *       ..
  26 *
  27 *
  28 *> \par Purpose:
  29 *  =============
  30 *>
  31 *> \verbatim
  32 *>
  33 *> SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
  34 *> overflow.
  35 *> \endverbatim
  36 *
  37 *  Arguments:
  38 *  ==========
  39 *
  40 *> \param[in] X
  41 *> \verbatim
  42 *>          X is REAL
  43 *> \endverbatim
  44 *>
  45 *> \param[in] Y
  46 *> \verbatim
  47 *>          Y is REAL
  48 *>          X and Y specify the values x and y.
  49 *> \endverbatim
  50 *
  51 *  Authors:
  52 *  ========
  53 *
  54 *> \author Univ. of Tennessee
  55 *> \author Univ. of California Berkeley
  56 *> \author Univ. of Colorado Denver
  57 *> \author NAG Ltd.
  58 *
  59 *> \date September 2012
  60 *
  61 *> \ingroup OTHERauxiliary
  62 *
  63 *  =====================================================================
  64       REAL             FUNCTION SLAPY2( X, Y )
  65 *
  66 *  -- LAPACK auxiliary routine (version 3.4.2) --
  67 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  68 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  69 *     September 2012
  70 *
  71 *     .. Scalar Arguments ..
  72       REAL               X, Y
  73 *     ..
  74 *
  75 *  =====================================================================
  76 *
  77 *     .. Parameters ..
  78       REAL               ZERO
  79       PARAMETER          ( ZERO = 0.0E0 )
  80       REAL               ONE
  81       PARAMETER          ( ONE = 1.0E0 )
  82 *     ..
  83 *     .. Local Scalars ..
  84       REAL               W, XABS, YABS, Z
  85 *     ..
  86 *     .. Intrinsic Functions ..
  87       INTRINSIC          ABS, MAX, MIN, SQRT
  88 *     ..
  89 *     .. Executable Statements ..
  90 *
  91       XABS = ABS( X )
  92       YABS = ABS( Y )
  93       W = MAX( XABS, YABS )
  94       Z = MIN( XABS, YABS )
  95       IF( Z.EQ.ZERO ) THEN
  96          SLAPY2 = W
  97       ELSE
  98          SLAPY2 = W*SQRT( ONE+( Z / W )**2 )
  99       END IF
 100       RETURN
 101 *
 102 *     End of SLAPY2
 103 *
 104       END