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