152 SUBROUTINE zhbev( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
162 INTEGER INFO, KD, LDAB, LDZ, N
165 DOUBLE PRECISION RWORK( * ), W( * )
166 COMPLEX*16 AB( LDAB, * ), WORK( * ), Z( LDZ, * )
172 DOUBLE PRECISION ZERO, ONE
173 parameter( zero = 0.0d0, one = 1.0d0 )
177 INTEGER IINFO, IMAX, INDE, INDRWK, ISCALE
178 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
183 DOUBLE PRECISION DLAMCH, ZLANHB
184 EXTERNAL lsame, dlamch, zlanhb
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(
'ZHBEV ', -info )
228 w( 1 ) = ab( kd+1, 1 )
237 safmin = dlamch(
'Safe minimum' )
238 eps = dlamch(
'Precision' )
239 smlnum = safmin / eps
240 bignum = one / smlnum
241 rmin = sqrt( smlnum )
242 rmax = sqrt( bignum )
246 anrm = zlanhb(
'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 zlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
259 CALL zlascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
266 CALL zhbtrd( jobz, uplo, n, kd, ab, ldab, w, rwork( inde ), z,
271 IF( .NOT.wantz )
THEN
272 CALL dsterf( n, w, rwork( inde ), info )
275 CALL zsteqr( jobz, n, w, rwork( inde ), z, ldz,
276 $ rwork( indrwk ), info )
281 IF( iscale.EQ.1 )
THEN
287 CALL dscal( imax, one / sigma, w, 1 )