mirror of https://github.com/opencv/opencv.git
Open Source Computer Vision Library
https://opencv.org/
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
116 lines
3.2 KiB
116 lines
3.2 KiB
/* slassq.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 "clapack.h" |
|
|
|
|
|
/* Subroutine */ int slassq_(integer *n, real *x, integer *incx, real *scale, |
|
real *sumsq) |
|
{ |
|
/* System generated locals */ |
|
integer i__1, i__2; |
|
real r__1; |
|
|
|
/* Local variables */ |
|
integer ix; |
|
real absxi; |
|
|
|
|
|
/* -- LAPACK auxiliary routine (version 3.2) -- */ |
|
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ |
|
/* November 2006 */ |
|
|
|
/* .. Scalar Arguments .. */ |
|
/* .. */ |
|
/* .. Array Arguments .. */ |
|
/* .. */ |
|
|
|
/* Purpose */ |
|
/* ======= */ |
|
|
|
/* SLASSQ 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) REAL 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) REAL */ |
|
/* 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) REAL */ |
|
/* 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.f) { |
|
absxi = (r__1 = x[ix], dabs(r__1)); |
|
if (*scale < absxi) { |
|
/* Computing 2nd power */ |
|
r__1 = *scale / absxi; |
|
*sumsq = *sumsq * (r__1 * r__1) + 1; |
|
*scale = absxi; |
|
} else { |
|
/* Computing 2nd power */ |
|
r__1 = absxi / *scale; |
|
*sumsq += r__1 * r__1; |
|
} |
|
} |
|
/* L10: */ |
|
} |
|
} |
|
return 0; |
|
|
|
/* End of SLASSQ */ |
|
|
|
} /* slassq_ */
|
|
|