diff options
author | shmel1k <shmel1k@ydb.tech> | 2022-09-02 12:44:59 +0300 |
---|---|---|
committer | shmel1k <shmel1k@ydb.tech> | 2022-09-02 12:44:59 +0300 |
commit | 90d450f74722da7859d6f510a869f6c6908fd12f (patch) | |
tree | 538c718dedc76cdfe37ad6d01ff250dd930d9278 /contrib/libs/clapack/cgeql2.c | |
parent | 01f64c1ecd0d4ffa9e3a74478335f1745f26cc75 (diff) | |
download | ydb-90d450f74722da7859d6f510a869f6c6908fd12f.tar.gz |
[] add metering mode to CLI
Diffstat (limited to 'contrib/libs/clapack/cgeql2.c')
-rw-r--r-- | contrib/libs/clapack/cgeql2.c | 167 |
1 files changed, 167 insertions, 0 deletions
diff --git a/contrib/libs/clapack/cgeql2.c b/contrib/libs/clapack/cgeql2.c new file mode 100644 index 0000000000..e26141146f --- /dev/null +++ b/contrib/libs/clapack/cgeql2.c @@ -0,0 +1,167 @@ +/* cgeql2.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 cgeql2_(integer *m, integer *n, complex *a, integer *lda, + complex *tau, complex *work, integer *info) +{ + /* System generated locals */ + integer a_dim1, a_offset, i__1, i__2; + complex q__1; + + /* Builtin functions */ + void r_cnjg(complex *, complex *); + + /* Local variables */ + integer i__, k; + complex alpha; + extern /* Subroutine */ int clarf_(char *, integer *, integer *, complex * +, integer *, complex *, complex *, integer *, complex *), + clarfp_(integer *, complex *, complex *, integer *, complex *), + xerbla_(char *, integer *); + + +/* -- LAPACK routine (version 3.2) -- */ +/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ +/* November 2006 */ + +/* .. Scalar Arguments .. */ +/* .. */ +/* .. Array Arguments .. */ +/* .. */ + +/* Purpose */ +/* ======= */ + +/* CGEQL2 computes a QL factorization of a complex m by n matrix A: */ +/* A = Q * L. */ + +/* Arguments */ +/* ========= */ + +/* M (input) INTEGER */ +/* The number of rows of the matrix A. M >= 0. */ + +/* N (input) INTEGER */ +/* The number of columns of the matrix A. N >= 0. */ + +/* A (input/output) COMPLEX array, dimension (LDA,N) */ +/* On entry, the m by n matrix A. */ +/* On exit, if m >= n, the lower triangle of the subarray */ +/* A(m-n+1:m,1:n) contains the n by n lower triangular matrix L; */ +/* if m <= n, the elements on and below the (n-m)-th */ +/* superdiagonal contain the m by n lower trapezoidal matrix L; */ +/* the remaining elements, with the array TAU, represent the */ +/* unitary matrix Q as a product of elementary reflectors */ +/* (see Further Details). */ + +/* LDA (input) INTEGER */ +/* The leading dimension of the array A. LDA >= max(1,M). */ + +/* TAU (output) COMPLEX array, dimension (min(M,N)) */ +/* The scalar factors of the elementary reflectors (see Further */ +/* Details). */ + +/* WORK (workspace) COMPLEX array, dimension (N) */ + +/* INFO (output) INTEGER */ +/* = 0: successful exit */ +/* < 0: if INFO = -i, the i-th argument had an illegal value */ + +/* Further Details */ +/* =============== */ + +/* The matrix Q is represented as a product of elementary reflectors */ + +/* Q = H(k) . . . H(2) H(1), where k = min(m,n). */ + +/* Each H(i) has the form */ + +/* H(i) = I - tau * v * v' */ + +/* where tau is a complex scalar, and v is a complex vector with */ +/* v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in */ +/* A(1:m-k+i-1,n-k+i), and tau in TAU(i). */ + +/* ===================================================================== */ + +/* .. Parameters .. */ +/* .. */ +/* .. Local Scalars .. */ +/* .. */ +/* .. External Subroutines .. */ +/* .. */ +/* .. Intrinsic Functions .. */ +/* .. */ +/* .. Executable Statements .. */ + +/* Test the input arguments */ + + /* Parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1; + a -= a_offset; + --tau; + --work; + + /* Function Body */ + *info = 0; + if (*m < 0) { + *info = -1; + } else if (*n < 0) { + *info = -2; + } else if (*lda < max(1,*m)) { + *info = -4; + } + if (*info != 0) { + i__1 = -(*info); + xerbla_("CGEQL2", &i__1); + return 0; + } + + k = min(*m,*n); + + for (i__ = k; i__ >= 1; --i__) { + +/* Generate elementary reflector H(i) to annihilate */ +/* A(1:m-k+i-1,n-k+i) */ + + i__1 = *m - k + i__ + (*n - k + i__) * a_dim1; + alpha.r = a[i__1].r, alpha.i = a[i__1].i; + i__1 = *m - k + i__; + clarfp_(&i__1, &alpha, &a[(*n - k + i__) * a_dim1 + 1], &c__1, &tau[ + i__]); + +/* Apply H(i)' to A(1:m-k+i,1:n-k+i-1) from the left */ + + i__1 = *m - k + i__ + (*n - k + i__) * a_dim1; + a[i__1].r = 1.f, a[i__1].i = 0.f; + i__1 = *m - k + i__; + i__2 = *n - k + i__ - 1; + r_cnjg(&q__1, &tau[i__]); + clarf_("Left", &i__1, &i__2, &a[(*n - k + i__) * a_dim1 + 1], &c__1, & + q__1, &a[a_offset], lda, &work[1]); + i__1 = *m - k + i__ + (*n - k + i__) * a_dim1; + a[i__1].r = alpha.r, a[i__1].i = alpha.i; +/* L10: */ + } + return 0; + +/* End of CGEQL2 */ + +} /* cgeql2_ */ |