238 SUBROUTINE cgeesx( 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
255 COMPLEX a( lda, * ), vs( ldvs, * ), w( * ), work( * )
266 parameter( zero = 0.0e0, one = 1.0e0 )
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 REAL anrm, bignum, cscale, eps, smlnum
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,
'CGEHRD',
' ', n, 1, n, 0 )
341 CALL
chseqr(
'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,
'CUNGHR',
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(
'CGEESX', -info )
366 ELSE IF( lquery )
THEN
381 bignum = one / smlnum
382 CALL
slabad( smlnum, bignum )
383 smlnum = sqrt( smlnum ) / eps
384 bignum = one / smlnum
388 anrm =
clange(
'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
clascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
406 CALL
cgebal(
'P', n, a, lda, ilo, ihi, rwork( ibal ), ierr )
414 CALL
cgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
415 $ lwork-iwrk+1, ierr )
421 CALL
clacpy(
'L', n, n, a, lda, vs, ldvs )
427 CALL
cunghr( n, ilo, ihi, vs, ldvs, work( itau ), work( iwrk ),
428 $ lwork-iwrk+1, ierr )
438 CALL
chseqr(
'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
clascl(
'G', 0, 0, cscale, anrm, n, 1, w, n, ierr )
449 bwork( i ) =
SELECT( w( i ) )
458 CALL
ctrsen( 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
cgebak(
'P',
'R', n, ilo, ihi, rwork( ibal ), n, vs, ldvs,
485 CALL
clascl(
'U', 0, 0, cscale, anrm, n, n, a, lda, ierr )
486 CALL
ccopy( n, a, lda+1, w, 1 )
487 IF( ( wantsv .OR. wantsb ) .AND. info.EQ.0 )
THEN
489 CALL
slascl(
'G', 0, 0, cscale, anrm, 1, 1, dum, 1, ierr )
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine ctrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
CTRSEN
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine cgeesx(JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, BWORK, INFO)
CGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE...
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 clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR
real function slamch(CMACH)
SLAMCH
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine cgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CGEHRD
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine cgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
CGEBAK
subroutine cunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CUNGHR