SUBROUTINE INSYS (SYSFIL, 2 NINPS,NOUTS,NSTATS, 3 NA,NB,NC,A,B,C,D,ERRCD) C C FUNCTION: CF CF INSYS reads a system container file, in the format CF specified in the system container file specification in the CF User's Manual, and stores the system parameters in CF user-supplied variables and arrays. The user-supplied arrays CF must be as large as the largest system which is anticipated. CF C USAGE: CU CU The subroutine INSYS is used to read a system container file CU and store the system parameters in user-supplied variables and arrays. CU The function is invoked by a subroutine call CU CU CALL INSYS (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 INSYS reads the system container file and defines the CU values of NINPS (the number of inputs to the system), CU NOUTS (the number of outputs from the system), and CU NSTATS (the number of states of the system). The system CU parameters A,B,C, and D are read from the file, corresponding CU to the usual state variable description, as defined in the system CU container file specification. CU C INPUTS: CI CI SYSFIL = a character string of length less than or equal CI to 80, which contains the file pathname CI of the input system container file. If CI an extension is not given, the extension .SYS CI 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 C OUTPUTS: CO CO NINPS = an integer containing the number of inputs to CO the system CO CO NOUTS = an integer containing the number of outputs to CO the system CO CO NSTATS = an integer containing the number of states of CO the system CO CO A = a double precision array of dimension (NA,NA) CO containing the system dynamics matrix (NSTATS CO by NSTATS). If NA is less than NSTATS, an CO error code is returned. CO CO B = a double precision array of dimension (NA,NB) CO containing the system input matrix (NSTATS CO by NINPS). If NB is less than NINPS, an CO error code is returned. CO CO C = a double precision array of dimension (NC,NA) CO containing the system output matrix (NOUTS CO by NSTATS). If NC is less than NOUTS, an CO error code is returned. CO CO D = a double precision array of dimension (NC,NB) CO containing the system feedthrough matrix CO (NOUTS by NINPS). 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 does not exist or CO cannot be read 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 CO If the ERRCD is even, NSTATS, NINPS, CO and NOUTS will have correct values. These CO can be used to re-try the operation with larger CO values for NA, NB, and/or NC, and larger arrays. 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: November 12, 1984 CH current version: 1.1 CH modifications: 9-jan-1985:jdb:removed close(unit=1) CH statements so data positioned after the CH system matrices can be read by the calling CH program. CH 15-aug-1985:bb:extensive modifications CH to conform to standard Fortran 77. 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 OPEN LOCFIL C OPEN ( ACCESS = 'SEQUENTIAL', 2 ERR = 100, 3 FILE = LOCFIL, 4 UNIT = UNIT1, 5 STATUS = 'OLD') GO TO 200 100 CONTINUE C C--IF HERE, THE FILE IS NOT OPENABLE C ERRCD = 1 RETURN C 200 CONTINUE C C--NORMAL OPEN; ATTEMPT READ C READ (UNIT1,*,ERR=300,END=300) NSTATS, NINPS, NOUTS GO TO 400 300 CONTINUE C C--IF HERE, THE FILE IS WRONG (EOF) 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--READ MATRIX A C DO 10, I = 1, NSTATS READ (UNIT1,*,END=300) (A(I,J),J=1,NSTATS) 10 CONTINUE C C--READ MATRIX B C DO 20, I = 1, NSTATS READ (UNIT1,*,END=300) (B(I,J),J=1,NINPS) 20 CONTINUE C C--READ MATRIX C C DO 30, I = 1, NOUTS READ (UNIT1,*,END=300) (C(I,J),J=1,NSTATS) 30 CONTINUE C C--READ MATRIX D C DO 40, I = 1, NOUTS READ (UNIT1,*,END=300) (D(I,J),J=1,NINPS) 40 CONTINUE C C--FINISHED C RETURN END