slassq.c

InsightToolkit-1.4.0(有大量的优化算法程序)

#include "f2c.h"
#include "netlib.h"

/* Subroutine */ void slassq_(const integer *n, const real *x, const integer *incx, real *scale, real *sumsq)
{
    /* Local variables */
    static real absxi;
    static integer ix;

/*  -- LAPACK auxiliary routine (version 2.0) --                        */
/*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,      */
/*     Courant Institute, Argonne National Lab, and Rice University     */
/*     October 31, 1992                                                 */

/*  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                                                */
/*          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.             */
/*                                                                      */
/* =====================================================================*/

    if (*n > 0) {
        for (ix = 0; *incx < 0 ? ix > *n * *incx : ix < *n * *incx; ix += *incx) {
            if (x[ix] != 0.f) {
                absxi = abs(x[ix]);
                if (*scale < absxi) {
                    *scale /= absxi;
                    *sumsq = *sumsq * *scale * *scale + 1;
                    *scale = absxi;
                } else {
                    absxi /= *scale;
                    *sumsq += absxi * absxi;
                }
            }
        }
    }
} /* slassq_ */