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/slaqge.c | |
parent | 01f64c1ecd0d4ffa9e3a74478335f1745f26cc75 (diff) | |
download | ydb-90d450f74722da7859d6f510a869f6c6908fd12f.tar.gz |
[] add metering mode to CLI
Diffstat (limited to 'contrib/libs/clapack/slaqge.c')
-rw-r--r-- | contrib/libs/clapack/slaqge.c | 188 |
1 files changed, 188 insertions, 0 deletions
diff --git a/contrib/libs/clapack/slaqge.c b/contrib/libs/clapack/slaqge.c new file mode 100644 index 0000000000..54e8f1b7f1 --- /dev/null +++ b/contrib/libs/clapack/slaqge.c @@ -0,0 +1,188 @@ +/* slaqge.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" + +/* Subroutine */ int slaqge_(integer *m, integer *n, real *a, integer *lda, + real *r__, real *c__, real *rowcnd, real *colcnd, real *amax, char * + equed) +{ + /* System generated locals */ + integer a_dim1, a_offset, i__1, i__2; + + /* Local variables */ + integer i__, j; + real cj, large, small; + extern doublereal slamch_(char *); + + +/* -- LAPACK auxiliary routine (version 3.2) -- */ +/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ +/* November 2006 */ + +/* .. Scalar Arguments .. */ +/* .. */ +/* .. Array Arguments .. */ +/* .. */ + +/* Purpose */ +/* ======= */ + +/* SLAQGE equilibrates a general M by N matrix A using the row and */ +/* column scaling factors in the vectors R and C. */ + +/* 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) REAL array, dimension (LDA,N) */ +/* On entry, the M by N matrix A. */ +/* On exit, the equilibrated matrix. See EQUED for the form of */ +/* the equilibrated matrix. */ + +/* LDA (input) INTEGER */ +/* The leading dimension of the array A. LDA >= max(M,1). */ + +/* R (input) REAL array, dimension (M) */ +/* The row scale factors for A. */ + +/* C (input) REAL array, dimension (N) */ +/* The column scale factors for A. */ + +/* ROWCND (input) REAL */ +/* Ratio of the smallest R(i) to the largest R(i). */ + +/* COLCND (input) REAL */ +/* Ratio of the smallest C(i) to the largest C(i). */ + +/* AMAX (input) REAL */ +/* Absolute value of largest matrix entry. */ + +/* EQUED (output) CHARACTER*1 */ +/* Specifies the form of equilibration that was done. */ +/* = 'N': No equilibration */ +/* = 'R': Row equilibration, i.e., A has been premultiplied by */ +/* diag(R). */ +/* = 'C': Column equilibration, i.e., A has been postmultiplied */ +/* by diag(C). */ +/* = 'B': Both row and column equilibration, i.e., A has been */ +/* replaced by diag(R) * A * diag(C). */ + +/* Internal Parameters */ +/* =================== */ + +/* THRESH is a threshold value used to decide if row or column scaling */ +/* should be done based on the ratio of the row or column scaling */ +/* factors. If ROWCND < THRESH, row scaling is done, and if */ +/* COLCND < THRESH, column scaling is done. */ + +/* LARGE and SMALL are threshold values used to decide if row scaling */ +/* should be done based on the absolute size of the largest matrix */ +/* element. If AMAX > LARGE or AMAX < SMALL, row scaling is done. */ + +/* ===================================================================== */ + +/* .. Parameters .. */ +/* .. */ +/* .. Local Scalars .. */ +/* .. */ +/* .. External Functions .. */ +/* .. */ +/* .. Executable Statements .. */ + +/* Quick return if possible */ + + /* Parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1; + a -= a_offset; + --r__; + --c__; + + /* Function Body */ + if (*m <= 0 || *n <= 0) { + *(unsigned char *)equed = 'N'; + return 0; + } + +/* Initialize LARGE and SMALL. */ + + small = slamch_("Safe minimum") / slamch_("Precision"); + large = 1.f / small; + + if (*rowcnd >= .1f && *amax >= small && *amax <= large) { + +/* No row scaling */ + + if (*colcnd >= .1f) { + +/* No column scaling */ + + *(unsigned char *)equed = 'N'; + } else { + +/* Column scaling */ + + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + cj = c__[j]; + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + a[i__ + j * a_dim1] = cj * a[i__ + j * a_dim1]; +/* L10: */ + } +/* L20: */ + } + *(unsigned char *)equed = 'C'; + } + } else if (*colcnd >= .1f) { + +/* Row scaling, no column scaling */ + + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + a[i__ + j * a_dim1] = r__[i__] * a[i__ + j * a_dim1]; +/* L30: */ + } +/* L40: */ + } + *(unsigned char *)equed = 'R'; + } else { + +/* Row and column scaling */ + + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + cj = c__[j]; + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + a[i__ + j * a_dim1] = cj * r__[i__] * a[i__ + j * a_dim1]; +/* L50: */ + } +/* L60: */ + } + *(unsigned char *)equed = 'B'; + } + + return 0; + +/* End of SLAQGE */ + +} /* slaqge_ */ |