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: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
006: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
007: *     November 2006
008: *
009: *     .. Scalar Arguments ..
010:       CHARACTER          EQUED
011:       INTEGER            KL, KU, LDAB, M, N
012:       DOUBLE PRECISION   AMAX, COLCND, ROWCND
013: *     ..
014: *     .. Array Arguments ..
015:       DOUBLE PRECISION   C( * ), R( * )
016:       COMPLEX*16         AB( LDAB, * )
017: *     ..
018: *
019: *  Purpose
020: *  =======
021: *
022: *  ZLAQGB equilibrates a general M by N band matrix A with KL
023: *  subdiagonals and KU superdiagonals using the row and scaling factors
024: *  in the vectors R and C.
025: *
026: *  Arguments
027: *  =========
028: *
029: *  M       (input) INTEGER
030: *          The number of rows of the matrix A.  M >= 0.
031: *
032: *  N       (input) INTEGER
033: *          The number of columns of the matrix A.  N >= 0.
034: *
035: *  KL      (input) INTEGER
036: *          The number of subdiagonals within the band of A.  KL >= 0.
037: *
038: *  KU      (input) INTEGER
039: *          The number of superdiagonals within the band of A.  KU >= 0.
040: *
041: *  AB      (input/output) COMPLEX*16 array, dimension (LDAB,N)
042: *          On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
043: *          The j-th column of A is stored in the j-th column of the
044: *          array AB as follows:
045: *          AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
046: *
047: *          On exit, the equilibrated matrix, in the same storage format
048: *          as A.  See EQUED for the form of the equilibrated matrix.
049: *
050: *  LDAB    (input) INTEGER
051: *          The leading dimension of the array AB.  LDA >= KL+KU+1.
052: *
053: *  R       (input) DOUBLE PRECISION array, dimension (M)
054: *          The row scale factors for A.
055: *
056: *  C       (input) DOUBLE PRECISION array, dimension (N)
057: *          The column scale factors for A.
058: *
059: *  ROWCND  (input) DOUBLE PRECISION
060: *          Ratio of the smallest R(i) to the largest R(i).
061: *
062: *  COLCND  (input) DOUBLE PRECISION
063: *          Ratio of the smallest C(i) to the largest C(i).
064: *
065: *  AMAX    (input) DOUBLE PRECISION
066: *          Absolute value of largest matrix entry.
067: *
068: *  EQUED   (output) CHARACTER*1
069: *          Specifies the form of equilibration that was done.
070: *          = 'N':  No equilibration
071: *          = 'R':  Row equilibration, i.e., A has been premultiplied by
072: *                  diag(R).
073: *          = 'C':  Column equilibration, i.e., A has been postmultiplied
074: *                  by diag(C).
075: *          = 'B':  Both row and column equilibration, i.e., A has been
076: *                  replaced by diag(R) * A * diag(C).
077: *
078: *  Internal Parameters
079: *  ===================
080: *
081: *  THRESH is a threshold value used to decide if row or column scaling
082: *  should be done based on the ratio of the row or column scaling
083: *  factors.  If ROWCND < THRESH, row scaling is done, and if
084: *  COLCND < THRESH, column scaling is done.
085: *
086: *  LARGE and SMALL are threshold values used to decide if row scaling
087: *  should be done based on the absolute size of the largest matrix
088: *  element.  If AMAX > LARGE or AMAX < SMALL, row scaling is done.
089: *
090: *  =====================================================================
091: *
092: *     .. Parameters ..
093:       DOUBLE PRECISION   ONE, THRESH
094:       PARAMETER          ( ONE = 1.0D+0, THRESH = 0.1D+0 )
095: *     ..
096: *     .. Local Scalars ..
097:       INTEGER            I, J
098:       DOUBLE PRECISION   CJ, LARGE, SMALL
099: *     ..
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
171: