```001:       SUBROUTINE ZGEEQU( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
002:      \$                   INFO )
003: *
004: *  -- LAPACK 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:       INTEGER            INFO, LDA, M, N
011:       DOUBLE PRECISION   AMAX, COLCND, ROWCND
012: *     ..
013: *     .. Array Arguments ..
014:       DOUBLE PRECISION   C( * ), R( * )
015:       COMPLEX*16         A( LDA, * )
016: *     ..
017: *
018: *  Purpose
019: *  =======
020: *
021: *  ZGEEQU computes row and column scalings intended to equilibrate an
022: *  M-by-N matrix A and reduce its condition number.  R returns the row
023: *  scale factors and C the column scale factors, chosen to try to make
024: *  the largest element in each row and column of the matrix B with
025: *  elements B(i,j)=R(i)*A(i,j)*C(j) have absolute value 1.
026: *
027: *  R(i) and C(j) are restricted to be between SMLNUM = smallest safe
028: *  number and BIGNUM = largest safe number.  Use of these scaling
029: *  factors is not guaranteed to reduce the condition number of A but
030: *  works well in practice.
031: *
032: *  Arguments
033: *  =========
034: *
035: *  M       (input) INTEGER
036: *          The number of rows of the matrix A.  M >= 0.
037: *
038: *  N       (input) INTEGER
039: *          The number of columns of the matrix A.  N >= 0.
040: *
041: *  A       (input) COMPLEX*16 array, dimension (LDA,N)
042: *          The M-by-N matrix whose equilibration factors are
043: *          to be computed.
044: *
045: *  LDA     (input) INTEGER
046: *          The leading dimension of the array A.  LDA >= max(1,M).
047: *
048: *  R       (output) DOUBLE PRECISION array, dimension (M)
049: *          If INFO = 0 or INFO > M, R contains the row scale factors
050: *          for A.
051: *
052: *  C       (output) DOUBLE PRECISION array, dimension (N)
053: *          If INFO = 0,  C contains the column scale factors for A.
054: *
055: *  ROWCND  (output) DOUBLE PRECISION
056: *          If INFO = 0 or INFO > M, ROWCND contains the ratio of the
057: *          smallest R(i) to the largest R(i).  If ROWCND >= 0.1 and
058: *          AMAX is neither too large nor too small, it is not worth
059: *          scaling by R.
060: *
061: *  COLCND  (output) DOUBLE PRECISION
062: *          If INFO = 0, COLCND contains the ratio of the smallest
063: *          C(i) to the largest C(i).  If COLCND >= 0.1, it is not
064: *          worth scaling by C.
065: *
066: *  AMAX    (output) DOUBLE PRECISION
067: *          Absolute value of largest matrix element.  If AMAX is very
068: *          close to overflow or very close to underflow, the matrix
069: *          should be scaled.
070: *
071: *  INFO    (output) INTEGER
072: *          = 0:  successful exit
073: *          < 0:  if INFO = -i, the i-th argument had an illegal value
074: *          > 0:  if INFO = i,  and i is
075: *                <= M:  the i-th row of A is exactly zero
076: *                >  M:  the (i-M)-th column of A is exactly zero
077: *
078: *  =====================================================================
079: *
080: *     .. Parameters ..
081:       DOUBLE PRECISION   ONE, ZERO
082:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
083: *     ..
084: *     .. Local Scalars ..
085:       INTEGER            I, J
086:       DOUBLE PRECISION   BIGNUM, RCMAX, RCMIN, SMLNUM
087:       COMPLEX*16         ZDUM
088: *     ..
089: *     .. External Functions ..
090:       DOUBLE PRECISION   DLAMCH
091:       EXTERNAL           DLAMCH
092: *     ..
093: *     .. External Subroutines ..
094:       EXTERNAL           XERBLA
095: *     ..
096: *     .. Intrinsic Functions ..
097:       INTRINSIC          ABS, DBLE, DIMAG, MAX, MIN
098: *     ..
099: *     .. Statement Functions ..
100:       DOUBLE PRECISION   CABS1
101: *     ..
102: *     .. Statement Function definitions ..
103:       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) )
104: *     ..
105: *     .. Executable Statements ..
106: *
107: *     Test the input parameters.
108: *
109:       INFO = 0
110:       IF( M.LT.0 ) THEN
111:          INFO = -1
112:       ELSE IF( N.LT.0 ) THEN
113:          INFO = -2
114:       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
115:          INFO = -4
116:       END IF
117:       IF( INFO.NE.0 ) THEN
118:          CALL XERBLA( 'ZGEEQU', -INFO )
119:          RETURN
120:       END IF
121: *
122: *     Quick return if possible
123: *
124:       IF( M.EQ.0 .OR. N.EQ.0 ) THEN
125:          ROWCND = ONE
126:          COLCND = ONE
127:          AMAX = ZERO
128:          RETURN
129:       END IF
130: *
131: *     Get machine constants.
132: *
133:       SMLNUM = DLAMCH( 'S' )
134:       BIGNUM = ONE / SMLNUM
135: *
136: *     Compute row scale factors.
137: *
138:       DO 10 I = 1, M
139:          R( I ) = ZERO
140:    10 CONTINUE
141: *
142: *     Find the maximum element in each row.
143: *
144:       DO 30 J = 1, N
145:          DO 20 I = 1, M
146:             R( I ) = MAX( R( I ), CABS1( A( I, J ) ) )
147:    20    CONTINUE
148:    30 CONTINUE
149: *
150: *     Find the maximum and minimum scale factors.
151: *
152:       RCMIN = BIGNUM
153:       RCMAX = ZERO
154:       DO 40 I = 1, M
155:          RCMAX = MAX( RCMAX, R( I ) )
156:          RCMIN = MIN( RCMIN, R( I ) )
157:    40 CONTINUE
158:       AMAX = RCMAX
159: *
160:       IF( RCMIN.EQ.ZERO ) THEN
161: *
162: *        Find the first zero scale factor and return an error code.
163: *
164:          DO 50 I = 1, M
165:             IF( R( I ).EQ.ZERO ) THEN
166:                INFO = I
167:                RETURN
168:             END IF
169:    50    CONTINUE
170:       ELSE
171: *
172: *        Invert the scale factors.
173: *
174:          DO 60 I = 1, M
175:             R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
176:    60    CONTINUE
177: *
178: *        Compute ROWCND = min(R(I)) / max(R(I))
179: *
180:          ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
181:       END IF
182: *
183: *     Compute column scale factors
184: *
185:       DO 70 J = 1, N
186:          C( J ) = ZERO
187:    70 CONTINUE
188: *
189: *     Find the maximum element in each column,
190: *     assuming the row scaling computed above.
191: *
192:       DO 90 J = 1, N
193:          DO 80 I = 1, M
194:             C( J ) = MAX( C( J ), CABS1( A( I, J ) )*R( I ) )
195:    80    CONTINUE
196:    90 CONTINUE
197: *
198: *     Find the maximum and minimum scale factors.
199: *
200:       RCMIN = BIGNUM
201:       RCMAX = ZERO
202:       DO 100 J = 1, N
203:          RCMIN = MIN( RCMIN, C( J ) )
204:          RCMAX = MAX( RCMAX, C( J ) )
205:   100 CONTINUE
206: *
207:       IF( RCMIN.EQ.ZERO ) THEN
208: *
209: *        Find the first zero scale factor and return an error code.
210: *
211:          DO 110 J = 1, N
212:             IF( C( J ).EQ.ZERO ) THEN
213:                INFO = M + J
214:                RETURN
215:             END IF
216:   110    CONTINUE
217:       ELSE
218: *
219: *        Invert the scale factors.
220: *
221:          DO 120 J = 1, N
222:             C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
223:   120    CONTINUE
224: *
225: *        Compute COLCND = min(C(J)) / max(C(J))
226: *
227:          COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
228:       END IF
229: *
230:       RETURN
231: *
232: *     End of ZGEEQU
233: *
234:       END
235: ```