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