001:       SUBROUTINE ZLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
002:      $                   AMAX, EQUED )
003: *
004: *  -- LAPACK auxiliary routine (version 3.2) --
005: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       CHARACTER          EQUED
010:       INTEGER            KL, KU, LDAB, M, N
011:       DOUBLE PRECISION   AMAX, COLCND, ROWCND
012: *     ..
013: *     .. Array Arguments ..
014:       DOUBLE PRECISION   C( * ), R( * )
015:       COMPLEX*16         AB( LDAB, * )
016: *     ..
017: *
018: *  Purpose
019: *  =======
020: *
021: *  ZLAQGB equilibrates a general M by N band matrix A with KL
022: *  subdiagonals and KU superdiagonals using the row and scaling factors
023: *  in the vectors R and C.
024: *
025: *  Arguments
026: *  =========
027: *
028: *  M       (input) INTEGER
029: *          The number of rows of the matrix A.  M >= 0.
030: *
031: *  N       (input) INTEGER
032: *          The number of columns of the matrix A.  N >= 0.
033: *
034: *  KL      (input) INTEGER
035: *          The number of subdiagonals within the band of A.  KL >= 0.
036: *
037: *  KU      (input) INTEGER
038: *          The number of superdiagonals within the band of A.  KU >= 0.
039: *
040: *  AB      (input/output) COMPLEX*16 array, dimension (LDAB,N)
041: *          On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
042: *          The j-th column of A is stored in the j-th column of the
043: *          array AB as follows:
044: *          AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
045: *
046: *          On exit, the equilibrated matrix, in the same storage format
047: *          as A.  See EQUED for the form of the equilibrated matrix.
048: *
049: *  LDAB    (input) INTEGER
050: *          The leading dimension of the array AB.  LDA >= KL+KU+1.
051: *
052: *  R       (input) DOUBLE PRECISION array, dimension (M)
053: *          The row scale factors for A.
054: *
055: *  C       (input) DOUBLE PRECISION array, dimension (N)
056: *          The column scale factors for A.
057: *
058: *  ROWCND  (input) DOUBLE PRECISION
059: *          Ratio of the smallest R(i) to the largest R(i).
060: *
061: *  COLCND  (input) DOUBLE PRECISION
062: *          Ratio of the smallest C(i) to the largest C(i).
063: *
064: *  AMAX    (input) DOUBLE PRECISION
065: *          Absolute value of largest matrix entry.
066: *
067: *  EQUED   (output) CHARACTER*1
068: *          Specifies the form of equilibration that was done.
069: *          = 'N':  No equilibration
070: *          = 'R':  Row equilibration, i.e., A has been premultiplied by
071: *                  diag(R).
072: *          = 'C':  Column equilibration, i.e., A has been postmultiplied
073: *                  by diag(C).
074: *          = 'B':  Both row and column equilibration, i.e., A has been
075: *                  replaced by diag(R) * A * diag(C).
076: *
077: *  Internal Parameters
078: *  ===================
079: *
080: *  THRESH is a threshold value used to decide if row or column scaling
081: *  should be done based on the ratio of the row or column scaling
082: *  factors.  If ROWCND < THRESH, row scaling is done, and if
083: *  COLCND < THRESH, column scaling is done.
084: *
085: *  LARGE and SMALL are threshold values used to decide if row scaling
086: *  should be done based on the absolute size of the largest matrix
087: *  element.  If AMAX > LARGE or AMAX < SMALL, row scaling is done.
088: *
089: *  =====================================================================
090: *
091: *     .. Parameters ..
092:       DOUBLE PRECISION   ONE, THRESH
093:       PARAMETER          ( ONE = 1.0D+0, THRESH = 0.1D+0 )
094: *     ..
095: *     .. Local Scalars ..
096:       INTEGER            I, J
097:       DOUBLE PRECISION   CJ, LARGE, SMALL
098: *     ..
099: *     .. External Functions ..
100:       DOUBLE PRECISION   DLAMCH
101:       EXTERNAL           DLAMCH
102: *     ..
103: *     .. Intrinsic Functions ..
104:       INTRINSIC          MAX, MIN
105: *     ..
106: *     .. Executable Statements ..
107: *
108: *     Quick return if possible
109: *
110:       IF( M.LE.0 .OR. N.LE.0 ) THEN
111:          EQUED = 'N'
112:          RETURN
113:       END IF
114: *
115: *     Initialize LARGE and SMALL.
116: *
117:       SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
118:       LARGE = ONE / SMALL
119: *
120:       IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
121:      $     THEN
122: *
123: *        No row scaling
124: *
125:          IF( COLCND.GE.THRESH ) THEN
126: *
127: *           No column scaling
128: *
129:             EQUED = 'N'
130:          ELSE
131: *
132: *           Column scaling
133: *
134:             DO 20 J = 1, N
135:                CJ = C( J )
136:                DO 10 I = MAX( 1, J-KU ), MIN( M, J+KL )
137:                   AB( KU+1+I-J, J ) = CJ*AB( KU+1+I-J, J )
138:    10          CONTINUE
139:    20       CONTINUE
140:             EQUED = 'C'
141:          END IF
142:       ELSE IF( COLCND.GE.THRESH ) THEN
143: *
144: *        Row scaling, no column scaling
145: *
146:          DO 40 J = 1, N
147:             DO 30 I = MAX( 1, J-KU ), MIN( M, J+KL )
148:                AB( KU+1+I-J, J ) = R( I )*AB( KU+1+I-J, J )
149:    30       CONTINUE
150:    40    CONTINUE
151:          EQUED = 'R'
152:       ELSE
153: *
154: *        Row and column scaling
155: *
156:          DO 60 J = 1, N
157:             CJ = C( J )
158:             DO 50 I = MAX( 1, J-KU ), MIN( M, J+KL )
159:                AB( KU+1+I-J, J ) = CJ*R( I )*AB( KU+1+I-J, J )
160:    50       CONTINUE
161:    60    CONTINUE
162:          EQUED = 'B'
163:       END IF
164: *
165:       RETURN
166: *
167: *     End of ZLAQGB
168: *
169:       END
170: