LAPACK 3.3.0
|
00001 SUBROUTINE CPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO ) 00002 * 00003 * -- LAPACK routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER UPLO 00010 INTEGER INFO, KD, LDAB, N 00011 REAL AMAX, SCOND 00012 * .. 00013 * .. Array Arguments .. 00014 REAL S( * ) 00015 COMPLEX AB( LDAB, * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * CPBEQU computes row and column scalings intended to equilibrate a 00022 * Hermitian positive definite band matrix A and reduce its condition 00023 * number (with respect to the two-norm). S contains the scale factors, 00024 * S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with 00025 * elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This 00026 * choice of S puts the condition number of B within a factor N of the 00027 * smallest possible condition number over all possible diagonal 00028 * scalings. 00029 * 00030 * Arguments 00031 * ========= 00032 * 00033 * UPLO (input) CHARACTER*1 00034 * = 'U': Upper triangular of A is stored; 00035 * = 'L': Lower triangular of A is stored. 00036 * 00037 * N (input) INTEGER 00038 * The order of the matrix A. N >= 0. 00039 * 00040 * KD (input) INTEGER 00041 * The number of superdiagonals of the matrix A if UPLO = 'U', 00042 * or the number of subdiagonals if UPLO = 'L'. KD >= 0. 00043 * 00044 * AB (input) COMPLEX array, dimension (LDAB,N) 00045 * The upper or lower triangle of the Hermitian band matrix A, 00046 * stored in the first KD+1 rows of the array. The j-th column 00047 * of A is stored in the j-th column of the array AB as follows: 00048 * if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j; 00049 * if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd). 00050 * 00051 * LDAB (input) INTEGER 00052 * The leading dimension of the array A. LDAB >= KD+1. 00053 * 00054 * S (output) REAL array, dimension (N) 00055 * If INFO = 0, S contains the scale factors for A. 00056 * 00057 * SCOND (output) REAL 00058 * If INFO = 0, S contains the ratio of the smallest S(i) to 00059 * the largest S(i). If SCOND >= 0.1 and AMAX is neither too 00060 * large nor too small, it is not worth scaling by S. 00061 * 00062 * AMAX (output) REAL 00063 * Absolute value of largest matrix element. If AMAX is very 00064 * close to overflow or very close to underflow, the matrix 00065 * should be scaled. 00066 * 00067 * INFO (output) INTEGER 00068 * = 0: successful exit 00069 * < 0: if INFO = -i, the i-th argument had an illegal value. 00070 * > 0: if INFO = i, the i-th diagonal element is nonpositive. 00071 * 00072 * ===================================================================== 00073 * 00074 * .. Parameters .. 00075 REAL ZERO, ONE 00076 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 00077 * .. 00078 * .. Local Scalars .. 00079 LOGICAL UPPER 00080 INTEGER I, J 00081 REAL SMIN 00082 * .. 00083 * .. External Functions .. 00084 LOGICAL LSAME 00085 EXTERNAL LSAME 00086 * .. 00087 * .. External Subroutines .. 00088 EXTERNAL XERBLA 00089 * .. 00090 * .. Intrinsic Functions .. 00091 INTRINSIC MAX, MIN, REAL, SQRT 00092 * .. 00093 * .. Executable Statements .. 00094 * 00095 * Test the input parameters. 00096 * 00097 INFO = 0 00098 UPPER = LSAME( UPLO, 'U' ) 00099 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00100 INFO = -1 00101 ELSE IF( N.LT.0 ) THEN 00102 INFO = -2 00103 ELSE IF( KD.LT.0 ) THEN 00104 INFO = -3 00105 ELSE IF( LDAB.LT.KD+1 ) THEN 00106 INFO = -5 00107 END IF 00108 IF( INFO.NE.0 ) THEN 00109 CALL XERBLA( 'CPBEQU', -INFO ) 00110 RETURN 00111 END IF 00112 * 00113 * Quick return if possible 00114 * 00115 IF( N.EQ.0 ) THEN 00116 SCOND = ONE 00117 AMAX = ZERO 00118 RETURN 00119 END IF 00120 * 00121 IF( UPPER ) THEN 00122 J = KD + 1 00123 ELSE 00124 J = 1 00125 END IF 00126 * 00127 * Initialize SMIN and AMAX. 00128 * 00129 S( 1 ) = REAL( AB( J, 1 ) ) 00130 SMIN = S( 1 ) 00131 AMAX = S( 1 ) 00132 * 00133 * Find the minimum and maximum diagonal elements. 00134 * 00135 DO 10 I = 2, N 00136 S( I ) = REAL( AB( J, I ) ) 00137 SMIN = MIN( SMIN, S( I ) ) 00138 AMAX = MAX( AMAX, S( I ) ) 00139 10 CONTINUE 00140 * 00141 IF( SMIN.LE.ZERO ) THEN 00142 * 00143 * Find the first non-positive diagonal element and return. 00144 * 00145 DO 20 I = 1, N 00146 IF( S( I ).LE.ZERO ) THEN 00147 INFO = I 00148 RETURN 00149 END IF 00150 20 CONTINUE 00151 ELSE 00152 * 00153 * Set the scale factors to the reciprocals 00154 * of the diagonal elements. 00155 * 00156 DO 30 I = 1, N 00157 S( I ) = ONE / SQRT( S( I ) ) 00158 30 CONTINUE 00159 * 00160 * Compute SCOND = min(S(I)) / max(S(I)) 00161 * 00162 SCOND = SQRT( SMIN ) / SQRT( AMAX ) 00163 END IF 00164 RETURN 00165 * 00166 * End of CPBEQU 00167 * 00168 END