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 )
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
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 )
LOGICAL function lsame(CA, CB)
LSAME
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
DOUBLE PRECISION function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ztrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
ZTRSEN
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 dlabad(SMALL, LARGE)
DLABAD
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
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 zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK
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...