1*> \brief \b CGBEQU 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download CGBEQU + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbequ.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgbequ.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbequ.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE CGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, 22* AMAX, INFO ) 23* 24* .. Scalar Arguments .. 25* INTEGER INFO, KL, KU, LDAB, M, N 26* REAL AMAX, COLCND, ROWCND 27* .. 28* .. Array Arguments .. 29* REAL C( * ), R( * ) 30* COMPLEX AB( LDAB, * ) 31* .. 32* 33* 34*> \par Purpose: 35* ============= 36*> 37*> \verbatim 38*> 39*> CGBEQU computes row and column scalings intended to equilibrate an 40*> M-by-N band matrix A and reduce its condition number. R returns the 41*> row scale factors and C the column scale factors, chosen to try to 42*> make the largest element in each row and column of the matrix B with 43*> elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1. 44*> 45*> R(i) and C(j) are restricted to be between SMLNUM = smallest safe 46*> number and BIGNUM = largest safe number. Use of these scaling 47*> factors is not guaranteed to reduce the condition number of A but 48*> works well in practice. 49*> \endverbatim 50* 51* Arguments: 52* ========== 53* 54*> \param[in] M 55*> \verbatim 56*> M is INTEGER 57*> The number of rows of the matrix A. M >= 0. 58*> \endverbatim 59*> 60*> \param[in] N 61*> \verbatim 62*> N is INTEGER 63*> The number of columns of the matrix A. N >= 0. 64*> \endverbatim 65*> 66*> \param[in] KL 67*> \verbatim 68*> KL is INTEGER 69*> The number of subdiagonals within the band of A. KL >= 0. 70*> \endverbatim 71*> 72*> \param[in] KU 73*> \verbatim 74*> KU is INTEGER 75*> The number of superdiagonals within the band of A. KU >= 0. 76*> \endverbatim 77*> 78*> \param[in] AB 79*> \verbatim 80*> AB is COMPLEX array, dimension (LDAB,N) 81*> The band matrix A, stored in rows 1 to KL+KU+1. The j-th 82*> column of A is stored in the j-th column of the array AB as 83*> follows: 84*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl). 85*> \endverbatim 86*> 87*> \param[in] LDAB 88*> \verbatim 89*> LDAB is INTEGER 90*> The leading dimension of the array AB. LDAB >= KL+KU+1. 91*> \endverbatim 92*> 93*> \param[out] R 94*> \verbatim 95*> R is REAL array, dimension (M) 96*> If INFO = 0, or INFO > M, R contains the row scale factors 97*> for A. 98*> \endverbatim 99*> 100*> \param[out] C 101*> \verbatim 102*> C is REAL array, dimension (N) 103*> If INFO = 0, C contains the column scale factors for A. 104*> \endverbatim 105*> 106*> \param[out] ROWCND 107*> \verbatim 108*> ROWCND is REAL 109*> If INFO = 0 or INFO > M, ROWCND contains the ratio of the 110*> smallest R(i) to the largest R(i). If ROWCND >= 0.1 and 111*> AMAX is neither too large nor too small, it is not worth 112*> scaling by R. 113*> \endverbatim 114*> 115*> \param[out] COLCND 116*> \verbatim 117*> COLCND is REAL 118*> If INFO = 0, COLCND contains the ratio of the smallest 119*> C(i) to the largest C(i). If COLCND >= 0.1, it is not 120*> worth scaling by C. 121*> \endverbatim 122*> 123*> \param[out] AMAX 124*> \verbatim 125*> AMAX is REAL 126*> Absolute value of largest matrix element. If AMAX is very 127*> close to overflow or very close to underflow, the matrix 128*> should be scaled. 129*> \endverbatim 130*> 131*> \param[out] INFO 132*> \verbatim 133*> INFO is INTEGER 134*> = 0: successful exit 135*> < 0: if INFO = -i, the i-th argument had an illegal value 136*> > 0: if INFO = i, and i is 137*> <= M: the i-th row of A is exactly zero 138*> > M: the (i-M)-th column of A is exactly zero 139*> \endverbatim 140* 141* Authors: 142* ======== 143* 144*> \author Univ. of Tennessee 145*> \author Univ. of California Berkeley 146*> \author Univ. of Colorado Denver 147*> \author NAG Ltd. 148* 149*> \ingroup complexGBcomputational 150* 151* ===================================================================== 152 SUBROUTINE CGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, 153 $ AMAX, INFO ) 154* 155* -- LAPACK computational routine -- 156* -- LAPACK is a software package provided by Univ. of Tennessee, -- 157* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 158* 159* .. Scalar Arguments .. 160 INTEGER INFO, KL, KU, LDAB, M, N 161 REAL AMAX, COLCND, ROWCND 162* .. 163* .. Array Arguments .. 164 REAL C( * ), R( * ) 165 COMPLEX AB( LDAB, * ) 166* .. 167* 168* ===================================================================== 169* 170* .. Parameters .. 171 REAL ONE, ZERO 172 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 173* .. 174* .. Local Scalars .. 175 INTEGER I, J, KD 176 REAL BIGNUM, RCMAX, RCMIN, SMLNUM 177 COMPLEX ZDUM 178* .. 179* .. External Functions .. 180 REAL SLAMCH 181 EXTERNAL SLAMCH 182* .. 183* .. External Subroutines .. 184 EXTERNAL XERBLA 185* .. 186* .. Intrinsic Functions .. 187 INTRINSIC ABS, AIMAG, MAX, MIN, REAL 188* .. 189* .. Statement Functions .. 190 REAL CABS1 191* .. 192* .. Statement Function definitions .. 193 CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) 194* .. 195* .. Executable Statements .. 196* 197* Test the input parameters 198* 199 INFO = 0 200 IF( M.LT.0 ) THEN 201 INFO = -1 202 ELSE IF( N.LT.0 ) THEN 203 INFO = -2 204 ELSE IF( KL.LT.0 ) THEN 205 INFO = -3 206 ELSE IF( KU.LT.0 ) THEN 207 INFO = -4 208 ELSE IF( LDAB.LT.KL+KU+1 ) THEN 209 INFO = -6 210 END IF 211 IF( INFO.NE.0 ) THEN 212 CALL XERBLA( 'CGBEQU', -INFO ) 213 RETURN 214 END IF 215* 216* Quick return if possible 217* 218 IF( M.EQ.0 .OR. N.EQ.0 ) THEN 219 ROWCND = ONE 220 COLCND = ONE 221 AMAX = ZERO 222 RETURN 223 END IF 224* 225* Get machine constants. 226* 227 SMLNUM = SLAMCH( 'S' ) 228 BIGNUM = ONE / SMLNUM 229* 230* Compute row scale factors. 231* 232 DO 10 I = 1, M 233 R( I ) = ZERO 234 10 CONTINUE 235* 236* Find the maximum element in each row. 237* 238 KD = KU + 1 239 DO 30 J = 1, N 240 DO 20 I = MAX( J-KU, 1 ), MIN( J+KL, M ) 241 R( I ) = MAX( R( I ), CABS1( AB( KD+I-J, J ) ) ) 242 20 CONTINUE 243 30 CONTINUE 244* 245* Find the maximum and minimum scale factors. 246* 247 RCMIN = BIGNUM 248 RCMAX = ZERO 249 DO 40 I = 1, M 250 RCMAX = MAX( RCMAX, R( I ) ) 251 RCMIN = MIN( RCMIN, R( I ) ) 252 40 CONTINUE 253 AMAX = RCMAX 254* 255 IF( RCMIN.EQ.ZERO ) THEN 256* 257* Find the first zero scale factor and return an error code. 258* 259 DO 50 I = 1, M 260 IF( R( I ).EQ.ZERO ) THEN 261 INFO = I 262 RETURN 263 END IF 264 50 CONTINUE 265 ELSE 266* 267* Invert the scale factors. 268* 269 DO 60 I = 1, M 270 R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM ) 271 60 CONTINUE 272* 273* Compute ROWCND = min(R(I)) / max(R(I)) 274* 275 ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) 276 END IF 277* 278* Compute column scale factors 279* 280 DO 70 J = 1, N 281 C( J ) = ZERO 282 70 CONTINUE 283* 284* Find the maximum element in each column, 285* assuming the row scaling computed above. 286* 287 KD = KU + 1 288 DO 90 J = 1, N 289 DO 80 I = MAX( J-KU, 1 ), MIN( J+KL, M ) 290 C( J ) = MAX( C( J ), CABS1( AB( KD+I-J, J ) )*R( I ) ) 291 80 CONTINUE 292 90 CONTINUE 293* 294* Find the maximum and minimum scale factors. 295* 296 RCMIN = BIGNUM 297 RCMAX = ZERO 298 DO 100 J = 1, N 299 RCMIN = MIN( RCMIN, C( J ) ) 300 RCMAX = MAX( RCMAX, C( J ) ) 301 100 CONTINUE 302* 303 IF( RCMIN.EQ.ZERO ) THEN 304* 305* Find the first zero scale factor and return an error code. 306* 307 DO 110 J = 1, N 308 IF( C( J ).EQ.ZERO ) THEN 309 INFO = M + J 310 RETURN 311 END IF 312 110 CONTINUE 313 ELSE 314* 315* Invert the scale factors. 316* 317 DO 120 J = 1, N 318 C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM ) 319 120 CONTINUE 320* 321* Compute COLCND = min(C(J)) / max(C(J)) 322* 323 COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) 324 END IF 325* 326 RETURN 327* 328* End of CGBEQU 329* 330 END 331