150 SUBROUTINE chbev( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
159 INTEGER INFO, KD, LDAB, LDZ, N
162 REAL RWORK( * ), W( * )
163 COMPLEX AB( LDAB, * ), WORK( * ), Z( 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 xerbla(srname, info)
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
subroutine chbtrd(vect, uplo, n, kd, ab, ldab, d, e, q, ldq, work, info)
CHBTRD
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.
subroutine sscal(n, sa, sx, incx)
SSCAL
subroutine csteqr(compz, n, d, e, z, ldz, work, info)
CSTEQR
subroutine ssterf(n, d, e, info)
SSTERF