240 SUBROUTINE zhsein( SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W,
242 $ LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL,
250 CHARACTER EIGSRC, INITV, SIDE
251 INTEGER INFO, LDH, LDVL, LDVR, M, MM, N
255 INTEGER IFAILL( * ), IFAILR( * )
256 DOUBLE PRECISION RWORK( * )
257 COMPLEX*16 H( LDH, * ), VL( LDVL, * ), VR( LDVR, * ),
265 PARAMETER ( ZERO = ( 0.0d+0, 0.0d+0 ) )
266 DOUBLE PRECISION RZERO
267 parameter( rzero = 0.0d+0 )
270 LOGICAL BOTHV, FROMQR, LEFTV, NOINIT, RIGHTV
271 INTEGER I, IINFO, K, KL, KLN, KR, KS, LDWORK
272 DOUBLE PRECISION EPS3, HNORM, SMLNUM, ULP, UNFL
276 LOGICAL LSAME, DISNAN
277 DOUBLE PRECISION DLAMCH, ZLANHS
278 EXTERNAL LSAME, DLAMCH, ZLANHS, DISNAN
284 INTRINSIC abs, dble, dimag, max
287 DOUBLE PRECISION CABS1
290 cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) )
296 bothv = lsame( side,
'B' )
297 rightv = lsame( side,
'R' ) .OR. bothv
298 leftv = lsame( side,
'L' ) .OR. bothv
300 fromqr = lsame( eigsrc,
'Q' )
302 noinit = lsame( initv,
'N' )
314 IF( .NOT.rightv .AND. .NOT.leftv )
THEN
316 ELSE IF( .NOT.fromqr .AND. .NOT.lsame( eigsrc,
'N' ) )
THEN
318 ELSE IF( .NOT.noinit .AND. .NOT.lsame( initv,
'U' ) )
THEN
320 ELSE IF( n.LT.0 )
THEN
322 ELSE IF( ldh.LT.max( 1, n ) )
THEN
324 ELSE IF( ldvl.LT.1 .OR. ( leftv .AND. ldvl.LT.n ) )
THEN
326 ELSE IF( ldvr.LT.1 .OR. ( rightv .AND. ldvr.LT.n ) )
THEN
328 ELSE IF( mm.LT.m )
THEN
332 CALL xerbla(
'ZHSEIN', -info )
343 unfl = dlamch(
'Safe minimum' )
344 ulp = dlamch(
'Precision' )
345 smlnum = unfl*( n / ulp )
359 IF(
SELECT( k ) )
THEN
376 DO 20 i = k, kl + 1, -1
377 IF( h( i, i-1 ).EQ.zero )
384 IF( h( i+1, i ).EQ.zero )
398 hnorm = zlanhs(
'I', kr-kl+1, h( kl, kl ), ldh,
400 IF( disnan( hnorm ) )
THEN
403 ELSE IF( hnorm.GT.rzero )
THEN
416 DO 70 i = k - 1, kl, -1
417 IF(
SELECT( i ) .AND. cabs1( w( i )-wk ).LT.eps3 )
THEN
428 CALL zlaein( .false., noinit, n-kl+1, h( kl, kl ),
430 $ wk, vl( kl, ks ), work, ldwork, rwork, eps3,
432 IF( iinfo.GT.0 )
THEN
446 CALL zlaein( .true., noinit, kr, h, ldh, wk, vr( 1,
448 $ work, ldwork, rwork, eps3, smlnum, iinfo )
449 IF( iinfo.GT.0 )
THEN
subroutine zhsein(side, eigsrc, initv, select, n, h, ldh, w, vl, ldvl, vr, ldvr, mm, m, work, rwork, ifaill, ifailr, info)
ZHSEIN
subroutine zlaein(rightv, noinit, n, h, ldh, w, v, b, ldb, rwork, eps3, smlnum, info)
ZLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iterat...