326 SUBROUTINE ssyevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
327 $ abstol, m, w, z, ldz, isuppz, work, lwork,
328 $ iwork, liwork, info )
336 CHARACTER JOBZ, RANGE, UPLO
337 INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
341 INTEGER ISUPPZ( * ), IWORK( * )
342 REAL A( lda, * ), W( * ), WORK( * ), Z( ldz, * )
349 parameter( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
352 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
355 INTEGER I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
356 $ indee, indibl, indifl, indisp, indiwo, indtau,
357 $ indwk, indwkn, iscale, j, jj, liwmin,
358 $ llwork, llwrkn, lwkopt, lwmin, nb, nsplit
359 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
360 $ sigma, smlnum, tmp1, vll, vuu
366 EXTERNAL lsame, ilaenv, slamch, slansy
373 INTRINSIC max, min, sqrt
379 ieeeok = ilaenv( 10,
'SSYEVR',
'N', 1, 2, 3, 4 )
381 lower = lsame( uplo,
'L' )
382 wantz = lsame( jobz,
'V' )
383 alleig = lsame( range,
'A' )
384 valeig = lsame( range,
'V' )
385 indeig = lsame( range,
'I' )
387 lquery = ( ( lwork.EQ.-1 ) .OR. ( liwork.EQ.-1 ) )
389 lwmin = max( 1, 26*n )
390 liwmin = max( 1, 10*n )
393 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
395 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
397 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
399 ELSE IF( n.LT.0 )
THEN
401 ELSE IF( lda.LT.max( 1, n ) )
THEN
405 IF( n.GT.0 .AND. vu.LE.vl )
407 ELSE IF( indeig )
THEN
408 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
410 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
416 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
422 nb = ilaenv( 1,
'SSYTRD', uplo, n, -1, -1, -1 )
423 nb = max( nb, ilaenv( 1,
'SORMTR', uplo, n, -1, -1, -1 ) )
424 lwkopt = max( ( nb+1 )*n, lwmin )
428 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
430 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
436 CALL xerbla(
'SSYEVR', -info )
438 ELSE IF( lquery )
THEN
452 IF( alleig .OR. indeig )
THEN
456 IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) )
THEN
471 safmin = slamch(
'Safe minimum' )
472 eps = slamch(
'Precision' )
473 smlnum = safmin / eps
474 bignum = one / smlnum
475 rmin = sqrt( smlnum )
476 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
486 anrm = slansy(
'M', uplo, n, a, lda, work )
487 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
490 ELSE IF( anrm.GT.rmax )
THEN
494 IF( iscale.EQ.1 )
THEN
497 CALL sscal( n-j+1, sigma, a( j, j ), 1 )
501 CALL sscal( j, sigma, a( 1, j ), 1 )
505 $ abstll = abstol*sigma
532 llwork = lwork - indwk + 1
551 CALL ssytrd( uplo, n, a, lda, work( indd ), work( inde ),
552 $ work( indtau ), work( indwk ), llwork, iinfo )
559 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
563 IF( ( alleig.OR.test ) .AND. ( ieeeok.EQ.1 ) )
THEN
564 IF( .NOT.wantz )
THEN
565 CALL scopy( n, work( indd ), 1, w, 1 )
566 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
567 CALL ssterf( n, w, work( indee ), info )
569 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
570 CALL scopy( n, work( indd ), 1, work( inddd ), 1 )
572 IF (abstol .LE. two*n*eps)
THEN
577 CALL sstemr( jobz,
'A', n, work( inddd ), work( indee ),
578 $ vl, vu, il, iu, m, w, z, ldz, n, isuppz,
579 $ tryrac, work( indwk ), lwork, iwork, liwork,
587 IF( wantz .AND. info.EQ.0 )
THEN
589 llwrkn = lwork - indwkn + 1
590 CALL sormtr(
'L', uplo,
'N', n, m, a, lda,
591 $ work( indtau ), z, ldz, work( indwkn ),
615 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
616 $ work( indd ), work( inde ), m, nsplit, w,
617 $ iwork( indibl ), iwork( indisp ), work( indwk ),
618 $ iwork( indiwo ), info )
621 CALL sstein( n, work( indd ), work( inde ), m, w,
622 $ iwork( indibl ), iwork( indisp ), z, ldz,
623 $ work( indwk ), iwork( indiwo ), iwork( indifl ),
630 llwrkn = lwork - indwkn + 1
631 CALL sormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
632 $ ldz, work( indwkn ), llwrkn, iinfo )
639 IF( iscale.EQ.1 )
THEN
645 CALL sscal( imax, one / sigma, w, 1 )
658 IF( w( jj ).LT.tmp1 )
THEN
667 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 sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
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 sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
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 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 ssterf(N, D, E, INFO)
SSTERF
subroutine sscal(N, SA, SX, INCX)
SSCAL