262 SUBROUTINE shsein( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI,
263 $ vl, ldvl, vr, ldvr, mm, m, work, ifaill,
272 CHARACTER eigsrc, initv, side
273 INTEGER info, ldh, ldvl, ldvr, m, mm, n
277 INTEGER ifaill( * ), ifailr( * )
278 REAL h( ldh, * ), vl( ldvl, * ), vr( ldvr, * ),
279 $ wi( * ), work( * ), wr( * )
286 parameter( zero = 0.0e+0, one = 1.0e+0 )
289 LOGICAL bothv, fromqr, leftv, noinit, pair, rightv
290 INTEGER i, iinfo, k, kl, kln, kr, ksi, ksr, ldwork
291 REAL bignum, eps3, hnorm, smlnum, ulp, unfl, wki,
309 bothv =
lsame( side,
'B' )
310 rightv =
lsame( side,
'R' ) .OR. bothv
311 leftv =
lsame( side,
'L' ) .OR. bothv
313 fromqr =
lsame( eigsrc,
'Q' )
315 noinit =
lsame( initv,
'N' )
325 SELECT( k ) = .false.
327 IF( wi( k ).EQ.zero )
THEN
332 IF(
SELECT( k ) .OR.
SELECT( k+1 ) )
THEN
341 IF( .NOT.rightv .AND. .NOT.leftv )
THEN
343 ELSE IF( .NOT.fromqr .AND. .NOT.
lsame( eigsrc,
'N' ) )
THEN
345 ELSE IF( .NOT.noinit .AND. .NOT.
lsame( initv,
'U' ) )
THEN
347 ELSE IF( n.LT.0 )
THEN
349 ELSE IF( ldh.LT.max( 1, n ) )
THEN
351 ELSE IF( ldvl.LT.1 .OR. ( leftv .AND. ldvl.LT.n ) )
THEN
353 ELSE IF( ldvr.LT.1 .OR. ( rightv .AND. ldvr.LT.n ) )
THEN
355 ELSE IF( mm.LT.m )
THEN
359 CALL
xerbla(
'SHSEIN', -info )
370 unfl =
slamch(
'Safe minimum' )
371 ulp =
slamch(
'Precision' )
372 smlnum = unfl*( n / ulp )
373 bignum = ( one-ulp ) / smlnum
387 IF(
SELECT( k ) )
THEN
404 DO 20 i = k, kl + 1, -1
405 IF( h( i, i-1 ).EQ.zero )
412 IF( h( i+1, i ).EQ.zero )
426 hnorm =
slanhs(
'I', kr-kl+1, h( kl, kl ), ldh, work )
427 IF(
sisnan( hnorm ) )
THEN
430 ELSE IF( hnorm.GT.zero )
THEN
444 DO 70 i = k - 1, kl, -1
445 IF(
SELECT( i ) .AND. abs( wr( i )-wkr )+
446 $ abs( wi( i )-wki ).LT.eps3 )
THEN
463 CALL
slaein( .false., noinit, n-kl+1, h( kl, kl ), ldh,
464 $ wkr, wki, vl( kl, ksr ), vl( kl, ksi ),
465 $ work, ldwork, work( n*n+n+1 ), eps3, smlnum,
467 IF( iinfo.GT.0 )
THEN
492 CALL
slaein( .true., noinit, kr, h, ldh, wkr, wki,
493 $ vr( 1, ksr ), vr( 1, ksi ), work, ldwork,
494 $ work( n*n+n+1 ), eps3, smlnum, bignum,
496 IF( iinfo.GT.0 )
THEN