278 SUBROUTINE sgeesx( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM,
279 $ WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK,
280 $ IWORK, LIWORK, BWORK, INFO )
287 CHARACTER JOBVS, SENSE, SORT
288 INTEGER INFO, LDA, LDVS, LIWORK, LWORK, N, SDIM
294 REAL A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
306 PARAMETER ( ZERO = 0.0e0, one = 1.0e0 )
309 LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTSB,
310 $ WANTSE, WANTSN, WANTST, WANTSV, WANTVS
311 INTEGER HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
312 $ IHI, ILO, INXT, IP, ITAU, IWRK, LWRK, LIWRK,
314 REAL ANRM, BIGNUM, CSCALE, EPS, SMLNUM
327 EXTERNAL lsame, ilaenv, slamch, slange
337 wantvs = lsame( jobvs,
'V' )
338 wantst = lsame( sort,
'S' )
339 wantsn = lsame( sense,
'N' )
340 wantse = lsame( sense,
'E' )
341 wantsv = lsame( sense,
'V' )
342 wantsb = lsame( sense,
'B' )
343 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
345 IF( ( .NOT.wantvs ) .AND. ( .NOT.lsame( jobvs,
'N' ) ) )
THEN
347 ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.lsame( sort,
'N' ) ) )
THEN
349 ELSE IF( .NOT.( wantsn .OR. wantse .OR. wantsv .OR. wantsb ) .OR.
350 $ ( .NOT.wantst .AND. .NOT.wantsn ) )
THEN
352 ELSE IF( n.LT.0 )
THEN
354 ELSE IF( lda.LT.
max( 1, n ) )
THEN
356 ELSE IF( ldvs.LT.1 .OR. ( wantvs .AND. ldvs.LT.n ) )
THEN
380 maxwrk = 2*n + n*ilaenv( 1,
'SGEHRD',
' ', n, 1, n, 0 )
383 CALL shseqr(
'S', jobvs, n, 1, n, a, lda, wr, wi, vs, ldvs,
387 IF( .NOT.wantvs )
THEN
388 maxwrk =
max( maxwrk, n + hswork )
390 maxwrk =
max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
391 $
'SORGHR',
' ', n, 1, n, -1 ) )
392 maxwrk =
max( maxwrk, n + hswork )
396 $ lwrk =
max( lwrk, n + ( n*n )/2 )
397 IF( wantsv .OR. wantsb )
403 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
405 ELSE IF( liwork.LT.1 .AND. .NOT.lquery )
THEN
411 CALL xerbla(
'SGEESX', -info )
413 ELSE IF( lquery )
THEN
427 smlnum = slamch(
'S' )
428 bignum = one / smlnum
429 CALL slabad( smlnum, bignum )
430 smlnum = sqrt( smlnum ) / eps
431 bignum = one / smlnum
435 anrm = slange( 'm
', N, N, A, LDA, DUM )
437.GT..AND..LT.
IF( ANRMZERO ANRMSMLNUM ) THEN
440.GT.
ELSE IF( ANRMBIGNUM ) THEN
445 $ CALL SLASCL( 'g
', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
451 CALL SGEBAL( 'p
', N, A, LDA, ILO, IHI, WORK( IBAL ), IERR )
458 CALL SGEHRD( N, ILO, IHI, A, LDA, WORK( ITAU ), WORK( IWRK ),
459 $ LWORK-IWRK+1, IERR )
465 CALL SLACPY( 'l
', N, N, A, LDA, VS, LDVS )
470 CALL SORGHR( N, ILO, IHI, VS, LDVS, WORK( ITAU ), WORK( IWRK ),
471 $ LWORK-IWRK+1, IERR )
480 CALL SHSEQR( 's
', JOBVS, N, ILO, IHI, A, LDA, WR, WI, VS, LDVS,
481 $ WORK( IWRK ), LWORK-IWRK+1, IEVAL )
487.AND..EQ.
IF( WANTST INFO0 ) THEN
489 CALL SLASCL( 'g
', 0, 0, CSCALE, ANRM, N, 1, WR, N, IERR )
490 CALL SLASCL( 'g
', 0, 0, CSCALE, ANRM, N, 1, WI, N, IERR )
493 BWORK( I ) = SELECT( WR( I ), WI( I ) )
503 CALL STRSEN( SENSE, JOBVS, BWORK, N, A, LDA, VS, LDVS, WR, WI,
504 $ SDIM, RCONDE, RCONDV, WORK( IWRK ), LWORK-IWRK+1,
505 $ IWORK, LIWORK, ICOND )
507 $ MAXWRK = MAX( MAXWRK, N+2*SDIM*( N-SDIM ) )
508.EQ.
IF( ICOND-15 ) THEN
513.EQ.
ELSE IF( ICOND-17 ) THEN
518.GT.
ELSE IF( ICOND0 ) THEN
531 CALL SGEBAK( 'p
', 'r
', N, ILO, IHI, WORK( IBAL ), N, VS, LDVS,
539 CALL SLASCL( 'h
', 0, 0, CSCALE, ANRM, N, N, A, LDA, IERR )
540 CALL SCOPY( N, A, LDA+1, WR, 1 )
541.OR..AND..EQ.
IF( ( WANTSV WANTSB ) INFO0 ) THEN
543 CALL SLASCL( 'g
', 0, 0, CSCALE, ANRM, 1, 1, DUM, 1, IERR )
546.EQ.
IF( CSCALESMLNUM ) THEN
552.GT.
IF( IEVAL0 ) THEN
555 CALL SLASCL( 'g
', 0, 0, CSCALE, ANRM, ILO-1, 1, WI, N,
557 ELSE IF( WANTST ) THEN
568.EQ.
IF( WI( I )ZERO ) THEN
571.EQ.
IF( A( I+1, I )ZERO ) THEN
574.NE..AND..EQ.
ELSE IF( A( I+1, I )ZERO A( I, I+1 )
579 $ CALL SSWAP( I-1, A( 1, I ), 1, A( 1, I+1 ), 1 )
581 $ CALL SSWAP( N-I-1, A( I, I+2 ), LDA,
582 $ A( I+1, I+2 ), LDA )
584 CALL SSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 )
586 A( I, I+1 ) = A( I+1, I )
593 CALL SLASCL( 'g
', 0, 0, CSCALE, ANRM, N-IEVAL, 1,
594 $ WI( IEVAL+1 ), MAX( N-IEVAL, 1 ), IERR )
597.AND..EQ.
IF( WANTST INFO0 ) THEN
606 CURSL = SELECT( WR( I ), WI( I ) )
607.EQ.
IF( WI( I )ZERO ) THEN
611.AND..NOT.
IF( CURSL LASTSL )
618.OR.
CURSL = CURSL LASTSL
623.AND..NOT.
IF( CURSL LST2SL )
638.OR.
IF( WANTSV WANTSB ) THEN
639 IWORK( 1 ) = SDIM*(N-SDIM)
subroutine slabad(small, large)
SLABAD
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
subroutine slascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine xerbla(srname, info)
XERBLA
subroutine sgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
SGEHRD
subroutine sgebal(job, n, a, lda, ilo, ihi, scale, info)
SGEBAL
subroutine sgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
SGEBAK
subroutine sgeesx(jobvs, sort, select, sense, n, a, lda, sdim, wr, wi, vs, ldvs, rconde, rcondv, work, lwork, iwork, liwork, bwork, info)
SGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
subroutine shseqr(job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork, info)
SHSEQR
subroutine strsen(job, compq, select, n, t, ldt, q, ldq, wr, wi, m, s, sep, work, lwork, iwork, liwork, info)
STRSEN
subroutine sorghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
SORGHR
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
subroutine sswap(n, sx, incx, sy, incy)
SSWAP