--- rpl/lapack/lapack/dlapy3.f 2010/08/06 15:32:27 1.4 +++ rpl/lapack/lapack/dlapy3.f 2023/08/07 08:38:55 1.18 @@ -1,28 +1,79 @@ +*> \brief \b DLAPY3 returns sqrt(x2+y2+z2). +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DLAPY3 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z ) +* +* .. Scalar Arguments .. +* DOUBLE PRECISION X, Y, Z +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause +*> unnecessary overflow and unnecessary underflow. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] X +*> \verbatim +*> X is DOUBLE PRECISION +*> \endverbatim +*> +*> \param[in] Y +*> \verbatim +*> Y is DOUBLE PRECISION +*> \endverbatim +*> +*> \param[in] Z +*> \verbatim +*> Z is DOUBLE PRECISION +*> X, Y and Z specify the values x, y and z. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \ingroup OTHERauxiliary +* +* ===================================================================== DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z ) * -* -- LAPACK auxiliary routine (version 3.2) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2006 * * .. Scalar Arguments .. DOUBLE PRECISION X, Y, Z * .. * -* Purpose -* ======= -* -* DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause -* unnecessary overflow. -* -* Arguments -* ========= -* -* X (input) DOUBLE PRECISION -* Y (input) DOUBLE PRECISION -* Z (input) DOUBLE PRECISION -* X, Y and Z specify the values x, y and z. -* * ===================================================================== * * .. Parameters .. @@ -30,18 +81,22 @@ PARAMETER ( ZERO = 0.0D0 ) * .. * .. Local Scalars .. - DOUBLE PRECISION W, XABS, YABS, ZABS + DOUBLE PRECISION W, XABS, YABS, ZABS, HUGEVAL +* .. +* .. External Subroutines .. + DOUBLE PRECISION DLAMCH * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, SQRT * .. * .. Executable Statements .. * + HUGEVAL = DLAMCH( 'Overflow' ) XABS = ABS( X ) YABS = ABS( Y ) ZABS = ABS( Z ) W = MAX( XABS, YABS, ZABS ) - IF( W.EQ.ZERO ) THEN + IF( W.EQ.ZERO .OR. W.GT.HUGEVAL ) THEN * W can be zero for max(0,nan,0) * adding all three entries together will make sure * NaN will not disappear.