413 lines
14 KiB
Fortran
413 lines
14 KiB
Fortran
SUBROUTINE MC03NY( NBLCKS, NRA, NCA, A, LDA, E, LDE, IMUK, INUK,
|
|
$ VEPS, LDVEPS, 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 determine a minimal basis of the right nullspace of the
|
|
C subpencil s*E(eps)-A(eps) using the method given in [1] (see
|
|
C Eqs.(4.6.8), (4.6.9)).
|
|
C This pencil only contains Kronecker column indices, and it must be
|
|
C in staircase form as supplied by SLICOT Library Routine MB04VD.
|
|
C The basis vectors are represented by matrix V(s) having the form
|
|
C
|
|
C | V11(s) V12(s) V13(s) . . V1n(s) |
|
|
C | V22(s) V23(s) V2n(s) |
|
|
C | V33(s) . |
|
|
C V(s) = | . . |
|
|
C | . . |
|
|
C | . . |
|
|
C | Vnn(s) |
|
|
C
|
|
C where n is the number of full row rank blocks in matrix A(eps) and
|
|
C
|
|
C k j-i
|
|
C Vij(s) = Vij,0 + Vij,1*s +...+ Vij,k*s +...+ Vij,j-i*s . (1)
|
|
C
|
|
C In other words, Vij,k is the coefficient corresponding to degree k
|
|
C in the matrix polynomial Vij(s).
|
|
C Vij,k has dimensions mu(i)-by-(mu(j)-nu(j)).
|
|
C The coefficients Vij,k are stored in the matrix VEPS as follows
|
|
C (for the case n = 3):
|
|
C
|
|
C sizes m1-n1 m2-n2 m2-n2 m3-n3 m3-n3 m3-n3
|
|
C
|
|
C m1 { | V11,0 || V12,0 | V12,1 || V13,0 | V13,1 | V13,2 ||
|
|
C | || | || | | ||
|
|
C VEPS = m2 { | || V22,0 | || V23,0 | V23,1 | ||
|
|
C | || | || | | ||
|
|
C m3 { | || | || V33,0 | | ||
|
|
C
|
|
C where mi = mu(i), ni = nu(i).
|
|
C Matrix VEPS has dimensions nrv-by-ncv where
|
|
C nrv = Sum(i=1,...,n) mu(i)
|
|
C ncv = Sum(i=1,...,n) i*(mu(i)-nu(i))
|
|
C
|
|
C ==================================================================
|
|
C REMARK: This routine is intended to be called only from the SLICOT
|
|
C routine MC03ND.
|
|
C ==================================================================
|
|
C
|
|
C ARGUMENTS
|
|
C
|
|
C Input/Output Parameters
|
|
C
|
|
C NBLCKS (input) INTEGER
|
|
C Number of full row rank blocks in subpencil
|
|
C s*E(eps)-A(eps) that contains all Kronecker column indices
|
|
C of s*E-A. NBLCKS >= 0.
|
|
C
|
|
C NRA (input) INTEGER
|
|
C Number of rows of the subpencil s*E(eps)-A(eps) in s*E-A.
|
|
C NRA = nu(1) + nu(2) + ... + nu(NBLCKS). NRA >= 0.
|
|
C
|
|
C NCA (input) INTEGER
|
|
C Number of columns of the subpencil s*E(eps)-A(eps) in
|
|
C s*E-A.
|
|
C NCA = mu(1) + mu(2) + ... + mu(NBLCKS). NCA >= 0.
|
|
C
|
|
C A (input/output) DOUBLE PRECISION array, dimension (LDA,NCA)
|
|
C E (input/output) DOUBLE PRECISION array, dimension (LDE,NCA)
|
|
C On entry, the leading NRA-by-NCA part of these arrays must
|
|
C contain the matrices A and E, where s*E-A is the
|
|
C transformed pencil s*E0-A0 which is the pencil associated
|
|
C with P(s) as described in [1] Section 4.6. The pencil
|
|
C s*E-A is assumed to be in generalized Schur form.
|
|
C On exit, these arrays contain no useful information.
|
|
C
|
|
C LDA INTEGER
|
|
C The leading dimension of array A. LDA >= MAX(1,NRA).
|
|
C
|
|
C LDE INTEGER
|
|
C The leading dimension of array E. LDE >= MAX(1,NRA).
|
|
C
|
|
C IMUK (input) INTEGER array, dimension (NBLCKS)
|
|
C This array must contain the column dimensions mu(k) of the
|
|
C full column rank blocks in the subpencil s*E(eps)-A(eps)
|
|
C of s*E-A. The content of IMUK is modified by the routine
|
|
C but restored on exit.
|
|
C
|
|
C INUK (input) INTEGER array, dimension (NBLCKS)
|
|
C This array must contain the row dimensions nu(k) of the
|
|
C full row rank blocks in the subpencil s*E(eps)-A(eps) of
|
|
C s*E-A.
|
|
C
|
|
C VEPS (output) DOUBLE PRECISION array, dimension (LDVEPS,ncv)
|
|
C Let nrv = Sum(i=1,...,NBLCKS) mu(i) = NCA,
|
|
C ncv = Sum(i=1,...,NBLCKS) i*(mu(i)-nu(i)).
|
|
C The leading nrv-by-ncv part of this array contains the
|
|
C column vectors of a minimal polynomial basis for the right
|
|
C nullspace of the subpencil s*E(eps)-A(eps). (See [1]
|
|
C Section 4.6.4.) An upper bound for ncv is (NRA+1)*NCA.
|
|
C
|
|
C LDVEPS INTEGER
|
|
C The leading dimension of array VEPS.
|
|
C LDVEPS >= MAX(1,NCA).
|
|
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 > 0: if INFO = k, the k-th diagonal block of A had not a
|
|
C full row rank.
|
|
C
|
|
C REFERENCES
|
|
C
|
|
C [1] Th.G.J. Beelen, New Algorithms for Computing the Kronecker
|
|
C structure of a Pencil with Applications to Systems and
|
|
C Control Theory.
|
|
C Ph.D.Thesis, Eindhoven University of Technology, 1987.
|
|
C
|
|
C NUMERICAL ASPECTS
|
|
C
|
|
C None.
|
|
C
|
|
C CONTRIBUTORS
|
|
C
|
|
C Release 3.0: V. Sima, Katholieke Univ. Leuven, Belgium, Mar. 1997.
|
|
C Supersedes Release 2.0 routine MC03BY by Th.G.J. Beelen,
|
|
C A.J. Geurts, and G.J.H.H. van den Hurk.
|
|
C
|
|
C REVISIONS
|
|
C
|
|
C Dec. 1997.
|
|
C
|
|
C KEYWORDS
|
|
C
|
|
C Elementary polynomial operations, Kronecker form, polynomial
|
|
C matrix, polynomial operations, staircase form.
|
|
C
|
|
C ******************************************************************
|
|
C
|
|
C .. Parameters ..
|
|
DOUBLE PRECISION ZERO, ONE
|
|
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
|
|
C .. Scalar Arguments ..
|
|
INTEGER INFO, LDA, LDE, LDVEPS, NBLCKS, NCA, NRA
|
|
C .. Array Arguments ..
|
|
INTEGER IMUK(*), INUK(*)
|
|
DOUBLE PRECISION A(LDA,*), E(LDE,*), VEPS(LDVEPS,*)
|
|
C .. Local Scalars ..
|
|
INTEGER AC1, AC2, AR1, ARI, ARK, DIF, EC1, ER1, I, J, K,
|
|
$ MUI, NCV, NRV, NUI, SMUI, SMUI1, VC1, VC2, VR1,
|
|
$ VR2, WC1, WR1
|
|
C .. Local Arrays ..
|
|
DOUBLE PRECISION DUMMY(1)
|
|
C .. External Subroutines ..
|
|
EXTERNAL DCOPY, DGEMM, DLASET, DSCAL, DTRTRS, XERBLA
|
|
C .. Executable Statements ..
|
|
C
|
|
INFO = 0
|
|
IF( NBLCKS.LT.0 ) THEN
|
|
INFO = -1
|
|
ELSE IF( NRA.LT.0 ) THEN
|
|
INFO = -2
|
|
ELSE IF( NCA.LT.0 ) THEN
|
|
INFO = -3
|
|
ELSE IF( LDA.LT.MAX( 1, NRA ) ) THEN
|
|
INFO = -5
|
|
ELSE IF( LDE.LT.MAX( 1, NRA ) ) THEN
|
|
INFO = -7
|
|
ELSE IF( LDVEPS.LT.MAX( 1, NCA ) ) THEN
|
|
INFO = -11
|
|
END IF
|
|
C
|
|
IF ( INFO.NE.0 ) THEN
|
|
C
|
|
C Error return.
|
|
C
|
|
CALL XERBLA( 'MC03NY', -INFO )
|
|
RETURN
|
|
END IF
|
|
C
|
|
C Quick return if possible.
|
|
C
|
|
IF ( NBLCKS.EQ.0 .OR. NRA.EQ.0 .OR. NCA.EQ.0 )
|
|
$ RETURN
|
|
C
|
|
C Computation of the nonzero parts of W1 and W2:
|
|
C
|
|
C | AH11 AH12 ... AH1n | | EH11 EH12 ... EH1n |
|
|
C | AH22 AH2n | | EH22 EH2n |
|
|
C W1 = | . . |, W2 = | . . |
|
|
C | . . | | . . |
|
|
C | AHnn | | EHnn |
|
|
C
|
|
C with AHij = -pinv(Aii) * Aij, EHij = pinv(Aii) * Eij and EHii = 0,
|
|
C AHij and EHij have dimensions mu(i)-by-mu(j), Aii = [ Oi | Ri ],
|
|
C and
|
|
C Ri is a regular nu(i)-by-nu(i) upper triangular matrix;
|
|
C Oi is a not necessarily square null matrix.
|
|
C Note that the first mu(i)-nu(i) rows in AHij and EHij are zero.
|
|
C For memory savings, the nonzero parts of W1 and W2 are constructed
|
|
C over A and E, respectively.
|
|
C
|
|
C (AR1,AC1) denotes the position of the first element of the
|
|
C submatrix Ri in matrix Aii.
|
|
C EC1 is the index of the first column of Ai,i+1/Ei,i+1.
|
|
C
|
|
EC1 = 1
|
|
AR1 = 1
|
|
C
|
|
DO 40 I = 1, NBLCKS - 1
|
|
NUI = INUK(I)
|
|
IF ( NUI.EQ.0 ) GO TO 60
|
|
MUI = IMUK(I)
|
|
EC1 = EC1 + MUI
|
|
AC1 = EC1 - NUI
|
|
CALL DTRTRS( 'Upper', 'No transpose', 'Non-unit', NUI,
|
|
$ NCA-EC1+1, A(AR1,AC1), LDA, E(AR1,EC1), LDE,
|
|
$ INFO )
|
|
IF ( INFO.GT.0 ) THEN
|
|
INFO = I
|
|
RETURN
|
|
END IF
|
|
C
|
|
DO 20 J = 1, NUI
|
|
CALL DSCAL( J, -ONE, A(AR1,AC1+J-1), 1 )
|
|
20 CONTINUE
|
|
C
|
|
CALL DTRTRS( 'Upper', 'No transpose', 'Non-unit', NUI,
|
|
$ NCA-EC1+1, A(AR1,AC1), LDA, A(AR1,EC1), LDA,
|
|
$ INFO )
|
|
AR1 = AR1 + NUI
|
|
40 CONTINUE
|
|
C
|
|
60 CONTINUE
|
|
C
|
|
C The contents of the array IMUK is changed for temporary use in
|
|
C this routine as follows:
|
|
C
|
|
C IMUK(i) = Sum(j=1,...,i) mu(j).
|
|
C
|
|
C On return, the original contents of IMUK is restored.
|
|
C In the same loop the actual number of columns of VEPS is computed.
|
|
C The number of rows of VEPS is NCA.
|
|
C
|
|
C NRV = Sum(i=1,...,NBLCKS) mu(i) = NCA,
|
|
C NCV = Sum(i=1,...,NBLCKS) i*(mu(i)-nu(i)).
|
|
C
|
|
SMUI = 0
|
|
NCV = 0
|
|
C
|
|
DO 80 I = 1, NBLCKS
|
|
MUI = IMUK(I)
|
|
SMUI = SMUI + MUI
|
|
IMUK(I) = SMUI
|
|
NCV = NCV + I*( MUI - INUK(I) )
|
|
80 CONTINUE
|
|
C
|
|
NRV = NCA
|
|
C
|
|
C Computation of the matrix VEPS.
|
|
C
|
|
C Initialisation of VEPS to zero.
|
|
C
|
|
CALL DLASET( 'Full', NRV, NCV, ZERO, ZERO, VEPS, LDVEPS )
|
|
C | I |
|
|
C Set Vii,0 = Kii in VEPS , i=1,...,NBLCKS, where Kii = |---|
|
|
C | O |
|
|
C and I is an identity matrix of size mu(i)-nu(i),
|
|
C O is a null matrix, dimensions nu(i)-by-(mu(i)-nu(i)).
|
|
C
|
|
C WR1 := Sum(j=1,...,i-1) mu(j) + 1
|
|
C is the index of the first row in Vii,0 in VEPS.
|
|
C WC1 := Sum(j=1,...,i-1) j*(mu(j)-nu(j)) + 1
|
|
C is the index of the first column in Vii,0 in VEPS.
|
|
C
|
|
DUMMY(1) = ONE
|
|
NUI = IMUK(1) - INUK(1)
|
|
CALL DCOPY( NUI, DUMMY, 0, VEPS, LDVEPS+1 )
|
|
WR1 = IMUK(1) + 1
|
|
WC1 = NUI + 1
|
|
C
|
|
DO 100 I = 2, NBLCKS
|
|
NUI = IMUK(I) - IMUK(I-1) - INUK(I)
|
|
CALL DCOPY( NUI, DUMMY, 0, VEPS(WR1,WC1), LDVEPS+1 )
|
|
WR1 = IMUK(I) + 1
|
|
WC1 = WC1 + I*NUI
|
|
100 CONTINUE
|
|
C
|
|
C Determination of the remaining nontrivial matrices in Vij,k
|
|
C block column by block column with decreasing block row index.
|
|
C
|
|
C The computation starts with the second block column since V11,0
|
|
C has already been determined.
|
|
C The coefficients Vij,k satisfy the recurrence relation:
|
|
C
|
|
C Vij,k = Sum(r=i+1,...,j-k) AHir*Vrj,k +
|
|
C + Sum(r=i+1,...,j-k+1) EHir*Vrj,k-1, i + k < j,
|
|
C
|
|
C = EHi,i+1 * Vi+1,j,k-1 i + k = j.
|
|
C
|
|
C This recurrence relation can be derived from [1], (4.6.8)
|
|
C and formula (1) in Section PURPOSE.
|
|
C
|
|
VC1 = IMUK(1) - INUK(1) + 1
|
|
ARI = 1
|
|
C
|
|
DO 180 J = 2, NBLCKS
|
|
DIF = IMUK(J) - IMUK(J-1) - INUK(J)
|
|
ARI = ARI + INUK(J-1)
|
|
ARK = ARI
|
|
C
|
|
C Computation of the matrices Vij,k where i + k < j.
|
|
C Each matrix Vij,k has dimension mu(i)-by-(mu(j) - nu(j)).
|
|
C
|
|
DO 160 K = 0, J - 2
|
|
C
|
|
C VC1, VC2 are the first and last column index of Vij,k.
|
|
C
|
|
VC2 = VC1 + DIF - 1
|
|
AC2 = IMUK(J-K)
|
|
AR1 = ARK
|
|
ARK = ARK - INUK(J-K-1)
|
|
C
|
|
DO 120 I = J - K - 1, 1, -1
|
|
C
|
|
C Compute the first part of Vij,k in decreasing order:
|
|
C Vij,k := Vij,k + Sum(r=i+1,..,j-k) AHir*Vrj,k.
|
|
C The non-zero parts of AHir are stored in
|
|
C A(AR1:AR1+nu(i)-1,AC1:AC2) and Vrj,k are stored in
|
|
C VEPS(AC1:AC2,VC1:VC2).
|
|
C The non-zero part of the result is stored in
|
|
C VEPS(VR1:VR2,VC1:VC2).
|
|
C
|
|
VR2 = IMUK(I)
|
|
AC1 = VR2 + 1
|
|
VR1 = AC1 - INUK(I)
|
|
AR1 = AR1 - INUK(I)
|
|
CALL DGEMM( 'No transpose', 'No transpose', INUK(I),
|
|
$ DIF, AC2-VR2, ONE, A(AR1,AC1), LDA,
|
|
$ VEPS(AC1,VC1), LDVEPS, ONE, VEPS(VR1,VC1),
|
|
$ LDVEPS )
|
|
120 CONTINUE
|
|
C
|
|
ER1 = 1
|
|
C
|
|
DO 140 I = 1, J - K - 1
|
|
C
|
|
C Compute the second part of Vij,k+1 in normal order:
|
|
C Vij,k+1 := Sum(r=i+1,..,j-k) EHir*Vrj,k.
|
|
C The non-zero parts of EHir are stored in
|
|
C E(ER1:ER1+nu(i)-1,EC1:AC2) and Vrj,k are stored in
|
|
C VEPS(EC1:AC2,VC1:VC2).
|
|
C The non-zero part of the result is stored in
|
|
C VEPS(VR1:VR2,VC2+1:VC2+DIF), where
|
|
C DIF = VC2 - VC1 + 1 = mu(j) - nu(j).
|
|
C This code portion also computes Vij,k+1 for i + k = j.
|
|
C
|
|
VR2 = IMUK(I)
|
|
EC1 = VR2 + 1
|
|
VR1 = EC1 - INUK(I)
|
|
CALL DGEMM( 'No transpose', 'No transpose', INUK(I),
|
|
$ DIF, AC2-VR2, ONE, E(ER1,EC1), LDE,
|
|
$ VEPS(EC1,VC1), LDVEPS, ZERO, VEPS(VR1,VC2+1),
|
|
$ LDVEPS )
|
|
ER1 = ER1 + INUK(I)
|
|
140 CONTINUE
|
|
C
|
|
VC1 = VC2 + 1
|
|
160 CONTINUE
|
|
C
|
|
VC1 = VC1 + DIF
|
|
180 CONTINUE
|
|
C
|
|
C Restore original contents of the array IMUK.
|
|
C
|
|
C Since, at the moment:
|
|
C IMUK(i) = Sum(j=1,...,i) mu(j), (i=1,...,NBLCKS),
|
|
C the original values are:
|
|
C mu(i) = IMUK(i) - IMUK(i-1) with IMUK(0 ) = 0.
|
|
C
|
|
SMUI1 = 0
|
|
C
|
|
DO 200 I = 1, NBLCKS
|
|
SMUI = IMUK(I)
|
|
IMUK(I) = SMUI - SMUI1
|
|
SMUI1 = SMUI
|
|
200 CONTINUE
|
|
C
|
|
RETURN
|
|
C *** Last line of MC03NY ***
|
|
END
|