335 SUBROUTINE ssyevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
336 $ abstol, m, w, z, ldz, isuppz, work, lwork,
337 $ iwork, liwork, info )
345 CHARACTER JOBZ, RANGE, UPLO
346 INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
350 INTEGER ISUPPZ( * ), IWORK( * )
351 REAL A( lda, * ), W( * ), WORK( * ), Z( ldz, * )
358 parameter ( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
361 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
364 INTEGER I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
365 $ indee, indibl, indifl, indisp, indiwo, indtau,
366 $ indwk, indwkn, iscale, j, jj, liwmin,
367 $ llwork, llwrkn, lwkopt, lwmin, nb, nsplit
368 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
369 $ sigma, smlnum, tmp1, vll, vuu
375 EXTERNAL lsame, ilaenv, slamch, slansy
382 INTRINSIC max, min, sqrt
388 ieeeok = ilaenv( 10,
'SSYEVR',
'N', 1, 2, 3, 4 )
390 lower = lsame( uplo,
'L' )
391 wantz = lsame( jobz,
'V' )
392 alleig = lsame( range,
'A' )
393 valeig = lsame( range,
'V' )
394 indeig = lsame( range,
'I' )
396 lquery = ( ( lwork.EQ.-1 ) .OR. ( liwork.EQ.-1 ) )
398 lwmin = max( 1, 26*n )
399 liwmin = max( 1, 10*n )
402 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
404 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
406 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
408 ELSE IF( n.LT.0 )
THEN
410 ELSE IF( lda.LT.max( 1, n ) )
THEN
414 IF( n.GT.0 .AND. vu.LE.vl )
416 ELSE IF( indeig )
THEN
417 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
419 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
425 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
431 nb = ilaenv( 1,
'SSYTRD', uplo, n, -1, -1, -1 )
432 nb = max( nb, ilaenv( 1,
'SORMTR', uplo, n, -1, -1, -1 ) )
433 lwkopt = max( ( nb+1 )*n, lwmin )
437 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
439 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
445 CALL xerbla(
'SSYEVR', -info )
447 ELSE IF( lquery )
THEN
461 IF( alleig .OR. indeig )
THEN
465 IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) )
THEN
480 safmin = slamch(
'Safe minimum' )
481 eps = slamch(
'Precision' )
482 smlnum = safmin / eps
483 bignum = one / smlnum
484 rmin = sqrt( smlnum )
485 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
495 anrm = slansy(
'M', uplo, n, a, lda, work )
496 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
499 ELSE IF( anrm.GT.rmax )
THEN
503 IF( iscale.EQ.1 )
THEN
506 CALL sscal( n-j+1, sigma, a( j, j ), 1 )
510 CALL sscal( j, sigma, a( 1, j ), 1 )
514 $ abstll = abstol*sigma
541 llwork = lwork - indwk + 1
560 CALL ssytrd( uplo, n, a, lda, work( indd ), work( inde ),
561 $ work( indtau ), work( indwk ), llwork, iinfo )
568 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
572 IF( ( alleig.OR.test ) .AND. ( ieeeok.EQ.1 ) )
THEN
573 IF( .NOT.wantz )
THEN
574 CALL scopy( n, work( indd ), 1, w, 1 )
575 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
576 CALL ssterf( n, w, work( indee ), info )
578 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
579 CALL scopy( n, work( indd ), 1, work( inddd ), 1 )
581 IF (abstol .LE. two*n*eps)
THEN
586 CALL sstemr( jobz,
'A', n, work( inddd ), work( indee ),
587 $ vl, vu, il, iu, m, w, z, ldz, n, isuppz,
588 $ tryrac, work( indwk ), lwork, iwork, liwork,
596 IF( wantz .AND. info.EQ.0 )
THEN
598 llwrkn = lwork - indwkn + 1
599 CALL sormtr(
'L', uplo,
'N', n, m, a, lda,
600 $ work( indtau ), z, ldz, work( indwkn ),
624 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
625 $ work( indd ), work( inde ), m, nsplit, w,
626 $ iwork( indibl ), iwork( indisp ), work( indwk ),
627 $ iwork( indiwo ), info )
630 CALL sstein( n, work( indd ), work( inde ), m, w,
631 $ iwork( indibl ), iwork( indisp ), z, ldz,
632 $ work( indwk ), iwork( indiwo ), iwork( indifl ),
639 llwrkn = lwork - indwkn + 1
640 CALL sormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
641 $ ldz, work( indwkn ), llwrkn, iinfo )
648 IF( iscale.EQ.1 )
THEN
654 CALL sscal( imax, one / sigma, w, 1 )
667 IF( w( jj ).LT.tmp1 )
THEN
676 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
subroutine sormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMTR
subroutine ssyevr(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine sstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEMR
subroutine ssytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
SSYTRD
subroutine sstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEIN
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY