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
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 )
REAL function slansy(NORM, UPLO, N, A, LDA, WORK)
SLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
LOGICAL function lsame(CA, CB)
LSAME
subroutine sormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMTR
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
REAL function slamch(CMACH)
SLAMCH
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
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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