![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLAPY3 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SLAPY3 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapy3.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapy3.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapy3.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * REAL FUNCTION SLAPY3( X, Y, Z ) 00022 * 00023 * .. Scalar Arguments .. 00024 * REAL X, Y, Z 00025 * .. 00026 * 00027 * 00028 *> \par Purpose: 00029 * ============= 00030 *> 00031 *> \verbatim 00032 *> 00033 *> SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause 00034 *> unnecessary overflow. 00035 *> \endverbatim 00036 * 00037 * Arguments: 00038 * ========== 00039 * 00040 *> \param[in] X 00041 *> \verbatim 00042 *> X is REAL 00043 *> \endverbatim 00044 *> 00045 *> \param[in] Y 00046 *> \verbatim 00047 *> Y is REAL 00048 *> \endverbatim 00049 *> 00050 *> \param[in] Z 00051 *> \verbatim 00052 *> Z is REAL 00053 *> X, Y and Z specify the values x, y and z. 00054 *> \endverbatim 00055 * 00056 * Authors: 00057 * ======== 00058 * 00059 *> \author Univ. of Tennessee 00060 *> \author Univ. of California Berkeley 00061 *> \author Univ. of Colorado Denver 00062 *> \author NAG Ltd. 00063 * 00064 *> \date November 2011 00065 * 00066 *> \ingroup auxOTHERauxiliary 00067 * 00068 * ===================================================================== 00069 REAL FUNCTION SLAPY3( X, Y, Z ) 00070 * 00071 * -- LAPACK auxiliary routine (version 3.4.0) -- 00072 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00073 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00074 * November 2011 00075 * 00076 * .. Scalar Arguments .. 00077 REAL X, Y, Z 00078 * .. 00079 * 00080 * ===================================================================== 00081 * 00082 * .. Parameters .. 00083 REAL ZERO 00084 PARAMETER ( ZERO = 0.0E0 ) 00085 * .. 00086 * .. Local Scalars .. 00087 REAL W, XABS, YABS, ZABS 00088 * .. 00089 * .. Intrinsic Functions .. 00090 INTRINSIC ABS, MAX, SQRT 00091 * .. 00092 * .. Executable Statements .. 00093 * 00094 XABS = ABS( X ) 00095 YABS = ABS( Y ) 00096 ZABS = ABS( Z ) 00097 W = MAX( XABS, YABS, ZABS ) 00098 IF( W.EQ.ZERO ) THEN 00099 * W can be zero for max(0,nan,0) 00100 * adding all three entries together will make sure 00101 * NaN will not disappear. 00102 SLAPY3 = XABS + YABS + ZABS 00103 ELSE 00104 SLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+ 00105 $ ( ZABS / W )**2 ) 00106 END IF 00107 RETURN 00108 * 00109 * End of SLAPY3 00110 * 00111 END