328 SUBROUTINE cstemr( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
329 $ m, w, z, ldz, nzc, isuppz, tryrac, work, lwork,
330 $ iwork, liwork, info )
338 CHARACTER jobz, range
340 INTEGER il, info, iu, ldz, nzc, liwork, lwork, m, n
344 INTEGER isuppz( * ), iwork( * )
345 REAL d( * ), e( * ), w( * ), work( * )
352 REAL zero, one, four, minrgp
353 parameter( zero = 0.0e0, one = 1.0e0,
358 LOGICAL alleig, indeig, lquery, valeig, wantz, zquery
359 INTEGER i, ibegin, iend, ifirst, iil, iindbl, iindw,
360 $ iindwk, iinfo, iinspl, iiu, ilast, in, indd,
361 $ inde2, inderr, indgp, indgrs, indwrk, itmp,
362 $ itmp2,
j, jblk, jj, liwmin, lwmin, nsplit,
363 $ nzcmin, offset, wbegin, wend
364 REAL bignum, cs, eps, pivmin, r1, r2, rmax, rmin,
365 $ rtol1, rtol2, safmin, scale, smlnum, sn,
366 $ thresh, tmp, tnrm, wl, wu
379 INTRINSIC max, min, sqrt
387 wantz =
lsame( jobz,
'V' )
388 alleig =
lsame( range,
'A' )
389 valeig =
lsame( range,
'V' )
390 indeig =
lsame( range,
'I' )
392 lquery = ( ( lwork.EQ.-1 ).OR.( liwork.EQ.-1 ) )
393 zquery = ( nzc.EQ.-1 )
419 ELSEIF( indeig )
THEN
426 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
428 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
430 ELSE IF( n.LT.0 )
THEN
432 ELSE IF( valeig .AND. n.GT.0 .AND. wu.LE.wl )
THEN
434 ELSE IF( indeig .AND. ( iil.LT.1 .OR. iil.GT.n ) )
THEN
436 ELSE IF( indeig .AND. ( iiu.LT.iil .OR. iiu.GT.n ) )
THEN
438 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
440 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
442 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
448 safmin =
slamch(
'Safe minimum' )
449 eps =
slamch(
'Precision' )
450 smlnum = safmin / eps
451 bignum = one / smlnum
452 rmin = sqrt( smlnum )
453 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
459 IF( wantz .AND. alleig )
THEN
461 ELSE IF( wantz .AND. valeig )
THEN
462 CALL
slarrc(
'T', n, vl, vu, d, e, safmin,
463 $ nzcmin, itmp, itmp2, info )
464 ELSE IF( wantz .AND. indeig )
THEN
470 IF( zquery .AND. info.EQ.0 )
THEN
472 ELSE IF( nzc.LT.nzcmin .AND. .NOT.zquery )
THEN
479 CALL
xerbla(
'CSTEMR', -info )
482 ELSE IF( lquery .OR. zquery )
THEN
493 IF( alleig .OR. indeig )
THEN
497 IF( wl.LT.d( 1 ) .AND. wu.GE.d( 1 ) )
THEN
502 IF( wantz.AND.(.NOT.zquery) )
THEN
511 IF( .NOT.wantz )
THEN
512 CALL
slae2( d(1), e(1), d(2), r1, r2 )
513 ELSE IF( wantz.AND.(.NOT.zquery) )
THEN
514 CALL
slaev2( d(1), e(1), d(2), r1, r2, cs, sn )
517 $ (valeig.AND.(r2.GT.wl).AND.
519 $ (indeig.AND.(iil.EQ.1)) )
THEN
522 IF( wantz.AND.(.NOT.zquery) )
THEN
541 $ (valeig.AND.(r1.GT.wl).AND.
543 $ (indeig.AND.(iiu.EQ.2)) )
THEN
546 IF( wantz.AND.(.NOT.zquery) )
THEN
587 tnrm =
slanst(
'M', n, d, e )
588 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
590 ELSE IF( tnrm.GT.rmax )
THEN
593 IF( scale.NE.one )
THEN
594 CALL
sscal( n, scale, d, 1 )
595 CALL
sscal( n-1, scale, e, 1 )
615 CALL
slarrr( n, d, e, iinfo )
631 CALL
scopy(n,d,1,work(indd),1)
635 work( inde2+
j-1 ) = e(
j)**2
639 IF( .NOT.wantz )
THEN
648 rtol1 = max( sqrt(eps)*5.0e-2, four * eps )
649 rtol2 = max( sqrt(eps)*5.0e-3, four * eps )
651 CALL
slarre( range, n, wl, wu, iil, iiu, d, e,
652 $ work(inde2), rtol1, rtol2, thresh, nsplit,
653 $ iwork( iinspl ), m, w, work( inderr ),
654 $ work( indgp ), iwork( iindbl ),
655 $ iwork( iindw ), work( indgrs ), pivmin,
656 $ work( indwrk ), iwork( iindwk ), iinfo )
657 IF( iinfo.NE.0 )
THEN
658 info = 10 + abs( iinfo )
671 CALL
clarrv( n, wl, wu, d, e,
672 $ pivmin, iwork( iinspl ), m,
673 $ 1, m, minrgp, rtol1, rtol2,
674 $ w, work( inderr ), work( indgp ), iwork( iindbl ),
675 $ iwork( iindw ), work( indgrs ), z, ldz,
676 $ isuppz, work( indwrk ), iwork( iindwk ), iinfo )
677 IF( iinfo.NE.0 )
THEN
678 info = 20 + abs( iinfo )
688 itmp = iwork( iindbl+
j-1 )
689 w(
j ) = w(
j ) + e( iwork( iinspl+itmp-1 ) )
699 DO 39 jblk = 1, iwork( iindbl+m-1 )
700 iend = iwork( iinspl+jblk-1 )
701 in = iend - ibegin + 1
706 IF( iwork( iindbl+wend ).EQ.jblk )
THEN
711 IF( wend.LT.wbegin )
THEN
716 offset = iwork(iindw+wbegin-1)-1
717 ifirst = iwork(iindw+wbegin-1)
718 ilast = iwork(iindw+wend-1)
721 $ work(indd+ibegin-1), work(inde2+ibegin-1),
722 $ ifirst, ilast, rtol2, offset, w(wbegin),
723 $ work( inderr+wbegin-1 ),
724 $ work( indwrk ), iwork( iindwk ), pivmin,
733 IF( scale.NE.one )
THEN
734 CALL
sscal( m, one / scale, w, 1 )
741 IF( nsplit.GT.1 .OR. n.EQ.2 )
THEN
742 IF( .NOT. wantz )
THEN
743 CALL
slasrt(
'I', m, w, iinfo )
744 IF( iinfo.NE.0 )
THEN
753 IF( w( jj ).LT.tmp )
THEN
762 CALL
cswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
763 itmp = isuppz( 2*i-1 )
764 isuppz( 2*i-1 ) = isuppz( 2*
j-1 )
765 isuppz( 2*
j-1 ) = itmp
767 isuppz( 2*i ) = isuppz( 2*
j )