	SUBROUTINE RTDIR(DEVICE,PASSIN,PASOUT,MORE,IBLK,INDEX,IBUF,ICHAN,
     C                    IVOL,IOWN)
C SUBROUTINE TO LOOK FOR A FILE NAME IN DIRECTORY AND RETURN IT'S DATE AND
C  NUMBER OF BLOCKS, AS WELL AS THE DEVICE ON WHICH IT WAS FOUND.
C
C CALL AS:
C
C	CALL RTDIR(DEVICE,PASSIN,PASOUT,MORE,IBLK,INDEX,IBUF,ICHAN,
C     C             IVOL,IOWN)
C WHERE:
C I	DEVICE= DEVICE (OR SUBDEVICE FILE NAME) ON WHICH DIRECTORY IS CHECKED.
C I	PASSIN= FILE NAME ARRAY OF 3 RAD50 WORDS. FILE TO SEARCH FOR.
C O	PASOUT= (1-3)	RETURNED FILE NAME (RAD50).
C		(4)	NUMBER OF BLOCKS.
C		(5)	DATE OF FILE.
C		(6)	TIME OF FILE (TSX+ CREATED FILES ONLY).
C O	MORE=	-1-> SUBDEVICE IS NOT RT-11 VOLUME.
C O		0-> FILE NOT FOUND IN DIRECTORY.
C		1-> FILE FOUND.
C I/O	IBLK=	CURRENT BLOCK # OF DEVICE DIRECTORY BEING ACCESSED.
C		MUST BE ZERO FOR 1ST ENTRY.
C O	INDEX=	CURRENT WORD # IN BLOCK.
C O	IBUF=	512 WORD BUFFER TO STORE DIRECTORY SEGMENT.
C O	ICHAN=	RT-11 CHANNEL REFERENCE NUMBER TO DIRECTORY FILE.
C O	IVOL=	12 CHARACTER VOLUME IDENTIFIER.
C O	IOWN=	12 CHARACTER OWNER IDENTIFIER.
C
C I-> INPUT TO SUBROUTINE. O-> OUTPUT (RETURNED) FROM SUBROUTINE. 
C
C TSX+ TIME OF DAY ADDED--3-JAN-86, G. BEVER.
C
	INTEGER*2 PASSIN(3),PASOUT(6),IBUF(512),DEVICE(4),ICOMP(6)
	INTEGER*2 IVOL(6),IOWN(6)
	DATA ICOMP/'DE','CR','T1','1A','  ','  '/

C IF THIS IS NOT 1ST CALL, GO TO 15.
	IF(IBLK.NE.0) GO TO 15

C GET A CHANNEL NUMBER. 
	ICHAN=IGETC() 

	IF(ICHAN.LT.0) STOP 'NO CHANNEL'
C FETCH INPUT DEVICE HANDLER INTO MEMORY. 
	IF(IFETCH(DEVICE(1)).NE.0) STOP 'BAD FETCH' 
C PERFORM LOOKUP OF INPUT FILE. 
	I=LOOKUP(ICHAN,DEVICE(1)) 
	IF(I.LT.0) GO TO 500
C
C VERIFY THAT IT IS RT-11 VOLUME.
	IBLK=1
	I=IREADW(256,IBUF,IBLK,ICHAN)
	 IF(I.EQ.-1) GO TO 9999	! PAST EOF.
	 IF(I.LT.-1) GO TO 51	! BAD READ.
	DO 11 J=1,6
	IF(IBUF(J+"756/2+1).NE.ICOMP(J)) GO TO 57 ! NOT RT-11, SO RETURN.
11	CONTINUE

C GET VOLUME ID, OWNER.
	DO 4 J=1,6
	IVOL(J)=IBUF(J+"726/2+1 )
4	IOWN(J)=IBUF(J+"742/2+1)

	IBLK=6		! STARTING BLOCK OF DIRECTORY.

C READ 1ST DIRECTORY SEGMENT (2 BLOCKS).
10	I=IREADW(256,IBUF,IBLK,ICHAN)
	 IF(I.EQ.-1) GO TO 9999	! PAST EOF.
	 IF(I.LT.-1) GO TO 51	! BAD READ.
	I=IREADW(256,IBUF(257),IBLK+1,ICHAN)
	 IF(I.EQ.-1) GO TO 9999	! PAST EOF.
	 IF(I.LT.-1) GO TO 51	! BAD READ.

	INDEX=6		! BYTE OFFSET OF 1ST DIRECTORY ENTRY.
C ASSIGN HEADER INFORMATION.
15	NSEG=IBUF(1)	! NUMBER OF DIRECTORY SEGMENTS (2 BLOCKS EACH).
	NXTSEG=IBUF(2)	! NEXT SEGMENT NUMBER. 0 -> THIS IS LAST ONE.
	NHISEG=IBUF(3)	! HIGHEST SEGMENT IN USE.
	NEXTRA=IBUF(4)	! # EXTRA BYTES USED IN EACH DIR ENTRY (USER DEFINED).
	IBK1ST=IBUF(5)	! STARTING BLK # OF DATA MONITORED BY THIS SEGMENT.

	MUL=NEXTRA+7	! LENGTH OF EACH DIRECTORY ENTRY.

C IF TERMINATION OF SEGMENT, GO TO 55.
16	IF(IBUF(INDEX).EQ."4000) GO TO 55

C IF NON-PERMANENT ENTRY, GO TO 50.
	IF(IBUF(INDEX).NE."2000.AND.IBUF(INDEX).NE."102000) GO TO 50

C PERMANENT ENTRY.
C COMPARE DESIRED TO FOUND FILE NAMES.

C IF FILE NAMES NOT THE SAME, GO TO 50.

	I=NAMCMP(PASSIN(1),IBUF(INDEX+1),6)	! CHECK FILE NAME.
	J=NAMCMP(PASSIN(3),IBUF(INDEX+3),3)	! CHECK EXTENT.
	IF(I.EQ.0.OR.J.EQ.0) GO TO 50	! IF EITHER DOESN'T COMPARE, GO TO 50.

C FILE FOUND.

19	PASOUT(1)=IBUF(INDEX+1)	! RETURN FILE NAME.
	PASOUT(2)=IBUF(INDEX+2)
	PASOUT(3)=IBUF(INDEX+3)

	PASOUT(4)=IBUF(INDEX+4)	! RETURN NUMBER OF BLOCKS.

	PASOUT(6)=IBUF(INDEX+5)	! RETURN TIME (TSX+ CREATED FILES ONLY).
	PASOUT(5)=IBUF(INDEX+6)	! RETURN DATE.

C ARE MORE ENTRIES IN DIRECTORY.
47	MORE=1			! 'MORE IN DIRECTORY' FLAG.
	INDEX=INDEX+MUL		! POINT INDEX TO NEXT DIRECTORY ENTRY.
	GO TO 400

C TRY NEXT DIRECTORY ENTRY.
50	INDEX=INDEX+MUL		! POINT INDEX TO NEXT DIRECTORY ENTRY.

	IF(INDEX.LE.512) GO TO 16 ! IF NOT AT BLOCK END, GO TO 16.

C NEW DIRECTORY SEGMENT NEED.
55	IBLK=NXTSEG*2+4		! CALCULATE BLOCK # OF NEXT DIRECTORY SEGMENT.

	IF(NXTSEG.EQ.0) GO TO 60 ! IF NO MORE SEGMENTS, GO TO 60.

	GO TO 10		! ELSE GET NEXT DIRECTORY SEGMENT.

57	MORE=-1			! NOT RT-11 VOLUME.
	GO TO 65

C END OF DIRECTORY FOUND.
60	MORE=0			! 'NO MORE IN DIR.' FLAG. (FILE NOT FOUND).

65	CALL CLOSEC(ICHAN)	! CLOSE CHANNEL.
	CALL IFREEC(ICHAN)	! FREE IT FOR OTHER USE.

400	RETURN

C ERROR PRINTOUT AREA.
51	TYPE 101,I
101	FORMAT(1X,I7,'BAD READ')
	STOP

9999	STOP 'INVALID BLOCK, PAST END OF FILE'

500	TYPE 100,I
100	FORMAT(1X,I7)
	STOP 'BAD LOOKUP'

	END
