LAPACK  3.6.0
LAPACK: Linear Algebra PACKage
Collaboration diagram for double:

Functions

subroutine dgegs (JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, INFO)
  DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 
subroutine dgegv (JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
  DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 
subroutine dgees (JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, VS, LDVS, WORK, LWORK, BWORK, INFO)
  DGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices More...
 
subroutine dgeesx (JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, IWORK, LIWORK, BWORK, INFO)
  DGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices More...
 
subroutine dgeev (JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
  DGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 
subroutine dgeevx (BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, IWORK, INFO)
  DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 
subroutine dgges (JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, BWORK, INFO)
  DGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices More...
 
subroutine dgges3 (JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, BWORK, INFO)
  DGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices (blocked algorithm) More...
 
subroutine dggesx (JOBVSL, JOBVSR, SORT, SELCTG, SENSE, N, A, LDA, B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, RCONDE, RCONDV, WORK, LWORK, IWORK, LIWORK, BWORK, INFO)
  DGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices More...
 
subroutine dggev (JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
  DGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 
subroutine dggev3 (JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
  DGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm) More...
 
subroutine dggevx (BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, WORK, LWORK, IWORK, BWORK, INFO)
  DGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 

Detailed Description

This is the group of double eigenvalue driver functions for GE matrices

Function Documentation

subroutine dgees ( character  JOBVS,
character  SORT,
external  SELECT,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
integer  SDIM,
double precision, dimension( * )  WR,
double precision, dimension( * )  WI,
double precision, dimension( ldvs, * )  VS,
integer  LDVS,
double precision, dimension( * )  WORK,
integer  LWORK,
logical, dimension( * )  BWORK,
integer  INFO 
)

DGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices

Download DGEES + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DGEES computes for an N-by-N real nonsymmetric matrix A, the
 eigenvalues, the real Schur form T, and, optionally, the matrix of
 Schur vectors Z.  This gives the Schur factorization A = Z*T*(Z**T).

 Optionally, it also orders the eigenvalues on the diagonal of the
 real Schur form so that selected eigenvalues are at the top left.
 The leading columns of Z then form an orthonormal basis for the
 invariant subspace corresponding to the selected eigenvalues.

 A matrix is in real Schur form if it is upper quasi-triangular with
 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in the
 form
         [  a  b  ]
         [  c  a  ]

 where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
Parameters
[in]JOBVS
          JOBVS is CHARACTER*1
          = 'N': Schur vectors are not computed;
          = 'V': Schur vectors are computed.
[in]SORT
          SORT is CHARACTER*1
          Specifies whether or not to order the eigenvalues on the
          diagonal of the Schur form.
          = 'N': Eigenvalues are not ordered;
          = 'S': Eigenvalues are ordered (see SELECT).
[in]SELECT
          SELECT is a LOGICAL FUNCTION of two DOUBLE PRECISION arguments
          SELECT must be declared EXTERNAL in the calling subroutine.
          If SORT = 'S', SELECT is used to select eigenvalues to sort
          to the top left of the Schur form.
          If SORT = 'N', SELECT is not referenced.
          An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
          SELECT(WR(j),WI(j)) is true; i.e., if either one of a complex
          conjugate pair of eigenvalues is selected, then both complex
          eigenvalues are selected.
          Note that a selected complex eigenvalue may no longer
          satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
          ordering may change the value of complex eigenvalues
          (especially if the eigenvalue is ill-conditioned); in this
          case INFO is set to N+2 (see INFO below).
[in]N
          N is INTEGER
          The order of the matrix A. N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA,N)
          On entry, the N-by-N matrix A.
          On exit, A has been overwritten by its real Schur form T.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[out]SDIM
          SDIM is INTEGER
          If SORT = 'N', SDIM = 0.
          If SORT = 'S', SDIM = number of eigenvalues (after sorting)
                         for which SELECT is true. (Complex conjugate
                         pairs for which SELECT is true for either
                         eigenvalue count as 2.)
[out]WR
          WR is DOUBLE PRECISION array, dimension (N)
[out]WI
          WI is DOUBLE PRECISION array, dimension (N)
          WR and WI contain the real and imaginary parts,
          respectively, of the computed eigenvalues in the same order
          that they appear on the diagonal of the output Schur form T.
          Complex conjugate pairs of eigenvalues will appear
          consecutively with the eigenvalue having the positive
          imaginary part first.
[out]VS
          VS is DOUBLE PRECISION array, dimension (LDVS,N)
          If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
          vectors.
          If JOBVS = 'N', VS is not referenced.
[in]LDVS
          LDVS is INTEGER
          The leading dimension of the array VS.  LDVS >= 1; if
          JOBVS = 'V', LDVS >= N.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) contains the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.  LWORK >= max(1,3*N).
          For good performance, LWORK must generally be larger.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]BWORK
          BWORK is LOGICAL array, dimension (N)
          Not referenced if SORT = 'N'.
[out]INFO
          INFO is INTEGER
          = 0: successful exit
          < 0: if INFO = -i, the i-th argument had an illegal value.
          > 0: if INFO = i, and i is
             <= N: the QR algorithm failed to compute all the
                   eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
                   contain those eigenvalues which have converged; if
                   JOBVS = 'V', VS contains the matrix which reduces A
                   to its partially converged Schur form.
             = N+1: the eigenvalues could not be reordered because some
                   eigenvalues were too close to separate (the problem
                   is very ill-conditioned);
             = N+2: after reordering, roundoff changed values of some
                   complex eigenvalues so that leading eigenvalues in
                   the Schur form no longer satisfy SELECT=.TRUE.  This
                   could also be caused by underflow due to scaling.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 218 of file dgees.f.

218 *
219 * -- LAPACK driver routine (version 3.4.0) --
220 * -- LAPACK is a software package provided by Univ. of Tennessee, --
221 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
222 * November 2011
223 *
224 * .. Scalar Arguments ..
225  CHARACTER jobvs, sort
226  INTEGER info, lda, ldvs, lwork, n, sdim
227 * ..
228 * .. Array Arguments ..
229  LOGICAL bwork( * )
230  DOUBLE PRECISION a( lda, * ), vs( ldvs, * ), wi( * ), work( * ),
231  $ wr( * )
232 * ..
233 * .. Function Arguments ..
234  LOGICAL select
235  EXTERNAL SELECT
236 * ..
237 *
238 * =====================================================================
239 *
240 * .. Parameters ..
241  DOUBLE PRECISION zero, one
242  parameter( zero = 0.0d0, one = 1.0d0 )
243 * ..
244 * .. Local Scalars ..
245  LOGICAL cursl, lastsl, lquery, lst2sl, scalea, wantst,
246  $ wantvs
247  INTEGER hswork, i, i1, i2, ibal, icond, ierr, ieval,
248  $ ihi, ilo, inxt, ip, itau, iwrk, maxwrk, minwrk
249  DOUBLE PRECISION anrm, bignum, cscale, eps, s, sep, smlnum
250 * ..
251 * .. Local Arrays ..
252  INTEGER idum( 1 )
253  DOUBLE PRECISION dum( 1 )
254 * ..
255 * .. External Subroutines ..
256  EXTERNAL dcopy, dgebak, dgebal, dgehrd, dhseqr, dlacpy,
258 * ..
259 * .. External Functions ..
260  LOGICAL lsame
261  INTEGER ilaenv
262  DOUBLE PRECISION dlamch, dlange
263  EXTERNAL lsame, ilaenv, dlamch, dlange
264 * ..
265 * .. Intrinsic Functions ..
266  INTRINSIC max, sqrt
267 * ..
268 * .. Executable Statements ..
269 *
270 * Test the input arguments
271 *
272  info = 0
273  lquery = ( lwork.EQ.-1 )
274  wantvs = lsame( jobvs, 'V' )
275  wantst = lsame( sort, 'S' )
276  IF( ( .NOT.wantvs ) .AND. ( .NOT.lsame( jobvs, 'N' ) ) ) THEN
277  info = -1
278  ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.lsame( sort, 'N' ) ) ) THEN
279  info = -2
280  ELSE IF( n.LT.0 ) THEN
281  info = -4
282  ELSE IF( lda.LT.max( 1, n ) ) THEN
283  info = -6
284  ELSE IF( ldvs.LT.1 .OR. ( wantvs .AND. ldvs.LT.n ) ) THEN
285  info = -11
286  END IF
287 *
288 * Compute workspace
289 * (Note: Comments in the code beginning "Workspace:" describe the
290 * minimal amount of workspace needed at that point in the code,
291 * as well as the preferred amount for good performance.
292 * NB refers to the optimal block size for the immediately
293 * following subroutine, as returned by ILAENV.
294 * HSWORK refers to the workspace preferred by DHSEQR, as
295 * calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
296 * the worst case.)
297 *
298  IF( info.EQ.0 ) THEN
299  IF( n.EQ.0 ) THEN
300  minwrk = 1
301  maxwrk = 1
302  ELSE
303  maxwrk = 2*n + n*ilaenv( 1, 'DGEHRD', ' ', n, 1, n, 0 )
304  minwrk = 3*n
305 *
306  CALL dhseqr( 'S', jobvs, n, 1, n, a, lda, wr, wi, vs, ldvs,
307  $ work, -1, ieval )
308  hswork = work( 1 )
309 *
310  IF( .NOT.wantvs ) THEN
311  maxwrk = max( maxwrk, n + hswork )
312  ELSE
313  maxwrk = max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
314  $ 'DORGHR', ' ', n, 1, n, -1 ) )
315  maxwrk = max( maxwrk, n + hswork )
316  END IF
317  END IF
318  work( 1 ) = maxwrk
319 *
320  IF( lwork.LT.minwrk .AND. .NOT.lquery ) THEN
321  info = -13
322  END IF
323  END IF
324 *
325  IF( info.NE.0 ) THEN
326  CALL xerbla( 'DGEES ', -info )
327  RETURN
328  ELSE IF( lquery ) THEN
329  RETURN
330  END IF
331 *
332 * Quick return if possible
333 *
334  IF( n.EQ.0 ) THEN
335  sdim = 0
336  RETURN
337  END IF
338 *
339 * Get machine constants
340 *
341  eps = dlamch( 'P' )
342  smlnum = dlamch( 'S' )
343  bignum = one / smlnum
344  CALL dlabad( smlnum, bignum )
345  smlnum = sqrt( smlnum ) / eps
346  bignum = one / smlnum
347 *
348 * Scale A if max element outside range [SMLNUM,BIGNUM]
349 *
350  anrm = dlange( 'M', n, n, a, lda, dum )
351  scalea = .false.
352  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
353  scalea = .true.
354  cscale = smlnum
355  ELSE IF( anrm.GT.bignum ) THEN
356  scalea = .true.
357  cscale = bignum
358  END IF
359  IF( scalea )
360  $ CALL dlascl( 'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
361 *
362 * Permute the matrix to make it more nearly triangular
363 * (Workspace: need N)
364 *
365  ibal = 1
366  CALL dgebal( 'P', n, a, lda, ilo, ihi, work( ibal ), ierr )
367 *
368 * Reduce to upper Hessenberg form
369 * (Workspace: need 3*N, prefer 2*N+N*NB)
370 *
371  itau = n + ibal
372  iwrk = n + itau
373  CALL dgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
374  $ lwork-iwrk+1, ierr )
375 *
376  IF( wantvs ) THEN
377 *
378 * Copy Householder vectors to VS
379 *
380  CALL dlacpy( 'L', n, n, a, lda, vs, ldvs )
381 *
382 * Generate orthogonal matrix in VS
383 * (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
384 *
385  CALL dorghr( n, ilo, ihi, vs, ldvs, work( itau ), work( iwrk ),
386  $ lwork-iwrk+1, ierr )
387  END IF
388 *
389  sdim = 0
390 *
391 * Perform QR iteration, accumulating Schur vectors in VS if desired
392 * (Workspace: need N+1, prefer N+HSWORK (see comments) )
393 *
394  iwrk = itau
395  CALL dhseqr( 'S', jobvs, n, ilo, ihi, a, lda, wr, wi, vs, ldvs,
396  $ work( iwrk ), lwork-iwrk+1, ieval )
397  IF( ieval.GT.0 )
398  $ info = ieval
399 *
400 * Sort eigenvalues if desired
401 *
402  IF( wantst .AND. info.EQ.0 ) THEN
403  IF( scalea ) THEN
404  CALL dlascl( 'G', 0, 0, cscale, anrm, n, 1, wr, n, ierr )
405  CALL dlascl( 'G', 0, 0, cscale, anrm, n, 1, wi, n, ierr )
406  END IF
407  DO 10 i = 1, n
408  bwork( i ) = SELECT( wr( i ), wi( i ) )
409  10 CONTINUE
410 *
411 * Reorder eigenvalues and transform Schur vectors
412 * (Workspace: none needed)
413 *
414  CALL dtrsen( 'N', jobvs, bwork, n, a, lda, vs, ldvs, wr, wi,
415  $ sdim, s, sep, work( iwrk ), lwork-iwrk+1, idum, 1,
416  $ icond )
417  IF( icond.GT.0 )
418  $ info = n + icond
419  END IF
420 *
421  IF( wantvs ) THEN
422 *
423 * Undo balancing
424 * (Workspace: need N)
425 *
426  CALL dgebak( 'P', 'R', n, ilo, ihi, work( ibal ), n, vs, ldvs,
427  $ ierr )
428  END IF
429 *
430  IF( scalea ) THEN
431 *
432 * Undo scaling for the Schur form of A
433 *
434  CALL dlascl( 'H', 0, 0, cscale, anrm, n, n, a, lda, ierr )
435  CALL dcopy( n, a, lda+1, wr, 1 )
436  IF( cscale.EQ.smlnum ) THEN
437 *
438 * If scaling back towards underflow, adjust WI if an
439 * offdiagonal element of a 2-by-2 block in the Schur form
440 * underflows.
441 *
442  IF( ieval.GT.0 ) THEN
443  i1 = ieval + 1
444  i2 = ihi - 1
445  CALL dlascl( 'G', 0, 0, cscale, anrm, ilo-1, 1, wi,
446  $ max( ilo-1, 1 ), ierr )
447  ELSE IF( wantst ) THEN
448  i1 = 1
449  i2 = n - 1
450  ELSE
451  i1 = ilo
452  i2 = ihi - 1
453  END IF
454  inxt = i1 - 1
455  DO 20 i = i1, i2
456  IF( i.LT.inxt )
457  $ GO TO 20
458  IF( wi( i ).EQ.zero ) THEN
459  inxt = i + 1
460  ELSE
461  IF( a( i+1, i ).EQ.zero ) THEN
462  wi( i ) = zero
463  wi( i+1 ) = zero
464  ELSE IF( a( i+1, i ).NE.zero .AND. a( i, i+1 ).EQ.
465  $ zero ) THEN
466  wi( i ) = zero
467  wi( i+1 ) = zero
468  IF( i.GT.1 )
469  $ CALL dswap( i-1, a( 1, i ), 1, a( 1, i+1 ), 1 )
470  IF( n.GT.i+1 )
471  $ CALL dswap( n-i-1, a( i, i+2 ), lda,
472  $ a( i+1, i+2 ), lda )
473  IF( wantvs ) THEN
474  CALL dswap( n, vs( 1, i ), 1, vs( 1, i+1 ), 1 )
475  END IF
476  a( i, i+1 ) = a( i+1, i )
477  a( i+1, i ) = zero
478  END IF
479  inxt = i + 2
480  END IF
481  20 CONTINUE
482  END IF
483 *
484 * Undo scaling for the imaginary part of the eigenvalues
485 *
486  CALL dlascl( 'G', 0, 0, cscale, anrm, n-ieval, 1,
487  $ wi( ieval+1 ), max( n-ieval, 1 ), ierr )
488  END IF
489 *
490  IF( wantst .AND. info.EQ.0 ) THEN
491 *
492 * Check if reordering successful
493 *
494  lastsl = .true.
495  lst2sl = .true.
496  sdim = 0
497  ip = 0
498  DO 30 i = 1, n
499  cursl = SELECT( wr( i ), wi( i ) )
500  IF( wi( i ).EQ.zero ) THEN
501  IF( cursl )
502  $ sdim = sdim + 1
503  ip = 0
504  IF( cursl .AND. .NOT.lastsl )
505  $ info = n + 2
506  ELSE
507  IF( ip.EQ.1 ) THEN
508 *
509 * Last eigenvalue of conjugate pair
510 *
511  cursl = cursl .OR. lastsl
512  lastsl = cursl
513  IF( cursl )
514  $ sdim = sdim + 2
515  ip = -1
516  IF( cursl .AND. .NOT.lst2sl )
517  $ info = n + 2
518  ELSE
519 *
520 * First eigenvalue of conjugate pair
521 *
522  ip = 1
523  END IF
524  END IF
525  lst2sl = lastsl
526  lastsl = cursl
527  30 CONTINUE
528  END IF
529 *
530  work( 1 ) = maxwrk
531  RETURN
532 *
533 * End of DGEES
534 *
subroutine dhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
DHSEQR
Definition: dhseqr.f:318
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL
Definition: dgebal.f:162
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
Definition: dswap.f:53
subroutine dtrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
DTRSEN
Definition: dtrsen.f:315
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DGEHRD
Definition: dgehrd.f:169
subroutine dgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
DGEBAK
Definition: dgebak.f:132
subroutine dorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DORGHR
Definition: dorghr.f:128
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
Definition: dcopy.f:53

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine dgeesx ( character  JOBVS,
character  SORT,
external  SELECT,
character  SENSE,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
integer  SDIM,
double precision, dimension( * )  WR,
double precision, dimension( * )  WI,
double precision, dimension( ldvs, * )  VS,
integer  LDVS,
double precision  RCONDE,
double precision  RCONDV,
double precision, dimension( * )  WORK,
integer  LWORK,
integer, dimension( * )  IWORK,
integer  LIWORK,
logical, dimension( * )  BWORK,
integer  INFO 
)

DGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices

Download DGEESX + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DGEESX computes for an N-by-N real nonsymmetric matrix A, the
 eigenvalues, the real Schur form T, and, optionally, the matrix of
 Schur vectors Z.  This gives the Schur factorization A = Z*T*(Z**T).

 Optionally, it also orders the eigenvalues on the diagonal of the
 real Schur form so that selected eigenvalues are at the top left;
 computes a reciprocal condition number for the average of the
 selected eigenvalues (RCONDE); and computes a reciprocal condition
 number for the right invariant subspace corresponding to the
 selected eigenvalues (RCONDV).  The leading columns of Z form an
 orthonormal basis for this invariant subspace.

 For further explanation of the reciprocal condition numbers RCONDE
 and RCONDV, see Section 4.10 of the LAPACK Users' Guide (where
 these quantities are called s and sep respectively).

 A real matrix is in real Schur form if it is upper quasi-triangular
 with 1-by-1 and 2-by-2 blocks. 2-by-2 blocks will be standardized in
 the form
           [  a  b  ]
           [  c  a  ]

 where b*c < 0. The eigenvalues of such a block are a +- sqrt(bc).
Parameters
[in]JOBVS
          JOBVS is CHARACTER*1
          = 'N': Schur vectors are not computed;
          = 'V': Schur vectors are computed.
[in]SORT
          SORT is CHARACTER*1
          Specifies whether or not to order the eigenvalues on the
          diagonal of the Schur form.
          = 'N': Eigenvalues are not ordered;
          = 'S': Eigenvalues are ordered (see SELECT).
[in]SELECT
          SELECT is procedure) LOGICAL FUNCTION of two DOUBLE PRECISION arguments
          SELECT must be declared EXTERNAL in the calling subroutine.
          If SORT = 'S', SELECT is used to select eigenvalues to sort
          to the top left of the Schur form.
          If SORT = 'N', SELECT is not referenced.
          An eigenvalue WR(j)+sqrt(-1)*WI(j) is selected if
          SELECT(WR(j),WI(j)) is true; i.e., if either one of a
          complex conjugate pair of eigenvalues is selected, then both
          are.  Note that a selected complex eigenvalue may no longer
          satisfy SELECT(WR(j),WI(j)) = .TRUE. after ordering, since
          ordering may change the value of complex eigenvalues
          (especially if the eigenvalue is ill-conditioned); in this
          case INFO may be set to N+3 (see INFO below).
[in]SENSE
          SENSE is CHARACTER*1
          Determines which reciprocal condition numbers are computed.
          = 'N': None are computed;
          = 'E': Computed for average of selected eigenvalues only;
          = 'V': Computed for selected right invariant subspace only;
          = 'B': Computed for both.
          If SENSE = 'E', 'V' or 'B', SORT must equal 'S'.
[in]N
          N is INTEGER
          The order of the matrix A. N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA, N)
          On entry, the N-by-N matrix A.
          On exit, A is overwritten by its real Schur form T.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[out]SDIM
          SDIM is INTEGER
          If SORT = 'N', SDIM = 0.
          If SORT = 'S', SDIM = number of eigenvalues (after sorting)
                         for which SELECT is true. (Complex conjugate
                         pairs for which SELECT is true for either
                         eigenvalue count as 2.)
[out]WR
          WR is DOUBLE PRECISION array, dimension (N)
[out]WI
          WI is DOUBLE PRECISION array, dimension (N)
          WR and WI contain the real and imaginary parts, respectively,
          of the computed eigenvalues, in the same order that they
          appear on the diagonal of the output Schur form T.  Complex
          conjugate pairs of eigenvalues appear consecutively with the
          eigenvalue having the positive imaginary part first.
[out]VS
          VS is DOUBLE PRECISION array, dimension (LDVS,N)
          If JOBVS = 'V', VS contains the orthogonal matrix Z of Schur
          vectors.
          If JOBVS = 'N', VS is not referenced.
[in]LDVS
          LDVS is INTEGER
          The leading dimension of the array VS.  LDVS >= 1, and if
          JOBVS = 'V', LDVS >= N.
[out]RCONDE
          RCONDE is DOUBLE PRECISION
          If SENSE = 'E' or 'B', RCONDE contains the reciprocal
          condition number for the average of the selected eigenvalues.
          Not referenced if SENSE = 'N' or 'V'.
[out]RCONDV
          RCONDV is DOUBLE PRECISION
          If SENSE = 'V' or 'B', RCONDV contains the reciprocal
          condition number for the selected right invariant subspace.
          Not referenced if SENSE = 'N' or 'E'.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.  LWORK >= max(1,3*N).
          Also, if SENSE = 'E' or 'V' or 'B',
          LWORK >= N+2*SDIM*(N-SDIM), where SDIM is the number of
          selected eigenvalues computed by this routine.  Note that
          N+2*SDIM*(N-SDIM) <= N+N*N/2. Note also that an error is only
          returned if LWORK < max(1,3*N), but if SENSE = 'E' or 'V' or
          'B' this may not be large enough.
          For good performance, LWORK must generally be larger.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates upper bounds on the optimal sizes of the
          arrays WORK and IWORK, returns these values as the first
          entries of the WORK and IWORK arrays, and no error messages
          related to LWORK or LIWORK are issued by XERBLA.
[out]IWORK
          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
[in]LIWORK
          LIWORK is INTEGER
          The dimension of the array IWORK.
          LIWORK >= 1; if SENSE = 'V' or 'B', LIWORK >= SDIM*(N-SDIM).
          Note that SDIM*(N-SDIM) <= N*N/4. Note also that an error is
          only returned if LIWORK < 1, but if SENSE = 'V' or 'B' this
          may not be large enough.

          If LIWORK = -1, then a workspace query is assumed; the
          routine only calculates upper bounds on the optimal sizes of
          the arrays WORK and IWORK, returns these values as the first
          entries of the WORK and IWORK arrays, and no error messages
          related to LWORK or LIWORK are issued by XERBLA.
[out]BWORK
          BWORK is LOGICAL array, dimension (N)
          Not referenced if SORT = 'N'.
[out]INFO
          INFO is INTEGER
          = 0: successful exit
          < 0: if INFO = -i, the i-th argument had an illegal value.
          > 0: if INFO = i, and i is
             <= N: the QR algorithm failed to compute all the
                   eigenvalues; elements 1:ILO-1 and i+1:N of WR and WI
                   contain those eigenvalues which have converged; if
                   JOBVS = 'V', VS contains the transformation which
                   reduces A to its partially converged Schur form.
             = N+1: the eigenvalues could not be reordered because some
                   eigenvalues were too close to separate (the problem
                   is very ill-conditioned);
             = N+2: after reordering, roundoff changed values of some
                   complex eigenvalues so that leading eigenvalues in
                   the Schur form no longer satisfy SELECT=.TRUE.  This
                   could also be caused by underflow due to scaling.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 283 of file dgeesx.f.

283 *
284 * -- LAPACK driver routine (version 3.4.0) --
285 * -- LAPACK is a software package provided by Univ. of Tennessee, --
286 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
287 * November 2011
288 *
289 * .. Scalar Arguments ..
290  CHARACTER jobvs, sense, sort
291  INTEGER info, lda, ldvs, liwork, lwork, n, sdim
292  DOUBLE PRECISION rconde, rcondv
293 * ..
294 * .. Array Arguments ..
295  LOGICAL bwork( * )
296  INTEGER iwork( * )
297  DOUBLE PRECISION a( lda, * ), vs( ldvs, * ), wi( * ), work( * ),
298  $ wr( * )
299 * ..
300 * .. Function Arguments ..
301  LOGICAL select
302  EXTERNAL SELECT
303 * ..
304 *
305 * =====================================================================
306 *
307 * .. Parameters ..
308  DOUBLE PRECISION zero, one
309  parameter( zero = 0.0d0, one = 1.0d0 )
310 * ..
311 * .. Local Scalars ..
312  LOGICAL cursl, lastsl, lquery, lst2sl, scalea, wantsb,
313  $ wantse, wantsn, wantst, wantsv, wantvs
314  INTEGER hswork, i, i1, i2, ibal, icond, ierr, ieval,
315  $ ihi, ilo, inxt, ip, itau, iwrk, liwrk, lwrk,
316  $ maxwrk, minwrk
317  DOUBLE PRECISION anrm, bignum, cscale, eps, smlnum
318 * ..
319 * .. Local Arrays ..
320  DOUBLE PRECISION dum( 1 )
321 * ..
322 * .. External Subroutines ..
323  EXTERNAL dcopy, dgebak, dgebal, dgehrd, dhseqr, dlacpy,
325 * ..
326 * .. External Functions ..
327  LOGICAL lsame
328  INTEGER ilaenv
329  DOUBLE PRECISION dlamch, dlange
330  EXTERNAL lsame, ilaenv, dlabad, dlamch, dlange
331 * ..
332 * .. Intrinsic Functions ..
333  INTRINSIC max, sqrt
334 * ..
335 * .. Executable Statements ..
336 *
337 * Test the input arguments
338 *
339  info = 0
340  wantvs = lsame( jobvs, 'V' )
341  wantst = lsame( sort, 'S' )
342  wantsn = lsame( sense, 'N' )
343  wantse = lsame( sense, 'E' )
344  wantsv = lsame( sense, 'V' )
345  wantsb = lsame( sense, 'B' )
346  lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
347 *
348  IF( ( .NOT.wantvs ) .AND. ( .NOT.lsame( jobvs, 'N' ) ) ) THEN
349  info = -1
350  ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.lsame( sort, 'N' ) ) ) THEN
351  info = -2
352  ELSE IF( .NOT.( wantsn .OR. wantse .OR. wantsv .OR. wantsb ) .OR.
353  $ ( .NOT.wantst .AND. .NOT.wantsn ) ) THEN
354  info = -4
355  ELSE IF( n.LT.0 ) THEN
356  info = -5
357  ELSE IF( lda.LT.max( 1, n ) ) THEN
358  info = -7
359  ELSE IF( ldvs.LT.1 .OR. ( wantvs .AND. ldvs.LT.n ) ) THEN
360  info = -12
361  END IF
362 *
363 * Compute workspace
364 * (Note: Comments in the code beginning "RWorkspace:" describe the
365 * minimal amount of real workspace needed at that point in the
366 * code, as well as the preferred amount for good performance.
367 * IWorkspace refers to integer workspace.
368 * NB refers to the optimal block size for the immediately
369 * following subroutine, as returned by ILAENV.
370 * HSWORK refers to the workspace preferred by DHSEQR, as
371 * calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
372 * the worst case.
373 * If SENSE = 'E', 'V' or 'B', then the amount of workspace needed
374 * depends on SDIM, which is computed by the routine DTRSEN later
375 * in the code.)
376 *
377  IF( info.EQ.0 ) THEN
378  liwrk = 1
379  IF( n.EQ.0 ) THEN
380  minwrk = 1
381  lwrk = 1
382  ELSE
383  maxwrk = 2*n + n*ilaenv( 1, 'DGEHRD', ' ', n, 1, n, 0 )
384  minwrk = 3*n
385 *
386  CALL dhseqr( 'S', jobvs, n, 1, n, a, lda, wr, wi, vs, ldvs,
387  $ work, -1, ieval )
388  hswork = work( 1 )
389 *
390  IF( .NOT.wantvs ) THEN
391  maxwrk = max( maxwrk, n + hswork )
392  ELSE
393  maxwrk = max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
394  $ 'DORGHR', ' ', n, 1, n, -1 ) )
395  maxwrk = max( maxwrk, n + hswork )
396  END IF
397  lwrk = maxwrk
398  IF( .NOT.wantsn )
399  $ lwrk = max( lwrk, n + ( n*n )/2 )
400  IF( wantsv .OR. wantsb )
401  $ liwrk = ( n*n )/4
402  END IF
403  iwork( 1 ) = liwrk
404  work( 1 ) = lwrk
405 *
406  IF( lwork.LT.minwrk .AND. .NOT.lquery ) THEN
407  info = -16
408  ELSE IF( liwork.LT.1 .AND. .NOT.lquery ) THEN
409  info = -18
410  END IF
411  END IF
412 *
413  IF( info.NE.0 ) THEN
414  CALL xerbla( 'DGEESX', -info )
415  RETURN
416  ELSE IF( lquery ) THEN
417  RETURN
418  END IF
419 *
420 * Quick return if possible
421 *
422  IF( n.EQ.0 ) THEN
423  sdim = 0
424  RETURN
425  END IF
426 *
427 * Get machine constants
428 *
429  eps = dlamch( 'P' )
430  smlnum = dlamch( 'S' )
431  bignum = one / smlnum
432  CALL dlabad( smlnum, bignum )
433  smlnum = sqrt( smlnum ) / eps
434  bignum = one / smlnum
435 *
436 * Scale A if max element outside range [SMLNUM,BIGNUM]
437 *
438  anrm = dlange( 'M', n, n, a, lda, dum )
439  scalea = .false.
440  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
441  scalea = .true.
442  cscale = smlnum
443  ELSE IF( anrm.GT.bignum ) THEN
444  scalea = .true.
445  cscale = bignum
446  END IF
447  IF( scalea )
448  $ CALL dlascl( 'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
449 *
450 * Permute the matrix to make it more nearly triangular
451 * (RWorkspace: need N)
452 *
453  ibal = 1
454  CALL dgebal( 'P', n, a, lda, ilo, ihi, work( ibal ), ierr )
455 *
456 * Reduce to upper Hessenberg form
457 * (RWorkspace: need 3*N, prefer 2*N+N*NB)
458 *
459  itau = n + ibal
460  iwrk = n + itau
461  CALL dgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
462  $ lwork-iwrk+1, ierr )
463 *
464  IF( wantvs ) THEN
465 *
466 * Copy Householder vectors to VS
467 *
468  CALL dlacpy( 'L', n, n, a, lda, vs, ldvs )
469 *
470 * Generate orthogonal matrix in VS
471 * (RWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
472 *
473  CALL dorghr( n, ilo, ihi, vs, ldvs, work( itau ), work( iwrk ),
474  $ lwork-iwrk+1, ierr )
475  END IF
476 *
477  sdim = 0
478 *
479 * Perform QR iteration, accumulating Schur vectors in VS if desired
480 * (RWorkspace: need N+1, prefer N+HSWORK (see comments) )
481 *
482  iwrk = itau
483  CALL dhseqr( 'S', jobvs, n, ilo, ihi, a, lda, wr, wi, vs, ldvs,
484  $ work( iwrk ), lwork-iwrk+1, ieval )
485  IF( ieval.GT.0 )
486  $ info = ieval
487 *
488 * Sort eigenvalues if desired
489 *
490  IF( wantst .AND. info.EQ.0 ) THEN
491  IF( scalea ) THEN
492  CALL dlascl( 'G', 0, 0, cscale, anrm, n, 1, wr, n, ierr )
493  CALL dlascl( 'G', 0, 0, cscale, anrm, n, 1, wi, n, ierr )
494  END IF
495  DO 10 i = 1, n
496  bwork( i ) = SELECT( wr( i ), wi( i ) )
497  10 CONTINUE
498 *
499 * Reorder eigenvalues, transform Schur vectors, and compute
500 * reciprocal condition numbers
501 * (RWorkspace: if SENSE is not 'N', need N+2*SDIM*(N-SDIM)
502 * otherwise, need N )
503 * (IWorkspace: if SENSE is 'V' or 'B', need SDIM*(N-SDIM)
504 * otherwise, need 0 )
505 *
506  CALL dtrsen( sense, jobvs, bwork, n, a, lda, vs, ldvs, wr, wi,
507  $ sdim, rconde, rcondv, work( iwrk ), lwork-iwrk+1,
508  $ iwork, liwork, icond )
509  IF( .NOT.wantsn )
510  $ maxwrk = max( maxwrk, n+2*sdim*( n-sdim ) )
511  IF( icond.EQ.-15 ) THEN
512 *
513 * Not enough real workspace
514 *
515  info = -16
516  ELSE IF( icond.EQ.-17 ) THEN
517 *
518 * Not enough integer workspace
519 *
520  info = -18
521  ELSE IF( icond.GT.0 ) THEN
522 *
523 * DTRSEN failed to reorder or to restore standard Schur form
524 *
525  info = icond + n
526  END IF
527  END IF
528 *
529  IF( wantvs ) THEN
530 *
531 * Undo balancing
532 * (RWorkspace: need N)
533 *
534  CALL dgebak( 'P', 'R', n, ilo, ihi, work( ibal ), n, vs, ldvs,
535  $ ierr )
536  END IF
537 *
538  IF( scalea ) THEN
539 *
540 * Undo scaling for the Schur form of A
541 *
542  CALL dlascl( 'H', 0, 0, cscale, anrm, n, n, a, lda, ierr )
543  CALL dcopy( n, a, lda+1, wr, 1 )
544  IF( ( wantsv .OR. wantsb ) .AND. info.EQ.0 ) THEN
545  dum( 1 ) = rcondv
546  CALL dlascl( 'G', 0, 0, cscale, anrm, 1, 1, dum, 1, ierr )
547  rcondv = dum( 1 )
548  END IF
549  IF( cscale.EQ.smlnum ) THEN
550 *
551 * If scaling back towards underflow, adjust WI if an
552 * offdiagonal element of a 2-by-2 block in the Schur form
553 * underflows.
554 *
555  IF( ieval.GT.0 ) THEN
556  i1 = ieval + 1
557  i2 = ihi - 1
558  CALL dlascl( 'G', 0, 0, cscale, anrm, ilo-1, 1, wi, n,
559  $ ierr )
560  ELSE IF( wantst ) THEN
561  i1 = 1
562  i2 = n - 1
563  ELSE
564  i1 = ilo
565  i2 = ihi - 1
566  END IF
567  inxt = i1 - 1
568  DO 20 i = i1, i2
569  IF( i.LT.inxt )
570  $ GO TO 20
571  IF( wi( i ).EQ.zero ) THEN
572  inxt = i + 1
573  ELSE
574  IF( a( i+1, i ).EQ.zero ) THEN
575  wi( i ) = zero
576  wi( i+1 ) = zero
577  ELSE IF( a( i+1, i ).NE.zero .AND. a( i, i+1 ).EQ.
578  $ zero ) THEN
579  wi( i ) = zero
580  wi( i+1 ) = zero
581  IF( i.GT.1 )
582  $ CALL dswap( i-1, a( 1, i ), 1, a( 1, i+1 ), 1 )
583  IF( n.GT.i+1 )
584  $ CALL dswap( n-i-1, a( i, i+2 ), lda,
585  $ a( i+1, i+2 ), lda )
586  CALL dswap( n, vs( 1, i ), 1, vs( 1, i+1 ), 1 )
587  a( i, i+1 ) = a( i+1, i )
588  a( i+1, i ) = zero
589  END IF
590  inxt = i + 2
591  END IF
592  20 CONTINUE
593  END IF
594  CALL dlascl( 'G', 0, 0, cscale, anrm, n-ieval, 1,
595  $ wi( ieval+1 ), max( n-ieval, 1 ), ierr )
596  END IF
597 *
598  IF( wantst .AND. info.EQ.0 ) THEN
599 *
600 * Check if reordering successful
601 *
602  lastsl = .true.
603  lst2sl = .true.
604  sdim = 0
605  ip = 0
606  DO 30 i = 1, n
607  cursl = SELECT( wr( i ), wi( i ) )
608  IF( wi( i ).EQ.zero ) THEN
609  IF( cursl )
610  $ sdim = sdim + 1
611  ip = 0
612  IF( cursl .AND. .NOT.lastsl )
613  $ info = n + 2
614  ELSE
615  IF( ip.EQ.1 ) THEN
616 *
617 * Last eigenvalue of conjugate pair
618 *
619  cursl = cursl .OR. lastsl
620  lastsl = cursl
621  IF( cursl )
622  $ sdim = sdim + 2
623  ip = -1
624  IF( cursl .AND. .NOT.lst2sl )
625  $ info = n + 2
626  ELSE
627 *
628 * First eigenvalue of conjugate pair
629 *
630  ip = 1
631  END IF
632  END IF
633  lst2sl = lastsl
634  lastsl = cursl
635  30 CONTINUE
636  END IF
637 *
638  work( 1 ) = maxwrk
639  IF( wantsv .OR. wantsb ) THEN
640  iwork( 1 ) = max( 1, sdim*( n-sdim ) )
641  ELSE
642  iwork( 1 ) = 1
643  END IF
644 *
645  RETURN
646 *
647 * End of DGEESX
648 *
subroutine dhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
DHSEQR
Definition: dhseqr.f:318
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL
Definition: dgebal.f:162
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
Definition: dswap.f:53
subroutine dtrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
DTRSEN
Definition: dtrsen.f:315
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DGEHRD
Definition: dgehrd.f:169
subroutine dgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
DGEBAK
Definition: dgebak.f:132
subroutine dorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DORGHR
Definition: dorghr.f:128
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
Definition: dcopy.f:53

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine dgeev ( character  JOBVL,
character  JOBVR,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( * )  WR,
double precision, dimension( * )  WI,
double precision, dimension( ldvl, * )  VL,
integer  LDVL,
double precision, dimension( ldvr, * )  VR,
integer  LDVR,
double precision, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

DGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices

Download DGEEV + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DGEEV computes for an N-by-N real nonsymmetric matrix A, the
 eigenvalues and, optionally, the left and/or right eigenvectors.

 The right eigenvector v(j) of A satisfies
                  A * v(j) = lambda(j) * v(j)
 where lambda(j) is its eigenvalue.
 The left eigenvector u(j) of A satisfies
               u(j)**H * A = lambda(j) * u(j)**H
 where u(j)**H denotes the conjugate-transpose of u(j).

 The computed eigenvectors are normalized to have Euclidean norm
 equal to 1 and largest component real.
Parameters
[in]JOBVL
          JOBVL is CHARACTER*1
          = 'N': left eigenvectors of A are not computed;
          = 'V': left eigenvectors of A are computed.
[in]JOBVR
          JOBVR is CHARACTER*1
          = 'N': right eigenvectors of A are not computed;
          = 'V': right eigenvectors of A are computed.
[in]N
          N is INTEGER
          The order of the matrix A. N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA,N)
          On entry, the N-by-N matrix A.
          On exit, A has been overwritten.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[out]WR
          WR is DOUBLE PRECISION array, dimension (N)
[out]WI
          WI is DOUBLE PRECISION array, dimension (N)
          WR and WI contain the real and imaginary parts,
          respectively, of the computed eigenvalues.  Complex
          conjugate pairs of eigenvalues appear consecutively
          with the eigenvalue having the positive imaginary part
          first.
[out]VL
          VL is DOUBLE PRECISION array, dimension (LDVL,N)
          If JOBVL = 'V', the left eigenvectors u(j) are stored one
          after another in the columns of VL, in the same order
          as their eigenvalues.
          If JOBVL = 'N', VL is not referenced.
          If the j-th eigenvalue is real, then u(j) = VL(:,j),
          the j-th column of VL.
          If the j-th and (j+1)-st eigenvalues form a complex
          conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
          u(j+1) = VL(:,j) - i*VL(:,j+1).
[in]LDVL
          LDVL is INTEGER
          The leading dimension of the array VL.  LDVL >= 1; if
          JOBVL = 'V', LDVL >= N.
[out]VR
          VR is DOUBLE PRECISION array, dimension (LDVR,N)
          If JOBVR = 'V', the right eigenvectors v(j) are stored one
          after another in the columns of VR, in the same order
          as their eigenvalues.
          If JOBVR = 'N', VR is not referenced.
          If the j-th eigenvalue is real, then v(j) = VR(:,j),
          the j-th column of VR.
          If the j-th and (j+1)-st eigenvalues form a complex
          conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
          v(j+1) = VR(:,j) - i*VR(:,j+1).
[in]LDVR
          LDVR is INTEGER
          The leading dimension of the array VR.  LDVR >= 1; if
          JOBVR = 'V', LDVR >= N.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.  LWORK >= max(1,3*N), and
          if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N.  For good
          performance, LWORK must generally be larger.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          > 0:  if INFO = i, the QR algorithm failed to compute all the
                eigenvalues, and no eigenvectors have been computed;
                elements i+1:N of WR and WI contain eigenvalues which
                have converged.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 191 of file dgeev.f.

191 *
192 * -- LAPACK driver routine (version 3.4.2) --
193 * -- LAPACK is a software package provided by Univ. of Tennessee, --
194 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
195 * September 2012
196 *
197 * .. Scalar Arguments ..
198  CHARACTER jobvl, jobvr
199  INTEGER info, lda, ldvl, ldvr, lwork, n
200 * ..
201 * .. Array Arguments ..
202  DOUBLE PRECISION a( lda, * ), vl( ldvl, * ), vr( ldvr, * ),
203  $ wi( * ), work( * ), wr( * )
204 * ..
205 *
206 * =====================================================================
207 *
208 * .. Parameters ..
209  DOUBLE PRECISION zero, one
210  parameter( zero = 0.0d0, one = 1.0d0 )
211 * ..
212 * .. Local Scalars ..
213  LOGICAL lquery, scalea, wantvl, wantvr
214  CHARACTER side
215  INTEGER hswork, i, ibal, ierr, ihi, ilo, itau, iwrk, k,
216  $ maxwrk, minwrk, nout
217  DOUBLE PRECISION anrm, bignum, cs, cscale, eps, r, scl, smlnum,
218  $ sn
219 * ..
220 * .. Local Arrays ..
221  LOGICAL select( 1 )
222  DOUBLE PRECISION dum( 1 )
223 * ..
224 * .. External Subroutines ..
225  EXTERNAL dgebak, dgebal, dgehrd, dhseqr, dlabad, dlacpy,
227  $ xerbla
228 * ..
229 * .. External Functions ..
230  LOGICAL lsame
231  INTEGER idamax, ilaenv
232  DOUBLE PRECISION dlamch, dlange, dlapy2, dnrm2
233  EXTERNAL lsame, idamax, ilaenv, dlamch, dlange, dlapy2,
234  $ dnrm2
235 * ..
236 * .. Intrinsic Functions ..
237  INTRINSIC max, sqrt
238 * ..
239 * .. Executable Statements ..
240 *
241 * Test the input arguments
242 *
243  info = 0
244  lquery = ( lwork.EQ.-1 )
245  wantvl = lsame( jobvl, 'V' )
246  wantvr = lsame( jobvr, 'V' )
247  IF( ( .NOT.wantvl ) .AND. ( .NOT.lsame( jobvl, 'N' ) ) ) THEN
248  info = -1
249  ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.lsame( jobvr, 'N' ) ) ) THEN
250  info = -2
251  ELSE IF( n.LT.0 ) THEN
252  info = -3
253  ELSE IF( lda.LT.max( 1, n ) ) THEN
254  info = -5
255  ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) ) THEN
256  info = -9
257  ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) ) THEN
258  info = -11
259  END IF
260 *
261 * Compute workspace
262 * (Note: Comments in the code beginning "Workspace:" describe the
263 * minimal amount of workspace needed at that point in the code,
264 * as well as the preferred amount for good performance.
265 * NB refers to the optimal block size for the immediately
266 * following subroutine, as returned by ILAENV.
267 * HSWORK refers to the workspace preferred by DHSEQR, as
268 * calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
269 * the worst case.)
270 *
271  IF( info.EQ.0 ) THEN
272  IF( n.EQ.0 ) THEN
273  minwrk = 1
274  maxwrk = 1
275  ELSE
276  maxwrk = 2*n + n*ilaenv( 1, 'DGEHRD', ' ', n, 1, n, 0 )
277  IF( wantvl ) THEN
278  minwrk = 4*n
279  maxwrk = max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
280  $ 'DORGHR', ' ', n, 1, n, -1 ) )
281  CALL dhseqr( 'S', 'V', n, 1, n, a, lda, wr, wi, vl, ldvl,
282  $ work, -1, info )
283  hswork = work( 1 )
284  maxwrk = max( maxwrk, n + 1, n + hswork )
285  maxwrk = max( maxwrk, 4*n )
286  ELSE IF( wantvr ) THEN
287  minwrk = 4*n
288  maxwrk = max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
289  $ 'DORGHR', ' ', n, 1, n, -1 ) )
290  CALL dhseqr( 'S', 'V', n, 1, n, a, lda, wr, wi, vr, ldvr,
291  $ work, -1, info )
292  hswork = work( 1 )
293  maxwrk = max( maxwrk, n + 1, n + hswork )
294  maxwrk = max( maxwrk, 4*n )
295  ELSE
296  minwrk = 3*n
297  CALL dhseqr( 'E', 'N', n, 1, n, a, lda, wr, wi, vr, ldvr,
298  $ work, -1, info )
299  hswork = work( 1 )
300  maxwrk = max( maxwrk, n + 1, n + hswork )
301  END IF
302  maxwrk = max( maxwrk, minwrk )
303  END IF
304  work( 1 ) = maxwrk
305 *
306  IF( lwork.LT.minwrk .AND. .NOT.lquery ) THEN
307  info = -13
308  END IF
309  END IF
310 *
311  IF( info.NE.0 ) THEN
312  CALL xerbla( 'DGEEV ', -info )
313  RETURN
314  ELSE IF( lquery ) THEN
315  RETURN
316  END IF
317 *
318 * Quick return if possible
319 *
320  IF( n.EQ.0 )
321  $ RETURN
322 *
323 * Get machine constants
324 *
325  eps = dlamch( 'P' )
326  smlnum = dlamch( 'S' )
327  bignum = one / smlnum
328  CALL dlabad( smlnum, bignum )
329  smlnum = sqrt( smlnum ) / eps
330  bignum = one / smlnum
331 *
332 * Scale A if max element outside range [SMLNUM,BIGNUM]
333 *
334  anrm = dlange( 'M', n, n, a, lda, dum )
335  scalea = .false.
336  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
337  scalea = .true.
338  cscale = smlnum
339  ELSE IF( anrm.GT.bignum ) THEN
340  scalea = .true.
341  cscale = bignum
342  END IF
343  IF( scalea )
344  $ CALL dlascl( 'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
345 *
346 * Balance the matrix
347 * (Workspace: need N)
348 *
349  ibal = 1
350  CALL dgebal( 'B', n, a, lda, ilo, ihi, work( ibal ), ierr )
351 *
352 * Reduce to upper Hessenberg form
353 * (Workspace: need 3*N, prefer 2*N+N*NB)
354 *
355  itau = ibal + n
356  iwrk = itau + n
357  CALL dgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
358  $ lwork-iwrk+1, ierr )
359 *
360  IF( wantvl ) THEN
361 *
362 * Want left eigenvectors
363 * Copy Householder vectors to VL
364 *
365  side = 'L'
366  CALL dlacpy( 'L', n, n, a, lda, vl, ldvl )
367 *
368 * Generate orthogonal matrix in VL
369 * (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
370 *
371  CALL dorghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
372  $ lwork-iwrk+1, ierr )
373 *
374 * Perform QR iteration, accumulating Schur vectors in VL
375 * (Workspace: need N+1, prefer N+HSWORK (see comments) )
376 *
377  iwrk = itau
378  CALL dhseqr( 'S', 'V', n, ilo, ihi, a, lda, wr, wi, vl, ldvl,
379  $ work( iwrk ), lwork-iwrk+1, info )
380 *
381  IF( wantvr ) THEN
382 *
383 * Want left and right eigenvectors
384 * Copy Schur vectors to VR
385 *
386  side = 'B'
387  CALL dlacpy( 'F', n, n, vl, ldvl, vr, ldvr )
388  END IF
389 *
390  ELSE IF( wantvr ) THEN
391 *
392 * Want right eigenvectors
393 * Copy Householder vectors to VR
394 *
395  side = 'R'
396  CALL dlacpy( 'L', n, n, a, lda, vr, ldvr )
397 *
398 * Generate orthogonal matrix in VR
399 * (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB)
400 *
401  CALL dorghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
402  $ lwork-iwrk+1, ierr )
403 *
404 * Perform QR iteration, accumulating Schur vectors in VR
405 * (Workspace: need N+1, prefer N+HSWORK (see comments) )
406 *
407  iwrk = itau
408  CALL dhseqr( 'S', 'V', n, ilo, ihi, a, lda, wr, wi, vr, ldvr,
409  $ work( iwrk ), lwork-iwrk+1, info )
410 *
411  ELSE
412 *
413 * Compute eigenvalues only
414 * (Workspace: need N+1, prefer N+HSWORK (see comments) )
415 *
416  iwrk = itau
417  CALL dhseqr( 'E', 'N', n, ilo, ihi, a, lda, wr, wi, vr, ldvr,
418  $ work( iwrk ), lwork-iwrk+1, info )
419  END IF
420 *
421 * If INFO > 0 from DHSEQR, then quit
422 *
423  IF( info.GT.0 )
424  $ GO TO 50
425 *
426  IF( wantvl .OR. wantvr ) THEN
427 *
428 * Compute left and/or right eigenvectors
429 * (Workspace: need 4*N)
430 *
431  CALL dtrevc( side, 'B', SELECT, n, a, lda, vl, ldvl, vr, ldvr,
432  $ n, nout, work( iwrk ), ierr )
433  END IF
434 *
435  IF( wantvl ) THEN
436 *
437 * Undo balancing of left eigenvectors
438 * (Workspace: need N)
439 *
440  CALL dgebak( 'B', 'L', n, ilo, ihi, work( ibal ), n, vl, ldvl,
441  $ ierr )
442 *
443 * Normalize left eigenvectors and make largest component real
444 *
445  DO 20 i = 1, n
446  IF( wi( i ).EQ.zero ) THEN
447  scl = one / dnrm2( n, vl( 1, i ), 1 )
448  CALL dscal( n, scl, vl( 1, i ), 1 )
449  ELSE IF( wi( i ).GT.zero ) THEN
450  scl = one / dlapy2( dnrm2( n, vl( 1, i ), 1 ),
451  $ dnrm2( n, vl( 1, i+1 ), 1 ) )
452  CALL dscal( n, scl, vl( 1, i ), 1 )
453  CALL dscal( n, scl, vl( 1, i+1 ), 1 )
454  DO 10 k = 1, n
455  work( iwrk+k-1 ) = vl( k, i )**2 + vl( k, i+1 )**2
456  10 CONTINUE
457  k = idamax( n, work( iwrk ), 1 )
458  CALL dlartg( vl( k, i ), vl( k, i+1 ), cs, sn, r )
459  CALL drot( n, vl( 1, i ), 1, vl( 1, i+1 ), 1, cs, sn )
460  vl( k, i+1 ) = zero
461  END IF
462  20 CONTINUE
463  END IF
464 *
465  IF( wantvr ) THEN
466 *
467 * Undo balancing of right eigenvectors
468 * (Workspace: need N)
469 *
470  CALL dgebak( 'B', 'R', n, ilo, ihi, work( ibal ), n, vr, ldvr,
471  $ ierr )
472 *
473 * Normalize right eigenvectors and make largest component real
474 *
475  DO 40 i = 1, n
476  IF( wi( i ).EQ.zero ) THEN
477  scl = one / dnrm2( n, vr( 1, i ), 1 )
478  CALL dscal( n, scl, vr( 1, i ), 1 )
479  ELSE IF( wi( i ).GT.zero ) THEN
480  scl = one / dlapy2( dnrm2( n, vr( 1, i ), 1 ),
481  $ dnrm2( n, vr( 1, i+1 ), 1 ) )
482  CALL dscal( n, scl, vr( 1, i ), 1 )
483  CALL dscal( n, scl, vr( 1, i+1 ), 1 )
484  DO 30 k = 1, n
485  work( iwrk+k-1 ) = vr( k, i )**2 + vr( k, i+1 )**2
486  30 CONTINUE
487  k = idamax( n, work( iwrk ), 1 )
488  CALL dlartg( vr( k, i ), vr( k, i+1 ), cs, sn, r )
489  CALL drot( n, vr( 1, i ), 1, vr( 1, i+1 ), 1, cs, sn )
490  vr( k, i+1 ) = zero
491  END IF
492  40 CONTINUE
493  END IF
494 *
495 * Undo scaling if necessary
496 *
497  50 CONTINUE
498  IF( scalea ) THEN
499  CALL dlascl( 'G', 0, 0, cscale, anrm, n-info, 1, wr( info+1 ),
500  $ max( n-info, 1 ), ierr )
501  CALL dlascl( 'G', 0, 0, cscale, anrm, n-info, 1, wi( info+1 ),
502  $ max( n-info, 1 ), ierr )
503  IF( info.GT.0 ) THEN
504  CALL dlascl( 'G', 0, 0, cscale, anrm, ilo-1, 1, wr, n,
505  $ ierr )
506  CALL dlascl( 'G', 0, 0, cscale, anrm, ilo-1, 1, wi, n,
507  $ ierr )
508  END IF
509  END IF
510 *
511  work( 1 ) = maxwrk
512  RETURN
513 *
514 * End of DGEEV
515 *
subroutine dhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
DHSEQR
Definition: dhseqr.f:318
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine dlartg(F, G, CS, SN, R)
DLARTG generates a plane rotation with real cosine and real sine.
Definition: dlartg.f:99
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dtrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
DTREVC
Definition: dtrevc.f:224
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL
Definition: dgebal.f:162
double precision function dlapy2(X, Y)
DLAPY2 returns sqrt(x2+y2).
Definition: dlapy2.f:65
subroutine drot(N, DX, INCX, DY, INCY, C, S)
DROT
Definition: drot.f:53
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DGEHRD
Definition: dgehrd.f:169
double precision function dnrm2(N, X, INCX)
DNRM2
Definition: dnrm2.f:56
integer function idamax(N, DX, INCX)
IDAMAX
Definition: idamax.f:53
subroutine dgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
DGEBAK
Definition: dgebak.f:132
subroutine dorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DORGHR
Definition: dorghr.f:128
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine dscal(N, DA, DX, INCX)
DSCAL
Definition: dscal.f:55

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine dgeevx ( character  BALANC,
character  JOBVL,
character  JOBVR,
character  SENSE,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( * )  WR,
double precision, dimension( * )  WI,
double precision, dimension( ldvl, * )  VL,
integer  LDVL,
double precision, dimension( ldvr, * )  VR,
integer  LDVR,
integer  ILO,
integer  IHI,
double precision, dimension( * )  SCALE,
double precision  ABNRM,
double precision, dimension( * )  RCONDE,
double precision, dimension( * )  RCONDV,
double precision, dimension( * )  WORK,
integer  LWORK,
integer, dimension( * )  IWORK,
integer  INFO 
)

DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices

Download DGEEVX + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DGEEVX computes for an N-by-N real nonsymmetric matrix A, the
 eigenvalues and, optionally, the left and/or right eigenvectors.

 Optionally also, it computes a balancing transformation to improve
 the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
 SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues
 (RCONDE), and reciprocal condition numbers for the right
 eigenvectors (RCONDV).

 The right eigenvector v(j) of A satisfies
                  A * v(j) = lambda(j) * v(j)
 where lambda(j) is its eigenvalue.
 The left eigenvector u(j) of A satisfies
               u(j)**H * A = lambda(j) * u(j)**H
 where u(j)**H denotes the conjugate-transpose of u(j).

 The computed eigenvectors are normalized to have Euclidean norm
 equal to 1 and largest component real.

 Balancing a matrix means permuting the rows and columns to make it
 more nearly upper triangular, and applying a diagonal similarity
 transformation D * A * D**(-1), where D is a diagonal matrix, to
 make its rows and columns closer in norm and the condition numbers
 of its eigenvalues and eigenvectors smaller.  The computed
 reciprocal condition numbers correspond to the balanced matrix.
 Permuting rows and columns will not change the condition numbers
 (in exact arithmetic) but diagonal scaling will.  For further
 explanation of balancing, see section 4.10.2 of the LAPACK
 Users' Guide.
Parameters
[in]BALANC
          BALANC is CHARACTER*1
          Indicates how the input matrix should be diagonally scaled
          and/or permuted to improve the conditioning of its
          eigenvalues.
          = 'N': Do not diagonally scale or permute;
          = 'P': Perform permutations to make the matrix more nearly
                 upper triangular. Do not diagonally scale;
          = 'S': Diagonally scale the matrix, i.e. replace A by
                 D*A*D**(-1), where D is a diagonal matrix chosen
                 to make the rows and columns of A more equal in
                 norm. Do not permute;
          = 'B': Both diagonally scale and permute A.

          Computed reciprocal condition numbers will be for the matrix
          after balancing and/or permuting. Permuting does not change
          condition numbers (in exact arithmetic), but balancing does.
[in]JOBVL
          JOBVL is CHARACTER*1
          = 'N': left eigenvectors of A are not computed;
          = 'V': left eigenvectors of A are computed.
          If SENSE = 'E' or 'B', JOBVL must = 'V'.
[in]JOBVR
          JOBVR is CHARACTER*1
          = 'N': right eigenvectors of A are not computed;
          = 'V': right eigenvectors of A are computed.
          If SENSE = 'E' or 'B', JOBVR must = 'V'.
[in]SENSE
          SENSE is CHARACTER*1
          Determines which reciprocal condition numbers are computed.
          = 'N': None are computed;
          = 'E': Computed for eigenvalues only;
          = 'V': Computed for right eigenvectors only;
          = 'B': Computed for eigenvalues and right eigenvectors.

          If SENSE = 'E' or 'B', both left and right eigenvectors
          must also be computed (JOBVL = 'V' and JOBVR = 'V').
[in]N
          N is INTEGER
          The order of the matrix A. N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA,N)
          On entry, the N-by-N matrix A.
          On exit, A has been overwritten.  If JOBVL = 'V' or
          JOBVR = 'V', A contains the real Schur form of the balanced
          version of the input matrix A.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.  LDA >= max(1,N).
[out]WR
          WR is DOUBLE PRECISION array, dimension (N)
[out]WI
          WI is DOUBLE PRECISION array, dimension (N)
          WR and WI contain the real and imaginary parts,
          respectively, of the computed eigenvalues.  Complex
          conjugate pairs of eigenvalues will appear consecutively
          with the eigenvalue having the positive imaginary part
          first.
[out]VL
          VL is DOUBLE PRECISION array, dimension (LDVL,N)
          If JOBVL = 'V', the left eigenvectors u(j) are stored one
          after another in the columns of VL, in the same order
          as their eigenvalues.
          If JOBVL = 'N', VL is not referenced.
          If the j-th eigenvalue is real, then u(j) = VL(:,j),
          the j-th column of VL.
          If the j-th and (j+1)-st eigenvalues form a complex
          conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and
          u(j+1) = VL(:,j) - i*VL(:,j+1).
[in]LDVL
          LDVL is INTEGER
          The leading dimension of the array VL.  LDVL >= 1; if
          JOBVL = 'V', LDVL >= N.
[out]VR
          VR is DOUBLE PRECISION array, dimension (LDVR,N)
          If JOBVR = 'V', the right eigenvectors v(j) are stored one
          after another in the columns of VR, in the same order
          as their eigenvalues.
          If JOBVR = 'N', VR is not referenced.
          If the j-th eigenvalue is real, then v(j) = VR(:,j),
          the j-th column of VR.
          If the j-th and (j+1)-st eigenvalues form a complex
          conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and
          v(j+1) = VR(:,j) - i*VR(:,j+1).
[in]LDVR
          LDVR is INTEGER
          The leading dimension of the array VR.  LDVR >= 1, and if
          JOBVR = 'V', LDVR >= N.
[out]ILO
          ILO is INTEGER
[out]IHI
          IHI is INTEGER
          ILO and IHI are integer values determined when A was
          balanced.  The balanced A(i,j) = 0 if I > J and
          J = 1,...,ILO-1 or I = IHI+1,...,N.
[out]SCALE
          SCALE is DOUBLE PRECISION array, dimension (N)
          Details of the permutations and scaling factors applied
          when balancing A.  If P(j) is the index of the row and column
          interchanged with row and column j, and D(j) is the scaling
          factor applied to row and column j, then
          SCALE(J) = P(J),    for J = 1,...,ILO-1
                   = D(J),    for J = ILO,...,IHI
                   = P(J)     for J = IHI+1,...,N.
          The order in which the interchanges are made is N to IHI+1,
          then 1 to ILO-1.
[out]ABNRM
          ABNRM is DOUBLE PRECISION
          The one-norm of the balanced matrix (the maximum
          of the sum of absolute values of elements of any column).
[out]RCONDE
          RCONDE is DOUBLE PRECISION array, dimension (N)
          RCONDE(j) is the reciprocal condition number of the j-th
          eigenvalue.
[out]RCONDV
          RCONDV is DOUBLE PRECISION array, dimension (N)
          RCONDV(j) is the reciprocal condition number of the j-th
          right eigenvector.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.   If SENSE = 'N' or 'E',
          LWORK >= max(1,2*N), and if JOBVL = 'V' or JOBVR = 'V',
          LWORK >= 3*N.  If SENSE = 'V' or 'B', LWORK >= N*(N+6).
          For good performance, LWORK must generally be larger.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]IWORK
          IWORK is INTEGER array, dimension (2*N-2)
          If SENSE = 'N' or 'E', not referenced.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          > 0:  if INFO = i, the QR algorithm failed to compute all the
                eigenvalues, and no eigenvectors or condition numbers
                have been computed; elements 1:ILO-1 and i+1:N of WR
                and WI contain eigenvalues which have converged.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 305 of file dgeevx.f.

305 *
306 * -- LAPACK driver routine (version 3.4.2) --
307 * -- LAPACK is a software package provided by Univ. of Tennessee, --
308 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
309 * September 2012
310 *
311 * .. Scalar Arguments ..
312  CHARACTER balanc, jobvl, jobvr, sense
313  INTEGER ihi, ilo, info, lda, ldvl, ldvr, lwork, n
314  DOUBLE PRECISION abnrm
315 * ..
316 * .. Array Arguments ..
317  INTEGER iwork( * )
318  DOUBLE PRECISION a( lda, * ), rconde( * ), rcondv( * ),
319  $ scale( * ), vl( ldvl, * ), vr( ldvr, * ),
320  $ wi( * ), work( * ), wr( * )
321 * ..
322 *
323 * =====================================================================
324 *
325 * .. Parameters ..
326  DOUBLE PRECISION zero, one
327  parameter( zero = 0.0d0, one = 1.0d0 )
328 * ..
329 * .. Local Scalars ..
330  LOGICAL lquery, scalea, wantvl, wantvr, wntsnb, wntsne,
331  $ wntsnn, wntsnv
332  CHARACTER job, side
333  INTEGER hswork, i, icond, ierr, itau, iwrk, k, maxwrk,
334  $ minwrk, nout
335  DOUBLE PRECISION anrm, bignum, cs, cscale, eps, r, scl, smlnum,
336  $ sn
337 * ..
338 * .. Local Arrays ..
339  LOGICAL select( 1 )
340  DOUBLE PRECISION dum( 1 )
341 * ..
342 * .. External Subroutines ..
343  EXTERNAL dgebak, dgebal, dgehrd, dhseqr, dlabad, dlacpy,
345  $ dtrsna, xerbla
346 * ..
347 * .. External Functions ..
348  LOGICAL lsame
349  INTEGER idamax, ilaenv
350  DOUBLE PRECISION dlamch, dlange, dlapy2, dnrm2
351  EXTERNAL lsame, idamax, ilaenv, dlamch, dlange, dlapy2,
352  $ dnrm2
353 * ..
354 * .. Intrinsic Functions ..
355  INTRINSIC max, sqrt
356 * ..
357 * .. Executable Statements ..
358 *
359 * Test the input arguments
360 *
361  info = 0
362  lquery = ( lwork.EQ.-1 )
363  wantvl = lsame( jobvl, 'V' )
364  wantvr = lsame( jobvr, 'V' )
365  wntsnn = lsame( sense, 'N' )
366  wntsne = lsame( sense, 'E' )
367  wntsnv = lsame( sense, 'V' )
368  wntsnb = lsame( sense, 'B' )
369  IF( .NOT.( lsame( balanc, 'N' ) .OR. lsame( balanc,
370  $ 'S' ) .OR. lsame( balanc, 'P' ) .OR. lsame( balanc, 'B' ) ) )
371  $ THEN
372  info = -1
373  ELSE IF( ( .NOT.wantvl ) .AND. ( .NOT.lsame( jobvl, 'N' ) ) ) THEN
374  info = -2
375  ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.lsame( jobvr, 'N' ) ) ) THEN
376  info = -3
377  ELSE IF( .NOT.( wntsnn .OR. wntsne .OR. wntsnb .OR. wntsnv ) .OR.
378  $ ( ( wntsne .OR. wntsnb ) .AND. .NOT.( wantvl .AND.
379  $ wantvr ) ) ) THEN
380  info = -4
381  ELSE IF( n.LT.0 ) THEN
382  info = -5
383  ELSE IF( lda.LT.max( 1, n ) ) THEN
384  info = -7
385  ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) ) THEN
386  info = -11
387  ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) ) THEN
388  info = -13
389  END IF
390 *
391 * Compute workspace
392 * (Note: Comments in the code beginning "Workspace:" describe the
393 * minimal amount of workspace needed at that point in the code,
394 * as well as the preferred amount for good performance.
395 * NB refers to the optimal block size for the immediately
396 * following subroutine, as returned by ILAENV.
397 * HSWORK refers to the workspace preferred by DHSEQR, as
398 * calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
399 * the worst case.)
400 *
401  IF( info.EQ.0 ) THEN
402  IF( n.EQ.0 ) THEN
403  minwrk = 1
404  maxwrk = 1
405  ELSE
406  maxwrk = n + n*ilaenv( 1, 'DGEHRD', ' ', n, 1, n, 0 )
407 *
408  IF( wantvl ) THEN
409  CALL dhseqr( 'S', 'V', n, 1, n, a, lda, wr, wi, vl, ldvl,
410  $ work, -1, info )
411  ELSE IF( wantvr ) THEN
412  CALL dhseqr( 'S', 'V', n, 1, n, a, lda, wr, wi, vr, ldvr,
413  $ work, -1, info )
414  ELSE
415  IF( wntsnn ) THEN
416  CALL dhseqr( 'E', 'N', n, 1, n, a, lda, wr, wi, vr,
417  $ ldvr, work, -1, info )
418  ELSE
419  CALL dhseqr( 'S', 'N', n, 1, n, a, lda, wr, wi, vr,
420  $ ldvr, work, -1, info )
421  END IF
422  END IF
423  hswork = work( 1 )
424 *
425  IF( ( .NOT.wantvl ) .AND. ( .NOT.wantvr ) ) THEN
426  minwrk = 2*n
427  IF( .NOT.wntsnn )
428  $ minwrk = max( minwrk, n*n+6*n )
429  maxwrk = max( maxwrk, hswork )
430  IF( .NOT.wntsnn )
431  $ maxwrk = max( maxwrk, n*n + 6*n )
432  ELSE
433  minwrk = 3*n
434  IF( ( .NOT.wntsnn ) .AND. ( .NOT.wntsne ) )
435  $ minwrk = max( minwrk, n*n + 6*n )
436  maxwrk = max( maxwrk, hswork )
437  maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1, 'DORGHR',
438  $ ' ', n, 1, n, -1 ) )
439  IF( ( .NOT.wntsnn ) .AND. ( .NOT.wntsne ) )
440  $ maxwrk = max( maxwrk, n*n + 6*n )
441  maxwrk = max( maxwrk, 3*n )
442  END IF
443  maxwrk = max( maxwrk, minwrk )
444  END IF
445  work( 1 ) = maxwrk
446 *
447  IF( lwork.LT.minwrk .AND. .NOT.lquery ) THEN
448  info = -21
449  END IF
450  END IF
451 *
452  IF( info.NE.0 ) THEN
453  CALL xerbla( 'DGEEVX', -info )
454  RETURN
455  ELSE IF( lquery ) THEN
456  RETURN
457  END IF
458 *
459 * Quick return if possible
460 *
461  IF( n.EQ.0 )
462  $ RETURN
463 *
464 * Get machine constants
465 *
466  eps = dlamch( 'P' )
467  smlnum = dlamch( 'S' )
468  bignum = one / smlnum
469  CALL dlabad( smlnum, bignum )
470  smlnum = sqrt( smlnum ) / eps
471  bignum = one / smlnum
472 *
473 * Scale A if max element outside range [SMLNUM,BIGNUM]
474 *
475  icond = 0
476  anrm = dlange( 'M', n, n, a, lda, dum )
477  scalea = .false.
478  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
479  scalea = .true.
480  cscale = smlnum
481  ELSE IF( anrm.GT.bignum ) THEN
482  scalea = .true.
483  cscale = bignum
484  END IF
485  IF( scalea )
486  $ CALL dlascl( 'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
487 *
488 * Balance the matrix and compute ABNRM
489 *
490  CALL dgebal( balanc, n, a, lda, ilo, ihi, scale, ierr )
491  abnrm = dlange( '1', n, n, a, lda, dum )
492  IF( scalea ) THEN
493  dum( 1 ) = abnrm
494  CALL dlascl( 'G', 0, 0, cscale, anrm, 1, 1, dum, 1, ierr )
495  abnrm = dum( 1 )
496  END IF
497 *
498 * Reduce to upper Hessenberg form
499 * (Workspace: need 2*N, prefer N+N*NB)
500 *
501  itau = 1
502  iwrk = itau + n
503  CALL dgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
504  $ lwork-iwrk+1, ierr )
505 *
506  IF( wantvl ) THEN
507 *
508 * Want left eigenvectors
509 * Copy Householder vectors to VL
510 *
511  side = 'L'
512  CALL dlacpy( 'L', n, n, a, lda, vl, ldvl )
513 *
514 * Generate orthogonal matrix in VL
515 * (Workspace: need 2*N-1, prefer N+(N-1)*NB)
516 *
517  CALL dorghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
518  $ lwork-iwrk+1, ierr )
519 *
520 * Perform QR iteration, accumulating Schur vectors in VL
521 * (Workspace: need 1, prefer HSWORK (see comments) )
522 *
523  iwrk = itau
524  CALL dhseqr( 'S', 'V', n, ilo, ihi, a, lda, wr, wi, vl, ldvl,
525  $ work( iwrk ), lwork-iwrk+1, info )
526 *
527  IF( wantvr ) THEN
528 *
529 * Want left and right eigenvectors
530 * Copy Schur vectors to VR
531 *
532  side = 'B'
533  CALL dlacpy( 'F', n, n, vl, ldvl, vr, ldvr )
534  END IF
535 *
536  ELSE IF( wantvr ) THEN
537 *
538 * Want right eigenvectors
539 * Copy Householder vectors to VR
540 *
541  side = 'R'
542  CALL dlacpy( 'L', n, n, a, lda, vr, ldvr )
543 *
544 * Generate orthogonal matrix in VR
545 * (Workspace: need 2*N-1, prefer N+(N-1)*NB)
546 *
547  CALL dorghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
548  $ lwork-iwrk+1, ierr )
549 *
550 * Perform QR iteration, accumulating Schur vectors in VR
551 * (Workspace: need 1, prefer HSWORK (see comments) )
552 *
553  iwrk = itau
554  CALL dhseqr( 'S', 'V', n, ilo, ihi, a, lda, wr, wi, vr, ldvr,
555  $ work( iwrk ), lwork-iwrk+1, info )
556 *
557  ELSE
558 *
559 * Compute eigenvalues only
560 * If condition numbers desired, compute Schur form
561 *
562  IF( wntsnn ) THEN
563  job = 'E'
564  ELSE
565  job = 'S'
566  END IF
567 *
568 * (Workspace: need 1, prefer HSWORK (see comments) )
569 *
570  iwrk = itau
571  CALL dhseqr( job, 'N', n, ilo, ihi, a, lda, wr, wi, vr, ldvr,
572  $ work( iwrk ), lwork-iwrk+1, info )
573  END IF
574 *
575 * If INFO > 0 from DHSEQR, then quit
576 *
577  IF( info.GT.0 )
578  $ GO TO 50
579 *
580  IF( wantvl .OR. wantvr ) THEN
581 *
582 * Compute left and/or right eigenvectors
583 * (Workspace: need 3*N)
584 *
585  CALL dtrevc( side, 'B', SELECT, n, a, lda, vl, ldvl, vr, ldvr,
586  $ n, nout, work( iwrk ), ierr )
587  END IF
588 *
589 * Compute condition numbers if desired
590 * (Workspace: need N*N+6*N unless SENSE = 'E')
591 *
592  IF( .NOT.wntsnn ) THEN
593  CALL dtrsna( sense, 'A', SELECT, n, a, lda, vl, ldvl, vr, ldvr,
594  $ rconde, rcondv, n, nout, work( iwrk ), n, iwork,
595  $ icond )
596  END IF
597 *
598  IF( wantvl ) THEN
599 *
600 * Undo balancing of left eigenvectors
601 *
602  CALL dgebak( balanc, 'L', n, ilo, ihi, scale, n, vl, ldvl,
603  $ ierr )
604 *
605 * Normalize left eigenvectors and make largest component real
606 *
607  DO 20 i = 1, n
608  IF( wi( i ).EQ.zero ) THEN
609  scl = one / dnrm2( n, vl( 1, i ), 1 )
610  CALL dscal( n, scl, vl( 1, i ), 1 )
611  ELSE IF( wi( i ).GT.zero ) THEN
612  scl = one / dlapy2( dnrm2( n, vl( 1, i ), 1 ),
613  $ dnrm2( n, vl( 1, i+1 ), 1 ) )
614  CALL dscal( n, scl, vl( 1, i ), 1 )
615  CALL dscal( n, scl, vl( 1, i+1 ), 1 )
616  DO 10 k = 1, n
617  work( k ) = vl( k, i )**2 + vl( k, i+1 )**2
618  10 CONTINUE
619  k = idamax( n, work, 1 )
620  CALL dlartg( vl( k, i ), vl( k, i+1 ), cs, sn, r )
621  CALL drot( n, vl( 1, i ), 1, vl( 1, i+1 ), 1, cs, sn )
622  vl( k, i+1 ) = zero
623  END IF
624  20 CONTINUE
625  END IF
626 *
627  IF( wantvr ) THEN
628 *
629 * Undo balancing of right eigenvectors
630 *
631  CALL dgebak( balanc, 'R', n, ilo, ihi, scale, n, vr, ldvr,
632  $ ierr )
633 *
634 * Normalize right eigenvectors and make largest component real
635 *
636  DO 40 i = 1, n
637  IF( wi( i ).EQ.zero ) THEN
638  scl = one / dnrm2( n, vr( 1, i ), 1 )
639  CALL dscal( n, scl, vr( 1, i ), 1 )
640  ELSE IF( wi( i ).GT.zero ) THEN
641  scl = one / dlapy2( dnrm2( n, vr( 1, i ), 1 ),
642  $ dnrm2( n, vr( 1, i+1 ), 1 ) )
643  CALL dscal( n, scl, vr( 1, i ), 1 )
644  CALL dscal( n, scl, vr( 1, i+1 ), 1 )
645  DO 30 k = 1, n
646  work( k ) = vr( k, i )**2 + vr( k, i+1 )**2
647  30 CONTINUE
648  k = idamax( n, work, 1 )
649  CALL dlartg( vr( k, i ), vr( k, i+1 ), cs, sn, r )
650  CALL drot( n, vr( 1, i ), 1, vr( 1, i+1 ), 1, cs, sn )
651  vr( k, i+1 ) = zero
652  END IF
653  40 CONTINUE
654  END IF
655 *
656 * Undo scaling if necessary
657 *
658  50 CONTINUE
659  IF( scalea ) THEN
660  CALL dlascl( 'G', 0, 0, cscale, anrm, n-info, 1, wr( info+1 ),
661  $ max( n-info, 1 ), ierr )
662  CALL dlascl( 'G', 0, 0, cscale, anrm, n-info, 1, wi( info+1 ),
663  $ max( n-info, 1 ), ierr )
664  IF( info.EQ.0 ) THEN
665  IF( ( wntsnv .OR. wntsnb ) .AND. icond.EQ.0 )
666  $ CALL dlascl( 'G', 0, 0, cscale, anrm, n, 1, rcondv, n,
667  $ ierr )
668  ELSE
669  CALL dlascl( 'G', 0, 0, cscale, anrm, ilo-1, 1, wr, n,
670  $ ierr )
671  CALL dlascl( 'G', 0, 0, cscale, anrm, ilo-1, 1, wi, n,
672  $ ierr )
673  END IF
674  END IF
675 *
676  work( 1 ) = maxwrk
677  RETURN
678 *
679 * End of DGEEVX
680 *
subroutine dhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
DHSEQR
Definition: dhseqr.f:318
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine dlartg(F, G, CS, SN, R)
DLARTG generates a plane rotation with real cosine and real sine.
Definition: dlartg.f:99
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dtrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
DTREVC
Definition: dtrevc.f:224
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL
Definition: dgebal.f:162
double precision function dlapy2(X, Y)
DLAPY2 returns sqrt(x2+y2).
Definition: dlapy2.f:65
subroutine drot(N, DX, INCX, DY, INCY, C, S)
DROT
Definition: drot.f:53
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dtrsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, INFO)
DTRSNA
Definition: dtrsna.f:267
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DGEHRD
Definition: dgehrd.f:169
double precision function dnrm2(N, X, INCX)
DNRM2
Definition: dnrm2.f:56
integer function idamax(N, DX, INCX)
IDAMAX
Definition: idamax.f:53
subroutine dgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
DGEBAK
Definition: dgebak.f:132
subroutine dorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DORGHR
Definition: dorghr.f:128
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine dscal(N, DA, DX, INCX)
DSCAL
Definition: dscal.f:55

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine dgegs ( character  JOBVSL,
character  JOBVSR,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( ldb, * )  B,
integer  LDB,
double precision, dimension( * )  ALPHAR,
double precision, dimension( * )  ALPHAI,
double precision, dimension( * )  BETA,
double precision, dimension( ldvsl, * )  VSL,
integer  LDVSL,
double precision, dimension( ldvsr, * )  VSR,
integer  LDVSR,
double precision, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices

Download DGEGS + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 This routine is deprecated and has been replaced by routine DGGES.

 DGEGS computes the eigenvalues, real Schur form, and, optionally,
 left and or/right Schur vectors of a real matrix pair (A,B).
 Given two square matrices A and B, the generalized real Schur
 factorization has the form

   A = Q*S*Z**T,  B = Q*T*Z**T

 where Q and Z are orthogonal matrices, T is upper triangular, and S
 is an upper quasi-triangular matrix with 1-by-1 and 2-by-2 diagonal
 blocks, the 2-by-2 blocks corresponding to complex conjugate pairs
 of eigenvalues of (A,B).  The columns of Q are the left Schur vectors
 and the columns of Z are the right Schur vectors.

 If only the eigenvalues of (A,B) are needed, the driver routine
 DGEGV should be used instead.  See DGEGV for a description of the
 eigenvalues of the generalized nonsymmetric eigenvalue problem
 (GNEP).
Parameters
[in]JOBVSL
          JOBVSL is CHARACTER*1
          = 'N':  do not compute the left Schur vectors;
          = 'V':  compute the left Schur vectors (returned in VSL).
[in]JOBVSR
          JOBVSR is CHARACTER*1
          = 'N':  do not compute the right Schur vectors;
          = 'V':  compute the right Schur vectors (returned in VSR).
[in]N
          N is INTEGER
          The order of the matrices A, B, VSL, and VSR.  N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA, N)
          On entry, the matrix A.
          On exit, the upper quasi-triangular matrix S from the
          generalized real Schur factorization.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  LDA >= max(1,N).
[in,out]B
          B is DOUBLE PRECISION array, dimension (LDB, N)
          On entry, the matrix B.
          On exit, the upper triangular matrix T from the generalized
          real Schur factorization.
[in]LDB
          LDB is INTEGER
          The leading dimension of B.  LDB >= max(1,N).
[out]ALPHAR
          ALPHAR is DOUBLE PRECISION array, dimension (N)
          The real parts of each scalar alpha defining an eigenvalue
          of GNEP.
[out]ALPHAI
          ALPHAI is DOUBLE PRECISION array, dimension (N)
          The imaginary parts of each scalar alpha defining an
          eigenvalue of GNEP.  If ALPHAI(j) is zero, then the j-th
          eigenvalue is real; if positive, then the j-th and (j+1)-st
          eigenvalues are a complex conjugate pair, with
          ALPHAI(j+1) = -ALPHAI(j).
[out]BETA
          BETA is DOUBLE PRECISION array, dimension (N)
          The scalars beta that define the eigenvalues of GNEP.
          Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
          beta = BETA(j) represent the j-th eigenvalue of the matrix
          pair (A,B), in one of the forms lambda = alpha/beta or
          mu = beta/alpha.  Since either lambda or mu may overflow,
          they should not, in general, be computed.
[out]VSL
          VSL is DOUBLE PRECISION array, dimension (LDVSL,N)
          If JOBVSL = 'V', the matrix of left Schur vectors Q.
          Not referenced if JOBVSL = 'N'.
[in]LDVSL
          LDVSL is INTEGER
          The leading dimension of the matrix VSL. LDVSL >=1, and
          if JOBVSL = 'V', LDVSL >= N.
[out]VSR
          VSR is DOUBLE PRECISION array, dimension (LDVSR,N)
          If JOBVSR = 'V', the matrix of right Schur vectors Z.
          Not referenced if JOBVSR = 'N'.
[in]LDVSR
          LDVSR is INTEGER
          The leading dimension of the matrix VSR. LDVSR >= 1, and
          if JOBVSR = 'V', LDVSR >= N.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.  LWORK >= max(1,4*N).
          For good performance, LWORK must generally be larger.
          To compute the optimal value of LWORK, call ILAENV to get
          blocksizes (for DGEQRF, DORMQR, and DORGQR.)  Then compute:
          NB  -- MAX of the blocksizes for DGEQRF, DORMQR, and DORGQR
          The optimal LWORK is  2*N + N*(NB+1).

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          = 1,...,N:
                The QZ iteration failed.  (A,B) are not in Schur
                form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
                be correct for j=INFO+1,...,N.
          > N:  errors that usually indicate LAPACK problems:
                =N+1: error return from DGGBAL
                =N+2: error return from DGEQRF
                =N+3: error return from DORMQR
                =N+4: error return from DORGQR
                =N+5: error return from DGGHRD
                =N+6: error return from DHGEQZ (other than failed
                                                iteration)
                =N+7: error return from DGGBAK (computing VSL)
                =N+8: error return from DGGBAK (computing VSR)
                =N+9: error return from DLASCL (various places)
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 229 of file dgegs.f.

229 *
230 * -- LAPACK driver routine (version 3.4.0) --
231 * -- LAPACK is a software package provided by Univ. of Tennessee, --
232 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
233 * November 2011
234 *
235 * .. Scalar Arguments ..
236  CHARACTER jobvsl, jobvsr
237  INTEGER info, lda, ldb, ldvsl, ldvsr, lwork, n
238 * ..
239 * .. Array Arguments ..
240  DOUBLE PRECISION a( lda, * ), alphai( * ), alphar( * ),
241  $ b( ldb, * ), beta( * ), vsl( ldvsl, * ),
242  $ vsr( ldvsr, * ), work( * )
243 * ..
244 *
245 * =====================================================================
246 *
247 * .. Parameters ..
248  DOUBLE PRECISION zero, one
249  parameter( zero = 0.0d0, one = 1.0d0 )
250 * ..
251 * .. Local Scalars ..
252  LOGICAL ilascl, ilbscl, ilvsl, ilvsr, lquery
253  INTEGER icols, ihi, iinfo, ijobvl, ijobvr, ileft, ilo,
254  $ iright, irows, itau, iwork, lopt, lwkmin,
255  $ lwkopt, nb, nb1, nb2, nb3
256  DOUBLE PRECISION anrm, anrmto, bignum, bnrm, bnrmto, eps,
257  $ safmin, smlnum
258 * ..
259 * .. External Subroutines ..
260  EXTERNAL dgeqrf, dggbak, dggbal, dgghrd, dhgeqz, dlacpy,
262 * ..
263 * .. External Functions ..
264  LOGICAL lsame
265  INTEGER ilaenv
266  DOUBLE PRECISION dlamch, dlange
267  EXTERNAL lsame, ilaenv, dlamch, dlange
268 * ..
269 * .. Intrinsic Functions ..
270  INTRINSIC int, max
271 * ..
272 * .. Executable Statements ..
273 *
274 * Decode the input arguments
275 *
276  IF( lsame( jobvsl, 'N' ) ) THEN
277  ijobvl = 1
278  ilvsl = .false.
279  ELSE IF( lsame( jobvsl, 'V' ) ) THEN
280  ijobvl = 2
281  ilvsl = .true.
282  ELSE
283  ijobvl = -1
284  ilvsl = .false.
285  END IF
286 *
287  IF( lsame( jobvsr, 'N' ) ) THEN
288  ijobvr = 1
289  ilvsr = .false.
290  ELSE IF( lsame( jobvsr, 'V' ) ) THEN
291  ijobvr = 2
292  ilvsr = .true.
293  ELSE
294  ijobvr = -1
295  ilvsr = .false.
296  END IF
297 *
298 * Test the input arguments
299 *
300  lwkmin = max( 4*n, 1 )
301  lwkopt = lwkmin
302  work( 1 ) = lwkopt
303  lquery = ( lwork.EQ.-1 )
304  info = 0
305  IF( ijobvl.LE.0 ) THEN
306  info = -1
307  ELSE IF( ijobvr.LE.0 ) THEN
308  info = -2
309  ELSE IF( n.LT.0 ) THEN
310  info = -3
311  ELSE IF( lda.LT.max( 1, n ) ) THEN
312  info = -5
313  ELSE IF( ldb.LT.max( 1, n ) ) THEN
314  info = -7
315  ELSE IF( ldvsl.LT.1 .OR. ( ilvsl .AND. ldvsl.LT.n ) ) THEN
316  info = -12
317  ELSE IF( ldvsr.LT.1 .OR. ( ilvsr .AND. ldvsr.LT.n ) ) THEN
318  info = -14
319  ELSE IF( lwork.LT.lwkmin .AND. .NOT.lquery ) THEN
320  info = -16
321  END IF
322 *
323  IF( info.EQ.0 ) THEN
324  nb1 = ilaenv( 1, 'DGEQRF', ' ', n, n, -1, -1 )
325  nb2 = ilaenv( 1, 'DORMQR', ' ', n, n, n, -1 )
326  nb3 = ilaenv( 1, 'DORGQR', ' ', n, n, n, -1 )
327  nb = max( nb1, nb2, nb3 )
328  lopt = 2*n + n*( nb+1 )
329  work( 1 ) = lopt
330  END IF
331 *
332  IF( info.NE.0 ) THEN
333  CALL xerbla( 'DGEGS ', -info )
334  RETURN
335  ELSE IF( lquery ) THEN
336  RETURN
337  END IF
338 *
339 * Quick return if possible
340 *
341  IF( n.EQ.0 )
342  $ RETURN
343 *
344 * Get machine constants
345 *
346  eps = dlamch( 'E' )*dlamch( 'B' )
347  safmin = dlamch( 'S' )
348  smlnum = n*safmin / eps
349  bignum = one / smlnum
350 *
351 * Scale A if max element outside range [SMLNUM,BIGNUM]
352 *
353  anrm = dlange( 'M', n, n, a, lda, work )
354  ilascl = .false.
355  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
356  anrmto = smlnum
357  ilascl = .true.
358  ELSE IF( anrm.GT.bignum ) THEN
359  anrmto = bignum
360  ilascl = .true.
361  END IF
362 *
363  IF( ilascl ) THEN
364  CALL dlascl( 'G', -1, -1, anrm, anrmto, n, n, a, lda, iinfo )
365  IF( iinfo.NE.0 ) THEN
366  info = n + 9
367  RETURN
368  END IF
369  END IF
370 *
371 * Scale B if max element outside range [SMLNUM,BIGNUM]
372 *
373  bnrm = dlange( 'M', n, n, b, ldb, work )
374  ilbscl = .false.
375  IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) THEN
376  bnrmto = smlnum
377  ilbscl = .true.
378  ELSE IF( bnrm.GT.bignum ) THEN
379  bnrmto = bignum
380  ilbscl = .true.
381  END IF
382 *
383  IF( ilbscl ) THEN
384  CALL dlascl( 'G', -1, -1, bnrm, bnrmto, n, n, b, ldb, iinfo )
385  IF( iinfo.NE.0 ) THEN
386  info = n + 9
387  RETURN
388  END IF
389  END IF
390 *
391 * Permute the matrix to make it more nearly triangular
392 * Workspace layout: (2*N words -- "work..." not actually used)
393 * left_permutation, right_permutation, work...
394 *
395  ileft = 1
396  iright = n + 1
397  iwork = iright + n
398  CALL dggbal( 'P', n, a, lda, b, ldb, ilo, ihi, work( ileft ),
399  $ work( iright ), work( iwork ), iinfo )
400  IF( iinfo.NE.0 ) THEN
401  info = n + 1
402  GO TO 10
403  END IF
404 *
405 * Reduce B to triangular form, and initialize VSL and/or VSR
406 * Workspace layout: ("work..." must have at least N words)
407 * left_permutation, right_permutation, tau, work...
408 *
409  irows = ihi + 1 - ilo
410  icols = n + 1 - ilo
411  itau = iwork
412  iwork = itau + irows
413  CALL dgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
414  $ work( iwork ), lwork+1-iwork, iinfo )
415  IF( iinfo.GE.0 )
416  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
417  IF( iinfo.NE.0 ) THEN
418  info = n + 2
419  GO TO 10
420  END IF
421 *
422  CALL dormqr( 'L', 'T', irows, icols, irows, b( ilo, ilo ), ldb,
423  $ work( itau ), a( ilo, ilo ), lda, work( iwork ),
424  $ lwork+1-iwork, iinfo )
425  IF( iinfo.GE.0 )
426  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
427  IF( iinfo.NE.0 ) THEN
428  info = n + 3
429  GO TO 10
430  END IF
431 *
432  IF( ilvsl ) THEN
433  CALL dlaset( 'Full', n, n, zero, one, vsl, ldvsl )
434  CALL dlacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
435  $ vsl( ilo+1, ilo ), ldvsl )
436  CALL dorgqr( irows, irows, irows, vsl( ilo, ilo ), ldvsl,
437  $ work( itau ), work( iwork ), lwork+1-iwork,
438  $ iinfo )
439  IF( iinfo.GE.0 )
440  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
441  IF( iinfo.NE.0 ) THEN
442  info = n + 4
443  GO TO 10
444  END IF
445  END IF
446 *
447  IF( ilvsr )
448  $ CALL dlaset( 'Full', n, n, zero, one, vsr, ldvsr )
449 *
450 * Reduce to generalized Hessenberg form
451 *
452  CALL dgghrd( jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb, vsl,
453  $ ldvsl, vsr, ldvsr, iinfo )
454  IF( iinfo.NE.0 ) THEN
455  info = n + 5
456  GO TO 10
457  END IF
458 *
459 * Perform QZ algorithm, computing Schur vectors if desired
460 * Workspace layout: ("work..." must have at least 1 word)
461 * left_permutation, right_permutation, work...
462 *
463  iwork = itau
464  CALL dhgeqz( 'S', jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb,
465  $ alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr,
466  $ work( iwork ), lwork+1-iwork, iinfo )
467  IF( iinfo.GE.0 )
468  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
469  IF( iinfo.NE.0 ) THEN
470  IF( iinfo.GT.0 .AND. iinfo.LE.n ) THEN
471  info = iinfo
472  ELSE IF( iinfo.GT.n .AND. iinfo.LE.2*n ) THEN
473  info = iinfo - n
474  ELSE
475  info = n + 6
476  END IF
477  GO TO 10
478  END IF
479 *
480 * Apply permutation to VSL and VSR
481 *
482  IF( ilvsl ) THEN
483  CALL dggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
484  $ work( iright ), n, vsl, ldvsl, iinfo )
485  IF( iinfo.NE.0 ) THEN
486  info = n + 7
487  GO TO 10
488  END IF
489  END IF
490  IF( ilvsr ) THEN
491  CALL dggbak( 'P', 'R', n, ilo, ihi, work( ileft ),
492  $ work( iright ), n, vsr, ldvsr, iinfo )
493  IF( iinfo.NE.0 ) THEN
494  info = n + 8
495  GO TO 10
496  END IF
497  END IF
498 *
499 * Undo scaling
500 *
501  IF( ilascl ) THEN
502  CALL dlascl( 'H', -1, -1, anrmto, anrm, n, n, a, lda, iinfo )
503  IF( iinfo.NE.0 ) THEN
504  info = n + 9
505  RETURN
506  END IF
507  CALL dlascl( 'G', -1, -1, anrmto, anrm, n, 1, alphar, n,
508  $ iinfo )
509  IF( iinfo.NE.0 ) THEN
510  info = n + 9
511  RETURN
512  END IF
513  CALL dlascl( 'G', -1, -1, anrmto, anrm, n, 1, alphai, n,
514  $ iinfo )
515  IF( iinfo.NE.0 ) THEN
516  info = n + 9
517  RETURN
518  END IF
519  END IF
520 *
521  IF( ilbscl ) THEN
522  CALL dlascl( 'U', -1, -1, bnrmto, bnrm, n, n, b, ldb, iinfo )
523  IF( iinfo.NE.0 ) THEN
524  info = n + 9
525  RETURN
526  END IF
527  CALL dlascl( 'G', -1, -1, bnrmto, bnrm, n, 1, beta, n, iinfo )
528  IF( iinfo.NE.0 ) THEN
529  info = n + 9
530  RETURN
531  END IF
532  END IF
533 *
534  10 CONTINUE
535  work( 1 ) = lwkopt
536 *
537  RETURN
538 *
539 * End of DGEGS
540 *
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGEQRF
Definition: dgeqrf.f:138
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
DGGHRD
Definition: dgghrd.f:209
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
Definition: dormqr.f:169
subroutine dhgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
DHGEQZ
Definition: dhgeqz.f:306
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:130
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
DGGBAL
Definition: dggbal.f:179
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
DGGBAK
Definition: dggbak.f:149
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83

Here is the call graph for this function:

subroutine dgegv ( character  JOBVL,
character  JOBVR,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( ldb, * )  B,
integer  LDB,
double precision, dimension( * )  ALPHAR,
double precision, dimension( * )  ALPHAI,
double precision, dimension( * )  BETA,
double precision, dimension( ldvl, * )  VL,
integer  LDVL,
double precision, dimension( ldvr, * )  VR,
integer  LDVR,
double precision, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

DGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices

Download DGEGV + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 This routine is deprecated and has been replaced by routine DGGEV.

 DGEGV computes the eigenvalues and, optionally, the left and/or right
 eigenvectors of a real matrix pair (A,B).
 Given two square matrices A and B,
 the generalized nonsymmetric eigenvalue problem (GNEP) is to find the
 eigenvalues lambda and corresponding (non-zero) eigenvectors x such
 that

    A*x = lambda*B*x.

 An alternate form is to find the eigenvalues mu and corresponding
 eigenvectors y such that

    mu*A*y = B*y.

 These two forms are equivalent with mu = 1/lambda and x = y if
 neither lambda nor mu is zero.  In order to deal with the case that
 lambda or mu is zero or small, two values alpha and beta are returned
 for each eigenvalue, such that lambda = alpha/beta and
 mu = beta/alpha.

 The vectors x and y in the above equations are right eigenvectors of
 the matrix pair (A,B).  Vectors u and v satisfying

    u**H*A = lambda*u**H*B  or  mu*v**H*A = v**H*B

 are left eigenvectors of (A,B).

 Note: this routine performs "full balancing" on A and B
Parameters
[in]JOBVL
          JOBVL is CHARACTER*1
          = 'N':  do not compute the left generalized eigenvectors;
          = 'V':  compute the left generalized eigenvectors (returned
                  in VL).
[in]JOBVR
          JOBVR is CHARACTER*1
          = 'N':  do not compute the right generalized eigenvectors;
          = 'V':  compute the right generalized eigenvectors (returned
                  in VR).
[in]N
          N is INTEGER
          The order of the matrices A, B, VL, and VR.  N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA, N)
          On entry, the matrix A.
          If JOBVL = 'V' or JOBVR = 'V', then on exit A
          contains the real Schur form of A from the generalized Schur
          factorization of the pair (A,B) after balancing.
          If no eigenvectors were computed, then only the diagonal
          blocks from the Schur form will be correct.  See DGGHRD and
          DHGEQZ for details.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  LDA >= max(1,N).
[in,out]B
          B is DOUBLE PRECISION array, dimension (LDB, N)
          On entry, the matrix B.
          If JOBVL = 'V' or JOBVR = 'V', then on exit B contains the
          upper triangular matrix obtained from B in the generalized
          Schur factorization of the pair (A,B) after balancing.
          If no eigenvectors were computed, then only those elements of
          B corresponding to the diagonal blocks from the Schur form of
          A will be correct.  See DGGHRD and DHGEQZ for details.
[in]LDB
          LDB is INTEGER
          The leading dimension of B.  LDB >= max(1,N).
[out]ALPHAR
          ALPHAR is DOUBLE PRECISION array, dimension (N)
          The real parts of each scalar alpha defining an eigenvalue of
          GNEP.
[out]ALPHAI
          ALPHAI is DOUBLE PRECISION array, dimension (N)
          The imaginary parts of each scalar alpha defining an
          eigenvalue of GNEP.  If ALPHAI(j) is zero, then the j-th
          eigenvalue is real; if positive, then the j-th and
          (j+1)-st eigenvalues are a complex conjugate pair, with
          ALPHAI(j+1) = -ALPHAI(j).
[out]BETA
          BETA is DOUBLE PRECISION array, dimension (N)
          The scalars beta that define the eigenvalues of GNEP.
          
          Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
          beta = BETA(j) represent the j-th eigenvalue of the matrix
          pair (A,B), in one of the forms lambda = alpha/beta or
          mu = beta/alpha.  Since either lambda or mu may overflow,
          they should not, in general, be computed.
[out]VL
          VL is DOUBLE PRECISION array, dimension (LDVL,N)
          If JOBVL = 'V', the left eigenvectors u(j) are stored
          in the columns of VL, in the same order as their eigenvalues.
          If the j-th eigenvalue is real, then u(j) = VL(:,j).
          If the j-th and (j+1)-st eigenvalues form a complex conjugate
          pair, then
             u(j) = VL(:,j) + i*VL(:,j+1)
          and
            u(j+1) = VL(:,j) - i*VL(:,j+1).

          Each eigenvector is scaled so that its largest component has
          abs(real part) + abs(imag. part) = 1, except for eigenvectors
          corresponding to an eigenvalue with alpha = beta = 0, which
          are set to zero.
          Not referenced if JOBVL = 'N'.
[in]LDVL
          LDVL is INTEGER
          The leading dimension of the matrix VL. LDVL >= 1, and
          if JOBVL = 'V', LDVL >= N.
[out]VR
          VR is DOUBLE PRECISION array, dimension (LDVR,N)
          If JOBVR = 'V', the right eigenvectors x(j) are stored
          in the columns of VR, in the same order as their eigenvalues.
          If the j-th eigenvalue is real, then x(j) = VR(:,j).
          If the j-th and (j+1)-st eigenvalues form a complex conjugate
          pair, then
            x(j) = VR(:,j) + i*VR(:,j+1)
          and
            x(j+1) = VR(:,j) - i*VR(:,j+1).

          Each eigenvector is scaled so that its largest component has
          abs(real part) + abs(imag. part) = 1, except for eigenvalues
          corresponding to an eigenvalue with alpha = beta = 0, which
          are set to zero.
          Not referenced if JOBVR = 'N'.
[in]LDVR
          LDVR is INTEGER
          The leading dimension of the matrix VR. LDVR >= 1, and
          if JOBVR = 'V', LDVR >= N.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.  LWORK >= max(1,8*N).
          For good performance, LWORK must generally be larger.
          To compute the optimal value of LWORK, call ILAENV to get
          blocksizes (for DGEQRF, DORMQR, and DORGQR.)  Then compute:
          NB  -- MAX of the blocksizes for DGEQRF, DORMQR, and DORGQR;
          The optimal LWORK is:
              2*N + MAX( 6*N, N*(NB+1) ).

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          = 1,...,N:
                The QZ iteration failed.  No eigenvectors have been
                calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
                should be correct for j=INFO+1,...,N.
          > N:  errors that usually indicate LAPACK problems:
                =N+1: error return from DGGBAL
                =N+2: error return from DGEQRF
                =N+3: error return from DORMQR
                =N+4: error return from DORGQR
                =N+5: error return from DGGHRD
                =N+6: error return from DHGEQZ (other than failed
                                                iteration)
                =N+7: error return from DTGEVC
                =N+8: error return from DGGBAK (computing VL)
                =N+9: error return from DGGBAK (computing VR)
                =N+10: error return from DLASCL (various calls)
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011
Further Details:
  Balancing
  ---------

  This driver calls DGGBAL to both permute and scale rows and columns
  of A and B.  The permutations PL and PR are chosen so that PL*A*PR
  and PL*B*R will be upper triangular except for the diagonal blocks
  A(i:j,i:j) and B(i:j,i:j), with i and j as close together as
  possible.  The diagonal scaling matrices DL and DR are chosen so
  that the pair  DL*PL*A*PR*DR, DL*PL*B*PR*DR have elements close to
  one (except for the elements that start out zero.)

  After the eigenvalues and eigenvectors of the balanced matrices
  have been computed, DGGBAK transforms the eigenvectors back to what
  they would have been (in perfect arithmetic) if they had not been
  balanced.

  Contents of A and B on Exit
  -------- -- - --- - -- ----

  If any eigenvectors are computed (either JOBVL='V' or JOBVR='V' or
  both), then on exit the arrays A and B will contain the real Schur
  form[*] of the "balanced" versions of A and B.  If no eigenvectors
  are computed, then only the diagonal blocks will be correct.

  [*] See DHGEQZ, DGEGS, or read the book "Matrix Computations",
      by Golub & van Loan, pub. by Johns Hopkins U. Press.

Definition at line 308 of file dgegv.f.

308 *
309 * -- LAPACK driver routine (version 3.4.0) --
310 * -- LAPACK is a software package provided by Univ. of Tennessee, --
311 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
312 * November 2011
313 *
314 * .. Scalar Arguments ..
315  CHARACTER jobvl, jobvr
316  INTEGER info, lda, ldb, ldvl, ldvr, lwork, n
317 * ..
318 * .. Array Arguments ..
319  DOUBLE PRECISION a( lda, * ), alphai( * ), alphar( * ),
320  $ b( ldb, * ), beta( * ), vl( ldvl, * ),
321  $ vr( ldvr, * ), work( * )
322 * ..
323 *
324 * =====================================================================
325 *
326 * .. Parameters ..
327  DOUBLE PRECISION zero, one
328  parameter( zero = 0.0d0, one = 1.0d0 )
329 * ..
330 * .. Local Scalars ..
331  LOGICAL ilimit, ilv, ilvl, ilvr, lquery
332  CHARACTER chtemp
333  INTEGER icols, ihi, iinfo, ijobvl, ijobvr, ileft, ilo,
334  $ in, iright, irows, itau, iwork, jc, jr, lopt,
335  $ lwkmin, lwkopt, nb, nb1, nb2, nb3
336  DOUBLE PRECISION absai, absar, absb, anrm, anrm1, anrm2, bnrm,
337  $ bnrm1, bnrm2, eps, onepls, safmax, safmin,
338  $ salfai, salfar, sbeta, scale, temp
339 * ..
340 * .. Local Arrays ..
341  LOGICAL ldumma( 1 )
342 * ..
343 * .. External Subroutines ..
344  EXTERNAL dgeqrf, dggbak, dggbal, dgghrd, dhgeqz, dlacpy,
346 * ..
347 * .. External Functions ..
348  LOGICAL lsame
349  INTEGER ilaenv
350  DOUBLE PRECISION dlamch, dlange
351  EXTERNAL lsame, ilaenv, dlamch, dlange
352 * ..
353 * .. Intrinsic Functions ..
354  INTRINSIC abs, int, max
355 * ..
356 * .. Executable Statements ..
357 *
358 * Decode the input arguments
359 *
360  IF( lsame( jobvl, 'N' ) ) THEN
361  ijobvl = 1
362  ilvl = .false.
363  ELSE IF( lsame( jobvl, 'V' ) ) THEN
364  ijobvl = 2
365  ilvl = .true.
366  ELSE
367  ijobvl = -1
368  ilvl = .false.
369  END IF
370 *
371  IF( lsame( jobvr, 'N' ) ) THEN
372  ijobvr = 1
373  ilvr = .false.
374  ELSE IF( lsame( jobvr, 'V' ) ) THEN
375  ijobvr = 2
376  ilvr = .true.
377  ELSE
378  ijobvr = -1
379  ilvr = .false.
380  END IF
381  ilv = ilvl .OR. ilvr
382 *
383 * Test the input arguments
384 *
385  lwkmin = max( 8*n, 1 )
386  lwkopt = lwkmin
387  work( 1 ) = lwkopt
388  lquery = ( lwork.EQ.-1 )
389  info = 0
390  IF( ijobvl.LE.0 ) THEN
391  info = -1
392  ELSE IF( ijobvr.LE.0 ) THEN
393  info = -2
394  ELSE IF( n.LT.0 ) THEN
395  info = -3
396  ELSE IF( lda.LT.max( 1, n ) ) THEN
397  info = -5
398  ELSE IF( ldb.LT.max( 1, n ) ) THEN
399  info = -7
400  ELSE IF( ldvl.LT.1 .OR. ( ilvl .AND. ldvl.LT.n ) ) THEN
401  info = -12
402  ELSE IF( ldvr.LT.1 .OR. ( ilvr .AND. ldvr.LT.n ) ) THEN
403  info = -14
404  ELSE IF( lwork.LT.lwkmin .AND. .NOT.lquery ) THEN
405  info = -16
406  END IF
407 *
408  IF( info.EQ.0 ) THEN
409  nb1 = ilaenv( 1, 'DGEQRF', ' ', n, n, -1, -1 )
410  nb2 = ilaenv( 1, 'DORMQR', ' ', n, n, n, -1 )
411  nb3 = ilaenv( 1, 'DORGQR', ' ', n, n, n, -1 )
412  nb = max( nb1, nb2, nb3 )
413  lopt = 2*n + max( 6*n, n*( nb+1 ) )
414  work( 1 ) = lopt
415  END IF
416 *
417  IF( info.NE.0 ) THEN
418  CALL xerbla( 'DGEGV ', -info )
419  RETURN
420  ELSE IF( lquery ) THEN
421  RETURN
422  END IF
423 *
424 * Quick return if possible
425 *
426  IF( n.EQ.0 )
427  $ RETURN
428 *
429 * Get machine constants
430 *
431  eps = dlamch( 'E' )*dlamch( 'B' )
432  safmin = dlamch( 'S' )
433  safmin = safmin + safmin
434  safmax = one / safmin
435  onepls = one + ( 4*eps )
436 *
437 * Scale A
438 *
439  anrm = dlange( 'M', n, n, a, lda, work )
440  anrm1 = anrm
441  anrm2 = one
442  IF( anrm.LT.one ) THEN
443  IF( safmax*anrm.LT.one ) THEN
444  anrm1 = safmin
445  anrm2 = safmax*anrm
446  END IF
447  END IF
448 *
449  IF( anrm.GT.zero ) THEN
450  CALL dlascl( 'G', -1, -1, anrm, one, n, n, a, lda, iinfo )
451  IF( iinfo.NE.0 ) THEN
452  info = n + 10
453  RETURN
454  END IF
455  END IF
456 *
457 * Scale B
458 *
459  bnrm = dlange( 'M', n, n, b, ldb, work )
460  bnrm1 = bnrm
461  bnrm2 = one
462  IF( bnrm.LT.one ) THEN
463  IF( safmax*bnrm.LT.one ) THEN
464  bnrm1 = safmin
465  bnrm2 = safmax*bnrm
466  END IF
467  END IF
468 *
469  IF( bnrm.GT.zero ) THEN
470  CALL dlascl( 'G', -1, -1, bnrm, one, n, n, b, ldb, iinfo )
471  IF( iinfo.NE.0 ) THEN
472  info = n + 10
473  RETURN
474  END IF
475  END IF
476 *
477 * Permute the matrix to make it more nearly triangular
478 * Workspace layout: (8*N words -- "work" requires 6*N words)
479 * left_permutation, right_permutation, work...
480 *
481  ileft = 1
482  iright = n + 1
483  iwork = iright + n
484  CALL dggbal( 'P', n, a, lda, b, ldb, ilo, ihi, work( ileft ),
485  $ work( iright ), work( iwork ), iinfo )
486  IF( iinfo.NE.0 ) THEN
487  info = n + 1
488  GO TO 120
489  END IF
490 *
491 * Reduce B to triangular form, and initialize VL and/or VR
492 * Workspace layout: ("work..." must have at least N words)
493 * left_permutation, right_permutation, tau, work...
494 *
495  irows = ihi + 1 - ilo
496  IF( ilv ) THEN
497  icols = n + 1 - ilo
498  ELSE
499  icols = irows
500  END IF
501  itau = iwork
502  iwork = itau + irows
503  CALL dgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
504  $ work( iwork ), lwork+1-iwork, iinfo )
505  IF( iinfo.GE.0 )
506  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
507  IF( iinfo.NE.0 ) THEN
508  info = n + 2
509  GO TO 120
510  END IF
511 *
512  CALL dormqr( 'L', 'T', irows, icols, irows, b( ilo, ilo ), ldb,
513  $ work( itau ), a( ilo, ilo ), lda, work( iwork ),
514  $ lwork+1-iwork, iinfo )
515  IF( iinfo.GE.0 )
516  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
517  IF( iinfo.NE.0 ) THEN
518  info = n + 3
519  GO TO 120
520  END IF
521 *
522  IF( ilvl ) THEN
523  CALL dlaset( 'Full', n, n, zero, one, vl, ldvl )
524  CALL dlacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
525  $ vl( ilo+1, ilo ), ldvl )
526  CALL dorgqr( irows, irows, irows, vl( ilo, ilo ), ldvl,
527  $ work( itau ), work( iwork ), lwork+1-iwork,
528  $ iinfo )
529  IF( iinfo.GE.0 )
530  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
531  IF( iinfo.NE.0 ) THEN
532  info = n + 4
533  GO TO 120
534  END IF
535  END IF
536 *
537  IF( ilvr )
538  $ CALL dlaset( 'Full', n, n, zero, one, vr, ldvr )
539 *
540 * Reduce to generalized Hessenberg form
541 *
542  IF( ilv ) THEN
543 *
544 * Eigenvectors requested -- work on whole matrix.
545 *
546  CALL dgghrd( jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb, vl,
547  $ ldvl, vr, ldvr, iinfo )
548  ELSE
549  CALL dgghrd( 'N', 'N', irows, 1, irows, a( ilo, ilo ), lda,
550  $ b( ilo, ilo ), ldb, vl, ldvl, vr, ldvr, iinfo )
551  END IF
552  IF( iinfo.NE.0 ) THEN
553  info = n + 5
554  GO TO 120
555  END IF
556 *
557 * Perform QZ algorithm
558 * Workspace layout: ("work..." must have at least 1 word)
559 * left_permutation, right_permutation, work...
560 *
561  iwork = itau
562  IF( ilv ) THEN
563  chtemp = 'S'
564  ELSE
565  chtemp = 'E'
566  END IF
567  CALL dhgeqz( chtemp, jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb,
568  $ alphar, alphai, beta, vl, ldvl, vr, ldvr,
569  $ work( iwork ), lwork+1-iwork, iinfo )
570  IF( iinfo.GE.0 )
571  $ lwkopt = max( lwkopt, int( work( iwork ) )+iwork-1 )
572  IF( iinfo.NE.0 ) THEN
573  IF( iinfo.GT.0 .AND. iinfo.LE.n ) THEN
574  info = iinfo
575  ELSE IF( iinfo.GT.n .AND. iinfo.LE.2*n ) THEN
576  info = iinfo - n
577  ELSE
578  info = n + 6
579  END IF
580  GO TO 120
581  END IF
582 *
583  IF( ilv ) THEN
584 *
585 * Compute Eigenvectors (DTGEVC requires 6*N words of workspace)
586 *
587  IF( ilvl ) THEN
588  IF( ilvr ) THEN
589  chtemp = 'B'
590  ELSE
591  chtemp = 'L'
592  END IF
593  ELSE
594  chtemp = 'R'
595  END IF
596 *
597  CALL dtgevc( chtemp, 'B', ldumma, n, a, lda, b, ldb, vl, ldvl,
598  $ vr, ldvr, n, in, work( iwork ), iinfo )
599  IF( iinfo.NE.0 ) THEN
600  info = n + 7
601  GO TO 120
602  END IF
603 *
604 * Undo balancing on VL and VR, rescale
605 *
606  IF( ilvl ) THEN
607  CALL dggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
608  $ work( iright ), n, vl, ldvl, iinfo )
609  IF( iinfo.NE.0 ) THEN
610  info = n + 8
611  GO TO 120
612  END IF
613  DO 50 jc = 1, n
614  IF( alphai( jc ).LT.zero )
615  $ GO TO 50
616  temp = zero
617  IF( alphai( jc ).EQ.zero ) THEN
618  DO 10 jr = 1, n
619  temp = max( temp, abs( vl( jr, jc ) ) )
620  10 CONTINUE
621  ELSE
622  DO 20 jr = 1, n
623  temp = max( temp, abs( vl( jr, jc ) )+
624  $ abs( vl( jr, jc+1 ) ) )
625  20 CONTINUE
626  END IF
627  IF( temp.LT.safmin )
628  $ GO TO 50
629  temp = one / temp
630  IF( alphai( jc ).EQ.zero ) THEN
631  DO 30 jr = 1, n
632  vl( jr, jc ) = vl( jr, jc )*temp
633  30 CONTINUE
634  ELSE
635  DO 40 jr = 1, n
636  vl( jr, jc ) = vl( jr, jc )*temp
637  vl( jr, jc+1 ) = vl( jr, jc+1 )*temp
638  40 CONTINUE
639  END IF
640  50 CONTINUE
641  END IF
642  IF( ilvr ) THEN
643  CALL dggbak( 'P', 'R', n, ilo, ihi, work( ileft ),
644  $ work( iright ), n, vr, ldvr, iinfo )
645  IF( iinfo.NE.0 ) THEN
646  info = n + 9
647  GO TO 120
648  END IF
649  DO 100 jc = 1, n
650  IF( alphai( jc ).LT.zero )
651  $ GO TO 100
652  temp = zero
653  IF( alphai( jc ).EQ.zero ) THEN
654  DO 60 jr = 1, n
655  temp = max( temp, abs( vr( jr, jc ) ) )
656  60 CONTINUE
657  ELSE
658  DO 70 jr = 1, n
659  temp = max( temp, abs( vr( jr, jc ) )+
660  $ abs( vr( jr, jc+1 ) ) )
661  70 CONTINUE
662  END IF
663  IF( temp.LT.safmin )
664  $ GO TO 100
665  temp = one / temp
666  IF( alphai( jc ).EQ.zero ) THEN
667  DO 80 jr = 1, n
668  vr( jr, jc ) = vr( jr, jc )*temp
669  80 CONTINUE
670  ELSE
671  DO 90 jr = 1, n
672  vr( jr, jc ) = vr( jr, jc )*temp
673  vr( jr, jc+1 ) = vr( jr, jc+1 )*temp
674  90 CONTINUE
675  END IF
676  100 CONTINUE
677  END IF
678 *
679 * End of eigenvector calculation
680 *
681  END IF
682 *
683 * Undo scaling in alpha, beta
684 *
685 * Note: this does not give the alpha and beta for the unscaled
686 * problem.
687 *
688 * Un-scaling is limited to avoid underflow in alpha and beta
689 * if they are significant.
690 *
691  DO 110 jc = 1, n
692  absar = abs( alphar( jc ) )
693  absai = abs( alphai( jc ) )
694  absb = abs( beta( jc ) )
695  salfar = anrm*alphar( jc )
696  salfai = anrm*alphai( jc )
697  sbeta = bnrm*beta( jc )
698  ilimit = .false.
699  scale = one
700 *
701 * Check for significant underflow in ALPHAI
702 *
703  IF( abs( salfai ).LT.safmin .AND. absai.GE.
704  $ max( safmin, eps*absar, eps*absb ) ) THEN
705  ilimit = .true.
706  scale = ( onepls*safmin / anrm1 ) /
707  $ max( onepls*safmin, anrm2*absai )
708 *
709  ELSE IF( salfai.EQ.zero ) THEN
710 *
711 * If insignificant underflow in ALPHAI, then make the
712 * conjugate eigenvalue real.
713 *
714  IF( alphai( jc ).LT.zero .AND. jc.GT.1 ) THEN
715  alphai( jc-1 ) = zero
716  ELSE IF( alphai( jc ).GT.zero .AND. jc.LT.n ) THEN
717  alphai( jc+1 ) = zero
718  END IF
719  END IF
720 *
721 * Check for significant underflow in ALPHAR
722 *
723  IF( abs( salfar ).LT.safmin .AND. absar.GE.
724  $ max( safmin, eps*absai, eps*absb ) ) THEN
725  ilimit = .true.
726  scale = max( scale, ( onepls*safmin / anrm1 ) /
727  $ max( onepls*safmin, anrm2*absar ) )
728  END IF
729 *
730 * Check for significant underflow in BETA
731 *
732  IF( abs( sbeta ).LT.safmin .AND. absb.GE.
733  $ max( safmin, eps*absar, eps*absai ) ) THEN
734  ilimit = .true.
735  scale = max( scale, ( onepls*safmin / bnrm1 ) /
736  $ max( onepls*safmin, bnrm2*absb ) )
737  END IF
738 *
739 * Check for possible overflow when limiting scaling
740 *
741  IF( ilimit ) THEN
742  temp = ( scale*safmin )*max( abs( salfar ), abs( salfai ),
743  $ abs( sbeta ) )
744  IF( temp.GT.one )
745  $ scale = scale / temp
746  IF( scale.LT.one )
747  $ ilimit = .false.
748  END IF
749 *
750 * Recompute un-scaled ALPHAR, ALPHAI, BETA if necessary.
751 *
752  IF( ilimit ) THEN
753  salfar = ( scale*alphar( jc ) )*anrm
754  salfai = ( scale*alphai( jc ) )*anrm
755  sbeta = ( scale*beta( jc ) )*bnrm
756  END IF
757  alphar( jc ) = salfar
758  alphai( jc ) = salfai
759  beta( jc ) = sbeta
760  110 CONTINUE
761 *
762  120 CONTINUE
763  work( 1 ) = lwkopt
764 *
765  RETURN
766 *
767 * End of DGEGV
768 *
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGEQRF
Definition: dgeqrf.f:138
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
DGGHRD
Definition: dgghrd.f:209
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
Definition: dormqr.f:169
subroutine dhgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
DHGEQZ
Definition: dhgeqz.f:306
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:130
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dtgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
DTGEVC
Definition: dtgevc.f:297
subroutine dggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
DGGBAL
Definition: dggbal.f:179
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
DGGBAK
Definition: dggbak.f:149
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83

Here is the call graph for this function:

subroutine dgges ( character  JOBVSL,
character  JOBVSR,
character  SORT,
external  SELCTG,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( ldb, * )  B,
integer  LDB,
integer  SDIM,
double precision, dimension( * )  ALPHAR,
double precision, dimension( * )  ALPHAI,
double precision, dimension( * )  BETA,
double precision, dimension( ldvsl, * )  VSL,
integer  LDVSL,
double precision, dimension( ldvsr, * )  VSR,
integer  LDVSR,
double precision, dimension( * )  WORK,
integer  LWORK,
logical, dimension( * )  BWORK,
integer  INFO 
)

DGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices

Download DGGES + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DGGES computes for a pair of N-by-N real nonsymmetric matrices (A,B),
 the generalized eigenvalues, the generalized real Schur form (S,T),
 optionally, the left and/or right matrices of Schur vectors (VSL and
 VSR). This gives the generalized Schur factorization

          (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T )

 Optionally, it also orders the eigenvalues so that a selected cluster
 of eigenvalues appears in the leading diagonal blocks of the upper
 quasi-triangular matrix S and the upper triangular matrix T.The
 leading columns of VSL and VSR then form an orthonormal basis for the
 corresponding left and right eigenspaces (deflating subspaces).

 (If only the generalized eigenvalues are needed, use the driver
 DGGEV instead, which is faster.)

 A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
 or a ratio alpha/beta = w, such that  A - w*B is singular.  It is
 usually represented as the pair (alpha,beta), as there is a
 reasonable interpretation for beta=0 or both being zero.

 A pair of matrices (S,T) is in generalized real Schur form if T is
 upper triangular with non-negative diagonal and S is block upper
 triangular with 1-by-1 and 2-by-2 blocks.  1-by-1 blocks correspond
 to real generalized eigenvalues, while 2-by-2 blocks of S will be
 "standardized" by making the corresponding elements of T have the
 form:
         [  a  0  ]
         [  0  b  ]

 and the pair of corresponding 2-by-2 blocks in S and T will have a
 complex conjugate pair of generalized eigenvalues.
Parameters
[in]JOBVSL
          JOBVSL is CHARACTER*1
          = 'N':  do not compute the left Schur vectors;
          = 'V':  compute the left Schur vectors.
[in]JOBVSR
          JOBVSR is CHARACTER*1
          = 'N':  do not compute the right Schur vectors;
          = 'V':  compute the right Schur vectors.
[in]SORT
          SORT is CHARACTER*1
          Specifies whether or not to order the eigenvalues on the
          diagonal of the generalized Schur form.
          = 'N':  Eigenvalues are not ordered;
          = 'S':  Eigenvalues are ordered (see SELCTG);
[in]SELCTG
          SELCTG is a LOGICAL FUNCTION of three DOUBLE PRECISION arguments
          SELCTG must be declared EXTERNAL in the calling subroutine.
          If SORT = 'N', SELCTG is not referenced.
          If SORT = 'S', SELCTG is used to select eigenvalues to sort
          to the top left of the Schur form.
          An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
          SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
          one of a complex conjugate pair of eigenvalues is selected,
          then both complex eigenvalues are selected.

          Note that in the ill-conditioned case, a selected complex
          eigenvalue may no longer satisfy SELCTG(ALPHAR(j),ALPHAI(j),
          BETA(j)) = .TRUE. after ordering. INFO is to be set to N+2
          in this case.
[in]N
          N is INTEGER
          The order of the matrices A, B, VSL, and VSR.  N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA, N)
          On entry, the first of the pair of matrices.
          On exit, A has been overwritten by its generalized Schur
          form S.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  LDA >= max(1,N).
[in,out]B
          B is DOUBLE PRECISION array, dimension (LDB, N)
          On entry, the second of the pair of matrices.
          On exit, B has been overwritten by its generalized Schur
          form T.
[in]LDB
          LDB is INTEGER
          The leading dimension of B.  LDB >= max(1,N).
[out]SDIM
          SDIM is INTEGER
          If SORT = 'N', SDIM = 0.
          If SORT = 'S', SDIM = number of eigenvalues (after sorting)
          for which SELCTG is true.  (Complex conjugate pairs for which
          SELCTG is true for either eigenvalue count as 2.)
[out]ALPHAR
          ALPHAR is DOUBLE PRECISION array, dimension (N)
[out]ALPHAI
          ALPHAI is DOUBLE PRECISION array, dimension (N)
[out]BETA
          BETA is DOUBLE PRECISION array, dimension (N)
          On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
          be the generalized eigenvalues.  ALPHAR(j) + ALPHAI(j)*i,
          and  BETA(j),j=1,...,N are the diagonals of the complex Schur
          form (S,T) that would result if the 2-by-2 diagonal blocks of
          the real Schur form of (A,B) were further reduced to
          triangular form using 2-by-2 complex unitary transformations.
          If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
          positive, then the j-th and (j+1)-st eigenvalues are a
          complex conjugate pair, with ALPHAI(j+1) negative.

          Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
          may easily over- or underflow, and BETA(j) may even be zero.
          Thus, the user should avoid naively computing the ratio.
          However, ALPHAR and ALPHAI will be always less than and
          usually comparable with norm(A) in magnitude, and BETA always
          less than and usually comparable with norm(B).
[out]VSL
          VSL is DOUBLE PRECISION array, dimension (LDVSL,N)
          If JOBVSL = 'V', VSL will contain the left Schur vectors.
          Not referenced if JOBVSL = 'N'.
[in]LDVSL
          LDVSL is INTEGER
          The leading dimension of the matrix VSL. LDVSL >=1, and
          if JOBVSL = 'V', LDVSL >= N.
[out]VSR
          VSR is DOUBLE PRECISION array, dimension (LDVSR,N)
          If JOBVSR = 'V', VSR will contain the right Schur vectors.
          Not referenced if JOBVSR = 'N'.
[in]LDVSR
          LDVSR is INTEGER
          The leading dimension of the matrix VSR. LDVSR >= 1, and
          if JOBVSR = 'V', LDVSR >= N.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.
          If N = 0, LWORK >= 1, else LWORK >= 8*N+16.
          For good performance , LWORK must generally be larger.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]BWORK
          BWORK is LOGICAL array, dimension (N)
          Not referenced if SORT = 'N'.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          = 1,...,N:
                The QZ iteration failed.  (A,B) are not in Schur
                form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
                be correct for j=INFO+1,...,N.
          > N:  =N+1: other than QZ iteration failed in DHGEQZ.
                =N+2: after reordering, roundoff changed values of
                      some complex eigenvalues so that leading
                      eigenvalues in the Generalized Schur form no
                      longer satisfy SELCTG=.TRUE.  This could also
                      be caused due to scaling.
                =N+3: reordering failed in DTGSEN.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 286 of file dgges.f.

286 *
287 * -- LAPACK driver routine (version 3.4.0) --
288 * -- LAPACK is a software package provided by Univ. of Tennessee, --
289 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
290 * November 2011
291 *
292 * .. Scalar Arguments ..
293  CHARACTER jobvsl, jobvsr, sort
294  INTEGER info, lda, ldb, ldvsl, ldvsr, lwork, n, sdim
295 * ..
296 * .. Array Arguments ..
297  LOGICAL bwork( * )
298  DOUBLE PRECISION a( lda, * ), alphai( * ), alphar( * ),
299  $ b( ldb, * ), beta( * ), vsl( ldvsl, * ),
300  $ vsr( ldvsr, * ), work( * )
301 * ..
302 * .. Function Arguments ..
303  LOGICAL selctg
304  EXTERNAL selctg
305 * ..
306 *
307 * =====================================================================
308 *
309 * .. Parameters ..
310  DOUBLE PRECISION zero, one
311  parameter( zero = 0.0d+0, one = 1.0d+0 )
312 * ..
313 * .. Local Scalars ..
314  LOGICAL cursl, ilascl, ilbscl, ilvsl, ilvsr, lastsl,
315  $ lquery, lst2sl, wantst
316  INTEGER i, icols, ierr, ihi, ijobvl, ijobvr, ileft,
317  $ ilo, ip, iright, irows, itau, iwrk, maxwrk,
318  $ minwrk
319  DOUBLE PRECISION anrm, anrmto, bignum, bnrm, bnrmto, eps, pvsl,
320  $ pvsr, safmax, safmin, smlnum
321 * ..
322 * .. Local Arrays ..
323  INTEGER idum( 1 )
324  DOUBLE PRECISION dif( 2 )
325 * ..
326 * .. External Subroutines ..
327  EXTERNAL dgeqrf, dggbak, dggbal, dgghrd, dhgeqz, dlabad,
329  $ xerbla
330 * ..
331 * .. External Functions ..
332  LOGICAL lsame
333  INTEGER ilaenv
334  DOUBLE PRECISION dlamch, dlange
335  EXTERNAL lsame, ilaenv, dlamch, dlange
336 * ..
337 * .. Intrinsic Functions ..
338  INTRINSIC abs, max, sqrt
339 * ..
340 * .. Executable Statements ..
341 *
342 * Decode the input arguments
343 *
344  IF( lsame( jobvsl, 'N' ) ) THEN
345  ijobvl = 1
346  ilvsl = .false.
347  ELSE IF( lsame( jobvsl, 'V' ) ) THEN
348  ijobvl = 2
349  ilvsl = .true.
350  ELSE
351  ijobvl = -1
352  ilvsl = .false.
353  END IF
354 *
355  IF( lsame( jobvsr, 'N' ) ) THEN
356  ijobvr = 1
357  ilvsr = .false.
358  ELSE IF( lsame( jobvsr, 'V' ) ) THEN
359  ijobvr = 2
360  ilvsr = .true.
361  ELSE
362  ijobvr = -1
363  ilvsr = .false.
364  END IF
365 *
366  wantst = lsame( sort, 'S' )
367 *
368 * Test the input arguments
369 *
370  info = 0
371  lquery = ( lwork.EQ.-1 )
372  IF( ijobvl.LE.0 ) THEN
373  info = -1
374  ELSE IF( ijobvr.LE.0 ) THEN
375  info = -2
376  ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.lsame( sort, 'N' ) ) ) THEN
377  info = -3
378  ELSE IF( n.LT.0 ) THEN
379  info = -5
380  ELSE IF( lda.LT.max( 1, n ) ) THEN
381  info = -7
382  ELSE IF( ldb.LT.max( 1, n ) ) THEN
383  info = -9
384  ELSE IF( ldvsl.LT.1 .OR. ( ilvsl .AND. ldvsl.LT.n ) ) THEN
385  info = -15
386  ELSE IF( ldvsr.LT.1 .OR. ( ilvsr .AND. ldvsr.LT.n ) ) THEN
387  info = -17
388  END IF
389 *
390 * Compute workspace
391 * (Note: Comments in the code beginning "Workspace:" describe the
392 * minimal amount of workspace needed at that point in the code,
393 * as well as the preferred amount for good performance.
394 * NB refers to the optimal block size for the immediately
395 * following subroutine, as returned by ILAENV.)
396 *
397  IF( info.EQ.0 ) THEN
398  IF( n.GT.0 )THEN
399  minwrk = max( 8*n, 6*n + 16 )
400  maxwrk = minwrk - n +
401  $ n*ilaenv( 1, 'DGEQRF', ' ', n, 1, n, 0 )
402  maxwrk = max( maxwrk, minwrk - n +
403  $ n*ilaenv( 1, 'DORMQR', ' ', n, 1, n, -1 ) )
404  IF( ilvsl ) THEN
405  maxwrk = max( maxwrk, minwrk - n +
406  $ n*ilaenv( 1, 'DORGQR', ' ', n, 1, n, -1 ) )
407  END IF
408  ELSE
409  minwrk = 1
410  maxwrk = 1
411  END IF
412  work( 1 ) = maxwrk
413 *
414  IF( lwork.LT.minwrk .AND. .NOT.lquery )
415  $ info = -19
416  END IF
417 *
418  IF( info.NE.0 ) THEN
419  CALL xerbla( 'DGGES ', -info )
420  RETURN
421  ELSE IF( lquery ) THEN
422  RETURN
423  END IF
424 *
425 * Quick return if possible
426 *
427  IF( n.EQ.0 ) THEN
428  sdim = 0
429  RETURN
430  END IF
431 *
432 * Get machine constants
433 *
434  eps = dlamch( 'P' )
435  safmin = dlamch( 'S' )
436  safmax = one / safmin
437  CALL dlabad( safmin, safmax )
438  smlnum = sqrt( safmin ) / eps
439  bignum = one / smlnum
440 *
441 * Scale A if max element outside range [SMLNUM,BIGNUM]
442 *
443  anrm = dlange( 'M', n, n, a, lda, work )
444  ilascl = .false.
445  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
446  anrmto = smlnum
447  ilascl = .true.
448  ELSE IF( anrm.GT.bignum ) THEN
449  anrmto = bignum
450  ilascl = .true.
451  END IF
452  IF( ilascl )
453  $ CALL dlascl( 'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
454 *
455 * Scale B if max element outside range [SMLNUM,BIGNUM]
456 *
457  bnrm = dlange( 'M', n, n, b, ldb, work )
458  ilbscl = .false.
459  IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) THEN
460  bnrmto = smlnum
461  ilbscl = .true.
462  ELSE IF( bnrm.GT.bignum ) THEN
463  bnrmto = bignum
464  ilbscl = .true.
465  END IF
466  IF( ilbscl )
467  $ CALL dlascl( 'G', 0, 0, bnrm, bnrmto, n, n, b, ldb, ierr )
468 *
469 * Permute the matrix to make it more nearly triangular
470 * (Workspace: need 6*N + 2*N space for storing balancing factors)
471 *
472  ileft = 1
473  iright = n + 1
474  iwrk = iright + n
475  CALL dggbal( 'P', n, a, lda, b, ldb, ilo, ihi, work( ileft ),
476  $ work( iright ), work( iwrk ), ierr )
477 *
478 * Reduce B to triangular form (QR decomposition of B)
479 * (Workspace: need N, prefer N*NB)
480 *
481  irows = ihi + 1 - ilo
482  icols = n + 1 - ilo
483  itau = iwrk
484  iwrk = itau + irows
485  CALL dgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
486  $ work( iwrk ), lwork+1-iwrk, ierr )
487 *
488 * Apply the orthogonal transformation to matrix A
489 * (Workspace: need N, prefer N*NB)
490 *
491  CALL dormqr( 'L', 'T', irows, icols, irows, b( ilo, ilo ), ldb,
492  $ work( itau ), a( ilo, ilo ), lda, work( iwrk ),
493  $ lwork+1-iwrk, ierr )
494 *
495 * Initialize VSL
496 * (Workspace: need N, prefer N*NB)
497 *
498  IF( ilvsl ) THEN
499  CALL dlaset( 'Full', n, n, zero, one, vsl, ldvsl )
500  IF( irows.GT.1 ) THEN
501  CALL dlacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
502  $ vsl( ilo+1, ilo ), ldvsl )
503  END IF
504  CALL dorgqr( irows, irows, irows, vsl( ilo, ilo ), ldvsl,
505  $ work( itau ), work( iwrk ), lwork+1-iwrk, ierr )
506  END IF
507 *
508 * Initialize VSR
509 *
510  IF( ilvsr )
511  $ CALL dlaset( 'Full', n, n, zero, one, vsr, ldvsr )
512 *
513 * Reduce to generalized Hessenberg form
514 * (Workspace: none needed)
515 *
516  CALL dgghrd( jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb, vsl,
517  $ ldvsl, vsr, ldvsr, ierr )
518 *
519 * Perform QZ algorithm, computing Schur vectors if desired
520 * (Workspace: need N)
521 *
522  iwrk = itau
523  CALL dhgeqz( 'S', jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb,
524  $ alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr,
525  $ work( iwrk ), lwork+1-iwrk, ierr )
526  IF( ierr.NE.0 ) THEN
527  IF( ierr.GT.0 .AND. ierr.LE.n ) THEN
528  info = ierr
529  ELSE IF( ierr.GT.n .AND. ierr.LE.2*n ) THEN
530  info = ierr - n
531  ELSE
532  info = n + 1
533  END IF
534  GO TO 50
535  END IF
536 *
537 * Sort eigenvalues ALPHA/BETA if desired
538 * (Workspace: need 4*N+16 )
539 *
540  sdim = 0
541  IF( wantst ) THEN
542 *
543 * Undo scaling on eigenvalues before SELCTGing
544 *
545  IF( ilascl ) THEN
546  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n,
547  $ ierr )
548  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n,
549  $ ierr )
550  END IF
551  IF( ilbscl )
552  $ CALL dlascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
553 *
554 * Select eigenvalues
555 *
556  DO 10 i = 1, n
557  bwork( i ) = selctg( alphar( i ), alphai( i ), beta( i ) )
558  10 CONTINUE
559 *
560  CALL dtgsen( 0, ilvsl, ilvsr, bwork, n, a, lda, b, ldb, alphar,
561  $ alphai, beta, vsl, ldvsl, vsr, ldvsr, sdim, pvsl,
562  $ pvsr, dif, work( iwrk ), lwork-iwrk+1, idum, 1,
563  $ ierr )
564  IF( ierr.EQ.1 )
565  $ info = n + 3
566 *
567  END IF
568 *
569 * Apply back-permutation to VSL and VSR
570 * (Workspace: none needed)
571 *
572  IF( ilvsl )
573  $ CALL dggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
574  $ work( iright ), n, vsl, ldvsl, ierr )
575 *
576  IF( ilvsr )
577  $ CALL dggbak( 'P', 'R', n, ilo, ihi, work( ileft ),
578  $ work( iright ), n, vsr, ldvsr, ierr )
579 *
580 * Check if unscaling would cause over/underflow, if so, rescale
581 * (ALPHAR(I),ALPHAI(I),BETA(I)) so BETA(I) is on the order of
582 * B(I,I) and ALPHAR(I) and ALPHAI(I) are on the order of A(I,I)
583 *
584  IF( ilascl ) THEN
585  DO 20 i = 1, n
586  IF( alphai( i ).NE.zero ) THEN
587  IF( ( alphar( i ) / safmax ).GT.( anrmto / anrm ) .OR.
588  $ ( safmin / alphar( i ) ).GT.( anrm / anrmto ) ) THEN
589  work( 1 ) = abs( a( i, i ) / alphar( i ) )
590  beta( i ) = beta( i )*work( 1 )
591  alphar( i ) = alphar( i )*work( 1 )
592  alphai( i ) = alphai( i )*work( 1 )
593  ELSE IF( ( alphai( i ) / safmax ).GT.
594  $ ( anrmto / anrm ) .OR.
595  $ ( safmin / alphai( i ) ).GT.( anrm / anrmto ) )
596  $ THEN
597  work( 1 ) = abs( a( i, i+1 ) / alphai( i ) )
598  beta( i ) = beta( i )*work( 1 )
599  alphar( i ) = alphar( i )*work( 1 )
600  alphai( i ) = alphai( i )*work( 1 )
601  END IF
602  END IF
603  20 CONTINUE
604  END IF
605 *
606  IF( ilbscl ) THEN
607  DO 30 i = 1, n
608  IF( alphai( i ).NE.zero ) THEN
609  IF( ( beta( i ) / safmax ).GT.( bnrmto / bnrm ) .OR.
610  $ ( safmin / beta( i ) ).GT.( bnrm / bnrmto ) ) THEN
611  work( 1 ) = abs( b( i, i ) / beta( i ) )
612  beta( i ) = beta( i )*work( 1 )
613  alphar( i ) = alphar( i )*work( 1 )
614  alphai( i ) = alphai( i )*work( 1 )
615  END IF
616  END IF
617  30 CONTINUE
618  END IF
619 *
620 * Undo scaling
621 *
622  IF( ilascl ) THEN
623  CALL dlascl( 'H', 0, 0, anrmto, anrm, n, n, a, lda, ierr )
624  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n, ierr )
625  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n, ierr )
626  END IF
627 *
628  IF( ilbscl ) THEN
629  CALL dlascl( 'U', 0, 0, bnrmto, bnrm, n, n, b, ldb, ierr )
630  CALL dlascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
631  END IF
632 *
633  IF( wantst ) THEN
634 *
635 * Check if reordering is correct
636 *
637  lastsl = .true.
638  lst2sl = .true.
639  sdim = 0
640  ip = 0
641  DO 40 i = 1, n
642  cursl = selctg( alphar( i ), alphai( i ), beta( i ) )
643  IF( alphai( i ).EQ.zero ) THEN
644  IF( cursl )
645  $ sdim = sdim + 1
646  ip = 0
647  IF( cursl .AND. .NOT.lastsl )
648  $ info = n + 2
649  ELSE
650  IF( ip.EQ.1 ) THEN
651 *
652 * Last eigenvalue of conjugate pair
653 *
654  cursl = cursl .OR. lastsl
655  lastsl = cursl
656  IF( cursl )
657  $ sdim = sdim + 2
658  ip = -1
659  IF( cursl .AND. .NOT.lst2sl )
660  $ info = n + 2
661  ELSE
662 *
663 * First eigenvalue of conjugate pair
664 *
665  ip = 1
666  END IF
667  END IF
668  lst2sl = lastsl
669  lastsl = cursl
670  40 CONTINUE
671 *
672  END IF
673 *
674  50 CONTINUE
675 *
676  work( 1 ) = maxwrk
677 *
678  RETURN
679 *
680 * End of DGGES
681 *
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGEQRF
Definition: dgeqrf.f:138
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
DGGHRD
Definition: dgghrd.f:209
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
Definition: dormqr.f:169
subroutine dhgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
DHGEQZ
Definition: dhgeqz.f:306
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:130
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
DGGBAL
Definition: dggbal.f:179
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
DGGBAK
Definition: dggbak.f:149
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine dtgsen(IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO)
DTGSEN
Definition: dtgsen.f:454

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine dgges3 ( character  JOBVSL,
character  JOBVSR,
character  SORT,
external  SELCTG,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( ldb, * )  B,
integer  LDB,
integer  SDIM,
double precision, dimension( * )  ALPHAR,
double precision, dimension( * )  ALPHAI,
double precision, dimension( * )  BETA,
double precision, dimension( ldvsl, * )  VSL,
integer  LDVSL,
double precision, dimension( ldvsr, * )  VSR,
integer  LDVSR,
double precision, dimension( * )  WORK,
integer  LWORK,
logical, dimension( * )  BWORK,
integer  INFO 
)

DGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices (blocked algorithm)

Download DGGES3 + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DGGES3 computes for a pair of N-by-N real nonsymmetric matrices (A,B),
 the generalized eigenvalues, the generalized real Schur form (S,T),
 optionally, the left and/or right matrices of Schur vectors (VSL and
 VSR). This gives the generalized Schur factorization

          (A,B) = ( (VSL)*S*(VSR)**T, (VSL)*T*(VSR)**T )

 Optionally, it also orders the eigenvalues so that a selected cluster
 of eigenvalues appears in the leading diagonal blocks of the upper
 quasi-triangular matrix S and the upper triangular matrix T.The
 leading columns of VSL and VSR then form an orthonormal basis for the
 corresponding left and right eigenspaces (deflating subspaces).

 (If only the generalized eigenvalues are needed, use the driver
 DGGEV instead, which is faster.)

 A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
 or a ratio alpha/beta = w, such that  A - w*B is singular.  It is
 usually represented as the pair (alpha,beta), as there is a
 reasonable interpretation for beta=0 or both being zero.

 A pair of matrices (S,T) is in generalized real Schur form if T is
 upper triangular with non-negative diagonal and S is block upper
 triangular with 1-by-1 and 2-by-2 blocks.  1-by-1 blocks correspond
 to real generalized eigenvalues, while 2-by-2 blocks of S will be
 "standardized" by making the corresponding elements of T have the
 form:
         [  a  0  ]
         [  0  b  ]

 and the pair of corresponding 2-by-2 blocks in S and T will have a
 complex conjugate pair of generalized eigenvalues.
Parameters
[in]JOBVSL
          JOBVSL is CHARACTER*1
          = 'N':  do not compute the left Schur vectors;
          = 'V':  compute the left Schur vectors.
[in]JOBVSR
          JOBVSR is CHARACTER*1
          = 'N':  do not compute the right Schur vectors;
          = 'V':  compute the right Schur vectors.
[in]SORT
          SORT is CHARACTER*1
          Specifies whether or not to order the eigenvalues on the
          diagonal of the generalized Schur form.
          = 'N':  Eigenvalues are not ordered;
          = 'S':  Eigenvalues are ordered (see SELCTG);
[in]SELCTG
          SELCTG is a LOGICAL FUNCTION of three DOUBLE PRECISION arguments
          SELCTG must be declared EXTERNAL in the calling subroutine.
          If SORT = 'N', SELCTG is not referenced.
          If SORT = 'S', SELCTG is used to select eigenvalues to sort
          to the top left of the Schur form.
          An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
          SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
          one of a complex conjugate pair of eigenvalues is selected,
          then both complex eigenvalues are selected.

          Note that in the ill-conditioned case, a selected complex
          eigenvalue may no longer satisfy SELCTG(ALPHAR(j),ALPHAI(j),
          BETA(j)) = .TRUE. after ordering. INFO is to be set to N+2
          in this case.
[in]N
          N is INTEGER
          The order of the matrices A, B, VSL, and VSR.  N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA, N)
          On entry, the first of the pair of matrices.
          On exit, A has been overwritten by its generalized Schur
          form S.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  LDA >= max(1,N).
[in,out]B
          B is DOUBLE PRECISION array, dimension (LDB, N)
          On entry, the second of the pair of matrices.
          On exit, B has been overwritten by its generalized Schur
          form T.
[in]LDB
          LDB is INTEGER
          The leading dimension of B.  LDB >= max(1,N).
[out]SDIM
          SDIM is INTEGER
          If SORT = 'N', SDIM = 0.
          If SORT = 'S', SDIM = number of eigenvalues (after sorting)
          for which SELCTG is true.  (Complex conjugate pairs for which
          SELCTG is true for either eigenvalue count as 2.)
[out]ALPHAR
          ALPHAR is DOUBLE PRECISION array, dimension (N)
[out]ALPHAI
          ALPHAI is DOUBLE PRECISION array, dimension (N)
[out]BETA
          BETA is DOUBLE PRECISION array, dimension (N)
          On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
          be the generalized eigenvalues.  ALPHAR(j) + ALPHAI(j)*i,
          and  BETA(j),j=1,...,N are the diagonals of the complex Schur
          form (S,T) that would result if the 2-by-2 diagonal blocks of
          the real Schur form of (A,B) were further reduced to
          triangular form using 2-by-2 complex unitary transformations.
          If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
          positive, then the j-th and (j+1)-st eigenvalues are a
          complex conjugate pair, with ALPHAI(j+1) negative.

          Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
          may easily over- or underflow, and BETA(j) may even be zero.
          Thus, the user should avoid naively computing the ratio.
          However, ALPHAR and ALPHAI will be always less than and
          usually comparable with norm(A) in magnitude, and BETA always
          less than and usually comparable with norm(B).
[out]VSL
          VSL is DOUBLE PRECISION array, dimension (LDVSL,N)
          If JOBVSL = 'V', VSL will contain the left Schur vectors.
          Not referenced if JOBVSL = 'N'.
[in]LDVSL
          LDVSL is INTEGER
          The leading dimension of the matrix VSL. LDVSL >=1, and
          if JOBVSL = 'V', LDVSL >= N.
[out]VSR
          VSR is DOUBLE PRECISION array, dimension (LDVSR,N)
          If JOBVSR = 'V', VSR will contain the right Schur vectors.
          Not referenced if JOBVSR = 'N'.
[in]LDVSR
          LDVSR is INTEGER
          The leading dimension of the matrix VSR. LDVSR >= 1, and
          if JOBVSR = 'V', LDVSR >= N.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]BWORK
          BWORK is LOGICAL array, dimension (N)
          Not referenced if SORT = 'N'.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          = 1,...,N:
                The QZ iteration failed.  (A,B) are not in Schur
                form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
                be correct for j=INFO+1,...,N.
          > N:  =N+1: other than QZ iteration failed in DHGEQZ.
                =N+2: after reordering, roundoff changed values of
                      some complex eigenvalues so that leading
                      eigenvalues in the Generalized Schur form no
                      longer satisfy SELCTG=.TRUE.  This could also
                      be caused due to scaling.
                =N+3: reordering failed in DTGSEN.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
January 2015

Definition at line 284 of file dgges3.f.

284 *
285 * -- LAPACK driver routine (version 3.6.0) --
286 * -- LAPACK is a software package provided by Univ. of Tennessee, --
287 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
288 * January 2015
289 *
290 * .. Scalar Arguments ..
291  CHARACTER jobvsl, jobvsr, sort
292  INTEGER info, lda, ldb, ldvsl, ldvsr, lwork, n, sdim
293 * ..
294 * .. Array Arguments ..
295  LOGICAL bwork( * )
296  DOUBLE PRECISION a( lda, * ), alphai( * ), alphar( * ),
297  $ b( ldb, * ), beta( * ), vsl( ldvsl, * ),
298  $ vsr( ldvsr, * ), work( * )
299 * ..
300 * .. Function Arguments ..
301  LOGICAL selctg
302  EXTERNAL selctg
303 * ..
304 *
305 * =====================================================================
306 *
307 * .. Parameters ..
308  DOUBLE PRECISION zero, one
309  parameter( zero = 0.0d+0, one = 1.0d+0 )
310 * ..
311 * .. Local Scalars ..
312  LOGICAL cursl, ilascl, ilbscl, ilvsl, ilvsr, lastsl,
313  $ lquery, lst2sl, wantst
314  INTEGER i, icols, ierr, ihi, ijobvl, ijobvr, ileft,
315  $ ilo, ip, iright, irows, itau, iwrk, lwkopt
316  DOUBLE PRECISION anrm, anrmto, bignum, bnrm, bnrmto, eps, pvsl,
317  $ pvsr, safmax, safmin, smlnum
318 * ..
319 * .. Local Arrays ..
320  INTEGER idum( 1 )
321  DOUBLE PRECISION dif( 2 )
322 * ..
323 * .. External Subroutines ..
324  EXTERNAL dgeqrf, dggbak, dggbal, dgghd3, dhgeqz, dlabad,
326  $ xerbla
327 * ..
328 * .. External Functions ..
329  LOGICAL lsame
330  DOUBLE PRECISION dlamch, dlange
331  EXTERNAL lsame, dlamch, dlange
332 * ..
333 * .. Intrinsic Functions ..
334  INTRINSIC abs, max, sqrt
335 * ..
336 * .. Executable Statements ..
337 *
338 * Decode the input arguments
339 *
340  IF( lsame( jobvsl, 'N' ) ) THEN
341  ijobvl = 1
342  ilvsl = .false.
343  ELSE IF( lsame( jobvsl, 'V' ) ) THEN
344  ijobvl = 2
345  ilvsl = .true.
346  ELSE
347  ijobvl = -1
348  ilvsl = .false.
349  END IF
350 *
351  IF( lsame( jobvsr, 'N' ) ) THEN
352  ijobvr = 1
353  ilvsr = .false.
354  ELSE IF( lsame( jobvsr, 'V' ) ) THEN
355  ijobvr = 2
356  ilvsr = .true.
357  ELSE
358  ijobvr = -1
359  ilvsr = .false.
360  END IF
361 *
362  wantst = lsame( sort, 'S' )
363 *
364 * Test the input arguments
365 *
366  info = 0
367  lquery = ( lwork.EQ.-1 )
368  IF( ijobvl.LE.0 ) THEN
369  info = -1
370  ELSE IF( ijobvr.LE.0 ) THEN
371  info = -2
372  ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.lsame( sort, 'N' ) ) ) THEN
373  info = -3
374  ELSE IF( n.LT.0 ) THEN
375  info = -5
376  ELSE IF( lda.LT.max( 1, n ) ) THEN
377  info = -7
378  ELSE IF( ldb.LT.max( 1, n ) ) THEN
379  info = -9
380  ELSE IF( ldvsl.LT.1 .OR. ( ilvsl .AND. ldvsl.LT.n ) ) THEN
381  info = -15
382  ELSE IF( ldvsr.LT.1 .OR. ( ilvsr .AND. ldvsr.LT.n ) ) THEN
383  info = -17
384  ELSE IF( lwork.LT.6*n+16 .AND. .NOT.lquery ) THEN
385  info = -19
386  END IF
387 *
388 * Compute workspace
389 *
390  IF( info.EQ.0 ) THEN
391  CALL dgeqrf( n, n, b, ldb, work, work, -1, ierr )
392  lwkopt = max( 6*n+16, 3*n+int( work( 1 ) ) )
393  CALL dormqr( 'L', 'T', n, n, n, b, ldb, work, a, lda, work,
394  $ -1, ierr )
395  lwkopt = max( lwkopt, 3*n+int( work( 1 ) ) )
396  IF( ilvsl ) THEN
397  CALL dorgqr( n, n, n, vsl, ldvsl, work, work, -1, ierr )
398  lwkopt = max( lwkopt, 3*n+int( work( 1 ) ) )
399  END IF
400  CALL dgghd3( jobvsl, jobvsr, n, 1, n, a, lda, b, ldb, vsl,
401  $ ldvsl, vsr, ldvsr, work, -1, ierr )
402  lwkopt = max( lwkopt, 3*n+int( work( 1 ) ) )
403  CALL dhgeqz( 'S', jobvsl, jobvsr, n, 1, n, a, lda, b, ldb,
404  $ alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr,
405  $ work, -1, ierr )
406  lwkopt = max( lwkopt, 2*n+int( work( 1 ) ) )
407  IF( wantst ) THEN
408  CALL dtgsen( 0, ilvsl, ilvsr, bwork, n, a, lda, b, ldb,
409  $ alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr,
410  $ sdim, pvsl, pvsr, dif, work, -1, idum, 1,
411  $ ierr )
412  lwkopt = max( lwkopt, 2*n+int( work( 1 ) ) )
413  END IF
414  work( 1 ) = lwkopt
415  END IF
416 *
417  IF( info.NE.0 ) THEN
418  CALL xerbla( 'DGGES3 ', -info )
419  RETURN
420  ELSE IF( lquery ) THEN
421  RETURN
422  END IF
423 *
424 * Quick return if possible
425 *
426  IF( n.EQ.0 ) THEN
427  sdim = 0
428  RETURN
429  END IF
430 *
431 * Get machine constants
432 *
433  eps = dlamch( 'P' )
434  safmin = dlamch( 'S' )
435  safmax = one / safmin
436  CALL dlabad( safmin, safmax )
437  smlnum = sqrt( safmin ) / eps
438  bignum = one / smlnum
439 *
440 * Scale A if max element outside range [SMLNUM,BIGNUM]
441 *
442  anrm = dlange( 'M', n, n, a, lda, work )
443  ilascl = .false.
444  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
445  anrmto = smlnum
446  ilascl = .true.
447  ELSE IF( anrm.GT.bignum ) THEN
448  anrmto = bignum
449  ilascl = .true.
450  END IF
451  IF( ilascl )
452  $ CALL dlascl( 'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
453 *
454 * Scale B if max element outside range [SMLNUM,BIGNUM]
455 *
456  bnrm = dlange( 'M', n, n, b, ldb, work )
457  ilbscl = .false.
458  IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) THEN
459  bnrmto = smlnum
460  ilbscl = .true.
461  ELSE IF( bnrm.GT.bignum ) THEN
462  bnrmto = bignum
463  ilbscl = .true.
464  END IF
465  IF( ilbscl )
466  $ CALL dlascl( 'G', 0, 0, bnrm, bnrmto, n, n, b, ldb, ierr )
467 *
468 * Permute the matrix to make it more nearly triangular
469 *
470  ileft = 1
471  iright = n + 1
472  iwrk = iright + n
473  CALL dggbal( 'P', n, a, lda, b, ldb, ilo, ihi, work( ileft ),
474  $ work( iright ), work( iwrk ), ierr )
475 *
476 * Reduce B to triangular form (QR decomposition of B)
477 *
478  irows = ihi + 1 - ilo
479  icols = n + 1 - ilo
480  itau = iwrk
481  iwrk = itau + irows
482  CALL dgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
483  $ work( iwrk ), lwork+1-iwrk, ierr )
484 *
485 * Apply the orthogonal transformation to matrix A
486 *
487  CALL dormqr( 'L', 'T', irows, icols, irows, b( ilo, ilo ), ldb,
488  $ work( itau ), a( ilo, ilo ), lda, work( iwrk ),
489  $ lwork+1-iwrk, ierr )
490 *
491 * Initialize VSL
492 *
493  IF( ilvsl ) THEN
494  CALL dlaset( 'Full', n, n, zero, one, vsl, ldvsl )
495  IF( irows.GT.1 ) THEN
496  CALL dlacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
497  $ vsl( ilo+1, ilo ), ldvsl )
498  END IF
499  CALL dorgqr( irows, irows, irows, vsl( ilo, ilo ), ldvsl,
500  $ work( itau ), work( iwrk ), lwork+1-iwrk, ierr )
501  END IF
502 *
503 * Initialize VSR
504 *
505  IF( ilvsr )
506  $ CALL dlaset( 'Full', n, n, zero, one, vsr, ldvsr )
507 *
508 * Reduce to generalized Hessenberg form
509 *
510  CALL dgghd3( jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb, vsl,
511  $ ldvsl, vsr, ldvsr, work( iwrk ), lwork+1-iwrk,
512  $ ierr )
513 *
514 * Perform QZ algorithm, computing Schur vectors if desired
515 *
516  iwrk = itau
517  CALL dhgeqz( 'S', jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb,
518  $ alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr,
519  $ work( iwrk ), lwork+1-iwrk, ierr )
520  IF( ierr.NE.0 ) THEN
521  IF( ierr.GT.0 .AND. ierr.LE.n ) THEN
522  info = ierr
523  ELSE IF( ierr.GT.n .AND. ierr.LE.2*n ) THEN
524  info = ierr - n
525  ELSE
526  info = n + 1
527  END IF
528  GO TO 50
529  END IF
530 *
531 * Sort eigenvalues ALPHA/BETA if desired
532 *
533  sdim = 0
534  IF( wantst ) THEN
535 *
536 * Undo scaling on eigenvalues before SELCTGing
537 *
538  IF( ilascl ) THEN
539  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n,
540  $ ierr )
541  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n,
542  $ ierr )
543  END IF
544  IF( ilbscl )
545  $ CALL dlascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
546 *
547 * Select eigenvalues
548 *
549  DO 10 i = 1, n
550  bwork( i ) = selctg( alphar( i ), alphai( i ), beta( i ) )
551  10 CONTINUE
552 *
553  CALL dtgsen( 0, ilvsl, ilvsr, bwork, n, a, lda, b, ldb, alphar,
554  $ alphai, beta, vsl, ldvsl, vsr, ldvsr, sdim, pvsl,
555  $ pvsr, dif, work( iwrk ), lwork-iwrk+1, idum, 1,
556  $ ierr )
557  IF( ierr.EQ.1 )
558  $ info = n + 3
559 *
560  END IF
561 *
562 * Apply back-permutation to VSL and VSR
563 *
564  IF( ilvsl )
565  $ CALL dggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
566  $ work( iright ), n, vsl, ldvsl, ierr )
567 *
568  IF( ilvsr )
569  $ CALL dggbak( 'P', 'R', n, ilo, ihi, work( ileft ),
570  $ work( iright ), n, vsr, ldvsr, ierr )
571 *
572 * Check if unscaling would cause over/underflow, if so, rescale
573 * (ALPHAR(I),ALPHAI(I),BETA(I)) so BETA(I) is on the order of
574 * B(I,I) and ALPHAR(I) and ALPHAI(I) are on the order of A(I,I)
575 *
576  IF( ilascl ) THEN
577  DO 20 i = 1, n
578  IF( alphai( i ).NE.zero ) THEN
579  IF( ( alphar( i ) / safmax ).GT.( anrmto / anrm ) .OR.
580  $ ( safmin / alphar( i ) ).GT.( anrm / anrmto ) ) THEN
581  work( 1 ) = abs( a( i, i ) / alphar( i ) )
582  beta( i ) = beta( i )*work( 1 )
583  alphar( i ) = alphar( i )*work( 1 )
584  alphai( i ) = alphai( i )*work( 1 )
585  ELSE IF( ( alphai( i ) / safmax ).GT.
586  $ ( anrmto / anrm ) .OR.
587  $ ( safmin / alphai( i ) ).GT.( anrm / anrmto ) )
588  $ THEN
589  work( 1 ) = abs( a( i, i+1 ) / alphai( i ) )
590  beta( i ) = beta( i )*work( 1 )
591  alphar( i ) = alphar( i )*work( 1 )
592  alphai( i ) = alphai( i )*work( 1 )
593  END IF
594  END IF
595  20 CONTINUE
596  END IF
597 *
598  IF( ilbscl ) THEN
599  DO 30 i = 1, n
600  IF( alphai( i ).NE.zero ) THEN
601  IF( ( beta( i ) / safmax ).GT.( bnrmto / bnrm ) .OR.
602  $ ( safmin / beta( i ) ).GT.( bnrm / bnrmto ) ) THEN
603  work( 1 ) = abs( b( i, i ) / beta( i ) )
604  beta( i ) = beta( i )*work( 1 )
605  alphar( i ) = alphar( i )*work( 1 )
606  alphai( i ) = alphai( i )*work( 1 )
607  END IF
608  END IF
609  30 CONTINUE
610  END IF
611 *
612 * Undo scaling
613 *
614  IF( ilascl ) THEN
615  CALL dlascl( 'H', 0, 0, anrmto, anrm, n, n, a, lda, ierr )
616  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n, ierr )
617  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n, ierr )
618  END IF
619 *
620  IF( ilbscl ) THEN
621  CALL dlascl( 'U', 0, 0, bnrmto, bnrm, n, n, b, ldb, ierr )
622  CALL dlascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
623  END IF
624 *
625  IF( wantst ) THEN
626 *
627 * Check if reordering is correct
628 *
629  lastsl = .true.
630  lst2sl = .true.
631  sdim = 0
632  ip = 0
633  DO 40 i = 1, n
634  cursl = selctg( alphar( i ), alphai( i ), beta( i ) )
635  IF( alphai( i ).EQ.zero ) THEN
636  IF( cursl )
637  $ sdim = sdim + 1
638  ip = 0
639  IF( cursl .AND. .NOT.lastsl )
640  $ info = n + 2
641  ELSE
642  IF( ip.EQ.1 ) THEN
643 *
644 * Last eigenvalue of conjugate pair
645 *
646  cursl = cursl .OR. lastsl
647  lastsl = cursl
648  IF( cursl )
649  $ sdim = sdim + 2
650  ip = -1
651  IF( cursl .AND. .NOT.lst2sl )
652  $ info = n + 2
653  ELSE
654 *
655 * First eigenvalue of conjugate pair
656 *
657  ip = 1
658  END IF
659  END IF
660  lst2sl = lastsl
661  lastsl = cursl
662  40 CONTINUE
663 *
664  END IF
665 *
666  50 CONTINUE
667 *
668  work( 1 ) = lwkopt
669 *
670  RETURN
671 *
672 * End of DGGES3
673 *
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGEQRF
Definition: dgeqrf.f:138
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
Definition: dormqr.f:169
subroutine dhgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
DHGEQZ
Definition: dhgeqz.f:306
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:130
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
DGGBAL
Definition: dggbal.f:179
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dgghd3(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
DGGHD3
Definition: dgghd3.f:232
subroutine dggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
DGGBAK
Definition: dggbak.f:149
subroutine dtgsen(IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO)
DTGSEN
Definition: dtgsen.f:454

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine dggesx ( character  JOBVSL,
character  JOBVSR,
character  SORT,
external  SELCTG,
character  SENSE,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( ldb, * )  B,
integer  LDB,
integer  SDIM,
double precision, dimension( * )  ALPHAR,
double precision, dimension( * )  ALPHAI,
double precision, dimension( * )  BETA,
double precision, dimension( ldvsl, * )  VSL,
integer  LDVSL,
double precision, dimension( ldvsr, * )  VSR,
integer  LDVSR,
double precision, dimension( 2 )  RCONDE,
double precision, dimension( 2 )  RCONDV,
double precision, dimension( * )  WORK,
integer  LWORK,
integer, dimension( * )  IWORK,
integer  LIWORK,
logical, dimension( * )  BWORK,
integer  INFO 
)

DGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices

Download DGGESX + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DGGESX computes for a pair of N-by-N real nonsymmetric matrices
 (A,B), the generalized eigenvalues, the real Schur form (S,T), and,
 optionally, the left and/or right matrices of Schur vectors (VSL and
 VSR).  This gives the generalized Schur factorization

      (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T )

 Optionally, it also orders the eigenvalues so that a selected cluster
 of eigenvalues appears in the leading diagonal blocks of the upper
 quasi-triangular matrix S and the upper triangular matrix T; computes
 a reciprocal condition number for the average of the selected
 eigenvalues (RCONDE); and computes a reciprocal condition number for
 the right and left deflating subspaces corresponding to the selected
 eigenvalues (RCONDV). The leading columns of VSL and VSR then form
 an orthonormal basis for the corresponding left and right eigenspaces
 (deflating subspaces).

 A generalized eigenvalue for a pair of matrices (A,B) is a scalar w
 or a ratio alpha/beta = w, such that  A - w*B is singular.  It is
 usually represented as the pair (alpha,beta), as there is a
 reasonable interpretation for beta=0 or for both being zero.

 A pair of matrices (S,T) is in generalized real Schur form if T is
 upper triangular with non-negative diagonal and S is block upper
 triangular with 1-by-1 and 2-by-2 blocks.  1-by-1 blocks correspond
 to real generalized eigenvalues, while 2-by-2 blocks of S will be
 "standardized" by making the corresponding elements of T have the
 form:
         [  a  0  ]
         [  0  b  ]

 and the pair of corresponding 2-by-2 blocks in S and T will have a
 complex conjugate pair of generalized eigenvalues.
Parameters
[in]JOBVSL
          JOBVSL is CHARACTER*1
          = 'N':  do not compute the left Schur vectors;
          = 'V':  compute the left Schur vectors.
[in]JOBVSR
          JOBVSR is CHARACTER*1
          = 'N':  do not compute the right Schur vectors;
          = 'V':  compute the right Schur vectors.
[in]SORT
          SORT is CHARACTER*1
          Specifies whether or not to order the eigenvalues on the
          diagonal of the generalized Schur form.
          = 'N':  Eigenvalues are not ordered;
          = 'S':  Eigenvalues are ordered (see SELCTG).
[in]SELCTG
          SELCTG is procedure) LOGICAL FUNCTION of three DOUBLE PRECISION arguments
          SELCTG must be declared EXTERNAL in the calling subroutine.
          If SORT = 'N', SELCTG is not referenced.
          If SORT = 'S', SELCTG is used to select eigenvalues to sort
          to the top left of the Schur form.
          An eigenvalue (ALPHAR(j)+ALPHAI(j))/BETA(j) is selected if
          SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) is true; i.e. if either
          one of a complex conjugate pair of eigenvalues is selected,
          then both complex eigenvalues are selected.
          Note that a selected complex eigenvalue may no longer satisfy
          SELCTG(ALPHAR(j),ALPHAI(j),BETA(j)) = .TRUE. after ordering,
          since ordering may change the value of complex eigenvalues
          (especially if the eigenvalue is ill-conditioned), in this
          case INFO is set to N+3.
[in]SENSE
          SENSE is CHARACTER*1
          Determines which reciprocal condition numbers are computed.
          = 'N' : None are computed;
          = 'E' : Computed for average of selected eigenvalues only;
          = 'V' : Computed for selected deflating subspaces only;
          = 'B' : Computed for both.
          If SENSE = 'E', 'V', or 'B', SORT must equal 'S'.
[in]N
          N is INTEGER
          The order of the matrices A, B, VSL, and VSR.  N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA, N)
          On entry, the first of the pair of matrices.
          On exit, A has been overwritten by its generalized Schur
          form S.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  LDA >= max(1,N).
[in,out]B
          B is DOUBLE PRECISION array, dimension (LDB, N)
          On entry, the second of the pair of matrices.
          On exit, B has been overwritten by its generalized Schur
          form T.
[in]LDB
          LDB is INTEGER
          The leading dimension of B.  LDB >= max(1,N).
[out]SDIM
          SDIM is INTEGER
          If SORT = 'N', SDIM = 0.
          If SORT = 'S', SDIM = number of eigenvalues (after sorting)
          for which SELCTG is true.  (Complex conjugate pairs for which
          SELCTG is true for either eigenvalue count as 2.)
[out]ALPHAR
          ALPHAR is DOUBLE PRECISION array, dimension (N)
[out]ALPHAI
          ALPHAI is DOUBLE PRECISION array, dimension (N)
[out]BETA
          BETA is DOUBLE PRECISION array, dimension (N)
          On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
          be the generalized eigenvalues.  ALPHAR(j) + ALPHAI(j)*i
          and BETA(j),j=1,...,N  are the diagonals of the complex Schur
          form (S,T) that would result if the 2-by-2 diagonal blocks of
          the real Schur form of (A,B) were further reduced to
          triangular form using 2-by-2 complex unitary transformations.
          If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
          positive, then the j-th and (j+1)-st eigenvalues are a
          complex conjugate pair, with ALPHAI(j+1) negative.

          Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
          may easily over- or underflow, and BETA(j) may even be zero.
          Thus, the user should avoid naively computing the ratio.
          However, ALPHAR and ALPHAI will be always less than and
          usually comparable with norm(A) in magnitude, and BETA always
          less than and usually comparable with norm(B).
[out]VSL
          VSL is DOUBLE PRECISION array, dimension (LDVSL,N)
          If JOBVSL = 'V', VSL will contain the left Schur vectors.
          Not referenced if JOBVSL = 'N'.
[in]LDVSL
          LDVSL is INTEGER
          The leading dimension of the matrix VSL. LDVSL >=1, and
          if JOBVSL = 'V', LDVSL >= N.
[out]VSR
          VSR is DOUBLE PRECISION array, dimension (LDVSR,N)
          If JOBVSR = 'V', VSR will contain the right Schur vectors.
          Not referenced if JOBVSR = 'N'.
[in]LDVSR
          LDVSR is INTEGER
          The leading dimension of the matrix VSR. LDVSR >= 1, and
          if JOBVSR = 'V', LDVSR >= N.
[out]RCONDE
          RCONDE is DOUBLE PRECISION array, dimension ( 2 )
          If SENSE = 'E' or 'B', RCONDE(1) and RCONDE(2) contain the
          reciprocal condition numbers for the average of the selected
          eigenvalues.
          Not referenced if SENSE = 'N' or 'V'.
[out]RCONDV
          RCONDV is DOUBLE PRECISION array, dimension ( 2 )
          If SENSE = 'V' or 'B', RCONDV(1) and RCONDV(2) contain the
          reciprocal condition numbers for the selected deflating
          subspaces.
          Not referenced if SENSE = 'N' or 'E'.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.
          If N = 0, LWORK >= 1, else if SENSE = 'E', 'V', or 'B',
          LWORK >= max( 8*N, 6*N+16, 2*SDIM*(N-SDIM) ), else
          LWORK >= max( 8*N, 6*N+16 ).
          Note that 2*SDIM*(N-SDIM) <= N*N/2.
          Note also that an error is only returned if
          LWORK < max( 8*N, 6*N+16), but if SENSE = 'E' or 'V' or 'B'
          this may not be large enough.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the bound on the optimal size of the WORK
          array and the minimum size of the IWORK array, returns these
          values as the first entries of the WORK and IWORK arrays, and
          no error message related to LWORK or LIWORK is issued by
          XERBLA.
[out]IWORK
          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
          On exit, if INFO = 0, IWORK(1) returns the minimum LIWORK.
[in]LIWORK
          LIWORK is INTEGER
          The dimension of the array IWORK.
          If SENSE = 'N' or N = 0, LIWORK >= 1, otherwise
          LIWORK >= N+6.

          If LIWORK = -1, then a workspace query is assumed; the
          routine only calculates the bound on the optimal size of the
          WORK array and the minimum size of the IWORK array, returns
          these values as the first entries of the WORK and IWORK
          arrays, and no error message related to LWORK or LIWORK is
          issued by XERBLA.
[out]BWORK
          BWORK is LOGICAL array, dimension (N)
          Not referenced if SORT = 'N'.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          = 1,...,N:
                The QZ iteration failed.  (A,B) are not in Schur
                form, but ALPHAR(j), ALPHAI(j), and BETA(j) should
                be correct for j=INFO+1,...,N.
          > N:  =N+1: other than QZ iteration failed in DHGEQZ
                =N+2: after reordering, roundoff changed values of
                      some complex eigenvalues so that leading
                      eigenvalues in the Generalized Schur form no
                      longer satisfy SELCTG=.TRUE.  This could also
                      be caused due to scaling.
                =N+3: reordering failed in DTGSEN.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011
Further Details:
  An approximate (asymptotic) bound on the average absolute error of
  the selected eigenvalues is

       EPS * norm((A, B)) / RCONDE( 1 ).

  An approximate (asymptotic) bound on the maximum angular error in
  the computed deflating subspaces is

       EPS * norm((A, B)) / RCONDV( 2 ).

  See LAPACK User's Guide, section 4.11 for more information.

Definition at line 367 of file dggesx.f.

367 *
368 * -- LAPACK driver routine (version 3.4.0) --
369 * -- LAPACK is a software package provided by Univ. of Tennessee, --
370 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
371 * November 2011
372 *
373 * .. Scalar Arguments ..
374  CHARACTER jobvsl, jobvsr, sense, sort
375  INTEGER info, lda, ldb, ldvsl, ldvsr, liwork, lwork, n,
376  $ sdim
377 * ..
378 * .. Array Arguments ..
379  LOGICAL bwork( * )
380  INTEGER iwork( * )
381  DOUBLE PRECISION a( lda, * ), alphai( * ), alphar( * ),
382  $ b( ldb, * ), beta( * ), rconde( 2 ),
383  $ rcondv( 2 ), vsl( ldvsl, * ), vsr( ldvsr, * ),
384  $ work( * )
385 * ..
386 * .. Function Arguments ..
387  LOGICAL selctg
388  EXTERNAL selctg
389 * ..
390 *
391 * =====================================================================
392 *
393 * .. Parameters ..
394  DOUBLE PRECISION zero, one
395  parameter( zero = 0.0d+0, one = 1.0d+0 )
396 * ..
397 * .. Local Scalars ..
398  LOGICAL cursl, ilascl, ilbscl, ilvsl, ilvsr, lastsl,
399  $ lquery, lst2sl, wantsb, wantse, wantsn, wantst,
400  $ wantsv
401  INTEGER i, icols, ierr, ihi, ijob, ijobvl, ijobvr,
402  $ ileft, ilo, ip, iright, irows, itau, iwrk,
403  $ liwmin, lwrk, maxwrk, minwrk
404  DOUBLE PRECISION anrm, anrmto, bignum, bnrm, bnrmto, eps, pl,
405  $ pr, safmax, safmin, smlnum
406 * ..
407 * .. Local Arrays ..
408  DOUBLE PRECISION dif( 2 )
409 * ..
410 * .. External Subroutines ..
411  EXTERNAL dgeqrf, dggbak, dggbal, dgghrd, dhgeqz, dlabad,
413  $ xerbla
414 * ..
415 * .. External Functions ..
416  LOGICAL lsame
417  INTEGER ilaenv
418  DOUBLE PRECISION dlamch, dlange
419  EXTERNAL lsame, ilaenv, dlamch, dlange
420 * ..
421 * .. Intrinsic Functions ..
422  INTRINSIC abs, max, sqrt
423 * ..
424 * .. Executable Statements ..
425 *
426 * Decode the input arguments
427 *
428  IF( lsame( jobvsl, 'N' ) ) THEN
429  ijobvl = 1
430  ilvsl = .false.
431  ELSE IF( lsame( jobvsl, 'V' ) ) THEN
432  ijobvl = 2
433  ilvsl = .true.
434  ELSE
435  ijobvl = -1
436  ilvsl = .false.
437  END IF
438 *
439  IF( lsame( jobvsr, 'N' ) ) THEN
440  ijobvr = 1
441  ilvsr = .false.
442  ELSE IF( lsame( jobvsr, 'V' ) ) THEN
443  ijobvr = 2
444  ilvsr = .true.
445  ELSE
446  ijobvr = -1
447  ilvsr = .false.
448  END IF
449 *
450  wantst = lsame( sort, 'S' )
451  wantsn = lsame( sense, 'N' )
452  wantse = lsame( sense, 'E' )
453  wantsv = lsame( sense, 'V' )
454  wantsb = lsame( sense, 'B' )
455  lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
456  IF( wantsn ) THEN
457  ijob = 0
458  ELSE IF( wantse ) THEN
459  ijob = 1
460  ELSE IF( wantsv ) THEN
461  ijob = 2
462  ELSE IF( wantsb ) THEN
463  ijob = 4
464  END IF
465 *
466 * Test the input arguments
467 *
468  info = 0
469  IF( ijobvl.LE.0 ) THEN
470  info = -1
471  ELSE IF( ijobvr.LE.0 ) THEN
472  info = -2
473  ELSE IF( ( .NOT.wantst ) .AND. ( .NOT.lsame( sort, 'N' ) ) ) THEN
474  info = -3
475  ELSE IF( .NOT.( wantsn .OR. wantse .OR. wantsv .OR. wantsb ) .OR.
476  $ ( .NOT.wantst .AND. .NOT.wantsn ) ) THEN
477  info = -5
478  ELSE IF( n.LT.0 ) THEN
479  info = -6
480  ELSE IF( lda.LT.max( 1, n ) ) THEN
481  info = -8
482  ELSE IF( ldb.LT.max( 1, n ) ) THEN
483  info = -10
484  ELSE IF( ldvsl.LT.1 .OR. ( ilvsl .AND. ldvsl.LT.n ) ) THEN
485  info = -16
486  ELSE IF( ldvsr.LT.1 .OR. ( ilvsr .AND. ldvsr.LT.n ) ) THEN
487  info = -18
488  END IF
489 *
490 * Compute workspace
491 * (Note: Comments in the code beginning "Workspace:" describe the
492 * minimal amount of workspace needed at that point in the code,
493 * as well as the preferred amount for good performance.
494 * NB refers to the optimal block size for the immediately
495 * following subroutine, as returned by ILAENV.)
496 *
497  IF( info.EQ.0 ) THEN
498  IF( n.GT.0) THEN
499  minwrk = max( 8*n, 6*n + 16 )
500  maxwrk = minwrk - n +
501  $ n*ilaenv( 1, 'DGEQRF', ' ', n, 1, n, 0 )
502  maxwrk = max( maxwrk, minwrk - n +
503  $ n*ilaenv( 1, 'DORMQR', ' ', n, 1, n, -1 ) )
504  IF( ilvsl ) THEN
505  maxwrk = max( maxwrk, minwrk - n +
506  $ n*ilaenv( 1, 'DORGQR', ' ', n, 1, n, -1 ) )
507  END IF
508  lwrk = maxwrk
509  IF( ijob.GE.1 )
510  $ lwrk = max( lwrk, n*n/2 )
511  ELSE
512  minwrk = 1
513  maxwrk = 1
514  lwrk = 1
515  END IF
516  work( 1 ) = lwrk
517  IF( wantsn .OR. n.EQ.0 ) THEN
518  liwmin = 1
519  ELSE
520  liwmin = n + 6
521  END IF
522  iwork( 1 ) = liwmin
523 *
524  IF( lwork.LT.minwrk .AND. .NOT.lquery ) THEN
525  info = -22
526  ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery ) THEN
527  info = -24
528  END IF
529  END IF
530 *
531  IF( info.NE.0 ) THEN
532  CALL xerbla( 'DGGESX', -info )
533  RETURN
534  ELSE IF (lquery) THEN
535  RETURN
536  END IF
537 *
538 * Quick return if possible
539 *
540  IF( n.EQ.0 ) THEN
541  sdim = 0
542  RETURN
543  END IF
544 *
545 * Get machine constants
546 *
547  eps = dlamch( 'P' )
548  safmin = dlamch( 'S' )
549  safmax = one / safmin
550  CALL dlabad( safmin, safmax )
551  smlnum = sqrt( safmin ) / eps
552  bignum = one / smlnum
553 *
554 * Scale A if max element outside range [SMLNUM,BIGNUM]
555 *
556  anrm = dlange( 'M', n, n, a, lda, work )
557  ilascl = .false.
558  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
559  anrmto = smlnum
560  ilascl = .true.
561  ELSE IF( anrm.GT.bignum ) THEN
562  anrmto = bignum
563  ilascl = .true.
564  END IF
565  IF( ilascl )
566  $ CALL dlascl( 'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
567 *
568 * Scale B if max element outside range [SMLNUM,BIGNUM]
569 *
570  bnrm = dlange( 'M', n, n, b, ldb, work )
571  ilbscl = .false.
572  IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) THEN
573  bnrmto = smlnum
574  ilbscl = .true.
575  ELSE IF( bnrm.GT.bignum ) THEN
576  bnrmto = bignum
577  ilbscl = .true.
578  END IF
579  IF( ilbscl )
580  $ CALL dlascl( 'G', 0, 0, bnrm, bnrmto, n, n, b, ldb, ierr )
581 *
582 * Permute the matrix to make it more nearly triangular
583 * (Workspace: need 6*N + 2*N for permutation parameters)
584 *
585  ileft = 1
586  iright = n + 1
587  iwrk = iright + n
588  CALL dggbal( 'P', n, a, lda, b, ldb, ilo, ihi, work( ileft ),
589  $ work( iright ), work( iwrk ), ierr )
590 *
591 * Reduce B to triangular form (QR decomposition of B)
592 * (Workspace: need N, prefer N*NB)
593 *
594  irows = ihi + 1 - ilo
595  icols = n + 1 - ilo
596  itau = iwrk
597  iwrk = itau + irows
598  CALL dgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
599  $ work( iwrk ), lwork+1-iwrk, ierr )
600 *
601 * Apply the orthogonal transformation to matrix A
602 * (Workspace: need N, prefer N*NB)
603 *
604  CALL dormqr( 'L', 'T', irows, icols, irows, b( ilo, ilo ), ldb,
605  $ work( itau ), a( ilo, ilo ), lda, work( iwrk ),
606  $ lwork+1-iwrk, ierr )
607 *
608 * Initialize VSL
609 * (Workspace: need N, prefer N*NB)
610 *
611  IF( ilvsl ) THEN
612  CALL dlaset( 'Full', n, n, zero, one, vsl, ldvsl )
613  IF( irows.GT.1 ) THEN
614  CALL dlacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
615  $ vsl( ilo+1, ilo ), ldvsl )
616  END IF
617  CALL dorgqr( irows, irows, irows, vsl( ilo, ilo ), ldvsl,
618  $ work( itau ), work( iwrk ), lwork+1-iwrk, ierr )
619  END IF
620 *
621 * Initialize VSR
622 *
623  IF( ilvsr )
624  $ CALL dlaset( 'Full', n, n, zero, one, vsr, ldvsr )
625 *
626 * Reduce to generalized Hessenberg form
627 * (Workspace: none needed)
628 *
629  CALL dgghrd( jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb, vsl,
630  $ ldvsl, vsr, ldvsr, ierr )
631 *
632  sdim = 0
633 *
634 * Perform QZ algorithm, computing Schur vectors if desired
635 * (Workspace: need N)
636 *
637  iwrk = itau
638  CALL dhgeqz( 'S', jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb,
639  $ alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr,
640  $ work( iwrk ), lwork+1-iwrk, ierr )
641  IF( ierr.NE.0 ) THEN
642  IF( ierr.GT.0 .AND. ierr.LE.n ) THEN
643  info = ierr
644  ELSE IF( ierr.GT.n .AND. ierr.LE.2*n ) THEN
645  info = ierr - n
646  ELSE
647  info = n + 1
648  END IF
649  GO TO 60
650  END IF
651 *
652 * Sort eigenvalues ALPHA/BETA and compute the reciprocal of
653 * condition number(s)
654 * (Workspace: If IJOB >= 1, need MAX( 8*(N+1), 2*SDIM*(N-SDIM) )
655 * otherwise, need 8*(N+1) )
656 *
657  IF( wantst ) THEN
658 *
659 * Undo scaling on eigenvalues before SELCTGing
660 *
661  IF( ilascl ) THEN
662  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n,
663  $ ierr )
664  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n,
665  $ ierr )
666  END IF
667  IF( ilbscl )
668  $ CALL dlascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
669 *
670 * Select eigenvalues
671 *
672  DO 10 i = 1, n
673  bwork( i ) = selctg( alphar( i ), alphai( i ), beta( i ) )
674  10 CONTINUE
675 *
676 * Reorder eigenvalues, transform Generalized Schur vectors, and
677 * compute reciprocal condition numbers
678 *
679  CALL dtgsen( ijob, ilvsl, ilvsr, bwork, n, a, lda, b, ldb,
680  $ alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr,
681  $ sdim, pl, pr, dif, work( iwrk ), lwork-iwrk+1,
682  $ iwork, liwork, ierr )
683 *
684  IF( ijob.GE.1 )
685  $ maxwrk = max( maxwrk, 2*sdim*( n-sdim ) )
686  IF( ierr.EQ.-22 ) THEN
687 *
688 * not enough real workspace
689 *
690  info = -22
691  ELSE
692  IF( ijob.EQ.1 .OR. ijob.EQ.4 ) THEN
693  rconde( 1 ) = pl
694  rconde( 2 ) = pr
695  END IF
696  IF( ijob.EQ.2 .OR. ijob.EQ.4 ) THEN
697  rcondv( 1 ) = dif( 1 )
698  rcondv( 2 ) = dif( 2 )
699  END IF
700  IF( ierr.EQ.1 )
701  $ info = n + 3
702  END IF
703 *
704  END IF
705 *
706 * Apply permutation to VSL and VSR
707 * (Workspace: none needed)
708 *
709  IF( ilvsl )
710  $ CALL dggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
711  $ work( iright ), n, vsl, ldvsl, ierr )
712 *
713  IF( ilvsr )
714  $ CALL dggbak( 'P', 'R', n, ilo, ihi, work( ileft ),
715  $ work( iright ), n, vsr, ldvsr, ierr )
716 *
717 * Check if unscaling would cause over/underflow, if so, rescale
718 * (ALPHAR(I),ALPHAI(I),BETA(I)) so BETA(I) is on the order of
719 * B(I,I) and ALPHAR(I) and ALPHAI(I) are on the order of A(I,I)
720 *
721  IF( ilascl ) THEN
722  DO 20 i = 1, n
723  IF( alphai( i ).NE.zero ) THEN
724  IF( ( alphar( i ) / safmax ).GT.( anrmto / anrm ) .OR.
725  $ ( safmin / alphar( i ) ).GT.( anrm / anrmto ) ) THEN
726  work( 1 ) = abs( a( i, i ) / alphar( i ) )
727  beta( i ) = beta( i )*work( 1 )
728  alphar( i ) = alphar( i )*work( 1 )
729  alphai( i ) = alphai( i )*work( 1 )
730  ELSE IF( ( alphai( i ) / safmax ).GT.
731  $ ( anrmto / anrm ) .OR.
732  $ ( safmin / alphai( i ) ).GT.( anrm / anrmto ) )
733  $ THEN
734  work( 1 ) = abs( a( i, i+1 ) / alphai( i ) )
735  beta( i ) = beta( i )*work( 1 )
736  alphar( i ) = alphar( i )*work( 1 )
737  alphai( i ) = alphai( i )*work( 1 )
738  END IF
739  END IF
740  20 CONTINUE
741  END IF
742 *
743  IF( ilbscl ) THEN
744  DO 30 i = 1, n
745  IF( alphai( i ).NE.zero ) THEN
746  IF( ( beta( i ) / safmax ).GT.( bnrmto / bnrm ) .OR.
747  $ ( safmin / beta( i ) ).GT.( bnrm / bnrmto ) ) THEN
748  work( 1 ) = abs( b( i, i ) / beta( i ) )
749  beta( i ) = beta( i )*work( 1 )
750  alphar( i ) = alphar( i )*work( 1 )
751  alphai( i ) = alphai( i )*work( 1 )
752  END IF
753  END IF
754  30 CONTINUE
755  END IF
756 *
757 * Undo scaling
758 *
759  IF( ilascl ) THEN
760  CALL dlascl( 'H', 0, 0, anrmto, anrm, n, n, a, lda, ierr )
761  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n, ierr )
762  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n, ierr )
763  END IF
764 *
765  IF( ilbscl ) THEN
766  CALL dlascl( 'U', 0, 0, bnrmto, bnrm, n, n, b, ldb, ierr )
767  CALL dlascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
768  END IF
769 *
770  IF( wantst ) THEN
771 *
772 * Check if reordering is correct
773 *
774  lastsl = .true.
775  lst2sl = .true.
776  sdim = 0
777  ip = 0
778  DO 50 i = 1, n
779  cursl = selctg( alphar( i ), alphai( i ), beta( i ) )
780  IF( alphai( i ).EQ.zero ) THEN
781  IF( cursl )
782  $ sdim = sdim + 1
783  ip = 0
784  IF( cursl .AND. .NOT.lastsl )
785  $ info = n + 2
786  ELSE
787  IF( ip.EQ.1 ) THEN
788 *
789 * Last eigenvalue of conjugate pair
790 *
791  cursl = cursl .OR. lastsl
792  lastsl = cursl
793  IF( cursl )
794  $ sdim = sdim + 2
795  ip = -1
796  IF( cursl .AND. .NOT.lst2sl )
797  $ info = n + 2
798  ELSE
799 *
800 * First eigenvalue of conjugate pair
801 *
802  ip = 1
803  END IF
804  END IF
805  lst2sl = lastsl
806  lastsl = cursl
807  50 CONTINUE
808 *
809  END IF
810 *
811  60 CONTINUE
812 *
813  work( 1 ) = maxwrk
814  iwork( 1 ) = liwmin
815 *
816  RETURN
817 *
818 * End of DGGESX
819 *
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGEQRF
Definition: dgeqrf.f:138
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
DGGHRD
Definition: dgghrd.f:209
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
Definition: dormqr.f:169
subroutine dhgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
DHGEQZ
Definition: dhgeqz.f:306
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:130
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
DGGBAL
Definition: dggbal.f:179
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
DGGBAK
Definition: dggbak.f:149
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine dtgsen(IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO)
DTGSEN
Definition: dtgsen.f:454

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine dggev ( character  JOBVL,
character  JOBVR,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( ldb, * )  B,
integer  LDB,
double precision, dimension( * )  ALPHAR,
double precision, dimension( * )  ALPHAI,
double precision, dimension( * )  BETA,
double precision, dimension( ldvl, * )  VL,
integer  LDVL,
double precision, dimension( ldvr, * )  VR,
integer  LDVR,
double precision, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

DGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices

Download DGGEV + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DGGEV computes for a pair of N-by-N real nonsymmetric matrices (A,B)
 the generalized eigenvalues, and optionally, the left and/or right
 generalized eigenvectors.

 A generalized eigenvalue for a pair of matrices (A,B) is a scalar
 lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
 singular. It is usually represented as the pair (alpha,beta), as
 there is a reasonable interpretation for beta=0, and even for both
 being zero.

 The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
 of (A,B) satisfies

                  A * v(j) = lambda(j) * B * v(j).

 The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
 of (A,B) satisfies

                  u(j)**H * A  = lambda(j) * u(j)**H * B .

 where u(j)**H is the conjugate-transpose of u(j).
Parameters
[in]JOBVL
          JOBVL is CHARACTER*1
          = 'N':  do not compute the left generalized eigenvectors;
          = 'V':  compute the left generalized eigenvectors.
[in]JOBVR
          JOBVR is CHARACTER*1
          = 'N':  do not compute the right generalized eigenvectors;
          = 'V':  compute the right generalized eigenvectors.
[in]N
          N is INTEGER
          The order of the matrices A, B, VL, and VR.  N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA, N)
          On entry, the matrix A in the pair (A,B).
          On exit, A has been overwritten.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  LDA >= max(1,N).
[in,out]B
          B is DOUBLE PRECISION array, dimension (LDB, N)
          On entry, the matrix B in the pair (A,B).
          On exit, B has been overwritten.
[in]LDB
          LDB is INTEGER
          The leading dimension of B.  LDB >= max(1,N).
[out]ALPHAR
          ALPHAR is DOUBLE PRECISION array, dimension (N)
[out]ALPHAI
          ALPHAI is DOUBLE PRECISION array, dimension (N)
[out]BETA
          BETA is DOUBLE PRECISION array, dimension (N)
          On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
          be the generalized eigenvalues.  If ALPHAI(j) is zero, then
          the j-th eigenvalue is real; if positive, then the j-th and
          (j+1)-st eigenvalues are a complex conjugate pair, with
          ALPHAI(j+1) negative.

          Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
          may easily over- or underflow, and BETA(j) may even be zero.
          Thus, the user should avoid naively computing the ratio
          alpha/beta.  However, ALPHAR and ALPHAI will be always less
          than and usually comparable with norm(A) in magnitude, and
          BETA always less than and usually comparable with norm(B).
[out]VL
          VL is DOUBLE PRECISION array, dimension (LDVL,N)
          If JOBVL = 'V', the left eigenvectors u(j) are stored one
          after another in the columns of VL, in the same order as
          their eigenvalues. If the j-th eigenvalue is real, then
          u(j) = VL(:,j), the j-th column of VL. If the j-th and
          (j+1)-th eigenvalues form a complex conjugate pair, then
          u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
          Each eigenvector is scaled so the largest component has
          abs(real part)+abs(imag. part)=1.
          Not referenced if JOBVL = 'N'.
[in]LDVL
          LDVL is INTEGER
          The leading dimension of the matrix VL. LDVL >= 1, and
          if JOBVL = 'V', LDVL >= N.
[out]VR
          VR is DOUBLE PRECISION array, dimension (LDVR,N)
          If JOBVR = 'V', the right eigenvectors v(j) are stored one
          after another in the columns of VR, in the same order as
          their eigenvalues. If the j-th eigenvalue is real, then
          v(j) = VR(:,j), the j-th column of VR. If the j-th and
          (j+1)-th eigenvalues form a complex conjugate pair, then
          v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
          Each eigenvector is scaled so the largest component has
          abs(real part)+abs(imag. part)=1.
          Not referenced if JOBVR = 'N'.
[in]LDVR
          LDVR is INTEGER
          The leading dimension of the matrix VR. LDVR >= 1, and
          if JOBVR = 'V', LDVR >= N.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK.  LWORK >= max(1,8*N).
          For good performance, LWORK must generally be larger.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          = 1,...,N:
                The QZ iteration failed.  No eigenvectors have been
                calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
                should be correct for j=INFO+1,...,N.
          > N:  =N+1: other than QZ iteration failed in DHGEQZ.
                =N+2: error return from DTGEVC.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
April 2012

Definition at line 228 of file dggev.f.

228 *
229 * -- LAPACK driver routine (version 3.4.1) --
230 * -- LAPACK is a software package provided by Univ. of Tennessee, --
231 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
232 * April 2012
233 *
234 * .. Scalar Arguments ..
235  CHARACTER jobvl, jobvr
236  INTEGER info, lda, ldb, ldvl, ldvr, lwork, n
237 * ..
238 * .. Array Arguments ..
239  DOUBLE PRECISION a( lda, * ), alphai( * ), alphar( * ),
240  $ b( ldb, * ), beta( * ), vl( ldvl, * ),
241  $ vr( ldvr, * ), work( * )
242 * ..
243 *
244 * =====================================================================
245 *
246 * .. Parameters ..
247  DOUBLE PRECISION zero, one
248  parameter( zero = 0.0d+0, one = 1.0d+0 )
249 * ..
250 * .. Local Scalars ..
251  LOGICAL ilascl, ilbscl, ilv, ilvl, ilvr, lquery
252  CHARACTER chtemp
253  INTEGER icols, ierr, ihi, ijobvl, ijobvr, ileft, ilo,
254  $ in, iright, irows, itau, iwrk, jc, jr, maxwrk,
255  $ minwrk
256  DOUBLE PRECISION anrm, anrmto, bignum, bnrm, bnrmto, eps,
257  $ smlnum, temp
258 * ..
259 * .. Local Arrays ..
260  LOGICAL ldumma( 1 )
261 * ..
262 * .. External Subroutines ..
263  EXTERNAL dgeqrf, dggbak, dggbal, dgghrd, dhgeqz, dlabad,
265  $ xerbla
266 * ..
267 * .. External Functions ..
268  LOGICAL lsame
269  INTEGER ilaenv
270  DOUBLE PRECISION dlamch, dlange
271  EXTERNAL lsame, ilaenv, dlamch, dlange
272 * ..
273 * .. Intrinsic Functions ..
274  INTRINSIC abs, max, sqrt
275 * ..
276 * .. Executable Statements ..
277 *
278 * Decode the input arguments
279 *
280  IF( lsame( jobvl, 'N' ) ) THEN
281  ijobvl = 1
282  ilvl = .false.
283  ELSE IF( lsame( jobvl, 'V' ) ) THEN
284  ijobvl = 2
285  ilvl = .true.
286  ELSE
287  ijobvl = -1
288  ilvl = .false.
289  END IF
290 *
291  IF( lsame( jobvr, 'N' ) ) THEN
292  ijobvr = 1
293  ilvr = .false.
294  ELSE IF( lsame( jobvr, 'V' ) ) THEN
295  ijobvr = 2
296  ilvr = .true.
297  ELSE
298  ijobvr = -1
299  ilvr = .false.
300  END IF
301  ilv = ilvl .OR. ilvr
302 *
303 * Test the input arguments
304 *
305  info = 0
306  lquery = ( lwork.EQ.-1 )
307  IF( ijobvl.LE.0 ) THEN
308  info = -1
309  ELSE IF( ijobvr.LE.0 ) THEN
310  info = -2
311  ELSE IF( n.LT.0 ) THEN
312  info = -3
313  ELSE IF( lda.LT.max( 1, n ) ) THEN
314  info = -5
315  ELSE IF( ldb.LT.max( 1, n ) ) THEN
316  info = -7
317  ELSE IF( ldvl.LT.1 .OR. ( ilvl .AND. ldvl.LT.n ) ) THEN
318  info = -12
319  ELSE IF( ldvr.LT.1 .OR. ( ilvr .AND. ldvr.LT.n ) ) THEN
320  info = -14
321  END IF
322 *
323 * Compute workspace
324 * (Note: Comments in the code beginning "Workspace:" describe the
325 * minimal amount of workspace needed at that point in the code,
326 * as well as the preferred amount for good performance.
327 * NB refers to the optimal block size for the immediately
328 * following subroutine, as returned by ILAENV. The workspace is
329 * computed assuming ILO = 1 and IHI = N, the worst case.)
330 *
331  IF( info.EQ.0 ) THEN
332  minwrk = max( 1, 8*n )
333  maxwrk = max( 1, n*( 7 +
334  $ ilaenv( 1, 'DGEQRF', ' ', n, 1, n, 0 ) ) )
335  maxwrk = max( maxwrk, n*( 7 +
336  $ ilaenv( 1, 'DORMQR', ' ', n, 1, n, 0 ) ) )
337  IF( ilvl ) THEN
338  maxwrk = max( maxwrk, n*( 7 +
339  $ ilaenv( 1, 'DORGQR', ' ', n, 1, n, -1 ) ) )
340  END IF
341  work( 1 ) = maxwrk
342 *
343  IF( lwork.LT.minwrk .AND. .NOT.lquery )
344  $ info = -16
345  END IF
346 *
347  IF( info.NE.0 ) THEN
348  CALL xerbla( 'DGGEV ', -info )
349  RETURN
350  ELSE IF( lquery ) THEN
351  RETURN
352  END IF
353 *
354 * Quick return if possible
355 *
356  IF( n.EQ.0 )
357  $ RETURN
358 *
359 * Get machine constants
360 *
361  eps = dlamch( 'P' )
362  smlnum = dlamch( 'S' )
363  bignum = one / smlnum
364  CALL dlabad( smlnum, bignum )
365  smlnum = sqrt( smlnum ) / eps
366  bignum = one / smlnum
367 *
368 * Scale A if max element outside range [SMLNUM,BIGNUM]
369 *
370  anrm = dlange( 'M', n, n, a, lda, work )
371  ilascl = .false.
372  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
373  anrmto = smlnum
374  ilascl = .true.
375  ELSE IF( anrm.GT.bignum ) THEN
376  anrmto = bignum
377  ilascl = .true.
378  END IF
379  IF( ilascl )
380  $ CALL dlascl( 'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
381 *
382 * Scale B if max element outside range [SMLNUM,BIGNUM]
383 *
384  bnrm = dlange( 'M', n, n, b, ldb, work )
385  ilbscl = .false.
386  IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) THEN
387  bnrmto = smlnum
388  ilbscl = .true.
389  ELSE IF( bnrm.GT.bignum ) THEN
390  bnrmto = bignum
391  ilbscl = .true.
392  END IF
393  IF( ilbscl )
394  $ CALL dlascl( 'G', 0, 0, bnrm, bnrmto, n, n, b, ldb, ierr )
395 *
396 * Permute the matrices A, B to isolate eigenvalues if possible
397 * (Workspace: need 6*N)
398 *
399  ileft = 1
400  iright = n + 1
401  iwrk = iright + n
402  CALL dggbal( 'P', n, a, lda, b, ldb, ilo, ihi, work( ileft ),
403  $ work( iright ), work( iwrk ), ierr )
404 *
405 * Reduce B to triangular form (QR decomposition of B)
406 * (Workspace: need N, prefer N*NB)
407 *
408  irows = ihi + 1 - ilo
409  IF( ilv ) THEN
410  icols = n + 1 - ilo
411  ELSE
412  icols = irows
413  END IF
414  itau = iwrk
415  iwrk = itau + irows
416  CALL dgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
417  $ work( iwrk ), lwork+1-iwrk, ierr )
418 *
419 * Apply the orthogonal transformation to matrix A
420 * (Workspace: need N, prefer N*NB)
421 *
422  CALL dormqr( 'L', 'T', irows, icols, irows, b( ilo, ilo ), ldb,
423  $ work( itau ), a( ilo, ilo ), lda, work( iwrk ),
424  $ lwork+1-iwrk, ierr )
425 *
426 * Initialize VL
427 * (Workspace: need N, prefer N*NB)
428 *
429  IF( ilvl ) THEN
430  CALL dlaset( 'Full', n, n, zero, one, vl, ldvl )
431  IF( irows.GT.1 ) THEN
432  CALL dlacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
433  $ vl( ilo+1, ilo ), ldvl )
434  END IF
435  CALL dorgqr( irows, irows, irows, vl( ilo, ilo ), ldvl,
436  $ work( itau ), work( iwrk ), lwork+1-iwrk, ierr )
437  END IF
438 *
439 * Initialize VR
440 *
441  IF( ilvr )
442  $ CALL dlaset( 'Full', n, n, zero, one, vr, ldvr )
443 *
444 * Reduce to generalized Hessenberg form
445 * (Workspace: none needed)
446 *
447  IF( ilv ) THEN
448 *
449 * Eigenvectors requested -- work on whole matrix.
450 *
451  CALL dgghrd( jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb, vl,
452  $ ldvl, vr, ldvr, ierr )
453  ELSE
454  CALL dgghrd( 'N', 'N', irows, 1, irows, a( ilo, ilo ), lda,
455  $ b( ilo, ilo ), ldb, vl, ldvl, vr, ldvr, ierr )
456  END IF
457 *
458 * Perform QZ algorithm (Compute eigenvalues, and optionally, the
459 * Schur forms and Schur vectors)
460 * (Workspace: need N)
461 *
462  iwrk = itau
463  IF( ilv ) THEN
464  chtemp = 'S'
465  ELSE
466  chtemp = 'E'
467  END IF
468  CALL dhgeqz( chtemp, jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb,
469  $ alphar, alphai, beta, vl, ldvl, vr, ldvr,
470  $ work( iwrk ), lwork+1-iwrk, ierr )
471  IF( ierr.NE.0 ) THEN
472  IF( ierr.GT.0 .AND. ierr.LE.n ) THEN
473  info = ierr
474  ELSE IF( ierr.GT.n .AND. ierr.LE.2*n ) THEN
475  info = ierr - n
476  ELSE
477  info = n + 1
478  END IF
479  GO TO 110
480  END IF
481 *
482 * Compute Eigenvectors
483 * (Workspace: need 6*N)
484 *
485  IF( ilv ) THEN
486  IF( ilvl ) THEN
487  IF( ilvr ) THEN
488  chtemp = 'B'
489  ELSE
490  chtemp = 'L'
491  END IF
492  ELSE
493  chtemp = 'R'
494  END IF
495  CALL dtgevc( chtemp, 'B', ldumma, n, a, lda, b, ldb, vl, ldvl,
496  $ vr, ldvr, n, in, work( iwrk ), ierr )
497  IF( ierr.NE.0 ) THEN
498  info = n + 2
499  GO TO 110
500  END IF
501 *
502 * Undo balancing on VL and VR and normalization
503 * (Workspace: none needed)
504 *
505  IF( ilvl ) THEN
506  CALL dggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
507  $ work( iright ), n, vl, ldvl, ierr )
508  DO 50 jc = 1, n
509  IF( alphai( jc ).LT.zero )
510  $ GO TO 50
511  temp = zero
512  IF( alphai( jc ).EQ.zero ) THEN
513  DO 10 jr = 1, n
514  temp = max( temp, abs( vl( jr, jc ) ) )
515  10 CONTINUE
516  ELSE
517  DO 20 jr = 1, n
518  temp = max( temp, abs( vl( jr, jc ) )+
519  $ abs( vl( jr, jc+1 ) ) )
520  20 CONTINUE
521  END IF
522  IF( temp.LT.smlnum )
523  $ GO TO 50
524  temp = one / temp
525  IF( alphai( jc ).EQ.zero ) THEN
526  DO 30 jr = 1, n
527  vl( jr, jc ) = vl( jr, jc )*temp
528  30 CONTINUE
529  ELSE
530  DO 40 jr = 1, n
531  vl( jr, jc ) = vl( jr, jc )*temp
532  vl( jr, jc+1 ) = vl( jr, jc+1 )*temp
533  40 CONTINUE
534  END IF
535  50 CONTINUE
536  END IF
537  IF( ilvr ) THEN
538  CALL dggbak( 'P', 'R', n, ilo, ihi, work( ileft ),
539  $ work( iright ), n, vr, ldvr, ierr )
540  DO 100 jc = 1, n
541  IF( alphai( jc ).LT.zero )
542  $ GO TO 100
543  temp = zero
544  IF( alphai( jc ).EQ.zero ) THEN
545  DO 60 jr = 1, n
546  temp = max( temp, abs( vr( jr, jc ) ) )
547  60 CONTINUE
548  ELSE
549  DO 70 jr = 1, n
550  temp = max( temp, abs( vr( jr, jc ) )+
551  $ abs( vr( jr, jc+1 ) ) )
552  70 CONTINUE
553  END IF
554  IF( temp.LT.smlnum )
555  $ GO TO 100
556  temp = one / temp
557  IF( alphai( jc ).EQ.zero ) THEN
558  DO 80 jr = 1, n
559  vr( jr, jc ) = vr( jr, jc )*temp
560  80 CONTINUE
561  ELSE
562  DO 90 jr = 1, n
563  vr( jr, jc ) = vr( jr, jc )*temp
564  vr( jr, jc+1 ) = vr( jr, jc+1 )*temp
565  90 CONTINUE
566  END IF
567  100 CONTINUE
568  END IF
569 *
570 * End of eigenvector calculation
571 *
572  END IF
573 *
574 * Undo scaling if necessary
575 *
576  110 CONTINUE
577 *
578  IF( ilascl ) THEN
579  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n, ierr )
580  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n, ierr )
581  END IF
582 *
583  IF( ilbscl ) THEN
584  CALL dlascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
585  END IF
586 *
587  work( 1 ) = maxwrk
588  RETURN
589 *
590 * End of DGGEV
591 *
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGEQRF
Definition: dgeqrf.f:138
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
DGGHRD
Definition: dgghrd.f:209
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
Definition: dormqr.f:169
subroutine dhgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
DHGEQZ
Definition: dhgeqz.f:306
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:130
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dtgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
DTGEVC
Definition: dtgevc.f:297
subroutine dggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
DGGBAL
Definition: dggbal.f:179
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
DGGBAK
Definition: dggbak.f:149
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine dggev3 ( character  JOBVL,
character  JOBVR,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( ldb, * )  B,
integer  LDB,
double precision, dimension( * )  ALPHAR,
double precision, dimension( * )  ALPHAI,
double precision, dimension( * )  BETA,
double precision, dimension( ldvl, * )  VL,
integer  LDVL,
double precision, dimension( ldvr, * )  VR,
integer  LDVR,
double precision, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

DGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm)

Download DGGEV3 + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DGGEV3 computes for a pair of N-by-N real nonsymmetric matrices (A,B)
 the generalized eigenvalues, and optionally, the left and/or right
 generalized eigenvectors.

 A generalized eigenvalue for a pair of matrices (A,B) is a scalar
 lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
 singular. It is usually represented as the pair (alpha,beta), as
 there is a reasonable interpretation for beta=0, and even for both
 being zero.

 The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
 of (A,B) satisfies

                  A * v(j) = lambda(j) * B * v(j).

 The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
 of (A,B) satisfies

                  u(j)**H * A  = lambda(j) * u(j)**H * B .

 where u(j)**H is the conjugate-transpose of u(j).
Parameters
[in]JOBVL
          JOBVL is CHARACTER*1
          = 'N':  do not compute the left generalized eigenvectors;
          = 'V':  compute the left generalized eigenvectors.
[in]JOBVR
          JOBVR is CHARACTER*1
          = 'N':  do not compute the right generalized eigenvectors;
          = 'V':  compute the right generalized eigenvectors.
[in]N
          N is INTEGER
          The order of the matrices A, B, VL, and VR.  N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA, N)
          On entry, the matrix A in the pair (A,B).
          On exit, A has been overwritten.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  LDA >= max(1,N).
[in,out]B
          B is DOUBLE PRECISION array, dimension (LDB, N)
          On entry, the matrix B in the pair (A,B).
          On exit, B has been overwritten.
[in]LDB
          LDB is INTEGER
          The leading dimension of B.  LDB >= max(1,N).
[out]ALPHAR
          ALPHAR is DOUBLE PRECISION array, dimension (N)
[out]ALPHAI
          ALPHAI is DOUBLE PRECISION array, dimension (N)
[out]BETA
          BETA is DOUBLE PRECISION array, dimension (N)
          On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
          be the generalized eigenvalues.  If ALPHAI(j) is zero, then
          the j-th eigenvalue is real; if positive, then the j-th and
          (j+1)-st eigenvalues are a complex conjugate pair, with
          ALPHAI(j+1) negative.

          Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
          may easily over- or underflow, and BETA(j) may even be zero.
          Thus, the user should avoid naively computing the ratio
          alpha/beta.  However, ALPHAR and ALPHAI will be always less
          than and usually comparable with norm(A) in magnitude, and
          BETA always less than and usually comparable with norm(B).
[out]VL
          VL is DOUBLE PRECISION array, dimension (LDVL,N)
          If JOBVL = 'V', the left eigenvectors u(j) are stored one
          after another in the columns of VL, in the same order as
          their eigenvalues. If the j-th eigenvalue is real, then
          u(j) = VL(:,j), the j-th column of VL. If the j-th and
          (j+1)-th eigenvalues form a complex conjugate pair, then
          u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
          Each eigenvector is scaled so the largest component has
          abs(real part)+abs(imag. part)=1.
          Not referenced if JOBVL = 'N'.
[in]LDVL
          LDVL is INTEGER
          The leading dimension of the matrix VL. LDVL >= 1, and
          if JOBVL = 'V', LDVL >= N.
[out]VR
          VR is DOUBLE PRECISION array, dimension (LDVR,N)
          If JOBVR = 'V', the right eigenvectors v(j) are stored one
          after another in the columns of VR, in the same order as
          their eigenvalues. If the j-th eigenvalue is real, then
          v(j) = VR(:,j), the j-th column of VR. If the j-th and
          (j+1)-th eigenvalues form a complex conjugate pair, then
          v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
          Each eigenvector is scaled so the largest component has
          abs(real part)+abs(imag. part)=1.
          Not referenced if JOBVR = 'N'.
[in]LDVR
          LDVR is INTEGER
          The leading dimension of the matrix VR. LDVR >= 1, and
          if JOBVR = 'V', LDVR >= N.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          = 1,...,N:
                The QZ iteration failed.  No eigenvectors have been
                calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
                should be correct for j=INFO+1,...,N.
          > N:  =N+1: other than QZ iteration failed in DHGEQZ.
                =N+2: error return from DTGEVC.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
January 2015

Definition at line 228 of file dggev3.f.

228 *
229 * -- LAPACK driver routine (version 3.6.0) --
230 * -- LAPACK is a software package provided by Univ. of Tennessee, --
231 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
232 * January 2015
233 *
234 * .. Scalar Arguments ..
235  CHARACTER jobvl, jobvr
236  INTEGER info, lda, ldb, ldvl, ldvr, lwork, n
237 * ..
238 * .. Array Arguments ..
239  DOUBLE PRECISION a( lda, * ), alphai( * ), alphar( * ),
240  $ b( ldb, * ), beta( * ), vl( ldvl, * ),
241  $ vr( ldvr, * ), work( * )
242 * ..
243 *
244 * =====================================================================
245 *
246 * .. Parameters ..
247  DOUBLE PRECISION zero, one
248  parameter( zero = 0.0d+0, one = 1.0d+0 )
249 * ..
250 * .. Local Scalars ..
251  LOGICAL ilascl, ilbscl, ilv, ilvl, ilvr, lquery
252  CHARACTER chtemp
253  INTEGER icols, ierr, ihi, ijobvl, ijobvr, ileft, ilo,
254  $ in, iright, irows, itau, iwrk, jc, jr, lwkopt
255  DOUBLE PRECISION anrm, anrmto, bignum, bnrm, bnrmto, eps,
256  $ smlnum, temp
257 * ..
258 * .. Local Arrays ..
259  LOGICAL ldumma( 1 )
260 * ..
261 * .. External Subroutines ..
262  EXTERNAL dgeqrf, dggbak, dggbal, dgghd3, dhgeqz, dlabad,
264  $ xerbla
265 * ..
266 * .. External Functions ..
267  LOGICAL lsame
268  DOUBLE PRECISION dlamch, dlange
269  EXTERNAL lsame, dlamch, dlange
270 * ..
271 * .. Intrinsic Functions ..
272  INTRINSIC abs, max, sqrt
273 * ..
274 * .. Executable Statements ..
275 *
276 * Decode the input arguments
277 *
278  IF( lsame( jobvl, 'N' ) ) THEN
279  ijobvl = 1
280  ilvl = .false.
281  ELSE IF( lsame( jobvl, 'V' ) ) THEN
282  ijobvl = 2
283  ilvl = .true.
284  ELSE
285  ijobvl = -1
286  ilvl = .false.
287  END IF
288 *
289  IF( lsame( jobvr, 'N' ) ) THEN
290  ijobvr = 1
291  ilvr = .false.
292  ELSE IF( lsame( jobvr, 'V' ) ) THEN
293  ijobvr = 2
294  ilvr = .true.
295  ELSE
296  ijobvr = -1
297  ilvr = .false.
298  END IF
299  ilv = ilvl .OR. ilvr
300 *
301 * Test the input arguments
302 *
303  info = 0
304  lquery = ( lwork.EQ.-1 )
305  IF( ijobvl.LE.0 ) THEN
306  info = -1
307  ELSE IF( ijobvr.LE.0 ) THEN
308  info = -2
309  ELSE IF( n.LT.0 ) THEN
310  info = -3
311  ELSE IF( lda.LT.max( 1, n ) ) THEN
312  info = -5
313  ELSE IF( ldb.LT.max( 1, n ) ) THEN
314  info = -7
315  ELSE IF( ldvl.LT.1 .OR. ( ilvl .AND. ldvl.LT.n ) ) THEN
316  info = -12
317  ELSE IF( ldvr.LT.1 .OR. ( ilvr .AND. ldvr.LT.n ) ) THEN
318  info = -14
319  ELSE IF( lwork.LT.max( 1, 8*n ) .AND. .NOT.lquery ) THEN
320  info = -16
321  END IF
322 *
323 * Compute workspace
324 *
325  IF( info.EQ.0 ) THEN
326  CALL dgeqrf( n, n, b, ldb, work, work, -1, ierr )
327  lwkopt = max(1, 8*n, 3*n+int( work( 1 ) ) )
328  CALL dormqr( 'L', 'T', n, n, n, b, ldb, work, a, lda, work, -1,
329  $ ierr )
330  lwkopt = max( lwkopt, 3*n+int( work( 1 ) ) )
331  IF( ilvl ) THEN
332  CALL dorgqr( n, n, n, vl, ldvl, work, work, -1, ierr )
333  lwkopt = max( lwkopt, 3*n+int( work( 1 ) ) )
334  END IF
335  IF( ilv ) THEN
336  CALL dgghd3( jobvl, jobvr, n, 1, n, a, lda, b, ldb, vl,
337  $ ldvl, vr, ldvr, work, -1, ierr )
338  lwkopt = max( lwkopt, 3*n+int( work( 1 ) ) )
339  CALL dhgeqz( 'S', jobvl, jobvr, n, 1, n, a, lda, b, ldb,
340  $ alphar, alphai, beta, vl, ldvl, vr, ldvr,
341  $ work, -1, ierr )
342  lwkopt = max( lwkopt, 2*n+int( work( 1 ) ) )
343  ELSE
344  CALL dgghd3( 'N', 'N', n, 1, n, a, lda, b, ldb, vl, ldvl,
345  $ vr, ldvr, work, -1, ierr )
346  lwkopt = max( lwkopt, 3*n+int( work( 1 ) ) )
347  CALL dhgeqz( 'E', jobvl, jobvr, n, 1, n, a, lda, b, ldb,
348  $ alphar, alphai, beta, vl, ldvl, vr, ldvr,
349  $ work, -1, ierr )
350  lwkopt = max( lwkopt, 2*n+int( work( 1 ) ) )
351  END IF
352 
353  work( 1 ) = lwkopt
354  END IF
355 *
356  IF( info.NE.0 ) THEN
357  CALL xerbla( 'DGGEV3 ', -info )
358  RETURN
359  ELSE IF( lquery ) THEN
360  RETURN
361  END IF
362 *
363 * Quick return if possible
364 *
365  IF( n.EQ.0 )
366  $ RETURN
367 *
368 * Get machine constants
369 *
370  eps = dlamch( 'P' )
371  smlnum = dlamch( 'S' )
372  bignum = one / smlnum
373  CALL dlabad( smlnum, bignum )
374  smlnum = sqrt( smlnum ) / eps
375  bignum = one / smlnum
376 *
377 * Scale A if max element outside range [SMLNUM,BIGNUM]
378 *
379  anrm = dlange( 'M', n, n, a, lda, work )
380  ilascl = .false.
381  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
382  anrmto = smlnum
383  ilascl = .true.
384  ELSE IF( anrm.GT.bignum ) THEN
385  anrmto = bignum
386  ilascl = .true.
387  END IF
388  IF( ilascl )
389  $ CALL dlascl( 'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
390 *
391 * Scale B if max element outside range [SMLNUM,BIGNUM]
392 *
393  bnrm = dlange( 'M', n, n, b, ldb, work )
394  ilbscl = .false.
395  IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) THEN
396  bnrmto = smlnum
397  ilbscl = .true.
398  ELSE IF( bnrm.GT.bignum ) THEN
399  bnrmto = bignum
400  ilbscl = .true.
401  END IF
402  IF( ilbscl )
403  $ CALL dlascl( 'G', 0, 0, bnrm, bnrmto, n, n, b, ldb, ierr )
404 *
405 * Permute the matrices A, B to isolate eigenvalues if possible
406 *
407  ileft = 1
408  iright = n + 1
409  iwrk = iright + n
410  CALL dggbal( 'P', n, a, lda, b, ldb, ilo, ihi, work( ileft ),
411  $ work( iright ), work( iwrk ), ierr )
412 *
413 * Reduce B to triangular form (QR decomposition of B)
414 *
415  irows = ihi + 1 - ilo
416  IF( ilv ) THEN
417  icols = n + 1 - ilo
418  ELSE
419  icols = irows
420  END IF
421  itau = iwrk
422  iwrk = itau + irows
423  CALL dgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
424  $ work( iwrk ), lwork+1-iwrk, ierr )
425 *
426 * Apply the orthogonal transformation to matrix A
427 *
428  CALL dormqr( 'L', 'T', irows, icols, irows, b( ilo, ilo ), ldb,
429  $ work( itau ), a( ilo, ilo ), lda, work( iwrk ),
430  $ lwork+1-iwrk, ierr )
431 *
432 * Initialize VL
433 *
434  IF( ilvl ) THEN
435  CALL dlaset( 'Full', n, n, zero, one, vl, ldvl )
436  IF( irows.GT.1 ) THEN
437  CALL dlacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
438  $ vl( ilo+1, ilo ), ldvl )
439  END IF
440  CALL dorgqr( irows, irows, irows, vl( ilo, ilo ), ldvl,
441  $ work( itau ), work( iwrk ), lwork+1-iwrk, ierr )
442  END IF
443 *
444 * Initialize VR
445 *
446  IF( ilvr )
447  $ CALL dlaset( 'Full', n, n, zero, one, vr, ldvr )
448 *
449 * Reduce to generalized Hessenberg form
450 *
451  IF( ilv ) THEN
452 *
453 * Eigenvectors requested -- work on whole matrix.
454 *
455  CALL dgghd3( jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb, vl,
456  $ ldvl, vr, ldvr, work( iwrk ), lwork+1-iwrk, ierr )
457  ELSE
458  CALL dgghd3( 'N', 'N', irows, 1, irows, a( ilo, ilo ), lda,
459  $ b( ilo, ilo ), ldb, vl, ldvl, vr, ldvr,
460  $ work( iwrk ), lwork+1-iwrk, ierr )
461  END IF
462 *
463 * Perform QZ algorithm (Compute eigenvalues, and optionally, the
464 * Schur forms and Schur vectors)
465 *
466  iwrk = itau
467  IF( ilv ) THEN
468  chtemp = 'S'
469  ELSE
470  chtemp = 'E'
471  END IF
472  CALL dhgeqz( chtemp, jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb,
473  $ alphar, alphai, beta, vl, ldvl, vr, ldvr,
474  $ work( iwrk ), lwork+1-iwrk, ierr )
475  IF( ierr.NE.0 ) THEN
476  IF( ierr.GT.0 .AND. ierr.LE.n ) THEN
477  info = ierr
478  ELSE IF( ierr.GT.n .AND. ierr.LE.2*n ) THEN
479  info = ierr - n
480  ELSE
481  info = n + 1
482  END IF
483  GO TO 110
484  END IF
485 *
486 * Compute Eigenvectors
487 *
488  IF( ilv ) THEN
489  IF( ilvl ) THEN
490  IF( ilvr ) THEN
491  chtemp = 'B'
492  ELSE
493  chtemp = 'L'
494  END IF
495  ELSE
496  chtemp = 'R'
497  END IF
498  CALL dtgevc( chtemp, 'B', ldumma, n, a, lda, b, ldb, vl, ldvl,
499  $ vr, ldvr, n, in, work( iwrk ), ierr )
500  IF( ierr.NE.0 ) THEN
501  info = n + 2
502  GO TO 110
503  END IF
504 *
505 * Undo balancing on VL and VR and normalization
506 *
507  IF( ilvl ) THEN
508  CALL dggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
509  $ work( iright ), n, vl, ldvl, ierr )
510  DO 50 jc = 1, n
511  IF( alphai( jc ).LT.zero )
512  $ GO TO 50
513  temp = zero
514  IF( alphai( jc ).EQ.zero ) THEN
515  DO 10 jr = 1, n
516  temp = max( temp, abs( vl( jr, jc ) ) )
517  10 CONTINUE
518  ELSE
519  DO 20 jr = 1, n
520  temp = max( temp, abs( vl( jr, jc ) )+
521  $ abs( vl( jr, jc+1 ) ) )
522  20 CONTINUE
523  END IF
524  IF( temp.LT.smlnum )
525  $ GO TO 50
526  temp = one / temp
527  IF( alphai( jc ).EQ.zero ) THEN
528  DO 30 jr = 1, n
529  vl( jr, jc ) = vl( jr, jc )*temp
530  30 CONTINUE
531  ELSE
532  DO 40 jr = 1, n
533  vl( jr, jc ) = vl( jr, jc )*temp
534  vl( jr, jc+1 ) = vl( jr, jc+1 )*temp
535  40 CONTINUE
536  END IF
537  50 CONTINUE
538  END IF
539  IF( ilvr ) THEN
540  CALL dggbak( 'P', 'R', n, ilo, ihi, work( ileft ),
541  $ work( iright ), n, vr, ldvr, ierr )
542  DO 100 jc = 1, n
543  IF( alphai( jc ).LT.zero )
544  $ GO TO 100
545  temp = zero
546  IF( alphai( jc ).EQ.zero ) THEN
547  DO 60 jr = 1, n
548  temp = max( temp, abs( vr( jr, jc ) ) )
549  60 CONTINUE
550  ELSE
551  DO 70 jr = 1, n
552  temp = max( temp, abs( vr( jr, jc ) )+
553  $ abs( vr( jr, jc+1 ) ) )
554  70 CONTINUE
555  END IF
556  IF( temp.LT.smlnum )
557  $ GO TO 100
558  temp = one / temp
559  IF( alphai( jc ).EQ.zero ) THEN
560  DO 80 jr = 1, n
561  vr( jr, jc ) = vr( jr, jc )*temp
562  80 CONTINUE
563  ELSE
564  DO 90 jr = 1, n
565  vr( jr, jc ) = vr( jr, jc )*temp
566  vr( jr, jc+1 ) = vr( jr, jc+1 )*temp
567  90 CONTINUE
568  END IF
569  100 CONTINUE
570  END IF
571 *
572 * End of eigenvector calculation
573 *
574  END IF
575 *
576 * Undo scaling if necessary
577 *
578  110 CONTINUE
579 *
580  IF( ilascl ) THEN
581  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n, ierr )
582  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n, ierr )
583  END IF
584 *
585  IF( ilbscl ) THEN
586  CALL dlascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
587  END IF
588 *
589  work( 1 ) = lwkopt
590  RETURN
591 *
592 * End of DGGEV3
593 *
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGEQRF
Definition: dgeqrf.f:138
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
Definition: dormqr.f:169
subroutine dhgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
DHGEQZ
Definition: dhgeqz.f:306
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:130
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dtgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
DTGEVC
Definition: dtgevc.f:297
subroutine dggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
DGGBAL
Definition: dggbal.f:179
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dgghd3(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
DGGHD3
Definition: dgghd3.f:232
subroutine dggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
DGGBAK
Definition: dggbak.f:149

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine dggevx ( character  BALANC,
character  JOBVL,
character  JOBVR,
character  SENSE,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( ldb, * )  B,
integer  LDB,
double precision, dimension( * )  ALPHAR,
double precision, dimension( * )  ALPHAI,
double precision, dimension( * )  BETA,
double precision, dimension( ldvl, * )  VL,
integer  LDVL,
double precision, dimension( ldvr, * )  VR,
integer  LDVR,
integer  ILO,
integer  IHI,
double precision, dimension( * )  LSCALE,
double precision, dimension( * )  RSCALE,
double precision  ABNRM,
double precision  BBNRM,
double precision, dimension( * )  RCONDE,
double precision, dimension( * )  RCONDV,
double precision, dimension( * )  WORK,
integer  LWORK,
integer, dimension( * )  IWORK,
logical, dimension( * )  BWORK,
integer  INFO 
)

DGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices

Download DGGEVX + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DGGEVX computes for a pair of N-by-N real nonsymmetric matrices (A,B)
 the generalized eigenvalues, and optionally, the left and/or right
 generalized eigenvectors.

 Optionally also, it computes a balancing transformation to improve
 the conditioning of the eigenvalues and eigenvectors (ILO, IHI,
 LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for
 the eigenvalues (RCONDE), and reciprocal condition numbers for the
 right eigenvectors (RCONDV).

 A generalized eigenvalue for a pair of matrices (A,B) is a scalar
 lambda or a ratio alpha/beta = lambda, such that A - lambda*B is
 singular. It is usually represented as the pair (alpha,beta), as
 there is a reasonable interpretation for beta=0, and even for both
 being zero.

 The right eigenvector v(j) corresponding to the eigenvalue lambda(j)
 of (A,B) satisfies

                  A * v(j) = lambda(j) * B * v(j) .

 The left eigenvector u(j) corresponding to the eigenvalue lambda(j)
 of (A,B) satisfies

                  u(j)**H * A  = lambda(j) * u(j)**H * B.

 where u(j)**H is the conjugate-transpose of u(j).
Parameters
[in]BALANC
          BALANC is CHARACTER*1
          Specifies the balance option to be performed.
          = 'N':  do not diagonally scale or permute;
          = 'P':  permute only;
          = 'S':  scale only;
          = 'B':  both permute and scale.
          Computed reciprocal condition numbers will be for the
          matrices after permuting and/or balancing. Permuting does
          not change condition numbers (in exact arithmetic), but
          balancing does.
[in]JOBVL
          JOBVL is CHARACTER*1
          = 'N':  do not compute the left generalized eigenvectors;
          = 'V':  compute the left generalized eigenvectors.
[in]JOBVR
          JOBVR is CHARACTER*1
          = 'N':  do not compute the right generalized eigenvectors;
          = 'V':  compute the right generalized eigenvectors.
[in]SENSE
          SENSE is CHARACTER*1
          Determines which reciprocal condition numbers are computed.
          = 'N': none are computed;
          = 'E': computed for eigenvalues only;
          = 'V': computed for eigenvectors only;
          = 'B': computed for eigenvalues and eigenvectors.
[in]N
          N is INTEGER
          The order of the matrices A, B, VL, and VR.  N >= 0.
[in,out]A
          A is DOUBLE PRECISION array, dimension (LDA, N)
          On entry, the matrix A in the pair (A,B).
          On exit, A has been overwritten. If JOBVL='V' or JOBVR='V'
          or both, then A contains the first part of the real Schur
          form of the "balanced" versions of the input A and B.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  LDA >= max(1,N).
[in,out]B
          B is DOUBLE PRECISION array, dimension (LDB, N)
          On entry, the matrix B in the pair (A,B).
          On exit, B has been overwritten. If JOBVL='V' or JOBVR='V'
          or both, then B contains the second part of the real Schur
          form of the "balanced" versions of the input A and B.
[in]LDB
          LDB is INTEGER
          The leading dimension of B.  LDB >= max(1,N).
[out]ALPHAR
          ALPHAR is DOUBLE PRECISION array, dimension (N)
[out]ALPHAI
          ALPHAI is DOUBLE PRECISION array, dimension (N)
[out]BETA
          BETA is DOUBLE PRECISION array, dimension (N)
          On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will
          be the generalized eigenvalues.  If ALPHAI(j) is zero, then
          the j-th eigenvalue is real; if positive, then the j-th and
          (j+1)-st eigenvalues are a complex conjugate pair, with
          ALPHAI(j+1) negative.

          Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j)
          may easily over- or underflow, and BETA(j) may even be zero.
          Thus, the user should avoid naively computing the ratio
          ALPHA/BETA. However, ALPHAR and ALPHAI will be always less
          than and usually comparable with norm(A) in magnitude, and
          BETA always less than and usually comparable with norm(B).
[out]VL
          VL is DOUBLE PRECISION array, dimension (LDVL,N)
          If JOBVL = 'V', the left eigenvectors u(j) are stored one
          after another in the columns of VL, in the same order as
          their eigenvalues. If the j-th eigenvalue is real, then
          u(j) = VL(:,j), the j-th column of VL. If the j-th and
          (j+1)-th eigenvalues form a complex conjugate pair, then
          u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1).
          Each eigenvector will be scaled so the largest component have
          abs(real part) + abs(imag. part) = 1.
          Not referenced if JOBVL = 'N'.
[in]LDVL
          LDVL is INTEGER
          The leading dimension of the matrix VL. LDVL >= 1, and
          if JOBVL = 'V', LDVL >= N.
[out]VR
          VR is DOUBLE PRECISION array, dimension (LDVR,N)
          If JOBVR = 'V', the right eigenvectors v(j) are stored one
          after another in the columns of VR, in the same order as
          their eigenvalues. If the j-th eigenvalue is real, then
          v(j) = VR(:,j), the j-th column of VR. If the j-th and
          (j+1)-th eigenvalues form a complex conjugate pair, then
          v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1).
          Each eigenvector will be scaled so the largest component have
          abs(real part) + abs(imag. part) = 1.
          Not referenced if JOBVR = 'N'.
[in]LDVR
          LDVR is INTEGER
          The leading dimension of the matrix VR. LDVR >= 1, and
          if JOBVR = 'V', LDVR >= N.
[out]ILO
          ILO is INTEGER
[out]IHI
          IHI is INTEGER
          ILO and IHI are integer values such that on exit
          A(i,j) = 0 and B(i,j) = 0 if i > j and
          j = 1,...,ILO-1 or i = IHI+1,...,N.
          If BALANC = 'N' or 'S', ILO = 1 and IHI = N.
[out]LSCALE
          LSCALE is DOUBLE PRECISION array, dimension (N)
          Details of the permutations and scaling factors applied
          to the left side of A and B.  If PL(j) is the index of the
          row interchanged with row j, and DL(j) is the scaling
          factor applied to row j, then
            LSCALE(j) = PL(j)  for j = 1,...,ILO-1
                      = DL(j)  for j = ILO,...,IHI
                      = PL(j)  for j = IHI+1,...,N.
          The order in which the interchanges are made is N to IHI+1,
          then 1 to ILO-1.
[out]RSCALE
          RSCALE is DOUBLE PRECISION array, dimension (N)
          Details of the permutations and scaling factors applied
          to the right side of A and B.  If PR(j) is the index of the
          column interchanged with column j, and DR(j) is the scaling
          factor applied to column j, then
            RSCALE(j) = PR(j)  for j = 1,...,ILO-1
                      = DR(j)  for j = ILO,...,IHI
                      = PR(j)  for j = IHI+1,...,N
          The order in which the interchanges are made is N to IHI+1,
          then 1 to ILO-1.
[out]ABNRM
          ABNRM is DOUBLE PRECISION
          The one-norm of the balanced matrix A.
[out]BBNRM
          BBNRM is DOUBLE PRECISION
          The one-norm of the balanced matrix B.
[out]RCONDE
          RCONDE is DOUBLE PRECISION array, dimension (N)
          If SENSE = 'E' or 'B', the reciprocal condition numbers of
          the eigenvalues, stored in consecutive elements of the array.
          For a complex conjugate pair of eigenvalues two consecutive
          elements of RCONDE are set to the same value. Thus RCONDE(j),
          RCONDV(j), and the j-th columns of VL and VR all correspond
          to the j-th eigenpair.
          If SENSE = 'N or 'V', RCONDE is not referenced.
[out]RCONDV
          RCONDV is DOUBLE PRECISION array, dimension (N)
          If SENSE = 'V' or 'B', the estimated reciprocal condition
          numbers of the eigenvectors, stored in consecutive elements
          of the array. For a complex eigenvector two consecutive
          elements of RCONDV are set to the same value. If the
          eigenvalues cannot be reordered to compute RCONDV(j),
          RCONDV(j) is set to 0; this can only occur when the true
          value would be very small anyway.
          If SENSE = 'N' or 'E', RCONDV is not referenced.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK. LWORK >= max(1,2*N).
          If BALANC = 'S' or 'B', or JOBVL = 'V', or JOBVR = 'V',
          LWORK >= max(1,6*N).
          If SENSE = 'E' or 'B', LWORK >= max(1,10*N).
          If SENSE = 'V' or 'B', LWORK >= 2*N*N+8*N+16.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]IWORK
          IWORK is INTEGER array, dimension (N+6)
          If SENSE = 'E', IWORK is not referenced.
[out]BWORK
          BWORK is LOGICAL array, dimension (N)
          If SENSE = 'N', BWORK is not referenced.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          = 1,...,N:
                The QZ iteration failed.  No eigenvectors have been
                calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
                should be correct for j=INFO+1,...,N.
          > N:  =N+1: other than QZ iteration failed in DHGEQZ.
                =N+2: error return from DTGEVC.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
April 2012
Further Details:
  Balancing a matrix pair (A,B) includes, first, permuting rows and
  columns to isolate eigenvalues, second, applying diagonal similarity
  transformation to the rows and columns to make the rows and columns
  as close in norm as possible. The computed reciprocal condition
  numbers correspond to the balanced matrix. Permuting rows and columns
  will not change the condition numbers (in exact arithmetic) but
  diagonal scaling will.  For further explanation of balancing, see
  section 4.11.1.2 of LAPACK Users' Guide.

  An approximate error bound on the chordal distance between the i-th
  computed generalized eigenvalue w and the corresponding exact
  eigenvalue lambda is

       chord(w, lambda) <= EPS * norm(ABNRM, BBNRM) / RCONDE(I)

  An approximate error bound for the angle between the i-th computed
  eigenvector VL(i) or VR(i) is given by

       EPS * norm(ABNRM, BBNRM) / DIF(i).

  For further explanation of the reciprocal condition numbers RCONDE
  and RCONDV, see section 4.11 of LAPACK User's Guide.

Definition at line 393 of file dggevx.f.

393 *
394 * -- LAPACK driver routine (version 3.4.1) --
395 * -- LAPACK is a software package provided by Univ. of Tennessee, --
396 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
397 * April 2012
398 *
399 * .. Scalar Arguments ..
400  CHARACTER balanc, jobvl, jobvr, sense
401  INTEGER ihi, ilo, info, lda, ldb, ldvl, ldvr, lwork, n
402  DOUBLE PRECISION abnrm, bbnrm
403 * ..
404 * .. Array Arguments ..
405  LOGICAL bwork( * )
406  INTEGER iwork( * )
407  DOUBLE PRECISION a( lda, * ), alphai( * ), alphar( * ),
408  $ b( ldb, * ), beta( * ), lscale( * ),
409  $ rconde( * ), rcondv( * ), rscale( * ),
410  $ vl( ldvl, * ), vr( ldvr, * ), work( * )
411 * ..
412 *
413 * =====================================================================
414 *
415 * .. Parameters ..
416  DOUBLE PRECISION zero, one
417  parameter( zero = 0.0d+0, one = 1.0d+0 )
418 * ..
419 * .. Local Scalars ..
420  LOGICAL ilascl, ilbscl, ilv, ilvl, ilvr, lquery, noscl,
421  $ pair, wantsb, wantse, wantsn, wantsv
422  CHARACTER chtemp
423  INTEGER i, icols, ierr, ijobvl, ijobvr, in, irows,
424  $ itau, iwrk, iwrk1, j, jc, jr, m, maxwrk,
425  $ minwrk, mm
426  DOUBLE PRECISION anrm, anrmto, bignum, bnrm, bnrmto, eps,
427  $ smlnum, temp
428 * ..
429 * .. Local Arrays ..
430  LOGICAL ldumma( 1 )
431 * ..
432 * .. External Subroutines ..
433  EXTERNAL dgeqrf, dggbak, dggbal, dgghrd, dhgeqz, dlabad,
435  $ dtgsna, xerbla
436 * ..
437 * .. External Functions ..
438  LOGICAL lsame
439  INTEGER ilaenv
440  DOUBLE PRECISION dlamch, dlange
441  EXTERNAL lsame, ilaenv, dlamch, dlange
442 * ..
443 * .. Intrinsic Functions ..
444  INTRINSIC abs, max, sqrt
445 * ..
446 * .. Executable Statements ..
447 *
448 * Decode the input arguments
449 *
450  IF( lsame( jobvl, 'N' ) ) THEN
451  ijobvl = 1
452  ilvl = .false.
453  ELSE IF( lsame( jobvl, 'V' ) ) THEN
454  ijobvl = 2
455  ilvl = .true.
456  ELSE
457  ijobvl = -1
458  ilvl = .false.
459  END IF
460 *
461  IF( lsame( jobvr, 'N' ) ) THEN
462  ijobvr = 1
463  ilvr = .false.
464  ELSE IF( lsame( jobvr, 'V' ) ) THEN
465  ijobvr = 2
466  ilvr = .true.
467  ELSE
468  ijobvr = -1
469  ilvr = .false.
470  END IF
471  ilv = ilvl .OR. ilvr
472 *
473  noscl = lsame( balanc, 'N' ) .OR. lsame( balanc, 'P' )
474  wantsn = lsame( sense, 'N' )
475  wantse = lsame( sense, 'E' )
476  wantsv = lsame( sense, 'V' )
477  wantsb = lsame( sense, 'B' )
478 *
479 * Test the input arguments
480 *
481  info = 0
482  lquery = ( lwork.EQ.-1 )
483  IF( .NOT.( lsame( balanc, 'N' ) .OR. lsame( balanc,
484  $ 'S' ) .OR. lsame( balanc, 'P' ) .OR. lsame( balanc, 'B' ) ) )
485  $ THEN
486  info = -1
487  ELSE IF( ijobvl.LE.0 ) THEN
488  info = -2
489  ELSE IF( ijobvr.LE.0 ) THEN
490  info = -3
491  ELSE IF( .NOT.( wantsn .OR. wantse .OR. wantsb .OR. wantsv ) )
492  $ THEN
493  info = -4
494  ELSE IF( n.LT.0 ) THEN
495  info = -5
496  ELSE IF( lda.LT.max( 1, n ) ) THEN
497  info = -7
498  ELSE IF( ldb.LT.max( 1, n ) ) THEN
499  info = -9
500  ELSE IF( ldvl.LT.1 .OR. ( ilvl .AND. ldvl.LT.n ) ) THEN
501  info = -14
502  ELSE IF( ldvr.LT.1 .OR. ( ilvr .AND. ldvr.LT.n ) ) THEN
503  info = -16
504  END IF
505 *
506 * Compute workspace
507 * (Note: Comments in the code beginning "Workspace:" describe the
508 * minimal amount of workspace needed at that point in the code,
509 * as well as the preferred amount for good performance.
510 * NB refers to the optimal block size for the immediately
511 * following subroutine, as returned by ILAENV. The workspace is
512 * computed assuming ILO = 1 and IHI = N, the worst case.)
513 *
514  IF( info.EQ.0 ) THEN
515  IF( n.EQ.0 ) THEN
516  minwrk = 1
517  maxwrk = 1
518  ELSE
519  IF( noscl .AND. .NOT.ilv ) THEN
520  minwrk = 2*n
521  ELSE
522  minwrk = 6*n
523  END IF
524  IF( wantse .OR. wantsb ) THEN
525  minwrk = 10*n
526  END IF
527  IF( wantsv .OR. wantsb ) THEN
528  minwrk = max( minwrk, 2*n*( n + 4 ) + 16 )
529  END IF
530  maxwrk = minwrk
531  maxwrk = max( maxwrk,
532  $ n + n*ilaenv( 1, 'DGEQRF', ' ', n, 1, n, 0 ) )
533  maxwrk = max( maxwrk,
534  $ n + n*ilaenv( 1, 'DORMQR', ' ', n, 1, n, 0 ) )
535  IF( ilvl ) THEN
536  maxwrk = max( maxwrk, n +
537  $ n*ilaenv( 1, 'DORGQR', ' ', n, 1, n, 0 ) )
538  END IF
539  END IF
540  work( 1 ) = maxwrk
541 *
542  IF( lwork.LT.minwrk .AND. .NOT.lquery ) THEN
543  info = -26
544  END IF
545  END IF
546 *
547  IF( info.NE.0 ) THEN
548  CALL xerbla( 'DGGEVX', -info )
549  RETURN
550  ELSE IF( lquery ) THEN
551  RETURN
552  END IF
553 *
554 * Quick return if possible
555 *
556  IF( n.EQ.0 )
557  $ RETURN
558 *
559 *
560 * Get machine constants
561 *
562  eps = dlamch( 'P' )
563  smlnum = dlamch( 'S' )
564  bignum = one / smlnum
565  CALL dlabad( smlnum, bignum )
566  smlnum = sqrt( smlnum ) / eps
567  bignum = one / smlnum
568 *
569 * Scale A if max element outside range [SMLNUM,BIGNUM]
570 *
571  anrm = dlange( 'M', n, n, a, lda, work )
572  ilascl = .false.
573  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
574  anrmto = smlnum
575  ilascl = .true.
576  ELSE IF( anrm.GT.bignum ) THEN
577  anrmto = bignum
578  ilascl = .true.
579  END IF
580  IF( ilascl )
581  $ CALL dlascl( 'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
582 *
583 * Scale B if max element outside range [SMLNUM,BIGNUM]
584 *
585  bnrm = dlange( 'M', n, n, b, ldb, work )
586  ilbscl = .false.
587  IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) THEN
588  bnrmto = smlnum
589  ilbscl = .true.
590  ELSE IF( bnrm.GT.bignum ) THEN
591  bnrmto = bignum
592  ilbscl = .true.
593  END IF
594  IF( ilbscl )
595  $ CALL dlascl( 'G', 0, 0, bnrm, bnrmto, n, n, b, ldb, ierr )
596 *
597 * Permute and/or balance the matrix pair (A,B)
598 * (Workspace: need 6*N if BALANC = 'S' or 'B', 1 otherwise)
599 *
600  CALL dggbal( balanc, n, a, lda, b, ldb, ilo, ihi, lscale, rscale,
601  $ work, ierr )
602 *
603 * Compute ABNRM and BBNRM
604 *
605  abnrm = dlange( '1', n, n, a, lda, work( 1 ) )
606  IF( ilascl ) THEN
607  work( 1 ) = abnrm
608  CALL dlascl( 'G', 0, 0, anrmto, anrm, 1, 1, work( 1 ), 1,
609  $ ierr )
610  abnrm = work( 1 )
611  END IF
612 *
613  bbnrm = dlange( '1', n, n, b, ldb, work( 1 ) )
614  IF( ilbscl ) THEN
615  work( 1 ) = bbnrm
616  CALL dlascl( 'G', 0, 0, bnrmto, bnrm, 1, 1, work( 1 ), 1,
617  $ ierr )
618  bbnrm = work( 1 )
619  END IF
620 *
621 * Reduce B to triangular form (QR decomposition of B)
622 * (Workspace: need N, prefer N*NB )
623 *
624  irows = ihi + 1 - ilo
625  IF( ilv .OR. .NOT.wantsn ) THEN
626  icols = n + 1 - ilo
627  ELSE
628  icols = irows
629  END IF
630  itau = 1
631  iwrk = itau + irows
632  CALL dgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
633  $ work( iwrk ), lwork+1-iwrk, ierr )
634 *
635 * Apply the orthogonal transformation to A
636 * (Workspace: need N, prefer N*NB)
637 *
638  CALL dormqr( 'L', 'T', irows, icols, irows, b( ilo, ilo ), ldb,
639  $ work( itau ), a( ilo, ilo ), lda, work( iwrk ),
640  $ lwork+1-iwrk, ierr )
641 *
642 * Initialize VL and/or VR
643 * (Workspace: need N, prefer N*NB)
644 *
645  IF( ilvl ) THEN
646  CALL dlaset( 'Full', n, n, zero, one, vl, ldvl )
647  IF( irows.GT.1 ) THEN
648  CALL dlacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
649  $ vl( ilo+1, ilo ), ldvl )
650  END IF
651  CALL dorgqr( irows, irows, irows, vl( ilo, ilo ), ldvl,
652  $ work( itau ), work( iwrk ), lwork+1-iwrk, ierr )
653  END IF
654 *
655  IF( ilvr )
656  $ CALL dlaset( 'Full', n, n, zero, one, vr, ldvr )
657 *
658 * Reduce to generalized Hessenberg form
659 * (Workspace: none needed)
660 *
661  IF( ilv .OR. .NOT.wantsn ) THEN
662 *
663 * Eigenvectors requested -- work on whole matrix.
664 *
665  CALL dgghrd( jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb, vl,
666  $ ldvl, vr, ldvr, ierr )
667  ELSE
668  CALL dgghrd( 'N', 'N', irows, 1, irows, a( ilo, ilo ), lda,
669  $ b( ilo, ilo ), ldb, vl, ldvl, vr, ldvr, ierr )
670  END IF
671 *
672 * Perform QZ algorithm (Compute eigenvalues, and optionally, the
673 * Schur forms and Schur vectors)
674 * (Workspace: need N)
675 *
676  IF( ilv .OR. .NOT.wantsn ) THEN
677  chtemp = 'S'
678  ELSE
679  chtemp = 'E'
680  END IF
681 *
682  CALL dhgeqz( chtemp, jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb,
683  $ alphar, alphai, beta, vl, ldvl, vr, ldvr, work,
684  $ lwork, ierr )
685  IF( ierr.NE.0 ) THEN
686  IF( ierr.GT.0 .AND. ierr.LE.n ) THEN
687  info = ierr
688  ELSE IF( ierr.GT.n .AND. ierr.LE.2*n ) THEN
689  info = ierr - n
690  ELSE
691  info = n + 1
692  END IF
693  GO TO 130
694  END IF
695 *
696 * Compute Eigenvectors and estimate condition numbers if desired
697 * (Workspace: DTGEVC: need 6*N
698 * DTGSNA: need 2*N*(N+2)+16 if SENSE = 'V' or 'B',
699 * need N otherwise )
700 *
701  IF( ilv .OR. .NOT.wantsn ) THEN
702  IF( ilv ) THEN
703  IF( ilvl ) THEN
704  IF( ilvr ) THEN
705  chtemp = 'B'
706  ELSE
707  chtemp = 'L'
708  END IF
709  ELSE
710  chtemp = 'R'
711  END IF
712 *
713  CALL dtgevc( chtemp, 'B', ldumma, n, a, lda, b, ldb, vl,
714  $ ldvl, vr, ldvr, n, in, work, ierr )
715  IF( ierr.NE.0 ) THEN
716  info = n + 2
717  GO TO 130
718  END IF
719  END IF
720 *
721  IF( .NOT.wantsn ) THEN
722 *
723 * compute eigenvectors (DTGEVC) and estimate condition
724 * numbers (DTGSNA). Note that the definition of the condition
725 * number is not invariant under transformation (u,v) to
726 * (Q*u, Z*v), where (u,v) are eigenvectors of the generalized
727 * Schur form (S,T), Q and Z are orthogonal matrices. In order
728 * to avoid using extra 2*N*N workspace, we have to recalculate
729 * eigenvectors and estimate one condition numbers at a time.
730 *
731  pair = .false.
732  DO 20 i = 1, n
733 *
734  IF( pair ) THEN
735  pair = .false.
736  GO TO 20
737  END IF
738  mm = 1
739  IF( i.LT.n ) THEN
740  IF( a( i+1, i ).NE.zero ) THEN
741  pair = .true.
742  mm = 2
743  END IF
744  END IF
745 *
746  DO 10 j = 1, n
747  bwork( j ) = .false.
748  10 CONTINUE
749  IF( mm.EQ.1 ) THEN
750  bwork( i ) = .true.
751  ELSE IF( mm.EQ.2 ) THEN
752  bwork( i ) = .true.
753  bwork( i+1 ) = .true.
754  END IF
755 *
756  iwrk = mm*n + 1
757  iwrk1 = iwrk + mm*n
758 *
759 * Compute a pair of left and right eigenvectors.
760 * (compute workspace: need up to 4*N + 6*N)
761 *
762  IF( wantse .OR. wantsb ) THEN
763  CALL dtgevc( 'B', 'S', bwork, n, a, lda, b, ldb,
764  $ work( 1 ), n, work( iwrk ), n, mm, m,
765  $ work( iwrk1 ), ierr )
766  IF( ierr.NE.0 ) THEN
767  info = n + 2
768  GO TO 130
769  END IF
770  END IF
771 *
772  CALL dtgsna( sense, 'S', bwork, n, a, lda, b, ldb,
773  $ work( 1 ), n, work( iwrk ), n, rconde( i ),
774  $ rcondv( i ), mm, m, work( iwrk1 ),
775  $ lwork-iwrk1+1, iwork, ierr )
776 *
777  20 CONTINUE
778  END IF
779  END IF
780 *
781 * Undo balancing on VL and VR and normalization
782 * (Workspace: none needed)
783 *
784  IF( ilvl ) THEN
785  CALL dggbak( balanc, 'L', n, ilo, ihi, lscale, rscale, n, vl,
786  $ ldvl, ierr )
787 *
788  DO 70 jc = 1, n
789  IF( alphai( jc ).LT.zero )
790  $ GO TO 70
791  temp = zero
792  IF( alphai( jc ).EQ.zero ) THEN
793  DO 30 jr = 1, n
794  temp = max( temp, abs( vl( jr, jc ) ) )
795  30 CONTINUE
796  ELSE
797  DO 40 jr = 1, n
798  temp = max( temp, abs( vl( jr, jc ) )+
799  $ abs( vl( jr, jc+1 ) ) )
800  40 CONTINUE
801  END IF
802  IF( temp.LT.smlnum )
803  $ GO TO 70
804  temp = one / temp
805  IF( alphai( jc ).EQ.zero ) THEN
806  DO 50 jr = 1, n
807  vl( jr, jc ) = vl( jr, jc )*temp
808  50 CONTINUE
809  ELSE
810  DO 60 jr = 1, n
811  vl( jr, jc ) = vl( jr, jc )*temp
812  vl( jr, jc+1 ) = vl( jr, jc+1 )*temp
813  60 CONTINUE
814  END IF
815  70 CONTINUE
816  END IF
817  IF( ilvr ) THEN
818  CALL dggbak( balanc, 'R', n, ilo, ihi, lscale, rscale, n, vr,
819  $ ldvr, ierr )
820  DO 120 jc = 1, n
821  IF( alphai( jc ).LT.zero )
822  $ GO TO 120
823  temp = zero
824  IF( alphai( jc ).EQ.zero ) THEN
825  DO 80 jr = 1, n
826  temp = max( temp, abs( vr( jr, jc ) ) )
827  80 CONTINUE
828  ELSE
829  DO 90 jr = 1, n
830  temp = max( temp, abs( vr( jr, jc ) )+
831  $ abs( vr( jr, jc+1 ) ) )
832  90 CONTINUE
833  END IF
834  IF( temp.LT.smlnum )
835  $ GO TO 120
836  temp = one / temp
837  IF( alphai( jc ).EQ.zero ) THEN
838  DO 100 jr = 1, n
839  vr( jr, jc ) = vr( jr, jc )*temp
840  100 CONTINUE
841  ELSE
842  DO 110 jr = 1, n
843  vr( jr, jc ) = vr( jr, jc )*temp
844  vr( jr, jc+1 ) = vr( jr, jc+1 )*temp
845  110 CONTINUE
846  END IF
847  120 CONTINUE
848  END IF
849 *
850 * Undo scaling if necessary
851 *
852  130 CONTINUE
853 *
854  IF( ilascl ) THEN
855  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n, ierr )
856  CALL dlascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n, ierr )
857  END IF
858 *
859  IF( ilbscl ) THEN
860  CALL dlascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
861  END IF
862 *
863  work( 1 ) = maxwrk
864  RETURN
865 *
866 * End of DGGEVX
867 *
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dtgsna(JOB, HOWMNY, SELECT, N, A, LDA, B, LDB, VL, LDVL, VR, LDVR, S, DIF, MM, M, WORK, LWORK, IWORK, INFO)
DTGSNA
Definition: dtgsna.f:383
subroutine dgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGEQRF
Definition: dgeqrf.f:138
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine dgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
DGGHRD
Definition: dgghrd.f:209
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
Definition: dormqr.f:169
subroutine dhgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
DHGEQZ
Definition: dhgeqz.f:306
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:130
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dtgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
DTGEVC
Definition: dtgevc.f:297
subroutine dggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
DGGBAL
Definition: dggbal.f:179
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: dlascl.f:141
subroutine dggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
DGGBAK
Definition: dggbak.f:149
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83

Here is the call graph for this function:

Here is the caller graph for this function: