238 SUBROUTINE zgeesx( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W,
239 $ vs, ldvs, rconde, rcondv, work, lwork, rwork,
248 CHARACTER JOBVS, SENSE, SORT
249 INTEGER INFO, LDA, LDVS, LWORK, N, SDIM
250 DOUBLE PRECISION RCONDE, RCONDV
254 DOUBLE PRECISION RWORK( * )
255 COMPLEX*16 A( lda, * ), VS( ldvs, * ), W( * ), WORK( * )
265 DOUBLE PRECISION ZERO, ONE
266 parameter ( zero = 0.0d0, one = 1.0d0 )
269 LOGICAL LQUERY, SCALEA, WANTSB, WANTSE, WANTSN, WANTST,
271 INTEGER HSWORK, I, IBAL, ICOND, IERR, IEVAL, IHI, ILO,
272 $ itau, iwrk, lwrk, maxwrk, minwrk
273 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SMLNUM
276 DOUBLE PRECISION DUM( 1 )
285 DOUBLE PRECISION DLAMCH, ZLANGE
286 EXTERNAL lsame, ilaenv, dlamch, zlange
296 wantvs = lsame( jobvs,
'V' )
297 wantst = lsame( sort,
'S' )
298 wantsn = lsame( sense,
'N' )
299 wantse = lsame( sense,
'E' )
300 wantsv = lsame( sense,
'V' )
301 wantsb = lsame( sense,
'B' )
302 lquery = ( lwork.EQ.-1 )
304 IF( ( .NOT.wantvs ) .AND. ( .NOT.lsame( jobvs,
'N' ) ) )
THEN
306 ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.lsame( sort,
'N' ) ) )
THEN
308 ELSE IF( .NOT.( wantsn .OR. wantse .OR. wantsv .OR. wantsb ) .OR.
309 $ ( .NOT.wantst .AND. .NOT.wantsn ) )
THEN
311 ELSE IF( n.LT.0 )
THEN
313 ELSE IF( lda.LT.max( 1, n ) )
THEN
315 ELSE IF( ldvs.LT.1 .OR. ( wantvs .AND. ldvs.LT.n ) )
THEN
338 maxwrk = n + n*ilaenv( 1,
'ZGEHRD',
' ', n, 1, n, 0 )
341 CALL zhseqr(
'S', jobvs, n, 1, n, a, lda, w, vs, ldvs,
345 IF( .NOT.wantvs )
THEN
346 maxwrk = max( maxwrk, hswork )
348 maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1,
'ZUNGHR',
349 $
' ', n, 1, n, -1 ) )
350 maxwrk = max( maxwrk, hswork )
354 $ lwrk = max( lwrk, ( n*n )/2 )
358 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
364 CALL xerbla(
'ZGEESX', -info )
366 ELSE IF( lquery )
THEN
380 smlnum = dlamch(
'S' )
381 bignum = one / smlnum
382 CALL dlabad( smlnum, bignum )
383 smlnum = sqrt( smlnum ) / eps
384 bignum = one / smlnum
388 anrm = zlange(
'M', n, n, a, lda, dum )
390 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
393 ELSE IF( anrm.GT.bignum )
THEN
398 $
CALL zlascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
406 CALL zgebal(
'P', n, a, lda, ilo, ihi, rwork( ibal ), ierr )
414 CALL zgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
415 $ lwork-iwrk+1, ierr )
421 CALL zlacpy(
'L', n, n, a, lda, vs, ldvs )
427 CALL zunghr( n, ilo, ihi, vs, ldvs, work( itau ), work( iwrk ),
428 $ lwork-iwrk+1, ierr )
438 CALL zhseqr(
'S', jobvs, n, ilo, ihi, a, lda, w, vs, ldvs,
439 $ work( iwrk ), lwork-iwrk+1, ieval )
445 IF( wantst .AND. info.EQ.0 )
THEN
447 $
CALL zlascl(
'G', 0, 0, cscale, anrm, n, 1, w, n, ierr )
449 bwork( i ) =
SELECT( w( i ) )
458 CALL ztrsen( sense, jobvs, bwork, n, a, lda, vs, ldvs, w, sdim,
459 $ rconde, rcondv, work( iwrk ), lwork-iwrk+1,
462 $ maxwrk = max( maxwrk, 2*sdim*( n-sdim ) )
463 IF( icond.EQ.-14 )
THEN
477 CALL zgebak(
'P',
'R', n, ilo, ihi, rwork( ibal ), n, vs, ldvs,
485 CALL zlascl(
'U', 0, 0, cscale, anrm, n, n, a, lda, ierr )
486 CALL zcopy( n, a, lda+1, w, 1 )
487 IF( ( wantsv .OR. wantsb ) .AND. info.EQ.0 )
THEN
489 CALL dlascl(
'G', 0, 0, cscale, anrm, 1, 1, dum, 1, ierr )
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
subroutine ztrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
ZTRSEN
subroutine zgeesx(JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, BWORK, INFO)
ZGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE...