Home | History | Annotate | Download | only in lapack
      1 *> \brief \b SLAPY2
      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 November 2011
     60 *
     61 *> \ingroup auxOTHERauxiliary
     62 *
     63 *  =====================================================================
     64       REAL             FUNCTION SLAPY2( X, Y )
     65 *
     66 *  -- LAPACK auxiliary routine (version 3.4.0) --
     67 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
     68 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
     69 *     November 2011
     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
    105