C PROGRAM TO SEARCH A DEVICE DIRECTORY FOR A REQUESTED FILENAME AND RETURN ITS
C  NAME, # OF BLOCKS, DATE AND DEVICE WHERE DIRECTORY ENTRY WAS FOUND.  THEN
C  THE DEVICE IS SCANNED FOR '*.DEV' FILES (SUBDEVICES) AND THEIR INDIVIDUAL
C  DIRECTORIES ARE SCANNED FOR FILENAME.
C
C THIS PROGRAM ALLOWS A LARGE DISK VOLUME CONTAINING SEVERAL SUBDEVICES TO
C  SCANNED FOR A FILENAME. THE PROGRAM RETURNS THE USUAL DIRECTORY
C  INFORMATION PLUS WHAT DEVICE OR SUBDEVICE THE FILE WAS FOUND ON.
C
C FILED BY GLENN BEVER--14-FEB-83. (HAPPY VALENTINE'S DAY!)
C WILD CARD SEARCHES IMPROVED--5-APR-83, G. BEVER.
C '/V' OPTION ADDED--8-APR-83, G. BEVER.
C 'E:EXT' OPTION ADDED--9-JUL-84, G. BEVER.
C SYSTEM IDENTIFICATION CHECK ADDED--31-0CT-84, G. BEVER.
C RTDIR SUBROUTINE REMOVED AND MADE ANOTHER MODULE--8-MAR-85, G. BEVER.
C CHECK FOR FILE < 6 BLKS LONG MOVED TO PREVENT 'HANG'--19-APR-85, G. BEVER.
C ADD DATE OPTION--22-APR-85, G. BEVER.
C
C          NASA DFRF
C          P.O. BOX 273
C          EDWARDS, CA   93523
C
C COMPILE AS FOLLOWS:
C
C  .FORTRA SDIR
C
C LINK AS FOLLOWS:
C
C  .LINK SDIR,RTDIR,NAMCMP
C
C REQUIRES LINKAGE WITH 'IRAM.OBJ' IF IT HAS NOT BEEN PUT IN 'SYSLIB.OBJ'.
C
C
C CALL COMMAND STRING INTERPRETER TO GET DEVICE NAMES.
C  *TT:=DEV:FILE.NAM
C
C   WHERE 'FILE.NAM' IS THE FILE TO SEARCH THE DIRECTORY FOR.
C	AND 'DEV:' IS THE DISK CONTAINING THE DIRECTORY TO SCAN
C	 FOR 'FILE.NAM' AND SUBDIRECTORIES '*.DEV' TO SCAN FOR 'FILE.NAM'.
C
C  */H
C	WILL PRINT OUT HELP FOR USING THIS PROGRAM.
C
C  *DEV:FILE.NAM
C	WILL DEFAULT LIST TO LOGICAL UNIT 7 (TT:).
C
C*******KNOWN BUGS (IN PROGRAM)**********
C 1) BOTH NAME AND EXTENT FIELD MUST HAVE THEIR OWN WILDCARD.
C	E.G.:
C	*.*			*
C	WIL*.*   INSTEAD OF	WIL*
C	*.*D			*D
C
C*******KNOWN BUGS (IN SUBROUTINE NAMCMP)**********
C 1) REPEATED CHARACTER STRING COMPARE PROBLEM. E.G.:
C	IF '*FER.*' IS ENTERED AND 'BUFFER.COM' IS ENCOUNTERED, IT WILL NOT
C	REPORT IT AS A MATCH.  THE ALGORITHM STARTS COMPARING CHARACTER
C	STRING 'FER' WITH THE 1ST 'F' IN 'BUFFER', HENCE, IT SEES 'FFE'
C	AND NOT 'FER'.
C
C 2) IF 5 CHARACTERS ARE ENTERED AND THE 6TH IS '*', NO MATCH WILL BE
C	REPORTED. E.G.:
C	'BUFFE*.COM' REQUESTED WILL NOT FIND 'BUFFER.COM'.
C
C**************************************************
C    BUG SUMMARY: ALL PERMUTATIONS OF WILDCARD COMPARES DON'T WORK.
C**************************************************
C
	INTEGER*2 JNUM(2)
	INTEGER*2 ISPEC(39),JSWI(4,13)
	INTEGER*2 IVOL(6),IOWN(6),IDUM(6),JDAT(3)
	REAL*4 EXT(2)
	INTEGER*2 PASSIN(3),PASOUT(5),IBUF(512),IBUF1(512),IN(3),
     C		DEVICE(6)
	BYTE NAMDEV(12),NAME(9)
	DATA EXT/6RDEVLST,6RDATDAT/
	DATA JSWI/'H',3*0,'V',3*0,'E',3*0,'A',3*0,
     .            'D',3*0,'D',3*0,'D',3*0,'S',3*0,'S',3*0,'S',3*0,
     .            'B',3*0,'B',3*0,'B',3*0/,IDIF/0/
C NOTE: 'A' & 'S' CURRENTLY UNUSED.
	INUM=0
C CALL COMMAND STRING INTERPRETER TO GET FILE NAMES.
5	IF(ICSI(ISPEC,EXT,,JSWI,13).NE.0) GO TO 5
C ASSIGN LOGICAL UNIT 7 TO 1ST OUTPUT FILE ENTERED.
	CALL IASIGN(7,ISPEC(1),ISPEC(2),0,0)

C IF '/H' SWITCH NOT HIT, GO TO 6.
	IF(JSWI(2,1).EQ.0) GO TO 9

C HELP OUTPUT.
	WRITE(7,105)
105	FORMAT(' */H			PRINTS THIS TEXT.'/
     C	       ' *LP:=DEV:FILE.NAM	SEARCHES "DEV:" & ALL SUBDEVICES'/
     C	       ' 			 ON IT FOR "FILE.NAM."'/
     C	       ' 			 PRINTS ON LP:'/
     C	       ' *FILE.*			SEARCHES FOR "FILE.*". PRINTS ON TT:.'/
     C	       ' *TT:=*.NAM		SEARCHES FOR "*.NAM". PRINTS ON TT:.'/
     C	       ' .RU SDIR *.NAM		SEARCHES FOR "*.NAM" FILES.'/
     C	       ' 			 PRINTS ON TT:.'/
     C	       ' .RU SDIR *.NAM LP:	SEARCHES FOR "*.NAM" FILES.'/
     C	       ' 			 PRINTS ON LP:.'/
     C         ' .RU SDIR DEV:/V	PRINTS OUT VOLUME IDs FOR ALL'/
     C         ' 			 SUBDEVICES ON "DEV:"'/
     C         ' .RU SDIR		SEARCHES "DEV:" & "DEV:*.DSK" '/
     C         ' *DEV:FILE.NAM/E:DSK	 SUBDEVICES FOR "FILE.NAM."'/
     C	       ' .SDIR DEV:FILE.NAM	SEARCHES "DEV:" & ALL SUBDEVICES'/
     C	       '				 ENCOUNTERED ON IT FOR "FILE.NAM"'/
     C	       '				 (RT-11 V5 OR LATER ONLY)')
	WRITE(7,101)
101	FORMAT(' .SDIR *.*/D:22.:APR:85. SEARCHES "DEV:" & ALL SUBDEVICES'
     C      /,'				 FOR ALL FILES ON SPECIFIED DATE'/
     C      ' .SDIR *.*/S:22.:APR:85. SEARCHES "DEV:" & ALL SUBDEVICES'/
     C      '				 FOR ALL FILES ON OR AFTER DATE'/
     C      ' .SDIR *.*/B:22.:APR:85. SEARCHES "DEV:" & ALL SUBDEVICES'/
     C      '				 FOR ALL FILES ON OR BEFORE DATE'/)
	GO TO 5		! CALL COMMAND STRING INTERPRETER AGAIN.
C
9	I=0			! INIT BASE.
	IF(JSWI(2,11).EQ.2) I=11! IF 'B' OPTION ENTERED, ASSIGN BASE.
	IF(JSWI(2,8).EQ.2) I=8	! IF 'S' OPTION ENTERED, ASSIGN BASE.
	IF(JSWI(2,5).EQ.2) I=5	! IF 'D' OPTION ENTERED, ASSIGN BASE.
C
	IF(I.EQ.0) GO TO 11	! IF NOT 'D' OR 'S' OPTION, GO TO 11.
C
	JDAT(3)=JSWI(4,I)	! ASSIGN JDAT THE DATE ENTERED ON '/D' SWITCH.
	JDAT(2)=JSWI(4,I+1)
	JDAT(1)=JSWI(4,I+2)
C
	JDATE=INTDAT(JDAT)! CALL ROUTINE TO CONVERT SWITCH DATE TO INTERNAL DATE.
C
C GET FILE NAME TO SEARCH FOR.
11	PASSIN(1)=ISPEC(17)
	PASSIN(2)=ISPEC(18)
	PASSIN(3)=ISPEC(19)

C NULL OUT FILE NAME SO AS TO OPEN THE DEVICE NON-STRUCTURED.
	ISPEC(17)="000000
	ISPEC(18)="000000
	ISPEC(19)="000000

C SET 'IBK' TO INDICATE 1ST CALL TO 'RTDIR'.
	IBK=0

C SET TO SEARCH DEVICE.
	DEVICE(1)=ISPEC(16)
C SEARCH DEVICE 1ST (BEFORE SEARCHING SUBDEVICES).
	DEVICE(2)="000000
	DEVICE(3)="000000
	DEVICE(4)="000000
C
C CONVERT FOUND DEVICE FILE NAME TO ASCII.
	CALL R50ASC(12,DEVICE,NAMDEV)
C
	GO TO 8

C ASSIGN '*.DEV' TO FILE NAME REQUEST.
7	IN(1)="132500
	IN(2)="000000
	IN(3)="132500
	IF(JSWI(2,3).EQ.2) IN(3)=JSWI(4,3)! IF /E OPTION, ASSIGN IT TO IN(3).
C CALL ROUTINE TO FIND DIRECTORY ENTRY '*.DEV', '*.*' (/A) OR '*.xxx' (/E:xxx).
	CALL RTDIR(ISPEC(16),IN,DEVICE(2),MORE,IBK,IND,IBUF1,ICH,
     C              IVOL,IOWN)

C IF FILE NOT FOUND, GO TO 20.
	IF(MORE.EQ.0) GO TO 20
	IF(DEVICE(5).LT.6) GO TO 7	! IF FILE < 6 BLKS, CAN'T BE SUBDEVICE.
C IF NOT RT-11 VOLUME, IGNORE.
	IF(MORE.EQ.-1) GO TO 7
C CONVERT FOUND DEVICE FILE NAME TO ASCII.
	CALL R50ASC(12,DEVICE,NAMDEV)
C
C CHECK FOR '/V' OPTION.
	IF(JSWI(2,2).EQ.0) GO TO 8	! IF NO /V OPTION, GO TO 8.
C GET VOLID ONLY.
	IBLK=0
	CALL RTDIR(DEVICE,PASSIN,PASOUT,MORE,IBLK,INDEX,IBUF,ICHAN,
     C              IVOL,IOWN)
C
	IF(MORE.EQ.-1) GO TO 7	! IF NOT RT-11 VOLUME, DON'T PRINT.

	WRITE(7,106)(NAMDEV(I),I=1,12),(IVOL(I),I=1,6),(IOWN(I),I=1,6)
106	FORMAT(1X,3A1,':',6A1,'.',3A1,2X,6A2,1X,6A2)
	GO TO 7	! GET NEXT '*.DEV' FILE.
C
C SET 'IBLK' TO INDICATE 1ST CALL TO 'RTDIR'.
8	IBLK=0

C CALL ROUTINE TO FIND DIRECTORY ENTRY OF FILE.NAM.
10	CALL RTDIR(DEVICE,PASSIN,PASOUT,MORE,IBLK,INDEX,IBUF,ICHAN,
     C              IVOL,IOWN)

C IF FILE NOT FOUND, GO TO 7.
	IF(MORE.LE.0) GO TO 7

C CONVERT DATE.
	I=IDATE(PASOUT(5),IDAY,RMON,IYR,JDATE)

	IF(JSWI(2,5).NE.2) GO TO 12	! IF 'D' OPTION NOT ENTERED, GO TO 12.
	IF(I.NE.0) GO TO 10	! IF NO DATE COMPARE, GO TO 10.
	GO TO 14
12	IF(JSWI(2,8).NE.2) GO TO 13	! IF 'S' OPTION NOT ENTERED, GO TO 13.
	IF(I.NE.0.AND.I.NE.1) GO TO 10	! IF NOT ON OR AFTER DATE, GO TO 10.
	GO TO 14
13	IF(JSWI(2,11).NE.2) GO TO 14	! IF 'B' OPTION NOT ENTERED, GO TO 14.
	IF(I.NE.0.AND.I.NE.-1) GO TO 10	! IF NOT ON OR BEFORE DATE, GO TO 10.
C
C CONVERT FILE NAME FROM RAD50 TO ASCII.
14	CALL R50ASC(10,PASOUT,NAME)

C IF FILE DIRECTORY ENTRY HAD NO DATE, GO TO 19.
	IF(IDAY.EQ.0.AND.IYR.EQ.0) GO TO 19

C OUTPUT DIRECTORY INFORMATION TO LOGICAL UNIT 7.
	WRITE(7,103)(NAME(I),I=1,9),PASOUT(4),IDAY,RMON,IYR,
     C	             (NAMDEV(I),I=1,12),(IVOL(I),I=1,6),(IOWN(I),I=1,6)
103	FORMAT(1X,6A1,'.',3A1,I6,2X,I2,'-',A3,'-',I2,5X,
     C	       3A1,':',6A1,'.',3A1,2X,6A2,1X,6A2)

C LOOK FOR MORE IN FILE.
	GO TO 10

C OUTPUT DIRECTORY INFORMATION TO LOGICAL UNIT 7 (NO DATE).
19	WRITE(7,104)(NAME(I),I=1,9),PASOUT(4),
     C	             (NAMDEV(I),I=1,12),(IVOL(I),I=1,6),(IOWN(I),I=1,6)
104	FORMAT(1X,6A1,'.',3A1,I6,2X,9X,5X,
     C	       3A1,':',6A1,'.',3A1,2X,6A2,1X,6A2)

C LOOK FOR MORE IN FILE.
	GO TO 10

C GET NEXT COMMAND.
20	TYPE 110	! PRINT CR,LF.
110	FORMAT(1X,/)
	REWIND 7	! CLEAR OUTPUT BUFFER.
	CALL CLOSE(7)	! RELEASE LU 7 DEFINITION.
	GO TO 5

  	END
	FUNCTION IDATE(IDAT,IDAY,RMON,IYR,JDATE)
C SUBROUTINE TO CONVERT RT-11 INTERNAL TIME FORMAT TO 'DA-MON-YR' FORMAT.
C CALL AS:
C
C	IRET=IDATE(IDAT,IDAY,RMON,IYR,JDATE)
C WHERE:
C I	IDAT=	INTERNAL FORMATTED TIME.
C O	IDAY=	INTEGER DAY (0-31).
C O	RMON=	(REAL) ASCII MONTH ('Jan'-'Dec' or '   ')
C O	IYR=	INTEGER YEAR (0-99).
C I	JDATE=	INTERNAL FORMATTED TIME TO COMPARE WITH.
C
C RETURNS:
C O	IRET=  -1 -> FILE DATE IS BEFORE SPECIFIED FILE DATE.
C		0 -> FILE DATE IS SAME AS SPECIFIED FILE DATE.
C		1 -> FILE DATE IS AFTER SPECIFIED FILE DATE.
C
C I-> INPUT TO SUBROUTINE. O-> OUTPUT (RETURNED) FROM SUBROUTINE.
C
	REAL*4 TABLE(13),RMON
	DATA TABLE/'Jan ','Feb ','Mar ','Apr ','May ','Jun ','Jul','Aug ',
     C		   'Sep ','Oct ','Nov ','Dec ','    '/

	IF(IDAT.NE.0) GO TO 10

C NO DATE FOUND (IDAT=0).
	IDAY=0		! SET DAY TO 00.
	RMON=TABLE(13)	! SET MONTH TO '   '.
	IYR=0		! SET YEAR TO 00.
	RETURN

C DATE FOUND.
10	MON=IRAM(IDAT,10,"17)	! GET MONTH TABLE INDEX.
	RMON=TABLE(MON)		! RE-FORMAT MONTH.
	IDAY=IRAM(IDAT,5,"37)	! RE-FORMAT DAY.
	IYR=IRAM(IDAT,0,"37)+72	! RE-FORMAT YEAR.
C
	IDATE=0				! DATE MATCHES.
	IF(IDAT.EQ.JDATE) IDATE=0	! DATE MATCHES.
C MAKE INTERNAL DATE YR.MON.DA FOR COMPARISON.
	IDAT1=IRAM(IDAT,-10,"76000)
	IDAT1=IOR(IDAT1,IRAM(IDAT,4,"001700))
	IDAT1=IOR(IDAT1,IRAM(IDAT,5,"37))
C
C MAKE INTERNAL DATE YR.MON.DA FOR COMPARISON.
	JDATE1=IRAM(JDATE,-10,"76000)
	JDATE1=IOR(JDATE1,IRAM(JDATE,4,"001700))
	JDATE1=IOR(JDATE1,IRAM(JDATE,5,"37))
C
	IF(IDAT1.LT.JDATE1) IDATE=-1	! DATE IS BEFORE COMPARISON DATE.
	IF(IDAT1.GT.JDATE1) IDATE=1	! DATE IS AFTER COMPARISON DATE.
	RETURN
	END
	FUNCTION INTDAT(JDAT)
C FUNCTION TO CONVERT ICSI SWITCH ENTERED DATE TO INTERNAL FORMAT.
C WHERE:
C I     JDAT=	3 WORD ARRAY (DAY,MON,YR) DATE TO CONVERT TO INTERNAL
C		FORMAT, WHERE:
C		DAY= INTEGER FOR DAY.
C		MON= RAD50 FOR MONTH (3 LETTERS).
C		YR=  LAST 2 DIGITS INTEGER FOR YEAR.
C O	INTDAT=   RETURNED INTERNALLY FORMATTED DATE.
C
	INTEGER*2 JDAT(3),MONTH(12)
	DATA MONTH/3RJAN, 3RFEB, 3RMAR, 3RAPR, 3RMAY, 3RJUN, 3RJUL, 3RAUG,
     .           3RSEP, 3ROCT, 3RNOV, 3RDEC/
C CONVERT JDAT TO INTERNAL FORMAT.
	JDATE=IRAM(JDAT(1),-5,"1740)		!DAY
	JDATE=IOR(JDATE,IAND(JDAT(3)-72,"37))	!YEAR.
	DO 15 I=1,12
	IF(JDAT(2).EQ.MONTH(I)) GO TO 20	! IF YEAR FOUND IN TABLE, GO TO 20.
15	CONTINUE
	STOP 'MONTH NOT FOUND'
20	INTDAT=IOR(JDATE,IRAM(I,-10,"36000))	!MONTH.
	RETURN

      END
�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������