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