diff options
author | jason <jason@8a072113-8704-0410-8d35-dd094bca7971> | 2008-10-28 01:38:50 +0000 |
---|---|---|
committer | jason <jason@8a072113-8704-0410-8d35-dd094bca7971> | 2008-10-28 01:38:50 +0000 |
commit | baba851215b44ac3b60b9248eb02bcce7eb76247 (patch) | |
tree | 8c0f5c006875532a30d4409f5e94b0f310ff00a7 /SRC/zlassq.f | |
download | lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.gz lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.bz2 lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.zip |
Move LAPACK trunk into position.
Diffstat (limited to 'SRC/zlassq.f')
-rw-r--r-- | SRC/zlassq.f | 101 |
1 files changed, 101 insertions, 0 deletions
diff --git a/SRC/zlassq.f b/SRC/zlassq.f new file mode 100644 index 00000000..a209984b --- /dev/null +++ b/SRC/zlassq.f @@ -0,0 +1,101 @@ + SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ ) +* +* -- LAPACK auxiliary routine (version 3.1) -- +* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +* November 2006 +* +* .. Scalar Arguments .. + INTEGER INCX, N + DOUBLE PRECISION SCALE, SUMSQ +* .. +* .. Array Arguments .. + COMPLEX*16 X( * ) +* .. +* +* Purpose +* ======= +* +* ZLASSQ returns the values scl and ssq such that +* +* ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq, +* +* where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is +* assumed to be at least unity and the value of ssq will then satisfy +* +* 1.0 .le. ssq .le. ( sumsq + 2*n ). +* +* scale is assumed to be non-negative and scl returns the value +* +* scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ), +* i +* +* scale and sumsq must be supplied in SCALE and SUMSQ respectively. +* SCALE and SUMSQ are overwritten by scl and ssq respectively. +* +* The routine makes only one pass through the vector X. +* +* Arguments +* ========= +* +* N (input) INTEGER +* The number of elements to be used from the vector X. +* +* X (input) COMPLEX*16 array, dimension (N) +* The vector x as described above. +* x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. +* +* INCX (input) INTEGER +* The increment between successive values of the vector X. +* INCX > 0. +* +* SCALE (input/output) DOUBLE PRECISION +* On entry, the value scale in the equation above. +* On exit, SCALE is overwritten with the value scl . +* +* SUMSQ (input/output) DOUBLE PRECISION +* On entry, the value sumsq in the equation above. +* On exit, SUMSQ is overwritten with the value ssq . +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER ( ZERO = 0.0D+0 ) +* .. +* .. Local Scalars .. + INTEGER IX + DOUBLE PRECISION TEMP1 +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, DIMAG +* .. +* .. Executable Statements .. +* + IF( N.GT.0 ) THEN + DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX + IF( DBLE( X( IX ) ).NE.ZERO ) THEN + TEMP1 = ABS( DBLE( X( IX ) ) ) + IF( SCALE.LT.TEMP1 ) THEN + SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2 + SCALE = TEMP1 + ELSE + SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2 + END IF + END IF + IF( DIMAG( X( IX ) ).NE.ZERO ) THEN + TEMP1 = ABS( DIMAG( X( IX ) ) ) + IF( SCALE.LT.TEMP1 ) THEN + SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2 + SCALE = TEMP1 + ELSE + SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2 + END IF + END IF + 10 CONTINUE + END IF +* + RETURN +* +* End of ZLASSQ +* + END |