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