1*> \brief \b CGBEQUB
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CGBEQUB + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbequb.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgbequb.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbequb.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
22*                           AMAX, INFO )
23*
24*       .. Scalar Arguments ..
25*       INTEGER            INFO, KL, KU, LDAB, M, N
26*       REAL               AMAX, COLCND, ROWCND
27*       ..
28*       .. Array Arguments ..
29*       REAL               C( * ), R( * )
30*       COMPLEX            AB( LDAB, * )
31*       ..
32*
33*
34*> \par Purpose:
35*  =============
36*>
37*> \verbatim
38*>
39*> CGBEQUB computes row and column scalings intended to equilibrate an
40*> M-by-N matrix A and reduce its condition number.  R returns the row
41*> scale factors and C the column scale factors, chosen to try to make
42*> the largest element in each row and column of the matrix B with
43*> elements B(i,j)=R(i)*A(i,j)*C(j) have an absolute value of at most
44*> the radix.
45*>
46*> R(i) and C(j) are restricted to be a power of the radix between
47*> SMLNUM = smallest safe number and BIGNUM = largest safe number.  Use
48*> of these scaling factors is not guaranteed to reduce the condition
49*> number of A but works well in practice.
50*>
51*> This routine differs from CGEEQU by restricting the scaling factors
52*> to a power of the radix.  Barring over- and underflow, scaling by
53*> these factors introduces no additional rounding errors.  However, the
54*> scaled entries' magnitudes are no longer approximately 1 but lie
55*> between sqrt(radix) and 1/sqrt(radix).
56*> \endverbatim
57*
58*  Arguments:
59*  ==========
60*
61*> \param[in] M
62*> \verbatim
63*>          M is INTEGER
64*>          The number of rows of the matrix A.  M >= 0.
65*> \endverbatim
66*>
67*> \param[in] N
68*> \verbatim
69*>          N is INTEGER
70*>          The number of columns of the matrix A.  N >= 0.
71*> \endverbatim
72*>
73*> \param[in] KL
74*> \verbatim
75*>          KL is INTEGER
76*>          The number of subdiagonals within the band of A.  KL >= 0.
77*> \endverbatim
78*>
79*> \param[in] KU
80*> \verbatim
81*>          KU is INTEGER
82*>          The number of superdiagonals within the band of A.  KU >= 0.
83*> \endverbatim
84*>
85*> \param[in] AB
86*> \verbatim
87*>          AB is COMPLEX array, dimension (LDAB,N)
88*>          On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
89*>          The j-th column of A is stored in the j-th column of the
90*>          array AB as follows:
91*>          AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl)
92*> \endverbatim
93*>
94*> \param[in] LDAB
95*> \verbatim
96*>          LDAB is INTEGER
97*>          The leading dimension of the array A.  LDAB >= max(1,M).
98*> \endverbatim
99*>
100*> \param[out] R
101*> \verbatim
102*>          R is REAL array, dimension (M)
103*>          If INFO = 0 or INFO > M, R contains the row scale factors
104*>          for A.
105*> \endverbatim
106*>
107*> \param[out] C
108*> \verbatim
109*>          C is REAL array, dimension (N)
110*>          If INFO = 0,  C contains the column scale factors for A.
111*> \endverbatim
112*>
113*> \param[out] ROWCND
114*> \verbatim
115*>          ROWCND is REAL
116*>          If INFO = 0 or INFO > M, ROWCND contains the ratio of the
117*>          smallest R(i) to the largest R(i).  If ROWCND >= 0.1 and
118*>          AMAX is neither too large nor too small, it is not worth
119*>          scaling by R.
120*> \endverbatim
121*>
122*> \param[out] COLCND
123*> \verbatim
124*>          COLCND is REAL
125*>          If INFO = 0, COLCND contains the ratio of the smallest
126*>          C(i) to the largest C(i).  If COLCND >= 0.1, it is not
127*>          worth scaling by C.
128*> \endverbatim
129*>
130*> \param[out] AMAX
131*> \verbatim
132*>          AMAX is REAL
133*>          Absolute value of largest matrix element.  If AMAX is very
134*>          close to overflow or very close to underflow, the matrix
135*>          should be scaled.
136*> \endverbatim
137*>
138*> \param[out] INFO
139*> \verbatim
140*>          INFO is INTEGER
141*>          = 0:  successful exit
142*>          < 0:  if INFO = -i, the i-th argument had an illegal value
143*>          > 0:  if INFO = i,  and i is
144*>                <= M:  the i-th row of A is exactly zero
145*>                >  M:  the (i-M)-th column of A is exactly zero
146*> \endverbatim
147*
148*  Authors:
149*  ========
150*
151*> \author Univ. of Tennessee
152*> \author Univ. of California Berkeley
153*> \author Univ. of Colorado Denver
154*> \author NAG Ltd.
155*
156*> \ingroup complexGBcomputational
157*
158*  =====================================================================
159      SUBROUTINE CGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
160     $                    AMAX, INFO )
161*
162*  -- LAPACK computational routine --
163*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
164*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
165*
166*     .. Scalar Arguments ..
167      INTEGER            INFO, KL, KU, LDAB, M, N
168      REAL               AMAX, COLCND, ROWCND
169*     ..
170*     .. Array Arguments ..
171      REAL               C( * ), R( * )
172      COMPLEX            AB( LDAB, * )
173*     ..
174*
175*  =====================================================================
176*
177*     .. Parameters ..
178      REAL               ONE, ZERO
179      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
180*     ..
181*     .. Local Scalars ..
182      INTEGER            I, J, KD
183      REAL               BIGNUM, RCMAX, RCMIN, SMLNUM, RADIX,
184     $                   LOGRDX
185      COMPLEX            ZDUM
186*     ..
187*     .. External Functions ..
188      REAL               SLAMCH
189      EXTERNAL           SLAMCH
190*     ..
191*     .. External Subroutines ..
192      EXTERNAL           XERBLA
193*     ..
194*     .. Intrinsic Functions ..
195      INTRINSIC          ABS, MAX, MIN, LOG, REAL, AIMAG
196*     ..
197*     .. Statement Functions ..
198      REAL               CABS1
199*     ..
200*     .. Statement Function definitions ..
201      CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
202*     ..
203*     .. Executable Statements ..
204*
205*     Test the input parameters.
206*
207      INFO = 0
208      IF( M.LT.0 ) THEN
209         INFO = -1
210      ELSE IF( N.LT.0 ) THEN
211         INFO = -2
212      ELSE IF( KL.LT.0 ) THEN
213         INFO = -3
214      ELSE IF( KU.LT.0 ) THEN
215         INFO = -4
216      ELSE IF( LDAB.LT.KL+KU+1 ) THEN
217         INFO = -6
218      END IF
219      IF( INFO.NE.0 ) THEN
220         CALL XERBLA( 'CGBEQUB', -INFO )
221         RETURN
222      END IF
223*
224*     Quick return if possible.
225*
226      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
227         ROWCND = ONE
228         COLCND = ONE
229         AMAX = ZERO
230         RETURN
231      END IF
232*
233*     Get machine constants.  Assume SMLNUM is a power of the radix.
234*
235      SMLNUM = SLAMCH( 'S' )
236      BIGNUM = ONE / SMLNUM
237      RADIX = SLAMCH( 'B' )
238      LOGRDX = LOG(RADIX)
239*
240*     Compute row scale factors.
241*
242      DO 10 I = 1, M
243         R( I ) = ZERO
244   10 CONTINUE
245*
246*     Find the maximum element in each row.
247*
248      KD = KU + 1
249      DO 30 J = 1, N
250         DO 20 I = MAX( J-KU, 1 ), MIN( J+KL, M )
251            R( I ) = MAX( R( I ), CABS1( AB( KD+I-J, J ) ) )
252   20    CONTINUE
253   30 CONTINUE
254      DO I = 1, M
255         IF( R( I ).GT.ZERO ) THEN
256            R( I ) = RADIX**INT( LOG( R( I ) ) / LOGRDX )
257         END IF
258      END DO
259*
260*     Find the maximum and minimum scale factors.
261*
262      RCMIN = BIGNUM
263      RCMAX = ZERO
264      DO 40 I = 1, M
265         RCMAX = MAX( RCMAX, R( I ) )
266         RCMIN = MIN( RCMIN, R( I ) )
267   40 CONTINUE
268      AMAX = RCMAX
269*
270      IF( RCMIN.EQ.ZERO ) THEN
271*
272*        Find the first zero scale factor and return an error code.
273*
274         DO 50 I = 1, M
275            IF( R( I ).EQ.ZERO ) THEN
276               INFO = I
277               RETURN
278            END IF
279   50    CONTINUE
280      ELSE
281*
282*        Invert the scale factors.
283*
284         DO 60 I = 1, M
285            R( I ) = ONE / MIN( MAX( R( I ), SMLNUM ), BIGNUM )
286   60    CONTINUE
287*
288*        Compute ROWCND = min(R(I)) / max(R(I)).
289*
290         ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
291      END IF
292*
293*     Compute column scale factors.
294*
295      DO 70 J = 1, N
296         C( J ) = ZERO
297   70 CONTINUE
298*
299*     Find the maximum element in each column,
300*     assuming the row scaling computed above.
301*
302      DO 90 J = 1, N
303         DO 80 I = MAX( J-KU, 1 ), MIN( J+KL, M )
304            C( J ) = MAX( C( J ), CABS1( AB( KD+I-J, J ) )*R( I ) )
305   80    CONTINUE
306         IF( C( J ).GT.ZERO ) THEN
307            C( J ) = RADIX**INT( LOG( C( J ) ) / LOGRDX )
308         END IF
309   90 CONTINUE
310*
311*     Find the maximum and minimum scale factors.
312*
313      RCMIN = BIGNUM
314      RCMAX = ZERO
315      DO 100 J = 1, N
316         RCMIN = MIN( RCMIN, C( J ) )
317         RCMAX = MAX( RCMAX, C( J ) )
318  100 CONTINUE
319*
320      IF( RCMIN.EQ.ZERO ) THEN
321*
322*        Find the first zero scale factor and return an error code.
323*
324         DO 110 J = 1, N
325            IF( C( J ).EQ.ZERO ) THEN
326               INFO = M + J
327               RETURN
328            END IF
329  110    CONTINUE
330      ELSE
331*
332*        Invert the scale factors.
333*
334         DO 120 J = 1, N
335            C( J ) = ONE / MIN( MAX( C( J ), SMLNUM ), BIGNUM )
336  120    CONTINUE
337*
338*        Compute COLCND = min(C(J)) / max(C(J)).
339*
340         COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
341      END IF
342*
343      RETURN
344*
345*     End of CGBEQUB
346*
347      END
348