205 SUBROUTINE cheevd( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
206 $ lrwork, iwork, liwork, info )
215 INTEGER INFO, LDA, LIWORK, LRWORK, LWORK, N
219 REAL RWORK( * ), W( * )
220 COMPLEX A( lda, * ), WORK( * )
227 parameter( zero = 0.0e0, one = 1.0e0 )
229 parameter( cone = ( 1.0e0, 0.0e0 ) )
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 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
243 EXTERNAL ilaenv, lsame, clanhe, slamch
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,
'CHETRD', 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(
'CHEEVD', -info )
310 ELSE IF( lquery )
THEN
328 safmin = slamch(
'Safe minimum' )
329 eps = slamch(
'Precision' )
330 smlnum = safmin / eps
331 bignum = one / smlnum
332 rmin = sqrt( smlnum )
333 rmax = sqrt( bignum )
337 anrm = clanhe(
'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
clascl( 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
chetrd( uplo, n, a, lda, w, rwork( inde ), work( indtau ),
360 $ work( indwrk ), llwork, iinfo )
368 IF( .NOT.wantz )
THEN
369 CALL
ssterf( n, w, rwork( inde ), info )
371 CALL
cstedc(
'I', n, w, rwork( inde ), work( indwrk ), n,
372 $ work( indwk2 ), llwrk2, rwork( indrwk ), llrwk,
373 $ iwork, liwork, info )
374 CALL
cunmtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
375 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
376 CALL
clacpy(
'A', n, n, work( indwrk ), n, a, lda )
381 IF( iscale.EQ.1 )
THEN
387 CALL
sscal( imax, one / sigma, w, 1 )
subroutine cstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CSTEDC
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMTR
subroutine cheevd(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CHEEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine chetrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
CHETRD
subroutine sscal(N, SA, SX, INCX)
SSCAL