PROGRAM TEST C C This program is to read in a test file and correctly count C the various pieces. C IMPLICIT INTEGER (A-Z) REAL UNIT, FLD1, FLD2 C DIMENSION IN(22), RMINMK(3), RMINLT(6), RMINDT(2) DIMENSION GGINMK(3), GGINLT(6), GGINDT(2) C DIMENSION RMMK(10,4), RMLOT(800,7), RMDATE(360), RMYEAR(30) DIMENSION GGMK(10,4), GGLOT(800,7), GGDATE(360), GGYEAR(30) C DIMENSION FROM(6), TO(6), COUNT(6) C EQUIVALENCE (IN(1),RMINMK(1)), (IN(2),RMINMK(2)) EQUIVALENCE (IN(3),RMINMK(3)) EQUIVALENCE (IN(4),RMINLT(1)), (IN(5),RMINLT(2)) EQUIVALENCE (IN(6),RMINLT(3)) EQUIVALENCE (IN(7),RMINLT(4)), (IN(8),RMINLT(5)) EQUIVALENCE (IN(9),RMINLT(6)) EQUIVALENCE (IN(10),RMINDT(1)), (IN(11),RMINDT(2)) EQUIVALENCE (IN(12),GGINMK(1)), (IN(13),GGINMK(2)) EQUIVALENCE (IN(14),GGINMK(3)) EQUIVALENCE (IN(15),GGINLT(1)), (IN(16),GGINLT(2)) EQUIVALENCE (IN(17),GGINLT(3)) EQUIVALENCE (IN(18),GGINLT(4)), (IN(19),GGINLT(5)) EQUIVALENCE (IN(20),GGINLT(6)) EQUIVALENCE (IN(21),GGINDT(1)), (IN(22),GGINDT(2)) C DATA RMMK, RMLOT, RMDATE, RMYEAR /6030 * 0/ DATA GGMK, GGLOT, GGDATE, GGYEAR /6030 * 0/ C DATA FROM/39, 46, 79, 95, 102, 128/ DATA TO/1, 7, 19, 23, 29, 41/ DATA COUNT/6, 12, 4, 6, 12, 4/ C DATA UNIT, FLD1, FLD2 /'Spar', 'R.M.', 'Ignt'/ DATA MT /'MT'/ C IBNR = 8 RL = 136 !RL - Record length NUMREC=10 !NUMREC - Number of records per block NF = 6 !NF - Number of fields CALL MTINI(1, MT, 1368, IBNR, RL, NUMREC, NF, FROM, TO, 1 COUNT, IN, 44, 0, 0) C C Number of lots of rocket motors and gas generators (includes maximum) C MAXLOT = 800 RMLLST = 0 !R.M. Lot lost GGLLST = 0 !G.G. Lot lost RMLCNT = 0 !R.M. Lot count GGLCNT = 0 !G.G. Lot count C C Number of Mk/Mods of rocket motors and gas generators (includes maximum) C MAXMK = 10 RMMLST = 0 !R.M. Mk lost GGMLST = 0 !G.G. Mk lost RMMCNT = 0 GGMCNT = 0 C C Number of unknown manufacturing dates on rocket motors and gas generators C RMUNKN = 0 GGUNKN = 0 C C Number of rocket motors and gas generators that have manufacturing dates C out of range C RMDTLS = 0 RMDTGT = 0 GGDTLS = 0 GGDTGT = 0 C C This is set to 1 after the first time through, used for initialization C BEENHR = 0 10 CONTINUE CALL MTBLOK (IERR) IF (IERR .LT. 0) GO TO 1000 C DO 100 I=1, NUMREC CALL MTGET( I ) IF (BEENHR .NE. 0) GO TO 20 C C Initialize the rocket motor Mk/Mod C CALL INITCT (MAXMK, RMMK, RMMCNT, 4, RMINMK, 3, RMMLST) C C Initialize the rocket motor lot information C CALL INITCT (MAXLOT, RMLOT, RMLCNT, 7, RMINLT, 6, RMLLST) C C Initialize the gas generator Mk/Mod C CALL INITCT (MAXMK, GGMK, GGMCNT, 4, GGINMK, 3, GGMLST) C C Initialize the gas generator lot information C CALL INITCT (MAXLOT, GGLOT, GGLCNT, 7, GGINLT, 6, RMLLST) C BEENHR = 1 C C Initialization complete, start program C 20 CONTINUE C C Compare the rocket motor Mk/Mod and count as neccessary C CALL CCOUNT (MAXMK, RMMK, RMMCNT, 4, RMINMK, 3, RMMLST) C C Compare the rocket motor lot information and count as neccessary C CALL CCOUNT (MAXLOT, RMLOT, RMLCNT, 7, RMINLT, 6, RMLLST) C C Read, decode and count the Rocket motor manufacturing date C CALL DOMCNT (RMDATE, RMYEAR, RMINDT, RMUNKN, RMDTLS, RMDTGT) C C Compare the gas generator Mk/Mod and count as neccessary C CALL CCOUNT (MAXMK, GGMK, GGMCNT, 4, GGINMK, 3, GGMLST) C C Compare the gas generator lot information and count as neccessary C CALL CCOUNT (MAXLOT, GGLOT, GGLCNT, 7, GGINLT, 6, GGLLST) C C Read, decode and count the Gas generator date C CALL DOMCNT (GGDATE, GGYEAR, GGINDT, GGUNKN, GGDTLS, GGDTGT) C 100 CONTINUE C C GO TO 10 C 1000 CONTINUE C C Write out the results to files - FIRST FIELDS C CALL ASSIGN (5, 'SY:SPFLD1.MK') CALL FDBSET (5, 'NEW') C CALL WRITEN (MAXMK, 4, RMMK, RMMCNT, RMMLST, UNIT, FLD1) C CLOSE ( UNIT=5) C CALL ASSIGN (5, 'SY:SPFLD1.LOT') CALL FDBSET (5, 'NEW') C CALL WRITEN (MAXLOT, 7, RMLOT, RMLCNT, RMLLST, UNIT, FLD1) C CLOSE ( UNIT=5) C C Write out the date file C CALL ASSIGN (5, 'NL:SPFLD1.DTE') CALL FDBSET (5, 'NEW') C CALL PRTDTE ( RMYEAR, RMDATE, RMUNKN, RMDTLS, RMDTGT, UNIT, FLD1) C CLOSE ( UNIT=5) C C C Write out the results to files - SECOND FIELDS C CALL ASSIGN (5, 'SY:SPFLD2.MK') CALL FDBSET (5, 'NEW') C CALL WRITEN (MAXMK, 4, GGMK, GGMCNT, GGMLST, UNIT, FLD2) C CLOSE ( UNIT=5) C CALL ASSIGN (5, 'SY:SPFLD2.LOT') CALL FDBSET (5, 'NEW') C CALL WRITEN (MAXLOT, 7, GGLOT, GGLCNT, GGLLST, UNIT, FLD2) C CLOSE ( UNIT=5) C C Write out the date file C CALL ASSIGN (5, 'NL:SPFLD2.DTE') CALL FDBSET (5, 'NEW') C CALL PRTDTE ( GGYEAR, GGDATE, GGUNKN, GGDTLS, GGDTGT, UNIT, FLD2) C CLOSE ( UNIT=5) C C Write out the last block read in (use octal) C CALL ASSIGN (5, 'NL:SPTRAILS.TMP') CALL FDBSET (5, 'NEW') DO 1202 I = 1,NUMREC CALL MTGET(I) WRITE (5, 1201) (IN(K), K=1,22) 1201 FORMAT (' >',22A2,'<') 1202 CONTINUE DO 1208 I = 1,NUMREC CALL MTGET(I) WRITE (5, 1206) (IN(K), K=1,10), (IN(K), K=1,10) WRITE (5, 1206) (IN(K), K=11,20), (IN(K), K=11,20) 1206 FORMAT (2X,'>',10A2,'<',/,10(O6,2X)) WRITE (5, 1207) (IN(K), K=21,22), (IN(K), K=21,22) 1207 FORMAT (2X,'>',2A2,'<',/,2(O6,2X),/) 1208 CONTINUE C C CALL EXIT END