SUBROUTINE LSTDIR ( lun, luntrm, outstr, lfnam, device, idev,
     +			    direct, grp, usr, cmp, ier )
C
	CHARACTER*80	outstr
	CHARACTER*80	device
	CHARACTER*80	filnam
	CHARACTER*15	deffil
	CHARACTER*9	fnam
	CHARACTER*3	ext, dir
	CHARACTER*3	cmp
	CHARACTER*1	decid
C
	LOGICAL		direct			! TRUE => directory mode.
	LOGICAL		grp, usr
C
	INTEGER*2	idev
	INTEGER*2	idata(8), icnt
	INTEGER*2	lun, luntrm
	INTEGER*2	lfnam
	INTEGER*2	ipntr
C
	DATA		icnt/12/
	DATA		dir/'DIR'/
	DATA		deffil/'[0,0]000000.DIR'/
C
C	 Executable begins here.
C
	IF ( idev .GT. 0 ) THEN
	    filnam(1:idev) = device(1:idev)
	    ipntr = idev + 1
	ELSE
	    filnam(1:3) = 'SY:'
	    ipntr = 4
	END IF
	filnam(ipntr:ipntr+15-1) = deffil
	OPEN ( UNIT = lun, NAME = filnam,
     +		STATUS = 'old',
     +		FORM = 'unformatted',
     +		RECL = 4,
     +		RECORDTYPE = 'fixed',
     +		READONLY, SHARED, ERR = 9100 )
1000	CONTINUE
	READ ( lun, END = 9010, ERR = 9200 ) idata
	icnt = 3
	CALL R50ASC ( icnt, idata(7), ext )
	IF ( ext .EQ. dir ) THEN
	    icnt = 9
	    CALL R50ASC ( icnt, idata(4), fnam )
	    lfnam = INDEX ( fnam, ' ' ) - 1
	    IF ( lfnam .LE. 0 ) THEN
		lfnam = 9
	    END IF
	    IF ( fnam(1:lfnam) .EQ. '000000' ) GOTO 1000
	    IF ( direct .OR.				! Either directory mode
     +		 ( .NOT. direct .AND.			! or UIC with 6
     +		   lfnam .EQ. 6 ) ) THEN		! characters only.
		IF ( .NOT. direct ) THEN		! Check UIC mode.
		    DO 1050 i = 1, lfnam
			IF ( fnam(i:i) .LT. '0' .OR.	! In UIC mode, the
     +			     fnam(i:i) .GT. '9' ) THEN	! data must be numeric.
			    GOTO 1000
			END IF
1050		    CONTINUE
		    IF ( grp .AND.			! Group mode and no
     +			 fnam(1:3) .NE. cmp ) GOTO 1000	! match on group #.
		    IF ( usr .AND.			! User mode and no
     +			 fnam(4:6) .NE. cmp ) GOTO 1000	! match on user #.
		    fnam(5:7) = fnam(4:6)		! Reformat UIC string.
		    fnam(4:4) = ','			! Stick in comma.
		    lfnam = lfnam + 1			! Increment length, too.
		END IF
		WRITE ( luntrm, 1100) fnam(1:lfnam)
1100		FORMAT ( '$Move to directory [',A,']? ')
		READ ( luntrm, 1200, END = 9400, ERR = 9300 ) decid
1200		FORMAT ( 1A1 )
		IF ( decid .NE. 'y' .AND. decid .NE. 'Y' ) THEN
		    GOTO 1000
		ELSE
		    outstr(1:lfnam) = fnam(1:lfnam)
		END IF
	    ELSE
		GOTO 1000
	    END IF
	ELSE
	    GOTO 1000
	END IF
	ier = 1
9000	CONTINUE
	CLOSE ( lun )
	RETURN
9010	CONTINUE
	WRITE ( luntrm, 9020)
9020	FORMAT ( ' %DEF-F-NODIR, No more directories' )
	ier = -1
	GOTO 9000
C
C	 I/O Error processing.
C
9100	CONTINUE
	WRITE ( luntrm, 9110 )
9110	FORMAT ( 'Could not open master directory file.' )
	ier = -1
	GOTO 9000
9200	CONTINUE
	WRITE ( luntrm, 9210 )
9210	FORMAT ( 'Could not read from master directory file.' )
	ier = -1
	GOTO 9000
9300	CONTINUE
	WRITE ( luntrm, 9310 )
9310	FORMAT ( 'Input error from terminal.' )
	ier = -1
	GOTO 9000
9400	CONTINUE
	WRITE ( luntrm, 9410 )
9410	FORMAT ( ' %DEF-F-NOCHG, No change in directory location.' )
	ier = -1
	GOTO 9000
	END