[] add metering mode to CLI

1 files changed, 440 insertions, 0 deletions

diff --git a/contrib/libs/clapack/zcposv.c b/contrib/libs/clapack/zcposv.c
new file mode 100644
index 0000000000..5a2d9c93b2
--- /dev/null
+++ b/contrib/libs/clapack/zcposv.c
@@ -0,0 +1,440 @@
+/* zcposv.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 doublecomplex c_b1 = {-1.,0.};
+static doublecomplex c_b2 = {1.,0.};
+static integer c__1 = 1;
+
+/* Subroutine */ int zcposv_(char *uplo, integer *n, integer *nrhs, 
+	doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb, 
+	doublecomplex *x, integer *ldx, doublecomplex *work, complex *swork, 
+	doublereal *rwork, integer *iter, integer *info)
+{
+    /* System generated locals */
+    integer a_dim1, a_offset, b_dim1, b_offset, work_dim1, work_offset, 
+	    x_dim1, x_offset, i__1, i__2;
+    doublereal d__1, d__2;
+
+    /* Builtin functions */
+    double sqrt(doublereal), d_imag(doublecomplex *);
+
+    /* Local variables */
+    integer i__;
+    doublereal cte, eps, anrm;
+    integer ptsa;
+    doublereal rnrm, xnrm;
+    integer ptsx;
+    extern logical lsame_(char *, char *);
+    integer iiter;
+    extern /* Subroutine */ int zhemm_(char *, char *, integer *, integer *, 
+	    doublecomplex *, doublecomplex *, integer *, doublecomplex *, 
+	    integer *, doublecomplex *, doublecomplex *, integer *), zaxpy_(integer *, doublecomplex *, doublecomplex *, 
+	    integer *, doublecomplex *, integer *), zlag2c_(integer *, 
+	    integer *, doublecomplex *, integer *, complex *, integer *, 
+	    integer *), clag2z_(integer *, integer *, complex *, integer *, 
+	    doublecomplex *, integer *, integer *), zlat2c_(char *, integer *, 
+	     doublecomplex *, integer *, complex *, integer *, integer *);
+    extern doublereal dlamch_(char *);
+    extern /* Subroutine */ int xerbla_(char *, integer *);
+    extern doublereal zlanhe_(char *, char *, integer *, doublecomplex *, 
+	    integer *, doublereal *);
+    extern integer izamax_(integer *, doublecomplex *, integer *);
+    extern /* Subroutine */ int cpotrf_(char *, integer *, complex *, integer 
+	    *, integer *), zlacpy_(char *, integer *, integer *, 
+	    doublecomplex *, integer *, doublecomplex *, integer *), 
+	    cpotrs_(char *, integer *, integer *, complex *, integer *, 
+	    complex *, integer *, integer *), zpotrf_(char *, integer 
+	    *, doublecomplex *, integer *, integer *), zpotrs_(char *, 
+	     integer *, integer *, doublecomplex *, integer *, doublecomplex *
+, integer *, integer *);
+
+
+/*  -- LAPACK PROTOTYPE driver routine (version 3.2.1)                 -- */
+
+/*  -- April 2009                                                      -- */
+
+/*  -- LAPACK is a software package provided by Univ. of Tennessee,    -- */
+/*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
+/*     .. */
+/*     .. Scalar Arguments .. */
+/*     .. */
+/*     .. Array Arguments .. */
+/*     .. */
+
+/*  Purpose */
+/*  ======= */
+
+/*  ZCPOSV computes the solution to a complex system of linear equations */
+/*     A * X = B, */
+/*  where A is an N-by-N Hermitian positive definite matrix and X and B */
+/*  are N-by-NRHS matrices. */
+
+/*  ZCPOSV first attempts to factorize the matrix in COMPLEX and use this */
+/*  factorization within an iterative refinement procedure to produce a */
+/*  solution with COMPLEX*16 normwise backward error quality (see below). */
+/*  If the approach fails the method switches to a COMPLEX*16 */
+/*  factorization and solve. */
+
+/*  The iterative refinement is not going to be a winning strategy if */
+/*  the ratio COMPLEX performance over COMPLEX*16 performance is too */
+/*  small. A reasonable strategy should take the number of right-hand */
+/*  sides and the size of the matrix into account. This might be done */
+/*  with a call to ILAENV in the future. Up to now, we always try */
+/*  iterative refinement. */
+
+/*  The iterative refinement process is stopped if */
+/*      ITER > ITERMAX */
+/*  or for all the RHS we have: */
+/*      RNRM < SQRT(N)*XNRM*ANRM*EPS*BWDMAX */
+/*  where */
+/*      o ITER is the number of the current iteration in the iterative */
+/*        refinement process */
+/*      o RNRM is the infinity-norm of the residual */
+/*      o XNRM is the infinity-norm of the solution */
+/*      o ANRM is the infinity-operator-norm of the matrix A */
+/*      o EPS is the machine epsilon returned by DLAMCH('Epsilon') */
+/*  The value ITERMAX and BWDMAX are fixed to 30 and 1.0D+00 */
+/*  respectively. */
+
+/*  Arguments */
+/*  ========= */
+
+/*  UPLO    (input) CHARACTER */
+/*          = 'U':  Upper triangle of A is stored; */
+/*          = 'L':  Lower triangle of A is stored. */
+
+/*  N       (input) INTEGER */
+/*          The number of linear equations, i.e., the order of the */
+/*          matrix A.  N >= 0. */
+
+/*  NRHS    (input) INTEGER */
+/*          The number of right hand sides, i.e., the number of columns */
+/*          of the matrix B.  NRHS >= 0. */
+
+/*  A       (input or input/ouptut) COMPLEX*16 array, */
+/*          dimension (LDA,N) */
+/*          On entry, the Hermitian matrix A. If UPLO = 'U', the leading */
+/*          N-by-N upper triangular part of A contains the upper */
+/*          triangular part of the matrix A, and the strictly lower */
+/*          triangular part of A is not referenced.  If UPLO = 'L', the */
+/*          leading N-by-N lower triangular part of A contains the lower */
+/*          triangular part of the matrix A, and the strictly upper */
+/*          triangular part of A is not referenced. */
+
+/*          Note that the imaginary parts of the diagonal */
+/*          elements need not be set and are assumed to be zero. */
+
+/*          On exit, if iterative refinement has been successfully used */
+/*          (INFO.EQ.0 and ITER.GE.0, see description below), then A is */
+/*          unchanged, if double precision factorization has been used */
+/*          (INFO.EQ.0 and ITER.LT.0, see description below), then the */
+/*          array A contains the factor U or L from the Cholesky */
+/*          factorization A = U**H*U or A = L*L**H. */
+
+/*  LDA     (input) INTEGER */
+/*          The leading dimension of the array A.  LDA >= max(1,N). */
+
+/*  B       (input) COMPLEX*16 array, dimension (LDB,NRHS) */
+/*          The N-by-NRHS right hand side matrix B. */
+
+/*  LDB     (input) INTEGER */
+/*          The leading dimension of the array B.  LDB >= max(1,N). */
+
+/*  X       (output) COMPLEX*16 array, dimension (LDX,NRHS) */
+/*          If INFO = 0, the N-by-NRHS solution matrix X. */
+
+/*  LDX     (input) INTEGER */
+/*          The leading dimension of the array X.  LDX >= max(1,N). */
+
+/*  WORK    (workspace) COMPLEX*16 array, dimension (N*NRHS) */
+/*          This array is used to hold the residual vectors. */
+
+/*  SWORK   (workspace) COMPLEX array, dimension (N*(N+NRHS)) */
+/*          This array is used to use the single precision matrix and the */
+/*          right-hand sides or solutions in single precision. */
+
+/*  RWORK   (workspace) DOUBLE PRECISION array, dimension (N) */
+
+/*  ITER    (output) INTEGER */
+/*          < 0: iterative refinement has failed, COMPLEX*16 */
+/*               factorization has been performed */
+/*               -1 : the routine fell back to full precision for */
+/*                    implementation- or machine-specific reasons */
+/*               -2 : narrowing the precision induced an overflow, */
+/*                    the routine fell back to full precision */
+/*               -3 : failure of CPOTRF */
+/*               -31: stop the iterative refinement after the 30th */
+/*                    iterations */
+/*          > 0: iterative refinement has been sucessfully used. */
+/*               Returns the number of iterations */
+
+/*  INFO    (output) INTEGER */
+/*          = 0:  successful exit */
+/*          < 0:  if INFO = -i, the i-th argument had an illegal value */
+/*          > 0:  if INFO = i, the leading minor of order i of */
+/*                (COMPLEX*16) A is not positive definite, so the */
+/*                factorization could not be completed, and the solution */
+/*                has not been computed. */
+
+/*  ========= */
+
+/*     .. Parameters .. */
+
+
+
+
+/*     .. Local Scalars .. */
+
+/*     .. External Subroutines .. */
+/*     .. */
+/*     .. External Functions .. */
+/*     .. */
+/*     .. Intrinsic Functions .. */
+/*     .. Statement Functions .. */
+/*     .. */
+/*     .. Statement Function definitions .. */
+/*     .. */
+/*     .. Executable Statements .. */
+
+    /* Parameter adjustments */
+    work_dim1 = *n;
+    work_offset = 1 + work_dim1;
+    work -= work_offset;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    b_dim1 = *ldb;
+    b_offset = 1 + b_dim1;
+    b -= b_offset;
+    x_dim1 = *ldx;
+    x_offset = 1 + x_dim1;
+    x -= x_offset;
+    --swork;
+    --rwork;
+
+    /* Function Body */
+    *info = 0;
+    *iter = 0;
+
+/*     Test the input parameters. */
+
+    if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
+	*info = -1;
+    } else if (*n < 0) {
+	*info = -2;
+    } else if (*nrhs < 0) {
+	*info = -3;
+    } else if (*lda < max(1,*n)) {
+	*info = -5;
+    } else if (*ldb < max(1,*n)) {
+	*info = -7;
+    } else if (*ldx < max(1,*n)) {
+	*info = -9;
+    }
+    if (*info != 0) {
+	i__1 = -(*info);
+	xerbla_("ZCPOSV", &i__1);
+	return 0;
+    }
+
+/*     Quick return if (N.EQ.0). */
+
+    if (*n == 0) {
+	return 0;
+    }
+
+/*     Skip single precision iterative refinement if a priori slower */
+/*     than double precision factorization. */
+
+    if (FALSE_) {
+	*iter = -1;
+	goto L40;
+    }
+
+/*     Compute some constants. */
+
+    anrm = zlanhe_("I", uplo, n, &a[a_offset], lda, &rwork[1]);
+    eps = dlamch_("Epsilon");
+    cte = anrm * eps * sqrt((doublereal) (*n)) * 1.;
+
+/*     Set the indices PTSA, PTSX for referencing SA and SX in SWORK. */
+
+    ptsa = 1;
+    ptsx = ptsa + *n * *n;
+
+/*     Convert B from double precision to single precision and store the */
+/*     result in SX. */
+
+    zlag2c_(n, nrhs, &b[b_offset], ldb, &swork[ptsx], n, info);
+
+    if (*info != 0) {
+	*iter = -2;
+	goto L40;
+    }
+
+/*     Convert A from double precision to single precision and store the */
+/*     result in SA. */
+
+    zlat2c_(uplo, n, &a[a_offset], lda, &swork[ptsa], n, info);
+
+    if (*info != 0) {
+	*iter = -2;
+	goto L40;
+    }
+
+/*     Compute the Cholesky factorization of SA. */
+
+    cpotrf_(uplo, n, &swork[ptsa], n, info);
+
+    if (*info != 0) {
+	*iter = -3;
+	goto L40;
+    }
+
+/*     Solve the system SA*SX = SB. */
+
+    cpotrs_(uplo, n, nrhs, &swork[ptsa], n, &swork[ptsx], n, info);
+
+/*     Convert SX back to COMPLEX*16 */
+
+    clag2z_(n, nrhs, &swork[ptsx], n, &x[x_offset], ldx, info);
+
+/*     Compute R = B - AX (R is WORK). */
+
+    zlacpy_("All", n, nrhs, &b[b_offset], ldb, &work[work_offset], n);
+
+    zhemm_("Left", uplo, n, nrhs, &c_b1, &a[a_offset], lda, &x[x_offset], ldx, 
+	     &c_b2, &work[work_offset], n);
+
+/*     Check whether the NRHS normwise backward errors satisfy the */
+/*     stopping criterion. If yes, set ITER=0 and return. */
+
+    i__1 = *nrhs;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+	i__2 = izamax_(n, &x[i__ * x_dim1 + 1], &c__1) + i__ * x_dim1;
+	xnrm = (d__1 = x[i__2].r, abs(d__1)) + (d__2 = d_imag(&x[izamax_(n, &
+		x[i__ * x_dim1 + 1], &c__1) + i__ * x_dim1]), abs(d__2));
+	i__2 = izamax_(n, &work[i__ * work_dim1 + 1], &c__1) + i__ * 
+		work_dim1;
+	rnrm = (d__1 = work[i__2].r, abs(d__1)) + (d__2 = d_imag(&work[
+		izamax_(n, &work[i__ * work_dim1 + 1], &c__1) + i__ * 
+		work_dim1]), abs(d__2));
+	if (rnrm > xnrm * cte) {
+	    goto L10;
+	}
+    }
+
+/*     If we are here, the NRHS normwise backward errors satisfy the */
+/*     stopping criterion. We are good to exit. */
+
+    *iter = 0;
+    return 0;
+
+L10:
+
+    for (iiter = 1; iiter <= 30; ++iiter) {
+
+/*        Convert R (in WORK) from double precision to single precision */
+/*        and store the result in SX. */
+
+	zlag2c_(n, nrhs, &work[work_offset], n, &swork[ptsx], n, info);
+
+	if (*info != 0) {
+	    *iter = -2;
+	    goto L40;
+	}
+
+/*        Solve the system SA*SX = SR. */
+
+	cpotrs_(uplo, n, nrhs, &swork[ptsa], n, &swork[ptsx], n, info);
+
+/*        Convert SX back to double precision and update the current */
+/*        iterate. */
+
+	clag2z_(n, nrhs, &swork[ptsx], n, &work[work_offset], n, info);
+
+	i__1 = *nrhs;
+	for (i__ = 1; i__ <= i__1; ++i__) {
+	    zaxpy_(n, &c_b2, &work[i__ * work_dim1 + 1], &c__1, &x[i__ * 
+		    x_dim1 + 1], &c__1);
+	}
+
+/*        Compute R = B - AX (R is WORK). */
+
+	zlacpy_("All", n, nrhs, &b[b_offset], ldb, &work[work_offset], n);
+
+	zhemm_("L", uplo, n, nrhs, &c_b1, &a[a_offset], lda, &x[x_offset], 
+		ldx, &c_b2, &work[work_offset], n);
+
+/*        Check whether the NRHS normwise backward errors satisfy the */
+/*        stopping criterion. If yes, set ITER=IITER>0 and return. */
+
+	i__1 = *nrhs;
+	for (i__ = 1; i__ <= i__1; ++i__) {
+	    i__2 = izamax_(n, &x[i__ * x_dim1 + 1], &c__1) + i__ * x_dim1;
+	    xnrm = (d__1 = x[i__2].r, abs(d__1)) + (d__2 = d_imag(&x[izamax_(
+		    n, &x[i__ * x_dim1 + 1], &c__1) + i__ * x_dim1]), abs(
+		    d__2));
+	    i__2 = izamax_(n, &work[i__ * work_dim1 + 1], &c__1) + i__ * 
+		    work_dim1;
+	    rnrm = (d__1 = work[i__2].r, abs(d__1)) + (d__2 = d_imag(&work[
+		    izamax_(n, &work[i__ * work_dim1 + 1], &c__1) + i__ * 
+		    work_dim1]), abs(d__2));
+	    if (rnrm > xnrm * cte) {
+		goto L20;
+	    }
+	}
+
+/*        If we are here, the NRHS normwise backward errors satisfy the */
+/*        stopping criterion, we are good to exit. */
+
+	*iter = iiter;
+
+	return 0;
+
+L20:
+
+/* L30: */
+	;
+    }
+
+/*     If we are at this place of the code, this is because we have */
+/*     performed ITER=ITERMAX iterations and never satisified the */
+/*     stopping criterion, set up the ITER flag accordingly and follow */
+/*     up on double precision routine. */
+
+    *iter = -31;
+
+L40:
+
+/*     Single-precision iterative refinement failed to converge to a */
+/*     satisfactory solution, so we resort to double precision. */
+
+    zpotrf_(uplo, n, &a[a_offset], lda, info);
+
+    if (*info != 0) {
+	return 0;
+    }
+
+    zlacpy_("All", n, nrhs, &b[b_offset], ldb, &x[x_offset], ldx);
+    zpotrs_(uplo, n, nrhs, &a[a_offset], lda, &x[x_offset], ldx, info);
+
+    return 0;
+
+/*     End of ZCPOSV. */
+
+} /* zcposv_ */