215 SUBROUTINE zhbevd( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
216 $ lwork, rwork, lrwork, iwork, liwork, info )
225 INTEGER info, kd, ldab, ldz, liwork, lrwork, lwork, n
229 DOUBLE PRECISION rwork( * ), w( * )
230 COMPLEX*16 ab( ldab, * ), work( * ), z( ldz, * )
236 DOUBLE PRECISION zero, one
237 parameter( zero = 0.0d0, one = 1.0d0 )
238 COMPLEX*16 czero, cone
239 parameter( czero = ( 0.0d0, 0.0d0 ),
240 $ cone = ( 1.0d0, 0.0d0 ) )
243 LOGICAL lower, lquery, wantz
244 INTEGER iinfo, imax, inde, indwk2, indwrk, iscale,
245 $ liwmin, llrwk, llwk2, lrwmin, lwmin
246 DOUBLE PRECISION anrm, bignum, eps, rmax, rmin, safmin, sigma,
265 wantz =
lsame( jobz,
'V' )
266 lower =
lsame( uplo,
'L' )
267 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 .OR. lrwork.EQ.-1 )
277 lrwmin = 1 + 5*n + 2*n**2
285 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
287 ELSE IF( .NOT.( lower .OR.
lsame( uplo,
'U' ) ) )
THEN
289 ELSE IF( n.LT.0 )
THEN
291 ELSE IF( kd.LT.0 )
THEN
293 ELSE IF( ldab.LT.kd+1 )
THEN
295 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
304 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
306 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
308 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
314 CALL
xerbla(
'ZHBEVD', -info )
316 ELSE IF( lquery )
THEN
334 safmin =
dlamch(
'Safe minimum' )
335 eps =
dlamch(
'Precision' )
336 smlnum = safmin / eps
337 bignum = one / smlnum
338 rmin = sqrt( smlnum )
339 rmax = sqrt( bignum )
343 anrm =
zlanhb(
'M', uplo, n, kd, ab, ldab, rwork )
345 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
348 ELSE IF( anrm.GT.rmax )
THEN
352 IF( iscale.EQ.1 )
THEN
354 CALL
zlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
356 CALL
zlascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
365 llwk2 = lwork - indwk2 + 1
366 llrwk = lrwork - indwrk + 1
367 CALL
zhbtrd( jobz, uplo, n, kd, ab, ldab, w, rwork( inde ), z,
372 IF( .NOT.wantz )
THEN
373 CALL
dsterf( n, w, rwork( inde ), info )
375 CALL
zstedc(
'I', n, w, rwork( inde ), work, n, work( indwk2 ),
376 $ llwk2, rwork( indwrk ), llrwk, iwork, liwork,
378 CALL
zgemm(
'N',
'N', n, n, n, cone, z, ldz, work, n, czero,
379 $ work( indwk2 ), n )
380 CALL
zlacpy(
'A', n, n, work( indwk2 ), n, z, ldz )
385 IF( iscale.EQ.1 )
THEN
391 CALL
dscal( imax, one / sigma, w, 1 )
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine zstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZSTEDC
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zhbevd(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZHBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
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.
logical function lsame(CA, CB)
LSAME
subroutine dscal(N, DA, DX, INCX)
DSCAL
double precision function zlanhb(NORM, UPLO, N, K, AB, LDAB, WORK)
ZLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian band matrix.
double precision function dlamch(CMACH)
DLAMCH