C - - -PROGRAM LINCUR.SEP SEP 0010 C - - - PROGRAM SEPERATES OUT SUBROUTINES IN A FILE SEP 0020 C - - - FOR EASE OF OVERLAYING WITH F10 COMPILER. SEP 0030 C - - - SEP 0040 C - - - PROGRAM WRITTEN BY R. F. KOHM, ALCOHA R & D. SEP 0050 C - - - SEP 0060 C - - -MAKE NEWFILES WITH THE NAME SEP 0070 C - - -LINC.--- WHERE --- IS A NUMBER FROM 100 TO 999 SEP 0080 C - - -THESE ARE NUMBERED SEQUENCTIALLY STARTING WITH 10 SEP 0090 DOUBLE PRECISION WORD SEP 0100 DIMENSION IWORD(2) SEP 0110 EQUIVALENCE (IWORD,WORD) SEP 0120 EQUIVALENCE (IWORD(2),NUM) SEP 0130 DIMENSION N(80),NSUB(30) SEP 0140 EQUIVALENCE (N(1),NSUB(1)) SEP 0150 C - - -DEFINE DATA SEP 0160 DATA IPER/'('/ SEP 0170 DATA IWORD/'LINC.',' '/ SEP 0180 DATA NE,NN,ND/'E','N','D'/ SEP 0190 DATA IC/'C'/ SEP 0200 DATA IBLANK/' '/ SEP 0210 C - - -DEFINE THE LOGICAL UNIT FOR INPUT SEP 0220 C - - -THIS IS ASSUMED DISK SEP 0230 C - - -FLAG FOR DATA READ SEP 0240 IDAT=0 SEP 0250 LUCR=1 SEP 0260 LUOUT=23 SEP 0270 WRITE(5,1999) SEP 0280 1999 FORMAT(' OUTPUT FILE IS LOGICAL UNIT 23') SEP 0290 LUIO=24 SEP 0300 IFLAG=0 SEP 0310 C - - -START LOOP CHECKING FOR ------END SEP 0320 1 DO 900 I=100,999 SEP 0330 ENCODE(5,1001,NUM) I,IBLANK SEP 0340 1001 FORMAT(I3,A2) SEP 0350 IDAT=0 SEP 0360 OPEN(UNIT=LUIO,ACCESS='SEQOUT',FILE=WORD) SEP 0370 ILINE=1 SEP 0380 WRITE(5,2000) WORD SEP 0390 C***** WRITE(LUOUT,2000) WORD SEP 0400 2000 FORMAT(1X,A10,$) SEP 0410 2 READ(LUCR,1000,END=901) N SEP 0420 1000 FORMAT(80A1) SEP 0430 ISPACE=7 SEP 0440 IF(N(1).EQ. IC) GO TO 102 SEP 0450 IF(ILINE.GT.1) GO TO 100 SEP 0460 IF(N(1) .EQ. IC) GO TO 99 SEP 0470 JSTOP=30 SEP 0480 DO 173 M=1,30 SEP 0490 IF(N(M) .NE. IPER) GO TO 173 SEP 0500 ISTOP=M SEP 0510 GO TO 81 SEP 0520 173 CONTINUE SEP 0530 81 ILINE=2 SEP 0540 WRITE(5,2200) ( NSUB(J),J=1,ISTOP) SEP 0550 WRITE(LUOUT,2200) ( NSUB(J),J=1,ISTOP) SEP 0560 WRITE(LUOUT,2300) WORD SEP 0570 2300 FORMAT(' = ', A10) SEP 0580 2200 FORMAT(5X,30A1) SEP 0590 99 ISPACE=10 SEP 0600 100 CONTINUE SEP 0610 IFINDE=0 SEP 0620 ICSTOP=1 SEP 0630 DO 150 IJ=2,80 SEP 0640 IF(N(IJ) .NE. IBLANK) GO TO 140 SEP 0650 GO TO 150 SEP 0660 140 ICSTOP=IJ SEP 0670 IF(IFINDE.NE.0) GO TO 150 SEP 0680 7 IF(N(IJ).NE.NE) GO TO 170 SEP 0690 IFINDE=1 SEP 0700 8 IF(N(IJ+1).EQ.NN) GO TO 9 SEP 0710 IFINDE=1 SEP 0720 GO TO 150 SEP 0730 9 IF(N(IJ+2) .EQ. ND) GO TO 97 SEP 0740 IFINDE=1 SEP 0750 GO TO 150 SEP 0760 97 ISPACE=80 SEP 0770 150 CONTINUE SEP 0780 C - - -------END FOUND SET FLAG FOR END OF A PROGRAM SEP 0790 IF(ISPACE.EQ. 80) IFLAG=1 SEP 0800 170 CONTINUE SEP 0810 102 WRITE(LUIO,1000) N SEP 0820 IF (IFLAG.EQ.0) GO TO 2 SEP 0830 IFLAG=0 SEP 0840 CLOSE(UNIT=LUIO) SEP 0850 900 CONTINUE SEP 0860 901 CLOSE(UNIT=LUIO) SEP 0870 STOP SEP 0880 END SEP 0890