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