C*********************************************************************
C
C			PROGRAM MJP
C			***********
C
C	THIS ROUTINE PRODUCES A MONTHLY TASK ACTIVITY REPORT
C	SORTED BY...
C
C			A) INCREASING UIC NUMBER
C			B) SORTED TASK NAME
C
C	RECORDS ASSOCIATED WITH UIC'S WHOSE GROUP NUMBER
C	IS LESS THAN OR EQUAL TO 7 ARE BUNCHED
C	TOGETHER INTO ONE UIC -- [0,0].
C
C		INPUTS;
C
C		A) INPUT FILENAME
C		B) JOB-UIC INFORMATION FILENAME
C		C) MONTH (1 TO 12)
C
C*********************************************************************
C
	LOGICAL		FIRST,SECOND,ASK
C
	LOGICAL*1	PUIC(2),CARD(80),IEND,OLD,UICP(6),TASK(3),
     *			D1UIC(2),I1UIC(4),MNTHYR(20),DAT(9),TIM(8),
     *			COST(10)
C
	INTEGER*2	PMMDD,PHHMM,PTASK,PRCRD(16),UIC,D2UIC
C
	INTEGER*4	PB(8),LIST(8),SLIST(8),CPU,ELAPS,DBQ,
     *			LPQ,MTQ,OTQ,I4UIC,NUIC,JUIC,COUNT,
     *			SYSOVR(8),LSTTOT(8,200),UICTAB(200),
     *			OVRTOT(6,200)
C
	DIMENSION	TOTWUN(200),RLIST(6),WEIGHT(6)
C
	EQUIVALENCE	(PB,PRCRD,PMMDD),	(PRCRD(2),PHHMM),
     *			(PRCRD(3),PUIC,UIC),	(PRCRD(4),PTASK),
     *			(PB(3),LIST,CPU),	(PB(4),ELAPS),
     *			(PB(5),DBQ),		(PB(6),LPQ),
     *			(PB(7),MTQ),		(PB(8),OTQ),
     *			(D1UIC,D2UIC),		(I1UIC,I4UIC)
C
	EQUIVALENCE	(WEIGHT(1),WC),		(WEIGHT(2),WE),
     *			(WEIGHT(3),WD),		(WEIGHT(4),WL),
     *			(WEIGHT(5),WM),		(WEIGHT(6),WT)
C
	DATA	LEN,KNT	/8,0/,  IEND,OLD/.FALSE.,.FALSE./
	DATA	I4UIC/0/,  MAXLNS/40/,  TOTLWV/0.0/
	DATA	NTOT/0/,  MAXTOT/200/,  SLIST/8*0/
	DATA	FIRST,SECOND / .TRUE., .FALSE. /
C
9000	FORMAT (80A1)
9010	FORMAT (' PROGMMDD.ACL FILENAME >',80A1)
9020	FORMAT (' UIC TO JOB REF. FILENAME >',80A1)
9030	FORMAT (' MONTH >',I3)
9050	FORMAT (2O3)
9060	FORMAT (' INCENTIVES (0-7,8-17,18-24),',/,
     *		' WORK UNIT WEIGHTS (CP,ELAPS,DB,LP,MT,TERM)',/,' >',$)
9070	FORMAT (1H1,40X,'ACTIVITY REPORT FOR ACCOUNT - [',3A1,
     *		',',3A1,']',/41X,39('*'))
9080	FORMAT (40X,80A1,//)
9090	FORMAT (6X,'PROGRAM   INCENTIVE   CPU (MIN)  ELAP.(MIN)',4X,
     *		'DISK-I/O   PRINT-I/O    TAPE-I/O    TERM-I/O',4X,
     *		'ADJ.-UNITS   ADJ.-CO$T',/6X,7('*'),3X,9('*'),3X,
     *		9('*'),2X,10('*'),4X,8('*'),3X,9('*'),4X,8('*'),
     *		4X,8('*'),4X,10('*'),3X,9('*'),/)
9100	FORMAT (8X,3A1,F12.1,F12.2,F12.2,I13,I12,I12,I12,F14.3,F12.2)
9110	FORMAT (/6X,I5,' PROGRAMS',/)
9120	FORMAT (7X,'TOTALS',F10.1,2F12.2,I13,3I12,F14.3,F12.2)
9130	FORMAT (1H1,15X,9A1,3X,'PROGRAM MJP',3X,8A1,/28X,11('*'),/)
9140	FORMAT (' RUN IDENT. MONTH AND YEAR (20 CHAR)>',$)
9150	FORMAT (/45X,'FOR PERIOD : ',20A1,/)
9160	FORMAT (/10X,'FOR PERIOD : ',20A1)
9170	FORMAT (/10X,'RATE FOR TIME PERIOD 00:00 TO 07:59 >',I4,'%')
9180	FORMAT (/10X,'RATE FOR TIME PERIOD 08:00 TO 16:59 >',I4,'%')
9190	FORMAT (/10X,'RATE FOR TIME PERIOD 17:00 TO 24:00 >',I4,'%')
9195	FORMAT (//10X,'WORK UNIT VALUES',/)
9200	FORMAT	( 10X,'CPU TICKS          >',F9.6)
9210	FORMAT	( 10X,'ELAPSED TIME TICKS >',F9.6)
9220	FORMAT	( 10X,'DISK QIO CALLS     >',F9.6)
9230	FORMAT	( 10X,'LINE PRINTER LINES >',F9.6)
9240	FORMAT	( 10X,'MAG.TAPE QIO CALLS >',F9.6)
9250	FORMAT	( 10X,'TERMINAL I/O CALLS >',F9.6)
9260	FORMAT (' SYSTEM OVERHEAD (DIST.)',F11.2,F12.2,I13,3I12,F14.3,
     *		F12.2)
9270	FORMAT (' UIC TOTAL, INCENT. ADJ.',F11.2,F12.2,I13,3I12,F14.3,
     *		F12.2)
9280	FORMAT ('0UIC + SYS OVERHEAD ADJ.',F11.2,F12.2,I13,3I12,F14.3,
     *		F12.2)
9290	FORMAT (/,' THE FOLLOWING TOTALS INCLUDE ADJUSTMENT',
     *		' FOR INCENTIVE.',/)
9300	FORMAT (' WORK-UNIT VALUE ($) >',$)
9310	FORMAT (/10X,'WORK-UNIT VALUE ($)>',F9.6)
9320	FORMAT (F10.2)
9330	FORMAT (1H1,40X,'SUMMARY BY ACCOUNT',//,45X,20A1,//)
9340	FORMAT ('   [',3A1,',',3A1,']   ',10A1,3X,80A1)
9350	FORMAT (/5X,'TOTAL=',F10.2)
C
C-----
C   OPEN THE FILES
C-----
	CALL GETMCR (CARD,I)
	ASK=.TRUE.
	LU=1
	IF (I.LT.5) GO TO 50
	ASK=.FALSE.
	LU=7
	CARD(I+1)=0
	CALL ASSIGN (LU,CARD(5))
C
C
50	CALL ASSIGN (6,'MJP.PRT')
	CALL DATE (DAT)
	CALL TIME (TIM)
	WRITE (6,9130) DAT,TIM
C
	OPEN (UNIT=8,NAME='MJP.SCR',TYPE='SCRATCH',ACCESS='SEQUENTIAL',
     *		CARRIAGECONTROL='LIST')
C
	IF (ASK) WRITE (LU,9140)
	READ (LU,9000) MNTHYR
	WRITE (6,9160) MNTHYR
C
	IF (ASK) WRITE (LU,9010)
	READ (LU,9000) CARD
	WRITE (6,9010) CARD
	CALL TRIM (CARD)
	CALL ASSIGN (2,CARD)
C
	IF (ASK) WRITE (LU,9020)
	READ (LU,9000) CARD
	WRITE (6,9020) CARD
	CALL TRIM (CARD)
	CALL ASSIGN (3,CARD)
C
	IF (ASK) WRITE (LU,9030)
	READ (LU,*) MONTH
	WRITE (6,9030) MONTH
C
	IF (ASK) WRITE (LU,9060)
	READ (LU,*) I07,I817,I1824,WC,WE,WD,WL,WM,WT
C
	WRITE (6,9170) I07
	WRITE (6,9180) I817
	WRITE (6,9190) I1824
C
	WRITE (6,9195)
	WRITE (6,9200) WC
	WRITE (6,9210) WE
	WRITE (6,9220) WD
	WRITE (6,9230) WL
	WRITE (6,9240) WM
	WRITE (6,9250) WT
C
	IF (ASK) WRITE (LU,9300)
	READ (LU,*) WUNVAL
	WRITE (6,9310) WUNVAL
C
	IF (LU.EQ.7) CALL CLOSE (LU)
C
C
C--------------------------------------------------------------------
C   READ THROUGH THE INPUT FILE AND BUILD THE RANDOM FILE.
C
C
1000	READ (2,END=2000) PB
C
	M=PMMDD/100
	IF (M.NE.MONTH) GO TO 1000
	IF (PUIC(2).GE.0.AND.PUIC(2).LT."10) UIC=0
	I1UIC(1)=PUIC(1)
	I1UIC(2)=PUIC(2)
C
C   INCENTIVE ???
C
	LIST(8)=I07
	IF (PHHMM.GE.759.AND.PHHMM.LT.1700) LIST(8)=I817
	IF (PHHMM.GE.1700) LIST(8)=I1824
	LIST(7)=1
C
	KD=1
	CALL SUM (KD,I4UIC,PTASK,LEN,LIST)
	GO TO 1000
C
C--------------------------------------------------------------------
C   SORT THE DATA AND ON A NEW PAGE FOR EACH UIC, REPORT.
C
C
2000	CALL CLOSE (2)
	KD=0
	CALL SUM (KD,I4UIC,PTASK,LEN,LIST)
C
3000	KD=-1
	CALL SUM (KD,I4UIC,PTASK,LEN,LIST)
	IF (KD.EQ.-1) GO TO 3100
	IEND=.TRUE.
	GO TO 5000
C
3100	IF (OLD) GO TO 3200
	NUIC=I4UIC
	OLD=.TRUE.
C
3200	IF (I4UIC.NE.NUIC) GO TO 5000
	IF (FIRST) GO TO 4050
C
	KNT=KNT+1
	IF (KNT.GT.1) GO TO 3800
C
C------------------------
C   NEW PAGE >
C   SCAN THROUGH THE UIC > JOB CROSS REF FILE
C
3300	READ (3,9050,END=3400) D1UIC(2),D1UIC(1)
	JUIC=D2UIC
	READ (3,9000) CARD
	IF (JUIC.NE.NUIC) GO TO 3300
	GO TO 3600
3400	DO 3500 I=1,80
3500	CARD(I)=1H     
3600	REWIND 3
	CALL UICPRT (NUIC,UICP)
C
3800	IF (KNT.NE.1.AND.MOD(KNT,MAXLNS).NE.0) GO TO 4000
C
C   PRINT PAGE HEADINGS
C
	WRITE (6,9070) UICP
	WRITE (6,9150) MNTHYR
	WRITE (6,9080) CARD
	WRITE (6,9090)
C
C
C-----
C   PRINT THE CURRENT TASK INFO
C-----
4000	CALL R50ASC (3,PTASK,TASK)
	CMIN=CPU/3600.
	EMIN=ELAPS/3600.
C
C   CALC THE WORK UNITS
C
	WUNITS=       CPU  *WC
	WUNITS=WUNITS+ELAPS*WE
	WUNITS=WUNITS+DBQ  *WD
	WUNITS=WUNITS+LPQ  *WL
	WUNITS=WUNITS+MTQ  *WM
	WUNITS=WUNITS+OTQ  *WT
C
	CENTIV=LIST(8)
	CENTIV=CENTIV/LIST(7) 
	WUNITS=WUNITS*CENTIV* 0.01
C
	WV=WUNITS*WUNVAL
C
	WRITE (6,9100) TASK,CENTIV,CMIN,EMIN,(LIST(I),I=3,6),WUNITS,WV
C
4050	DO 4100 I=1,LEN
	SLIST(I)=SLIST(I)+LIST(I)
4100	CONTINUE
	GO TO 3000
C
C-----
C   END OF THIS UIC,  PRINT THE SUMMARY LINE
C-----
5000	CMIN=SLIST(1)/3600.
	EMIN=SLIST(2)/3600.
C
C   INCENTIVES
C
	WUNITS=       SLIST(1)*WC
	WUNITS=WUNITS+SLIST(2)*WE
	WUNITS=WUNITS+SLIST(3)*WD
	WUNITS=WUNITS+SLIST(4)*WL
	WUNITS=WUNITS+SLIST(5)*WM
	WUNITS=WUNITS+SLIST(6)*WT
C
	CENTIV=SLIST(8)
	CENTIV=CENTIV/SLIST(7) 
	WUNITS=WUNITS*CENTIV*0.01
C
	WV=WUNITS*WUNVAL
C
	IF (SECOND) WRITE (6,9110) KNT
	IF (SECOND) WRITE (6,9120)	CENTIV,CMIN,EMIN,
     *					(SLIST(I),I=3,6),WUNITS,WV
	IF (SECOND) WRITE (6,9290)
C
C   IF THIS IS THE OPERATING SYSTEM UIC [000,000] -- SAVE OVERHEADS
C
	CENTIV=CENTIV*0.01
	CMIN=CMIN*CENTIV
	EMIN=EMIN*CENTIV
	DO 5100 I=1,6
	SLIST(I)=SLIST(I)*CENTIV
5100	CONTINUE
C
	IF (NUIC.NE.0) GO TO 5400
C
	IF (SECOND) WRITE (6,9260) CMIN,EMIN,(SLIST(I),I=3,6),WUNITS,WV
C
	DO 5300 I=1,8
	SYSOVR(I)=SLIST(I)
5300	CONTINUE
	GO TO 6000
C
C   THIS MUST BE AN ACCOUNTABLE UIC, -- SAVE THE TOTAL LINE
C   BUT !   IF THIS IS THE SECOND PASS,  PRINT THE TOTALS LINES
C
5400	NTOT=NTOT+1
	IF (SECOND) GO TO 5600
C
	IF (NTOT.GT.MAXTOT)	STOP 'MEM. EXCEEDED, TOT UNIQUE UICS'
	DO 5500 I=1,8
	LSTTOT(I,NTOT)=SLIST(I)
5500	CONTINUE
	UICTAB(NTOT)=NUIC
	GO TO 6000
C
C   FIRST, PRINT THE SUMMARY CHARGE FOR UIC ONLY
C
5600	WRITE (6,9270) CMIN,EMIN,(SLIST(I),I=3,6),WUNITS,WV
C
C   NOW,   PRINT THE SUMMARY CHARGE FOR THE DISTRIBUTED SYS OVERHEAD
C
	CM=OVRTOT(1,NTOT)/3600.
	EM=OVRTOT(2,NTOT)/3600.
	WUN=TOTWUN(NTOT)
	WV=WUN*WUNVAL
	WRITE (6,9260) CM,EM,(OVRTOT(I,NTOT),I=3,6),WUN,WV
C
C   FINALLY, PRINT THE TOTALS SUMMARY LINE
C
	CM=CM+CMIN
	EM=EM+EMIN
	WUN=WUN+WUNITS
	WV=WUN*WUNVAL
	DO 5700 I=3,6
	SLIST(I)=LSTTOT(I,NTOT)+OVRTOT(I,NTOT)
5700	CONTINUE
	WRITE (6,9280) CM,EM,(SLIST(I),I=3,6),WUN,WV
C
C   WRITE A SUMMARY ENTRY TO THE SCRATCH FILE
C
	WRITE (8,9000) UICP
	WRITE (8,9320) WV
	WRITE (8,9000) CARD
	TOTLWV=TOTLWV+WV
C
C   IS THIS THE END OF DATA ???
C
6000	IF (IEND) GO TO 6200
C
	KNT=1
	NUIC=I4UIC
	DO 6100 I=1,LEN
6100	SLIST(I)=0
	IF (FIRST) GO TO 4050
	GO TO 3300
C
C   YEP,  IS THIS THE END OF THE SECOND PASS ?
C
6200	IF (SECOND)   GO TO 7000
C
C   NOPE,  CALCULATE THE DISTRIBUTED OVERHEAD
C
	KD=0
	CALL SUM (KD,I4UIC,PTASK,LEN,LIST)
C
	IEND=.FALSE.
	FIRST=.FALSE.
	SECOND=.TRUE.
	KNT=0
	OLD=.FALSE.
C
C   ZERO ACCUMULATORS
C
	DO 6300 I=1,6
6300	SLIST(I)=0
C
C   SUM EVERYTHING
C
	DO 6500 I=1,NTOT
	DO 6400 J=1,6
	SLIST(J)=SLIST(J)+LSTTOT(J,I)
6400	CONTINUE
6500	CONTINUE
C
C   CALC DISTRIBUTION FACTORS
C
	DO 6600 I=1,6
	RLIST(I)=0.0
	IF (SYSOVR(I).EQ.0) GO TO 6600
	RLIST(I)=SYSOVR(I)
	RLIST(I)=RLIST(I)/SLIST(I)
6600	CONTINUE
C
C   APPLY DISTRIBUTION FACTORS TO ALL THE KEPT TOTALS
C
	DO 6800 I=1,NTOT
	W=0.0
	DO 6700 J=1,6
	OVRTOT(J,I)=LSTTOT(J,I)*RLIST(J)
	W=W+OVRTOT(J,I)*WEIGHT(J)
6700	CONTINUE
	TOTWUN(I)=W
6800	CONTINUE
C
	DO 6900 I=1,LEN
6900	SLIST(I)=0
C
C   NOW GO BACK FOR SECOND PASS
C
	NTOT=0
	GO TO 3000
C
C   GENERAL REPORT FINISHED,  NOW PRINT SUMMARY
C
7000	REWIND 8
	WRITE (6,9330) MNTHYR
C
7100	READ (8,9000,END=7200) UICP
	READ (8,9000) COST
	READ (8,9000) CARD
	WRITE (6,9340) UICP,COST,CARD
	GO TO 7100
C
7200	WRITE (6,9350) TOTLWV
	STOP
C
	END