860 lines
32 KiB
Fortran
860 lines
32 KiB
Fortran
SUBROUTINE AB09IY( DICO, JOBC, JOBO, WEIGHT, N, M, P, NV, PV,
|
|
$ NW, MW, ALPHAC, ALPHAO, A, LDA, B, LDB, C, LDC,
|
|
$ AV, LDAV, BV, LDBV, CV, LDCV, DV, LDDV,
|
|
$ AW, LDAW, BW, LDBW, CW, LDCW, DW, LDDW,
|
|
$ SCALEC, SCALEO, S, LDS, R, LDR,
|
|
$ 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 compute for given state-space representations
|
|
C (A,B,C,0), (AV,BV,CV,DV), and (AW,BW,CW,DW) of the
|
|
C transfer-function matrices G, V and W, respectively,
|
|
C the Cholesky factors of the frequency-weighted
|
|
C controllability and observability Grammians corresponding
|
|
C to a frequency-weighted model reduction problem.
|
|
C G, V and W must be stable transfer-function matrices with
|
|
C the state matrices A, AV, and AW in real Schur form.
|
|
C It is assumed that the state space realizations (AV,BV,CV,DV)
|
|
C and (AW,BW,CW,DW) are minimal. In case of possible pole-zero
|
|
C cancellations in forming V*G and/or G*W, the parameters for the
|
|
C choice of frequency-weighted Grammians ALPHAO and/or ALPHAC,
|
|
C respectively, must be different from 1.
|
|
C
|
|
C ARGUMENTS
|
|
C
|
|
C Mode Parameters
|
|
C
|
|
C DICO CHARACTER*1
|
|
C Specifies the type of the systems as follows:
|
|
C = 'C': G, V and W are continuous-time systems;
|
|
C = 'D': G, V and W are discrete-time systems.
|
|
C
|
|
C JOBC CHARACTER*1
|
|
C Specifies the choice of frequency-weighted controllability
|
|
C Grammian as follows:
|
|
C = 'S': choice corresponding to a combination method [4]
|
|
C of the approaches of Enns [1] and Lin-Chiu [2,3];
|
|
C = 'E': choice corresponding to the stability enhanced
|
|
C modified combination method of [4].
|
|
C
|
|
C JOBO CHARACTER*1
|
|
C Specifies the choice of frequency-weighted observability
|
|
C Grammian as follows:
|
|
C = 'S': choice corresponding to a combination method [4]
|
|
C of the approaches of Enns [1] and Lin-Chiu [2,3];
|
|
C = 'E': choice corresponding to the stability enhanced
|
|
C modified combination method of [4].
|
|
C
|
|
C WEIGHT CHARACTER*1
|
|
C Specifies the type of frequency weighting, as follows:
|
|
C = 'N': no weightings are used (V = I, W = I);
|
|
C = 'L': only left weighting V is used (W = I);
|
|
C = 'R': only right weighting W is used (V = I);
|
|
C = 'B': both left and right weightings V and W are used.
|
|
C
|
|
C Input/Output Parameters
|
|
C
|
|
C N (input) INTEGER
|
|
C The order of the state-space representation of G, i.e.,
|
|
C the order of the matrix A. N >= 0.
|
|
C
|
|
C M (input) INTEGER
|
|
C The number of columns of the matrix B and
|
|
C the number of rows of the matrices CW and DW. M >= 0.
|
|
C M represents the dimension of the input vector of the
|
|
C system with the transfer-function matrix G and
|
|
C also the dimension of the output vector of the system
|
|
C with the transfer-function matrix W.
|
|
C
|
|
C P (input) INTEGER
|
|
C The number of rows of the matrix C and the
|
|
C number of columns of the matrices BV and DV. P >= 0.
|
|
C P represents the dimension of the output vector of the
|
|
C system with the transfer-function matrix G and
|
|
C also the dimension of the input vector of the system
|
|
C with the transfer-function matrix V.
|
|
C
|
|
C NV (input) INTEGER
|
|
C The order of the matrix AV. Also the number of rows of
|
|
C the matrix BV and the number of columns of the matrix CV.
|
|
C NV represents the dimension of the state vector of the
|
|
C system with the transfer-function matrix V. NV >= 0.
|
|
C
|
|
C PV (input) INTEGER
|
|
C The number of rows of the matrices CV and DV. PV >= 0.
|
|
C PV represents the dimension of the output vector of the
|
|
C system with the transfer-function matrix V.
|
|
C
|
|
C NW (input) INTEGER
|
|
C The order of the matrix AW. Also the number of rows of
|
|
C the matrix BW and the number of columns of the matrix CW.
|
|
C NW represents the dimension of the state vector of the
|
|
C system with the transfer-function matrix W. NW >= 0.
|
|
C
|
|
C MW (input) INTEGER
|
|
C The number of columns of the matrices BW and DW. MW >= 0.
|
|
C MW represents the dimension of the input vector of the
|
|
C system with the transfer-function matrix W.
|
|
C
|
|
C ALPHAC (input) DOUBLE PRECISION
|
|
C Combination method parameter for defining the
|
|
C frequency-weighted controllability Grammian (see METHOD);
|
|
C ABS(ALPHAC) <= 1.
|
|
C
|
|
C ALPHAO (input) DOUBLE PRECISION
|
|
C Combination method parameter for defining the
|
|
C frequency-weighted observability Grammian (see METHOD);
|
|
C ABS(ALPHAO) <= 1.
|
|
C
|
|
C A (input) DOUBLE PRECISION array, dimension (LDA,N)
|
|
C The leading N-by-N part of this array must
|
|
C contain the state matrix A (of the system with the
|
|
C transfer-function matrix G) in a real Schur form.
|
|
C
|
|
C LDA INTEGER
|
|
C The leading dimension of array A. LDA >= MAX(1,N).
|
|
C
|
|
C B (input) DOUBLE PRECISION array, dimension (LDB,M)
|
|
C The leading N-by-M part of this array must contain the
|
|
C input/state matrix B.
|
|
C
|
|
C LDB INTEGER
|
|
C The leading dimension of array B. LDB >= MAX(1,N).
|
|
C
|
|
C C (input) DOUBLE PRECISION array, dimension (LDC,N)
|
|
C The leading P-by-N part of this array must contain the
|
|
C state/output matrix C.
|
|
C
|
|
C LDC INTEGER
|
|
C The leading dimension of array C. LDC >= MAX(1,P).
|
|
C
|
|
C AV (input) DOUBLE PRECISION array, dimension (LDAV,NV)
|
|
C If WEIGHT = 'L' or 'B', the leading NV-by-NV part of this
|
|
C array must contain the state matrix AV (of the system with
|
|
C the transfer-function matrix V) in a real Schur form.
|
|
C AV is not referenced if WEIGHT = 'R' or 'N'.
|
|
C
|
|
C LDAV INTEGER
|
|
C The leading dimension of array AV.
|
|
C LDAV >= MAX(1,NV), if WEIGHT = 'L' or 'B';
|
|
C LDAV >= 1, if WEIGHT = 'R' or 'N'.
|
|
C
|
|
C BV (input) DOUBLE PRECISION array, dimension (LDBV,P)
|
|
C If WEIGHT = 'L' or 'B', the leading NV-by-P part of this
|
|
C array must contain the input matrix BV of the system with
|
|
C the transfer-function matrix V.
|
|
C BV is not referenced if WEIGHT = 'R' or 'N'.
|
|
C
|
|
C LDBV INTEGER
|
|
C The leading dimension of array BV.
|
|
C LDBV >= MAX(1,NV), if WEIGHT = 'L' or 'B';
|
|
C LDBV >= 1, if WEIGHT = 'R' or 'N'.
|
|
C
|
|
C CV (input) DOUBLE PRECISION array, dimension (LDCV,NV)
|
|
C If WEIGHT = 'L' or 'B', the leading PV-by-NV part of this
|
|
C array must contain the output matrix CV of the system with
|
|
C the transfer-function matrix V.
|
|
C CV is not referenced if WEIGHT = 'R' or 'N'.
|
|
C
|
|
C LDCV INTEGER
|
|
C The leading dimension of array CV.
|
|
C LDCV >= MAX(1,PV), if WEIGHT = 'L' or 'B';
|
|
C LDCV >= 1, if WEIGHT = 'R' or 'N'.
|
|
C
|
|
C DV (input) DOUBLE PRECISION array, dimension (LDDV,P)
|
|
C If WEIGHT = 'L' or 'B', the leading PV-by-P part of this
|
|
C array must contain the feedthrough matrix DV of the system
|
|
C with the transfer-function matrix V.
|
|
C DV is not referenced if WEIGHT = 'R' or 'N'.
|
|
C
|
|
C LDDV INTEGER
|
|
C The leading dimension of array DV.
|
|
C LDDV >= MAX(1,PV), if WEIGHT = 'L' or 'B';
|
|
C LDDV >= 1, if WEIGHT = 'R' or 'N'.
|
|
C
|
|
C AW (input) DOUBLE PRECISION array, dimension (LDAW,NW)
|
|
C If WEIGHT = 'R' or 'B', the leading NW-by-NW part of this
|
|
C array must contain the state matrix AW (of the system with
|
|
C the transfer-function matrix W) in a real Schur form.
|
|
C AW is not referenced if WEIGHT = 'L' or 'N'.
|
|
C
|
|
C LDAW INTEGER
|
|
C The leading dimension of array AW.
|
|
C LDAW >= MAX(1,NW), if WEIGHT = 'R' or 'B';
|
|
C LDAW >= 1, if WEIGHT = 'L' or 'N'.
|
|
C
|
|
C BW (input) DOUBLE PRECISION array, dimension (LDBW,MW)
|
|
C If WEIGHT = 'R' or 'B', the leading NW-by-MW part of this
|
|
C array must contain the input matrix BW of the system with
|
|
C the transfer-function matrix W.
|
|
C BW is not referenced if WEIGHT = 'L' or 'N'.
|
|
C
|
|
C LDBW INTEGER
|
|
C The leading dimension of array BW.
|
|
C LDBW >= MAX(1,NW), if WEIGHT = 'R' or 'B';
|
|
C LDBW >= 1, if WEIGHT = 'L' or 'N'.
|
|
C
|
|
C CW (input) DOUBLE PRECISION array, dimension (LDCW,NW)
|
|
C If WEIGHT = 'R' or 'B', the leading M-by-NW part of this
|
|
C array must contain the output matrix CW of the system with
|
|
C the transfer-function matrix W.
|
|
C CW is not referenced if WEIGHT = 'L' or 'N'.
|
|
C
|
|
C LDCW INTEGER
|
|
C The leading dimension of array CW.
|
|
C LDCW >= MAX(1,M), if WEIGHT = 'R' or 'B';
|
|
C LDCW >= 1, if WEIGHT = 'L' or 'N'.
|
|
C
|
|
C DW (input) DOUBLE PRECISION array, dimension (LDDW,MW)
|
|
C If WEIGHT = 'R' or 'B', the leading M-by-MW part of this
|
|
C array must contain the feedthrough matrix DW of the system
|
|
C with the transfer-function matrix W.
|
|
C DW is not referenced if WEIGHT = 'L' or 'N'.
|
|
C
|
|
C LDDW INTEGER
|
|
C The leading dimension of array DW.
|
|
C LDDW >= MAX(1,M), if WEIGHT = 'R' or 'B';
|
|
C LDDW >= 1, if WEIGHT = 'L' or 'N'.
|
|
C
|
|
C SCALEC (output) DOUBLE PRECISION
|
|
C Scaling factor for the controllability Grammian in (1)
|
|
C or (3). See METHOD.
|
|
C
|
|
C SCALEO (output) DOUBLE PRECISION
|
|
C Scaling factor for the observability Grammian in (2)
|
|
C or (4). See METHOD.
|
|
C
|
|
C S (output) DOUBLE PRECISION array, dimension (LDS,N)
|
|
C The leading N-by-N upper triangular part of this array
|
|
C contains the Cholesky factor S of the frequency-weighted
|
|
C cotrollability Grammian P = S*S'. See METHOD.
|
|
C
|
|
C LDS INTEGER
|
|
C The leading dimension of array S. LDS >= MAX(1,N).
|
|
C
|
|
C R (output) DOUBLE PRECISION array, dimension (LDR,N)
|
|
C The leading N-by-N upper triangular part of this array
|
|
C contains the Cholesky factor R of the frequency-weighted
|
|
C observability Grammian Q = R'*R. See METHOD.
|
|
C
|
|
C LDR INTEGER
|
|
C The leading dimension of array R. LDR >= MAX(1,N).
|
|
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, LLEFT, LRIGHT ),
|
|
C where
|
|
C LLEFT = (N+NV)*(N+NV+MAX(N+NV,PV)+5)
|
|
C if WEIGHT = 'L' or 'B' and PV > 0;
|
|
C LLEFT = N*(P+5) if WEIGHT = 'R' or 'N' or PV = 0;
|
|
C LRIGHT = (N+NW)*(N+NW+MAX(N+NW,MW)+5)
|
|
C if WEIGHT = 'R' or 'B' and MW > 0;
|
|
C LRIGHT = N*(M+5) if WEIGHT = 'L' or 'N' or MW = 0.
|
|
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 = 1: if the state matrices A and/or AV are not stable or
|
|
C not in a real Schur form;
|
|
C = 2: if the state matrices A and/or AW are not stable or
|
|
C not in a real Schur form;
|
|
C = 3: eigenvalues computation failure.
|
|
C
|
|
C METHOD
|
|
C
|
|
C Let Pi = Si*Si' and Qo = Ro'*Ro be the Cholesky factored
|
|
C controllability and observability Grammians satisfying
|
|
C in the continuous-time case
|
|
C
|
|
C Ai*Pi + Pi*Ai' + scalec^2*Bi*Bi' = 0, (1)
|
|
C
|
|
C Ao'*Qo + Qo*Ao + scaleo^2*Co'*Co = 0, (2)
|
|
C
|
|
C and in the discrete-time case
|
|
C
|
|
C Ai*Pi*Ai' - Pi + scalec^2*Bi*Bi' = 0, (3)
|
|
C
|
|
C Ao'*Qo*Ao - Qo + scaleo^2*Co'*Co = 0, (4)
|
|
C
|
|
C where
|
|
C
|
|
C Ai = ( A B*Cw ) , Bi = ( B*Dw ) ,
|
|
C ( 0 Aw ) ( Bw )
|
|
C
|
|
C Ao = ( A 0 ) , Co = ( Dv*C Cv ) .
|
|
C ( Bv*C Av )
|
|
C
|
|
C Consider the partitioned Grammians
|
|
C
|
|
C Pi = ( P11 P12 ) and Qo = ( Q11 Q12 ) ,
|
|
C ( P12' P22 ) ( Q12' Q22 )
|
|
C
|
|
C where P11 and Q11 are the leading N-by-N parts of Pi and Qo,
|
|
C respectively, and let P0 and Q0 be non-negative definite matrices
|
|
C defined in the combination method [4]
|
|
C -1
|
|
C P0 = P11 - ALPHAC**2*P12*P22 *P21 ,
|
|
C -1
|
|
C Q0 = Q11 - ALPHAO**2*Q12*Q22 *Q21.
|
|
C
|
|
C The frequency-weighted controllability and observability
|
|
C Grammians, P and Q, respectively, are defined as follows:
|
|
C P = P0 if JOBC = 'S' (standard combination method [4]);
|
|
C P = P1 >= P0 if JOBC = 'E', where P1 is the controllability
|
|
C Grammian defined to enforce stability for a modified combination
|
|
C method of [4];
|
|
C Q = Q0 if JOBO = 'S' (standard combination method [4]);
|
|
C Q = Q1 >= Q0 if JOBO = 'E', where Q1 is the observability
|
|
C Grammian defined to enforce stability for a modified combination
|
|
C method of [4].
|
|
C
|
|
C If JOBC = JOBO = 'S' and ALPHAC = ALPHAO = 0, the choice of
|
|
C Grammians corresponds to the method of Enns [1], while if
|
|
C ALPHAC = ALPHAO = 1, the choice of Grammians corresponds to the
|
|
C method of Lin and Chiu [2,3].
|
|
C
|
|
C The routine computes directly the Cholesky factors S and R
|
|
C such that P = S*S' and Q = R'*R according to formulas
|
|
C developed in [4]. No matrix inversions are involved.
|
|
C
|
|
C REFERENCES
|
|
C
|
|
C [1] Enns, D.
|
|
C Model reduction with balanced realizations: An error bound
|
|
C and a frequency weighted generalization.
|
|
C Proc. CDC, Las Vegas, pp. 127-132, 1984.
|
|
C
|
|
C [2] Lin, C.-A. and Chiu, T.-Y.
|
|
C Model reduction via frequency-weighted balanced realization.
|
|
C Control Theory and Advanced Technology, vol. 8,
|
|
C pp. 341-351, 1992.
|
|
C
|
|
C [3] Sreeram, V., Anderson, B.D.O and Madievski, A.G.
|
|
C New results on frequency weighted balanced reduction
|
|
C technique.
|
|
C Proc. ACC, Seattle, Washington, pp. 4004-4009, 1995.
|
|
C
|
|
C [4] Varga, A. and Anderson, B.D.O.
|
|
C Square-root balancing-free methods for the frequency-weighted
|
|
C balancing related model reduction.
|
|
C (report in preparation)
|
|
C
|
|
C CONTRIBUTORS
|
|
C
|
|
C A. Varga, German Aerospace Center, Oberpfaffenhofen, August 2000.
|
|
C D. Sima, University of Bucharest, August 2000.
|
|
C V. Sima, Research Institute for Informatics, Bucharest, Aug. 2000.
|
|
C
|
|
C REVISIONS
|
|
C
|
|
C A. Varga, Australian National University, Canberra, November 2000.
|
|
C V. Sima, Research Institute for Informatics, Bucharest, Dec. 2000.
|
|
C A. Varga, German Aerospace Center, Oberpfaffenhofen, August 2001.
|
|
C
|
|
C KEYWORDS
|
|
C
|
|
C Frequency weighting, model reduction, multivariable system,
|
|
C state-space model, state-space representation.
|
|
C
|
|
C ******************************************************************
|
|
C
|
|
C .. Parameters ..
|
|
DOUBLE PRECISION ZERO, ONE
|
|
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
|
|
C .. Scalar Arguments ..
|
|
CHARACTER DICO, JOBC, JOBO, WEIGHT
|
|
INTEGER INFO, LDA, LDAV, LDAW, LDB, LDBV, LDBW,
|
|
$ LDC, LDCV, LDCW, LDDV, LDDW, LDR, LDS, LDWORK,
|
|
$ M, MW, N, NV, NW, P, PV
|
|
DOUBLE PRECISION ALPHAC, ALPHAO, SCALEC, SCALEO
|
|
C .. Array Arguments ..
|
|
DOUBLE PRECISION A(LDA,*), AV(LDAV,*), AW(LDAW,*),
|
|
$ B(LDB,*), BV(LDBV,*), BW(LDBW,*),
|
|
$ C(LDC,*), CV(LDCV,*), CW(LDCW,*),
|
|
$ DV(LDDV,*), DW(LDDW,*),
|
|
$ DWORK(*), R(LDR,*), S(LDS,*)
|
|
C .. Local Scalars ..
|
|
LOGICAL DISCR, FRWGHT, LEFTW, RIGHTW
|
|
INTEGER I, IERR, J, KAW, KTAU, KU, KW, LDU, LW, MBBAR,
|
|
$ NNV, NNW, PCBAR
|
|
DOUBLE PRECISION T, TOL, WORK
|
|
C .. Local Arrays ..
|
|
DOUBLE PRECISION DUM(1)
|
|
C .. External Functions ..
|
|
LOGICAL LSAME
|
|
DOUBLE PRECISION DLAMCH
|
|
EXTERNAL DLAMCH, LSAME
|
|
C .. External Subroutines ..
|
|
EXTERNAL DCOPY, DGEMM, DLACPY, DLASET, DSCAL, DSYEV,
|
|
$ MB01WD, MB04ND, MB04OD, SB03OU, XERBLA
|
|
C .. Intrinsic Functions ..
|
|
INTRINSIC ABS, DBLE, MAX, MIN, SQRT
|
|
C .. Executable Statements ..
|
|
C
|
|
DISCR = LSAME( DICO, 'D' )
|
|
LEFTW = LSAME( WEIGHT, 'L' ) .OR. LSAME( WEIGHT, 'B' )
|
|
RIGHTW = LSAME( WEIGHT, 'R' ) .OR. LSAME( WEIGHT, 'B' )
|
|
FRWGHT = LEFTW .OR. RIGHTW
|
|
C
|
|
INFO = 0
|
|
LW = 1
|
|
NNV = N + NV
|
|
NNW = N + NW
|
|
IF( LEFTW .AND. PV.GT.0 ) THEN
|
|
LW = MAX( LW, NNV*( NNV + MAX( NNV, PV ) + 5 ) )
|
|
ELSE
|
|
LW = MAX( LW, N*( P + 5 ) )
|
|
END IF
|
|
IF( RIGHTW .AND. MW.GT.0 ) THEN
|
|
LW = MAX( LW, NNW*( NNW + MAX( NNW, MW ) + 5 ) )
|
|
ELSE
|
|
LW = MAX( LW, N*( M + 5 ) )
|
|
END IF
|
|
C
|
|
IF( .NOT. ( LSAME( DICO, 'C' ) .OR. DISCR ) ) THEN
|
|
INFO = -1
|
|
ELSE IF( .NOT.( LSAME( JOBC, 'S' ) .OR. LSAME( JOBC, 'E' ) ) )
|
|
$ THEN
|
|
INFO = -2
|
|
ELSE IF( .NOT.( LSAME( JOBO, 'S' ) .OR. LSAME( JOBO, 'E' ) ) )
|
|
$ THEN
|
|
INFO = -3
|
|
ELSE IF( .NOT.( FRWGHT .OR. LSAME( WEIGHT, 'N' ) ) ) THEN
|
|
INFO = -4
|
|
ELSE IF( N.LT.0 ) THEN
|
|
INFO = -5
|
|
ELSE IF( M.LT.0 ) THEN
|
|
INFO = -6
|
|
ELSE IF( P.LT.0 ) THEN
|
|
INFO = -7
|
|
ELSE IF( NV.LT.0 ) THEN
|
|
INFO = -8
|
|
ELSE IF( PV.LT.0 ) THEN
|
|
INFO = -9
|
|
ELSE IF( NW.LT.0 ) THEN
|
|
INFO = -10
|
|
ELSE IF( MW.LT.0 ) THEN
|
|
INFO = -11
|
|
ELSE IF( ABS( ALPHAC ).GT.ONE ) THEN
|
|
INFO = -12
|
|
ELSE IF( ABS( ALPHAO ).GT.ONE ) THEN
|
|
INFO = -13
|
|
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
|
|
INFO = -15
|
|
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
|
|
INFO = -17
|
|
ELSE IF( LDC.LT.MAX( 1, P ) ) THEN
|
|
INFO = -19
|
|
ELSE IF( LDAV.LT.1 .OR. ( LEFTW .AND. LDAV.LT.NV ) ) THEN
|
|
INFO = -21
|
|
ELSE IF( LDBV.LT.1 .OR. ( LEFTW .AND. LDBV.LT.NV ) ) THEN
|
|
INFO = -23
|
|
ELSE IF( LDCV.LT.1 .OR. ( LEFTW .AND. LDCV.LT.PV ) ) THEN
|
|
INFO = -25
|
|
ELSE IF( LDDV.LT.1 .OR. ( LEFTW .AND. LDDV.LT.PV ) ) THEN
|
|
INFO = -27
|
|
ELSE IF( LDAW.LT.1 .OR. ( RIGHTW .AND. LDAW.LT.NW ) ) THEN
|
|
INFO = -29
|
|
ELSE IF( LDBW.LT.1 .OR. ( RIGHTW .AND. LDBW.LT.NW ) ) THEN
|
|
INFO = -31
|
|
ELSE IF( LDCW.LT.1 .OR. ( RIGHTW .AND. LDCW.LT.M ) ) THEN
|
|
INFO = -33
|
|
ELSE IF( LDDW.LT.1 .OR. ( RIGHTW .AND. LDDW.LT.M ) ) THEN
|
|
INFO = -35
|
|
ELSE IF( LDS.LT.MAX( 1, N ) ) THEN
|
|
INFO = -39
|
|
ELSE IF( LDR.LT.MAX( 1, N ) ) THEN
|
|
INFO = -41
|
|
ELSE IF( LDWORK.LT.LW ) THEN
|
|
INFO = -43
|
|
END IF
|
|
C
|
|
IF( INFO.NE.0 ) THEN
|
|
C
|
|
C Error return.
|
|
C
|
|
CALL XERBLA( 'AB09IY', -INFO )
|
|
RETURN
|
|
END IF
|
|
C
|
|
C Quick return if possible.
|
|
C
|
|
SCALEC = ONE
|
|
SCALEO = ONE
|
|
IF( MIN( N, M, P ).EQ.0 ) THEN
|
|
DWORK(1) = ONE
|
|
RETURN
|
|
END IF
|
|
C
|
|
WORK = 1
|
|
IF( LEFTW .AND. PV.GT.0 ) THEN
|
|
C
|
|
C Build the extended permuted matrices
|
|
C
|
|
C Ao = ( Av Bv*C ) , Co = ( Cv Dv*C ) .
|
|
C ( 0 A )
|
|
C
|
|
KAW = 1
|
|
KU = KAW + NNV*NNV
|
|
LDU = MAX( NNV, PV )
|
|
CALL DLACPY( 'Full', NV, NV, AV, LDAV, DWORK(KAW), NNV )
|
|
CALL DLASET( 'Full', N, NV, ZERO, ZERO, DWORK(KAW+NV), NNV )
|
|
CALL DGEMM( 'No-transpose', 'No-transpose', NV, N, P, ONE,
|
|
$ BV, LDBV, C, LDC, ZERO, DWORK(KAW+NNV*NV), NNV )
|
|
CALL DLACPY( 'Full', N, N, A, LDA, DWORK(KAW+NNV*NV+NV), NNV )
|
|
C
|
|
CALL DLACPY( 'Full', PV, NV, CV, LDCV, DWORK(KU), LDU )
|
|
CALL DGEMM( 'No-transpose', 'No-transpose', PV, N, P, ONE,
|
|
$ DV, LDDV, C, LDC, ZERO, DWORK(KU+LDU*NV), LDU )
|
|
C
|
|
C Solve for the Cholesky factor Ro of Qo, Qo = Ro'*Ro,
|
|
C the continuous-time Lyapunov equation (if DICO = 'C')
|
|
C
|
|
C Ao'*Qo + Qo*Ao + scaleo^2*Co'*Co = 0,
|
|
C
|
|
C or the discrete-time Lyapunov equation (if DICO = 'D')
|
|
C
|
|
C Ao'*Qo*Ao - Qo + scaleo^2*Co'*Co = 0.
|
|
C
|
|
C Workspace: need (N+NV)*(N+NV+MAX(N+NV,PV)+5);
|
|
C prefer larger.
|
|
C
|
|
KTAU = KU + LDU*NNV
|
|
KW = KTAU + NNV
|
|
C
|
|
CALL SB03OU( DISCR, .FALSE., NNV, PV, DWORK(KAW), NNV,
|
|
$ DWORK(KU), LDU, DWORK(KTAU), DWORK(KU), LDU,
|
|
$ SCALEO, DWORK(KW), LDWORK-KW+1, IERR )
|
|
C
|
|
IF( IERR.NE.0 ) THEN
|
|
INFO = 1
|
|
RETURN
|
|
END IF
|
|
WORK = MAX( WORK, DWORK(KW) + DBLE( KW - 1 ) )
|
|
C
|
|
C Partition Ro as Ro = ( R11 R12 ) and compute R such that
|
|
C ( 0 R22 )
|
|
C
|
|
C R'*R = R22'*R22 + (1-ALPHAO**2)*R12'*R12.
|
|
C
|
|
KW = KU + LDU*NV + NV
|
|
CALL DLACPY( 'Upper', N, N, DWORK(KW), LDU, R, LDR )
|
|
IF( ALPHAO.NE.ZERO ) THEN
|
|
T = SQRT( ONE - ALPHAO*ALPHAO )
|
|
DO 10 J = KU + LDU*NV, KU + LDU*(NNV-1), LDU
|
|
CALL DSCAL( NV, T, DWORK(J), 1 )
|
|
10 CONTINUE
|
|
END IF
|
|
IF( ALPHAO.LT.ONE .AND. NV.GT.0 ) THEN
|
|
KTAU = 1
|
|
CALL MB04OD( 'Full', N, 0, NV, R, LDR, DWORK(KU+LDU*NV),
|
|
$ LDU, DUM, 1, DUM, 1, DWORK(KTAU), DWORK(KW) )
|
|
C
|
|
DO 30 J = 1, N
|
|
DWORK(J) = R(J,J)
|
|
DO 20 I = 1, J
|
|
IF ( DWORK(I).LT.ZERO ) R(I,J) = -R(I,J)
|
|
20 CONTINUE
|
|
30 CONTINUE
|
|
C
|
|
END IF
|
|
C
|
|
IF( LSAME( JOBO, 'E' ) .AND. ALPHAO.LT.ONE ) THEN
|
|
C
|
|
C Form Y = -A'*(R'*R)-(R'*R)*A if DICO = 'C', or
|
|
C Y = -A'*(R'*R)*A+(R'*R) if DICO = 'D'.
|
|
C
|
|
CALL DLACPY( 'Upper', N, N, R, LDR, DWORK(KU), N )
|
|
CALL MB01WD( DICO, 'Upper', 'No-transpose', 'Hessenberg', N,
|
|
$ -ONE, ZERO, R, LDR, DWORK(KAW+NNV*NV+NV), NNV,
|
|
$ DWORK(KU), N, IERR )
|
|
C
|
|
C Compute the eigendecomposition of Y as Y = Z*Sigma*Z'.
|
|
C
|
|
KU = N + 1
|
|
CALL DSYEV( 'Vectors', 'Upper', N, R, LDR, DWORK, DWORK(KU),
|
|
$ LDWORK-N, IERR )
|
|
IF( IERR.GT.0 ) THEN
|
|
INFO = 3
|
|
RETURN
|
|
END IF
|
|
WORK = MAX( WORK, DWORK(KU) + DBLE( N ) )
|
|
C
|
|
C Partition Sigma = (Sigma1,Sigma2), such that
|
|
C Sigma1 <= 0, Sigma2 > 0.
|
|
C Partition correspondingly Z = [Z1 Z2].
|
|
C
|
|
TOL = MAX( ABS( DWORK(1) ), ABS( DWORK(N) ) )
|
|
$ * DLAMCH( 'Epsilon')
|
|
C _
|
|
C Form C = [ sqrt(Sigma2)*Z2' ]
|
|
C
|
|
PCBAR = 0
|
|
DO 40 J = 1, N
|
|
IF( DWORK(J).GT.TOL ) THEN
|
|
CALL DSCAL( N, SQRT( DWORK(J) ), R(1,J), 1 )
|
|
CALL DCOPY( N, R(1,J), 1, DWORK(KU+PCBAR), N )
|
|
PCBAR = PCBAR + 1
|
|
END IF
|
|
40 CONTINUE
|
|
C
|
|
C Solve for the Cholesky factor R of Q, Q = R'*R,
|
|
C the continuous-time Lyapunov equation (if DICO = 'C')
|
|
C _ _
|
|
C A'*Q + Q*A + t^2*C'*C = 0,
|
|
C
|
|
C or the discrete-time Lyapunov equation (if DICO = 'D')
|
|
C _ _
|
|
C A'*Q*A - Q + t^2*C'*C = 0.
|
|
C
|
|
C Workspace: need N*(N + 6);
|
|
C prefer larger.
|
|
C
|
|
KTAU = KU + N*N
|
|
KW = KTAU + N
|
|
C
|
|
CALL SB03OU( DISCR, .FALSE., N, PCBAR, A, LDA, DWORK(KU), N,
|
|
$ DWORK(KTAU), R, LDR, T, DWORK(KW), LDWORK-KW+1,
|
|
$ IERR )
|
|
IF( IERR.NE.0 ) THEN
|
|
INFO = 1
|
|
RETURN
|
|
END IF
|
|
SCALEO = SCALEO*T
|
|
WORK = MAX( WORK, DWORK(KW) + DBLE( KW - 1 ) )
|
|
END IF
|
|
C
|
|
ELSE
|
|
C
|
|
C Solve for the Cholesky factor R of Q, Q = R'*R,
|
|
C the continuous-time Lyapunov equation (if DICO = 'C')
|
|
C
|
|
C A'*Q + Q*A + scaleo^2*C'*C = 0,
|
|
C
|
|
C or the discrete-time Lyapunov equation (if DICO = 'D')
|
|
C
|
|
C A'*Q*A - Q + scaleo^2*C'*C = 0.
|
|
C
|
|
C Workspace: need N*(P + 5);
|
|
C prefer larger.
|
|
C
|
|
KU = 1
|
|
KTAU = KU + P*N
|
|
KW = KTAU + N
|
|
C
|
|
CALL DLACPY( 'Full', P, N, C, LDC, DWORK(KU), P )
|
|
CALL SB03OU( DISCR, .FALSE., N, P, A, LDA, DWORK(KU), P,
|
|
$ DWORK(KTAU), R, LDR, SCALEO, DWORK(KW),
|
|
$ LDWORK-KW+1, IERR )
|
|
IF( IERR.NE.0 ) THEN
|
|
INFO = 1
|
|
RETURN
|
|
END IF
|
|
WORK = MAX( WORK, DWORK(KW) + DBLE( KW - 1 ) )
|
|
END IF
|
|
C
|
|
IF( RIGHTW .AND. MW.GT.0 ) THEN
|
|
C
|
|
C Build the extended matrices
|
|
C
|
|
C Ai = ( A B*Cw ) , Bi = ( B*Dw ) .
|
|
C ( 0 Aw ) ( Bw )
|
|
C
|
|
KAW = 1
|
|
KU = KAW + NNW*NNW
|
|
CALL DLACPY( 'Full', N, N, A, LDA, DWORK(KAW), NNW )
|
|
CALL DLASET( 'Full', NW, N, ZERO, ZERO, DWORK(KAW+N), NNW )
|
|
CALL DGEMM( 'No-transpose', 'No-transpose', N, NW, M, ONE,
|
|
$ B, LDB, CW, LDCW, ZERO, DWORK(KAW+NNW*N), NNW )
|
|
CALL DLACPY( 'Full', NW, NW, AW, LDAW,
|
|
$ DWORK(KAW+NNW*N+N), NNW )
|
|
C
|
|
CALL DGEMM( 'No-transpose', 'No-transpose', N, MW, M, ONE,
|
|
$ B, LDB, DW, LDDW, ZERO, DWORK(KU), NNW )
|
|
CALL DLACPY( 'Full', NW, MW, BW, LDBW, DWORK(KU+N), NNW )
|
|
C
|
|
C Solve for the Cholesky factor Si of Pi, Pi = Si*Si',
|
|
C the continuous-time Lyapunov equation (if DICO = 'C')
|
|
C
|
|
C Ai*Pi + Pi*Ai' + scalec^2*Bi*Bi' = 0,
|
|
C
|
|
C or the discrete-time Lyapunov equation (if DICO = 'D')
|
|
C
|
|
C Ai*Pi*Ai' - Pi + scalec^2*Bi*Bi' = 0.
|
|
C
|
|
C Workspace: need (N+NW)*(N+NW+MAX(N+NW,MW)+5);
|
|
C prefer larger.
|
|
C
|
|
KTAU = KU + NNW*MAX( NNW, MW )
|
|
KW = KTAU + NNW
|
|
C
|
|
CALL SB03OU( DISCR, .TRUE., NNW, MW, DWORK(KAW), NNW,
|
|
$ DWORK(KU), NNW, DWORK(KTAU), DWORK(KU), NNW,
|
|
$ SCALEC, DWORK(KW), LDWORK-KW+1, IERR )
|
|
C
|
|
IF( IERR.NE.0 ) THEN
|
|
INFO = 2
|
|
RETURN
|
|
END IF
|
|
WORK = MAX( WORK, DWORK(KW) + DBLE( KW - 1 ) )
|
|
C
|
|
C Partition Si as Si = ( S11 S12 ) and compute S such that
|
|
C ( 0 S22 )
|
|
C
|
|
C S*S' = S11*S11' + (1-ALPHAC**2)*S12*S12'.
|
|
C
|
|
CALL DLACPY( 'Upper', N, N, DWORK(KU), NNW, S, LDS )
|
|
IF( ALPHAC.NE.ZERO ) THEN
|
|
T = SQRT( ONE - ALPHAC*ALPHAC )
|
|
DO 50 J = KU + NNW*N, KU + NNW*(NNW-1), NNW
|
|
CALL DSCAL( N, T, DWORK(J), 1 )
|
|
50 CONTINUE
|
|
END IF
|
|
IF( ALPHAC.LT.ONE .AND. NW.GT.0 ) THEN
|
|
KTAU = N*NNW + 1
|
|
KW = KTAU + N
|
|
CALL MB04ND( 'Full', N, 0, NW, S, LDS, DWORK(KU+NNW*N), NNW,
|
|
$ DUM, 1, DUM, 1, DWORK(KTAU), DWORK(KW) )
|
|
C
|
|
DO 70 J = 1, N
|
|
IF ( S(J,J).LT.ZERO ) THEN
|
|
DO 60 I = 1, J
|
|
S(I,J) = -S(I,J)
|
|
60 CONTINUE
|
|
END IF
|
|
70 CONTINUE
|
|
END IF
|
|
C
|
|
IF( LSAME( JOBC, 'E' ) .AND. ALPHAC.LT.ONE ) THEN
|
|
C
|
|
C Form X = -A*(S*S')-(S*S')*A' if DICO = 'C', or
|
|
C X = -A*(S*S')*A'+(S*S') if DICO = 'D'.
|
|
C
|
|
CALL DLACPY( 'Upper', N, N, S, LDS, DWORK(KU), N )
|
|
CALL MB01WD( DICO, 'Upper', 'Transpose', 'Hessenberg', N,
|
|
$ -ONE, ZERO, S, LDS, DWORK(KAW), NNW, DWORK(KU),
|
|
$ N, IERR )
|
|
C
|
|
C Compute the eigendecomposition of X as X = Z*Sigma*Z'.
|
|
C
|
|
KU = N + 1
|
|
CALL DSYEV( 'Vectors', 'Upper', N, S, LDS, DWORK, DWORK(KU),
|
|
$ LDWORK-N, IERR )
|
|
IF( IERR.GT.0 ) THEN
|
|
INFO = 3
|
|
RETURN
|
|
END IF
|
|
WORK = MAX( WORK, DWORK(KU) + DBLE( N ) )
|
|
C
|
|
C Partition Sigma = (Sigma1,Sigma2), such that
|
|
C Sigma1 =< 0, Sigma2 > 0.
|
|
C Partition correspondingly Z = [Z1 Z2].
|
|
C
|
|
TOL = MAX( ABS( DWORK(1) ), ABS( DWORK(N) ) )
|
|
$ * DLAMCH( 'Epsilon')
|
|
C _
|
|
C Form B = [ Z2*sqrt(Sigma2) ]
|
|
C
|
|
MBBAR = 0
|
|
I = KU
|
|
DO 80 J = 1, N
|
|
IF( DWORK(J).GT.TOL ) THEN
|
|
MBBAR = MBBAR + 1
|
|
CALL DSCAL( N, SQRT( DWORK(J) ), S(1,J), 1 )
|
|
CALL DCOPY( N, S(1,J), 1, DWORK(I), 1 )
|
|
I = I + N
|
|
END IF
|
|
80 CONTINUE
|
|
C
|
|
C Solve for the Cholesky factor S of P, P = S*S',
|
|
C the continuous-time Lyapunov equation (if DICO = 'C')
|
|
C _ _
|
|
C A*P + P*A' + t^2*B*B' = 0,
|
|
C
|
|
C or the discrete-time Lyapunov equation (if DICO = 'D')
|
|
C _ _
|
|
C A*P*A' - P + t^2*B*B' = 0.
|
|
C
|
|
C Workspace: need maximum N*(N + 6);
|
|
C prefer larger.
|
|
C
|
|
KTAU = KU + MBBAR*N
|
|
KW = KTAU + N
|
|
C
|
|
CALL SB03OU( DISCR, .TRUE., N, MBBAR, A, LDA, DWORK(KU), N,
|
|
$ DWORK(KTAU), S, LDS, T, DWORK(KW), LDWORK-KW+1,
|
|
$ IERR )
|
|
IF( IERR.NE.0 ) THEN
|
|
INFO = 2
|
|
RETURN
|
|
END IF
|
|
SCALEC = SCALEC*T
|
|
WORK = MAX( WORK, DWORK(KW) + DBLE( KW - 1 ) )
|
|
END IF
|
|
C
|
|
ELSE
|
|
C
|
|
C Solve for the Cholesky factor S of P, P = S*S',
|
|
C the continuous-time Lyapunov equation (if DICO = 'C')
|
|
C
|
|
C A*P + P*A' + scalec^2*B*B' = 0,
|
|
C
|
|
C or the discrete-time Lyapunov equation (if DICO = 'D')
|
|
C
|
|
C A*P*A' - P + scalec^2*B*B' = 0.
|
|
C
|
|
C Workspace: need N*(M+5);
|
|
C prefer larger.
|
|
C
|
|
KU = 1
|
|
KTAU = KU + N*M
|
|
KW = KTAU + N
|
|
C
|
|
CALL DLACPY( 'Full', N, M, B, LDB, DWORK(KU), N )
|
|
CALL SB03OU( DISCR, .TRUE., N, M, A, LDA, DWORK(KU), N,
|
|
$ DWORK(KTAU), S, LDS, SCALEC, DWORK(KW),
|
|
$ LDWORK-KW+1, IERR )
|
|
IF( IERR.NE.0 ) THEN
|
|
INFO = 2
|
|
RETURN
|
|
END IF
|
|
WORK = MAX( WORK, DWORK(KW) + DBLE( KW - 1 ) )
|
|
END IF
|
|
C
|
|
C Save optimal workspace.
|
|
C
|
|
DWORK(1) = WORK
|
|
C
|
|
RETURN
|
|
C *** Last line of AB09IY ***
|
|
END
|