PROGRAM ACCT_INFO
C
C	ACCOUNTING PROGRAM OBTAINED FROM VAX COURSE JUNE 1978.
C	MODIFIED FOR USE WITH RELEASE 1.0 BY J. THOMPSON INTERMETRICS.
C	ADDED "FORGET USER FEATURE" NOVEMBER 9, 1978.
C
	IMPLICIT INTEGER (A-Z)
	PARAMETER MAX_USERS = 300
	INTEGER*2 MSGTYPE,MSGSIZE,INTER_JOB_TYPE,BATCH_JOB_TYPE
	INTEGER*2 PRINT_JOB_TYPE,LOGIN_FAILURE
	CHARACTER*24 TIMBUF1,TIMBUF2,LOWTIME,HITIME
	CHARACTER*256 MSGBUF
	CHARACTER FLAG*1
	CHARACTER*30 INFILE,OUTFILE
	CHARACTER USERNAME(MAX_USERS)*12,CUR_USER*12, USER_ACCT(MAX_USERS)*8,
	1	CUR_ACCT*8
	CHARACTER FORGETUSER(20)*12
	INTEGER*2 NUMBERFORGOT
	REAL CPU_SEC
	DIMENSION ELAPSED(2),TERMTIME(2),LOGIN(2)
	DIMENSION JOB_NAME(2),JOB_QUE(4),ACCOUNT(2)
	DIMENSION QUETIME(2),PRT_NAME(2),PRT_QUE(3)
	DIMENSION REST(16)
	DIMENSION ICOUNTS(MAX_USERS,11)
C		ICOUNTS ARRAY ELEMENTS
C		1 - CPU TIME IN 10 MS UNITS
C		2 - # OF PAGE FAULTS
C		3 - # LOGINS (BATCH+INTERACTIVE)
C		4 - # ELAPSED SECS (INTERACTIVE JOBS)
C		5 - # BUFFERED I/O S
C		6 - # DIRECT I/O S
C		7 - # VOLUME MOUNTS
C		8 - # PRINT JOBS
C		9 - # PAGES PRINTED
C		10- FIRST WORD OF ACCOUNT ID LABEL
C		11- SECOND WORD OF ACCOUNT ID LABEL
C
	COMMON FIRST_TIME(2),LAST_TIME(2),FILE_TYPE,DATAOUT,LOW_TIME(2),
	2	HI_TIME(2)
C
C BASIC RECORD FIELDS
C	MSGTYPE,MSGSIZE,FINALSTS,PID,JOBID,TERMTIME,ACCOUNT,CUR_USER
C
C INTERACTIVE/BATCH JOB FIELDS
C
	EQUIVALENCE (CPUTIM,REST(1)),(PAGEFLTS,REST(2)),(PGFLPEAK,REST(3))
	EQUIVALENCE (WSPEAK,REST(4)),(BIOCNT,REST(5)),(DIOCNT,REST(6))
	EQUIVALENCE (VOLUMES,REST(7)),(LOGIN(1),REST(8))
	EQUIVALENCE (LOGIN(2),REST(9)),(OWNER,REST(10))
C
C BATCH JOB FIELDS
C
	EQUIVALENCE (JOB_NAME(1),REST(11)),(JOB_NAME(2),REST(12))
	EQUIVALENCE (JOB_QUE(1),REST(13)),(JOB_QUE(2),REST(14))
	EQUIVALENCE (JOB_QUE(3),REST(15)),(JOB_QUE(4),REST(16))
C
C PRINT JOB FIELDS
C
	EQUIVALENCE (UNKNOWN,REST(1))
	EQUIVALENCE (PAGCNT,REST(2)),(QIOCNT,REST(3)),(GETCNT,REST(4))
	EQUIVALENCE (QUETIME(1),REST(5)),(QUETIME(2),REST(6))
	EQUIVALENCE (PRT_NAME(1),REST(7)),(PRT_NAME(2),REST(8))
	EQUIVALENCE (PRT_QUE(1),REST(9)),(PRT_QUE(2),REST(10))
	EQUIVALENCE (PRT_QUE(3),REST(11))
C
	DATA INTER_JOB_TYPE/3/,BATCH_JOB_TYPE/2/,LOGIN_FAILURE/4/
	DATA PRINT_JOB_TYPE/16/
	DATA INTERMAX/0/,PRINTMAX/0/,LOGIN_FAIL_CNT/0/
	DATA TOTAL_RECORDS/0/
C
C SET UP COMMON VARIABLES
C
	DATAOUT=1
	DATAIN=2
	SCRATCH = 3
C
	FIRST_TIME(1)=0
	FIRST_TIME(2)='7FFFFFFF'X
	LAST_TIME(1)=0
C
C	*** OPEN ALL I/O FILES ***
C
	OPEN (UNIT=DATAIN,  NAME='INPUT_DATA', TYPE='OLD', READONLY)
	OPEN (UNIT=DATAOUT, NAME='OUTPUT_DATA', TYPE='NEW')
	OPEN (UNIT=SCRATCH, NAME='SCRATCH_FILE', TYPE='OLD', READONLY)
C
	HITIME = ' '
	LOWTIME = ' '
C
	READ (SCRATCH, 50, END=9990) LOWTIME
	READ (SCRATCH, 50, END=9990) HITIME
50	FORMAT (A)
C
	IF (LOWTIME .EQ. ' ') LOWTIME = '1-JAN-1978 0:0:0.0'
	IF(.NOT.SYS$BINTIM(LOWTIME,LOW_TIME)) THEN
		WRITE(6,*) ' INVALID TIME FORMAT'
		STOP 'ACCT_INFO--ERROR, LOWTIME INVALID FORMAT'
		ENDIF
C
C	PUT IN CANONICAL FORM
	CALL CVT_TIME(LOWTIME,LEN1,LOW_TIME)
C
	IF (HITIME .EQ. ' ') HITIME = '31-DEC-1999 23:59:59.99'
	IF (.NOT. SYS$BINTIM(HITIME,HI_TIME)) THEN
		WRITE(6,*) ' INVALID TIME FORMAT'
		STOP 'ACCT_INFO--ERROR, HITIME INVALID FORMAT'
		ENDIF
C
C	PUT IN CANONICAL FORM
	CALL CVT_TIME(HITIME,LEN1,HI_TIME)
C
C***************************************************************
C
C READ THE RECORD
C
100	READ(DATAIN,110,ERR=9950,END=9000) MSGTYPE,MSGSIZE,FINALSTS,PID,
	1JOBID,TERMTIME,ACCOUNT,CUR_USER,REST
110	FORMAT(2A2,7A4,A12,16A4)
C
C ADD 1 FOR THIS RECORD
C
113	TOTAL_RECORDS=TOTAL_RECORDS+1
C
C VALIDATE AND DISPATCH TO CORRECT REPORT
C
	FLAG = ' '
	IF (MSGTYPE .EQ. 1) FLAG = 'I'	!USE INTERACTIVE TYPE HERE
	IF (MSGTYPE .EQ. 3) FLAG = 'I'	!INTERACTIVE JOB
	IF (MSGTYPE .EQ. 2) FLAG = 'B'	!BATCH JOB
	IF (MSGTYPE .EQ.16) FLAG = 'P'	!PRINT JOB
	IF (FLAG .EQ. ' ') GO TO 115	!BAD RECORD
C
C UPDATE TIME SPAN OF THIS FILE
C
	IF (.NOT. CHECK_TIME(TERMTIME)) GO TO 100 !CHECK END TIME
	IF ((FLAG .EQ. 'I') .OR. (FLAG .EQ. 'B')) THEN
C		CHECK START TIME
		IF(.NOT.CHECK_TIME(LOGIN)) GO TO 100
C
C 		CALC CPU TIME IS SECONDS
C
		CPU_SEC=FLOAT(CPUTIM)/100.
		CALL SUBQUAD(TERMTIME,LOGIN,ELAPSED)
		CALL EDIV(ELAPSED,10000000,IELAPSE)
		IF(MSGTYPE .EQ. 1) IELAPSE = 0	!USE 0 FOR NON-INT
		ENDIF
C
C	CHECK START TIME OF PRINT JOB
	IF(FLAG .EQ. 'P') THEN
		IF(.NOT.CHECK_TIME(QUETIME)) GO TO 100
		ENDIF
C
	GOTO 500
C
C********************************************************************
C	BAD RECORD
C CHECK IF IT IS A LOGIN FAILURE MESSAGE
C
115	IF(MSGTYPE.NE.LOGIN_FAILURE) GO TO 120
	LOGIN_FAIL_CNT=LOGIN_FAIL_CNT+1
	GO TO 100
C
C UNEXPECTED MSG TYPE
C
120	TYPE 130, MSGTYPE,MSGSIZE,CUR_USER
130	FORMAT('0UNRECOGNIZED TYPE'/' MSGTYPE = ',Z4,' MSGSIZE = ',
	1Z4,' USERNAME = ',A12)
	IF(FILE_TYPE.EQ.'F') WRITE(DATAOUT,130)MSGTYPE,MSGSIZE,CUR_USER
	GO TO 100
C
C**********
C TOTALS
C**********
C
C 	LOOK FOR THE USERNAME AND ACCOUNT NAME
C
500	ENCODE (8, 501, CUR_ACCT) ACCOUNT(1), ACCOUNT(2)
501	FORMAT (2A4)
C
	DO 510 I=1,INTERMAX+1
	INDX=I
	IF (CUR_USER.EQ.USERNAME(I) .AND. CUR_ACCT.EQ.USER_ACCT(I)) GO TO 540
	IF (CUR_USER .LT. USERNAME(I)) GO TO 515
510	CONTINUE
C
C ENTER NEW USER
C
515	INTERMAX = INTERMAX + 1	!NUMBER OF USERS SEEN SO FAR
	IF (INTERMAX .EQ. 1) GO TO 530
	IF (INTERMAX .GT. MAX_USERS) STOP 'TOO MANY USERS-STORAGE EXCEEDED'
C
C	PUSH DOWN CURRENT DATA VALUES
	DO 520 I = INTERMAX,INDX,-1
	USERNAME(I)= USERNAME(I-1)
	USER_ACCT(I) = USER_ACCT(I-1)
	DO 520 J = 1,11
520	ICOUNTS(I,J) = ICOUNTS(I-1,J)
C
C	NOW CLEAR THE ARRAY ELEMENTS FOR NEW USER
530	DO 535 J = 1,11
535	ICOUNTS(INDX,J) = 0
C
	USERNAME(INDX) = CUR_USER
	USER_ACCT(INDX)= CUR_ACCT
D	PRINT *,'NEW ACCT=',USERNAME(INDX),',',USER_ACCT(INDX)
C
C	*** SAVE USER'S ACCOUNT NUMBER ***
	ICOUNTS(INDX,10) = ACCOUNT(1)
	ICOUNTS(INDX,11) = ACCOUNT(2)
C
C**************
C UPDATE NON-INTERACTIVE, INTERACTIVE & BATCH TOTALS
C***************
540	IF (FLAG .EQ. 'P') GO TO 550	!PRINT RECORD
C
C	UPDATE BATCH/INTERACTIVE TOTALS
	ICOUNTS(INDX,1)=ICOUNTS(INDX,1)+CPUTIM
	ICOUNTS(INDX,2)=ICOUNTS(INDX,2)+PAGEFLTS
	ICOUNTS(INDX,3) = ICOUNTS(INDX,3) + 1	!LOGIN COUNT
	ICOUNTS(INDX,4)=ICOUNTS(INDX,4) + IELAPSE
	ICOUNTS(INDX,5)=ICOUNTS(INDX,5)+BIOCNT
	ICOUNTS(INDX,6)=ICOUNTS(INDX,6)+DIOCNT
	ICOUNTS(INDX,7)=ICOUNTS(INDX,7)+VOLUMES
	GO TO 100
C****************
C
C  UPDATE PRINT JOB TOTALS
C
C****************
550	ICOUNTS(INDX,8)=ICOUNTS(INDX,8) + 1 	!# OF PRINT JOBS
	ICOUNTS(INDX,9)=ICOUNTS(INDX,9) + PAGCNT !# OF PAGES PRINTED
	GO TO 100
C*********************************************************************
C
C END OF FILE READ
C
9000	LINES = 0	!CLEAR LINE COUNT TO FORCE NEW PG FOR TOTALS
	IF (INTERMAX .EQ. 0) THEN
		WRITE(DATAOUT,9020)
9020	FORMAT('1**** NO INTERACTIVE OR BATCH JOBS ****')
		GO TO 9928
		ENDIF
	DO 9500 I=1,INTERMAX
	CPU_SEC=FLOAT(ICOUNTS(I,1))/100.
	CALL SECS_CVT(ICOUNTS(I,4),HRS,MINS,SECS)
C
C	WRITE OUT THE PAGE HEADER
C
	IF (LINES .EQ. 0) WRITE (DATAOUT, 9080) 'INPUT_DATA',
	1	LOWTIME, HITIME
9080	FORMAT('1',' TOTALS FOR FILE: ',A,' FOR THE PERIOD ',A,' TO ',A,//
	2	' USERNAME    LOGIN-COUNT  CONNECT TIME'
	2	' CPU-SECONDS',
	2	'  BUF I/O   DIR I/O VOL-MOUNTS  ',
	2	'PRINT-JOBS PRINT PGS  ACCOUNT #')
	WRITE(DATAOUT,9085) USERNAME(I),ICOUNTS(I,3),HRS,MINS,SECS,CPU_SEC,
	2	ICOUNTS(I,5),ICOUNTS(I,6),ICOUNTS(I,7),
	2	ICOUNTS(I,8),ICOUNTS(I,9), ICOUNTS(I,10), ICOUNTS(I,11)
9085	FORMAT(' ',A12,I10,I7,':',I2,':',I2,F12.0,5I10, 7X, 2A4)
	LINES = LINES + 1
	TOT_LOGINS = TOT_LOGINS + ICOUNTS(I,3)
	TOT_ELAPSED= TOT_ELAPSED + ICOUNTS(I,4)
	TOT_SECS = TOT_SECS + ICOUNTS(I,1)
	TOT_PJOBS =  TOT_PJOBS + ICOUNTS(I,8)
	TOT_PAGES = TOT_PAGES + ICOUNTS(I,9)
9500	CONTINUE
C
C DONE
C
9900	WRITE(DATAOUT,9910) TOTAL_RECORDS
9910	FORMAT(/' TOTAL RECORDS READ  = ',I10)
	WRITE(DATAOUT,9920) LOGIN_FAIL_CNT
9920	FORMAT(' LOGIN FAILURE COUNT = ',I10)
	CALL SECS_CVT(TOT_ELAPSED,HRS,MINS,SECS)
	CPU_SECS = FLOAT(TOT_SECS)/100.
	WRITE(DATAOUT,9925) TOT_LOGINS,HRS,MINS,SECS,CPU_SECS,TOT_PJOBS,
	2	TOT_PAGES
9925	FORMAT (/,
	2	' TOTAL LOGINS:        ',I12,/
	2	' TOTAL CONNECT TIME:  ',I6,':',I2,':',I2,/
	2	' TOTAL CPU SECONDS:   ',I12,/
	2	' TOTAL PRINT JOBS:    ',I12,/
	2	' TOTAL PAGES PRINTED: ',I12)
C
C CONVERT FIRST TIME AND LAST TIME TO ASCII
C
9928	CALL CVT_TIME(TIMBUF1,LEN1,FIRST_TIME)
	CALL CVT_TIME(TIMBUF2,LEN2,LAST_TIME)
	WRITE(DATAOUT,9930) TIMBUF1,TIMBUF2
9930	FORMAT('0THIS DATA IS FROM ',A,' TO ',A)
C
	STOP 'ACCT_INFO--STOP OK'
C
C ERROR ON INPUT
C
9950	TYPE 9960
9960	FORMAT(////' **** ERROR ON INPUT ****'////)
	GO TO 100
C
C ERROR ON OUTPUT
C
9970	TYPE 9980
9980	FORMAT(////' **** ERROR ON OUTPUT ****'////)
	GO TO 100
C
C	*** ERROR ON SCRATCH DATA FILE READ ***
C
9990	STOP 'ACCT_INFO--ERROR, EOF READ ON SCRATCH DATA FILE'
C
	END

	FUNCTION CHECK_TIME(CURRENT)
C
C **********************************************
C
C SUBROUTINE TO UPDATE THE TIME SPAN OF THE FILE
C
C **********************************************
C
	IMPLICIT INTEGER(A-Z)
	COMMON FIRST_TIME(2),LAST_TIME(2),FILE_TYPE,DATAOUT,
	2	LOW_TIME(2),HI_TIME(2)
	DIMENSION CURRENT(2),TEMP(2)
C
C	TEST FOR RECORD WITHIN SPECIFIED RANGE
C
	CALL SUBQUAD(CURRENT(1),LOW_TIME(1),TEMP(1))
	IF(TEMP(2) .GE. 0) GO TO 4
	CHECK_TIME = .FALSE.	!OUT OF RANGE
	RETURN
4	CALL SUBQUAD(HI_TIME(1),CURRENT(1),TEMP(1))
	IF (TEMP(2) .GE. 0) GO TO 8
	CHECK_TIME = .FALSE.	!OUT OF RANGE
	RETURN
C
C	CHECK IF THIS IS NEW FIRST TIME VALUE
C
8	CALL SUBQUAD(CURRENT(1),FIRST_TIME(1),TEMP(1))
	IF (TEMP(2) .GE. 0) GO TO 10
	FIRST_TIME(1)=CURRENT(1)
	FIRST_TIME(2)=CURRENT(2)
10	CALL SUBQUAD(CURRENT(1),LAST_TIME(1),TEMP(1))
	IF (TEMP(2) .LT. 0) GO TO 20
	LAST_TIME(1)=CURRENT(1)
	LAST_TIME(2)=CURRENT(2)
20	CHECK_TIME = .TRUE.
	RETURN
	END

	SUBROUTINE CVT_TIME(TIMEBUFFER,LENGTH,TIME)
C
C *************************************
C
C SUBROUTINE TO CONVERT A TIME TO ASCII
C
C *************************************
C
	IMPLICIT INTEGER(A-Z)
	COMMON FIRST_TIME(2),LAST_TIME(2),FILE_TYPE,DATAOUT
	CHARACTER*24 TIMEBUFFER
	DIMENSION TIME(2)
	STATUS=SYS$ASCTIM(LENGTH,TIMEBUFFER,TIME,%VAL(0))
	IF(.NOT.STATUS) TYPE 10,STATUS
10	FORMAT(' *** ASCTIM FAILED, STATUS = ',Z8)
	RETURN
	END

	SUBROUTINE SECS_CVT(TIME,HRS,MINS,SECS)
	IMPLICIT INTEGER(A-Z)
	SECS = TIME
	HRS = SECS/3600
	MINS = (SECS - HRS*3600) / 60
	SECS = SECS - (HRS*3600) - (MINS*60)
	RETURN
	END