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,
295 LOGICAL LSAME, SISNAN
297 EXTERNAL lsame, slamch, slanhs, sisnan
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
subroutine shsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI, VL, LDVL, VR, LDVR, MM, M, WORK, IFAILL, IFAILR, INFO)
SHSEIN
subroutine slaein(RIGHTV, NOINIT, N, H, LDH, WR, WI, VR, VI, B, LDB, WORK, EPS3, SMLNUM, BIGNUM, INFO)
SLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iterat...
subroutine xerbla(SRNAME, INFO)
XERBLA