SUBROUTINE AB8NXZ( N, M, P, RO, SIGMA, SVLMAX, ABCD, LDABCD,
     $                   NINFZ, INFZ, KRONL, MU, NU, NKROL, 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) system
C                  ( B  A )
C                  ( D  C )
C     an (NU+MU)-by-(M+NU) "reduced" system
C                  ( B' A')
C                  ( D' C')
C     having the same transmission zeros but with D' of full row rank.
C
C     ARGUMENTS
C
C     Input/Output Parameters
C
C     N       (input) INTEGER
C             The number of state variables.  N >= 0.
C
C     M       (input) INTEGER
C             The number of system inputs.  M >= 0.
C
C     P       (input) INTEGER
C             The number of system outputs.  P >= 0.
C
C     RO      (input/output) INTEGER
C             On entry,
C             = P     for the original system;
C             = MAX(P-M, 0) for the pertransposed system.
C             On exit, RO contains the last computed rank.
C
C     SIGMA   (input/output) INTEGER
C             On entry,
C             = 0  for the original system;
C             = M  for the pertransposed system.
C             On exit, SIGMA contains the last computed value sigma in
C             the algorithm.
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 input matrix of the system.
C             On exit, the leading (NU+MU)-by-(M+NU) part of this array
C             contains the reduced compound input matrix of the system.
C
C     LDABCD  INTEGER
C             The leading dimension of array ABCD.
C             LDABCD >= MAX(1,N+P).
C
C     NINFZ   (input/output) INTEGER
C             On entry, the currently computed number of infinite zeros.
C             It should be initialized to zero on the first call.
C             NINFZ >= 0.
C             On exit, the number of infinite zeros.
C
C     INFZ    (input/output) INTEGER array, dimension (N)
C             On entry, INFZ(i) must contain the current number of
C             infinite zeros of degree i, where i = 1,2,...,N, found in
C             the previous call(s) of the routine. It should be
C             initialized to zero on the first call.
C             On exit, INFZ(i) contains the number of infinite zeros of
C             degree i, where i = 1,2,...,N.
C
C     KRONL   (input/output) INTEGER array, dimension (N+1)
C             On entry, this array must contain the currently computed
C             left Kronecker (row) indices found in the previous call(s)
C             of the routine. It should be initialized to zero on the
C             first call.
C             On exit, the leading NKROL elements of this array contain
C             the left Kronecker (row) indices.
C
C     MU      (output) INTEGER
C             The normal rank of the transfer function matrix of the
C             original system.
C
C     NU      (output) INTEGER
C             The dimension of the reduced system matrix and the number
C             of (finite) invariant zeros if D' is invertible.
C
C     NKROL   (output) INTEGER
C             The number of left Kronecker indices.
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             NOTE that when SVLMAX > 0, the estimated ranks could be
C             less than those defined above (see SVLMAX).
C
C     Workspace
C
C     IWORK   INTEGER array, dimension (MAX(M,P))
C
C     DWORK   DOUBLE PRECISION array, dimension (2*MAX(M,P))
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 >= MAX( 1, MIN(P,M) + MAX(3*M-1,N),
C                               MIN(P,N) + MAX(3*P-1,N+P,N+M) ).
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     REFERENCES
C
C     [1] Svaricek, F.
C         Computation of the Structural Invariants of Linear
C         Multivariable Systems with an Extended Version of
C         the Program ZEROS.
C         System & Control Letters, 6, pp. 261-266, 1985.
C
C     [2] Emami-Naeini, A. and Van Dooren, P.
C         Computation of Zeros of Linear Multivariable Systems.
C         Automatica, 18, pp. 415-430, 1982.
C
C     NUMERICAL ASPECTS
C
C     The algorithm is backward stable.
C
C     CONTRIBUTOR
C
C     V. Sima, Katholieke Univ. Leuven, Belgium, Nov. 1996.
C     Complex version: V. Sima, Research Institute for Informatics,
C     Bucharest, Nov. 2008 with suggestions from P. Gahinet,
C     The MathWorks.
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 ..
      COMPLEX*16        ZERO
      PARAMETER         ( ZERO = ( 0.0D+0, 0.0D+0 ) )
      DOUBLE PRECISION  DZERO
      PARAMETER         ( DZERO = 0.0D0 )
C     .. Scalar Arguments ..
      INTEGER           INFO, LDABCD, LZWORK, M, MU, N, NINFZ, NKROL,
     $                  NU, P, RO, SIGMA
      DOUBLE PRECISION  SVLMAX, TOL
C     .. Array Arguments ..
      INTEGER           INFZ(*), IWORK(*), KRONL(*)
      COMPLEX*16        ABCD(LDABCD,*), ZWORK(*)
      DOUBLE PRECISION  DWORK(*)
C     .. Local Scalars ..
      LOGICAL           LQUERY
      INTEGER           I1, IK, IROW, ITAU, IZ, JWORK, MM1, MNTAU, MNU,
     $                  MPM, NB, NP, RANK, RO1, TAU, WRKOPT
      COMPLEX*16        TC
C     .. Local Arrays ..
      DOUBLE PRECISION  SVAL(3)
C     .. External Functions ..
      INTEGER           ILAENV
      EXTERNAL          ILAENV
C     .. External Subroutines ..
      EXTERNAL          MB3OYZ, MB3PYZ, XERBLA, ZLAPMT, ZLARFG, ZLASET,
     $                  ZLATZM, ZUNMQR, ZUNMRQ
C     .. Intrinsic Functions ..
      INTRINSIC         DCONJG, INT, MAX, MIN
C     .. Executable Statements ..
C
      NP   = N + P
      MPM  = MIN( P, M )
      INFO = 0
      LQUERY = ( LZWORK.EQ.-1 )
C
C     Test the input scalar arguments.
C
      IF( N.LT.0 ) THEN
         INFO = -1
      ELSE IF( M.LT.0 ) THEN
         INFO = -2
      ELSE IF( P.LT.0 ) THEN
         INFO = -3
      ELSE IF( RO.NE.P .AND. RO.NE.MAX( P-M, 0 ) ) THEN
         INFO = -4
      ELSE IF( SIGMA.NE.0 .AND. SIGMA.NE.M ) THEN
         INFO = -5
      ELSE IF( SVLMAX.LT.DZERO ) THEN
         INFO = -6
      ELSE IF( LDABCD.LT.MAX( 1, NP ) ) THEN
         INFO = -8
      ELSE IF( NINFZ.LT.0 ) THEN
         INFO = -9
      ELSE
         JWORK = MAX( 1,      MPM + MAX( 3*M - 1, N ),
     $                MIN( P, N ) + MAX( 3*P - 1, NP, N+M ) )
         IF( LQUERY ) THEN
            IF( M.GT.0 ) THEN
               NB = MIN( 64, ILAENV( 1, 'ZUNMQR', 'LC', P, N, MPM,
     $                               -1 ) )
               WRKOPT = MAX( JWORK, MPM + MAX( 1, N )*NB )
            ELSE
               WRKOPT = JWORK
            END IF
            NB = MIN( 64, ILAENV( 1, 'ZUNMRQ', 'RC', NP, N, MIN( P, N ),
     $                            -1 ) )
            WRKOPT = MAX( WRKOPT, MIN( P, N ) + MAX( 1, NP )*NB )
            NB = MIN( 64, ILAENV( 1, 'ZUNMRQ', 'LN', N, M+N,
     $                            MIN( P, N ), -1 ) )
            WRKOPT = MAX( WRKOPT, MIN( P, N ) + MAX( 1, M+N )*NB )
         ELSE IF( LZWORK.LT.JWORK ) THEN
            INFO = -19
         END IF
      END IF
C
      IF ( INFO.NE.0 ) THEN
C
C        Error return.
C
         CALL XERBLA( 'AB8NXZ', -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         ZWORK(1) = WRKOPT
         RETURN
      END IF
C
      MU = P
      NU = N
C
      IZ = 0
      IK = 1
      MM1 = M + 1
      ITAU = 1
      NKROL = 0
      WRKOPT = 1
C
C     Main reduction loop:
C
C            M   NU                  M     NU
C      NU  [ B   A ]           NU  [ B     A ]
C      MU  [ D   C ]  -->    SIGMA [ RD   C1 ]   (SIGMA = rank(D) =
C                             TAU  [ 0    C2 ]    row size of RD)
C
C                                    M   NU-RO  RO
C                            NU-RO [ B1   A11  A12 ]
C                     -->      RO  [ B2   A21  A22 ]  (RO = rank(C2) =
C                            SIGMA [ RD   C11  C12 ]   col size of LC)
C                             TAU  [ 0     0   LC  ]
C
C                                     M   NU-RO
C                            NU-RO [ B1   A11 ]     NU := NU - RO
C                                  [----------]     MU := RO + SIGMA
C                     -->      RO  [ B2   A21 ]      D := [B2;RD]
C                            SIGMA [ RD   C11 ]      C := [A21;C11]
C
   20 IF ( MU.EQ.0 )
     $   GO TO 80
C
C     (Note: Comments in the code beginning "xWorkspace:", where x is
C     I, D, or C, describe the minimal amount of integer, real and
C     complex workspace needed at that point in the code, respectively,
C     as well as the preferred amount for good performance.)
C
      RO1 = RO
      MNU = M + NU
      IF ( M.GT.0 ) THEN
         IF ( SIGMA.NE.0 ) THEN
            IROW = NU + 1
C
C           Compress rows of D.  First exploit triangular shape.
C           CWorkspace: need   M+N-1.
C
            DO 40 I1 = 1, SIGMA
               CALL ZLARFG( RO+1, ABCD(IROW,I1), ABCD(IROW+1,I1), 1,
     $                      TC )
               CALL ZLATZM( 'L', RO+1, MNU-I1, ABCD(IROW+1,I1), 1,
     $                      DCONJG( TC ), ABCD(IROW,I1+1),
     $                      ABCD(IROW+1,I1+1), LDABCD, ZWORK )
               IROW = IROW + 1
   40       CONTINUE
            CALL ZLASET( 'Lower', RO+SIGMA-1, SIGMA, ZERO, ZERO,
     $                   ABCD(NU+2,1), LDABCD )
         END IF
C
C        Continue with Householder with column pivoting.
C
C        The rank of D is the number of (estimated) singular values
C        that are greater than TOL * MAX(SVLMAX,EMSV). This number
C        includes the singular values of the first SIGMA columns.
C        IWorkspace: need   M;
C        RWorkspace: need   2*M;
C        CWorkspace: need   min(RO1,M) + 3*M - 1.  RO1 <= P.
C
         IF ( SIGMA.LT.M ) THEN
            JWORK = ITAU + MIN( RO1, M )
            I1    = SIGMA + 1
            IROW  = NU + I1
            CALL MB3OYZ( RO1, M-SIGMA, ABCD(IROW,I1), LDABCD, TOL,
     $                   SVLMAX, RANK, SVAL, IWORK, ZWORK(ITAU), DWORK,
     $                   ZWORK(JWORK), INFO )
            WRKOPT = MAX( WRKOPT, JWORK + 3*M - 2 )
C
C           Apply the column permutations to matrices B and part of D.
C
            CALL ZLAPMT( .TRUE., NU+SIGMA, M-SIGMA, ABCD(1,I1), LDABCD,
     $                   IWORK )
C
            IF ( RANK.GT.0 ) THEN
C
C              Apply the Householder transformations to the submatrix C.
C              CWorkspace:    need   min(RO1,M) + NU;
C                             prefer min(RO1,M) + NU*NB.
C
               CALL ZUNMQR( 'Left', 'Conjugate', RO1, NU, RANK,
     $                      ABCD(IROW,I1), LDABCD, ZWORK(ITAU),
     $                      ABCD(IROW,MM1), LDABCD, ZWORK(JWORK),
     $                      LZWORK-JWORK+1, INFO )
               WRKOPT = MAX( WRKOPT, INT( ZWORK(JWORK) ) + JWORK - 1 )
               IF ( RO1.GT.1 )
     $            CALL ZLASET( 'Lower', RO1-1, MIN( RO1-1, RANK ), ZERO,
     $                         ZERO, ABCD(IROW+1,I1), LDABCD )
               RO1 = RO1 - RANK
            END IF
         END IF
      END IF
C
      TAU = RO1
      SIGMA = MU - TAU
C
C     Determination of the orders of the infinite zeros.
C
      IF ( IZ.GT.0 ) THEN
         INFZ(IZ) = INFZ(IZ) + RO - TAU
         NINFZ = NINFZ + IZ*( RO - TAU )
      END IF
      IF ( RO1.EQ.0 )
     $   GO TO 80
      IZ = IZ + 1
C
      IF ( NU.LE.0 ) THEN
         MU = SIGMA
         NU = 0
         RO = 0
      ELSE
C
C        Compress the columns of C2 using RQ factorization with row
C        pivoting, P * C2 = R * Q.
C
         I1 = NU + SIGMA + 1
         MNTAU = MIN( TAU, NU )
         JWORK = ITAU + MNTAU
C
C        The rank of C2 is the number of (estimated) singular values
C        greater than TOL * MAX(SVLMAX,EMSV).
C        IWorkspace: need TAU;
C        RWorkspace: need 2*TAU;
C        CWorkspace: need min(TAU,NU) + 3*TAU - 1.
C
         CALL MB3PYZ( TAU, NU, ABCD(I1,MM1), LDABCD, TOL, SVLMAX, RANK,
     $                SVAL, IWORK, ZWORK(ITAU), DWORK, ZWORK(JWORK),
     $                INFO )
         WRKOPT = MAX( WRKOPT, JWORK + 3*TAU - 1 )
         IF ( RANK.GT.0 ) THEN
            IROW = I1 + TAU - RANK
C
C           Apply Q' to the first NU columns of [A; C1] from the right.
C           CWorkspace: need   min(TAU,NU) + NU + SIGMA; SIGMA <= P;
C                       prefer min(TAU,NU) + (NU  + SIGMA)*NB.
C
            CALL ZUNMRQ( 'Right', 'ConjTranspose', I1-1, NU, RANK,
     $                   ABCD(IROW,MM1), LDABCD, ZWORK(MNTAU-RANK+1),
     $                   ABCD(1,MM1), LDABCD, ZWORK(JWORK),
     $                   LZWORK-JWORK+1, INFO )
            WRKOPT = MAX( WRKOPT, INT( ZWORK(JWORK) ) + JWORK - 1 )
C
C           Apply Q to the first NU rows and M + NU columns of [ B  A ]
C           from the left.
C           CWorkspace: need   min(TAU,NU) + M + NU;
C                       prefer min(TAU,NU) + (M + NU)*NB.
C
            CALL ZUNMRQ( 'Left', 'NoTranspose', NU, MNU, RANK,
     $                   ABCD(IROW,MM1), LDABCD, ZWORK(MNTAU-RANK+1),
     $                   ABCD, LDABCD, ZWORK(JWORK), LZWORK-JWORK+1,
     $                   INFO )
            WRKOPT = MAX( WRKOPT, INT( ZWORK(JWORK) ) + JWORK - 1 )
C
            CALL ZLASET( 'Full', RANK, NU-RANK, ZERO, ZERO,
     $                   ABCD(IROW,MM1), LDABCD )
            IF ( RANK.GT.1 )
     $         CALL ZLASET( 'Lower', RANK-1, RANK-1, ZERO, ZERO,
     $                      ABCD(IROW+1,MM1+NU-RANK), LDABCD )
         END IF
C
         RO = RANK
      END IF
C
C     Determine the left Kronecker indices (row indices).
C
      KRONL(IK) = KRONL(IK) + TAU - RO
      NKROL = NKROL + KRONL(IK)
      IK = IK + 1
C
C     C and D are updated to [A21 ; C11] and [B2 ; RD].
C
      NU = NU - RO
      MU = SIGMA + RO
      IF ( RO.NE.0 )
     $   GO TO 20
C
   80 CONTINUE
      ZWORK(1) = WRKOPT
      RETURN
C *** Last line of AB8NXZ ***
      END