234 SUBROUTINE cgeesx( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM,
236 $ VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK,
244 CHARACTER JOBVS, SENSE, SORT
245 INTEGER INFO, LDA, LDVS, LWORK, N, SDIM
251 COMPLEX A( LDA, * ), VS( LDVS, * ), W( * ), WORK( * )
262 PARAMETER ( ZERO = 0.0e0, one = 1.0e0 )
265 LOGICAL LQUERY, SCALEA, WANTSB, WANTSE, WANTSN, WANTST,
267 INTEGER HSWORK, I, IBAL, ICOND, IERR, IEVAL, IHI, ILO,
268 $ itau, iwrk, lwrk, maxwrk, minwrk
269 REAL ANRM, BIGNUM, CSCALE, EPS, SMLNUM
282 REAL CLANGE, SLAMCH, SROUNDUP_LWORK
283 EXTERNAL lsame, ilaenv, clange, slamch,
294 wantvs = lsame( jobvs,
'V' )
295 wantst = lsame( sort,
'S' )
296 wantsn = lsame( sense,
'N' )
297 wantse = lsame( sense,
'E' )
298 wantsv = lsame( sense,
'V' )
299 wantsb = lsame( sense,
'B' )
300 lquery = ( lwork.EQ.-1 )
302 IF( ( .NOT.wantvs ) .AND. ( .NOT.lsame( jobvs,
'N' ) ) )
THEN
304 ELSE IF( ( .NOT.wantst ) .AND.
305 $ ( .NOT.lsame( sort,
'N' ) ) )
THEN
307 ELSE IF( .NOT.( wantsn .OR. wantse .OR. wantsv .OR. wantsb ) .OR.
308 $ ( .NOT.wantst .AND. .NOT.wantsn ) )
THEN
310 ELSE IF( n.LT.0 )
THEN
312 ELSE IF( lda.LT.max( 1, n ) )
THEN
314 ELSE IF( ldvs.LT.1 .OR. ( wantvs .AND. ldvs.LT.n ) )
THEN
337 maxwrk = n + n*ilaenv( 1,
'CGEHRD',
' ', n, 1, n, 0 )
340 CALL chseqr(
'S', jobvs, n, 1, n, a, lda, w, vs, ldvs,
342 hswork = int( work( 1 ) )
344 IF( .NOT.wantvs )
THEN
345 maxwrk = max( maxwrk, hswork )
347 maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1,
349 $
' ', n, 1, n, -1 ) )
350 maxwrk = max( maxwrk, hswork )
354 $ lwrk = max( lwrk, ( n*n )/2 )
356 work( 1 ) = sroundup_lwork(lwrk)
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 smlnum = sqrt( smlnum ) / eps
383 bignum = one / smlnum
387 anrm = clange(
'M', n, n, a, lda, dum )
389 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
392 ELSE IF( anrm.GT.bignum )
THEN
397 $
CALL clascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
405 CALL cgebal(
'P', n, a, lda, ilo, ihi, rwork( ibal ), ierr )
413 CALL cgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
414 $ lwork-iwrk+1, ierr )
420 CALL clacpy(
'L', n, n, a, lda, vs, ldvs )
426 CALL cunghr( n, ilo, ihi, vs, ldvs, work( itau ),
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,
460 $ rconde, rcondv, work( iwrk ), lwork-iwrk+1,
463 $ maxwrk = max( maxwrk, 2*sdim*( n-sdim ) )
464 IF( icond.EQ.-14 )
THEN
478 CALL cgebak(
'P',
'R', n, ilo, ihi, rwork( ibal ), n, vs,
487 CALL clascl(
'U', 0, 0, cscale, anrm, n, n, a, lda, ierr )
488 CALL ccopy( n, a, lda+1, w, 1 )
489 IF( ( wantsv .OR. wantsb ) .AND. info.EQ.0 )
THEN
491 CALL slascl(
'G', 0, 0, cscale, anrm, 1, 1, dum, 1,
497 work( 1 ) = sroundup_lwork(maxwrk)
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 ...