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,
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 )