278 SUBROUTINE dgeesx( 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
289 DOUBLE PRECISION RCONDE, RCONDV
294 DOUBLE PRECISION A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
305 DOUBLE PRECISION ZERO, ONE
306 PARAMETER ( ZERO = 0.0d0, one = 1.0d0 )
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, LIWRK, LWRK,
314 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SMLNUM
317 DOUBLE PRECISION DUM( 1 )
326 DOUBLE PRECISION DLAMCH, DLANGE
327 EXTERNAL lsame, ilaenv,
dlabad, dlamch, dlange
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,
'DGEHRD',
' ', n, 1, n, 0 )
383 CALL dhseqr(
'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 $
'DORGHR',
' ', 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(
'DGEESX', -info )
413 ELSE IF( lquery )
THEN
427 smlnum = dlamch(
'S' )
428 bignum = one / smlnum
429 CALL dlabad( smlnum, bignum )
430 smlnum = sqrt( smlnum ) / eps
431 bignum = one / smlnum
435 anrm = dlange(
'M', n, n, a, lda, dum )
437 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
440 ELSE IF( anrm.GT.bignum )
THEN
445 $
CALL dlascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
451 CALL dgebal(
'P', n, a, lda, ilo, ihi, work( ibal ), ierr )
458 CALL dgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
459 $ lwork-iwrk+1, ierr )
465 CALL dlacpy(
'L', n, n, a, lda, vs, ldvs )
470 CALL dorghr( n, ilo, ihi, vs, ldvs, work( itau ), work( iwrk ),
471 $ lwork-iwrk+1, ierr )
480 CALL dhseqr(
'S', jobvs, n, ilo, ihi, a, lda, wr, wi, vs, ldvs,
481 $ work( iwrk ), lwork-iwrk+1, ieval )
487 IF( wantst .AND. info.EQ.0 )
THEN
489 CALL dlascl(
'G', 0, 0, cscale, anrm, n, 1, wr, n, ierr
490 CALL dlascl(
'G', 0, 0, cscale, anrm, n, 1, wi, n, ierr )
493 bwork( i ) =
SELECT( wr( i ), wi( i ) )
503 CALL dtrsen( 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 IF( icond.EQ.-15 )
THEN
513 ELSE IF( icond.EQ.-17 )
THEN
518 ELSE IF( icond.GT.0 )
THEN
531 CALL dgebak(
'P',
'R', n, ilo, ihi, work( ibal ), n, vs, ldvs,
539 CALL dlascl(
'H', 0, 0, cscale, anrm, n, n, a, lda, ierr )
540 CALL dcopy( n, a, lda+1, wr, 1 )
541 IF( ( wantsv .OR. wantsb ) .AND. info.EQ.0 )
THEN
543 CALL dlascl(
'G', 0, 0, cscale, anrm, 1, 1, dum, 1, ierr )
546 IF( cscale.EQ.smlnum )
THEN
552 IF( ieval.GT.0 )
THEN
555 CALL dlascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, wi, n,
557 ELSE IF( wantst )
THEN
568 IF( wi( i ).EQ.zero )
THEN
571 IF( a( i+1, i ).EQ.zero )
THEN
574 ELSE IF( a( i+1, i ).NE.zero .AND. a( i, i+1 ).EQ.
579 $
CALL dswap( i-1, a( 1, i ), 1, a( 1, i+1 ), 1 )
581 $
CALL dswap( n-i-1, a( i, i+2 ), lda,
582 $ a( i+1, i+2 ), lda )
584 CALL dswap( n, vs( 1, i ), 1, vs( 1, i+1 ), 1 )
586 a( i, i+1 ) = a( i+1, i )
593 CALL dlascl(
'G', 0, 0, cscale, anrm, n-ieval, 1,
594 $ wi( ieval+1 ),
max( n-ieval, 1 ), ierr )
597 IF( wantst .AND. info.EQ.0 )
THEN
606 cursl =
SELECT( wr( i ), wi( i ) )
607 IF( wi( i ).EQ.zero )
THEN
611 IF( cursl .AND. .NOT.lastsl )
618 cursl = cursl .OR. lastsl
623 IF( cursl .AND. .NOT.lst2sl )
638 IF( wantsv .OR. wantsb )
THEN
639 iwork( 1 ) =
max( 1, sdim*( n-sdim ) )