319 $ LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
320 $ LDZ, WORK, LWORK, IWORK, IFAIL, INFO )
329 CHARACTER JOBZ, RANGE, UPLO
330 INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
334 INTEGER IFAIL( * ), IWORK( * )
335 REAL AB( LDAB, * ), Q( LDQ, * ), W( * ), WORK( * ),
343 PARAMETER ( ZERO = 0.0e0, one = 1.0e0 )
346 LOGICAL ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ,
349 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
350 $ INDISP, INDIWO, INDWRK, ISCALE, ITMP1, J, JJ,
351 $ llwork, lwmin, lhtrd, lwtrd, ib, indhous,
353 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
354 $ SIGMA, SMLNUM, TMP1, VLL, VUU
359 REAL SLAMCH, SLANSB, SROUNDUP_LWORK
360 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,
499 CALL slascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab,
503 $ abstll = abstol*sigma
515 indwrk = indhous + lhtrd
516 llwork = lwork - indwrk + 1
520 $ work( inde ), work( indhous ), lhtrd,
521 $ work( indwrk ), llwork, iinfo )
529 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
533 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
534 CALL scopy( n, work( indd ), 1, w, 1 )
536 IF( .NOT.wantz )
THEN
537 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
538 CALL ssterf( n, w, work( indee ), info )
540 CALL slacpy(
'A', n, n, q, ldq, z, ldz )
541 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
542 CALL ssteqr( jobz, n, w, work( indee ), z, ldz,
543 $ work( indwrk ), info )
567 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
568 $ work( indd ), work( inde ), m, nsplit, w,
569 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
570 $ iwork( indiwo ), info )
573 CALL sstein( n, work( indd ), work( inde ), m, w,
574 $ iwork( indibl ), iwork( indisp ), z, ldz,
575 $ work( indwrk ), iwork( indiwo ), ifail, info )
581 CALL scopy( n, z( 1, j ), 1, work( 1 ), 1 )
582 CALL sgemv(
'N', n, n, one, q, ldq, work, 1, zero,
590 IF( iscale.EQ.1 )
THEN
596 CALL sscal( imax, one / sigma, w, 1 )
607 IF( w( jj ).LT.tmp1 )
THEN
614 itmp1 = iwork( indibl+i-1 )
616 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
618 iwork( indibl+j-1 ) = itmp1
619 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
622 ifail( i ) = ifail( j )
631 work( 1 ) = sroundup_lwork(lwmin)