00001 /* dlassq.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Subroutine */ int dlassq_(integer *n, doublereal *x, integer *incx, 00017 doublereal *scale, doublereal *sumsq) 00018 { 00019 /* System generated locals */ 00020 integer i__1, i__2; 00021 doublereal d__1; 00022 00023 /* Local variables */ 00024 integer ix; 00025 doublereal absxi; 00026 00027 00028 /* -- LAPACK auxiliary routine (version 3.2) -- */ 00029 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00030 /* November 2006 */ 00031 00032 /* .. Scalar Arguments .. */ 00033 /* .. */ 00034 /* .. Array Arguments .. */ 00035 /* .. */ 00036 00037 /* Purpose */ 00038 /* ======= */ 00039 00040 /* DLASSQ returns the values scl and smsq such that */ 00041 00042 /* ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq, */ 00043 00044 /* where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is */ 00045 /* assumed to be non-negative and scl returns the value */ 00046 00047 /* scl = max( scale, abs( x( i ) ) ). */ 00048 00049 /* scale and sumsq must be supplied in SCALE and SUMSQ and */ 00050 /* scl and smsq are overwritten on SCALE and SUMSQ respectively. */ 00051 00052 /* The routine makes only one pass through the vector x. */ 00053 00054 /* Arguments */ 00055 /* ========= */ 00056 00057 /* N (input) INTEGER */ 00058 /* The number of elements to be used from the vector X. */ 00059 00060 /* X (input) DOUBLE PRECISION array, dimension (N) */ 00061 /* The vector for which a scaled sum of squares is computed. */ 00062 /* x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. */ 00063 00064 /* INCX (input) INTEGER */ 00065 /* The increment between successive values of the vector X. */ 00066 /* INCX > 0. */ 00067 00068 /* SCALE (input/output) DOUBLE PRECISION */ 00069 /* On entry, the value scale in the equation above. */ 00070 /* On exit, SCALE is overwritten with scl , the scaling factor */ 00071 /* for the sum of squares. */ 00072 00073 /* SUMSQ (input/output) DOUBLE PRECISION */ 00074 /* On entry, the value sumsq in the equation above. */ 00075 /* On exit, SUMSQ is overwritten with smsq , the basic sum of */ 00076 /* squares from which scl has been factored out. */ 00077 00078 /* ===================================================================== */ 00079 00080 /* .. Parameters .. */ 00081 /* .. */ 00082 /* .. Local Scalars .. */ 00083 /* .. */ 00084 /* .. Intrinsic Functions .. */ 00085 /* .. */ 00086 /* .. Executable Statements .. */ 00087 00088 /* Parameter adjustments */ 00089 --x; 00090 00091 /* Function Body */ 00092 if (*n > 0) { 00093 i__1 = (*n - 1) * *incx + 1; 00094 i__2 = *incx; 00095 for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) { 00096 if (x[ix] != 0.) { 00097 absxi = (d__1 = x[ix], abs(d__1)); 00098 if (*scale < absxi) { 00099 /* Computing 2nd power */ 00100 d__1 = *scale / absxi; 00101 *sumsq = *sumsq * (d__1 * d__1) + 1; 00102 *scale = absxi; 00103 } else { 00104 /* Computing 2nd power */ 00105 d__1 = absxi / *scale; 00106 *sumsq += d__1 * d__1; 00107 } 00108 } 00109 /* L10: */ 00110 } 00111 } 00112 return 0; 00113 00114 /* End of DLASSQ */ 00115 00116 } /* dlassq_ */