C define(VAX) C location of system-wide "SYMBOLS." file C maximum field for integer strings C must be highest lu for standard files C C C C BURSTF Fortran program unit burster C =================================== C C C Author: William Wood C Computer Center C Institute For Cancer Research C 7701 Burholme Ave. C Philadelphia, Pa. 19111 C (215) 728 2760 C C Version: 2.0 C C Date: December 18, 1981 C C C 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 BYTE FILE(34), BUF(134), WHITE(3), TEMP(134), FILOUT(134), DIGSCN( *13), ENDNAM(4), TEMP2(134) BYTE CUPPER INTEGER NC, SOURCE, N, F, FTMP, I, J, NFILE, NFILEB, NCOMNT, FOUT INTEGER SEARCH, GARG, SCAN, LENGTH, OPENC, GETLIN, BKSCAN DATA WHITE/' ', 9, 0/ DATA DIGSCN/' ', 9, '1', '2', '3', '4', '5', '6', '7', '8', '9', ' *0', 0/ DATA ENDNAM/' ', '(', 9, 0/ CALL INITR4 FTMP = OPENC('BURSTF.TMP', 'W') IF (.NOT.(FTMP .EQ. -1)) GOTO 2000 CALL ENDR4 2000 CONTINUE NFILE = 1 NFILEB = 1 2020 CONTINUE N = 0 IF (.NOT.(GARG('BURSTF> ', N, FILE, 134) .EQ. -10)) GOTO 2050 GOTO 2040 2050 CONTINUE CALL DEFNAM(FILE, 0, 0, 0, 0, '.FTN', .FALSE.) F = OPENC(FILE, 'R') IF (.NOT.(F .EQ. -1)) GOTO 2070 GOTO 2030 2070 CONTINUE 2090 CONTINUE NCOMNT = 0 2120 IF (.NOT.(GETLIN(BUF,F) .NE. -10)) GOTO 2140 IF (.NOT.(CUPPER(BUF(1)) .EQ. 'C')) GOTO 2150 CALL PUTLIN(BUF, FTMP) GOTO 2160 2150 CONTINUE IF (.NOT.(BUF(SCAN(BUF, WHITE, 1)) .EQ. 10)) GOTO 2170 CALL PUTLIN(BUF, FTMP) GOTO 2160 2170 CONTINUE GOTO 2140 2160 CONTINUE 2130 NCOMNT = NCOMNT + 1 GOTO 2120 2140 CONTINUE IF (.NOT.(BUF(1) .NE. -10)) GOTO 2190 I = 0 CALL SCOPY(BUF, 1, TEMP2, 1) C delete NEWLINE, ignore BUF(MIN(72 + 1, LENGTH(BUF))) = 0 C stuff past MAXCOLUMN for now CALL UPPER(BUF) IF (.NOT.(SEARCH(BUF, 'FUNCTION') .NE. 0)) GOTO 2210 I = SCAN(BUF, WHITE, SEARCH(BUF, 'FUNCTION') + LENGTH('FUN *CTION')) GOTO 2220 2210 CONTINUE IF (.NOT.(SEARCH(BUF, 'SUBROUTINE') .NE. 0)) GOTO 2230 I = SCAN(BUF, WHITE, SEARCH(BUF, 'SUBROUTINE') + LENGTH('S *UBROUTINE')) GOTO 2220 2230 CONTINUE IF (.NOT.(SEARCH(BUF, 'PROGRAM') .NE. 0)) GOTO 2250 I = SCAN(BUF, WHITE, SEARCH(BUF, 'PROGRAM') + LENGTH('PROG *RAM')) GOTO 2220 2250 CONTINUE IF (.NOT.(SEARCH(BUF, 'BLOCK DATA') .NE. 0)) GOTO 2270 I = SCAN(BUF, WHITE, SEARCH(BUF, 'BLOCK DATA') + LENGTH('B *LOCK DATA')) 2270 CONTINUE 2220 CONTINUE IF (.NOT.(I .EQ. 0)) GOTO 2290 CALL SCOPY('MAIN', 1, FILOUT, 1) CALL ITOC(NFILE, TEMP, 134) NFILE = NFILE + 1 CALL CONCAT(FILOUT, TEMP, 34) GOTO 2300 2290 CONTINUE CALL SCOPY(BUF, I, FILOUT, 1) FILOUT(BKSCAN(FILOUT, ENDNAM, 1)) = 0 IF (.NOT.(LENGTH(FILOUT) .EQ. 0)) GOTO 2310 CALL SCOPY('BLOCK', 1, FILOUT, 1) CALL ITOC(NFILEB, TEMP, 134) NFILEB = NFILEB + 1 CALL CONCAT(FILOUT, TEMP, 34) 2310 CONTINUE 2300 CONTINUE GOTO 2200 2190 CONTINUE IF (.NOT.(NCOMNT .GT. 0)) GOTO 2330 CALL SCOPY('MAIN', 1, FILOUT, 1) CALL ITOC(NFILE, TEMP, 134) NFILE = NFILE + 1 CALL CONCAT(FILOUT, TEMP, 34) GOTO 2200 2330 CONTINUE GOTO 2110 2200 CONTINUE CALL CONCAT(FILOUT, '.FTN', 34) FOUT = OPENC(FILOUT, 'W') IF (.NOT.(FOUT .EQ. -1)) GOTO 2350 GOTO 2040 2350 CONTINUE CALL OUTLIN(FILOUT, 2) IF (.NOT.(NCOMNT .GT. 0)) GOTO 2370 REWIND FTMP 2390 IF (.NOT.(GETLIN(TEMP, FTMP) .NE. -10)) GOTO 2400 CALL PUTLIN(TEMP, FOUT) GOTO 2390 2400 CONTINUE REWIND FTMP 2370 CONTINUE IF (.NOT.(BUF(1) .NE. -10)) GOTO 2410 CALL PUTLIN(TEMP2, FOUT) 2430 CONTINUE IF (.NOT.(GETLIN(BUF, F) .EQ. -10)) GOTO 2460 GOTO 2450 2460 CONTINUE CALL PUTLIN(BUF, FOUT) I = SCAN(BUF, DIGSCN, 1) IF (.NOT.(CUPPER(BUF(I)) .EQ. 'E' .AND. CUPPER(BUF(I+1)) . *EQ. 'N' .AND. CUPPER(BUF(I+2)) .EQ. 'D')) GOTO 2480 J = SCAN(BUF, WHITE, I + 3) IF (.NOT.(J .GT. 72 .OR. BUF(J) .EQ. 10)) GOTO 2500 GOTO 2450 2500 CONTINUE 2480 CONTINUE 2440 GOTO 2430 2450 CONTINUE 2410 CONTINUE CALL CLOSEL(FOUT, 'S') 2100 GOTO 2090 2110 CONTINUE CALL CLOSEL(F, 'S') 2030 GOTO 2020 2040 CONTINUE CALL CLOSEL(FTMP, 'D') CALL ENDR4 END