SUBROUTINE FBGAIN (NR,NRX,NRW,N,M,A,B,E,R,RI,S,X,FB,W,WK,IPVT,
     X                   EFLAG,RDFLG,RFLAG,SFLAG,TYPE)
C
C     *****PARAMETERS:
      INTEGER NR,NRX,NRW,N,M,IPVT(N)
      CHARACTER EFLAG,RDFLG,RFLAG,SFLAG
      DOUBLE PRECISION A(NR,N),B(NR,M),E(NR,N),R(NR,M),RI(NR,M),
     X    S(NR,M),X(NRX,N),FB(NRW,N),W(NRW,N),WK(N)
      LOGICAL TYPE
C
C     *****LOCAL VARIABLES:
      INTEGER I,J
      DOUBLE PRECISION COND 
C
C     *****FORTRAN FUNCTIONS:
C     NONE
C
C     *****SUBROUTINES CALLED:
C     MADD, MLINEQ, MMUL, MULA, MULB, TRNATA, TRNATB
C
C     --------------------------------------------------------------
C
C     *****PURPOSE:
C     GIVEN THE RICCATI SOLUTION AND THE MODEL MATRICES OF THE
C     OPTIMAL CONTROL PROBLEM, THIS SUBROUTINE CALCULATES THE
C     OPTIMAL FEEDBACK GAIN MATRIX FOR THE GENERALIZED CONTINUOUS-
C     OR DISCRETE-TIME OPTIMAL CONTROL PROBLEM.
C
C       CONTINUOUS:  FB = RI*(BT*X*E + ST)
C
C         DISCRETE:  FB = ((R + BT*X*B)**-1)*(BT*X*A + ST)
C
C     WHERE T DENOTES THE MATRIX TRANSPOSE.
C
C     REF.:  ARNOLD, W.F., "ON THE NUMERICAL SOLUTION OF
C     ALGEBRAIC MATRIX RICCATI EQUATIONS," PHD THESIS, USC,
C     DECEMBER 1983.
C
C     *****PARAMETER DESCRIPTION:
C
C     ON INPUT:
C
C       NR       INTEGER
C                ROW DIMENSION OF THE ARRAYS CONTAINING
C                A, B, E, R, RI AND S AS DECLARED IN THE MAIN
C                CALLING PROGRAM DIMENSION STATEMENT;
C
C       NRX      INTEGER
C                ROW DIMENSION OF THE ARRAY CONTAINING X AS DECLARED
C                IN THE MAIN CALLING PROGRAM DIMENSION STATEMENT;
C
C       NRW      INTEGER
C                ROW DIMENSION OF THE ARRAYS CONTAINING FB AND W AS
C                DECLARED IN THE MAIN PROGRAM DIMENSION STATEMENT;
C
C       N        INTEGER
C                ORDER OF THE SQUARE MATRICES A, E, AND X
C                ROW DIMENSION OF THE MATRICES B, S, AND FB;
C
C       M        INTEGER
C                ORDER OF THE SQUARE MATRICES R AND RI
C                COLUMN DIMENSION OF THE MATRICES B AND S;
C
C       A        REAL(NR,N)
C                MODEL SYSTEM MATRIX;
C
C       B        REAL(NR,M)
C                MODEL INPUT MATRIX;
C
C       E        REAL(NR,N)
C                MODEL DESCRIPTOR MATRIX;
C
C       R        REAL(NR,M)
C                INPUT WEIGHTING MATRIX;
C
C       RI       REAL(NR,M)
C                INVERSE OF THE INPUT WEIGHTING MATRIX;
C
C       S        REAL(NR,M)
C                STATE - INPUT CROSS-WEIGHTING MATRIX;
C
C       X        REAL(NRX,N)
C                ALGEBRAIC RICCATI EQUATION SOLUTION MATRIX;
C
C       W        REAL(NRW,N)
C                SCRATCH ARRAY OF SIZE AT LEAST N BY N;
C
C       WK       REAL(N)
C                WORKING VECTOR OF LENGTH AT LEAST N;
C
C       IPVT     INTEGER(M)
C                WORKING VECTOR OF LENGTH AT LEAST M;
C
C       EFLAG    CHARACTER
C                FLAG SET TO 'Y' IF E IS OTHER THAN THE IDENTITY
C                MATRIX;
C
C       RDFLG    CHARACTER
C                FLAG SET TO 'Y' IF R IS A DIAGONAL MATRIX;
C
C       RFLAG    CHARACTER
C                FLAG SET TO 'Y' IF R IS OTHER THAN THE IDENTITY
C                MATRIX;
C
C       SFLAG    CHARACTER
C                FLAG SET TO 'Y' IF S IS OTHER THAN THE ZERO MATRIX;
C
C       TYPE     LOGICAL
C                = .TRUE.  FOR CONTINUOUS-TIME SYSTEM
C                = .FALSE.  FOR DISCRETE-TIME SYSTEM.
C
C     ON OUTPUT:
C
C       FB       REAL(NRW,N)
C                OPTIMAL FEEDBACK GAIN MATRIX AS DESCRIBED ABOVE;
C
C       WK(1)    ESTIMATED CONDITION NUMBER OF R+BT*X*B WITH RESPECT
C                TO INVERSION (DISCRETE PROBLEM).
C
C     *****ALGORITHM NOTES:
C     NONE
C
C     *****HISTORY:
C     THIS SUBROUTINE WAS WRITTEN BY W.F. ARNOLD, NAVAL WEAPONS
C     CENTER, CODE 35104, CHINA LAKE, CA  93555, AS PART OF THE 
C     SOFTWARE PACKAGE RICPACK, SEPTEMBER 1983.
C
C     --------------------------------------------------------------
C
      IF(TYPE) GO TO 60
C
C     DISCRETE-TIME CASE
C 
      CALL TRNATB(NR,NRW,N,M,B,FB)
      CALL MULA(NRW,NRX,M,N,N,FB,X,WK)
      CALL MMUL(NRW,NR,NRW,M,M,N,FB,B,W)
      IF(RFLAG .EQ. 'Y' .OR. RFLAG .EQ. 'y') GO TO 20
      DO 10 I=1,M
          W(I,I) = W(I,I) + 1.0D0
   10 CONTINUE
      GO TO 50  
   20 CONTINUE  
      IF(RDFLG .EQ. 'Y' .OR. RDFLG .EQ. 'y') GO TO 30
      CALL MADD(NRW,NR,NRW,M,M,W,R,W)
      GO TO 50
   30 CONTINUE  
      DO 40 I=1,M
          W(I,I) = W(I,I) + R(I,I)
   40 CONTINUE
   50 CONTINUE  
      CALL MULA(NRW,NR,M,N,N,FB,A,WK)
      IF(SFLAG .NE. 'Y' .AND. SFLAG .NE. 'y') GO TO 58
      DO 54 J=1,N
          DO 52 I=1,M
              FB(I,J) = FB(I,J) + S(J,I)
   52     CONTINUE
   54 CONTINUE
   58 CONTINUE
      CALL MLINEQ(NRW,NRW,M,N,W,FB,COND,IPVT,WK)
      WK(1) = COND
      GO TO 110
   60 CONTINUE
C
C     CONTINUOUS-TIME CASE
C
      CALL TRNATB(NR,NRW,N,M,B,FB)
      CALL MULA(NRW,NRX,M,N,N,FB,X,WK)
      IF(EFLAG .EQ. 'Y' .OR. EFLAG .EQ. 'y')
     X                CALL MULA(NRW,NR,M,N,N,FB,E,WK)
      IF(SFLAG .NE. 'Y' .AND. SFLAG .NE. 'y') GO TO 68
      DO 64 J=1,N
          DO 62 I=1,M
              FB(I,J) = FB(I,J) + S(J,I)
   62     CONTINUE
   64 CONTINUE
   68 CONTINUE
      IF(RFLAG .NE. 'Y' .AND. RFLAG .NE. 'y') GO TO 100
      IF(RDFLG .NE. 'Y' .AND. RDFLG .NE. 'y') GO TO 90
      DO 80 J=1,N
          DO 70 I=1,M
              FB(I,J) = RI(I,I)*FB(I,J)
   70 CONTINUE
   80 CONTINUE  
      GO TO 100
   90 CONTINUE
      CALL MULB(NR,NRW,M,M,N,RI,FB,WK)
  100 CONTINUE
      WK(1) = 1.0D0
  110 CONTINUE
      RETURN
C
C     LAST LINE OF FBGAIN
C
      END