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