Purpose
  To determine the one-dimensional state feedback matrix G of the
  linear time-invariant single-input system
        dX/dt = A * X + B * U,
  where A is an NCONT-by-NCONT matrix and B is an NCONT element
  vector such that the closed-loop system
        dX/dt = (A - B * G) * X
  has desired poles. The system must be preliminarily reduced
  to orthogonal canonical form using the SLICOT Library routine
  AB01MD.
Specification
      SUBROUTINE SB01MD( NCONT, N, A, LDA, B, WR, WI, Z, LDZ, G, DWORK,
     $                   INFO )
C     .. Scalar Arguments ..
      INTEGER           INFO, LDA, LDZ, N, NCONT
C     .. Array Arguments ..
      DOUBLE PRECISION  A(LDA,*), B(*), DWORK(*), G(*), WI(*), WR(*),
     $                  Z(LDZ,*)
Arguments
Input/Output Parameters
  NCONT   (input) INTEGER
          The order of the matrix A as produced by SLICOT Library
          routine AB01MD.  NCONT >= 0.
  N       (input) INTEGER
          The order of the matrix Z.  N >= NCONT.
  A       (input/output) DOUBLE PRECISION array, dimension
          (LDA,NCONT)
          On entry, the leading NCONT-by-NCONT part of this array
          must contain the canonical form of the state dynamics
          matrix A as produced by SLICOT Library routine AB01MD.
          On exit, the leading NCONT-by-NCONT part of this array
          contains the upper quasi-triangular form S of the closed-
          loop system matrix (A - B * G), that is triangular except
          for possible 2-by-2 diagonal blocks.
          (To reconstruct the closed-loop system matrix see
          FURTHER COMMENTS below.)
  LDA     INTEGER
          The leading dimension of array A.  LDA >= MAX(1,NCONT).
  B       (input/output) DOUBLE PRECISION array, dimension (NCONT)
          On entry, this array must contain the canonical form of
          the input/state vector B as produced by SLICOT Library
          routine AB01MD.
          On exit, this array contains the transformed vector Z * B
          of the closed-loop system.
  WR      (input) DOUBLE PRECISION array, dimension (NCONT)
  WI      (input) DOUBLE PRECISION array, dimension (NCONT)
          These arrays must contain the real and imaginary parts,
          respectively, of the desired poles of the closed-loop
          system. The poles can be unordered, except that complex
          conjugate pairs of poles must appear consecutively.
  Z       (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
          On entry, the leading N-by-N part of this array must
          contain the orthogonal transformation matrix as produced
          by SLICOT Library routine AB01MD, which reduces the system
          to canonical form.
          On exit, the leading NCONT-by-NCONT part of this array
          contains the orthogonal matrix Z which reduces the closed-
          loop system matrix (A - B * G) to upper quasi-triangular
          form.
  LDZ     INTEGER
          The leading dimension of array Z.  LDZ >= MAX(1,N).
  G       (output) DOUBLE PRECISION array, dimension (NCONT)
          This array contains the one-dimensional state feedback
          matrix G of the original system.
Workspace
DWORK DOUBLE PRECISION array, dimension (3*NCONT)Error Indicator
  INFO    INTEGER
          = 0:  successful exit;
          < 0:  if INFO = -i, the i-th argument had an illegal
                value.
Method
The method is based on the orthogonal reduction of the closed-loop system matrix (A - B * G) to upper quasi-triangular form S whose 1-by-1 and 2-by-2 diagonal blocks correspond to the desired poles. That is, S = Z'*(A - B * G)*Z, where Z is an orthogonal matrix.References
  [1] Petkov, P. Hr.
      A Computational Algorithm for Pole Assignment of Linear
      Single Input Systems.
      Internal Report 81/2, Control Systems Research Group, School
      of Electronic Engineering and Computer Science, Kingston
      Polytechnic, 1981.
Numerical Aspects
3 The algorithm requires 0(NCONT ) operations and is backward stable.Further Comments
If required, the closed-loop system matrix (A - B * G) can be formed from the matrix product Z * S * Z' (where S and Z are the matrices output in arrays A and Z respectively).Example
Program Text
*     SB01MD EXAMPLE PROGRAM TEXT
*     Copyright (c) 2002-2010 NICONET e.V.
*
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        ( NIN = 5, NOUT = 6 )
      INTEGER          NMAX
      PARAMETER        ( NMAX = 20 )
      INTEGER          LDA, LDZ
      PARAMETER        ( LDA = NMAX, LDZ = NMAX )
      INTEGER          LDWORK
      PARAMETER        ( LDWORK = 3*NMAX )
*     .. Local Scalars ..
      DOUBLE PRECISION TOL
      INTEGER          I, INFO1, INFO2, J, N, NCONT
      CHARACTER*1      JOBZ
*     .. Local Arrays ..
      DOUBLE PRECISION A(LDA,NMAX), B(NMAX), DWORK(LDWORK), G(NMAX),
     $                 WI(NMAX), WR(NMAX), Z(LDZ,NMAX)
*     .. External Subroutines ..
      EXTERNAL         AB01MD, SB01MD
*     .. Executable Statements ..
*
      WRITE ( NOUT, FMT = 99999 )
*     Skip the heading in the data file and read the data.
      READ ( NIN, FMT = '()' )
      READ ( NIN, FMT = * ) N, TOL, JOBZ
      IF ( N.LT.0 .OR. N.GT.NMAX ) THEN
         WRITE ( NOUT, FMT = 99995 ) N
      ELSE
         READ ( NIN, FMT = * ) ( ( A(I,J), J = 1,N ), I = 1,N )
         READ ( NIN, FMT = * ) ( B(I), I = 1,N )
         READ ( NIN, FMT = * ) ( WR(I), I = 1,N )
         READ ( NIN, FMT = * ) ( WI(I), I = 1,N )
*        First reduce the given system to canonical form.
         CALL AB01MD( JOBZ, N, A, LDA, B, NCONT, Z, LDZ, DWORK, TOL,
     $                DWORK(N+1), LDWORK-N, INFO1 )
*
         IF ( INFO1.EQ.0 ) THEN
*           Find the one-dimensional state feedback matrix G.
            CALL SB01MD( NCONT, N, A, LDA, B, WR, WI, Z, LDZ, G, DWORK,
     $                   INFO2 )
*
            IF ( INFO2.NE.0 ) THEN
               WRITE ( NOUT, FMT = 99997 ) INFO2
            ELSE
               WRITE ( NOUT, FMT = 99996 ) ( G(I), I = 1,NCONT )
            END IF
         ELSE
            WRITE ( NOUT, FMT = 99998 ) INFO1
         END IF
      END IF
      STOP
*
99999 FORMAT (' SB01MD EXAMPLE PROGRAM RESULTS',/1X)
99998 FORMAT (' INFO on exit from AB01MD =',I2)
99997 FORMAT (' INFO on exit from SB01MD =',I2)
99996 FORMAT (' The one-dimensional state feedback matrix G is',
     $       /20(1X,F8.4))
99995 FORMAT (/' N is out of range.',/' N = ',I5)
      END
Program Data
SB01MD EXAMPLE PROGRAM DATA 4 0.0 I -1.0 0.0 2.0 -3.0 1.0 -4.0 3.0 -1.0 0.0 2.0 4.0 -5.0 0.0 0.0 -1.0 -2.0 1.0 0.0 0.0 0.0 -1.0 -1.0 -1.0 -1.0 0.0 0.0 0.0 0.0Program Results
SB01MD EXAMPLE PROGRAM RESULTS The one-dimensional state feedback matrix G is 1.0000 29.0000 93.0000 -76.0000
Click here to get a compressed (gzip) tar file containing the source code of the routine, the example program, data, documentation, and related files.
Return to index