Retro1.org codex

ACPAGE
      PROGRAM ACPAGE(RAF,TAPE2=RAF,TAPE3,TAPE7,TAPE10,
     1               TAPE11,OUTPUT,TAPE12)
C 
C --- PROGRAM TO PRINT OUT FORMATTED DATA REGARDING USER- 
C --- REQUESTED PRINTS. 
C 
C --- TAPE2 (RAF) IS THE RAW ACCOUNTING DATA (INPUT). 
C --- TAPE3 IS THE UNSORTED FILE WITH ONLY PRINT-RELATED
C ---       DATA. 
C --- TAPE7 IS WHERE ALL ERROR MESSAGES ARE WRITTEN, UNLESS 
C ---       THE REPORT ABORTS.
C --- TAPE10 IS THE SORTED PRINT-DATA FILE. 
C --- OUTPUT IS THE RESULT OF THE PROCESSING OF TAPE10. 
C ---       IT IS IN A FORMAT SIMILAR TO BCYTD-TYPE FILES.
C 
***** ***** *****    PHASE 1   ***** ***** *****
C 
      DIMENSION NAMES(5000,4),INPUT(55),LETTER(18)
C 
C --- ARRAYS -- 
C 
C ---  *NAMES* IS THE LIST OF PRINT-RELATED JOBNAMES. 
C ---      *NAMES(XXX,1)* IS THE JOB DATE.
C ---      *NAMES(XXX,2)* IS THE JOB TIME.
C ---      *NAMES(XXX,3)* IS THE JOB NAME.
C ---      *NAMES(XXX,4)* IS JOB NAME OF OUTPUT FILE(NOS V2)
C ---         * TO MATCH OUTPUT JSN BACK TO ORIGINAL JOB JSN
C ---  *INPUT* IS THE LIST OF ALL CHARS IN A PRINT ENTRY. 
C ---  *LETTER* IS THE LETTERS IN EACH WORD OF SAID ENTRY 
C 
      COMMON/BLOCK1/JOBDAT,JOBTIM,JOBNAM,NINPUT(6),NPER 
      COMMON/BLOCK2/LIST(12),MASKL4,MASKL6
      COMMON/WHATEVR/ KWASTE,WASTE
C 
C --- COMMON *BLOCK1* --
C 
C ---    *JOBDAT* - DATE OF JOB FROM NOS ACCOUNTING FILE. 
C ---    *JOBTIM* - TIME . . . . .
C ---    *JOBNAM* - NAME . . . . .
C ---    *NINPUT* - ARRAY CONTAINING THE OTHER 54 CHARS OF
C ---        THE ACCNTING FILE ENTRY. 
C ---    *NPER* - HOLLERITH CONSTANT = 1H.
C 
C --- COMMON *BLOCK2* --
C 
C ---    *LIST* - THE LIST OF ALL POSSIBLE PRINT-RELATED
C ---        ENTRIES IN THE ACCNTING FILE (IN L-FORMAT).
C ---    *MASKL4* - OCTAL MASK OF LEFTMOST 4 CHARACTERS.
C ---    *MASKL6* - OCTAL MASK OF LEFTMOST 6 CHARACTERS.
C 
      INTEGER WCNT, WORD (7), ARRAY (6), WASTE (3)
C 
C --- INTEGER VARIABLE -- 
C 
C --- *WCNT* - WORD COUNT VARIABLE
C 
C --- INTEGER ARRAYS -- 
C 
C --- *WORD* - THE WORDS FROM THE PRINT REQUEST ENTRY IN THE
C ---        ACCNTING FILE. 
C --- 
C ---        *WORD(1)* - *TPRINT*, *DPRINT*, *NPRINT*,
C ---                    *MODPRT* OR *DOCPRT*.
C ---        *WORD(3)* - ACCOUNT OF USER REQUESTING PRINT.
C ---        *WORD(4)* - GROUP OF USER REQUESTING PRINT.
C ---        *WORD(5)*,*WORD(6)* - NAME (18 CHARS) OF USER
C ---                  REQUESTING PRINT.
C ---        *WORD(7)* - USED AS ROOM FOR EXPANSION.
C 
      DATA LABUN/4LABUN/
      DATA LACUN/4LACUN/
      DATA LABSY/4LABSY/
      DATA LARSY/4LARSY/
      DATA LPS/4LPS  /
C 
      DATA (LIST(I),I=1,4)/4LTPRI,4LNPRI,4LDPRI,4LMODP/ 
      DATA (LIST(I),I=5,6)/4LDOCP,4LNMOD/ 
      DATA (LIST(I),I=7,10)/4LNDOC,1L ,1L ,1L / 
C 
C --- ARRAY *LIST* - SEE DESCRIPTION AT DIMENSION STMT. 
C 
      DATA MASKL2/7777 0000 0000 0000 0000B/
      DATA MASKL4/7777 7777 0000 0000 0000B/
      DATA MASKL6/7777 7777 7777 0000 0000B/
C 
C --- OCTAL CONSTANTS *MASKL4* + *MASKL6* -- SEE DESCRIP- 
C --- TION AT COMMON STATEMENT (COMMON BLOCK *BLOCK2*)
C 
      DATA LPRINTS/6LPRINTS/
      DATA JOBDAT/10H          /
      DATA NZZ/0/ 
      DATA KOUNT/0/ 
      DATA NPER/1H./
      DATA NCOM/1H,/
      DATA NPNT, NPNT2/2*1/ 
      DATA JOBDAT2/1H / 
C 
C 
      REWIND 2
      REWIND 3
      REWIND 7
      REWIND 10 
      REWIND 11 
C 
 10   CONTINUE
C 
C --- CHECK FOR LIMIT IN JOB NAMES IN ARRAY *NAMES*, FOR
C --- WHICH *KOUNT* IS A COUNTER. 
C 
      IF(KOUNT .GE. 5000) GOTO 3000 
C 
C --- READ 1 RECORD FROM NOS ACCOUNTING FILE. 
C 
      READ(2,5000) JOBTIM,JOBNAM,NINPUT 
5000  FORMAT(1X,A8,1X,A7,3X,6A10) 
C 
C --- CHECK FOR END-OF-FILE.  IF REACHED, GO TO PHASE 2.
C 
      IF(EOF(2))2000,15 
 15   CONTINUE
C     IF NOS V2 THEN JOBNAMES ARE SHIFTED 2 CHARS TO RIGHT
      IBLNK = JOBNAM .AND. MASK(12) 
      IF(IBLNK.EQ.2L  ) JOBNAM=SHIFT(JOBNAM,12) 
C 
C --- MASK OFF LEFTMOST 4 CHARACTERS OF ACCNTING FILE 
C 
      N1 = NINPUT(1) .AND. MASKL4 
C 
C --- CHECK FOR ALL POSSIBLE WAYS OF RE/SETTING DATE
C 
      IF (N1 .NE. LABSY) GO TO 18 
      DECODE (15,17,NINPUT) JOBDAT
 17   FORMAT(7X,A8) 
      GO TO 24
 18   IF (N1 .NE. LARSY) GO TO 21 
      DECODE (17,19,NINPUT) JOBDAT
 19   FORMAT(9X,A8) 
      GO TO 24
 21   IF (N1 .NE. LPS) GO TO 23 
      DECODE (19,22,NINPUT) JOBDAT
 22   FORMAT(11X,A8)
C 
 24   CONTINUE
C     FLAG THAT FACT THAT DATE WAS FOUND AND KEEP POINTER 
C     INTO JSN TABLE FOR WHERE CURRENT DAY AND PREVIOUS 
C     DAY START 
      NZZ=-1
      IF(JOBDAT.EQ.JOBDAT2) GOTO 25 
          JOBDAT2=JOBDAT
          NPNT2=NPNT
          NPNT=KOUNT
25    CONTINUE
      GO TO 10
 23   CONTINUE
C 
C --- CHECK TO SEE IF ANY DATE HAS BEEN SET YET.  IF NONE,
C --- GO BACK AND READ UNTIL ONE IS REACHED.
C 
      IF (NZZ .NE. -1) GO TO 10 
C 
C --- CHECK FOR JOBNAM .EQ. PLATXXX.  IF FOUND, GO BACK TO
C --- TOP OF READ LOOP. 
C 
C     FOLLOWING IS FOR NOS V1 AND NOS V2 CHANGES
      IF ((JOBNAM.AND.MASK(24)).EQ.4LPLAT) GO TO 10 
      IF ((JOBNAM.AND.MASK(24)).EQ.4LPLA1) GOTO 10
C 
C     CHECK FOR =UCLP= ENTRIES
      IF(N1.NE.4LUCLP) GOTO 39
      IF(KOUNT.LT.1) GOTO 10
C     FOR NOS V2
      JNAME2=(JOBNAM.AND.MASKL4).OR.5555 5555 5555B 
C     CHANGE =UCLP= TO =ZZZZ= FOR SORT PURPOSES 
      NINPUT(1)=(NINPUT(1).AND.7777 7777 7777B).OR.4LZZZZ 
C     MATCH JSN OF OUTPUT FILE =UCLP=(PRINT PAGES) ENTRY
C     BACK TO THE ORIGINAL SUBMITTED JOBS JSN.
C     SEARCH CURRENT DAY FOR MATCH TO JSN.
      DO 35 L=NPNT,KOUNT
         IF(NAMES(L,4).NE.JNAME2) GOTO 35 
C         APPEND THE VAR LL FOR SORT PURPOSES 
          LL=(2*L)+1
         WRITE(3,103) NAMES(L,1), JOBTIM, NAMES(L,3), 
     +    NINPUT, LL
C         MARK THE FACT THAT =UCLP= WAS MATCHED TO JOB
          NAMES(L,4)=-1 
         GOTO 10
35    CONTINUE
C     FOR NOS V1 (JOBNAME AND =UCLP= ENTRY HAVE SAME JSN) 
C     SEARCH CURRENT DAY FOR JSN
      DO 36 L=NPNT,KOUNT
         IF(NAMES(L,3).NE.JOBNAM) GOTO 36 
          IF(NAMES(L,4).EQ.-1) GOTO 36
C         APPEND THE VAR LL FOR SORT PURPOSES 
          LL=(2*L)+1
         WRITE(3,103) JOBDAT, JOBTIM, JOBNAM, NINPUT, LL
          NAMES(L,4)=-1 
         GOTO 10
36    CONTINUE
39    CONTINUE
C 
C --- ENTRY WITH FIRST 4 CHARS AS *ABUN* OR *ACUN* SHOWS THE
C --- BEGINNING OF A JOB. 
C 
      IF ((N1 .NE. LABUN) .AND. (N1 .NE. LACUN)) GO TO 49 
C 
C --- IF IT IS *ACUN*, SKIP 2 CHARS, AND DECODE OFF NEXT
C --- 6 CHARS INTO *N2* AND SEE IF IT EQUALS *LPRINTS*. 
C 
      DECODE (12,40,NINPUT) N2
 40   FORMAT(6X,A6) 
      N2 = N2 .AND. MASKL6
C 
C --- IF *N2* NOT EQUAL *LPRINTS*, IGNORE RECORD. 
C --- IF *N2* EQUALS *LPRINTS*, ADD 1 TO *KOUNT* AND ADD
C --- *JOBDAT*, *JOBTIM*, AND *JOBNAM* TO THE LIST OF JOB 
C --- NAMES AND THEN GO BACK. 
      IF (N2 .NE. LPRINTS) GO TO 10 
C 
C --- FIRST CHECK TO SEE IF THE NAME IS ALREADY IN THE LIST.
C     NOTE THAT WE DO NOT NEED BOTH =ABUN= AND =ACUN= ENTRY.
      IDUP=0
      DO 43 NK = NPNT, KOUNT
      IF (JOBNAM .NE. NAMES(NK,3)) GO TO 43 
      IF (JOBDAT .NE. NAMES(NK,1)) GO TO 43 
      IDUP=1
      IF (JOBTIM .NE. NAMES(NK,2)) GO TO 43 
      WRITE (7,41) JOBDAT,JOBTIM,JOBNAM,(NINPUT(MM),MM=1,4) 
 41   FORMAT (2A8,A7,1X,4A10,25X,*DUPLICATE RECORD*)
      GO TO 10
 43   CONTINUE
      IF(IDUP.GT.0) GOTO 10 
      KOUNT = KOUNT + 1 
      NAMES(KOUNT,1) = JOBDAT 
      NAMES(KOUNT,2) = JOBTIM 
      NAMES(KOUNT,3) = JOBNAM 
      NAMES(KOUNT,4) = 0
      GO TO 10
C 
C --- SINCE THE FIRST 4 CHARS WERE NOT *ABUN*/*ACUN*, CHECK 
C --- TO SEE IF THE JOB NAME IS ON THE LIST, BY LOOPING 
C --- THROUGH ARRAY *NAMES* *KOUNT* TIMES.
C 
 49   CONTINUE
      IF(KOUNT.LT.1) GOTO 10
C     SEARCH JSNS OF CURRENT DAY TO SEE IF RECORD HAS 
C     JOBNAME OF A JOB BEING PROCESSED
      DO 101 I=NPNT,KOUNT 
      IF (JOBNAM .NE. NAMES(I,3)) GO TO 101 
C     CHECK THAT JSN NOT ALREADY MATCHED/PROCESSED
      IF(NAMES(I,4).EQ.0) GOTO 100
      IF(N1.EQ.4LABLQ) GOTO 101 
100   CONTINUE
              INDXX=I 
              GOTO 102
 101  CONTINUE
C 
C --- IF THIS POINT IS REACHED, JOB NAME WAS NOT FOUND IN 
C --- ARRAY *NAMES*, SO THE RECORD IS IGNORED.
C 
      GO TO 10
C 
C --- THIS LOOP CHECKS TO SEE IF THE FIRST 4 CHARS EQUAL
C --- ANY OF THE PRINT-TYPE ENTRIES THAT ARE TO BE PRO- 
C --- CESSED. 
C 
 102  CONTINUE
      DO 104 J=1,7
      IF (N1 .NE. LIST(J)) GO TO 104
      LL=2*INDXX
      WRITE(3,103) JOBDAT, JOBTIM, JOBNAM, NINPUT, LL 
 103  FORMAT(2A8,A7,1X,6A10,I5) 
      GO TO 10
 104  CONTINUE
C 
C     GET JOBNAME OF OUTPUT FILE FROM =ABLQ= RECORD 
      IF(N1.NE.4LABLQ) GOTO 105 
      IF((SHIFT(NINPUT(1),36).AND.MASKL2).NE.2LC1) GOTO 105 
C     SAVE THE JSN OF OUTPUT FILE TO MATCH THE LATER
C     =UCLP= ENTRY TO COME WHEN FILE IS PRINTED.
      NAMES(INDXX,4)=(NINPUT(2).AND.MASKL4).OR.5555 5555 5555B
105   CONTINUE
C 
C --- IF THIS POINT IS REACHED, THEN THE ENTRY IS ONE OF
C --- THE NON-DESIRABLE PRINT-TYPE ENTRIES, AND THIS
C --- RECORD IS ALSO IGNORED. 
      GO TO 10
C 
 2000 CONTINUE
C 
***** ***** *****    PHASE 2    ***** ***** ***** 
C 
C --- SORT TAPE 3, RESULT IS ON TAPE 10 
C --- SORT WITH RESPECT TO -- 
C 
C ---        1) JOB DATE
C ---        2) JOB NAME
C ---        3) TYPE FIELD
C 
      REWIND 3
      REWIND 10 
C 
      CALL SM5SORT(0) 
      CALL SM5FROM("TAPE3") 
      CALL SM5TO("TAPE10")
C     SORT ONLY ON INTEGER FIELD APPENDED TO THE PRINT
C     AND UCLP ENTRIES.  ONCE SORTED, ALL UCLP ENTRIES
C     SHOULD FOLLOW THE JOBS PRINT TYPE ENTRY.
      CALL SM5KEY(85,5,"COBOL6")
      CALL SM5END 
C 
C --- THIS SECTION READS DATA OFF THE SORTED FILE AND PRO-
C --- CESSES IT.
C 
      REWIND 3
      REWIND 10 
C 
C --- SET EACH ELEMENT OF *LETTER* TO O55 = 1H  = BLANK 
C 
 201  DO 202 IZ=1,18
 202  LETTER (IZ) = 1H
C 
C --- SET EACH ELEMENT OF *WORD* TO 1 BLANK-FILLED WORD.
C 
      DO 203 IZ=1,7 
 203  WORD(IZ)=10H
C 
C --- SET WORD AND LETTER COUNTS TO ZERO. 
C 
      LCNT = 0
      WCNT = 0
C 
C --- READ ONE RECORD, COMPOSED OF JOBNAME (*JWASTE*) AND 
C --- *ARRAY*, WHICH IS THE -TPRINT- RECORD.
C 
 210  CONTINUE
      READ (10,220) JOBDAT, JOBTIM, JWASTE, ARRAY 
 220  FORMAT(2A8,A7,1X,6A10)
C 
C --- CHECK FOR END-OF-FILE -- IF FOUND, GO TO -STOP- STMT
C --- (I.E., END REPORT). 
C 
      IF (EOF(10)) 999, 211 
 211  CONTINUE
C 
C --- CHECK TO SEE IF *UCLP* ENTRY. 
C 
      IF ((ARRAY(1).AND.MASK(24)).EQ.4LZZZZ) GO TO 210
C 
C --- BREAK UP *ARRAY* INTO 55 INDIVIDUAL LETTERS.
C 
      DECODE(55,221,ARRAY)(INPUT(I),I=1,55) 
 221  FORMAT(55A1)
C 
C --- LOOP TO SEARCH FOR PERIODS/COMMAS IN *INPUT*. 
C 
      NFLG1 = NFLG2 = 0 
C 
      DO 245 I = 1, 55
C 
C --- CHECK TO SEE IF WCNT EQUALS 5 OR MORE YET.  IF SO,
C --- GO TO A POINT BEYOND THIS LOOP, BECAUSE ALL THE 
C --- WORDS HAVE BEEN SEPARATED.
C 
 222  CONTINUE
      IF (WCNT.GE.5) GO TO 246
C 
      NZ = INPUT(I) 
C 
C --- CHECK FOR CHAR EQUALING 1H. OR 1H, OR THE LETTER
C --- COUNT BEING GREATER THAN OR EQUAL TO 18, THE MAXIMUM
C --- NUMBER OF PERMISSIBLE LETTERS IN A WORD (NOT COMPUTER 
C --- WORD, BUT TEXT WORD). 
C 
      IF((NZ.EQ.NCOM).OR.(NZ.EQ.NPER).OR.(LCNT.GE.18)) GO TO 230
C 
C --- LETTER IS NON-PERIOD/COMMA AND LETTER COUNT IS LESS 
C --- THAN 18.
C 
C --- ADD 1 TO THE LETTER COUNT AND PUT THE CHAR PRESENTLY
C --- UNDER CONSIDERATION INTO ARRAY *LETTER*, AS THE 
C --- *LCNT*TH ELEMENT.  THEN GO TO THE -CONTINUE- TO 
C --- CONTINUE PROCESSING WITH THE NEXT CHAR. 
C 
      LCNT = LCNT + 1 
      LETTER (LCNT) = NZ
      GO TO 245 
C 
C --- A PERIOD OR COMMA HAS BEEN FOUND (OR THE LETTER COUNT 
C --- HAS REACHED 18).
C 
 230  CONTINUE
C 
      IF ((WORD(1).AND.MASK(24)).EQ.LIST(4)) NFLG1 = -1 
      IF ((WORD(1).AND.MASK(24)).EQ.LIST(5)) NFLG1 = -1 
      IF((WORD(1).AND.MASK(24)).EQ.LIST(11)) NFLG1=-1 
C 
C --- ADD 1 TO THE WORD COUNT, *WCNT*.
C 
      WCNT = WCNT + 1 
C 
C --- IN CASE OF ERROR, SKIP THE WORD, LEAVING IT BLANK.
C 
      IF (LCNT .EQ. 0) GO TO 234
C 
C --- PUT ALL *LCNT* LETTERS INTO ARRAY *WORD*, STARTING
C --- WITH *WORD(WCNT)*.  (FORMAT IS OF 18 CHARS, SINCE THAT
C --- IS THE MAXIMUM NUMBER OF CHARS THAT CAN BE ASSEMBLED.)
C 
      ENCODE(LCNT,233,WORD(WCNT))(LETTER(K),K=1,LCNT) 
 233  FORMAT(18A1)
C 
C --- SET EACH ELEMENT OF ARRAY *LETTER* TO 1 BLANK.
C 
 234  CONTINUE
      IF (NFLG1.EQ.0) GOTO 235
      IF (NFLG2.EQ.0) GOTO 236
      NFLG1 = NFLG2 = 0 
      GO TO 235 
 236  IF (WCNT.NE.3) GOTO 235 
      WCNT = WCNT - 1 
      NFLG2 = -1
C 
 235  CONTINUE
      DO 237 K=1,18 
 237  LETTER(K) = 1H
C 
C --- RESET *LCNT* TO ZERO AND CONTINUE PROCESSING. 
C 
      LCNT = 0
 245  CONTINUE
 246  CONTINUE
C 
C --- AFTER ALL THE CHARS OF THE FIRST STRING HAVE BEEN 
C --- PROCESSED, READ THE NEXT RECORD.  THIS RECORD IS
C --- MADE OF THE JOBNAME (*KWASTE*) AND THE NUMBER OF
C --- KILO-LINES PRINTED TO FULFILL THE PRINT REQUEST.
C --- THE SECOND OF THESE IS READ IN ALPHANUMERIC FORMAT
C --- IN ORDER TO CATCH MISTAKES, LIKE A MISSING RECORD 
C --- FOR THE NUMBER OF PRINTED LINES, ETC. 
C 
      READ (10,247) KWASTE, WASTE 
 247  FORMAT (16X,A7,1X,3A10) 
C 
C --- CHECK FOR END-OF-FILE.  IF ENCOUNTERED, PRINT AN ERROR
C --- MESSAGE ABOUT A MISSING -UCLP- ENTRY AND PROCEED TO 
C --- ROUTINE *PHASE3*. 
C 
      IF (EOF(10) .EQ. 0) GO TO 250 
C 
      WRITE (7,4001) JOBDAT, JOBTIM, JOBNAM, ARRAY
      GO TO 999 
C 
 250  CONTINUE
C 
C --- CHECK TO SEE IF THE TWO ENTRIES HAVE THE SAME JOB 
C --- NAME.  IF NOT, PRINT OUT AN ERROR MESSAGE.
C 
      N99 = WASTE(1).AND.MASK(24) 
      IF ((KWASTE.NE.JWASTE).OR.(N99.NE.4LZZZZ)) GO TO 4000 
C 
C 
C     FORMAT OF -UCLP- ENTRIES SEEMS TO KEEP CHANGING SO
C     THE FLOATING POINT FIELD CONTAINING NUMBER OF LINES 
C     PRINTED KEEPS MOVING.  SOLUTION IS TO HAVE THE
C     FOLLOWING ROUTINE LOCATE THE DECIMAL POINT AND THEN 
C     RETURN THE NUMBER OF LINES BASED ON WHERE THE 
C     DECIMAL POINT WAS FOUND.
      CALL FINDPNT(JJNUM) 
C     MAKE SURE WE REALLY HAVE A FLOATING POINT NUMBER
      CALL FCHECK(JJNUM,JFLAG)
      IF(JFLAG.LT.0) GOTO 201 
          DECODE(10,301,JJNUM) XLINES 
301       FORMAT(F10.3) 
C 
C --- CONVERT KILO-LINES TO PRINTER PAGES.
C 
 320  CONTINUE
      NOPAGES = INT (XLINES * 100. / 6.)
C 
C --- CHECK TO SEE IF EQUATION YIELDS A FRACTION OF A PAGE. 
C --- IF SO, ADD 1 TO NOPAGES.
C 
      IF ((XLINES*100./6.)-FLOAT(NOPAGES).GT.0.001)NOPAGES = NOPAGES+1
C 
C --- OUTPUT -- USER ACCNT, USER GROUP, USER NAME, NAME 
C --- OF LESSON/FILE BEING PRINTED, NUMBER OF PAGES OF
C --- OUTPUT AND DATE OF PRINTING.
C 
      WRITE (11,401) (WORD(L),L=3,6),WORD(2),NOPAGES,JOBDAT 
 401  FORMAT(1X,A7,1X,2(A8,A10),I10,3X,A8)
      GO TO 201 
C 
 999  CALL PHASE3 
C 
      STOP
C 
C --- ERROR MESSAGES. 
C 
 3000 CONTINUE
      PRINT 3001
 3001 FORMAT(////* ERROR -- DIMENSION OF ARRAY -NAMES- OF */
     1      * 5000 HAS BEEN EXCEEDED. REPORT STOPPED.*/)
      STOP
C 
C --- 
C 
 4000 CONTINUE
      WRITE (7,4001) JOBDAT,JOBTIM,JWASTE,ARRAY 
 4001 FORMAT(2A8,A7,1X,6A10,5X,*RECORD IGNORED*)
C 
C --- BACKSPACE TAPE10 ONE RECORD IN ORDER TO RE-READ 
C --- THE RECORD WHICH DID NOT MATCH WITH THE CONTENTS
C --- OF *ARRAY* AT THE TIME OF THE PRINTING OF THIS
C --- ERROR MESSAGE.
C 
      BACKSPACE 10
C 
C --- GO BACK TO THE TOP OF THE READ LOOP.
C 
      GO TO 201 
C 
C --- 
C 
      END 
      SUBROUTINE PHASE3 
C 
C --- ROUTINE TO PROCESS THE DATA FROM TAPE11 TO PRODUCE
C --- REPORT-TYPE OUTPUT. 
C 
      COMMON/PAGE/IPAGE,ILINE 
C 
      INTEGER ACCT(500,2) 
      DIMENSION INPLIN(9), MESS(2)
C 
      DATA IACCT/-1/,LACCT/0/,IFLAG1/-1/
      DATA KOUNT/1/,ACCT/1000*0/,NTOTAL/0/
C 
      REWIND 11 
      REWIND 12 
C 
C --- SORT TAPE11 BY ACCOUNT, GROUP, USER NAME, FILE NAME,
C --- DATE PRINTED AND NUMBER OF PAGES PRINTED. 
C 
      CALL SM5SORT(0) 
      CALL SM5FROM("TAPE11")
      CALL SM5TO("TAPE12")
      CALL SM5KEY(2,7,"DISPLAY")
      CALL SM5KEY(10,8,"DISPLAY") 
      CALL SM5KEY(18,18,"DISPLAY")
      CALL SM5KEY(36,10,"COBOL6") 
      CALL SM5KEY(59,8,"DISPLAY") 
      CALL SM5KEY(46,10,"COBOL6") 
      CALL SM5END 
C 
      REWIND 12 
      IPAGE = 1 
      ILINE = 12
C 
 1    CONTINUE
      READ (12,2) IACCT,IGRP,NAME1,NAME2,IFLNAM,NPAGES,IDATE
 2    FORMAT(1X,A7,1X,2(A8,A10),I10,3X,A8)
C 
C --- CHECK FOR END-OF-FILE.
C 
      IF (EOF(12)) 10, 3
C 
C --- CHECK TO SEE IF THIS ACCOUNT NAME = LAST ACCOUNT NAME 
C 
 3    CONTINUE
      IF (LACCT.EQ.IACCT) GO TO 6 
C 
C --- IF NOT, PRINT OUT THE TOTAL NUMBER OF PAGES FOR LACCT,
C --- THE LAST ACCOUNT NAME AND A NEW PAGE FOR IACCT, THE 
C --- ACCOUNT NAME JUST READ IN.
C 
C --- FIRST CHECK TO SEE IF *IFLAG1* IS -1, MEANING THAT
C --- THIS IS THE FIRST TIME THIS AREA HAS BEEN REACHED 
C --- AND NO -TOTAL PAGES PRINTED- OUTPUT IS NEEDED.
C 
      IF (IFLAG1.EQ.-1) GO TO 9 
      IF (ILINE.LE.49) GO TO 907
      CALL PAGE 
      PRINT 5, IACCT
 907  CONTINUE
      PRINT 4, ACCT(KOUNT-1,2)
 4    FORMAT(///11X,7H*TOTAL*,57X,I10)
C 
C --- PRINT THE NEW PAGE HEADING FOR *IACCT*. 
C 
 9    CONTINUE
      CALL PAGE 
      PRINT 5, IACCT
 5    FORMAT (///21X,*ACCOUNT *,A7///11X,*NAME*,19X,*GROUP*,
     1        8X,*FILE NAME*,8X,*DATE*,12X,*PAGES*//) 
C 
C --- SET ACCT(KOUNT,1) TO IACCT
C 
      ACCT(KOUNT,1) = IACCT 
      KOUNT = KOUNT + 1 
      IF (KOUNT.EQ.501) GO TO 10
C 
C --- SET *IFLAG1* TO 0.
C 
      IFLAG1 = 0
C 
C --- PRINT OUT THE USER'7S RECORD.  FIRST, HOWEVER, CHECK TO 
C --- SEE IF THE OUTPUT WILL BE GOING PAST THE 55TH LINE ON 
C --- THE PAPER. IF SO, RESTORE THE LINE COUNT AND PRINT A
C --- NEW HEADING.
C 
 6    CONTINUE
      IF (ILINE.LE.52) GO TO 7
      CALL PAGE 
      PRINT 5, IACCT
 7    CONTINUE
      PRINT 8, NAME1,NAME2,IGRP,IFLNAM,IDATE,NPAGES 
 8    FORMAT (11X,A10,2(A8,5X),A10,5X,A8,5X,I10)
C 
      ACCT(KOUNT-1,2) = ACCT(KOUNT-1,2) + NPAGES
      ILINE = ILINE + 1 
      LACCT = IACCT 
C 
C --- RETURN BACK TO THE TOP OF THE READ LOOP.
C 
      GO TO 1 
C 
C --- END-OF-FILE ENCOUNTERED -- PRINT THE TOTAL OF THE 
C --- LAST ACCOUNT PROCESSED AND PRINT OUT THE SUMMARY. 
C 
 10   CONTINUE
      IF (KOUNT.EQ.1) GO TO 32
      IF (ILINE.LE.49) GO TO 908
      CALL PAGE 
      PRINT 5, IACCT
 908  CONTINUE
      PRINT 4, ACCT(KOUNT-1,2)
C 
C --- PRINT OUT THE SUMMARY OF ACCOUNT PRINT REQUESTS.
C 
      CALL PAGE 
      PRINT 11
 11   FORMAT (///36X,*SUMMARY OF PAGES PRINTED*////)
C 
C --- LOOP TO PRINT OUT THE LIST OF ACCOUNTS
C 
      KOUNT = KOUNT - 1 
C 
      DO 20 I = 1, KOUNT
      IF (ILINE.LE.52) GO TO 14 
      CALL PAGE 
      PRINT 11
 14   CONTINUE
      PRINT 15, ACCT(I,1), ACCT(I,2)
 15   FORMAT (21X,*ACCOUNT *,A7,30X,I10,* PAGES*) 
      NTOTAL = NTOTAL + ACCT(I,2) 
 20   CONTINUE
C 
C --- PRINT OUT THE GRAND TOTAL NUMBER OF PAGES PRINTED.
C 
      IF (ILINE.LE.49) GO TO 909
      CALL PAGE 
      PRINT 5, IACCT
 909  CONTINUE
      PRINT 30, NTOTAL
 30   FORMAT (///21X,7H*TOTAL*,38X,I10,* PAGES*)
      GOTO 40 
32    CONTINUE
      PRINT 33
33    FORMAT(1H1///,5X,2H**,* NO USERS TO BILL WITH INPUT*, 
     +    * DATA PROVIDED*) 
C 
C --- PRINT OUT LIST OF ERRORS ON TAPE7.
C 
 40   IPAGE = 1 
      ILINE = 12
      CALL PAGE 
C 
      PRINT 50
 50   FORMAT (1H1///,5X,2H**,* ERROR SUMMARY FOR INPUT DATA*
     +    ,3H **) 
C 
      REWIND 7
C 
C --- LOOP TO READ FROM TAPE7 AND PRINT TO OUTPUT.
C 
 51   CONTINUE
      IF (ILINE.LE.52) GO TO 52 
      CALL PAGE 
      PRINT 50
 52   CONTINUE
C 
      READ (7,60) INPLIN, MESS
 60   FORMAT (8A10,A3,5X,2A10)
C 
C --- CHECK FOR END-OF-FILE.  IF ENCOUNTERED, STOP. 
C 
      IF (EOF(7)) 65,59 
59    CONTINUE
C 
      PRINT 61, INPLIN, MESS
 61   FORMAT (5X,8A10,A3,15X,2A10)
C 
      GO TO 51
65    CONTINUE
      PRINT 66
66    FORMAT(5X,* -- END OF INFORMATION --*)
      STOP
C 
      END 
      SUBROUTINE FINDPNT(JJNUM) 
      INTEGER WASTE(3),STRING(30) 
      COMMON/WHATEVR/ KWASTE,WASTE
      JJNUM=0 
      K=0 
C     BREAK ARRAY UP INTO A STRING OF CHARACTERS
      DO 100 I=1,3
          ITEMP=WASTE(I)
          DO 100 J=1,10 
              K=K+1 
              ITEMP=SHIFT(ITEMP,6)
              ICHAR=ITEMP.AND.77B 
              STRING(K)=ICHAR 
100   CONTINUE
C 
C     FIND DECIMAL POINT IN FLOATING POINT NUMBER OF LINES
      DO 200 I=7,27 
          IF(STRING(I).NE.1R.) GOTO 200 
              IPNT=I
              GOTO 300
200   CONTINUE
      PRINT 250 
250   FORMAT(* -- ERROR WITH UCLP ENTRIES*) 
      STOP
300   CONTINUE
C 
      IPNT=IPNT-6 
C     COPY FLOATING POINT NUMBER TO A SEPERATE WORD 
      DO 400 I=1,10 
          JJNUM=SHIFT(JJNUM,6)
          JJNUM=JJNUM.OR.STRING(IPNT) 
          IPNT=IPNT+1 
400   CONTINUE
      RETURN
      END 
C 
C 
      SUBROUTINE FCHECK(JPARAM,IFLAG) 
      INTEGER WASTE(3)
      COMMON/WHATEVR/ KWASTE,WASTE
C 
      JVAL = JPARAM 
      DO 100 I = 1,10 
          ITEMP = JVAL.AND.77B
          JVAL = SHIFT(JVAL,-6) 
          IF(I.NE.4) GOTO 50
              IF(ITEMP.NE.57B) GOTO 200 
              GOTO 100
50        CONTINUE
          IF( .NOT.( ((ITEMP.GT.32B).AND.(ITEMP.LT.45B))
     +              .OR. (ITEMP.EQ.55B) )) GOTO 200 
100   CONTINUE
C 
      IFLAG = 0 
      RETURN
200   CONTINUE
      WRITE(7,300) KWASTE, WASTE
300   FORMAT(*   BAD REC - *,4A10)
      IFLAG = -1
      RETURN
      END 
      SUBROUTINE PAGE 
C 
C --- SUBROUTINE TO PRINT OUT AND INCREMENT THE PAGE NUMBER.
C 
      COMMON/PAGE/IPAGE,ILINE 
C 
      PRINT 1, IPAGE
 1    FORMAT (1H1////106X,*PAGE *,I4) 
C 
      IPAGE = IPAGE + 1 
      ILINE = 12
C 
      RETURN
      END