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 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 xerbla(SRNAME, INFO)
XERBLA
subroutine chbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
CHBTRD
subroutine csteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
CSTEQR
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 sscal(N, SA, SX, INCX)
SSCAL
subroutine ssterf(N, D, E, INFO)
SSTERF