SUBROUTINE SUM (KD,IUIC,ITSK,LEN,LIST)
C***********************************************************
C
C	THIS SUBROUTINE IS USED BY THE ACCOUNTING
C	PROGRAMS TO SUM TIMES AND QIOS BY UIC AND
C	TASK NAME.
C
C	OPEN AND RUN CALL -- KD=1
C		IUIC=INTEGER*4 UIC OF CURRENT TASK.
C		ITSK=RADIX-50 3 CHAR TASK NAME.
C		 LEN=NUMBER OF ITEMS TO SUM.
C		LIST=INTEGER*4 ARRAY CONTAINING
C		     ITEMS TO SUM.
C
C
C	CLOSE CALL -- KD=0
C		SETS UP THE ROUTINE TO RETURN SORTED
C		ENTRYS IN...
C			A)ASCENDING UIC NUMBER
C			B)ALPHA SORTED TASK NAME.
C		    *NOTE*
C			ANY SUBSEQUENT KD=0 CALLS RESET
C			THE ROUTINE TO POINT TO THE BEGINNING
C			UIC-TASK AGAIN.
C
C	RUN CALL -- KD=-1
C		RETURNS...
C			KD=-1	SORTED SUMMED RECORD.
C			KD=0	END OF FILE.
C
C	LIMITS
C	******
C		256	UNIQUE UIC NUMBERS.
C		4096	INDIVIDUAL UIC/TASK ENTRYS.
C		256	MAXIMUM TASKS PER UIC.
C
C	LOGICAL UNIT # 4 IS USED FOR A DISK SCRATCH FILE.
C************************************************************
C
	LOGICAL*1 OLD,NEW
C
	INTEGER*2 ADDR(256),TASK(17,256),SORTAB(2,256),
     *		  PACTAB(256)
C
	INTEGER*4 UICTAB(256),PACK(8,16),LIST(1),IAV,IUIC,
     *		  LSTUIC,SRTAB(256)
C
	EQUIVALENCE (SRTAB,SORTAB)
C
	DATA OLD/.FALSE./,MAXUIC,MAXPAC,MAXSRT/256,256,256/
	DATA NUIC/0/,SRTAB/256*0/,NEW/.TRUE./
C
C
	IF (OLD) GO TO 100
C
C   OPEN THE SCRATCH FILE.....
C
	OPEN (UNIT=4,NAME='[1,6]ACCSCRACH.TMP',TYPE='SCRATCH',
     *	      ACCESS='DIRECT',ASSOCIATEVARIABLE=IAV,
     *	      RECORDSIZE=128)
C
	OLD=.TRUE.
C
C   WHAT TYPE OF CALL ???????
C
100	IF (KD) 5000,4000,1000
C
C--------------------------------------------------------------
C		R U N   C A L L
C--------------------------------------------------------------
C
1000	IF (NUIC.GT.0) GO TO 1500
C
C   FIRST RUN CALL,  RESET EVERYTHING.....
C
C
	NPACK=0
	NPIN=0
	GO TO 1700
C
C   DOES THE CALLING UIC EXIST IN THE TABLE ?????
C
1500	DO 1600 I=1,NUIC
	IF (IUIC.EQ.UICTAB(I)) GO TO 2500
1600	CONTINUE
C
C   NO, ADD ANOTHER UIC ENTRY.....
C
1700	NUIC=NUIC+1
	IF (NUIC.GT.MAXUIC)		STOP 'MAX # OF UICS EXCEEDED'
	UICTAB(NUIC)=IUIC
	ADDR(NUIC)=NPACK+1
C
C   ADD ANOTHER PACKET TO UIC TASK TABLE.....
C
1800	NPACK=NPACK+1
	IF (NPACK.GT.MAXPAC)		STOP 'MAX # OF PACKS EXCEEDED'
	IF (NPIN.NE.0) WRITE (4'NPIN) PACK
	DO 2000 I=1,8
	DO 1900 J=1,16
	PACK(I,J)=0
1900	CONTINUE
2000	CONTINUE
	DO 2100 I=1,17
2100	TASK(I,NPACK)=0
	TASK(1,NPACK)=ITSK
	NPIN=NPACK
	NENTRY=1
	GO TO 3000
C
C   DOES THE TASK EXIST UNDER THE CURRENT UIC ?????
C   IF NOT,  INCLUDE IT
C
2500	NP=ADDR(I)
C
2600	DO 2700 I=1,16
	IF (TASK(I,NP).EQ.0) TASK(I,NP)=ITSK
	IF (ITSK.EQ.TASK(I,NP)) GO TO 2800
2700	CONTINUE
	J=NP
	NP=TASK(17,NP)
	IF (NP.GT.0) GO TO 2600
	TASK(17,J)=NPACK+1
	GO TO 1800
C
C   TASK EXISTS,  ADD CURRENT DATA TO PREVIOUS DATA.....
C
2800	NENTRY=I
	IF (NP.EQ.NPIN) GO TO 3000
	WRITE (4'NPIN) PACK
	READ (4'NP) PACK
	NPIN=NP
C
3000	DO 3100 I=1,LEN
	PACK(I,NENTRY)=PACK(I,NENTRY)+LIST(I)
3100	CONTINUE
	RETURN
C
C-----------------------------------------------------------
C		C L O S E   C A L L
C-----------------------------------------------------------
C
4000	IF (NEW) WRITE (4'NPIN) PACK
	NEW=.FALSE.
	NU=0
	NENTRY=0
	NP=1
	LSTUIC=-999998
	RETURN
C-----------------------------------------------------------
C		R E A D   C A L L
C-----------------------------------------------------------
C
5000	IF (NP.LT.NENTRY) GO TO 6000
	NU=NU+1
	IF (NU.LE.NUIC) GO TO 5100
C
C   END OF DATA.....
C
	KD=0
	RETURN
C
C   GET THE NEXT ASCENDING UIC NUMBER.....
C
5100	IUIC=999999
	DO 5200 I=1,NUIC
	IF (UICTAB(I).LE.LSTUIC) GO TO 5200
	IF (UICTAB(I).GT.IUIC) GO TO 5200
	J=I
	IUIC=UICTAB(I)
5200	CONTINUE
	LSTUIC=IUIC
	NP=ADDR(J)
	NENTRY=0
C
C   GATHER THE TASKS UNDER THE NEXT UIC.....
C
5300	DO 5400 I=1,16
	IF (TASK(I,NP).EQ.0) GO TO 5500
	NENTRY=NENTRY+1
	SORTAB(1,NENTRY)=TASK(I,NP)
	PACTAB(NENTRY)=NP*100+I
5400	CONTINUE
C
	NP=TASK(17,NP)
	IF (NP.GT.0) GO TO 5300
5500	NP=0
	NPIN=0
C
	CALL SSORT (SRTAB,PACTAB,NENTRY)
C
C   GET NEXT ENTRY FROM TABLE & RETURN LIST FOR IT.....
C
6000	IUIC=LSTUIC
	NP=NP+1
	I=NPIN
	NPIN=PACTAB(NP)/100
	IF (I.NE.NPIN) READ (4'NPIN) PACK
	ITSK=SORTAB(1,NP)
	J=MOD(PACTAB(NP),100)
C
	DO 6100 I=1,LEN
	LIST(I)=PACK(I,J)
6100	CONTINUE
	RETURN
	END