C ******************************************************* C * * C * THIS SOFTWARE WAS DEVELOPED WITH SUPPORT * C * FROM THE NATIONAL INSTITUTES OF HEALTH: * C * NIH CA06927 * C * NIH CA22780 * C * * C * DIRECT INQUIRIES TO: * C * COMPUTER CENTER * C * THE INSTITUTE FOR CANCER RESEARCH * C * 7701 BURHOLME AVENUE * C * PHILADELPHIA, PENNSYLVANIA 19111 * C * * C * NO WARRANTY OR REPRESENTATION, EXPRESS OR * C * IMPLIED, IS MADE WITH RESPECT TO THE * C * CORRECTNESS, COMPLETENESS, OR USEFULNESS * C * OF THIS SOFTWARE, NOR THAT USE OF THIS * C * SOFTWARE MIGHT NOT INFRINGE PRIVATELY * C * OWNED RIGHTS. * C * * C * NO LIABILITY IS ASSUMED WITH RESPECT TO * C * THE USE OF, OR FOR DAMAGES RESULTING FROM * C * THE USE OF THIS SOFTWARE * C * * C ******************************************************* C * * C * THIS SOFTWARE WAS DESIGNED FOR USE ON A * C * PDP-11/70 OPERATING UNDER IAS V3.0 USING * C * THE FORTRAN-IV PLUS COMPILER. * C * * C ******************************************************* C C C FNDFIL - RETURN FILES SELECTED BY SRD C AUTHOR - BOB STODOLA C C THIS ROUTINE CALLS RUNSYS, WHICH SUBTASKS SRD TO CREATE C A FILE, FNDFIL.TMP, WITH THE FILES SELECTED BY SRD IN IT. C C FNDFIL THEN READS THIS FILE AND RETURNS THE FILE NAMES ONE C AT A TIME. THEN FNDFIL.TMP IS DELETED. C C IF THE FILE FORMAT PRODUCED BY YOUR SRD IS DIFFERENT, THIS C ROUTINE WILL HAVE TO BE MODIFIED. C C SUBROUTINE FNDFIL(LU,INFILE,OUTFIL,INDEX) IMPLICIT INTEGER*2 (A - Z) BYTE INFILE(1),OUTFIL(40),COMBUF(80),LSTFIL(28),BUF(132) EQUIVALENCE (LSTFIL,COMBUF),(BUF,COMBUF(29)) IF (INDEX.GT.0) GO TO 100 NS = 1 CALL MBT('SRD FNDFIL.TMP=',99,COMBUF,NS) NLAST = LOCS(INFILE,1,80,0) NEND = LOCS(INFILE,1,NLAST,'/') NSEMI = LOCS(INFILE,1,NEND,';') NUIC = LOCS(INFILE,1,NSEMI,']') IF (NUIC .EQ. NSEMI) NUIC = LOCS(INFILE,1,NSEMI,':') IF (NUIC .EQ. NSEMI) NUIC = -1 CALL MBT(INFILE,NUIC+1,COMBUF,NS) IF (NEND.LT.NLAST) CALL MBT(INFILE(NEND+1),NLAST-NEND,COMBUF,NS) CALL MBT('/SE:',99,COMBUF,NS) IF (NSEMI-NUIC-1.GT.0) GO TO 98 CALL MBT('*',1,COMBUF,NS) GO TO 99 98 CONTINUE CALL MBT(INFILE(NUIC+2),NSEMI-NUIC-1,COMBUF,NS) 99 CONTINUE IVER = 0 IF (NSEMI.LT.NEND) IVER = GETVER(INFILE(NSEMI+2),NEND-NSEMI-1) CALL RUNSYS(COMBUF,NS-1,IER) IF (IER .LT. 0) GO TO 250 CALL WAITSY CLOSE(UNIT=LU) OPEN (UNIT=LU,NAME='SY:FNDFIL.TMP',DISPOSE='DELETE',TYPE='OLD', 1 ERR=250) LSTFIL(1) = 0 100 CONTINUE CALL GET(LU,BUF,132,NCHAR) IF (NCHAR.LT.1) GO TO 200 IF (BUF(2) .NE. 1H*) GO TO 120 NEN = LOCS(BUF,5,NCHAR,']') NGT = 1 CALL MBT(BUF(5),NEN-3,OUTFIL,NGT) LSTFIL(1) = 0 IF (NGT.GT.14) GO TO 100 DO 110 I=NGT,14 OUTFIL(I) = ' ' 110 CONTINUE GO TO 100 120 CONTINUE NCHAR = LOCS(BUF,14,NCHAR,' ') NCH = 15 CALL MBT(BUF,NCHAR,OUTFIL,NCH) NCHAR = NCH-1 IF (IVER)160,130,150 130 CONTINUE KVER = 1 DO 140 I = 1,28 IF (LSTFIL(I) .EQ. OUTFIL(I)) GO TO 140 LSTFIL(I) = OUTFIL(I) KVER = 0 140 CONTINUE IF (KVER)100,160,100 150 CONTINUE KVER = GETVER(OUTFIL(29),NCHAR-28) IF (IVER.NE.KVER) GO TO 100 160 CONTINUE OUTFIL(NCHAR+1) = 0 INDEX = INDEX+1 RETURN 200 CONTINUE CLOSE (UNIT=LU) 250 CONTINUE INDEX = 0 RETURN END SUBROUTINE MBT(INB,NB,OUB,NO) IMPLICIT INTEGER*2 (A - Z) BYTE INB(1),OUB(1) IP = 0 10 CONTINUE IP = IP+1 IF (IP.GT.NB) RETURN IF (INB(IP).EQ.0) RETURN OUB(NO) = INB(IP) NO = NO+1 GO TO 10 END INTEGER FUNCTION LOCS(BUF,IS,IE,ICH) IMPLICIT INTEGER*2 (A - Z) BYTE BUF(1),ICH L = IS-1 10 CONTINUE IF (L.GE.IE) GO TO 100 IF (BUF(L+1).EQ.ICH) GO TO 100 L = L+1 GO TO 10 100 CONTINUE LOCS = L RETURN END INTEGER FUNCTION GETVER(BUF,NB) IMPLICIT INTEGER*2 (A - Z) BYTE BUF(1) IVER = 0 IP = 0 10 CONTINUE IP = IP+1 IF (IP.GT.NB) GO TO 100 IF (BUF(IP).EQ.1H .OR.BUF(IP).EQ.9) GO TO 10 IF (BUF(IP).EQ.1H*) GO TO 20 IF (BUF(IP).EQ.0) GO TO 100 IF (BUF(IP).LT.48.OR.BUF(IP).GT.55) GO TO 100 L = BUF(IP)-48 IVER = IVER*8+L GO TO 10 20 CONTINUE IVER = -1 100 CONTINUE GETVER = IVER RETURN END