SRC/cgbequ.f

   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 *> \date November 2011
 150 *
 151 *> \ingroup complexGBcomputational
 152 *
 153 *  =====================================================================
 154       SUBROUTINE CGBEQU( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
 155      $                   AMAX, INFO )
 156 *
 157 *  -- LAPACK computational routine (version 3.4.0) --
 158 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 159 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 160 *     November 2011
 161 *
 162 *     .. Scalar Arguments ..
 163       INTEGER            INFO, KL, KU, LDAB, M, N
 164       REAL               AMAX, COLCND, ROWCND
 165 *     ..
 166 *     .. Array Arguments ..
 167       REAL               C( * ), R( * )
 168       COMPLEX            AB( LDAB, * )
 169 *     ..
 170 *
 171 *  =====================================================================
 172 *
 173 *     .. Parameters ..
 174       REAL               ONE, ZERO
 175       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 176 *     ..
 177 *     .. Local Scalars ..
 178       INTEGER            I, J, KD
 179       REAL               BIGNUM, RCMAX, RCMIN, SMLNUM
 180       COMPLEX            ZDUM
 181 *     ..
 182 *     .. External Functions ..
 183       REAL               SLAMCH
 184       EXTERNAL           SLAMCH
 185 *     ..
 186 *     .. External Subroutines ..
 187       EXTERNAL           XERBLA
 188 *     ..
 189 *     .. Intrinsic Functions ..
 190       INTRINSIC          ABS, AIMAG, MAX, MIN, REAL
 191 *     ..
 192 *     .. Statement Functions ..
 193       REAL               CABS1
 194 *     ..
 195 *     .. Statement Function definitions ..
 196       CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
 197 *     ..
 198 *     .. Executable Statements ..
 199 *
 200 *     Test the input parameters
 201 *
 202       INFO = 0
 203       IF( M.LT.0 ) THEN
 204          INFO = -1
 205       ELSE IF( N.LT.0 ) THEN
 206          INFO = -2
 207       ELSE IF( KL.LT.0 ) THEN
 208          INFO = -3
 209       ELSE IF( KU.LT.0 ) THEN
 210          INFO = -4
 211       ELSE IF( LDAB.LT.KL+KU+1 ) THEN
 212          INFO = -6
 213       END IF
 214       IF( INFO.NE.0 ) THEN
 215          CALL XERBLA( 'CGBEQU', -INFO )
 216          RETURN
 217       END IF
 218 *
 219 *     Quick return if possible
 220 *
 221       IF( M.EQ.0 .OR. N.EQ.0 ) THEN
 222          ROWCND = ONE
 223          COLCND = ONE
 224          AMAX = ZERO
 225          RETURN
 226       END IF
 227 *
 228 *     Get machine constants.
 229 *
 230       SMLNUM = SLAMCH( 'S' )
 231       BIGNUM = ONE / SMLNUM
 232 *
 233 *     Compute row scale factors.
 234 *
 235       DO 10 I = 1, M
 236          R( I ) = ZERO
 237    10 CONTINUE
 238 *
 239 *     Find the maximum element in each row.
 240 *
 241       KD = KU + 1
 242       DO 30 J = 1, N
 243          DO 20 I = MAX( J-KU, 1 ), MIN( J+KL, M )
 244             R( I ) = MAX( R( I ), CABS1( AB( KD+I-J, J ) ) )
 245    20    CONTINUE
 246    30 CONTINUE
 247 *
 248 *     Find the maximum and minimum scale factors.
 249 *
 250       RCMIN = BIGNUM
 251       RCMAX = ZERO
 252       DO 40 I = 1, M
 253          RCMAX = MAX( RCMAX, R( I ) )
 254          RCMIN = MIN( RCMIN, R( I ) )
 255    40 CONTINUE
 256       AMAX = RCMAX
 257 *
 258       IF( RCMIN.EQ.ZERO ) THEN
 259 *
 260 *        Find the first zero scale factor and return an error code.
 261 *
 262          DO 50 I = 1, M
 263             IF( R( I ).EQ.ZERO ) THEN
 264                INFO = I
 265                RETURN
 266             END IF
 267    50    CONTINUE
 268       ELSE
 269 *
 270 *        Invert the scale factors.
 271 *
 272          DO 60 I = 1, M
 273             R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
 274    60    CONTINUE
 275 *
 276 *        Compute ROWCND = min(R(I)) / max(R(I))
 277 *
 278          ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
 279       END IF
 280 *
 281 *     Compute column scale factors
 282 *
 283       DO 70 J = 1, N
 284          C( J ) = ZERO
 285    70 CONTINUE
 286 *
 287 *     Find the maximum element in each column,
 288 *     assuming the row scaling computed above.
 289 *
 290       KD = KU + 1
 291       DO 90 J = 1, N
 292          DO 80 I = MAX( J-KU, 1 ), MIN( J+KL, M )
 293             C( J ) = MAX( C( J ), CABS1( AB( KD+I-J, J ) )*R( I ) )
 294    80    CONTINUE
 295    90 CONTINUE
 296 *
 297 *     Find the maximum and minimum scale factors.
 298 *
 299       RCMIN = BIGNUM
 300       RCMAX = ZERO
 301       DO 100 J = 1, N
 302          RCMIN = MIN( RCMIN, C( J ) )
 303          RCMAX = MAX( RCMAX, C( J ) )
 304   100 CONTINUE
 305 *
 306       IF( RCMIN.EQ.ZERO ) THEN
 307 *
 308 *        Find the first zero scale factor and return an error code.
 309 *
 310          DO 110 J = 1, N
 311             IF( C( J ).EQ.ZERO ) THEN
 312                INFO = M + J
 313                RETURN
 314             END IF
 315   110    CONTINUE
 316       ELSE
 317 *
 318 *        Invert the scale factors.
 319 *
 320          DO 120 J = 1, N
 321             C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
 322   120    CONTINUE
 323 *
 324 *        Compute COLCND = min(C(J)) / max(C(J))
 325 *
 326          COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
 327       END IF
 328 *
 329       RETURN
 330 *
 331 *     End of CGBEQU
 332 *
 333       END