	SUBROUTINE ENC(FBUF,OPTION)
C
C	Encode ASCII to FORTRAN or MACRO format
C
	INTEGER FBUF(39),OPTION(4,6),MAXBLK,MAXTF,LNEMAX
	INTEGER LEVEL,NREPT,OCHAN,OBLK,OBP
	LOGICAL*1 TTIN,TTOUT
	BYTE OBUF
	COMMON /TXTW01/ LEVEL,NREPT(10),OCHAN(10),OBLK(10),OBP(10),
     #	 OBUF(512,10),TTIN,TTOUT

   10	OCHAN(2) = IGETC()
	IF(OCHAN(2) .LT. 0)
     #	 STOP '?TXTWRT-F-ENC  No channel available for input'
	I = 1
	IF(OPTION(2,6) .NE. 0)  I = 16		! /S  ASCII stream file 
	MAXBLK = LOOKUP(OCHAN(2),FBUF(I))
	IF(MAXBLK .GT. 0)  GO TO 20
	IF(MAXBLK .EQ. 0)  STOP
     #	 '?TXTWRT-F-ENC  Input must come from a file structured device'
	GO TO (11,12,13,14) ,-MAXBLK
   11	STOP  '?TXTWRT-F-ENC  Input channel specified is already open'
   12	STOP  '?TXTWRT-F-ENC  Input file not found on input device'
   13	STOP  '?TXTWRT-F-ENC  Input device in use'
   14	STOP  '?TXTWRT-F-ENC  Input tape drive not available'
   20	OCHAN(1) = IGETC()
	IF(OCHAN(1) .LT. 0)
     #	 STOP '?TXTWRT-F-ENC  No channel available for output'
	IF(IENTER(OCHAN(1),FBUF(1),FBUF(5)) .LT. 0)
     #	STOP '?TXTWRT-F-ENC  ENTER failure for output file'
	LEVEL = 1
	OBLK(1) = 0
	OBP(1) = 1
	OBLK(2) = 0
	OBP(2) = 1

	MAXTF = "176	!Highest character value to be represented as text
	IF(OPTION(2,3) .EQ. 2)  MAXTF = OPTION(4,3)	! /L:vvv
	LNEMAX = 72	!Default formatted line length
	IF(OPTION(2,2) .NE. 0)  GO TO 30
	IF(OPTION(2,1) .EQ. 2)  LNEMAX = OPTION(4,1)
	CALL FORTRA(MAXTF,LNEMAX,MAXBLK)		! /F:xxx
	GO TO 40
   30	IF(OPTION(2,2) .EQ. 2)  LNEMAX = OPTION(4,2)
	CALL MACRO(MAXTF,LNEMAX)			! /M:xxx

   40	CALL LBOUTP	!Write out the last block of output file
	CALL CLOSEC(OCHAN(2))	!Close input channel
	CALL CLOSEC(OCHAN(1))	!Close output or Supersede input file
	CALL IFREEC(OCHAN(2))
	CALL IFREEC(OCHAN(1))
	RETURN
	END
	SUBROUTINE MACRO(MAXTF,LNEMAX)
	INTEGER LEVEL,NREPT,OCHAN,OBLK,OBP,LNECNT,MAXTF,LNEMAX
	LOGICAL*1 TTIN,TTOUT,TEXT
	BYTE OBUF,ID(8),PRE(9),CRLF(3),SLASH(2),WKSPC(6),OPANGL
	COMMON /TXTW01/ LEVEL,NREPT(10),OCHAN(10),OBLK(10),OBP(10),
     #	 OBUF(512,10),TTIN,TTOUT
	DATA ID /'T','X','T','W','R','T',':',0/, CRLF /"15,"12,0/
	DATA PRE /"11,'.','A','S','C','I','I',' ',0/
	DATA SLASH /'/',0/, OPANGL /'<'/, WKSPC/6*0/
	IF(LNEMAX .LE. 18)
     #	 STOP 'TXTWRT-F-MACRO Defined line length too short'
	TEXT = .FALSE.
	CALL KPYOUT(ID)
	CALL KPYOUT(PRE)
	KNTLNE = 15
	OBLK(2) = -1
	OBP(2) = 513

   10	IF(OBP(2) .LE. 512)  GO TO 20
	OBLK(2) = OBLK(2) + 1
	I = IREADW(256,OBUF(1,2),OBLK(2),OCHAN(2))
	IF(I .LE. 0)  GO TO 70
	OBP(2) = 1

   20	ICHAR = OBUF(OBP(2),2)
	IF(ICHAR .EQ. 0)  GO TO 75
	IF(ICHAR.LT."40 .OR. ICHAR .EQ. "57 .OR. ICHAR.GT.MAXTF)  GO TO 30
C
C	Text character found
C
	IWP = 5
	J = 1
	WKSPC(5) = ICHAR
	IF(.NOT. TEXT)  GO TO 25
	IF(KNTLNE+1 .LT. LNEMAX)  GO TO 60
	CALL KPYOUT(SLASH)
	KNTLNE = KNTLNE + 1
   25	TEXT = .TRUE.
	IWP = 4
	J = 1
	WKSPC(4) = SLASH(1)
	IF(KNTLNE+2 .LT. LNEMAX)  GO TO 60
	GO TO 50
C
C	Non text character found
C
   30	ENCODE(4,100,WKSPC(2)) ICHAR
  100	FORMAT(O3,'>')
	DO 1000 IWP = 2,4
	IF(WKSPC(IWP) .NE. "40)  GO TO 35
 1000	CONTINUE
   35	IWP = IWP - 1
	J = 6 - IWP
	WKSPC(IWP) = OPANGL
	IF(.NOT. TEXT)  GO TO 40
	TEXT = .FALSE.
	CALL KPYOUT(SLASH)
	KNTLNE = KNTLNE + 1
   40	IF(KNTLNE+J .LE. LNEMAX)  GO TO 60
   50	CALL KPYOUT(CRLF)
	CALL KPYOUT(PRE)
	KNTLNE = 15
   60	CALL KPYOUT(WKSPC(IWP))
	KNTLNE = KNTLNE + J
	OBP(2) = OBP(2) + 1
	GO TO 10

   70	IF(I .NE. -1)  GO TO 95
   75	IF(TEXT)  CALL KPYOUT(SLASH)
	CALL KPYOUT(CRLF)
	RETURN

   95	CALL PRINT('?TXTWRT-F-MACRO READW error from input file')
	IF(I+2) 96,97,98
   96	STOP '	Attempt to read past EOF'
   97	STOP '	Hardware error occurred'
   98	STOP '	Channel not open'
	END
	SUBROUTINE FORTRA(MAXTF,LNEMAX,MAXBLK)
	INTEGER LEVEL,NREPT,OCHAN,OBLK,OBP,LNECNT,MAXTF,LNEMAX,MAXBLK
	INTEGER NCHARS,NVEC,LVNCHR,ERR
	LOGICAL*1 TTIN,TTOUT
	BYTE OBUF,VNAME(7,131),DCLRF(4),CONT(11),TRMNTR(8),NUMB(5)
	BYTE WKSPC(6),NULL,SQUOTE,DQUOTE,COMA
	COMMON /TXTW01/ LEVEL,NREPT(10),OCHAN(10),OBLK(10),OBP(10),
     #	 OBUF(512,10),TTIN,TTOUT
	EQUIVALENCE (VNAME(1,1),OBUF(1,3))
	DATA NULL,DQUOTE,SQUOTE,COMA/0,"42,"47,"54/
	DATA DCLRF/')',"15,"12,0/,CONT /"15,"12,5*' ','#',"11,' ',0/
	DATA TRMNTR/'"','2','0','0','/',"15,"12,0/, WKSPC/6*0/

	IF(LNEMAX .LE. 25)
     #	 STOP '?TXTWRT-F-FORTRA Defined line length too short'

    5	IF(MAXBLK .LE. 0)  STOP '?TXTWRT-F-FORTRA Input file is empty'
	ERR = IREADW(256,OBUF(1,2),MAXBLK-1,OCHAN(2))
	IF(ERR .LT. 0)  GO TO 95
	DO 1000 I = 512,1,-1	!Find first non null char. in last block
	IF(OBUF(I,2) .NE. NULL)  GO TO 10
 1000	CONTINUE
	MAXBLK = MAXBLK - 1
	GO TO 5

   10	NCHARS = (MAXBLK-1) * 512 + I
	NVEC = NCHARS / 254  + 1	!Account for final vector
	LVNCHR = NCHARS - ((NVEC-1)*254)
	I = 3
	IF(NVEC .LT. 100)  I = I + 1
	IF(NVEC .LT. 10)   I = I + 1
	IF(NVEC .EQ. 1)    I = I + 1
	TYPE 100,I
  100	FORMAT(1H ,'Name for the FORTRAN output vectors (maximum of ',
     #	 I1,' characters) =  ',$)
	ACCEPT 200, (VNAME(L,131),L=1,6)
  200	FORMAT(6A1)
	VNAME(I+1,131) = 0
	CALL TRIM(VNAME(1,131))
	K = LEN(VNAME(1,131)) + 6	!Determine length of XXXXXX(255),
	CALL KPYOUT('	BYTE ')
	KNTLNE = 13
	DO 2000 JJ = 1,NVEC
	J = JJ		!Only to avoid a compiler warning
	CALL SCOPY(VNAME(1,131),VNAME(1,J))
	IF(I .EQ. 6)  GO TO 15
	ENCODE(3,300,NUMB) J
  300	FORMAT(I3)
	IF(NUMB(1) .EQ. ' ')  NUMB(1) = '0'
	IF(NUMB(2) .EQ. ' ')  NUMB(2) = '0'
	NUMB(4) = 0	!NULL terminator
	CALL CONCAT(VNAME(1,J),NUMB(I-2),VNAME(1,J))
   15	IF(KNTLNE+K .LE. LNEMAX)  GO TO 20
	CALL KPYOUT(CONT)
	KNTLNE = 9
   20	CALL KPYOUT(VNAME(1,J))
	IF(J .EQ. NVEC)  GO TO 25
	CALL KPYOUT('(255),')
	GO TO 2000
   25	ENCODE(3,300,NUMB(2))  LVNCHR+1
	L = 1
	IF(NUMB(2) .EQ. ' ') L = L + 1
	IF(NUMB(3) .EQ. ' ') L = L + 1
	NUMB(L) = '('
	NUMB(5) = 0	!NULL terminator
	CALL KPYOUT(NUMB(L))
	CALL KPYOUT(DCLRF)
 2000	CONTINUE
	OBLK(2) = -1
	OBP(2) = 513

	L = 17	!Space out vector name for "nice" output appearance
	JJ = 2
	IF(LEN(VNAME(1,1)) .LE. 2)  GO TO 30
	L = 21
	JJ = 6

   30	DO 4000 I = 1,NVEC
	CALL KPYOUT('	DATA ')
	CALL STRPAD(VNAME(1,I),JJ)
	CALL KPYOUT(VNAME(1,I))
	CALL KPYOUT(' /')
	KNTLNE = L
	NCHRS = 254
	IF(I .EQ. NVEC)  NCHRS = LVNCHR
	K = 0
   40	IF(OBP(2) .LE. 512)  GO TO 45
	OBLK(2) = OBLK(2) + 1
	ERR = IREADW(256,OBUF(1,2),OBLK(2),OCHAN(2))
	IF(ERR .LE. 0)  GO TO 95
	OBP(2) = 1

   45	ICHAR = OBUF(OBP(2),2)
	IF(ICHAR .LT. "40 .OR. ICHAR .GT. MAXTF)  GO TO 50
	WKSPC(2) = SQUOTE
	WKSPC(3) = ICHAR
	WKSPC(4) = SQUOTE
	WKSPC(5) = COMA
	IWP = 2
	GO TO 60

   50	ENCODE(4,400,WKSPC(2)) ICHAR
  400	FORMAT(O3,1H,)
	DO 5000 IWP = 2,4
	IF(WKSPC(IWP) .NE. "40)  GO TO 55
 5000	CONTINUE
   55	IWP = IWP - 1
	WKSPC(IWP) = DQUOTE

   60	J = 6 - IWP
	IF(KNTLNE+J .LE. LNEMAX)  GO TO 65
	CALL KPYOUT(CONT)
	KNTLNE = 9
   65	CALL KPYOUT(WKSPC(IWP))
	KNTLNE = KNTLNE + J
	OBP(2) = OBP(2) + 1
	K = K + 1
	IF(K .LT. NCHRS)  GO TO 40
	IF(KNTLNE+5 .LE. LNEMAX)  GO TO 70	!Install "200 terminator
	CALL KPYOUT(CONT)
   70	CALL KPYOUT(TRMNTR)
 4000	CONTINUE
	RETURN


   90	CALL PRINT('?TXTWRT-F-FORTRA  READW error from output file')
	IF(I+2) 96,97,98
   95	CALL PRINT('?TXTWRT-F-FORTRA  READW error from input file')
	IF(I+2) 96,97,98
   96	STOP '	Attempt to read past EOF'
   97	STOP '	Hardware error occurred'
   98	STOP '	Channel not open'
	END
