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