148 SUBROUTINE zhbev( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
157 INTEGER INFO, KD, LDAB, LDZ, N
160 DOUBLE PRECISION RWORK( * ), W( * )
161 COMPLEX*16 AB( LDAB, * ), WORK( * ), Z( LDZ, * )
167 DOUBLE PRECISION ZERO, ONE
168 parameter( zero = 0.0d0, one = 1.0d0 )
172 INTEGER IINFO, IMAX, INDE, INDRWK, ISCALE
173 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
178 DOUBLE PRECISION DLAMCH, ZLANHB
179 EXTERNAL lsame, dlamch, zlanhb
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(
'ZHBEV ', -info )
222 w( 1 ) = dble( ab( 1, 1 ) )
224 w( 1 ) = dble( ab( kd+1, 1 ) )
233 safmin = dlamch(
'Safe minimum' )
234 eps = dlamch(
'Precision' )
235 smlnum = safmin / eps
236 bignum = one / smlnum
237 rmin = sqrt( smlnum )
238 rmax = sqrt( bignum )
242 anrm = zlanhb(
'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 zlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab,
256 CALL zlascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab,
264 CALL zhbtrd( jobz, uplo, n, kd, ab, ldab, w, rwork( inde ), z,
269 IF( .NOT.wantz )
THEN
270 CALL dsterf( n, w, rwork( inde ), info )
273 CALL zsteqr( jobz, n, w, rwork( inde ), z, ldz,
274 $ rwork( indrwk ), info )
279 IF( iscale.EQ.1 )
THEN
285 CALL dscal( imax, one / sigma, w, 1 )
subroutine zhbev(jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, rwork, info)
ZHBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices
subroutine zhbtrd(vect, uplo, n, kd, ab, ldab, d, e, q, ldq, work, info)
ZHBTRD
subroutine zlascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.