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