1*> \brief \b DLASSQ updates a sum of squares represented in scaled form.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DLASSQ + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlassq.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlassq.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlassq.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
22*
23*       .. Scalar Arguments ..
24*       INTEGER            INCX, N
25*       DOUBLE PRECISION   SCALE, SUMSQ
26*       ..
27*       .. Array Arguments ..
28*       DOUBLE PRECISION   X( * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> DLASSQ  returns the values  scl  and  smsq  such that
38*>
39*>    ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
40*>
41*> where  x( i ) = X( 1 + ( i - 1 )*INCX ). The value of  sumsq  is
42*> assumed to be non-negative and  scl  returns the value
43*>
44*>    scl = max( scale, abs( x( i ) ) ).
45*>
46*> scale and sumsq must be supplied in SCALE and SUMSQ and
47*> scl and smsq are overwritten on SCALE and SUMSQ respectively.
48*>
49*> The routine makes only one pass through the vector x.
50*> \endverbatim
51*
52*  Arguments:
53*  ==========
54*
55*> \param[in] N
56*> \verbatim
57*>          N is INTEGER
58*>          The number of elements to be used from the vector X.
59*> \endverbatim
60*>
61*> \param[in] X
62*> \verbatim
63*>          X is DOUBLE PRECISION array, dimension (N)
64*>          The vector for which a scaled sum of squares is computed.
65*>             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
66*> \endverbatim
67*>
68*> \param[in] INCX
69*> \verbatim
70*>          INCX is INTEGER
71*>          The increment between successive values of the vector X.
72*>          INCX > 0.
73*> \endverbatim
74*>
75*> \param[in,out] SCALE
76*> \verbatim
77*>          SCALE is DOUBLE PRECISION
78*>          On entry, the value  scale  in the equation above.
79*>          On exit, SCALE is overwritten with  scl , the scaling factor
80*>          for the sum of squares.
81*> \endverbatim
82*>
83*> \param[in,out] SUMSQ
84*> \verbatim
85*>          SUMSQ is DOUBLE PRECISION
86*>          On entry, the value  sumsq  in the equation above.
87*>          On exit, SUMSQ is overwritten with  smsq , the basic sum of
88*>          squares from which  scl  has been factored out.
89*> \endverbatim
90*
91*  Authors:
92*  ========
93*
94*> \author Univ. of Tennessee
95*> \author Univ. of California Berkeley
96*> \author Univ. of Colorado Denver
97*> \author NAG Ltd.
98*
99*> \date September 2012
100*
101*> \ingroup auxOTHERauxiliary
102*
103*  =====================================================================
104      SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
105*
106*  -- LAPACK auxiliary routine (version 3.4.2) --
107*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
108*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
109*     September 2012
110*
111*     .. Scalar Arguments ..
112      INTEGER            INCX, N
113      DOUBLE PRECISION   SCALE, SUMSQ
114*     ..
115*     .. Array Arguments ..
116      DOUBLE PRECISION   X( * )
117*     ..
118*
119* =====================================================================
120*
121*     .. Parameters ..
122      DOUBLE PRECISION   ZERO
123      PARAMETER          ( ZERO = 0.0D+0 )
124*     ..
125*     .. Local Scalars ..
126      INTEGER            IX
127      DOUBLE PRECISION   ABSXI
128*     ..
129*     .. External Functions ..
130      LOGICAL            DISNAN
131      EXTERNAL           DISNAN
132*     ..
133*     .. Intrinsic Functions ..
134      INTRINSIC          ABS
135*     ..
136*     .. Executable Statements ..
137*
138      IF( N.GT.0 ) THEN
139         DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
140            ABSXI = ABS( X( IX ) )
141            IF( ABSXI.GT.ZERO.OR.DISNAN( ABSXI ) ) THEN
142               IF( SCALE.LT.ABSXI ) THEN
143                  SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
144                  SCALE = ABSXI
145               ELSE
146                  SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
147               END IF
148            END IF
149   10    CONTINUE
150      END IF
151      RETURN
152*
153*     End of DLASSQ
154*
155      END
156