244 SUBROUTINE chsein( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL,
245 $ ldvl, vr, ldvr, mm, m, work, rwork, ifaill,
254 CHARACTER EIGSRC, INITV, SIDE
255 INTEGER INFO, LDH, LDVL, LDVR, M, MM, N
259 INTEGER IFAILL( * ), IFAILR( * )
261 COMPLEX H( ldh, * ), VL( ldvl, * ), VR( ldvr, * ),
269 parameter ( zero = ( 0.0e+0, 0.0e+0 ) )
271 parameter ( rzero = 0.0e+0 )
274 LOGICAL BOTHV, FROMQR, LEFTV, NOINIT, RIGHTV
275 INTEGER I, IINFO, K, KL, KLN, KR, KS, LDWORK
276 REAL EPS3, HNORM, SMLNUM, ULP, UNFL
280 LOGICAL LSAME, SISNAN
282 EXTERNAL lsame, clanhs, slamch, sisnan
288 INTRINSIC abs, aimag, max, real
294 cabs1( cdum ) = abs(
REAL( CDUM ) ) + abs( AIMAG( cdum ) )
300 bothv = lsame( side,
'B' )
301 rightv = lsame( side,
'R' ) .OR. bothv
302 leftv = lsame( side,
'L' ) .OR. bothv
304 fromqr = lsame( eigsrc,
'Q' )
306 noinit = lsame( initv,
'N' )
318 IF( .NOT.rightv .AND. .NOT.leftv )
THEN
320 ELSE IF( .NOT.fromqr .AND. .NOT.lsame( eigsrc,
'N' ) )
THEN
322 ELSE IF( .NOT.noinit .AND. .NOT.lsame( initv,
'U' ) )
THEN
324 ELSE IF( n.LT.0 )
THEN
326 ELSE IF( ldh.LT.max( 1, n ) )
THEN
328 ELSE IF( ldvl.LT.1 .OR. ( leftv .AND. ldvl.LT.n ) )
THEN
330 ELSE IF( ldvr.LT.1 .OR. ( rightv .AND. ldvr.LT.n ) )
THEN
332 ELSE IF( mm.LT.m )
THEN
336 CALL xerbla(
'CHSEIN', -info )
347 unfl = slamch(
'Safe minimum' )
348 ulp = slamch(
'Precision' )
349 smlnum = unfl*( n / ulp )
363 IF(
SELECT( k ) )
THEN
380 DO 20 i = k, kl + 1, -1
381 IF( h( i, i-1 ).EQ.zero )
388 IF( h( i+1, i ).EQ.zero )
402 hnorm = clanhs(
'I', kr-kl+1, h( kl, kl ), ldh, rwork )
403 IF( sisnan( hnorm ) )
THEN
406 ELSE IF( (hnorm.GT.rzero) )
THEN
419 DO 70 i = k - 1, kl, -1
420 IF(
SELECT( i ) .AND. cabs1( w( i )-wk ).LT.eps3 )
THEN
431 CALL claein( .false., noinit, n-kl+1, h( kl, kl ), ldh,
432 $ wk, vl( kl, ks ), work, ldwork, rwork, eps3,
434 IF( iinfo.GT.0 )
THEN
448 CALL claein( .true., noinit, kr, h, ldh, wk, vr( 1, ks ),
449 $ work, ldwork, rwork, eps3, smlnum, iinfo )
450 IF( iinfo.GT.0 )
THEN
subroutine chsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, IFAILR, INFO)
CHSEIN
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine claein(RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK, EPS3, SMLNUM, INFO)
CLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iterat...