diff options
| author | Stanislaw Halik <sthalik@misaki.pl> | 2016-09-18 12:42:15 +0200 |
|---|---|---|
| committer | Stanislaw Halik <sthalik@misaki.pl> | 2016-11-02 15:12:04 +0100 |
| commit | 44861dcbfeee041223c4aac1ee075e92fa4daa01 (patch) | |
| tree | 6dfdfd9637846a7aedd71ace97d7d2ad366496d7 /eigen/lapack/slapy2.f | |
| parent | f3fe458b9e0a29a99a39d47d9a76dc18964b6fec (diff) | |
update
Diffstat (limited to 'eigen/lapack/slapy2.f')
| -rw-r--r-- | eigen/lapack/slapy2.f | 104 |
1 files changed, 104 insertions, 0 deletions
diff --git a/eigen/lapack/slapy2.f b/eigen/lapack/slapy2.f new file mode 100644 index 0000000..1f6b1ca --- /dev/null +++ b/eigen/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 |