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
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
LOGICAL function sisnan(SIN)
SISNAN tests input for NaN.
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 shsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, WR, WI, VL, LDVL, VR, LDVR, MM, M, WORK, IFAILL, IFAILR, INFO)
SHSEIN
REAL function slanhs(NORM, N, A, LDA, WORK)
SLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...