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
286 EXTERNAL lsame, ilaenv, clange, slamch
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
380 smlnum = slamch(
'S' )
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 )
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR
subroutine cgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
CGEBAK
subroutine ctrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
CTRSEN
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 xerbla(SRNAME, INFO)
XERBLA
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 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 clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CGEHRD
subroutine cunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CUNGHR