SUBROUTINE KBF(SYSFIL,BALFIL,OUTFIL,MU,ERRCD,ERRMSG) C C FUNCTION: CF CF C USAGE: CU CU C INPUTS: CI CI C OUTPUTS: CO CO C ALGORITHM: CA CA C MACHINE DEPENDENCIES: CM CM C HISTORY: CH CH written by: Bobby Bodenheimer CH date: December 1986 CH current version: 1.2 CH modifications: declared undeclared variables - jdb - 5/11/88 CH added dpcom: 7/16/88 jdb CH C ROUTINES CALLED: CC CC C COMMON MEMORY USED: CM CM DPCOM -- see dpcommon.f and dpcom.f CM C---------------------------------------------------------------------- C written for: The CASCADE Project C Oak Ridge National Laboratory C U.S. Department of Energy C contract number DE-AC05-840R21400 C subcontract number 37B-07685C S13 C organization: The University of Tennessee C---------------------------------------------------------------------- C THIS SOFTWARE IS IN THE PUBLIC DOMAIN C NO RESTRICTIONS ON ITS USE ARE IMPLIED C---------------------------------------------------------------------- C C INCLUDE 'Parameter.f' C DOUBLE PRECISION A(SIZE2,SIZE2) DOUBLE PRECISION AT(SIZE2,SIZE2) DOUBLE PRECISION B(SIZE2,SIZE2) DOUBLE PRECISION C(SIZE2,SIZE2) DOUBLE PRECISION CT(SIZE2,SIZE2) DOUBLE PRECISION E(SIZE2,SIZE2) DOUBLE PRECISION D(SIZE2,SIZE2) DOUBLE PRECISION GDG(SIZE2,SIZE2) DOUBLE PRECISION F(SIZE2,SIZE2) DOUBLE PRECISION FCL(SIZE2,SIZE2) DOUBLE PRECISION P(SIZE2,SIZE2) DOUBLE PRECISION Q(SIZE2,SIZE2) DOUBLE PRECISION R(SIZE2,SIZE2) DOUBLE PRECISION RI(SIZE2,SIZE2) DOUBLE PRECISION RS(SIZE2,SIZE2) DOUBLE PRECISION S(SIZE2,SIZE2) DOUBLE PRECISION U(SIZE2,SIZE2) DOUBLE PRECISION WK(SIZE2,SIZE2) DOUBLE PRECISION WXYZ(SIZE2,SIZE2) C DOUBLE COMPLEX H(SIZE2,SIZE2) C DOUBLE PRECISION ALFI(SIZE2) DOUBLE PRECISION ALFR(SIZE2) DOUBLE PRECISION BETA(SIZE2) DOUBLE PRECISION CPERM(SIZE2) DOUBLE PRECISION CSCALE(SIZE2) C DOUBLE PRECISION MU DOUBLE PRECISION RTOL DOUBLE PRECISION RSD C INTEGER I INTEGER J INTEGER ERRCD INTEGER IERR INTEGER IND(SIZE2) INTEGER MAXIT INTEGER NINPS INTEGER NOUTS INTEGER NSTATS INTEGER RSTRUC C CHARACTER*(*) SYSFIL CHARACTER*(*) BALFIL CHARACTER*(*) OUTFIL CHARACTER*(*) ERRMSG C INCLUDE 'dpcom.f' C C Initialize ERRCD, MAXIT, RTOL, and RSTRUC. C ERRCD = 0 IERR = 0 MAXIT = 5 RTOL = 0.0D0 IF (MU.EQ.1.0D0) THEN RSTRUC = 0 ELSE RSTRUC = 1 END IF C C Read in the system matrices. C CALL INSYS(SYSFIL,NINPS,NOUTS,NSTATS, 1 SIZE2,SIZE2,SIZE2,A,B,C,D,ERRCD) C CLOSE(UNIT=UNIT1) C IF (ERRCD.NE.0) THEN ERRMSG = 'KBF: Fatal Error from INSYS accessing '//SYSFIL RETURN END IF C C For the KBF solution, we want B to be the identity matrix. C DO 20 I=1,NSTATS DO 10 J=1,NSTATS B(J,I) = 0.0D0 10 CONTINUE B(I,I) = 1.0D0 20 CONTINUE C C Set R equal to a diagonal matrix equal to mu*I. C DO 40 I=1,NOUTS DO 30 J=1,NOUTS R(J,I) = 0.0D0 30 CONTINUE R(I,I) = MU 40 CONTINUE C C Read in the balancing matrix. H isn't used. C OPEN(UNIT=UNIT1,FILE=BALFIL,STATUS='OLD',ERR=9990) C DO 50 I=1,NSTATS READ(UNIT1,*,ERR=9990) (H(I,J),J=1,NOUTS) 50 CONTINUE C DO 60 I=1,NSTATS READ(UNIT1,*,ERR=9990) (Q(I,J),J=1,NSTATS) 60 CONTINUE C CLOSE(UNIT=UNIT1,ERR=9990) C C Compute the KBF solution. C CALL CKBF(SIZE2,NSTATS,NSTATS,NOUTS,A,B,C,R,Q,P,F,FCL, 1 GDG,WXYZ,AT,CT,E,RI,RS,S,U,WK,ALFI,ALFR,BETA, 2 CPERM,CSCALE,RSD,RTOL,MAXIT, 3 RSTRUC,IBAL,IND,IERR,ERRMSG) C IF (IERR.GT.0) THEN ERRCD = IERR RETURN END IF C C Output the new system. F is the optimal filter gain matrix. C CALL OUTSYS(OUTFIL,NOUTS,NOUTS,NSTATS,SIZE2, 1 SIZE2,SIZE2,A,F,C,D,ERRCD) C IF (ERRCD.NE.0) THEN ERRMSG = ' KBF: Fatal Error from OUTSYS '// 1 'accessing '//SYSFIL RETURN END IF C C Append the closed-loop matrix to the output file. C DO 70 I=1,NSTATS WRITE(UNIT1,*,ERR=9991) (FCL(I,J),J=1,NSTATS) 70 CONTINUE C C Append the solution of the ARE to the output file. C DO 80 I=1,NSTATS WRITE(UNIT1,*,ERR=9991) (P(I,J),J=1,NSTATS) 80 CONTINUE C C Append the closed-loop eigenvalues to the output file. C DO 90 I=1,NSTATS WRITE(UNIT1,*,ERR=9991) ALFR(I),ALFI(I) 90 CONTINUE C CLOSE(UNIT=UNIT1,ERR=9991) C C End of the program. C RETURN C C Error traps. C 9990 ERRCD = 100 + ERRCD ERRMSG = 'KBF: Error reading Balance File '//BALFIL RETURN 9991 ERRCD = 200 + ERRCD ERRMSG = 'KBF: Error writing Output File '//OUTFIL RETURN C END