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) 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 FROM/33, 40, 78, 93, 100, 128/ DATA TO/1, 7, 19, 23, 29, 41/ DATA COUNT/6, 12, 4, 6, 12, 4/ C IBNR = 8 RL = 136 !RL - Record length NUMREC=10 !NUMREC - Number of records per block NF = 6 !NF - Number of fields CALL MTINI(IBNR, RL, NUMREC, NF, FROM, TO, COUNT, IN, 44, 0, 0) C C Number of lots of rocket motors and gas generators C RMLCNT = 0 GGLCNT = 0 C C Number of Mk/Mods of rocket motors and gas generators C 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 10 CONTINUE CALL MTBLOK (IERR) IF (IERR .LT. 0) GO TO 1000 C DO 900 ZZZZ=1,NUMREC CALL MTGET(ZZZZ) C C Compare the rocket motor Mk/Mod and count as neccessary C DO 102 I = 1,RMMCNT DO 100 J = 1,3 IF (RMINMK(J) .NE. RMMK(I,J)) GO TO 102 100 CONTINUE RMMK (I,4) = RMMK (I,4) + 1 !This is an existing Mk/Mod add one GO TO 108 102 CONTINUE RMMCNT = RMMCNT + 1 DO 106 I = 1,3 RMMK (RMMCNT,I) = RMINMK(I) 106 CONTINUE RMMK (RMMCNT,4) = 1 108 CONTINUE C C Compare the rocket motor lot information and count as neccessary C DO 112 I = 1,RMLCNT DO 110 J = 1,6 IF (RMINLT(J) .NE. RMLOT(I,J)) GO TO 112 110 CONTINUE RMLOT (I,7) = RMLOT (I,7) + 1 !This is an existing Mk/Mod add one GO TO 118 112 CONTINUE RMLCNT = RMLCNT + 1 DO 116 I = 1,6 RMLOT (RMLCNT,I) = RMINLT(I) 116 CONTINUE RMLOT (RMLCNT,7) = 1 118 CONTINUE C C Read, decode and count the Rocket motor manufacturing date C IF (RMINDT(2) .NE. ' ') GO TO 120 RMUNKN = RMUNKN + 1 !Unknown manuf date GO TO 130 120 DECODE (4, 122, RMINDT) RMMNTH, RMMANU 122 FORMAT (2I2) C MONTH = ((RMMANU-55) * 12) + RMMNTH IF (MONTH .GT. 0) GO TO 124 RMDTLS = RMDTLS + 1 GO TO 130 124 IF (MONTH .LE. 360) GO TO 126 RMDTGT = RMDTGT + 1 GO TO 130 126 RMDATE (MONTH) = RMDATE (MONTH) + 1 YEAR = RMMANU - 55 RMYEAR(YEAR) = RMYEAR(YEAR) + 1 C 130 CONTINUE C C Compare the gas generator Mk/Mod and count as neccessary C DO 202 I = 1,GGMCNT DO 200 J = 1,3 IF (GGINMK(J) .NE. GGMK(I,J)) GO TO 202 200 CONTINUE GGMK (I,4) = GGMK (I,4) + 1 !This is an existing Mk/Mod add one GO TO 208 202 CONTINUE GGMCNT = GGMCNT + 1 DO 206 I = 1,3 GGMK (GGMCNT,I) = GGINMK(I) 206 CONTINUE GGMK (GGMCNT,4) = 1 208 CONTINUE C C Compare the gas generator lot information and count as neccessary C DO 212 I = 1,GGLCNT DO 210 J = 1,6 IF (GGINLT(J) .NE. GGLOT(I,J)) GO TO 212 210 CONTINUE GGLOT (I,7) = GGLOT (I,7) + 1 !This is an existing Mk/Mod add one GO TO 218 212 CONTINUE GGLCNT = GGLCNT + 1 DO 216 I = 1,6 GGLOT (GGLCNT,I) = GGINLT(I) 216 CONTINUE GGLOT (GGLCNT,7) = 1 218 CONTINUE C C Read, decode and count the Gas generator date C IF (GGINDT(2) .NE. ' ') GO TO 220 GGUNKN =GGUNKN + 1 !Unknown manuf date GO TO 230 220 DECODE (4, 122, GGINDT) GGMNTH, GGMANU MONTH = ((GGMANU-55) * 12) + GGMNTH IF (MONTH .GT. 0) GO TO 224 GGDTLS = GGDTLS + 1 GO TO 230 224 IF (MONTH .LE. 360) GO TO 226 GGDTGT = GGDTGT + 1 GO TO 230 226 GGDATE (MONTH) = GGDATE (MONTH) + 1 YEAR = GGMANU - 55 GGYEAR(YEAR) = GGYEAR(YEAR) + 1 C 230 CONTINUE !End of the loop C 900 CONTINUE C GO TO 10 C 1000 CONTINUE C C Write out the results to files - FIRST FIELDS C CALL ASSIGN (5, 'DX:SIFLD1.MK') CALL FDBSET (5, 'NEW') WRITE (5, 1002) RMMCNT 1002 FORMAT (3X, 'Total number of FIELD 1 Mk/Mods found:',I2) DO 1008 I = 1, RMMCNT WRITE (5, 1006) (RMMK(I,K), K=1,4) 1006 FORMAT (5X,3A2,2X,I4) 1008 CONTINUE C CLOSE ( UNIT=5) C CALL ASSIGN (5, 'DX:SIFLD1.LOT') CALL FDBSET (5, 'NEW') WRITE (5, 1012) RMLCNT 1012 FORMAT (3X, 'Total number of FIELD 1 lots found:',I4) DO 1018 I = 1, RMLCNT WRITE (5, 1016) (RMLOT(I,K), K=1,7) 1016 FORMAT (5X,6A2,2X,I4) 1018 CONTINUE C CLOSE ( UNIT=5) C CALL ASSIGN (5, 'DX:SIFLD1.DTE') CALL FDBSET (5, 'NEW') WRITE (5, 1022) RMUNKN 1022 FORMAT (2X,'A total of :',I4,' units were found with ', 1 'unknown dates') WRITE (5, 1024) RMDTLS, RMDTGT 1024 FORMAT (2X,'There were ',I3,' units that were made before we', 1 ' started counting',/, 2X, 'and there were ',I3, ' units', 2 ' were made after we started counting',//) DO 1026 I = 1, 30 J = I + 55 WRITE (5,1025) J,RMYEAR(I) 1025 FORMAT (2X,I2,3X,I5) 1026 CONTINUE WRITE (5,1027) 1027 FORMAT (//) DO 1029 I = 1, 360 KM = ((I-1)/12) JM = I - (KM*12) KM = KM +55 WRITE (5, 1028) KM,JM, RMDATE(I) 1028 FORMAT (5X,I2,'/',I2,3X,I4) 1029 CONTINUE C CLOSE ( UNIT=5) C C C Write out the results to files - SECOND FIELDS C CALL ASSIGN (5, 'DX:SIFLD2.MK') CALL FDBSET (5, 'NEW') WRITE (5, 1102) GGMCNT 1102 FORMAT (3X, 'Total number of FIELD 2 Mk/Mods found:',I2) DO 1108 I = 1, GGMCNT WRITE (5, 1006) (GGMK(I,K), K=1,4) 1108 CONTINUE C CLOSE ( UNIT=5) C CALL ASSIGN (5, 'DX:SIFLD2.LOT') CALL FDBSET (5, 'NEW') WRITE (5, 1112) GGLCNT 1112 FORMAT (3X, 'Total number of FIELD 2 lots found:',I4) DO 1118 I = 1, GGLCNT WRITE (5, 1016) (GGLOT(I,K), K=1,7) 1118 CONTINUE C CLOSE ( UNIT=5) C CALL ASSIGN (5, 'DX:SIFLD2.DTE') CALL FDBSET (5, 'NEW') WRITE (5, 1022) GGUNKN WRITE (5, 1024) GGDTLS, GGDTGT DO 1126 I = 1, 30 J = I + 55 WRITE (5,1025) J,GGYEAR(I) 1126 CONTINUE DO 1128 I = 1, 360 KM = ((I-1)/12) JM = I - (KM*12) KM = KM +55 WRITE (5, 1028) KM,JM, GGDATE(I) 1128 CONTINUE C CLOSE ( UNIT=5) C C Write out the last block read in (use octal) C CALL ASSIGN (5, 'SY:SITRAILS.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