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 ************************************************************************