d0/d30/slapy3_8f_source.html

00001       REAL             FUNCTION SLAPY3( X, Y, Z )
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, Z
00010 *     ..
00011 *
00012 *  Purpose
00013 *  =======
00014 *
00015 *  SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
00016 *  unnecessary overflow.
00017 *
00018 *  Arguments
00019 *  =========
00020 *
00021 *  X       (input) REAL
00022 *  Y       (input) REAL
00023 *  Z       (input) REAL
00024 *          X, Y and Z specify the values x, y and z.
00025 *
00026 *  =====================================================================
00027 *
00028 *     .. Parameters ..
00029       REAL               ZERO
00030       PARAMETER          ( ZERO = 0.0E0 )
00031 *     ..
00032 *     .. Local Scalars ..
00033       REAL               W, XABS, YABS, ZABS
00034 *     ..
00035 *     .. Intrinsic Functions ..
00036       INTRINSIC          ABS, MAX, SQRT
00037 *     ..
00038 *     .. Executable Statements ..
00039 *
00040       XABS = ABS( X )
00041       YABS = ABS( Y )
00042       ZABS = ABS( Z )
00043       W = MAX( XABS, YABS, ZABS )
00044       IF( W.EQ.ZERO ) THEN
00045 *     W can be zero for max(0,nan,0)
00046 *     adding all three entries together will make sure
00047 *     NaN will not disappear.
00048          SLAPY3 =  XABS + YABS + ZABS
00049       ELSE
00050          SLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
00051      $            ( ZABS / W )**2 )
00052       END IF
00053       RETURN
00054 *
00055 *     End of SLAPY3
00056 *
00057       END