295 SUBROUTINE chseqr( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ,
296 $ WORK, LWORK, INFO )
303 INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
307 COMPLEX H( LDH, * ), W( * ), WORK( * ), Z( LDZ, * )
318 parameter( ntiny = 15 )
329 parameter( zero = ( 0.0e0, 0.0e0 ),
330 $ one = ( 1.0e0, 0.0e0 ) )
332 parameter( rzero = 0.0e0 )
335 COMPLEX HL( NL, NL ), WORKL( NL )
339 LOGICAL INITZ, LQUERY, WANTT, WANTZ
345 EXTERNAL ilaenv, lsame, sroundup_lwork
352 INTRINSIC cmplx, max, min, real
358 wantt = lsame( job,
'S' )
359 initz = lsame( compz,
'I' )
360 wantz = initz .OR. lsame( compz,
'V' )
361 work( 1 ) = cmplx( real( max( 1, n ) ), rzero )
365 IF( .NOT.lsame( job,
'E' ) .AND. .NOT.wantt )
THEN
367 ELSE IF( .NOT.lsame( compz,
'N' ) .AND. .NOT.wantz )
THEN
369 ELSE IF( n.LT.0 )
THEN
371 ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) )
THEN
373 ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n )
THEN
375 ELSE IF( ldh.LT.max( 1, n ) )
THEN
377 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.max( 1, n ) ) )
THEN
379 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
387 CALL xerbla(
'CHSEQR', -info )
390 ELSE IF( n.EQ.0 )
THEN
396 ELSE IF( lquery )
THEN
400 CALL claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
402 $ ldz, work, lwork, info )
405 work( 1 ) = cmplx( max( real( work( 1 ) ), real( max( 1,
414 $
CALL ccopy( ilo-1, h, ldh+1, w, 1 )
416 $
CALL ccopy( n-ihi, h( ihi+1, ihi+1 ), ldh+1, w( ihi+1 ),
422 $
CALL claset(
'A', n, n, zero, one, z, ldz )
426 IF( ilo.EQ.ihi )
THEN
427 w( ilo ) = h( ilo, ilo )
433 nmin = ilaenv( 12,
'CHSEQR', job( : 1 ) // compz( : 1 ), n,
435 nmin = max( ntiny, nmin )
440 CALL claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo,
442 $ z, ldz, work, lwork, info )
447 CALL clahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo,
463 CALL claqr0( wantt, wantz, n, ilo, kbot, h, ldh, w,
464 $ ilo, ihi, z, ldz, work, lwork, info )
473 CALL clacpy(
'A', n, n, h, ldh, hl, nl )
475 CALL claset(
'A', nl, nl-n, zero, zero, hl( 1,
478 CALL claqr0( wantt, wantz, nl, ilo, kbot, hl, nl,
480 $ ilo, ihi, z, ldz, workl, nl, info )
481 IF( wantt .OR. info.NE.0 )
482 $
CALL clacpy(
'A', n, n, hl, nl, h, ldh )
489 IF( ( wantt .OR. info.NE.0 ) .AND. n.GT.2 )
490 $
CALL claset(
'L', n-2, n-2, zero, zero, h( 3, 1 ), ldh )
495 work( 1 ) = cmplx( max( real( max( 1, n ) ),
496 $ real( work( 1 ) ) ), rzero )
subroutine claqr0(wantt, wantz, n, ilo, ihi, h, ldh, w, iloz, ihiz, z, ldz, work, lwork, info)
CLAQR0 computes the eigenvalues of a Hessenberg matrix, and optionally the matrices from the Schur de...