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,
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 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 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
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
subroutine zstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZSTEDC
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zhetrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
ZHETRD
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 dlamch(CMACH)
DLAMCH
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine zunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMTR