Return to zlaqgb.f CVS log

Up to [local] / rpl / lapack / lapack

En route pour la 4.0.15 !

    1:       SUBROUTINE ZLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
    2:      $                   AMAX, EQUED )
    3: *
    4: *  -- LAPACK auxiliary routine (version 3.2) --
    5: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    6: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    7: *     November 2006
    8: *
    9: *     .. Scalar Arguments ..
   10:       CHARACTER          EQUED
   11:       INTEGER            KL, KU, LDAB, M, N
   12:       DOUBLE PRECISION   AMAX, COLCND, ROWCND
   13: *     ..
   14: *     .. Array Arguments ..
   15:       DOUBLE PRECISION   C( * ), R( * )
   16:       COMPLEX*16         AB( LDAB, * )
   17: *     ..
   18: *
   19: *  Purpose
   20: *  =======
   21: *
   22: *  ZLAQGB equilibrates a general M by N band matrix A with KL
   23: *  subdiagonals and KU superdiagonals using the row and scaling factors
   24: *  in the vectors R and C.
   25: *
   26: *  Arguments
   27: *  =========
   28: *
   29: *  M       (input) INTEGER
   30: *          The number of rows of the matrix A.  M >= 0.
   31: *
   32: *  N       (input) INTEGER
   33: *          The number of columns of the matrix A.  N >= 0.
   34: *
   35: *  KL      (input) INTEGER
   36: *          The number of subdiagonals within the band of A.  KL >= 0.
   37: *
   38: *  KU      (input) INTEGER
   39: *          The number of superdiagonals within the band of A.  KU >= 0.
   40: *
   41: *  AB      (input/output) COMPLEX*16 array, dimension (LDAB,N)
   42: *          On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
   43: *          The j-th column of A is stored in the j-th column of the
   44: *          array AB as follows:
   45: *          AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
   46: *
   47: *          On exit, the equilibrated matrix, in the same storage format
   48: *          as A.  See EQUED for the form of the equilibrated matrix.
   49: *
   50: *  LDAB    (input) INTEGER
   51: *          The leading dimension of the array AB.  LDA >= KL+KU+1.
   52: *
   53: *  R       (input) DOUBLE PRECISION array, dimension (M)
   54: *          The row scale factors for A.
   55: *
   56: *  C       (input) DOUBLE PRECISION array, dimension (N)
   57: *          The column scale factors for A.
   58: *
   59: *  ROWCND  (input) DOUBLE PRECISION
   60: *          Ratio of the smallest R(i) to the largest R(i).
   61: *
   62: *  COLCND  (input) DOUBLE PRECISION
   63: *          Ratio of the smallest C(i) to the largest C(i).
   64: *
   65: *  AMAX    (input) DOUBLE PRECISION
   66: *          Absolute value of largest matrix entry.
   67: *
   68: *  EQUED   (output) CHARACTER*1
   69: *          Specifies the form of equilibration that was done.
   70: *          = 'N':  No equilibration
   71: *          = 'R':  Row equilibration, i.e., A has been premultiplied by
   72: *                  diag(R).
   73: *          = 'C':  Column equilibration, i.e., A has been postmultiplied
   74: *                  by diag(C).
   75: *          = 'B':  Both row and column equilibration, i.e., A has been
   76: *                  replaced by diag(R) * A * diag(C).
   77: *
   78: *  Internal Parameters
   79: *  ===================
   80: *
   81: *  THRESH is a threshold value used to decide if row or column scaling
   82: *  should be done based on the ratio of the row or column scaling
   83: *  factors.  If ROWCND < THRESH, row scaling is done, and if
   84: *  COLCND < THRESH, column scaling is done.
   85: *
   86: *  LARGE and SMALL are threshold values used to decide if row scaling
   87: *  should be done based on the absolute size of the largest matrix
   88: *  element.  If AMAX > LARGE or AMAX < SMALL, row scaling is done.
   89: *
   90: *  =====================================================================
   91: *
   92: *     .. Parameters ..
   93:       DOUBLE PRECISION   ONE, THRESH
   94:       PARAMETER          ( ONE = 1.0D+0, THRESH = 0.1D+0 )
   95: *     ..
   96: *     .. Local Scalars ..
   97:       INTEGER            I, J
   98:       DOUBLE PRECISION   CJ, LARGE, SMALL
   99: *     ..
  100: *     .. External Functions ..
  101:       DOUBLE PRECISION   DLAMCH
  102:       EXTERNAL           DLAMCH
  103: *     ..
  104: *     .. Intrinsic Functions ..
  105:       INTRINSIC          MAX, MIN
  106: *     ..
  107: *     .. Executable Statements ..
  108: *
  109: *     Quick return if possible
  110: *
  111:       IF( M.LE.0 .OR. N.LE.0 ) THEN
  112:          EQUED = 'N'
  113:          RETURN
  114:       END IF
  115: *
  116: *     Initialize LARGE and SMALL.
  117: *
  118:       SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
  119:       LARGE = ONE / SMALL
  120: *
  121:       IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
  122:      $     THEN
  123: *
  124: *        No row scaling
  125: *
  126:          IF( COLCND.GE.THRESH ) THEN
  127: *
  128: *           No column scaling
  129: *
  130:             EQUED = 'N'
  131:          ELSE
  132: *
  133: *           Column scaling
  134: *
  135:             DO 20 J = 1, N
  136:                CJ = C( J )
  137:                DO 10 I = MAX( 1, J-KU ), MIN( M, J+KL )
  138:                   AB( KU+1+I-J, J ) = CJ*AB( KU+1+I-J, J )
  139:    10          CONTINUE
  140:    20       CONTINUE
  141:             EQUED = 'C'
  142:          END IF
  143:       ELSE IF( COLCND.GE.THRESH ) THEN
  144: *
  145: *        Row scaling, no column scaling
  146: *
  147:          DO 40 J = 1, N
  148:             DO 30 I = MAX( 1, J-KU ), MIN( M, J+KL )
  149:                AB( KU+1+I-J, J ) = R( I )*AB( KU+1+I-J, J )
  150:    30       CONTINUE
  151:    40    CONTINUE
  152:          EQUED = 'R'
  153:       ELSE
  154: *
  155: *        Row and column scaling
  156: *
  157:          DO 60 J = 1, N
  158:             CJ = C( J )
  159:             DO 50 I = MAX( 1, J-KU ), MIN( M, J+KL )
  160:                AB( KU+1+I-J, J ) = CJ*R( I )*AB( KU+1+I-J, J )
  161:    50       CONTINUE
  162:    60    CONTINUE
  163:          EQUED = 'B'
  164:       END IF
  165: *
  166:       RETURN
  167: *
  168: *     End of ZLAQGB
  169: *
  170:       END