150 SUBROUTINE chbev( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
159 INTEGER INFO, KD, LDAB, , N
163COMPLEX ( LDAB, * ), WORK( * ), ( LDZ, * )
170 parameter( zero = 0.0e0, one = 1.0e0 )
174 INTEGER IINFO, IMAX, INDE, INDRWK, ISCALE
175 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
181 EXTERNAL lsame,
clanhb, slamch
193 wantz = lsame( jobz,
'V' )
194 lower = lsame( uplo,
'L' )
197 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
199 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
201 ELSE IF( n.LT.0 )
THEN
203 ELSE IF( kd.LT.0 )
THEN
205 ELSE IF( ldab.LT.kd+1 )
THEN
207 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
212 CALL xerbla(
'CHBEV ', -info )
223 w( 1 ) = real( ab( 1, 1 ) )
225 w( 1 ) = real( ab( kd+1, 1 ) )
234 safmin = slamch(
'Safe minimum' )
235 eps = slamch(
'Precision' )
236 smlnum = safmin / eps
237 bignum = one / smlnum
238 rmin = sqrt( smlnum )
239 rmax = sqrt( bignum )
243 anrm =
clanhb(
'M', uplo, n, kd, ab, ldab, rwork )
245 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
248 ELSE IF( anrm.GT.rmax )
THEN
252 IF( iscale.EQ.1 )
THEN
254 CALL clascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
256 CALL clascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
263 CALL chbtrd( jobz, uplo, n, kd, ab, ldab, w, rwork( inde ), z,
268 IF( .NOT.wantz )
THEN
269 CALL ssterf( n, w, rwork( inde ), info )
272 CALL csteqr( jobz, n, w, rwork( inde ), z, ldz,
273 $ rwork( indrwk ), info )
278 IF( iscale.EQ.1 )
THEN
284 CALL sscal( imax, one / sigma, w, 1 )
subroutine clascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
real function clanhb(norm, uplo, n, k, ab, ldab, work)
CLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
subroutine chbtrd(vect, uplo, n, kd, ab, ldab, d, e, q, ldq, work, info)
CHBTRD
subroutine chbev(jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, rwork, info)
CHBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices