205 SUBROUTINE zheevd( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
206 $ lrwork, iwork, liwork, info )
215 INTEGER INFO, LDA, LIWORK, LRWORK, LWORK, N
219 DOUBLE PRECISION RWORK( * ), W( * )
220 COMPLEX*16 A( lda, * ), WORK( * )
226 DOUBLE PRECISION ZERO, ONE
227 parameter ( zero = 0.0d0, one = 1.0d0 )
229 parameter ( cone = ( 1.0d0, 0.0d0 ) )
232 LOGICAL LOWER, LQUERY, WANTZ
233 INTEGER IINFO, IMAX, INDE, INDRWK, INDTAU, INDWK2,
234 $ indwrk, iscale, liopt, liwmin, llrwk, llwork,
235 $ llwrk2, lopt, lropt, lrwmin, lwmin
236 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
242 DOUBLE PRECISION DLAMCH, ZLANHE
243 EXTERNAL lsame, ilaenv, dlamch, zlanhe
256 wantz = lsame( jobz,
'V' )
257 lower = lsame( uplo,
'L' )
258 lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 .OR. liwork.EQ.-1 )
261 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
263 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
265 ELSE IF( n.LT.0 )
THEN
267 ELSE IF( lda.LT.max( 1, n ) )
THEN
282 lrwmin = 1 + 5*n + 2*n**2
289 lopt = max( lwmin, n +
290 $ ilaenv( 1,
'ZHETRD', uplo, n, -1, -1, -1 ) )
298 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
300 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
302 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
308 CALL xerbla(
'ZHEEVD', -info )
310 ELSE IF( lquery )
THEN
328 safmin = dlamch(
'Safe minimum' )
329 eps = dlamch(
'Precision' )
330 smlnum = safmin / eps
331 bignum = one / smlnum
332 rmin = sqrt( smlnum )
333 rmax = sqrt( bignum )
337 anrm = zlanhe(
'M', uplo, n, a, lda, rwork )
339 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
342 ELSE IF( anrm.GT.rmax )
THEN
347 $
CALL zlascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
355 indwk2 = indwrk + n*n
356 llwork = lwork - indwrk + 1
357 llwrk2 = lwork - indwk2 + 1
358 llrwk = lrwork - indrwk + 1
359 CALL zhetrd( uplo, n, a, lda, w, rwork( inde ), work( indtau ),
360 $ work( indwrk ), llwork, iinfo )
368 IF( .NOT.wantz )
THEN
369 CALL dsterf( n, w, rwork( inde ), info )
371 CALL zstedc(
'I', n, w, rwork( inde ), work( indwrk ), n,
372 $ work( indwk2 ), llwrk2, rwork( indrwk ), llrwk,
373 $ iwork, liwork, info )
374 CALL zunmtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
375 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
376 CALL zlacpy(
'A', n, n, work( indwrk ), n, a, lda )
381 IF( iscale.EQ.1 )
THEN
387 CALL dscal( imax, one / sigma, w, 1 )
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 dsterf(N, D, E, INFO)
DSTERF
subroutine zunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMTR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine zheevd(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...
subroutine zhetrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
ZHETRD