SUBROUTINE MB04TX( UPDATQ, UPDATZ, M, N, NBLCKS, INUK, IMUK, A, $ LDA, E, LDE, Q, LDQ, Z, LDZ, MNEI ) 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 . C C PURPOSE C C To separate the pencils s*E(eps)-A(eps) and s*E(inf)-A(inf) in C s*E(eps,inf)-A(eps,inf) using Algorithm 3.3.3 in [1]. C C On entry, it is assumed that the M-by-N matrices A and E have C been obtained after applying the Algorithms 3.2.1 and 3.3.1 to C the pencil s*E - A as described in [1], i.e. C C | s*E(eps,inf)-A(eps,inf) | X | C Q'(s*E - A)Z = |-------------------------|-------------| C | 0 | s*E(r)-A(r) | C C Here the pencil s*E(eps,inf)-A(eps,inf) is in staircase form. C This pencil contains all Kronecker column indices and infinite C elementary divisors of the pencil s*E - A. C The pencil s*E(r)-A(r) contains all Kronecker row indices and C finite elementary divisors of s*E - A. C Furthermore, the submatrices having full row and column rank in C the pencil s*E(eps,inf)-A(eps,inf) are assumed to be C triangularized. C C On exit, the result then is C C Q'(s*E - A)Z = C C | s*E(eps)-A(eps) | X | X | C |-----------------|-----------------|-------------| C | 0 | s*E(inf)-A(inf) | X | C |===================================|=============| C | | | C | 0 | s*E(r)-A(r) | C C Note that the pencil s*E(r)-A(r) is not reduced further. C C ARGUMENTS C C Mode Parameters C C UPDATQ LOGICAL C Indicates whether the user wishes to accumulate in a C matrix Q the orthogonal row transformations, as follows: C = .FALSE.: Do not form Q; C = .TRUE.: The given matrix Q is updated by the orthogonal C row transformations used in the reduction. C C UPDATZ LOGICAL C Indicates whether the user wishes to accumulate in a C matrix Z the orthogonal column transformations, as C follows: C = .FALSE.: Do not form Z; C = .TRUE.: The given matrix Z is updated by the orthogonal C column transformations used in the reduction. C C Input/Output Parameters C C M (input) INTEGER C Number of rows of A and E. M >= 0. C C N (input) INTEGER C Number of columns of A and E. N >= 0. C C NBLCKS (input/output) INTEGER C On entry, the number of submatrices having full row rank C (possibly zero) in A(eps,inf). C On exit, the input value has been reduced by one, if the C last submatrix is a 0-by-0 (empty) matrix. C C INUK (input/output) INTEGER array, dimension (NBLCKS) C On entry, this array contains the row dimensions nu(k), C (k=1, 2, ..., NBLCKS) of the submatrices having full row C rank in the pencil s*E(eps,inf)-A(eps,inf). C On exit, this array contains the row dimensions nu(k), C (k=1, 2, ..., NBLCKS) of the submatrices having full row C rank in the pencil s*E(eps)-A(eps). C C IMUK (input/output) INTEGER array, dimension (NBLCKS) C On entry, this array contains the column dimensions mu(k), C (k=1, 2, ..., NBLCKS) of the submatrices having full C column rank in the pencil s*E(eps,inf)-A(eps,inf). C On exit, this array contains the column dimensions mu(k), C (k=1, 2, ..., NBLCKS) of the submatrices having full C column rank in the pencil s*E(eps)-A(eps). C C A (input/output) DOUBLE PRECISION array, dimension (LDA,N) C On entry, this array contains the matrix A to be reduced. C On exit, it contains the transformed matrix A. C C LDA INTEGER C The leading dimension of array A. LDA >= MAX(1,M). C C E (input/output) DOUBLE PRECISION array, dimension (LDE,N) C On entry, this array contains the matrix E to be reduced. C On exit, it contains the transformed matrix E. C C LDE INTEGER C The leading dimension of array E. LDE >= MAX(1,M). C C Q (input/output) DOUBLE PRECISION array, dimension (LDQ,*) C On entry, if UPDATQ = .TRUE., then the leading M-by-M C part of this array must contain a given matrix Q (e.g. C from a previous call to another SLICOT routine), and on C exit, the leading M-by-M part of this array contains the C product of the input matrix Q and the row transformation C matrix that has transformed the rows of the matrices A C and E. C If UPDATQ = .FALSE., the array Q is not referenced and C can be supplied as a dummy array (i.e. set parameter C LDQ = 1 and declare this array to be Q(1,1) in the calling C program). C C LDQ INTEGER C The leading dimension of array Q. If UPDATQ = .TRUE., C LDQ >= MAX(1,M); if UPDATQ = .FALSE., LDQ >= 1. C C Z (input/output) DOUBLE PRECISION array, dimension (LDZ,*) C On entry, if UPDATZ = .TRUE., then the leading N-by-N C part of this array must contain a given matrix Z (e.g. C from a previous call to another SLICOT routine), and on C exit, the leading N-by-N part of this array contains the C product of the input matrix Z and the column C transformation matrix that has transformed the columns of C the matrices A and E. C If UPDATZ = .FALSE., the array Z is not referenced and C can be supplied as a dummy array (i.e. set parameter C LDZ = 1 and declare this array to be Z(1,1) in the calling C program). C C LDZ INTEGER C The leading dimension of array Z. If UPDATZ = .TRUE., C LDZ >= MAX(1,N); if UPDATZ = .FALSE., LDZ >= 1. C C MNEI (output) INTEGER array, dimension (4) C MNEI(1) = MEPS = row dimension of s*E(eps)-A(eps), C MNEI(2) = NEPS = column dimension of s*E(eps)-A(eps), C MNEI(3) = MINF = row dimension of s*E(inf)-A(inf), C MNEI(4) = NINF = column dimension of s*E(inf)-A(inf). C C REFERENCES C C [1] Beelen, Th. C New Algorithms for Computing the Kronecker structure of a C Pencil with Applications to Systems and Control Theory. C Ph.D.Thesis, Eindhoven University of Technology, C The Netherlands, 1987. C C NUMERICAL ASPECTS C C The algorithm is backward stable. C C CONTRIBUTOR C C Release 3.0: V. Sima, Katholieke Univ. Leuven, Belgium, Apr. 1997. C Supersedes Release 2.0 routine MB04FX by Th.G.J. Beelen, C Philips Glass Eindhoven, Holland. C C REVISIONS C C June 13, 1997, V. Sima. C November 24, 1997, A. Varga: initialization of MNEI to 0, instead C of ZERO. C C KEYWORDS C C Generalized eigenvalue problem, Kronecker indices, orthogonal C transformation, staircase form. C C ****************************************************************** C C .. Parameters .. DOUBLE PRECISION ZERO PARAMETER ( ZERO = 0.0D0 ) C .. Scalar Arguments .. LOGICAL UPDATQ, UPDATZ INTEGER LDA, LDE, LDQ, LDZ, M, N, NBLCKS C .. Array Arguments .. INTEGER IMUK(*), INUK(*), MNEI(4) DOUBLE PRECISION A(LDA,*), E(LDE,*), Q(LDQ,*), Z(LDZ,*) C .. Local Scalars .. INTEGER CA, CE, CJA, CJE, IP, ISMUK, ISNUK, K, MEPS, $ MINF, MUK, MUKP1, MUP, MUP1, NEPS, NINF, NUK, $ NUP, RA, RJE, SK1P1, TK1P1, TP1 DOUBLE PRECISION SC, SS C .. External Subroutines .. EXTERNAL DROTG, MB04TU C .. Executable Statements .. C MNEI(1) = 0 MNEI(2) = 0 MNEI(3) = 0 MNEI(4) = 0 IF ( M.LE.0 .OR. N.LE.0 ) $ RETURN C C Initialisation. C ISMUK = 0 ISNUK = 0 C DO 20 K = 1, NBLCKS ISMUK = ISMUK + IMUK(K) ISNUK = ISNUK + INUK(K) 20 CONTINUE C C MEPS, NEPS are the dimensions of the pencil s*E(eps)-A(eps). C MEPS = Sum(k=1,...,nblcks) NU(k), C NEPS = Sum(k=1,...,nblcks) MU(k). C MINF, NINF are the dimensions of the pencil s*E(inf)-A(inf). C MEPS = ISNUK NEPS = ISMUK MINF = 0 NINF = 0 C C MUKP1 = mu(k+1). N.B. It is assumed that mu(NBLCKS + 1) = 0. C MUKP1 = 0 C DO 120 K = NBLCKS, 1, -1 NUK = INUK(K) MUK = IMUK(K) C C Reduce submatrix E(k,k+1) to square matrix. C NOTE that always NU(k) >= MU(k+1) >= 0. C C WHILE ( NU(k) > MU(k+1) ) DO 40 IF ( NUK.GT.MUKP1 ) THEN C C sk1p1 = sum(i=k+1,...,p-1) NU(i) C tk1p1 = sum(i=k+1,...,p-1) MU(i) C ismuk = sum(i=1,...,k) MU(i) C tp1 = sum(i=1,...,p-1) MU(i) = ismuk + tk1p1. C SK1P1 = 0 TK1P1 = 0 C DO 100 IP = K + 1, NBLCKS C C Annihilate the elements originally present in the last C row of E(k,p+1) and A(k,p). C Start annihilating the first MU(p) - MU(p+1) elements by C applying column Givens rotations plus interchanging C elements. C Use original bottom diagonal element of A(k,k) as pivot. C Start position of pivot in A = (ra,ca). C TP1 = ISMUK + TK1P1 RA = ISNUK + SK1P1 CA = TP1 C MUP = IMUK(IP) NUP = INUK(IP) MUP1 = NUP C DO 60 CJA = CA, CA + MUP - NUP - 1 C C CJA = current column index of pivot in A. C CALL DROTG( A(RA,CJA), A(RA,CJA+1), SC, SS ) C C Apply transformations to A- and E-matrix. C Interchange columns simultaneously. C Update column transformation matrix Z, if needed. C CALL MB04TU( RA-1, A(1,CJA), 1, A(1,CJA+1), 1, SC, $ SS ) A(RA,CJA+1) = A(RA,CJA) A(RA,CJA) = ZERO CALL MB04TU( RA, E(1,CJA), 1, E(1,CJA+1), 1, SC, SS ) IF( UPDATZ ) CALL MB04TU( N, Z(1,CJA), 1, Z(1,CJA+1), $ 1, SC, SS ) 60 CONTINUE C C Annihilate the remaining elements originally present in C the last row of E(k,p+1) and A(k,p) by alternatingly C applying row and column rotations plus interchanging C elements. C Use diagonal elements of E(p,p+1) and original bottom C diagonal element of A(k,k) as pivots, respectively. C (re,ce) and (ra,ca) are the starting positions of the C pivots in E and A. C CE = TP1 + MUP CA = CE - MUP1 - 1 C DO 80 RJE = RA + 1, RA + MUP1 C C (RJE,CJE) = current position pivot in E. C CJE = CE + 1 CJA = CA + 1 C C Determine the row transformations. C Apply these transformations to E- and A-matrix. C Interchange the rows simultaneously. C Update row transformation matrix Q, if needed. C CALL DROTG( E(RJE,CJE), E(RJE-1,CJE), SC, SS ) CALL MB04TU( N-CJE, E(RJE,CJE+1), LDE, E(RJE-1,CJE+1), $ LDE, SC, SS ) E(RJE-1,CJE) = E(RJE,CJE) E(RJE,CJE) = ZERO CALL MB04TU( N-CJA+1, A(RJE,CJA), LDA, A(RJE-1,CJA), $ LDA, SC, SS ) IF( UPDATQ ) CALL MB04TU( M, Q(1,RJE), 1, $ Q(1,RJE-1), 1, SC, SS ) C C Determine the column transformations. C Apply these transformations to A- and E-matrix. C Interchange the columns simultaneously. C Update column transformation matrix Z, if needed. C CALL DROTG( A(RJE,CJA), A(RJE,CJA+1), SC, SS ) CALL MB04TU( RJE-1, A(1,CJA), 1, A(1,CJA+1), 1, SC, $ SS ) A(RJE,CJA+1) = A(RJE,CJA) A(RJE,CJA) = ZERO CALL MB04TU( RJE, E(1,CJA), 1, E(1,CJA+1), 1, SC, SS ) IF( UPDATZ ) CALL MB04TU( N, Z(1,CJA), 1, Z(1,CJA+1), $ 1, SC, SS ) 80 CONTINUE C SK1P1 = SK1P1 + NUP TK1P1 = TK1P1 + MUP C 100 CONTINUE C C Reduce A=A(eps,inf) and E=E(eps,inf) by ignoring their last C row and right most column. The row and column ignored C belong to the pencil s*E(inf)-A(inf). C Redefine blocks in new A and E. C MUK = MUK - 1 NUK = NUK - 1 ISMUK = ISMUK - 1 ISNUK = ISNUK - 1 MEPS = MEPS - 1 NEPS = NEPS - 1 MINF = MINF + 1 NINF = NINF + 1 C GO TO 40 END IF C END WHILE 40 C IMUK(K) = MUK INUK(K) = NUK C C Now submatrix E(k,k+1) is square. C C Consider next submatrix (k:=k-1). C ISNUK = ISNUK - NUK ISMUK = ISMUK - MUK MUKP1 = MUK 120 CONTINUE C C If mu(NBLCKS) = 0, then the last submatrix counted in NBLCKS is C a 0-by-0 (empty) matrix. This "matrix" must be removed. C IF ( IMUK(NBLCKS).EQ.0 ) NBLCKS = NBLCKS - 1 C C Store dimensions of the pencils s*E(eps)-A(eps) and C s*E(inf)-A(inf) in array MNEI. C MNEI(1) = MEPS MNEI(2) = NEPS MNEI(3) = MINF MNEI(4) = NINF C RETURN C *** Last line of MB04TX *** END