X-Git-Url: http://git.maemo.org/git/?p=opencv;a=blobdiff_plain;f=3rdparty%2Flapack%2Fslarrc.c;fp=3rdparty%2Flapack%2Fslarrc.c;h=44847ddb84d539953a380df47358f66255d5f78b;hp=0000000000000000000000000000000000000000;hb=e4c14cdbdf2fe805e79cd96ded236f57e7b89060;hpb=454138ff8a20f6edb9b65a910101403d8b520643

diff --git a/3rdparty/lapack/slarrc.c b/3rdparty/lapack/slarrc.c
new file mode 100644
index 0000000..44847dd
--- /dev/null
+++ b/3rdparty/lapack/slarrc.c
@@ -0,0 +1,170 @@
+#include "clapack.h"
+
+/* Subroutine */ int slarrc_(char *jobt, integer *n, real *vl, real *vu, real 
+	*d__, real *e, real *pivmin, integer *eigcnt, integer *lcnt, integer *
+	rcnt, integer *info)
+{
+    /* System generated locals */
+    integer i__1;
+    real r__1;
+
+    /* Local variables */
+    integer i__;
+    real sl, su, tmp, tmp2;
+    logical matt;
+    extern logical lsame_(char *, char *);
+    real lpivot, rpivot;
+
+
+/*  -- LAPACK auxiliary routine (version 3.1) -- */
+/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/*     November 2006 */
+
+/*     .. Scalar Arguments .. */
+/*     .. */
+/*     .. Array Arguments .. */
+/*     .. */
+
+/*  Purpose */
+/*  ======= */
+
+/*  Find the number of eigenvalues of the symmetric tridiagonal matrix T */
+/*  that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T */
+/*  if JOBT = 'L'. */
+
+/*  Arguments */
+/*  ========= */
+
+/*  JOBT    (input) CHARACTER*1 */
+/*          = 'T':  Compute Sturm count for matrix T. */
+/*          = 'L':  Compute Sturm count for matrix L D L^T. */
+
+/*  N       (input) INTEGER */
+/*          The order of the matrix. N > 0. */
+
+/*  VL      (input) DOUBLE PRECISION */
+/*  VU      (input) DOUBLE PRECISION */
+/*          The lower and upper bounds for the eigenvalues. */
+
+/*  D       (input) DOUBLE PRECISION array, dimension (N) */
+/*          JOBT = 'T': The N diagonal elements of the tridiagonal matrix T. */
+/*          JOBT = 'L': The N diagonal elements of the diagonal matrix D. */
+
+/*  E       (input) DOUBLE PRECISION array, dimension (N) */
+/*          JOBT = 'T': The N-1 offdiagonal elements of the matrix T. */
+/*          JOBT = 'L': The N-1 offdiagonal elements of the matrix L. */
+
+/*  PIVMIN  (input) DOUBLE PRECISION */
+/*          The minimum pivot in the Sturm sequence for T. */
+
+/*  EIGCNT  (output) INTEGER */
+/*          The number of eigenvalues of the symmetric tridiagonal matrix T */
+/*          that are in the interval (VL,VU] */
+
+/*  LCNT    (output) INTEGER */
+/*  RCNT    (output) INTEGER */
+/*          The left and right negcounts of the interval. */
+
+/*  INFO    (output) INTEGER */
+
+/*  Further Details */
+/*  =============== */
+
+/*  Based on contributions by */
+/*     Beresford Parlett, University of California, Berkeley, USA */
+/*     Jim Demmel, University of California, Berkeley, USA */
+/*     Inderjit Dhillon, University of Texas, Austin, USA */
+/*     Osni Marques, LBNL/NERSC, USA */
+/*     Christof Voemel, University of California, Berkeley, USA */
+
+/*  ===================================================================== */
+
+/*     .. Parameters .. */
+/*     .. */
+/*     .. Local Scalars .. */
+/*     .. */
+/*     .. External Functions .. */
+/*     .. */
+/*     .. Executable Statements .. */
+
+    /* Parameter adjustments */
+    --e;
+    --d__;
+
+    /* Function Body */
+    *info = 0;
+    *lcnt = 0;
+    *rcnt = 0;
+    *eigcnt = 0;
+    matt = lsame_(jobt, "T");
+    if (matt) {
+/*        Sturm sequence count on T */
+	lpivot = d__[1] - *vl;
+	rpivot = d__[1] - *vu;
+	if (lpivot <= 0.f) {
+	    ++(*lcnt);
+	}
+	if (rpivot <= 0.f) {
+	    ++(*rcnt);
+	}
+	i__1 = *n - 1;
+	for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing 2nd power */
+	    r__1 = e[i__];
+	    tmp = r__1 * r__1;
+	    lpivot = d__[i__ + 1] - *vl - tmp / lpivot;
+	    rpivot = d__[i__ + 1] - *vu - tmp / rpivot;
+	    if (lpivot <= 0.f) {
+		++(*lcnt);
+	    }
+	    if (rpivot <= 0.f) {
+		++(*rcnt);
+	    }
+/* L10: */
+	}
+    } else {
+/*        Sturm sequence count on L D L^T */
+	sl = -(*vl);
+	su = -(*vu);
+	i__1 = *n - 1;
+	for (i__ = 1; i__ <= i__1; ++i__) {
+	    lpivot = d__[i__] + sl;
+	    rpivot = d__[i__] + su;
+	    if (lpivot <= 0.f) {
+		++(*lcnt);
+	    }
+	    if (rpivot <= 0.f) {
+		++(*rcnt);
+	    }
+	    tmp = e[i__] * d__[i__] * e[i__];
+
+	    tmp2 = tmp / lpivot;
+	    if (tmp2 == 0.f) {
+		sl = tmp - *vl;
+	    } else {
+		sl = sl * tmp2 - *vl;
+	    }
+
+	    tmp2 = tmp / rpivot;
+	    if (tmp2 == 0.f) {
+		su = tmp - *vu;
+	    } else {
+		su = su * tmp2 - *vu;
+	    }
+/* L20: */
+	}
+	lpivot = d__[*n] + sl;
+	rpivot = d__[*n] + su;
+	if (lpivot <= 0.f) {
+	    ++(*lcnt);
+	}
+	if (rpivot <= 0.f) {
+	    ++(*rcnt);
+	}
+    }
+    *eigcnt = *rcnt - *lcnt;
+    return 0;
+
+/*     end of SLARRC */
+
+} /* slarrc_ */