C PROGRAM TO SEARCH FOR AN INTEGER VALUE IN FILE. C C FILED BY GLENN BEVER--20-FEB-79. C MODIFIED BY GLENN BEVER--20-NOV-81. C NASA DFRF C P.O. BOX 273 C EDWARDS, CA 93523 C C COMPILE AS FOLLOWS: C C .R FORTRA C *BNSRCH=BNSRCH/U C C LINK AS FOLLOWS: C C .R LINK C *BNSRCH=BNSRCH C INTEGER*2 ISPEC(39),JSWI(4,2),IBUF(256) REAL*4 EXT(2) DATA EXT/6RSAVLST,6RDATDAT/ DATA JSWI/'W',3*0,'B',3*0/,IDIF/0/ C C CALL COMMAND STRING INTERPRETER TO GET DEVICE NAMES. C *TT:=DK:FILE.NAM/W:XXXXXX C WHERE FILE.NAM IS A FILE TO BE SEARCHED AND 'XXXXXX' IS THE C OCTAL WORD TO SEARCH FOR. 'NAM' IS 'SAV' BY DEFAULT. C OR C *TT:=DK:FILE.NAM/B:XXXXXX C C WHERE FILE.NAM IS A FILE TO BE SEARCHED AND 'XXXXXX' IS THE C OCTAL BYTE TO SEARCH FOR. 'NAM' IS 'SAV' BY DEFAULT. C 5 IF(ICSI(ISPEC,EXT,,JSWI,2).NE.0) GO TO 5 C ASSIGN LOGICAL UNIT 10 TO 1ST OUTPUT FILE ENTERED. CALL IASIGN(10,ISPEC(1),ISPEC(2),0,0) C GET A CHANNEL NUMBER. ICHAN=IGETC() IF(ICHAN.LT.0) STOP 'NO CHANNEL' C FETCH INPUT DEVICE HANDLER INTO MEMORY. IF(IFETCH(ISPEC(16)).NE.0) STOP 'BAD FETCH' C PERFORM LOOKUP OF INPUT FILE. I=LOOKUP(ICHAN,ISPEC(16)) C IF BAD LOOKUP, GO TO 50. IF(I.LT.0) GO TO 50 C INITIALIZE BLOCK NUMBER OF INPUT FILES. IBLK=0 C INITIALIZE 'COMPARE FOUND' COUNTER. ICNT=0 C READ A BLOCK. 10 I=IREADW(256,IBUF,IBLK,ICHAN) C IF END OF FILE REACHED, END PROGRAM. IF(I.EQ.-1) GO TO 9999 C IF BAD READ, GO TO 51. IF(I.LT.-1) GO TO 51 C INITIALIZE BYTE COUNT. INUM=0 C IF SWITCH NOT 'W', GO TO 30. IF(JSWI(2,1).NE.2) GO TO 30 C SET 'ISRCH' TO VALUE OF SWITCH. ISRCH=JSWI(4,1) C C COMPARE WORDS IN BLOCK. DO 25 J=1,256 IF(IBUF(J).NE.ISRCH) GO TO 25 C BLOCK= OCTAL BLOCK # IN FILE WHERE 'VALUE' FOUND. C BYTE = RELATIVE OCTAL BYTE POSITION IN BLOCK WHERE 'VALUE' FOUND. C VALUE= OCTAL VALUE BEING SEARCHED FOR IN FILE. WRITE(10,109)ICNT,IBLK,INUM,IBUF(J) 109 FORMAT(1X,I4,' BLOCK',O4,' BYTE',O4,' VALUE=',O6) ICNT=ICNT+1 25 INUM=INUM+2 IBLK=IBLK+1 GO TO 10 C C IF SWITCH NOT 'B', STOP. 30 IF(JSWI(2,2).NE.2) STOP 'NO SWITCH' ISRCH=JSWI(4,2) C COMPARE BYTES IN BLOCK. DO 35 J=1,256 IBYTE=IAND(IBUF(J),"377) NUM=INUM C IF COMPARE ON LSB BYTE GOOD, GO TO 37. IF(IBYTE.EQ.ISRCH) GO TO 37 C IF COMPARE ON MSB BYTE NOT GOOD, GO TO 35. IBYTE=IRAM(IBUF(J),8,"377) IF(IBYTE.NE.ISRCH) GO TO 35 NUM=INUM+1 37 WRITE(10,109) ICNT,IBLK,NUM,IBYTE ICNT=ICNT+1 35 INUM=INUM+2 IBLK=IBLK+1 GO TO 10 C 50 WRITE(10,100)I 100 FORMAT(I7) STOP 'BAD LOOKUP' 51 WRITE(10,101)I 101 FORMAT(1X,I7,'BAD READ') 9999 STOP END