207 SUBROUTINE zhbevd( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
208 $ LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO )
216 INTEGER INFO, KD, LDAB, LDZ, LIWORK, LRWORK, LWORK, N
220 DOUBLE PRECISION RWORK( * ), W( * )
221 COMPLEX*16 AB( LDAB, * ), WORK( * ), Z( LDZ, * )
227 DOUBLE PRECISION ZERO, ONE
228 parameter( zero = 0.0d0, one = 1.0d0 )
229 COMPLEX*16 CZERO, CONE
230 parameter( czero = ( 0.0d0, 0.0d0 ),
231 $ cone = ( 1.0d0, 0.0d0 ) )
234 LOGICAL LOWER, LQUERY, WANTZ
235 INTEGER IINFO, IMAX, INDE, INDWK2, INDWRK, ISCALE,
236 $ liwmin, llrwk, llwk2, lrwmin, lwmin
237 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
242 DOUBLE PRECISION DLAMCH, ZLANHB
243 EXTERNAL lsame, dlamch, zlanhb
256 wantz = lsame( jobz,
'V' )
257 lower = lsame( uplo,
'L' )
258 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 .OR. lrwork.EQ.-1 )
268 lrwmin = 1 + 5*n + 2*n**2
276 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
278 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
280 ELSE IF( n.LT.0 )
THEN
282 ELSE IF( kd.LT.0 )
THEN
284 ELSE IF( ldab.LT.kd+1 )
THEN
286 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
295 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
297 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
299 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
305 CALL xerbla(
'ZHBEVD', -info )
307 ELSE IF( lquery )
THEN
317 w( 1 ) = dble( ab( 1, 1 ) )
325 safmin = dlamch(
'Safe minimum' )
326 eps = dlamch(
'Precision' )
327 smlnum = safmin / eps
328 bignum = one / smlnum
329 rmin = sqrt( smlnum )
330 rmax = sqrt( bignum )
334 anrm = zlanhb(
'M', uplo, n, kd, ab, ldab, rwork )
336 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
339 ELSE IF( anrm.GT.rmax )
THEN
343 IF( iscale.EQ.1 )
THEN
345 CALL zlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
347 CALL zlascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
356 llwk2 = lwork - indwk2 + 1
357 llrwk = lrwork - indwrk + 1
358 CALL zhbtrd( jobz, uplo, n, kd, ab, ldab, w, rwork( inde ), z,
363 IF( .NOT.wantz )
THEN
364 CALL dsterf( n, w, rwork( inde ), info )
366 CALL zstedc(
'I', n, w, rwork( inde ), work, n, work( indwk2 ),
367 $ llwk2, rwork( indwrk ), llrwk, iwork, liwork,
369 CALL zgemm(
'N',
'N', n, n, n, cone, z, ldz, work, n, czero,
370 $ work( indwk2 ), n )
371 CALL zlacpy(
'A', n, n, work( indwk2 ), n, z, ldz )
376 IF( iscale.EQ.1 )
THEN
382 CALL dscal( imax, one / sigma, w, 1 )
subroutine xerbla(srname, info)
subroutine zgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
ZGEMM
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 matrice...
subroutine zhbtrd(vect, uplo, n, kd, ab, ldab, d, e, q, ldq, work, info)
ZHBTRD
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
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 dscal(n, da, dx, incx)
DSCAL
subroutine zstedc(compz, n, d, e, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
ZSTEDC
subroutine dsterf(n, d, e, info)
DSTERF