aboutsummaryrefslogtreecommitdiffstats
path: root/contrib/libs/clapack/dlassq.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/dlassq.c
parent01f64c1ecd0d4ffa9e3a74478335f1745f26cc75 (diff)
downloadydb-90d450f74722da7859d6f510a869f6c6908fd12f.tar.gz
[] add metering mode to CLI
Diffstat (limited to 'contrib/libs/clapack/dlassq.c')
-rw-r--r--contrib/libs/clapack/dlassq.c116
1 files changed, 116 insertions, 0 deletions
diff --git a/contrib/libs/clapack/dlassq.c b/contrib/libs/clapack/dlassq.c
new file mode 100644
index 0000000000..9b3aee5ee4
--- /dev/null
+++ b/contrib/libs/clapack/dlassq.c
@@ -0,0 +1,116 @@
+/* dlassq.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 dlassq_(integer *n, doublereal *x, integer *incx,
+ doublereal *scale, doublereal *sumsq)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublereal d__1;
+
+ /* Local variables */
+ integer ix;
+ doublereal absxi;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLASSQ returns the values scl and smsq such that */
+
+/* ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq, */
+
+/* where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is */
+/* assumed to be non-negative and scl returns the value */
+
+/* scl = max( scale, abs( x( i ) ) ). */
+
+/* scale and sumsq must be supplied in SCALE and SUMSQ and */
+/* scl and smsq are overwritten on SCALE and SUMSQ respectively. */
+
+/* The routine makes only one pass through the vector x. */
+
+/* Arguments */
+/* ========= */
+
+/* N (input) INTEGER */
+/* The number of elements to be used from the vector X. */
+
+/* X (input) DOUBLE PRECISION array, dimension (N) */
+/* The vector for which a scaled sum of squares is computed. */
+/* x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. */
+
+/* INCX (input) INTEGER */
+/* The increment between successive values of the vector X. */
+/* INCX > 0. */
+
+/* SCALE (input/output) DOUBLE PRECISION */
+/* On entry, the value scale in the equation above. */
+/* On exit, SCALE is overwritten with scl , the scaling factor */
+/* for the sum of squares. */
+
+/* SUMSQ (input/output) DOUBLE PRECISION */
+/* On entry, the value sumsq in the equation above. */
+/* On exit, SUMSQ is overwritten with smsq , the basic sum of */
+/* squares from which scl has been factored out. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ if (*n > 0) {
+ i__1 = (*n - 1) * *incx + 1;
+ i__2 = *incx;
+ for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
+ if (x[ix] != 0.) {
+ absxi = (d__1 = x[ix], abs(d__1));
+ if (*scale < absxi) {
+/* Computing 2nd power */
+ d__1 = *scale / absxi;
+ *sumsq = *sumsq * (d__1 * d__1) + 1;
+ *scale = absxi;
+ } else {
+/* Computing 2nd power */
+ d__1 = absxi / *scale;
+ *sumsq += d__1 * d__1;
+ }
+ }
+/* L10: */
+ }
+ }
+ return 0;
+
+/* End of DLASSQ */
+
+} /* dlassq_ */