diff options
| author |  Gael Guennebaud <g.gael@free.fr> | 2013-06-12 10:12:50 +0200 |
|---|---|---|
| committer | Gael Guennebaud <g.gael@free.fr> | 2013-06-12 10:12:50 +0200 |
| commit | 827843bbbdb5a27019d7d679f371a3a69053c762 (patch) | |
| tree | 21fb96e9f4d721dac0e2248ce93b07a86d090ad8 /lapack/slapy2.f | |
| parent | 76f48205603ba1ea89022dff9537383171d69d53 (diff) | |
Complete the lapack interface to make it complete enough for suitesparse QR.
Diffstat (limited to 'lapack/slapy2.f')
| -rw-r--r-- | lapack/slapy2.f | 104 |
1 files changed, 104 insertions, 0 deletions
diff --git a/lapack/slapy2.f b/lapack/slapy2.f new file mode 100644 index 000000000..1f6b1ca4f --- /dev/null +++ b/lapack/slapy2.f @@ -0,0 +1,104 @@ +*> \brief \b SLAPY2 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download SLAPY2 + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapy2.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapy2.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapy2.f"> +*> [TXT]</a> +*> \endhtmlonly +* +* Definition: +* =========== +* +* REAL FUNCTION SLAPY2( X, Y ) +* +* .. Scalar Arguments .. +* REAL X, Y +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary +*> overflow. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] X +*> \verbatim +*> X is REAL +*> \endverbatim +*> +*> \param[in] Y +*> \verbatim +*> Y is REAL +*> X and Y specify the values x and y. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2011 +* +*> \ingroup auxOTHERauxiliary +* +* ===================================================================== + REAL FUNCTION SLAPY2( X, Y ) +* +* -- LAPACK auxiliary routine (version 3.4.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2011 +* +* .. Scalar Arguments .. + REAL X, Y +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ZERO + PARAMETER ( ZERO = 0.0E0 ) + REAL ONE + PARAMETER ( ONE = 1.0E0 ) +* .. +* .. Local Scalars .. + REAL W, XABS, YABS, Z +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, MIN, SQRT +* .. +* .. Executable Statements .. +* + XABS = ABS( X ) + YABS = ABS( Y ) + W = MAX( XABS, YABS ) + Z = MIN( XABS, YABS ) + IF( Z.EQ.ZERO ) THEN + SLAPY2 = W + ELSE + SLAPY2 = W*SQRT( ONE+( Z / W )**2 ) + END IF + RETURN +* +* End of SLAPY2 +* + END |