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