354 SUBROUTINE cheevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
355 $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
356 $ RWORK, LRWORK, IWORK, LIWORK, INFO )
363 CHARACTER , RANGE, UPLO
364 INTEGER IL, , IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
369 INTEGER ISUPPZ( * ), IWORK( * )
371COMPLEX A( LDA, * ), WORK( * ), Z( LDZ, * )
378 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
381 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
384 INTEGER I, IEEEOK, IINFO, IMAX, INDIBL, INDIFL, INDISP,
385 $ indiwo, indrd, indrdd, indre, indree, indrwk,
386 $ indtau, indwk, indwkn, iscale, itmp1, j, jj,
387 $ liwmin, llwork, llrwork, llwrkn, lrwmin,
388 $ lwkopt, lwmin, nb, nsplit
389 REAL ABSTLL, ANRM, , EPS, RMAX, RMIN, SAFMIN,
390 $ SIGMA, SMLNUM, TMP1, VLL, VUU
396 EXTERNAL lsame, ilaenv, clansy, slamch
403 INTRINSIC max,
min, real, sqrt
409 ieeeok = ilaenv( 10,
'CHEEVR',
'N', 1, 2, 3, 4 )
411 lower = lsame( uplo,
'L' )
412 wantz = lsame( jobz,
'V' )
413 alleig = lsame( range,
'A' )
414 valeig = lsame( range,
'V' )
415 indeig = lsame( range,
'I' )
417 lquery = ( ( lwork.EQ.-1 ) .OR. ( lrwork.EQ.-1 ) .OR.
420 lrwmin =
max( 1, 24*n )
421 liwmin =
max( 1, 10*n )
422 lwmin =
max( 1, 2*n )
425 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
427 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
429 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
431 ELSE IF( n.LT.0 )
THEN
433 ELSE IF( lda.LT.
max( 1, n ) )
THEN
437 IF( n.GT.0 .AND. vu.LE.vl )
439 ELSE IF( indeig )
THEN
440 IF( il.LT.1 .OR. il.GT.
max( 1, n ) )
THEN
442 ELSE IF( iu.LT.
min( n, il ) .OR. iu.GT.n )
THEN
448 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
454 nb = ilaenv( 1,
'CHETRD', uplo, n, -1, -1, -1 )
455 nb =
max( nb, ilaenv( 1, '
cunmtr', UPLO, N, -1, -1, -1 ) )
456 LWKOPT = MAX( ( NB+1 )*N, LWMIN )
461.LT..AND..NOT.
IF( LWORKLWMIN LQUERY ) THEN
463.LT..AND..NOT.
ELSE IF( LRWORKLRWMIN LQUERY ) THEN
465.LT..AND..NOT.
ELSE IF( LIWORKLIWMIN LQUERY ) THEN
471 CALL XERBLA( 'cheevr', -INFO )
473 ELSE IF( LQUERY ) THEN
487.OR.
IF( ALLEIG INDEIG ) THEN
489 W( 1 ) = REAL( A( 1, 1 ) )
491.LT..AND..GE.
IF( VLREAL( A( 1, 1 ) ) VUREAL( A( 1, 1 ) ) )
494 W( 1 ) = REAL( A( 1, 1 ) )
507 SAFMIN = SLAMCH( 'safe minimum
' )
508 EPS = SLAMCH( 'precision
' )
509 SMLNUM = SAFMIN / EPS
510 BIGNUM = ONE / SMLNUM
511 RMIN = SQRT( SMLNUM )
512 RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
522 ANRM = CLANSY( 'm
', UPLO, N, A, LDA, RWORK )
523.GT..AND..LT.
IF( ANRMZERO ANRMRMIN ) THEN
526.GT.
ELSE IF( ANRMRMAX ) THEN
530.EQ.
IF( ISCALE1 ) THEN
533 CALL CSSCAL( N-J+1, SIGMA, A( J, J ), 1 )
537 CALL CSSCAL( J, SIGMA, A( 1, J ), 1 )
541 $ ABSTLL = ABSTOL*SIGMA
557 LLWORK = LWORK - INDWK + 1
574 LLRWORK = LRWORK - INDRWK + 1
593 CALL CHETRD( UPLO, N, A, LDA, RWORK( INDRD ), RWORK( INDRE ),
594 $ WORK( INDTAU ), WORK( INDWK ), LLWORK, IINFO )
601.EQ..AND..EQ.
IF( IL1 IUN ) THEN
605.OR..AND..EQ.
IF( ( ALLEIGTEST ) ( IEEEOK1 ) ) THEN
606.NOT.
IF( WANTZ ) THEN
607 CALL SCOPY( N, RWORK( INDRD ), 1, W, 1 )
608 CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 )
609 CALL SSTERF( N, W, RWORK( INDREE ), INFO )
611 CALL SCOPY( N-1, RWORK( INDRE ), 1, RWORK( INDREE ), 1 )
612 CALL SCOPY( N, RWORK( INDRD ), 1, RWORK( INDRDD ), 1 )
614.LE.
IF (ABSTOL TWO*N*EPS) THEN
619 CALL CSTEMR( JOBZ, 'a
', N, RWORK( INDRDD ),
620 $ RWORK( INDREE ), VL, VU, IL, IU, M, W,
621 $ Z, LDZ, N, ISUPPZ, TRYRAC,
622 $ RWORK( INDRWK ), LLRWORK,
623 $ IWORK, LIWORK, INFO )
628.AND..EQ.
IF( WANTZ INFO0 ) THEN
630 LLWRKN = LWORK - INDWKN + 1
631 CALL CUNMTR( 'l
', UPLO, 'n
', N, M, A, LDA,
632 $ WORK( INDTAU ), Z, LDZ, WORK( INDWKN ),
654 CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
655 $ RWORK( INDRD ), RWORK( INDRE ), M, NSPLIT, W,
656 $ IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
657 $ IWORK( INDIWO ), INFO )
660 CALL CSTEIN( N, RWORK( INDRD ), RWORK( INDRE ), M, W,
661 $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
662 $ RWORK( INDRWK ), IWORK( INDIWO ), IWORK( INDIFL ),
669 LLWRKN = LWORK - INDWKN + 1
670 CALL CUNMTR( 'l
', UPLO, 'n
', N, M, A, LDA, WORK( INDTAU ), Z,
671 $ LDZ, WORK( INDWKN ), LLWRKN, IINFO )
677.EQ.
IF( ISCALE1 ) THEN
683 CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
694.LT.
IF( W( JJ )TMP1 ) THEN
701 ITMP1 = IWORK( INDIBL+I-1 )
703 IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
705 IWORK( INDIBL+J-1 ) = ITMP1
706 CALL CSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
subroutine sstebz(range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork, info)
SSTEBZ
subroutine ssterf(n, d, e, info)
SSTERF
subroutine xerbla(srname, info)
XERBLA
subroutine chetrd(uplo, n, a, lda, d, e, tau, work, lwork, info)
CHETRD
subroutine cheevr(jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, isuppz, work, lwork, rwork, lrwork, iwork, liwork, info)
CHEEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices
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 cstemr(jobz, range, n, d, e, vl, vu, il, iu, m, w, z, ldz, nzc, isuppz, tryrac, work, lwork, iwork, liwork, info)
CSTEMR
subroutine cswap(n, cx, incx, cy, incy)
CSWAP
subroutine csscal(n, sa, cx, incx)
CSSCAL
subroutine sscal(n, sa, sx, incx)
SSCAL
subroutine scopy(n, sx, incx, sy, incy)
SCOPY