PROGRAM SPRT
C
C
	LOGICAL*1 NAME(40),CHAR(120),TAB,SPACE,DOTEXT(4),END(3),OPEN
	DATA TAB/'	'/, SPACE/' '/, DOTEXT/'.','F','T','N'/
	DATA END/'E','N','D'/, OPEN/'('/
C
	CALL ASSIGN(1,'TI0:',4)
C
100	WRITE(1,110)
110	FORMAT(/,'$INPUT FILENAME: ')
	READ(1,120,END=5300) NCHRS, (NAME(I), I=1,NCHRS)
120	FORMAT(Q,120A1)
	IF( NCHRS .EQ. 0 ) GO TO 100
C
	CALL ASSIGN(2,NAME,NCHRS)
C
	DO 121 I=1,NCHRS
	IF( NAME(I) .EQ. DOTEXT(1) ) GO TO 122
121	CONTINUE
122	DO 123 J=2,4
123	DOTEXT(J) = NAME( I+J-1 )
C
C - READ IN FIRST LINE.
200	READ(2,120,END=5200) NCHRS, (CHAR(I), I=1,NCHRS)
	ISTART = 13
	IF( CHAR(1) .EQ. TAB ) ISTART = 8
C
C - TRY AND EXTRACT A FILENAME.
	DO 1000 I=ISTART,NCHRS
	IF( CHAR(I) .EQ. SPACE ) GO TO 1100
1000	CONTINUE
	STOP  'FILENAME EXTRACT FAILED'
C
C - COPY OUT FILENAME.
1100	J = 0
	DO 2000 K=I,NCHRS
	IF( CHAR(K) .EQ. OPEN ) GO TO 2100
	J = J+1
2000	NAME(J) = CHAR(K)
C
C - CONSTRUCT FILENAME AND OPEN FILE.
2100	DO 3000 K=J+1,J+4
3000	NAME(K) = DOTEXT(K-J)
	CALL ASSIGN(3,NAME,J+4)
	WRITE(1,3010) (NAME(I), I=1,J+4)
3010	FORMAT(' OUTPUT FILENAME: ',40A1)
C
C - COPY FILE ONTO OUTPUT UNTIL AN "END" CARD IS ENCOUNTERED.
3100	WRITE(3,3110) (CHAR(I), I=1,NCHRS)
3110	FORMAT(120A1)
C
C - READ IN NEXT LINE AND CHECK FOR "END" CARD.
	READ(2,120,END=5100) NCHRS,(CHAR(I), I=1,NCHRS)
	ISTART = 6
	IF( CHAR(1) .EQ. TAB ) ISTART = 1
	DO 4000 I=1,3
	IF( CHAR(ISTART+I) .NE. END(I) ) GO TO 3100
4000	CONTINUE
C
C - CHECK TO MAKE SURE IT'S NOT A VARIABLE NAME.
	IF( ISTART+4 .GE. NCHRS ) GO TO 5100
	DO 5000 I=ISTART+4,NCHRS
	IF( CHAR(I) .NE. SPACE ) GO TO 3100
5000	CONTINUE
5100	WRITE(3,3110) (CHAR(I), I=1,NCHRS)
	CALL CLOSE(3)
	GO TO 200
C
5200	CALL CLOSE(2)
	GO TO 100
C
5300	STOP
	END