LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cgbequb.f
Go to the documentation of this file.
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. Baring over- and underflow, scaling by
53 *> these factors introduces no additional rounding errors. However, the
54 *> scaled entries' magnitured 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 DOUBLE PRECISION 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 *> \date November 2011
157 *
158 *> \ingroup complexGBcomputational
159 *
160 * =====================================================================
161  SUBROUTINE cgbequb( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
162  $ amax, info )
163 *
164 * -- LAPACK computational routine (version 3.4.0) --
165 * -- LAPACK is a software package provided by Univ. of Tennessee, --
166 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
167 * November 2011
168 *
169 * .. Scalar Arguments ..
170  INTEGER info, kl, ku, ldab, m, n
171  REAL amax, colcnd, rowcnd
172 * ..
173 * .. Array Arguments ..
174  REAL c( * ), r( * )
175  COMPLEX ab( ldab, * )
176 * ..
177 *
178 * =====================================================================
179 *
180 * .. Parameters ..
181  REAL one, zero
182  parameter( one = 1.0e+0, zero = 0.0e+0 )
183 * ..
184 * .. Local Scalars ..
185  INTEGER i, j, kd
186  REAL bignum, rcmax, rcmin, smlnum, radix,
187  $ logrdx
188  COMPLEX zdum
189 * ..
190 * .. External Functions ..
191  REAL slamch
192  EXTERNAL slamch
193 * ..
194 * .. External Subroutines ..
195  EXTERNAL xerbla
196 * ..
197 * .. Intrinsic Functions ..
198  INTRINSIC abs, max, min, log, REAL, aimag
199 * ..
200 * .. Statement Functions ..
201  REAL cabs1
202 * ..
203 * .. Statement Function definitions ..
204  cabs1( zdum ) = abs( REAL( ZDUM ) ) + abs( aimag( zdum ) )
205 * ..
206 * .. Executable Statements ..
207 *
208 * Test the input parameters.
209 *
210  info = 0
211  IF( m.LT.0 ) THEN
212  info = -1
213  ELSE IF( n.LT.0 ) THEN
214  info = -2
215  ELSE IF( kl.LT.0 ) THEN
216  info = -3
217  ELSE IF( ku.LT.0 ) THEN
218  info = -4
219  ELSE IF( ldab.LT.kl+ku+1 ) THEN
220  info = -6
221  END IF
222  IF( info.NE.0 ) THEN
223  CALL xerbla( 'CGBEQUB', -info )
224  return
225  END IF
226 *
227 * Quick return if possible.
228 *
229  IF( m.EQ.0 .OR. n.EQ.0 ) THEN
230  rowcnd = one
231  colcnd = one
232  amax = zero
233  return
234  END IF
235 *
236 * Get machine constants. Assume SMLNUM is a power of the radix.
237 *
238  smlnum = slamch( 'S' )
239  bignum = one / smlnum
240  radix = slamch( 'B' )
241  logrdx = log(radix)
242 *
243 * Compute row scale factors.
244 *
245  DO 10 i = 1, m
246  r( i ) = zero
247  10 continue
248 *
249 * Find the maximum element in each row.
250 *
251  kd = ku + 1
252  DO 30 j = 1, n
253  DO 20 i = max( j-ku, 1 ), min( j+kl, m )
254  r( i ) = max( r( i ), cabs1( ab( kd+i-j, j ) ) )
255  20 continue
256  30 continue
257  DO i = 1, m
258  IF( r( i ).GT.zero ) THEN
259  r( i ) = radix**int( log( r( i ) ) / logrdx )
260  END IF
261  END DO
262 *
263 * Find the maximum and minimum scale factors.
264 *
265  rcmin = bignum
266  rcmax = zero
267  DO 40 i = 1, m
268  rcmax = max( rcmax, r( i ) )
269  rcmin = min( rcmin, r( i ) )
270  40 continue
271  amax = rcmax
272 *
273  IF( rcmin.EQ.zero ) THEN
274 *
275 * Find the first zero scale factor and return an error code.
276 *
277  DO 50 i = 1, m
278  IF( r( i ).EQ.zero ) THEN
279  info = i
280  return
281  END IF
282  50 continue
283  ELSE
284 *
285 * Invert the scale factors.
286 *
287  DO 60 i = 1, m
288  r( i ) = one / min( max( r( i ), smlnum ), bignum )
289  60 continue
290 *
291 * Compute ROWCND = min(R(I)) / max(R(I)).
292 *
293  rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
294  END IF
295 *
296 * Compute column scale factors.
297 *
298  DO 70 j = 1, n
299  c( j ) = zero
300  70 continue
301 *
302 * Find the maximum element in each column,
303 * assuming the row scaling computed above.
304 *
305  DO 90 j = 1, n
306  DO 80 i = max( j-ku, 1 ), min( j+kl, m )
307  c( j ) = max( c( j ), cabs1( ab( kd+i-j, j ) )*r( i ) )
308  80 continue
309  IF( c( j ).GT.zero ) THEN
310  c( j ) = radix**int( log( c( j ) ) / logrdx )
311  END IF
312  90 continue
313 *
314 * Find the maximum and minimum scale factors.
315 *
316  rcmin = bignum
317  rcmax = zero
318  DO 100 j = 1, n
319  rcmin = min( rcmin, c( j ) )
320  rcmax = max( rcmax, c( j ) )
321  100 continue
322 *
323  IF( rcmin.EQ.zero ) THEN
324 *
325 * Find the first zero scale factor and return an error code.
326 *
327  DO 110 j = 1, n
328  IF( c( j ).EQ.zero ) THEN
329  info = m + j
330  return
331  END IF
332  110 continue
333  ELSE
334 *
335 * Invert the scale factors.
336 *
337  DO 120 j = 1, n
338  c( j ) = one / min( max( c( j ), smlnum ), bignum )
339  120 continue
340 *
341 * Compute COLCND = min(C(J)) / max(C(J)).
342 *
343  colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
344  END IF
345 *
346  return
347 *
348 * End of CGBEQUB
349 *
350  END