346 SUBROUTINE ssyevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL,
348 $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
349 $ IWORK, LIWORK, INFO )
356 CHARACTER JOBZ, RANGE, UPLO
357 INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
361 INTEGER ISUPPZ( * ), IWORK( * )
362 REAL A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
369 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
372 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
375 INTEGER I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
376 $ INDEE, INDIBL, INDIFL, INDISP, INDIWO, INDTAU,
377 $ indwk, indwkn, iscale, j, jj, liwmin,
378 $ llwork, llwrkn, lwkopt, lwmin, nb, nsplit
379 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
380 $ SIGMA, SMLNUM, TMP1, VLL, VUU
385 REAL SLAMCH, SLANSY, SROUNDUP_LWORK
386 EXTERNAL lsame, ilaenv, slamch,
387 $ slansy, sroundup_lwork
395 INTRINSIC max, min, sqrt
401 ieeeok = ilaenv( 10,
'SSYEVR',
'N', 1, 2, 3, 4 )
403 lower = lsame( uplo,
'L' )
404 wantz = lsame( jobz,
'V' )
405 alleig = lsame( range,
'A' )
406 valeig = lsame( range,
'V' )
407 indeig = lsame( range,
'I' )
409 lquery = ( ( lwork.EQ.-1 ) .OR. ( liwork.EQ.-1 ) )
420 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
422 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
424 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
426 ELSE IF( n.LT.0 )
THEN
428 ELSE IF( lda.LT.max( 1, n ) )
THEN
432 IF( n.GT.0 .AND. vu.LE.vl )
434 ELSE IF( indeig )
THEN
435 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
437 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
443 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
449 nb = ilaenv( 1,
'SSYTRD', uplo, n, -1, -1, -1 )
450 nb = max( nb, ilaenv( 1,
'SORMTR', uplo, n, -1, -1, -1 ) )
451 lwkopt = max( ( nb+1 )*n, lwmin )
452 work( 1 ) = sroundup_lwork( lwkopt )
455 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
457 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
463 CALL xerbla(
'SSYEVR', -info )
465 ELSE IF( lquery )
THEN
479 IF( alleig .OR. indeig )
THEN
483 IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) )
THEN
498 safmin = slamch(
'Safe minimum' )
499 eps = slamch(
'Precision' )
500 smlnum = safmin / eps
501 bignum = one / smlnum
502 rmin = sqrt( smlnum )
503 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
513 anrm = slansy(
'M', uplo, n, a, lda, work )
514 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
517 ELSE IF( anrm.GT.rmax )
THEN
521 IF( iscale.EQ.1 )
THEN
524 CALL sscal( n-j+1, sigma, a( j, j ), 1 )
528 CALL sscal( j, sigma, a( 1, j ), 1 )
532 $ abstll = abstol*sigma
559 llwork = lwork - indwk + 1
578 CALL ssytrd( uplo, n, a, lda, work( indd ), work( inde ),
579 $ work( indtau ), work( indwk ), llwork, iinfo )
586 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
590 IF( ( alleig.OR.test ) .AND. ( ieeeok.EQ.1 ) )
THEN
591 IF( .NOT.wantz )
THEN
592 CALL scopy( n, work( indd ), 1, w, 1 )
593 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
594 CALL ssterf( n, w, work( indee ), info )
596 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
597 CALL scopy( n, work( indd ), 1, work( inddd ), 1 )
599 IF (abstol .LE. two*real( n )*eps)
THEN
604 CALL sstemr( jobz,
'A', n, work( inddd ), work( indee ),
605 $ vl, vu, il, iu, m, w, z, ldz, n, isuppz,
606 $ tryrac, work( indwk ), lwork, iwork, liwork,
614 IF( wantz .AND. info.EQ.0 )
THEN
616 llwrkn = lwork - indwkn + 1
617 CALL sormtr(
'L', uplo,
'N', n, m, a, lda,
618 $ work( indtau ), z, ldz, work( indwkn ),
642 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
643 $ work( indd ), work( inde ), m, nsplit, w,
644 $ iwork( indibl ), iwork( indisp ), work( indwk ),
645 $ iwork( indiwo ), info )
648 CALL sstein( n, work( indd ), work( inde ), m, w,
649 $ iwork( indibl ), iwork( indisp ), z, ldz,
650 $ work( indwk ), iwork( indiwo ), iwork( indifl ),
657 llwrkn = lwork - indwkn + 1
658 CALL sormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ),
660 $ ldz, work( indwkn ), llwrkn, iinfo )
667 IF( iscale.EQ.1 )
THEN
673 CALL sscal( imax, one / sigma, w, 1 )
686 IF( w( jj ).LT.tmp1 )
THEN
695 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
702 work( 1 ) = sroundup_lwork( lwkopt )