SUBROUTINE OUTSYS (SYSFIL, 2 NINPS,NOUTS,NSTATS, 3 NA,NB,NC,A,B,C,D,ERRCD) C C FUNCTION: CF CF OUTSYS writes a system container file, in the format CF specified in the system container file format in the CF User's guide, from system parameters stored in CF user-supplied variables and arrays. CF C USAGE: CU CU The subroutine OUTSYS is used to write a system container file CU using system parameters stored in user-supplied variables and arrays. CU The function is invoked by a subroutine call CU CU CALL OUTSYS (SYSFIL,, CU 2 NINPS,NOUTS,NSTATS, CU 3 NA,NB,NC,A,B,C,D,ERRCD) CU CU where SYSFIL is a character array with maximum length CU of 255 characters containing a valid file specification for a CU system container file. The default CU extension is .SYS. CU CU OUTSYS writes the system container file defined by the CU values of NINPS (the number of inputs to the system), CU NOUTS (the number of outputs from the system), CU NSTATS (the number of states of the system), and the system CU parameters A,B,C, and D, corresponding CU to the usual state variable description, as defined in SCF.SPC. CU C INPUTS: CI CI SYSFIL = a character string of length less than or equal CI to 255, which will contain the file CI specification of the output system container CI file. If an extension is not given, the CI extension .SYS is assumed. CI CI NA = The row and column dimension of A, the number CI of rows of B, and the number of columns of C. CI CI NB = The number of columns of B, and the number of CI columns of D. CI CI NC = The number of rows of C, and the number of rows CI of D. CI CI NINPS = an integer containing the number of inputs to CI the system CI CI NOUTS = an integer containing the number of outputs to CI the system CI CI NSTATS = an integer containing the number of states of CI the system CI CI A = a double precision array of dimension (NA,NA) CI containing the system dynamics matrix (NSTATS CI by NSTATS). If NA is less than NSTATS, an CI error code is returned. CI CI B = a double precision array of dimension (NA,NB) CI containing the system input matrix (NSTATS CI by NINPS). If NB is less than NINPS, an CI error code is returned. CI CI C = a double precision array of dimension (NC,NA) CI containing the system output matrix (NOUTS CI by NSTATS). If NC is less than NOUTS, an CI error code is returned. CI CI D = a double precision array of dimension (NC,NB) CI containing the system feedthrough matrix CI (NOUTS by NINPS). CI C OUTPUTS: CO CO CO ERRCD = an integer indicating an error occurred during CO processing. It is the sum of the following CO codes. An error code value of zero indicates CO successful completion. CO CO ERRCD : 1 : the file cannot be created CO successfully. CO CO ERRCD : 2 : NA is less than NSTATS. CO CO ERRCD : 4 : NB is less than NINPS. CO CO ERRCD : 8 : NC is less than NOUTS. CO CO ERRCD :16 : the file name is either too CO long or blank CO C ALGORITHM: CA CA NONE CA C MACHINE DEPENDENCIES: CM CM NONE CM C HISTORY: CH CH written by: J. Douglas Birdwell CH date: January 9, 1985 CH current version: 1.1 CH modifications: 8-aug-86:bb:extensive mods CH to conform to f77. CH 16-jun-88:jdb:removed status='new' CH qualifier on open statement. CH C ROUTINES CALLED: CC CC filext CC C COMMON MEMORY USED: CM CM NONE 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-7685 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 GLOBAL VARIABLES: C INCLUDE 'Parameter.f' C CHARACTER*(*) SYSFIL INTEGER NINPS INTEGER NOUTS INTEGER NSTATS INTEGER NA INTEGER NB INTEGER NC INTEGER ERRCD DOUBLE PRECISION A(NA,NA) DOUBLE PRECISION B(NA,NB) DOUBLE PRECISION C(NC,NA) DOUBLE PRECISION D(NC,NB) C C LOCAL VARIABLES: C CHARACTER*255 LOCFIL INTEGER IERR C C--ADD DEFAULT EXTENSION TO FILE SPECIFICATION IF NECESSARY C CALL FILEXT (SYSFIL,LOCFIL, 2 '.SYS',IERR) C C--SEE IF FILE SPECIFICATION ERROR C--AN ERROR CODE OF 17 MEANS ILLEGAL NAME AND FILE NOT READ C IF (IERR .NE. 0) THEN ERRCD = 17 RETURN END IF C C--LOCFIL CONTAINS THE FULLY QUALIFIED FILE SPECIFICATON C--ATTEMPT TO CREATE LOCFIL C OPEN ( ACCESS = 'SEQUENTIAL', 2 ERR = 100, 3 FILE = LOCFIL, 4 UNIT = UNIT1) GO TO 200 100 CONTINUE C C--IF HERE, THE FILE IS NOT CREATED C ERRCD = 1 RETURN C 200 CONTINUE C C--NORMAL OPEN; ATTEMPT WRITE C WRITE (UNIT1,*,ERR=300) NSTATS, NINPS, NOUTS GO TO 400 300 CONTINUE C C--IF HERE, THE FILE IS WRONG C ERRCD = 1 RETURN C 400 CONTINUE C C--SIZE OF SYSTEM IS NOW KNOWN C--CHECK SIZE C ERRCD = 0 IF (NSTATS .GT. NA) ERRCD = ERRCD + 2 IF (NINPS .GT. NB) ERRCD = ERRCD + 4 IF (NOUTS .GT. NC) ERRCD = ERRCD + 8 IF (ERRCD .GT. 0) THEN RETURN END IF C C--WRITE MATRIX A C DO 10, I = 1, NSTATS WRITE (UNIT1,*,ERR=300) (A(I,J),J=1,NSTATS) 10 CONTINUE C C--WRITE MATRIX B C DO 20, I = 1, NSTATS WRITE (UNIT1,*,ERR=300) (B(I,J),J=1,NINPS) 20 CONTINUE C C--WRITE MATRIX C C DO 30, I = 1, NOUTS WRITE (UNIT1,*,ERR=300) (C(I,J),J=1,NSTATS) 30 CONTINUE C C--WRITE MATRIX D C DO 40, I = 1, NOUTS WRITE (UNIT1,*,ERR=300) (D(I,J),J=1,NINPS) 40 CONTINUE C C--FINISHED C C C--LEAVE UNIT1 OPEN ON RETURN SO CALLING PROGRAM CAN ADD TO FILE IF C--DESIRED. C RETURN END