Google
 

Trailing-Edge - PDP-10 Archives - BB-4172G-BM - 4-sources/usah20.for
There are 17 other files named usah20.for in the archive. Click here to see a list.
C 20-JUN-78 /BAH PUT IN WARNING ABOUT USING THE VERSION 4 OF SORT.
C	THE FORMAT OF THE SORT CALL CHANGED WITH THIS VERSION.
C ************************************************************************
C	PROGRAM V3A(2) TO READ A RATE FILE, USAG20.CHG, AND A FILE IN THE USAGE
C	FORMAT AND CREATE A BILLING SUMMARY LISTING
C ************************************************************************

	PROGRAM USAH20
	IMPLICIT INTEGER (A-Z)
	REAL FRATE,FSESCO,FSESRU,FPAGRU,FPAGPA,FCRDRU,FCRDCR,FDSKPA
	REAL FRUNTI,FCONNE,FCHARG
	DOUBLE PRECISION INFIL,OUTFIL
	DIMENSION CDATE(3),IDATE(5),FDATE(5),LDATE(5)
	DIMENSION PROGNA(6),PROVER(15),MODVER(15),NODE(6)
	DIMENSION ZSYSNA(39),A(40)
	EQUIVALENCE (IDATE(1),YEAR), (IDATE(2),MONTH), (IDATE(3),DAY),
	1 (IDATE(4),HOUR), (IDATE(5),MINUTE)
	TYPE 2001

C GET THE RATES FOR RUNTIMES, CONNECT TIME, AND DISK PAGES

	OPEN (FILE='USAG20.CHG', DEVICE='DSK', UNIT=1, ACCESS='SEQIN')
1	READ (1,1001,END=2) CHGCOD,FRATE
	IF (CHGCOD.EQ.'SESCO') FSESCO=FRATE
	IF (CHGCOD.EQ.'SESRU') FSESRU=FRATE
	IF (CHGCOD.EQ.'PAGRU') FPAGRU=FRATE
	IF (CHGCOD.EQ.'PAGPA') FPAGPA=FRATE
	IF (CHGCOD.EQ.'CRDRU') FCRDRU=FRATE
	IF (CHGCOD.EQ.'CRDCR') FCRDCR=FRATE
	IF (CHGCOD.EQ.'DSKPA') FDSKPA=FRATE
	GO TO 1
2	CLOSE (FILE='USAG20.CHG', DEVICE='DSK', UNIT=1)

C ************************************************************************
C	THIS IS THE BEGINNING OF THE MAIN LOOP.
C ************************************************************************

C ASK THE USER FOR INPUT, OUTPUT FILENAMES, TYPE OF REPORT AND SORT

3	CALL QUEST (INFIL,OUTFIL,REPORT,SORTBY)

C GET THE CURRENT DATE AND TIME OF THE RUN

	CALL DATE (CDATE)
	CALL TIME (CDATE(3))
	IF ( (REPORT.EQ.'S') .AND. (SORTBY.EQ.'N') ) GO TO 400
	IF ( (REPORT.EQ.'S') .AND. (SORTBY.EQ.'A') ) GO TO 400
	IF ( (REPORT.EQ.'D') .AND. (SORTBY.EQ.'N') ) GO TO 500
	IF ( (REPORT.EQ.'D') .AND. (SORTBY.EQ.'A') ) GO TO 500
	GO TO 3

C ************************************************************************
C	END OF MAIN LOOP
C ************************************************************************
C ************************************************************************
C	REPORT OF SYSTEM USAGE SORTED ON NAME OR ACCOUNT SECTION
C ************************************************************************

400	OPEN (FILE=INFIL, DEVICE='DSK', UNIT=1, ACCESS='SEQIN')
	OPEN (FILE='INSRT.TMP', DEVICE ='DSK', UNIT=2, ACCESS='SEQOUT')

C INITIALIZE THE FIRST DATE-TIME AND LAST DATE-TIME SO THE ENTRY TIME
C RANGE CAN BE REPORTED.

401	READ (1,1049,END=450) ENTRY,OS,RECSEQ,DECREV,CUSREV,A
	IF (RECSEQ.NE.1) GO TO 401
	DECODE (65,1050,A) JOB,YEAR,MONTH,DAY,HOUR,MINUTE,SECOND,
	1 TERMD,LINENO,PROGNA,PROVER,MODVER,NODE
	DO 402 I=1,5
	FDATE(I)=IDATE(I)
	LDATE(I)=IDATE(I)
402	CONTINUE
	GO TO 408

C THIS POINT IS THE ACTUAL BEGINNING OF THE MAIN LOOP FOR REPORT BY
C SYSTEM USAGE

403	READ (1,1049,END=450) ENTRY,OS,RECSEQ,DECREV,CUSREV,A
404	IF (RECSEQ.NE.1) GO TO 403
	DECODE (65,1050,A) JOB,YEAR,MONTH,DAY,HOUR,MINUTE,SECOND,
	1 TERMD,LINENO,PROGNA,PROVER,MODVER,NODE


C NOW GO PROCESS THE ENTRY

408	IF (ENTRY.EQ.1) CALL PRORES (ZSYSNA,$405,$406,$407)
	IF ( (ENTRY.EQ.2) .OR. (ENTRY.EQ.3) )
	1 CALL PROSES (FSESCO,FSESRU,$405,$406,$407)
	IF (ENTRY.EQ.7) CALL PROINP (FCRDRU,FCRDCR,$405,$406,$407)
	IF (ENTRY.EQ.8) CALL PROOUT (FPAGRU,FPAGPA,$405,$406,$407)
	GO TO 403

C HERE IF NO ERRORS ENCOUNTERED. SORT RECORD HAS BEEN WRITTEN
C NOW CALL THE SUBROUTINE THAT CHECKS THE DATE-TIME RANGE OF THE ENTRIES
405	CALL CHKDAT (IDATE,FDATE,LDATE)
	GO TO 403

C HERE IF AN INCOMPLETE ENTRY IS FOUND
406	REREAD 1049,ENTRY,OS,RECSEQ,DECREV,CUSREV,A
	GO TO 404

C HERE IF END OF FILE HAS BEEN REACHED WHEN READING THE USAGE FILE
407	GO TO 450
C HERE TO PRODUCE REPORT. BUT FIRST CLOSE OPEN FILES AND THEN SORT 
C THE TEMPORARY FILE INSRT.TMP ACCORDING TO WHAT REPORT HAS BEEN CHOSEN

450	CLOSE (FILE=INFIL, DEVICE='DSK', UNIT=1)
	CLOSE (FILE='INSRT.TMP', DEVICE='DSK', UNIT=2)
	IF (SORTBY.EQ.'A') GO TO 451

C HERE TO DO REPORT BY NAME

C ************************************************************************
C ************************************************************************
C	IF YOU ARE TRYING TO COMPILE THIS PROGRAM WITH SORT VERSION 4,
C	THE FOLLOWING LINES NEED TO BE EDITED BECAUSE THE CALLING 
C	SEQUENCE TO SORT V4 HAVE CHANGED.

C	INSTRUCTIONS:
C	    1.  DELETE THE C'S IN COLUMN ONE OF THE NEXT 3 LINES OF CODE.
C	    2.  PUT A C IN COLUMN 1 OF THE FOLLOWING TWO LINES.
C	CALL SORT ('SORT/RECORD-SIZE:160/KEY:1,39,ASCENDING
C	1 /KEY:79,39,ASCENDING/KEY:40,39,ASCENDING /ASCII INSRT.TMP
C	2 OUTSRT.TMP')


	CALL SORT ('OUTSRT.TMP=INSRT.TMP/RECORD:160/KEY:1:39:A
	1 /KEY:79:39:A/KEY:40:39:A/ASCII')
C ************************************************************************
C ************************************************************************

	OPEN (FILE='INSRT.TMP', DEVICE='DSK', UNIT=1)
	CLOSE (FILE='INSRT.TMP', DISPOSE='DELETE', DEVICE='DSK', UNIT=1)
	CALL REPNAM (OUTFIL,ZSYSNA,CDATE,FDATE,LDATE,FSESCO,FSESRU,FPAGRU,
	1 FPAGPA,FCRDRU,FCRDCR)
	GO TO 3

C HERE TO DO REPORT BY ACCOUNT

C ************************************************************************
C ************************************************************************
C	IF YOU ARE TRYING TO COMPILE THIS PROGRAM WITH SORT VERSION 4,
C	THE FOLLOWING LINES NEED TO BE EDITED BECAUSE THE CALLING 
C	SEQUENCE TO SORT V4 HAVE CHANGED.

C	INSTRUCTIONS:
C	    1.  DELETE THE C'S IN COLUMN ONE OF THE NEXT 3 LINES OF CODE.
C	    2.  PUT A C IN COLUMN 1 OF THE FOLLOWING TWO LINES.
C451	CALL SORT ('SORT/RECORD-SIZE:160/KEY:79,39,ASCENDING
C	1 /KEY:1,39,ASCENDING/KEY:40,39,ASCENDING /ASCII INSRT.TMP
C	2 OUTSRT.TMP')

451	CALL SORT ('OUTSRT.TMP=INSRT.TMP/RECORD:160/KEY:79:39:A
	1 /KEY:1:39:A/KEY:40:39:A/ASCII')
C ************************************************************************
C ************************************************************************

	OPEN (FILE='INSRT.TMP', DEVICE='DSK', UNIT=1)
	CLOSE (FILE='INSRT.TMP', DEVICE='DSK', UNIT=1, DISPOSE='DELETE')
	CALL REPACT (OUTFIL,ZSYSNA,CDATE,FDATE,LDATE,FSESCO,FSESRU,
	1 FPAGRU,FPAGPA,FCRDRU,FCRDCR)
	GO TO 3


C ALL DONE WITH REPORT. RETURN TO MAIN LOOP

C ************************************************************************
C	END OF REPORT OF SYSTEM USAGE SORTED ON NAME OR ACCOUNT SECTION
C ************************************************************************
C ************************************************************************
C	REPORT BY DISK USAGE SORTED ON DIRECTORY OR ACCOUNT SECTION
C ************************************************************************

500	OPEN (FILE=INFIL, DEVICE='DSK', UNIT=1, ACCESS='SEQIN')
	OPEN (FILE='INSRT.TMP', DEVICE ='DSK', UNIT=2, ACCESS='SEQOUT')

C INITIALIZE THE FIRST DATE-TIME AND LAST DATE-TIME SO THE ENTRY TIME
C CAN BE REPORTED.

501	READ (1,1049,END=550) ENTRY,OS,RECSEQ,DECREV,CUSREV,A
	IF (RECSEQ.NE.1) GO TO 501
	DECODE (65,1050,A) JOB,YEAR,MONTH,DAY,HOUR,MINUTE,SECOND,
	1 TERMD,LINENO,PROGNA,PROVER,MODVER,NODE
	DO 502 I=1,5
	FDATE(I)=IDATE(I)
502	CONTINUE
	GO TO 508

C THIS POINT IS THE ACTUAL BEGINNING OF THE MAIN LOOP FOR REPORT BY
C DISK USAGE

503	READ (1,1049,END=550) ENTRY,OS,RECSEQ,DECREV,CUSREV,A
504	IF (RECSEQ.NE.1) GO TO 503
	DECODE (65,1050,A) JOB,YEAR,MONTH,DAY,HOUR,MINUTE,SECOND,
	1 TERMD,LINENO,PROGNA,PROVER,MODVER,NODE


C NOW GO PROCESS THE ENTRY

508	IF (ENTRY.EQ.1) CALL PRORES (ZSYSNA,$505,$506,$507)
	IF (ENTRY.EQ.9) CALL PRODSK (FDSKPA,$505,$506,$507)
	GO TO 503

C HERE IF NO ERRORS ENCOUNTERED WHEN READING RESTART ENTRY
C NOW CALL THE SUBROUTINE THAT CHECKS THE DATE-TIME OF THE ENTRIES
505	CALL CHKDAT (IDATE,FDATE,LDATE)
	GO TO 503

C HERE IF ANOTHER ENTRY IS FOUND
C NOW CALL THE SUBROUTINE THAT CHECKS THE DATE-TIME OF THE ENTRIES
506	CALL CHKDAT (IDATE,FDATE,LDATE)
	REREAD 1049,ENTRY,OS,RECSEQ,DECREV,CUSREV,A
	GO TO 504

C HERE IF END OF FILE HAS BEEN REACHED WHEN READING THE USAGE FILE
507	GO TO 550
C HERE TO PRODUCE REPORT. BUT FIRST CLOSE OPEN FILES AND THEN SORT 
C THE TEMPORARY FILE INSRT.TMP ACCORDING TO WHAT REPORT HAS BEEN CHOSEN

550	CLOSE (FILE=INFIL, DEVICE='DSK', UNIT=1)
	CLOSE (FILE='INSRT.TMP', DEVICE='DSK', UNIT=2)
	IF (SORTBY.EQ.'A') GO TO 551

C HERE TO DO REPORT BY DIRECTORY

C ************************************************************************
C ************************************************************************
C	IF YOU ARE TRYING TO COMPILE THIS PROGRAM WITH SORT VERSION 4,
C	THE FOLLOWING LINES NEED TO BE EDITED BECAUSE THE CALLING 
C	SEQUENCE TO SORT V4 HAVE CHANGED.

C	INSTRUCTIONS:
C	    1.  DELETE THE C'S IN COLUMN ONE OF THE NEXT 3 LINES OF CODE.
C	    2.  PUT A C IN COLUMN 1 OF THE FOLLOWING TWO LINES.
C	CALL SORT ('SORT/RECORD:109/KEY:1,39,ASCENDING
C	1 /KEY:46,39,ASCENDING/KEY:40,6,ASCENDING /ASCII INSRT.TMP
C	2 OUTSRT.TMP')
	CALL SORT ('OUTSRT.TMP=INSRT.TMP/RECORD:109/KEY:1:39:A
	1 /KEY:46:39:A/KEY:40:6:A/ASCII')
C ************************************************************************
C ************************************************************************

	OPEN (FILE='INSRT.TMP', DEVICE='DSK', UNIT=1)
	CLOSE (FILE='INSRT.TMP', DISPOSE='DELETE', DEVICE='DSK', UNIT=1)
	CALL REPDNA (OUTFIL,ZSYSNA,CDATE,FDATE,FDSKPA)
	GO TO 3

C HERE TO DO REPORT BY ACCOUNT

C ************************************************************************
C ************************************************************************
C	IF YOU ARE TRYING TO COMPILE THIS PROGRAM WITH SORT VERSION 4,
C	THE FOLLOWING LINES NEED TO BE EDITED BECAUSE THE CALLING 
C	SEQUENCE TO SORT V4 HAVE CHANGED.

C	INSTRUCTIONS:
C	    1.  DELETE THE C'S IN COLUMN ONE OF THE NEXT 3 LINES OF CODE.
C	    2.  PUT A C IN COLUMN 1 OF THE FOLLOWING TWO LINES.
C551	CALL SORT ('SORT/RECORD:109/KEY:46:39:ASCENDING
C	1 /KEY:1,39,ASCENDING/KEY:40,6,ASCENDING /ASCII INSRT.TMP
C	2 OUTSRT.TMP')
551	CALL SORT ('OUTSRT.TMP=INSRT.TMP/RECORD:109/KEY:46:39:A
	1 /KEY:1:39:A/KEY:40:6:A/ASCII')
C ************************************************************************
C ************************************************************************

	OPEN (FILE='INSRT.TMP', DEVICE='DSK', UNIT=1)
	CLOSE (FILE='INSRT.TMP', DEVICE='DSK', UNIT=1, DISPOSE='DELETE')
	CALL REPDAC (OUTFIL,ZSYSNA,CDATE,FDATE,FDSKPA)
	GO TO 3


C ALL DONE WITH REPORT. RETURN TO MAIN LOOP

C ************************************************************************
C	END OF REPORT BY DISK USAGE SORTED ON DIRECTORY OR ACCOUNT SECTION
C ************************************************************************
C ************************************************************************
C	INPUT FORMAT STATEMENTS FOR THE MAIN PROGRAM
C ************************************************************************

1001	FORMAT (A5,2X,F6.2)

C ***********
C FORMAT STATEMENTS FOR ALL OTHER RECORD DESCRIPTIONS OF THE USAGE FILE
C	ARE IN THEIR RESPECTIVE ENTRY PROCESSING SUBROUTINES CALLED PROXXX,
C	(E.G., PROSES PROCESSES THE SESSION ENTRY)
C ***********

C ENTRY HEADER RECORD
1050	FORMAT (2I4,5I2,A1,I4,6A1,2(15A1),6A1)
1049	FORMAT (I4,2I1,2I2,10X,40A5)

C ************************************************************************
C	OUTPUT FORMAT STATEMENTS FOR THE MAIN PROGRAM
C ************************************************************************

2001	FORMAT (' TOPS20 ACCOUNTING SYSTEM')

C ************************************************************************
C	END OF USAH20 PROGRAM - FOLLOWING ARE THE SUBROUTINES
C ************************************************************************
	END
C ************************************************************************
	SUBROUTINE QUEST(INFIL,OUTFIL,REPORT,SORTBY)
C ************************************************************************

	IMPLICIT INTEGER (A-Z)
	DOUBLE PRECISION INFIL,OUTFIL

C NOW ASK FOR THE INPUT FILE NAME. DEFAULT IS USAGE.OUT.

1	TYPE 2001
	ACCEPT 1001,INFIL
	IF (INFIL.EQ.'?') GO TO 2
	IF (INFIL.EQ.'EXIT') CALL EXIT
	IF (INFIL.EQ.' ') INFIL='USAGE.OUT'
	TYPE 2002,INFIL
	GO TO 3

C HELP FOR INPUT FILE QUESTION

2	TYPE 2003
	TYPE 2004
	GO TO 1

C NOW ASK FOR THE TYPE OF REPORT.  DEFAULT IS SYSTEM USAGE.

3	TYPE 2005
	ACCEPT 1002,REPORT
	IF (REPORT.EQ.'?') GO TO 4
	IF (REPORT.EQ.'EXIT') CALL EXIT
	IF (REPORT.EQ.' ') REPORT='S'
	GO TO 5

C HELP FOR REPORT QUESTION. DEFAULT IS SYSTEM USAGE.

4	TYPE 2006
	TYPE 2004
	GO TO 3

C NOW ASK FOR TYPE OF SORT. DEFAULT IS BY NAME/DIRECTORY

5	TYPE 2007
	ACCEPT 1002,SORTBY
	IF (SORTBY.EQ.'?') GO TO 6
	IF (SORTBY.EQ.'EXIT') CALL EXIT
	IF (SORTBY.EQ.' ') SORTBY='N'
	GO TO 7
C HELP FOR SORT QUESTION.

6	TYPE 2008
	TYPE 2004
	GO TO 5
7	TYPE 2009
	ACCEPT 1001,OUTFIL
	IF (OUTFIL.EQ.'?') GO TO 8
	IF (OUTFIL.EQ.'EXIT') CALL EXIT
	IF (OUTFIL.EQ.' ') OUTFIL='USAGE.RPT'
	TYPE 2011, OUTFIL
	RETURN

C HELP FOR OUTPUT FILE QUESTION

8	TYPE 2010
	TYPE 2004
	GO TO 7

1001	FORMAT (A10)
1002	FORMAT (A5)
2001	FORMAT (' READ USAGE FILE: '$)
2002	FORMAT ('  Input file name: ',A10)
2003	FORMAT (' Type file name of input file containing USAGE'
	1' entries.'/' Default is USAGE.OUT.')
2004	FORMAT (' Type EXIT to return to monitor mode. Type ? to'
	1' get this' / ' help message.')
2005	FORMAT (' Report by [System usage (S) or Disk usage (D)]: '$)
2006	FORMAT (' Type S for system usage report. Type D for disk usage'/
	1' report. Default is S.')
2007	FORMAT (' Sort by [Name (N) or Account (A)]: '$)
2008	FORMAT (' Type N if reports are broken down by name. Type A if'
	1/' reports are broken down by account. Default is N.')
2009	FORMAT (' Write to file: ' $)
2010	FORMAT (' Type file name of new output file. Default is'
	1' USAGE.RPT.')
2011	FORMAT ('  Output file name: ', A10)

C ************************************************************************
C	END OF SUBROUTINE QUEST
C ************************************************************************
	END
C ************************************************************************
	SUBROUTINE CHKDAT (IDATE,FDATE,LDATE)
C ************************************************************************

	IMPLICIT INTEGER (A-Z)
	DIMENSION IDATE(5),FDATE(5),LDATE(5)
	DO 1 I=1,5
1	IF (FDATE(I).LT.IDATE(I)) GO TO 4
	DO 2 I=1,5
2	FDATE(I)=IDATE(I)
	RETURN
4	DO 5 I=1,5
5	IF (LDATE(I).LT.IDATE(I)) GO TO 6
	RETURN
6	DO 7 I=1,5
7	LDATE(I)=IDATE(I)
	RETURN

C ************************************************************************
C	END OF SUBROUTINE CHKDAT
C ************************************************************************
	END
C ************************************************************************
C	SUBROUTINE TO PROCESS A SYSTEM RESTART ENTRY - PRORES
C ************************************************************************

	SUBROUTINE PRORES (ZSYSNA,*,*,*)

	IMPLICIT INTEGER (A-Z)
	DIMENSION ZSYSNA(39), SYSNAM(39), MONVER(15),A(40)
	READ (1,1049,END=3) ENTRY,OS,RECSEQ,DECVER,CUSVER,A
	IF (RECSEQ.NE.2) GO TO 2
	IF (ENTRY.NE.1) GO TO 2
	DECODE (125,1051,A) SYSNAM,MONVER,MBYEAR,MBMON,MBDAY,MBHOUR,
	1 MBMIN,MBSEC,MONUP,CPUNO,CPU0,CPU1,CPU2,CPU3,CPU4,CPU5,CHYEAR,
	2 CHMON,CHDAY,CHHOUR,CHMIN,CHSEC
	DO 4 I=1,39
4	ZSYSNA(I)=SYSNAM(I)
	GO TO 1

C HERE IF NO ERRORS ENCOUNTERED. SORT RECORD HAS BEEN WRITTEN
1	LABEL=1
	RETURN (LABEL)
C HERE IF AN INCOMPLETE ENTRY IS FOUND
2	LABEL=2
	RETURN (LABEL)
C HERE IF END OF FILE HAS BEEN REACHED WHEN READING THE USAGE FILE
3	LABEL=3
	RETURN (LABEL)

C **********

C MONITOR RESTART RECORD
1049	FORMAT (I4,2I1,2I2,10X,40A5)
1051	FORMAT (39A1,15A1,I4,5A2,I18,I1,7I4,5I2)

C ************************************************************************
C	END OF SUBROUTINE PRORES
C ************************************************************************
	END
C ************************************************************************
C	SUBROUTINE TO PROCESS A SESSION ENTRY - PROSES
C ************************************************************************

	SUBROUTINE PROSES (FSESCO,FSESRU,*,*,*)

	IMPLICIT INTEGER (A-Z)
	DIMENSION ACCOUN(39), BATNAM(6), REMARK(39), NAME(39),A(40)
	REAL FRUNTI,FCONNE,FCHARG,FSESCO,FSESRU
	READ (1,1049,END=3) ENTRY,OS,RECSEQ,DECVER,CUSVER,A
	IF (RECSEQ.NE.2) GO TO 2
	IF ( (ENTRY.NE.2) .AND. (ENTRY.NE.3) ) GO TO 2
	DECODE (121,1053,A) ACCOUN,RUNTIM,STYEAR,STMON,STDAY,STHOUR,
	1 STMIN,STSEC,JOBTYP,BATNAM,BATSEQ,REMARK,CONNEC
	READ (1,1049,END=3) ENTRY,OS,RECSEQ,DECVER,CUSVER,A
	IF (RECSEQ.NE.3) GO TO 2
	IF ( (ENTRY.NE.2) .AND. (ENTRY.NE.3) ) GO TO 2
	DECODE (39,1052,A) NAME
	FRUNTI=FLOAT(RUNTIM)/1000.
	FCONNE=FLOAT(CONNEC)/3600.
	FCHARG=FRUNTI * FSESRU + FCONNE * FSESCO

C NOW CHECK TO SEE IF THE ACCOUNT STRING IS ALL SPACES. IF IT IS, PUT
C UNSPECIFIED ACCOUNT IN THE ACCOUNT FIELD.

	J=0
	DO 4 I=1,39
	IF (ACCOUN(I).EQ.' ') J=J+1
4	CONTINUE
	IF (J.EQ.39) GO TO 5
	WRITE (2,2002) NAME,REMARK,ACCOUN,FCONNE,FRUNTI,FCHARG
	GO TO 1
5	WRITE (2,2003) NAME,REMARK,FCONNE,FRUNTI,FCHARG
	GO TO 1

C HERE IF NO ERRORS ENCOUNTERED. SORT RECORD HAS BEEN WRITTEN
1	LABEL=1
	RETURN (LABEL)

C HERE IF AN INCOMPLETE ENTRY IS FOUND
2	LABEL=2
	RETURN (LABEL)

C HERE IF END OF FILE HAS BEEN REACHED WHEN READING THE USAGE FILE
3	LABEL=3
	RETURN (LABEL)

C **********


C TOPS20 USER IDENTIFICATION RECORD
1049	FORMAT (I4,2I1,2I2,10X,40A5)
1052	FORMAT (39A1)

C SESSION RECORD #1
1053	FORMAT (39A1,I9,I4,5I2,I1,6A1,I6,39A1,I7)

C FORMAT OF FILE TO BE SORTED
2002	FORMAT (3(39A1),F8.2,F8.1,14X,F10.2)
2003	FORMAT (2(39A1),' UNSPECIFIED ACCOUNT',19X,F8.2,F8.1,14X,F10.2)

C ************************************************************************
C	END OF SUBROUTINE PROSES
C ************************************************************************
	END
C ************************************************************************
C	SUBROUTINE TO PROCESS AN INPUT SPOOLER ENTRY - PROINP
C ************************************************************************

	SUBROUTINE PROINP (FCRDRU,FCRDCR,*,*,*)

	IMPLICIT INTEGER (A-Z)
	DIMENSION ACCOUN(39), JOBNAM(6), QUENAM(3), DEVNAM(6)
	DIMENSION DISPOS(6), DITEXT(39), NAME(39),A(40)
	REAL FCRDRU,FCRDCR,FRUNTI,FCHARG

	READ (1,1049,END=3) ENTRY,OS,RECSEQ,DECVER,CUSVER,A
	IF (RECSEQ.NE.2) GO TO 2
	IF (ENTRY.NE.7) GO TO 2
	DECODE (163,1054,A) ACCOUN,RUNTIM,CORETI,DSKRED,DSKWRI,JOBNAM,
	1 QUENAM,DEVNAM,SEQNUM,CARDS,CDYEAR,CDMON,CDDAY,CDHOUR,CDMIN,
	2 CDSEC,DISPOS,DITEXT,PRIOR
	READ (1,1049,END=3) ENTRY,OS,RECSEQ,DECVER,CUSVER,A
	IF (RECSEQ.NE.3) GO TO 2
	IF (ENTRY.NE.7) GO TO 2
	DECODE (39,1052,A) NAME
	FRUNTI = FLOAT(RUNTIM)/1000.
	FCHARG = FRUNTI * FCRDRU + FLOAT(CARDS) * FCRDCR

C NOW CHECK TO SEE IF THE ACCOUNT STRING IS ALL SPACES. IF IT IS, PUT
C UNSPECIFIED ACCOUNT IN THE ACCOUNT FIELD.

	J=0
	DO 4 I=1,39
	IF (ACCOUN(I).EQ.' ') J=J+1
4	CONTINUE
	IF (J.EQ.39) GO TO 5
	WRITE (2,2002) NAME,ACCOUN,FRUNTI,CARDS,FCHARG
	GO TO 1
5	WRITE (2,2003) NAME,FRUNTI,CARDS,FCHARG
	GO TO 1

C HERE IF NO ERRORS ENCOUNTERED. SORT RECORD HAS BEEN WRITTEN
1	LABEL=1
	RETURN (LABEL)

C HERE IF AN INCOMPLETE ENTRY IS FOUND
2	LABEL=2
	RETURN (LABEL)

C HERE IF END OF FILE HAS BEEN REACHED WHEN READING THE USAGE FILE
3	LABEL=3
	RETURN (LABEL)

C **********

C READ FORMAT BEFORE THE DECODE
1049	FORMAT (I4,2I1,2I2,10X,40A5)

C TOPS20 USER IDENTIFICATION RECORD
1052	FORMAT (39A1)

C INPUT SPOOLER RECORD
1054	FORMAT (39A1,I9,I11,I8,I8,6A1,3A1,6A1,2I6,I4,5I2,6A1,39A1,I2)

C FORMAT OF FILE TO BE SORTED
2002	FORMAT (39A1,'INPUT SPOOLER CHARGES',18X,39A1,8X,F8.1,I7,7X,F10.2)
2003	FORMAT (39A1,'INPUT SPOOLER CHARGES',18X,' UNSPECIFIED ACCOUNT',
	1 19X,8X,F8.1,I7,7X,F10.2)

C ************************************************************************
C	END OF SUBROUTINE PROINP
C ************************************************************************
	END
C ************************************************************************
C	SUBROUTINE TO PROCESS AN OUTPUT SPOOLER ENTRY - PROOUT
C ************************************************************************

	SUBROUTINE PROOUT (FPAGRU,FPAGPA,*,*,*)

	IMPLICIT INTEGER (A-Z)
	DIMENSION ACCOUN(39), JOBNAM(6), QUENAM(3), DEVNAM(6)
	DIMENSION FORMS(6), DISPOS(6), DITEXT(39),NAME(39),A(40)
	REAL FPAGRU,FPAGPA,FRUNTI,FCHARG

	READ (1,1049,END=3) ENTRY,OS,RECSEQ,DECVER,CUSVER,A
	IF (RECSEQ.NE.2) GO TO 2
	IF (ENTRY.NE.8) GO TO 2
	DECODE (188,1055,A) ACCOUN,RUNTIM,CORETI,DSKRED,DSKWRI,JOBNAM,
	1 QUENAM,DEVNAM,SEQNUM,PAGES,FILES,CDYEAR,CDMON,CDDAY,CDHOUR,
	2 CDMIN,CDSEC,SDYEAR,SDMON,SDHOUR,SDMIN,SDSEC,FORMS,DISPOS,
	3 DITEXT,PRIOR
	READ (1,1049,END=3) ENTRY,OS,RECSEQ,DECVER,CUSVER,A
	IF (RECSEQ.NE.3) GO TO 2
	IF (ENTRY.NE.8) GO TO 2
	DECODE (39,1052,A) NAME
	FRUNTI = FLOAT(RUNTIM)/1000.
	FCHARG = FRUNTI * FPAGRU + FLOAT(PAGES) * FPAGPA

C NOW CHECK TO SEE IF THE ACCOUNT STRING IS ALL SPACES. IF IT IS, PUT
C UNSPECIFIED ACCOUNT IN THE ACCOUNT FIELD.

	J=0
	DO 4 I=1,39
	IF (ACCOUN(I).EQ.' ') J=J+1
4	CONTINUE
	IF (J.EQ.39) GO TO 5
	WRITE (2,2002) NAME,ACCOUN,FRUNTI,PAGES,FCHARG
	GO TO 1
5	WRITE (2,2003) NAME,FRUNTI,PAGES,FCHARG
	GO TO 1

C HERE IF NO ERRORS ENCOUNTERED. SORT RECORD HAS BEEN WRITTEN
1	LABEL=1
	RETURN (LABEL)

C HERE IF AN INCOMPLETE ENTRY IS FOUND
2	LABEL=2
	RETURN (LABEL)

C HERE IF END OF FILE HAS BEEN REACHED WHEN READING THE USAGE FILE
3	LABEL=3
	RETURN (LABEL)

C **********

1049	FORMAT (I4,2I1,2I2,10X,40A5)

C TOPS20 USER IDENTIFICATION RECORD
1052	FORMAT (39A1)

C OUTPUT SPOOLER RECORD
1055	FORMAT (39A1,I9,I11,2I8,6A1,3A1,6A1,2I6,I5,I4,
	1 5I2,I4,5I2,6A1,6A1,39A1,I2)

C FORMAT OF FILE TO BE SORTED
2002	FORMAT (39A1,'OUTPUT SPOOLER CHARGES',17X,39A1,8X,F8.1,7X,
	1 I7,F10.2)
2003	FORMAT (39A1,'OUTPUT SPOOLER CHARGES',17X,' UNSPECIFIED ACCOUNT',
	1 19X,8X,F8.1,7X,I7,F10.2)

C ************************************************************************
C	END OF SUBROUTINE PROOUT
C ************************************************************************
	END
C ************************************************************************
C	SUBROUTINE TO PROCESS A DISK USAGE ENTRY - PRODSK
C ************************************************************************

	SUBROUTINE PRODSK (FDSKPA,*,*,*)

	IMPLICIT INTEGER (A-Z)
	REAL FDSKPA,FCHARG
	DIMENSION STRNAM(6), DIRECT(39), ACCOUN(39), A(40)

	READ (1,1049,END=3) ENTRY,OS,RECSEQ,DECVER,CUSVER,A
	IF (RECSEQ.NE.2) GO TO 2
	IF (ENTRY.NE.9) GO TO 2
	DECODE (122,1056,A) RECNUM,TOTALL,
	1 TOTACT,TOTFIL,STRNAM,DIRECT,STRTYP,CONTYP,DEVTYP,QUOIN,QUOOUT,
	2 LLYEAR,LLMON,LLDAY,LLHOUR,LLMIN,LLSEC,LAYEAR,LAMON,LADAY,LAHOUR,
	3 LAMIN,LASEC,EXPDIR,FODIR
4	READ (1,1049,END=3) ENTRY,OS,RECSEQ,DECVER,CUSVER,A
	IF (RECSEQ.NE.3) GO TO 2
	IF (ENTRY.NE.9) GO TO 2
	DECODE (116,1057,A) ACCOUN,DIRECT,
	1 DSKALL,PAGES,FILES,STRNAM,STRTYP,CONTYP,DEVTYP
	FCHARG = FLOAT(PAGES) * FDSKPA
	J=0
	DO 5 I=1,39
5	IF (ACCOUN(I).EQ.' ') J=J+1
	IF (J.EQ.39) GO TO 6
	WRITE (2,2004) DIRECT,STRNAM,ACCOUN,PAGES,FILES,FCHARG
	GO TO 4
6	WRITE (2,2005) DIRECT,STRNAM,PAGES,FILES,FCHARG
	GO TO 4

C HERE IF A NEW ENTRY HAS BEEN FOUND
2	LABEL = 2
	RETURN (LABEL)

C HERE IF END OF FILE HAS BEEN REACHED WHEN READING USAGE FILE
3	LABEL = 3
	RETURN (LABEL)

C **********

C READ FORMAT BEFORE DECODE
1049	FORMAT (I4,2I1,2I2,10X,40A5)

C DISK USAGE DIRECTORY RECORD
1056	FORMAT (I3,2I10,I5,6A1,39A1,I1,2I3,2I6,2(I4,5I2),2A1)

C DISK USAGE ACCOUNT STRING RECORD
1057	FORMAT (2(39A1),2I10,I5,6A1,I1,2I3)

C FORMATS OF FILE TO BE SORTED
2004	FORMAT (39A1,6A1,39A1,I10,I5,F10.2)
2005	FORMAT (39A1,6A1,' UNSPECIFIED ACCOUNT',19X,I10,I5,F10.2)

C ************************************************************************
C	END OF SUBROUTINE PRODSK
C ************************************************************************
	END
C ************************************************************************
C ************************************************************************
C	BEGINNING OF REPORT WRITING SUBROUTINES
C ************************************************************************
C ************************************************************************

C ************************************************************************
C	SUBROUTINE TO PRODUCE A SYSTEM USAGE REPORT SORTED BY NAME, ACCOUNT,
C	AND REMARK - REPNAM
C ************************************************************************

	SUBROUTINE REPNAM (OUTFIL,ZSYSNA,CDATE,FDATE,LDATE,FSESCO,
	1 FSESRU,FPAGRU,FPAGPA,FCRDRU,FCRDCR)
	IMPLICIT INTEGER (A-Z)
	DOUBLE PRECISION OUTFIL
	DIMENSION CDATE(3),FDATE(5),LDATE(5),ZSYSNA(39)
	DIMENSION ACCOUN(39),NAME(39),REMARK(39)
	DIMENSION LACCOU(39),LNAME(39),LREMAR(39)

	REAL FSESCO,FSESRU,FPAGRU,FPAGPA,FCRDRU,FCRDCR
	REAL FCHARG,FCONNE,FRUNTI
	REAL XCHARG,XCONNE,XRUNTI
	REAL YCHARG,YCONNE,YRUNTI
	REAL ZCHARG,ZCONNE,ZRUNTI

	OPEN (FILE='OUTSRT.TMP',UNIT=1,DEVICE='DSK',ACCESS='SEQIN')
	OPEN (FILE=OUTFIL,UNIT=2,DEVICE='DSK',ACCESS='SEQOUT')

C FIRST INITIALIZE ACCOUNT, NAME AND REMARK (ITEMS BEGINNING WITH L, E.G.,
C	LACCOU, LREMAR, LNAME).  THESE  ARE THE CONTROLS OF THE REPORT.
C	WHEN THE NAME READ IN IS DIFFERENT FROM LNAME, A REPORT FOOTING
C	IS OUTPUT, A PAGE HEADER IS OUTPUT, ETC.  ALSO INITIALIZE THE
C	ACCUMULATORS FOR RUNTIME, CONNECT TIME, PAGES, CARDS, AND CHARGES.
C	IF THE REMARK JUST READ IN IS DIFFERENT, THE X* (E.G., XRUNTI,
C	XCONNE, XPAGE, ETC.) ARE OUTPUT AND ZEROED.  WHEN THE ACCOUNT
C	CHANGES, THE ITEMS BEGINNING WITH Y* WILL BE OUTPUT AND THE X*
C	AND Y* ITEMS ARE ZEROED.  WHEN THE NAME CHANGES, THE ITEMS
C	BEGINNING WITH Z* ARE OUTPUT AND ALL ITEMS (X*, Y*, Z*) WILL BE
C	ZEROED.

	READ (1,1000,END=500) NAME,REMARK,ACCOUN,FCONNE,FRUNTI,CARDS,
	1 PAGES,FCHARG
1	DO 2 I=1,39
	LACCOU(I)=ACCOUN(I)
	LNAME(I)=NAME(I)
2	LREMAR(I)=REMARK(I)
	XCONNE=FCONNE
	YCONNE=FCONNE
	ZCONNE=FCONNE
	XRUNTI=FRUNTI
	YRUNTI=FRUNTI
	ZRUNTI=FRUNTI
	XCARDS=CARDS
	YCARDS=CARDS
	ZCARDS=CARDS
	XPAGES=PAGES
	YPAGES=PAGES
	ZPAGES=PAGES
	XCHARG=FCHARG
	YCHARG=FCHARG
	ZCHARG=FCHARG
	CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,LINENO)
3	READ (1,1000,END=500) NAME,REMARK,ACCOUN,FCONNE,FRUNTI,CARDS,
	1 PAGES,FCHARG
	J=0
	DO 4 I=1,39
4	IF (NAME(I).NE.LNAME(I)) J=J+1
	IF (J.EQ.0) GO TO 5
	CALL NAMERS (LINENO,LREMAR,LACCOU,XCHARG,XCONNE,XRUNTI,XCARDS,
	1 XPAGES,CDATE,FDATE,LDATE,ZSYSNA,LNAME)
	CALL NAMEAS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,CDATE,
	1 FDATE,LDATE,ZSYSNA,LNAME)
	CALL NAMENS (LINENO,ZCHARG,ZCONNE,ZRUNTI,ZCARDS,ZPAGES,CDATE,
	1 FDATE,LDATE,ZSYSNA,LNAME,FSESCO,FSESRU,FPAGRU,FPAGPA,FCRDRU,
	2 FCRDCR)
	GO TO 1
5	J=0
	DO 6 I=1,39
6	IF (ACCOUN(I).NE.LACCOU(I)) J=J+1
	IF (J.EQ.0) GO TO 8
	CALL NAMERS (LINENO,LREMAR,LACCOU,XCHARG,XCONNE,XRUNTI,XCARDS,
	1 XPAGES,CDATE,FDATE,LDATE,ZSYSNA,LNAME)
	CALL NAMEAS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,CDATE,
	1 FDATE,LDATE,ZSYSNA,LNAME)
	DO 7 I=1,39
	LACCOU(I)=ACCOUN(I)
7	LREMAR(I)=REMARK(I)
	XCONNE=FCONNE
	YCONNE=FCONNE
	ZCONNE=ZCONNE+FCONNE
	XRUNTI=FRUNTI
	YRUNTI=FRUNTI
	ZRUNTI=ZRUNTI+FRUNTI
	XCARDS=CARDS
	YCARDS=CARDS
	ZCARDS=ZCARDS+CARDS
	XPAGES=PAGES
	YPAGES=PAGES
	ZPAGES=ZPAGES+PAGES
	XCHARG=FCHARG
	YCHARG=FCHARG
	ZCHARG=ZCHARG+FCHARG
	GO TO 3
8	J=0
	DO 9 I=1,39
9	IF (REMARK(I).NE.LREMAR(I)) J=J+1
	IF (J.EQ.0) GO TO 11
	CALL NAMERS (LINENO,LREMAR,LACCOU,XCHARG,XCONNE,XRUNTI,XCARDS,
	1 XPAGES,CDATE,FDATE,LDATE,ZSYSNA,LNAME)
	DO 10 I=1,39
10	LREMAR(I)=REMARK(I)
	XCONNE=FCONNE
	YCONNE=YCONNE+FCONNE
	ZCONNE=ZCONNE+FCONNE
	XRUNTI=FRUNTI
	YRUNTI=YRUNTI+FRUNTI
	ZRUNTI=ZRUNTI+FRUNTI
	XCARDS=CARDS
	YCARDS=YCARDS+CARDS
	ZCARDS=ZCARDS+CARDS
	XPAGES=PAGES
	YPAGES=YPAGES+PAGES
	ZPAGES=ZPAGES+PAGES
	XCHARG=FCHARG
	YCHARG=YCHARG+FCHARG
	ZCHARG=ZCHARG+FCHARG
	GO TO 3
11	XCONNE=XCONNE+FCONNE
	YCONNE=YCONNE+FCONNE
	ZCONNE=ZCONNE+FCONNE
	XRUNTI=XRUNTI+FRUNTI
	YRUNTI=YRUNTI+FRUNTI
	ZRUNTI=ZRUNTI+FRUNTI
	XCARDS=XCARDS+CARDS
	YCARDS=YCARDS+CARDS
	ZCARDS=ZCARDS+CARDS
	XPAGES=XPAGES+PAGES
	YPAGES=YPAGES+PAGES
	ZPAGES=ZPAGES+PAGES
	XCHARG=XCHARG+FCHARG
	YCHARG=YCHARG+FCHARG
	ZCHARG=ZCHARG+FCHARG
	GO TO 3

C **********
C HERE WHEN END OF FILE HAS BEEN READ IN SORT FILE.  OUTPUT LAST
C 	REPORT AND FINISH UP.
C **********

500	CALL NAMERS (LINENO,LREMAR,LACCOU,XCHARG,XCONNE,XRUNTI,XCARDS,
	1 XPAGES,CDATE,FDATE,LDATE,ZSYSNA,LNAME)
	CALL NAMEAS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,CDATE,
	1 FDATE,LDATE,ZSYSNA,LNAME)
	CALL NAMENS (LINENO,ZCHARG,ZCONNE,ZRUNTI,ZCARDS,ZPAGES,CDATE,
	1 FDATE,LDATE,ZSYSNA,LNAME,FSESCO,FSESRU,FPAGRU,FPAGPA,FCRDRU,
	2 FCRDCR)
	CLOSE (FILE='OUTSRT.TMP',UNIT=1,DEVICE='DSK',DISPOSE='DELETE')
	CLOSE (FILE=OUTFIL,UNIT=2,DEVICE='DSK')
	RETURN

C INPUT FORMAT STATEMENT
1000	FORMAT (3(39A1),F8.2,F8.1,2I7,F10.2)

C ************************************************************************
C	END OF SUBROUTINES TO REPORT SYSTEM USAGE SORTED BY NAME, ACCOUNT,
C	AND REMARK - REPNAM
C ************************************************************************
	END
C **********
C	SUBROUTINE TO OUTPUT THE PAGE HEADER FOR SYSTEM USAGE REPORT BY
C	NAME
C **********
	SUBROUTINE NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,LINENO)

	IMPLICIT INTEGER (A-Z)
	DIMENSION CDATE(3),FDATE(5),LDATE(5),ZSYSNA(39),LNAME(39)
	DIMENSION LETMON(12)
	DATA (LETMON(I),I=1,12)/'-Jan-','-Feb-','-Mar-','-Apr-',
	1 '-May-','-Jun-','-Jul-','-Aug-','-Sep-','-Oct-','-Nov-',
	2 '-Dec-'/

	WRITE (2,107)
	LINENO=0
	WRITE (2,100) CDATE,ZSYSNA
	LINENO=LINENO+1
	WRITE (2,101) LNAME
	LINENO=LINENO+1
	WRITE (2,102) FDATE(3),LETMON(FDATE(2)),FDATE(1),FDATE(4),
	1 FDATE(5),LDATE(3),LETMON(LDATE(2)),LDATE(1),LDATE(4),LDATE(5)
	LINENO=LINENO+1
	WRITE (2,103)
	LINENO=LINENO+2
	WRITE (2,104)
	LINENO=LINENO+1
	WRITE (2,105)
	LINENO=LINENO+1
	WRITE (2,106)
	LINENO=LINENO+2
	RETURN

C OUTPUT FORMATS FOR THE PAGE HEADER
100	FORMAT ('*','Run Date:', T12,A5,T17,A5,T22,A5,T47,39A1)
101	FORMAT ('*','User ',39A1,T53,'TOPS20 System USAGE Report')
102	FORMAT ('*',T39,'USAGE Entries From: ',I2,A5,I4,1X,I2,':',I2,
	1 1X,'to: ',I2,A5,I4,1X,I2,':',I2)
103	FORMAT ('*',/'*',T56,'Connect',T76,'Input',T84,'Output')
104	FORMAT ('*',T46,'Total',T57,'Time',T66,'Runtime',T75,
	1 'Spooler',T83,'Spooler')
105	FORMAT ('*',T15,'Account',T45,'Charge',T56,'(Hours)',T67,
	1 '(Sec.)',T76,'Cards',T84,'Pages',T91,'Remark')
106	FORMAT ('*',T15,'-------',T43,'-----------',T55,'---------',
	1 T65,'---------',T75,'-------',T83,'-------',T91,'------'/
	2 '*')
107	FORMAT ('1')

	END
C ********
C	SUBROUTINE TO OUTPUT DETAIL LINE WHENEVER A REMARK, ACCOUNT, OR
C	NAME CHANGES IN SYSTEM USAGE REPORT SORTED BY NAME
C **********
	SUBROUTINE NAMERS (LINENO,LREMAR,LACCOU,XCHARG,XCONNE,XRUNTI,
	1 XCARDS,XPAGES,CDATE,FDATE,LDATE,ZSYSNA,LNAME)

	IMPLICIT INTEGER (A-Z)
	REAL XCONNE,XRUNTI,XCHARG
	DIMENSION LREMAR(39),LACCOU(39),CDATE(3),FDATE(5),LDATE(5)
	DIMENSION ZSYSNA(39),LNAME(39)

	IF (XCARDS.EQ.0) GO TO 1
	WRITE (2,100) LACCOU,XCHARG,XRUNTI,XCARDS,LREMAR
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	GO TO 3
1	IF (XPAGES.EQ.0) GO TO 2
	WRITE (2,101) LACCOU,XCHARG,XRUNTI,XPAGES,LREMAR
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	GO TO 3
2	WRITE (2,102) LACCOU,XCHARG,XCONNE,XRUNTI,LREMAR
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
3	XCHARG=0.
	XCONNE=0.
	XRUNTI=0.
	XCARDS=0
	XPAGES=0
	RETURN

100	FORMAT ('*',39A1,T41,'$',F10.2,T65,F8.1,T75,I7,T91,39A1)
101	FORMAT ('*',39A1,T41,'$',F10.2,T65,F8.1,T83,I7,T91,39A1)
102	FORMAT ('*',39A1,T41,'$',F10.2,T55,F8.2,T65,F8.1,T91,39A1)
	END
C **********
C	SUBROUTINE TO OUTPUT ACCOUNT SUBTOTAL FOOTING WHEN ACCOUNT OR
C	NAME CHANGES IN SYSTEM USAGE REPORT SORTED BY NAME
C **********
	SUBROUTINE NAMEAS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,
	1 CDATE,FDATE,LDATE,ZSYSNA,LNAME)

	IMPLICIT INTEGER (A-Z)
	REAL YCHARG,YCONNE,YRUNTI
	DIMENSION CDATE(3),FDATE(5),LDATE(5),ZSYSNA(39),LNAME(39)

	WRITE (2,100)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,101) YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,102)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,102)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
1	YCHARG=0.
	YRUNTI=0.
	YCONNE=0.
	YPAGES=0
	YCARDS=0
	RETURN

100	FORMAT ('*',T41,'-----------',T55,'---------',T65,'---------',
	1 T75,'-------',T83,'-------')
101	FORMAT ('*','* * * Account Subtotal * * *',T41,'$',F10.2,T55,
	1 F8.2,T65,F8.1,T75,I7,T83,I7)
102	FORMAT ('*')
	END
C **********
C	SUBROUTINE TO OUTPUT REPORT FOOTING WHEN THE NAME CHANGES IN
C	SYSTEM USAGE REPORT SORTED BY NAME
C **********

	SUBROUTINE NAMENS (LINENO,ZCHARG,ZCONNE,ZRUNTI,ZCARDS,ZPAGES,
	1 CDATE,FDATE,LDATE,ZSYSNA,LNAME,FSESCO,FSESRU,FPAGRU,FPAGPA,
	2 FCRDRU,FCRDCR)

	IMPLICIT INTEGER (A-Z)
	REAL ZCHARG,ZCONNE,ZRUNTI,FSESCO,FSESRU,FPAGRU,FPAGPA,FCRDRU
	REAL FCRDCR
	DIMENSION CDATE(3),FDATE(5),LDATE(5),ZSYSNA(39),LNAME(39)

	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,101)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,102) ZCHARG,ZCONNE,ZRUNTI,ZCARDS,ZPAGES
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,100)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,103)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,104) LNAME
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,103)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,105)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,106) FSESCO,FSESRU
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,107) FCRDCR,FCRDRU
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
	1 LINENO)
	WRITE (2,108) FPAGPA,FPAGRU
	RETURN

100	FORMAT ('*')
101	FORMAT ('*',T41,'===========',T55,'=========',T65,'=========',
	1 T75,'=======',T83,'=======')
102	FORMAT ('*','* * * Totals * * *',T41,'$',F10.2,T55,F8.2,T65,
	1 F8.1,T75,I7,T83,I7)
103	FORMAT ('*','******************************')
104	FORMAT ('*','* End of Report for User ',39A1)
105	FORMAT ('*','Rates:')
106	FORMAT ('*',T5,'Session Connect Time = $',F5.2,
	1 '/Hour,  Session Runtime',8X,'= $',F5.2,'/Second')
107	FORMAT ('*',T5,'Input Spooler Unit   = $',F5.2,
	1 '/Card,  Input Spooler Runtime  = $',F5.2,'/Second')
108	FORMAT ('*',T5,'Output Spooler Unit  = $',F5.2,
	1 '/Page,  Output Spooler Runtime = $',F5.2,'/Second')
	END
C ************************************************************************
C	SUBROUTINE TO PRODUCE A SYSTEM USAGE REPORT SORTED BY ACCOUNT, NAME,
C	AND REMARK - REPACT
C ************************************************************************

	SUBROUTINE REPACT (OUTFIL,ZSYSNA,CDATE,FDATE,LDATE,FSESCO,
	1 FSESRU,FPAGRU,FPAGPA,FCRDRU,FCRDCR)
	IMPLICIT INTEGER (A-Z)
	DOUBLE PRECISION OUTFIL
	DIMENSION CDATE(3),FDATE(5),LDATE(5),ZSYSNA(39)
	DIMENSION ACCOUN(39),NAME(39),REMARK(39)
	DIMENSION LACCOU(39),LNAME(39),LREMAR(39)

	REAL FSESCO,FSESRU,FPAGRU,FPAGPA,FCRDRU,FCRDCR
	REAL FCHARG,FCONNE,FRUNTI
	REAL XCHARG,XCONNE,XRUNTI
	REAL YCHARG,YCONNE,YRUNTI
	REAL ZCHARG,ZCONNE,ZRUNTI

	OPEN (FILE='OUTSRT.TMP',UNIT=1,DEVICE='DSK',ACCESS='SEQIN')
	OPEN (FILE=OUTFIL,UNIT=2,DEVICE='DSK',ACCESS='SEQOUT')

C FIRST INITIALIZE ACCOUNT, NAME AND REMARK (ITEMS BEGINNING WITH L, E.G.,
C	LACCOU, LREMAR, LNAME).  THESE  ARE THE CONTROLS OF THE REPORT.
C	WHEN THE NAME READ IN IS DIFFERENT FROM LNAME, A REPORT FOOTING
C	IS OUTPUT, A PAGE HEADER IS OUTPUT, ETC.  ALSO INITIALIZE THE
C	ACCUMULATORS FOR RUNTIME, CONNECT TIME, PAGES, CARDS, AND CHARGES.
C	IF THE REMARK JUST READ IN IS DIFFERENT, THE X* (E.G., XRUNTI,
C	XCONNE, XPAGE, ETC.) ARE OUTPUT AND ZEROED.  WHEN THE NAME
C	CHANGES, THE ITEMS BEGINNING WITH Y* WILL BE OUTPUT AND THE X*
C	AND Y* ITEMS ARE ZEROED.  WHEN THE ACCOUNT CHANGES, THE ITEMS
C	BEGINNING WITH Z* ARE OUTPUT AND ALL ITEMS (X*, Y*, Z*) WILL BE
C	ZEROED.

	READ (1,1000,END=500) NAME,REMARK,ACCOUN,FCONNE,FRUNTI,CARDS,
	1 PAGES,FCHARG
1	DO 2 I=1,39
	LACCOU(I)=ACCOUN(I)
	LNAME(I)=NAME(I)
2	LREMAR(I)=REMARK(I)
	XCONNE=FCONNE
	YCONNE=FCONNE
	ZCONNE=FCONNE
	XRUNTI=FRUNTI
	YRUNTI=FRUNTI
	ZRUNTI=FRUNTI
	XCARDS=CARDS
	YCARDS=CARDS
	ZCARDS=CARDS
	XPAGES=PAGES
	YPAGES=PAGES
	ZPAGES=PAGES
	XCHARG=FCHARG
	YCHARG=FCHARG
	ZCHARG=FCHARG
	CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,LINENO)
3	READ (1,1000,END=500) NAME,REMARK,ACCOUN,FCONNE,FRUNTI,CARDS,
	1 PAGES,FCHARG
	J=0
	DO 4 I=1,39
4	IF (ACCOUN(I).NE.LACCOU(I)) J=J+1
	IF (J.EQ.0) GO TO 5
	CALL ACCTRS (LINENO,LREMAR,LACCOU,XCHARG,XCONNE,XRUNTI,XCARDS,
	1 XPAGES,CDATE,FDATE,LDATE,ZSYSNA,LNAME)
	CALL ACCTNS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,CDATE,
	1 FDATE,LDATE,ZSYSNA,LACCOU)
	CALL ACCTAS (LINENO,ZCHARG,ZCONNE,ZRUNTI,ZCARDS,ZPAGES,CDATE,
	1 FDATE,LDATE,ZSYSNA,LACCOU,FSESCO,FSESRU,FPAGRU,FPAGPA,FCRDRU,
	2 FCRDCR)
	GO TO 1
5	J=0
	DO 6 I=1,39
6	IF (NAME(I).NE.LNAME(I)) J=J+1
	IF (J.EQ.0) GO TO 8
	CALL ACCTRS (LINENO,LREMAR,LACCOU,XCHARG,XCONNE,XRUNTI,XCARDS,
	1 XPAGES,CDATE,FDATE,LDATE,ZSYSNA,LNAME)
	CALL ACCTNS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,CDATE,
	1 FDATE,LDATE,ZSYSNA,LACCOU)
	DO 7 I=1,39
	LNAME(I)=NAME(I)
7	LREMAR(I)=REMARK(I)
	XCONNE=FCONNE
	YCONNE=FCONNE
	ZCONNE=ZCONNE+FCONNE
	XRUNTI=FRUNTI
	YRUNTI=FRUNTI
	ZRUNTI=ZRUNTI+FRUNTI
	XCARDS=CARDS
	YCARDS=CARDS
	ZCARDS=ZCARDS+CARDS
	XPAGES=PAGES
	YPAGES=PAGES
	ZPAGES=ZPAGES+PAGES
	XCHARG=FCHARG
	YCHARG=FCHARG
	ZCHARG=ZCHARG+FCHARG
	GO TO 3
8	J=0
	DO 9 I=1,39
9	IF (REMARK(I).NE.LREMAR(I)) J=J+1
	IF (J.EQ.0) GO TO 11
	CALL ACCTRS (LINENO,LREMAR,LACCOU,XCHARG,XCONNE,XRUNTI,XCARDS,
	1 XPAGES,CDATE,FDATE,LDATE,ZSYSNA,LNAME)
	DO 10 I=1,39
10	LREMAR(I)=REMARK(I)
	XCONNE=FCONNE
	YCONNE=YCONNE+FCONNE
	ZCONNE=ZCONNE+FCONNE
	XRUNTI=FRUNTI
	YRUNTI=YRUNTI+FRUNTI
	ZRUNTI=ZRUNTI+FRUNTI
	XCARDS=CARDS
	YCARDS=YCARDS+CARDS
	ZCARDS=ZCARDS+CARDS
	XPAGES=PAGES
	YPAGES=YPAGES+PAGES
	ZPAGES=ZPAGES+PAGES
	XCHARG=FCHARG
	YCHARG=YCHARG+FCHARG
	ZCHARG=ZCHARG+FCHARG
	GO TO 3
11	XCONNE=XCONNE+FCONNE
	YCONNE=YCONNE+FCONNE
	ZCONNE=ZCONNE+FCONNE
	XRUNTI=XRUNTI+FRUNTI
	YRUNTI=YRUNTI+FRUNTI
	ZRUNTI=ZRUNTI+FRUNTI
	XCARDS=XCARDS+CARDS
	YCARDS=YCARDS+CARDS
	ZCARDS=ZCARDS+CARDS
	XPAGES=XPAGES+PAGES
	YPAGES=YPAGES+PAGES
	ZPAGES=ZPAGES+PAGES
	XCHARG=XCHARG+FCHARG
	YCHARG=YCHARG+FCHARG
	ZCHARG=ZCHARG+FCHARG
	GO TO 3

C **********
C HERE WHEN END OF FILE HAS BEEN READ IN SORT FILE.  OUTPUT LAST
C 	REPORT AND FINISH UP.
C **********

500	CALL ACCTRS (LINENO,LREMAR,LACCOU,XCHARG,XCONNE,XRUNTI,XCARDS,
	1 XPAGES,CDATE,FDATE,LDATE,ZSYSNA,LNAME)
	CALL ACCTNS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,CDATE,
	1 FDATE,LDATE,ZSYSNA,LACCOU)
	CALL ACCTAS (LINENO,ZCHARG,ZCONNE,ZRUNTI,ZCARDS,ZPAGES,CDATE,
	1 FDATE,LDATE,ZSYSNA,LACCOU,FSESCO,FSESRU,FPAGRU,FPAGPA,FCRDRU,
	2 FCRDCR)
	CLOSE (FILE='OUTSRT.TMP',UNIT=1,DEVICE='DSK',DISPOSE='DELETE')
	CLOSE (FILE=OUTFIL,UNIT=2,DEVICE='DSK')
	RETURN

C INPUT FORMAT STATEMENT
1000	FORMAT (3(39A1),F8.2,F8.1,2I7,F10.2)

C ************************************************************************
C	END OF SUBROUTINES TO REPORT SYSTEM USAGE SORTED BY ACCOUNT, NAME
C	AND REMARK - REPACT
C ************************************************************************
	END
C **********
C	SUBROUTINE TO OUTPUT THE PAGE HEADER FOR SYSTEM USAGE REPORT BY
C	ACCOUNT
C **********
	SUBROUTINE ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,LINENO)

	IMPLICIT INTEGER (A-Z)
	DIMENSION CDATE(3),FDATE(5),LDATE(5),ZSYSNA(39),LACCOU(39)
	DIMENSION LETMON(12)
	DATA (LETMON(I),I=1,12)/'-Jan-','-Feb-','-Mar-','-Apr-',
	1 '-May-','-Jun-','-Jul-','-Aug-','-Sep-','-Oct-','-Nov-',
	2 '-Dec-'/

	WRITE (2,107)
	LINENO=0
	WRITE (2,100) CDATE,ZSYSNA
	LINENO=LINENO+1
	WRITE (2,101) LACCOU
	LINENO=LINENO+1
	WRITE (2,102) FDATE(3),LETMON(FDATE(2)),FDATE(1),FDATE(4),
	1 FDATE(5),LDATE(3),LETMON(LDATE(2)),LDATE(1),LDATE(4),LDATE(5)
	LINENO=LINENO+1
	WRITE (2,103)
	LINENO=LINENO+2
	WRITE (2,104)
	LINENO=LINENO+1
	WRITE (2,105)
	LINENO=LINENO+1
	WRITE (2,106)
	LINENO=LINENO+2
	RETURN

C OUTPUT FORMATS FOR THE PAGE HEADER
100	FORMAT ('*','Run Date:', T12,A5,T17,A5,T22,A5,T47,39A1)
101	FORMAT ('*','Account ',39A1,T53,'TOPS20 System USAGE Report')
102	FORMAT ('*',T39,'USAGE Entries From: ',I2,A5,I4,1X,I2,':',I2,
	1 1X,'to: ',I2,A5,I4,1X,I2,':',I2)
103	FORMAT ('*',/'*',T56,'Connect',T76,'Input',T84,'Output')
104	FORMAT ('*',T46,'Total',T57,'Time',T66,'Runtime',T75,
	1 'Spooler',T83,'Spooler')
105	FORMAT ('*',T17,'Name',T45,'Charge',T56,'(Hours)',T67,
	1 '(Sec.)',T76,'Cards',T84,'Pages',T91,'Remark')
106	FORMAT ('*',T17,'----',T43,'-----------',T55,'---------',
	1 T65,'---------',T75,'-------',T83,'-------',T91,'------'/
	2 '*')
107	FORMAT ('1')

	END
C ********
C	SUBROUTINE TO OUTPUT DETAIL LINE WHENEVER A REMARK, ACCOUNT, OR
C	NAME CHANGES IN SYSTEM USAGE REPORT SORTED BY ACCOUNT
C **********
	SUBROUTINE ACCTRS (LINENO,LREMAR,LACCOU,XCHARG,XCONNE,XRUNTI,
	1 XCARDS,XPAGES,CDATE,FDATE,LDATE,ZSYSNA,LNAME)

	IMPLICIT INTEGER (A-Z)
	REAL XCONNE,XRUNTI,XCHARG
	DIMENSION LREMAR(39),LACCOU(39),CDATE(3),FDATE(5),LDATE(5)
	DIMENSION ZSYSNA(39),LNAME(39)

	IF (XCARDS.EQ.0) GO TO 1
	WRITE (2,100) LNAME,XCHARG,XRUNTI,XCARDS,LREMAR
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	GO TO 3
1	IF (XPAGES.EQ.0) GO TO 2
	WRITE (2,101) LNAME,XCHARG,XRUNTI,XPAGES,LREMAR
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	GO TO 3
2	WRITE (2,102) LNAME,XCHARG,XCONNE,XRUNTI,LREMAR
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
3	XCHARG=0.
	XCONNE=0.
	XRUNTI=0.
	XCARDS=0
	XPAGES=0
	RETURN

100	FORMAT ('*',39A1,T41,'$',F10.2,T65,F8.1,T75,I7,T91,39A1)
101	FORMAT ('*',39A1,T41,'$',F10.2,T65,F8.1,T83,I7,T91,39A1)
102	FORMAT ('*',39A1,T41,'$',F10.2,T55,F8.2,T65,F8.1,T91,39A1)
	END
C **********
C	SUBROUTINE TO OUTPUT NAME SUBTOTAL FOOTING WHEN ACCOUNT OR
C	NAME CHANGES IN SYSTEM USAGE REPORT SORTED BY ACCOUNT
C **********
	SUBROUTINE ACCTNS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,
	1 CDATE,FDATE,LDATE,ZSYSNA,LACCOU)

	IMPLICIT INTEGER (A-Z)
	REAL YCHARG,YCONNE,YRUNTI
	DIMENSION CDATE(3),FDATE(5),LDATE(5),ZSYSNA(39),LACCOU(39)

	WRITE (2,100)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,101) YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,102)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,102)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
1	YCHARG=0.
	YRUNTI=0.
	YCONNE=0.
	YPAGES=0
	YCARDS=0
	RETURN

100	FORMAT ('*',T41,'-----------',T55,'---------',T65,'---------',
	1 T75,'-------',T83,'-------')
101	FORMAT ('*','* * * User Subtotal * * *',T41,'$',F10.2,T55,
	1 F8.2,T65,F8.1,T75,I7,T83,I7)
102	FORMAT ('*')
	END
C **********
C	SUBROUTINE TO OUTPUT REPORT FOOTING WHEN THE ACCOUNT CHANGES IN
C	SYSTEM USAGE REPORT SORTED BY ACCOUNT
C **********

	SUBROUTINE ACCTAS (LINENO,ZCHARG,ZCONNE,ZRUNTI,ZCARDS,ZPAGES,
	1 CDATE,FDATE,LDATE,ZSYSNA,LACCOU,FSESCO,FSESRU,FPAGRU,FPAGPA,
	2 FCRDRU,FCRDCR)

	IMPLICIT INTEGER (A-Z)
	REAL ZCHARG,ZCONNE,ZRUNTI,FSESCO,FSESRU,FPAGRU,FPAGPA,FCRDRU
	REAL FCRDCR
	DIMENSION CDATE(3),FDATE(5),LDATE(5),ZSYSNA(39),LACCOU(39)

	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,101)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,102) ZCHARG,ZCONNE,ZRUNTI,ZCARDS,ZPAGES
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,100)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,103)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,104) LACCOU
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,103)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,105)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,106) FSESCO,FSESRU
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,107) FCRDCR,FCRDRU
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL ACCTPH (CDATE,FDATE,LDATE,ZSYSNA,LACCOU,
	1 LINENO)
	WRITE (2,108) FPAGPA,FPAGRU
	RETURN

100	FORMAT ('*')
101	FORMAT ('*',T41,'===========',T55,'=========',T65,'=========',
	1 T75,'=======',T83,'=======')
102	FORMAT ('*','* * * Totals * * *',T41,'$',F10.2,T55,F8.2,T65,
	1 F8.1,T75,I7,T83,I7)
103	FORMAT ('*','******************************')
104	FORMAT ('*','* End of Report for Account ',39A1)
105	FORMAT ('*','Rates:')
106	FORMAT ('*',T5,'Session Connect Time = $',F5.2,
	1 '/Hour,  Session Runtime',8X,'= $',F5.2,'/Second')
107	FORMAT ('*',T5,'Input Spooler Unit   = $',F5.2,
	1 '/Card,  Input Spooler Runtime  = $',F5.2,'/Second')
108	FORMAT ('*',T5,'Output Spooler Unit  = $',F5.2,
	1 '/Page,  Output Spooler Runtime = $',F5.2,'/Second')
	END
C ************************************************************************
C	SUBROUTINE TO PRODUCE A DISK USAGE REPORT SORTED BY DIRECTORY,
C	ACCOUNT AND STRUCTURE - REPDNA
C ************************************************************************
	SUBROUTINE REPDNA(OUTFIL,ZSYSNA,CDATE,FDATE,FDSKPA)
	IMPLICIT INTEGER (A-Z)
	DOUBLE PRECISION OUTFIL
	DIMENSION CDATE(3),FDATE(5),ZSYSNA(39)
	DIMENSION DIRECT(39),STRNAM(6),ACCOUN(39)
	DIMENSION LDIREC(39),LSTRNA(6),LACCOU(39)
	REAL FDSKPA,FCHARG,XCHARG,YCHARG,ZCHARG

	OPEN (FILE='OUTSRT.TMP',UNIT=1,DEVICE='DSK',ACCESS='SEQIN')
	OPEN (FILE=OUTFIL,UNIT=2,DEVICE='DSK',ACCESS='SEQOUT')

C FIRST INITIALIZE ACCOUNT, DIRECTORY, AND STRUCTURE (ITEMS BEGINNING
C	WITH L, E.G., LACCOU, LSTRNA, LDIREC).  THESE ARE THE CONTROLS
C	OF THE REPORT.  WHEN THE DIRECTORY READ IN IS DIFFERENT FROM 
C	LDIREC, A REPORT FOOTING IS OUTPUT, A PAGE HEADER IS OUTPUT, ETC.
C	ALSO INITIALIZE THE ACCUMULATORS FOR DISK PAGES, FILES, AND CHARGE.
C	IF THE STRUCUTRE NAME JUST READ IN IS DIFFERENT, THE X* (E.G.,
C	XCHARG, XPAGES, XFILES, ETC.) ARE OUTPUT AND ZEROED.  WHEN
C	THE ACCOUNT CHANGES, THE ITEMS BEGINNING WITH Y* WILL BE OUTPUT
C	AND THE X* ITEMS AND Y* ITEMS ARE ZEROED. WHEN THE DIRECTORY
C	CHANGES, THE ITEMS BEGINNING WITH Z* ARE OUTPUT AND ALL ITEMS
C	(X*,Y*,Z*) WILL BE ZEROED.

	READ (1,1000,END=500) DIRECT,STRNAM,ACCOUN,PAGES,FILES,FCHARG
1	DO 2 I=1,39
	LDIREC(I)=DIRECT(I)
2	LACCOU(I)=ACCOUN(I)
	DO 12 I=1,6
12	LSTRNA(I)=STRNAM(I)
	XPAGES=PAGES
	YPAGES=PAGES
	ZPAGES=PAGES
	XFILES=FILES
	YFILES=FILES
	ZFILES=FILES
	XCHARG=FCHARG
	YCHARG=FCHARG
	ZCHARG=FCHARG
	XRECRD=1
	YRECRD=1
	ZRECRD=1
	CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
3	READ (1,1000,END=500) DIRECT,STRNAM,ACCOUN,PAGES,FILES,FCHARG
	J=0
	DO 4 I=1,39
4	IF (DIRECT(I).NE.LDIREC(I)) J=J+1
	IF (J.EQ.0) GO TO 5
	CALL DNAMRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,CDATE,
	1 FDATE,ZSYSNA,LDIREC,XRECRD)
	CALL DNAMAS (LINENO,YCHARG,YPAGES,YFILES,CDATE,FDATE,ZSYSNA,
	1 LDIREC,YRECRD)
	CALL DNAMDS (LINENO,ZCHARG,ZPAGES,ZFILES,CDATE,FDATE,ZSYSNA,
	1 LDIREC,FDSKPA,ZRECRD)
	GO TO 1
5	J=0
	DO 6 I=1,39
6	IF (ACCOUN(I).NE.LACCOU(I)) J=J+1
	IF (J.EQ.0) GO TO 8
	CALL DNAMRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,CDATE,
	1 FDATE,ZSYSNA,LDIREC,XRECRD)
	CALL DNAMAS (LINENO,YCHARG,YPAGES,YFILES,CDATE,FDATE,ZSYSNA,
	1 LDIREC,YRECRD)
	DO 7 I=1,39
7	LACCOU(I)=ACCOUN(I)
	DO 13 I=1,6
13	LSTRNA(I)=STRNAM(I)
	XPAGES=PAGES
	YPAGES=PAGES
	ZPAGES=ZPAGES+PAGES
	XFILES=FILES
	YFILES=FILES
	ZFILES=ZFILES+FILES
	XCHARG=FCHARG
	YCHARG=FCHARG
	ZCHARG=ZCHARG+FCHARG
	XRECRD=1
	YRECRD=1
	ZRECRD=ZRECRD+1
	GO TO 3
8	J=0
	DO 9 I=1,6
9	IF (STRNAM(I).NE.LSTRNA(I)) J=J+1
	IF (J.EQ.0) GO TO 11
	CALL DNAMRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,CDATE,
	1 FDATE,ZSYSNA,LDIREC,XRECRD)
	DO 10 I=1,6
10	LSTRNA(I)=STRNAM(I)
	XPAGES=PAGES
	YPAGES=YPAGES+PAGES
	ZPAGES=ZPAGES+PAGES
	XFILES=FILES
	YFILES=YFILES+FILES
	ZFILES=ZFILES+FILES
	XCHARG=FCHARG
	YCHARG=YCHARG+FCHARG
	ZCHARG=ZCHARG+FCHARG
	XRECRD=1
	YRECRD=YRECRD+1
	ZRECRD=ZRECRD+1
	GO TO 3
11	XPAGES=XPAGES+PAGES
	YPAGES=YPAGES+PAGES
	ZPAGES=ZPAGES+PAGES
	XFILES=XFILES+FILES
	YFILES=YFILES+FILES
	ZFILES=ZFILES+FILES
	XCHARG=XCHARG+FCHARG
	YCHARG=YCHARG+FCHARG
	ZCHARG=ZCHARG+FCHARG
	XRECRD=XRECRD+1
	YRECRD=YRECRD+1
	ZRECRD=ZRECRD+1
	GO TO 3

C **********
C HERE WHEN END OF FILE HAS BEEN READ IN SORT FILE. OUTPUT LAST REPORT
C	AND FINISH UP
C *********

500	CALL DNAMRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,CDATE,
	1 FDATE,ZSYSNA,LDIREC,XRECRD)
	CALL DNAMAS (LINENO,YCHARG,YPAGES,YFILES,CDATE,FDATE,ZSYSNA,
	1 LDIREC,YRECRD)
	CALL DNAMDS (LINENO,ZCHARG,ZPAGES,ZFILES,CDATE,FDATE,ZSYSNA,
	1 LDIREC,FDSKPA,ZRECRD)
	CLOSE (FILE='OUTSRT.TMP',UNIT=1,DEVICE='DSK',DISPOSE='DELETE')
	CLOSE (FILE=OUTFIL,UNIT=2,DEVICE='DSK')
	RETURN

C INPUT FORMAT STATEMENT
1000	FORMAT (39A1,6A1,39A1,I10,I5,F10.2)

	END
C **********
C	SUBROUTINE TO OUTPUT THE PAGE HEADER FOR DISK USAGE REPORT
C	SORTED BY DIRECTORY
C **********
	SUBROUTINE DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)

	IMPLICIT INTEGER (A-Z)
	DIMENSION CDATE(3),FDATE(5),ZSYSNA(39),LDIREC(39)
	DIMENSION LETMON(12)
	DATA (LETMON(I),I=1,12)/'-Jan-','-Feb-','-Mar-','-Apr-',
	1 '-May-','-Jun-','-Jul-','-Aug-','-Sep-','-Oct-','-Nov-',
	2 '-Dec-'/

	WRITE (2,106)
	LINENO=0
	WRITE (2,100) CDATE,ZSYSNA
	LINENO=LINENO+1
	WRITE (2,101) LDIREC
	LINENO=LINENO+1
	WRITE (2,102) FDATE(3),LETMON(FDATE(2)),FDATE(1),FDATE(4),FDATE(5)
	LINENO=LINENO+1
	WRITE (2,103)
	LINENO=LINENO+2
	WRITE (2,104)
	LINENO=LINENO+1
	WRITE (2,105)
	LINENO=LINENO+2
	RETURN

C OUTPUT FORMATS FOR THE PAGE HEADER
100	FORMAT ('*','Run Date: ',3A5,T47,39A1)
101	FORMAT ('*','Directory ',39A1,T54,'TOPS20 Directory USAGE Report')
102	FORMAT ('*',T48,'USAGE Entries on: ',I2,A5,I4,1X,I2,':',I2)
103	FORMAT ('*',/'*',T45,'Total',T56,'Disk',T65,'Number',T74,
	1 'Avg. No.',T84,'Structure')
104	FORMAT ('*',T15,'Account',T44,'Charge',T56,'Pages',T64,
	1 'of Files',T74,'of Pages',T86,'Name')
105	FORMAT ('*',T15,'-------',T42,'-----------',T54,'---------',T64,
	1 '---------',T74,'---------',T84,'---------'/'*')
106	FORMAT ('1')

	END
C ********
C	SUBROUTINE TO OUTPUT DETAIL LINE WHENEVER A STRUCTURE, ACCOUNT, OR
C	DIRECTORY CHANGES IN DISK USAGE REPORT SORTED BY DIRECTORY
C **********
	SUBROUTINE DNAMRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,
	1 CDATE,FDATE,ZSYSNA,LDIREC,XRECRD)

	IMPLICIT INTEGER (A-Z)
	REAL XCHARG,AVGPAG
	DIMENSION LSTRNA(6),LACCOU(39),CDATE(3),FDATE(5)
	DIMENSION ZSYSNA(39),LDIREC(39)

	AVGPAG=FLOAT(XPAGES)/FLOAT(XRECRD)
	WRITE (2,100) LACCOU,XCHARG,XPAGES,XFILES,AVGPAG,LSTRNA
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	XCHARG=0.
	XPAGES=0
	XFILES=0
	XRECRD=0
	RETURN

100	FORMAT ('*',39A1,T41,'$',F10.2,T54,I9,T64,I9,T75,F8.1,T84,6A1)
	END
C **********
C	SUBROUTINE TO OUTPUT ACCOUNT SUBTOTAL FOOTING WHEN ACCOUNT OR
C	DIRECTORY CHANGES IN DISK USAGE REPORT SORTED BY DIRECTORY
C **********
	SUBROUTINE DNAMAS (LINENO,YCHARG,YPAGES,YFILES,
	1 CDATE,FDATE,ZSYSNA,LDIREC,YRECRD)

	IMPLICIT INTEGER (A-Z)
	REAL YCHARG,AVGPAG
	DIMENSION CDATE(3),FDATE(5),ZSYSNA(39),LDIREC(39)

	AVGPAG=FLOAT(YPAGES)/FLOAT(YRECRD)
	WRITE (2,100)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,101) YCHARG,YPAGES,YFILES,AVGPAG
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	WRITE (2,102)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	WRITE (2,102)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	YCHARG=0.
	YPAGES=0
	YFILES=0
	YRECRD=0
	RETURN

100	FORMAT ('*',T41,'-----------',T54,'---------',T64,'---------',
	1 T74,'---------')
101	FORMAT ('*','* * * Account Subtotal * * *',T41,'$',F10.2,T54,
	1 I9,T64,I9,T75,F8.1)
102	FORMAT ('*')
	END
C **********
C	SUBROUTINE TO OUTPUT REPORT FOOTING WHEN THE DIRECTORY CHANGES IN
C	DISK USAGE REPORT SORTED BY DIRECTORY
C **********

	SUBROUTINE DNAMDS (LINENO,ZCHARG,ZPAGES,ZFILES,
	1 CDATE,FDATE,ZSYSNA,LDIREC,FDSKPA,ZRECRD)

	IMPLICIT INTEGER (A-Z)
	REAL ZCHARG,FDSKPA,AVGPAG
	DIMENSION CDATE(3),FDATE(5),ZSYSNA(39),LDIREC(39)

	AVGPAG=FLOAT(ZPAGES)/FLOAT(ZRECRD)
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	WRITE (2,101)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	WRITE (2,102) ZCHARG,ZPAGES,ZFILES,AVGPAG
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	WRITE (2,100)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	WRITE (2,103)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	WRITE (2,104) LDIREC
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	WRITE (2,103)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	WRITE (2,105)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	WRITE (2,106) FDSKPA
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LDIREC,LINENO)
	RETURN

100	FORMAT ('*')
101	FORMAT ('*',T41,'===========',T54,'=========',T64,'=========',
	1 T74,'=========')
102	FORMAT ('*','* * * Totals * * *',T41,'$',F10.2,T54,I9,T64,
	1 I9,T75,F8.1)
103	FORMAT ('*','******************************')
104	FORMAT ('*','* End of Report for Directory ',39A1)
105	FORMAT ('*','Rates:')
106	FORMAT ('*',T5,'Disk Usage = $',F5.2,'/Page')
	END

C ************************************************************************
C	END OF SUBROUTINES TO REPORT DISK USAGE BY DIRECTORY, ACCOUNT,
C	AND STRUCTURE - REPDNA
C ************************************************************************
C ************************************************************************
C	SUBROUTINE TO PRODUCE A DISK USAGE REPORT SORTED BY ACCOUNT,
C	DIRECTORY AND STRUCTURE - REPDAC
C ************************************************************************
	SUBROUTINE REPDAC(OUTFIL,ZSYSNA,CDATE,FDATE,FDSKPA)
	IMPLICIT INTEGER (A-Z)
	DOUBLE PRECISION OUTFIL
	DIMENSION CDATE(3),FDATE(5),ZSYSNA(39)
	DIMENSION DIRECT(39),STRNAM(6),ACCOUN(39)
	DIMENSION LDIREC(39),LSTRNA(6),LACCOU(39)
	REAL FDSKPA,FCHARG,XCHARG,YCHARG,ZCHARG

	OPEN (FILE='OUTSRT.TMP',UNIT=1,DEVICE='DSK',ACCESS='SEQIN')
	OPEN (FILE=OUTFIL,UNIT=2,DEVICE='DSK',ACCESS='SEQOUT')

C FIRST INITIALIZE ACCOUNT, DIRECTORY, AND STRUCTURE (ITEMS BEGINNING
C	WITH L, E.G., LACCOU, LSTRNA, LDIREC).  THESE ARE THE CONTROLS
C	OF THE REPORT.  WHEN THE ACCOUNT READ IN IS DIFFERENT FROM 
C	LACCOU, A REPORT FOOTING IS OUTPUT, A PAGE HEADER IS OUTPUT, ETC.
C	ALSO INITIALIZE THE ACCUMULATORS FOR DISK PAGES, FILES, AND CHARGE.
C	IF THE STRUCUTRE NAME JUST READ IN IS DIFFERENT, THE X* (E.G.,
C	XCHARG, XPAGES, XFILES, ETC.) ARE OUTPUT AND ZEROED.  WHEN
C	THE DIRECTORY CHANGES, THE ITEMS BEGINNING WITH Y* WILL BE OUTPUT
C	AND THE X* ITEMS AND Y* ITEMS ARE ZEROED. WHEN THE ACCOUNT
C	CHANGES, THE ITEMS BEGINNING WITH Z* ARE OUTPUT AND ALL ITEMS
C	(X*,Y*,Z*) WILL BE ZEROED.

	READ (1,1000,END=500) DIRECT,STRNAM,ACCOUN,PAGES,FILES,FCHARG
1	DO 2 I=1,39
	LDIREC(I)=DIRECT(I)
2	LACCOU(I)=ACCOUN(I)
	DO 12 I=1,6
12	LSTRNA(I)=STRNAM(I)
	XPAGES=PAGES
	YPAGES=PAGES
	ZPAGES=PAGES
	XFILES=FILES
	YFILES=FILES
	ZFILES=FILES
	XCHARG=FCHARG
	YCHARG=FCHARG
	ZCHARG=FCHARG
	XRECRD=1
	YRECRD=1
	ZRECRD=1
	CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
3	READ (1,1000,END=500) DIRECT,STRNAM,ACCOUN,PAGES,FILES,FCHARG
	J=0
	DO 4 I=1,39
4	IF (ACCOUN(I).NE.LACCOU(I)) J=J+1
	IF (J.EQ.0) GO TO 5
	CALL DACTRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,CDATE,
	1 FDATE,ZSYSNA,LDIREC,XRECRD)
	CALL DACTDS (LINENO,YCHARG,YPAGES,YFILES,CDATE,FDATE,ZSYSNA,
	1 LACCOU,YRECRD)
	CALL DACTAS (LINENO,ZCHARG,ZPAGES,ZFILES,CDATE,FDATE,ZSYSNA,
	1 LACCOU,FDSKPA,ZRECRD)
	GO TO 1
5	J=0
	DO 6 I=1,39
6	IF (DIRECT(I).NE.LDIREC(I)) J=J+1
	IF (J.EQ.0) GO TO 8
	CALL DACTRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,CDATE,
	1 FDATE,ZSYSNA,LDIREC,XRECRD)
	CALL DACTDS (LINENO,YCHARG,YPAGES,YFILES,CDATE,FDATE,ZSYSNA,
	1 LACCOU,YRECRD)
	DO 7 I=1,39
7	LDIREC(I)=DIRECT(I)
	DO 13 I=1,6
13	LSTRNA(I)=STRNAM(I)
	XPAGES=PAGES
	YPAGES=PAGES
	ZPAGES=ZPAGES+PAGES
	XFILES=FILES
	YFILES=FILES
	ZFILES=ZFILES+FILES
	XCHARG=FCHARG
	YCHARG=FCHARG
	ZCHARG=ZCHARG+FCHARG
	XRECRD=1
	YRECRD=1
	ZRECRD=ZRECRD+1
	GO TO 3
8	J=0
	DO 9 I=1,6
9	IF (STRNAM(I).NE.LSTRNA(I)) J=J+1
	IF (J.EQ.0) GO TO 11
	CALL DACTRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,CDATE,
	1 FDATE,ZSYSNA,LDIREC,XRECRD)
	DO 10 I=1,6
10	LSTRNA(I)=STRNAM(I)
	XPAGES=PAGES
	YPAGES=YPAGES+PAGES
	ZPAGES=ZPAGES+PAGES
	XFILES=FILES
	YFILES=YFILES+FILES
	ZFILES=ZFILES+FILES
	XCHARG=FCHARG
	YCHARG=YCHARG+FCHARG
	ZCHARG=ZCHARG+FCHARG
	XRECRD=1
	YRECRD=YRECRD+1
	ZRECRD=ZRECRD+1
	GO TO 3
11	XPAGES=XPAGES+PAGES
	YPAGES=YPAGES+PAGES
	ZPAGES=ZPAGES+PAGES
	XFILES=XFILES+FILES
	YFILES=YFILES+FILES
	ZFILES=ZFILES+FILES
	XCHARG=XCHARG+FCHARG
	YCHARG=YCHARG+FCHARG
	ZCHARG=ZCHARG+FCHARG
	XRECRD=XRECRD+1
	YRECRD=YRECRD+1
	ZRECRD=ZRECRD+1
	GO TO 3

C **********
C HERE WHEN END OF FILE HAS BEEN READ IN SORT FILE. OUTPUT LAST REPORT
C	AND FINISH UP
C *********

500	CALL DACTRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,CDATE,
	1 FDATE,ZSYSNA,LDIREC,XRECRD)
	CALL DACTDS (LINENO,YCHARG,YPAGES,YFILES,CDATE,FDATE,ZSYSNA,
	1 LACCOU,YRECRD)
	CALL DACTAS (LINENO,ZCHARG,ZPAGES,ZFILES,CDATE,FDATE,ZSYSNA,
	1 LACCOU,FDSKPA,ZRECRD)
	CLOSE (FILE='OUTSRT.TMP',UNIT=1,DEVICE='DSK',DISPOSE='DELETE')
	CLOSE (FILE=OUTFIL,UNIT=2,DEVICE='DSK')
	RETURN

C INPUT FORMAT STATEMENT
1000	FORMAT (39A1,6A1,39A1,I10,I5,F10.2)

	END
C **********
C	SUBROUTINE TO OUTPUT THE PAGE HEADER FOR DISK USAGE REPORT
C	SORTED BY ACCOUNT
C **********
	SUBROUTINE DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)

	IMPLICIT INTEGER (A-Z)
	DIMENSION CDATE(3),FDATE(5),ZSYSNA(39),LACCOU(39)
	DIMENSION LETMON(12)
	DATA (LETMON(I),I=1,12)/'-Jan-','-Feb-','-Mar-','-Apr-',
	1 '-May-','-Jun-','-Jul-','-Aug-','-Sep-','-Oct-','-Nov-',
	2 '-Dec-'/

	WRITE (2,106)
	LINENO=0
	WRITE (2,100) CDATE,ZSYSNA
	LINENO=LINENO+1
	WRITE (2,101) LACCOU
	LINENO=LINENO+1
	WRITE (2,102) FDATE(3),LETMON(FDATE(2)),FDATE(1),FDATE(4),FDATE(5)
	LINENO=LINENO+1
	WRITE (2,103)
	LINENO=LINENO+2
	WRITE (2,104)
	LINENO=LINENO+1
	WRITE (2,105)
	LINENO=LINENO+2
	RETURN

C OUTPUT FORMATS FOR THE PAGE HEADER
100	FORMAT ('*','Run Date: ',3A5,T47,39A1)
101	FORMAT ('*','Account ',39A1,T54,'TOPS20 Directory USAGE Report')
102	FORMAT ('*',T48,'USAGE Entries on: ',I2,A5,I4,1X,I2,':',I2)
103	FORMAT ('*',/'*',T45,'Total',T56,'Disk',T65,'Number',T74,
	1 'Avg. No.',T84,'Structure')
104	FORMAT ('*',T14,'Directory',T44,'Charge',T56,'Pages',T64,
	1 'of Files',T74,'of Pages',T86,'Name')
105	FORMAT ('*',T14,'---------',T42,'-----------',T54,'---------',T64,
	1 '---------',T74,'---------',T84,'---------'/'*')
106	FORMAT ('1')

	END
C ********
C	SUBROUTINE TO OUTPUT DETAIL LINE WHENEVER A STRUCTURE, ACCOUNT, OR
C	DIRECTORY CHANGES IN DISK USAGE REPORT SORTED BY ACCOUNT
C **********
	SUBROUTINE DACTRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,
	1 CDATE,FDATE,ZSYSNA,LDIREC,XRECRD)

	IMPLICIT INTEGER (A-Z)
	REAL XCHARG,AVGPAG
	DIMENSION LSTRNA(6),LACCOU(39),CDATE(3),FDATE(5)
	DIMENSION ZSYSNA(39),LDIREC(39)

	AVGPAG=FLOAT(XPAGES)/FLOAT(XRECRD)
	WRITE (2,100) LDIREC,XCHARG,XPAGES,XFILES,AVGPAG,LSTRNA
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	XCHARG=0.
	XPAGES=0
	XFILES=0
	XRECRD=0
	RETURN

100	FORMAT ('*',39A1,T41,'$',F10.2,T54,I9,T64,I9,T75,F8.1,T84,6A1)
	END
C **********
C	SUBROUTINE TO OUTPUT DIRECTORY SUBTOTAL FOOTING WHEN ACCOUNT OR
C	DIRECTORY CHANGES IN DISK USAGE REPORT SORTED BY ACCOUNT
C **********
	SUBROUTINE DACTDS (LINENO,YCHARG,YPAGES,YFILES,
	1 CDATE,FDATE,ZSYSNA,LACCOU,YRECRD)

	IMPLICIT INTEGER (A-Z)
	REAL YCHARG,AVGPAG
	DIMENSION CDATE(3),FDATE(5),ZSYSNA(39),LACCOU(39)

	AVGPAG=FLOAT(YPAGES)/FLOAT(YRECRD)
	WRITE (2,100)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,101) YCHARG,YPAGES,YFILES,AVGPAG
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,102)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,102)
	LINENO = LINENO + 1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	YCHARG=0.
	YPAGES=0
	YFILES=0
	YRECRD=0
	RETURN

100	FORMAT ('*',T41,'-----------',T54,'---------',T64,'---------',
	1 T74,'---------')
101	FORMAT ('*','* * * Directory Subtotal * * *',T41,'$',F10.2,T54,
	1 I9,T64,I9,T75,F8.1)
102	FORMAT ('*')
	END
C **********
C	SUBROUTINE TO OUTPUT REPORT FOOTING WHEN THE ACCOUNT CHANGES IN
C	DISK USAGE REPORT SORTED BY ACCOUNT
C **********

	SUBROUTINE DACTAS (LINENO,ZCHARG,ZPAGES,ZFILES,
	1 CDATE,FDATE,ZSYSNA,LACCOU,FDSKPA,ZRECRD)

	IMPLICIT INTEGER (A-Z)
	REAL ZCHARG,FDSKPA,AVGPAG
	DIMENSION CDATE(3),FDATE(5),ZSYSNA(39),LACCOU(39)

	AVGPAG=FLOAT(ZPAGES)/FLOAT(ZRECRD)
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,101)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,102) ZCHARG,ZPAGES,ZFILES,AVGPAG
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,100)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,103)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,104) LACCOU
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,103)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,105)
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	WRITE (2,106) FDSKPA
	LINENO=LINENO+1
	IF (LINENO.EQ.58) CALL DACTPH (CDATE,FDATE,ZSYSNA,LACCOU,LINENO)
	RETURN

100	FORMAT ('*')
101	FORMAT ('*',T41,'===========',T54,'=========',T64,'=========',
	1 T74,'=========')
102	FORMAT ('*','* * * Totals * * *',T41,'$',F10.2,T54,I9,T64,
	1 I9,T75,F8.1)
103	FORMAT ('*','******************************')
104	FORMAT ('*','* End of Report for Account ',39A1)
105	FORMAT ('*','Rates:')
106	FORMAT ('*',T5,'Disk Usage = $',F5.2,'/Page')
	END

C ************************************************************************
C	END OF SUBROUTINES TO REPORT DISK USAGE BY ACCOUNT, DIRECTORY,
C	AND STRUCTURE - REPDAC
C ************************************************************************