001:       SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       INTEGER            INCX, N
010:       DOUBLE PRECISION   SCALE, SUMSQ
011: *     ..
012: *     .. Array Arguments ..
013:       COMPLEX*16         X( * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  ZLASSQ returns the values scl and ssq such that
020: *
021: *     ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
022: *
023: *  where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is
024: *  assumed to be at least unity and the value of ssq will then satisfy
025: *
026: *     1.0 .le. ssq .le. ( sumsq + 2*n ).
027: *
028: *  scale is assumed to be non-negative and scl returns the value
029: *
030: *     scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
031: *            i
032: *
033: *  scale and sumsq must be supplied in SCALE and SUMSQ respectively.
034: *  SCALE and SUMSQ are overwritten by scl and ssq respectively.
035: *
036: *  The routine makes only one pass through the vector X.
037: *
038: *  Arguments
039: *  =========
040: *
041: *  N       (input) INTEGER
042: *          The number of elements to be used from the vector X.
043: *
044: *  X       (input) COMPLEX*16 array, dimension (N)
045: *          The vector x as described above.
046: *             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
047: *
048: *  INCX    (input) INTEGER
049: *          The increment between successive values of the vector X.
050: *          INCX > 0.
051: *
052: *  SCALE   (input/output) DOUBLE PRECISION
053: *          On entry, the value  scale  in the equation above.
054: *          On exit, SCALE is overwritten with the value  scl .
055: *
056: *  SUMSQ   (input/output) DOUBLE PRECISION
057: *          On entry, the value  sumsq  in the equation above.
058: *          On exit, SUMSQ is overwritten with the value  ssq .
059: *
060: * =====================================================================
061: *
062: *     .. Parameters ..
063:       DOUBLE PRECISION   ZERO
064:       PARAMETER          ( ZERO = 0.0D+0 )
065: *     ..
066: *     .. Local Scalars ..
067:       INTEGER            IX
068:       DOUBLE PRECISION   TEMP1
069: *     ..
070: *     .. Intrinsic Functions ..
071:       INTRINSIC          ABS, DBLE, DIMAG
072: *     ..
073: *     .. Executable Statements ..
074: *
075:       IF( N.GT.0 ) THEN
076:          DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
077:             IF( DBLE( X( IX ) ).NE.ZERO ) THEN
078:                TEMP1 = ABS( DBLE( X( IX ) ) )
079:                IF( SCALE.LT.TEMP1 ) THEN
080:                   SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
081:                   SCALE = TEMP1
082:                ELSE
083:                   SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
084:                END IF
085:             END IF
086:             IF( DIMAG( X( IX ) ).NE.ZERO ) THEN
087:                TEMP1 = ABS( DIMAG( X( IX ) ) )
088:                IF( SCALE.LT.TEMP1 ) THEN
089:                   SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
090:                   SCALE = TEMP1
091:                ELSE
092:                   SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
093:                END IF
094:             END IF
095:    10    CONTINUE
096:       END IF
097: *
098:       RETURN
099: *
100: *     End of ZLASSQ
101: *
102:       END
103: