SUBROUTINE INITCT (MAX, MRKLOT, UNTCNT, WRDCNT, IN, CHRCNT, LOST) C C This subroutine is to initialize the Mk/Mods and Lots C C MAX - The maximum number of Mk/Mods and Lots allowed C MRKLOT - The total collection of Mk/Mods and Lots C UNTCNT - The number of Mk/Mods or Lots found so far C WRDCNT - The number of words to write (should be the number of C characters divided by two) C IN - The current Mk/Mod or Lot C CHRCNT - Number of pairs of characters, by definition one less than C WRDCNT C LOST - The number of units 'LOST' because the allocated storage space C was to small C IMPLICIT INTEGER (A-Z) C C One is used as a null variable because the actual dimensions on the arrays C are unknown C DIMENSION MRKLOT (MAX, WRDCNT), IN(CHRCNT) C C Put an initial value here for the first one found C UNTCNT = 1 DO 100 I = 1,CHRCNT MRKLOT (UNTCNT,I) = IN(I) 100 CONTINUE RETURN END SUBROUTINE CCOUNT (MAX, MRKLOT, UNTCNT, WRDCNT, IN, CHRCNT, LOST) C C This subroutine is to take and count the number of Mark/Mods and Lots C C MAX - Maximum number of Mk/Mods and Lots allowed C MRKLOT - The collection of total Mk/Mods and Lots C UNTCNT - The number of Mk/Mods or Lots found so far C WRDCNT - The number of words to compare (should be the number of C characters divided by two) C IN - The current Mk/Mod or Lot C CHRCNT - The number of pairs of characters, by definition one less C than WRDCNT C LOST - The number of units 'LOST' because the allocated storage space C was to small C IMPLICIT INTEGER (A-Z) C DIMENSION MRKLOT (MAX, WRDCNT), IN(CHRCNT) C C C Compare the rocket motor Mk/Mod and count as neccessary C DO 110 I = 1,UNTCNT DO 100 J = 1,CHRCNT IF (IN(J) .NE. MRKLOT(I,J)) GO TO 110 100 CONTINUE MRKLOT (I, WRDCNT) = MRKLOT (I, WRDCNT) + 1 !This exists, add one GO TO 130 110 CONTINUE UNTCNT = UNTCNT + 1 IF ( UNTCNT .LE. MAX) GO TO 115 UNTCNT = MAX LOST = LOST + 1 !Lost a Mk/Mod or Lot GO TO 130 115 CONTINUE DO 120 I = 1, CHRCNT MRKLOT (UNTCNT,I) = IN(I) 120 CONTINUE MRKLOT (UNTCNT, WRDCNT) = 1 130 CONTINUE RETURN END SUBROUTINE DOMCNT (MNTHCT, YEARCT, INDATE, UNKNWN, ZERO, TOOBIG) C C Read, decode and count the date of manufacturing (DOM); C C MNTHCT - The name of the array that has the manufacturing data by month C YEARCT - The name of the array that has the manufacturing data by year C INDATE - The array name that has the current month/year combination C UNKNWN - The name of the variable which says that the DOM is unknown C IMPLICIT INTEGER (A-Z) C DIMENSION MNTHCT(360), YEARCT(30), INDATE(2) IF (INDATE(1) .NE. ' ' .AND. INDATE(2) .NE. ' ') GO TO 100 UNKNWN = UNKNWN + 1 !Unknown manuf date GO TO 140 100 DECODE (4, 110, INDATE) MANUYR, MANUMT C C MANUYR - Manufacturing year MANUMT - Manufacturing month C 110 FORMAT (2I2) C YEAR = MANUYR - 55 MONTH = ( YEAR * 12) + MANUMT IF (MONTH .GT. 0) GO TO 120 ZERO = ZERO + 1 GO TO 140 120 IF (MONTH .LE. 360) GO TO 130 TOOBIG = TOOBIG + 1 GO TO 140 130 MNTHCT (MONTH) = MNTHCT (MONTH) + 1 YEARCT (YEAR) = YEARCT (YEAR) + 1 C 140 CONTINUE RETURN END SUBROUTINE WRITEN (MAX, WRDCNT, MRKLOT, UNTCNT, LOST, UNIT, FIELD) C C This subroutine writes out a file which has already been opened and writes C out elements of an array that is N X M elements. The first M - 1 elements C are alpha-numeric characters in an A2 format, the M-th is an integer C less than 9999. C C WRDCNT - The number of words to write out (i.e. the number of pairs C of chars plus one) C MRKLOT - The total collection of Mk/Mods and Lots C UNTCNT - The number of items found C LOST - The number of units 'LOST' because the allocated storage space C was to small C UNIT - An alpha field denoting the system that the data is C from (4 chars max) C FIELD - An alpha field denoting field being printed (4 chars max) C IMPLICIT INTEGER (A-Z) REAL UNIT, FIELD DIMENSION FMT(8) !! Run-time format C DIMENSION MRKLOT( MAX, WRDCNT) C C FORMAT (5X,--A2,2X,I4) DATA FMT / '(5', 'X,', ' ', 'A2', ',2', 'X,', 'I4', ')' / C WRDCT1 = WRDCNT - 1 WRITE (5, 100) UNIT, FIELD, UNTCNT, LOST 100 FORMAT (4X, 'Unit:',A4,4X, 'Field:',A4, 3X,'Total:', 1 'number of items found:',I4,4X, 'Lost items:', I4) ENCODE (2, 105, TEMP) WRDCT1 105 FORMAT (I2) FMT(3) = TEMP DO 120 I = 1, UNTCNT WRITE (5, FMT) (MRKLOT(I,K), K=1, WRDCNT) C 110 FORMAT (5X,3A2,2X,I4) 120 CONTINUE C RETURN END SUBROUTINE PRTDTE (QYEAR, QMONTH, UNKNWN, LSSTHN, GRTHAN, 1 UNIT, FIELD) C C This program is to print out the dates of manufacture and quantities C for the results of this age program. C C QYEAR - Quantity made in that year C QMONTH - Quantity made in that month C UNKNWN - Quantity that have an unknown date C LSSTHN - Quantity that were made before we started counting (1955) C GRTHAN - Quantity that were made after we started counting (1984) C UNIT - An alpha field denoting the system that the data is C from (4 chars max) C FIELD - An alpha field denoting field being printed (4 chars max) C IMPLICIT INTEGER (A-Z) REAL UNIT, FIELD C DIMENSION QYEAR(30), QMONTH(360) C WRITE (5, 10) UNIT, FIELD 10 FORMAT (4X, 'Unit:',A4,4X, 'Field:',A4) C WRITE (5, 100) UNKNWN 100 FORMAT (2X,'A total of :',I4,' units were found with ', 1 'unknown dates') WRITE (5, 110) LSSTHN, GRTHAN 110 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 130 I = 1, 30 J = I + 55 WRITE (5,120) J,QYEAR(I) 120 FORMAT (2X,I2,3X,I5) 130 CONTINUE WRITE (5,150) 150 FORMAT (//) DO 200 I = 1, 360 KM = ((I-1)/12) JM = I - (KM*12) KM = KM +55 WRITE (5, 175) KM,JM, QMONTH(I) 175 FORMAT (5X,I2,'/',I2,3X,I4) 200 CONTINUE C RETURN END