246 $ RWORK, LRWORK, IWORK, LIWORK, INFO )
256 INTEGER INFO, LDA, LIWORK, LRWORK, LWORK, N
260 REAL RWORK( * ), W( * )
261 COMPLEX A( LDA, * ), WORK( * )
268 parameter( zero = 0.0e0, one = 1.0e0 )
270 parameter( cone = ( 1.0e0, 0.0e0 ) )
273 LOGICAL LOWER, LQUERY, WANTZ
274 INTEGER IINFO, IMAX, INDE, INDRWK, INDTAU, INDWK2,
275 $ indwrk, iscale, liwmin, llrwk, llwork,
276 $ llwrk2, lrwmin, lwmin,
277 $ lhtrd, lwtrd, kd, ib, indhous
280 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
287 EXTERNAL lsame, slamch, clanhe, ilaenv2stage
294 INTRINSIC real, max, sqrt
300 wantz = lsame( jobz,
'V' )
301 lower = lsame( uplo,
'L' )
302 lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 .OR. liwork.EQ.-1 )
305 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
307 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
309 ELSE IF( n.LT.0 )
THEN
311 ELSE IF( lda.LT.max( 1, n ) )
THEN
321 kd = ilaenv2stage( 1,
'CHETRD_2STAGE', jobz,
323 ib = ilaenv2stage( 2,
'CHETRD_2STAGE', jobz,
325 lhtrd = ilaenv2stage( 3,
'CHETRD_2STAGE', jobz,
327 lwtrd = ilaenv2stage( 4,
'CHETRD_2STAGE', jobz,
331 lrwmin = 1 + 5*n + 2*n**2
334 lwmin = n + 1 + lhtrd + lwtrd
343 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
345 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
347 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
353 CALL xerbla(
'CHEEVD_2STAGE', -info )
355 ELSE IF( lquery )
THEN
365 w( 1 ) = real( a( 1, 1 ) )
373 safmin = slamch(
'Safe minimum' )
374 eps = slamch(
'Precision' )
375 smlnum = safmin / eps
376 bignum = one / smlnum
377 rmin = sqrt( smlnum )
378 rmax = sqrt( bignum )
382 anrm = clanhe(
'M', uplo, n, a, lda, rwork )
384 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
387 ELSE IF( anrm.GT.rmax )
THEN
392 $
CALL clascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
398 llrwk = lrwork - indrwk + 1
401 indwrk = indhous + lhtrd
402 llwork = lwork - indwrk + 1
403 indwk2 = indwrk + n*n
404 llwrk2 = lwork - indwk2 + 1
407 $ work( indtau ), work( indhous ), lhtrd,
408 $ work( indwrk ), llwork, iinfo )
416 IF( .NOT.wantz )
THEN
417 CALL ssterf( n, w, rwork( inde ), info )
419 CALL cstedc(
'I', n, w, rwork( inde ), work( indwrk ), n,
420 $ work( indwk2 ), llwrk2, rwork( indrwk ), llrwk,
421 $ iwork, liwork, info )
422 CALL cunmtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
423 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
424 CALL clacpy(
'A', n, n, work( indwrk ), n, a, lda )
429 IF( iscale.EQ.1 )
THEN
435 CALL sscal( imax, one / sigma, w, 1 )
subroutine xerbla(srname, info)
subroutine cheevd_2stage(jobz, uplo, n, a, lda, w, work, lwork, rwork, lrwork, iwork, liwork, info)
CHEEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE mat...
subroutine chetrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
CHETRD_2STAGE
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 sscal(n, sa, sx, incx)
SSCAL
subroutine cstedc(compz, n, d, e, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
CSTEDC
subroutine ssterf(n, d, e, info)
SSTERF
subroutine cunmtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
CUNMTR