304 $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
305 $ LWORK, RWORK, IWORK, IFAIL, INFO )
314 CHARACTER JOBZ, RANGE, UPLO
315 INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
319 INTEGER IFAIL( * ), IWORK( * )
320 REAL RWORK( * ), W( * )
321 COMPLEX A( LDA, * ), WORK( * ), Z( LDZ, * )
328 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
330 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
333 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
336 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
337 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
338 $ itmp1, j, jj, llwork,
339 $ nsplit, lwmin, lhtrd, lwtrd, kd, ib, indhous
340 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
341 $ SIGMA, SMLNUM, TMP1, VLL, VUU
347 EXTERNAL lsame, slamch, clanhe, ilaenv2stage
355 INTRINSIC real, max, min, sqrt
361 lower = lsame( uplo,
'L' )
362 wantz = lsame( jobz,
'V' )
363 alleig = lsame( range,
'A' )
364 valeig = lsame( range,
'V' )
365 indeig = lsame( range,
'I' )
366 lquery = ( lwork.EQ.-1 )
369 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
371 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
373 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
375 ELSE IF( n.LT.0 )
THEN
377 ELSE IF( lda.LT.max( 1, n ) )
THEN
381 IF( n.GT.0 .AND. vu.LE.vl )
383 ELSE IF( indeig )
THEN
384 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
386 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
392 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
402 kd = ilaenv2stage( 1,
'CHETRD_2STAGE', jobz,
404 ib = ilaenv2stage( 2,
'CHETRD_2STAGE', jobz,
406 lhtrd = ilaenv2stage( 3,
'CHETRD_2STAGE', jobz,
408 lwtrd = ilaenv2stage( 4,
'CHETRD_2STAGE', jobz,
410 lwmin = n + lhtrd + lwtrd
414 IF( lwork.LT.lwmin .AND. .NOT.lquery )
419 CALL xerbla(
'CHEEVX_2STAGE', -info )
421 ELSE IF( lquery )
THEN
433 IF( alleig .OR. indeig )
THEN
435 w( 1 ) = real( a( 1, 1 ) )
436 ELSE IF( valeig )
THEN
437 IF( vl.LT.real( a( 1, 1 ) ) .AND. vu.GE.real( a( 1, 1 ) ) )
440 w( 1 ) = real( a( 1, 1 ) )
450 safmin = slamch(
'Safe minimum' )
451 eps = slamch(
'Precision' )
452 smlnum = safmin / eps
453 bignum = one / smlnum
454 rmin = sqrt( smlnum )
455 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
465 anrm = clanhe(
'M', uplo, n, a, lda, rwork )
466 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
469 ELSE IF( anrm.GT.rmax )
THEN
473 IF( iscale.EQ.1 )
THEN
476 CALL csscal( n-j+1, sigma, a( j, j ), 1 )
480 CALL csscal( j, sigma, a( 1, j ), 1 )
484 $ abstll = abstol*sigma
498 indwrk = indhous + lhtrd
499 llwork = lwork - indwrk + 1
502 $ rwork( inde ), work( indtau ),
503 $ work( indhous ), lhtrd, work( indwrk ),
512 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
516 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
517 CALL scopy( n, rwork( indd ), 1, w, 1 )
519 IF( .NOT.wantz )
THEN
520 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
521 CALL ssterf( n, w, rwork( indee ), info )
523 CALL clacpy(
'A', n, n, a, lda, z, ldz )
524 CALL cungtr( uplo, n, z, ldz, work( indtau ),
525 $ work( indwrk ), llwork, iinfo )
526 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
527 CALL csteqr( jobz, n, w, rwork( indee ), z, ldz,
528 $ rwork( indrwk ), info )
552 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
553 $ rwork( indd ), rwork( inde ), m, nsplit, w,
554 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
555 $ iwork( indiwk ), info )
558 CALL cstein( n, rwork( indd ), rwork( inde ), m, w,
559 $ iwork( indibl ), iwork( indisp ), z, ldz,
560 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
565 CALL cunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
566 $ ldz, work( indwrk ), llwork, iinfo )
572 IF( iscale.EQ.1 )
THEN
578 CALL sscal( imax, one / sigma, w, 1 )
589 IF( w( jj ).LT.tmp1 )
THEN
596 itmp1 = iwork( indibl+i-1 )
598 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
600 iwork( indibl+j-1 ) = itmp1
601 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
604 ifail( i ) = ifail( j )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine chetrd_2stage(VECT, UPLO, N, A, LDA, D, E, TAU, HOUS2, LHOUS2, WORK, LWORK, INFO)
CHETRD_2STAGE
subroutine cheevx_2stage(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL, INFO)
CHEEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE mat...
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMTR
subroutine cstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
CSTEIN
subroutine csteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
CSTEQR
subroutine cungtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
CUNGTR
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine sscal(N, SA, SX, INCX)
SSCAL