197 SUBROUTINE cgees( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS,
198 $ ldvs, work, lwork, rwork, bwork, info )
206 CHARACTER jobvs, sort
207 INTEGER info, lda, ldvs, lwork, n, sdim
212 COMPLEX a( lda, * ), vs( ldvs, * ), w( * ), work( * )
223 parameter( zero = 0.0e0, one = 1.0e0 )
226 LOGICAL lquery, scalea, wantst, wantvs
227 INTEGER hswork, i, ibal, icond, ierr, ieval, ihi, ilo,
228 $ itau, iwrk, maxwrk, minwrk
229 REAL anrm, bignum, cscale, eps, s, sep, smlnum
252 lquery = ( lwork.EQ.-1 )
253 wantvs =
lsame( jobvs,
'V' )
254 wantst =
lsame( sort,
'S' )
255 IF( ( .NOT.wantvs ) .AND. ( .NOT.
lsame( jobvs,
'N' ) ) )
THEN
257 ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.
lsame( sort,
'N' ) ) )
THEN
259 ELSE IF( n.LT.0 )
THEN
261 ELSE IF( lda.LT.max( 1, n ) )
THEN
263 ELSE IF( ldvs.LT.1 .OR. ( wantvs .AND. ldvs.LT.n ) )
THEN
283 maxwrk = n + n*
ilaenv( 1,
'CGEHRD',
' ', n, 1, n, 0 )
286 CALL
chseqr(
'S', jobvs, n, 1, n, a, lda, w, vs, ldvs,
290 IF( .NOT.wantvs )
THEN
291 maxwrk = max( maxwrk, hswork )
293 maxwrk = max( maxwrk, n + ( n - 1 )*
ilaenv( 1,
'CUNGHR',
294 $
' ', n, 1, n, -1 ) )
295 maxwrk = max( maxwrk, hswork )
300 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
306 CALL
xerbla(
'CGEES ', -info )
308 ELSE IF( lquery )
THEN
323 bignum = one / smlnum
324 CALL
slabad( smlnum, bignum )
325 smlnum = sqrt( smlnum ) / eps
326 bignum = one / smlnum
330 anrm =
clange(
'M', n, n, a, lda, dum )
332 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
335 ELSE IF( anrm.GT.bignum )
THEN
340 $ CALL
clascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
347 CALL
cgebal(
'P', n, a, lda, ilo, ihi, rwork( ibal ), ierr )
355 CALL
cgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
356 $ lwork-iwrk+1, ierr )
362 CALL
clacpy(
'L', n, n, a, lda, vs, ldvs )
368 CALL
cunghr( n, ilo, ihi, vs, ldvs, work( itau ), work( iwrk ),
369 $ lwork-iwrk+1, ierr )
379 CALL
chseqr(
'S', jobvs, n, ilo, ihi, a, lda, w, vs, ldvs,
380 $ work( iwrk ), lwork-iwrk+1, ieval )
386 IF( wantst .AND. info.EQ.0 )
THEN
388 $ CALL
clascl(
'G', 0, 0, cscale, anrm, n, 1, w, n, ierr )
390 bwork( i ) =
SELECT( w( i ) )
397 CALL
ctrsen(
'N', jobvs, bwork, n, a, lda, vs, ldvs, w, sdim,
398 $ s, sep, work( iwrk ), lwork-iwrk+1, icond )
407 CALL
cgebak(
'P',
'R', n, ilo, ihi, rwork( ibal ), n, vs, ldvs,
415 CALL
clascl(
'U', 0, 0, cscale, anrm, n, n, a, lda, ierr )
416 CALL
ccopy( n, a, lda+1, w, 1 )
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
subroutine cgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, LDVS, WORK, LWORK, RWORK, BWORK, INFO)
CGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
logical function lsame(CA, CB)
LSAME
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