1      SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
2*
3*  -- LAPACK auxiliary routine (version 3.0) --
4*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5*     Courant Institute, Argonne National Lab, and Rice University
6*     June 30, 1999
7*
8*     .. Scalar Arguments ..
9      INTEGER            INCX, N
10      DOUBLE PRECISION   SCALE, SUMSQ
11*     ..
12*     .. Array Arguments ..
13      DOUBLE PRECISION   X( * )
14*     ..
15*
16*  Purpose
17*  =======
18*
19*  DLASSQ  returns the values  scl  and  smsq  such that
20*
21*     ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
22*
23*  where  x( i ) = X( 1 + ( i - 1 )*INCX ). The value of  sumsq  is
24*  assumed to be non-negative and  scl  returns the value
25*
26*     scl = max( scale, abs( x( i ) ) ).
27*
28*  scale and sumsq must be supplied in SCALE and SUMSQ and
29*  scl and smsq are overwritten on SCALE and SUMSQ respectively.
30*
31*  The routine makes only one pass through the vector x.
32*
33*  Arguments
34*  =========
35*
36*  N       (input) INTEGER
37*          The number of elements to be used from the vector X.
38*
39*  X       (input) DOUBLE PRECISION array, dimension (N)
40*          The vector for which a scaled sum of squares is computed.
41*             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
42*
43*  INCX    (input) INTEGER
44*          The increment between successive values of the vector X.
45*          INCX > 0.
46*
47*  SCALE   (input/output) DOUBLE PRECISION
48*          On entry, the value  scale  in the equation above.
49*          On exit, SCALE is overwritten with  scl , the scaling factor
50*          for the sum of squares.
51*
52*  SUMSQ   (input/output) DOUBLE PRECISION
53*          On entry, the value  sumsq  in the equation above.
54*          On exit, SUMSQ is overwritten with  smsq , the basic sum of
55*          squares from which  scl  has been factored out.
56*
57* =====================================================================
58*
59*     .. Parameters ..
60      DOUBLE PRECISION   ZERO
61      PARAMETER          ( ZERO = 0.0D+0 )
62*     ..
63*     .. Local Scalars ..
64      INTEGER            IX
65      DOUBLE PRECISION   ABSXI
66*     ..
67*     .. Intrinsic Functions ..
68      INTRINSIC          ABS
69*     ..
70*     .. Executable Statements ..
71*
72      IF( N.GT.0 ) THEN
73         DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
74            IF( X( IX ).NE.ZERO ) THEN
75               ABSXI = ABS( X( IX ) )
76               IF( SCALE.LT.ABSXI ) THEN
77                  SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
78                  SCALE = ABSXI
79               ELSE
80                  SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
81               END IF
82            END IF
83   10    CONTINUE
84      END IF
85      RETURN
86*
87*     End of DLASSQ
88*
89      END
90