From 827843bbbdb5a27019d7d679f371a3a69053c762 Mon Sep 17 00:00:00 2001
From: Gael Guennebaud <g.gael@free.fr>
Date: Wed, 12 Jun 2013 10:12:50 +0200
Subject: Complete the lapack interface to make it complete enough for
 suitesparse QR.

---
 lapack/slapy2.f | 104 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 104 insertions(+)
 create mode 100644 lapack/slapy2.f

(limited to 'lapack/slapy2.f')

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
-- 
cgit v1.2.3