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