aboutsummaryrefslogtreecommitdiffstats
path: root/contrib/libs/clapack/cgtcon.c
diff options
context:
space:
mode:
authorshmel1k <shmel1k@ydb.tech>2022-09-02 12:44:59 +0300
committershmel1k <shmel1k@ydb.tech>2022-09-02 12:44:59 +0300
commit90d450f74722da7859d6f510a869f6c6908fd12f (patch)
tree538c718dedc76cdfe37ad6d01ff250dd930d9278 /contrib/libs/clapack/cgtcon.c
parent01f64c1ecd0d4ffa9e3a74478335f1745f26cc75 (diff)
downloadydb-90d450f74722da7859d6f510a869f6c6908fd12f.tar.gz
[] add metering mode to CLI
Diffstat (limited to 'contrib/libs/clapack/cgtcon.c')
-rw-r--r--contrib/libs/clapack/cgtcon.c207
1 files changed, 207 insertions, 0 deletions
diff --git a/contrib/libs/clapack/cgtcon.c b/contrib/libs/clapack/cgtcon.c
new file mode 100644
index 0000000000..462a36a57c
--- /dev/null
+++ b/contrib/libs/clapack/cgtcon.c
@@ -0,0 +1,207 @@
+/* cgtcon.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 cgtcon_(char *norm, integer *n, complex *dl, complex *
+ d__, complex *du, complex *du2, integer *ipiv, real *anorm, real *
+ rcond, complex *work, integer *info)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ integer i__, kase, kase1;
+ extern logical lsame_(char *, char *);
+ integer isave[3];
+ extern /* Subroutine */ int clacn2_(integer *, complex *, complex *, real
+ *, integer *, integer *), xerbla_(char *, integer *);
+ real ainvnm;
+ logical onenrm;
+ extern /* Subroutine */ int cgttrs_(char *, integer *, integer *, complex
+ *, complex *, complex *, complex *, integer *, complex *, integer
+ *, integer *);
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* Modified to call CLACN2 in place of CLACON, 10 Feb 03, SJH. */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* CGTCON estimates the reciprocal of the condition number of a complex */
+/* tridiagonal matrix A using the LU factorization as computed by */
+/* CGTTRF. */
+
+/* An estimate is obtained for norm(inv(A)), and the reciprocal of the */
+/* condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))). */
+
+/* Arguments */
+/* ========= */
+
+/* NORM (input) CHARACTER*1 */
+/* Specifies whether the 1-norm condition number or the */
+/* infinity-norm condition number is required: */
+/* = '1' or 'O': 1-norm; */
+/* = 'I': Infinity-norm. */
+
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+
+/* DL (input) COMPLEX array, dimension (N-1) */
+/* The (n-1) multipliers that define the matrix L from the */
+/* LU factorization of A as computed by CGTTRF. */
+
+/* D (input) COMPLEX array, dimension (N) */
+/* The n diagonal elements of the upper triangular matrix U from */
+/* the LU factorization of A. */
+
+/* DU (input) COMPLEX array, dimension (N-1) */
+/* The (n-1) elements of the first superdiagonal of U. */
+
+/* DU2 (input) COMPLEX array, dimension (N-2) */
+/* The (n-2) elements of the second superdiagonal of U. */
+
+/* IPIV (input) INTEGER array, dimension (N) */
+/* The pivot indices; for 1 <= i <= n, row i of the matrix was */
+/* interchanged with row IPIV(i). IPIV(i) will always be either */
+/* i or i+1; IPIV(i) = i indicates a row interchange was not */
+/* required. */
+
+/* ANORM (input) REAL */
+/* If NORM = '1' or 'O', the 1-norm of the original matrix A. */
+/* If NORM = 'I', the infinity-norm of the original matrix A. */
+
+/* RCOND (output) REAL */
+/* The reciprocal of the condition number of the matrix A, */
+/* computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an */
+/* estimate of the 1-norm of inv(A) computed in this routine. */
+
+/* WORK (workspace) COMPLEX array, dimension (2*N) */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Local Arrays .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input arguments. */
+
+ /* Parameter adjustments */
+ --work;
+ --ipiv;
+ --du2;
+ --du;
+ --d__;
+ --dl;
+
+ /* Function Body */
+ *info = 0;
+ onenrm = *(unsigned char *)norm == '1' || lsame_(norm, "O");
+ if (! onenrm && ! lsame_(norm, "I")) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*anorm < 0.f) {
+ *info = -8;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("CGTCON", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ *rcond = 0.f;
+ if (*n == 0) {
+ *rcond = 1.f;
+ return 0;
+ } else if (*anorm == 0.f) {
+ return 0;
+ }
+
+/* Check that D(1:N) is non-zero. */
+
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ i__2 = i__;
+ if (d__[i__2].r == 0.f && d__[i__2].i == 0.f) {
+ return 0;
+ }
+/* L10: */
+ }
+
+ ainvnm = 0.f;
+ if (onenrm) {
+ kase1 = 1;
+ } else {
+ kase1 = 2;
+ }
+ kase = 0;
+L20:
+ clacn2_(n, &work[*n + 1], &work[1], &ainvnm, &kase, isave);
+ if (kase != 0) {
+ if (kase == kase1) {
+
+/* Multiply by inv(U)*inv(L). */
+
+ cgttrs_("No transpose", n, &c__1, &dl[1], &d__[1], &du[1], &du2[1]
+, &ipiv[1], &work[1], n, info);
+ } else {
+
+/* Multiply by inv(L')*inv(U'). */
+
+ cgttrs_("Conjugate transpose", n, &c__1, &dl[1], &d__[1], &du[1],
+ &du2[1], &ipiv[1], &work[1], n, info);
+ }
+ goto L20;
+ }
+
+/* Compute the estimate of the reciprocal condition number. */
+
+ if (ainvnm != 0.f) {
+ *rcond = 1.f / ainvnm / *anorm;
+ }
+
+ return 0;
+
+/* End of CGTCON */
+
+} /* cgtcon_ */