298 $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK,
299 $ LWORK, IWORK, IFAIL, INFO )
308 CHARACTER JOBZ, RANGE, UPLO
309 INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
313 INTEGER IFAIL( * ), IWORK( * )
314 REAL A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
321 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
324 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
327 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
328 $ indisp, indiwo, indtau, indwkn, indwrk, iscale,
329 $ itmp1, j, jj, llwork, llwrkn,
330 $ nsplit, lwmin, lhtrd, lwtrd, kd, ib, indhous
331 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
332 $ SIGMA, SMLNUM, TMP1, VLL, VUU
337 REAL SLAMCH, SLANSY, SROUNDUP_LWORK
338 EXTERNAL lsame, slamch, slansy, ilaenv2stage,
347 INTRINSIC max, min, sqrt
353 lower = lsame( uplo,
'L' )
354 wantz = lsame( jobz,
'V' )
355 alleig = lsame( range,
'A' )
356 valeig = lsame( range,
'V' )
357 indeig = lsame( range,
'I' )
358 lquery = ( lwork.EQ.-1 )
361 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
363 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
365 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
367 ELSE IF( n.LT.0 )
THEN
369 ELSE IF( lda.LT.max( 1, n ) )
THEN
373 IF( n.GT.0 .AND. vu.LE.vl )
375 ELSE IF( indeig )
THEN
376 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
378 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
384 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
392 work( 1 ) = sroundup_lwork(lwmin)
394 kd = ilaenv2stage( 1,
'SSYTRD_2STAGE', jobz,
396 ib = ilaenv2stage( 2,
'SSYTRD_2STAGE', jobz,
398 lhtrd = ilaenv2stage( 3,
'SSYTRD_2STAGE', jobz,
400 lwtrd = ilaenv2stage( 4,
'SSYTRD_2STAGE', jobz,
402 lwmin = max( 8*n, 3*n + lhtrd + lwtrd )
406 IF( lwork.LT.lwmin .AND. .NOT.lquery )
411 CALL xerbla(
'SSYEVX_2STAGE', -info )
413 ELSE IF( lquery )
THEN
425 IF( alleig .OR. indeig )
THEN
429 IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) )
THEN
441 safmin = slamch(
'Safe minimum' )
442 eps = slamch(
'Precision' )
443 smlnum = safmin / eps
444 bignum = one / smlnum
445 rmin = sqrt( smlnum )
446 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
456 anrm = slansy(
'M', uplo, n, a, lda, work )
457 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
460 ELSE IF( anrm.GT.rmax )
THEN
464 IF( iscale.EQ.1 )
THEN
467 CALL sscal( n-j+1, sigma, a( j, j ), 1 )
471 CALL sscal( j, sigma, a( 1, j ), 1 )
475 $ abstll = abstol*sigma
488 indwrk = indhous + lhtrd
489 llwork = lwork - indwrk + 1
492 $ work( inde ), work( indtau ), work( indhous ),
493 $ lhtrd, work( indwrk ), llwork, iinfo )
501 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
505 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
506 CALL scopy( n, work( indd ), 1, w, 1 )
508 IF( .NOT.wantz )
THEN
509 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
510 CALL ssterf( n, w, work( indee ), info )
512 CALL slacpy(
'A', n, n, a, lda, z, ldz )
513 CALL sorgtr( uplo, n, z, ldz, work( indtau ),
514 $ work( indwrk ), llwork, iinfo )
515 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
516 CALL ssteqr( jobz, n, w, work( indee ), z, ldz,
517 $ work( indwrk ), info )
541 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
542 $ work( indd ), work( inde ), m, nsplit, w,
543 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
544 $ iwork( indiwo ), info )
547 CALL sstein( n, work( indd ), work( inde ), m, w,
548 $ iwork( indibl ), iwork( indisp ), z, ldz,
549 $ work( indwrk ), iwork( indiwo ), ifail, info )
555 llwrkn = lwork - indwkn + 1
556 CALL sormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
557 $ ldz, work( indwkn ), llwrkn, iinfo )
563 IF( iscale.EQ.1 )
THEN
569 CALL sscal( imax, one / sigma, w, 1 )
580 IF( w( jj ).LT.tmp1 )
THEN
587 itmp1 = iwork( indibl+i-1 )
589 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
591 iwork( indibl+j-1 ) = itmp1
592 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
595 ifail( i ) = ifail( j )
604 work( 1 ) = sroundup_lwork(lwmin)
subroutine xerbla(srname, info)
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
subroutine ssyevx_2stage(jobz, range, uplo, n, a, lda, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, iwork, ifail, info)
SSYEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY mat...
subroutine ssytrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
SSYTRD_2STAGE
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sscal(n, sa, sx, incx)
SSCAL
subroutine sstebz(range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork, info)
SSTEBZ
subroutine sstein(n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifail, info)
SSTEIN
subroutine ssteqr(compz, n, d, e, z, ldz, work, info)
SSTEQR
subroutine ssterf(n, d, e, info)
SSTERF
subroutine sswap(n, sx, incx, sy, incy)
SSWAP
subroutine sorgtr(uplo, n, a, lda, tau, work, lwork, info)
SORGTR
subroutine sormtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
SORMTR