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,
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 )