152 SUBROUTINE chbev( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
162 INTEGER INFO, KD, LDAB, LDZ, N
165 REAL RWORK( * ), W( * )
166 COMPLEX AB( ldab, * ), WORK( * ), Z( ldz, * )
173 parameter( zero = 0.0e0, one = 1.0e0 )
177 INTEGER IINFO, IMAX, INDE, INDRWK, ISCALE
178 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
184 EXTERNAL lsame, clanhb, slamch
196 wantz = lsame( jobz,
'V' )
197 lower = lsame( uplo,
'L' )
200 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN 202 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN 204 ELSE IF( n.LT.0 )
THEN 206 ELSE IF( kd.LT.0 )
THEN 208 ELSE IF( ldab.LT.kd+1 )
THEN 210 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN 215 CALL xerbla(
'CHBEV ', -info )
228 w( 1 ) = ab( kd+1, 1 )
237 safmin = slamch(
'Safe minimum' )
238 eps = slamch(
'Precision' )
239 smlnum = safmin / eps
240 bignum = one / smlnum
241 rmin = sqrt( smlnum )
242 rmax = sqrt( bignum )
246 anrm = clanhb(
'M', uplo, n, kd, ab, ldab, rwork )
248 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN 251 ELSE IF( anrm.GT.rmax )
THEN 255 IF( iscale.EQ.1 )
THEN 257 CALL clascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
259 CALL clascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
266 CALL chbtrd( jobz, uplo, n, kd, ab, ldab, w, rwork( inde ), z,
271 IF( .NOT.wantz )
THEN 272 CALL ssterf( n, w, rwork( inde ), info )
275 CALL csteqr( jobz, n, w, rwork( inde ), z, ldz,
276 $ rwork( indrwk ), info )
281 IF( iscale.EQ.1 )
THEN 287 CALL sscal( imax, one / sigma, w, 1 )
subroutine csteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
CSTEQR
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 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 matrice...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine ssterf(N, D, E, INFO)
SSTERF