276 SUBROUTINE dgeesx( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM,
277 $ WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK,
278 $ IWORK, LIWORK, BWORK, INFO )
285 CHARACTER JOBVS, SENSE, SORT
286 INTEGER INFO, LDA, LDVS, LIWORK, LWORK, N, SDIM
287 DOUBLE PRECISION RCONDE, RCONDV
292 DOUBLE PRECISION A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
303 DOUBLE PRECISION ZERO, ONE
304 PARAMETER ( ZERO = 0.0d0, one = 1.0d0 )
307 LOGICAL CURSL, LASTSL, LQUERY, LST2SL, SCALEA, WANTSB,
308 $ WANTSE, WANTSN, WANTST, WANTSV, WANTVS
309 INTEGER HSWORK, I, I1, I2, IBAL, ICOND, IERR, IEVAL,
310 $ IHI, ILO, INXT, IP, ITAU, IWRK, LIWRK, LWRK,
312 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SMLNUM
315 DOUBLE PRECISION DUM( 1 )
325 DOUBLE PRECISION DLAMCH, DLANGE
326 EXTERNAL lsame, ilaenv, dlamch, dlange
336 wantvs = lsame( jobvs,
'V' )
337 wantst = lsame( sort,
'S' )
338 wantsn = lsame( sense,
'N' )
339 wantse = lsame( sense,
'E' )
340 wantsv = lsame( sense,
'V' )
341 wantsb = lsame( sense,
'B' )
342 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
344 IF( ( .NOT.wantvs ) .AND. ( .NOT.lsame( jobvs,
'N' ) ) )
THEN
346 ELSE IF( ( .NOT.wantst ) .AND.
347 $ ( .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,
386 hswork = int( work( 1 ) )
388 IF( .NOT.wantvs )
THEN
389 maxwrk = max( maxwrk, n + hswork )
391 maxwrk = max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
392 $
'DORGHR',
' ', n, 1, n, -1 ) )
393 maxwrk = max( maxwrk, n + hswork )
397 $ lwrk = max( lwrk, n + ( n*n )/2 )
398 IF( wantsv .OR. wantsb )
404 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
406 ELSE IF( liwork.LT.1 .AND. .NOT.lquery )
THEN
412 CALL xerbla(
'DGEESX', -info )
414 ELSE IF( lquery )
THEN
428 smlnum = dlamch(
'S' )
429 bignum = one / smlnum
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 ),
472 $ lwork-iwrk+1, ierr )
481 CALL dhseqr(
'S', jobvs, n, ilo, ihi, a, lda, wr, wi, vs, ldvs,
482 $ work( iwrk ), lwork-iwrk+1, ieval )
488 IF( wantst .AND. info.EQ.0 )
THEN
490 CALL dlascl(
'G', 0, 0, cscale, anrm, n, 1, wr, n, ierr )
491 CALL dlascl(
'G', 0, 0, cscale, anrm, n, 1, wi, n, ierr )
494 bwork( i ) =
SELECT( wr( i ), wi( i ) )
504 CALL dtrsen( sense, jobvs, bwork, n, a, lda, vs, ldvs, wr,
506 $ sdim, rconde, rcondv, work( iwrk ), lwork-iwrk+1,
507 $ iwork, liwork, icond )
509 $ maxwrk = max( maxwrk, n+2*sdim*( n-sdim ) )
510 IF( icond.EQ.-15 )
THEN
515 ELSE IF( icond.EQ.-17 )
THEN
520 ELSE IF( icond.GT.0 )
THEN
533 CALL dgebak(
'P',
'R', n, ilo, ihi, work( ibal ), n, vs,
542 CALL dlascl(
'H', 0, 0, cscale, anrm, n, n, a, lda, ierr )
543 CALL dcopy( n, a, lda+1, wr, 1 )
544 IF( ( wantsv .OR. wantsb ) .AND. info.EQ.0 )
THEN
546 CALL dlascl(
'G', 0, 0, cscale, anrm, 1, 1, dum, 1,
550 IF( cscale.EQ.smlnum )
THEN
556 IF( ieval.GT.0 )
THEN
559 CALL dlascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, wi, n,
561 ELSE IF( wantst )
THEN
572 IF( wi( i ).EQ.zero )
THEN
575 IF( a( i+1, i ).EQ.zero )
THEN
578 ELSE IF( a( i+1, i ).NE.zero .AND. a( i, i+1 ).EQ.
583 $
CALL dswap( i-1, a( 1, i ), 1, a( 1, i+1 ),
586 $
CALL dswap( n-i-1, a( i, i+2 ), lda,
587 $ a( i+1, i+2 ), lda )
589 CALL dswap( n, vs( 1, i ), 1, vs( 1, i+1 ),
592 a( i, i+1 ) = a( i+1, i )
599 CALL dlascl(
'G', 0, 0, cscale, anrm, n-ieval, 1,
600 $ wi( ieval+1 ), max( n-ieval, 1 ), ierr )
603 IF( wantst .AND. info.EQ.0 )
THEN
612 cursl =
SELECT( wr( i ), wi( i ) )
613 IF( wi( i ).EQ.zero )
THEN
617 IF( cursl .AND. .NOT.lastsl )
624 cursl = cursl .OR. lastsl
629 IF( cursl .AND. .NOT.lst2sl )
644 IF( wantsv .OR. wantsb )
THEN
645 iwork( 1 ) = max( 1, sdim*( n-sdim ) )