X-Git-Url: https://vcs.maemo.org/git/?a=blobdiff_plain;f=3rdparty%2Flapack%2Fsnrm2.c;fp=3rdparty%2Flapack%2Fsnrm2.c;h=7e9a209341c6a3f48532807636c6bf8f1c007fa3;hb=e4c14cdbdf2fe805e79cd96ded236f57e7b89060;hp=0000000000000000000000000000000000000000;hpb=454138ff8a20f6edb9b65a910101403d8b520643;p=opencv

diff --git a/3rdparty/lapack/snrm2.c b/3rdparty/lapack/snrm2.c
new file mode 100644
index 0000000..7e9a209
--- /dev/null
+++ b/3rdparty/lapack/snrm2.c
@@ -0,0 +1,84 @@
+#include "clapack.h"
+
+doublereal snrm2_(integer *n, real *x, integer *incx)
+{
+    /* System generated locals */
+    integer i__1, i__2;
+    real ret_val, r__1;
+
+    /* Builtin functions */
+    double sqrt(doublereal);
+
+    /* Local variables */
+    integer ix;
+    real ssq, norm, scale, absxi;
+
+/*     .. Scalar Arguments .. */
+/*     .. */
+/*     .. Array Arguments .. */
+/*     .. */
+
+/*  Purpose */
+/*  ======= */
+
+/*  SNRM2 returns the euclidean norm of a vector via the function */
+/*  name, so that */
+
+/*     SNRM2 := sqrt( x'*x ). */
+
+/*  Further Details */
+/*  =============== */
+
+/*  -- This version written on 25-October-1982. */
+/*     Modified on 14-October-1993 to inline the call to SLASSQ. */
+/*     Sven Hammarling, Nag Ltd. */
+
+
+/*     .. Parameters .. */
+/*     .. */
+/*     .. Local Scalars .. */
+/*     .. */
+/*     .. Intrinsic Functions .. */
+/*     .. */
+    /* Parameter adjustments */
+    --x;
+
+    /* Function Body */
+    if (*n < 1 || *incx < 1) {
+	norm = 0.f;
+    } else if (*n == 1) {
+	norm = dabs(x[1]);
+    } else {
+	scale = 0.f;
+	ssq = 1.f;
+/*        The following loop is equivalent to this call to the LAPACK */
+/*        auxiliary routine: */
+/*        CALL SLASSQ( N, X, INCX, SCALE, SSQ ) */
+
+	i__1 = (*n - 1) * *incx + 1;
+	i__2 = *incx;
+	for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
+	    if (x[ix] != 0.f) {
+		absxi = (r__1 = x[ix], dabs(r__1));
+		if (scale < absxi) {
+/* Computing 2nd power */
+		    r__1 = scale / absxi;
+		    ssq = ssq * (r__1 * r__1) + 1.f;
+		    scale = absxi;
+		} else {
+/* Computing 2nd power */
+		    r__1 = absxi / scale;
+		    ssq += r__1 * r__1;
+		}
+	    }
+/* L10: */
+	}
+	norm = scale * sqrt(ssq);
+    }
+
+    ret_val = norm;
+    return ret_val;
+
+/*     End of SNRM2. */
+
+} /* snrm2_ */