148 SUBROUTINE chbev( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
157 INTEGER INFO, KD, LDAB, LDZ, N
160 REAL RWORK( * ), W( * )
161 COMPLEX AB( LDAB, * ), WORK( * ), Z( LDZ, * )
168 parameter( zero = 0.0e0, one = 1.0e0 )
172 INTEGER IINFO, IMAX, INDE, INDRWK, ISCALE
173 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
179 EXTERNAL lsame, clanhb, slamch
192 wantz = lsame( jobz,
'V' )
193 lower = lsame( uplo,
'L' )
196 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
198 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
200 ELSE IF( n.LT.0 )
THEN
202 ELSE IF( kd.LT.0 )
THEN
204 ELSE IF( ldab.LT.kd+1 )
THEN
206 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
211 CALL xerbla(
'CHBEV ', -info )
222 w( 1 ) = real( ab( 1, 1 ) )
224 w( 1 ) = real( ab( kd+1, 1 ) )
233 safmin = slamch(
'Safe minimum' )
234 eps = slamch(
'Precision' )
235 smlnum = safmin / eps
236 bignum = one / smlnum
237 rmin = sqrt( smlnum )
238 rmax = sqrt( bignum )
242 anrm = clanhb(
'M', uplo, n, kd, ab, ldab, rwork )
244 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
247 ELSE IF( anrm.GT.rmax )
THEN
251 IF( iscale.EQ.1 )
THEN
253 CALL clascl(
'B', kd, kd, one, sigma, n, n, ab, ldab,
256 CALL clascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab,
264 CALL chbtrd( jobz, uplo, n, kd, ab, ldab, w, rwork( inde ), z,
269 IF( .NOT.wantz )
THEN
270 CALL ssterf( n, w, rwork( inde ), info )
273 CALL csteqr( jobz, n, w, rwork( inde ), z, ldz,
274 $ rwork( indrwk ), info )
279 IF( iscale.EQ.1 )
THEN
285 CALL sscal( imax, one / sigma, w, 1 )
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.