DOUBLE PRECISION WORD
	DIMENSION IWORD(2)
	EQUIVALENCE (IWORD(1),WORD)
	EQUIVALENCE (IWORD(2),NUM)
	DIMENSION N(80),NSUB(30)
	EQUIVALENCE (N(1),NSUB(1))
C - - - PROGRAM TO STRIP OUT SEPERATE PROGRAMS IN A FILE
C - - -
C - - - MAKE NEWFILES WITH THE NAME
C - - - LINC.--- WHERE --- IS A NUMBER FROM 100 TO 999
C - --  THESE ARE NUMBERED SEQUENCTIALLY STARTING WITH 10
C - - - DEFINE DATA
	DATA IPER/'('/
	DATA IWORD/'LINC.',' '/
	DATA NE,NN,ND/'E','N','D'/
	DATA IC/'C'/
	DATA IBLANK/' '/
C - - - DEFINE THE LOGICAL UNIT FOR INPUT
C - - - THIS IS ASSUMED DISK
C - - - FLAG FOR DATA READ
	IDAT=0
	LUCR=1
	LUOUT=23
	WRITE(5,1999)
 1999	FORMAT(' OUTPUT FILE IS LOGICAL UNIT 23')
	LUIO=24
	IFLAG=0
C - - - START LOOP CHECKING FOR ------END
 1	DO 900 I=100,999
	ENCODE(5,1001,NUM) I,IBLANK
 1001	FORMAT(I3,A2)
	IDAT=0
	OPEN(UNIT=LUIO,ACCESS='SEQOUT',FILE=WORD)
	ILINE=1
	WRITE(5,2000) WORD
C*****	WRITE(LUOUT,2000) WORD
 2000	FORMAT(1X,A10,$)
 2	READ(LUCR,1000,END=901) N
 1000	FORMAT(80A1)
	ISPACE=7
	IF(N(1).EQ. IC) GO TO 102
	IF(ILINE.GT.1) GO TO 100
	IF(N(1) .EQ. IC) GO TO 99
	JSTOP=30
	DO 173 M=1,30
	IF(N(M) .NE. IPER) GO TO 173
	ISTOP=M
	GO TO 81
 173	CONTINUE
81	ILINE=2
	WRITE(5,2200) ( NSUB(J),J=1,ISTOP)
	WRITE(LUOUT,2200) ( NSUB(J),J=1,ISTOP)
	WRITE(LUOUT,2300) WORD
 2300	FORMAT(' = ', A10)
 2200	FORMAT(5X,30A1)
 99	ISPACE=10
 100	CONTINUE
	IFINDE=0
	ICSTOP=1
	DO 150 IJ=2,80
	IF(N(IJ) .NE. IBLANK) GO TO 140
	GO TO 150
 140	ICSTOP=IJ
	IF(IFINDE.NE.0) GO TO 150
 7	IF(N(IJ).NE.NE) GO TO 170
	IFINDE=1
 8	IF(N(IJ+1).EQ.NN) GO TO 9
	IFINDE=1
	GO TO 150
 9	IF(N(IJ+2) .EQ. ND) GO TO 97
	IFINDE=1
	GO TO 150
 97	ISPACE=80
 150	CONTINUE
C - - - ------END FOUND SET FLAG FOR END OF A PROGRAM
	IF(ISPACE.EQ. 80) IFLAG=1
 170	CONTINUE
 102	WRITE(LUIO,1000) N
	IF (IFLAG.EQ.0) GO TO 2
	IFLAG=0
	CLOSE(UNIT=LUIO)
 900	CONTINUE
 901	CLOSE(UNIT=LUIO)
	STOP
	END