SUBROUTINE AG8BYZ( FIRST, N, M, P, SVLMAX, ABCD, LDABCD, E, LDE,
     $                   NR, PR, NINFZ, DINFZ, NKRONL, INFZ, KRONL,
     $                   TOL, IWORK, DWORK, ZWORK, LZWORK, INFO )
C
C     SLICOT RELEASE 5.0.
C
C     Copyright (c) 2002-2009 NICONET e.V.
C
C     This program is free software: you can redistribute it and/or
C     modify it under the terms of the GNU General Public License as
C     published by the Free Software Foundation, either version 2 of
C     the License, or (at your option) any later version.
C
C     This program is distributed in the hope that it will be useful,
C     but WITHOUT ANY WARRANTY; without even the implied warranty of
C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C     GNU General Public License for more details.
C
C     You should have received a copy of the GNU General Public License
C     along with this program.  If not, see
C     <http://www.gnu.org/licenses/>.
C
C     PURPOSE
C
C     To extract from the (N+P)-by-(M+N) descriptor system pencil
C
C        S(lambda) = ( B   A - lambda*E  )
C                    ( D        C        )
C
C     with E nonsingular and upper triangular a
C     (NR+PR)-by-(M+NR) "reduced" descriptor system pencil
C
C                           ( Br  Ar-lambda*Er )
C              Sr(lambda) = (                  )
C                           ( Dr     Cr        )
C
C     having the same finite Smith zeros as the pencil
C     S(lambda) but with Dr, a PR-by-M full row rank
C     left upper trapezoidal matrix, and Er, an NR-by-NR
C     upper triangular nonsingular matrix.
C
C     ARGUMENTS
C
C     Mode Parameters
C
C     FIRST   LOGICAL
C             Specifies if AG8BYZ is called first time or it is called
C             for an already reduced system, with D full column rank
C             with the last M rows in upper triangular form:
C             FIRST = .TRUE.,  first time called;
C             FIRST = .FALSE., not first time called.
C
C     Input/Output Parameters
C
C     N       (input) INTEGER
C             The number of rows of matrix B, the number of columns of
C             matrix C and the order of square matrices A and E.
C             N >= 0.
C
C     M       (input) INTEGER
C             The number of columns of matrices B and D.  M >= 0.
C             M <= P if FIRST = .FALSE. .
C
C     P       (input) INTEGER
C             The number of rows of matrices C and D.  P >= 0.
C
C     SVLMAX  (input) DOUBLE PRECISION
C             During each reduction step, the rank-revealing QR
C             factorization of a matrix stops when the estimated minimum
C             singular value is smaller than TOL * MAX(SVLMAX,EMSV),
C             where EMSV is the estimated maximum singular value.
C             SVLMAX >= 0.
C
C     ABCD    (input/output) COMPLEX*16 array, dimension (LDABCD,M+N)
C             On entry, the leading (N+P)-by-(M+N) part of this array
C             must contain the compound matrix
C                      (  B   A  ) ,
C                      (  D   C  )
C             where A is an N-by-N matrix, B is an N-by-M matrix,
C             C is a P-by-N matrix and D is a P-by-M matrix.
C             If FIRST = .FALSE., then D must be a full column
C             rank matrix with the last M rows in upper triangular form.
C             On exit, the leading (NR+PR)-by-(M+NR) part of ABCD
C             contains the reduced compound matrix
C                       (  Br  Ar ) ,
C                       (  Dr  Cr )
C             where Ar is an NR-by-NR matrix, Br is an NR-by-M matrix,
C             Cr is a PR-by-NR matrix, Dr is a PR-by-M full row rank
C             left upper trapezoidal matrix with the first PR columns
C             in upper triangular form.
C
C     LDABCD  INTEGER
C             The leading dimension of array ABCD.
C             LDABCD >= MAX(1,N+P).
C
C     E       (input/output) COMPLEX*16 array, dimension (LDE,N)
C             On entry, the leading N-by-N part of this array must
C             contain the upper triangular nonsingular matrix E.
C             On exit, the leading NR-by-NR part contains the reduced
C             upper triangular nonsingular matrix Er.
C
C     LDE     INTEGER
C             The leading dimension of array E.  LDE >= MAX(1,N).
C
C     NR      (output) INTEGER
C             The order of the reduced matrices Ar and Er; also the
C             number of rows of the reduced matrix Br and the number
C             of columns of the reduced matrix Cr.
C             If Dr is invertible, NR is also the number of finite
C             Smith zeros.
C
C     PR      (output) INTEGER
C             The rank of the resulting matrix Dr; also the number of
C             rows of reduced matrices Cr and Dr.
C
C     NINFZ   (output) INTEGER
C             Number of infinite zeros.  NINFZ = 0 if FIRST = .FALSE. .
C
C     DINFZ   (output) INTEGER
C             The maximal multiplicity of infinite zeros.
C             DINFZ = 0 if FIRST = .FALSE. .
C
C     NKRONL  (output) INTEGER
C             The maximal dimension of left elementary Kronecker blocks.
C
C     INFZ    (output) INTEGER array, dimension (N)
C             INFZ(i) contains the number of infinite zeros of
C             degree i, where i = 1,2,...,DINFZ.
C             INFZ is not referenced if FIRST = .FALSE. .
C
C     KRONL   (output) INTEGER array, dimension (N+1)
C             KRONL(i) contains the number of left elementary Kronecker
C             blocks of dimension i-by-(i-1), where i = 1,2,...,NKRONL.
C
C     Tolerances
C
C     TOL     DOUBLE PRECISION
C             A tolerance used in rank decisions to determine the
C             effective rank, which is defined as the order of the
C             largest leading (or trailing) triangular submatrix in the
C             QR (or RQ) factorization with column (or row) pivoting
C             whose estimated condition number is less than 1/TOL.
C             If the user sets TOL <= 0, then an implicitly computed,
C             default tolerance TOLDEF = (N+P)*(N+M)*EPS,  is used
C             instead, where EPS is the machine precision
C             (see LAPACK Library routine DLAMCH).
C             NOTE that when SVLMAX > 0, the estimated ranks could be
C             less than those defined above (see SVLMAX).  TOL <= 1.
C
C     Workspace
C
C     IWORK   INTEGER array, dimension (M)
C             If FIRST = .FALSE., IWORK is not referenced.
C
C     DWORK   DOUBLE PRECISION array, dimension (LDWORK)
C             LDWORK >= 2*MAX(M,P), if FIRST = .TRUE.;
C             LDWORK >= 2*P,        if FIRST = .FALSE. .
C
C     ZWORK   COMPLEX*16 array, dimension (LZWORK)
C             On exit, if INFO = 0, ZWORK(1) returns the optimal value
C             of LZWORK.
C
C     LZWORK  INTEGER
C             The length of the array ZWORK.
C             LZWORK >= 1, if P = 0; otherwise
C             LZWORK >= MAX( 1, N+M-1, MIN(P,M) + MAX(3*M-1,N), 3*P ),
C                                             if FIRST = .TRUE.;
C             LZWORK >= MAX( 1, N+M-1, 3*P ), if FIRST = .FALSE. .
C             The second term is not needed if M = 0.
C             For optimum performance LZWORK should be larger.
C
C             If LZWORK = -1, then a workspace query is assumed;
C             the routine only calculates the optimal size of the
C             ZWORK array, returns this value as the first entry of
C             the ZWORK array, and no error message related to LZWORK
C             is issued by XERBLA.
C
C     Error Indicator
C
C     INFO    INTEGER
C             = 0:  successful exit;
C             < 0:  if INFO = -i, the i-th argument had an illegal
C                   value.
C
C     METHOD
C
C     The subroutine is based on the reduction algorithm of [1].
C
C     REFERENCES
C
C     [1] P. Misra, P. Van Dooren and A. Varga.
C         Computation of structural invariants of generalized
C         state-space systems.
C         Automatica, 30, pp. 1921-1936, 1994.
C
C     NUMERICAL ASPECTS
C
C     The algorithm is numerically backward stable and requires
C     0( (P+N)*(M+N)*N )  floating point operations.
C
C     FURTHER COMMENTS
C
C     The number of infinite zeros is computed as
C
C                   DINFZ
C        NINFZ =     Sum  (INFZ(i)*i) .
C                    i=1
C     Note that each infinite zero of multiplicity k corresponds to
C     an infinite eigenvalue of multiplicity k+1.
C     The multiplicities of the infinite eigenvalues can be determined
C     from PR, DINFZ and INFZ(i), i = 1, ..., DINFZ, as follows:
C
C                     DINFZ
C     - there are PR - Sum (INFZ(i)) simple infinite eigenvalues;
C                      i=1
C
C     - there are INFZ(i) infinite eigenvalues with multiplicity i+1,
C       for i = 1, ..., DINFZ.
C
C     The left Kronecker indices are:
C
C     [ 0  0 ...  0  | 1  1  ...  1 |  .... | NKRONL  ...  NKRONL ]
C     |<- KRONL(1) ->|<- KRONL(2) ->|       |<-  KRONL(NKRONL)  ->|
C
C     CONTRIBUTOR
C
C     A. Varga, German Aerospace Center, DLR Oberpfaffenhofen.
C     May 1999.
C     Complex version: V. Sima, Research Institute for Informatics,
C     Bucharest, Nov. 2008.
C
C     REVISIONS
C
C     V. Sima, Research Institute for Informatics, Bucharest, Apr. 2009.
C
C     KEYWORDS
C
C     Generalized eigenvalue problem, Kronecker indices, multivariable
C     system, unitary transformation, structural invariant.
C
C     ******************************************************************
C
C     .. Parameters ..
      INTEGER            IMAX, IMIN
      PARAMETER          ( IMAX = 1, IMIN = 2 )
      DOUBLE PRECISION   ONE, P05, ZERO
      PARAMETER          ( ONE = 1.0D0, P05 = 0.05D0, ZERO = 0.0D0 )
      COMPLEX*16         CONE, CZERO
      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ),
     $                    CZERO = ( 0.0D+0, 0.0D+0 ) )
C     .. Scalar Arguments ..
      INTEGER            DINFZ, INFO, LDABCD, LDE, LZWORK, M, N, NINFZ,
     $                   NKRONL, NR, P, PR
      DOUBLE PRECISION   SVLMAX, TOL
      LOGICAL            FIRST
C     .. Array Arguments ..
      INTEGER            INFZ( * ), IWORK(*), KRONL( * )
      DOUBLE PRECISION   DWORK( * )
      COMPLEX*16         ABCD( LDABCD, * ), E( LDE, * ), ZWORK( * )
C     .. Local Scalars ..
      LOGICAL            LQUERY
      INTEGER            I, ICOL, ILAST, IRC, IROW, ISMAX, ISMIN, ITAU,
     $                   J, JLAST, JWORK1, JWORK2, K, MN, MN1, MNR,
     $                   MNTAU, MP1, MPM, MUI, MUIM1, N1, NB, NBLCKS,
     $                   PN, RANK, RO, RO1, SIGMA, TAUI, WRKOPT
      DOUBLE PRECISION   C, RCOND, SMAX, SMAXPR, SMIN, SMINPR, T, TT
      COMPLEX*16         C1, C2, S, S1, S2, TC
C     .. Local Arrays ..
      DOUBLE PRECISION   SVAL(3)
      COMPLEX*16         DUM(1)
C     .. External Functions ..
      INTEGER            IDAMAX, ILAENV
      DOUBLE PRECISION   DLAMCH, DZNRM2
      EXTERNAL           DLAMCH, DZNRM2, IDAMAX, ILAENV
C     .. External Subroutines ..
      EXTERNAL           MB3OYZ, XERBLA, ZCOPY, ZLAIC1, ZLAPMT, ZLARFG,
     $                   ZLARTG, ZLASET, ZLATZM, ZROT, ZSWAP, ZUNMQR
C     .. Intrinsic Functions ..
      INTRINSIC          ABS, DBLE, DCONJG, INT, MAX, MIN, SQRT
C     .. Executable Statements ..
C
C     Test the input parameters.
C
      LQUERY = ( LZWORK.EQ.-1 )
      INFO = 0
      PN   = P + N
      MN   = M + N
      MPM  = MIN( P, M )
      IF( N.LT.0 ) THEN
         INFO = -2
      ELSE IF( M.LT.0 .OR. ( .NOT.FIRST .AND. M.GT.P ) ) THEN
         INFO = -3
      ELSE IF( P.LT.0 ) THEN
         INFO = -4
      ELSE IF( SVLMAX.LT.ZERO ) THEN
         INFO = -5
      ELSE IF( LDABCD.LT.MAX( 1, PN ) ) THEN
         INFO = -7
      ELSE IF( LDE.LT.MAX( 1, N ) ) THEN
         INFO = -9
      ELSE IF( TOL.GT.ONE ) THEN
         INFO = -17
      ELSE
         WRKOPT = MAX( 1, 3*P )
         IF( P.GT.0 ) THEN
            IF( M.GT.0 ) THEN
               WRKOPT = MAX( WRKOPT, MN-1 )
               IF( FIRST ) THEN
                  WRKOPT = MAX( WRKOPT, MPM + MAX( 3*M-1, N ) )
                  IF( LQUERY ) THEN
                     NB = MIN( 64, ILAENV( 1, 'ZUNMQR', 'LC', P, N,
     $                                     MPM, -1 ) )
                     WRKOPT = MAX( WRKOPT, MPM + MAX( 1, N )*NB )
                  END IF
               END IF
            END IF
         END IF
         IF( LZWORK.LT.WRKOPT .AND. .NOT.LQUERY ) THEN
            INFO = -21
         END IF
      END IF
      IF( INFO.NE.0 ) THEN
         CALL XERBLA( 'AG8BYZ', -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         ZWORK(1) = WRKOPT
         RETURN
      END IF
C
C     Initialize output variables.
C
      PR = P
      NR = N
      DINFZ  = 0
      NINFZ  = 0
      NKRONL = 0
C
C     Quick return if possible.
C
      IF( P.EQ.0 ) THEN
         ZWORK(1) = CONE
         RETURN
      END IF
      IF( N.EQ.0 .AND. M.EQ.0 ) THEN
         PR = 0
         NKRONL   = 1
         KRONL(1) = P
         ZWORK(1) = CONE
         RETURN
      END IF
C
      RCOND = TOL
      IF( RCOND.LE.ZERO ) THEN
C
C        Use the default tolerance in rank determination.
C
         RCOND = DBLE( PN*MN )*DLAMCH( 'EPSILON' )
      END IF
C
C     The D matrix is (RO+SIGMA)-by-M, where RO = P - SIGMA and
C     SIGMA = 0 for FIRST = .TRUE. and SIGMA = M for FIRST = .FALSE..
C     The leading (RO+SIGMA)-by-SIGMA submatrix of D has full column
C     rank, with the trailing SIGMA-by-SIGMA submatrix upper triangular.
C
      IF( FIRST ) THEN
         SIGMA = 0
      ELSE
         SIGMA = M
      END IF
      RO  = P - SIGMA
      MP1 = M + 1
      MUI = 0
      DUM(1) = CZERO
C
      ITAU   = 1
      JWORK1 = ITAU + MPM
      ISMIN  = 1
      ISMAX  = ISMIN + P
      JWORK2 = ISMAX + P
      NBLCKS = 0
      WRKOPT = 1
C
   10 IF( PR.EQ.0 ) GO TO 90
C
C     (NR+1,ICOL+1) points to the current position of matrix D.
C
      RO1 = RO
      MNR = M + NR
      IF( M.GT.0 ) THEN
C
C        Compress rows of D; first exploit the trapezoidal shape of the
C        (RO+SIGMA)-by-SIGMA matrix in the first SIGMA columns of D;
C        compress the first SIGMA columns without column pivoting:
C
C              ( x x x x x )       ( x x x x x )
C              ( x x x x x )       ( 0 x x x x )
C              ( x x x x x )  - >  ( 0 0 x x x )
C              ( 0 x x x x )       ( 0 0 0 x x )
C              ( 0 0 x x x )       ( 0 0 0 x x )
C
C        where SIGMA = 3 and RO = 2.
C        Complex workspace: need maximum M+N-1.
C
         IROW = NR
         DO 20 ICOL = 1, SIGMA
            IROW = IROW + 1
            CALL ZLARFG( RO+1, ABCD(IROW,ICOL), ABCD(IROW+1,ICOL), 1,
     $                   TC )
            CALL ZLATZM( 'L', RO+1, MNR-ICOL, ABCD(IROW+1,ICOL), 1,
     $                   DCONJG( TC ), ABCD(IROW,ICOL+1),
     $                   ABCD(IROW+1,ICOL+1), LDABCD, ZWORK )
            CALL ZCOPY( PR-ICOL, DUM, 0, ABCD(IROW+1,ICOL), 1 )
   20    CONTINUE
         WRKOPT = MAX( WRKOPT, MN - 1 )
C
         IF( FIRST ) THEN
C
C           Continue with Householder with column pivoting.
C
C              ( x x x x x )        ( x x x x x )
C              ( 0 x x x x )        ( 0 x x x x )
C              ( 0 0 x x x )  - >   ( 0 0 x x x )
C              ( 0 0 0 x x )        ( 0 0 0 x x )
C              ( 0 0 0 x x )        ( 0 0 0 0 0 )
C
C           Real workspace:    need maximum 2*M;
C           Complex workspace: need maximum min(P,M)+3*M-1;
C           Integer workspace: need maximum M.
C
            IROW = MIN( NR+SIGMA+1, PN )
            ICOL = MIN( SIGMA+1, M )
            CALL MB3OYZ( RO1, M-SIGMA, ABCD(IROW,ICOL), LDABCD,
     $                   RCOND, SVLMAX, RANK, SVAL, IWORK, ZWORK(ITAU),
     $                   DWORK, ZWORK(JWORK1), INFO )
            WRKOPT = MAX( WRKOPT, JWORK1 + 3*M - 2 )
C
C           Apply the column permutations to B and part of D.
C
            CALL ZLAPMT( .TRUE., NR+SIGMA, M-SIGMA, ABCD(1,ICOL),
     $                   LDABCD, IWORK )
C
            IF( RANK.GT.0 ) THEN
C
C              Apply the Householder transformations to the submatrix C.
C              Complex workspace: need   maximum min(P,M) + N;
C                                 prefer maximum min(P,M) + N*NB.
C
               CALL ZUNMQR( 'Left', 'ConjTranspose', RO1, NR, RANK,
     $                      ABCD(IROW,ICOL), LDABCD, ZWORK(ITAU),
     $                      ABCD(IROW,MP1), LDABCD, ZWORK(JWORK1),
     $                      LZWORK-JWORK1+1, INFO )
               WRKOPT = MAX( WRKOPT, JWORK1 + INT( ZWORK(JWORK1) ) - 1 )
               CALL ZLASET( 'Lower', RO1-1, MIN( RO1-1, RANK ), CZERO,
     $                      CZERO, ABCD(MIN( IROW+1, PN ),ICOL),
     $                      LDABCD )
               RO1 = RO1 - RANK
            END IF
         END IF
C
C        Terminate if Dr has maximal row rank.
C
         IF( RO1.EQ.0 ) GO TO 90
C
      END IF
C
C     Update SIGMA.
C
      SIGMA = PR - RO1
C
      NBLCKS = NBLCKS + 1
      TAUI = RO1
C
C     Compress the columns of current C to separate a TAUI-by-MUI
C     full column rank block.
C
      IF( NR.EQ.0 ) THEN
C
C        Finish for zero state dimension.
C
         PR = SIGMA
         RANK = 0
      ELSE
C
C        Perform RQ-decomposition with row pivoting on the current C
C        while keeping E upper triangular.
C        The current C is the TAUI-by-NR matrix delimited by rows
C        IRC+1 to IRC+TAUI and columns M+1 to M+NR of ABCD.
C        The rank of current C is computed in MUI.
C        Real workspace:    need maximum 2*P;
C        Complex workspace: need maximum 3*P.
C
         IRC = NR + SIGMA
         N1  = NR
         IF( TAUI.GT.1 ) THEN
C
C           Compute norms.
C
            DO 30 I = 1, TAUI
               DWORK(I) = DZNRM2( NR, ABCD(IRC+I,MP1), LDABCD )
               DWORK(P+I) = DWORK(I)
   30       CONTINUE
         END IF
C
         RANK  = 0
         MNTAU = MIN( TAUI, NR )
C
C        ICOL and IROW will point to the current pivot position in C.
C
         ILAST = NR + PR
         JLAST = M  + NR
         IROW = ILAST
         ICOL = JLAST
         I = TAUI
   40    IF( RANK.LT.MNTAU ) THEN
            MN1 = M + N1
C
C           Pivot if necessary.
C
            IF( I.NE.1 ) THEN
               J = IDAMAX( I, DWORK, 1 )
               IF( J.NE.I ) THEN
                  DWORK(J) = DWORK(I)
                  DWORK(P+J) = DWORK(P+I)
                  CALL ZSWAP( N1, ABCD(IROW,MP1), LDABCD,
     $                        ABCD(IRC+J,MP1), LDABCD )
               END IF
            END IF
C
C           Zero elements left to ABCD(IROW,ICOL).
C
            DO 50 K = 1, N1-1
               J = M + K
C
C              Rotate columns J, J+1 to zero ABCD(IROW,J).
C
               TC = ABCD(IROW,J+1)
               CALL ZLARTG( TC, ABCD(IROW,J), C, S, ABCD(IROW,J+1) )
               ABCD(IROW,J) = CZERO
               CALL ZROT( IROW-1, ABCD(1,J+1), 1, ABCD(1,J), 1, C, S )
               CALL ZROT( K+1, E(1,K+1), 1, E(1,K), 1, C, S )
C
C              Rotate rows K, K+1 to zero E(K+1,K).
C
               TC = E(K,K)
               CALL ZLARTG( TC, E(K+1,K), C, S, E(K,K) )
               E(K+1,K) = CZERO
               CALL ZROT( N1-K, E(K,K+1), LDE, E(K+1,K+1), LDE, C, S )
               CALL ZROT( MN1, ABCD(K,1), LDABCD, ABCD(K+1,1), LDABCD,
     $                    C, S )
   50       CONTINUE
C
            IF( RANK.EQ.0 ) THEN
C
C              Initialize; exit if matrix is zero (RANK = 0).
C
               SMAX = ABS( ABCD(ILAST,JLAST) )
               IF ( SMAX.EQ.ZERO ) GO TO 80
               SMIN   = SMAX
               SMAXPR = SMAX
               SMINPR = SMIN
               C1 = CONE
               C2 = CONE
            ELSE
C
C              One step of incremental condition estimation.
C              Complex workspace: need maximum 3*P.
C
               CALL ZCOPY(  RANK, ABCD(IROW,ICOL+1), LDABCD,
     $                      ZWORK(JWORK2), 1 )
               CALL ZLAIC1( IMIN, RANK, ZWORK(ISMIN), SMIN,
     $                      ZWORK(JWORK2), ABCD(IROW,ICOL), SMINPR, S1,
     $                      C1 )
               CALL ZLAIC1( IMAX, RANK, ZWORK(ISMAX), SMAX,
     $                      ZWORK(JWORK2), ABCD(IROW,ICOL), SMAXPR, S2,
     $                      C2 )
               WRKOPT = MAX( WRKOPT, 3*P )
            END IF
C
C           Check the rank; finish the loop if rank loss occurs.
C
            IF( SVLMAX*RCOND.LE.SMAXPR ) THEN
               IF( SVLMAX*RCOND.LE.SMINPR ) THEN
                  IF( SMAXPR*RCOND.LE.SMINPR ) THEN
C
C                    Finish the loop if last row.
C
                     IF( N1.EQ.0 ) THEN
                        RANK = RANK + 1
                        GO TO 80
                     END IF
C
                     IF( N1.GT.1 ) THEN
C
C                       Update norms.
C
                        IF( I-1.GT.1 ) THEN
                           DO 60 J = 1, I - 1
                              IF( DWORK(J).NE.ZERO ) THEN
                                 T = ONE - ( ABS( ABCD(IRC+J,ICOL) )
     $                                   /DWORK(J) )**2
                                 T = MAX( T, ZERO )
                                 TT = ONE +
     $                                P05*T*( DWORK(J)/DWORK(P+J) )**2
                                 IF( TT.NE.ONE ) THEN
                                    DWORK(J) = DWORK(J)*SQRT( T )
                                 ELSE
                                    DWORK(J) = DZNRM2( N1-1,
     $                                         ABCD(IRC+J,MP1), LDABCD )
                                    DWORK(P+J) = DWORK(J)
                                 END IF
                              END IF
   60                      CONTINUE
                        END IF
                     END IF
C
                     DO 70 J = 1, RANK
                        ZWORK(ISMIN+J-1) = S1*ZWORK(ISMIN+J-1)
                        ZWORK(ISMAX+J-1) = S2*ZWORK(ISMAX+J-1)
   70                CONTINUE
C
                     ZWORK(ISMIN+RANK) = C1
                     ZWORK(ISMAX+RANK) = C2
                     SMIN = SMINPR
                     SMAX = SMAXPR
                     RANK = RANK + 1
                     ICOL = ICOL - 1
                     IROW = IROW - 1
                     N1 = N1 - 1
                     I  = I  - 1
                     GO TO 40
                  END IF
               END IF
            END IF
         END IF
      END IF
C
   80 CONTINUE
      MUI = RANK
      NR  = NR - MUI
      PR  = SIGMA + MUI
C
C     Set number of left Kronecker blocks of order (i-1)-by-i.
C
      KRONL(NBLCKS) = TAUI - MUI
C
C     Set number of infinite divisors of order i-1.
C
      IF( FIRST .AND. NBLCKS.GT.1 )
     $   INFZ(NBLCKS-1) = MUIM1 - TAUI
      MUIM1 = MUI
      RO = MUI
C
C     Continue reduction if rank of current C is positive.
C
      IF( MUI.GT.0 )
     $   GO TO 10
C
C     Determine the maximal degree of infinite zeros and
C     the number of infinite zeros.
C
   90 CONTINUE
      IF( FIRST ) THEN
         IF( MUI.EQ.0 ) THEN
            DINFZ = MAX( 0, NBLCKS - 1 )
         ELSE
            DINFZ = NBLCKS
            INFZ(NBLCKS) = MUI
         END IF
         K = DINFZ
         DO 100 I = K, 1, -1
            IF( INFZ(I).NE.0 ) GO TO 110
            DINFZ = DINFZ - 1
  100    CONTINUE
  110    CONTINUE
         DO 120 I = 1, DINFZ
            NINFZ = NINFZ + INFZ(I)*I
  120    CONTINUE
      END IF
C
C     Determine the maximal order of left elementary Kronecker blocks.
C
      NKRONL = NBLCKS
      DO 130 I = NBLCKS, 1, -1
         IF( KRONL(I).NE.0 ) GO TO 140
         NKRONL = NKRONL - 1
  130 CONTINUE
  140 CONTINUE
C
      ZWORK(1) = WRKOPT
      RETURN
C *** Last line of AG8BYZ ***
      END