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,
251 DOUBLE PRECISION DLAMCH, ZLANHB
252 EXTERNAL lsame, dlamch, zlanhb
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 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 zstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZSTEDC
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.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine zhbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
ZHBTRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL