260 lines
8.6 KiB
Fortran
260 lines
8.6 KiB
Fortran
SUBROUTINE TB01WD( N, M, P, A, LDA, B, LDB, C, LDC, U, LDU,
|
|
$ WR, WI, 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 system state matrix A to an upper real Schur form
|
|
C by using an orthogonal similarity transformation A <-- U'*A*U and
|
|
C to apply the transformation to the matrices B and C: B <-- U'*B
|
|
C and C <-- C*U.
|
|
C
|
|
C ARGUMENTS
|
|
C
|
|
C Input/Output Parameters
|
|
C
|
|
C N (input) INTEGER
|
|
C The order of the original state-space representation,
|
|
C i.e. the order of the matrix A. N >= 0.
|
|
C
|
|
C M (input) INTEGER
|
|
C The number of system inputs, or of columns of B. M >= 0.
|
|
C
|
|
C P (input) INTEGER
|
|
C The number of system outputs, or of rows of C. P >= 0.
|
|
C
|
|
C A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
|
|
C On entry, the leading N-by-N part of this array must
|
|
C contain the original state dynamics matrix A.
|
|
C On exit, the leading N-by-N part of this array contains
|
|
C the matrix U' * A * U in real Schur form. The elements
|
|
C below the first subdiagonal are set to zero.
|
|
C Note: A matrix is in real Schur form if it is upper
|
|
C quasi-triangular with 1-by-1 and 2-by-2 blocks.
|
|
C 2-by-2 blocks are standardized in the form
|
|
C [ a b ]
|
|
C [ c a ]
|
|
C where b*c < 0. The eigenvalues of such a block
|
|
C are a +- sqrt(bc).
|
|
C
|
|
C LDA INTEGER
|
|
C The leading dimension of array A. LDA >= MAX(1,N).
|
|
C
|
|
C B (input/output) DOUBLE PRECISION array, dimension (LDB,M)
|
|
C On entry, the leading N-by-M part of this array must
|
|
C contain the input matrix B.
|
|
C On exit, the leading N-by-M part of this array contains
|
|
C the transformed input matrix U' * B.
|
|
C
|
|
C LDB INTEGER
|
|
C The leading dimension of array B. LDB >= MAX(1,N).
|
|
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 output matrix C.
|
|
C On exit, the leading P-by-N part of this array contains
|
|
C the transformed output matrix C * U.
|
|
C
|
|
C LDC INTEGER
|
|
C The leading dimension of array C. LDC >= MAX(1,P).
|
|
C
|
|
C U (output) DOUBLE PRECISION array, dimension (LDU,N)
|
|
C The leading N-by-N part of this array contains the
|
|
C orthogonal transformation matrix used to reduce A to the
|
|
C real Schur form. The columns of U are the Schur vectors of
|
|
C matrix A.
|
|
C
|
|
C LDU INTEGER
|
|
C The leading dimension of array U. LDU >= max(1,N).
|
|
C
|
|
C WR, WI (output) DOUBLE PRECISION arrays, dimension (N)
|
|
C WR and WI contain the real and imaginary parts,
|
|
C respectively, of the computed eigenvalues of A. The
|
|
C eigenvalues will be in the same order that they appear on
|
|
C the diagonal of the output real Schur form of A. Complex
|
|
C conjugate pairs of eigenvalues will appear consecutively
|
|
C with the eigenvalue having the positive imaginary part
|
|
C first.
|
|
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 dimension of working array DWORK. LWORK >= 3*N.
|
|
C For optimum performance LDWORK should be larger.
|
|
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 = i, the QR algorithm failed to compute
|
|
C all the eigenvalues; elements i+1:N of WR and WI
|
|
C contain those eigenvalues which have converged;
|
|
C U contains the matrix which reduces A to its
|
|
C partially converged Schur form.
|
|
C
|
|
C METHOD
|
|
C
|
|
C Matrix A is reduced to a real Schur form using an orthogonal
|
|
C similarity transformation A <- U'*A*U. Then, the transformation
|
|
C is applied to the matrices B and C: B <-- U'*B and C <-- C*U.
|
|
C
|
|
C NUMERICAL ASPECTS
|
|
C 3
|
|
C The algorithm requires about 10N floating point operations.
|
|
C
|
|
C CONTRIBUTOR
|
|
C
|
|
C A. Varga, German Aerospace Center,
|
|
C DLR Oberpfaffenhofen, March 1998.
|
|
C Based on the RASP routine SRSFDC.
|
|
C
|
|
C REVISIONS
|
|
C
|
|
C -
|
|
C
|
|
C KEYWORDS
|
|
C
|
|
C Orthogonal transformation, real Schur form, similarity
|
|
C transformation.
|
|
C
|
|
C ******************************************************************
|
|
C
|
|
C .. Parameters ..
|
|
DOUBLE PRECISION ZERO, ONE
|
|
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
|
|
C .. Scalar Arguments ..
|
|
INTEGER INFO, LDA, LDB, LDC, LDU, LDWORK, M, N, P
|
|
C .. Array Arguments ..
|
|
DOUBLE PRECISION A(LDA,*), B(LDB,*), C(LDC,*), DWORK(*), U(LDU,*),
|
|
$ WI(*), WR(*)
|
|
C .. Local Scalars ..
|
|
INTEGER I, LDWP, SDIM
|
|
DOUBLE PRECISION WRKOPT
|
|
C .. Local Arrays ..
|
|
LOGICAL BWORK( 1 )
|
|
C .. External Functions ..
|
|
LOGICAL LSAME, SELECT
|
|
EXTERNAL LSAME, SELECT
|
|
C .. External Subroutines ..
|
|
EXTERNAL DCOPY, DGEES, DGEMM, DGEMV, DLACPY, XERBLA
|
|
C .. Intrinsic Functions ..
|
|
INTRINSIC DBLE, MAX
|
|
C
|
|
C .. Executable Statements ..
|
|
C
|
|
INFO = 0
|
|
C
|
|
C Check input parameters.
|
|
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( LDA.LT.MAX( 1, N ) ) THEN
|
|
INFO = -5
|
|
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
|
|
INFO = -7
|
|
ELSE IF( LDC.LT.MAX( 1, P ) ) THEN
|
|
INFO = -9
|
|
ELSE IF( LDU.LT.MAX( 1, N ) ) THEN
|
|
INFO = -11
|
|
ELSE IF( LDWORK.LT.3*N ) THEN
|
|
INFO = -15
|
|
END IF
|
|
C
|
|
IF( INFO.NE.0 ) THEN
|
|
C
|
|
C Error return.
|
|
C
|
|
CALL XERBLA( 'TB01WD', -INFO )
|
|
RETURN
|
|
END IF
|
|
C
|
|
C Quick return if possible.
|
|
C
|
|
IF( N.EQ.0 )
|
|
$ RETURN
|
|
C
|
|
C Reduce A to real Schur form using an orthogonal similarity
|
|
C transformation A <- U'*A*U, accumulate the transformation in U
|
|
C and compute the eigenvalues of A in (WR,WI).
|
|
C
|
|
C Workspace: need 3*N;
|
|
C prefer larger.
|
|
C
|
|
CALL DGEES( 'Vectors', 'Not ordered', SELECT, N, A, LDA, SDIM,
|
|
$ WR, WI, U, LDU, DWORK, LDWORK, BWORK, INFO )
|
|
WRKOPT = DWORK( 1 )
|
|
IF( INFO.NE.0 )
|
|
$ RETURN
|
|
C
|
|
C Apply the transformation: B <-- U'*B.
|
|
C
|
|
IF( LDWORK.LT.N*M ) THEN
|
|
C
|
|
C Not enough working space for using DGEMM.
|
|
C
|
|
DO 10 I = 1, M
|
|
CALL DCOPY( N, B(1,I), 1, DWORK, 1 )
|
|
CALL DGEMV( 'Transpose', N, N, ONE, U, LDU, DWORK, 1, ZERO,
|
|
$ B(1,I), 1 )
|
|
10 CONTINUE
|
|
C
|
|
ELSE
|
|
CALL DLACPY( 'Full', N, M, B, LDB, DWORK, N )
|
|
CALL DGEMM( 'Transpose', 'No transpose', N, M, N, ONE, U, LDU,
|
|
$ DWORK, N, ZERO, B, LDB )
|
|
WRKOPT = MAX( WRKOPT, DBLE( N*M ) )
|
|
END IF
|
|
C
|
|
C Apply the transformation: C <-- C*U.
|
|
C
|
|
IF( LDWORK.LT.N*P ) THEN
|
|
C
|
|
C Not enough working space for using DGEMM.
|
|
C
|
|
DO 20 I = 1, P
|
|
CALL DCOPY( N, C(I,1), LDC, DWORK, 1 )
|
|
CALL DGEMV( 'Transpose', N, N, ONE, U, LDU, DWORK, 1, ZERO,
|
|
$ C(I,1), LDC )
|
|
20 CONTINUE
|
|
C
|
|
ELSE
|
|
LDWP = MAX( 1, P )
|
|
CALL DLACPY( 'Full', P, N, C, LDC, DWORK, LDWP )
|
|
CALL DGEMM( 'No transpose', 'No transpose', P, N, N, ONE,
|
|
$ DWORK, LDWP, U, LDU, ZERO, C, LDC )
|
|
WRKOPT = MAX( WRKOPT, DBLE( N*P ) )
|
|
END IF
|
|
C
|
|
DWORK( 1 ) = WRKOPT
|
|
C
|
|
RETURN
|
|
C *** Last line of TB01WD ***
|
|
END
|