243 SUBROUTINE chsein( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL,
244 $ ldvl, vr, ldvr, mm, m, work, rwork, ifaill,
253 CHARACTER eigsrc, initv, side
254 INTEGER info, ldh, ldvl, ldvr, m, mm, n
258 INTEGER ifaill( * ), ifailr( * )
260 COMPLEX h( ldh, * ), vl( ldvl, * ), vr( ldvr, * ),
268 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
270 parameter( rzero = 0.0e+0 )
273 LOGICAL bothv, fromqr, leftv, noinit, rightv
274 INTEGER i, iinfo, k, kl, kln, kr, ks, ldwork
275 REAL eps3, hnorm, smlnum, ulp, unfl
287 INTRINSIC abs, aimag, max, real
293 cabs1( cdum ) = abs(
REAL( CDUM ) ) + abs( aimag( cdum ) )
299 bothv =
lsame( side,
'B' )
300 rightv =
lsame( side,
'R' ) .OR. bothv
301 leftv =
lsame( side,
'L' ) .OR. bothv
303 fromqr =
lsame( eigsrc,
'Q' )
305 noinit =
lsame( initv,
'N' )
317 IF( .NOT.rightv .AND. .NOT.leftv )
THEN
319 ELSE IF( .NOT.fromqr .AND. .NOT.
lsame( eigsrc,
'N' ) )
THEN
321 ELSE IF( .NOT.noinit .AND. .NOT.
lsame( initv,
'U' ) )
THEN
323 ELSE IF( n.LT.0 )
THEN
325 ELSE IF( ldh.LT.max( 1, n ) )
THEN
327 ELSE IF( ldvl.LT.1 .OR. ( leftv .AND. ldvl.LT.n ) )
THEN
329 ELSE IF( ldvr.LT.1 .OR. ( rightv .AND. ldvr.LT.n ) )
THEN
331 ELSE IF( mm.LT.m )
THEN
335 CALL
xerbla(
'CHSEIN', -info )
346 unfl =
slamch(
'Safe minimum' )
347 ulp =
slamch(
'Precision' )
348 smlnum = unfl*( n / ulp )
362 IF(
SELECT( k ) )
THEN
379 DO 20 i = k, kl + 1, -1
380 IF( h( i, i-1 ).EQ.zero )
387 IF( h( i+1, i ).EQ.zero )
401 hnorm =
clanhs(
'I', kr-kl+1, h( kl, kl ), ldh, rwork )
402 IF( hnorm.GT.rzero )
THEN
415 DO 70 i = k - 1, kl, -1
416 IF(
SELECT( i ) .AND. cabs1( w( i )-wk ).LT.eps3 )
THEN
427 CALL
claein( .false., noinit, n-kl+1, h( kl, kl ), ldh,
428 $ wk, vl( kl, ks ), work, ldwork, rwork, eps3,
430 IF( iinfo.GT.0 )
THEN
444 CALL
claein( .true., noinit, kr, h, ldh, wk, vr( 1, ks ),
445 $ work, ldwork, rwork, eps3, smlnum, iinfo )
446 IF( iinfo.GT.0 )
THEN