LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
claqgb.f
Go to the documentation of this file.
1*> \brief \b CLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CLAQGB + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/claqgb.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/claqgb.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/claqgb.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CLAQGB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
22* AMAX, EQUED )
23*
24* .. Scalar Arguments ..
25* CHARACTER EQUED
26* INTEGER KL, KU, LDAB, M, N
27* REAL AMAX, COLCND, ROWCND
28* ..
29* .. Array Arguments ..
30* REAL C( * ), R( * )
31* COMPLEX AB( LDAB, * )
32* ..
33*
34*
35*> \par Purpose:
36* =============
37*>
38*> \verbatim
39*>
40*> CLAQGB equilibrates a general M by N band matrix A with KL
41*> subdiagonals and KU superdiagonals using the row and scaling factors
42*> in the vectors R and C.
43*> \endverbatim
44*
45* Arguments:
46* ==========
47*
48*> \param[in] M
49*> \verbatim
50*> M is INTEGER
51*> The number of rows of the matrix A. M >= 0.
52*> \endverbatim
53*>
54*> \param[in] N
55*> \verbatim
56*> N is INTEGER
57*> The number of columns of the matrix A. N >= 0.
58*> \endverbatim
59*>
60*> \param[in] KL
61*> \verbatim
62*> KL is INTEGER
63*> The number of subdiagonals within the band of A. KL >= 0.
64*> \endverbatim
65*>
66*> \param[in] KU
67*> \verbatim
68*> KU is INTEGER
69*> The number of superdiagonals within the band of A. KU >= 0.
70*> \endverbatim
71*>
72*> \param[in,out] AB
73*> \verbatim
74*> AB is COMPLEX array, dimension (LDAB,N)
75*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1.
76*> The j-th column of A is stored in the j-th column of the
77*> array AB as follows:
78*> AB(ku+1+i-j,j) = A(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
79*>
80*> On exit, the equilibrated matrix, in the same storage format
81*> as A. See EQUED for the form of the equilibrated matrix.
82*> \endverbatim
83*>
84*> \param[in] LDAB
85*> \verbatim
86*> LDAB is INTEGER
87*> The leading dimension of the array AB. LDA >= KL+KU+1.
88*> \endverbatim
89*>
90*> \param[in] R
91*> \verbatim
92*> R is REAL array, dimension (M)
93*> The row scale factors for A.
94*> \endverbatim
95*>
96*> \param[in] C
97*> \verbatim
98*> C is REAL array, dimension (N)
99*> The column scale factors for A.
100*> \endverbatim
101*>
102*> \param[in] ROWCND
103*> \verbatim
104*> ROWCND is REAL
105*> Ratio of the smallest R(i) to the largest R(i).
106*> \endverbatim
107*>
108*> \param[in] COLCND
109*> \verbatim
110*> COLCND is REAL
111*> Ratio of the smallest C(i) to the largest C(i).
112*> \endverbatim
113*>
114*> \param[in] AMAX
115*> \verbatim
116*> AMAX is REAL
117*> Absolute value of largest matrix entry.
118*> \endverbatim
119*>
120*> \param[out] EQUED
121*> \verbatim
122*> EQUED is CHARACTER*1
123*> Specifies the form of equilibration that was done.
124*> = 'N': No equilibration
125*> = 'R': Row equilibration, i.e., A has been premultiplied by
126*> diag(R).
127*> = 'C': Column equilibration, i.e., A has been postmultiplied
128*> by diag(C).
129*> = 'B': Both row and column equilibration, i.e., A has been
130*> replaced by diag(R) * A * diag(C).
131*> \endverbatim
132*
133*> \par Internal Parameters:
134* =========================
135*>
136*> \verbatim
137*> THRESH is a threshold value used to decide if row or column scaling
138*> should be done based on the ratio of the row or column scaling
139*> factors. If ROWCND < THRESH, row scaling is done, and if
140*> COLCND < THRESH, column scaling is done.
141*>
142*> LARGE and SMALL are threshold values used to decide if row scaling
143*> should be done based on the absolute size of the largest matrix
144*> element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
145*> \endverbatim
146*
147* Authors:
148* ========
149*
150*> \author Univ. of Tennessee
151*> \author Univ. of California Berkeley
152*> \author Univ. of Colorado Denver
153*> \author NAG Ltd.
154*
155*> \ingroup laqgb
156*
157* =====================================================================
158 SUBROUTINE claqgb( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND,
159 $ AMAX, EQUED )
160*
161* -- LAPACK auxiliary routine --
162* -- LAPACK is a software package provided by Univ. of Tennessee, --
163* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
164*
165* .. Scalar Arguments ..
166 CHARACTER EQUED
167 INTEGER 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, THRESH
179 parameter( one = 1.0e+0, thresh = 0.1e+0 )
180* ..
181* .. Local Scalars ..
182 INTEGER I, J
183 REAL CJ, LARGE, SMALL
184* ..
185* .. External Functions ..
186 REAL SLAMCH
187 EXTERNAL slamch
188* ..
189* .. Intrinsic Functions ..
190 INTRINSIC max, min
191* ..
192* .. Executable Statements ..
193*
194* Quick return if possible
195*
196 IF( m.LE.0 .OR. n.LE.0 ) THEN
197 equed = 'N'
198 RETURN
199 END IF
200*
201* Initialize LARGE and SMALL.
202*
203 small = slamch( 'Safe minimum' ) / slamch( 'Precision' )
204 large = one / small
205*
206 IF( rowcnd.GE.thresh .AND. amax.GE.small .AND. amax.LE.large )
207 $ THEN
208*
209* No row scaling
210*
211 IF( colcnd.GE.thresh ) THEN
212*
213* No column scaling
214*
215 equed = 'N'
216 ELSE
217*
218* Column scaling
219*
220 DO 20 j = 1, n
221 cj = c( j )
222 DO 10 i = max( 1, j-ku ), min( m, j+kl )
223 ab( ku+1+i-j, j ) = cj*ab( ku+1+i-j, j )
224 10 CONTINUE
225 20 CONTINUE
226 equed = 'C'
227 END IF
228 ELSE IF( colcnd.GE.thresh ) THEN
229*
230* Row scaling, no column scaling
231*
232 DO 40 j = 1, n
233 DO 30 i = max( 1, j-ku ), min( m, j+kl )
234 ab( ku+1+i-j, j ) = r( i )*ab( ku+1+i-j, j )
235 30 CONTINUE
236 40 CONTINUE
237 equed = 'R'
238 ELSE
239*
240* Row and column scaling
241*
242 DO 60 j = 1, n
243 cj = c( j )
244 DO 50 i = max( 1, j-ku ), min( m, j+kl )
245 ab( ku+1+i-j, j ) = cj*r( i )*ab( ku+1+i-j, j )
246 50 CONTINUE
247 60 CONTINUE
248 equed = 'B'
249 END IF
250*
251 RETURN
252*
253* End of CLAQGB
254*
255 END
subroutine claqgb(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, equed)
CLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ.
Definition claqgb.f:160