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 zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
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 zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ztrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
ZTRSEN
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
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.
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK