296 lines
9.5 KiB
Fortran
296 lines
9.5 KiB
Fortran
SUBROUTINE TG01DD( COMPZ, L, N, P, A, LDA, E, LDE, C, LDC, Z, LDZ,
|
|
$ DWORK, LDWORK, 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 reduce the descriptor system pair (C,A-lambda E) to the
|
|
C RQ-coordinate form by computing an orthogonal transformation
|
|
C matrix Z such that the transformed descriptor system pair
|
|
C (C*Z,A*Z-lambda E*Z) has the descriptor matrix E*Z in an upper
|
|
C trapezoidal form.
|
|
C The right orthogonal transformations performed to reduce E can
|
|
C be optionally accumulated.
|
|
C
|
|
C ARGUMENTS
|
|
C
|
|
C Mode Parameters
|
|
C
|
|
C COMPZ CHARACTER*1
|
|
C = 'N': do not compute Z;
|
|
C = 'I': Z is initialized to the unit matrix, and the
|
|
C orthogonal matrix Z is returned;
|
|
C = 'U': Z must contain an orthogonal matrix Z1 on entry,
|
|
C and the product Z1*Z is returned.
|
|
C
|
|
C Input/Output Parameters
|
|
C
|
|
C L (input) INTEGER
|
|
C The number of rows of matrices A and E. L >= 0.
|
|
C
|
|
C N (input) INTEGER
|
|
C The number of columns of matrices A, E, and C. N >= 0.
|
|
C
|
|
C P (input) INTEGER
|
|
C The number of rows of matrix C. P >= 0.
|
|
C
|
|
C A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
|
|
C On entry, the leading L-by-N part of this array must
|
|
C contain the state dynamics matrix A.
|
|
C On exit, the leading L-by-N part of this array contains
|
|
C the transformed matrix A*Z.
|
|
C
|
|
C LDA INTEGER
|
|
C The leading dimension of array A. LDA >= MAX(1,L).
|
|
C
|
|
C E (input/output) DOUBLE PRECISION array, dimension (LDE,N)
|
|
C On entry, the leading L-by-N part of this array must
|
|
C contain the descriptor matrix E.
|
|
C On exit, the leading L-by-N part of this array contains
|
|
C the transformed matrix E*Z in upper trapezoidal form,
|
|
C i.e.
|
|
C
|
|
C ( E11 )
|
|
C E*Z = ( ) , if L >= N ,
|
|
C ( R )
|
|
C or
|
|
C
|
|
C E*Z = ( 0 R ), if L < N ,
|
|
C
|
|
C where R is an MIN(L,N)-by-MIN(L,N) upper triangular
|
|
C matrix.
|
|
C
|
|
C LDE INTEGER
|
|
C The leading dimension of array E. LDE >= MAX(1,L).
|
|
C
|
|
C C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
|
|
C On entry, the leading P-by-N part of this array must
|
|
C contain the state/output matrix C.
|
|
C On exit, the leading P-by-N part of this array contains
|
|
C the transformed matrix C*Z.
|
|
C
|
|
C LDC INTEGER
|
|
C The leading dimension of array C. LDC >= MAX(1,P).
|
|
C
|
|
C Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
|
|
C If COMPZ = 'N': Z is not referenced.
|
|
C If COMPZ = 'I': on entry, Z need not be set;
|
|
C on exit, the leading N-by-N part of this
|
|
C array contains the orthogonal matrix Z,
|
|
C which is the product of Householder
|
|
C transformations applied to A, E, and C
|
|
C on the right.
|
|
C If COMPZ = 'U': on entry, the leading N-by-N part of this
|
|
C array must contain an orthogonal matrix
|
|
C Z1;
|
|
C on exit, the leading N-by-N part of this
|
|
C array contains the orthogonal matrix
|
|
C Z1*Z.
|
|
C
|
|
C LDZ INTEGER
|
|
C The leading dimension of array Z.
|
|
C LDZ >= 1, if COMPZ = 'N';
|
|
C LDZ >= MAX(1,N), if COMPZ = 'U' or 'I'.
|
|
C
|
|
C Workspace
|
|
C
|
|
C DWORK DOUBLE PRECISION array, dimension (LDWORK)
|
|
C On exit, if INFO = 0, DWORK(1) returns the optimal value
|
|
C of LDWORK.
|
|
C
|
|
C LDWORK INTEGER
|
|
C The length of the array DWORK.
|
|
C LDWORK >= MAX(1, MIN(L,N) + MAX(L,N,P)).
|
|
C For optimum performance
|
|
C LWORK >= MAX(1, MIN(L,N) + MAX(L,N,P)*NB),
|
|
C where NB is the optimal blocksize.
|
|
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 routine computes the RQ factorization of E to reduce it
|
|
C the upper trapezoidal form.
|
|
C
|
|
C The transformations are also applied to the rest of system
|
|
C matrices
|
|
C
|
|
C A <- A * Z, C <- C * Z.
|
|
C
|
|
C NUMERICAL ASPECTS
|
|
C
|
|
C The algorithm is numerically backward stable and requires
|
|
C 0( L*N*N ) floating point operations.
|
|
C
|
|
C CONTRIBUTOR
|
|
C
|
|
C C. Oara, University "Politehnica" Bucharest.
|
|
C A. Varga, German Aerospace Center, DLR Oberpfaffenhofen.
|
|
C March 1999. Based on the RASP routine RPDSRQ.
|
|
C
|
|
C REVISIONS
|
|
C
|
|
C July 1999, V. Sima, Research Institute for Informatics, Bucharest.
|
|
C
|
|
C KEYWORDS
|
|
C
|
|
C Descriptor system, matrix algebra, matrix operations,
|
|
C orthogonal transformation.
|
|
C
|
|
C ******************************************************************
|
|
C
|
|
C .. Parameters ..
|
|
DOUBLE PRECISION ONE, ZERO
|
|
PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0 )
|
|
C .. Scalar Arguments ..
|
|
CHARACTER COMPZ
|
|
INTEGER INFO, L, LDA, LDC, LDE, LDWORK, LDZ, N, P
|
|
C .. Array Arguments ..
|
|
DOUBLE PRECISION A( LDA, * ), C( LDC, * ), DWORK( * ),
|
|
$ E( LDE, * ), Z( LDZ, * )
|
|
C .. Local Scalars ..
|
|
LOGICAL ILZ
|
|
INTEGER ICOMPZ, LN, WRKOPT
|
|
C .. External Functions ..
|
|
LOGICAL LSAME
|
|
EXTERNAL LSAME
|
|
C .. External Subroutines ..
|
|
EXTERNAL DGERQF, DLASET, DORMRQ, XERBLA
|
|
C .. Intrinsic Functions ..
|
|
INTRINSIC INT, MAX, MIN
|
|
C
|
|
C .. Executable Statements ..
|
|
C
|
|
C Decode COMPZ.
|
|
C
|
|
IF( LSAME( COMPZ, 'N' ) ) THEN
|
|
ILZ = .FALSE.
|
|
ICOMPZ = 1
|
|
ELSE IF( LSAME( COMPZ, 'U' ) ) THEN
|
|
ILZ = .TRUE.
|
|
ICOMPZ = 2
|
|
ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
|
|
ILZ = .TRUE.
|
|
ICOMPZ = 3
|
|
ELSE
|
|
ICOMPZ = 0
|
|
END IF
|
|
C
|
|
C Test the input parameters.
|
|
C
|
|
INFO = 0
|
|
WRKOPT = MAX( 1, MIN( L, N ) + MAX( L, N, P ) )
|
|
IF( ICOMPZ.EQ.0 ) THEN
|
|
INFO = -1
|
|
ELSE IF( L.LT.0 ) THEN
|
|
INFO = -2
|
|
ELSE IF( N.LT.0 ) THEN
|
|
INFO = -3
|
|
ELSE IF( P.LT.0 ) THEN
|
|
INFO = -4
|
|
ELSE IF( LDA.LT.MAX( 1, L ) ) THEN
|
|
INFO = -6
|
|
ELSE IF( LDE.LT.MAX( 1, L ) ) THEN
|
|
INFO = -8
|
|
ELSE IF( LDC.LT.MAX( 1, P ) ) THEN
|
|
INFO = -10
|
|
ELSE IF( ( ILZ .AND. LDZ.LT.N ) .OR. LDZ.LT.1 ) THEN
|
|
INFO = -12
|
|
ELSE IF( LDWORK.LT.WRKOPT ) THEN
|
|
INFO = -14
|
|
END IF
|
|
IF( INFO .NE. 0 ) THEN
|
|
CALL XERBLA( 'TG01DD', -INFO )
|
|
RETURN
|
|
END IF
|
|
C
|
|
C Initialize Q if necessary.
|
|
C
|
|
IF( ICOMPZ.EQ.3 )
|
|
$ CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDZ )
|
|
C
|
|
C Quick return if possible.
|
|
C
|
|
IF( L.EQ.0 .OR. N.EQ.0 ) THEN
|
|
DWORK( 1 ) = ONE
|
|
RETURN
|
|
END IF
|
|
C
|
|
LN = MIN( L, N )
|
|
C
|
|
C Compute the RQ decomposition of E, E = R*Z.
|
|
C
|
|
C Workspace: need MIN(L,N) + L;
|
|
C prefer MIN(L,N) + L*NB.
|
|
C
|
|
CALL DGERQF( L, N, E, LDE, DWORK, DWORK( LN+1 ), LDWORK-LN, INFO )
|
|
WRKOPT = MAX( WRKOPT, INT( DWORK( LN+1 ) ) + LN )
|
|
C
|
|
C Apply transformation on the rest of matrices.
|
|
C
|
|
C A <-- A * Z'.
|
|
C Workspace: need MIN(L,N) + L;
|
|
C prefer MIN(L,N) + L*NB.
|
|
C
|
|
CALL DORMRQ( 'Right', 'Transpose', L, N, LN, E( L-LN+1,1 ), LDE,
|
|
$ DWORK, A, LDA, DWORK( LN+1 ), LDWORK-LN, INFO )
|
|
WRKOPT = MAX( WRKOPT, INT( DWORK( LN+1 ) ) + LN )
|
|
C
|
|
C C <-- C * Z'.
|
|
C Workspace: need MIN(L,N) + P;
|
|
C prefer MIN(L,N) + P*NB.
|
|
C
|
|
CALL DORMRQ( 'Right', 'Transpose', P, N, LN, E( L-LN+1,1 ), LDE,
|
|
$ DWORK, C, LDC, DWORK( LN+1 ), LDWORK-LN, INFO )
|
|
WRKOPT = MAX( WRKOPT, INT( DWORK( LN+1 ) ) + LN )
|
|
C
|
|
C Z <-- Z1 * Z'.
|
|
C Workspace: need MIN(L,N) + N;
|
|
C prefer MIN(L,N) + N*NB.
|
|
C
|
|
IF( ILZ ) THEN
|
|
CALL DORMRQ( 'Right', 'Transpose', N, N, LN, E( L-LN+1,1 ),
|
|
$ LDE, DWORK, Z, LDZ, DWORK( LN+1 ), LDWORK-LN,
|
|
$ INFO )
|
|
WRKOPT = MAX( WRKOPT, INT( DWORK( LN+1 ) ) + LN )
|
|
END IF
|
|
C
|
|
C Set lower triangle of E to zero.
|
|
C
|
|
IF( L.LT.N ) THEN
|
|
CALL DLASET( 'Full', L, N-L, ZERO, ZERO, E, LDE )
|
|
IF( L.GE.2 ) CALL DLASET( 'Lower', L-1, L, ZERO, ZERO,
|
|
$ E( 2, N-L+1 ), LDE )
|
|
ELSE
|
|
IF( N.GE.2 ) CALL DLASET( 'Lower', N-1, N, ZERO, ZERO,
|
|
$ E( L-N+2, 1 ), LDE )
|
|
END IF
|
|
C
|
|
DWORK(1) = WRKOPT
|
|
C
|
|
RETURN
|
|
C *** Last line of TG01DD ***
|
|
END
|