SUBROUTINE LSTLOG(IER)
C
C*****************************************************************************
C
C	PURPOSE: TO LIST THE CURRENT CONTENTS OF THE LOG FILE.
C
C*****************************************************************************
C
	LOGICAL*1 LD(32),DATTIM(18),YN
	LOGICAL FULL
	INTEGER LI(4),LO(4)
	REAL MON(0:12)
	INCLUDE 'LOGHDR.ADM'
	INCLUDE 'LOGVBL.ADM'
	INCLUDE 'LOGPR1.ADM'
	INCLUDE 'LOGPR2.ADM'
C
	DATA MON/'***-','JAN-','FEB-','MAR-','APR-','MAY-','JUN-','JUL-',
     $'AUG-','SEP-','OCT-','NOV-','DEC-'/
C
C
C*****************************************************************************
C
C	PRESET ERROR CODE ANS ASK FOR FULL LIST AND LIST DEVICE.
C
C*****************************************************************************
C
	IER=-1
	WRITE(6,5)
5	FORMAT(/'$FULL LIST? [Y/N]: ')
	READ(5,6,END=1000) YN
6	FORMAT(A1)
	FULL=.FALSE.
	IF(YN.EQ.'Y') FULL=.TRUE.
	WRITE(6,10)
10	FORMAT('$ENTER LIST DEVICE: ')
	READ(5,20,END=1000) NLD,(LD(I),I=1,NLD)
20	FORMAT(Q,32A1)
	CALL CLOSE(2)
	CALL ASSIGN(2,LD,NLD)
C
C*****************************************************************************
C
C	GET DATE AND TIME AND WRITE THEM TO LIST DEVICE
C
C*****************************************************************************
C
	CALL DATE(DATTIM)
	DATTIM(10)=' '
	CALL TIME(DATTIM(11))
	IF(.NOT.FULL) GO TO 27
C
C*****************************************************************************
C
C	PRINT ALL TERMINALS WHICH ARE LOGGED IN AND THEIR PROJECTS.
C
C*****************************************************************************
C
	WRITE(2,21) DATTIM
21	FORMAT(1H1//1X,40('=')/' = PROCESSING DATE:  ',18A1,' ='/
     $1X,40('=')//)
	DO 25 I=1,10
	IF(TTLGIN(I).EQ.0) GO TO 25
	READ(1'TTLGIN(I)) IBFPR1
	WRITE(2,23) I-1,(UIC(J),J=1,9),PRONAM
23	FORMAT(' TT',I1,': LOGGED IN AT ',9A1,' FOR PROJECT: ',32A1)
25	CONTINUE
C
C
C*****************************************************************************
C
C	MAIN DO LOOP.
C
C*****************************************************************************
C
C
C
27	DO 100 I=1,30
C
C*****************************************************************************
C
C	FIND NEXT NON-EMPTY UIC RECORD.
C
C*****************************************************************************
C
	IF(LRCHDR(1,I).NE.'[') GO TO 100
C
C*****************************************************************************
C
C	READ PROPER "VBN" BLOCK
C
C*****************************************************************************
C
	IVBN=(I-1)/8+2
	MUIC=MOD(I-1,8)+1
	IF(MUIC.EQ.1) READ(1'IVBN,ERR=1000) IBFVBL
C
C*****************************************************************************
C
C	PRINT ACCOUNT AND THE NUMBER OF PROJECTS
C
C*****************************************************************************
C
	WRITE(2,21) DATTIM
	WRITE(2,30) (LRCHDR(J,I),J=1,9),IRCHDR(8,I)
30	FORMAT(//' ACCOUNT ',9A1,' HAS ',I2,' PROJECTS:')
C
C*****************************************************************************
C
C	READ BOTH PROJECT BLOCKS AND PRINT THE CONTENTS OF THE FIRST ONE.
C
C*****************************************************************************
C
	NJ=0
	DO 100 J=1,32
	IVBL=IRCVBL(J,MUIC)
	IF(IVBL.EQ.0) GO TO 100
	NJ=NJ+1
	READ(1'IVBL,ERR=1000) IBFPR1
	READ(1'IVBL+1,ERR=1000) IBFPR2
	WRITE(2,40) NJ,PRONAM
40	FORMAT(/1X,I2,'. PROJECT NAME: ',32A1)
	WRITE(2,45)
45	FORMAT(/1X,72('*'))
	RM=MON(GRANTS(2))
	WRITE(2,50) GRANTL,GRANTS(3),RM,GRANTS(1),(GRANTS(K),K=4,8)
50	FORMAT(' *** GRAND TOTAL       : ',I5,':',I2,':',I2,' SINCE ',
     $I2,'-',A4,I2,2X,I2,':',I2,':',I2,' ''',I2,'"',I2,' ***')
	RM=MON(TOTSNC(2))
	WRITE(2,51) TOTLOG,TOTSNC(3),RM,TOTSNC(1),(TOTSNC(K),K=4,8)
51	FORMAT(' *** TOTAL CONNECT TIME: ',I5,':',I2,':',I2,' SINCE ',
     $I2,'-',A4,I2,2X,I2,':',I2,':',I2,' ''',I2,'"',I2,' ***')
	IP=ICURPN
	WRITE(2,52)
52	FORMAT(1X,72('*'))
	IF(.NOT.FULL) GO TO 100
C
C*****************************************************************************
C
C	PRINT THE OLD TOTALS OUT OF 2ND PROJECT BLOCK STARTING WITH THE MOST
C	RECENT ONE.
C
C*****************************************************************************
C
	WRITE(2,522)
522	FORMAT(/6X,62('*'))
	DO 54 K=1,31
	IP=IP-1
	IF(IP.LE.0) IP=32
	IF(IRCPR2(4,IP).LE.0) GO TO 54
	RM=MON(IRCPR2(5,IP))
	WRITE(2,53) (IRCPR2(JJ,IP),JJ=1,3),IRCPR2(6,IP),RM,IRCPR2(4,IP),
     $(IRCPR2(JJ,IP),JJ=7,8)
53	FORMAT(6X,'*** TOTAL CONNECT TIME: ',I5,':',I2,':',I2,' SINCE ',
     $I2,'-',A4,I2,2X,I2,':',I2,' ***')
54	CONTINUE
	WRITE(2,55)
55	FORMAT(6X,62('*')/)
C
C*****************************************************************************
C
C	PRINT LAST LOGIN AND LAST LOGOUT FOR EVERY TERMINAL (0-9).
C
C*****************************************************************************
C
	DO 70 K=1,10
	RI=MON(LLGIN(2,K))
	RO=MON(LLGOUT(2,K))
	LI(1)=LLGIN(1,K)
	LO(1)=LLGOUT(1,K)
	DO 57 M=2,4
	LI(M)=LLGIN(M+2,K)
57	LO(M)=LLGOUT(M+2,K)
	WRITE(2,60) K-1,LLGIN(3,K),RI,LI,LLGOUT(3,K),RO,LO
60	FORMAT(' TT',I1,': LAST LOGIN: ',I3,'-',A4,I2,I3,':',I2,':',I2,5X,
     $'LAST LOGOUT: ',I3,'-',A4,I2,I3,':',I2,':',I2)
70	CONTINUE
C
C
C
C*****************************************************************************
C
C	END OF MAIN DO LOOP.
C
C*****************************************************************************
C
100	CONTINUE
C
C
	IER=1
C
C
1000	RETURN
	END