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/cpoequ.f |
Move LAPACK trunk into position.
Diffstat (limited to 'SRC/cpoequ.f')
-rw-r--r-- | SRC/cpoequ.f | 137 |
1 files changed, 137 insertions, 0 deletions
diff --git a/SRC/cpoequ.f b/SRC/cpoequ.f new file mode 100644 index 00000000..f08acd3e --- /dev/null +++ b/SRC/cpoequ.f @@ -0,0 +1,137 @@ + SUBROUTINE CPOEQU( N, A, LDA, S, SCOND, AMAX, INFO ) +* +* -- LAPACK routine (version 3.1) -- +* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +* November 2006 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, N + REAL AMAX, SCOND +* .. +* .. Array Arguments .. + REAL S( * ) + COMPLEX A( LDA, * ) +* .. +* +* Purpose +* ======= +* +* CPOEQU computes row and column scalings intended to equilibrate a +* Hermitian positive definite matrix A and reduce its condition number +* (with respect to the two-norm). S contains the scale factors, +* S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with +* elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This +* choice of S puts the condition number of B within a factor N of the +* smallest possible condition number over all possible diagonal +* scalings. +* +* Arguments +* ========= +* +* N (input) INTEGER +* The order of the matrix A. N >= 0. +* +* A (input) COMPLEX array, dimension (LDA,N) +* The N-by-N Hermitian positive definite matrix whose scaling +* factors are to be computed. Only the diagonal elements of A +* are referenced. +* +* LDA (input) INTEGER +* The leading dimension of the array A. LDA >= max(1,N). +* +* S (output) REAL array, dimension (N) +* If INFO = 0, S contains the scale factors for A. +* +* SCOND (output) REAL +* If INFO = 0, S contains the ratio of the smallest S(i) to +* the largest S(i). If SCOND >= 0.1 and AMAX is neither too +* large nor too small, it is not worth scaling by S. +* +* AMAX (output) REAL +* Absolute value of largest matrix element. If AMAX is very +* close to overflow or very close to underflow, the matrix +* should be scaled. +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -i, the i-th argument had an illegal value +* > 0: if INFO = i, the i-th diagonal element is nonpositive. +* +* ===================================================================== +* +* .. Parameters .. + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) +* .. +* .. Local Scalars .. + INTEGER I + REAL SMIN +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN, REAL, SQRT +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + IF( N.LT.0 ) THEN + INFO = -1 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -3 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'CPOEQU', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.EQ.0 ) THEN + SCOND = ONE + AMAX = ZERO + RETURN + END IF +* +* Find the minimum and maximum diagonal elements. +* + S( 1 ) = REAL( A( 1, 1 ) ) + SMIN = S( 1 ) + AMAX = S( 1 ) + DO 10 I = 2, N + S( I ) = REAL( A( I, I ) ) + SMIN = MIN( SMIN, S( I ) ) + AMAX = MAX( AMAX, S( I ) ) + 10 CONTINUE +* + IF( SMIN.LE.ZERO ) THEN +* +* Find the first non-positive diagonal element and return. +* + DO 20 I = 1, N + IF( S( I ).LE.ZERO ) THEN + INFO = I + RETURN + END IF + 20 CONTINUE + ELSE +* +* Set the scale factors to the reciprocals +* of the diagonal elements. +* + DO 30 I = 1, N + S( I ) = ONE / SQRT( S( I ) ) + 30 CONTINUE +* +* Compute SCOND = min(S(I)) / max(S(I)) +* + SCOND = SQRT( SMIN ) / SQRT( AMAX ) + END IF + RETURN +* +* End of CPOEQU +* + END |