github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-28 17:09:15 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/usage/usah10.for
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

2056 lines
62 KiB
Fortran
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
C 4-Jun-80/BAH V1(2) Convert USAH20.FOR to USAH10.FOR.
C 25-Sep-81/BAH V1(3) Modify the CLOSE statements so this program can run
C under V6 of FOROTS.
C ************************************************************************
C PROGRAM V1(1) TO READ A RATE FILE, USAG10.CHG, AND A FILE IN THE USAGE
C FORMAT AND CREATE A BILLING SUMMARY LISTING
C ************************************************************************
PROGRAM USAH10
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='USAG10.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 ( 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) .OR. (ENTRY.EQ.4) )
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 (UNIT=1)
CLOSE (UNIT=2)
IF (SORTBY.EQ.'A') GO TO 451
C HERE TO DO REPORT BY NAME
CALL SORT ('OUTSRT.TMP=INSRT.TMP/RECORD:160/KEY:1:12:A
1 /KEY:13:6:A/KEY:19:6:A/KEY:79:39:A/KEY:40:39:A/ASCII')
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
451 CALL SORT ('OUTSRT.TMP=INSRT.TMP/RECORD:160/KEY:79:39:A
1 /KEY:1:12:A/KEY:13:6:A/KEY:19:6:A/KEY:40:39:A/ASCII')
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) .OR. (ENTRY.EQ.4) )
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 (UNIT=1)
CLOSE (UNIT=2)
IF (SORTBY.EQ.'A') GO TO 551
C HERE TO DO REPORT BY DIRECTORY
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:12:A
1 /KEY:46:39:A/KEY:40:6:A/ASCII')
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
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:12:A/KEY:40:6:A/ASCII')
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 (' TOPS10 Accounting System')
C ************************************************************************
C END OF USAH10 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 (A30)
1002 FORMAT (A5)
2001 FORMAT (' READ USAGE FILE: '$)
2002 FORMAT (' Input file name: ',A30)
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: ', A30)
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 OR A USAGE FILE
C HEADER 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) .AND. (ENTRY.NE.4) ) 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 OR FILE HEADER 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(12), 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
READ (1,1049,END=3) ENTRY,OS,RECSEQ,DECVER,CUSVER,A
IF (RECSEQ.NE.4) GO TO 2
IF ( (ENTRY.NE.2) .AND. (ENTRY.NE.3) ) GO TO 2
DECODE (39,1052,A) PROJ,PROG,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,PROJ,PROG,REMARK,ACCOUN,FCONNE,FRUNTI,FCHARG
GO TO 1
5 WRITE (2,2003) NAME,PROJ,PROG,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 TOPS10 USER IDENTIFICATION RECORD
1049 FORMAT (I4,2I1,2I2,10X,40A5)
1052 FORMAT (2I6,12A1)
C SESSION RECORD #1
1053 FORMAT (39A1,I9,I4,5I2,I1,6A1,I6,39A1,I7)
C FORMAT OF FILE TO BE SORTED
2002 FORMAT (12A1,I6,I6,15X,2(39A1),F8.2,F8.1,14X,F10.2)
2003 FORMAT (12A1,I6,I6,15X,39A1,' UNSPECIFIED ACCOUNT',
1 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(12),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) PROJ,PROG,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,PROJ,PROG,ACCOUN,FRUNTI,CARDS,FCHARG
GO TO 1
5 WRITE (2,2003) NAME,PROJ,PROG,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 TOPS10 USER IDENTIFICATION RECORD
1052 FORMAT (2I6,12A1)
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 (12A1,I6,I6,15X,'INPUT SPOOLER CHARGES',18X,39A1,
1 8X,F8.1,I7,7X,F10.2)
2003 FORMAT (12A1,I6,I6,15X,'INPUT SPOOLER CHARGES',18X,
1 ' UNSPECIFIED ACCOUNT',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(12),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) PROJ,PROG,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,PROJ,PROG,ACCOUN,FRUNTI,PAGES,FCHARG
GO TO 1
5 WRITE (2,2003) NAME,PROJ,PROG,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 TOPS10 USER IDENTIFICATION RECORD
1052 FORMAT (2I6,12A1)
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 (12A1,I6,I6,15X,'OUTPUT SPOOLER CHARGES',17X,39A1,
1 8X,F8.1,7X,I7,F10.2)
2003 FORMAT (12A1,I6,I6,15X,'OUTPUT SPOOLER CHARGES',17X,
1 ' UNSPECIFIED ACCOUNT',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), 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,PROJ,PROG,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,PROJ,PROG,
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) PROJ,PROG,STRNAM,ACCOUN,PAGES,FILES,FCHARG
GO TO 4
6 WRITE (2,2005) PROJ,PROG,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,2I6,27X,I1,2I3,2I6,2(I4,5I2),2A1)
C DISK USAGE ACCOUNT STRING RECORD
1057 FORMAT (2I6,27X,39A1,2I10,I5,6A1,I1,2I3)
C FORMATS OF FILE TO BE SORTED
2004 FORMAT (2I6,6A1,39A1,I10,I5,F10.2)
2005 FORMAT (2I6,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(12),REMARK(39)
DIMENSION LACCOU(39),LNAME(12),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,PROJ,PROG,REMARK,ACCOUN,FCONNE,
1 FRUNTI,CARDS,PAGES,FCHARG
1 DO 2 I=1,39
LACCOU(I)=ACCOUN(I)
2 LREMAR(I)=REMARK(I)
DO 20 I=1,12
20 LNAME(I)=NAME(I)
LPROJ=PROJ
LPROG=PROG
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,LPROJ,LPROG,LINENO)
3 READ (1,1000,END=500) NAME,PROJ,PROG,REMARK,ACCOUN,FCONNE,
1 FRUNTI,CARDS,PAGES,FCHARG
J=0
DO 4 I=1,12
4 IF (NAME(I).NE.LNAME(I)) J=J+1
IF (PROJ.NE.LPROJ) J=J+1
IF (PROG.NE.LPROG) 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,LPROJ,LPROG)
CALL NAMEAS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,CDATE,
1 FDATE,LDATE,ZSYSNA,LNAME,LPROJ,LPROG)
CALL NAMENS (LINENO,ZCHARG,ZCONNE,ZRUNTI,ZCARDS,ZPAGES,CDATE,
1 FDATE,LDATE,ZSYSNA,LNAME,LPROJ,LPROG,FSESCO,FSESRU,FPAGRU,
2 FPAGPA,FCRDRU,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,LPROJ,LPROG)
CALL NAMEAS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,CDATE,
1 FDATE,LDATE,ZSYSNA,LNAME,LPROJ,LPROG)
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,LPROJ,LPROG)
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,LPROJ,LPROG)
CALL NAMEAS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,CDATE,
1 FDATE,LDATE,ZSYSNA,LNAME,LPROJ,LPROG)
CALL NAMENS (LINENO,ZCHARG,ZCONNE,ZRUNTI,ZCARDS,ZPAGES,CDATE,
1 FDATE,LDATE,ZSYSNA,LNAME,LPROJ,LPROG,FSESCO,FSESRU,FPAGRU,
2 FPAGPA,FCRDRU,FCRDCR)
CLOSE (FILE='OUTSRT.TMP',UNIT=1,DEVICE='DSK',DISPOSE='DELETE')
CLOSE (UNIT=2)
RETURN
C INPUT FORMAT STATEMENT
1000 FORMAT (12A1,I6,I6,15X,2(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,
1 LPROJ,LPROG,LINENO)
IMPLICIT INTEGER (A-Z)
DIMENSION CDATE(3),FDATE(5),LDATE(5),ZSYSNA(39),LNAME(12)
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,LPROJ,LPROG
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 ',12A1,1X,'[',I6,',',I6,']',T53,
1 'TOPS10 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,LPROJ,LPROG)
IMPLICIT INTEGER (A-Z)
REAL XCONNE,XRUNTI,XCHARG
DIMENSION LREMAR(39),LACCOU(39),CDATE(3),FDATE(5),LDATE(5)
DIMENSION ZSYSNA(39),LNAME(12)
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 LPROJ,LPROG,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 LPROJ,LPROG,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 LPROJ,LPROG,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,LPROJ,LPROG)
IMPLICIT INTEGER (A-Z)
REAL YCHARG,YCONNE,YRUNTI
DIMENSION CDATE(3),FDATE(5),LDATE(5),ZSYSNA(39),LNAME(12)
WRITE (2,100)
LINENO = LINENO + 1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,101) YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES
LINENO = LINENO + 1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,102)
LINENO = LINENO + 1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,102)
LINENO = LINENO + 1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,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,LPROJ,LPROG,FSESCO,FSESRU,
2 FPAGRU,FPAGPA,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(12)
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,101)
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,102) ZCHARG,ZCONNE,ZRUNTI,ZCARDS,ZPAGES
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,100)
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,103)
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,104) LNAME,LPROJ,LPROG
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,103)
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,105)
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,106) FSESCO,FSESRU
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,LINENO)
WRITE (2,107) FCRDCR,FCRDRU
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL NAMEPH (CDATE,FDATE,LDATE,ZSYSNA,LNAME,
1 LPROJ,LPROG,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 ',12A1,1X,'[',I6,',',I6,']')
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(12),REMARK(39)
DIMENSION LACCOU(39),LNAME(12),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,PROJ,PROG,REMARK,ACCOUN,FCONNE,
1 FRUNTI,CARDS,PAGES,FCHARG
1 DO 2 I=1,39
LACCOU(I)=ACCOUN(I)
2 LREMAR(I)=REMARK(I)
DO 20 I=1,12
20 LNAME(I)=NAME(I)
LPROJ=PROJ
LPROG=PROG
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,PROJ,PROG,REMARK,ACCOUN,FCONNE,
1 FRUNTI,CARDS,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,LPROJ,LPROG)
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,12
6 IF (NAME(I).NE.LNAME(I)) J=J+1
IF (PROJ.NE.LPROJ) J=J+1
IF (PROG.NE.LPROG) 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,LPROJ,LPROG)
CALL ACCTNS (LINENO,YCHARG,YCONNE,YRUNTI,YCARDS,YPAGES,CDATE,
1 FDATE,LDATE,ZSYSNA,LACCOU)
DO 7 I=1,39
7 LREMAR(I)=REMARK(I)
DO 21 I=1,12
21 LNAME(I)=NAME(I)
LPROJ=PROJ
LPROG=PROG
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,LPROJ,LPROG)
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,LPROJ,LPROG)
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 (UNIT=2)
RETURN
C INPUT FORMAT STATEMENT
1000 FORMAT (12A1,2I6,15X,2(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,'TOPS10 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,LPROJ,LPROG)
IMPLICIT INTEGER (A-Z)
REAL XCONNE,XRUNTI,XCHARG
DIMENSION LREMAR(39),LACCOU(39),CDATE(3),FDATE(5),LDATE(5)
DIMENSION ZSYSNA(39),LNAME(12)
IF (XCARDS.EQ.0) GO TO 1
WRITE (2,100) LNAME,LPROJ,LPROG,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,LPROJ,LPROG,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,LPROJ,LPROG,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 ('*',12A1,1X,'[',I6,',',I6,']',T41,'$',F10.2,T65,
1 F8.1,T75,I7,T91,39A1)
101 FORMAT ('*',12A1,1X,'[',I6,',',I6,']',T41,'$',F10.2,T65,
1 F8.1,T83,I7,T91,39A1)
102 FORMAT ('*',12A1,1X,'[',I6,',',I6,']',T41,'$',F10.2,T55,
1 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 STRNAM(6),ACCOUN(39)
DIMENSION 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) PROJ,PROG,STRNAM,ACCOUN,PAGES,FILES,FCHARG
1 DO 2 I=1,39
2 LACCOU(I)=ACCOUN(I)
DO 12 I=1,6
12 LSTRNA(I)=STRNAM(I)
LPROJ=PROJ
LPROG=PROG
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,LPROJ,LPROG,LINENO)
3 READ (1,1000,END=500) PROJ,PROG,STRNAM,ACCOUN,PAGES,FILES,FCHARG
J=0
IF (PROJ.NE.LPROJ) J=J+1
IF (PROG.NE.LPROG) J=J+1
IF (J.EQ.0) GO TO 5
CALL DNAMRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,CDATE,
1 FDATE,ZSYSNA,LPROJ,LPROG,XRECRD)
CALL DNAMAS (LINENO,YCHARG,YPAGES,YFILES,CDATE,FDATE,ZSYSNA,
1 LPROJ,LPROG,YRECRD)
CALL DNAMDS (LINENO,ZCHARG,ZPAGES,ZFILES,CDATE,FDATE,ZSYSNA,
1 LPROJ,LPROG,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,LPROJ,LPROG,XRECRD)
CALL DNAMAS (LINENO,YCHARG,YPAGES,YFILES,CDATE,FDATE,ZSYSNA,
1 LPROJ,LPROG,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,LPROJ,LPROG,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,LPROJ,LPROG,XRECRD)
CALL DNAMAS (LINENO,YCHARG,YPAGES,YFILES,CDATE,FDATE,ZSYSNA,
1 LPROJ,LPROG,YRECRD)
CALL DNAMDS (LINENO,ZCHARG,ZPAGES,ZFILES,CDATE,FDATE,ZSYSNA,
1 LPROJ,LPROG,FDSKPA,ZRECRD)
CLOSE (FILE='OUTSRT.TMP',UNIT=1,DEVICE='DSK',DISPOSE='DELETE')
CLOSE (UNIT=2)
RETURN
C INPUT FORMAT STATEMENT
1000 FORMAT (2I6,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,LPROJ,LPROG,LINENO)
IMPLICIT INTEGER (A-Z)
DIMENSION CDATE(3),FDATE(5),ZSYSNA(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) LPROJ,LPROG
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 ('*','[',I6,',',I6,']',T54,'TOPS10 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,'Blocks',T64,
1 'of Files',T74,'of Blocks',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,LPROJ,LPROG,XRECRD)
IMPLICIT INTEGER (A-Z)
REAL XCHARG,AVGPAG
DIMENSION LSTRNA(6),LACCOU(39),CDATE(3),FDATE(5)
DIMENSION ZSYSNA(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,LPROJ,
1 LPROG,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,LPROJ,LPROG,YRECRD)
IMPLICIT INTEGER (A-Z)
REAL YCHARG,AVGPAG
DIMENSION CDATE(3),FDATE(5),ZSYSNA(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,LPROJ,
1 LPROG,LINENO)
WRITE (2,102)
LINENO = LINENO + 1
IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LPROJ,
1 LPROG,LINENO)
WRITE (2,102)
LINENO = LINENO + 1
IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LPROJ,
1 LPROG,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,LPROJ,LPROG,FDSKPA,ZRECRD)
IMPLICIT INTEGER (A-Z)
REAL ZCHARG,FDSKPA,AVGPAG
DIMENSION CDATE(3),FDATE(5),ZSYSNA(39)
AVGPAG=FLOAT(ZPAGES)/FLOAT(ZRECRD)
IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LPROJ,
1 LPROG,LINENO)
WRITE (2,101)
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LPROJ,
1 LPROG,LINENO)
WRITE (2,102) ZCHARG,ZPAGES,ZFILES,AVGPAG
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LPROJ,
1 LPROG,LINENO)
WRITE (2,100)
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LPROJ,
1 LPROG,LINENO)
WRITE (2,103)
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LPROJ,
1 LPROG,LINENO)
WRITE (2,104) LPROJ,LPROG
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LPROJ,
1 LPROG,LINENO)
WRITE (2,103)
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LPROJ,
1 LPROG,LINENO)
WRITE (2,105)
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LPROJ,
1 LPROG,LINENO)
WRITE (2,106) FDSKPA
LINENO=LINENO+1
IF (LINENO.EQ.58) CALL DNAMPH (CDATE,FDATE,ZSYSNA,LPROJ,
1 LPROG,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 ','[',I6,',',I6,']')
105 FORMAT ('*','Rates:')
106 FORMAT ('*',T5,'Disk Usage = $',F5.2,'/Block')
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 STRNAM(6),ACCOUN(39)
DIMENSION 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) PROJ,PROG,STRNAM,ACCOUN,PAGES,FILES,FCHARG
1 DO 2 I=1,39
2 LACCOU(I)=ACCOUN(I)
DO 12 I=1,6
12 LSTRNA(I)=STRNAM(I)
LPROJ=PROJ
LPROG=PROG
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) PROJ,PROG,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,LPROJ,LPROG,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
IF (PROJ.NE.LPROJ) J=J+1
IF (PROG.NE.LPROG) J=J+1
IF (J.EQ.0) GO TO 8
CALL DACTRS (LINENO,LSTRNA,LACCOU,XCHARG,XFILES,XPAGES,CDATE,
1 FDATE,ZSYSNA,LPROJ,LPROG,XRECRD)
CALL DACTDS (LINENO,YCHARG,YPAGES,YFILES,CDATE,FDATE,ZSYSNA,
1 LACCOU,YRECRD)
LPROJ=PROJ
LPROG=PROG
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,LPROJ,LPROG,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,LPROJ,LPROG,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 (UNIT=2)
RETURN
C INPUT FORMAT STATEMENT
1000 FORMAT (2I6,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,'TOPS10 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,'Blocks',T64,
1 'of Files',T74,'of Blocks',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,LPROJ,LPROG,XRECRD)
IMPLICIT INTEGER (A-Z)
REAL XCHARG,AVGPAG
DIMENSION LSTRNA(6),LACCOU(39),CDATE(3),FDATE(5)
DIMENSION ZSYSNA(39)
AVGPAG=FLOAT(XPAGES)/FLOAT(XRECRD)
WRITE (2,100) LPROJ,LPROG,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 ('*','[',I6,',',I6,']',T41,'$',F10.2,T54,I9,T64,
1 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,'/Block')
END
C ************************************************************************
C END OF SUBROUTINES TO REPORT DISK USAGE BY ACCOUNT, DIRECTORY,
C AND STRUCTURE - REPDAC
C ************************************************************************
Reference in New Issue View Git Blame Copy Permalink