1      SUBROUTINE ZLASSQ( 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      COMPLEX*16         X( * )
14*     ..
15*
16*  Purpose
17*  =======
18*
19*  ZLASSQ returns the values scl and ssq such that
20*
21*     ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
22*
23*  where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is
24*  assumed to be at least unity and the value of ssq will then satisfy
25*
26*     1.0 .le. ssq .le. ( sumsq + 2*n ).
27*
28*  scale is assumed to be non-negative and scl returns the value
29*
30*     scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
31*            i
32*
33*  scale and sumsq must be supplied in SCALE and SUMSQ respectively.
34*  SCALE and SUMSQ are overwritten by scl and ssq respectively.
35*
36*  The routine makes only one pass through the vector X.
37*
38*  Arguments
39*  =========
40*
41*  N       (input) INTEGER
42*          The number of elements to be used from the vector X.
43*
44*  X       (input) COMPLEX*16 array, dimension (N)
45*          The vector x as described above.
46*             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
47*
48*  INCX    (input) INTEGER
49*          The increment between successive values of the vector X.
50*          INCX > 0.
51*
52*  SCALE   (input/output) DOUBLE PRECISION
53*          On entry, the value  scale  in the equation above.
54*          On exit, SCALE is overwritten with the value  scl .
55*
56*  SUMSQ   (input/output) DOUBLE PRECISION
57*          On entry, the value  sumsq  in the equation above.
58*          On exit, SUMSQ is overwritten with the value  ssq .
59*
60* =====================================================================
61*
62*     .. Parameters ..
63      DOUBLE PRECISION   ZERO
64      PARAMETER          ( ZERO = 0.0D+0 )
65*     ..
66*     .. Local Scalars ..
67      INTEGER            IX
68      DOUBLE PRECISION   TEMP1
69*     ..
70*     .. Intrinsic Functions ..
71      INTRINSIC          ABS, DBLE, DIMAG
72*     ..
73*     .. Executable Statements ..
74*
75      IF( N.GT.0 ) THEN
76         DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
77            IF( DBLE( X( IX ) ).NE.ZERO ) THEN
78               TEMP1 = ABS( DBLE( X( IX ) ) )
79               IF( SCALE.LT.TEMP1 ) THEN
80                  SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
81                  SCALE = TEMP1
82               ELSE
83                  SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
84               END IF
85            END IF
86            IF( DIMAG( X( IX ) ).NE.ZERO ) THEN
87               TEMP1 = ABS( DIMAG( X( IX ) ) )
88               IF( SCALE.LT.TEMP1 ) THEN
89                  SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
90                  SCALE = TEMP1
91               ELSE
92                  SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
93               END IF
94            END IF
95   10    CONTINUE
96      END IF
97*
98      RETURN
99*
100*     End of ZLASSQ
101*
102      END
103