![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CGEEQUB 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CGEEQUB + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgeequb.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgeequb.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgeequb.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE CGEEQUB( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, 00022 * INFO ) 00023 * 00024 * .. Scalar Arguments .. 00025 * INTEGER INFO, LDA, M, N 00026 * REAL AMAX, COLCND, ROWCND 00027 * .. 00028 * .. Array Arguments .. 00029 * REAL C( * ), R( * ) 00030 * COMPLEX A( LDA, * ) 00031 * .. 00032 * 00033 * 00034 *> \par Purpose: 00035 * ============= 00036 *> 00037 *> \verbatim 00038 *> 00039 *> CGEEQUB computes row and column scalings intended to equilibrate an 00040 *> M-by-N matrix A and reduce its condition number. R returns the row 00041 *> scale factors and C the column scale factors, chosen to try to make 00042 *> the largest element in each row and column of the matrix B with 00043 *> elements B(i,j)=R(i)*A(i,j)*C(j) have an absolute value of at most 00044 *> the radix. 00045 *> 00046 *> R(i) and C(j) are restricted to be a power of the radix between 00047 *> SMLNUM = smallest safe number and BIGNUM = largest safe number. Use 00048 *> of these scaling factors is not guaranteed to reduce the condition 00049 *> number of A but works well in practice. 00050 *> 00051 *> This routine differs from CGEEQU by restricting the scaling factors 00052 *> to a power of the radix. Baring over- and underflow, scaling by 00053 *> these factors introduces no additional rounding errors. However, the 00054 *> scaled entries' magnitured are no longer approximately 1 but lie 00055 *> between sqrt(radix) and 1/sqrt(radix). 00056 *> \endverbatim 00057 * 00058 * Arguments: 00059 * ========== 00060 * 00061 *> \param[in] M 00062 *> \verbatim 00063 *> M is INTEGER 00064 *> The number of rows of the matrix A. M >= 0. 00065 *> \endverbatim 00066 *> 00067 *> \param[in] N 00068 *> \verbatim 00069 *> N is INTEGER 00070 *> The number of columns of the matrix A. N >= 0. 00071 *> \endverbatim 00072 *> 00073 *> \param[in] A 00074 *> \verbatim 00075 *> A is COMPLEX array, dimension (LDA,N) 00076 *> The M-by-N matrix whose equilibration factors are 00077 *> to be computed. 00078 *> \endverbatim 00079 *> 00080 *> \param[in] LDA 00081 *> \verbatim 00082 *> LDA is INTEGER 00083 *> The leading dimension of the array A. LDA >= max(1,M). 00084 *> \endverbatim 00085 *> 00086 *> \param[out] R 00087 *> \verbatim 00088 *> R is REAL array, dimension (M) 00089 *> If INFO = 0 or INFO > M, R contains the row scale factors 00090 *> for A. 00091 *> \endverbatim 00092 *> 00093 *> \param[out] C 00094 *> \verbatim 00095 *> C is REAL array, dimension (N) 00096 *> If INFO = 0, C contains the column scale factors for A. 00097 *> \endverbatim 00098 *> 00099 *> \param[out] ROWCND 00100 *> \verbatim 00101 *> ROWCND is REAL 00102 *> If INFO = 0 or INFO > M, ROWCND contains the ratio of the 00103 *> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and 00104 *> AMAX is neither too large nor too small, it is not worth 00105 *> scaling by R. 00106 *> \endverbatim 00107 *> 00108 *> \param[out] COLCND 00109 *> \verbatim 00110 *> COLCND is REAL 00111 *> If INFO = 0, COLCND contains the ratio of the smallest 00112 *> C(i) to the largest C(i). If COLCND >= 0.1, it is not 00113 *> worth scaling by C. 00114 *> \endverbatim 00115 *> 00116 *> \param[out] AMAX 00117 *> \verbatim 00118 *> AMAX is REAL 00119 *> Absolute value of largest matrix element. If AMAX is very 00120 *> close to overflow or very close to underflow, the matrix 00121 *> should be scaled. 00122 *> \endverbatim 00123 *> 00124 *> \param[out] INFO 00125 *> \verbatim 00126 *> INFO is INTEGER 00127 *> = 0: successful exit 00128 *> < 0: if INFO = -i, the i-th argument had an illegal value 00129 *> > 0: if INFO = i, and i is 00130 *> <= M: the i-th row of A is exactly zero 00131 *> > M: the (i-M)-th column of A is exactly zero 00132 *> \endverbatim 00133 * 00134 * Authors: 00135 * ======== 00136 * 00137 *> \author Univ. of Tennessee 00138 *> \author Univ. of California Berkeley 00139 *> \author Univ. of Colorado Denver 00140 *> \author NAG Ltd. 00141 * 00142 *> \date November 2011 00143 * 00144 *> \ingroup complexGEcomputational 00145 * 00146 * ===================================================================== 00147 SUBROUTINE CGEEQUB( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, 00148 $ INFO ) 00149 * 00150 * -- LAPACK computational routine (version 3.4.0) -- 00151 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00152 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00153 * November 2011 00154 * 00155 * .. Scalar Arguments .. 00156 INTEGER INFO, LDA, M, N 00157 REAL AMAX, COLCND, ROWCND 00158 * .. 00159 * .. Array Arguments .. 00160 REAL C( * ), R( * ) 00161 COMPLEX A( LDA, * ) 00162 * .. 00163 * 00164 * ===================================================================== 00165 * 00166 * .. Parameters .. 00167 REAL ONE, ZERO 00168 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00169 * .. 00170 * .. Local Scalars .. 00171 INTEGER I, J 00172 REAL BIGNUM, RCMAX, RCMIN, SMLNUM, RADIX, LOGRDX 00173 COMPLEX ZDUM 00174 * .. 00175 * .. External Functions .. 00176 REAL SLAMCH 00177 EXTERNAL SLAMCH 00178 * .. 00179 * .. External Subroutines .. 00180 EXTERNAL XERBLA 00181 * .. 00182 * .. Intrinsic Functions .. 00183 INTRINSIC ABS, MAX, MIN, LOG, REAL, AIMAG 00184 * .. 00185 * .. Statement Functions .. 00186 REAL CABS1 00187 * .. 00188 * .. Statement Function definitions .. 00189 CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) 00190 * .. 00191 * .. Executable Statements .. 00192 * 00193 * Test the input parameters. 00194 * 00195 INFO = 0 00196 IF( M.LT.0 ) THEN 00197 INFO = -1 00198 ELSE IF( N.LT.0 ) THEN 00199 INFO = -2 00200 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN 00201 INFO = -4 00202 END IF 00203 IF( INFO.NE.0 ) THEN 00204 CALL XERBLA( 'CGEEQUB', -INFO ) 00205 RETURN 00206 END IF 00207 * 00208 * Quick return if possible. 00209 * 00210 IF( M.EQ.0 .OR. N.EQ.0 ) THEN 00211 ROWCND = ONE 00212 COLCND = ONE 00213 AMAX = ZERO 00214 RETURN 00215 END IF 00216 * 00217 * Get machine constants. Assume SMLNUM is a power of the radix. 00218 * 00219 SMLNUM = SLAMCH( 'S' ) 00220 BIGNUM = ONE / SMLNUM 00221 RADIX = SLAMCH( 'B' ) 00222 LOGRDX = LOG( RADIX ) 00223 * 00224 * Compute row scale factors. 00225 * 00226 DO 10 I = 1, M 00227 R( I ) = ZERO 00228 10 CONTINUE 00229 * 00230 * Find the maximum element in each row. 00231 * 00232 DO 30 J = 1, N 00233 DO 20 I = 1, M 00234 R( I ) = MAX( R( I ), CABS1( A( I, J ) ) ) 00235 20 CONTINUE 00236 30 CONTINUE 00237 DO I = 1, M 00238 IF( R( I ).GT.ZERO ) THEN 00239 R( I ) = RADIX**INT( LOG(R( I ) ) / LOGRDX ) 00240 END IF 00241 END DO 00242 * 00243 * Find the maximum and minimum scale factors. 00244 * 00245 RCMIN = BIGNUM 00246 RCMAX = ZERO 00247 DO 40 I = 1, M 00248 RCMAX = MAX( RCMAX, R( I ) ) 00249 RCMIN = MIN( RCMIN, R( I ) ) 00250 40 CONTINUE 00251 AMAX = RCMAX 00252 * 00253 IF( RCMIN.EQ.ZERO ) THEN 00254 * 00255 * Find the first zero scale factor and return an error code. 00256 * 00257 DO 50 I = 1, M 00258 IF( R( I ).EQ.ZERO ) THEN 00259 INFO = I 00260 RETURN 00261 END IF 00262 50 CONTINUE 00263 ELSE 00264 * 00265 * Invert the scale factors. 00266 * 00267 DO 60 I = 1, M 00268 R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM ) 00269 60 CONTINUE 00270 * 00271 * Compute ROWCND = min(R(I)) / max(R(I)). 00272 * 00273 ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) 00274 END IF 00275 * 00276 * Compute column scale factors. 00277 * 00278 DO 70 J = 1, N 00279 C( J ) = ZERO 00280 70 CONTINUE 00281 * 00282 * Find the maximum element in each column, 00283 * assuming the row scaling computed above. 00284 * 00285 DO 90 J = 1, N 00286 DO 80 I = 1, M 00287 C( J ) = MAX( C( J ), CABS1( A( I, J ) )*R( I ) ) 00288 80 CONTINUE 00289 IF( C( J ).GT.ZERO ) THEN 00290 C( J ) = RADIX**INT( LOG( C( J ) ) / LOGRDX ) 00291 END IF 00292 90 CONTINUE 00293 * 00294 * Find the maximum and minimum scale factors. 00295 * 00296 RCMIN = BIGNUM 00297 RCMAX = ZERO 00298 DO 100 J = 1, N 00299 RCMIN = MIN( RCMIN, C( J ) ) 00300 RCMAX = MAX( RCMAX, C( J ) ) 00301 100 CONTINUE 00302 * 00303 IF( RCMIN.EQ.ZERO ) THEN 00304 * 00305 * Find the first zero scale factor and return an error code. 00306 * 00307 DO 110 J = 1, N 00308 IF( C( J ).EQ.ZERO ) THEN 00309 INFO = M + J 00310 RETURN 00311 END IF 00312 110 CONTINUE 00313 ELSE 00314 * 00315 * Invert the scale factors. 00316 * 00317 DO 120 J = 1, N 00318 C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM ) 00319 120 CONTINUE 00320 * 00321 * Compute COLCND = min(C(J)) / max(C(J)). 00322 * 00323 COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) 00324 END IF 00325 * 00326 RETURN 00327 * 00328 * End of CGEEQUB 00329 * 00330 END