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