197 SUBROUTINE zgees( 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
211 DOUBLE PRECISION RWORK( * )
212 COMPLEX*16 A( lda, * ), VS( ldvs, * ), W( * ), WORK( * )
222 DOUBLE PRECISION ZERO, ONE
223 parameter ( zero = 0.0d0, one = 1.0d0 )
226 LOGICAL LQUERY, SCALEA, WANTST, WANTVS
227 INTEGER HSWORK, I, IBAL, ICOND, IERR, IEVAL, IHI, ILO,
228 $ itau, iwrk, maxwrk, minwrk
229 DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, S, SEP, SMLNUM
232 DOUBLE PRECISION DUM( 1 )
241 DOUBLE PRECISION DLAMCH, ZLANGE
242 EXTERNAL lsame, ilaenv, dlamch, zlange
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,
'ZGEHRD',
' ', n, 1, n, 0 )
286 CALL zhseqr(
'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,
'ZUNGHR',
294 $
' ', n, 1, n, -1 ) )
295 maxwrk = max( maxwrk, hswork )
300 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
306 CALL xerbla(
'ZGEES ', -info )
308 ELSE IF( lquery )
THEN
322 smlnum = dlamch(
'S' )
323 bignum = one / smlnum
324 CALL dlabad( smlnum, bignum )
325 smlnum = sqrt( smlnum ) / eps
326 bignum = one / smlnum
330 anrm = zlange(
'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 zlascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
347 CALL zgebal(
'P', n, a, lda, ilo, ihi, rwork( ibal ), ierr )
355 CALL zgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
356 $ lwork-iwrk+1, ierr )
362 CALL zlacpy(
'L', n, n, a, lda, vs, ldvs )
368 CALL zunghr( n, ilo, ihi, vs, ldvs, work( itau ), work( iwrk ),
369 $ lwork-iwrk+1, ierr )
379 CALL zhseqr(
'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 zlascl(
'G', 0, 0, cscale, anrm, n, 1, w, n, ierr )
390 bwork( i ) =
SELECT( w( i ) )
397 CALL ztrsen(
'N', jobvs, bwork, n, a, lda, vs, ldvs, w, sdim,
398 $ s, sep, work( iwrk ), lwork-iwrk+1, icond )
407 CALL zgebak(
'P',
'R', n, ilo, ihi, rwork( ibal ), n, vs, ldvs,
415 CALL zlascl(
'U', 0, 0, cscale, anrm, n, n, a, lda, ierr )
416 CALL zcopy( n, a, lda+1, w, 1 )
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK
subroutine zgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, LDVS, WORK, LWORK, RWORK, BWORK, INFO)
ZGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
subroutine ztrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
ZTRSEN
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
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.