216 SUBROUTINE sgees( JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI,
217 $ vs, ldvs, work, lwork, bwork, info )
225 CHARACTER JOBVS, SORT
226 INTEGER INFO, LDA, LDVS, LWORK, N, SDIM
230 REAL A( lda, * ), VS( ldvs, * ), WI( * ), WORK( * ),
242 parameter ( zero = 0.0e0, one = 1.0e0 )
245 LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTST,
247 INTEGER HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
248 $ ihi, ilo, inxt, ip, itau, iwrk, maxwrk, minwrk
249 REAL ANRM, BIGNUM, CSCALE, EPS, S, SEP, SMLNUM
263 EXTERNAL lsame, ilaenv, slamch, slange
273 lquery = ( lwork.EQ.-1 )
274 wantvs = lsame( jobvs,
'V' )
275 wantst = lsame( sort,
'S' )
276 IF( ( .NOT.wantvs ) .AND. ( .NOT.lsame( jobvs,
'N' ) ) )
THEN
278 ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.lsame( sort,
'N' ) ) )
THEN
280 ELSE IF( n.LT.0 )
THEN
282 ELSE IF( lda.LT.max( 1, n ) )
THEN
284 ELSE IF( ldvs.LT.1 .OR. ( wantvs .AND. ldvs.LT.n ) )
THEN
303 maxwrk = 2*n + n*ilaenv( 1,
'SGEHRD',
' ', n, 1, n, 0 )
306 CALL shseqr(
'S', jobvs, n, 1, n, a, lda, wr, wi, vs, ldvs,
310 IF( .NOT.wantvs )
THEN
311 maxwrk = max( maxwrk, n + hswork )
313 maxwrk = max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
314 $
'SORGHR',
' ', n, 1, n, -1 ) )
315 maxwrk = max( maxwrk, n + hswork )
320 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
326 CALL xerbla(
'SGEES ', -info )
328 ELSE IF( lquery )
THEN
342 smlnum = slamch(
'S' )
343 bignum = one / smlnum
344 CALL slabad( smlnum, bignum )
345 smlnum = sqrt( smlnum ) / eps
346 bignum = one / smlnum
350 anrm = slange(
'M', n, n, a, lda, dum )
352 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
355 ELSE IF( anrm.GT.bignum )
THEN
360 $
CALL slascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
366 CALL sgebal(
'P', n, a, lda, ilo, ihi, work( ibal ), ierr )
373 CALL sgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
374 $ lwork-iwrk+1, ierr )
380 CALL slacpy(
'L', n, n, a, lda, vs, ldvs )
385 CALL sorghr( n, ilo, ihi, vs, ldvs, work( itau ), work( iwrk ),
386 $ lwork-iwrk+1, ierr )
395 CALL shseqr(
'S', jobvs, n, ilo, ihi, a, lda, wr, wi, vs, ldvs,
396 $ work( iwrk ), lwork-iwrk+1, ieval )
402 IF( wantst .AND. info.EQ.0 )
THEN
404 CALL slascl(
'G', 0, 0, cscale, anrm, n, 1, wr, n, ierr )
405 CALL slascl(
'G', 0, 0, cscale, anrm, n, 1, wi, n, ierr )
408 bwork( i ) =
SELECT( wr( i ), wi( i ) )
414 CALL strsen(
'N', jobvs, bwork, n, a, lda, vs, ldvs, wr, wi,
415 $ sdim, s, sep, work( iwrk ), lwork-iwrk+1, idum, 1,
426 CALL sgebak(
'P',
'R', n, ilo, ihi, work( ibal ), n, vs, ldvs,
434 CALL slascl(
'H', 0, 0, cscale, anrm, n, n, a, lda, ierr )
435 CALL scopy( n, a, lda+1, wr, 1 )
436 IF( cscale.EQ.smlnum )
THEN
442 IF( ieval.GT.0 )
THEN
445 CALL slascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, wi,
446 $ max( ilo-1, 1 ), ierr )
447 ELSE IF( wantst )
THEN
458 IF( wi( i ).EQ.zero )
THEN
461 IF( a( i+1, i ).EQ.zero )
THEN
464 ELSE IF( a( i+1, i ).NE.zero .AND. a( i, i+1 ).EQ.
469 $
CALL sswap( i-1, a( 1, i ), 1, a( 1, i+1 ), 1 )
471 $
CALL sswap( n-i-1, a( i, i+2 ), lda,
472 $ a( i+1, i+2 ), lda )
474 CALL sswap( n, vs( 1, i ), 1, vs( 1, i+1 ), 1 )
476 a( i, i+1 ) = a( i+1, i )
486 CALL slascl(
'G', 0, 0, cscale, anrm, n-ieval, 1,
487 $ wi( ieval+1 ), max( n-ieval, 1 ), ierr )
490 IF( wantst .AND. info.EQ.0 )
THEN
499 cursl =
SELECT( wr( i ), wi( i ) )
500 IF( wi( i ).EQ.zero )
THEN
504 IF( cursl .AND. .NOT.lastsl )
511 cursl = cursl .OR. lastsl
516 IF( cursl .AND. .NOT.lst2sl )
subroutine sgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, VS, LDVS, WORK, LWORK, BWORK, INFO)
SGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
subroutine sgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SGEHRD
subroutine sgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
SGEBAK
subroutine sorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SORGHR
subroutine sgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
SGEBAL
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine strsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
STRSEN
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 slabad(SMALL, LARGE)
SLABAD
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine shseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
SHSEQR