SUBROUTINE SPFILE(NAMER,NAMEA,IEXT,MODE,TITLE,IRET)
C
	INTEGER NAMER(4)
	BYTE TITLE(1),NAMEA(15)
C
10	IF((MODE.AND."2).NE.0)GO TO 30
C
20	TYPE 500,(TITLE(I),I=1,LEN(TITLE))
500	FORMAT($' WHAT IS THE ',99A1)
	TYPE 510
510	FORMAT('+ FILE NAME ? '$)
	CALL GETSTC(NAMEA,14)
30	CALL GETFIL(NAMER,NAMEA,IEXT,IRET)
	IF(NAMER(1).EQ.0)GO TO 20
	IF(IRET.NE.-4)GO TO 35
40	TYPE 520
520	FORMAT('+THATS AN ILLEGAL FILENAME - PLEASE REPEAT')
	GO TO 20
35	IF(IRET.NE.-3)GO TO 50
	CALL FTRAN(NAMER,NAMEA)
	DO 32,IL=1,15
32	IF(NAMEA(IL).EQ."72)GO TO 33
33	TYPE 515,(NAMEA(I),I=1,IL)
515	FORMAT('+UNRECOGNIZED DEVICE '4A1)
	GO TO 20
50	CALL ASLOOK(NAMER,NAMER,I)
	IF(IRET.EQ.0)NAMER(4)=0
	CALL FTRAN(NAMER,NAMEA)
	IF((MODE.AND."4).EQ.0)RETURN
	IL=LEN(NAMEA)
	IF((MODE.AND."1).NE.0)GO TO 80
C INPUT FILE PROCESSING
	TYPE 530,(NAMEA(I),I=1,IL)
530	FORMAT($' FILE ',14A1)
	IF(IRET.LT.0)GO TO 60
	TYPE 540
540	FORMAT('+ FOUND')
	RETURN
60	IF(IRET.NE.-2)GO TO 70
	TYPE 550
550	FORMAT('+ HAS ZERO BLOCKS')
	GO TO 20
70	TYPE 560
560	FORMAT('+ NOT FOUND')
	GO TO 20
C
80	IF(IRET.LE.0)GO TO 90
	TYPE 530,(NAMEA(I),I=1,IL)
	TYPE 570
570	FORMAT('+ EXISTS - DO YOU WANT TO REPLACE IT ? '$)
	IF(YESCHK(0).NE.0)GO TO 20
90	TYPE 580,(NAMEA(I),I=1,LEN(NAMEA))
580	FORMAT(' OUTPUT FILE IS '16A1)
	RETURN
	END


	SUBROUTINE GETFIL(NAMER,NAMEA,IEXT,IRET)
C
	INTEGER ISPEC(39),JEXT(4),NAMER(4)
	BYTE NAMEA(15)
	DATA JEXT /4*0/,INUL /3R   /
C
	JEXT(1)=IEXT
C
C CALL THE CSI TO PARSE THE STRING
	L=ICSI(ISPEC,JEXT,NAMEA,,0)
	IF(L.EQ.0)GO TO 20
10	IRET=-4
	RETURN
20	DO 30 I=1,4
30	NAMER(I)=ISPEC(I+15)
	M=IFETCH(NAMER(1))
	IRET=-3
	IF(M.EQ.1.OR.M.EQ.3)RETURN
	IF(M.NE.0)STOP 'FETCH ERROR IN GETFIL'
C FIND A FREE CHANNEL
	ICHAN=IGETC(0)
40	I=LOOKUP(ICHAN,NAMER)
	IF(I.EQ.-1.OR.I.LT.-2)STOP 'LOOKUP ERROR IN GETFIL'
	CALL PURGE(ICHAN)
	CALL IFREEC(ICHAN)
C CHECK FOR NON-FILE STRUCTURED LOOKUP
	IRET=I
	IF(I.GT.0)RETURN
	IRET=-1
	IF(I.EQ.-2)RETURN
	CALL IDSTAT(NAMER,ISPEC)
	IRET=0
	IF(I.EQ.0.AND.ISPEC(4).EQ.0)RETURN
	IRET=-2
	IF(NAMER(2).NE.INUL)RETURN
	GO TO 10
	END


	SUBROUTINE FTRAN(NAMER,NAMEA)
C
	INTEGER NAMER(4)
	BYTE NAMEA(15)
C
	CALL R50ASC(3,NAMER,NAMEA)
	CALL R50ASC(6,NAMER(2),NAMEA(5))
	CALL R50ASC(3,NAMER(4),NAMEA(12))
	NAMEA(4)="72
	IF(NAMER(2).NE.0)NAMEA(11)="56
	NAMEA(15)=0
	CALL TRIMS(NAMEA)
	RETURN
	END



	SUBROUTINE SPFILN(NAMER,NAMEA,BASNAM,MODE,TITLE,IRET)
C
	INTEGER NAMER(4),IDUM(1),YESCHK
	BYTE NAMEA(15),TITLE(1),BASNAM(15)
C
	IF((MODE.AND."2).NE.0)GO TO 20
10	TYPE 500,(TITLE(I),I=1,LEN(TITLE))
500	FORMAT($' WHAT IS THE ',99A1)
	TYPE 510
510	FORMAT('+ NUMBER '$)
	CALL GETSTC(NAMEA,4)
20	IRET=-3
	IF(LEN(NAMEA).EQ.0)RETURN
	IRET=-4
	I=1
	CALL ILNUM(NAMEA,IDUM,I)
	IF(I.EQ.0)RETURN
	IRET=-5
	INUM=IDUM(1)
	IF(INUM.LT.0)RETURN
	CALL SCOPY(BASNAM,NAMEA)
C
C ENCODE THE FILE NUMBER
30	ENCODE(4,520,NAMEA(7))INUM
520	FORMAT(I4)
	DO 40 I=7,10
40	IF(NAMEA(I).EQ."40)NAMEA(I)="60
	CALL FCHECK(NAMER,NAMEA,IRET,-1)
	CALL ASLOOK(NAMER,NAMER,I)
	CALL R50ASC(3,NAMER,NAMEA)
	CALL TRIMS(NAMEA)
	IF(IRET.NE.-2)GO TO 50
	TYPE 530,(NAMEA(I),I=1,3)
530	FORMAT(' NO HANDLER FOR ',3A1)
	STOP 'TELL D.S.'
50	IF((MODE.AND."4).EQ.0)RETURN
	IL=LEN(NAMEA)
	IF((MODE.AND."1).NE.0)GO TO 80
C INPUT FILE PROCESSING
	TYPE 540,(NAMEA(I),I=1,IL)
540	FORMAT($' FILE ',14A1)
	IF(IRET.LE.0)GO TO 60
	TYPE 550
550	FORMAT('+ FOUND')
	RETURN
60	IF(IRET.NE.0)GO TO 70
	TYPE 560
560	FORMAT('+ HAS ZERO BLOCKS')
	GO TO 10
70	TYPE 570
570	FORMAT('+ NOT FOUND')
	GO TO 10
C
C OUTPUT FILE PROCESSING
80	IF(IRET.GT.0)GO TO 100
90	TYPE 580,(NAMEA(I),I=1,IL)
580	FORMAT(' OUTPUT FILE IS ',14A1)
	RETURN
100	TYPE 540,(NAMEA(I),I=1,IL)
	TYPE 590
590	FORMAT('+ EXISTS - DO YOU WANT TO REPLACE IT ? '$)
	IF(YESCHK(0).NE.0)GO TO 10
	GO TO 90
	END


	SUBROUTINE FREEFL(NAMER,NAMEA,BASNAM,ICHAN)
C
	INTEGER NAMER(4)
	BYTE NAMEA(15),BASNAM(15)
C
	CALL SCOPY(BASNAM,NAMEA)
	N=1
	IFLAG=0
10	ENCODE(4,500,NAMEA(7))N
500	FORMAT(I4)
	DO 20 I=7,10
20	IF(NAMEA(I).EQ."40)NAMEA(I)="60
	CALL FCHECK(NAMER,NAMEA,IRET,ICHAN)
	CALL ASLOOK(NAMER,NAMER,I)
	CALL R50ASC(3,NAMER,NAMEA)
	CALL TRIMS(NAMEA)
	IF(IRET.NE.-2)GO TO 25
	TYPE 505,(NAMEA(I),I=1,3)
505	FORMAT(' NO HANDLER FOR ',3A1)
	STOP 'TELL D.S.'
25	IF(IFLAG.NE.0)GO TO 40
	IF(IRET.LE.0)GO TO 30
	N=N+10
	GO TO 10
C
30	IF(N.EQ.1)GO TO 50
C THERE IS NO FILE N, BUT THERE IS A FILE N-10, SO THERE MIGHT NOT BE A
C FILE N-10+1
	IFLAG=1
	N=N-9
	GO TO 10
40	IF(IRET.LE.0)GO TO 50
	N=N+1
	GO TO 10
C
50	TYPE 510,(NAMEA(I),I=1,LEN(NAMEA))
510	FORMAT(' OUTPUT FILE IS ',14A1)
	RETURN
C
	END


	SUBROUTINE FCHECK(NAMER,NAMEA,IRET,ICHAN)
C
	INTEGER NAMER(4)
	BYTE NAMEA(15)
C
	CALL IRAD50(3,NAMEA,NAMER)
	CALL IRAD50(6,NAMEA(5),NAMER(2))
	CALL IRAD50(3,NAMEA(12),NAMER(4))
	IRET=-2
	I=IFETCH(NAMER)
	IF(I.EQ.2)STOP 'FETCH ERROR IN FCHECK'
	IF(I.NE.0)RETURN
	I=ICHAN
	IF(I.LT.0)I=IGETC(0)
	IRET=LOOKUP(I,NAMER)
	IF(IRET.GE.0)GO TO 10
	IF(IRET.NE.-2)STOP 'BAD LOOKUP IN FCHECK'
	IRET=-1
10	CALL CLOSEC(I)
	IF(ICHAN.LT.0)CALL IFREEC(I)
	RETURN
	END



	INTEGER FUNCTION YESCHK
C
	BYTE DUM(2)
	CALL GETSTC(DUM,1)
	CALL SCOMP('Y',DUM,YESCHK)
	IF(YESCHK.NE.0)YESCHK=1
	IF(DUM(1).EQ.0)YESCHK=-1
	RETURN
	END


	SUBROUTINE GETSTC(STRING,ILEN)
C
	BYTE LINE(81)
	CALL GTLIN(LINE)
	CALL SCOPY(LINE,STRING,ILEN)
	RETURN
	END


	SUBROUTINE TRIMS(LINE)
C
	BYTE LINE(1)
	I=1
	J=1
10	IF(LINE(I).EQ.0)GO TO 30
C	  REMOVE SPACES AND TABS
	IF(LINE(I).EQ."40.OR.LINE(I).EQ."11)GO TO 20
	LINE(J)=LINE(I)
	J=J+1
20	I=I+1
	GO TO 10
30	DO 40 K=J,I
40	LINE(K)=0
	RETURN
	END



	SUBROUTINE LNUM(LINE,ARAY,N)
C
	BYTE LINE(1),CHAR,FCHAR,LCHAR
	REAL ARAY(10)
C
	NMAX=N
	DO 10 I=1,NMAX
10	ARAY(I)=0.
	IPOS=0
	IFLAG=0
	ILEN=LEN(LINE)
	LCHAR=0
	N=0
C
20	IPOS=IPOS+1
	IF(IPOS.NE.1)LCHAR=CHAR		! PREVIOUS CHARACTER
	IF(IPOS.LE.ILEN)GO TO 30
	IF(IFLAG.EQ.0)RETURN
	GO TO 80
30	CHAR=LINE(IPOS)
	IF(CHAR.LT."60.OR.CHAR.GT."71)GO TO 50
C
C	  CHARACTER IS A NUMERAL
C	  IS A NUMBER IN PROGRESS ?
	IF(IFLAG.EQ.1)GO TO 40
	IPOINT=0
	X=FLOAT(CHAR-"60)
	IFLAG=1
	FCHAR=LCHAR			! REMEMBER PRECEEDING CHARACTER
	GO TO 20
40	X=10.*X+FLOAT(CHAR-"60)
	GO TO 20
50	IF(CHAR.NE."56)GO TO 70
C
C	  CHARACTER IS A DECIMAL POINT
C	  IS A NUMBER IN PROGRESS ?
	IF(IFLAG.EQ.1)GO TO 60
	IFLAG=1
	FCHAR=LCHAR
	X=0.
60	IPOINT=IPOS
	GO TO 20
C
C	  CHARACTER IS NON-NUMERIC
C	  IS A NUMBER IN PROGRESS ?
70	IF(IFLAG.NE.1)GO TO 20
C
C	  WAS THERE A DECIMAL POINT ?
	IFLAG=0
80	IF(IPOINT.EQ.0)GO TO 90
	X=X/(10.**(IPOS-IPOINT-1))
90	IF(FCHAR.EQ."55) X=-X
	ARAY(N+1)=X
	N=N+1
	IF(IFLAG.EQ.1) RETURN
	IF(N.NE.NMAX)GO TO 20
	RETURN
	END


	SUBROUTINE ILNUM(LINE,IRAY,N)
C
	BYTE LINE(1),CHAR,FCHAR,LCHAR
	INTEGER IRAY(1)
C
	NMAX=N
	DO 10 I=1,NMAX
10	IRAY(I)=0
	IPOS=0
	IFLAG=0
	LCHAR=0
	N=0
C
20	IPOS=IPOS+1
	IF(IPOS.NE.1)LCHAR=CHAR        ! PREVIOUS CHARACTER
	CHAR=LINE(IPOS)
	IF(CHAR.NE.0.AND.CHAR.NE."15)GO TO 30
	IF(IFLAG.EQ.0)RETURN
	GO TO 70
30	IF(CHAR.LT."60.OR.CHAR.GT."71)GO TO 60
C
C CHARACTER IS A NUMERAL, IS A NUMBER IN PROGRESS ?
	IF(IFLAG.EQ.1)GO TO 40
	I=CHAR-"60
	IFLAG=1
	FCHAR=LCHAR                    ! REMEMBER PRECEEDING CHARACTER
	GO TO 20
40	IF(I.LT.3276)GO TO 50
	IF(I.NE.3276)GO TO 20
	IF((CHAR-"60).LE.7)GO TO 50
	I=32767
	GO TO 20
50	I=10*I+CHAR-"60
	GO TO 20
C
C CHARACTER IS NON-NUMERIC, IS A NUMBER IN PROGRESS ?
60	IF(IFLAG.NE.1)GO TO 20
	IFLAG=0
70	IF(FCHAR.EQ."55) I=-I
	N=N+1
	IRAY(N)=I
	IF(IFLAG.EQ.1) RETURN
	IF(N.NE.NMAX)GO TO 20
	RETURN
	END


	SUBROUTINE RENAME(ICHAN,OLDNAM,NEWNAM)
C
	INTEGER OLDNAM(4),NEWNAM(4),BLOCK(8)

	DO 10 I=1,4
	BLOCK(I)=OLDNAM(I)
10	BLOCK(I+4)=NEWNAM(I)
	J=ICHAN
	IF(J.LT.0)J=IGETC(0)
	I=IRENAM(J,BLOCK)
	IF(I.EQ.0)GO TO 20
	TYPE 500,I
500	FORMAT('0RENAME FAILED, ERROR='I1)
	STOP
20	IF(ICHAN.LT.0)CALL IFREEC(J)
	RETURN
	END


	SUBROUTINE RFILT(A,B,M,N)
C
	REAL A(1),B(1)
	IF(N.NE.0) GO TO 30
10	DO 20 I=1,M
20	B(I)=A(I)
	RETURN
C
30	IF(N.NE.1) GO TO 50
	TEMP1=.75*A(1)+.25*A(2)
	DO 40 I=2,M-1
	TEMP2=.25*A(I-1)+.5*A(I)+.25*A(I+1)
	A(I-1)=TEMP1
40	TEMP1=TEMP2
	TEMP2=.25*A(M-1)+.75*A(M)
	B(M-1)=TEMP1
	B(M)=TEMP2
	RETURN
C
50	IF(N.NE.2) GO TO 70
	TEMP1=.25*(2.*A(1)+1.5*A(2)+.5*A(3))
	TEMP2=.25*(1.5*A(1)+A(2)+A(3)+.5*A(4))
	DO 60 I=3,M-2
	TEMP3=.25*(.5*A(I-2)+A(I-1)+A(I)+A(I+1)+.5*A(I+2))
	B(I-2)=TEMP1
	TEMP1=TEMP2
60	TEMP2=TEMP3
	TEMP3=.25*(.5*A(M-3)+A(M-2)+A(M-1)+1.5*A(M))
	B(M-3)=TEMP1
	TEMP1=.25*(.5*A(M-2)+1.5*A(M-1)+2.*A(M))
	B(M-2)=TEMP2
	B(M-1)=TEMP3
	B(M)=TEMP1
	RETURN
C
70	TYPE 500,N
500	FORMAT(1X,'UNDEFINED FILTER',I12,'  ZERO FILTER ASSUMED')
	GO TO 10
C
	END


	SUBROUTINE VALDAT
C
	CALL IDATE(I,I1,I1)
	IF(I.NE.0)RETURN
	CALL PUTSTR(7,'PLEASE ENTER THE DATE',' ')
	CALL EXIT
	END