LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dpbequ.f
Go to the documentation of this file.
1*> \brief \b DPBEQU
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DPBEQU + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dpbequ.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dpbequ.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dpbequ.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE DPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO )
22*
23* .. Scalar Arguments ..
24* CHARACTER UPLO
25* INTEGER INFO, KD, LDAB, N
26* DOUBLE PRECISION AMAX, SCOND
27* ..
28* .. Array Arguments ..
29* DOUBLE PRECISION AB( LDAB, * ), S( * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> DPBEQU computes row and column scalings intended to equilibrate a
39*> symmetric positive definite band matrix A and reduce its condition
40*> number (with respect to the two-norm). S contains the scale factors,
41*> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with
42*> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This
43*> choice of S puts the condition number of B within a factor N of the
44*> smallest possible condition number over all possible diagonal
45*> scalings.
46*> \endverbatim
47*
48* Arguments:
49* ==========
50*
51*> \param[in] UPLO
52*> \verbatim
53*> UPLO is CHARACTER*1
54*> = 'U': Upper triangular of A is stored;
55*> = 'L': Lower triangular of A is stored.
56*> \endverbatim
57*>
58*> \param[in] N
59*> \verbatim
60*> N is INTEGER
61*> The order of the matrix A. N >= 0.
62*> \endverbatim
63*>
64*> \param[in] KD
65*> \verbatim
66*> KD is INTEGER
67*> The number of superdiagonals of the matrix A if UPLO = 'U',
68*> or the number of subdiagonals if UPLO = 'L'. KD >= 0.
69*> \endverbatim
70*>
71*> \param[in] AB
72*> \verbatim
73*> AB is DOUBLE PRECISION array, dimension (LDAB,N)
74*> The upper or lower triangle of the symmetric band matrix A,
75*> stored in the first KD+1 rows of the array. The j-th column
76*> of A is stored in the j-th column of the array AB as follows:
77*> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
78*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
79*> \endverbatim
80*>
81*> \param[in] LDAB
82*> \verbatim
83*> LDAB is INTEGER
84*> The leading dimension of the array A. LDAB >= KD+1.
85*> \endverbatim
86*>
87*> \param[out] S
88*> \verbatim
89*> S is DOUBLE PRECISION array, dimension (N)
90*> If INFO = 0, S contains the scale factors for A.
91*> \endverbatim
92*>
93*> \param[out] SCOND
94*> \verbatim
95*> SCOND is DOUBLE PRECISION
96*> If INFO = 0, S contains the ratio of the smallest S(i) to
97*> the largest S(i). If SCOND >= 0.1 and AMAX is neither too
98*> large nor too small, it is not worth scaling by S.
99*> \endverbatim
100*>
101*> \param[out] AMAX
102*> \verbatim
103*> AMAX is DOUBLE PRECISION
104*> Absolute value of largest matrix element. If AMAX is very
105*> close to overflow or very close to underflow, the matrix
106*> should be scaled.
107*> \endverbatim
108*>
109*> \param[out] INFO
110*> \verbatim
111*> INFO is INTEGER
112*> = 0: successful exit
113*> < 0: if INFO = -i, the i-th argument had an illegal value.
114*> > 0: if INFO = i, the i-th diagonal element is nonpositive.
115*> \endverbatim
116*
117* Authors:
118* ========
119*
120*> \author Univ. of Tennessee
121*> \author Univ. of California Berkeley
122*> \author Univ. of Colorado Denver
123*> \author NAG Ltd.
124*
125*> \ingroup pbequ
126*
127* =====================================================================
128 SUBROUTINE dpbequ( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO )
129*
130* -- LAPACK computational routine --
131* -- LAPACK is a software package provided by Univ. of Tennessee, --
132* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
133*
134* .. Scalar Arguments ..
135 CHARACTER UPLO
136 INTEGER INFO, KD, LDAB, N
137 DOUBLE PRECISION AMAX, SCOND
138* ..
139* .. Array Arguments ..
140 DOUBLE PRECISION AB( LDAB, * ), S( * )
141* ..
142*
143* =====================================================================
144*
145* .. Parameters ..
146 DOUBLE PRECISION ZERO, ONE
147 parameter( zero = 0.0d+0, one = 1.0d+0 )
148* ..
149* .. Local Scalars ..
150 LOGICAL UPPER
151 INTEGER I, J
152 DOUBLE PRECISION SMIN
153* ..
154* .. External Functions ..
155 LOGICAL LSAME
156 EXTERNAL lsame
157* ..
158* .. External Subroutines ..
159 EXTERNAL xerbla
160* ..
161* .. Intrinsic Functions ..
162 INTRINSIC max, min, sqrt
163* ..
164* .. Executable Statements ..
165*
166* Test the input parameters.
167*
168 info = 0
169 upper = lsame( uplo, 'U' )
170 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
171 info = -1
172 ELSE IF( n.LT.0 ) THEN
173 info = -2
174 ELSE IF( kd.LT.0 ) THEN
175 info = -3
176 ELSE IF( ldab.LT.kd+1 ) THEN
177 info = -5
178 END IF
179 IF( info.NE.0 ) THEN
180 CALL xerbla( 'DPBEQU', -info )
181 RETURN
182 END IF
183*
184* Quick return if possible
185*
186 IF( n.EQ.0 ) THEN
187 scond = one
188 amax = zero
189 RETURN
190 END IF
191*
192 IF( upper ) THEN
193 j = kd + 1
194 ELSE
195 j = 1
196 END IF
197*
198* Initialize SMIN and AMAX.
199*
200 s( 1 ) = ab( j, 1 )
201 smin = s( 1 )
202 amax = s( 1 )
203*
204* Find the minimum and maximum diagonal elements.
205*
206 DO 10 i = 2, n
207 s( i ) = ab( j, i )
208 smin = min( smin, s( i ) )
209 amax = max( amax, s( i ) )
210 10 CONTINUE
211*
212 IF( smin.LE.zero ) THEN
213*
214* Find the first non-positive diagonal element and return.
215*
216 DO 20 i = 1, n
217 IF( s( i ).LE.zero ) THEN
218 info = i
219 RETURN
220 END IF
221 20 CONTINUE
222 ELSE
223*
224* Set the scale factors to the reciprocals
225* of the diagonal elements.
226*
227 DO 30 i = 1, n
228 s( i ) = one / sqrt( s( i ) )
229 30 CONTINUE
230*
231* Compute SCOND = min(S(I)) / max(S(I))
232*
233 scond = sqrt( smin ) / sqrt( amax )
234 END IF
235 RETURN
236*
237* End of DPBEQU
238*
239 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine dpbequ(uplo, n, kd, ab, ldab, s, scond, amax, info)
DPBEQU
Definition dpbequ.f:129