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