001:       SUBROUTINE CLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
002:      $                   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            LDA, M, N
011:       REAL               AMAX, COLCND, ROWCND
012: *     ..
013: *     .. Array Arguments ..
014:       REAL               C( * ), R( * )
015:       COMPLEX            A( LDA, * )
016: *     ..
017: *
018: *  Purpose
019: *  =======
020: *
021: *  CLAQGE equilibrates a general M by N matrix A using the row and
022: *  column scaling factors in the vectors R and C.
023: *
024: *  Arguments
025: *  =========
026: *
027: *  M       (input) INTEGER
028: *          The number of rows of the matrix A.  M >= 0.
029: *
030: *  N       (input) INTEGER
031: *          The number of columns of the matrix A.  N >= 0.
032: *
033: *  A       (input/output) COMPLEX array, dimension (LDA,N)
034: *          On entry, the M by N matrix A.
035: *          On exit, the equilibrated matrix.  See EQUED for the form of
036: *          the equilibrated matrix.
037: *
038: *  LDA     (input) INTEGER
039: *          The leading dimension of the array A.  LDA >= max(M,1).
040: *
041: *  R       (input) REAL array, dimension (M)
042: *          The row scale factors for A.
043: *
044: *  C       (input) REAL array, dimension (N)
045: *          The column scale factors for A.
046: *
047: *  ROWCND  (input) REAL
048: *          Ratio of the smallest R(i) to the largest R(i).
049: *
050: *  COLCND  (input) REAL
051: *          Ratio of the smallest C(i) to the largest C(i).
052: *
053: *  AMAX    (input) REAL
054: *          Absolute value of largest matrix entry.
055: *
056: *  EQUED   (output) CHARACTER*1
057: *          Specifies the form of equilibration that was done.
058: *          = 'N':  No equilibration
059: *          = 'R':  Row equilibration, i.e., A has been premultiplied by
060: *                  diag(R).
061: *          = 'C':  Column equilibration, i.e., A has been postmultiplied
062: *                  by diag(C).
063: *          = 'B':  Both row and column equilibration, i.e., A has been
064: *                  replaced by diag(R) * A * diag(C).
065: *
066: *  Internal Parameters
067: *  ===================
068: *
069: *  THRESH is a threshold value used to decide if row or column scaling
070: *  should be done based on the ratio of the row or column scaling
071: *  factors.  If ROWCND < THRESH, row scaling is done, and if
072: *  COLCND < THRESH, column scaling is done.
073: *
074: *  LARGE and SMALL are threshold values used to decide if row scaling
075: *  should be done based on the absolute size of the largest matrix
076: *  element.  If AMAX > LARGE or AMAX < SMALL, row scaling is done.
077: *
078: *  =====================================================================
079: *
080: *     .. Parameters ..
081:       REAL               ONE, THRESH
082:       PARAMETER          ( ONE = 1.0E+0, THRESH = 0.1E+0 )
083: *     ..
084: *     .. Local Scalars ..
085:       INTEGER            I, J
086:       REAL               CJ, LARGE, SMALL
087: *     ..
088: *     .. External Functions ..
089:       REAL               SLAMCH
090:       EXTERNAL           SLAMCH
091: *     ..
092: *     .. Executable Statements ..
093: *
094: *     Quick return if possible
095: *
096:       IF( M.LE.0 .OR. N.LE.0 ) THEN
097:          EQUED = 'N'
098:          RETURN
099:       END IF
100: *
101: *     Initialize LARGE and SMALL.
102: *
103:       SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
104:       LARGE = ONE / SMALL
105: *
106:       IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
107:      $     THEN
108: *
109: *        No row scaling
110: *
111:          IF( COLCND.GE.THRESH ) THEN
112: *
113: *           No column scaling
114: *
115:             EQUED = 'N'
116:          ELSE
117: *
118: *           Column scaling
119: *
120:             DO 20 J = 1, N
121:                CJ = C( J )
122:                DO 10 I = 1, M
123:                   A( I, J ) = CJ*A( I, J )
124:    10          CONTINUE
125:    20       CONTINUE
126:             EQUED = 'C'
127:          END IF
128:       ELSE IF( COLCND.GE.THRESH ) THEN
129: *
130: *        Row scaling, no column scaling
131: *
132:          DO 40 J = 1, N
133:             DO 30 I = 1, M
134:                A( I, J ) = R( I )*A( I, J )
135:    30       CONTINUE
136:    40    CONTINUE
137:          EQUED = 'R'
138:       ELSE
139: *
140: *        Row and column scaling
141: *
142:          DO 60 J = 1, N
143:             CJ = C( J )
144:             DO 50 I = 1, M
145:                A( I, J ) = CJ*R( I )*A( I, J )
146:    50       CONTINUE
147:    60    CONTINUE
148:          EQUED = 'B'
149:       END IF
150: *
151:       RETURN
152: *
153: *     End of CLAQGE
154: *
155:       END
156: