SGGES  -  compute  for  a pair of N-by-N real nonsymmetric
       matrices (A,B),


SYNOPSIS

       SUBROUTINE SGGES( JOBVSL, JOBVSR, SORT, SELCTG, N, A, LDA,
                         B, LDB, SDIM, ALPHAR, ALPHAI, BETA, VSL,
                         LDVSL, VSR, LDVSR, WORK,  LWORK,  BWORK,
                         INFO )

           CHARACTER     JOBVSL, JOBVSR, SORT

           INTEGER       INFO,  LDA, LDB, LDVSL, LDVSR, LWORK, N,
                         SDIM

           LOGICAL       BWORK( * )

           REAL          A( LDA, * ), ALPHAI( * ), ALPHAR(  *  ),
                         B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
                         VSR( LDVSR, * ), WORK( * )

           LOGICAL       SELCTG

           EXTERNAL      SELCTG


PURPOSE

       SGGES computes for a  pair  of  N-by-N  real  nonsymmetric
       matrices  (A,B), the generalized eigenvalues, the general­
       ized 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 correspond­
       ing 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,

       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  eigen­
       values.


ARGUMENTS

       JOBVSL  (input) CHARACTER*1
               = 'N':  do not compute the left Schur vectors;
               = 'V':  compute the left Schur vectors.

       JOBVSR  (input) CHARACTER*1
               = 'N':  do not compute the right Schur vectors;
               = 'V':  compute the right Schur vectors.

       SORT    (input) 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);

       SELCTG  (input) LOGICAL FUNCTION of three REAL arguments
               SELCTG  must  be  declared EXTERNAL in the calling
               subroutine.  If SORT = 'N', SELCTG is  not  refer­
               enced.   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.

       N       (input) INTEGER
               The  order  of the matrices A, B, VSL, and VSR.  N
               >= 0.

       A       (input/output) 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.

       LDA     (input) INTEGER
               The leading dimension of A.  LDA >= max(1,N).

               On entry, the second of the pair of matrices.   On
               exit,  B  has  been overwritten by its generalized
               Schur form T.

       LDB     (input) INTEGER
               The leading dimension of B.  LDB >= max(1,N).

       SDIM    (output) 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.)

       ALPHAR  (output) REAL array, dimension (N)
               ALPHAI  (output) REAL array,  dimension  (N)  BETA
               (output)   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 diago­
               nals  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 trian­
               gular form using 2-by-2 complex unitary  transfor­
               mations.   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.  How­
               ever, 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).

       VSL     (output) REAL array, dimension (LDVSL,N)
               If  JOBVSL  = 'V', VSL will contain the left Schur
               vectors.  Not referenced if JOBVSL = 'N'.

       LDVSL   (input) INTEGER
               The leading dimension of  the  matrix  VSL.  LDVSL
               >=1, and if JOBVSL = 'V', LDVSL >= N.

       VSR     (output) REAL array, dimension (LDVSR,N)
               If  JOBVSR = 'V', VSR will contain the right Schur
               vectors.  Not referenced if JOBVSR = 'N'.

       LDVSR   (input) INTEGER
               The leading dimension of the matrix VSR. LDVSR  >=
               1, and if JOBVSR = 'V', LDVSR >= N.

               On  exit, if INFO = 0, WORK(1) returns the optimal
               LWORK.

       LWORK   (input) INTEGER
               The dimension of the array WORK.  LWORK >= 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.

       BWORK   (workspace) LOGICAL array, dimension (N)
               Not referenced if SORT = 'N'.

       INFO    (output) INTEGER
               = 0:  successful exit
               < 0:  if INFO = -i, the i-th argument had an ille­
               gal 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 eigenval­
               ues in the Generalized Schur form no  longer  sat­
               isfy  SELCTG=.TRUE.  This could also be caused due
               to scaling.  =N+3: reordering failed in STGSEN.


Man(1) output converted with man2html