git.maemo.org Git - opencv/blob - 3rdparty/lapack/dlassq.c

   1 #include "clapack.h"
   2
   3 /* Subroutine */ int dlassq_(integer *n, doublereal *x, integer *incx,
   4         doublereal *scale, doublereal *sumsq)
   5 {
   6     /* System generated locals */
   7     integer i__1, i__2;
   8     doublereal d__1;
   9
  10     /* Local variables */
  11     integer ix;
  12     doublereal absxi;
  13
  14
  15 /*  -- LAPACK auxiliary routine (version 3.1) -- */
  16 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  17 /*     November 2006 */
  18
  19 /*     .. Scalar Arguments .. */
  20 /*     .. */
  21 /*     .. Array Arguments .. */
  22 /*     .. */
  23
  24 /*  Purpose */
  25 /*  ======= */
  26
  27 /*  DLASSQ  returns the values  scl  and  smsq  such that */
  28
  29 /*     ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq, */
  30
  31 /*  where  x( i ) = X( 1 + ( i - 1 )*INCX ). The value of  sumsq  is */
  32 /*  assumed to be non-negative and  scl  returns the value */
  33
  34 /*     scl = max( scale, abs( x( i ) ) ). */
  35
  36 /*  scale and sumsq must be supplied in SCALE and SUMSQ and */
  37 /*  scl and smsq are overwritten on SCALE and SUMSQ respectively. */
  38
  39 /*  The routine makes only one pass through the vector x. */
  40
  41 /*  Arguments */
  42 /*  ========= */
  43
  44 /*  N       (input) INTEGER */
  45 /*          The number of elements to be used from the vector X. */
  46
  47 /*  X       (input) DOUBLE PRECISION array, dimension (N) */
  48 /*          The vector for which a scaled sum of squares is computed. */
  49 /*             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. */
  50
  51 /*  INCX    (input) INTEGER */
  52 /*          The increment between successive values of the vector X. */
  53 /*          INCX > 0. */
  54
  55 /*  SCALE   (input/output) DOUBLE PRECISION */
  56 /*          On entry, the value  scale  in the equation above. */
  57 /*          On exit, SCALE is overwritten with  scl , the scaling factor */
  58 /*          for the sum of squares. */
  59
  60 /*  SUMSQ   (input/output) DOUBLE PRECISION */
  61 /*          On entry, the value  sumsq  in the equation above. */
  62 /*          On exit, SUMSQ is overwritten with  smsq , the basic sum of */
  63 /*          squares from which  scl  has been factored out. */
  64
  65 /* ===================================================================== */
  66
  67 /*     .. Parameters .. */
  68 /*     .. */
  69 /*     .. Local Scalars .. */
  70 /*     .. */
  71 /*     .. Intrinsic Functions .. */
  72 /*     .. */
  73 /*     .. Executable Statements .. */
  74
  75     /* Parameter adjustments */
  76     --x;
  77
  78     /* Function Body */
  79     if (*n > 0) {
  80         i__1 = (*n - 1) * *incx + 1;
  81         i__2 = *incx;
  82         for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
  83             if (x[ix] != 0.) {
  84                 absxi = (d__1 = x[ix], abs(d__1));
  85                 if (*scale < absxi) {
  86 /* Computing 2nd power */
  87                     d__1 = *scale / absxi;
  88                     *sumsq = *sumsq * (d__1 * d__1) + 1;
  89                     *scale = absxi;
  90                 } else {
  91 /* Computing 2nd power */
  92                     d__1 = absxi / *scale;
  93                     *sumsq += d__1 * d__1;
  94                 }
  95             }
  96 /* L10: */
  97         }
  98     }
  99     return 0;
 100
 101 /*     End of DLASSQ */
 102
 103 } /* dlassq_ */