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 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 chetrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
CHETRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
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 sscal(N, SA, SX, INCX)
SSCAL
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine cunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMTR
subroutine cstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CSTEDC