320 $ LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
321 $ LDZ, WORK, LWORK, IWORK, IFAIL, INFO )
330 CHARACTER JOBZ, RANGE, UPLO
331 INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
335 INTEGER IFAIL( * ), IWORK( * )
336 REAL AB( LDAB, * ), Q( LDQ, * ), W( * ), WORK( * ),
344 PARAMETER ( ZERO = 0.0e0, one = 1.0e0 )
347 LOGICAL ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ,
350 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
351 $ indisp, indiwo, indwrk, iscale, itmp1, j, jj,
352 $ llwork, lwmin, lhtrd, lwtrd, ib, indhous,
354 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
355 $ SIGMA, SMLNUM, TMP1, VLL, VUU
360 REAL SLAMCH, SLANSB, SROUNDUP_LWORK
361 EXTERNAL lsame, slamch, slansb, ilaenv2stage,
370 INTRINSIC max, min, sqrt
376 wantz = lsame( jobz,
'V' )
377 alleig = lsame( range,
'A' )
378 valeig = lsame( range,
'V' )
379 indeig = lsame( range,
'I' )
380 lower = lsame( uplo,
'L' )
381 lquery = ( lwork.EQ.-1 )
384 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
386 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
388 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
390 ELSE IF( n.LT.0 )
THEN
392 ELSE IF( kd.LT.0 )
THEN
394 ELSE IF( ldab.LT.kd+1 )
THEN
396 ELSE IF( wantz .AND. ldq.LT.max( 1, n ) )
THEN
400 IF( n.GT.0 .AND. vu.LE.vl )
402 ELSE IF( indeig )
THEN
403 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
405 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
411 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
418 work( 1 ) = sroundup_lwork(lwmin)
420 ib = ilaenv2stage( 2,
'SSYTRD_SB2ST', jobz,
422 lhtrd = ilaenv2stage( 3,
'SSYTRD_SB2ST', jobz,
424 lwtrd = ilaenv2stage( 4,
'SSYTRD_SB2ST', jobz,
426 lwmin = 2*n + lhtrd + lwtrd
427 work( 1 ) = sroundup_lwork(lwmin)
430 IF( lwork.LT.lwmin .AND. .NOT.lquery )
435 CALL xerbla(
'SSBEVX_2STAGE ', -info )
437 ELSE IF( lquery )
THEN
455 IF( .NOT.( vl.LT.tmp1 .AND. vu.GE.tmp1 ) )
468 safmin = slamch(
'Safe minimum' )
469 eps = slamch(
'Precision' )
470 smlnum = safmin / eps
471 bignum = one / smlnum
472 rmin = sqrt( smlnum )
473 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
486 anrm = slansb(
'M', uplo, n, kd, ab, ldab, work )
487 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
490 ELSE IF( anrm.GT.rmax )
THEN
494 IF( iscale.EQ.1 )
THEN
496 CALL slascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
498 CALL slascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
501 $ abstll = abstol*sigma
513 indwrk = indhous + lhtrd
514 llwork = lwork - indwrk + 1
516 CALL ssytrd_sb2st(
"N", jobz, uplo, n, kd, ab, ldab, work( indd ),
517 $ work( inde ), work( indhous ), lhtrd,
518 $ work( indwrk ), llwork, iinfo )
526 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
530 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
531 CALL scopy( n, work( indd ), 1, w, 1 )
533 IF( .NOT.wantz )
THEN
534 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
535 CALL ssterf( n, w, work( indee ), info )
537 CALL slacpy(
'A', n, n, q, ldq, z, ldz )
538 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
539 CALL ssteqr( jobz, n, w, work( indee ), z, ldz,
540 $ work( indwrk ), info )
564 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
565 $ work( indd ), work( inde ), m, nsplit, w,
566 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
567 $ iwork( indiwo ), info )
570 CALL sstein( n, work( indd ), work( inde ), m, w,
571 $ iwork( indibl ), iwork( indisp ), z, ldz,
572 $ work( indwrk ), iwork( indiwo ), ifail, info )
578 CALL scopy( n, z( 1, j ), 1, work( 1 ), 1 )
579 CALL sgemv(
'N', n, n, one, q, ldq, work, 1, zero,
587 IF( iscale.EQ.1 )
THEN
593 CALL sscal( imax, one / sigma, w, 1 )
604 IF( w( jj ).LT.tmp1 )
THEN
611 itmp1 = iwork( indibl+i-1 )
613 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
615 iwork( indibl+j-1 ) = itmp1
616 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
619 ifail( i ) = ifail( j )
628 work( 1 ) = sroundup_lwork(lwmin)
subroutine xerbla(srname, info)
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
subroutine sgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
SGEMV
subroutine ssbevx_2stage(jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, iwork, ifail, info)
SSBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER ...
subroutine ssytrd_sb2st(stage1, vect, uplo, n, kd, ab, ldab, d, e, hous, lhous, work, lwork, info)
SSYTRD_SB2ST reduces a real symmetric band matrix A to real symmetric tridiagonal form T
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
subroutine slascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
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