C PROGRAM TO SEARCH BIBLIOGRAPY FILES. C IT DOES DOUBLE BUFFERED BLOCK INPUT C AND RECORD IO OUTPUT C USES FORMAT.MAC TO CONVERT FORTRAN FORMAT INTO CRLF C SEAOU.MAC TO CONVERT BACK FOR RECORD OUTPUT C C PROGRAM SEARCH LOGICAL*1 IBUFA(4096),IBUFB(4096),SBUF(70),ICRLF(4),IFF(2) LOGICAL*1 RBUF(70),TBUF(1500),NBUF(70),IANS(10) INTEGER TBUFS COMMON /SEADA/NBUF,SBUF,RBUF,N1,N2,N3,NPAGE,NFND,NPR, 1IFIRST,IEND COMMON /DUMDUM/IREC DATA IBUFA/4096*91/,IBUFB/4096*91/ DATA TBUFS/1500/,IANS/78,79,8*0/ DATA ICRLF/"15,"12,"12,0/,SBUF/70*0/,IFF/12,0/,RBUF/70*0/ NSZ=4096 N1=0 CALL WDFUIC("300,"321) CALL PRINTW(' VERSION 002-A') CALL PRINTW(' TYPE ^Z TO EXIT') 5 CALL PRINTW('$FILE NAME?') CALL GET(N1,NBUF) IF(IOPENR(NBUF,N1,1,'.BIB').LT.0)GOTO 5 10 CALL PRINTW('$SEARCH TERM ') CALL GET(N2,SBUF) CALL PRINTW('$SEARCH RESTRICTION ') IF(RBUF(1).NE.0)CALL PRINTW(0,'(TYPE 0 FOR NO RESTRICTION) ') CALL GET(N3,RBUF) IF(RBUF(1).EQ."60)RBUF(1)=0 15 CALL PRINTW('$SPOOL OUTPUT? Y OR N ') CALL GET(N4,IANS) IF((IANS(1).AND."137).EQ."131)GOTO 25 20 NSPOOL=.FALSE. LUN=2 IF(IROPNW('TI:',3,LUN).LT.0)CALL EXIT GOTO 30 25 NSPOOL=.TRUE. LUN=3 IF(IROPNW(NBUF,N1,LUN,'.DMP').LT.0)CALL EXIT C IF(IROPNW('BIB.DMP',7,LUN).LT.0)CALL EXIT 30 IC=0 IREC=0 NFND=0 NPAGE=0 ITPNT=0 IEND=.FALSE. !NOT AT END OF FILE(EOF) IF(IREAD(IBUFA,NSZ,1).LT.0)GOTO 200 !READ FIRST BLOCK OF DATA 40 I=IWAIT(1) IF(I.LT.0)GOTO 200 !WAIT FOR PREVIOUS READ TO FINISH NA=I !NUMBER OF CHAR READ I=IREAD(IBUFB,NSZ,1) !START NEXT READ GOING IF(I.LT.-1)GOTO 200 !READ ERROR IF(I.LT.0)IEND=.TRUE. !SHOW EOF CALL FORMAT(IC,NA,IBUFA) !CONVERT TO CR/LF FORMAT NS=NA !SAVE BUFFER SIZE CALL SEARCH(NS,IBUFA(1),IFF) !SEARCH FOR FF IF(NS.EQ.0)NS=NA N=NS+ITPNT IF(N.GT.TBUFS)GOTO 190 IRECL=IREC DO 43 I=1,NS !XFER REST OF ITEM TO TEMPORY TBUF(ITPNT+I)=IBUFA(I) !BUFFER 43 CONTINUE N=NS+ITPNT I=1 C SEARCH TEMPORARY BUFFER FOR SEARCH TERM IF(IFNDBF(N,I,TBUF))CALL SEAOU(TBUF(2),N-2,LUN) !OUTPUT ITEM IPNT=NS NS=NA-IPNT C OK START SEARCH OF MAIN BUFFER 50 IF(.NOT.IFNDBF(NS,IPNT,IBUFA))GOTO 60 CALL SEAOU(IBUFA(IPNT+1),NS-2,LUN) IPNT=IPNT+NS NS=NA-IPNT GOTO 50 60 CONTINUE !IFNDBF EXITS POINTING TO LAST FF IF(IEND)GOTO 200 !EXIT IF EOF IFIRST=.FALSE. ITPNT=NS N=NS IRECL=IREC IF(N.GT.TBUFS)GOTO 190 DO 63 I=1,NS !XFER REST OF BUFFER INTO TBUF TBUF(I)=IBUFA(IPNT+I) 63 CONTINUE C C NOW WE DO OUR STUFF ON OTHER BUFFER C I=IWAIT(1) !WAIT FOR LAST READ TO FINISH IF(I.LT.0)GOTO 200 !READ ERROR NB=I !SAVE # OF CHAR READ I=IREAD(IBUFA,NSZ,1) !START NEXT READ IF(I.LT.-1)GOTO 200 !READ ERROR IF(I.LT.0)IEND=.TRUE. !SHOW EOF CALL FORMAT(IC,NB,IBUFB)!CONVERT TO CR/LF NS=NB CALL SEARCH(NS,IBUFB,IFF)!GET LAST PART OF ITEM IF(NS.EQ.0)NS=NB N=NS+ITPNT IF(N.GT.TBUFS)GOTO 190 IRECL=IREC DO 143 I=1,NS !ADD REST OF ITEM TO TBUF TBUF(ITPNT+I)=IBUFB(I) 143 CONTINUE N=NS+ITPNT I=1 IF(IFNDBF(N,I,TBUF))CALL SEAOU(TBUF(2),N-2,LUN) IPNT=NS NS=NB-IPNT 150 IF(.NOT.IFNDBF(NS,IPNT,IBUFB))GOTO 160 CALL SEAOU(IBUFB(IPNT+1),NS-2,LUN) IPNT=IPNT+NS NS=NB-IPNT GOTO 150 160 CONTINUE IF(IEND)GOTO 200 ITPNT=NS N=NS IRECL=IREC IF(N.GT.TBUFS)GOTO 190 DO 163 I=1,NS TBUF(I)=IBUFB(IPNT+I) 163 CONTINUE GOTO 40 190 TYPE 193,IRECL,N-TBUFS 193 FORMAT(' ITEM ',I6,' CONTAINS',I4,' EXTRA CHARACTERS') C 200 IF(NSPOOL)TYPE 201,NFND CALL SEAEN(LUN) !OUTPUT TALLY TO FILE I=ICLOSE(1) IF(NFND.EQ.0)NSPOOL=.FALSE. IF(NSPOOL)I=ISPOOL(LUN) IF(.NOT.NSPOOL)I=ICLOSE(LUN) IF(I.LT.0)CALL PRINTW(' CLOSE ERR') GOTO 5 201 FORMAT(' ',I3,' ITEMS FOUND*****') 300 END SUBROUTINE GET(N,IBUF) BYTE IBUF(2) CALL PRINTW(0,'< ') CALL PRINTW(0,IBUF) CALL PRINTW(0,' >') NOLD=N NSAVE=IBUF(1) READ (5,10,END=100)N,(IBUF(I),I=1,N) 10 FORMAT(Q,70A1) IF(N.NE.0)GOTO 50 N=NOLD IBUF(1)=NSAVE 50 IBUF(N+1)=0 RETURN 100 STOP END FUNCTION IFNDBF(LOC,IPNT,IBUF) C LOC NO. OF LOC'N TO SEARCH C IPNT BUFFER POINTER C IBUF BUFFER TO BE SEARCHED C SBUF BUFFER CONTAINING SEARCH STRING C RBUF BUFFER CONTAINING SEARCH RESTRICTION LOGICAL*1 NBUF(70),IBUF(2),SBUF(70),RBUF(70),IFF(2),ICRLF(4) COMMON /SEADA/NBUF,SBUF,RBUF,N1,N2,N3,NPAGE,NFND,NPR, 1IFIRST,IEND DATA IFF/12,0/,ICRLF/13,10,0,0/ C TYPE 991,LOC,IPNT C991 FORMAT(' IN LOC,IPNT',2I6) IPNTN=IPNT !SAVE BUFFER POINTER LOCN=LOC !SAVE # OF LOC'NS TO SEARCH 10 NS=LOCN CALL SEARCH(NS,IBUF(IPNTN),SBUF) IF(NS.EQ.0)GOTO 100 !NOT FOUND IPNTN=IPNTN+NS !MOVE POINTER TO BEGINNING OF SEARCH STRING LOCN=LOCN-NS !# OF LOC'NS LEFT TO SEARCH IF(RBUF(1).EQ.0)GOTO 20 !GO IF NO SEARCH RESTRICTION NS=-IPNTN CALL SEARCH(NS,IBUF(IPNTN),ICRLF) !GO TO BEGGINING OF LINE IF(NS.NE.0)GOTO 15 12 NS=LOCN !NOT FOUND CALL SEARCH(NS,IBUF(IPNTN),IFF) !GO TO NEXT FF IF(NS.EQ.0)GOTO 100 !END OF BUFFER IPNTN=IPNTN+NS !MOVE POINTER TO FF LOCN=LOCN-NS !REVISE # OF LOC'NS LEFT TO SEARCH GOTO 10 !CONTINUE SEARCHING 15 NM2=IPNTN+NS+2 N=72 CALL SEARCH(N,IBUF(NM2),RBUF) IF(N.EQ.1)GOTO 20 NS=LOCN CALL SEARCH(NS,IBUF(IPNTN),ICRLF) IF(NS.EQ.0)GOTO 100 !END OF BUFFER IPNTN=IPNTN+NS LOCN=LOCN-NS GOTO 10 !TRY AGAIN C 20 NS=-IPNTN CALL SEARCH(NS,IBUF(IPNTN),IFF) !SEARCH FOR STARTING FF IF(NS.EQ.0.AND.IFIRST)NS=-IPNTN IF(NS.EQ.0)GOTO 12 !START OF BUFFER MISSING IPNT=IPNTN+NS NS=LOCN CALL SEARCH(NS,IBUF(IPNTN),IFF) !SEARCH FOR ENDING FF IF(NS.EQ.0.AND.IEND)NS=LOCN IF(NS.EQ.0)GOTO 100 !END OF BUFFER MISSING LOC=IPNTN-IPNT+NS IFNDBF=.TRUE. C TYPE 992,LOC,IPNT C992 FORMAT(' OUT1 LOC,IPNT',2I6) RETURN 100 NS=-LOC IPNTN=IPNT+LOC-1 CALL SEARCH(NS,IBUF(IPNTN),IFF) IF(NS.EQ.0)NS=-LOC IPNT=IPNTN+NS NF=-NS CALL SEARCH(NF,IBUF(IPNT),0) IF(NF.EQ.0)NF=-NS LOC=NF IFNDBF=.FALSE. C TYPE 993,LOC,IPNT C993 FORMAT(' OUT2 LOC,IPNT',2I6) RETURN END