245 SUBROUTINE ssyevx( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
246 $ abstol, m, w, z, ldz, work, lwork, iwork,
255 CHARACTER JOBZ, RANGE, UPLO
256 INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
260 INTEGER IFAIL( * ), IWORK( * )
261 REAL A( lda, * ), W( * ), WORK( * ), Z( ldz, * )
268 parameter( zero = 0.0e+0, one = 1.0e+0 )
271 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
274 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
275 $ indisp, indiwo, indtau, indwkn, indwrk, iscale,
276 $ itmp1, j, jj, llwork, llwrkn, lwkmin,
278 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
279 $ sigma, smlnum, tmp1, vll, vuu
285 EXTERNAL lsame, ilaenv, slamch, slansy
292 INTRINSIC max, min, sqrt
298 lower = lsame( uplo,
'L' )
299 wantz = lsame( jobz,
'V' )
300 alleig = lsame( range,
'A' )
301 valeig = lsame( range,
'V' )
302 indeig = lsame( range,
'I' )
303 lquery = ( lwork.EQ.-1 )
306 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
308 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
310 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
312 ELSE IF( n.LT.0 )
THEN
314 ELSE IF( lda.LT.max( 1, n ) )
THEN
318 IF( n.GT.0 .AND. vu.LE.vl )
320 ELSE IF( indeig )
THEN
321 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
323 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
329 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
340 nb = ilaenv( 1,
'SSYTRD', uplo, n, -1, -1, -1 )
341 nb = max( nb, ilaenv( 1,
'SORMTR', uplo, n, -1, -1, -1 ) )
342 lwkopt = max( lwkmin, ( nb + 3 )*n )
346 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
351 CALL xerbla(
'SSYEVX', -info )
353 ELSE IF( lquery )
THEN
365 IF( alleig .OR. indeig )
THEN
369 IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) )
THEN
381 safmin = slamch(
'Safe minimum' )
382 eps = slamch(
'Precision' )
383 smlnum = safmin / eps
384 bignum = one / smlnum
385 rmin = sqrt( smlnum )
386 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
396 anrm = slansy(
'M', uplo, n, a, lda, work )
397 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
400 ELSE IF( anrm.GT.rmax )
THEN
404 IF( iscale.EQ.1 )
THEN
407 CALL sscal( n-j+1, sigma, a( j, j ), 1 )
411 CALL sscal( j, sigma, a( 1, j ), 1 )
415 $ abstll = abstol*sigma
428 llwork = lwork - indwrk + 1
429 CALL ssytrd( uplo, n, a, lda, work( indd ), work( inde ),
430 $ work( indtau ), work( indwrk ), llwork, iinfo )
438 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
442 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
443 CALL scopy( n, work( indd ), 1, w, 1 )
445 IF( .NOT.wantz )
THEN
446 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
447 CALL ssterf( n, w, work( indee ), info )
449 CALL slacpy(
'A', n, n, a, lda, z, ldz )
450 CALL sorgtr( uplo, n, z, ldz, work( indtau ),
451 $ work( indwrk ), llwork, iinfo )
452 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
453 CALL ssteqr( jobz, n, w, work( indee ), z, ldz,
454 $ work( indwrk ), info )
478 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
479 $ work( indd ), work( inde ), m, nsplit, w,
480 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
481 $ iwork( indiwo ), info )
484 CALL sstein( n, work( indd ), work( inde ), m, w,
485 $ iwork( indibl ), iwork( indisp ), z, ldz,
486 $ work( indwrk ), iwork( indiwo ), ifail, info )
492 llwrkn = lwork - indwkn + 1
493 CALL sormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
494 $ ldz, work( indwkn ), llwrkn, iinfo )
500 IF( iscale.EQ.1 )
THEN
506 CALL sscal( imax, one / sigma, w, 1 )
517 IF( w( jj ).LT.tmp1 )
THEN
524 itmp1 = iwork( indibl+i-1 )
526 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
528 iwork( indibl+j-1 ) = itmp1
529 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
532 ifail( i ) = ifail( j )
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 sorgtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
SORGTR
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 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 slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine ssteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEQR
subroutine sscal(N, SA, SX, INCX)
SSCAL