[] add metering mode to CLI

1 files changed, 275 insertions, 0 deletions

diff --git a/contrib/libs/clapack/clacon.c b/contrib/libs/clapack/clacon.c
new file mode 100644
index 0000000000..f77e3dc7bd
--- /dev/null
+++ b/contrib/libs/clapack/clacon.c
@@ -0,0 +1,275 @@
+/* clacon.f -- translated by f2c (version 20061008).
+   You must link the resulting object file with libf2c:
+	on Microsoft Windows system, link with libf2c.lib;
+	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+	or, if you install libf2c.a in a standard place, with -lf2c -lm
+	-- in that order, at the end of the command line, as in
+		cc *.o -lf2c -lm
+	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+		http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+
+/* Subroutine */ int clacon_(integer *n, complex *v, complex *x, real *est, 
+	integer *kase)
+{
+    /* System generated locals */
+    integer i__1, i__2, i__3;
+    real r__1, r__2;
+    complex q__1;
+
+    /* Builtin functions */
+    double c_abs(complex *), r_imag(complex *);
+
+    /* Local variables */
+    static integer i__, j, iter;
+    static real temp;
+    static integer jump;
+    static real absxi;
+    static integer jlast;
+    extern /* Subroutine */ int ccopy_(integer *, complex *, integer *, 
+	    complex *, integer *);
+    extern integer icmax1_(integer *, complex *, integer *);
+    extern doublereal scsum1_(integer *, complex *, integer *), slamch_(char *
+);
+    static real safmin, altsgn, estold;
+
+
+/*  -- LAPACK auxiliary routine (version 3.2) -- */
+/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/*     November 2006 */
+
+/*     .. Scalar Arguments .. */
+/*     .. */
+/*     .. Array Arguments .. */
+/*     .. */
+
+/*  Purpose */
+/*  ======= */
+
+/*  CLACON estimates the 1-norm of a square, complex matrix A. */
+/*  Reverse communication is used for evaluating matrix-vector products. */
+
+/*  Arguments */
+/*  ========= */
+
+/*  N      (input) INTEGER */
+/*         The order of the matrix.  N >= 1. */
+
+/*  V      (workspace) COMPLEX array, dimension (N) */
+/*         On the final return, V = A*W,  where  EST = norm(V)/norm(W) */
+/*         (W is not returned). */
+
+/*  X      (input/output) COMPLEX array, dimension (N) */
+/*         On an intermediate return, X should be overwritten by */
+/*               A * X,   if KASE=1, */
+/*               A' * X,  if KASE=2, */
+/*         where A' is the conjugate transpose of A, and CLACON must be */
+/*         re-called with all the other parameters unchanged. */
+
+/*  EST    (input/output) REAL */
+/*         On entry with KASE = 1 or 2 and JUMP = 3, EST should be */
+/*         unchanged from the previous call to CLACON. */
+/*         On exit, EST is an estimate (a lower bound) for norm(A). */
+
+/*  KASE   (input/output) INTEGER */
+/*         On the initial call to CLACON, KASE should be 0. */
+/*         On an intermediate return, KASE will be 1 or 2, indicating */
+/*         whether X should be overwritten by A * X  or A' * X. */
+/*         On the final return from CLACON, KASE will again be 0. */
+
+/*  Further Details */
+/*  ======= ======= */
+
+/*  Contributed by Nick Higham, University of Manchester. */
+/*  Originally named CONEST, dated March 16, 1988. */
+
+/*  Reference: N.J. Higham, "FORTRAN codes for estimating the one-norm of */
+/*  a real or complex matrix, with applications to condition estimation", */
+/*  ACM Trans. Math. Soft., vol. 14, no. 4, pp. 381-396, December 1988. */
+
+/*  Last modified:  April, 1999 */
+
+/*  ===================================================================== */
+
+/*     .. Parameters .. */
+/*     .. */
+/*     .. Local Scalars .. */
+/*     .. */
+/*     .. External Functions .. */
+/*     .. */
+/*     .. External Subroutines .. */
+/*     .. */
+/*     .. Intrinsic Functions .. */
+/*     .. */
+/*     .. Save statement .. */
+/*     .. */
+/*     .. Executable Statements .. */
+
+    /* Parameter adjustments */
+    --x;
+    --v;
+
+    /* Function Body */
+    safmin = slamch_("Safe minimum");
+    if (*kase == 0) {
+	i__1 = *n;
+	for (i__ = 1; i__ <= i__1; ++i__) {
+	    i__2 = i__;
+	    r__1 = 1.f / (real) (*n);
+	    q__1.r = r__1, q__1.i = 0.f;
+	    x[i__2].r = q__1.r, x[i__2].i = q__1.i;
+/* L10: */
+	}
+	*kase = 1;
+	jump = 1;
+	return 0;
+    }
+
+    switch (jump) {
+	case 1:  goto L20;
+	case 2:  goto L40;
+	case 3:  goto L70;
+	case 4:  goto L90;
+	case 5:  goto L120;
+    }
+
+/*     ................ ENTRY   (JUMP = 1) */
+/*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY A*X. */
+
+L20:
+    if (*n == 1) {
+	v[1].r = x[1].r, v[1].i = x[1].i;
+	*est = c_abs(&v[1]);
+/*        ... QUIT */
+	goto L130;
+    }
+    *est = scsum1_(n, &x[1], &c__1);
+
+    i__1 = *n;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+	absxi = c_abs(&x[i__]);
+	if (absxi > safmin) {
+	    i__2 = i__;
+	    i__3 = i__;
+	    r__1 = x[i__3].r / absxi;
+	    r__2 = r_imag(&x[i__]) / absxi;
+	    q__1.r = r__1, q__1.i = r__2;
+	    x[i__2].r = q__1.r, x[i__2].i = q__1.i;
+	} else {
+	    i__2 = i__;
+	    x[i__2].r = 1.f, x[i__2].i = 0.f;
+	}
+/* L30: */
+    }
+    *kase = 2;
+    jump = 2;
+    return 0;
+
+/*     ................ ENTRY   (JUMP = 2) */
+/*     FIRST ITERATION.  X HAS BEEN OVERWRITTEN BY CTRANS(A)*X. */
+
+L40:
+    j = icmax1_(n, &x[1], &c__1);
+    iter = 2;
+
+/*     MAIN LOOP - ITERATIONS 2,3,...,ITMAX. */
+
+L50:
+    i__1 = *n;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+	i__2 = i__;
+	x[i__2].r = 0.f, x[i__2].i = 0.f;
+/* L60: */
+    }
+    i__1 = j;
+    x[i__1].r = 1.f, x[i__1].i = 0.f;
+    *kase = 1;
+    jump = 3;
+    return 0;
+
+/*     ................ ENTRY   (JUMP = 3) */
+/*     X HAS BEEN OVERWRITTEN BY A*X. */
+
+L70:
+    ccopy_(n, &x[1], &c__1, &v[1], &c__1);
+    estold = *est;
+    *est = scsum1_(n, &v[1], &c__1);
+
+/*     TEST FOR CYCLING. */
+    if (*est <= estold) {
+	goto L100;
+    }
+
+    i__1 = *n;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+	absxi = c_abs(&x[i__]);
+	if (absxi > safmin) {
+	    i__2 = i__;
+	    i__3 = i__;
+	    r__1 = x[i__3].r / absxi;
+	    r__2 = r_imag(&x[i__]) / absxi;
+	    q__1.r = r__1, q__1.i = r__2;
+	    x[i__2].r = q__1.r, x[i__2].i = q__1.i;
+	} else {
+	    i__2 = i__;
+	    x[i__2].r = 1.f, x[i__2].i = 0.f;
+	}
+/* L80: */
+    }
+    *kase = 2;
+    jump = 4;
+    return 0;
+
+/*     ................ ENTRY   (JUMP = 4) */
+/*     X HAS BEEN OVERWRITTEN BY CTRANS(A)*X. */
+
+L90:
+    jlast = j;
+    j = icmax1_(n, &x[1], &c__1);
+    if (c_abs(&x[jlast]) != c_abs(&x[j]) && iter < 5) {
+	++iter;
+	goto L50;
+    }
+
+/*     ITERATION COMPLETE.  FINAL STAGE. */
+
+L100:
+    altsgn = 1.f;
+    i__1 = *n;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+	i__2 = i__;
+	r__1 = altsgn * ((real) (i__ - 1) / (real) (*n - 1) + 1.f);
+	q__1.r = r__1, q__1.i = 0.f;
+	x[i__2].r = q__1.r, x[i__2].i = q__1.i;
+	altsgn = -altsgn;
+/* L110: */
+    }
+    *kase = 1;
+    jump = 5;
+    return 0;
+
+/*     ................ ENTRY   (JUMP = 5) */
+/*     X HAS BEEN OVERWRITTEN BY A*X. */
+
+L120:
+    temp = scsum1_(n, &x[1], &c__1) / (real) (*n * 3) * 2.f;
+    if (temp > *est) {
+	ccopy_(n, &x[1], &c__1, &v[1], &c__1);
+	*est = temp;
+    }
+
+L130:
+    *kase = 0;
+    return 0;
+
+/*     End of CLACON */
+
+} /* clacon_ */