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

Functions

subroutine sgegs (JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, INFO)
  SGEGS computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 
subroutine sgegv (JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
  SGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 
subroutine sgees (JOBVS, SORT, SELECT, N, A, LDA, SDIM, WR, WI, VS, LDVS, WORK, LWORK, BWORK, INFO)
  SGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices More...
 
subroutine sgeesx (JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, IWORK, LIWORK, BWORK, INFO)
  SGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices More...
 
subroutine sgeev (JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
  SGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 
subroutine sgeevx (BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK, LWORK, IWORK, INFO)
  SGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 
subroutine sgges (JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, BWORK, INFO)
  SGGES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices More...
 
subroutine sgges3 (JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA, B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, BWORK, INFO)
  SGGES3 computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices (blocked algorithm) More...
 
subroutine sggesx (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)
  SGGESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE matrices More...
 
subroutine sggev (JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
  SGGEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 
subroutine sggev3 (JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
  SGGEV3 computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices (blocked algorithm) More...
 
subroutine sggevx (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)
  SGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices More...
 

Detailed Description

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

Function Documentation

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

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

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

Purpose:
 SGEES 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 LOGICAL FUNCTION of two REAL 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 REAL 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 REAL array, dimension (N)
[out]WI
          WI is REAL 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 REAL 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 REAL 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 sgees.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  REAL 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  REAL zero, one
242  parameter( zero = 0.0e0, one = 1.0e0 )
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  REAL anrm, bignum, cscale, eps, s, sep, smlnum
250 * ..
251 * .. Local Arrays ..
252  INTEGER idum( 1 )
253  REAL dum( 1 )
254 * ..
255 * .. External Subroutines ..
256  EXTERNAL scopy, sgebak, sgebal, sgehrd, shseqr, slabad,
258 * ..
259 * .. External Functions ..
260  LOGICAL lsame
261  INTEGER ilaenv
262  REAL slamch, slange
263  EXTERNAL lsame, ilaenv, slamch, slange
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 SHSEQR, 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, 'SGEHRD', ' ', n, 1, n, 0 )
304  minwrk = 3*n
305 *
306  CALL shseqr( '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  $ 'SORGHR', ' ', 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( 'SGEES ', -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 = slamch( 'P' )
342  smlnum = slamch( 'S' )
343  bignum = one / smlnum
344  CALL slabad( 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 = slange( '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 slascl( '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 sgebal( '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 sgehrd( 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 slacpy( '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 sorghr( 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 shseqr( '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 slascl( 'G', 0, 0, cscale, anrm, n, 1, wr, n, ierr )
405  CALL slascl( '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 strsen( '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 sgebak( '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 slascl( 'H', 0, 0, cscale, anrm, n, n, a, lda, ierr )
435  CALL scopy( 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 slascl( '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 sswap( i-1, a( 1, i ), 1, a( 1, i+1 ), 1 )
470  IF( n.GT.i+1 )
471  $ CALL sswap( n-i-1, a( i, i+2 ), lda,
472  $ a( i+1, i+2 ), lda )
473  IF( wantvs ) THEN
474  CALL sswap( 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 slascl( '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 SGEES
534 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:53
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine sgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
SGEBAK
Definition: sgebak.f:132
subroutine strsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
STRSEN
Definition: strsen.f:316
subroutine shseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
SHSEQR
Definition: shseqr.f:318
subroutine sgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SGEHRD
Definition: sgehrd.f:169
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
Definition: sswap.f:53
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
subroutine sgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
SGEBAL
Definition: sgebal.f:162
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:141
subroutine sorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SORGHR
Definition: sorghr.f:128
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

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

Purpose:
 SGEESX 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 REAL 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 REAL 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 REAL array, dimension (N)
[out]WI
          WI is REAL 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 REAL 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 REAL
          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 REAL
          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 REAL 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 sgeesx.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  REAL rconde, rcondv
293 * ..
294 * .. Array Arguments ..
295  LOGICAL bwork( * )
296  INTEGER iwork( * )
297  REAL 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  REAL zero, one
309  parameter( zero = 0.0e0, one = 1.0e0 )
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, lwrk, liwrk,
316  $ maxwrk, minwrk
317  REAL anrm, bignum, cscale, eps, smlnum
318 * ..
319 * .. Local Arrays ..
320  REAL dum( 1 )
321 * ..
322 * .. External Subroutines ..
323  EXTERNAL scopy, sgebak, sgebal, sgehrd, shseqr, slabad,
325 * ..
326 * .. External Functions ..
327  LOGICAL lsame
328  INTEGER ilaenv
329  REAL slamch, slange
330  EXTERNAL lsame, ilaenv, slamch, slange
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 SHSEQR, 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 STRSEN 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, 'SGEHRD', ' ', n, 1, n, 0 )
384  minwrk = 3*n
385 *
386  CALL shseqr( '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  $ 'SORGHR', ' ', 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( 'SGEESX', -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 = slamch( 'P' )
430  smlnum = slamch( 'S' )
431  bignum = one / smlnum
432  CALL slabad( 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 = slange( '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 slascl( '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 sgebal( '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 sgehrd( 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 slacpy( '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 sorghr( 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 shseqr( '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 slascl( 'G', 0, 0, cscale, anrm, n, 1, wr, n, ierr )
493  CALL slascl( '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 strsen( 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 * STRSEN 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 sgebak( '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 slascl( 'H', 0, 0, cscale, anrm, n, n, a, lda, ierr )
543  CALL scopy( n, a, lda+1, wr, 1 )
544  IF( ( wantsv .OR. wantsb ) .AND. info.EQ.0 ) THEN
545  dum( 1 ) = rcondv
546  CALL slascl( '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 slascl( '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 sswap( i-1, a( 1, i ), 1, a( 1, i+1 ), 1 )
583  IF( n.GT.i+1 )
584  $ CALL sswap( n-i-1, a( i, i+2 ), lda,
585  $ a( i+1, i+2 ), lda )
586  CALL sswap( 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 slascl( '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 ) = sdim*(n-sdim)
641  ELSE
642  iwork( 1 ) = 1
643  END IF
644 *
645  RETURN
646 *
647 * End of SGEESX
648 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:53
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine sgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
SGEBAK
Definition: sgebak.f:132
subroutine strsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, WR, WI, M, S, SEP, WORK, LWORK, IWORK, LIWORK, INFO)
STRSEN
Definition: strsen.f:316
subroutine shseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
SHSEQR
Definition: shseqr.f:318
subroutine sgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SGEHRD
Definition: sgehrd.f:169
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
Definition: sswap.f:53
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
subroutine sgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
SGEBAL
Definition: sgebal.f:162
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:141
subroutine sorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SORGHR
Definition: sorghr.f:128
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

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

Purpose:
 SGEEV 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 REAL 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 REAL array, dimension (N)
[out]WI
          WI is REAL 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 REAL 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 REAL 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 REAL 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 sgeev.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  REAL a( lda, * ), vl( ldvl, * ), vr( ldvr, * ),
203  $ wi( * ), work( * ), wr( * )
204 * ..
205 *
206 * =====================================================================
207 *
208 * .. Parameters ..
209  REAL zero, one
210  parameter( zero = 0.0e0, one = 1.0e0 )
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  REAL anrm, bignum, cs, cscale, eps, r, scl, smlnum,
218  $ sn
219 * ..
220 * .. Local Arrays ..
221  LOGICAL select( 1 )
222  REAL dum( 1 )
223 * ..
224 * .. External Subroutines ..
225  EXTERNAL sgebak, sgebal, sgehrd, shseqr, slabad, slacpy,
227  $ xerbla
228 * ..
229 * .. External Functions ..
230  LOGICAL lsame
231  INTEGER ilaenv, isamax
232  REAL slamch, slange, slapy2, snrm2
233  EXTERNAL lsame, ilaenv, isamax, slamch, slange, slapy2,
234  $ snrm2
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 SHSEQR, 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, 'SGEHRD', ' ', n, 1, n, 0 )
277  IF( wantvl ) THEN
278  minwrk = 4*n
279  maxwrk = max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
280  $ 'SORGHR', ' ', n, 1, n, -1 ) )
281  CALL shseqr( '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  $ 'SORGHR', ' ', n, 1, n, -1 ) )
290  CALL shseqr( '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 shseqr( '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( 'SGEEV ', -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 = slamch( 'P' )
326  smlnum = slamch( 'S' )
327  bignum = one / smlnum
328  CALL slabad( 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 = slange( '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 slascl( '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 sgebal( '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 sgehrd( 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 slacpy( '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 sorghr( 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 shseqr( '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 slacpy( '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 slacpy( '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 sorghr( 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 shseqr( '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 shseqr( '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 SHSEQR, 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 strevc( 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 sgebak( '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 / snrm2( n, vl( 1, i ), 1 )
448  CALL sscal( n, scl, vl( 1, i ), 1 )
449  ELSE IF( wi( i ).GT.zero ) THEN
450  scl = one / slapy2( snrm2( n, vl( 1, i ), 1 ),
451  $ snrm2( n, vl( 1, i+1 ), 1 ) )
452  CALL sscal( n, scl, vl( 1, i ), 1 )
453  CALL sscal( 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 = isamax( n, work( iwrk ), 1 )
458  CALL slartg( vl( k, i ), vl( k, i+1 ), cs, sn, r )
459  CALL srot( 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 sgebak( '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 / snrm2( n, vr( 1, i ), 1 )
478  CALL sscal( n, scl, vr( 1, i ), 1 )
479  ELSE IF( wi( i ).GT.zero ) THEN
480  scl = one / slapy2( snrm2( n, vr( 1, i ), 1 ),
481  $ snrm2( n, vr( 1, i+1 ), 1 ) )
482  CALL sscal( n, scl, vr( 1, i ), 1 )
483  CALL sscal( 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 = isamax( n, work( iwrk ), 1 )
488  CALL slartg( vr( k, i ), vr( k, i+1 ), cs, sn, r )
489  CALL srot( 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 slascl( 'G', 0, 0, cscale, anrm, n-info, 1, wr( info+1 ),
500  $ max( n-info, 1 ), ierr )
501  CALL slascl( '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 slascl( 'G', 0, 0, cscale, anrm, ilo-1, 1, wr, n,
505  $ ierr )
506  CALL slascl( '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 SGEEV
515 *
real function snrm2(N, X, INCX)
SNRM2
Definition: snrm2.f:56
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine slartg(F, G, CS, SN, R)
SLARTG generates a plane rotation with real cosine and real sine.
Definition: slartg.f:99
integer function isamax(N, SX, INCX)
ISAMAX
Definition: isamax.f:53
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
real function slapy2(X, Y)
SLAPY2 returns sqrt(x2+y2).
Definition: slapy2.f:65
subroutine sgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
SGEBAK
Definition: sgebak.f:132
subroutine shseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
SHSEQR
Definition: shseqr.f:318
subroutine sgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SGEHRD
Definition: sgehrd.f:169
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine sscal(N, SA, SX, INCX)
SSCAL
Definition: sscal.f:55
subroutine srot(N, SX, INCX, SY, INCY, C, S)
SROT
Definition: srot.f:53
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
subroutine sgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
SGEBAL
Definition: sgebal.f:162
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:141
subroutine sorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SORGHR
Definition: sorghr.f:128
subroutine strevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
STREVC
Definition: strevc.f:224
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

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

Purpose:
 SGEEVX 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 REAL 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 REAL array, dimension (N)
[out]WI
          WI is REAL 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 REAL 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 REAL 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 REAL 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 REAL
          The one-norm of the balanced matrix (the maximum
          of the sum of absolute values of elements of any column).
[out]RCONDE
          RCONDE is REAL array, dimension (N)
          RCONDE(j) is the reciprocal condition number of the j-th
          eigenvalue.
[out]RCONDV
          RCONDV is REAL array, dimension (N)
          RCONDV(j) is the reciprocal condition number of the j-th
          right eigenvector.
[out]WORK
          WORK is REAL 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 sgeevx.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  REAL abnrm
315 * ..
316 * .. Array Arguments ..
317  INTEGER iwork( * )
318  REAL a( lda, * ), rconde( * ), rcondv( * ),
319  $ scale( * ), vl( ldvl, * ), vr( ldvr, * ),
320  $ wi( * ), work( * ), wr( * )
321 * ..
322 *
323 * =====================================================================
324 *
325 * .. Parameters ..
326  REAL zero, one
327  parameter( zero = 0.0e0, one = 1.0e0 )
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  REAL anrm, bignum, cs, cscale, eps, r, scl, smlnum,
336  $ sn
337 * ..
338 * .. Local Arrays ..
339  LOGICAL select( 1 )
340  REAL dum( 1 )
341 * ..
342 * .. External Subroutines ..
343  EXTERNAL sgebak, sgebal, sgehrd, shseqr, slabad, slacpy,
345  $ strsna, xerbla
346 * ..
347 * .. External Functions ..
348  LOGICAL lsame
349  INTEGER ilaenv, isamax
350  REAL slamch, slange, slapy2, snrm2
351  EXTERNAL lsame, ilaenv, isamax, slamch, slange, slapy2,
352  $ snrm2
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, 'S' ) .OR.
370  $ lsame( balanc, 'P' ) .OR. lsame( balanc, 'B' ) ) ) THEN
371  info = -1
372  ELSE IF( ( .NOT.wantvl ) .AND. ( .NOT.lsame( jobvl, 'N' ) ) ) THEN
373  info = -2
374  ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.lsame( jobvr, 'N' ) ) ) THEN
375  info = -3
376  ELSE IF( .NOT.( wntsnn .OR. wntsne .OR. wntsnb .OR. wntsnv ) .OR.
377  $ ( ( wntsne .OR. wntsnb ) .AND. .NOT.( wantvl .AND.
378  $ wantvr ) ) ) THEN
379  info = -4
380  ELSE IF( n.LT.0 ) THEN
381  info = -5
382  ELSE IF( lda.LT.max( 1, n ) ) THEN
383  info = -7
384  ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) ) THEN
385  info = -11
386  ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) ) THEN
387  info = -13
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 * HSWORK refers to the workspace preferred by SHSEQR, as
397 * calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
398 * the worst case.)
399 *
400  IF( info.EQ.0 ) THEN
401  IF( n.EQ.0 ) THEN
402  minwrk = 1
403  maxwrk = 1
404  ELSE
405  maxwrk = n + n*ilaenv( 1, 'SGEHRD', ' ', n, 1, n, 0 )
406 *
407  IF( wantvl ) THEN
408  CALL shseqr( 'S', 'V', n, 1, n, a, lda, wr, wi, vl, ldvl,
409  $ work, -1, info )
410  ELSE IF( wantvr ) THEN
411  CALL shseqr( 'S', 'V', n, 1, n, a, lda, wr, wi, vr, ldvr,
412  $ work, -1, info )
413  ELSE
414  IF( wntsnn ) THEN
415  CALL shseqr( 'E', 'N', n, 1, n, a, lda, wr, wi, vr,
416  $ ldvr, work, -1, info )
417  ELSE
418  CALL shseqr( 'S', 'N', n, 1, n, a, lda, wr, wi, vr,
419  $ ldvr, work, -1, info )
420  END IF
421  END IF
422  hswork = work( 1 )
423 *
424  IF( ( .NOT.wantvl ) .AND. ( .NOT.wantvr ) ) THEN
425  minwrk = 2*n
426  IF( .NOT.wntsnn )
427  $ minwrk = max( minwrk, n*n+6*n )
428  maxwrk = max( maxwrk, hswork )
429  IF( .NOT.wntsnn )
430  $ maxwrk = max( maxwrk, n*n + 6*n )
431  ELSE
432  minwrk = 3*n
433  IF( ( .NOT.wntsnn ) .AND. ( .NOT.wntsne ) )
434  $ minwrk = max( minwrk, n*n + 6*n )
435  maxwrk = max( maxwrk, hswork )
436  maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1, 'SORGHR',
437  $ ' ', n, 1, n, -1 ) )
438  IF( ( .NOT.wntsnn ) .AND. ( .NOT.wntsne ) )
439  $ maxwrk = max( maxwrk, n*n + 6*n )
440  maxwrk = max( maxwrk, 3*n )
441  END IF
442  maxwrk = max( maxwrk, minwrk )
443  END IF
444  work( 1 ) = maxwrk
445 *
446  IF( lwork.LT.minwrk .AND. .NOT.lquery ) THEN
447  info = -21
448  END IF
449  END IF
450 *
451  IF( info.NE.0 ) THEN
452  CALL xerbla( 'SGEEVX', -info )
453  RETURN
454  ELSE IF( lquery ) THEN
455  RETURN
456  END IF
457 *
458 * Quick return if possible
459 *
460  IF( n.EQ.0 )
461  $ RETURN
462 *
463 * Get machine constants
464 *
465  eps = slamch( 'P' )
466  smlnum = slamch( 'S' )
467  bignum = one / smlnum
468  CALL slabad( smlnum, bignum )
469  smlnum = sqrt( smlnum ) / eps
470  bignum = one / smlnum
471 *
472 * Scale A if max element outside range [SMLNUM,BIGNUM]
473 *
474  icond = 0
475  anrm = slange( 'M', n, n, a, lda, dum )
476  scalea = .false.
477  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
478  scalea = .true.
479  cscale = smlnum
480  ELSE IF( anrm.GT.bignum ) THEN
481  scalea = .true.
482  cscale = bignum
483  END IF
484  IF( scalea )
485  $ CALL slascl( 'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
486 *
487 * Balance the matrix and compute ABNRM
488 *
489  CALL sgebal( balanc, n, a, lda, ilo, ihi, scale, ierr )
490  abnrm = slange( '1', n, n, a, lda, dum )
491  IF( scalea ) THEN
492  dum( 1 ) = abnrm
493  CALL slascl( 'G', 0, 0, cscale, anrm, 1, 1, dum, 1, ierr )
494  abnrm = dum( 1 )
495  END IF
496 *
497 * Reduce to upper Hessenberg form
498 * (Workspace: need 2*N, prefer N+N*NB)
499 *
500  itau = 1
501  iwrk = itau + n
502  CALL sgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
503  $ lwork-iwrk+1, ierr )
504 *
505  IF( wantvl ) THEN
506 *
507 * Want left eigenvectors
508 * Copy Householder vectors to VL
509 *
510  side = 'L'
511  CALL slacpy( 'L', n, n, a, lda, vl, ldvl )
512 *
513 * Generate orthogonal matrix in VL
514 * (Workspace: need 2*N-1, prefer N+(N-1)*NB)
515 *
516  CALL sorghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
517  $ lwork-iwrk+1, ierr )
518 *
519 * Perform QR iteration, accumulating Schur vectors in VL
520 * (Workspace: need 1, prefer HSWORK (see comments) )
521 *
522  iwrk = itau
523  CALL shseqr( 'S', 'V', n, ilo, ihi, a, lda, wr, wi, vl, ldvl,
524  $ work( iwrk ), lwork-iwrk+1, info )
525 *
526  IF( wantvr ) THEN
527 *
528 * Want left and right eigenvectors
529 * Copy Schur vectors to VR
530 *
531  side = 'B'
532  CALL slacpy( 'F', n, n, vl, ldvl, vr, ldvr )
533  END IF
534 *
535  ELSE IF( wantvr ) THEN
536 *
537 * Want right eigenvectors
538 * Copy Householder vectors to VR
539 *
540  side = 'R'
541  CALL slacpy( 'L', n, n, a, lda, vr, ldvr )
542 *
543 * Generate orthogonal matrix in VR
544 * (Workspace: need 2*N-1, prefer N+(N-1)*NB)
545 *
546  CALL sorghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
547  $ lwork-iwrk+1, ierr )
548 *
549 * Perform QR iteration, accumulating Schur vectors in VR
550 * (Workspace: need 1, prefer HSWORK (see comments) )
551 *
552  iwrk = itau
553  CALL shseqr( 'S', 'V', n, ilo, ihi, a, lda, wr, wi, vr, ldvr,
554  $ work( iwrk ), lwork-iwrk+1, info )
555 *
556  ELSE
557 *
558 * Compute eigenvalues only
559 * If condition numbers desired, compute Schur form
560 *
561  IF( wntsnn ) THEN
562  job = 'E'
563  ELSE
564  job = 'S'
565  END IF
566 *
567 * (Workspace: need 1, prefer HSWORK (see comments) )
568 *
569  iwrk = itau
570  CALL shseqr( job, 'N', n, ilo, ihi, a, lda, wr, wi, vr, ldvr,
571  $ work( iwrk ), lwork-iwrk+1, info )
572  END IF
573 *
574 * If INFO > 0 from SHSEQR, then quit
575 *
576  IF( info.GT.0 )
577  $ GO TO 50
578 *
579  IF( wantvl .OR. wantvr ) THEN
580 *
581 * Compute left and/or right eigenvectors
582 * (Workspace: need 3*N)
583 *
584  CALL strevc( side, 'B', SELECT, n, a, lda, vl, ldvl, vr, ldvr,
585  $ n, nout, work( iwrk ), ierr )
586  END IF
587 *
588 * Compute condition numbers if desired
589 * (Workspace: need N*N+6*N unless SENSE = 'E')
590 *
591  IF( .NOT.wntsnn ) THEN
592  CALL strsna( sense, 'A', SELECT, n, a, lda, vl, ldvl, vr, ldvr,
593  $ rconde, rcondv, n, nout, work( iwrk ), n, iwork,
594  $ icond )
595  END IF
596 *
597  IF( wantvl ) THEN
598 *
599 * Undo balancing of left eigenvectors
600 *
601  CALL sgebak( balanc, 'L', n, ilo, ihi, scale, n, vl, ldvl,
602  $ ierr )
603 *
604 * Normalize left eigenvectors and make largest component real
605 *
606  DO 20 i = 1, n
607  IF( wi( i ).EQ.zero ) THEN
608  scl = one / snrm2( n, vl( 1, i ), 1 )
609  CALL sscal( n, scl, vl( 1, i ), 1 )
610  ELSE IF( wi( i ).GT.zero ) THEN
611  scl = one / slapy2( snrm2( n, vl( 1, i ), 1 ),
612  $ snrm2( n, vl( 1, i+1 ), 1 ) )
613  CALL sscal( n, scl, vl( 1, i ), 1 )
614  CALL sscal( n, scl, vl( 1, i+1 ), 1 )
615  DO 10 k = 1, n
616  work( k ) = vl( k, i )**2 + vl( k, i+1 )**2
617  10 CONTINUE
618  k = isamax( n, work, 1 )
619  CALL slartg( vl( k, i ), vl( k, i+1 ), cs, sn, r )
620  CALL srot( n, vl( 1, i ), 1, vl( 1, i+1 ), 1, cs, sn )
621  vl( k, i+1 ) = zero
622  END IF
623  20 CONTINUE
624  END IF
625 *
626  IF( wantvr ) THEN
627 *
628 * Undo balancing of right eigenvectors
629 *
630  CALL sgebak( balanc, 'R', n, ilo, ihi, scale, n, vr, ldvr,
631  $ ierr )
632 *
633 * Normalize right eigenvectors and make largest component real
634 *
635  DO 40 i = 1, n
636  IF( wi( i ).EQ.zero ) THEN
637  scl = one / snrm2( n, vr( 1, i ), 1 )
638  CALL sscal( n, scl, vr( 1, i ), 1 )
639  ELSE IF( wi( i ).GT.zero ) THEN
640  scl = one / slapy2( snrm2( n, vr( 1, i ), 1 ),
641  $ snrm2( n, vr( 1, i+1 ), 1 ) )
642  CALL sscal( n, scl, vr( 1, i ), 1 )
643  CALL sscal( n, scl, vr( 1, i+1 ), 1 )
644  DO 30 k = 1, n
645  work( k ) = vr( k, i )**2 + vr( k, i+1 )**2
646  30 CONTINUE
647  k = isamax( n, work, 1 )
648  CALL slartg( vr( k, i ), vr( k, i+1 ), cs, sn, r )
649  CALL srot( n, vr( 1, i ), 1, vr( 1, i+1 ), 1, cs, sn )
650  vr( k, i+1 ) = zero
651  END IF
652  40 CONTINUE
653  END IF
654 *
655 * Undo scaling if necessary
656 *
657  50 CONTINUE
658  IF( scalea ) THEN
659  CALL slascl( 'G', 0, 0, cscale, anrm, n-info, 1, wr( info+1 ),
660  $ max( n-info, 1 ), ierr )
661  CALL slascl( 'G', 0, 0, cscale, anrm, n-info, 1, wi( info+1 ),
662  $ max( n-info, 1 ), ierr )
663  IF( info.EQ.0 ) THEN
664  IF( ( wntsnv .OR. wntsnb ) .AND. icond.EQ.0 )
665  $ CALL slascl( 'G', 0, 0, cscale, anrm, n, 1, rcondv, n,
666  $ ierr )
667  ELSE
668  CALL slascl( 'G', 0, 0, cscale, anrm, ilo-1, 1, wr, n,
669  $ ierr )
670  CALL slascl( 'G', 0, 0, cscale, anrm, ilo-1, 1, wi, n,
671  $ ierr )
672  END IF
673  END IF
674 *
675  work( 1 ) = maxwrk
676  RETURN
677 *
678 * End of SGEEVX
679 *
subroutine strsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, IWORK, INFO)
STRSNA
Definition: strsna.f:267
real function snrm2(N, X, INCX)
SNRM2
Definition: snrm2.f:56
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine slartg(F, G, CS, SN, R)
SLARTG generates a plane rotation with real cosine and real sine.
Definition: slartg.f:99
integer function isamax(N, SX, INCX)
ISAMAX
Definition: isamax.f:53
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
real function slapy2(X, Y)
SLAPY2 returns sqrt(x2+y2).
Definition: slapy2.f:65
subroutine sgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
SGEBAK
Definition: sgebak.f:132
subroutine shseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
SHSEQR
Definition: shseqr.f:318
subroutine sgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SGEHRD
Definition: sgehrd.f:169
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine sscal(N, SA, SX, INCX)
SSCAL
Definition: sscal.f:55
subroutine srot(N, SX, INCX, SY, INCY, C, S)
SROT
Definition: srot.f:53
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
subroutine sgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
SGEBAL
Definition: sgebal.f:162
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:141
subroutine sorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
SORGHR
Definition: sorghr.f:128
subroutine strevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
STREVC
Definition: strevc.f:224
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

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

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

 SGEGS 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
 SGEGV should be used instead.  See SGEGV 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 REAL 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 REAL 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 REAL array, dimension (N)
          The real parts of each scalar alpha defining an eigenvalue
          of GNEP.
[out]ALPHAI
          ALPHAI is REAL 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 REAL 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 REAL 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 REAL 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 REAL 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 SGEQRF, SORMQR, and SORGQR.)  Then compute:
          NB  -- MAX of the blocksizes for SGEQRF, SORMQR, and SORGQR
          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 SGGBAL
                =N+2: error return from SGEQRF
                =N+3: error return from SORMQR
                =N+4: error return from SORGQR
                =N+5: error return from SGGHRD
                =N+6: error return from SHGEQZ (other than failed
                                                iteration)
                =N+7: error return from SGGBAK (computing VSL)
                =N+8: error return from SGGBAK (computing VSR)
                =N+9: error return from SLASCL (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 sgegs.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  REAL a( lda, * ), alphai( * ), alphar( * ),
241  $ b( ldb, * ), beta( * ), vsl( ldvsl, * ),
242  $ vsr( ldvsr, * ), work( * )
243 * ..
244 *
245 * =====================================================================
246 *
247 * .. Parameters ..
248  REAL zero, one
249  parameter( zero = 0.0e0, one = 1.0e0 )
250 * ..
251 * .. Local Scalars ..
252  LOGICAL ilascl, ilbscl, ilvsl, ilvsr, lquery
253  INTEGER icols, ihi, iinfo, ijobvl, ijobvr, ileft,
254  $ ilo, iright, irows, itau, iwork, lopt, lwkmin,
255  $ lwkopt, nb, nb1, nb2, nb3
256  REAL anrm, anrmto, bignum, bnrm, bnrmto, eps,
257  $ safmin, smlnum
258 * ..
259 * .. External Subroutines ..
260  EXTERNAL sgeqrf, sggbak, sggbal, sgghrd, shgeqz, slacpy,
262 * ..
263 * .. External Functions ..
264  LOGICAL lsame
265  INTEGER ilaenv
266  REAL slamch, slange
267  EXTERNAL ilaenv, lsame, slamch, slange
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, 'SGEQRF', ' ', n, n, -1, -1 )
325  nb2 = ilaenv( 1, 'SORMQR', ' ', n, n, n, -1 )
326  nb3 = ilaenv( 1, 'SORGQR', ' ', 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( 'SGEGS ', -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 = slamch( 'E' )*slamch( 'B' )
347  safmin = slamch( 'S' )
348  smlnum = n*safmin / eps
349  bignum = one / smlnum
350 *
351 * Scale A if max element outside range [SMLNUM,BIGNUM]
352 *
353  anrm = slange( '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 slascl( '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 = slange( '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 slascl( '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 sggbal( '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 sgeqrf( 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 sormqr( '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 slaset( 'Full', n, n, zero, one, vsl, ldvsl )
434  CALL slacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
435  $ vsl( ilo+1, ilo ), ldvsl )
436  CALL sorgqr( 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 slaset( 'Full', n, n, zero, one, vsr, ldvsr )
449 *
450 * Reduce to generalized Hessenberg form
451 *
452  CALL sgghrd( 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 shgeqz( '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 sggbak( '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 sggbak( '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 slascl( '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 slascl( '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 slascl( '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 slascl( '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 slascl( '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 SGEGS
540 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
Definition: sormqr.f:170
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine sgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
SGGHRD
Definition: sgghrd.f:209
subroutine sgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRF
Definition: sgeqrf.f:138
subroutine sggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
SGGBAL
Definition: sggbal.f:179
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine shgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
SHGEQZ
Definition: shgeqz.f:306
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:141
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
Definition: sorgqr.f:130
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116
subroutine sggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
SGGBAK
Definition: sggbak.f:149
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: slaset.f:112

Here is the call graph for this function:

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

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

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

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

 SGEGV 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 REAL 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 SGGHRD and
          SHGEQZ for details.
[in]LDA
          LDA is INTEGER
          The leading dimension of A.  LDA >= max(1,N).
[in,out]B
          B is REAL 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 SGGHRD and SHGEQZ for details.
[in]LDB
          LDB is INTEGER
          The leading dimension of B.  LDB >= max(1,N).
[out]ALPHAR
          ALPHAR is REAL array, dimension (N)
          The real parts of each scalar alpha defining an eigenvalue of
          GNEP.
[out]ALPHAI
          ALPHAI is REAL 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 REAL 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 REAL 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 REAL 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 REAL 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 SGEQRF, SORMQR, and SORGQR.)  Then compute:
          NB  -- MAX of the blocksizes for SGEQRF, SORMQR, and SORGQR;
          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 SGGBAL
                =N+2: error return from SGEQRF
                =N+3: error return from SORMQR
                =N+4: error return from SORGQR
                =N+5: error return from SGGHRD
                =N+6: error return from SHGEQZ (other than failed
                                                iteration)
                =N+7: error return from STGEVC
                =N+8: error return from SGGBAK (computing VL)
                =N+9: error return from SGGBAK (computing VR)
                =N+10: error return from SLASCL (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 SGGBAL 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, SGGBAK 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 SHGEQZ, SGEGS, or read the book "Matrix Computations",
      by Golub & van Loan, pub. by Johns Hopkins U. Press.

Definition at line 308 of file sgegv.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  REAL a( lda, * ), alphai( * ), alphar( * ),
320  $ b( ldb, * ), beta( * ), vl( ldvl, * ),
321  $ vr( ldvr, * ), work( * )
322 * ..
323 *
324 * =====================================================================
325 *
326 * .. Parameters ..
327  REAL zero, one
328  parameter( zero = 0.0e0, one = 1.0e0 )
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  REAL 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 sgeqrf, sggbak, sggbal, sgghrd, shgeqz, slacpy,
346 * ..
347 * .. External Functions ..
348  LOGICAL lsame
349  INTEGER ilaenv
350  REAL slamch, slange
351  EXTERNAL ilaenv, lsame, slamch, slange
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, 'SGEQRF', ' ', n, n, -1, -1 )
410  nb2 = ilaenv( 1, 'SORMQR', ' ', n, n, n, -1 )
411  nb3 = ilaenv( 1, 'SORGQR', ' ', 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( 'SGEGV ', -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 = slamch( 'E' )*slamch( 'B' )
432  safmin = slamch( 'S' )
433  safmin = safmin + safmin
434  safmax = one / safmin
435  onepls = one + ( 4*eps )
436 *
437 * Scale A
438 *
439  anrm = slange( '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 slascl( '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 = slange( '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 slascl( '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 sggbal( '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 sgeqrf( 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 sormqr( '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 slaset( 'Full', n, n, zero, one, vl, ldvl )
524  CALL slacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
525  $ vl( ilo+1, ilo ), ldvl )
526  CALL sorgqr( 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 slaset( '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 sgghrd( jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb, vl,
547  $ ldvl, vr, ldvr, iinfo )
548  ELSE
549  CALL sgghrd( '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 shgeqz( 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 (STGEVC 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 stgevc( 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 sggbak( '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 sggbak( '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 SGEGV
768 *
subroutine stgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
STGEVC
Definition: stgevc.f:297
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
Definition: sormqr.f:170
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine sgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
SGGHRD
Definition: sgghrd.f:209
subroutine sgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRF
Definition: sgeqrf.f:138
subroutine sggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
SGGBAL
Definition: sggbal.f:179
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine shgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
SHGEQZ
Definition: shgeqz.f:306
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:141
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
Definition: sorgqr.f:130
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116
subroutine sggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
SGGBAK
Definition: sggbak.f:149
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: slaset.f:112

Here is the call graph for this function:

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

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

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

Purpose:
 SGGES 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
 SGGEV 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 REAL 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 REAL 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 REAL 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 REAL array, dimension (N)
[out]ALPHAI
          ALPHAI is REAL array, dimension (N)
[out]BETA
          BETA is REAL 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 REAL 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 REAL 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 REAL 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 >= max(8*N,6*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 SHGEQZ.
                =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 STGSEN.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 286 of file sgges.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  REAL 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  REAL zero, one
311  parameter( zero = 0.0e+0, one = 1.0e+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  REAL anrm, anrmto, bignum, bnrm, bnrmto, eps, pvsl,
320  $ pvsr, safmax, safmin, smlnum
321 * ..
322 * .. Local Arrays ..
323  INTEGER idum( 1 )
324  REAL dif( 2 )
325 * ..
326 * .. External Subroutines ..
327  EXTERNAL sgeqrf, sggbak, sggbal, sgghrd, shgeqz, slabad,
329  $ xerbla
330 * ..
331 * .. External Functions ..
332  LOGICAL lsame
333  INTEGER ilaenv
334  REAL slamch, slange
335  EXTERNAL lsame, ilaenv, slamch, slange
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, 'SGEQRF', ' ', n, 1, n, 0 )
402  maxwrk = max( maxwrk, minwrk - n +
403  $ n*ilaenv( 1, 'SORMQR', ' ', n, 1, n, -1 ) )
404  IF( ilvsl ) THEN
405  maxwrk = max( maxwrk, minwrk - n +
406  $ n*ilaenv( 1, 'SORGQR', ' ', 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( 'SGGES ', -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 = slamch( 'P' )
435  safmin = slamch( 'S' )
436  safmax = one / safmin
437  CALL slabad( 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 = slange( '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 slascl( 'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
454 *
455 * Scale B if max element outside range [SMLNUM,BIGNUM]
456 *
457  bnrm = slange( '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 slascl( '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 sggbal( '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 sgeqrf( 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 sormqr( '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 slaset( 'Full', n, n, zero, one, vsl, ldvsl )
500  IF( irows.GT.1 ) THEN
501  CALL slacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
502  $ vsl( ilo+1, ilo ), ldvsl )
503  END IF
504  CALL sorgqr( 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 slaset( 'Full', n, n, zero, one, vsr, ldvsr )
512 *
513 * Reduce to generalized Hessenberg form
514 * (Workspace: none needed)
515 *
516  CALL sgghrd( 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 shgeqz( '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 40
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 slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n,
547  $ ierr )
548  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n,
549  $ ierr )
550  END IF
551  IF( ilbscl )
552  $ CALL slascl( '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 stgsen( 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 sggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
574  $ work( iright ), n, vsl, ldvsl, ierr )
575 *
576  IF( ilvsr )
577  $ CALL sggbak( '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 50 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.( anrmto/anrm ) .OR.
594  $ ( safmin/alphai( i ) ).GT.( anrm/anrmto ) ) THEN
595  work( 1 ) = abs( a( i, i+1 )/alphai( i ) )
596  beta( i ) = beta( i )*work( 1 )
597  alphar( i ) = alphar( i )*work( 1 )
598  alphai( i ) = alphai( i )*work( 1 )
599  END IF
600  END IF
601  50 CONTINUE
602  END IF
603 *
604  IF( ilbscl )THEN
605  DO 60 i = 1, n
606  IF( alphai( i ).NE.zero ) THEN
607  IF( ( beta( i )/safmax ).GT.( bnrmto/bnrm ) .OR.
608  $ ( safmin/beta( i ) ).GT.( bnrm/bnrmto ) ) THEN
609  work( 1 ) = abs(b( i, i )/beta( i ))
610  beta( i ) = beta( i )*work( 1 )
611  alphar( i ) = alphar( i )*work( 1 )
612  alphai( i ) = alphai( i )*work( 1 )
613  END IF
614  END IF
615  60 CONTINUE
616  END IF
617 *
618 * Undo scaling
619 *
620  IF( ilascl ) THEN
621  CALL slascl( 'H', 0, 0, anrmto, anrm, n, n, a, lda, ierr )
622  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n, ierr )
623  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n, ierr )
624  END IF
625 *
626  IF( ilbscl ) THEN
627  CALL slascl( 'U', 0, 0, bnrmto, bnrm, n, n, b, ldb, ierr )
628  CALL slascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
629  END IF
630 *
631  IF( wantst ) THEN
632 *
633 * Check if reordering is correct
634 *
635  lastsl = .true.
636  lst2sl = .true.
637  sdim = 0
638  ip = 0
639  DO 30 i = 1, n
640  cursl = selctg( alphar( i ), alphai( i ), beta( i ) )
641  IF( alphai( i ).EQ.zero ) THEN
642  IF( cursl )
643  $ sdim = sdim + 1
644  ip = 0
645  IF( cursl .AND. .NOT.lastsl )
646  $ info = n + 2
647  ELSE
648  IF( ip.EQ.1 ) THEN
649 *
650 * Last eigenvalue of conjugate pair
651 *
652  cursl = cursl .OR. lastsl
653  lastsl = cursl
654  IF( cursl )
655  $ sdim = sdim + 2
656  ip = -1
657  IF( cursl .AND. .NOT.lst2sl )
658  $ info = n + 2
659  ELSE
660 *
661 * First eigenvalue of conjugate pair
662 *
663  ip = 1
664  END IF
665  END IF
666  lst2sl = lastsl
667  lastsl = cursl
668  30 CONTINUE
669 *
670  END IF
671 *
672  40 CONTINUE
673 *
674  work( 1 ) = maxwrk
675 *
676  RETURN
677 *
678 * End of SGGES
679 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
Definition: sormqr.f:170
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine sgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
SGGHRD
Definition: sgghrd.f:209
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine sgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRF
Definition: sgeqrf.f:138
subroutine sggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
SGGBAL
Definition: sggbal.f:179
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine shgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
SHGEQZ
Definition: shgeqz.f:306
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
subroutine stgsen(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)
STGSEN
Definition: stgsen.f:453
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:141
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
Definition: sorgqr.f:130
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116
subroutine sggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
SGGBAK
Definition: sggbak.f:149
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: slaset.f:112

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

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

Purpose:
 SGGES3 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
 SGGEV 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 REAL 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 REAL 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 REAL 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 REAL array, dimension (N)
[out]ALPHAI
          ALPHAI is REAL array, dimension (N)
[out]BETA
          BETA is REAL 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 REAL 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 REAL 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 REAL 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 SHGEQZ.
                =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 STGSEN.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
January 2015

Definition at line 284 of file sgges3.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  REAL 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  REAL zero, one
309  parameter( zero = 0.0e+0, one = 1.0e+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  REAL anrm, anrmto, bignum, bnrm, bnrmto, eps, pvsl,
317  $ pvsr, safmax, safmin, smlnum
318 * ..
319 * .. Local Arrays ..
320  INTEGER idum( 1 )
321  REAL dif( 2 )
322 * ..
323 * .. External Subroutines ..
324  EXTERNAL sgeqrf, sggbak, sggbal, sgghd3, shgeqz, slabad,
326  $ xerbla
327 * ..
328 * .. External Functions ..
329  LOGICAL lsame
330  REAL slamch, slange
331  EXTERNAL lsame, slamch, slange
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 sgeqrf( n, n, b, ldb, work, work, -1, ierr )
392  lwkopt = max( 6*n+16, 3*n+int( work( 1 ) ) )
393  CALL sormqr( '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 sorgqr( n, n, n, vsl, ldvsl, work, work, -1, ierr )
398  lwkopt = max( lwkopt, 3*n+int( work( 1 ) ) )
399  END IF
400  CALL sgghd3( 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 shgeqz( '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 stgsen( 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( 'SGGES3 ', -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 = slamch( 'P' )
434  safmin = slamch( 'S' )
435  safmax = one / safmin
436  CALL slabad( 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 = slange( '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 slascl( 'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
453 *
454 * Scale B if max element outside range [SMLNUM,BIGNUM]
455 *
456  bnrm = slange( '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 slascl( '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 sggbal( '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 sgeqrf( 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 sormqr( '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 slaset( 'Full', n, n, zero, one, vsl, ldvsl )
495  IF( irows.GT.1 ) THEN
496  CALL slacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
497  $ vsl( ilo+1, ilo ), ldvsl )
498  END IF
499  CALL sorgqr( 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 slaset( 'Full', n, n, zero, one, vsr, ldvsr )
507 *
508 * Reduce to generalized Hessenberg form
509 *
510  CALL sgghd3( jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb, vsl,
511  $ ldvsl, vsr, ldvsr, work( iwrk ), lwork+1-iwrk, ierr )
512 *
513 * Perform QZ algorithm, computing Schur vectors if desired
514 *
515  iwrk = itau
516  CALL shgeqz( 'S', jobvsl, jobvsr, n, ilo, ihi, a, lda, b, ldb,
517  $ alphar, alphai, beta, vsl, ldvsl, vsr, ldvsr,
518  $ work( iwrk ), lwork+1-iwrk, ierr )
519  IF( ierr.NE.0 ) THEN
520  IF( ierr.GT.0 .AND. ierr.LE.n ) THEN
521  info = ierr
522  ELSE IF( ierr.GT.n .AND. ierr.LE.2*n ) THEN
523  info = ierr - n
524  ELSE
525  info = n + 1
526  END IF
527  GO TO 40
528  END IF
529 *
530 * Sort eigenvalues ALPHA/BETA if desired
531 *
532  sdim = 0
533  IF( wantst ) THEN
534 *
535 * Undo scaling on eigenvalues before SELCTGing
536 *
537  IF( ilascl ) THEN
538  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n,
539  $ ierr )
540  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n,
541  $ ierr )
542  END IF
543  IF( ilbscl )
544  $ CALL slascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
545 *
546 * Select eigenvalues
547 *
548  DO 10 i = 1, n
549  bwork( i ) = selctg( alphar( i ), alphai( i ), beta( i ) )
550  10 CONTINUE
551 *
552  CALL stgsen( 0, ilvsl, ilvsr, bwork, n, a, lda, b, ldb, alphar,
553  $ alphai, beta, vsl, ldvsl, vsr, ldvsr, sdim, pvsl,
554  $ pvsr, dif, work( iwrk ), lwork-iwrk+1, idum, 1,
555  $ ierr )
556  IF( ierr.EQ.1 )
557  $ info = n + 3
558 *
559  END IF
560 *
561 * Apply back-permutation to VSL and VSR
562 *
563  IF( ilvsl )
564  $ CALL sggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
565  $ work( iright ), n, vsl, ldvsl, ierr )
566 *
567  IF( ilvsr )
568  $ CALL sggbak( 'P', 'R', n, ilo, ihi, work( ileft ),
569  $ work( iright ), n, vsr, ldvsr, ierr )
570 *
571 * Check if unscaling would cause over/underflow, if so, rescale
572 * (ALPHAR(I),ALPHAI(I),BETA(I)) so BETA(I) is on the order of
573 * B(I,I) and ALPHAR(I) and ALPHAI(I) are on the order of A(I,I)
574 *
575  IF( ilascl )THEN
576  DO 50 i = 1, n
577  IF( alphai( i ).NE.zero ) THEN
578  IF( ( alphar( i )/safmax ).GT.( anrmto/anrm ) .OR.
579  $ ( safmin/alphar( i ) ).GT.( anrm/anrmto ) ) THEN
580  work( 1 ) = abs( a( i, i )/alphar( i ) )
581  beta( i ) = beta( i )*work( 1 )
582  alphar( i ) = alphar( i )*work( 1 )
583  alphai( i ) = alphai( i )*work( 1 )
584  ELSE IF( ( alphai( i )/safmax ).GT.( anrmto/anrm ) .OR.
585  $ ( safmin/alphai( i ) ).GT.( anrm/anrmto ) ) THEN
586  work( 1 ) = abs( a( i, i+1 )/alphai( i ) )
587  beta( i ) = beta( i )*work( 1 )
588  alphar( i ) = alphar( i )*work( 1 )
589  alphai( i ) = alphai( i )*work( 1 )
590  END IF
591  END IF
592  50 CONTINUE
593  END IF
594 *
595  IF( ilbscl )THEN
596  DO 60 i = 1, n
597  IF( alphai( i ).NE.zero ) THEN
598  IF( ( beta( i )/safmax ).GT.( bnrmto/bnrm ) .OR.
599  $ ( safmin/beta( i ) ).GT.( bnrm/bnrmto ) ) THEN
600  work( 1 ) = abs(b( i, i )/beta( i ))
601  beta( i ) = beta( i )*work( 1 )
602  alphar( i ) = alphar( i )*work( 1 )
603  alphai( i ) = alphai( i )*work( 1 )
604  END IF
605  END IF
606  60 CONTINUE
607  END IF
608 *
609 * Undo scaling
610 *
611  IF( ilascl ) THEN
612  CALL slascl( 'H', 0, 0, anrmto, anrm, n, n, a, lda, ierr )
613  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n, ierr )
614  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n, ierr )
615  END IF
616 *
617  IF( ilbscl ) THEN
618  CALL slascl( 'U', 0, 0, bnrmto, bnrm, n, n, b, ldb, ierr )
619  CALL slascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
620  END IF
621 *
622  IF( wantst ) THEN
623 *
624 * Check if reordering is correct
625 *
626  lastsl = .true.
627  lst2sl = .true.
628  sdim = 0
629  ip = 0
630  DO 30 i = 1, n
631  cursl = selctg( alphar( i ), alphai( i ), beta( i ) )
632  IF( alphai( i ).EQ.zero ) THEN
633  IF( cursl )
634  $ sdim = sdim + 1
635  ip = 0
636  IF( cursl .AND. .NOT.lastsl )
637  $ info = n + 2
638  ELSE
639  IF( ip.EQ.1 ) THEN
640 *
641 * Last eigenvalue of conjugate pair
642 *
643  cursl = cursl .OR. lastsl
644  lastsl = cursl
645  IF( cursl )
646  $ sdim = sdim + 2
647  ip = -1
648  IF( cursl .AND. .NOT.lst2sl )
649  $ info = n + 2
650  ELSE
651 *
652 * First eigenvalue of conjugate pair
653 *
654  ip = 1
655  END IF
656  END IF
657  lst2sl = lastsl
658  lastsl = cursl
659  30 CONTINUE
660 *
661  END IF
662 *
663  40 CONTINUE
664 *
665  work( 1 ) = lwkopt
666 *
667  RETURN
668 *
669 * End of SGGES3
670 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
Definition: sormqr.f:170
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine sgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRF
Definition: sgeqrf.f:138
subroutine sggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
SGGBAL
Definition: sggbal.f:179
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine shgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
SHGEQZ
Definition: shgeqz.f:306
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
subroutine sgghd3(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
SGGHD3
Definition: sgghd3.f:232
subroutine stgsen(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)
STGSEN
Definition: stgsen.f:453
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:141
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
Definition: sorgqr.f:130
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116
subroutine sggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
SGGBAK
Definition: sggbak.f:149
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: slaset.f:112

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

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

Purpose:
 SGGESX 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 REAL 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 REAL 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 REAL 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 REAL array, dimension (N)
[out]ALPHAI
          ALPHAI is REAL array, dimension (N)
[out]BETA
          BETA is REAL 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 REAL 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 REAL 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 REAL 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 REAL 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 REAL 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 SHGEQZ
                =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 STGSEN.
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 sggesx.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  REAL 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  REAL zero, one
395  parameter( zero = 0.0e+0, one = 1.0e+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  REAL anrm, anrmto, bignum, bnrm, bnrmto, eps, pl,
405  $ pr, safmax, safmin, smlnum
406 * ..
407 * .. Local Arrays ..
408  REAL dif( 2 )
409 * ..
410 * .. External Subroutines ..
411  EXTERNAL sgeqrf, sggbak, sggbal, sgghrd, shgeqz, slabad,
413  $ xerbla
414 * ..
415 * .. External Functions ..
416  LOGICAL lsame
417  INTEGER ilaenv
418  REAL slamch, slange
419  EXTERNAL lsame, ilaenv, slamch, slange
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, 'SGEQRF', ' ', n, 1, n, 0 )
502  maxwrk = max( maxwrk, minwrk - n +
503  $ n*ilaenv( 1, 'SORMQR', ' ', n, 1, n, -1 ) )
504  IF( ilvsl ) THEN
505  maxwrk = max( maxwrk, minwrk - n +
506  $ n*ilaenv( 1, 'SORGQR', ' ', 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( 'SGGESX', -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 = slamch( 'P' )
548  safmin = slamch( 'S' )
549  safmax = one / safmin
550  CALL slabad( 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 = slange( '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 slascl( 'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
567 *
568 * Scale B if max element outside range [SMLNUM,BIGNUM]
569 *
570  bnrm = slange( '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 slascl( '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 sggbal( '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 sgeqrf( 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 sormqr( '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 slaset( 'Full', n, n, zero, one, vsl, ldvsl )
613  IF( irows.GT.1 ) THEN
614  CALL slacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
615  $ vsl( ilo+1, ilo ), ldvsl )
616  END IF
617  CALL sorgqr( 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 slaset( 'Full', n, n, zero, one, vsr, ldvsr )
625 *
626 * Reduce to generalized Hessenberg form
627 * (Workspace: none needed)
628 *
629  CALL sgghrd( 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 shgeqz( '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 50
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 slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n,
663  $ ierr )
664  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n,
665  $ ierr )
666  END IF
667  IF( ilbscl )
668  $ CALL slascl( '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 stgsen( 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 sggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
711  $ work( iright ), n, vsl, ldvsl, ierr )
712 *
713  IF( ilvsr )
714  $ CALL sggbak( '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 ) )
726  $ THEN
727  work( 1 ) = abs( a( i, i ) / alphar( i ) )
728  beta( i ) = beta( i )*work( 1 )
729  alphar( i ) = alphar( i )*work( 1 )
730  alphai( i ) = alphai( i )*work( 1 )
731  ELSE IF( ( alphai( i ) / safmax ).GT.( anrmto / anrm )
732  $ .OR. ( 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 25 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  25 CONTINUE
755  END IF
756 *
757 * Undo scaling
758 *
759  IF( ilascl ) THEN
760  CALL slascl( 'H', 0, 0, anrmto, anrm, n, n, a, lda, ierr )
761  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n, ierr )
762  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n, ierr )
763  END IF
764 *
765  IF( ilbscl ) THEN
766  CALL slascl( 'U', 0, 0, bnrmto, bnrm, n, n, b, ldb, ierr )
767  CALL slascl( '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 40 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  40 CONTINUE
808 *
809  END IF
810 *
811  50 CONTINUE
812 *
813  work( 1 ) = maxwrk
814  iwork( 1 ) = liwmin
815 *
816  RETURN
817 *
818 * End of SGGESX
819 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
Definition: sormqr.f:170
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine sgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
SGGHRD
Definition: sgghrd.f:209
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine sgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRF
Definition: sgeqrf.f:138
subroutine sggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
SGGBAL
Definition: sggbal.f:179
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine shgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
SHGEQZ
Definition: shgeqz.f:306
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
subroutine stgsen(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)
STGSEN
Definition: stgsen.f:453
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:141
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
Definition: sorgqr.f:130
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116
subroutine sggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
SGGBAK
Definition: sggbak.f:149
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: slaset.f:112

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

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

Purpose:
 SGGEV 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 REAL 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 REAL 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 REAL array, dimension (N)
[out]ALPHAI
          ALPHAI is REAL array, dimension (N)
[out]BETA
          BETA is REAL 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 REAL 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 REAL 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 REAL 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 SHGEQZ.
                =N+2: error return from STGEVC.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
April 2012

Definition at line 228 of file sggev.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  REAL a( lda, * ), alphai( * ), alphar( * ),
240  $ b( ldb, * ), beta( * ), vl( ldvl, * ),
241  $ vr( ldvr, * ), work( * )
242 * ..
243 *
244 * =====================================================================
245 *
246 * .. Parameters ..
247  REAL zero, one
248  parameter( zero = 0.0e+0, one = 1.0e+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  REAL anrm, anrmto, bignum, bnrm, bnrmto, eps,
257  $ smlnum, temp
258 * ..
259 * .. Local Arrays ..
260  LOGICAL ldumma( 1 )
261 * ..
262 * .. External Subroutines ..
263  EXTERNAL sgeqrf, sggbak, sggbal, sgghrd, shgeqz, slabad,
265  $ xerbla
266 * ..
267 * .. External Functions ..
268  LOGICAL lsame
269  INTEGER ilaenv
270  REAL slamch, slange
271  EXTERNAL lsame, ilaenv, slamch, slange
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, 'SGEQRF', ' ', n, 1, n, 0 ) ) )
335  maxwrk = max( maxwrk, n*( 7 +
336  $ ilaenv( 1, 'SORMQR', ' ', n, 1, n, 0 ) ) )
337  IF( ilvl ) THEN
338  maxwrk = max( maxwrk, n*( 7 +
339  $ ilaenv( 1, 'SORGQR', ' ', 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( 'SGGEV ', -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 = slamch( 'P' )
362  smlnum = slamch( 'S' )
363  bignum = one / smlnum
364  CALL slabad( 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 = slange( '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 slascl( 'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
381 *
382 * Scale B if max element outside range [SMLNUM,BIGNUM]
383 *
384  bnrm = slange( '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 slascl( '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 sggbal( '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 sgeqrf( 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 sormqr( '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 slaset( 'Full', n, n, zero, one, vl, ldvl )
431  IF( irows.GT.1 ) THEN
432  CALL slacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
433  $ vl( ilo+1, ilo ), ldvl )
434  END IF
435  CALL sorgqr( 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 slaset( '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 sgghrd( jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb, vl,
452  $ ldvl, vr, ldvr, ierr )
453  ELSE
454  CALL sgghrd( '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 shgeqz( 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 stgevc( 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 sggbak( '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 sggbak( '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 slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n, ierr )
580  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n, ierr )
581  END IF
582 *
583  IF( ilbscl ) THEN
584  CALL slascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
585  END IF
586 *
587  work( 1 ) = maxwrk
588  RETURN
589 *
590 * End of SGGEV
591 *
subroutine stgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
STGEVC
Definition: stgevc.f:297
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
Definition: sormqr.f:170
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine sgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
SGGHRD
Definition: sgghrd.f:209
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine sgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRF
Definition: sgeqrf.f:138
subroutine sggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
SGGBAL
Definition: sggbal.f:179
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine shgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
SHGEQZ
Definition: shgeqz.f:306
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:141
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
Definition: sorgqr.f:130
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116
subroutine sggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
SGGBAK
Definition: sggbak.f:149
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: slaset.f:112

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

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

Purpose:
 SGGEV3 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 REAL 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 REAL 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 REAL array, dimension (N)
[out]ALPHAI
          ALPHAI is REAL array, dimension (N)
[out]BETA
          BETA is REAL 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 REAL 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 REAL 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 REAL 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 SHGEQZ.
                =N+2: error return from STGEVC.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
January 2015

Definition at line 228 of file sggev3.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  REAL a( lda, * ), alphai( * ), alphar( * ),
240  $ b( ldb, * ), beta( * ), vl( ldvl, * ),
241  $ vr( ldvr, * ), work( * )
242 * ..
243 *
244 * =====================================================================
245 *
246 * .. Parameters ..
247  REAL zero, one
248  parameter( zero = 0.0e+0, one = 1.0e+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  REAL anrm, anrmto, bignum, bnrm, bnrmto, eps,
256  $ smlnum, temp
257 * ..
258 * .. Local Arrays ..
259  LOGICAL ldumma( 1 )
260 * ..
261 * .. External Subroutines ..
262  EXTERNAL sgeqrf, sggbak, sggbal, sgghd3, shgeqz, slabad,
264  $ xerbla
265 * ..
266 * .. External Functions ..
267  LOGICAL lsame
268  REAL slamch, slange
269  EXTERNAL lsame, slamch, slange
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 sgeqrf( n, n, b, ldb, work, work, -1, ierr )
327  lwkopt = max( 1, 8*n, 3*n+int( work( 1 ) ) )
328  CALL sormqr( 'L', 'T', n, n, n, b, ldb, work, a, lda, work,
329  $ -1, ierr )
330  lwkopt = max( lwkopt, 3*n+int( work( 1 ) ) )
331  CALL sgghd3( jobvl, jobvr, n, 1, n, a, lda, b, ldb, vl, ldvl,
332  $ vr, ldvr, work, -1, ierr )
333  lwkopt = max( lwkopt, 3*n+int( work( 1 ) ) )
334  IF( ilvl ) THEN
335  CALL sorgqr( n, n, n, vl, ldvl, work, work, -1, ierr )
336  lwkopt = max( lwkopt, 3*n+int( work( 1 ) ) )
337  CALL shgeqz( 'S', jobvl, jobvr, n, 1, n, a, lda, b, ldb,
338  $ alphar, alphai, beta, vl, ldvl, vr, ldvr,
339  $ work, -1, ierr )
340  lwkopt = max( lwkopt, 2*n+int( work( 1 ) ) )
341  ELSE
342  CALL shgeqz( 'E', jobvl, jobvr, n, 1, n, a, lda, b, ldb,
343  $ alphar, alphai, beta, vl, ldvl, vr, ldvr,
344  $ work, -1, ierr )
345  lwkopt = max( lwkopt, 2*n+int( work( 1 ) ) )
346  END IF
347  work( 1 ) = REAL( lwkopt )
348 *
349  END IF
350 *
351  IF( info.NE.0 ) THEN
352  CALL xerbla( 'SGGEV3 ', -info )
353  RETURN
354  ELSE IF( lquery ) THEN
355  RETURN
356  END IF
357 *
358 * Quick return if possible
359 *
360  IF( n.EQ.0 )
361  $ RETURN
362 *
363 * Get machine constants
364 *
365  eps = slamch( 'P' )
366  smlnum = slamch( 'S' )
367  bignum = one / smlnum
368  CALL slabad( smlnum, bignum )
369  smlnum = sqrt( smlnum ) / eps
370  bignum = one / smlnum
371 *
372 * Scale A if max element outside range [SMLNUM,BIGNUM]
373 *
374  anrm = slange( 'M', n, n, a, lda, work )
375  ilascl = .false.
376  IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
377  anrmto = smlnum
378  ilascl = .true.
379  ELSE IF( anrm.GT.bignum ) THEN
380  anrmto = bignum
381  ilascl = .true.
382  END IF
383  IF( ilascl )
384  $ CALL slascl( 'G', 0, 0, anrm, anrmto, n, n, a, lda, ierr )
385 *
386 * Scale B if max element outside range [SMLNUM,BIGNUM]
387 *
388  bnrm = slange( 'M', n, n, b, ldb, work )
389  ilbscl = .false.
390  IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) THEN
391  bnrmto = smlnum
392  ilbscl = .true.
393  ELSE IF( bnrm.GT.bignum ) THEN
394  bnrmto = bignum
395  ilbscl = .true.
396  END IF
397  IF( ilbscl )
398  $ CALL slascl( 'G', 0, 0, bnrm, bnrmto, n, n, b, ldb, ierr )
399 *
400 * Permute the matrices A, B to isolate eigenvalues if possible
401 *
402  ileft = 1
403  iright = n + 1
404  iwrk = iright + n
405  CALL sggbal( 'P', n, a, lda, b, ldb, ilo, ihi, work( ileft ),
406  $ work( iright ), work( iwrk ), ierr )
407 *
408 * Reduce B to triangular form (QR decomposition of B)
409 *
410  irows = ihi + 1 - ilo
411  IF( ilv ) THEN
412  icols = n + 1 - ilo
413  ELSE
414  icols = irows
415  END IF
416  itau = iwrk
417  iwrk = itau + irows
418  CALL sgeqrf( irows, icols, b( ilo, ilo ), ldb, work( itau ),
419  $ work( iwrk ), lwork+1-iwrk, ierr )
420 *
421 * Apply the orthogonal transformation to matrix A
422 *
423  CALL sormqr( 'L', 'T', irows, icols, irows, b( ilo, ilo ), ldb,
424  $ work( itau ), a( ilo, ilo ), lda, work( iwrk ),
425  $ lwork+1-iwrk, ierr )
426 *
427 * Initialize VL
428 *
429  IF( ilvl ) THEN
430  CALL slaset( 'Full', n, n, zero, one, vl, ldvl )
431  IF( irows.GT.1 ) THEN
432  CALL slacpy( 'L', irows-1, irows-1, b( ilo+1, ilo ), ldb,
433  $ vl( ilo+1, ilo ), ldvl )
434  END IF
435  CALL sorgqr( 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 slaset( 'Full', n, n, zero, one, vr, ldvr )
443 *
444 * Reduce to generalized Hessenberg form
445 *
446  IF( ilv ) THEN
447 *
448 * Eigenvectors requested -- work on whole matrix.
449 *
450  CALL sgghd3( jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb, vl,
451  $ ldvl, vr, ldvr, work( iwrk ), lwork+1-iwrk, ierr )
452  ELSE
453  CALL sgghd3( 'N', 'N', irows, 1, irows, a( ilo, ilo ), lda,
454  $ b( ilo, ilo ), ldb, vl, ldvl, vr, ldvr,
455  $ work( iwrk ), lwork+1-iwrk, ierr )
456  END IF
457 *
458 * Perform QZ algorithm (Compute eigenvalues, and optionally, the
459 * Schur forms and Schur vectors)
460 *
461  iwrk = itau
462  IF( ilv ) THEN
463  chtemp = 'S'
464  ELSE
465  chtemp = 'E'
466  END IF
467  CALL shgeqz( chtemp, jobvl, jobvr, n, ilo, ihi, a, lda, b, ldb,
468  $ alphar, alphai, beta, vl, ldvl, vr, ldvr,
469  $ work( iwrk ), lwork+1-iwrk, ierr )
470  IF( ierr.NE.0 ) THEN
471  IF( ierr.GT.0 .AND. ierr.LE.n ) THEN
472  info = ierr
473  ELSE IF( ierr.GT.n .AND. ierr.LE.2*n ) THEN
474  info = ierr - n
475  ELSE
476  info = n + 1
477  END IF
478  GO TO 110
479  END IF
480 *
481 * Compute Eigenvectors
482 *
483  IF( ilv ) THEN
484  IF( ilvl ) THEN
485  IF( ilvr ) THEN
486  chtemp = 'B'
487  ELSE
488  chtemp = 'L'
489  END IF
490  ELSE
491  chtemp = 'R'
492  END IF
493  CALL stgevc( chtemp, 'B', ldumma, n, a, lda, b, ldb, vl, ldvl,
494  $ vr, ldvr, n, in, work( iwrk ), ierr )
495  IF( ierr.NE.0 ) THEN
496  info = n + 2
497  GO TO 110
498  END IF
499 *
500 * Undo balancing on VL and VR and normalization
501 *
502  IF( ilvl ) THEN
503  CALL sggbak( 'P', 'L', n, ilo, ihi, work( ileft ),
504  $ work( iright ), n, vl, ldvl, ierr )
505  DO 50 jc = 1, n
506  IF( alphai( jc ).LT.zero )
507  $ GO TO 50
508  temp = zero
509  IF( alphai( jc ).EQ.zero ) THEN
510  DO 10 jr = 1, n
511  temp = max( temp, abs( vl( jr, jc ) ) )
512  10 CONTINUE
513  ELSE
514  DO 20 jr = 1, n
515  temp = max( temp, abs( vl( jr, jc ) )+
516  $ abs( vl( jr, jc+1 ) ) )
517  20 CONTINUE
518  END IF
519  IF( temp.LT.smlnum )
520  $ GO TO 50
521  temp = one / temp
522  IF( alphai( jc ).EQ.zero ) THEN
523  DO 30 jr = 1, n
524  vl( jr, jc ) = vl( jr, jc )*temp
525  30 CONTINUE
526  ELSE
527  DO 40 jr = 1, n
528  vl( jr, jc ) = vl( jr, jc )*temp
529  vl( jr, jc+1 ) = vl( jr, jc+1 )*temp
530  40 CONTINUE
531  END IF
532  50 CONTINUE
533  END IF
534  IF( ilvr ) THEN
535  CALL sggbak( 'P', 'R', n, ilo, ihi, work( ileft ),
536  $ work( iright ), n, vr, ldvr, ierr )
537  DO 100 jc = 1, n
538  IF( alphai( jc ).LT.zero )
539  $ GO TO 100
540  temp = zero
541  IF( alphai( jc ).EQ.zero ) THEN
542  DO 60 jr = 1, n
543  temp = max( temp, abs( vr( jr, jc ) ) )
544  60 CONTINUE
545  ELSE
546  DO 70 jr = 1, n
547  temp = max( temp, abs( vr( jr, jc ) )+
548  $ abs( vr( jr, jc+1 ) ) )
549  70 CONTINUE
550  END IF
551  IF( temp.LT.smlnum )
552  $ GO TO 100
553  temp = one / temp
554  IF( alphai( jc ).EQ.zero ) THEN
555  DO 80 jr = 1, n
556  vr( jr, jc ) = vr( jr, jc )*temp
557  80 CONTINUE
558  ELSE
559  DO 90 jr = 1, n
560  vr( jr, jc ) = vr( jr, jc )*temp
561  vr( jr, jc+1 ) = vr( jr, jc+1 )*temp
562  90 CONTINUE
563  END IF
564  100 CONTINUE
565  END IF
566 *
567 * End of eigenvector calculation
568 *
569  END IF
570 *
571 * Undo scaling if necessary
572 *
573  110 CONTINUE
574 *
575  IF( ilascl ) THEN
576  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphar, n, ierr )
577  CALL slascl( 'G', 0, 0, anrmto, anrm, n, 1, alphai, n, ierr )
578  END IF
579 *
580  IF( ilbscl ) THEN
581  CALL slascl( 'G', 0, 0, bnrmto, bnrm, n, 1, beta, n, ierr )
582  END IF
583 *
584  work( 1 ) = REAL( lwkopt )
585  RETURN
586 *
587 * End of SGGEV3
588 *
subroutine stgevc(SIDE, HOWMNY, SELECT, N, S, LDS, P, LDP, VL, LDVL, VR, LDVR, MM, M, WORK, INFO)
STGEVC
Definition: stgevc.f:297
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
Definition: sormqr.f:170
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine sgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
SGEQRF
Definition: sgeqrf.f:138
subroutine sggbal(JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, RSCALE, WORK, INFO)
SGGBAL
Definition: sggbal.f:179
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine shgeqz(JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT, ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
SHGEQZ
Definition: shgeqz.f:306
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
subroutine sgghd3(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, WORK, LWORK, INFO)
SGGHD3
Definition: sgghd3.f:232
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: slascl.f:141
subroutine sorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGQR
Definition: sorgqr.f:130
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116
subroutine sggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
SGGBAK
Definition: sggbak.f:149
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: slaset.f:112

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function: