244 SUBROUTINE zhsein( 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( * )
260 DOUBLE PRECISION rwork( * )
261 COMPLEX*16 h( ldh, * ), vl( ldvl, * ), vr( ldvr, * ),
269 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
270 DOUBLE PRECISION rzero
271 parameter( rzero = 0.0d+0 )
274 LOGICAL bothv, fromqr, leftv, noinit, rightv
275 INTEGER i, iinfo, k, kl, kln, kr, ks, ldwork
276 DOUBLE PRECISION eps3, hnorm, smlnum, ulp, unfl
288 INTRINSIC abs, dble, dimag, max
291 DOUBLE PRECISION cabs1
294 cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( 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(
'ZHSEIN', -info )
347 unfl =
dlamch(
'Safe minimum' )
348 ulp =
dlamch(
'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 =
zlanhs(
'I', kr-kl+1, h( kl, kl ), ldh, rwork )
403 IF(
disnan( 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
zlaein( .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
zlaein( .true., noinit, kr, h, ldh, wk, vr( 1, ks ),
449 $ work, ldwork, rwork, eps3, smlnum, iinfo )
450 IF( iinfo.GT.0 )
THEN
double precision function zlanhs(NORM, N, A, LDA, WORK)
ZLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
double precision function dlamch(CMACH)
DLAMCH
subroutine zhsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, IFAILR, INFO)
ZHSEIN
logical function disnan(DIN)
DISNAN tests input for NaN.
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...