379 $ IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK,
380 $ LWORK, IWORK, LIWORK, INFO )
389 CHARACTER JOBZ, RANGE, UPLO
390 INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
391 DOUBLE PRECISION ABSTOL, VL, VU
394 INTEGER ISUPPZ( * ), IWORK( * )
395 DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
401 DOUBLE PRECISION ZERO, ONE, TWO
402 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0, two = 2.0d+0 )
405 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, VALEIG, WANTZ,
408 INTEGER I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
409 $ indee, indibl, indifl, indisp, indiwo, indtau,
410 $ indwk, indwkn, iscale, j, jj, liwmin,
411 $ llwork, llwrkn, lwmin, nsplit,
412 $ lhtrd, lwtrd, kd, ib, indhous
413 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
414 $ SIGMA, SMLNUM, TMP1, VLL, VUU
418 INTEGER ILAENV, ILAENV2STAGE
419 DOUBLE PRECISION DLAMCH, DLANSY
420 EXTERNAL lsame, dlamch, dlansy, ilaenv,
429 INTRINSIC max, min, sqrt
435 ieeeok = ilaenv( 10,
'DSYEVR',
'N', 1, 2, 3, 4 )
437 lower = lsame( uplo,
'L' )
438 wantz = lsame( jobz,
'V' )
439 alleig = lsame( range,
'A' )
440 valeig = lsame( range,
'V' )
441 indeig = lsame( range,
'I' )
443 lquery = ( ( lwork.EQ.-1 ) .OR. ( liwork.EQ.-1 ) )
445 kd = ilaenv2stage( 1,
'DSYTRD_2STAGE', jobz, n, -1, -1,
447 ib = ilaenv2stage( 2,
'DSYTRD_2STAGE', jobz, n, kd, -1,
449 lhtrd = ilaenv2stage( 3,
'DSYTRD_2STAGE', jobz, n, kd, ib,
451 lwtrd = ilaenv2stage( 4,
'DSYTRD_2STAGE', jobz, n, kd, ib,
458 lwmin = max( 26*n, 5*n + lhtrd + lwtrd )
463 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
465 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
467 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
469 ELSE IF( n.LT.0 )
THEN
471 ELSE IF( lda.LT.max( 1, n ) )
THEN
475 IF( n.GT.0 .AND. vu.LE.vl )
477 ELSE IF( indeig )
THEN
478 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
480 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
486 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
488 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
490 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
504 CALL xerbla(
'DSYEVR_2STAGE', -info )
506 ELSE IF( lquery )
THEN
520 IF( alleig .OR. indeig )
THEN
524 IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) )
THEN
539 safmin = dlamch(
'Safe minimum' )
540 eps = dlamch(
'Precision' )
541 smlnum = safmin / eps
542 bignum = one / smlnum
543 rmin = sqrt( smlnum )
544 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
554 anrm = dlansy(
'M', uplo, n, a, lda, work )
555 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
558 ELSE IF( anrm.GT.rmax )
THEN
562 IF( iscale.EQ.1 )
THEN
565 CALL dscal( n-j+1, sigma, a( j, j ), 1 )
569 CALL dscal( j, sigma, a( 1, j ), 1 )
573 $ abstll = abstol*sigma
601 indwk = indhous + lhtrd
602 llwork = lwork - indwk + 1
624 $ work( inde ), work( indtau ), work( indhous ),
625 $ lhtrd, work( indwk ), llwork, iinfo )
630 IF( ( alleig .OR. ( indeig .AND. il.EQ.1 .AND. iu.EQ.n ) ) .AND.
632 IF( .NOT.wantz )
THEN
633 CALL dcopy( n, work( indd ), 1, w, 1 )
634 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
635 CALL dsterf( n, w, work( indee ), info )
637 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
638 CALL dcopy( n, work( indd ), 1, work( inddd ), 1 )
640 IF (abstol .LE. two*n*eps)
THEN
645 CALL dstemr( jobz,
'A', n, work( inddd ), work( indee ),
646 $ vl, vu, il, iu, m, w, z, ldz, n, isuppz,
647 $ tryrac, work( indwk ), lwork, iwork, liwork,
655 IF( wantz .AND. info.EQ.0 )
THEN
657 llwrkn = lwork - indwkn + 1
658 CALL dormtr(
'L', uplo,
'N', n, m, a, lda,
659 $ work( indtau ), z, ldz, work( indwkn ),
683 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
684 $ work( indd ), work( inde ), m, nsplit, w,
685 $ iwork( indibl ), iwork( indisp ), work( indwk ),
686 $ iwork( indiwo ), info )
689 CALL dstein( n, work( indd ), work( inde ), m, w,
690 $ iwork( indibl ), iwork( indisp ), z, ldz,
691 $ work( indwk ), iwork( indiwo ), iwork( indifl ),
698 llwrkn = lwork - indwkn + 1
699 CALL dormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ),
701 $ ldz, work( indwkn ), llwrkn, iinfo )
708 IF( iscale.EQ.1 )
THEN
714 CALL dscal( imax, one / sigma, w, 1 )
727 IF( w( jj ).LT.tmp1 )
THEN
736 CALL dswap( n, z( 1, i ), 1, z( 1, j ), 1 )