C 
C 
C	This program resequences FORTRAN IV-PLUS programs.
C 
C	Written by Cyndie Folkins April 1978.
C 
C	Keywords must be contained in one line (including the open
C	parentheses in some statements, and the characters ERR= or
C	END= in some).  Statement numbers must be contained in one line.
C 
C	In rare instances Hollerith constants may cause errors, particularly
C	if they are continued on another line.
C 
C	Options:
C 
C		JU -- justification	1 - left justified column 1
C					2 - left justified column 2
C					4 - right justified column 4
C					5 - right justified column 5
C 
C		ST -- start		positive integer
C 
C		IN -- increment		positive integer
C 
C		BL -- blocked           number of blocks (>=1,<=50)
C		      resequencing
C 
C	Error messages are handled by EERR and contained in
C	[1,2]RESEQ.MSG.
C 
	PARAMETER NSW=4,NMO=1,NMI=1,NPRM=9
	BYTE FILEO(40,NMO),FILEI(40,NMI),IPRM(NPRM)
	INTEGER LENFO(NMO),LENFI(NMI)
	INTEGER ISWO(NSW,NMO),ISWDO(NSW,NMO),ISWPO(NSW,NMO)
	INTEGER	ISWVO(NSW,NMO)
	INTEGER ISWI(NSW,NMI),ISWDI(NSW,NMI),ISWPI(NSW,NMI)
	INTEGER ISWVI(NSW,NMI)
	INTEGER*4 LINES,N,NU,N1,BLOCKS,INC
	BYTE IN,IOUT,JIF(3),RR(3),ND(3)
C 
C	IN is current input line.  IOUT is current output line.
C	IPT is pointer to next position to be filled in IOUT.
C	LINES contains the original line numbers.
C	LENG is current expected length of output line.
C	INC is increment for new numbers.  NBL is number of blocks.
C	BLOCKS contains block definitions (old start, new start).
C	ICOU is number of old line numbers (<=1000).
C 
	COMMON/RESBUF/IN(80),IOUT(80),IPT,LINES(1000),LENG,INC,
     &NBL,BLOCKS(100),ICOU
	DATA IPRM/"15,"12,1HR,1HE,1HS,1HE,1HQ,1H>,1H /
	DATA ISWO/2HJU,2HST,2HIN,2HBL/
	DATA ISWDO/3,3,3,3/
	DATA ISWI/NSW*0/
	DATA ISWDI/NSW*0/
	DATA JIF/73,70,40/
	DATA RR/82,82,61/
	DATA ND/78,68,61/
	DATA JUST,INC,NBL,BLOCKS/5,10,1,1,100,98*0/
C 
C	Process input line.  Set options.
C 
10	CALL FCSI(IPRM,NPRM,IER,NSW,NMO,NO,LENFO,FILEO,
     &	ISWO,ISWDO,ISWPO,ISWVO,
     &  NMI,NI,LENFI,FILEI,ISWI,ISWDI,ISWPI,ISWVI)
	IF(IER.EQ.1)GO TO 750
	IF(IER.EQ.0)GO TO 20
	CALL EERR(-1,,0)
20	IF(NO.GT.0.AND.LENFO(1).GT.0)GO TO 30
	CALL EERR(-2,,0)
C 
C	No input file implies same name as output file.
C 
30	IF(NI.GT.0)GO TO 50
	DO 40 I=1,LENFO(1)+1
40	FILEI(I,1)=FILEO(I,1)
50	IF(ISWPO(1,1).EQ.1)JUST=ISWVO(1,1)
	IF(JUST.LT.1.OR.JUST.EQ.3.OR.JUST.GT.5)CALL EERR(-4,JUST,-1)
	IF(ISWPO(3,1).EQ.1)INC=ISWVO(3,1)
	IF(INC.LE.0)CALL EERR(-6,INC,-1)
	IF(ISWPO(4,1).EQ.1)GO TO 60
	IF(ISWPO(2,1).EQ.1)BLOCKS(2)=ISWVO(2,1)
	IF(BLOCKS(2).LE.0)CALL EERR(-5,BLOCKS(2),-1)
	GO TO 110
C		Set up BLOCKS.
60	NBL=ISWVO(4,1)
	IF(NBL.LE.0.OR.NBL.GT.50)CALL EERR(-10,NBL,-1)
	WRITE(5,70)
70	FORMAT(' INPUT OLD START, NEW START ')
	K=1
	DO 100 I=1,NBL
	WRITE(5,80)I
80	FORMAT(' BLOCK ',I4,' : ',$)
	READ(5,*)(BLOCKS(J),J=K,K+1)
	IF(K.GT.1.AND.(BLOCKS(K).LE.BLOCKS(K-2).OR.BLOCKS(K+1).LE.
     &BLOCKS(K-1)))CALL EERR(-13,I,-1)
	DO 90 J=0,1
	IF(BLOCKS(K+J).LE.0)CALL EERR(-13,I,-1)
90	CONTINUE
	K=K+2
100	CONTINUE
C 
C	Unit 1 is used for first pass; unit 2 for second; unit 3 is output.
C 
110	OPEN(UNIT=1,NAME=FILEI(1,1),TYPE='OLD',READONLY,SHARED)
	OPEN(UNIT=2,NAME=FILEI(1,1),TYPE='OLD',READONLY,SHARED)
	OPEN(UNIT=3,NAME=FILEO(1,1),TYPE='NEW',CARRIAGECONTROL='LIST')
C 
C	First pass collects line numbers into LINES.
C 
	IROU=1
	ICOU=1
120	READ(1,130,END=160,ERR=150)IN
130	FORMAT(80A1)
	CALL STRUCT(IBEG,IEND,ITYPE,N)
	IF(N.EQ.0)GO TO 140
	LINES(ICOU)=N
	ICOU=ICOU+1
	IF(ICOU.GT.1000)STOP1111
140	IF(ITYPE.NE.4)GO TO 120
	IROU=IROU+1
	ICOU=ICOU-1
	IF(IROU.EQ.2)GO TO 170
	GO TO 160
150	CALL EERR(-8,,0)
C 
C	Second pass begins.
C 
160	WRITE(3,130)(IOUT(I),I=1,IPT-1)
170	READ(2,130,END=750)IN
	DO 180 I=1,80
180	IOUT(I)=32
	IPT=1
	CALL STRUCT(IBEG,IEND,ITYPE,N)
	IF(IBEG.EQ.0)GO TO 170
190	IF(ITYPE.EQ.2.OR.ITYPE.EQ.3)GO TO 300
	IF(ITYPE.LT.0)GO TO 750
	IF(IN(1).NE.68)GO TO 200
C		Line has D in first column.
	IOUT(1)=68
	IPT=2
200	IF(N.EQ.0)GO TO 240
C		Line has label; replace it.
	CALL GETNUM(N,NU)
	IS=JUST
	IF(JUST.EQ.1.OR.JUST.EQ.2)GO TO 210
	ISUB=LENGTH(NU)-1
	IS=IS-ISUB
210	IF(IS.GE.IPT)GO TO 220
	IS=IPT
220	LENG=0
	CALL PUTNUM(IS,NU,IE)
	IF(IE.LE.6)GO TO 230
	IS=IS+6-IE
	IF(IS.GE.IPT)GO TO 220
	CALL EERR(3,NU,-1)
230	IPT=IE
C		Put tab in output.
240	IOUT(IPT)=9
	IPT=IPT+1
	IF(ITYPE.EQ.4)GO TO 730
	NP=IBEG
	LENG=IPT+IEND-IBEG
C		Check for IF(.
	DO 250 I=1,3
	CALL NEXT(NP,IEND,NP)
	IF(NP.EQ.0)GO TO 260
	IF(IN(NP).NE.JIF(I))GO TO 260
250	NP=NP+1
	GO TO 630
C		Check for assignment statement.
260	IEQ=0
	IQUO=1
	NPAR=0
	DO 270 I=IBEG,IEND
	ICUR=IN(I)
	IF(ICUR.EQ.44.AND.IQUO.GT.0.AND.NPAR.EQ.0)GO TO 280
	IF(ICUR.EQ.39)IQUO=IQUO*-1
	IF(ICUR.EQ.40.AND.IQUO.GT.0)NPAR=NPAR+1
	IF(ICUR.EQ.41.AND.IQUO.GT.0)NPAR=NPAR-1
	IF(ICUR.EQ.61.AND.IQUO.GT.0.AND.NPAR.EQ.0)IEQ=1
270	CONTINUE
	IF(IEQ.EQ.0)GO TO 280
	GO TO 730
C		Find out statement category.
280	CALL STATE(IBEG,IEND,ICAT,KEY)
C		If blank after keyword, get continuation line.
	IF(KEY.NE.0)GO TO 290
	CALL CONT(IBEG,IEND,IBEG,ITYPE,N)
	KEY=IBEG
290	NX=IBEG-1
C 
C	Branch for different categories.
C 
	GO TO (730,340,410,360,540) ICAT+1
C 
C	Comment and continuation statements.
C 
300	IF(N.EQ.0)GO TO 320
C		Remove statement numbers from continuation lines.
	IF(IN(1).NE.68)GO TO 310
	IOUT(1)=68
	IPT=2
310	IOUT(IPT)=9
	IPT=IPT+1
	CALL FILL(IBEG-1,IEND)
	GO TO 160
320	IF(ITYPE.EQ.3)GO TO 330
	CALL TRANS(1,IBEG-1)
330	CALL FILL(IBEG,IEND)
	GO TO 160
C 
C	Category one -- keyword followed by statement number.
C 
340	NX=KEY
350	ICUR=IN(NX)
	IF(ICUR.GT.57.OR.ICUR.LT.48)GO TO 730
	CALL TRANS(IBEG,NX-1)
	CALL NUM(NX,IEND,N1)
	CALL GETNUM(N1,NU)
	CALL PUTNUM(IPT,NU,IPT)
	CALL FILL(NX+1,IEND)
	GO TO 160
C 
C	Category three -- second parameter statement number and
C	possible ERR= or END=.
C 
C		Find comma inside outer parentheses.
360	NPAR=0
	DO 370 J=KEY,IEND
	INI=IN(J)
	IF(NPAR.EQ.1.AND.INI.EQ.44)GO TO 380
	IF(INI.EQ.40)NPAR=NPAR+1
	IF(INI.EQ.41)NPAR=NPAR-1
	IF(NPAR.EQ.0)GO TO 520
370	CONTINUE
	CALL CONT(IBEG,IEND,IBEG,ITYPE,N)
	IF(ITYPE.NE.2)GO TO 190
	KEY=IBEG-1
	GO TO 360
C		If has number, replace.
380	CALL TRANS(IBEG,J)
390	CALL NEXT(J+1,IEND,NX)
	IF(NX.NE.0)GO TO 400
	CALL CONT(J+1,IEND,IBEG,ITYPE,N)
	IF(ITYPE.NE.2)GO TO 190
	J=IBEG-1
	GO TO 390
400	ICUR=IN(NX)
	IF(ICUR.GT.57.OR.ICUR.LT.48)GO TO 530
	CALL NUM(NX,IEND,N1)
	CALL GETNUM(N1,NU)
	CALL PUTNUM(IPT,NU,IPT)
C 
C	Category two -- possible ERR= or END=.
C 
410	IQUO=1
	NPAR=1
C		Look for E or last ).
420	DO 430 I=NX+1,IEND
	ICUR=IN(I)
	IF(ICUR.EQ.39)IQUO=IQUO*-1
	IF(ICUR.EQ.41.AND.IQUO.GT.0)NPAR=NPAR-1
	IF(ICUR.EQ.40.AND.IQUO.GT.0)NPAR=NPAR+1
	IF(NPAR.EQ.0)GO TO 520
	IF(ICUR.EQ.69.AND.IQUO.GT.0)GO TO 450
430	CONTINUE
440	CALL CONT(NX+1,IEND,IBEG,ITYPE,N)
	IF(ITYPE.NE.2)GO TO 190
	NX=IBEG-1
	GO TO 420
450	IS=I+1
C		Check for ERR=.
	DO 460 J=1,3
	CALL NEXT(IS,IEND,NT)
	IF(NT.EQ.0)GO TO 440
	IF(IN(NT).NE.RR(J))GO TO 490
	IS=NT+1
460	CONTINUE
470	CALL NEXT(IS,IEND,NT)
	IF(NT.EQ.0)GO TO 440
C		If has number, replace.
	ICUR=IN(NT)
	IF(ICUR.GT.57.OR.ICUR.LT.48)GO TO 480
	CALL TRANS(NX+1,NT-1)
	CALL NUM(NT,IEND,N1)
	CALL GETNUM(N1,NU)
	CALL PUTNUM(IPT,NU,IPT)
	NX=NT
	GO TO 420
480	CALL TRANS(NX+1,NT)
	NX=NT
	GO TO 420
490	IS=I+1
C		Check for END=.
	DO 500 J=1,3
	CALL NEXT(IS,IEND,NT)
	IF(NT.EQ.0)GO TO 440
	IF(IN(NT).NE.ND(J))GO TO 510
	IS=NT+1
500	CONTINUE
	GO TO 470
510	CALL TRANS(NX+1,NT)
	NX=NT
	GO TO 420
520	CALL FILL(NX+1,IEND)
	GO TO 160
530	CALL TRANS(J+1,NX)
	I=NX
	IF(IN(NX).EQ.69)GO TO 450
	GO TO 410
C 
C	GO TO statements.
C 
540	CALL TRANS(IBEG,KEY-1)
	NX=KEY
	ICUR=IN(NX)
	IF(ICUR.EQ.40)GO TO 580
	IF(ICUR.LT.48.OR.ICUR.GT.57)GO TO 550
C		GO TO number type.
	CALL NUM(NX,IEND,N1)
	CALL GETNUM(N1,NU)
	CALL PUTNUM(IPT,NU,IPT)
	CALL FILL(NX+1,IEND)
	GO TO 160
C		GO TO variable (...) type.
550	NX=NX+1
560	CALL NEXT(NX,IEND,NX)
	IF(NX.EQ.0)GO TO 610
	IF(IN(NX).EQ.40)GO TO 570
	NX=NX+1
	GO TO 560
570	CALL TRANS(KEY,NX-1)
C		Handle (s1,s2,s3,...).
580	CALL NEXT(NX,IEND,NT)
	IF(NT.EQ.0)GO TO 620
	ICUR=IN(NT)
	IF(ICUR.EQ.41)GO TO 600
	IF(ICUR.GE.48.AND.ICUR.LE.57)GO TO 590
	CALL TRANS(NX,NT)
	NX=NT+1
	GO TO 580
590	CALL NUM(NT,IEND,N1)
	CALL GETNUM(N1,NU)
	CALL PUTNUM(IPT,NU,IPT)
	NX=NT+1
	GO TO 580
C		Found ).
600	CALL FILL(NX,IEND)
	GO TO 160
C		Look for continuation of GO TO variable type.
610	CALL CONT(KEY,IEND,IBEG,ITYPE,N)
	IF(ITYPE.NE.2)GO TO 190
	IS=IBEG
	GO TO 560
620	CALL CONT(NX+1,IEND,IBEG,ITYPE,N)
	IF(ITYPE.NE.2)GO TO 190
	NX=IBEG
	GO TO 580
C 
C	IF statements start here.
C 
630	CALL NEXT(NP,IEND,NX)
	IF(NX.EQ.0)GO TO 670
C		Look for last ).  (Hollerith constants and things in quotes
C		do not count.)
640	IQUO=1
	NPAR=1
	IS=NX
650	ICUR=IN(IS)
	IF(ICUR.GE.48.AND.ICUR.LE.57.AND.IQUO.GT.0)GO TO 660
	IF(ICUR.EQ.39)IQUO=IQUO*-1
	IF(ICUR.EQ.40.AND.IQUO.GT.0)NPAR=NPAR+1
	IF(ICUR.EQ.41.AND.IQUO.GT.0)NPAR=NPAR-1
C		NPAR=0 implies found last ).
	IF(NPAR.EQ.0)GO TO 680
	IS=IS+1
	IF(IS.GT.IEND)GO TO 670
	GO TO 650
C		Handles Hollerith constants.
660	CALL NUM(IS,IEND,N1)
	IS=IS+1
	IF(IS.GT.IEND)GO TO 670
	IF(IN(IS).NE.72)GO TO 650
	IS=IS+N1+1
	IF(IS.GT.IEND)GO TO 670
	GO TO 650
C		If nothing after IF(, get continuation line.
670	CALL CONT(IBEG,IEND,IBEG,ITYPE,N)
	IF(ITYPE.NE.2)GO TO 190
	IS=IBEG
	GO TO 650
C		Got last ).
680	CALL NEXT(IS+1,IEND,NX)
	IF(NX.EQ.0)GO TO 690
C		Output IF(...)
	CALL TRANS(IBEG,NX-1)
	IBEG=NX
C		Logical IF, then reprocess remainder of line.
	ICUR=IN(NX)
	IF(ICUR.LT.48.OR.ICUR.GT.57)GO TO 260
	GO TO 700
690	CALL CONT(IBEG,IEND,IBEG,ITYPE,N)
	IF(ITYPE.NE.2)GO TO 190
	ICUR=IN(IBEG)
	IF(ICUR.LT.48.OR.ICUR.GT.57)GO TO 260
C		Arithmetic IF.
700	NX=IBEG
710	CALL NUM(NX,IEND,N1)
	CALL GETNUM(N1,NU)
	CALL PUTNUM(IPT,NU,IPT)
	CALL NEXT(NX+1,IEND,NT)
	IF(NT.EQ.0)GO TO 720
	CALL NEXT(NT+1,IEND,NT)
	IF(NT.EQ.0)GO TO 720
	CALL TRANS(NX+1,NT-1)
	NX=NT
	GO TO 710
720	CALL FILL(NX+1,IEND)
	GO TO 160
C 
C	Statements with no possible statement numbers.
C 
730	CALL FILL(IBEG,IEND)
C		Return to first pass for next routine if END statement.
740	IF(ITYPE.NE.4)GO TO 160
	ICOU=1
	GO TO 120
C		Close files.
750	CLOSE(UNIT=1)
	CLOSE(UNIT=2)
	CLOSE(UNIT=3)
C		If end of file input, stop, else get next file to reseq.
	IF(IER.EQ.1)GO TO 760
	GO TO 10
760	CONTINUE
	END
	BLOCKDATA
C 
C	Data for error message handling.  See [22,2]EERR.
C 
	PARAMETER NMES=11,NFILE=15
	BYTE PMES,FILE
	COMMON/EERRC1/NPMES,PMES(NMES)
	COMMON/EERRC2/FILE(NFILE)
	DATA NPMES/NMES/
	DATA PMES/1HR,1HE,1HS,1HE,1HQ,1H ,1HE,1HR,1HR,1HO,1HR/
	DATA FILE/1H[,1H1,1H,,1H2,1H],1HR,1HE,1HS,1HE,1HQ,1H.,1HM,
     &	1HS,1HG,0/
	END
	SUBROUTINE CONT(IBEG,IEND,NBEG,ITYPE,N)
C 
C	Transfers remainder of current line and outputs it.  Reads in
C	next line, expected to be continuation.
C 
C	IBEG	(I)	Beginning input IN.
C	IEND	(I/O)	End current line.
C	NBEG	(O)	Beginning output IN.
C	ITYPE	(O)	Type of output IN from STRUCT.
C	N	(O)	Line number of output IN from STRUCT.
C 
	BYTE IN,IOUT
	INTEGER*4 N
	COMMON/RESBUF/IN(80),IOUT(80),IPT
	CALL FILL(IBEG,IEND)
	WRITE(3,10)(IOUT(I),I=1,IPT-1)
	READ(2,10,END=50)IN
10	FORMAT(80A1)
	DO 20 I=1,80
20	IOUT(I)=32
	IPT=1
	CALL STRUCT(NBEG,IEND,ITYPE,N)
	IF(ITYPE.NE.2)RETURN
	IF(N.NE.0)GO TO 30
	CALL TRANS(1,NBEG-1)
	RETURN
30	IF(IN(1).NE.68)GO TO 40
	IOUT(1)=68
	IPT=2
40	IOUT(IPT)=9
	IPT=IPT+1
	RETURN
50	ITYPE=-1
	RETURN
	END
	SUBROUTINE STRUCT(IBEG,IEND,ITYPE,LAB)
C 
C	Finds start of statement (column 7) and end of FORTRAN
C	statement (excludes comments following !).  Classifies
C	as to general type of statement 1=normal
C                                       2=continuation
C                                       3=comment
C                                       4=END
C	and returns statement label if any.
C 
C	IBEG	(O)	Start of current line.
C	IEND	(O)	End of current line.
C	ITYPE	(O)	Type of current line.
C	LAB	(O)	Label of current line. (0 if none.)
C 
	BYTE IN,JEND(3)
	INTEGER*4 LAB
	COMMON/RESBUF/IN(80)
	DATA JEND/69,78,68/
	LAB=0
	IF(IN(1).NE.67)GO TO 30
	ITYPE=3
	IBEG=1
	DO 10 I=80,2,-1
	ICUR=IN(I)
	IF(ICUR.NE.32.AND.ICUR.NE.9)GO TO 20
10	CONTINUE
	I=2
20	IEND=I
	RETURN
30	I=0
40	I=I+1
	IF(I.GT.5)GO TO 50
	ICUR=IN(I)
	IF(ICUR.EQ.32.OR.ICUR.EQ.68)GO TO 40
	IF(ICUR.EQ.9)GO TO 60
	IF(ICUR.GE.48.AND.ICUR.LE.57)GO TO 70
	GO TO 40
50	ICUR=IN(I)
	IF(ICUR.EQ.9)GO TO 60
	IF(ICUR.NE.32.AND.ICUR.NE.48)GO TO 80
	ITYPE=1
	CALL FIND(I,IBEG,IEND)
	GO TO 90
60	I=I+1
	ICUR=IN(I)
	IF(ICUR.GT.48.AND.ICUR.LE.57)GO TO 80
	ITYPE=1
	CALL FIND(I,IBEG,IEND)
	GO TO 90
70	CALL NUM(I,5,LAB)
	GO TO 40
80	I=I+1
	ITYPE=2
	CALL FIND(I,IBEG,IEND)
	RETURN
90	IF (IEND-IBEG.NE.2)RETURN
	DO 100 J=1,3
	I=J+IBEG-1
	IF(IN(I).NE.JEND(J))RETURN
100	CONTINUE
	ITYPE=4
	RETURN
	END
	SUBROUTINE FIND(I,IB,IE)
C 
C	Finds first nonblank, nontab character after I and last nonblank,
C	nontab character prior to an external !.
C 
C	I	(I)	Place to begin searching.
C	IB	(O)	Position of first nonblank, nontab character.
C	IE	(O)	Position of last nonblank, nontab character.
C 
C	If there are no nonblank, nontab characters after I, IB=IE=0.
C 
	BYTE IN
	INTEGER*4 N
	COMMON/RESBUF/IN(80)
	IE=0
	CALL NEXT(I,72,IB)
	IF(IB.EQ.0)RETURN
	IQUO=1
	L=IB
10	ICUR=IN(L)
	IF(ICUR.GE.48.AND.ICUR.LE.57.AND.IQUO.GT.0)GO TO 50
	IF(ICUR.EQ.39)IQUO=IQUO*-1
	IF(ICUR.EQ.33.AND.IQUO.GT.0)GO TO 20
	L=L+1
	IF(L.LT.73)GO TO 10
20	DO 30 K=L-1,J,-1
	ICUR=IN(K)
	IF(ICUR.NE.32.AND.ICUR.NE.9)GO TO 40
30	CONTINUE
	K=J
40	IE=K
	ICUR=IN(IE-1)
	IF(IN(IE).NE.72.OR.ICUR.LT.48.OR.ICUR.GT.57)RETURN
	IE=IE+ICUR-48
	RETURN
50	CALL NUM(L,72,N)
	L=L+1
	IF(L.GT.72)GO TO 20
	IF(IN(L).NE.72)GO TO 10
	L=L+N+1
	IF(IN(L).GT.72)GO TO 20
	GO TO 10
	END
	SUBROUTINE NUM(I,J,N)
C 
C	ASCII to INTEGER*4 conversion.
C 
C	I	(I/O)	Place number begins/ends.
C	J	(I)	Place to stop looking for number
C	N	(O)	Statement label.
C 
	BYTE IN
	INTEGER*4 N
	COMMON/RESBUF/IN(80)
	N=0
	DO 10 K=I,J
	ICUR=IN(K)
	IF(ICUR.LT.48.OR.ICUR.GT.57)GO TO 20
10	N=10*N+ICUR-48
20	I=K-1
	RETURN
	END
	SUBROUTINE NEXT(ISTART,IEND,NX)
C 
C	Finds next nonblank, nontab character beginning at ISTART
C	and looking no further than IEND.
C 
C	ISTART	(I)	Begin search.
C	IEND	(I)	End search.
C	NX	(O)	Position of next nonblank, nontab character.
C 
C	If all characters between ISTART and IEND are blanks or tabs NX=0.
C 
	BYTE IN
	COMMON/RESBUF/IN(80)
	IF(IEND.GE.ISTART)GO TO 10
	NX=0
	RETURN
10	NX=ISTART
20	ICUR=IN(NX)
	IF(ICUR.NE.32.AND.ICUR.NE.9)RETURN
	NX=NX+1
	IF(NX.LE.IEND)GO TO 20
	NX=0
	RETURN
	END
	SUBROUTINE STATE(IBEG,IEND,ICAT,KEY)
C 
C	Looks thru IN from IBEG to IEND for keywords.
C	Assigns appropriate category	0=none of the below
C					1=statement number follows keyword
C					2=possible ERR= or END=
C					3=statement number second parameter
C					  and possible ERR= or END=
C	Returns first nonblank, nontab byte after keyword. (0 if none)
C	(IBEG if ICAT=0)
C 
C	IBEG	(I)	Beginning of current line.
C	IEND	(I)	End of current line.
C	ICAT	(O)	Category of statement.
C	KEY	(O)	First nonblank, nontab character after keyword.
C 
	BYTE IN,IS(81)
	COMMON/RESBUF/IN(80)
	DATA IS/6,65,67,67,69,80,84,1,
     &	6,65,83,83,73,71,78,1,
     &	5,67,76,79,83,69,2,
     &	6,68,69,67,79,68,69,3,
     &	2,68,79,1,
     &	6,69,78,67,79,68,69,3,
     &	4,71,79,84,79,4,
     &	4,79,80,69,78,2,
     &	5,80,82,73,78,84,1,
     &	4,82,69,65,68,5,
     &	4,84,89,80,69,1,
     &	5,87,82,73,84,69,3/
	ICAT=0
	KEY=IBEG
	IPT=1
10	NPT=IBEG
	KON=IS(IPT)+IPT
	IPT=IPT+1
20	IF(IN(NPT).NE.IS(IPT))GO TO 40
	IPT=IPT+1
	NPT=NPT+1
	CALL NEXT(NPT,IEND,NPT)
	IF(IPT.GT.KON)GO TO 30
	IF(NPT.EQ.0)GO TO 40
	GO TO 20
30	ICAT=IS(IPT)
	KEY=NPT
	IF(ICAT.EQ.5)GO TO 50
	RETURN
40	IPT=KON+2
	IF(IPT.GT.81)RETURN
	GO TO 10
50	ICAT=1
	IF(IN(KEY).EQ.40)ICAT=3
	RETURN
	END
	SUBROUTINE GETNUM(N,NU)
C 
C	Finds new line number associated with N.
C 
C	N	(I)	Number to reassign.
C	NU	(O)	New line number.
C 
	INTEGER*4 LINES,N,NU,NSTART,INC,I,BLOCKS,IEND,NBEG,NEND
	BYTE IN,IOUT
	COMMON/RESBUF/IN(80),IOUT(80),IPT,LINES(1000),LENG,INC,
     &NBL,BLOCKS(100),ICOU
	IBL=1
	KBL=2*IBL
10	I=BLOCKS(KBL-1)
	IF(N.GE.I.AND.(N.LT.BLOCKS(KBL+1).OR.IBL.GE.NBL))GO TO 20
	IBL=IBL+1
	KBL=KBL+2
	IF(IBL.LE.NBL)GO TO 10
	CALL EERR(-11,N,-1)
20	LPT=1
	NBEG=I
	NEND=99999
	IF(IBL.LT.NBL)NEND=BLOCKS(KBL+1)
	NU=BLOCKS(KBL)
	IEND=99999
	IF(IBL.LT.NBL)IEND=BLOCKS(KBL+2)
30	IF(LPT.GT.ICOU)CALL EERR(-14,N,-1)
	I=LINES(LPT)
	IF(I.GE.NBEG.AND.I.LT.NEND)GO TO 40
	LPT=LPT+1
	GO TO 30
40	IF(I.EQ.N)GO TO 50
	NU=NU+INC
	IF(NU.GE.IEND)CALL EERR(12,NU,-1)
	LPT=LPT+1
	GO TO 30
50	LENG=LENG+LENGTH(NU)-LENGTH(N)
	RETURN
	END
	FUNCTION LENGTH(N)
C 
C 
C 
	INTEGER*4 N
	LENGTH=1
	IF(N.GT.9)LENGTH=2
	IF(N.GT.99)LENGTH=3
	IF(N.GT.999)LENGTH=4
	IF(N.GT.9999)LENGTH=5
	RETURN
	END
	SUBROUTINE PUTNUM(ISTAR,N,IEND)
C 
C	Puts number into IOUT starting at ISTAR.
C 
C	ISTAR	(I)	Place to start.
C	N	(I)	Number to insert.
C	IEND	(O)	End of number.
C 
	BYTE IN,IOUT
	INTEGER*4 N,NN,SUM,LINES
	COMMON/RESBUF/IN(80),IOUT(80),IPT,LINES(1000),LENG
	IF(N.GT.99999)CALL EERR(7,N,-1)
	IF(LENG.LE.72)GO TO 30
	WRITE(3,10)(IOUT(J),J=1,IPT)
10	FORMAT(80A1)
	DO 20 J=1,5
20	IOUT(J)=32
	IOUT(6)=38
	IOUT(7)=9
	LENG=LENG-IPT+8
	IPT=8
	ISTAR=8
30	NPT=ISTAR
	SUM=0
	I=LENGTH(N)-1
	DO 40 J=I,0,-1
	NN=(N-SUM)/10**J
	SUM=SUM+NN*10**J
	IOUT(NPT)=NN+48
40	NPT=NPT+1
	IEND=NPT
	RETURN
	END
	SUBROUTINE TRANS(ISTAR,IEND)
C 
C	Transfer from input line to output line.
C 
C	ISTAR	(I)	Place to start in IN.
C	IEND	(I)	Place to end in IN.
C 
	BYTE IN,IOUT
	COMMON/RESBUF/IN(80),IOUT(80),IPT
	IF(ISTAR.GT.IEND)RETURN
	MPT=ISTAR
10	IF(IPT.LE.80)GO TO 20
	CALL EERR(9,,0)
	RETURN
20	IOUT(IPT)=IN(MPT)
	IPT=IPT+1
	MPT=MPT+1
	IF(MPT.GT.IEND)RETURN
	GO TO 10
	END
	SUBROUTINE FILL(IB,IE)
C 
C	Transfer from input to output handling ! comments.
C 
C	IB	(I)	Place to start in IN.
C	IE	(I)	End of FORTRAN statement in IN.
C 
	BYTE IN,IOUT
	COMMON/RESBUF/IN(80),IOUT(80),IPT
	CALL TRANS(IB,IE)
	CALL NEXT(IE+1,80,NX)
	IF(NX.EQ.0)RETURN
	IF(IN(NX).NE.33)GO TO 30
	DO 10 I=80,NX,-1
	ICUR=IN(I)
	IF(ICUR.NE.32.AND.ICUR.NE.9)GO TO 20
10	CONTINUE
	I=NX
20	CALL TRANS(IE+1,I)
	RETURN
30	IPT=NX
	CALL TRANS(NX,80)
	RETURN
	END