SUBROUTINE ADDLOG(IER)
C
C*****************************************************************************
C
C	PURPOSE: TO ADD AN ACCOUNT AND/OR PROJECTS TO THE LOG FILE.
C
C*****************************************************************************
C
	LOGICAL*1 RECHDR(10)
	INCLUDE 'LOGHDR.ADM'
	INCLUDE 'LOGVBL.ADM'
	INCLUDE 'LOGPR1.ADM'
	INCLUDE 'LOGPR2.ADM'
C
C
	DATA RECHDR/'[',3*0,',',3*0,']',0/
C
C
C
C*****************************************************************************
C
C	PRESET ERRORCODE.
C	DON'T PRODUCE ERROR MESSAGES FOR END OF FILE AND READ ERRORS, BECAUSE
C	THE FILE COULD BE EXTENDED.
C
C*****************************************************************************
C
	IER=-1
	CALL ERRSET(39,.TRUE.,.FALSE.,.TRUE.,.FALSE.)
	CALL ERRSET(24,.TRUE.,.FALSE.,.TRUE.,.FALSE.)
C
C*****************************************************************************
C
C	ASK FOR THE UIC, ENCODE IT AND REPLACE SPACES WITH ASCII '0'.
C
C*****************************************************************************
C
5	WRITE(6,10)
10	FORMAT(/'$ENTER GROUP,MEMBER: ')
	READ(5,20,END=1000,ERR=5) IGR,MEM
20	FORMAT(2O6)
	ENCODE(3,30,RECHDR(2),ERR=5) IGR
30	FORMAT(O3)
	ENCODE(3,30,RECHDR(6),ERR=5) MEM
	DO 35 I=2,8
35	IF(RECHDR(I).EQ.32) RECHDR(I)=48
C
C*****************************************************************************
C
C	SEE IF UIC ALREADY EXISTS. IF SO, GO TO THE PROPER SECTION.
C
C*****************************************************************************
C
	IFOUND=0
	DO 50 I=1,30
	DO 40 J=1,9
40	IF(RECHDR(J).NE.LRCHDR(J,I)) GO TO 50
	IFOUND=I
	GO TO 200
50	CONTINUE
C
C*****************************************************************************
C
C	NO MATCH
C
C	FIND FIRST FREE UIC RECORD IN THE FIRST BLOCK OF THE FILE. IF NONE,
C	EXIT WITH PROPER MESSAGE.
C	IF FOUND, COPY THE UIC INTO IT.
C
C*****************************************************************************
C
	DO 60 I=1,30
	IZERO=I
	IF(IRCHDR(1,I).EQ.0) GO TO 70
60	CONTINUE
	GO TO 900
70	DO 80 I=1,10
80	LRCHDR(I,IZERO)=RECHDR(I)
C
C*****************************************************************************
C
C	ASK FOR THE NUMBER OF PROJECTS. IF OUT OF RANGE,TRY AGAIN.
C
C*****************************************************************************
C
85	WRITE(6,90)
90	FORMAT('$ENTER NUMBER OF PROJECTS [<=32]: ')
	READ(5,94,ERR=85,END=1000) NPROJ
94	FORMAT(I5)
	IF(NPROJ.LE.0.OR.NPROJ.GT.32) GO TO 85
C
C*****************************************************************************
C
C	FILL UIC RECORD WITH NUMBER OF PROJECTS AND READ THE PROPER "VBN"BLOCK
C
C*****************************************************************************
C
	IPROJ=1
	IRCHDR(8,IZERO)=NPROJ
	IVBN=(IZERO-1)/8+2
	MUIC=MOD(IZERO-1,8)+1
	READ(1'IVBN,END=1000,ERR=1000) IBFVBL
C
C*****************************************************************************
C
C	LOOK FOR THE FIRST FREE PAIR OF PROJECT BLOCKS.
C	IF READ ERROR, FILE HAS TO BE EXTENDED.
C
C*****************************************************************************
C
	LVBN=6
	DO 150 I=1,NPROJ
95	READ(1'LVBN,ERR=100,END=100) IBFPR1
	IF(IBFPR1(1).EQ.0) GO TO 100
	LVBN=LVBN+2
	GO TO 95
C
C*****************************************************************************
C
C	NEW PROJECT WILL BE STORED INTO BLOCKS "LVBN" AND "LVBN+1".
C
C	FILL "LVBN" INTO "VBN" BLOCK.
C
C	STORE PROJECT NAME, UIC, DATE/TIME INTO PROJECT BLOCK #1.
C
C*****************************************************************************
C
100	IRCVBL(I,MUIC)=LVBN
	DO 110 J=1,256
	IBFPR1(J)=0
110	IBFPR2(J)=0
	ICURPN=1
	WRITE(6,120) I
120	FORMAT('$ENTER PROJECT NAME #',I2,' [32A1]: ')
	READ(5,130,END=1000) NP,(PRONAM(J),J=1,NP)
130	FORMAT(Q,32A1)
	DO 140 J=1,10
140	UIC(J)=LRCHDR(J,IZERO)
	CALL GETTIM(TOTSNC(1))
	DO 145 J=1,8
145	GRANTS(J)=TOTSNC(J)
	WRITE(1'LVBN,ERR=1000) IBFPR1
	WRITE(1'LVBN+1,ERR=1000) IBFPR2
	LVBN=LVBN+2
150	CONTINUE
C
C
C*****************************************************************************
C
C	JUMP TO UPDATE FIRST AND CURRENT "VBN" BLOCK.
C
C*****************************************************************************
C
	GO TO 300
C
C
C*****************************************************************************
C
C	MATCH, SEE IF NUMBER NOT >32 ALREADY. IF SO EXIT WITH MESSAGE.
C
C	READ PROPER "VBN" BLOCK.
C
C	FIND NEXT FREE PAIR OF PROJECT BLOCKS. IF READ ERROR FILE WILL BE
C	EXTENDED.
C
C*****************************************************************************
C
C
200	IF(IRCHDR(8,IFOUND).GE.32) GO TO 920
	IVBN=(IFOUND-1)/8+2
	MUIC=MOD(IFOUND-1,8)+1
	READ(1'IVBN,END=1000,ERR=1000) IBFVBL
	LVBN=6
205	READ(1'LVBN,ERR=210,END=210) IBFPR1
	IF(IBFPR1(1).EQ.0) GO TO 210
	LVBN=LVBN+2
	GO TO 205
C
C*****************************************************************************
C
C	VIRTUAL BLOCK NUMBER IS "LVBN".
C
C	FIND FIRST FREE LOCATION IN "VBN" RECORD AND STORE "LVBN" IN IT. IF
C	NOT FOUND, NUMBER OF PROJECTS IS 32 ALREADY.
C
C*****************************************************************************
C
210	DO 220 I=1,32
	IF(IRCVBL(I,MUIC).NE.0) GO TO 220
	IRCVBL(I,MUIC)=LVBN
	GO TO 230
220	CONTINUE
	GO TO 920
C
C*****************************************************************************
C
C	FILL PROJECT NAME, UIC, DATE/TIME AND WRITE PROJECT BLOCKS TO DISK.
C
C*****************************************************************************
C
230	DO 240 J=1,256
	IBFPR1(J)=0
240	IBFPR2(J)=0
	ICURPN=1
	WRITE(6,120) IRCHDR(8,IFOUND)+1
	READ(5,130,END=1000) NP,(PRONAM(J),J=1,NP)
	DO 250 J=1,10
250	UIC(J)=LRCHDR(J,IFOUND)
	CALL GETTIM(TOTSNC(1))
	DO 260 J=1,8
260	GRANTS(J)=TOTSNC(J)
	WRITE(1'LVBN,ERR=1000) IBFPR1
	WRITE(1'LVBN+1,ERR=1000) IBFPR2
	IRCHDR(8,IFOUND)=IRCHDR(8,IFOUND)+1
C
C
C
C*****************************************************************************
C
C	WRITE FIRST AND CURRENT "VBN" BLOCK TO DISK AND SET SUCCESS CODE.
C
C*****************************************************************************
C
300	WRITE(1'1,ERR=1000) IBFHDR
	WRITE(1'IVBN,ERR=1000) IBFVBL
	IER=1
	GO TO 1000
C
C
C*****************************************************************************
C
C	MESSAGE SECTION.
C
C*****************************************************************************
C
900	WRITE(6,910)
910	FORMAT(/' *** WARNING *** REACHED MAX NUMBER OF ACCOUNTS (30)'/)
	GO TO 1000
C
920	WRITE(6,930)
930	FORMAT(/' *** WARNING *** REACHED MAX NUMBER OF PROJECTS (32)'/)
C
C
C
C*****************************************************************************
C
C	RESET READ- AND END-OF-FILE ERROR RECOVERY TO DEFAULT.
C
C*****************************************************************************
C
1000	CALL ERRSET(24,.TRUE.,.TRUE.,.TRUE.,.TRUE.)
	CALL ERRSET(39,.TRUE.,.TRUE.,.TRUE.,.TRUE.)
	RETURN
	END