297 SUBROUTINE chseqr( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ,
298 $ WORK, LWORK, INFO )
305 INTEGER IHI, ILO, INFO, LDH, LDZ, LWORK, N
309 COMPLEX H( LDH, * ), W( * ), WORK( * ), Z( LDZ, * )
320 parameter( ntiny = 15 )
331 parameter( zero = ( 0.0e0, 0.0e0 ),
332 $ one = ( 1.0e0, 0.0e0 ) )
334 parameter( rzero = 0.0e0 )
337 COMPLEX HL( NL, NL ), WORKL( NL )
341 LOGICAL INITZ, LQUERY, WANTT, WANTZ
347 EXTERNAL ilaenv, lsame, sroundup_lwork
353 INTRINSIC cmplx, max, min, real
359 wantt = lsame( job,
'S' )
360 initz = lsame( compz,
'I' )
361 wantz = initz .OR. lsame( compz,
'V' )
362 work( 1 ) = cmplx( real( max( 1, n ) ), rzero )
366 IF( .NOT.lsame( job,
'E' ) .AND. .NOT.wantt )
THEN
368 ELSE IF( .NOT.lsame( compz,
'N' ) .AND. .NOT.wantz )
THEN
370 ELSE IF( n.LT.0 )
THEN
372 ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) )
THEN
374 ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n )
THEN
376 ELSE IF( ldh.LT.max( 1, n ) )
THEN
378 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.max( 1, n ) ) )
THEN
380 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
388 CALL xerbla(
'CHSEQR', -info )
391 ELSE IF( n.EQ.0 )
THEN
397 ELSE IF( lquery )
THEN
401 CALL claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi, z,
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 ), 1 )
421 $
CALL claset(
'A', n, n, zero, one, z, ldz )
425 IF( ilo.EQ.ihi )
THEN
426 w( ilo ) = h( ilo, ilo )
432 nmin = ilaenv( 12,
'CHSEQR', job( : 1 ) // compz( : 1 ), n,
434 nmin = max( ntiny, nmin )
439 CALL claqr0( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
440 $ z, ldz, work, lwork, info )
445 CALL clahqr( wantt, wantz, n, ilo, ihi, h, ldh, w, ilo, ihi,
460 CALL claqr0( wantt, wantz, n, ilo, kbot, h, ldh, w,
461 $ ilo, ihi, z, ldz, work, lwork, info )
470 CALL clacpy(
'A', n, n, h, ldh, hl, nl )
472 CALL claset(
'A', nl, nl-n, zero, zero, hl( 1, n+1 ),
474 CALL claqr0( wantt, wantz, nl, ilo, kbot, hl, nl, w,
475 $ ilo, ihi, z, ldz, workl, nl, info )
476 IF( wantt .OR. info.NE.0 )
477 $
CALL clacpy(
'A', n, n, hl, nl, h, ldh )
484 IF( ( wantt .OR. info.NE.0 ) .AND. n.GT.2 )
485 $
CALL claset(
'L', n-2, n-2, zero, zero, h( 3, 1 ), ldh )
490 work( 1 ) = cmplx( max( real( max( 1, n ) ),
491 $ real( work( 1 ) ) ), rzero )
subroutine xerbla(srname, info)
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
subroutine chseqr(job, compz, n, ilo, ihi, h, ldh, w, z, ldz, work, lwork, info)
CHSEQR
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clahqr(wantt, wantz, n, ilo, ihi, h, ldh, w, iloz, ihiz, z, ldz, info)
CLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix,...
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...
subroutine claset(uplo, m, n, alpha, beta, a, lda)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.