d3/d02/slapy2_8f_source.html

00001       REAL             FUNCTION SLAPY2( X, Y )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       REAL               X, Y
00010 *     ..
00011 *
00012 *  Purpose
00013 *  =======
00014 *
00015 *  SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
00016 *  overflow.
00017 *
00018 *  Arguments
00019 *  =========
00020 *
00021 *  X       (input) REAL
00022 *  Y       (input) REAL
00023 *          X and Y specify the values x and y.
00024 *
00025 *  =====================================================================
00026 *
00027 *     .. Parameters ..
00028       REAL               ZERO
00029       PARAMETER          ( ZERO = 0.0E0 )
00030       REAL               ONE
00031       PARAMETER          ( ONE = 1.0E0 )
00032 *     ..
00033 *     .. Local Scalars ..
00034       REAL               W, XABS, YABS, Z
00035 *     ..
00036 *     .. Intrinsic Functions ..
00037       INTRINSIC          ABS, MAX, MIN, SQRT
00038 *     ..
00039 *     .. Executable Statements ..
00040 *
00041       XABS = ABS( X )
00042       YABS = ABS( Y )
00043       W = MAX( XABS, YABS )
00044       Z = MIN( XABS, YABS )
00045       IF( Z.EQ.ZERO ) THEN
00046          SLAPY2 = W
00047       ELSE
00048          SLAPY2 = W*SQRT( ONE+( Z / W )**2 )
00049       END IF
00050       RETURN
00051 *
00052 *     End of SLAPY2
00053 *
00054       END