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