252 SUBROUTINE ssyevx( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
253 $ abstol, m, w, z, ldz, work, lwork, iwork,
262 CHARACTER JOBZ, RANGE, UPLO
263 INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
267 INTEGER IFAIL( * ), IWORK( * )
268 REAL A( lda, * ), W( * ), WORK( * ), Z( ldz, * )
275 parameter ( zero = 0.0e+0, one = 1.0e+0 )
278 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
281 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
282 $ indisp, indiwo, indtau, indwkn, indwrk, iscale,
283 $ itmp1, j, jj, llwork, llwrkn, lwkmin,
285 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
286 $ sigma, smlnum, tmp1, vll, vuu
292 EXTERNAL lsame, ilaenv, slamch, slansy
299 INTRINSIC max, min, sqrt
305 lower = lsame( uplo,
'L' )
306 wantz = lsame( jobz,
'V' )
307 alleig = lsame( range,
'A' )
308 valeig = lsame( range,
'V' )
309 indeig = lsame( range,
'I' )
310 lquery = ( lwork.EQ.-1 )
313 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
315 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
317 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
319 ELSE IF( n.LT.0 )
THEN
321 ELSE IF( lda.LT.max( 1, n ) )
THEN
325 IF( n.GT.0 .AND. vu.LE.vl )
327 ELSE IF( indeig )
THEN
328 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
330 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
336 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
347 nb = ilaenv( 1,
'SSYTRD', uplo, n, -1, -1, -1 )
348 nb = max( nb, ilaenv( 1,
'SORMTR', uplo, n, -1, -1, -1 ) )
349 lwkopt = max( lwkmin, ( nb + 3 )*n )
353 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
358 CALL xerbla(
'SSYEVX', -info )
360 ELSE IF( lquery )
THEN
372 IF( alleig .OR. indeig )
THEN
376 IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) )
THEN
388 safmin = slamch(
'Safe minimum' )
389 eps = slamch(
'Precision' )
390 smlnum = safmin / eps
391 bignum = one / smlnum
392 rmin = sqrt( smlnum )
393 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
403 anrm = slansy(
'M', uplo, n, a, lda, work )
404 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
407 ELSE IF( anrm.GT.rmax )
THEN
411 IF( iscale.EQ.1 )
THEN
414 CALL sscal( n-j+1, sigma, a( j, j ), 1 )
418 CALL sscal( j, sigma, a( 1, j ), 1 )
422 $ abstll = abstol*sigma
435 llwork = lwork - indwrk + 1
436 CALL ssytrd( uplo, n, a, lda, work( indd ), work( inde ),
437 $ work( indtau ), work( indwrk ), llwork, iinfo )
445 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
449 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
450 CALL scopy( n, work( indd ), 1, w, 1 )
452 IF( .NOT.wantz )
THEN
453 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
454 CALL ssterf( n, w, work( indee ), info )
456 CALL slacpy(
'A', n, n, a, lda, z, ldz )
457 CALL sorgtr( uplo, n, z, ldz, work( indtau ),
458 $ work( indwrk ), llwork, iinfo )
459 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
460 CALL ssteqr( jobz, n, w, work( indee ), z, ldz,
461 $ work( indwrk ), info )
485 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
486 $ work( indd ), work( inde ), m, nsplit, w,
487 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
488 $ iwork( indiwo ), info )
491 CALL sstein( n, work( indd ), work( inde ), m, w,
492 $ iwork( indibl ), iwork( indisp ), z, ldz,
493 $ work( indwrk ), iwork( indiwo ), ifail, info )
499 llwrkn = lwork - indwkn + 1
500 CALL sormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
501 $ ldz, work( indwkn ), llwrkn, iinfo )
507 IF( iscale.EQ.1 )
THEN
513 CALL sscal( imax, one / sigma, w, 1 )
524 IF( w( jj ).LT.tmp1 )
THEN
531 itmp1 = iwork( indibl+i-1 )
533 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
535 iwork( indibl+j-1 ) = itmp1
536 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
539 ifail( i ) = ifail( j )
subroutine sormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMTR
subroutine ssteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEQR
subroutine ssyevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
SSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
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 slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine sorgtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
SORGTR
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY