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