C     ALGORITHM 607, COLLECTED ALGORITHMS FROM ACM.
C     ALGORITHM APPEARED IN ACM-TRANS. MATH. SOFTWARE, VOL.9, NO. 4,
C     DEC., 1983, P. 427-440.
     THIS ACM-CALGO ALGORITHM 607 CONTAINS 18 LOGICAL FILES.  THESE
18 LOGICAL FILES ARE CONTAINED IN ONE PHYSICAL FILE CONSISTING
OF RECORDS OF 80 8-BIT ASCII CHARACTERS, GROUPED INTO BLOCKS
OF 36 RECORDS (2880 CHARACTERS).  EACH LOGICAL FILE AFTER THE
FIRST BEGINS WITH A RECORD CONSISTING OF THE STRING
"=TES FILE=N" WHERE THE QUOTATION MARKS ARE NOT PART OF THE
RECORD, AND N IS A DECIMAL NUMBER FROM 2 TO 18 INCLUSIVE.  BY
RECOGNIZING THIS RECORD, YOUR TEXT EDITOR, OR A TRIVIAL PROGRAM
(NOT PROVIDED HERE) SHOULD BE ABLE TO EXTRACT THE DESIRED
LOGICAL FILE FROM THE PHYSICAL FILE.
     IN ADDTION, A TAPE CONTAINING THE TES, IN THE FORMAT
ACCEPTED AND PRODUCED BY THE TES, IS DISTRIBUTED WITH ALGORITHM
607.  THIS TAPE HAS PHYSICAL BLOCK SIZES OF 180, 3600,...,3600
8-BIT CHARACTERS.  THE RECORDING FORMAT OF THIS TAPE IS DESCRIBED
MORE FULLY IN CHAPTER 2 OF THE DOCUMENT PROVIDED HERE AS LOGICAL
FILE 18 OF THE ALGORITHM DESCRIPTION.  BOTH TAPES (AS DISTRIBUTED)
ARE UNLABELLED AND ARE RECORDED AT 1600 BPI.
THE FILES CONTAIN:
   1:   THIS DESCRIPTION, PREPARED 830826.
   2:   IBM SYSTEM/370 VERSION OF TES
   3:   CDC 6600/7600 VERSION OF TES
   4:   UNIVAC 1100 VERSION OF TES
   5:   DEC VAX USING VMS VERSION OF TES
   6:   HELP FILE FOR DEC VAX USING VMS VERSION
   7:   DEC VAX USING UNIX VERSION OF TES, FORTRAN SUBPROGRAMS
   8:   DEC VAX USING UNIX VERSION OF TES, C PROGRAMS
   9:   DEC PDP10 USING TOPS 10 OR TOPS 20, FORTRAN SUBPROGRAMS
   10:  DEC PDP10 USING TOPS 10 OR TOPS 20, MACRO 10 SUBPROGRAMS
   11:  DEC PDP11 USING RSX11M/V1 VERSION OF TES, FORTRAN SUBPROGRAMS
   12:  DEC PDP11 USING RSX11M/V1 VERSION OF TES, MACRO11 SUBPROGRAMS
   13:  DEC PDP11 USING RSX11M/V1 TASK BUILD AND OVERLAY INSTRUCTIONS
   14:  DATA GENERAL MV/8000 VERSION OF TES
   15:  SPERRY UNIVAC V70 VERSION OF TES.
   16:  TEXT EXCHANGE SYSTEM USER'S GUIDE
   17:  TEXT EXCHANGE SYSTEM DESCRIPTION OF SYSTEM DEPENDENT VARIANTS
   18:  TEXT EXCHANGE SYSTEM PROGRAM DESCRIPTIONS
     THE LAST THREE OF THE ABOVE ARE PRINT FILES WITH FORTRAN STANDARD
 VERTICAL SPACING IN COLUMN 1.  A PERIOD IS PRINTED IN COLUMN 2 ON TWO
 LINES NEAR THE TOP AND BOTTOM OF EACH PAGE.  IF YOU PRINT AT 6 LINES
 PER INCH ON PAPER THAT IS 11 INCHES LONG, AND CUT THROUGH THESE
 PERIODS AND 8.5 INCHES TO THE RIGHT, THE PAGES WILL BE 8.5 X 11 INCHES
 AND THE TEXT WILL HAVE ADEQUATE MARGINS.
     IF YOU HAVE ANY PROBLEMS CALL VAN SNYDER AT 213/354-6271 OR
 DICK HANSON AT 505/844-1715.
     THE DEC PDP11 AND SPERRY UNIVAC V70 VERSIONS OF TES ARE NOT OF THE
 SAME QUALITY AS THE OTHER VERSIONS; THE AUTHORS NO LONGER HAVE ACCESS
 TO THESE MACHINES.  USE THEM AT YOUR OWN RISK.  THEY MAY REQUIRE SOME
 WORK TO BE USABLE.
     ANY VERSION OF THE TES FOR MACHINES NOT ON THE ABOVE LIST CAN BE
 SENT TO SNYDER. CALL SNYDER AT THE ABOVE NUMBER FOR MORE DETAILS.
     THE SPERRY UNIVAC V70 VORTEX OPERATING SYSTEM EXPECTS ASCII
 CHARACTERS TO HAVE THE HIGH-ORDER BIT SET.  THE HIGH-ORDER BIT IS NOT
 SET IN FILE 15.  AFTER UNBLOCKING FILE 15 WITH IOUTIL, RUN THE FOLLOWING
 PROGRAM ON THE OUTPUT TEXT:
 /JOB,HIGHBIT
 /MEM,6
 /FORT,M,L,B
 C     READ AN ASCII TAPE AND INSERT THE HIGH ORDER BIT IN
 C     EVERY BYTE.  DISCARD COMPLETELY BLANK RECORDS WHEN
 C     WRITING THE OUTPUT TAPE.
 C     ONE CARD IS READ USING FORMAT (2I5) TO DEFINE THE
 C     INPUT AND OUTPUT TAPE UNIT NUMBERS.
       INTEGER BLANKS,BUF(40),INTAPE,OUTAPE,SIGNS
       DATA BLANKS /2H  /, SIGNS /Z8080/
 C
       READ (2,10) INTAPE,OUTAPE
 10    FORMAT (2I5)
 20    READ (INTAPE,30,END=50) BUF
 30    FORMAT (40A2)
       J=0
       DO 40 I = 1, 40
       BUF(I)=BUF(I).OR.SIGNS
 40    IF (BUF(I).NE.BLANKS) J=1
       IF (J.NE.0) WRITE (OUTAPE,30) BUF
       GO TO 20
 50    END FILE OUTAPE
       STOP
       END
 /EXEC
    30   31
 /FINI
=TES FILE=2
C     IBM 360/370 MAIN PROGRAM FOR TEXT EXCHANGE PROGRAMS.

C
C     THE FOLLOWING STATEMENT ALLOCATES SPACE FOR TAPE INPUT.
C
      INTEGER IBLOCK(1800)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
C
      NWCBI=45
      READER=5
      PRINTR=6
      CALL EXCH (IBLOCK)
      STOP
      END
      BLOCK DATA
C
C     BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/
      DATA INTEXT /0/, INALT /0/
C
      DATA CHAR1L /1H1/
C                                                        A  U  T  H
      DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1)  /65,85,84,72/
C                                                        C  O  M  M
      DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2)  /67,79,77,77/
C                                                        C  O  P  Y
      DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3)  /67,79,80,89/
C                                                        D  A  T  A
      DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4)  /68,65,84,65/
C                                                        D  A  T  E
      DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5)  /68,65,84,69/
C                                                        G  R  O  U
      DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6)  /71,82,79,85/
C                                                        I  N  D  E
      DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7)  /73,78,68,69/
C                                                        I  N  P  U
      DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8)  /73,78,80,85/
C                                                        N  A  M  E
      DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9)  /78,65,77,69/
C                                                        I  N  T  A
      DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/
C                                                        K  E  Y  W
      DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/
C                                                        L  I  M  I
      DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/
C                                                        M  A  C  H
      DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/
C                                                        O  P  T  I
      DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/
C                                                        O  R  I  G
      DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/
C                                                        O  U  T  A
      DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/
C                                                        O  U  T  P
      DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/
C                                                        P  R  E  D
      DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/
C                                                        P  R  I  N
      DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/
C                                                        Q  U  I  T
      DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/
C                                                        R  E  A  D
      DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/
C                                                        R  E  F  E
      DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/
C                                                        R  E  M  O
      DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/
C                                                        R  E  W  I
      DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/
C                                                        S  I  T  E
      DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/
C                                                        S  K  I  P
      DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/
C                                                        T  E  X  T
      DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/
C                                                        T  I  T  L
      DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/
C                                                        U  P  D  A
      DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/
C                                                        W  O  R  K
      DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/
C                                                        C  O  N  T
      DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/
C                                                        I  D  E  N
      DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/
C                                                        I  N  C  L
      DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/
C                                                        S  I  G  N
      DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/
C                                                        M  A  R  G
      DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/
      DATA IDSTEP /0/, IDTXTL /0/
      DATA INDEX /0/
      DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/
      DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/
      DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/
      DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/
      DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/
      DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/
      DATA INDEXS(25),INDEXS(26)                       /0,0    /
      DATA INTOPN /0/
      DATA ITYPEI /0/
      DATA LIMIT /0/
      DATA MARGIN /180/
      DATA NCCBI /180/
      DATA NCCBO /180/
      DATA NCHCMD /0/
      DATA NCHMAX /180/
      DATA NCOMDP /35/
      DATA NCOMDT /35/
      DATA NDATAO /3591/
      DATA NERRCO /0/
      DATA NERRG /0/
      DATA NRWORK /0/
      DATA OUTOPN /0/
      DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/
      DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/
      DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/
      DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/
      DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/
      DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/
      DATA OPTVAL(25),OPTVAL(26)                       /0,0    /
      DATA PHASE /1/
C     INDICATE THAT NO PREDICATES ARE DEFINED.
      DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/
      DATA PRED(1,6),PRED(1,7),PRED(1,8)                     /0,0,0    /
      DATA SITE(1) /0/
      DATA TITLE(1) /32/
C     32 = ASCII BLANK
      DATA TODAY (1) /0/
      DATA TRANS /1/
C
C     TRANSLATION TABLE FROM ASCII TO HOLLERITH.  USES ASCII GRAPHICS.
C     TRANSLATES CONTROL CHARACTERS (<32) TO '$'.
C     MAY NOT BE EXACTLY CORRECT FOR ALL MACHINES.
C
      DATA XLATE(1),  XLATE(2),  XLATE(3),  XLATE(4)  /1H$,1H$,1H$,1H$/
      DATA XLATE(5),  XLATE(6),  XLATE(7),  XLATE(8)  /1H$,1H$,1H$,1H$/
      DATA XLATE(9),  XLATE(10), XLATE(11), XLATE(12) /1H$,1H$,1H$,1H$/
      DATA XLATE(13), XLATE(14), XLATE(15), XLATE(16) /1H$,1H$,1H$,1H$/
      DATA XLATE(17), XLATE(18), XLATE(19), XLATE(20) /1H$,1H$,1H$,1H$/
      DATA XLATE(21), XLATE(22), XLATE(23), XLATE(24) /1H$,1H$,1H$,1H$/
      DATA XLATE(25), XLATE(26), XLATE(27), XLATE(28) /1H$,1H$,1H$,1H$/
      DATA XLATE(29), XLATE(30), XLATE(31), XLATE(32) /1H$,1H$,1H$,1H$/
      DATA XLATE(33), XLATE(34), XLATE(35), XLATE(36) /1H ,1H!,1H",1H#/
      DATA XLATE(37), XLATE(38), XLATE(39), XLATE(40) /1H$,1H%,1H&,1H'/
      DATA XLATE(41), XLATE(42), XLATE(43), XLATE(44) /1H(,1H),1H*,1H+/
      DATA XLATE(45), XLATE(46), XLATE(47), XLATE(48) /1H,,1H-,1H.,1H//
      DATA XLATE(49), XLATE(50), XLATE(51), XLATE(52) /1H0,1H1,1H2,1H3/
      DATA XLATE(53), XLATE(54), XLATE(55), XLATE(56) /1H4,1H5,1H6,1H7/
      DATA XLATE(57), XLATE(58), XLATE(59), XLATE(60) /1H8,1H9,1H:,1H;/
      DATA XLATE(61), XLATE(62), XLATE(63), XLATE(64) /1H<,1H=,1H>,1H?/
      DATA XLATE(65), XLATE(66), XLATE(67), XLATE(68) /1H@,1HA,1HB,1HC/
      DATA XLATE(69), XLATE(70), XLATE(71), XLATE(72) /1HD,1HE,1HF,1HG/
      DATA XLATE(73), XLATE(74), XLATE(75), XLATE(76) /1HH,1HI,1HJ,1HK/
      DATA XLATE(77), XLATE(78), XLATE(79), XLATE(80) /1HL,1HM,1HN,1HO/
      DATA XLATE(81), XLATE(82), XLATE(83), XLATE(84) /1HP,1HQ,1HR,1HS/
      DATA XLATE(85), XLATE(86), XLATE(87), XLATE(88) /1HT,1HU,1HV,1HW/
      DATA XLATE(89), XLATE(90), XLATE(91), XLATE(92) /1HX,1HY,1HZ,1H[/
      DATA XLATE(93), XLATE(94), XLATE(95), XLATE(96) /1H\,1H],1H^,1H_/
      DATA XLATE(97), XLATE(98), XLATE(99), XLATE(100)/1H`,1Ha,1Hb,1Hc/
      DATA XLATE(101),XLATE(102),XLATE(103),XLATE(104)/1Hd,1He,1Hf,1Hg/
      DATA XLATE(105),XLATE(106),XLATE(107),XLATE(108)/1Hh,1Hi,1Hj,1Hk/
      DATA XLATE(109),XLATE(110),XLATE(111),XLATE(112)/1Hl,1Hm,1Hn,1Ho/
      DATA XLATE(113),XLATE(114),XLATE(115),XLATE(116)/1Hp,1Hq,1Hr,1Hs/
      DATA XLATE(117),XLATE(118),XLATE(119),XLATE(120)/1Ht,1Hu,1Hv,1Hw/
      DATA XLATE(121),XLATE(122),XLATE(123),XLATE(124)/1Hx,1Hy,1Hz,1H{/
      DATA XLATE(125),XLATE(126),XLATE(127),XLATE(128)/1H|,1H},1H~,1H$/
      END
      SUBROUTINE EXCH (IBLOCK)
C
C     IBM 360/370 INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM
C

      INTEGER IBLOCK(1)
C
C     ALLOCATE SPACE FOR TAPE OUTPUT
C
      INTEGER OBLOCK(900)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      NWCBO=45
      WORKF=8
      MARGIN=72
      CALL EXCHTR (IBLOCK,OBLOCK)
      RETURN
      END
      SUBROUTINE EXCHIM
C
C     READ A COMMAND OR TEXT IMAGE FROM  1.  ALTERNATE CORRECTION FILE,
C                                        2.  TEXT FILE,
C                                        3.  INPUT FILE,
C                                        4.  SYSTEM READER.
C     PUT THE HOLLERITH COMMAND IN HOLCMD,
C     PUT THE ASCII EQUIVALENT IN COMAND,
C     PUT THE NUMBER OF CHARACTERS IN NCHCMD.
C     IF A SYSTEM END-OF-FILE IS SENSED, SET NCHCMD=-1.
C
C     THIS IS AN IBM 360/370 VERSION.  IT READS 80 CHAR. IMAGES.
C     IT TRANSLATES IBM PRINTER GRAPHICS TO ASCII CODE.
C
C     R. J. HANSON, SANDIA LABS., ALBUQUERQUE, NM., OCTOBER, 1979.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     TRANSLATE FROM IBM PRINTER GRAPHICS TO ASCII CODES.
C     USE IBM PRINTER GRAPHICS TO ASCII CODE TRANSFORMATION TABLE.
C     REF. IBM 360 ASSEMB. LANG. REFERENCE MANUAL, CODE CONVERSION TABLE
C
      INTEGER PGASC(256),BLANK,CARD(45)
C
C     FILL NONPRINTABLE CHARS. WITH THE ASCII CODE FOR DOLLAR SIGN
C
      DATA PGASC /256*36/
C
C                                                   BLANK  .  <  (
      DATA PGASC(065),PGASC(076),PGASC(077),PGASC(078)/32,46,60,40/
C                                                       +  &  $  *
      DATA PGASC(079),PGASC(081),PGASC(092),PGASC(093)/43,38,36,42/
C                                                       )  -  /  ,
      DATA PGASC(094),PGASC(097),PGASC(098),PGASC(108)/41,45,47,44/
C                                                       %  #  @  '
      DATA PGASC(109),PGASC(124),PGASC(125),PGASC(126)/37,35,64,39/
C                                                       =  A  B  C
      DATA PGASC(127),PGASC(194),PGASC(195),PGASC(196)/61,65,66,67/
C                                                       D  E  F  G
      DATA PGASC(197),PGASC(198),PGASC(199),PGASC(200)/68,69,70,71/
C                                                       H  I  J  K
      DATA PGASC(201),PGASC(202),PGASC(210),PGASC(211)/72,73,74,75/
C                                                       L  M  N  O
      DATA PGASC(212),PGASC(213),PGASC(214),PGASC(215)/76,77,78,79/
C                                                       P  Q  R  S
      DATA PGASC(216),PGASC(217),PGASC(218),PGASC(227)/80,81,82,83/
C                                                       T  U  V  W
      DATA PGASC(228),PGASC(229),PGASC(230),PGASC(231)/84,85,86,87/
C                                                       X  Y  Z  0
      DATA PGASC(232),PGASC(233),PGASC(234),PGASC(241)/88,89,90,48/
C                                                       1  2  3  4
      DATA PGASC(242),PGASC(243),PGASC(244),PGASC(245)/49,50,51,52/
C                                                       5  6  7  8
      DATA PGASC(246),PGASC(247),PGASC(248),PGASC(249)/53,54,55,56/
C                                                       9
      DATA PGASC(250)                                 /57/
C
      DATA BLANK /64/
C
C     DETERMINE WHICH FILE TO READ.
      IF (IABS(ACTION).EQ.1) GO TO 70
      I=INALT
      IF (I.GT.0) GO TO 10
      I=INTEXT
      IF (I.NE.0) GO TO 10
      I=INFILE
      IF (I.EQ.0) I=READER
10    IF (ACTION.NE.2) GO TO 15
      REWIND I
      GO TO 70
15    READ (I,20,END=80) (CARD(J),J=1,20)
20    FORMAT (20A4)
C
C     RIGHT-ADJUST THE INPUT CHARACTERS.
      CALL EXCHUN(CARD,HOLCMD)
C
C     SCAN THE CARD IMAGE FROM THE RIGHT.  FIND LAST
C     NON-BLANK CHARACTER.
      DO 90 I=1,80
      IF(HOLCMD(81-I).NE.BLANK) GO TO 100
90    CONTINUE
      NCHCMD=1
      GO TO 40
100   NCHCMD=81-I
40    DO 60 I=1,NCHCMD
      COMAND(I)=PGASC(HOLCMD(I)+1)
C     CONVERT HOLCMD BACK TO HOLLERITH FOR 80A1 OUTPUT.
60    HOLCMD(I)=XLATE(COMAND(I)+1)
70    ACTION=0
      RETURN
80    NCHCMD=-1
      RETURN
      END
      SUBROUTINE EXCHPA(BUFIN,BUF9T)
C     CHARACTER PACKING ROUTINE FOR THE IBM 360, 370 SERIES MACHINES.
C     THE LOGICAL *1 DATA TYPE IS USED TO PACK THE CHARACTERS FROM
C     THE WORKING BUFFER BUFIN() TO BUF9T().
C     WRITTEN BY R. J . HANSON, SANDIA LABS., NOVEMBER, 1979.
      LOGICAL *1 BUFIN(720),BUF9T(180)
      DO 10 I=1,180
10    BUF9T(I)=BUFIN(4*I)
      RETURN
      END
      SUBROUTINE EXCHRT (ISTAT,DBLOCK)
C
C     IBM 360/370/3030.
C
C     READ A BLOCK FROM, OR REWIND, THE EXCHANGE TAPE.
C     INPUT:
C     ISTAT = 1 MEANS OPEN WITH NO REWIND.
C     ISTAT = 2 MEANS REWIND (CLOSE WITH REWIND).
C     ISTAT = 3 MEANS READ.
C     ISTAT = 4 MEANS CLOSE WITH NO REWIND.
C
C     OUTPUT:
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR WAS DETECTED.
C
C     DBLOCK IS THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
C
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
      I=ISTAT
      ISTAT=0
      GO TO (10,50,20,80), I
C
C     OPEN WITH NO REWIND.  THIS IS THE PLACE TO MODIFY THE DCB IF
C     YOUR JCL DOESN'T DO IT.
C
10    CONTINUE
      GO TO 80
C
C     READ A BLOCK.  ALLOW AN EOF IF WE ARE LOOKING FOR A LABEL.
C
20    NCDBI=NERRCI+NDATAI+9
      NWORDS=(NCDBI+3)/4
      DO 30 I=1,2
      READ (INTAPE,23,END=25,ERR=40) (DBLOCK(L),L=1,NWORDS)
23    FORMAT (10(255A4))
      GO TO 80
25    IF (BLKSQI.NE.0) GO TO 40
30    CONTINUE
40    ISTAT=3
      GO TO 80
C
C     REWIND
C
50    REWIND INTAPE
C
80    RETURN
C
      END
      SUBROUTINE EXCHUN(BUF9T,BUFOUT)
C     CHARACTER UNPACKING ROUTINE FOR THE IBM 360, 370 SERIES MACHINES.
C     THE LOGICAL *1 DATA TYPE IS USED TO UNPACK THE CHARACTERS FROM
C     THE INPUT BLOCK BUF9T() TO THE OUTPUT BUFFER, BUFOUT().
C
C     WRITTEN BY R. J. HANSON, SANDIA LABS., NOVEMBER, 1979.
      LOGICAL *1 BUF9T(180),BUFOUT(720)
      LOGICAL *1 IZERO
      DATA IZERO/Z00/
      DO 10 I=1,180
      BUFOUT(4*I-3)=IZERO
      BUFOUT(4*I-2)=IZERO
      BUFOUT(4*I-1)=IZERO
10    BUFOUT(4*I)=BUF9T(I)
      RETURN
      END
      SUBROUTINE EXCHWT (ISTAT,DBLOCK)
C
C     IBM 360/370/3030.
C
C     WRITE A BLOCK ON THE EXCHANGE TAPE.
C
C     INPUT:
C     ISTAT = 1 MEANS OPEN OUTPUT WITH NO REWIND
C     ISTAT = 2 MEANS WRITE
C     ISTAT = 3 MEANS WRITE END FILE AND CLOSE WITH NO REWIND.
C
C     OUTPUT:
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ON
C              TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
      I=ISTAT
      ISTAT=0
      GO TO (10,20,40), I
C
C     OPEN WITH NO REWIND.  THIS IS THE PLACE TO MODIFY THE DCB IF
C     YOUR JCL DOESN'T DO IT.
C
10    CONTINUE
      GO TO 50
C
C     WRITE A BLOCK.
C
20    NWORDS=(NDATAO+NERRCO+9+3)/4
      IF (BLKSQO.EQ.0) NWORDS=(CCDBO+3)/4
      WRITE (OUTAPE,25) (DBLOCK(I),I=1,NWORDS)
25    FORMAT (10(255A4))
      GO TO 50
C
C     WRITE END OF FILE MARK.
C
40    END FILE OUTAPE
C
50    RETURN
C
      END
      SUBROUTINE EXCHAH (RECORD,NCHAR)
C
C     CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO
C     HOLLERITH FORMAT.
C     THIS PROGRAM IS NOT MACHINE SENSITIVE.
C
C     RECORD IS THE RECORD TO BE CONVERTED.  THE HOLLERITH IS STORED
C     IN RECORD ALSO
      INTEGER RECORD(1)
C
C     NCHAR IS THE NUMBER OF CHARACTERS TO BE CONVERTED
C
      INTEGER XLATE(128)
      COMMON /EXCHXC/ XLATE
C
C
      DO 10 I=1,NCHAR
      J=RECORD(I)
10    RECORD(I)=XLATE(J+1)
      RETURN
      END
      SUBROUTINE EXCHFO (IOP)
C
C     OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM.
C     IOP LESS THAN ZERO MEANS CLOSE FILE, IOP GREATER THAN ZERO MEANS
C     OPEN FILE.  IABS(IOP) = 1 MEANS READER, = 2 MEANS PRINTER, = 3
C     MEANS WORK FILE, = 4 MEANS INFILE.  IOP = 4 IS USED ONLY BY THE
C     BOOTSTRAP PROGRAM.
C
      INTEGER IOP
C
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
      RETURN
C
      END
      SUBROUTINE EXCHOU (OUTPUT)
C
C     NATIVE FORMAT OUTPUT PROGRAM FOR THE TEXT EXCHANGE PROGRAM.
C
C     OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN.
C     THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT.
C
C     THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180),
C     THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179).  IF OUTPUT(180)
C     IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE.  IF OUTPUT(180)
C     IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW
C     IMAGE.
C
      INTEGER OUTPUT(1)
      INTEGER WORK(180)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C
C     DECIDE WHETHER TO OPEN, CLOSE OR WRITE.
C
      IF (IABS(ACTION).EQ.2) GO TO 50
C     IABS(ACTION) = 2 MEANS START OR END OF PROGRAM.
      IF (ACTION) 40,10,50
C     WRITE
10    DO 20 I=1,NCHOUT
      J=OUTPUT(I)
20    WORK(I)=XLATE(J+1)
      WRITE (OUFILE,30) (WORK(I),I=1,NCHOUT)
30    FORMAT (132A1)
      GO TO 50
C     CLOSE
40    END FILE OUFILE
C     OPEN, RETURN
50    ACTION=0
      RETURN
      END
      SUBROUTINE EXCHSL
C
C     LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS.
C
C     EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE
C     SEGMENT.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      RETURN
      END
      SUBROUTINE EXCHTR (IBLOCK,OBLOCK)
C
C     TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER.
C
      INTEGER IBLOCK(1), OBLOCK(1)
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4.
C
      CALL EXCHFO (1)
      CALL EXCHFO (2)
      WORKF=-IABS(WORKF)
C
10    IF (TRANS.LE.0) RETURN
      CALL EXCHSL
C     LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS.
      GO TO (11,12,13,14,15,16,17,18,19), TRANS
C     COMMAND PARSER
11    CALL EXCHC1 (IBLOCK,OBLOCK)
      GO TO 10
C     IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE
12    CALL EXCHC2
      GO TO 10
C     OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE.
13    CALL EXCHC3 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE.
14    CALL EXCHC4 (IBLOCK)
      GO TO 10
C     COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE.
15    CALL EXCHC5 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY TEXT FROM INTAPE TO OUTAPE
16    CALL EXCHC6 (IBLOCK,OBLOCK)
      GO TO 10
C     TEXT COMMAND
17    CALL EXCHC7 (IBLOCK,OBLOCK)
      GO TO 10
C     ERROR MESSAGES
18    CALL EXCHC8
      GO TO 10
C     QUIT
19    CALL EXCHC9 (IBLOCK,OBLOCK)
      GO TO 10
      END
      SUBROUTINE EXCHGB (ISTAT,DBLOCK)
C
C     READ A BLOCK FROM THE EXCHANGE TAPE.
C     IGNORE THE ERROR CONTROL SEGMENT.
C     CHECK THE BLOCK SEQUENCE NUMBER.
C     CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER,
C               OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
C
C     READ A BLOCK FROM INTAPE.
C
      BLKSQI=BLKSQI+1
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 160
C
C     GET INFORMATION OUT OF THE BLOCK HEADER.
C
      CCDBI=NERRCI
      CWDBI=NWCBI*(CCDBI/NCCBI)+1
      CPCBI=MOD(CCDBI,NCCBI)
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
      DO 110 JUMP=1,9
      CCDBI=CCDBI+1
      CPCBI=CPCBI+1
      IF (CCDBI.GT.NCDBI) GO TO 130
      IF (CPCBI.LE.NCCBI) GO TO 10
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
10    GO TO (20,30,40,50,60,70,80,90,100), JUMP
20    NEWBLK=256*CBLCKI(CPCBI)
      GO TO 110
30    NEWBLK=NEWBLK+CBLCKI(CPCBI)
      GO TO 110
40    LASTI=CBLCKI(CPCBI)
      GO TO 110
50    L1PRGI=256*CBLCKI(CPCBI)
      GO TO 110
60    L1PRGI=L1PRGI+CBLCKI(CPCBI)
      GO TO 110
70    N1RECI=256*CBLCKI(CPCBI)
      GO TO 110
80    N1RECI=N1RECI+CBLCKI(CPCBI)
      GO TO 110
90    L1RECI=256*CBLCKI(CPCBI)
      GO TO 110
100   L1RECI=L1RECI+CBLCKI(CPCBI)
110   CONTINUE
C
C     CHECK THE BLOCK SEQUENCE NUMBER.
C
      IF (BLKSQI.EQ.NEWBLK) GO TO 150
      ISTAT=1
      WRITE (PRINTR,120) NEWBLK,BLKSQI
120   FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I
     15//)
      BLKSQI=NEWBLK
      GO TO 160
C
C     FORMAT ERROR
C
130   ISTAT=2
      GO TO 160
C
C     CHECK L1PRGI AND L1RECI.
C
150   IF (L1PRGI.GT.NCDBI) GO TO 130
      IF (L1RECI.GT.NCDBI) GO TO 130
      ISTAT=0
160   RETURN
C
      END
      SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD)
C
C     GET A RECORD FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK).
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE
C               SPACE ALLOWED BY THE USER.  (POSITION IS STILL OK).
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C     THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM
C     CONTROL RECORDS.  NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS.
C
      ISTAT=0
      NCHACT=0
10    JUMP=1
      GO TO 260
20    NG=CBLCKI(CPCBI)
      IF (NG.EQ.0) GO TO 90
      IF (NG.NE.255) GO TO 30
C
C     END OF SHORT TAPE BLOCK.
C
      CCDBI=NCDBI
      GO TO 10
C
C     UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO
C     THE USER RECORD AREA.
C
30    ITYPEI=0
      IF (MODEI.EQ.0) GO TO 40
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG
40    IG=0
50    JUMP=2
      GO TO 260
60    NR=CBLCKI(CPCBI)
      IF (MODEI.EQ.0) GO TO 70
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR
      GO TO 160
70    IR=0
C     PUT REMVI INTO THE USER RECORD NR TIMES.
80    IF (IR.GE.NR) GO TO 160
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI
      IR=IR+1
      GO TO 80
C
C     THE NEXT RECORD IS A CONTROL RECORD.  FIND OUT WHAT KIND.
C
90    JUMP=3
      GO TO 260
100   ITYPEI=CBLCKI(CPCBI)
      IF (ITYPEI.LT.65) GO TO 250
C     65 = ASCII  A
      IF (ITYPEI.GT.90) GO TO 250
C     90 = ASCII  Z
      I=ITYPEI-64
C             A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
      GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160
     1,110,160,220,160,160,160,160,160,160,160,160), I
C       P   Q   R   S   T   U   V   W   X   Y   Z
C
C     P - PROGRAM HEADER
C
C     CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER
110   REMVI=32
C     RESET THE REMOVED CHARACTER TO ASCII BLANK.
      JUMP=4
      GO TO 260
120   L1PRGI=256*CBLCKI(CPCBI)
      JUMP=5
      GO TO 260
130   L1PRGI=L1PRGI+CBLCKI(CPCBI)
      JUMP=6
      GO TO 260
140   N1RECI=256*CBLCKI(CPCBI)
      JUMP=7
      GO TO 260
150   N1RECI=N1RECI+CBLCKI(CPCBI)
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
160   JUMP=8
      GO TO 260
170   NC=CBLCKI(CPCBI)
      IF (ITYPEI.NE.0) GO TO 180
      IF (MODEI.EQ.0) GO TO 180
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC
C     COPY NC CHARACTERS TO THE USER RECORD AREA.
180   IC=0
      JUMP=9
190   IF (IC.GE.NC) IF (ITYPEI) 240,210,240
      GO TO 260
200   NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI)
      IC=IC+1
      GO TO 190
210   IG=IG+1
      IF (IG-NG) 50,240,240
C
C     J - UPDATING AND END OF INPUT TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
220   JUMP=10
      GO TO 260
230   RECORD(1)=CBLCKI(CPCBI)
      NCHACT=1
      IF (ITYPEI.EQ.82) REMVI=RECORD(1)
C     82 = ASCII R
C
C     RETURN TO THE USER PROGRAM.
C
240   IF (NCHACT.GT.NCHMAX) ISTAT=4
      GO TO 290
C
C     CONTROL RECORD TYPE CANNOT BE DETERMINED.
C
250   ISTAT=5
      GO TO 290
C
C     GET A CHARACTER FROM CBLOCK.  UNPACK A NEW BLOCK IF NECESSARY.
C     READ MORE TAPE IF NECESSARY.
C
260   CPCBI=CPCBI+1
      CCDBI=CCDBI+1
      IF (CCDBI.LE.NCDBI) GO TO 270
      CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 290,260,290
270   IF (CPCBI.LE.NCCBI) GO TO 280
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
280   GO TO (20,60,100,120,130,140,150,170,200,230), JUMP
290   RETURN
C
      END
      SUBROUTINE EXCHNP (ISTAT,DBLOCK)
C
C     SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE
C     TAPE.
C     THIS MODULE IS MACHINE INSENSITIVE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
      ISTAT=0
      IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20
C
C     CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK.
C
10    IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20
C     76 = ASCII L
C
C     NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK.
      CCDBI=L1PRGI-1
      I=NWCBI*(CCDBI/NCCBI)+1
      IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI)
      CWDBI=I
      CPCBI=MOD(CCDBI,NCCBI)
      GO TO 40
C
C     NO MORE HEADERS IN THIS BLOCK.
C
20    CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 40,10,40
C
C     END OF FILE.
C
30    ISTAT=7
C
40    RETURN
C
      END
      SUBROUTINE EXCHPB (ISTAT,DBLOCK)
C
C     WRITE A BLOCK ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C     WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK.
      INTEGER WORK(9)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
C     PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK.
C
      BLKSQO=BLKSQO+1
      WORK(1)=BLKSQO/256
      WORK(2)=MOD(BLKSQO,256)
      WORK(3)=LASTO
      WORK(4)=L1PRGO/256
      WORK(5)=MOD(L1PRGO,256)
      WORK(6)=N1RECO/256
      WORK(7)=MOD(N1RECO,256)
      WORK(8)=L1RECO/256
      WORK(9)=MOD(L1RECO,256)
C
      CPCBO=MOD(NERRCO,NCCBO)
      CWDBO=(NERRCO/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
C
      DO 10 I=1,9
      CPCBO=CPCBO+1
      IF (CPCBO.LE.NCCBO) GO TO 10
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
      CWDBO=CWDBO+NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
      CPCBO=1
10    CBLCKO(CPCBO)=WORK(I)
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
C
C     WRITE THE DATA BLOCK ON TAPE.
C
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L).
C
      IF (LASTO.NE.76) GO TO 20
      ISTAT=3
      CALL EXCHWT (ISTAT,DBLOCK)
      GO TO 30
C
C     COMPUTE POINTERS FOR NEXT BLOCK OUT.
C
20    L1PRGO=0
      LLPRGO=0
      N1RECO=0
      L1RECO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
C
30    RETURN
C
      END
      SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD)
C
C     WRITE A RECORD ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A
C             TEXT RECORD CONTAINS MORE THAN 254 GROUPS.
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER GC,RC(255),CC(255)
C     GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      ISTAT=0
      INCHAR=0
C
C     DETERMINE THE RECORD TYPE.
C
      IF (NCHOUT.NE.255) GO TO 10
      ITYPEO=255
      GO TO 70
10    IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO
      IF (ITYPEO.NE.0) GO TO 30
C
C     DATA RECORD.
C
      IF (MODEO.NE.0) GO TO 170
C     COMPRESS THE RECORD.
      CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255)
      IF (GC.GE.255) GO TO 210
      IG=0
C     OUTPUT THE GROUP COUNT.
      CBLCKO(CPCBO)=GC
      JUMP=1
      GO TO 230
20    IG=IG+1
      IF (IG.GT.GC) GO TO 250
      NC=CC(IG)
      INCHAR=INCHAR+RC(IG)
C     OUTPUT REMOVED CHARACTER COUNT.
      CBLCKO(CPCBO)=RC(IG)
      JUMP=2
      GO TO 230
C
C     THE USER SAYS HE HAS A CONTROL RECORD TO WRITE.  FIND OUT
C     WHAT KIND.
C
30    IF (ITYPEO.LT.65) GO TO 220
C     65 = ASCII A
      IF (ITYPEO.GT.90) GO TO 220
C     90 = ASCII  Z
      I=ITYPEO-64
C             A  B  C  D  E  F  G  H  I  J   K  L  M  N  O  P  Q  R   S
      GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40,
     140,40,40,40,40,40,40), I
C      T  U  V  W  X  Y  Z
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE TYPE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
40    IF (NCHOUT-255) 100,100,210
C
C     END OF FILE.
C
50    IF (NERRCO+NDATAO+7-CCDBO) 70,80,80
C
C     P - PROGRAM HEADER.
C
60    IF (NCHOUT.GT.255) GO TO 210
      REMVO=32
C     RESET REMOVED CHARACTER TO ASCII BLANK.
      IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80
      IF (CCDBO.EQ.NERRCO+10) GO TO 80
C
C     END OF SHORT TAPE BLOCK.
C
70    CBLCKO(CPCBO)=255
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250
C     69 = ASCII E
C     80 = ASCII P
      L1RECO=CCDBO-NERRCO
80    IF (LLPRGO.EQ.0) GO TO 90
C     LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK.
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      NC=MOD(LLPRGO+1,NCCBO)
      NW=((LLPRGO+1)/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      CBLCKO(NC+1)=CCDBO/256
      IF (NC+1.LT.NCCBO) GO TO 85
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      NW=NW+NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      NC=-1
85    CBLCKO(NC+2)=MOD(CCDBO,256)
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      CALL EXCHUN (DBLOCK(CWDBO),CBLCKO)
C     UPDATE TABLE OF CONTENTS POINTERS
90    LLPRGO=CCDBO
      IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO
      NLRECO=NLRECO+1
      IF (N1RECO.EQ.0) N1RECO=NLRECO
100   CBLCKO(CPCBO)=0
      JUMP=3
      GO TO 230
110   CBLCKO(CPCBO)=ITYPEO
      JUMP=4
      GO TO 230
120   IF (ITYPEO.NE.69) GO TO 130
C     69 = ASCII E
      LASTO=76
      GO TO 70
130   IF (ITYPEO.NE.80) GO TO 170
C     80 = ASCII P
      CBLCKO(CPCBO)=0
      JUMP=5
      GO TO 230
140   CBLCKO(CPCBO)=0
      JUMP=6
      GO TO 230
150   CBLCKO(CPCBO)=NLRECO/256
      JUMP=7
      GO TO 230
160   CBLCKO(CPCBO)=MOD(NLRECO,256)
      JUMP=8
      GO TO 230
C
170   NC=NCHOUT
180   CBLCKO(CPCBO)=NC
      IC=0
      JUMP=9
C     PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD.
      IF (ITYPEO.EQ.82) GO TO 190
      IF (ITYPEO.EQ.74) GO TO 190
      IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230
190   IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250
      INCHAR=INCHAR+1
      IC=IC+1
      CBLCKO(CPCBO)=RECORD(INCHAR)
      GO TO 230
C
C     J - UPDATING AND END OF TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
200   NCHOUT=1
      IF (ITYPEO.EQ.82) REMVO=RECORD(1)
C     82 = ASCII R
      GO TO 100
C
C     RECORD TOO LONG.
C
210   ISTAT=4
      GO TO 250
C
C     UNKNOWN CONTROL RECORD TYPE.
C
220   ISTAT=5
      GO TO 250
C
C     INCREMENT THE OUTPUT BUFFER POINTERS.  PACK A CHARACTER BLOCK
C     IF NECESSARY.  WRITE A TAPE BLOCK IF NECESSARY.
C
230   CPCBO=CPCBO+1
      CCDBO=CCDBO+1
      IF (CPCBO.LE.NCCBO) GO TO 240
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CWDBO=CWDBO+NWCBO
      CPCBO=1
      IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 250
240   GO TO (20,180,110,120,140,150,160,170,190), JUMP
250   RETURN
C
      END
      SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL)
C
C     SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE
C     DATA TO BE REMOVED.  DIVIDE DATA INTO GROUPS CONSISTING OF
C     STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT
C     DATA.  THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE
C     REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP
C     ARE RECORDED IN RC() AND SC() RESPECTIVELY.  MAXSL IS THE
C     MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC().
C
      INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL
C
C     RC AND SC MUST BE AT LEAST (IMGLEN-1)//3.
C
      GC=1
      SC(1)=0
      RC(1)=0
      MODE=-1
      INPLEN=IABS(IMGLEN)
C
C     IDENTIFY DATA GROUPS.
C
      DO 110 I=1,INPLEN
      IF (MODE) 40,60,90
C
C     MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE.
C
40    IF (INPIMG(I).EQ.REMOVE) GO TO 50
C     SWITCH TO SIGNIFICANT DATA SCAN.
      MODE=1
      SC(GC)=1
      GO TO 110
C     CONTINUE REMOVE SCAN
50    RC(GC)=RC(GC)+1
      IF (RC(GC)-MAXSL) 110,95,110
C
C     MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY
C     ONE OCCURRENCE OF REMOVE.  CHANGE TO REMOVE MODE IF ANOTHER REMOVE
C     OCCURS OR BACK TO DATA MODE IF NOT.
C
60    IF (INPIMG(I).EQ.REMOVE) GO TO 80
C     SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT.
      MODE=1
      IF (SC(GC).GE.MAXSL-2) GO TO 70
      SC(GC)=SC(GC)+2
      GO TO 110
C     FULL GROUP
70    GC=GC+1
      RC(GC)=1
      SC(GC)=1
      GO TO 110
C     SWITCH TO REMOVE MODE.
80    GC=GC+1
      SC(GC)=0
      RC(GC)=2
      MODE=-1
      GO TO 110
C
C     MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA.
C
90    IF (INPIMG(I).EQ.REMOVE) GO TO 100
      SC(GC)=SC(GC)+1
      IF (SC(GC).NE.MAXSL) GO TO 110
C     FULL GROUP
      MODE=-1
95    IF (I.GE.INPLEN) GO TO 120
      GC=GC+1
      RC(GC)=0
      SC(GC)=0
      GO TO 110
100   MODE=0
110   CONTINUE
120   RETURN
C
      END
      SUBROUTINE EXCHTP (RECORD,LINEI)
C
C     MATERIALIZE INCLUDES IF INALT IS NON-ZERO.
C     CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE
C     AND THE PRINTER IF LISTING IS REQUESTED.
C     LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C
      INTEGER RECORD(1),LINEI
C
C     *****     LOCAL VARIABLES     ************************************
C
C COPY    DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR
C         SKIPPING TEXT NOT TO BE INCLUDED.
      INTEGER COPY
C DASH    CONTAINS '-' IN HOLLERITH.
      INTEGER DASH
C ENDMRK  HOLDS THE END SENTINEL.
      INTEGER ENDMRK(40)
C NCHEND  IS THE NUMBER OF CHARACTERS IN ENDMRK.
      INTEGER NCHEND
C NCHSAV  SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD.
      INTEGER NCHSAV
C NCHTAR  IS THE NUMBER OF CHARACTERS IN TARGET.
      INTEGER NCHTAR
C STAR    CONTAINS '*' IN HOLLERITH.
       INTEGER STAR
C TARGET  IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY).
      INTEGER TARGET(40)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL DATA     ***************************************
C
      DATA DASH /1H-/, STAR /1H*/
C
C     *****     PROCEDURES     *****************************************
C
      LINEO=LINEO+1
      IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190
      RECORD(180)=LINEO
      RECORD(179)=LINEI
      COPY=-1
C     COPY=-1 MEANS NOT COPYING INCLUDED TEXT.
      IF (ITYPEO.EQ.0) GO TO 110
C     PROCESS INCLUDE RECORD.
      DO 10 I=1,NCHOUT
10    RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I)
C     INSERT '-I '.
      RECORD(1)=45
      RECORD(2)=73
      RECORD(3)=32
      NCHOUT=NCHOUT+3
      IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110
C     STORE SEARCH TARGET
      NCHTAR=MIN0(NCHOUT,40)
      DO 20 I=1,NCHTAR
20    TARGET(I)=RECORD(I)
C     STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
      NCHSAV=NCHCMD
      DO 30 I=1,NUMBER
30    OUTREC(I)=COMAND(I)
      COPY=0
C     COPY=0 MEANS SKIPPING MODULE ON INALT FILE.
      INALT=IABS(INALT)
      NEOF=0
40    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
      IF (NCHCMD.LT.2) GO TO 40
      IF (COMAND(1).NE.45) GO TO 40
C     45 = ASCII -
      IF (COMAND(2).EQ.45) GO TO 130
      IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40
C     73 = ASCII I, 105 = ASCII LOWER CASE I.
C     COMPARE IMAGE WITH SEARCH TARGET.
      IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60
      DO 50 I=2,NCHTAR
      K=COMAND(I)
      IF (K.GT.96 .AND. K.LT.123) K=K-32
      IF (TARGET(I).NE.K) GO TO 60
50    CONTINUE
      NEOF=3
C     PREVENT SEARCH LOOP.
      COPY=1
C     COPY=1 MEANS COPYING INCLUDED TEXT.
60    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     STORE END OF INCLUDE MODULE SIGNAL.
      NCHEND=MIN0(40,NCHCMD)
      DO 70 I=1,NCHEND
70    ENDMRK(I)=COMAND(I)
      IF (COPY.EQ.0) GO TO 80
      CHAR1L=DASH
      NCHOUT=NCHTAR
      DO 75 I = 1,NCHOUT
75    COMAND(I)=TARGET(I)
      COMAND(180)=LINEO
      COMAND(179)=LINEI
C     GO PRINT TARGET.
      CALL EXCHTW (COMAND,-1)
      GO TO 120
C     COPY OR SKIP UNTIL ENDMRK SEEN AGAIN.
80    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF.
C     TEST FOR ENDMRK
      DO 90 I=1,NCHEND
      IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100
90    CONTINUE
      IF (COPY) 140,40,140
C     OUTPUT TEXT RECORD.
100   COMAND(180)=LINEO
      COMAND(179)=LINEI
      NCHOUT=NCHCMD
      CALL EXCHTW (COMAND,OPTI)
      GO TO 120
C     OUTPUT TEXT RECORD.
110   CALL EXCHTW (RECORD,1)
120   IF (COPY) 190,190,80
C     WE ONLY GET HERE WITH COPY .GE. 0.
130   NEOF=NEOF+1
      ACTION=2
C     ACTION = 2 MEANS REOPEN INALT.
      CALL EXCHIM
      IF (NEOF.LT.2) GO TO 40
140   INALT=-IABS(INALT)
      NCHCMD=1
      IF (COPY.GT.0) GO TO 170
C     PROCESS TARGET AS THOUGH IT WERE TEXT.
      NCHOUT=NCHTAR
C     SAVE TARGET FOR ERROR MESSAGE.
      DO 150 I=1,NCHTAR
150   COMAND(I)=TARGET(I)
      CALL EXCHTW (COMAND,1)
      CALL EXCHAH (TARGET,NCHTAR)
      WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR)
160   FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8
     10A1))
      NERRS=MAX0(NERRS,3)
C
C     RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
C
170   NCHCMD=NCHSAV
      DO 180 I=1,NUMBER
180   COMAND(I)=OUTREC(I)
C
190   CHAR1L=STAR
      RETURN
C
      END
      SUBROUTINE EXCHTW (RECORD,OPTION)
C
C     WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING
C     EXCHOU.  WRITE RECORD ON THE PRINTER IF LISTING REQUESTED.
C     RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C     IF OPTION = ZERO, WRITE TO FILE ONLY.
C     IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING.
C     IF OPTION .LT. ZERO, WRITE TO LISTING ONLY.
C
      INTEGER RECORD(1),OPTION
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     PROCEDURES     *****************************************
C
      LINEI=RECORD(179)
      IF (OPTION.LT.0) GO TO 130
C
C     INSERT IDENTIFICATION IF REQUESTED.
C
      IF (IDCOL2.LT.IDCOL1) GO TO 120
      IF (IDTXTL+IDSTEP.EQ.0) GO TO 120
      IF (NCHOUT.GE.IDCOL2) GO TO 20
      J=IDCOL2-1
C     FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2
      DO 10 I=NCHOUT,J
10    RECORD(I+1)=32
C     32 = ASCII BLANK.
20    NCHOUT=MAX0(NCHOUT,IDCOL2)
      N=-1
      IF (LINEI.EQ.0) GO TO 40
      IF (IDOPTN.NE.73) GO TO 40
C     73 = ASCII I.  IDENTIFY ONLY FROM INTAPE.
      N=(LINEI-1)*IDSTEP+IDSTRT
      GO TO 70
40    IF (IDOPTN.NE.79) GO TO 50
C     79 = ASCII O.  IDENTIFY ONLY TO OUTAPE.
      N=(LINEO-1)*IDSTEP+IDSTRT
      GO TO 70
50    IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70
C     67 = ASCII C, 70 = ASCII F.  IDENTIFY EVERYTHING.
      N=IDCUR
70    IF (N.LT.0) GO TO 120
      IF (IDTXTL.EQ.0) GO TO 100
      J=MIN0(IDCOL2,IDTXTL+IDCOL1-1)
      K=1
      DO 80 I=IDCOL1,J
      RECORD(I)=IDTEXT(K)
80    K=K+1
100   IF (IDSTEP.EQ.0) GO TO 120
      IDCUR=IDCUR+IDSTEP
      K=IDCOL2
110   RECORD(K)=MOD(N,10)+48
      N=N/10
      K=K-1
      IF (N.EQ.0) GO TO 120
      IF (K.GE.IDCOL1) GO TO 110
C
C     OUTPUT RECORD.
C
120   IF (OUFILE.NE.0) CALL EXCHOU (RECORD)
      IF (OPTION.EQ.0) GO TO 220
130   IF (OPTL.NE.0) GO TO 140
      IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220
140   CALL EXCHAH (RECORD,NCHOUT)
      IF (OPTV+VERT.NE.0) GO TO 200
      IF (PHASE.NE.8) GO TO 180
      IF (LINEI.EQ.0) GO TO 160
      WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
150   FORMAT (1X,2I5,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
160   WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
170   FORMAT (5H  NEW,I6,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
180   WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
190   FORMAT (1X,I5,A1,3X,110A1/(6H  CONT,4X,110A1))
      GO TO 220
200   WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT)
210   FORMAT (132A1)
220   RETURN
C
      END
      SUBROUTINE EXCHC1 (IBLOCK,OBLOCK)
C
C     COMMAND DECODER AND FORMAT VERIFIER.  SOME COMMANDS ARE ALSO
C     COMPLETELY PROCESSED HERE.
C
C     IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS.
C
      INTEGER IBLOCK(1),OBLOCK(1)
C
C
C     *****     LOCAL VARIABLES     ************************************
C
C ALLOW   TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED.  VALUES ARE
C         SUMS OF PERMITTED VALUES OF PHASE.
C         1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING,
C         8 = UPDATING.
C         ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A
C         PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR
C         MAY BE VOID (EQUAL SIGN IS LAST CHARACTER).
C         32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT.
      INTEGER ALLOW(35)
C BLANK   A CONSTANT.  1H .
      INTEGER BLANK
C DATE    IS THE DATE FROM UPDA=, DATE=, ORIG=.
      INTEGER DATE(3)
C DAYS    TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS.
      INTEGER DAYS(12)
C I       IS USED FREELY AS AN INDEX.
C J       IS USED FREELY AS AN INDEX.
C JUMP    USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE.
C K       IS USED FREELY AS AN INDEX.
C KDATE   IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD).
C KQUIT   IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD).
C KTEXT   IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD).
C N       IS USED FREELY AS AN INDEX.
C NCNREC  IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS.
C ND      IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER.
C NM      IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER.
C NY      IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER.
C TVAL    A VECTOR OF VALUES FOR TRANS.  INDEXED BY ICOMD.
      INTEGER TVAL(35)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL EQUIVALENCE     **********************************
C
      EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND)
C
C     *****     DATA STATEMENTS     ************************************
C
      DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/
      DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/
      DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/
      DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/
      DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/
      DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/
      DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/
      DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/
      DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/
      DATA BLANK /1H /
      DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/
      DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/
      DATA DAYS(11),DAYS(12) /30,31/
      DATA KDATE /5/
      DATA KQUIT /20/
      DATA KTEXT /27/
      DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/
      DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/
      DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/
      DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/
      DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/
      DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/
      DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/
C
C     *****     PROCEDURES     *****************************************
C
C     GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER.
C     ECHO IT IF THE E OPTION IS SET.  DETERMINE WHETHER IT IS A CHANGE
C     TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND.
C
10    NCNREC=0
20    ACTION=0
      IF (NCHCMD.LT.0) GO TO 220
      CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (OPTE.EQ.0) GO TO 27
      WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD)
23    FORMAT (1X,80A1)
      CHAR1L=0
27    NCHCMD=MIN0(NCHCMD,MARGIN)
      IF (PHASE.LT.4) SIGNAL=45
C     45 = ASCII -
      IF (COMAND(1).NE.45) GO TO 50
C     45 = ASCII -.  REQUEST TO CHANGE CONTROL RECORD.
      IF (PHASE.LT.4) GO TO 40
      WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD)
30    FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT
     1OR UPDATE/1X,80A1)
      NERRG=MAX0(NERRG,2)
      GO TO 200
40    ICOMD=0
      EQUAL=2
      TRANS=3
      GO TO 370
50    IF (COMAND(1).NE.42) GO TO 70
C     42 = ASCII *.  COMMENT RECORD.  JUST ECHO IT.
      NCHCMD=MAX0(NCHCMD,2)
      WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD)
60    FORMAT (A1,1H*,78A1/(1X,80A1))
      GO TO 10
C
C     SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR
C     EQUAL SIGN ARE FOUND.  LOOK UP THE WORD IN THE COMMAND NAME TABLE.
C
70    EQUAL=0
      DO 80 I=1,NCHCMD
      IF (COMAND(I).EQ.32) GO TO 80
C     32 = ASCII BLANK
      EQUAL=EQUAL+1
      ICOMD=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32
C     ABOVE STATEMENT CONVERTS TO UPPER CASE.
      COMAND(I)=32
      COMAND(EQUAL)=ICOMD
      IF (EQUAL.GE.4) GO TO 90
      IF (ICOMD.EQ.61) GO TO 90
C     61 = ASCII =.
      IF (ICOMD.EQ.44) GO TO 90
C     44 = ASCII ,.
80    CONTINUE
      IF (EQUAL.EQ.0) GO TO 185
90    DO 110 ICOMD=1,NCOMDT
      DO 100 K=1,EQUAL
      IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110
100   CONTINUE
      IF (EQUAL.EQ.4) GO TO 130
      IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130
C     32 = ASCII BLANK.
110   CONTINUE
C
C     UNRECOGNIZED COMMAND.
C
120   ICOMD=0
C
C     LOOK FOR AN EQUAL SIGN.  SET THE VARIABLE NAMED EQUAL TO ZERO IF
C     THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK
C     CHARACTER FOLLOWING THE EQUAL SIGN.
C
130   MODIFY=0
140   DO 150 I=EQUAL,NCHCMD
      K=COMAND(I)
      IF (K.EQ.61) GO TO 160
C     61 = ASCII =.
      IF (MODIFY.NE.0) GO TO 150
C     USE FIRST MODIFIER.
      IF (K.EQ.44) GO TO 160
C     44 = ASCII ,.
150   CONTINUE
      EQUAL=0
      GO TO 170
160   I=I+1
      EQUAL=I
      IF (I.GT.NCHCMD) GO TO 170
      IF (COMAND(I).EQ.32) GO TO 160
C     32 = ASCII BLANK
      IF (K.NE.44) GO TO 170
C     44 = ASCII ,.
      MODIFY=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32
C     CONVERT TO UPPER CASE.
      GO TO 140
170   IF (K.NE.61) EQUAL=0
C     61 = ASCII =.
      IF (ICOMD.EQ.0) GO TO 180
      IF (ICOMD.GT.NCOMDP) GO TO 180
      IF (EQUAL.GT.NCHCMD) GO TO 175
      IF (EQUAL.NE.0) GO TO 230
      IF (ALLOW(ICOMD)/64.NE.0) GO TO 230
175   IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690
C     PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK.
      NCHCMD=NCHCMD+1
      EQUAL=NCHCMD
      COMAND(NCHCMD)=32
C     32 = ASCII BLANK
      HOLCMD(NCHCMD)=BLANK
      GO TO 230
C
C     GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX.
C
180   CALL EXCHCX (0)
C     IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND.
      IF (ICOMD.NE.0) GO TO 730
185   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1))
      NERRG=MAX0(NERRG,5)
200   CHAR1L=0
      NCNREC=NCNREC+1
      IF (NCNREC.LE.20) GO TO 20
      WRITE (PRINTR,210)
210   FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU
     1MES TEXT COMMAND IS MISSING.)
      GO TO 270
C
C     END OF FILE - SIMULATE A QUIT COMMAND.
C
220   ICOMD=KQUIT
C
C     RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME.
C
230   IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240
      TRANS=TVAL(ICOMD)
C             1   2   3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300
     1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7
     230,370,730,370), ICOMD
C       16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
C     32  33  34  35
C
C     THE COMMAND IS NOT ALLOWED AT THIS TIME.
C
240   WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE
     1D./1X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
C     DECIDE WHETHER TO SKIP TEXT
260   IF (ICOMD.NE.KTEXT) GO TO 10
      IF (EQUAL.NE.0) GO TO 10
270   WRITE (PRINTR,280)
280   FORMAT (//15H0SKIPPING TEXT.)
290   CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (NCHCMD.LT.2) GO TO 290
      IF (COMAND(1).NE.SIGNAL) GO TO 290
      IF (COMAND(2).EQ.SIGNAL) GO TO 10
      IF (NCHCMD.LT.3) GO TO 290
      IF (COMAND(2).NE.61) GO TO 290
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 290
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING.
C     DATE=YYMMDD
C     ORIGIN=YYMMDD SITE
C     UPDATE=YYMMDD SITE
C     IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE
C     THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED.
C
300   IF (EQUAL+5.GT.NCHCMD) GO TO 700
      I=EQUAL
      DO 310 J=1,3
      DATE(J)=0
      DO 310 K=1,2
      N=COMAND(I)-48
      IF (N.LT.0) GO TO 320
      IF (N.GT.9) GO TO 320
      DATE(J)=10*DATE(J)+N
310   I=I+1
      IF (NM.EQ.0) GO TO 320
      IF (NM.GT.12) GO TO 320
      IF (ND.LE.0) GO TO 320
      DAYS(2)=28
      IF (MOD(NY,4).EQ.0) DAYS(2)=29
      IF (NY.EQ.0) DAYS(2)=28
      IF (ND.LE.DAYS(NM)) GO TO 440
320   IF (ICOMD.EQ.KDATE) GO TO 700
      IF (TODAY(1).EQ.32) GO TO 700
      I=MIN0(NCHCMD+6,180)
      NCHCMD=I
      J=I-6
      IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1
C     32 = ASCII BLANK
      IF (J.LT.EQUAL) GO TO 700
330   COMAND(I)=COMAND(J)
      HOLCMD(I)=HOLCMD(J)
      J=J-1
      I=I-1
      IF (J.GE.EQUAL) GO TO 330
      DO 340 I=1,6
      COMAND(I+EQUAL-1)=TODAY(I)
340   HOLCMD(I+EQUAL-1)=TODAY(I)
      CALL EXCHAH (HOLCMD(EQUAL),6)
      WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD)
345   FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1))
      NERRG=MAX0(NERRG,1)
      GO TO 440
C
C     REWIND INTAPE
C
350   IF (INTAPE.EQ.0) GO TO 680
      IF (INTOPN.NE.0) GO TO 360
      I=1
C     OPEN INTAPE IF NOT ALREADY OPEN.  DO NOT CHECK EXCH LABEL.
      CALL EXCHRT (I,IBLOCK)
C     IGNORE STATUS
360   I=2
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
      GO TO 725
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH
C     BEGINS WITH A NUMBER FOLLOWED BY A BLANK.
C
C     INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     INTAPE = NUMBER SYSTEM DEPENDENT DATA
C     LIMIT = NUMBER
C     MARGIN = NUMBER
C     OUTAPE = NUMBER SYSTEM DEPENDENT DATA
C     OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     PRINTER = NUMBER
C     READER = NUMBER
C     SKIP = NUMBER
C     TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL)
C     WORK = NUMBER
C
370   NUMBER=0
      IF (EQUAL.EQ.0) GO TO 440
      DO 410 J=EQUAL,NCHCMD
      IF (COMAND(J).EQ.32) GO TO 420
C     32 = ASCII BLANK
      N=COMAND(J)-48
C     48 = ASCII ZERO
      IF (N.GE.0) GO TO 400
380   WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD)
390   FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS.  NOT PROCESSED./
     11X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
      GO TO 260
400   IF (N.GT.9) GO TO 380
410   NUMBER=10*NUMBER+N
      EQUAL=NCHCMD+1
      GO TO 440
420   EQUAL=J
430   EQUAL=EQUAL+1
      IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440
C     32 = ASCII BLANK
C
C     PRELIMINARY FORMAT CHECKING IS COMPLETE
C
440   J=ICOMD+1
C             0  1   2  3  4  5   6  7  8   9  10 11  12 13 14  15  16
      GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6
     120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595),
     2J
C     17 18  19 20  21 22 23 24 25  26  27 28  29  30 31 32  33 34  35
C
C     DATE=YYMMDD
C
450   DO 460 I=1,6
460   TODAY(I)=COMAND(EQUAL+I-1)
      GO TO 10
C
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA.
C
470   I=INFILE
      J=1
      GO TO 500
C
C     INCLUDE = NUMBER SYSTEM DEPENDENT DATA.
C
480   I=INALT
      J=3
      INALT=IABS(INALT)
      GO TO 500
C
C     TEXT
C
490   I=INTEXT
      J=2
      IF (EQUAL.EQ.0) GO TO 560
C
C     OPEN AN INPUT FILE.
C
500   IF (NUMBER.EQ.0) GO TO 505
      IF (NUMBER.EQ.OUFILE) GO TO 710
      IF (NUMBER.EQ.OUTAPE) GO TO 710
505   IF (J.EQ.2) GO TO 510
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (I.NE.0) CALL EXCHIM
510   IF (J-2) 520,530,540
520   INFILE=NUMBER
      GO TO 550
530   INTEXT=NUMBER
      GO TO 550
540   INALT=NUMBER
550   IF (NUMBER.EQ.0) GO TO 560
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      CALL EXCHCX (J+1)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHIM
      ACTION=2
C     ACTION = 2 MEANS REWIND
      IF (J.EQ.3) CALL EXCHIM
      INALT=-IABS(INALT)
560   ACTION=0
C     ACTION = 0 MEANS READ TEXT
      GO TO 730
C
C     INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
570   IF (INTOPN.EQ.0) GO TO 580
C     CLOSE THE INPUT TAPE, IGNORE STATUS.
      I=4
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
580   INTAPE=NUMBER
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (INTAPE.NE.0) CALL EXCHCX (6)
      GO TO 725
C
C     LIMIT = NUMBER
C
590   LIMIT=NUMBER
      GO TO 10
C
C     MARGIN = NUMBER
C
C     MINIMUM MARGIN IS 60
595   MARGIN=MAX0(NUMBER,60)
      GO TO 10
C
C     OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
600   IF (OUTOPN.EQ.0) GO TO 610
C     WRITE AND END-OF-FILE MARK ON OUTAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (I,OBLOCK,OBLOCK)
C     IGNORE STATUS
      OUTOPN=0
      PHASE=1
610   OUTAPE=NUMBER
      OUTUPD=MODIFY
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (OUTAPE.NE.0) CALL EXCHCX (7)
      GO TO 730
C
C     OUTPUT =  NUMBER SYSTEM DEPENDENT INFORMATION
C
620   ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      OUFILE=NUMBER
      IDCUR=IDSTRT
      IF (OUFILE.EQ.0) GO TO 730
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND.
      CALL EXCHCX (5)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHOU (OUTREC)
      GO TO 730
C
C     PRINTER = NUMBER.
C
630   CALL EXCHFO (-2)
      PRINTR=NUMBER
      CALL EXCHFO (2)
      GO TO 10
C
C     READER = NUMBER.
C
640   IF (INFILE.NE.0) GO TO 670
      CALL EXCHFO (-1)
      READER=NUMBER
      CALL EXCHCX (1)
      CALL EXCHFO (1)
      GO TO 10
C
C     WORK = NUMBER
C
650   IF (WORKF.GT.0) CALL EXCHFO (-3)
      WORKF=NUMBER
C     WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4.
      GO TO 10
C
C     UPDATE
C
C     DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR
C     SIMPLY TO OUTPUT THE UPDATE COMMAND.
660   IF (PHASE.GE.4) TRANS=5
      GO TO 730
C
C     ERROR MESSAGES.
C
670   NUMBER=3
C     MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE.
      GO TO 720
680   NUMBER=4
C     MESSAGE 4 - INTAPE IS NOT DEFINED.
      GO TO 720
690   NUMBER=12
C     MESSAGE 12 - NO PARAMETER STRING.
      GO TO 720
700   NUMBER=13
C     MESSAGE 13 - IMPROPER DATE.
      GO TO 720
710   NUMBER=31
C     MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT.
C
C     RETURN TO ERROR MESSAGE SEGMENT.
C
720   TRANS=8
      GO TO 740
c
c     Indicate the WORK file is empty.
c
725   if (nrwork.le.0 .or. workf.le.0) go to 730
      REWIND WORKF
      NRWORK=0
C
C     IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP.
C
730   IF (TRANS.EQ.1) GO TO 10
740   RETURN
C
      END
      SUBROUTINE EXCHCX (REASON)
C
C     PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER
C     PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT,
C     INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS.
C     PORTABLE VERSION.
C
      INTEGER REASON
C
C     REASON=0 FOR UNRECOGNIZED COMMAND.
C     REASON=1 BEFORE OPENING READER.
C     REASON=2 BEFORE OPENING INFILE.
C     REASON=3 BEFORE OPENING INTEXT.
C     REASON=4 BEFORE OPENING INALT.
C     REASON=5 BEFORE OPENING OUFILE.
C     REASON=6 BEFORE OPENING INTAPE.
C     REASON=7 BEFORE OPENING OUTAPE.
C
      RETURN
C
      END
      SUBROUTINE  EXCHC2
C
C     PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KINDE /32/
      DATA KOPTI /14/
      DATA KSITE /25/
C
C     FIGURE OUT WHICH COMMAND GOT US HERE.
C
      IF (ICOMD-KOPTI) 60,150,10
10    IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270
C
C     ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT
C     WHERE C1, C2, STEP AND START ARE INTEGERS.
C     STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP,
C     START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF
C     CHARACTERS OF TEXT IN IDTXTL.  IF AN ERROR OCCURS,
C     STORE ZERO IN IDSTEP AND IDTXTL.
C     IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO.
C
C     STORE THE MODIFIER IN IDOPTN.
C     IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE
C     PRODUCED ONLY FOR IMAGES FROM INTAPE.  IF THE O MODIFIER
C     IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES
C     WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT.  IF THE F
C     MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION
C     OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE
C     PRODUCED FOR ALL IMAGES OUTPUT.  IF THE C MODIFIER IS SPECIFIED,
C     SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH
C     RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR
C     ALL IMAGES OUTPUT.  IF NONE OF THE I, F, OR C MODIFIERS ARE
C     SPECIFIED, THE O MODIFIER IS ASSUMED.
C
C     IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED.
C     IF IDTXTL = ZERO, TEXT IS NOT EMITTED.
C     IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE
C     EMITTED.
C
C     CONVERT C1,C2,STEP,START
C
      IDOPTN=MODIFY
      IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79
C     70 = ASCII F, 73 = ASCII I, 79 = ASCII O.
      DO 40 J=1,4
      NUMBER=0
20    IF (EQUAL.GT.NCHCMD) GO TO 40
      IF (COMAND(EQUAL).EQ.44) GO TO 30
C     44 = ASCII ,
      I=COMAND(EQUAL)-48
      IF (I.LT.0) GO TO 350
      IF (I.GT.9) GO TO 350
      NUMBER=10*NUMBER+I
      EQUAL=EQUAL+1
      GO TO 20
30    EQUAL=EQUAL+1
40    IDNBRS(J)=NUMBER
      IDCUR=IDSTRT
      IDCOL1=MAX0(1,MIN0(IDCOL1,178))
      IDCOL2=MIN0(IDCOL2,178)
C
C     STORE TEXT.
C
      IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0)
      IF (IDTXTL.EQ.0) GO TO 330
      DO 50 J=1,IDTXTL
      IDTEXT(J)=COMAND(EQUAL)
50    EQUAL=EQUAL+1
      GO TO 330
C
C     INDEX = PARAMETER STRING
C
60    J=0
      IF (COMAND(EQUAL).NE.45) GO TO 70
C     45 = ASCII -
      J=-1
      EQUAL=EQUAL+1
70    N=0
      DO 80 I=1,26
80    INDEXS(I)=0
90    IF (EQUAL.GT.NCHCMD) GO TO 130
      I=COMAND(EQUAL)-64
      IF (I.EQ.-32) GO TO 120
C     32 = ASCII BLANK.
      IF (I.GE.32) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.LE.0) GO TO 100
      IF (I.LE.26) GO TO 110
100   N=EQUAL
      GO TO 120
110   INDEXS(I)=1
120   EQUAL=EQUAL+1
      GO TO 90
130   INDEX=0
      DO 140 I=1,26
      INDEXS(I)=IABS(INDEXS(I)+J)
140   INDEX=INDEX+INDEXS(I)
      IF (MODIFY.EQ.76) INDEX=-INDEX
C     76 = ASCII L.
      IF (N) 340,330,340
C
C     OPTION = PARAMETER STRING
C
150   IF (MODIFY.NE.0) GO TO 170
      DO 160 I=1,26
160   OPTVAL(I)=0
170   IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330
      I=1
      IF (MODIFY.EQ.67) I=0
C     67 = ASCII C.
      N=0
      DO 190 J=EQUAL,NCHCMD
      K=COMAND(J)
      IF (K.GE.96) K=K-32
C     CONVERT TO UPPER CASE.
      IF (K.EQ.32) GO TO 190
C     32 = ASCII BLANK
      IF (K.LT.65) GO TO 180
      IF (K.GT.90) GO TO 180
C     PROCESS ALPHABETIC OPTIONS.
      OPTVAL(K-64)=I
      GO TO 190
180   N=J
190   CONTINUE
      IF (N) 330,330,340
C
C     PROCESS PRED = ID REC A/X MASK STRING
C       WHERE ID = PREDICATE IDENTIFIER (A-H),
C       REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE,
C       A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH
C             IN EXACT POSITION,
C       MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE
C              TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED.
C       STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF
C                CONTROL RECORDS.
C
C     THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR
C     PREDICATE A, ETC.
C
C     PRED(1,*)=LENGTH OF STRING + 3
C     PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED.
C     PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND).
C     PRED(3,*)=RECORD TYPE.
C     PRED(4,*)=A/X
C     PRED(5,*)=MASK CHARACTER.
C     PRED(6..42,*)=STRING.
C
200   IF (EQUAL.NE.0) GO TO 240
C     LIST ALL ACTIVE PREDICATES.
      DO 230 I=1,8
      IF (PRED(1,I).EQ.0) GO TO 230
      J=PRED(1,I)+1
      COMAND(1)=I+64
      DO 210 K=2,J
210   COMAND(K)=PRED(K+1,I)
      CALL EXCHAH (COMAND,J)
      WRITE (PRINTR,220) (COMAND(K),K=1,J)
220   FORMAT (6H PRED=,42A1)
230   CONTINUE
      GO TO 330
C     SAVE PREDICATE IF VALID.
240   IF (NCHCMD.LE.EQUAL+3) GO TO 370
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.GT.72) GO TO 360
C     72 = ASCII H
      NUMBER=J-64
      PRED(1,NUMBER)=0
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.GT.90) GO TO 360
C     90 = ASCII Z
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.EQ.82) GO TO 360
C     82 = ASCII R
      PRED(3,NUMBER)=J
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.NE.65.AND.J.NE.88) GO TO 360
C     65 = ASCII A, 88 = ASCII X
      PRED(4,NUMBER)=J
      EQUAL=EQUAL+1
      PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40)
      I=4
      DO 250 J=EQUAL,NCHCMD
      I=I+1
      IF (I.GT.42) GO TO 330
      K=COMAND(J)
      IF (K.GT.96) K=K-32
C     CONVERT TO UPPER CASE.
250   PRED(I,NUMBER)=K
      GO TO 330
C
C     SITE = SITE NAME
C
260   JUMP=1
      GO TO 280
C
C     TITLE = OUTPUT TAPE TITLE
C
270   JUMP=2
280   K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 320 I=1,40
      IF (K.GT.NCHCMD) GO TO 290
      J=COMAND(K)
      K=K+1
      GO TO 300
290   J=32
C     32 = ASCII BLANK.
300   IF (JUMP.EQ.2) GO TO 310
      SITE(I)=J
      GO TO 320
310   TITLE(I)=J
320   CONTINUE
C
C     RETURN TO COMMAND DECODER.
C
330   TRANS=1
      GO TO 390
C
C     ERROR MESSAGES
C
340   NUMBER=14
C     MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED.
      EQUAL=N
      GO TO 380
350   IDSTEP=0
      IDTXTL=0
360   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED.
      GO TO 380
370   NUMBER=30
C     MESSAGE 30 - COMMAND IS INCOMPLETE.
C
380   TRANS=8
C
390   RETURN
C
      END
      SUBROUTINE EXCHC3 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE
C     COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES.
C
C     OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE
C     NAME COMMAND.
C
C     OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING
C     COPY, NAME OR UPDATE COMMANDS.
C
C ID      IS USED TO CONSTRUCT THE OUTPUT LABEL.
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                                    E  X  C  H
      DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/
C                                    A  N  G  E
      DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/
      DATA KNAME /9/
      DATA KSKIP /26/
C
C     OPEN INTAPE IF NECESSARY
C
      IF (INTOPN.NE.0) GO TO 70
      IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300
      IF (INTAPE.EQ.OUTAPE) GO TO 360
      CALL EXCHRH (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 310
      INTOPN=1
C     COPY THE LABEL TO A SAVE AREA.
      DO 10 I=1,180
10    LABELI(I)=CBLCKI(I)
      CALL EXCHAH (CBLCKI(13),138)
      WRITE (PRINTR,20)
20    FORMAT (25H0INPUT LABEL INFORMATION.)
      WRITE (PRINTR,30) (CBLCKI(I),I=13,104)
30    FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/
     1        20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1)
      IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150)
40    FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1)
      WRITE (PRINTR,50) NDATAI
50    FORMAT (28H DATA CHARACTERS PER BLOCK =,I6)
      IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI
60    FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6)
      CHAR1L=0
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 290
70    IF (ICOMD.EQ.KSKIP) GO TO 270
C
C     OPEN OUTAPE IF NECESSARY
C
80    IF (ICOMD.EQ.0) GO TO 90
      IF (ICOMD.LT.KNAME) GO TO 100
90    IF (INTAPE*OUTAPE.EQ.0) GO TO 100
      IF (OUTUPD.NE.85) GO TO 370
C     85 = ASCII U.
100   IF (OUTOPN.NE.0) GO TO 240
      IF (OUTAPE.EQ.0) GO TO 240
C     CONSTRUCT THE OUTPUT LABEL.
      IF (TODAY(1).EQ.0) GO TO 340
      IF (INTOPN.EQ.0) GO TO 160
      DO 110 I=1,180
110   CBLCKO(I)=LABELI(I)
      IF (TITLE(1).EQ.32) GO TO 130
C     32 = ASCII BLANK
      DO 120 I=1,40
120   CBLCKO(I+18)=TITLE(I)
130   IF (OUTUPD.NE.85) GO TO 220
C     85 = ASCII U.
      IF (SITE(1).EQ.0) GO TO 350
      DO 140 I=1,6
140   CBLCKO(I+104)=TODAY(I)
      DO 150 I=1,40
150   CBLCKO(I+110)=SITE(I)
      GO TO 220
160   IF (TITLE(1).EQ.32) GO TO 330
C     32 = ASCII BLANK
      IF (SITE(1).EQ.0) GO TO 350
      IF (INTAPE*OUTAPE.EQ.0) GO TO 170
      IF (INTAPE.EQ.OUTAPE) GO TO 360
170   DO 180 I=1,8
180   CBLCKO(I)=ID(I)
      DO 190 I=1,40
      CBLCKO(I+18)=TITLE(I)
190   CBLCKO(I+64)=SITE(I)
      DO 200 I=1,6
200   CBLCKO(I+58)=TODAY(I)
      DO 210 I=105,180
210   CBLCKO(I)=0
220   CALL EXCHWH (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 320
      OUTOPN=1
      CBLCKO(1)=CBLCKO(105)
      CALL EXCHAH (CBLCKO(13),138)
      WRITE (PRINTR,230)
      WRITE (PRINTR,30) (CBLCKO(I),I=13,104)
230   FORMAT (26H0OUTPUT LABEL INFORMATION.)
      IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150)
      WRITE (PRINTR,50) NDATAO
      IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO
      CHAR1L=0
240   IF (ICOMD-KNAME) 250,260,280
C
C     COPY
C
250   TRANS=4
      MODEI=1-MIN0(1,OUFILE+OPTL)
      IF (ICOMD.EQ.0) MODEI=0
      GO TO 390
C
C     NAME
C
260   TRANS=5
      IF (NRWORK.EQ.0) PHASE=4
      GO TO 390
C
C     SKIP
C
270   TRANS=4
      GO TO 390
C
C     UPDATE
C
280   TRANS=5
      MODEI=0
      GO TO 390
C
C     ERROR MESSAGES
C
290   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      EQUAL=ISTAT
      GO TO 380
300   NUMBER=4
C     MESSAGE 4 - INTAPE NOT DEFINED.
      GO TO 380
310   NUMBER=5
C     MESSAGE 5 - UNABLE TO OPEN INTAPE.
      EQUAL=ISTAT
      GO TO 380
320   NUMBER=6
C     MESSAGE 6 - UNABLE TO OPEN OUTAPE.
      EQUAL=ISTAT
      GO TO 380
330   NUMBER=7
C     MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE.
      GO TO 380
340   NUMBER=8
C     MESSAGE 8 - DATE NOT SUPPLIED.
      GO TO 380
350   NUMBER=9
C     MESSAGE 9 - SITE NOT SUPPLIED.
      GO TO 380
360   NUMBER=10
C     MESSAGE 10 - INTAPE = OUTAPE.
      GO TO 380
370   NUMBER=11
C     MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED.
380   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM
C
390   RETURN
C
      END
      SUBROUTINE EXCHRH (ISTAT,DBLOCK)
C
C     READ THE HEADER LABEL FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE
C               NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     OPEN THE INPUT TAPE.
C
      ISTAT=1
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     READ A BLOCK.
C
      NDATAI=171
      NERRCI=0
      BLKSQI=0
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     FIND OUT IF IT IS A PROPER LABEL.
C
      CALL EXCHUN (DBLOCK,CBLCKI)
      DO 10 I=1,8
      IF (CBLCKI(I).NE.ID(I)) GO TO 20
10    CONTINUE
C
C     GET READY TO READ THE REST OF THE TAPE.
C
      CCDBI=NCDBI
      NDATAI=256*CBLCKI(9)+CBLCKI(10)
      NERRCI=256*CBLCKI(11)+CBLCKI(12)
      LASTI=0
      L1PRGI=0
      ISTAT=0
      GO TO 30
C
C     NOT A LABEL.
C
20    ISTAT=6
C
C     CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK.
25    I=4
      CALL EXCHRT (I,DBLOCK)
C
30    RETURN
C
      END
      SUBROUTINE EXCHWH (ISTAT,DBLOCK)
C
C     WRITE A HEADER ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE
C               WRITTEN ARE NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     MAKE SURE IT IS A PROPER LABEL.
C
      DO 10 I=1,8
      IF (CBLCKO(I).NE.ID(I)) GO TO 30
10    CONTINUE
C
C     OPEN THE OUTPUT TAPE.
C
      ISTAT=1
      CALL EXCHWT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 40
C
C     CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR
C     CONTROL CHARACTERS
C
      CBLCKO(9)=NDATAO/256
      CBLCKO(10)=MOD(NDATAO,256)
      CBLCKO(11)=NERRCO/256
      CBLCKO(12)=MOD(NERRCO,256)
C
C     INSERT TODAYS DATE
C
      DO 20 I=1,6
20    CBLCKO(I+12)=TODAY(I)
C
C     WRITE THE BLOCK ON TAPE.
C
      BLKSQO=0
      CALL EXCHPA (CBLCKO,DBLOCK)
      CCDBO=180
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     GET READY TO WRITE THE REST OF THE FILE.
C
      L1PRGO=0
      LLPRGO=0
      N1RECO=0
      NLRECO=0
      L1RECO=0
      LASTO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      GO TO 40
C
C     NOT A PROPER LABEL.
C
30    ISTAT=6
C
40    RETURN
C
      END
      SUBROUTINE EXCHC4 (IBLOCK)
      INTEGER IBLOCK(1)
C
C     PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM
C     COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KCOPY /3/
C
C     ARE WE STARTING OR CONTINUING?
C
C     ICOMD.EQ.0  MEANS  CHANGE A CONTROL RECORD
C     ICOMD.GT.0  MEANS  SKIP OR COPY COMMAND BEGIN
C     ICOMD.EQ.-1 MEANS  CONTINUE COPY = NUMBERS
C     ICOMD.EQ.-2 MEANS  CONTINUE COPY = PREDICATE EXPRESSION
      NEWP=0
      IF (ITYPEI.EQ.80) VERT=0
C     80 = ASCII P.  WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO
C     IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON
C     THE WORK FILE.
      IF (ICOMD.EQ.0) GO TO 190
C     ICOMD=0 MEANS CHANGING A CONTROL RECORD.
      IF (ICOMD+1) 290,170,10
10    IF (ICOMD.EQ.KCOPY) GO TO 30
C
C     SKIP COMMAND.
C
      IF (INTOPN.LT.0) GO TO 430
      if (modify.eq.70) number=number+n1reci-1
c     70 = ASCII F.
      IF (NUMBER+1-N1RECI) 540,430,20
20    CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.EQ.69) GO TO 460
C     69 = ASCII E.
      IF (N1RECI-NUMBER) 20,20,430
C
C     COPY COMMAND FORMAT VERIFICATION.
C
30    IF (COMAND(EQUAL).LT.48) GO TO 180
C     48 = ASCII ZERO
      IF (COMAND(EQUAL).GT.57) GO TO 180
C     57 = ASCII NINE
C
C     COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS.
C     CONVERT THE NUMBERS AND STORE THEM IN COMAND.  IF THE NUMBER
C     IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER.
C
      ICOMD=-1
      I=0
      J=44
C     44 = ASCII COMMA
40    I=I+1
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 480
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=NUMBER
50    EQUAL=EQUAL+1
      IF (EQUAL.GT.NCHCMD) GO TO 60
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 60
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=10*COMAND(I)+NUMBER
      GO TO 50
60    IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70
70    IF (J.EQ.45) COMAND(I)=-COMAND(I)
C     45 = ASCII DASH
      IF (EQUAL.GT.NCHCMD) GO TO 90
      J=COMAND(EQUAL)
      IF (J.EQ.32 .OR. J.EQ.46) GO TO 90
C     32 = ASCII BLANK, 46 = ASCII PERIOD.
      IF (J.NE.44.AND.J.NE.45) GO TO 480
C     44 = ASCII COMMA, 45 = ASCII DASH
80    EQUAL=EQUAL+1
      IF (COMAND(EQUAL)-32) 40,80,40
C     32 = ASCII BLANK
90    NUMBER=I
C     FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE
C     POSITION IN COMAND CURRENTLY BEING EXAMINED.
      EQUAL=-1
100   EQUAL=EQUAL+1
      IF (EQUAL.GE.NUMBER) GO TO 470
      IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100
      IF (EQUAL.EQ.0) GO TO 120
      WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD)
110   FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H)
     1NOT COPIED./(1X,80A1))
      NERRG=MAX0(NERRG,5)
120   IF (COMAND(EQUAL+1).GT.0) GO TO 130
      EQUAL=EQUAL-1
      COMAND(EQUAL+1)=N1RECI
130   IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
C
C     PROCESS COPY = LIST OF NUMBERS
C
140   EQUAL=EQUAL+1
C     GO COPY THE PROGRAM IF IT IS THE RIGHT ONE.
150   IF (INTOPN.LT.0) GO TO 430
      IF (COMAND(EQUAL)-N1RECI) 170,420,160
C     SKIP TO DESIRED PROGRAM
160   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI-69) 150,460,150
C     69 = ASCII E
170   IF (EQUAL.GE.NUMBER) GO TO 430
      IF (COMAND(EQUAL+1).GE.0) GO TO 140
      COMAND(EQUAL)=IABS(COMAND(EQUAL))+1
      IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420
      EQUAL=EQUAL+1
      GO TO 170
C
C     COPY = SELECTION STRING OR CHANGE CONTROL RECORD.
C
180   ICOMD=-2
      IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
      NRWORK=-1
C
C     DETERMINE NEED TO OPEN WORK FILE.
C
190   IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0)
     1IF (ICOMD) 290,430,290
      IF (WORKF.EQ.0) GO TO 500
      I=IABS(WORKF)
      IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510
      IF (WORKF.GT.0) GO TO 200
      WORKF=I
      CALL EXCHFO (3)
200   IF (ICOMD.NE.0) GO TO 280
C
C     CHANGE CONTROL RECORD.
C
      if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520
c     69 = ascii E, 73 = ascii I.
      if (nrwork.eq.0) go to 210
      if (itypei.eq.80) go to 520
c     80 = ascii P
210   IF (NUMBER-NRWORK-1) 530,220,410
220   NCHACT=NCHCMD+1-EQUAL
      IF (NCHACT.GT.0) GO TO 230
      NCHACT=1
      INTREC(1)=32
C     32 = ASCII BLANK
      GO TO 425
230   DO 240 I=1,NCHACT
240   INTREC(I)=COMAND(EQUAL+I-1)
      GO TO 425
C
C     COPY = SELECTION EXPRESSION.
C
C     SKIP TO NEXT PROGRAM.
250   IF (INTOPN.LT.0) GO TO 430
      if (itypei.eq.69) go to 460
c     69 = ASCII E.
      do 260 i = 1, 8
260   pred(2,i)=0
      if (itypei.ne.80) go to 265
c     If the current record is a new program, don't skip it (we haven't
c     processed it yet).
      if (nrwork.gt.0 .and. workf.gt.0) rewind workf
      nrwork=min0(nrwork,0)
      newp=0
      go to 320
265   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      nxnewp=0
270   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.NE.80) GO TO 310
C     80 = ASCII P
      NEWP=nxnewp
c     Set NEWP non-zero when all control records for a module have been
c     seen.
      GO TO 320
280   NRWORK=MAX0(NRWORK,0)
290   DO 300 I=1,8
300   PRED(2,I)=0
c     NEWP is non-zero when all control records have been read.
310   if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1
C     69 = ASCII E, 73 = ASCII I.
320   nxnewp=1
      if (icomd.eq.0) if (newp) 520,210,520
      IF (LIMIT.EQ.0) GO TO 340
      IF (N1RECI.LE.LIMIT) GO TO 340
      WRITE (PRINTR,330) LIMIT
330   FORMAT (7H LIMIT=,I6,9H REACHED.)
      GO TO 430
340   IF (NEWP.EQ.0) GO TO 360
      CALL EXCHLX
C     EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'.
      NUMBER=NCHCMD
      IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415
C     73 = ASCII I.
      IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425
C     80 = ASCII P.
      IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425
C     83 = ASCII S.
      IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415
C     88 = ASCII X.
      IF (COMAND(180)) 450,250,420
C     CONTROL RECORD.  EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE.
360   I=1
      DO 400 NUMBER=1,8
      IF (PRED(1,NUMBER).EQ.0) GO TO 400
      IF (PRED(2,NUMBER).NE.0) GO TO 400
      IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390
      NM=PRED(1,NUMBER)-3
      IF (.NOT.(NCHACT.GT.0)) GO TO 390
      DO 385 L = 1, NCHACT
      DO 380 J = 1, NM
C
C     DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND
C     IN PREDICATE.
      IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380
      IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370
C
C     NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS.
      K=32
      GO TO 375
C     USE CHARACTER FROM CONTROL RECORD.
370   K=INTREC(J+L-1)
C
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (K.GT.96 .AND. K.LT.123) K=K-32
C
C     TEST FOR A MATCH ON A SINGLE CHARACTER.
C     IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE
C     PATTERN.  IF THE SEARCH MODE IS X, TERMINATE THE SEARCH.
375   IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390
380   CONTINUE
C
C     FOUND A MATCH IN CONTROL RECORD AND PREDICATE.
      PRED(2,NUMBER)=1
      GO TO 400
385   CONTINUE
390   I=0
400   CONTINUE
      IF (I.NE.0) newp=1
      IF (NRWORK.LT.0) GO TO 270
C     AT LEAST ONE FALSE PREDICATE.  WRITE THE CONTROL RECORD ON WORKF.
410   WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT)
      NRWORK=NRWORK+1
      GO TO 270
C
C     GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM.
C
415   ICOMD=-3
C     RETURN TO EXCHC1 AFTER COPYING MODULE.
420   TRANS=5
      GO TO 570
C
C     RETURN TO THE COMMAND PROCESSOR.
C
425   TRANS=1
C     REMEMBER CONTROL RECORDS ON WORKF.
      GO TO 570
430   TRANS=1
      IF (ICOMD+1) 560,570,570
C
C     ERROR MESSAGES.
C
440   NUMBER=1
C     MESSAGE 1 - I/O ERROR.
      EQUAL=ISTAT
      GO TO 550
450   NUMBER=-COMAND(180)
C     MESSAGES GENERATED BY EXCHLX
      GO TO 550
460   IF (INTOPN.LT.0) GO TO 430
      INTOPN=-1
      EQUAL=NUMBER
      NUMBER=15
C     MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE.
      GO TO 550
470   NUMBER=16
C     MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION.
      GO TO 550
480   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER
      GO TO 550
490   NUMBER=18
C     MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER.
      GO TO 550
500   NUMBER=19
C     MESSAGE 19 - WORK FILE NOT DEFINED.
      GO TO 550
510   NUMBER=20
C     MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE.
      GO TO 550
520   EQUAL=NUMBER
      NUMBER=21
C     MESSAGE 21 - CONTROL RECORD NOT PRESENT
      GO TO 550
530   NUMBER=22
C     MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER.
      GO TO 550
540   NUMBER=29
C     MESSAGE 29 - BACKWARD SKIP IGNORED.
C
C     RETURN TO THE ERROR MESSAGE PROCESSOR.
C
550   TRANS=8
      IF (ICOMD.EQ.0) GO TO 570
C
C     DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF.
C
560   IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
C
C     RETURN TO TRANSITION PROGRAM.
C
570   RETURN
C
      END
      SUBROUTINE EXCHLX
C
C     EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND.
C
C     THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE
C     STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM
C     COPY=LOGICAL EXPRESSION.  THE LOGICAL EXPRESSION CONSISTS OF THE
C     EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY
C     OPERATORS + - * / AND PARENEHESES.  THE PRIMARY SYMBOLS A-H ARE
C     LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE
C     STATEMENTS.  THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE
C     NULL PREDICATE, WHICH IS ALWAYS FALSE.  THE OPERATORS + - * / ARE
C     THE BINARY LOGICAL OPERATIONS   OR, OR NOT, AND, AND NOT
C     RESPECTIVELY.  THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE
C     PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL
C     PRIORITY.  THE RELATIVE PRIORITY MAY BE CHANGED BY USING
C     PARENTHESES.
C
C     WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY
C     FALSE.  AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL
C     FALSE PREDICATES IS DETERMINED.  ONCE TRUE, A PREDICATE REMAINS
C     TRUE.  THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND
C     A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE.  WHEN ALL ACTIVE
C     PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM
C     HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND
C     IS EVALUATED.  IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED.
C     IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED.  THIS PROCESS
C     CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM
C     NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED.
C
C     THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE
C     TABLE BELOW.  INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS
C     APPENDED TO THE END OF THE LOGICAL EXPRESSION.
C
C     PREVIOUS  I                 CURRENT TOKEN                   I
C      TOKEN    I + - * / I PRIMARY I    (    I    )    I  ELSE   I
C     ----------I---------I---------I---------I---------I---------I
C      + - * /  I  ERROR  I   OK    I   OK    I  ERROR  I  ERROR  I
C      PRIMARY  I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C         (     I  ERROR  I   OK    I   OK    I   OK    I  ERROR  I
C         )     I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C     ----------I---------I---------I---------I---------I---------I
C
C     CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING
C     A STACK AND THE PRECEDENCE TABLE BELOW.  TOS MEANS TOP-OF-STACK,
C     HOI MEANS HEAD-OF-INPUT.  THE STACK INITIALLY CONTAINS (.
C
C                  TOS       HOI
C      TOKEN   I  INDEX  I  INDEX  I
C     ---------I---------I---------I
C       + -    I    2    I    1    I
C       * /    I    4    I    3    I
C     PRIMARY  I    6    I    5    I
C        (     I    0    I    7    I
C        )     I   N/A   I    0    I
C     ---------I---------I---------I
C
C     WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS
C     PUSHED ONTO THE STACK.  WHEN THE TOS INDEX IS GREATER THAN THE HOI
C     INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY
C     SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT
C     PLACED IN THE SUFFIX LIST.  THEN THE RELATION OF THE TOS INDEX TO
C     THE HOI INDEX IS RE-EXAMINED.  WHEN THE TOS INDEX IS EQUAL TO THE
C     HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED.
C
C     *****     INTERNAL VARIABLES     *********************************
C
C CHTAB   RECOGNIZED CHARACTERS.  INTERNAL PROCESSES USE THE INDEX
C         INTO CHTAB.
C COLTAB  CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX.
C HOI     CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE.
C INFIX   IS THE CURRENT POSITION IN THE INFIX.
C IPREV   IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN.
C ISTACK  IS THE CURRENT STACK INDEX.
C ISUFIX  IS THE CURRENT SUFFIX INDEX.
C SYNTAX  CONTAINS THE SYNTAX RULES.
C TOS     CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE.
C
      INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     DATA STATEMENTS     ************************************
C
C                                                    A  B  C  D
      DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/
C                                                    E  F  G  H
      DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/
C                                                    N  +  -  *
      DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/
C                                                    /  (  )
      DATA CHTAB(13),CHTAB(14),CHTAB(15)           /47,40,41   /
C                                                       A B C D
      DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/
C                                                       E F G H
      DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/
C                                                       N + - *
      DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/
C                                                       / ( )
      DATA COLTAB(13),COLTAB(14),COLTAB(15)            /1,3,4  /
C                                                   A B C D E
      DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/
C                                                   F G H N +
      DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/
C                                                   - * / ( )
      DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/
C                 CURRENT TOKEN IS +-*/.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/
C                 CURRENT TOKEN IS PRIM.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/
C                 CURRENT TOKEN IS (.     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/
C                 CURRENT TOKEN IS ).     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/
C                                                   A B C D E
      DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/
C                                                   F G H N +
      DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/
C                                                   - * / ( )
      DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/
C
C     *****     PROCEDURES     *****************************************
C
C     COMAND IS USED FOR INFIX, STACK AND SUFFIX.  UPON COMPLETION,
C     COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE
C     OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE
C     EXPRESSION IS TRUE.
C
      ISTACK=NCHCMD+2
      COMAND(ISTACK)=14
      ISUFIX=181
      IPREV=3
      COMAND(NCHCMD+1)=41
      INFIX=EQUAL-1
C
C     GET A CHARACTER FROM INFIX.  LOOK UP IN CHTAB.  CHECK SYNTAX.
C
10    IF (INFIX.GT.NCHCMD) GO TO 180
      INFIX=INFIX+1
      J=COMAND(INFIX)
      IF (J.EQ.32) GO TO 10
C     32 = ASCII BLANK - IGNORE IT.
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      DO 20 I=1,15
      IF (CHTAB(I).EQ.J) GO TO 30
20    CONTINUE
      GO TO 230
30    J=COLTAB(I)
      IF (SYNTAX(IPREV,J)-1) 40,190,200
C
C     CONVERT INFIX TO SUFFIX
C
40    IPREV=J
50    J=COMAND(ISTACK)
      IF (TOS(J)-HOI(I)) 60,70,80
C     PUSH INFIX ONTO STACK
60    ISTACK=ISTACK+1
      COMAND(ISTACK)=I
      GO TO 10
C     DELETE TOP OF STACK
70    ISTACK=ISTACK-1
      IF (ISTACK.GT.NCHCMD+1) GO TO 10
      IF (INFIX-NCHCMD) 220,220,250
C     IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX.
C     IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX.
80    IF (J-9) 90,100,130
C     PRIMARY IS SYMBOL A-H
90    IF (PRED(1,J).EQ.0) GO TO 210
      J=PRED(2,J)
      GO TO 110
C     NULL PREDICATE
100   J=0
110   ISUFIX=ISUFIX-1
120   COMAND(ISUFIX)=J
      ISTACK=ISTACK-1
      GO TO 50
C     OPERATOR
130   J=J-9
      ISUFIX=ISUFIX+1
      GO TO (140,150,160,170), J
C             +   -   *   /
140   J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1)
      GO TO 120
150   J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1)
      GO TO 120
160   J=COMAND(ISUFIX)*COMAND(ISUFIX-1)
      GO TO 120
170   J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1))
      GO TO 120
C
180   COMAND(180)=-23
C     MESSAGE 23 - TOO MANY (
      GO TO 240
190   COMAND(180)=-24
C     MESSAGE 24 - MISSING PRIMARY
      GO TO 240
200   COMAND(180)=-25
C     MESSAGE 25 - MISSING OPERATOR
      GO TO 240
210   EQUAL=CHTAB(J)
      CALL EXCHAH (EQUAL,1)
      COMAND(180)=-26
C     MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE.
      GO TO 250
220   COMAND(180)=-27
C     MESSAGE 27 - TOO MANY )
      GO TO 240
230   COMAND(180)=-28
C     MESSAGE 28 - UNRECOGNIZED CHARACTER
C
240   EQUAL=INFIX
250   RETURN
C
      END
      SUBROUTINE EXCHC5 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE,
C     AND INDEX IF SELECTED.  COPY RECORDS FROM WORKF FIRST, IF ANY.
C     CREATE CONTROL RECORDS DEMANDED BY COMMANDS.
C
C     THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF
C     THE PARAMETER STRING.
C
C     AUTHOR
C     COMMENT
C     CONTROL (ITYPEO SET FROM MODIFY)
C     DATA TYPE
C     GROUPS
C     INSERT
C     KEYWORDS
C     MACHINE
C     ORIGIN
C     REFERENCES
C     REMOVE   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     SIGNAL   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     UPDATE
C
C     IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS
C     ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A
C     CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND.
C
C     *****     LOCAL VARIABLES     ************************************
C
C BLANK   CONTAINS A HOLLERITH BLANK.
      INTEGER BLANK
C C1      IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING.
      INTEGER C1
C COL1    THE FIRST COLUMN OF TEXT OF A CONTROL RECORD.  DERIVED FROM
C         EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE.
      INTEGER COL1
C I,J     USED FREELY AS INDICES.
      INTEGER I,J
C KCONT   THE INDEX IN COMD OF THE CONTROL COMMAND.
      INTEGER KCONT
C KNAME   IS THE INDEX IN COMD OF THE NAME COMMAND.
      INTEGER KNAME
C KTEXT   THE INDEX IN COMD OF THE TEXT COMMAND.
      INTEGER KTEXT
C KUPDA   THE INDEX IN COMD OF THE UPDATE COMMAND.
      INTEGER KUPDA
C LIST    CONTAINS THE WORD LIST IN ASCII.  USED FOR THE A OPTION.
      INTEGER LIST(4)
C NM      IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NM
C NOUT    IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NOUT
C NY      IS THE PROGRAM NUMBER.  IT IS THE NUMBER FROM INTAPE IF
C         OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE.
      INTEGER NY
C ONE     CONTAINS A HOLLERITH 1.
      INTEGER ONE
C REASON  REASON FOR COPYING A CONTROL RECORD.  1 = COPY COMMAND
C         PENDING.  2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8.
C         3 = COMMAND.
      INTEGER REASON
C RI      CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A
C         GIVEN RECORD TYPE.  RI IS SUBSCRIPTED BY (ITYPEO-64).
      INTEGER RI(26)
C RT      IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT.
      INTEGER RT(34)
C STAR    CONTAINS A HOLLERITH STAR.
      INTEGER STAR
C ZERO    CONTAINS A HOLLERITH ZERO.
      INTEGER ZERO
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL VARIABLE DATA     ********************************
C
      DATA BLANK /1H /
C                                            L  I  S  T
      DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/
C
      DATA KCONT /31/
      DATA KNAME /9/
      DATA KTEXT /27/
      DATA KUPDA/29/
      DATA ONE /1H1/
C                                                      A  B  C  D  E  F
      DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/
C                                                      G  H  I  J  K  L
      DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/
C                                                      M  N  O  P  Q  R
      DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/
C                                                      S  T  U  V  W  X
      DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/
C                                                      Y  Z
      DATA RI(25),RI(26)                             /31,31            /
C                                                     A  C     D     G
      DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/
C                                                           P     K
      DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/
C                                                     M     O
      DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/
C                                                              B  R
      DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/
C                                                                 S
      DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/
C                                                              J
      DATA RT(31),RT(32),RT(33),RT(34)              /-1, 0, 0,74/
C
      DATA STAR /1H*/
      DATA ZERO /1H0/
C
C     *****     PROCEDURES     *****************************************
C
      REASON=1
      NY=N1RECI
      IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1
C     ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P.
C     IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT.
      IF (PHASE.EQ.4) NY=0
C     NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER.  (IT IS PRINTED
C     IN THE INDEX).
      IF (ICOMD.LE.0) GO TO 10
      IF (PHASE.GE.4) GO TO 100
      IF (ICOMD.EQ.KNAME) GO TO 10
      IF (ICOMD.NE.KUPDA) GO TO 100
      REASON=2
      PHASE=8
10    IF (NRWORK.GT.0) REWIND WORKF
      NM=0
      NOUT=0
20    NM=NM+1
      IF (NM.LE.NRWORK) GO TO 60
30    IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230
C     69 = ASCII E, 73 = ASCII I.
      IF (NOUT.EQ.0) GO TO 40
      IF (ITYPEI.EQ.80) GO TO 230
C     80 = ASCII P.
      IF (NCHACT.NE.1) GO TO 40
      IF (INTREC(1).EQ.32) GO TO 220
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
40    ITYPEO=ITYPEI
      NCHOUT=NCHACT
      DO 50 J=1,NCHOUT
50    OUTREC(J+5)=INTREC(J)
      GO TO 70
60    READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT)
      IF (NCHOUT.NE.1) GO TO 70
      IF (NM.EQ.1) GO TO 70
      IF (OUTREC(6).EQ.32) GO TO 200
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
70    NOUT=NOUT+1
      J=RI(ITYPEO-64)
      DO 80 I=1,4
80    OUTREC(I)=COMD(I,J)
      OUTREC(5)=61
C     61 = ASCII =
      COL1=5
      IF (J.NE.KCONT) GO TO 130
      COL1=7
C     CONTROL,*=...  MOVE UP TWO CHARACTERS AND INSERT ITYPEO.
      DO 90 I=1,NCHOUT
90    OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I)
      OUTREC(5)=44
C     44 = ASCII COMMA.
      OUTREC(6)=ITYPEO
      OUTREC(7)=61
C     61 = ASCII =
      GO TO 130
100   IF (ICOMD.EQ.KTEXT) GO TO 240
      COL1=EQUAL-1
      NCHOUT=NCHCMD-COL1
      NRWORK=NRWORK+1
C     NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD.
      ITYPEO=RT(ICOMD)
      IF (ITYPEO.GT.0) GO TO 110
C     PROCESS CONTROL,TYPE=TEXT COMMAND.
      ITYPEO=MODIFY
      IF (RI(ITYPEO-64).NE.KCONT) GO TO 320
110   NOUT=NRWORK
      REASON=3
      DO 120 I=1,NCHCMD
120   OUTREC(I)=COMAND(I)
130   IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1)
C     74 = ASCII J.
      IF (ITYPEO.EQ.80) VERT=0
C     80 = ASCII P
      IF (ITYPEO.NE.68) GO TO 150
C     68 = ASCII D
      IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150
      DO 140 J=1,4
      I=OUTREC(J+COL1)
      IF (I.GT.96 .AND. I.LT.123) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.NE.LIST(J)) GO TO 150
140   CONTINUE
      VERT=1
C     GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE.
150   CALL EXCHCG (OUTREC(COL1+1))
      IF (OUTOPN.EQ.0) GO TO 160
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1))
      IF (ISTAT.NE.0) GO TO 340
      NY=NLRECO
160   NCHOUT=NCHOUT+COL1
C     TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER.
      OUTREC(180)=-NOUT
      IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC)
C     PRINT THE INDEX IF SELECTED.
      IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO
     1190
      IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190
      C1=BLANK
C     DOUBLE SKIP FOR PROGRAM HEADER (P).
      IF (ITYPEO.EQ.80) C1=ZERO
      IF (OPTV+VERT.NE.0) GO TO 170
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170
      IF (CHAR1L.NE.ONE) C1=ONE
      CHAR1L=ONE
170   CALL EXCHAH (OUTREC,NCHOUT)
      WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT)
180   FORMAT (A1,2I5,1H*,(3X,105A1))
190   IF (REASON.EQ.3) GO TO 310
200   IF (NM-NRWORK) 20,210,220
210   REWIND WORKF
      NRWORK=0
      GO TO 30
220   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT) 330,30,330
230   IF (REASON.EQ.2) GO TO 300
240   IF (OUFILE.EQ.0) GO TO 260
      DO 250 I=1,4
250   OUTREC(I)=COMD(I,KTEXT)
      OUTREC(180)=0
      NCHOUT=0
C     TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED.
      CALL EXCHCG (OUTREC)
      NCHOUT=4
      ACTION=2-OPTC-OPTC
C     ACTION = 2 MEANS START OF PROGRAM.
      CALL EXCHOU (OUTREC)
260   IF (OPTV+VERT.NE.0) GO TO 280
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280
      IF (OUTOPN.NE.0) NY=NLRECO
      I=BLANK
      IF (CHAR1L.NE.ONE) I=ONE
      WRITE (PRINTR,270) I,NY
270   FORMAT (A1,I5,1H*,8X,4HTEXT/)
280   CHAR1L=STAR
      NRWORK=MIN0(NRWORK,0)
      IF (IDOPTN.NE.67) IDCUR=IDSTRT
C     67 = ASCII C
      IF (ICOMD.EQ.KTEXT) GO TO 290
C
C     WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL
C     RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED.
C
      TRANS=6
      GO TO 370
C
C     WORKING ON A TEXT STATEMENT.
C
290   TRANS=7
      GO TO 370
C
C     WORKING ON AN UPDATE STATMENT.
C
300   NRWORK=NOUT
      GO TO 100
C
C     WRITING A SINGLE CONTROL RECORD.
C
310   TRANS=1
      GO TO 370
C
C     ERROR MESSAGES.
C
320   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER.
      GO TO 360
330   NUMBER=1
      GO TO 350
340   NUMBER=2
350   EQUAL=ISTAT
360   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM.
C
370   RETURN
C
      END
      SUBROUTINE EXCHCG (RECORD)
C
C     USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL.
C     WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED.
C     THIS IS THE PORTABLE VERSION.  IT DOES NOT DO ANYTHING.
C
      INTEGER RECORD(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      RETURN
      END
      SUBROUTINE EXCHC6 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE.
C
      INTEGER KNAME,ONE,SVHCMD(180)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KNAME /9/
      DATA ONE /1H1/
C
      LINEO=0
      NERRS=0
C     SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT.
      DO 5 I = 1,NCHCMD
5     SVHCMD(I)=HOLCMD(I)
      IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165
C     73 = ASCII I.  IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE
C     A VOID MODULE.
      IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10
      CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.EQ.7) GO TO 220
      IF (ISTAT) 250,160,250
10    MODEO=MODEI
      ITYPEO=0
      NBC=OPTL+OUFILE
      IF (INDEX.GT.0) NBC=1
20    NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTOPN.EQ.0) GO TO 120
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 260
C
C     CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD
C     INSTEAD OF BYTE-BY-BYTE).  WE CAN DO A BLOCK COPY IF
C     WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT
C     FILE AND NOT PRINTING THE INDEX.  ALSO, THE INPUT AND
C     OUTPUT CHARACTER POSITIONS MUST BE THE SAME.  IF THE
C     PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH
C     THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE
C     CURRENT POSITION IN THE BYTE BUFFER BE THE SAME.
C     WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE
C     LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T
C     KNOW THE LOCATION OF THE END-OF-FILE RECORD.
C
      IF (NBC.NE.0) GO TO 120
      IF (CPCBI+1.NE.CPCBO) GO TO 120
      IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120
C     WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF.
      IF (L1PRGI.EQ.0) GO TO 25
      IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30
25    IF (CCDBI+1.NE.CCDBO) GO TO 120
      IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120
C     WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE).
C     FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO.
30    LI=L1PRGI+NERRCI-1
      IF (L1PRGI.NE.0) GO TO 40
      LI=NERRCI+NDATAI+9
      IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1
40    IF (CPCBI.GE.NCCBI) GO TO 50
      IF (CCDBI.GE.LI) GO TO 160
      CPCBI=CPCBI+1
      CBLCKO(CPCBO)=CBLCKI(CPCBI)
      CPCBO=CPCBO+1
      CCDBI=CCDBI+1
      CCDBO=CCDBO+1
      GO TO 40
C     PACK COPIED BYTES.
50    CALL EXCHPA (CBLCKO,OBLOCK(CWDBO))
      CPCBO=1
      CPCBI=0
      CWDBO=CWDBO+NWCBO
      CWDBI=CWDBI+NWCBI
C     NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM
60    IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70
      IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=L1RECI
      CALL EXCHPB (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 260
70    IF (CCDBI.LT.LI) GO TO 80
      IF (L1PRGI.NE.0) GO TO 100
      CALL EXCHGB (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 250
      GO TO 30
80    NW=NWCBI*((LI-CCDBI)/NCCBI)
      IF (NW.EQ.0) GO TO 100
      DO 90 I=1,NW
      OBLOCK(CWDBO)=IBLOCK(CWDBI)
      CWDBO=CWDBO+1
90    CWDBI=CWDBI+1
100   CCDBO=CCDBO+LI-CCDBI
      CCDBI=LI
      IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60
      CPCBI=MOD(LI,NCCBI)
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      CALL EXCHUN (IBLOCK(CWDBI),CBLCKI)
      IF (CPCBI.EQ.0) GO TO 160
      DO 110 I=1,CPCBI
110   CBLCKO(I)=CBLCKI(I)
      GO TO 160
C
C     END OF BLOCK COPY CODE.
C
120   CALL EXCHTP (INTREC,LINEO)
160   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 250
      IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20
C     73 = ASCII I.
165   IF (OPTL.NE.0) GO TO 180
      IF (INDEX.LE.0) GO TO 195
      WRITE (PRINTR,170) LINEO
170   FORMAT (I9,14H IMAGES COPIED)
      GO TO 200
180   WRITE (PRINTR,190)
190   FORMAT (1H1)
195   CHAR1L=ONE
200   IF (OUFILE.EQ.0) GO TO 210
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
210   IF (ITYPEI.EQ.69) GO TO 220
C     69 = ASCII E
C
C     RETURN TO THE COPY CONTROL SEGMENT.
C
      DO 215 I=1,NCHCMD
215   HOLCMD(I)=SVHCMD(I)
      IF (ICOMD.EQ.-3) GO TO 240
C     ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE.
      TRANS=4
      IF (ICOMD.NE.KNAME) GO TO 280
C     MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME'
C     COMMAND SUBMITTED.  GO PROCESS 'NAME' COMMAND.
      TRANS=5
      PHASE=4
      GO TO 280
C
C     END OF FILE ON INPUT TAPE.
C
220   IF (INTOPN.LT.0) GO TO 240
      WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD)
230   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1))
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
240   TRANS=1
      GO TO 280
C
C     ERROR MESSAGES.
C
250   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      GO TO 270
260   NUMBER=2
C     MESSAGE 2 - I/O ERROR WRITING OUTAPE.
270   TRANS=8
      EQUAL=ISTAT
C
C     RETURN TO THE TRANSITION PROGRAM.
C
280   IF (NERRS.EQ.0) GO TO 300
      WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD)
290   FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./
     1(1X,80A1))
      NERRG=MAX0(NERRS,NERRG)
300   RETURN
C
      END
      SUBROUTINE EXCHC7 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
      INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40)
C
C     PROCESS THE TEXT COMMAND.
C
C MSG     IS USED TO PRINT A MESSAGE.
      INTEGER MSG(6,2)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/
      DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/
      DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/
      DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/
      DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/
C
      LINEI=1
      LINEO=0
      NERRS=0
      INEND=0
      CHAR1L=STAR
C
C     SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND
C
      K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 20 I=1,40
      IF (K.GT.NCHCMD) GO TO 10
      J=COMAND(K)
      K=K+1
      GO TO 20
10    J=32
C     32 = ASCII BLANK.
20    TXDISK(I)=J
      IF (INTOPN.LE.0) ITYPEI=0
C
C     MAIN PROCESSING LOOP
C
60    EDIT=0
70    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 80
C     NCHCMD.LT.0 MEANS END OF FILE.
      IF (NCHCMD.LT.2) GO TO 100
      IF (COMAND(1).NE.SIGNAL) GO TO 100
      IF (COMAND(2).EQ.SIGNAL) GO TO 80
      IF (COMAND(2).EQ.73) GO TO 370
      IF (COMAND(2).EQ.105) GO TO 370
C     73,105 = ASCII I - REQUEST TO INCLUDE TEXT.
      IF (NCHCMD.LT.3) GO TO 100
      IF (COMAND(2).NE.61) GO TO 100
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 70
C     END OF TEXT FILE.
80    IF (INTEXT.EQ.0) GO TO 90
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      CALL EXCHIM
      INTEXT=0
      NCHCMD=0
90    NCHCMD=MIN0(NCHCMD,0)
      IF (PHASE.NE.8) GO TO 660
      IF (INEND) 660,630,660
100   IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110
110   IF (EDIT.EQ.0) GO TO 450
C
C     PARTIAL LINE EDITOR.
C     INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED.
C     EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES
C     THE FIRST NON-BLANK CHARACTER AFTER N2.  N1 AND N2 ARE COLUMN
C     LIMITS UNDER WHICH TO PERFORM THE EDITING.  N1 AND ,N2 ARE
C     OPTIONAL.  IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT
C     LIMIT.  IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS
C     ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE.  WHEN
C     STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING
C     PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT
C     LENGTHS OF STRING1 AND STRING2.  THE THIRD DELIMITER IS
C     OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED
C     AFTER STRING2 IS INSERTED.
C
      IF (INEND.NE.0) GO TO 240
C     CONVERT COLUMN NUMBERS.
      NBR1=0
      NBR2=0
      I=0
120   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.EQ.44) GO TO 150
C     44 = ASCII COMMA
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR1=10*NBR1+J-48
      GO TO 120
130   WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD)
140   FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/
     1(1X,80A1))
      NERRS=2
      GO TO 70
150   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR2=10*NBR2+J-48
      GO TO 150
C     SCAN FOR DELIMITER
160   IF (J.NE.32) GO TO 170
C     32 = ASCII BLANK
      I=I+1
      J=COMAND(I)
      GO TO 160
170   D1=I
      NBR1=MIN0(NBR1,180)
      NBR2=MIN0(NBR2,180)
      IF (NBR1.EQ.0) NBR1=1
      IF (NBR2.EQ.0) GO TO 180
      IF (NBR2.LT.NBR1) GO TO 130
180   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      IF (COMAND(I).NE.J) GO TO 180
      D2=I
      D3=0
190   I=I+1
      IF (I.GT.NCHCMD) GO TO 200
      IF (COMAND(I).NE.J) GO TO 190
      D3=I
C     LOOK FOR SEARCH STRING (STRING1)
200   NUMBER=D2-D1-1
      J=NBR1
      IF (NUMBER.EQ.0) GO TO 260
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
210   DO 220 I=1,NUMBER
      IF (I+J-1.GT.NY) GO TO 240
      IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230
220   CONTINUE
      GO TO 260
230   J=J+1
      GO TO 210
240   WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1))
      NERRS=2
      GO TO 70
C     FOUND SEARCH STRING.  REPLACE WITH UPDATE STRING.
260   CHAR1L=PLUS
      IF (D3.NE.0) GO TO 300
C     NO THIRD DELIMITER.   REPLACE REST OF REGION.
      NY=NBR2
      IF (NY.EQ.0) NY=180
      D2=D2+1
      IF (D2.GT.NCHCMD) GO TO 280
      DO 270 I=D2,NCHCMD
      INTREC(J)=COMAND(I)
      J=J+1
      IF (J.GT.NY) GO TO 280
270   CONTINUE
280   IF (NBR2.NE.0) GO TO 290
      NCHACT=J-1
      GO TO 70
290   IF (J.GT.NBR2) GO TO 70
      INTREC(J)=32
C     32 = ASCII BLANK
      J=J+1
      GO TO 290
C     WE HAVE A THIRD DELIMITER.  REPLACE ONLY THE SEARCH STRING.
C     SHIFT THE REST OF THE REGION AS NECESSARY.
300   NUMBER=(D3-D2)-(D2-D1)
      IF (NUMBER) 310,350,330
C     SHIFT LEFT
310   I=J+D2-D1-1
      NY=MIN0(NBR2,NCHACT)
      IF (NY.EQ.0) NY=NCHACT
320   IF (I.GT.NY) GO TO 350
      INTREC(I+NUMBER)=INTREC(I)
C     NOTE - NUMBER .LT. 0 HERE
      INTREC(I)=32
C     32 = ASCII BLANK
      I=I+1
      GO TO 320
C     RIGHT SHIFT
330   I=NBR2
      IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180)
      NY=J+NUMBER
340   IF (I.LT.NY) GO TO 350
      INTREC(I)=INTREC(I-NUMBER)
      I=I-1
      GO TO 340
C     NO SHIFT NEEDED.
350   IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180)
      IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2)
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
C     MOVE UPDATE STRING (STRING2).
360   D2=D2+1
      IF (D2.GE.D3) GO TO 70
      INTREC(J)=COMAND(D2)
      J=J+1
      IF (J-NY) 360,360,70
C
C     REQUEST TO INCLUDE TEXT.  -I IN COLUMNS 1 AND 2.
C
370   IF (EDIT.EQ.0) GO TO 390
      WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD)
380   FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X
     1,80A1))
      NERRS=2
      GO TO 70
390   ITYPEO=73
C     73 = ASCII I
      IF (NCHCMD.GE.4) GO TO 410
      WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD)
400   FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A
     11))
      NERRS=2
      GO TO 70
410   DO 420 I=4,NCHCMD
      IF (COMAND(I).NE.32) GO TO 430
420   CONTINUE
C     CONVERT TO UPPER CASE.  WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM
430   K=0
      DO 440 J=I,NCHCMD
      IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32
      K=K+1
440   COMAND(K)=COMAND(J)
      NCHCMD=K
      GO TO 460
C
C     TEXT RECORD.
C
450   ITYPEO=0
460   NCHOUT=NCHCMD
      IF (OUTOPN.EQ.0) GO TO 470
      MODEO=0
      CALL EXCHPR (ISTAT,OBLOCK,COMAND)
      IF (ISTAT.NE.0) GO TO 770
470   CALL EXCHTP (COMAND,0)
      GO TO 70
C
C     APPARENT CHANGE CONTROL COMMAND
C
480   IF (INEND.EQ.0) GO TO 510
490   WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD)
500   FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT
     1 END./(1X,80A1))
      NERRS=1
      GO TO 70
510   NUMBER=1
      NBR1=0
      EDIT=0
      I=1
520   I=I+1
      IF (I.GT.NCHCMD) GO TO 600
      J=COMAND(I)
      IF (J.EQ.32) GO TO 600
C     32 = ASCII BLANK
      IF (EDIT.NE.0) GO TO 530
C     EDIT CONTROL MUST BE BLANK AFTER $.
      IF (J.EQ.44) GO TO 570
C     44 = ASCII COMMA
      IF (J.EQ.36) GO TO 560
C     36 = ASCII $
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.LE.57) GO TO 550
C     57 = ASCII 9
530   WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD)
540   FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1)
      NERRS=2
      GO TO 60
550   NBR1=10*NBR1+J-48
      GO TO 520
560   IF (NBR1.EQ.0) GO TO 530
      EDIT=1
      NBR1=NBR1-1
      GO TO 520
570   NUMBER=2
      NBR2=0
580   I=I+1
      IF (I.GT.NCHCMD) GO TO 590
      J=COMAND(I)
      IF (J.EQ.32) GO TO 590
C     32 = ASCII BLANK
      IF (IABS(J-44).EQ.1) GO TO 590
C     43 = ASCII +, 45 = ASCII -
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 530
C     57 = ASCII 9
      NBR2=10*NBR2+J-48
      GO TO 580
590   IF (NBR2.LT.NBR1) GO TO 530
      NBR1=NBR1-1
600   IF (NBR1.GE.LINEI-1) GO TO 620
      WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD)
610   FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1)
      NERRS=2
      GO TO 60
620   IF (NCHCMD.LE.0) GO TO 630
      IF (LINEI.LE.NBR1) GO TO 630
      IF (NUMBER.EQ.1) GO TO 70
C     SKIP INTAPE UNTIL NBR2 IS SKIPPED.
      MODEI=1
      IF (LINEI.GE.NBR2) MODEI=0
      IF (LINEI-NBR2) 650,650,70
C     COPY FROM INTAPE UNTIL NBR1 COPIED.
630   MODEO=MODEI
      NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTAPE.EQ.0) GO TO 640
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 770
640   CALL EXCHTP (INTREC,LINEI)
      MODEI=0
      IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650
      IF (LINEI.EQ.NBR1) GO TO 650
      MODEI=1
650   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 760
      LINEI=LINEI+1
      IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620
C     73 = ASCII I
      INEND=1
      IF (NCHCMD.LE.0) GO TO 660
      I=NBR2
      IF (NUMBER.EQ.1) I=NBR1
      IF (LINEI-I) 490,490,70
660   IF (NERRS.EQ.0) GO TO 675
      J=1
      IF (PHASE.EQ.8) J=2
      WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS
670   FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.)
675   NERRG=MAX0(NERRG,NERRS)
      IF (OPTL+OPTS.NE.0) GO TO 690
      IF (OUTAPE+OUFILE.EQ.0) LINEO=0
      IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO
680   FORMAT (I9,14H IMAGES COPIED)
      GO TO 710
690   WRITE (PRINTR,700)
700   FORMAT (1H1)
      CHAR1L=ONE
710   IF (OUFILE.EQ.0) GO TO 720
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
720   IF (ITYPEI.NE.69) GO TO 750
C     69 = ASCII E
C
C     END OF FILE ON INPUT TAPE (UPDATE MODE).
C
      IF (INTOPN.LT.0) GO TO 750
      DO 730 I=1,40
730   HOLCMD(I+1)=TXDISK(I)
      HOLCMD(1)=32
      IF (TXDISK(1).NE.32) HOLCMD(1)=61
C     32 = ASCII BLANK, 61 = ASCII =
      CALL EXCHAH (HOLCMD,41)
      WRITE (PRINTR,740) (HOLCMD(I),I=1,41)
740   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1)
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
750   TRANS=1
      GO TO 790
C
C     ERROR MESSAGES.
C
760   NUMBER=1
      GO TO 780
770   NUMBER=2
780   EQUAL=ISTAT
      TRANS=8
C
C     RETURN TO THE TRANSITION PROGRAM.
C
790   PHASE=2
      IF (OUTOPN.EQ.0) PHASE=1
      RETURN
C
      END
      SUBROUTINE EXCHC8
C
C     PRINT ERROR MESSAGES.
C
C     ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE
      INTEGER S(31)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/
      DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/
      DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/
      DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/
      DATA S(29),S(30),S(31)                         /4,5,5        /
C
C             1  2  3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4
     160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751),
     2NUMBER
C     16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
10    WRITE (PRINTR,20) EQUAL
20    FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.)
      GO TO 50
30    WRITE (PRINTR,40) EQUAL
40    FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.)
50    GO TO (60,80,100,120,140,160), EQUAL
60    WRITE (PRINTR,70)
70    FORMAT (22H BLOCK SEQUENCE ERROR.)
      GO TO 180
80    WRITE (PRINTR,90)
90    FORMAT (20H BLOCK IS TOO SHORT.)
      GO TO 180
100   WRITE (PRINTR,110)
110   FORMAT (11H I/O ERROR.)
      GO TO 180
120   WRITE (PRINTR,130)
130   FORMAT (18H RECORD TOO LARGE.)
      GO TO 180
140   WRITE (PRINTR,150)
150   FORMAT (21H UNKNOWN RECORD TYPE.)
      GO TO 180
160   WRITE (PRINTR,170)
170   FORMAT (25H FIRST BLOCK NOT A LABEL.)
      GO TO 760
180   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1)
      INFILE=0
C
C     RETURN TO QUIT SEGMENT.
C
      TRANS=9
      GO TO 800
C
200   WRITE (PRINTR,210)
210   FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.)
      GO TO 760
220   WRITE (PRINTR,230)
230   FORMAT (//20H0INTAPE NOT DEFINED.)
      GO TO 760
240   WRITE (PRINTR,250)
250   FORMAT (//23H0UNABLE TO OPEN INTAPE.)
      GO TO 10
260   WRITE (PRINTR,270)
270   FORMAT (//23H0UNABLE TO OPEN OUTAPE.)
      GO TO 30
280   WRITE (PRINTR,290)
290   FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.)
      GO TO 760
300   WRITE (PRINTR,310)
310   FORMAT (//19H0DATE NOT SUPPLIED.)
      GO TO 760
320   WRITE (PRINTR,330)
330   FORMAT (//19H0SITE NOT SUPPLIED.)
      GO TO 760
340   WRITE (PRINTR,350) INTAPE
350   FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4)
      GO TO 760
360   WRITE (PRINTR,370)
370   FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.)
      GO TO 760
380   WRITE (PRINTR,390)
390   FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.)
      GO TO 760
400   WRITE (PRINTR,410)
410   FORMAT (//27H0COMMAND HAS IMPROPER DATE.)
      GO TO 760
420   WRITE (PRINTR,430) EQUAL
430   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.)
      GO TO 780
440   WRITE (PRINTR,450)
450   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.)
      IF (ICOMD) 780,560,780
460   WRITE (PRINTR,470) N1RECI
470   FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO
     1N (,I5,2H).)
      GO TO 760
480   WRITE (PRINTR,490) EQUAL
490   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
500   WRITE (PRINTR,510)
510   FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.)
      GO TO 760
520   WRITE (PRINTR,530)
530   FORMAT (//23H0WORK FILE NOT DEFINED.)
      GO TO 760
540   WRITE (PRINTR,550)
550   FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.)
      GO TO 760
560   WRITE (PRINTR,570) EQUAL
570   FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.)
      GO TO 760
580   WRITE (PRINTR,590)
590   FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE
     1R.)
      GO TO 760
600   WRITE (PRINTR,610)
610   FORMAT (//12H0TOO MANY (.)
      GO TO 760
620   WRITE (PRINTR,630) EQUAL
630   FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.)
      GO TO 760
640   WRITE (PRINTR,650) EQUAL
650   FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.)
      GO TO 760
660   WRITE (PRINTR,670) EQUAL
670   FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.)
      GO TO 760
680   WRITE (PRINTR,690) EQUAL
690   FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.)
      GO TO 760
700   WRITE (PRINTR,710) EQUAL
710   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
720   WRITE (PRINTR,730) N1RECI
730   FORMAT (//21H0INTAPE POSITIONED AT,I5,25H.  BACKWARD SKIP IGNORED.
     1)
      GO TO 780
740   WRITE (PRINTR,750)
750   FORMAT (//23H0COMMAND IS INCOMPLETE.)
      GO TO 760
751   WRITE (PRINTR,752)
752   FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA
     1PE OR OUTPUT.)
760   WRITE (PRINTR,770)
770   FORMAT (23H COMMAND NOT PROCESSED.)
780   WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD)
790   FORMAT ((1X,80A1))
C
C     RETURN TO COMMAND PROCESSSOR.
C
      CHAR1L=0
      NERRS=MAX0(S(NUMBER),NERRS)
      NERRG=MAX0(NERRG,NERRS)
      TRANS=1
C
C     RETURN TO TRANSITION PROGRAM.
C
800   RETURN
C
      END
      SUBROUTINE EXCHC9 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO
C     ERRORS.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KQUIT /20/
C
      IF (INFILE.EQ.0) GO TO 10
      IF (MODIFY.NE.82) GO TO 5
C     82 = ASCII R
      ACTION=2
C     ACTION = 2 MEANS REWIND INFILE.
      CALL EXCHIM
5     ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      CALL EXCHIM
      INFILE=0
      NCHCMD=0
      GO TO 50
10    IF (OPTC*OUFILE.EQ.0) GO TO 20
      ACTION=0
      NCHOUT=4
      CALL EXCHOU (COMD(1,KQUIT))
20    ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      IF (OUTOPN.EQ.0) GO TO 30
C     WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC)
C     CLOSE THE INPUT TAPE.
30    IF (INTOPN.EQ.0) GO TO 40
      ISTAT=4
      CALL EXCHRT (ISTAT,OBLOCK)
C
C     RETURN TO MAIN PROGRAM.
C
40    TRANS=0
      IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG
45    FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.)
      GO TO 60
C
C     RETURN TO THE COMMAND DECODER.
C
50    TRANS=1
60    RETURN
C
      END
=TES FILE=3
       PROGRAM EXCHMN(INPUT=/180,OUTPUT=/180,TAPE5=INPUT,TAPE6=OUTPUT,
     1 INTAPE,OUTAPE,TAPE7,TAPE10=/180,TAPE11=/180,TAPE12=/180,
     2 TAPE13=/180,TAPE14=/180,TAPE15=/180)
C
C     TAPES TAPE10,...,TAPE15 ARE AVAILABLE AS FILES THAT THE
C     USER MAY USE FOR DIRECTIVES AND SOURCE CARD FILES.
C
C     INTAPE IS THE INPUT EXCHANGE TAPE.
C     TAPE7 IS USED AS A WORKING OR SCRATCH FILE.
C     OUTAPE IS THE OUTPUT EXCHANGE TAPE THAT WILL BE WRITTEN.
C
C     TAPE EXCHANGE MAIN PROGRAM FOR CDC6000/7000
C
C     WRITTEN BY K. HASKELL, SANDIA LABS., ALBUQUERQUE, NM 87185.
C     REVISED JUN. 1, 1979.
C     REVISED NOV 27, 1979 BY W. V. SNYDER AT JPL, 91103.
C     REVISED FEB 22, 1980 BY W. V. SNYDER AT JPL, 91103.
C     REVISED DEC 15, 1980 BY R. J. HANSON AT SNLA, 87185.
C
      INTEGER IBLOCK(960)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER XLATE(128)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHXC/ XLATE
      PRINTR=6
      READER=5
      NWCBI=24
C
      CALL EXCH (IBLOCK)
      STOP
C
      END
      BLOCK DATA
C
C     BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/
      DATA INTEXT /0/, INALT /0/
C
      DATA CHAR1L /1H1/
C                                                        A  U  T  H
      DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1)  /65,85,84,72/
C                                                        C  O  M  M
      DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2)  /67,79,77,77/
C                                                        C  O  P  Y
      DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3)  /67,79,80,89/
C                                                        D  A  T  A
      DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4)  /68,65,84,65/
C                                                        D  A  T  E
      DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5)  /68,65,84,69/
C                                                        G  R  O  U
      DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6)  /71,82,79,85/
C                                                        I  N  D  E
      DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7)  /73,78,68,69/
C                                                        I  N  P  U
      DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8)  /73,78,80,85/
C                                                        N  A  M  E
      DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9)  /78,65,77,69/
C                                                        I  N  T  A
      DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/
C                                                        K  E  Y  W
      DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/
C                                                        L  I  M  I
      DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/
C                                                        M  A  C  H
      DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/
C                                                        O  P  T  I
      DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/
C                                                        O  R  I  G
      DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/
C                                                        O  U  T  A
      DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/
C                                                        O  U  T  P
      DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/
C                                                        P  R  E  D
      DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/
C                                                        P  R  I  N
      DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/
C                                                        Q  U  I  T
      DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/
C                                                        R  E  A  D
      DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/
C                                                        R  E  F  E
      DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/
C                                                        R  E  M  O
      DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/
C                                                        R  E  W  I
      DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/
C                                                        S  I  T  E
      DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/
C                                                        S  K  I  P
      DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/
C                                                        T  E  X  T
      DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/
C                                                        T  I  T  L
      DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/
C                                                        U  P  D  A
      DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/
C                                                        W  O  R  K
      DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/
C                                                        C  O  N  T
      DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/
C                                                        I  D  E  N
      DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/
C                                                        I  N  C  L
      DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/
C                                                        S  I  G  N
      DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/
C                                                        M  A  R  G
      DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/
      DATA IDSTEP /0/, IDTXTL /0/
      DATA INDEX /0/
      DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/
      DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/
      DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/
      DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/
      DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/
      DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/
      DATA INDEXS(25),INDEXS(26)                       /0,0    /
      DATA INTOPN /0/
      DATA ITYPEI /0/
      DATA LIMIT /0/
      DATA MARGIN /180/
      DATA NCCBI /180/
      DATA NCCBO /180/
      DATA NCHCMD /0/
      DATA NCHMAX /180/
      DATA NCOMDP /35/
      DATA NCOMDT /35/
      DATA NDATAO /3591/
      DATA NERRCO /0/
      DATA NERRG /0/
      DATA NRWORK /0/
      DATA OUTOPN /0/
      DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/
      DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/
      DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/
      DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/
      DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/
      DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/
      DATA OPTVAL(25),OPTVAL(26)                       /0,0    /
      DATA PHASE /1/
C     INDICATE THAT NO PREDICATES ARE DEFINED.
      DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/
      DATA PRED(1,6),PRED(1,7),PRED(1,8)                     /0,0,0    /
      DATA SITE(1) /0/
      DATA TITLE(1) /32/
C     32 = ASCII BLANK
      DATA TODAY (1) /0/
      DATA TRANS /1/
C
C     TRANSLATION TABLE FROM ASCII TO HOLLERITH.  USES ASCII GRAPHICS.
C     TRANSLATES CONTROL CHARACTERS (<32) TO '$'.
C     MAY NOT BE EXACTLY CORRECT FOR ALL MACHINES.
C
      DATA XLATE(1),  XLATE(2),  XLATE(3),  XLATE(4)  /1H$,1H$,1H$,1H$/
      DATA XLATE(5),  XLATE(6),  XLATE(7),  XLATE(8)  /1H$,1H$,1H$,1H$/
      DATA XLATE(9),  XLATE(10), XLATE(11), XLATE(12) /1H$,1H$,1H$,1H$/
      DATA XLATE(13), XLATE(14), XLATE(15), XLATE(16) /1H$,1H$,1H$,1H$/
      DATA XLATE(17), XLATE(18), XLATE(19), XLATE(20) /1H$,1H$,1H$,1H$/
      DATA XLATE(21), XLATE(22), XLATE(23), XLATE(24) /1H$,1H$,1H$,1H$/
      DATA XLATE(25), XLATE(26), XLATE(27), XLATE(28) /1H$,1H$,1H$,1H$/
      DATA XLATE(29), XLATE(30), XLATE(31), XLATE(32) /1H$,1H$,1H$,1H$/
      DATA XLATE(33), XLATE(34), XLATE(35), XLATE(36) /1H ,1H!,1H",1H#/
      DATA XLATE(37), XLATE(38), XLATE(39), XLATE(40) /1H$,1H%,1H&,1H'/
      DATA XLATE(41), XLATE(42), XLATE(43), XLATE(44) /1H(,1H),1H*,1H+/
      DATA XLATE(45), XLATE(46), XLATE(47), XLATE(48) /1H,,1H-,1H.,1H//
      DATA XLATE(49), XLATE(50), XLATE(51), XLATE(52) /1H0,1H1,1H2,1H3/
      DATA XLATE(53), XLATE(54), XLATE(55), XLATE(56) /1H4,1H5,1H6,1H7/
      DATA XLATE(57), XLATE(58), XLATE(59), XLATE(60) /1H8,1H9,1H:,1H;/
      DATA XLATE(61), XLATE(62), XLATE(63), XLATE(64) /1H<,1H=,1H>,1H?/
      DATA XLATE(65), XLATE(66), XLATE(67), XLATE(68) /1H@,1HA,1HB,1HC/
      DATA XLATE(69), XLATE(70), XLATE(71), XLATE(72) /1HD,1HE,1HF,1HG/
      DATA XLATE(73), XLATE(74), XLATE(75), XLATE(76) /1HH,1HI,1HJ,1HK/
      DATA XLATE(77), XLATE(78), XLATE(79), XLATE(80) /1HL,1HM,1HN,1HO/
      DATA XLATE(81), XLATE(82), XLATE(83), XLATE(84) /1HP,1HQ,1HR,1HS/
      DATA XLATE(85), XLATE(86), XLATE(87), XLATE(88) /1HT,1HU,1HV,1HW/
      DATA XLATE(89), XLATE(90), XLATE(91), XLATE(92) /1HX,1HY,1HZ,1H[/
      DATA XLATE(93), XLATE(94), XLATE(95), XLATE(96) /1H\,1H],1H^,1H_/
      DATA XLATE(97), XLATE(98), XLATE(99), XLATE(100)/1H`,1Ha,1Hb,1Hc/
      DATA XLATE(101),XLATE(102),XLATE(103),XLATE(104)/1Hd,1He,1Hf,1Hg/
      DATA XLATE(105),XLATE(106),XLATE(107),XLATE(108)/1Hh,1Hi,1Hj,1Hk/
      DATA XLATE(109),XLATE(110),XLATE(111),XLATE(112)/1Hl,1Hm,1Hn,1Ho/
      DATA XLATE(113),XLATE(114),XLATE(115),XLATE(116)/1Hp,1Hq,1Hr,1Hs/
      DATA XLATE(117),XLATE(118),XLATE(119),XLATE(120)/1Ht,1Hu,1Hv,1Hw/
      DATA XLATE(121),XLATE(122),XLATE(123),XLATE(124)/1Hx,1Hy,1Hz,1H{/
      DATA XLATE(125),XLATE(126),XLATE(127),XLATE(128)/1H|,1H},1H~,1H$/
      END
      SUBROUTINE EXCH (IBLOCK)
C
C     CDC 6600/7600 INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM
C
      INTEGER IBLOCK(1)
C
C     WRITTEN BY K. HASKELL, SANDIA LABS., ALBUQUERQUE, NM 87185.
C     REVISED JUN. 1, 1979.
C     REVISED NOV 27, 1979 BY W. V. SNYDER AT JPL, 91103.
C     REVISED FEB 22, 1980 BY W. V. SNYDER AT JPL, 91103.
C     REVISED JAN. 21, 1981 BY R. J. HANSON AT SNLA 87185
C
C     ALLOCATE SPACE FOR TAPE OUTPUT
C
      INTEGER OBLOCK(480)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      INTEGER DISASC(64)
      INTEGER CDCMDE
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      COMMON /DISASC/ DISASC
      COMMON /CDCMDE/ CDCMDE
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     SET CDCMDE=1 TO NOTE THAT 6-BIT MODE FOR CDC USAGE IS NORMAL.
C     THE SUBROUTINE EXCHCX( ) FOR CDC NOW RECOGNIZES TWO NEW
C     COMMANDS, 12BIT AND 6BIT.  12BIT SETS CDCMDE=2, WHILE 6BIT
C     SETS CDCMDE=1.
      CDCMDE=1
C
C     DATE COMPUTATION USING THE SUBROUTINE DATE( ) PROVIDED BY THE
C     CDC FORTRAN LIBRARY.
        CALL DATE(IDAY)
        IZERO=AND(COMPL(MASK(54)),SHIFT(1H0,6))
        DO 20 L=1,3
         DO 10 J=1,3
         IDAY=SHIFT(IDAY,6)
         IF(.NOT.(J.GT.1)) GO TO 10
         TODAY(2*(L-1)+J-1)=AND(COMPL(MASK(54)),IDAY)-IZERO+48
10       CONTINUE
20    CONTINUE
C     START SANDIA NATL. LABS. 87185 SITE DEFINITION.
C     SITE(1)=83
C     SITE(2)=78
C     SITE(3)=76
C     SITE(4)=65
C     SITE(5)=32
C     SITE(6)=56
C     SITE(7)=55
C     SITE(8)=49
C     SITE(9)=56
C     SITE(10)=53
C     DO 40 I=11,40
C  40 SITE(I)=32
C
C     THE ABOVE SITE MESSAGE IS ONLY FOR SANDIA NATL. LABS., 87185.
C     IT SAYS..  SNLA 87185.
C
C     PUT IN TWO CDC DEPENDENT COMMANDS, 6BIT AND 12BI(T).
      NCOMDT=NCOMDP+2
      COMD(1,NCOMDP+1)=54
      COMD(2,NCOMDP+1)=66
      COMD(3,NCOMDP+1)=73
      COMD(4,NCOMDP+1)=84
C
      COMD(1,NCOMDP+2)=49
      COMD(2,NCOMDP+2)=50
      COMD(3,NCOMDP+2)=66
      COMD(4,NCOMDP+2)=73
      NWCBO=24
      WORKF=7
C
C     CONSTRUCT TRANSLATE TABLE FROM DISPLAY CODE TO ASCII.
C     USED IN EXCHIM.
C
      DO 30 I = 32,95
30    DISASC(SHIFT(AND(MASK(6),XLATE(I+1)),6)+1)=I
      CALL EXCHTR (IBLOCK,OBLOCK)
      RETURN
C
      END
      SUBROUTINE EXCHIM
C
C     READ A COMMAND OR TEXT IMAGE FROM  1.  ALTERNATE CORRECTION FILE,
C                                        2.  TEXT FILE,
C                                        3.  INPUT FILE,
C                                        4.  SYSTEM READER.
C     PUT THE HOLLERITH COMMAND IN HOLCMD,
C     PUT THE ASCII EQUIVALENT IN COMAND,
C     PUT THE NUMBER OF CHARACTERS IN NCHCMD.
C     IF A SYSTEM END-OF-FILE IS SENSED, SET NCHCMD=-1.
C
C     THIS IS A CDC 6600-7600 VERSION.  IT READS 180 CHARACTER IMAGES.
C     IT TRANSLATES CDC GRAPHIC TO ASCII CODE.
C
C     R. J. HANSON, SANDIA LABS., ALBUQUERQUE, NM., DECEMBER, 1980.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER DISASC(64)
      INTEGER CDCMDE
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /DISASC/ DISASC
      COMMON /CDCMDE/ CDCMDE
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     TRANSLATE FROM CDC GRAPHIC TO ASCII CODES.
C     USE CDC GRAPHIC TO ASCII CODE TRANSFORMATION TABLE.
C     REF. SCOPE 2.1 REFERENCE MANUAL, CODE CONVERSION TABLES.
C
      INTEGER BLANK
C
      DATA BLANK /45/
C
C     DETERMINE WHICH FILE TO READ.
      IF (ACTION.EQ.0) GO TO 10
      IF (ACTION.NE.2) GO TO 250
   10 I = INALT
      IF (I.GT.0) GO TO 20
      I = INTEXT
      IF (I.NE.0) GO TO 20
      I = INFILE
      IF (I.EQ.0) I = READER
   20 IF (ACTION.NE.2) GO TO 30
      REWIND I
      GO TO 250
   30 READ (I,99999) (HOLCMD(J),J=1,180)
      IF (EOF(I).NE.0.) GO TO 260
99999 FORMAT (180R1)
C
C     SCAN THE CARD IMAGE FROM THE RIGHT.  FIND LAST
C     NON-BLANK CHARACTER.
      DO 40 I=1,180
        IF (HOLCMD(181-I).NE.BLANK) GO TO 50
   40 CONTINUE
      NCHCMD = 1
      GO TO 60
   50 NCHCMD = 181 - I
   60 DO 70 I=1,NCHCMD
        COMAND(I) = DISASC(HOLCMD(I)+1)
   70 CONTINUE
      IF (.NOT.(CDCMDE.EQ.2)) GO TO 230
C
C     THESE NEXT LINES CONVERT CERTAIN PAIRS OF 6 BIT CDC CODES
C     TO AN EQUIVALENT ASCII REPRESENTATION.
      ISHAVE = COMPL(MASK(54))
      I = 1
      IP = 0
   80 IF (.NOT.(I.LT.NCHCMD)) GO TO 190
      IP = IP + 1
      NEXT = COMAND(I+1)
C
C     TEST FOR A CIRCUMFLEX.
      IF (.NOT.(COMAND(I).EQ.94)) GO TO 120
C
C     TEST FOR THE NEXT CHAR. = LETTER OF ALPHABET.
      IF (.NOT.(65.LE.NEXT .AND. NEXT.LE.90)) GO TO 90
      COMAND(IP) = NEXT + 32
      HOLCMD(IP) = HOLCMD(I+1)
      I = I + 1
      GO TO 180
C
C     TEST FOR FOUR SPECIAL CHARACTERS.
   90 IF (.NOT.(48.LE.NEXT .AND. NEXT.LE.51)) GO TO 95
      COMAND(IP) = NEXT + 75
      HOLCMD(IP)=AND(ISHAVE,SHIFT(4H[\]^,6*(NEXT-47)))
      I = I + 1
      GO TO 180
C
C     TEST FOR ASCII CHARACTERS 0-31 EQUIVALENT.
   95 IF (.NOT.(32.LE.HOLCMD(I+1).AND.HOLCMD(I+1).LE.63)) GO TO 170
      I = I + 1
      COMAND(IP) = HOLCMD(I) - 32
      HOLCMD(IP) = HOLCMD(I)
      GO TO 180
C
C     TEST FOR COMMERCIAL AT SIGN.
  120 IF (.NOT.(COMAND(I).EQ.64)) GO TO 170
C
C     TEST FOR AT SIGN EQUIVALENT.
      IF (.NOT.(NEXT.EQ.65)) GO TO 130
      COMAND(IP) = 64
      HOLCMD(IP)=AND(ISHAVE,SHIFT(1H@,6))
      I = I + 1
      GO TO 180
C
C     TEST FOR CIRCUMFLEX EQUIVALENT.
  130 IF (.NOT.(NEXT.EQ.66)) GO TO 140
      COMAND(IP) = 94
      HOLCMD(IP)=AND(ISHAVE,SHIFT(1H^,6))
      I = I + 1
      GO TO 180
C
C     TEST FOR ACCENT GRAVE EQUIVALENT.
  140 IF (.NOT.(NEXT.EQ.71)) GO TO 150
      COMAND(IP) = 96
      HOLCMD(IP)=AND(ISHAVE,SHIFT(1H\,6))
      I = I + 1
      GO TO 180
C
C     TEST FOR COLON EQUIVALENT.
  150 IF(.NOT.(NEXT.EQ.68)) GO TO 170
      COMAND(IP)=58
      HOLCMD(IP)=AND(ISHAVE,SHIFT(1H:,6))
      I = I + 1
      GO TO 180
  170 COMAND(IP) = COMAND(I)
      HOLCMD(IP) = HOLCMD(I)
  180 I = I + 1
      GO TO 80
  190 IF (.NOT.(I.EQ.NCHCMD)) GO TO 200
      IP = IP + 1
      COMAND(IP) = COMAND(I)
      HOLCMD(IP) = HOLCMD(I)
  200 NCHCMD = IP
C
C     END OF CDC 12 BIT TO ASCII CONVERSION.
  230 DO 240 I=1,NCHCMD
        HOLCMD(I) = SHIFT(HOLCMD(I),54)
  240 CONTINUE
  250 ACTION = 0
      RETURN
  260 NCHCMD = -1
      RETURN
      END
      SUBROUTINE EXCHOU (OUTPUT)
C
C     NATIVE FORMAT OUTPUT PROGRAM FOR THE TEXT EXCHANGE PROGRAM.
C
C     OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN.
C     THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT.
C
C     THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180),
C     THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179).  IF OUTPUT(180)
C     IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE.  IF OUTPUT(180)
C     IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW
C     IMAGE.  CDC6600/7600 VERSION.
C
      INTEGER OUTPUT(1)
      INTEGER WORK(180)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      INTEGER CDCMDE
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /CDCMDE/ CDCMDE
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C
C     DECIDE WHETHER TO OPEN, CLOSE OR WRITE.
C
      IF (IABS(ACTION).EQ.2) GO TO 50
C     IABS(ACTION) = 2 MEANS START OR END OF PROGRAM.
      IF (ACTION) 40,10,50
C     WRITE
10    IF(.NOT.(CDCMDE.EQ.1)) GO TO 60
      DO 20 I=1,NCHOUT
      J=OUTPUT(I)
20    WORK(I)=XLATE(J+1)
      NOUT=NCHOUT
      GO TO 70
60    N=0
      DO 80 I=1,NCHOUT
      N=MIN0(N,178)
      J=OUTPUT(I)
      IF(.NOT.(97.LE.J .AND. J.LE.122)) GO TO 100
C
C     12 BIT CODE FOR LOWER CASE LETTERS OF THE ALPHABET.
      WORK(N+1)=1H^
      WORK(N+2)=XLATE(J-31)
      N=N+2
      GO TO 80
100   CONTINUE
      IF(.NOT.(123.LE.J .AND. J.LE.126)) GO TO 110
C
C     12 BIT CODE FOR FOUR SPECIAL CHARS.
      WORK(N+1)=1H^
      WORK(N+2)=XLATE(J-74)
      N=N+2
      GO TO 80
110   CONTINUE
      IF(.NOT.(J.EQ.64)) GO TO 120
C
C     12 BIT CODE FOR AT SIGN.
      WORK(N+1)=1H@
      WORK(N+2)=1HA
      N=N+2
      GO TO 80
120   CONTINUE
      IF(.NOT.(J.EQ.94)) GO TO 130
C
C     12 BIT CODE FOR CIRCUMFLEX.
      WORK(N+1)=1H@
      WORK(N+2)=1HB
      N=N+2
      GO TO 80
130   CONTINUE
      IF(.NOT.(J.EQ.96)) GO TO 140
C
C     12 BIT CODE FOR ACCENT GRAVE.
      WORK(N+1)=1H@
      WORK(N+2)=1HG
      N=N+2
      GO TO 80
140   CONTINUE
      IF(.NOT.(J.EQ.58)) GO TO 150
C
C     12 BIT CODE FOR COLON.
      WORK(N+1)=1H@
      WORK(N+2)=1HD
      N=N+2
      GO TO 80
  150 CONTINUE
C
C     LOOK FOR SPECIAL ASCII CHARACTERS 0-31.
      IF (.NOT.(0.LE.J .AND. J.LE.31)) GO TO 155
      WORK(N+1) = 1H^
      WORK(N+2) = SHIFT(J+32,54)
      N = N+2
      GO TO 80
  155 CONTINUE
C
C     ALL OTHER ASCII CODES TRANSLATE TO 6 BIT CODES.
      WORK(N+1)=XLATE(J+1)
      N=N+1
80    CONTINUE
      NOUT=N
70    WRITE (OUFILE,30) (WORK(I),I=1,NOUT)
30    FORMAT (180A1)
      GO TO 50
C     CLOSE
40    END FILE OUFILE
C     OPEN, RETURN
50    ACTION=0
      RETURN
      END
      SUBROUTINE EXCHPA (BUFIN,BUF9T)
C
C     CDC 6600/7600 VERSION
C
C     WRITTEN BY -- K. HASKELL, SANDIA LABS
C
C     REVISED JUN. 1, 1979.
C
C     PACK A BLOCK OF NCH CHARACTERS WRITTEN ONE CHARACTER PER WORD
C     IN BUFIN TO 9-TRACK FORMAT OUTPUT BUFFER BUF9T.
C
      INTEGER BUFIN(1),BUF9T(1)
      INTEGER TEMP
      DATA IPEEL8/377B/,IPEEL4/17B/
C
C     DEFINE NUMBER OF CHARACTERS TO PACK
      NCH=180
C
C     DEFINE THE NUMBER OF 15-CHARACTER GROUPS FOR NCH CHARACTERS
      NGR=NCH/15
C
C     FILL ONE GROUP (I.E. 15 CHARS) OF BUF9T AT ONCE
C
      DO 50 I=1,NGR
      K=2*I-1
C     PACK FIRST 7 CHARS OF GROUP
      TEMP=0
      L=(I-1)*15
      DO 20 J=1,7
      L=L+1
C     SHIFT 8 BITS INTO DESIRED POSITION
      TEMP=OR(SHIFT(AND(IPEEL8,BUFIN(L)),60-8*J),TEMP)
   20 CONTINUE
C     PACK CHAR. WHICH SPANS TWO WORDS
      L=L+1
      TEMP=OR(SHIFT(AND(IPEEL8,BUFIN(L)),-4),TEMP)
C
      BUF9T(K)=TEMP
C
      TEMP=AND(MASK(4),SHIFT(BUFIN(L),56))
C     PACK LAST 7 CHARS.
      DO 40 J=1,7
      L=L+1
      TEMP=OR(SHIFT(AND(IPEEL8,BUFIN(L)),56-8*J),TEMP)
   40 CONTINUE
C
      BUF9T(K+1)=TEMP
C
   50 CONTINUE
C
      RETURN
      END
      SUBROUTINE EXCHRT (ISTAT,DBLOCK)
C
C     CDC 6600 VERSION
C
C     MAY 6, 1977 -- K. H. HASKELL, R. J. HANSON, SANDIA LABS
C     DEC 20, 1978 -- MINOR MODS AS PER W V SNYDER, JPL
C
C     READ A BLOCK FROM, OR REWIND, THE EXCHANGE TAPE, INTAPE.
C     INPUT --
C       ISTAT = 1  MEANS OPEN TAPE WITH NO REWIND.
C       ISTAT = 2  MEANS REWIND TAPE (OR CLOSE WITH REWIND).
C       ISTAT = 3  MEANS READ.
C       ISTAT = 4  MEANS CLOSE WITH NO REWIND.
C       (NOTE -- ISTAT = 1 OR 4 CAUSE NULL OPERATIONS.)
C
C     OUTPUT --
C       ISTAT = 0  IF EVERYTHING IS OK.
C       ISTAT = 3  IF AN I/O ERROR WAS DETECTED.
C
C       DBLOCK IS THE RAW DATA BLOCK, EXACTLY AS IT COMES FROM THE
C       TAPE.
C
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
      I = ISTAT
      ISTAT = 0
      GO TO (110,100,10,110), I
C
C     READ A BLOCK (ISTAT=3)
C
   10 CONTINUE
C     CALCULATE NWORDS=NUMBER OF WORDS EXPECTED.  FOR THE FIRST
C     BLOCK READ FROM THE TAPE (I.E., THE LABEL) NDATAI AND NERRCI
C     HAVE BEEN INITIALIZED IN THE MAIN PROGRAM TO NDATAI=171 AND
C     NERRCI=0, IN ORDER TO READ 180 CHARACTERS.  AFTER THE LABEL
C     IS READ, NDATAI AND NERRCI ARE REASSIGNED ACCORDING TO THE
C     INFORMATION IN THE LABEL.
C     NDATAI IS DEFINED AS THE NUMBER OF DATA CHARACTERS PER BLOCK.
C     NERRCI IS DEFINED AS THE NUMBER OF ERROR CONTROL CHARACTERS
C     PER BLOCK.
C     SINCE THE CDC 6600/7600 HAS A 60-BIT WORD, EVERY 2 WORDS OF
C     DBLOCK WILL HOLD 15 8-BIT CHARACTERS OF DATA.
C
      NWORDS = 2*((NDATAI + NERRCI + 9 + 14)/15)
      DO 50 I=1,2
      BUFFER IN (INTAPE,1) (DBLOCK(1),DBLOCK(NWORDS))
      IF (UNIT(INTAPE)) 20,40,80
C     SET NCDBI TO INDICATE THE NUMBER OF CHARACTERS OF DATA IN DBLOCK.
   20 L = LENGTH(INTAPE)
      NCDBI = MIN0(NDATAI+NERRCI+9,15*L/2)
      GO TO 110
C
C     AN END-OF-FILE WAS ENCOUNTERED.
C
   40 IF (BLKSQI.NE.0) GO TO 60
C     ALLOW EXACTLY ONE END-OF-FILE IF TRYING TO READ THE LABEL.
   50 CONTINUE
   60 WRITE (PRINTR,70)
   70 FORMAT (//30H0EOF ENCOUNTERED ON INPUT TAPE)
      ISTAT = 3
      GO TO 110
C
C     PARITY ERROR ENCOUNTERED
C
   80 WRITE (PRINTR,90)
   90 FORMAT (//39H0PARITY ERROR ENCOUNTERED ON INPUT TAPE)
      ISTAT=3
      GO TO 110
C
C     REWIND THE EXCHANGE TAPE (ISTAT=2)
C
  100 CONTINUE
      REWIND INTAPE
C
C     TO OPEN (OR CLOSE) INTAPE WITH NO REWIND.
C     (ISTAT=1 OR ISTAT=4)
C
  110 CONTINUE
C
      RETURN
C
      END
      SUBROUTINE EXCHUN (BUF9T,BUFOUT)
C
C     CDC 6600/7600 VERSION
C
C     MAY 6, 1977 -- K H HASKELL, SANDIA LABS
C     REVISED BY R. J. HANSON, SANDIA LABS., OCTOBER, 1979.
C
C     READ A BLOCK NCH CHARACTERS LONG FROM THE INPUT BUFFER, BUF9T,
C     AND WRITE ONE 8-BIT CHARACTER IN EACH WORD OF THE OUTPUT BUFFER,
C     BUFOUT.
C
      INTEGER BUF9T(1),BUFOUT(1)
      DATA IPEEL8 /377B/, IPEEL4 /17B/
C
C     DEFINE NUMBER OF CHARACTERS TO UNPACK.
      NCH = 180
C
C     DEFINE THE NUMBER OF 15-CHARACTER GROUPS FOR NCH CHARACTERS.
      NGR = NCH/15
C
C     PROCESS ONE GROUP (I.E., 2 WORDS) OF BUF9T AT ONCE.
      L=0
      DO 50 I=1,NGR
      K = 2 * I - 1
C     UNPACK FIRST 7 CHARS. OF GROUP.
      IBUF9T=BUF9T(K)
      DO 20 J=8,56,8
      L=L+1
C     SHIFT DESIRED 8 BITS INTO LOW-ORDER 8 POSITIONS.
C     MASK 52 ZEROS AND 8-BIT CHAR. INTO OUTPUT WORD.
      BUFOUT(L)=AND(IPEEL8, SHIFT(IBUF9T,J))
   20 CONTINUE
C     UNPACK CHAR. WHICH IS SPLIT BETWEEN 2 WORDS.
      L=L+1
C     MASK AWAY 56 HIGH-ORDER BITS.
C     SHIFT LOW-ORDER 4 BITS LEFT 4 POSITIONS.
C     SHIFT HIGH-ORDER 4 BITS LEFT CIRC. INTO LOW-ORDER 4 POSITIONS.
      BUFOUT(L)=OR(SHIFT(AND(IPEEL4,BUF9T(K)),4),
     1             AND(IPEEL4,SHIFT(BUF9T(K+1),4)))
C     UNPACK LAST 7 CHARS. OF GROUP.
      IBUF9T=BUF9T(K+1)
      DO 40 J=12,60,8
      L=L+1
      BUFOUT(L)=AND(IPEEL8,SHIFT(IBUF9T,J))
   40 CONTINUE
C
   50 CONTINUE
C
      RETURN
      END
      SUBROUTINE EXCHWT (ISTAT,OUTBUF)
C
C     CDC 6600/7600 VERSION
C
C     WRITTEN BY -- K. HASKEL, SANDIA LABS
C
C     REVISED JUN. 1, 1979.
C
C     WRITE A BLOCK TO, OR CLOSE, THE EXCHANGE TAPE, OUTAPE.
C
C     INPUT--
C       ISTAT = 1  MEANS OPEN TAPE WITH NO REWIND
C             = 2  MEANS WRITE OUTBUF ON TAPE
C             = 3  MEANS WRITE ENDFILE AND CLOSE WITH NO REWIND
C
C       OUTBUF     THE DATA TO BE WRITTEN TO TAPE
C
C     OUTPUT--
C       ISTAT = 0  IF EVERYTHING IS OKAY
C             = 3  IF ERRORS OCCURRED (AN ERROR MESSAGE WILL
C                  BE PRINTED)
C
      INTEGER OUTBUF(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
      I=ISTAT
      ISTAT=0
      GO TO (50,10,20), I
C
C     WRITE BUFFER TO TAPE (ISTAT=2 ON INPUT).
C
   10 CONTINUE
C     CALCULATE NWORDS=NUMBER OF WORDS OF DATA WRITTEN.  EACH PAIR OF
C     CDC 60-BIT WORDS HOLDS 15 8-BIT CHARACTERS OF DATA.
      NWORDS=2*((CCDBO+14)/15)
      IF (BLKSQO.NE.0) NWORDS=2*((NDATAO+NERRCO+9+14)/15)
      BUFFER OUT (OUTAPE,1) (OUTBUF(1),OUTBUF(NWORDS))
      IF (UNIT(OUTAPE))50,30,35
C
C     WRITE ENDFILE, CLOSE TAPE WITH NO REWIND (ISTAT=3)
C
   20 CONTINUE
      ENDFILE OUTAPE
      GO TO 50
C
C     AN END-OF-FILE WAS ENCOUNTERED
C
   30 WRITE (PRINTR,31)
   31 FORMAT (//40H EOF ENCOUNTERED ON EXCHANGE OUTPUT TAPE)
      ISTAT=3
      GO TO 50
C
C     PARITY ERROR OCCURRED ON OUTPUT TAPE
C
   35 WRITE (PRINTR,36)
   36 FORMAT (//49H PARITY ERROR ENCOUNTERED ON EXCHANGE OUTPUT TAPE)
      ISTAT=3
C
C     TO OPEN TAPE WITH NO REWIND (ISTAT=1)
C
   50 CONTINUE
C
      RETURN
      END
      SUBROUTINE EXCHAH (RECORD,NCHAR)
C
C     CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO
C     HOLLERITH FORMAT.
C     THIS PROGRAM IS NOT MACHINE SENSITIVE.
C
C     RECORD IS THE RECORD TO BE CONVERTED.  THE HOLLERITH IS STORED
C     IN RECORD ALSO
      INTEGER RECORD(1)
C
C     NCHAR IS THE NUMBER OF CHARACTERS TO BE CONVERTED
C
      INTEGER XLATE(128)
      COMMON /EXCHXC/ XLATE
C
C
      DO 10 I=1,NCHAR
      J=RECORD(I)
10    RECORD(I)=XLATE(J+1)
      RETURN
      END
      SUBROUTINE EXCHFO (IOP)
C
C     OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM.
C     IOP LESS THAN ZERO MEANS CLOSE FILE, IOP GREATER THAN ZERO MEANS
C     OPEN FILE.  IABS(IOP) = 1 MEANS READER, = 2 MEANS PRINTER, = 3
C     MEANS WORK FILE, = 4 MEANS INFILE.  IOP = 4 IS USED ONLY BY THE
C     BOOTSTRAP PROGRAM.
C
      INTEGER IOP
C
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
      RETURN
C
      END
      SUBROUTINE EXCHSL
C
C     LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS.
C
C     EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE
C     SEGMENT.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      RETURN
      END
      SUBROUTINE EXCHTR (IBLOCK,OBLOCK)
C
C     TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER.
C
      INTEGER IBLOCK(1), OBLOCK(1)
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4.
C
      CALL EXCHFO (1)
      CALL EXCHFO (2)
      WORKF=-IABS(WORKF)
C
10    IF (TRANS.LE.0) RETURN
      CALL EXCHSL
C     LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS.
      GO TO (11,12,13,14,15,16,17,18,19), TRANS
C     COMMAND PARSER
11    CALL EXCHC1 (IBLOCK,OBLOCK)
      GO TO 10
C     IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE
12    CALL EXCHC2
      GO TO 10
C     OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE.
13    CALL EXCHC3 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE.
14    CALL EXCHC4 (IBLOCK)
      GO TO 10
C     COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE.
15    CALL EXCHC5 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY TEXT FROM INTAPE TO OUTAPE
16    CALL EXCHC6 (IBLOCK,OBLOCK)
      GO TO 10
C     TEXT COMMAND
17    CALL EXCHC7 (IBLOCK,OBLOCK)
      GO TO 10
C     ERROR MESSAGES
18    CALL EXCHC8
      GO TO 10
C     QUIT
19    CALL EXCHC9 (IBLOCK,OBLOCK)
      GO TO 10
      END
      SUBROUTINE EXCHGB (ISTAT,DBLOCK)
C
C     READ A BLOCK FROM THE EXCHANGE TAPE.
C     IGNORE THE ERROR CONTROL SEGMENT.
C     CHECK THE BLOCK SEQUENCE NUMBER.
C     CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER,
C               OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).

      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
C
C     READ A BLOCK FROM INTAPE.
C
      BLKSQI=BLKSQI+1
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 160
C
C     GET INFORMATION OUT OF THE BLOCK HEADER.
C
      CCDBI=NERRCI
      CWDBI=NWCBI*(CCDBI/NCCBI)+1
      CPCBI=MOD(CCDBI,NCCBI)
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
      DO 110 JUMP=1,9
      CCDBI=CCDBI+1
      CPCBI=CPCBI+1
      IF (CCDBI.GT.NCDBI) GO TO 130
      IF (CPCBI.LE.NCCBI) GO TO 10
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
10    GO TO (20,30,40,50,60,70,80,90,100), JUMP
20    NEWBLK=256*CBLCKI(CPCBI)
      GO TO 110
30    NEWBLK=NEWBLK+CBLCKI(CPCBI)
      GO TO 110
40    LASTI=CBLCKI(CPCBI)
      GO TO 110
50    L1PRGI=256*CBLCKI(CPCBI)
      GO TO 110
60    L1PRGI=L1PRGI+CBLCKI(CPCBI)
      GO TO 110
70    N1RECI=256*CBLCKI(CPCBI)
      GO TO 110
80    N1RECI=N1RECI+CBLCKI(CPCBI)
      GO TO 110
90    L1RECI=256*CBLCKI(CPCBI)
      GO TO 110
100   L1RECI=L1RECI+CBLCKI(CPCBI)
110   CONTINUE
C
C     CHECK THE BLOCK SEQUENCE NUMBER.
C
      IF (BLKSQI.EQ.NEWBLK) GO TO 150
      ISTAT=1
      WRITE (PRINTR,120) NEWBLK,BLKSQI
120   FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I
     15//)
      BLKSQI=NEWBLK
      GO TO 160
C
C     FORMAT ERROR
C
130   ISTAT=2
      GO TO 160
C
C     CHECK L1PRGI AND L1RECI.
C
150   IF (L1PRGI.GT.NCDBI) GO TO 130
      IF (L1RECI.GT.NCDBI) GO TO 130
      ISTAT=0
160   RETURN
C
      END
      SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD)
C
C     GET A RECORD FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK).
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE
C               SPACE ALLOWED BY THE USER.  (POSITION IS STILL OK).
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C     THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM
C     CONTROL RECORDS.  NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS.
C
      ISTAT=0
      NCHACT=0
10    JUMP=1
      GO TO 260
20    NG=CBLCKI(CPCBI)
      IF (NG.EQ.0) GO TO 90
      IF (NG.NE.255) GO TO 30
C
C     END OF SHORT TAPE BLOCK.
C
      CCDBI=NCDBI
      GO TO 10
C
C     UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO
C     THE USER RECORD AREA.
C
30    ITYPEI=0
      IF (MODEI.EQ.0) GO TO 40
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG
40    IG=0
50    JUMP=2
      GO TO 260
60    NR=CBLCKI(CPCBI)
      IF (MODEI.EQ.0) GO TO 70
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR
      GO TO 160
70    IR=0
C     PUT REMVI INTO THE USER RECORD NR TIMES.
80    IF (IR.GE.NR) GO TO 160
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI
      IR=IR+1
      GO TO 80
C
C     THE NEXT RECORD IS A CONTROL RECORD.  FIND OUT WHAT KIND.
C
90    JUMP=3
      GO TO 260
100   ITYPEI=CBLCKI(CPCBI)
      IF (ITYPEI.LT.65) GO TO 250
C     65 = ASCII  A
      IF (ITYPEI.GT.90) GO TO 250
C     90 = ASCII  Z
      I=ITYPEI-64
C             A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
      GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160
     1,110,160,220,160,160,160,160,160,160,160,160), I
C       P   Q   R   S   T   U   V   W   X   Y   Z
C
C     P - PROGRAM HEADER
C
C     CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER
110   REMVI=32
C     RESET THE REMOVED CHARACTER TO ASCII BLANK.
      JUMP=4
      GO TO 260
120   L1PRGI=256*CBLCKI(CPCBI)
      JUMP=5
      GO TO 260
130   L1PRGI=L1PRGI+CBLCKI(CPCBI)
      JUMP=6
      GO TO 260
140   N1RECI=256*CBLCKI(CPCBI)
      JUMP=7
      GO TO 260
150   N1RECI=N1RECI+CBLCKI(CPCBI)
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
160   JUMP=8
      GO TO 260
170   NC=CBLCKI(CPCBI)
      IF (ITYPEI.NE.0) GO TO 180
      IF (MODEI.EQ.0) GO TO 180
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC
C     COPY NC CHARACTERS TO THE USER RECORD AREA.
180   IC=0
      JUMP=9
190   IF (IC.GE.NC) IF (ITYPEI) 240,210,240
      GO TO 260
200   NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI)
      IC=IC+1
      GO TO 190
210   IG=IG+1
      IF (IG-NG) 50,240,240
C
C     J - UPDATING AND END OF INPUT TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
220   JUMP=10
      GO TO 260
230   RECORD(1)=CBLCKI(CPCBI)
      NCHACT=1
      IF (ITYPEI.EQ.82) REMVI=RECORD(1)
C     82 = ASCII R
C
C     RETURN TO THE USER PROGRAM.
C
240   IF (NCHACT.GT.NCHMAX) ISTAT=4
      GO TO 290
C
C     CONTROL RECORD TYPE CANNOT BE DETERMINED.
C
250   ISTAT=5
      GO TO 290
C
C     GET A CHARACTER FROM CBLOCK.  UNPACK A NEW BLOCK IF NECESSARY.
C     READ MORE TAPE IF NECESSARY.
C
260   CPCBI=CPCBI+1
      CCDBI=CCDBI+1
      IF (CCDBI.LE.NCDBI) GO TO 270
      CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 290,260,290
270   IF (CPCBI.LE.NCCBI) GO TO 280
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
280   GO TO (20,60,100,120,130,140,150,170,200,230), JUMP
290   RETURN
C
      END
      SUBROUTINE EXCHNP (ISTAT,DBLOCK)
C
C     SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE
C     TAPE.
C     THIS MODULE IS MACHINE INSENSITIVE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
      ISTAT=0
      IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20
C
C     CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK.
C
10    IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20
C     76 = ASCII L
C
C     NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK.
      CCDBI=L1PRGI-1
      I=NWCBI*(CCDBI/NCCBI)+1
      IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI)
      CWDBI=I
      CPCBI=MOD(CCDBI,NCCBI)
      GO TO 40
C
C     NO MORE HEADERS IN THIS BLOCK.
C
20    CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 40,10,40
C
C     END OF FILE.
C
30    ISTAT=7
C
40    RETURN
C
      END
      SUBROUTINE EXCHPB (ISTAT,DBLOCK)
C
C     WRITE A BLOCK ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C     WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK.
      INTEGER WORK(9)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
C     PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK.
C
      BLKSQO=BLKSQO+1
      WORK(1)=BLKSQO/256
      WORK(2)=MOD(BLKSQO,256)
      WORK(3)=LASTO
      WORK(4)=L1PRGO/256
      WORK(5)=MOD(L1PRGO,256)
      WORK(6)=N1RECO/256
      WORK(7)=MOD(N1RECO,256)
      WORK(8)=L1RECO/256
      WORK(9)=MOD(L1RECO,256)
C
      CPCBO=MOD(NERRCO,NCCBO)
      CWDBO=(NERRCO/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
C
      DO 10 I=1,9
      CPCBO=CPCBO+1
      IF (CPCBO.LE.NCCBO) GO TO 10
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
      CWDBO=CWDBO+NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
      CPCBO=1
10    CBLCKO(CPCBO)=WORK(I)
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
C
C     WRITE THE DATA BLOCK ON TAPE.
C
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L).
C
      IF (LASTO.NE.76) GO TO 20
      ISTAT=3
      CALL EXCHWT (ISTAT,DBLOCK)
      GO TO 30
C
C     COMPUTE POINTERS FOR NEXT BLOCK OUT.
C
20    L1PRGO=0
      LLPRGO=0
      N1RECO=0
      L1RECO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
C
30    RETURN
C
      END
      SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD)
C
C     WRITE A RECORD ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A
C             TEXT RECORD CONTAINS MORE THAN 254 GROUPS.
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER GC,RC(255),CC(255)
C     GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      ISTAT=0
      INCHAR=0
C
C     DETERMINE THE RECORD TYPE.
C
      IF (NCHOUT.NE.255) GO TO 10
      ITYPEO=255
      GO TO 70
10    IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO
      IF (ITYPEO.NE.0) GO TO 30
C
C     DATA RECORD.
C
      IF (MODEO.NE.0) GO TO 170
C     COMPRESS THE RECORD.
      CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255)
      IF (GC.GE.255) GO TO 210
      IG=0
C     OUTPUT THE GROUP COUNT.
      CBLCKO(CPCBO)=GC
      JUMP=1
      GO TO 230
20    IG=IG+1
      IF (IG.GT.GC) GO TO 250
      NC=CC(IG)
      INCHAR=INCHAR+RC(IG)
C     OUTPUT REMOVED CHARACTER COUNT.
      CBLCKO(CPCBO)=RC(IG)
      JUMP=2
      GO TO 230
C
C     THE USER SAYS HE HAS A CONTROL RECORD TO WRITE.  FIND OUT
C     WHAT KIND.
C
30    IF (ITYPEO.LT.65) GO TO 220
C     65 = ASCII A
      IF (ITYPEO.GT.90) GO TO 220
C     90 = ASCII  Z
      I=ITYPEO-64
C             A  B  C  D  E  F  G  H  I  J   K  L  M  N  O  P  Q  R   S
      GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40,
     140,40,40,40,40,40,40), I
C      T  U  V  W  X  Y  Z
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE TYPE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
40    IF (NCHOUT-255) 100,100,210
C
C     END OF FILE.
C
50    IF (NERRCO+NDATAO+7-CCDBO) 70,80,80
C
C     P - PROGRAM HEADER.
C
60    IF (NCHOUT.GT.255) GO TO 210
      REMVO=32
C     RESET REMOVED CHARACTER TO ASCII BLANK.
      IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80
      IF (CCDBO.EQ.NERRCO+10) GO TO 80
C
C     END OF SHORT TAPE BLOCK.
C
70    CBLCKO(CPCBO)=255
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250
C     69 = ASCII E
C     80 = ASCII P
      L1RECO=CCDBO-NERRCO
80    IF (LLPRGO.EQ.0) GO TO 90
C     LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK.
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      NC=MOD(LLPRGO+1,NCCBO)
      NW=((LLPRGO+1)/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      CBLCKO(NC+1)=CCDBO/256
      IF (NC+1.LT.NCCBO) GO TO 85
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      NW=NW+NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      NC=-1
85    CBLCKO(NC+2)=MOD(CCDBO,256)
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      CALL EXCHUN (DBLOCK(CWDBO),CBLCKO)
C     UPDATE TABLE OF CONTENTS POINTERS
90    LLPRGO=CCDBO
      IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO
      NLRECO=NLRECO+1
      IF (N1RECO.EQ.0) N1RECO=NLRECO
100   CBLCKO(CPCBO)=0
      JUMP=3
      GO TO 230
110   CBLCKO(CPCBO)=ITYPEO
      JUMP=4
      GO TO 230
120   IF (ITYPEO.NE.69) GO TO 130
C     69 = ASCII E
      LASTO=76
      GO TO 70
130   IF (ITYPEO.NE.80) GO TO 170
C     80 = ASCII P
      CBLCKO(CPCBO)=0
      JUMP=5
      GO TO 230
140   CBLCKO(CPCBO)=0
      JUMP=6
      GO TO 230
150   CBLCKO(CPCBO)=NLRECO/256
      JUMP=7
      GO TO 230
160   CBLCKO(CPCBO)=MOD(NLRECO,256)
      JUMP=8
      GO TO 230
C
170   NC=NCHOUT
180   CBLCKO(CPCBO)=NC
      IC=0
      JUMP=9
C     PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD.
      IF (ITYPEO.EQ.82) GO TO 190
      IF (ITYPEO.EQ.74) GO TO 190
      IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230
190   IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250
      INCHAR=INCHAR+1
      IC=IC+1
      CBLCKO(CPCBO)=RECORD(INCHAR)
      GO TO 230
C
C     J - UPDATING AND END OF TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
200   NCHOUT=1
      IF (ITYPEO.EQ.82) REMVO=RECORD(1)
C     82 = ASCII R
      GO TO 100
C
C     RECORD TOO LONG.
C
210   ISTAT=4
      GO TO 250
C
C     UNKNOWN CONTROL RECORD TYPE.
C
220   ISTAT=5
      GO TO 250
C
C     INCREMENT THE OUTPUT BUFFER POINTERS.  PACK A CHARACTER BLOCK
C     IF NECESSARY.  WRITE A TAPE BLOCK IF NECESSARY.
C
230   CPCBO=CPCBO+1
      CCDBO=CCDBO+1
      IF (CPCBO.LE.NCCBO) GO TO 240
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CWDBO=CWDBO+NWCBO
      CPCBO=1
      IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 250
240   GO TO (20,180,110,120,140,150,160,170,190), JUMP
250   RETURN
C
      END
      SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL)
C
C     SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE
C     DATA TO BE REMOVED.  DIVIDE DATA INTO GROUPS CONSISTING OF
C     STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT
C     DATA.  THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE
C     REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP
C     ARE RECORDED IN RC() AND SC() RESPECTIVELY.  MAXSL IS THE
C     MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC().
C
      INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL
C
C     RC AND SC MUST BE AT LEAST (IMGLEN-1)//3.
C
      GC=1
      SC(1)=0
      RC(1)=0
      MODE=-1
      INPLEN=IABS(IMGLEN)
C
C     IDENTIFY DATA GROUPS.
C
      DO 110 I=1,INPLEN
      IF (MODE) 40,60,90
C
C     MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE.
C
40    IF (INPIMG(I).EQ.REMOVE) GO TO 50
C     SWITCH TO SIGNIFICANT DATA SCAN.
      MODE=1
      SC(GC)=1
      GO TO 110
C     CONTINUE REMOVE SCAN
50    RC(GC)=RC(GC)+1
      IF (RC(GC)-MAXSL) 110,95,110
C
C     MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY
C     ONE OCCURRENCE OF REMOVE.  CHANGE TO REMOVE MODE IF ANOTHER REMOVE
C     OCCURS OR BACK TO DATA MODE IF NOT.
C
60    IF (INPIMG(I).EQ.REMOVE) GO TO 80
C     SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT.
      MODE=1
      IF (SC(GC).GE.MAXSL-2) GO TO 70
      SC(GC)=SC(GC)+2
      GO TO 110
C     FULL GROUP
70    GC=GC+1
      RC(GC)=1
      SC(GC)=1
      GO TO 110
C     SWITCH TO REMOVE MODE.
80    GC=GC+1
      SC(GC)=0
      RC(GC)=2
      MODE=-1
      GO TO 110
C
C     MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA.
C
90    IF (INPIMG(I).EQ.REMOVE) GO TO 100
      SC(GC)=SC(GC)+1
      IF (SC(GC).NE.MAXSL) GO TO 110
C     FULL GROUP
      MODE=-1
95    IF (I.GE.INPLEN) GO TO 120
      GC=GC+1
      RC(GC)=0
      SC(GC)=0
      GO TO 110
100   MODE=0
110   CONTINUE
120   RETURN
C
      END
      SUBROUTINE EXCHTP (RECORD,LINEI)
C
C     MATERIALIZE INCLUDES IF INALT IS NON-ZERO.
C     CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE
C     AND THE PRINTER IF LISTING IS REQUESTED.
C     LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C
      INTEGER RECORD(1),LINEI
C
C     *****     LOCAL VARIABLES     ************************************
C
C COPY    DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR
C         SKIPPING TEXT NOT TO BE INCLUDED.
      INTEGER COPY
C DASH    CONTAINS '-' IN HOLLERITH.
      INTEGER DASH
C ENDMRK  HOLDS THE END SENTINEL.
      INTEGER ENDMRK(40)
C NCHEND  IS THE NUMBER OF CHARACTERS IN ENDMRK.
      INTEGER NCHEND
C NCHSAV  SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD.
      INTEGER NCHSAV
C NCHTAR  IS THE NUMBER OF CHARACTERS IN TARGET.
      INTEGER NCHTAR
C STAR    CONTAINS '*' IN HOLLERITH.
       INTEGER STAR
C TARGET  IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY).
      INTEGER TARGET(40)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL DATA     ***************************************
C
      DATA DASH /1H-/, STAR /1H*/
C
C     *****     PROCEDURES     *****************************************
C
      LINEO=LINEO+1
      IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190
      RECORD(180)=LINEO
      RECORD(179)=LINEI
      COPY=-1
C     COPY=-1 MEANS NOT COPYING INCLUDED TEXT.
      IF (ITYPEO.EQ.0) GO TO 110
C     PROCESS INCLUDE RECORD.
      DO 10 I=1,NCHOUT
10    RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I)
C     INSERT '-I '.
      RECORD(1)=45
      RECORD(2)=73
      RECORD(3)=32
      NCHOUT=NCHOUT+3
      IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110
C     STORE SEARCH TARGET
      NCHTAR=MIN0(NCHOUT,40)
      DO 20 I=1,NCHTAR
20    TARGET(I)=RECORD(I)
C     STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
      NCHSAV=NCHCMD
      DO 30 I=1,NUMBER
30    OUTREC(I)=COMAND(I)
      COPY=0
C     COPY=0 MEANS SKIPPING MODULE ON INALT FILE.
      INALT=IABS(INALT)
      NEOF=0
40    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
      IF (NCHCMD.LT.2) GO TO 40
      IF (COMAND(1).NE.45) GO TO 40
C     45 = ASCII -
      IF (COMAND(2).EQ.45) GO TO 130
      IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40
C     73 = ASCII I, 105 = ASCII LOWER CASE I.
C     COMPARE IMAGE WITH SEARCH TARGET.
      IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60
      DO 50 I=2,NCHTAR
      K=COMAND(I)
      IF (K.GT.96 .AND. K.LT.123) K=K-32
      IF (TARGET(I).NE.K) GO TO 60
50    CONTINUE
      NEOF=3
C     PREVENT SEARCH LOOP.
      COPY=1
C     COPY=1 MEANS COPYING INCLUDED TEXT.
60    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     STORE END OF INCLUDE MODULE SIGNAL.
      NCHEND=MIN0(40,NCHCMD)
      DO 70 I=1,NCHEND
70    ENDMRK(I)=COMAND(I)
      IF (COPY.EQ.0) GO TO 80
      CHAR1L=DASH
      NCHOUT=NCHTAR
      DO 75 I = 1,NCHOUT
75    COMAND(I)=TARGET(I)
      COMAND(180)=LINEO
      COMAND(179)=LINEI
C     GO PRINT TARGET.
      CALL EXCHTW (COMAND,-1)
      GO TO 120
C     COPY OR SKIP UNTIL ENDMRK SEEN AGAIN.
80    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF.
C     TEST FOR ENDMRK
      DO 90 I=1,NCHEND
      IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100
90    CONTINUE
      IF (COPY) 140,40,140
C     OUTPUT TEXT RECORD.
100   COMAND(180)=LINEO
      COMAND(179)=LINEI
      NCHOUT=NCHCMD
      CALL EXCHTW (COMAND,OPTI)
      GO TO 120
C     OUTPUT TEXT RECORD.
110   CALL EXCHTW (RECORD,1)
120   IF (COPY) 190,190,80
C     WE ONLY GET HERE WITH COPY .GE. 0.
130   NEOF=NEOF+1
      ACTION=2
C     ACTION = 2 MEANS REOPEN INALT.
      CALL EXCHIM
      IF (NEOF.LT.2) GO TO 40
140   INALT=-IABS(INALT)
      NCHCMD=1
      IF (COPY.GT.0) GO TO 170
C     PROCESS TARGET AS THOUGH IT WERE TEXT.
      NCHOUT=NCHTAR
C     SAVE TARGET FOR ERROR MESSAGE.
      DO 150 I=1,NCHTAR
150   COMAND(I)=TARGET(I)
      CALL EXCHTW (COMAND,1)
      CALL EXCHAH (TARGET,NCHTAR)
      WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR)
160   FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8
     10A1))
      NERRS=MAX0(NERRS,3)
C
C     RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
C
170   NCHCMD=NCHSAV
      DO 180 I=1,NUMBER
180   COMAND(I)=OUTREC(I)
C
190   CHAR1L=STAR
      RETURN
C
      END
      SUBROUTINE EXCHTW (RECORD,OPTION)
C
C     WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING
C     EXCHOU.  WRITE RECORD ON THE PRINTER IF LISTING REQUESTED.
C     RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C     IF OPTION = ZERO, WRITE TO FILE ONLY.
C     IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING.
C     IF OPTION .LT. ZERO, WRITE TO LISTING ONLY.
C
      INTEGER RECORD(1),OPTION
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     PROCEDURES     *****************************************
C
      LINEI=RECORD(179)
      IF (OPTION.LT.0) GO TO 130
C
C     INSERT IDENTIFICATION IF REQUESTED.
C
      IF (IDCOL2.LT.IDCOL1) GO TO 120
      IF (IDTXTL+IDSTEP.EQ.0) GO TO 120
      IF (NCHOUT.GE.IDCOL2) GO TO 20
      J=IDCOL2-1
C     FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2
      DO 10 I=NCHOUT,J
10    RECORD(I+1)=32
C     32 = ASCII BLANK.
20    NCHOUT=MAX0(NCHOUT,IDCOL2)
      N=-1
      IF (LINEI.EQ.0) GO TO 40
      IF (IDOPTN.NE.73) GO TO 40
C     73 = ASCII I.  IDENTIFY ONLY FROM INTAPE.
      N=(LINEI-1)*IDSTEP+IDSTRT
      GO TO 70
40    IF (IDOPTN.NE.79) GO TO 50
C     79 = ASCII O.  IDENTIFY ONLY TO OUTAPE.
      N=(LINEO-1)*IDSTEP+IDSTRT
      GO TO 70
50    IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70
C     67 = ASCII C, 70 = ASCII F.  IDENTIFY EVERYTHING.
      N=IDCUR
70    IF (N.LT.0) GO TO 120
      IF (IDTXTL.EQ.0) GO TO 100
      J=MIN0(IDCOL2,IDTXTL+IDCOL1-1)
      K=1
      DO 80 I=IDCOL1,J
      RECORD(I)=IDTEXT(K)
80    K=K+1
100   IF (IDSTEP.EQ.0) GO TO 120
      IDCUR=IDCUR+IDSTEP
      K=IDCOL2
110   RECORD(K)=MOD(N,10)+48
      N=N/10
      K=K-1
      IF (N.EQ.0) GO TO 120
      IF (K.GE.IDCOL1) GO TO 110
C
C     OUTPUT RECORD.
C
120   IF (OUFILE.NE.0) CALL EXCHOU (RECORD)
      IF (OPTION.EQ.0) GO TO 220
130   IF (OPTL.NE.0) GO TO 140
      IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220
140   CALL EXCHAH (RECORD,NCHOUT)
      IF (OPTV+VERT.NE.0) GO TO 200
      IF (PHASE.NE.8) GO TO 180
      IF (LINEI.EQ.0) GO TO 160
      WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
150   FORMAT (1X,2I5,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
160   WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
170   FORMAT (5H  NEW,I6,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
180   WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
190   FORMAT (1X,I5,A1,3X,110A1/(6H  CONT,4X,110A1))
      GO TO 220
200   WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT)
210   FORMAT (132A1)
220   RETURN
C
      END
      SUBROUTINE EXCHC1 (IBLOCK,OBLOCK)
C
C     COMMAND DECODER AND FORMAT VERIFIER.  SOME COMMANDS ARE ALSO
C     COMPLETELY PROCESSED HERE.
C
C     IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS.
C
      INTEGER IBLOCK(1),OBLOCK(1)
C
C
C     *****     LOCAL VARIABLES     ************************************
C
C ALLOW   TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED.  VALUES ARE
C         SUMS OF PERMITTED VALUES OF PHASE.
C         1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING,
C         8 = UPDATING.
C         ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A
C         PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR
C         MAY BE VOID (EQUAL SIGN IS LAST CHARACTER).
C         32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT.
      INTEGER ALLOW(35)
C BLANK   A CONSTANT.  1H .
      INTEGER BLANK
C DATE    IS THE DATE FROM UPDA=, DATE=, ORIG=.
      INTEGER DATE(3)
C DAYS    TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS.
      INTEGER DAYS(12)
C I       IS USED FREELY AS AN INDEX.
C J       IS USED FREELY AS AN INDEX.
C JUMP    USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE.
C K       IS USED FREELY AS AN INDEX.
C KDATE   IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD).
C KQUIT   IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD).
C KTEXT   IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD).
C N       IS USED FREELY AS AN INDEX.
C NCNREC  IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS.
C ND      IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER.
C NM      IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER.
C NY      IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER.
C TVAL    A VECTOR OF VALUES FOR TRANS.  INDEXED BY ICOMD.
      INTEGER TVAL(35)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL EQUIVALENCE     **********************************
C
      EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND)
C
C     *****     DATA STATEMENTS     ************************************
C
      DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/
      DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/
      DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/
      DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/
      DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/
      DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/
      DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/
      DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/
      DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/
      DATA BLANK /1H /
      DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/
      DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/
      DATA DAYS(11),DAYS(12) /30,31/
      DATA KDATE /5/
      DATA KQUIT /20/
      DATA KTEXT /27/
      DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/
      DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/
      DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/
      DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/
      DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/
      DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/
      DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/
C
C     *****     PROCEDURES     *****************************************
C
C     GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER.
C     ECHO IT IF THE E OPTION IS SET.  DETERMINE WHETHER IT IS A CHANGE
C     TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND.
C
10    NCNREC=0
20    ACTION=0
      IF (NCHCMD.LT.0) GO TO 220
      CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (OPTE.EQ.0) GO TO 27
      WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD)
23    FORMAT (1X,80A1)
      CHAR1L=0
27    NCHCMD=MIN0(NCHCMD,MARGIN)
      IF (PHASE.LT.4) SIGNAL=45
C     45 = ASCII -
      IF (COMAND(1).NE.45) GO TO 50
C     45 = ASCII -.  REQUEST TO CHANGE CONTROL RECORD.
      IF (PHASE.LT.4) GO TO 40
      WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD)
30    FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT
     1OR UPDATE/1X,80A1)
      NERRG=MAX0(NERRG,2)
      GO TO 200
40    ICOMD=0
      EQUAL=2
      TRANS=3
      GO TO 370
50    IF (COMAND(1).NE.42) GO TO 70
C     42 = ASCII *.  COMMENT RECORD.  JUST ECHO IT.
      NCHCMD=MAX0(NCHCMD,2)
      WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD)
60    FORMAT (A1,1H*,78A1/(1X,80A1))
      GO TO 10
C
C     SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR
C     EQUAL SIGN ARE FOUND.  LOOK UP THE WORD IN THE COMMAND NAME TABLE.
C
70    EQUAL=0
      DO 80 I=1,NCHCMD
      IF (COMAND(I).EQ.32) GO TO 80
C     32 = ASCII BLANK
      EQUAL=EQUAL+1
      ICOMD=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32
C     ABOVE STATEMENT CONVERTS TO UPPER CASE.
      COMAND(I)=32
      COMAND(EQUAL)=ICOMD
      IF (EQUAL.GE.4) GO TO 90
      IF (ICOMD.EQ.61) GO TO 90
C     61 = ASCII =.
      IF (ICOMD.EQ.44) GO TO 90
C     44 = ASCII ,.
80    CONTINUE
      IF (EQUAL.EQ.0) GO TO 185
90    DO 110 ICOMD=1,NCOMDT
      DO 100 K=1,EQUAL
      IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110
100   CONTINUE
      IF (EQUAL.EQ.4) GO TO 130
      IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130
C     32 = ASCII BLANK.
110   CONTINUE
C
C     UNRECOGNIZED COMMAND.
C
120   ICOMD=0
C
C     LOOK FOR AN EQUAL SIGN.  SET THE VARIABLE NAMED EQUAL TO ZERO IF
C     THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK
C     CHARACTER FOLLOWING THE EQUAL SIGN.
C
130   MODIFY=0
140   DO 150 I=EQUAL,NCHCMD
      K=COMAND(I)
      IF (K.EQ.61) GO TO 160
C     61 = ASCII =.
      IF (MODIFY.NE.0) GO TO 150
C     USE FIRST MODIFIER.
      IF (K.EQ.44) GO TO 160
C     44 = ASCII ,.
150   CONTINUE
      EQUAL=0
      GO TO 170
160   I=I+1
      EQUAL=I
      IF (I.GT.NCHCMD) GO TO 170
      IF (COMAND(I).EQ.32) GO TO 160
C     32 = ASCII BLANK
      IF (K.NE.44) GO TO 170
C     44 = ASCII ,.
      MODIFY=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32
C     CONVERT TO UPPER CASE.
      GO TO 140
170   IF (K.NE.61) EQUAL=0
C     61 = ASCII =.
      IF (ICOMD.EQ.0) GO TO 180
      IF (ICOMD.GT.NCOMDP) GO TO 180
      IF (EQUAL.GT.NCHCMD) GO TO 175
      IF (EQUAL.NE.0) GO TO 230
      IF (ALLOW(ICOMD)/64.NE.0) GO TO 230
175   IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690
C     PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK.
      NCHCMD=NCHCMD+1
      EQUAL=NCHCMD
      COMAND(NCHCMD)=32
C     32 = ASCII BLANK
      HOLCMD(NCHCMD)=BLANK
      GO TO 230
C
C     GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX.
C
180   CALL EXCHCX (0)
C     IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND.
      IF (ICOMD.NE.0) GO TO 730
185   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1))
      NERRG=MAX0(NERRG,5)
200   CHAR1L=0
      NCNREC=NCNREC+1
      IF (NCNREC.LE.20) GO TO 20
      WRITE (PRINTR,210)
210   FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU
     1MES TEXT COMMAND IS MISSING.)
      GO TO 270
C
C     END OF FILE - SIMULATE A QUIT COMMAND.
C
220   ICOMD=KQUIT
C
C     RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME.
C
230   IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240
      TRANS=TVAL(ICOMD)
C             1   2   3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300
     1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7
     230,370,730,370), ICOMD
C       16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
C     32  33  34  35
C
C     THE COMMAND IS NOT ALLOWED AT THIS TIME.
C
240   WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE
     1D./1X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
C     DECIDE WHETHER TO SKIP TEXT
260   IF (ICOMD.NE.KTEXT) GO TO 10
      IF (EQUAL.NE.0) GO TO 10
270   WRITE (PRINTR,280)
280   FORMAT (//15H0SKIPPING TEXT.)
290   CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (NCHCMD.LT.2) GO TO 290
      IF (COMAND(1).NE.SIGNAL) GO TO 290
      IF (COMAND(2).EQ.SIGNAL) GO TO 10
      IF (NCHCMD.LT.3) GO TO 290
      IF (COMAND(2).NE.61) GO TO 290
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 290
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING.
C     DATE=YYMMDD
C     ORIGIN=YYMMDD SITE
C     UPDATE=YYMMDD SITE
C     IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE
C     THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED.
C
300   IF (EQUAL+5.GT.NCHCMD) GO TO 700
      I=EQUAL
      DO 310 J=1,3
      DATE(J)=0
      DO 310 K=1,2
      N=COMAND(I)-48
      IF (N.LT.0) GO TO 320
      IF (N.GT.9) GO TO 320
      DATE(J)=10*DATE(J)+N
310   I=I+1
      IF (NM.EQ.0) GO TO 320
      IF (NM.GT.12) GO TO 320
      IF (ND.LE.0) GO TO 320
      DAYS(2)=28
      IF (MOD(NY,4).EQ.0) DAYS(2)=29
      IF (NY.EQ.0) DAYS(2)=28
      IF (ND.LE.DAYS(NM)) GO TO 440
320   IF (ICOMD.EQ.KDATE) GO TO 700
      IF (TODAY(1).EQ.32) GO TO 700
      I=MIN0(NCHCMD+6,180)
      NCHCMD=I
      J=I-6
      IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1
C     32 = ASCII BLANK
      IF (J.LT.EQUAL) GO TO 700
330   COMAND(I)=COMAND(J)
      HOLCMD(I)=HOLCMD(J)
      J=J-1
      I=I-1
      IF (J.GE.EQUAL) GO TO 330
      DO 340 I=1,6
      COMAND(I+EQUAL-1)=TODAY(I)
340   HOLCMD(I+EQUAL-1)=TODAY(I)
      CALL EXCHAH (HOLCMD(EQUAL),6)
      WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD)
345   FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1))
      NERRG=MAX0(NERRG,1)
      GO TO 440
C
C     REWIND INTAPE
C
350   IF (INTAPE.EQ.0) GO TO 680
      IF (INTOPN.NE.0) GO TO 360
      I=1
C     OPEN INTAPE IF NOT ALREADY OPEN.  DO NOT CHECK EXCH LABEL.
      CALL EXCHRT (I,IBLOCK)
C     IGNORE STATUS
360   I=2
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
      GO TO 725
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH
C     BEGINS WITH A NUMBER FOLLOWED BY A BLANK.
C
C     INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     INTAPE = NUMBER SYSTEM DEPENDENT DATA
C     LIMIT = NUMBER
C     MARGIN = NUMBER
C     OUTAPE = NUMBER SYSTEM DEPENDENT DATA
C     OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     PRINTER = NUMBER
C     READER = NUMBER
C     SKIP = NUMBER
C     TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL)
C     WORK = NUMBER
C
370   NUMBER=0
      IF (EQUAL.EQ.0) GO TO 440
      DO 410 J=EQUAL,NCHCMD
      IF (COMAND(J).EQ.32) GO TO 420
C     32 = ASCII BLANK
      N=COMAND(J)-48
C     48 = ASCII ZERO
      IF (N.GE.0) GO TO 400
380   WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD)
390   FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS.  NOT PROCESSED./
     11X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
      GO TO 260
400   IF (N.GT.9) GO TO 380
410   NUMBER=10*NUMBER+N
      EQUAL=NCHCMD+1
      GO TO 440
420   EQUAL=J
430   EQUAL=EQUAL+1
      IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440
C     32 = ASCII BLANK
C
C     PRELIMINARY FORMAT CHECKING IS COMPLETE
C
440   J=ICOMD+1
C             0  1   2  3  4  5   6  7  8   9  10 11  12 13 14  15  16
      GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6
     120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595),
     2J
C     17 18  19 20  21 22 23 24 25  26  27 28  29  30 31 32  33 34  35
C
C     DATE=YYMMDD
C
450   DO 460 I=1,6
460   TODAY(I)=COMAND(EQUAL+I-1)
      GO TO 10
C
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA.
C
470   I=INFILE
      J=1
      GO TO 500
C
C     INCLUDE = NUMBER SYSTEM DEPENDENT DATA.
C
480   I=INALT
      J=3
      INALT=IABS(INALT)
      GO TO 500
C
C     TEXT
C
490   I=INTEXT
      J=2
      IF (EQUAL.EQ.0) GO TO 560
C
C     OPEN AN INPUT FILE.
C
500   IF (NUMBER.EQ.0) GO TO 505
      IF (NUMBER.EQ.OUFILE) GO TO 710
      IF (NUMBER.EQ.OUTAPE) GO TO 710
505   IF (J.EQ.2) GO TO 510
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (I.NE.0) CALL EXCHIM
510   IF (J-2) 520,530,540
520   INFILE=NUMBER
      GO TO 550
530   INTEXT=NUMBER
      GO TO 550
540   INALT=NUMBER
550   IF (NUMBER.EQ.0) GO TO 560
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      CALL EXCHCX (J+1)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHIM
      ACTION=2
C     ACTION = 2 MEANS REWIND
      IF (J.EQ.3) CALL EXCHIM
      INALT=-IABS(INALT)
560   ACTION=0
C     ACTION = 0 MEANS READ TEXT
      GO TO 730
C
C     INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
570   IF (INTOPN.EQ.0) GO TO 580
C     CLOSE THE INPUT TAPE, IGNORE STATUS.
      I=4
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
580   INTAPE=NUMBER
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (INTAPE.NE.0) CALL EXCHCX (6)
      GO TO 725
C
C     LIMIT = NUMBER
C
590   LIMIT=NUMBER
      GO TO 10
C
C     MARGIN = NUMBER
C
C     MINIMUM MARGIN IS 60
595   MARGIN=MAX0(NUMBER,60)
      GO TO 10
C
C     OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
600   IF (OUTOPN.EQ.0) GO TO 610
C     WRITE AND END-OF-FILE MARK ON OUTAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (I,OBLOCK,OBLOCK)
C     IGNORE STATUS
      OUTOPN=0
      PHASE=1
610   OUTAPE=NUMBER
      OUTUPD=MODIFY
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (OUTAPE.NE.0) CALL EXCHCX (7)
      GO TO 730
C
C     OUTPUT =  NUMBER SYSTEM DEPENDENT INFORMATION
C
620   ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      OUFILE=NUMBER
      IDCUR=IDSTRT
      IF (OUFILE.EQ.0) GO TO 730
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND.
      CALL EXCHCX (5)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHOU (OUTREC)
      GO TO 730
C
C     PRINTER = NUMBER.
C
630   CALL EXCHFO (-2)
      PRINTR=NUMBER
      CALL EXCHFO (2)
      GO TO 10
C
C     READER = NUMBER.
C
640   IF (INFILE.NE.0) GO TO 670
      CALL EXCHFO (-1)
      READER=NUMBER
      CALL EXCHCX (1)
      CALL EXCHFO (1)
      GO TO 10
C
C     WORK = NUMBER
C
650   IF (WORKF.GT.0) CALL EXCHFO (-3)
      WORKF=NUMBER
C     WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4.
      GO TO 10
C
C     UPDATE
C
C     DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR
C     SIMPLY TO OUTPUT THE UPDATE COMMAND.
660   IF (PHASE.GE.4) TRANS=5
      GO TO 730
C
C     ERROR MESSAGES.
C
670   NUMBER=3
C     MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE.
      GO TO 720
680   NUMBER=4
C     MESSAGE 4 - INTAPE IS NOT DEFINED.
      GO TO 720
690   NUMBER=12
C     MESSAGE 12 - NO PARAMETER STRING.
      GO TO 720
700   NUMBER=13
C     MESSAGE 13 - IMPROPER DATE.
      GO TO 720
710   NUMBER=31
C     MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT.
C
C     RETURN TO ERROR MESSAGE SEGMENT.
C
720   TRANS=8
      GO TO 740
c
c     Indicate the WORK file is empty.
c
725   if (nrwork.le.0 .or. workf.le.0) go to 730
      REWIND WORKF
      NRWORK=0
C
C     IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP.
C
730   IF (TRANS.EQ.1) GO TO 10
740   RETURN
C
      END
      SUBROUTINE EXCHCX (REASON)
C
C     PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER
C     PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT,
C     INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS.
C     CDC6600/7600 VERSION.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER REASON,CDCMDE
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /CDCMDE/ CDCMDE
C
C     REASON=0 FOR UNRECOGNIZED COMMAND.
C     REASON=1 BEFORE OPENING READER.
C     REASON=2 BEFORE OPENING INFILE.
C     REASON=3 BEFORE OPENING INTEXT.
C     REASON=4 BEFORE OPENING INALT.
C     REASON=5 BEFORE OPENING OUFILE.
C     REASON=6 BEFORE OPENING INTAPE.
C     REASON=7 BEFORE OPENING OUTAPE.
C
      IF(REASON.GT.0 .OR. NCHCMD.LT.4) RETURN
      I=ICOMD-NCOMDP
      IF(I.LT.0 .OR. I.GT.2) RETURN
      CDCMDE=I
      RETURN
C
      END
      SUBROUTINE  EXCHC2
C
C     PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KINDE /32/
      DATA KOPTI /14/
      DATA KSITE /25/
C
C     FIGURE OUT WHICH COMMAND GOT US HERE.
C
      IF (ICOMD-KOPTI) 60,150,10
10    IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270
C
C     ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT
C     WHERE C1, C2, STEP AND START ARE INTEGERS.
C     STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP,
C     START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF
C     CHARACTERS OF TEXT IN IDTXTL.  IF AN ERROR OCCURS,
C     STORE ZERO IN IDSTEP AND IDTXTL.
C     IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO.
C
C     STORE THE MODIFIER IN IDOPTN.
C     IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE
C     PRODUCED ONLY FOR IMAGES FROM INTAPE.  IF THE O MODIFIER
C     IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES
C     WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT.  IF THE F
C     MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION
C     OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE
C     PRODUCED FOR ALL IMAGES OUTPUT.  IF THE C MODIFIER IS SPECIFIED,
C     SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH
C     RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR
C     ALL IMAGES OUTPUT.  IF NONE OF THE I, F, OR C MODIFIERS ARE
C     SPECIFIED, THE O MODIFIER IS ASSUMED.
C
C     IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED.
C     IF IDTXTL = ZERO, TEXT IS NOT EMITTED.
C     IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE
C     EMITTED.
C
C     CONVERT C1,C2,STEP,START
C
      IDOPTN=MODIFY
      IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79
C     70 = ASCII F, 73 = ASCII I, 79 = ASCII O.
      DO 40 J=1,4
      NUMBER=0
20    IF (EQUAL.GT.NCHCMD) GO TO 40
      IF (COMAND(EQUAL).EQ.44) GO TO 30
C     44 = ASCII ,
      I=COMAND(EQUAL)-48
      IF (I.LT.0) GO TO 350
      IF (I.GT.9) GO TO 350
      NUMBER=10*NUMBER+I
      EQUAL=EQUAL+1
      GO TO 20
30    EQUAL=EQUAL+1
40    IDNBRS(J)=NUMBER
      IDCUR=IDSTRT
      IDCOL1=MAX0(1,MIN0(IDCOL1,178))
      IDCOL2=MIN0(IDCOL2,178)
C
C     STORE TEXT.
C
      IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0)
      IF (IDTXTL.EQ.0) GO TO 330
      DO 50 J=1,IDTXTL
      IDTEXT(J)=COMAND(EQUAL)
50    EQUAL=EQUAL+1
      GO TO 330
C
C     INDEX = PARAMETER STRING
C
60    J=0
      IF (COMAND(EQUAL).NE.45) GO TO 70
C     45 = ASCII -
      J=-1
      EQUAL=EQUAL+1
70    N=0
      DO 80 I=1,26
80    INDEXS(I)=0
90    IF (EQUAL.GT.NCHCMD) GO TO 130
      I=COMAND(EQUAL)-64
      IF (I.EQ.-32) GO TO 120
C     32 = ASCII BLANK.
      IF (I.GE.32) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.LE.0) GO TO 100
      IF (I.LE.26) GO TO 110
100   N=EQUAL
      GO TO 120
110   INDEXS(I)=1
120   EQUAL=EQUAL+1
      GO TO 90
130   INDEX=0
      DO 140 I=1,26
      INDEXS(I)=IABS(INDEXS(I)+J)
140   INDEX=INDEX+INDEXS(I)
      IF (MODIFY.EQ.76) INDEX=-INDEX
C     76 = ASCII L.
      IF (N) 340,330,340
C
C     OPTION = PARAMETER STRING
C
150   IF (MODIFY.NE.0) GO TO 170
      DO 160 I=1,26
160   OPTVAL(I)=0
170   IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330
      I=1
      IF (MODIFY.EQ.67) I=0
C     67 = ASCII C.
      N=0
      DO 190 J=EQUAL,NCHCMD
      K=COMAND(J)
      IF (K.GE.96) K=K-32
C     CONVERT TO UPPER CASE.
      IF (K.EQ.32) GO TO 190
C     32 = ASCII BLANK
      IF (K.LT.65) GO TO 180
      IF (K.GT.90) GO TO 180
C     PROCESS ALPHABETIC OPTIONS.
      OPTVAL(K-64)=I
      GO TO 190
180   N=J
190   CONTINUE
      IF (N) 330,330,340
C
C     PROCESS PRED = ID REC A/X MASK STRING
C       WHERE ID = PREDICATE IDENTIFIER (A-H),
C       REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE,
C       A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH
C             IN EXACT POSITION,
C       MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE
C              TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED.
C       STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF
C                CONTROL RECORDS.
C
C     THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR
C     PREDICATE A, ETC.
C
C     PRED(1,*)=LENGTH OF STRING + 3
C     PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED.
C     PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND).
C     PRED(3,*)=RECORD TYPE.
C     PRED(4,*)=A/X
C     PRED(5,*)=MASK CHARACTER.
C     PRED(6..42,*)=STRING.
C
200   IF (EQUAL.NE.0) GO TO 240
C     LIST ALL ACTIVE PREDICATES.
      DO 230 I=1,8
      IF (PRED(1,I).EQ.0) GO TO 230
      J=PRED(1,I)+1
      COMAND(1)=I+64
      DO 210 K=2,J
210   COMAND(K)=PRED(K+1,I)
      CALL EXCHAH (COMAND,J)
      WRITE (PRINTR,220) (COMAND(K),K=1,J)
220   FORMAT (6H PRED=,42A1)
230   CONTINUE
      GO TO 330
C     SAVE PREDICATE IF VALID.
240   IF (NCHCMD.LE.EQUAL+3) GO TO 370
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.GT.72) GO TO 360
C     72 = ASCII H
      NUMBER=J-64
      PRED(1,NUMBER)=0
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.GT.90) GO TO 360
C     90 = ASCII Z
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.EQ.82) GO TO 360
C     82 = ASCII R
      PRED(3,NUMBER)=J
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.NE.65.AND.J.NE.88) GO TO 360
C     65 = ASCII A, 88 = ASCII X
      PRED(4,NUMBER)=J
      EQUAL=EQUAL+1
      PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40)
      I=4
      DO 250 J=EQUAL,NCHCMD
      I=I+1
      IF (I.GT.42) GO TO 330
      K=COMAND(J)
      IF (K.GT.96) K=K-32
C     CONVERT TO UPPER CASE.
250   PRED(I,NUMBER)=K
      GO TO 330
C
C     SITE = SITE NAME
C
260   JUMP=1
      GO TO 280
C
C     TITLE = OUTPUT TAPE TITLE
C
270   JUMP=2
280   K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 320 I=1,40
      IF (K.GT.NCHCMD) GO TO 290
      J=COMAND(K)
      K=K+1
      GO TO 300
290   J=32
C     32 = ASCII BLANK.
300   IF (JUMP.EQ.2) GO TO 310
      SITE(I)=J
      GO TO 320
310   TITLE(I)=J
320   CONTINUE
C
C     RETURN TO COMMAND DECODER.
C
330   TRANS=1
      GO TO 390
C
C     ERROR MESSAGES
C
340   NUMBER=14
C     MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED.
      EQUAL=N
      GO TO 380
350   IDSTEP=0
      IDTXTL=0
360   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED.
      GO TO 380
370   NUMBER=30
C     MESSAGE 30 - COMMAND IS INCOMPLETE.
C
380   TRANS=8
C
390   RETURN
C
      END
      SUBROUTINE EXCHC3 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE
C     COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES.
C
C     OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE
C     NAME COMMAND.
C
C     OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING
C     COPY, NAME OR UPDATE COMMANDS.
C
C ID      IS USED TO CONSTRUCT THE OUTPUT LABEL.
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                                    E  X  C  H
      DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/
C                                    A  N  G  E
      DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/
      DATA KNAME /9/
      DATA KSKIP /26/
C
C     OPEN INTAPE IF NECESSARY
C
      IF (INTOPN.NE.0) GO TO 70
      IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300
      IF (INTAPE.EQ.OUTAPE) GO TO 360
      CALL EXCHRH (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 310
      INTOPN=1
C     COPY THE LABEL TO A SAVE AREA.
      DO 10 I=1,180
10    LABELI(I)=CBLCKI(I)
      CALL EXCHAH (CBLCKI(13),138)
      WRITE (PRINTR,20)
20    FORMAT (25H0INPUT LABEL INFORMATION.)
      WRITE (PRINTR,30) (CBLCKI(I),I=13,104)
30    FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/
     1        20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1)
      IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150)
40    FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1)
      WRITE (PRINTR,50) NDATAI
50    FORMAT (28H DATA CHARACTERS PER BLOCK =,I6)
      IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI
60    FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6)
      CHAR1L=0
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 290
70    IF (ICOMD.EQ.KSKIP) GO TO 270
C
C     OPEN OUTAPE IF NECESSARY
C
80    IF (ICOMD.EQ.0) GO TO 90
      IF (ICOMD.LT.KNAME) GO TO 100
90    IF (INTAPE*OUTAPE.EQ.0) GO TO 100
      IF (OUTUPD.NE.85) GO TO 370
C     85 = ASCII U.
100   IF (OUTOPN.NE.0) GO TO 240
      IF (OUTAPE.EQ.0) GO TO 240
C     CONSTRUCT THE OUTPUT LABEL.
      IF (TODAY(1).EQ.0) GO TO 340
      IF (INTOPN.EQ.0) GO TO 160
      DO 110 I=1,180
110   CBLCKO(I)=LABELI(I)
      IF (TITLE(1).EQ.32) GO TO 130
C     32 = ASCII BLANK
      DO 120 I=1,40
120   CBLCKO(I+18)=TITLE(I)
130   IF (OUTUPD.NE.85) GO TO 220
C     85 = ASCII U.
      IF (SITE(1).EQ.0) GO TO 350
      DO 140 I=1,6
140   CBLCKO(I+104)=TODAY(I)
      DO 150 I=1,40
150   CBLCKO(I+110)=SITE(I)
      GO TO 220
160   IF (TITLE(1).EQ.32) GO TO 330
C     32 = ASCII BLANK
      IF (SITE(1).EQ.0) GO TO 350
      IF (INTAPE*OUTAPE.EQ.0) GO TO 170
      IF (INTAPE.EQ.OUTAPE) GO TO 360
170   DO 180 I=1,8
180   CBLCKO(I)=ID(I)
      DO 190 I=1,40
      CBLCKO(I+18)=TITLE(I)
190   CBLCKO(I+64)=SITE(I)
      DO 200 I=1,6
200   CBLCKO(I+58)=TODAY(I)
      DO 210 I=105,180
210   CBLCKO(I)=0
220   CALL EXCHWH (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 320
      OUTOPN=1
      CBLCKO(1)=CBLCKO(105)
      CALL EXCHAH (CBLCKO(13),138)
      WRITE (PRINTR,230)
      WRITE (PRINTR,30) (CBLCKO(I),I=13,104)
230   FORMAT (26H0OUTPUT LABEL INFORMATION.)
      IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150)
      WRITE (PRINTR,50) NDATAO
      IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO
      CHAR1L=0
240   IF (ICOMD-KNAME) 250,260,280
C
C     COPY
C
250   TRANS=4
      MODEI=1-MIN0(1,OUFILE+OPTL)
      IF (ICOMD.EQ.0) MODEI=0
      GO TO 390
C
C     NAME
C
260   TRANS=5
      IF (NRWORK.EQ.0) PHASE=4
      GO TO 390
C
C     SKIP
C
270   TRANS=4
      GO TO 390
C
C     UPDATE
C
280   TRANS=5
      MODEI=0
      GO TO 390
C
C     ERROR MESSAGES
C
290   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      EQUAL=ISTAT
      GO TO 380
300   NUMBER=4
C     MESSAGE 4 - INTAPE NOT DEFINED.
      GO TO 380
310   NUMBER=5
C     MESSAGE 5 - UNABLE TO OPEN INTAPE.
      EQUAL=ISTAT
      GO TO 380
320   NUMBER=6
C     MESSAGE 6 - UNABLE TO OPEN OUTAPE.
      EQUAL=ISTAT
      GO TO 380
330   NUMBER=7
C     MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE.
      GO TO 380
340   NUMBER=8
C     MESSAGE 8 - DATE NOT SUPPLIED.
      GO TO 380
350   NUMBER=9
C     MESSAGE 9 - SITE NOT SUPPLIED.
      GO TO 380
360   NUMBER=10
C     MESSAGE 10 - INTAPE = OUTAPE.
      GO TO 380
370   NUMBER=11
C     MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED.
380   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM
C
390   RETURN
C
      END
      SUBROUTINE EXCHRH (ISTAT,DBLOCK)
C
C     READ THE HEADER LABEL FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE
C               NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     OPEN THE INPUT TAPE.
C
      ISTAT=1
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     READ A BLOCK.
C
      NDATAI=171
      NERRCI=0
      BLKSQI=0
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     FIND OUT IF IT IS A PROPER LABEL.
C
      CALL EXCHUN (DBLOCK,CBLCKI)
      DO 10 I=1,8
      IF (CBLCKI(I).NE.ID(I)) GO TO 20
10    CONTINUE
C
C     GET READY TO READ THE REST OF THE TAPE.
C
      CCDBI=NCDBI
      NDATAI=256*CBLCKI(9)+CBLCKI(10)
      NERRCI=256*CBLCKI(11)+CBLCKI(12)
      LASTI=0
      L1PRGI=0
      ISTAT=0
      GO TO 30
C
C     NOT A LABEL.
C
20    ISTAT=6
C
C     CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK.
25    I=4
      CALL EXCHRT (I,DBLOCK)
C
30    RETURN
C
      END
      SUBROUTINE EXCHWH (ISTAT,DBLOCK)
C
C     WRITE A HEADER ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE
C               WRITTEN ARE NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     MAKE SURE IT IS A PROPER LABEL.
C
      DO 10 I=1,8
      IF (CBLCKO(I).NE.ID(I)) GO TO 30
10    CONTINUE
C
C     OPEN THE OUTPUT TAPE.
C
      ISTAT=1
      CALL EXCHWT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 40
C
C     CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR
C     CONTROL CHARACTERS
C
      CBLCKO(9)=NDATAO/256
      CBLCKO(10)=MOD(NDATAO,256)
      CBLCKO(11)=NERRCO/256
      CBLCKO(12)=MOD(NERRCO,256)
C
C     INSERT TODAYS DATE
C
      DO 20 I=1,6
20    CBLCKO(I+12)=TODAY(I)
C
C     WRITE THE BLOCK ON TAPE.
C
      BLKSQO=0
      CALL EXCHPA (CBLCKO,DBLOCK)
      CCDBO=180
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     GET READY TO WRITE THE REST OF THE FILE.
C
      L1PRGO=0
      LLPRGO=0
      N1RECO=0
      NLRECO=0
      L1RECO=0
      LASTO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      GO TO 40
C
C     NOT A PROPER LABEL.
C
30    ISTAT=6
C
40    RETURN
C
      END
      SUBROUTINE EXCHC4 (IBLOCK)
      INTEGER IBLOCK(1)
C
C     PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM
C     COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KCOPY /3/
C
C     ARE WE STARTING OR CONTINUING?
C
C     ICOMD.EQ.0  MEANS  CHANGE A CONTROL RECORD
C     ICOMD.GT.0  MEANS  SKIP OR COPY COMMAND BEGIN
C     ICOMD.EQ.-1 MEANS  CONTINUE COPY = NUMBERS
C     ICOMD.EQ.-2 MEANS  CONTINUE COPY = PREDICATE EXPRESSION
      NEWP=0
      IF (ITYPEI.EQ.80) VERT=0
C     80 = ASCII P.  WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO
C     IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON
C     THE WORK FILE.
      IF (ICOMD.EQ.0) GO TO 190
C     ICOMD=0 MEANS CHANGING A CONTROL RECORD.
      IF (ICOMD+1) 290,170,10
10    IF (ICOMD.EQ.KCOPY) GO TO 30
C
C     SKIP COMMAND.
C
      IF (INTOPN.LT.0) GO TO 430
      if (modify.eq.70) number=number+n1reci-1
c     70 = ASCII F.
      IF (NUMBER+1-N1RECI) 540,430,20
20    CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.EQ.69) GO TO 460
C     69 = ASCII E.
      IF (N1RECI-NUMBER) 20,20,430
C
C     COPY COMMAND FORMAT VERIFICATION.
C
30    IF (COMAND(EQUAL).LT.48) GO TO 180
C     48 = ASCII ZERO
      IF (COMAND(EQUAL).GT.57) GO TO 180
C     57 = ASCII NINE
C
C     COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS.
C     CONVERT THE NUMBERS AND STORE THEM IN COMAND.  IF THE NUMBER
C     IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER.
C
      ICOMD=-1
      I=0
      J=44
C     44 = ASCII COMMA
40    I=I+1
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 480
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=NUMBER
50    EQUAL=EQUAL+1
      IF (EQUAL.GT.NCHCMD) GO TO 60
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 60
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=10*COMAND(I)+NUMBER
      GO TO 50
60    IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70
70    IF (J.EQ.45) COMAND(I)=-COMAND(I)
C     45 = ASCII DASH
      IF (EQUAL.GT.NCHCMD) GO TO 90
      J=COMAND(EQUAL)
      IF (J.EQ.32 .OR. J.EQ.46) GO TO 90
C     32 = ASCII BLANK, 46 = ASCII PERIOD.
      IF (J.NE.44.AND.J.NE.45) GO TO 480
C     44 = ASCII COMMA, 45 = ASCII DASH
80    EQUAL=EQUAL+1
      IF (COMAND(EQUAL)-32) 40,80,40
C     32 = ASCII BLANK
90    NUMBER=I
C     FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE
C     POSITION IN COMAND CURRENTLY BEING EXAMINED.
      EQUAL=-1
100   EQUAL=EQUAL+1
      IF (EQUAL.GE.NUMBER) GO TO 470
      IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100
      IF (EQUAL.EQ.0) GO TO 120
      WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD)
110   FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H)
     1NOT COPIED./(1X,80A1))
      NERRG=MAX0(NERRG,5)
120   IF (COMAND(EQUAL+1).GT.0) GO TO 130
      EQUAL=EQUAL-1
      COMAND(EQUAL+1)=N1RECI
130   IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
C
C     PROCESS COPY = LIST OF NUMBERS
C
140   EQUAL=EQUAL+1
C     GO COPY THE PROGRAM IF IT IS THE RIGHT ONE.
150   IF (INTOPN.LT.0) GO TO 430
      IF (COMAND(EQUAL)-N1RECI) 170,420,160
C     SKIP TO DESIRED PROGRAM
160   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI-69) 150,460,150
C     69 = ASCII E
170   IF (EQUAL.GE.NUMBER) GO TO 430
      IF (COMAND(EQUAL+1).GE.0) GO TO 140
      COMAND(EQUAL)=IABS(COMAND(EQUAL))+1
      IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420
      EQUAL=EQUAL+1
      GO TO 170
C
C     COPY = SELECTION STRING OR CHANGE CONTROL RECORD.
C
180   ICOMD=-2
      IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
      NRWORK=-1
C
C     DETERMINE NEED TO OPEN WORK FILE.
C
190   IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0)
     1IF (ICOMD) 290,430,290
      IF (WORKF.EQ.0) GO TO 500
      I=IABS(WORKF)
      IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510
      IF (WORKF.GT.0) GO TO 200
      WORKF=I
      CALL EXCHFO (3)
200   IF (ICOMD.NE.0) GO TO 280
C
C     CHANGE CONTROL RECORD.
C
      if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520
c     69 = ascii E, 73 = ascii I.
      if (nrwork.eq.0) go to 210
      if (itypei.eq.80) go to 520
c     80 = ascii P
210   IF (NUMBER-NRWORK-1) 530,220,410
220   NCHACT=NCHCMD+1-EQUAL
      IF (NCHACT.GT.0) GO TO 230
      NCHACT=1
      INTREC(1)=32
C     32 = ASCII BLANK
      GO TO 425
230   DO 240 I=1,NCHACT
240   INTREC(I)=COMAND(EQUAL+I-1)
      GO TO 425
C
C     COPY = SELECTION EXPRESSION.
C
C     SKIP TO NEXT PROGRAM.
250   IF (INTOPN.LT.0) GO TO 430
      if (itypei.eq.69) go to 460
c     69 = ASCII E.
      do 260 i = 1, 8
260   pred(2,i)=0
      if (itypei.ne.80) go to 265
c     If the current record is a new program, don't skip it (we haven't
c     processed it yet).
      if (nrwork.gt.0 .and. workf.gt.0) rewind workf
      nrwork=min0(nrwork,0)
      newp=0
      go to 320
265   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      nxnewp=0
270   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.NE.80) GO TO 310
C     80 = ASCII P
      NEWP=nxnewp
c     Set NEWP non-zero when all control records for a module have been
c     seen.
      GO TO 320
280   NRWORK=MAX0(NRWORK,0)
290   DO 300 I=1,8
300   PRED(2,I)=0
c     NEWP is non-zero when all control records have been read.
310   if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1
C     69 = ASCII E, 73 = ASCII I.
320   nxnewp=1
      if (icomd.eq.0) if (newp) 520,210,520
      IF (LIMIT.EQ.0) GO TO 340
      IF (N1RECI.LE.LIMIT) GO TO 340
      WRITE (PRINTR,330) LIMIT
330   FORMAT (7H LIMIT=,I6,9H REACHED.)
      GO TO 430
340   IF (NEWP.EQ.0) GO TO 360
      CALL EXCHLX
C     EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'.
      NUMBER=NCHCMD
      IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415
C     73 = ASCII I.
      IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425
C     80 = ASCII P.
      IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425
C     83 = ASCII S.
      IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415
C     88 = ASCII X.
      IF (COMAND(180)) 450,250,420
C     CONTROL RECORD.  EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE.
360   I=1
      DO 400 NUMBER=1,8
      IF (PRED(1,NUMBER).EQ.0) GO TO 400
      IF (PRED(2,NUMBER).NE.0) GO TO 400
      IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390
      NM=PRED(1,NUMBER)-3
      IF (.NOT.(NCHACT.GT.0)) GO TO 390
      DO 385 L = 1, NCHACT
      DO 380 J = 1, NM
C
C     DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND
C     IN PREDICATE.
      IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380
      IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370
C
C     NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS.
      K=32
      GO TO 375
C     USE CHARACTER FROM CONTROL RECORD.
370   K=INTREC(J+L-1)
C
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (K.GT.96 .AND. K.LT.123) K=K-32
C
C     TEST FOR A MATCH ON A SINGLE CHARACTER.
C     IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE
C     PATTERN.  IF THE SEARCH MODE IS X, TERMINATE THE SEARCH.
375   IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390
380   CONTINUE
C
C     FOUND A MATCH IN CONTROL RECORD AND PREDICATE.
      PRED(2,NUMBER)=1
      GO TO 400
385   CONTINUE
390   I=0
400   CONTINUE
      IF (I.NE.0) newp=1
      IF (NRWORK.LT.0) GO TO 270
C     AT LEAST ONE FALSE PREDICATE.  WRITE THE CONTROL RECORD ON WORKF.
410   WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT)
      NRWORK=NRWORK+1
      GO TO 270
C
C     GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM.
C
415   ICOMD=-3
C     RETURN TO EXCHC1 AFTER COPYING MODULE.
420   TRANS=5
      GO TO 570
C
C     RETURN TO THE COMMAND PROCESSOR.
C
425   TRANS=1
C     REMEMBER CONTROL RECORDS ON WORKF.
      GO TO 570
430   TRANS=1
      IF (ICOMD+1) 560,570,570
C
C     ERROR MESSAGES.
C
440   NUMBER=1
C     MESSAGE 1 - I/O ERROR.
      EQUAL=ISTAT
      GO TO 550
450   NUMBER=-COMAND(180)
C     MESSAGES GENERATED BY EXCHLX
      GO TO 550
460   IF (INTOPN.LT.0) GO TO 430
      INTOPN=-1
      EQUAL=NUMBER
      NUMBER=15
C     MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE.
      GO TO 550
470   NUMBER=16
C     MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION.
      GO TO 550
480   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER
      GO TO 550
490   NUMBER=18
C     MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER.
      GO TO 550
500   NUMBER=19
C     MESSAGE 19 - WORK FILE NOT DEFINED.
      GO TO 550
510   NUMBER=20
C     MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE.
      GO TO 550
520   EQUAL=NUMBER
      NUMBER=21
C     MESSAGE 21 - CONTROL RECORD NOT PRESENT
      GO TO 550
530   NUMBER=22
C     MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER.
      GO TO 550
540   NUMBER=29
C     MESSAGE 29 - BACKWARD SKIP IGNORED.
C
C     RETURN TO THE ERROR MESSAGE PROCESSOR.
C
550   TRANS=8
      IF (ICOMD.EQ.0) GO TO 570
C
C     DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF.
C
560   IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
C
C     RETURN TO TRANSITION PROGRAM.
C
570   RETURN
C
      END
      SUBROUTINE EXCHLX
C
C     EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND.
C
C     THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE
C     STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM
C     COPY=LOGICAL EXPRESSION.  THE LOGICAL EXPRESSION CONSISTS OF THE
C     EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY
C     OPERATORS + - * / AND PARENEHESES.  THE PRIMARY SYMBOLS A-H ARE
C     LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE
C     STATEMENTS.  THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE
C     NULL PREDICATE, WHICH IS ALWAYS FALSE.  THE OPERATORS + - * / ARE
C     THE BINARY LOGICAL OPERATIONS   OR, OR NOT, AND, AND NOT
C     RESPECTIVELY.  THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE
C     PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL
C     PRIORITY.  THE RELATIVE PRIORITY MAY BE CHANGED BY USING
C     PARENTHESES.
C
C     WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY
C     FALSE.  AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL
C     FALSE PREDICATES IS DETERMINED.  ONCE TRUE, A PREDICATE REMAINS
C     TRUE.  THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND
C     A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE.  WHEN ALL ACTIVE
C     PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM
C     HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND
C     IS EVALUATED.  IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED.
C     IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED.  THIS PROCESS
C     CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM
C     NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED.
C
C     THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE
C     TABLE BELOW.  INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS
C     APPENDED TO THE END OF THE LOGICAL EXPRESSION.
C
C     PREVIOUS  I                 CURRENT TOKEN                   I
C      TOKEN    I + - * / I PRIMARY I    (    I    )    I  ELSE   I
C     ----------I---------I---------I---------I---------I---------I
C      + - * /  I  ERROR  I   OK    I   OK    I  ERROR  I  ERROR  I
C      PRIMARY  I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C         (     I  ERROR  I   OK    I   OK    I   OK    I  ERROR  I
C         )     I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C     ----------I---------I---------I---------I---------I---------I
C
C     CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING
C     A STACK AND THE PRECEDENCE TABLE BELOW.  TOS MEANS TOP-OF-STACK,
C     HOI MEANS HEAD-OF-INPUT.  THE STACK INITIALLY CONTAINS (.
C
C                  TOS       HOI
C      TOKEN   I  INDEX  I  INDEX  I
C     ---------I---------I---------I
C       + -    I    2    I    1    I
C       * /    I    4    I    3    I
C     PRIMARY  I    6    I    5    I
C        (     I    0    I    7    I
C        )     I   N/A   I    0    I
C     ---------I---------I---------I
C
C     WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS
C     PUSHED ONTO THE STACK.  WHEN THE TOS INDEX IS GREATER THAN THE HOI
C     INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY
C     SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT
C     PLACED IN THE SUFFIX LIST.  THEN THE RELATION OF THE TOS INDEX TO
C     THE HOI INDEX IS RE-EXAMINED.  WHEN THE TOS INDEX IS EQUAL TO THE
C     HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED.
C
C     *****     INTERNAL VARIABLES     *********************************
C
C CHTAB   RECOGNIZED CHARACTERS.  INTERNAL PROCESSES USE THE INDEX
C         INTO CHTAB.
C COLTAB  CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX.
C HOI     CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE.
C INFIX   IS THE CURRENT POSITION IN THE INFIX.
C IPREV   IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN.
C ISTACK  IS THE CURRENT STACK INDEX.
C ISUFIX  IS THE CURRENT SUFFIX INDEX.
C SYNTAX  CONTAINS THE SYNTAX RULES.
C TOS     CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE.
C
      INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     DATA STATEMENTS     ************************************
C
C                                                    A  B  C  D
      DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/
C                                                    E  F  G  H
      DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/
C                                                    N  +  -  *
      DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/
C                                                    /  (  )
      DATA CHTAB(13),CHTAB(14),CHTAB(15)           /47,40,41   /
C                                                       A B C D
      DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/
C                                                       E F G H
      DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/
C                                                       N + - *
      DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/
C                                                       / ( )
      DATA COLTAB(13),COLTAB(14),COLTAB(15)            /1,3,4  /
C                                                   A B C D E
      DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/
C                                                   F G H N +
      DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/
C                                                   - * / ( )
      DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/
C                 CURRENT TOKEN IS +-*/.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/
C                 CURRENT TOKEN IS PRIM.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/
C                 CURRENT TOKEN IS (.     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/
C                 CURRENT TOKEN IS ).     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/
C                                                   A B C D E
      DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/
C                                                   F G H N +
      DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/
C                                                   - * / ( )
      DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/
C
C     *****     PROCEDURES     *****************************************
C
C     COMAND IS USED FOR INFIX, STACK AND SUFFIX.  UPON COMPLETION,
C     COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE
C     OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE
C     EXPRESSION IS TRUE.
C
      ISTACK=NCHCMD+2
      COMAND(ISTACK)=14
      ISUFIX=181
      IPREV=3
      COMAND(NCHCMD+1)=41
      INFIX=EQUAL-1
C
C     GET A CHARACTER FROM INFIX.  LOOK UP IN CHTAB.  CHECK SYNTAX.
C
10    IF (INFIX.GT.NCHCMD) GO TO 180
      INFIX=INFIX+1
      J=COMAND(INFIX)
      IF (J.EQ.32) GO TO 10
C     32 = ASCII BLANK - IGNORE IT.
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      DO 20 I=1,15
      IF (CHTAB(I).EQ.J) GO TO 30
20    CONTINUE
      GO TO 230
30    J=COLTAB(I)
      IF (SYNTAX(IPREV,J)-1) 40,190,200
C
C     CONVERT INFIX TO SUFFIX
C
40    IPREV=J
50    J=COMAND(ISTACK)
      IF (TOS(J)-HOI(I)) 60,70,80
C     PUSH INFIX ONTO STACK
60    ISTACK=ISTACK+1
      COMAND(ISTACK)=I
      GO TO 10
C     DELETE TOP OF STACK
70    ISTACK=ISTACK-1
      IF (ISTACK.GT.NCHCMD+1) GO TO 10
      IF (INFIX-NCHCMD) 220,220,250
C     IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX.
C     IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX.
80    IF (J-9) 90,100,130
C     PRIMARY IS SYMBOL A-H
90    IF (PRED(1,J).EQ.0) GO TO 210
      J=PRED(2,J)
      GO TO 110
C     NULL PREDICATE
100   J=0
110   ISUFIX=ISUFIX-1
120   COMAND(ISUFIX)=J
      ISTACK=ISTACK-1
      GO TO 50
C     OPERATOR
130   J=J-9
      ISUFIX=ISUFIX+1
      GO TO (140,150,160,170), J
C             +   -   *   /
140   J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1)
      GO TO 120
150   J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1)
      GO TO 120
160   J=COMAND(ISUFIX)*COMAND(ISUFIX-1)
      GO TO 120
170   J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1))
      GO TO 120
C
180   COMAND(180)=-23
C     MESSAGE 23 - TOO MANY (
      GO TO 240
190   COMAND(180)=-24
C     MESSAGE 24 - MISSING PRIMARY
      GO TO 240
200   COMAND(180)=-25
C     MESSAGE 25 - MISSING OPERATOR
      GO TO 240
210   EQUAL=CHTAB(J)
      CALL EXCHAH (EQUAL,1)
      COMAND(180)=-26
C     MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE.
      GO TO 250
220   COMAND(180)=-27
C     MESSAGE 27 - TOO MANY )
      GO TO 240
230   COMAND(180)=-28
C     MESSAGE 28 - UNRECOGNIZED CHARACTER
C
240   EQUAL=INFIX
250   RETURN
C
      END
      SUBROUTINE EXCHC5 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE,
C     AND INDEX IF SELECTED.  COPY RECORDS FROM WORKF FIRST, IF ANY.
C     CREATE CONTROL RECORDS DEMANDED BY COMMANDS.
C
C     THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF
C     THE PARAMETER STRING.
C
C     AUTHOR
C     COMMENT
C     CONTROL (ITYPEO SET FROM MODIFY)
C     DATA TYPE
C     GROUPS
C     INSERT
C     KEYWORDS
C     MACHINE
C     ORIGIN
C     REFERENCES
C     REMOVE   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     SIGNAL   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     UPDATE
C
C     IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS
C     ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A
C     CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND.
C
C     *****     LOCAL VARIABLES     ************************************
C
C BLANK   CONTAINS A HOLLERITH BLANK.
      INTEGER BLANK
C C1      IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING.
      INTEGER C1
C COL1    THE FIRST COLUMN OF TEXT OF A CONTROL RECORD.  DERIVED FROM
C         EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE.
      INTEGER COL1
C I,J     USED FREELY AS INDICES.
      INTEGER I,J
C KCONT   THE INDEX IN COMD OF THE CONTROL COMMAND.
      INTEGER KCONT
C KNAME   IS THE INDEX IN COMD OF THE NAME COMMAND.
      INTEGER KNAME
C KTEXT   THE INDEX IN COMD OF THE TEXT COMMAND.
      INTEGER KTEXT
C KUPDA   THE INDEX IN COMD OF THE UPDATE COMMAND.
      INTEGER KUPDA
C LIST    CONTAINS THE WORD LIST IN ASCII.  USED FOR THE A OPTION.
      INTEGER LIST(4)
C NM      IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NM
C NOUT    IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NOUT
C NY      IS THE PROGRAM NUMBER.  IT IS THE NUMBER FROM INTAPE IF
C         OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE.
      INTEGER NY
C ONE     CONTAINS A HOLLERITH 1.
      INTEGER ONE
C REASON  REASON FOR COPYING A CONTROL RECORD.  1 = COPY COMMAND
C         PENDING.  2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8.
C         3 = COMMAND.
      INTEGER REASON
C RI      CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A
C         GIVEN RECORD TYPE.  RI IS SUBSCRIPTED BY (ITYPEO-64).
      INTEGER RI(26)
C RT      IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT.
      INTEGER RT(34)
C STAR    CONTAINS A HOLLERITH STAR.
      INTEGER STAR
C ZERO    CONTAINS A HOLLERITH ZERO.
      INTEGER ZERO
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL VARIABLE DATA     ********************************
C
      DATA BLANK /1H /
C                                            L  I  S  T
      DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/
C
      DATA KCONT /31/
      DATA KNAME /9/
      DATA KTEXT /27/
      DATA KUPDA/29/
      DATA ONE /1H1/
C                                                      A  B  C  D  E  F
      DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/
C                                                      G  H  I  J  K  L
      DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/
C                                                      M  N  O  P  Q  R
      DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/
C                                                      S  T  U  V  W  X
      DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/
C                                                      Y  Z
      DATA RI(25),RI(26)                             /31,31            /
C                                                     A  C     D     G
      DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/
C                                                           P     K
      DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/
C                                                     M     O
      DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/
C                                                              B  R
      DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/
C                                                                 S
      DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/
C                                                              J
      DATA RT(31),RT(32),RT(33),RT(34)              /-1, 0, 0,74/
C
      DATA STAR /1H*/
      DATA ZERO /1H0/
C
C     *****     PROCEDURES     *****************************************
C
      REASON=1
      NY=N1RECI
      IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1
C     ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P.
C     IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT.
      IF (PHASE.EQ.4) NY=0
C     NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER.  (IT IS PRINTED
C     IN THE INDEX).
      IF (ICOMD.LE.0) GO TO 10
      IF (PHASE.GE.4) GO TO 100
      IF (ICOMD.EQ.KNAME) GO TO 10
      IF (ICOMD.NE.KUPDA) GO TO 100
      REASON=2
      PHASE=8
10    IF (NRWORK.GT.0) REWIND WORKF
      NM=0
      NOUT=0
20    NM=NM+1
      IF (NM.LE.NRWORK) GO TO 60
30    IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230
C     69 = ASCII E, 73 = ASCII I.
      IF (NOUT.EQ.0) GO TO 40
      IF (ITYPEI.EQ.80) GO TO 230
C     80 = ASCII P.
      IF (NCHACT.NE.1) GO TO 40
      IF (INTREC(1).EQ.32) GO TO 220
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
40    ITYPEO=ITYPEI
      NCHOUT=NCHACT
      DO 50 J=1,NCHOUT
50    OUTREC(J+5)=INTREC(J)
      GO TO 70
60    READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT)
      IF (NCHOUT.NE.1) GO TO 70
      IF (NM.EQ.1) GO TO 70
      IF (OUTREC(6).EQ.32) GO TO 200
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
70    NOUT=NOUT+1
      J=RI(ITYPEO-64)
      DO 80 I=1,4
80    OUTREC(I)=COMD(I,J)
      OUTREC(5)=61
C     61 = ASCII =
      COL1=5
      IF (J.NE.KCONT) GO TO 130
      COL1=7
C     CONTROL,*=...  MOVE UP TWO CHARACTERS AND INSERT ITYPEO.
      DO 90 I=1,NCHOUT
90    OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I)
      OUTREC(5)=44
C     44 = ASCII COMMA.
      OUTREC(6)=ITYPEO
      OUTREC(7)=61
C     61 = ASCII =
      GO TO 130
100   IF (ICOMD.EQ.KTEXT) GO TO 240
      COL1=EQUAL-1
      NCHOUT=NCHCMD-COL1
      NRWORK=NRWORK+1
C     NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD.
      ITYPEO=RT(ICOMD)
      IF (ITYPEO.GT.0) GO TO 110
C     PROCESS CONTROL,TYPE=TEXT COMMAND.
      ITYPEO=MODIFY
      IF (RI(ITYPEO-64).NE.KCONT) GO TO 320
110   NOUT=NRWORK
      REASON=3
      DO 120 I=1,NCHCMD
120   OUTREC(I)=COMAND(I)
130   IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1)
C     74 = ASCII J.
      IF (ITYPEO.EQ.80) VERT=0
C     80 = ASCII P
      IF (ITYPEO.NE.68) GO TO 150
C     68 = ASCII D
      IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150
      DO 140 J=1,4
      I=OUTREC(J+COL1)
      IF (I.GT.96 .AND. I.LT.123) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.NE.LIST(J)) GO TO 150
140   CONTINUE
      VERT=1
C     GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE.
150   CALL EXCHCG (OUTREC(COL1+1))
      IF (OUTOPN.EQ.0) GO TO 160
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1))
      IF (ISTAT.NE.0) GO TO 340
      NY=NLRECO
160   NCHOUT=NCHOUT+COL1
C     TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER.
      OUTREC(180)=-NOUT
      IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC)
C     PRINT THE INDEX IF SELECTED.
      IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO
     1190
      IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190
      C1=BLANK
C     DOUBLE SKIP FOR PROGRAM HEADER (P).
      IF (ITYPEO.EQ.80) C1=ZERO
      IF (OPTV+VERT.NE.0) GO TO 170
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170
      IF (CHAR1L.NE.ONE) C1=ONE
      CHAR1L=ONE
170   CALL EXCHAH (OUTREC,NCHOUT)
      WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT)
180   FORMAT (A1,2I5,1H*,(3X,105A1))
190   IF (REASON.EQ.3) GO TO 310
200   IF (NM-NRWORK) 20,210,220
210   REWIND WORKF
      NRWORK=0
      GO TO 30
220   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT) 330,30,330
230   IF (REASON.EQ.2) GO TO 300
240   IF (OUFILE.EQ.0) GO TO 260
      DO 250 I=1,4
250   OUTREC(I)=COMD(I,KTEXT)
      OUTREC(180)=0
      NCHOUT=0
C     TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED.
      CALL EXCHCG (OUTREC)
      NCHOUT=4
      ACTION=2-OPTC-OPTC
C     ACTION = 2 MEANS START OF PROGRAM.
      CALL EXCHOU (OUTREC)
260   IF (OPTV+VERT.NE.0) GO TO 280
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280
      IF (OUTOPN.NE.0) NY=NLRECO
      I=BLANK
      IF (CHAR1L.NE.ONE) I=ONE
      WRITE (PRINTR,270) I,NY
270   FORMAT (A1,I5,1H*,8X,4HTEXT/)
280   CHAR1L=STAR
      NRWORK=MIN0(NRWORK,0)
      IF (IDOPTN.NE.67) IDCUR=IDSTRT
C     67 = ASCII C
      IF (ICOMD.EQ.KTEXT) GO TO 290
C
C     WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL
C     RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED.
C
      TRANS=6
      GO TO 370
C
C     WORKING ON A TEXT STATEMENT.
C
290   TRANS=7
      GO TO 370
C
C     WORKING ON AN UPDATE STATMENT.
C
300   NRWORK=NOUT
      GO TO 100
C
C     WRITING A SINGLE CONTROL RECORD.
C
310   TRANS=1
      GO TO 370
C
C     ERROR MESSAGES.
C
320   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER.
      GO TO 360
330   NUMBER=1
      GO TO 350
340   NUMBER=2
350   EQUAL=ISTAT
360   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM.
C
370   RETURN
C
      END
      SUBROUTINE EXCHCG (RECORD)
C
C     USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL.
C     WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED.
C     THIS IS THE PORTABLE VERSION.  IT DOES NOT DO ANYTHING.
C
      INTEGER RECORD(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      RETURN
      END
      SUBROUTINE EXCHC6 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE.
C
      INTEGER KNAME,ONE,SVHCMD(180)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,

     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KNAME /9/
      DATA ONE /1H1/
C
      LINEO=0
      NERRS=0
C     SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT.
      DO 5 I = 1,NCHCMD
5     SVHCMD(I)=HOLCMD(I)
      IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165
C     73 = ASCII I.  IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE
C     A VOID MODULE.
      IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10
      CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.EQ.7) GO TO 220
      IF (ISTAT) 250,160,250
10    MODEO=MODEI
      ITYPEO=0
      NBC=OPTL+OUFILE
      IF (INDEX.GT.0) NBC=1
20    NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTOPN.EQ.0) GO TO 120
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 260
C
C     CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD
C     INSTEAD OF BYTE-BY-BYTE).  WE CAN DO A BLOCK COPY IF
C     WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT
C     FILE AND NOT PRINTING THE INDEX.  ALSO, THE INPUT AND
C     OUTPUT CHARACTER POSITIONS MUST BE THE SAME.  IF THE
C     PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH
C     THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE
C     CURRENT POSITION IN THE BYTE BUFFER BE THE SAME.
C     WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE
C     LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T
C     KNOW THE LOCATION OF THE END-OF-FILE RECORD.
C
      IF (NBC.NE.0) GO TO 120
      IF (CPCBI+1.NE.CPCBO) GO TO 120
      IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120
C     WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF.
      IF (L1PRGI.EQ.0) GO TO 25
      IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30
25    IF (CCDBI+1.NE.CCDBO) GO TO 120
      IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120
C     WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE).
C     FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO.
30    LI=L1PRGI+NERRCI-1
      IF (L1PRGI.NE.0) GO TO 40
      LI=NERRCI+NDATAI+9
      IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1
40    IF (CPCBI.GE.NCCBI) GO TO 50
      IF (CCDBI.GE.LI) GO TO 160
      CPCBI=CPCBI+1
      CBLCKO(CPCBO)=CBLCKI(CPCBI)
      CPCBO=CPCBO+1
      CCDBI=CCDBI+1
      CCDBO=CCDBO+1
      GO TO 40
C     PACK COPIED BYTES.
50    CALL EXCHPA (CBLCKO,OBLOCK(CWDBO))
      CPCBO=1
      CPCBI=0
      CWDBO=CWDBO+NWCBO
      CWDBI=CWDBI+NWCBI
C     NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM
60    IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70
      IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=L1RECI
      CALL EXCHPB (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 260
70    IF (CCDBI.LT.LI) GO TO 80
      IF (L1PRGI.NE.0) GO TO 100
      CALL EXCHGB (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 250
      GO TO 30
80    NW=NWCBI*((LI-CCDBI)/NCCBI)
      IF (NW.EQ.0) GO TO 100
      DO 90 I=1,NW
      OBLOCK(CWDBO)=IBLOCK(CWDBI)
      CWDBO=CWDBO+1
90    CWDBI=CWDBI+1
100   CCDBO=CCDBO+LI-CCDBI
      CCDBI=LI
      IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60
      CPCBI=MOD(LI,NCCBI)
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      CALL EXCHUN (IBLOCK(CWDBI),CBLCKI)
      IF (CPCBI.EQ.0) GO TO 160
      DO 110 I=1,CPCBI
110   CBLCKO(I)=CBLCKI(I)
      GO TO 160
C
C     END OF BLOCK COPY CODE.
C
120   CALL EXCHTP (INTREC,LINEO)
160   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 250
      IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20
C     73 = ASCII I.
165   IF (OPTL.NE.0) GO TO 180
      IF (INDEX.LE.0) GO TO 195
      WRITE (PRINTR,170) LINEO
170   FORMAT (I9,14H IMAGES COPIED)
      GO TO 200
180   WRITE (PRINTR,190)
190   FORMAT (1H1)
195   CHAR1L=ONE
200   IF (OUFILE.EQ.0) GO TO 210
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
210   IF (ITYPEI.EQ.69) GO TO 220
C     69 = ASCII E
C
C     RETURN TO THE COPY CONTROL SEGMENT.
C
      DO 215 I=1,NCHCMD
215   HOLCMD(I)=SVHCMD(I)
      IF (ICOMD.EQ.-3) GO TO 240
C     ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE.
      TRANS=4
      IF (ICOMD.NE.KNAME) GO TO 280
C     MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME'
C     COMMAND SUBMITTED.  GO PROCESS 'NAME' COMMAND.
      TRANS=5
      PHASE=4
      GO TO 280
C
C     END OF FILE ON INPUT TAPE.
C
220   IF (INTOPN.LT.0) GO TO 240
      WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD)
230   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1))
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
240   TRANS=1
      GO TO 280
C
C     ERROR MESSAGES.
C
250   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      GO TO 270
260   NUMBER=2
C     MESSAGE 2 - I/O ERROR WRITING OUTAPE.
270   TRANS=8
      EQUAL=ISTAT
C
C     RETURN TO THE TRANSITION PROGRAM.
C
280   IF (NERRS.EQ.0) GO TO 300
      WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD)
290   FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./
     1(1X,80A1))
      NERRG=MAX0(NERRS,NERRG)
300   RETURN
C
      END
      SUBROUTINE EXCHC7 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
      INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40)
C
C     PROCESS THE TEXT COMMAND.
C
C MSG     IS USED TO PRINT A MESSAGE.
      INTEGER MSG(6,2)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/
      DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/
      DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/
      DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/
      DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/
C
      LINEI=1
      LINEO=0
      NERRS=0
      INEND=0
      CHAR1L=STAR
C
C     SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND
C
      K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 20 I=1,40
      IF (K.GT.NCHCMD) GO TO 10
      J=COMAND(K)
      K=K+1
      GO TO 20
10    J=32
C     32 = ASCII BLANK.
20    TXDISK(I)=J
      IF (INTOPN.LE.0) ITYPEI=0
C
C     MAIN PROCESSING LOOP
C
60    EDIT=0
70    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 80
C     NCHCMD.LT.0 MEANS END OF FILE.
      IF (NCHCMD.LT.2) GO TO 100
      IF (COMAND(1).NE.SIGNAL) GO TO 100
      IF (COMAND(2).EQ.SIGNAL) GO TO 80
      IF (COMAND(2).EQ.73) GO TO 370
      IF (COMAND(2).EQ.105) GO TO 370
C     73,105 = ASCII I - REQUEST TO INCLUDE TEXT.
      IF (NCHCMD.LT.3) GO TO 100
      IF (COMAND(2).NE.61) GO TO 100
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 70
C     END OF TEXT FILE.
80    IF (INTEXT.EQ.0) GO TO 90
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      CALL EXCHIM
      INTEXT=0
      NCHCMD=0
90    NCHCMD=MIN0(NCHCMD,0)
      IF (PHASE.NE.8) GO TO 660
      IF (INEND) 660,630,660
100   IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110
110   IF (EDIT.EQ.0) GO TO 450
C
C     PARTIAL LINE EDITOR.
C     INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED.
C     EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES
C     THE FIRST NON-BLANK CHARACTER AFTER N2.  N1 AND N2 ARE COLUMN
C     LIMITS UNDER WHICH TO PERFORM THE EDITING.  N1 AND ,N2 ARE
C     OPTIONAL.  IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT
C     LIMIT.  IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS
C     ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE.  WHEN
C     STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING
C     PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT
C     LENGTHS OF STRING1 AND STRING2.  THE THIRD DELIMITER IS
C     OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED
C     AFTER STRING2 IS INSERTED.
C
      IF (INEND.NE.0) GO TO 240
C     CONVERT COLUMN NUMBERS.
      NBR1=0
      NBR2=0
      I=0
120   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.EQ.44) GO TO 150
C     44 = ASCII COMMA
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR1=10*NBR1+J-48
      GO TO 120
130   WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD)
140   FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/
     1(1X,80A1))
      NERRS=2
      GO TO 70
150   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR2=10*NBR2+J-48
      GO TO 150
C     SCAN FOR DELIMITER
160   IF (J.NE.32) GO TO 170
C     32 = ASCII BLANK
      I=I+1
      J=COMAND(I)
      GO TO 160
170   D1=I
      NBR1=MIN0(NBR1,180)
      NBR2=MIN0(NBR2,180)
      IF (NBR1.EQ.0) NBR1=1
      IF (NBR2.EQ.0) GO TO 180
      IF (NBR2.LT.NBR1) GO TO 130
180   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      IF (COMAND(I).NE.J) GO TO 180
      D2=I
      D3=0
190   I=I+1
      IF (I.GT.NCHCMD) GO TO 200
      IF (COMAND(I).NE.J) GO TO 190
      D3=I
C     LOOK FOR SEARCH STRING (STRING1)
200   NUMBER=D2-D1-1
      J=NBR1
      IF (NUMBER.EQ.0) GO TO 260
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
210   DO 220 I=1,NUMBER
      IF (I+J-1.GT.NY) GO TO 240
      IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230
220   CONTINUE
      GO TO 260
230   J=J+1
      GO TO 210
240   WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1))
      NERRS=2
      GO TO 70
C     FOUND SEARCH STRING.  REPLACE WITH UPDATE STRING.
260   CHAR1L=PLUS
      IF (D3.NE.0) GO TO 300
C     NO THIRD DELIMITER.   REPLACE REST OF REGION.
      NY=NBR2
      IF (NY.EQ.0) NY=180
      D2=D2+1
      IF (D2.GT.NCHCMD) GO TO 280
      DO 270 I=D2,NCHCMD
      INTREC(J)=COMAND(I)
      J=J+1
      IF (J.GT.NY) GO TO 280
270   CONTINUE
280   IF (NBR2.NE.0) GO TO 290
      NCHACT=J-1
      GO TO 70
290   IF (J.GT.NBR2) GO TO 70
      INTREC(J)=32
C     32 = ASCII BLANK
      J=J+1
      GO TO 290
C     WE HAVE A THIRD DELIMITER.  REPLACE ONLY THE SEARCH STRING.
C     SHIFT THE REST OF THE REGION AS NECESSARY.
300   NUMBER=(D3-D2)-(D2-D1)
      IF (NUMBER) 310,350,330
C     SHIFT LEFT
310   I=J+D2-D1-1
      NY=MIN0(NBR2,NCHACT)
      IF (NY.EQ.0) NY=NCHACT
320   IF (I.GT.NY) GO TO 350
      INTREC(I+NUMBER)=INTREC(I)
C     NOTE - NUMBER .LT. 0 HERE
      INTREC(I)=32
C     32 = ASCII BLANK
      I=I+1
      GO TO 320
C     RIGHT SHIFT
330   I=NBR2
      IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180)
      NY=J+NUMBER
340   IF (I.LT.NY) GO TO 350
      INTREC(I)=INTREC(I-NUMBER)
      I=I-1
      GO TO 340
C     NO SHIFT NEEDED.
350   IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180)
      IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2)
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
C     MOVE UPDATE STRING (STRING2).
360   D2=D2+1
      IF (D2.GE.D3) GO TO 70
      INTREC(J)=COMAND(D2)
      J=J+1
      IF (J-NY) 360,360,70
C
C     REQUEST TO INCLUDE TEXT.  -I IN COLUMNS 1 AND 2.
C
370   IF (EDIT.EQ.0) GO TO 390
      WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD)
380   FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X
     1,80A1))
      NERRS=2
      GO TO 70
390   ITYPEO=73
C     73 = ASCII I
      IF (NCHCMD.GE.4) GO TO 410
      WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD)
400   FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A
     11))
      NERRS=2
      GO TO 70
410   DO 420 I=4,NCHCMD
      IF (COMAND(I).NE.32) GO TO 430
420   CONTINUE
C     CONVERT TO UPPER CASE.  WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM
430   K=0
      DO 440 J=I,NCHCMD
      IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32
      K=K+1
440   COMAND(K)=COMAND(J)
      NCHCMD=K
      GO TO 460
C
C     TEXT RECORD.
C
450   ITYPEO=0
460   NCHOUT=NCHCMD
      IF (OUTOPN.EQ.0) GO TO 470
      MODEO=0
      CALL EXCHPR (ISTAT,OBLOCK,COMAND)
      IF (ISTAT.NE.0) GO TO 770
470   CALL EXCHTP (COMAND,0)
      GO TO 70
C
C     APPARENT CHANGE CONTROL COMMAND
C
480   IF (INEND.EQ.0) GO TO 510
490   WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD)
500   FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT
     1 END./(1X,80A1))
      NERRS=1
      GO TO 70
510   NUMBER=1
      NBR1=0
      EDIT=0
      I=1
520   I=I+1
      IF (I.GT.NCHCMD) GO TO 600
      J=COMAND(I)
      IF (J.EQ.32) GO TO 600
C     32 = ASCII BLANK
      IF (EDIT.NE.0) GO TO 530
C     EDIT CONTROL MUST BE BLANK AFTER $.
      IF (J.EQ.44) GO TO 570
C     44 = ASCII COMMA
      IF (J.EQ.36) GO TO 560
C     36 = ASCII $
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.LE.57) GO TO 550
C     57 = ASCII 9
530   WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD)
540   FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1)
      NERRS=2
      GO TO 60
550   NBR1=10*NBR1+J-48
      GO TO 520
560   IF (NBR1.EQ.0) GO TO 530
      EDIT=1
      NBR1=NBR1-1
      GO TO 520
570   NUMBER=2
      NBR2=0
580   I=I+1
      IF (I.GT.NCHCMD) GO TO 590
      J=COMAND(I)
      IF (J.EQ.32) GO TO 590
C     32 = ASCII BLANK
      IF (IABS(J-44).EQ.1) GO TO 590
C     43 = ASCII +, 45 = ASCII -
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 530
C     57 = ASCII 9
      NBR2=10*NBR2+J-48
      GO TO 580
590   IF (NBR2.LT.NBR1) GO TO 530
      NBR1=NBR1-1
600   IF (NBR1.GE.LINEI-1) GO TO 620
      WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD)
610   FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1)
      NERRS=2
      GO TO 60
620   IF (NCHCMD.LE.0) GO TO 630
      IF (LINEI.LE.NBR1) GO TO 630
      IF (NUMBER.EQ.1) GO TO 70
C     SKIP INTAPE UNTIL NBR2 IS SKIPPED.
      MODEI=1
      IF (LINEI.GE.NBR2) MODEI=0
      IF (LINEI-NBR2) 650,650,70
C     COPY FROM INTAPE UNTIL NBR1 COPIED.
630   MODEO=MODEI
      NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTAPE.EQ.0) GO TO 640
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 770
640   CALL EXCHTP (INTREC,LINEI)
      MODEI=0
      IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650
      IF (LINEI.EQ.NBR1) GO TO 650
      MODEI=1
650   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 760
      LINEI=LINEI+1
      IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620
C     73 = ASCII I
      INEND=1
      IF (NCHCMD.LE.0) GO TO 660
      I=NBR2
      IF (NUMBER.EQ.1) I=NBR1
      IF (LINEI-I) 490,490,70
660   IF (NERRS.EQ.0) GO TO 675
      J=1
      IF (PHASE.EQ.8) J=2
      WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS
670   FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.)
675   NERRG=MAX0(NERRG,NERRS)
      IF (OPTL+OPTS.NE.0) GO TO 690
      IF (OUTAPE+OUFILE.EQ.0) LINEO=0
      IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO
680   FORMAT (I9,14H IMAGES COPIED)
      GO TO 710
690   WRITE (PRINTR,700)
700   FORMAT (1H1)
      CHAR1L=ONE
710   IF (OUFILE.EQ.0) GO TO 720
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
720   IF (ITYPEI.NE.69) GO TO 750
C     69 = ASCII E
C
C     END OF FILE ON INPUT TAPE (UPDATE MODE).
C
      IF (INTOPN.LT.0) GO TO 750
      DO 730 I=1,40
730   HOLCMD(I+1)=TXDISK(I)
      HOLCMD(1)=32
      IF (TXDISK(1).NE.32) HOLCMD(1)=61
C     32 = ASCII BLANK, 61 = ASCII =
      CALL EXCHAH (HOLCMD,41)
      WRITE (PRINTR,740) (HOLCMD(I),I=1,41)
740   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1)
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
750   TRANS=1
      GO TO 790
C
C     ERROR MESSAGES.
C
760   NUMBER=1
      GO TO 780
770   NUMBER=2
780   EQUAL=ISTAT
      TRANS=8
C
C     RETURN TO THE TRANSITION PROGRAM.
C
790   PHASE=2
      IF (OUTOPN.EQ.0) PHASE=1
      RETURN
C
      END
      SUBROUTINE EXCHC8
C
C     PRINT ERROR MESSAGES.
C
C     ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE
      INTEGER S(31)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/
      DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/
      DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/
      DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/
      DATA S(29),S(30),S(31)                         /4,5,5        /
C
C             1  2  3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4
     160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751),
     2NUMBER
C     16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
10    WRITE (PRINTR,20) EQUAL
20    FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.)
      GO TO 50
30    WRITE (PRINTR,40) EQUAL
40    FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.)
50    GO TO (60,80,100,120,140,160), EQUAL
60    WRITE (PRINTR,70)
70    FORMAT (22H BLOCK SEQUENCE ERROR.)
      GO TO 180
80    WRITE (PRINTR,90)
90    FORMAT (20H BLOCK IS TOO SHORT.)
      GO TO 180
100   WRITE (PRINTR,110)
110   FORMAT (11H I/O ERROR.)
      GO TO 180
120   WRITE (PRINTR,130)
130   FORMAT (18H RECORD TOO LARGE.)
      GO TO 180
140   WRITE (PRINTR,150)
150   FORMAT (21H UNKNOWN RECORD TYPE.)
      GO TO 180
160   WRITE (PRINTR,170)
170   FORMAT (25H FIRST BLOCK NOT A LABEL.)
      GO TO 760
180   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1)
      INFILE=0
C
C     RETURN TO QUIT SEGMENT.
C
      TRANS=9
      GO TO 800
C
200   WRITE (PRINTR,210)
210   FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.)
      GO TO 760
220   WRITE (PRINTR,230)
230   FORMAT (//20H0INTAPE NOT DEFINED.)
      GO TO 760
240   WRITE (PRINTR,250)
250   FORMAT (//23H0UNABLE TO OPEN INTAPE.)
      GO TO 10
260   WRITE (PRINTR,270)
270   FORMAT (//23H0UNABLE TO OPEN OUTAPE.)
      GO TO 30
280   WRITE (PRINTR,290)
290   FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.)
      GO TO 760
300   WRITE (PRINTR,310)
310   FORMAT (//19H0DATE NOT SUPPLIED.)
      GO TO 760
320   WRITE (PRINTR,330)
330   FORMAT (//19H0SITE NOT SUPPLIED.)
      GO TO 760
340   WRITE (PRINTR,350) INTAPE
350   FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4)
      GO TO 760
360   WRITE (PRINTR,370)
370   FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.)
      GO TO 760
380   WRITE (PRINTR,390)
390   FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.)
      GO TO 760
400   WRITE (PRINTR,410)
410   FORMAT (//27H0COMMAND HAS IMPROPER DATE.)
      GO TO 760
420   WRITE (PRINTR,430) EQUAL
430   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.)
      GO TO 780
440   WRITE (PRINTR,450)
450   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.)
      IF (ICOMD) 780,560,780
460   WRITE (PRINTR,470) N1RECI
470   FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO
     1N (,I5,2H).)
      GO TO 760
480   WRITE (PRINTR,490) EQUAL
490   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
500   WRITE (PRINTR,510)
510   FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.)
      GO TO 760
520   WRITE (PRINTR,530)
530   FORMAT (//23H0WORK FILE NOT DEFINED.)
      GO TO 760
540   WRITE (PRINTR,550)
550   FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.)
      GO TO 760
560   WRITE (PRINTR,570) EQUAL
570   FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.)
      GO TO 760
580   WRITE (PRINTR,590)
590   FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE
     1R.)
      GO TO 760
600   WRITE (PRINTR,610)
610   FORMAT (//12H0TOO MANY (.)
      GO TO 760
620   WRITE (PRINTR,630) EQUAL
630   FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.)
      GO TO 760
640   WRITE (PRINTR,650) EQUAL
650   FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.)
      GO TO 760
660   WRITE (PRINTR,670) EQUAL
670   FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.)
      GO TO 760
680   WRITE (PRINTR,690) EQUAL
690   FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.)
      GO TO 760
700   WRITE (PRINTR,710) EQUAL
710   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
720   WRITE (PRINTR,730) N1RECI
730   FORMAT (//21H0INTAPE POSITIONED AT,I5,25H.  BACKWARD SKIP IGNORED.
     1)
      GO TO 780
740   WRITE (PRINTR,750)
750   FORMAT (//23H0COMMAND IS INCOMPLETE.)
      GO TO 760
751   WRITE (PRINTR,752)
752   FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA
     1PE OR OUTPUT.)
760   WRITE (PRINTR,770)
770   FORMAT (23H COMMAND NOT PROCESSED.)
780   WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD)
790   FORMAT ((1X,80A1))
C
C     RETURN TO COMMAND PROCESSSOR.
C
      CHAR1L=0
      NERRS=MAX0(S(NUMBER),NERRS)
      NERRG=MAX0(NERRG,NERRS)
      TRANS=1
C
C     RETURN TO TRANSITION PROGRAM.
C
800   RETURN
C
      END
      SUBROUTINE EXCHC9 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO
C     ERRORS.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KQUIT /20/
C
      IF (INFILE.EQ.0) GO TO 10
      IF (MODIFY.NE.82) GO TO 5
C     82 = ASCII R
      ACTION=2
C     ACTION = 2 MEANS REWIND INFILE.
      CALL EXCHIM
5     ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      CALL EXCHIM
      INFILE=0
      NCHCMD=0
      GO TO 50
10    IF (OPTC*OUFILE.EQ.0) GO TO 20
      ACTION=0
      NCHOUT=4
      CALL EXCHOU (COMD(1,KQUIT))
20    ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      IF (OUTOPN.EQ.0) GO TO 30
C     WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC)
C     CLOSE THE INPUT TAPE.
30    IF (INTOPN.EQ.0) GO TO 40
      ISTAT=4
      CALL EXCHRT (ISTAT,OBLOCK)
C
C     RETURN TO MAIN PROGRAM.
C
40    TRANS=0
      IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG
45    FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.)
      GO TO 60
C
C     RETURN TO THE COMMAND DECODER.
C
50    TRANS=1
60    RETURN
C
      END
=TES FILE=4
@HDG,P EXCHMAIN/1100
@FTN,SVI EXCHMAIN/1100
C     UNIVAC 1100 MAIN PROGRAM FOR TEXT EXCHANGE PROGRAMS.
C
C     THE FOLLOWING STATEMENT ALLOCATES SPACE FOR TAPE INPUT.
C
      INTEGER IBLOCK(1600)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
C     PFS ARE PROGRAM FILE SEARCH PACKETS FOR INTAPE AND OUTAPE
C     IF OMN ELEMENTS ON DISK ARE USED (COMPREHENSIVE PROGRAM ONLY).
      INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      COMMON /EXEC8A/ FILES,ELTS,VERS,PFS
      DATA ELTS(1,6) /O050505050505/    @ FIELDATA BLANKS FOR INTAPE ELT
      DATA PFS(11,1) /0/ @ INTAPE SECTOR POSITION (FOR SIMPLE PROGRAM)
      DATA NWCBI /40/
      DATA PRINTR /6/, READER /5/
C
      CALL EXCH (IBLOCK)
      CALL EXIT
      END
@HDG,P EXCHBD
@FTN,SVI EXCHBD
      BLOCK DATA
C
C     BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/
      DATA INTEXT /0/, INALT /0/
C
      DATA CHAR1L /1H1/
C                                                        A  U  T  H
      DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1)  /65,85,84,72/
C                                                        C  O  M  M
      DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2)  /67,79,77,77/
C                                                        C  O  P  Y
      DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3)  /67,79,80,89/
C                                                        D  A  T  A
      DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4)  /68,65,84,65/
C                                                        D  A  T  E
      DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5)  /68,65,84,69/
C                                                        G  R  O  U
      DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6)  /71,82,79,85/
C                                                        I  N  D  E
      DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7)  /73,78,68,69/
C                                                        I  N  P  U
      DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8)  /73,78,80,85/
C                                                        N  A  M  E
      DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9)  /78,65,77,69/
C                                                        I  N  T  A
      DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/
C                                                        K  E  Y  W
      DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/
C                                                        L  I  M  I
      DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/
C                                                        M  A  C  H
      DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/
C                                                        O  P  T  I
      DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/
C                                                        O  R  I  G
      DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/
C                                                        O  U  T  A
      DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/
C                                                        O  U  T  P
      DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/
C                                                        P  R  E  D
      DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/
C                                                        P  R  I  N
      DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/
C                                                        Q  U  I  T
      DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/
C                                                        R  E  A  D
      DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/
C                                                        R  E  F  E
      DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/
C                                                        R  E  M  O
      DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/
C                                                        R  E  W  I
      DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/
C                                                        S  I  T  E
      DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/
C                                                        S  K  I  P
      DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/
C                                                        T  E  X  T
      DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/
C                                                        T  I  T  L
      DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/
C                                                        U  P  D  A
      DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/
C                                                        W  O  R  K
      DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/
C                                                        C  O  N  T
      DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/
C                                                        I  D  E  N
      DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/
C                                                        I  N  C  L
      DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/
C                                                        S  I  G  N
      DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/
C                                                        M  A  R  G
      DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/
      DATA IDSTEP /0/, IDTXTL /0/
      DATA INDEX /0/
      DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/
      DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/
      DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/
      DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/
      DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/
      DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/
      DATA INDEXS(25),INDEXS(26)                       /0,0    /
      DATA INTOPN /0/
      DATA ITYPEI /0/
      DATA LIMIT /0/
      DATA MARGIN /180/
      DATA NCCBI /180/
      DATA NCCBO /180/
      DATA NCHCMD /0/
      DATA NCHMAX /180/
      DATA NCOMDP /35/
      DATA NCOMDT /35/
      DATA NDATAO /3591/
      DATA NERRCO /0/
      DATA NERRG /0/
      DATA NRWORK /0/
      DATA OUTOPN /0/
      DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/
      DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/
      DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/
      DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/
      DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/
      DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/
      DATA OPTVAL(25),OPTVAL(26)                       /0,0    /
      DATA PHASE /1/
C     INDICATE THAT NO PREDICATES ARE DEFINED.
      DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/
      DATA PRED(1,6),PRED(1,7),PRED(1,8)                     /0,0,0    /
      DATA SITE(1) /0/
      DATA TITLE(1) /32/
C     32 = ASCII BLANK
      DATA TODAY (1) /0/
      DATA TRANS /1/
C
C     TRANSLATION TABLE FROM ASCII TO HOLLERITH.  USES ASCII GRAPHICS.
C     TRANSLATES CONTROL CHARACTERS (<32) TO '$'.
C     MAY NOT BE EXACTLY CORRECT FOR ALL MACHINES.
C
      DATA XLATE(1),  XLATE(2),  XLATE(3),  XLATE(4)  /1H$,1H$,1H$,1H$/
      DATA XLATE(5),  XLATE(6),  XLATE(7),  XLATE(8)  /1H$,1H$,1H$,1H$/
      DATA XLATE(9),  XLATE(10), XLATE(11), XLATE(12) /1H$,1H$,1H$,1H$/
      DATA XLATE(13), XLATE(14), XLATE(15), XLATE(16) /1H$,1H$,1H$,1H$/
      DATA XLATE(17), XLATE(18), XLATE(19), XLATE(20) /1H$,1H$,1H$,1H$/
      DATA XLATE(21), XLATE(22), XLATE(23), XLATE(24) /1H$,1H$,1H$,1H$/
      DATA XLATE(25), XLATE(26), XLATE(27), XLATE(28) /1H$,1H$,1H$,1H$/
      DATA XLATE(29), XLATE(30), XLATE(31), XLATE(32) /1H$,1H$,1H$,1H$/
      DATA XLATE(33), XLATE(34), XLATE(35), XLATE(36) /1H ,1H!,1H",1H#/
      DATA XLATE(37), XLATE(38), XLATE(39), XLATE(40) /1H$,1H%,1H&,1H'/
      DATA XLATE(41), XLATE(42), XLATE(43), XLATE(44) /1H(,1H),1H*,1H+/
      DATA XLATE(45), XLATE(46), XLATE(47), XLATE(48) /1H,,1H-,1H.,1H//
      DATA XLATE(49), XLATE(50), XLATE(51), XLATE(52) /1H0,1H1,1H2,1H3/
      DATA XLATE(53), XLATE(54), XLATE(55), XLATE(56) /1H4,1H5,1H6,1H7/
      DATA XLATE(57), XLATE(58), XLATE(59), XLATE(60) /1H8,1H9,1H:,1H;/
      DATA XLATE(61), XLATE(62), XLATE(63), XLATE(64) /1H<,1H=,1H>,1H?/
      DATA XLATE(65), XLATE(66), XLATE(67), XLATE(68) /1H@,1HA,1HB,1HC/
      DATA XLATE(69), XLATE(70), XLATE(71), XLATE(72) /1HD,1HE,1HF,1HG/
      DATA XLATE(73), XLATE(74), XLATE(75), XLATE(76) /1HH,1HI,1HJ,1HK/
      DATA XLATE(77), XLATE(78), XLATE(79), XLATE(80) /1HL,1HM,1HN,1HO/
      DATA XLATE(81), XLATE(82), XLATE(83), XLATE(84) /1HP,1HQ,1HR,1HS/
      DATA XLATE(85), XLATE(86), XLATE(87), XLATE(88) /1HT,1HU,1HV,1HW/
      DATA XLATE(89), XLATE(90), XLATE(91), XLATE(92) /1HX,1HY,1HZ,1H[/
      DATA XLATE(93), XLATE(94), XLATE(95), XLATE(96) /1H\,1H],1H^,1H_/
      DATA XLATE(97), XLATE(98), XLATE(99), XLATE(100)/1H`,1Ha,1Hb,1Hc/
      DATA XLATE(101),XLATE(102),XLATE(103),XLATE(104)/1Hd,1He,1Hf,1Hg/
      DATA XLATE(105),XLATE(106),XLATE(107),XLATE(108)/1Hh,1Hi,1Hj,1Hk/
      DATA XLATE(109),XLATE(110),XLATE(111),XLATE(112)/1Hl,1Hm,1Hn,1Ho/
      DATA XLATE(113),XLATE(114),XLATE(115),XLATE(116)/1Hp,1Hq,1Hr,1Hs/
      DATA XLATE(117),XLATE(118),XLATE(119),XLATE(120)/1Ht,1Hu,1Hv,1Hw/
      DATA XLATE(121),XLATE(122),XLATE(123),XLATE(124)/1Hx,1Hy,1Hz,1H{/
      DATA XLATE(125),XLATE(126),XLATE(127),XLATE(128)/1H|,1H},1H~,1H$/
      END
@HDG,P EXCH/1100
@FTN,SVI EXCH/1100
      SUBROUTINE EXCH (IBLOCK)
C
C     UNIVAC 1100 INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM.
C
      INTEGER IBLOCK(1)
C
C     ALLOCATE SPACE FOR TAPE OUTPUT.
C
      INTEGER OBLOCK(800)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      INTEGER AFDFLG,WORKS(474,5) @ OUTPUT CODE, WORK AREAS
      COMMON /EXEC8/ AFDFLG,WORKS
      DATA AFDFLG /1/             @ DEFAULT OUTPUT CODE = ASCII.
      DATA NWCBO /40/
      DATA WORKF  /9/
C
      CALL XHINIT
      CALL EXCHTR (IBLOCK,OBLOCK)
      RETURN
      END
@HDG,P EXCHEM/1100
@FTN,SVI EXCHEM/1100
      SUBROUTINE EXCHEM (ISTAT)
      ENTRY EXCHM2 (ISTAT,ASGSTA)
C
C     WRITE ERROR MESSAGES ASSOCIATED WITH PROGRAM FILE I/O FOR
C     UNIVAC-1100 SENSITIVE EXCHIM, EXCHOU, EXCHRT, EXCHWT.
C
C     ASGSTA IS THE ASSIGN STATUS IF A FILE COULD NOT BE ASSIGNED.
C     ASGSTA IS USED ONLY IF ISTAT = 35, WHICH IS PRODUCED ONLY BY
C     EORSRO AND EORSWO.  EXCHM2 IS THEREFORE ONLY CALLED FROM EXCHCX
C     AND EXCHOU.
C
      INTEGER ISTAT,ASGSTA
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      IF (ISTAT.GT.32) GO TO 20
      WRITE (PRINTR,10) ISTAT
10    FORMAT (//'0I/O ERROR STATUS = ',O2)
      GO TO 130
20    ISTAT=ISTAT-32
      GO TO (30,50,70,90,110), ISTAT
30    WRITE (PRINTR,40)
40    FORMAT (//'0ELEMENT NOT FOUND')
      GO TO 130
50    WRITE (PRINTR,60)
60    FORMAT (//'0EXEC I/O ERROR')
      GO TO 130
70    if (asgsta.lt.0) go to 75
      write (printr,72)
72    format (//'0File is not a program file.')
      go to 130
75    write (printr,80) asgsta
80    format (//'0File cannot be assigned, @ASG status =',o13)
      GO TO 130
90    WRITE (PRINTR,100)
100   FORMAT (//'0FILE/ELEMENT NOT OPENED')
      GO TO 130
110   WRITE (PRINTR,120)
120   FORMAT (//'0PROGRAM FILE OVERFLOW')
C
130   NERRG=MAX0(NERRG,6)
      RETURN
C
      END
@HDG,P EXCHFO/1100-FTN
@FTN,SVI EXCHFO/1100-FTN
      SUBROUTINE EXCHFO (IOP)
C
C     OPEN AND CLOSE FILES FOR UNIVAC 1100 FTN VERSION OF EXCHANGE
C     PROGRAM.
C
C     IOP LESS THAN ZERO MEANS CLOSE FILE, IOP GREATER THAN ZERO MEANS
C     OPEN FILE.  IABS(IOP) = 1 MEANS READER, = 2 MEANS PRINTER, = 3
C     MEANS WORK FILE, = 4 MEANS INFILE.  IOP = 4 IS USED ONLY BY THE
C     BOOTSTRAP PROGRAM.
C
      INTEGER IOP
C
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
      IF (IOP.EQ.2) THEN
        IF (PRINTR.NE.6) OPEN (UNIT=PRINTR,TYPE='APRNTA')
      END IF
      RETURN
C
      END
@HDG,P EXCHIM/1100
@FTN,SVI EXCHIM/1100
      SUBROUTINE EXCHIM
C
C     READ A COMMAND OR TEXT IMAGE FROM  1.  ALTERNATE FILE
C                                        2.  TEXT FILE
C                                        3.  INPUT FILE
C                                        4.  SYSTEM READER.
C     PUT THE HOLLERITH COMMAND IN HOLCMD,
C     PUT THE ASCII EQUIVALENT IN COMAND,
C     PUT THE NUMBER OF CHARACTERS IN NCHCMD.
C     IF A SYSTEM END-OF-FILE IS SENSED, SET NCHCMD=-1.
C
C     UNIVAC-1100 VERSION.
C     FIELDATA OR ASCII FILES OR ELEMENTS MAY BE READ.
C
      INTEGER EXCH8I
      INTEGER AFDFLG,WORKS(474,5)      @ OUTPUT CODE, WORK AREAS
      INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      COMMON /EXEC8/ AFDFLG,WORKS
      COMMON /EXEC8A/ FILES,ELTS,VERS,PFS
C
      DATA WORKS(1,1) /0/
      DATA WORKS(6,1),WORKS(6,2),WORKS(6,3),WORKS(6,4) /0,0,0,0/
      DATA WORKS(10,1),WORKS(10,2),WORKS(10,3),WORKS(10,4) /0,0,0,0/
C
C     DECIDE WHAT TO DO.
C
      IF (ACTION.EQ.1) GO TO 100     @ FILES OPENED BY EXCHCX
C
C     DECIDE WHICH FILE TO READ.
C     VALUES OF J ARE DETERMINED BY ARGUMENT OF EXCHCX.
C
      J=4
      IF (INALT.GT.0) GO TO 10
      J=3
      IF (INTEXT.NE.0) GO TO 10
      J=2
      IF (INFILE.NE.0) GO TO 10
      J=1
10    IF (ACTION.NE.0) GO TO 30
      N1=EXCH8I(WORKS(1,J))
      IF (N1.EQ.0) GO TO 100
      CALL EXCHEM (N1)
      WRITE (PRINTR,20)
20    FORMAT (' WHILE READING INPUT.  EOF SIMULATED.')
      GO TO 90
C
C     CLOSE AN INPUT FILE.
C
30    CALL EORSRC (WORKS(1,J))
      IF (ACTION.NE.2) GO TO 100     @ EXIT IF NOT REOPENING INCLUDE
C
C     RE-OPEN INPUT FILE, IGNORE THE STATUS.
C
      CALL EORSRO (WORKS(1,J),ELTS(1,J),VERS(1,J))
      GO TO 100
C
C     END OF FILE ON INPUT.
C
90    NCHCMD=-1
C
100   ACTION=0
      RETURN
C
      END
@HDG,P EXCHOU/1100
@FTN,SVI EXCHOU/1100
      SUBROUTINE EXCHOU (OUTPUT)
C
C     NATIVE FORMAT OUTPUT SUBPROGRAM FOR THE EXCHANGE PROGRAM.
C     THIS MODULE IS FOR THE UNIVAC 1100 SERIES OF COMPUTERS.
C     IT EXAMINES THE SYSTEM DEPENDENT INFORMATION AFTER THE UNIT
C     NUMBER ON THE 'OUTP=...' COMMAND.  IF THERE IS NO SUCH INFORMATION
C     THE OUTPUT FILE IS REWOUND.  IF THE FIRST CHARACTER IS + OUTPUT
C     CONTINUES FROM THE CURRENT POSITION (THE UNIT NUMBER MUST NOT
C     CHANGE FROM ITS PREVIOUS VALUE, BUT THIS CANNOT BE CHECKED HERE).
C     OTHERWISE THE INFORMATION IS TREATED AS AN ELEMENT/VERSION
C     SPECIFICATION.  IF AN ERROR OCCURS WHILE OPENING THE ELEMENT
C     THE FILE WILL BE REWOUND.
C
C     OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN.
C     THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT.
C
C     THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180),
C     THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179).  IF OUTPUT(180)
C     IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE.  IF OUTPUT(180)
C     IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW
C     IMAGE.
C
      INTEGER OUTPUT(1)
      INTEGER EORSWO,EORSWW,EORSWC,EXCH8O
      INTEGER SDFF /O503011131350/     @ '*SDFF*' IN FD.
      INTEGER LABEL /O500130000000/    @ SDF LABEL ICW.
      INTEGER PLUS /1H+/
      INTEGER FDBLNK /O050505050505/   @ FIELDATA BLANK
      INTEGER BIT28 /O002000000000/    @ USED TO SET ASCII/FD BIT
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER AFDFLG,WORKS(474,5)
      INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2)
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXEC8/ AFDFLG,WORKS
      COMMON /EXEC8A/ FILES,ELTS,VERS,PFS
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     DECIDE WHETHER TO OPEN, CLOSE OR WRITE.
C
      IF (IABS(ACTION).EQ.2) GO TO 140
C     IABS(ACTION)=2 MEANS START OR END OF PROGRAM.
      IF (ACTION) 40,10,60
C
C     WRITE.
C
10    ISTAT=EXCH8O(OUTPUT)
      IF (ISTAT.EQ.0) GO TO 140
      CALL EXCHEM (ISTAT)
      WRITE (PRINTR,30)
30    FORMAT (' WHILE WRITING OUTPUT FILE.')
      GO TO 140
C
C     CLOSE.
C
40    IF (WORKS(1,5).EQ.0) GO TO 140      @ PUNCH FILE.
      ISTAT=EORSWC(WORKS(1,5),5,0,1)
      IF (ISTAT.EQ.0) GO TO 140
      CALL EXCHEM (ISTAT)
      WRITE (PRINTR,50)
50    FORMAT (' WHILE CLOSING OUTPUT FILE.')
      GO TO 140
C
C     OPEN.
C
60    WORKS(1,5)=0                     @ SETUP FOR PUNCH FILE OUTPUT.
      IF (NTABDC(OUFILE).GE.32) GO TO 140   @ JUMP IF PUNCH FILE.
C     USE FIFTH ELEMENT OF FILES, ELTS, VERS.  SEE EXCHCX.
      WORKS(1,5)=FILES(1,5)
      WORKS(2,5)=FILES(2,5)
      IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 90
      IF (HOLCMD(EQUAL).NE.PLUS) GO TO 70
      ELTS(1,5)=WORKS(6,5)             @ GET CURRENT DISK ADDRESS
      GO TO 100
C
C     OPEN AN ELEMENT TO WRITE.
C
70    IF (ELTS(1,5).NE.FDBLNK) GO TO 110
      WRITE (PRINTR,80) (HOLCMD(I),I=1,NCHCMD)
80    FORMAT (//'0IMPROPER ELEMENT NAME, OPEN FILE'/(1X,80A1))
      NERRG=MAX0(NERRG,5)
90    ELTS(1,5)=0
100   ELTS(2,5)=0
110   ISTAT=EORSWO(WORKS(1,5),ELTS(1,5),VERS(1,5))
      IF (ISTAT.NE.0) GO TO 120
C     SET ASCII FLAG.
      WORKS(468,5)=AND(WORKS(468,5),COMPL(BIT28))+AFDFLG*BIT28
      ISTAT=EORSWW(WORKS(1,5),SDFF,LABEL+AFDFLG)
      IF (ISTAT.EQ.0) GO TO 140
c     We can get away with using works(3,5) here because EORSWW does
c     not set ISTAT = 35.
120   call exchm2 (istat,works(3,5))
      WRITE (PRINTR,130) (HOLCMD(I),I=1,NCHCMD)
130   FORMAT (' WHILE OPENING OUTPUT FILE.'/(1X,80A1))
C
C     RETURN
C
140   ACTION=0
      RETURN
C
      END
@HDG,P EXCHRT/1100
@FTN,SVI EXCHRT/1100
      SUBROUTINE EXCHRT (ISTAT,DBLOCK)
C
C     UNIVAC 1100.
C
C     READ A BLOCK FROM, OR REWIND, THE EXCHANGE TAPE.
C     INPUT:
C     ISTAT = 1 MEANS OPEN WITH NO REWIND.
C     ISTAT = 2 MEANS REWIND (CLOSE WITH REWIND).
C     ISTAT = 3 MEANS READ.
C     ISTAT = 4 MEANS CLOSE WITH NO REWIND.
C
C     OUTPUT:
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR WAS DETECTED.
C
C     DBLOCK IS THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
C
      INTEGER DBLOCK(1)
C
      INTEGER EXCHIO,EXCHFN
      INTEGER FDBLNK /O050505050505/   @ FIELDATA BLANK
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXEC8A/ FILES,ELTS,VERS,PFS
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      I=ISTAT
      ISTAT=0
      GO TO (10,60,30,110), I
C
C     OPEN INTAPE.  CONVERT UNIT NUMBER TO FD (FOR SIMPLE PROGRAM).
C
10    FILES(1,6)=EXCHFN(INTAPE)
      FILES(2,6)=FDBLNK
      PFS(10,1)=PFS(11,1)
      GO TO 110
C
C     READ A BLOCK.
C
30    I=0
40    NWORDS=2*((NDATAI+NERRCI+9+8)/9) @ NUMBER OF WORDS EXPECTED
      L=EXCHIO (FILES(1,6),16,NWORDS,DBLOCK,PFS(11,1))
      IF (L.GT.0) GO TO 50
C     ALLOW ONE END OF FILE IF TRYING TO READ LABEL.
      IF (BLKSQI.NE.0) GO TO 90
      IF (I.NE.0) GO TO 80
      IF (L.NE.-1) GO TO 90
      I=1
      GO TO 40
50    NCDBI=MIN0(NDATAI+NERRCI+9,9*L/2)
      PFS(11,1)=PFS(11,1)+(L+27)/28            @ UPDATE SECTOR ADDRESS
      GO TO 110
C
C     REWIND.
C
60    L=EXCHIO (FILES(1,6),32,NWORDS,DBLOCK,PFS(11,1))
C     IGNORE THE STATUS.
      PFS(11,1)=PFS(10,1)
      GO TO 110
C
C     I/O ERROR.
C
80    L=-1
90    L=-L
      CALL EXCHEM (L)
      WRITE (PRINTR,100) L
100   FORMAT (' WHILE READING INTAPE.')
      ISTAT=3
110   RETURN
C
      END
@HDG,P EXCHWT/1100
@FTN,SVI EXCHWT/1100
      SUBROUTINE EXCHWT (ISTAT,DBLOCK)
C
C     UNIVAC 1100.
C
C     WRITE A BLOCK ON THE EXCHANGE TAPE.
C
C     INPUT:
C     ISTAT = 1 MEANS OPEN OUTPUT WITH NO REWIND
C     ISTAT = 2 MEANS WRITE
C     ISTAT = 3 MEANS WRITE END FILE AND CLOSE WITH NO REWIND.
C
C     OUTPUT:
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ON
C              TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER EXCHIO
      INTEGER FDBLNK /O050505050505/   @ FIELDATA BLANK
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2)
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXEC8A/ FILES,ELTS,VERS,PFS
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      I=ISTAT
      ISTAT=0
      GO TO (90,10,30), I
C
C     WRITE
C
10    NWORDS=2*((CCDBO+8)/9)
      IF (BLKSQO.NE.0) NWORDS=2*((NDATAO+NERRCO+9+8)/9)
      L=EXCHIO (FILES(1,7),8,NWORDS,DBLOCK,PFS(10,2))
      IF (L.LT.0) GO TO 15
      PFS(10,2)=PFS(10,2)+(L+27)/28    @ UPDATE SECTOR ADDRESS.
      GO TO 90
C
C     I/O ERROR.
C
15    L=-L
      CALL EXCHEM (L)
      WRITE (PRINTR,20)
20    FORMAT (' WHILE WRITING OUTAPE - EOF WRITTEN.')
C     NOW CLOSE OUTAPE.
C
C     CLOSE WITH NO REWIND (END FILE).
C
30    L=EXCHIO (FILES(1,7),9,NWORDS,DBLOCK,PFS(10,2))
C     IGNORE THE STATUS.
      WRITE (PRINTR,40) BLKSQO,OUTAPE
40    FORMAT (I6,23H BLOCKS WRITTEN ON TAPE,I4)
      IF (ELTS(1,7).EQ.FDBLNK) GO TO 90
      I=PFS(10,2)
      PFS(10,2)=PFS(10,2)-PFS(11,2)    @ COMPUTE ELEMENT LENGTH
      CALL PFIER (PFS(1,2),I,I)
      IF (I.EQ.0) GO TO 90
      I=I+32
      CALL EXCHEM (I)
      WRITE (PRINTR,50) OUTAPE
50    FORMAT (' WHILE TRYING TO CLOSE OUTAPE',I4,
     1'.  OUTPUT PROBABLY LOST.')
      IF (NCHCMD.LT.0) GO TO 90
      WRITE (PRINTR,60) (HOLCMD(I),I=1,NCHCMD)
60    FORMAT (1X,80A1)
      GO TO 90
90    RETURN
C
      END
@HDG,P ASMEXCH1/1100
@MASM,SI ASMEXCH1/1100,,,FTN
/.
FTN       EQU       $SS($PAR(4),1,3)='FTN'. 1 = FTN LINKAGE, 0 = FOR LINKAGE.
          AXR$.
.
.         CONVERT AN INTEGER TO LJSF FD.
.         FD=EXCHFN (INTEGER)
.         ONLY ONE WORD IS PRODUCED.
.
$(1),EXCHFN*.
          ON        1-FTN.
          SZ        A3.               FOR ADDR=IND.
          L         A1,*0,X11.        INTEGER.
          OFF.
          ON        FTN.
          L,H2      A1,0,A0.          ADDR OF INTEGER.
          L         A1,0,A1.          INTEGER.
          OFF.
          L         A3,('      ').
FNLOOP    DSL       A1,36.
          DI,U      A1,10.            PEEL OFF A DIGIT.
          A,U       A2,'0'.           CONVERT TO FD.
          DSL       A2,6.             SHIFT INTO A3.
          JNZ       A1,FNLOOP.        GET MORE DIGITS.
          S         A3,A0.            STORE FD.
          J         2-2*FTN,X11.      RETURN
/.        PERFORM I/O WITHOUT USING NTRAN.
.         I=EXCHIO (FNAME,FUNC,NWORDS,DBLOCK,DSKADR)
.           FNAME=2 WORD FD FILE NAME.
.           FUNC=8 TO WRITE, 16 TO READ, 32 TO REWIND TAPE.
.           NWORDS=NUMBER OF WORDS TO TRANSFER.
.           DBLOCK=BUFFER ADDRESS.
.           DSKADR=DISK SECTOR ADDRESS.
.         AFTER RETURN, I<0 = -IO STATUS, I>0 = WORDS TRANSFERRED.
.
$(1),EXCHIO*.
          ON        1-FTN.
          SZ        A3.               FOR ADDR=IND.
          L         A5,*4,X11.        DSKADR.
          L         A2,*1,X11.        FUNC.
          DL        A0,*0,X11.        FNAME.
          LXI       A3,*2,X11.        NWORDS.
          LXM,U     A3,*3,X11.        DBLOCK.
          OFF.
          ON        FTN.
          L,H2      A3,4,A0.          ADDR OF DSKADR.
          L         A5,0,A3.          DSKADR.
          L,H2      A3,1,A0.          ADDR OF FUNC.
          L         A2,0,A3.          FUNC.
          L,H2      A3,2,A0.          ADDR OF NWORDS.
          LXI       A3,0,A3.          NWORDS.
          LXM,H2    A3,3,A0.          DBLOCK.
          L,H2      A0,0,A0.          ADDR OF FNAME.
          DL        A0,0,A0.          FNAME.
          OFF.
          DS        A0,PKT.           STORE FNAME.
          L,U       A0,PKT.           GET PACKET ADDRESS.
          JZ        A2,TESTEQ.        TEST EQUIPMENT IF FUNC=0.
          TNE,U     A2,WEF$.          TRYING TO WRITE EOF MARK?
          J         TESTEQ.           YES, TEST EQUIPMENT.
          TE,U      A2,REW$.          TRYING TO REWIND?
          J         IO.               NO, GO DO I/O.
TESTEQ    ER        FACIL$.           GET FILE DESCRIPTION.
          L,S1      A1,PKT+6.         GET DEVICE CODE.
          JNZ       A1,ASGD.
          L         A0,(3,PKT-1).
          ER        CSF$.             ASSIGN WITH NO OPTIONS, IGNORE STATUS.
          L,U       A0,PKT.
          ER        FACIL$.           GET EQUIP CODE AGAIN.
          L,S1      A1,PKT+6.
ASGD      JZ        A2,6-6*FTN,X11.   RETURN IF FACIL & ASG ONLY.
          AN,U      A1,017.           FIRST NON-TAPE EQCODE.
          JP        A1,6-6*FTN,X11.   YES, RETURN IF NOT TAPE.
          L,U       A0,PKT.           GET I/O PACKET ADDRESS.
IO        SZ        PKT+2.
          SZ        PKT+3.
          S,S2      A2,PKT+3.         STORE FUNC.
          S         A3,PKT+4.         STORE NWORDS & DBLOCK.
          S         A5,PKT+5.         STORE DSKADR.
          ER        IOW$.             DO I/O, WAIT FOR COMPLETION.
          L,H2      A0,PKT+3.         GET NUMBER OF WORDS.
          TZ,S1     PKT+3.            TEST STATUS.
          LN,S1     A0,PKT+3.         GET -STATUS IF STATUS NOT=0.
          J         6-6*FTN,X11.      RETURN.
.
$(0)      '@ASG  '.
PKT       RES       9.                I/O PACKET.
/.        UNPACK 9-TRACK FORMAT 8-BIT CHARACTER DATA (WHICH MAY HAVE
.         BEEN READ FROM DISK OR 7-TRACK TAPE) TO ONE CHARACTER PER
.         WORD RJZF.  ALWAYS UNPACK NCH WORDS (DEFINED BY EQU).
.
.         CALL EXCHUN (BUF9T,BUFOUT)
.           BUF9T=9-TRACK FORMAT BUFFER.
.           BUFOUT=RJZF ONE CHARACTER PER WORD BUFFER.
.
NCH       EQU       180.              NUMBER OF CHARACTERS TO UNPACK.
.
$(1),EXCHUN*.
          ON        1-FTN.
          SZ        A3.               FOR ADDR=IND.
          L,U       A0,*0,X11.        BUF9T ADDRESS.
          L,U       A1,*1,X11.        BUFOUT ADDRESS.
          OFF.
          ON        FTN.
          L,H2      A1,1,A0.          BUFOUT ADDRESS.
          L,H2      A0,0,A0.          BUF9T ADDRESS.
          OFF.
          LXI,U     A0,2.             PROCESS DOUBLE WORDS OF BUF9T.
          LXI,U     A1,1.             PROCESS SINGLE WORDS OF BUFOUT.
          L,U       R1,NCH/9-1.       NUMBER OF 9 CHARACTER GROUPS.
.
GETNXT    DL        A3,0,*A0.         GET 9 8-BIT CHARACTERS.
          L,U       R2,8.             LOOP COUNTER TO PROCESS 9 CHARACTERS
NEXTCH    LDSC      A3,8.             GET 8 BITS.
          AND,U     A4,0377.          LOW ORDER 8 BITS OF A4 -> A5.
          S         A5,0,*A1.         STORE IN BUFOUT.
          JGD       R2,NEXTCH.        PEEL OFF ANOTHER 8 BITS.
          JGD       R1,GETNXT.        GET ANOTHER DOUBLE WORD.
          J         3-3*FTN,X11.      RETURN.
          END.
@HDG,P ASMEXCH2/1100
@MASM,SI ASMEXCH2/1100,,,FTN
/.
FTN       EQU       $SS($PAR(4),1,3)='FTN'. 1 = FTN LINKAGE, 0 = FOR LINKAGE.
          AXR$.
.         GET THE DATE AND STORE IT IN 'TODAY' IN /EXCHPC/,
.         ONE CHARACTER PER WORD, RIGHT JUSTIFIED, ZERO FILLED.
.         NOTE THAT THE FIELDATA NUMBERS AND THE ASCII NUMBERS
.         HAVE THE SAME VALUES.
.
$(1),XHINIT*.
          L         A2,(1,TODAY).     PLACE TO PUT THE DATE.
          ER        DATE$.            GET THE DATE FROM EXEC
          SSC       A0,12.            CONVERT DATE FROM MMDDYY TO YYMMDD
          L,U       R1,5.             LOOP COUNTER
NEXDAT    SZ        A1.
          LDSC      A0,6.             STRIP OFF ONE CHARACTER INTO A1
          S         A1,,*A2.          STORE IT IN 'TODAY' VECTOR
          JGD       R1,NEXDAT.        LOOP
.
.         STORE @XQT OPTIONS IN 'OPTVAL' VECTOR IN /EXCHPC/.
.
          L         A2,(1,OPTVAL).    PLACE TO STORE THE OPTIONS.
          ER        OPT$.             GET OPTION BITS FROM EXEC.
          LSSL      A0,10.            A OPTION -> SIGN BIT.
          L,U       A3,25.            LOOP COUNTER - 1.
OPTLOOP   SZ        A1.
          LDSC      A0,1.             SHIFT OPTION BIT INTO A1.
          S         A1,0,*A2.         STORE IN 'OPTVAL' VECTOR.
          JGD       A3,OPTLOOP.       PROCESS MORE OPTIONS.
          J         1-FTN,X11.        RETURN
.
.         DO A PROGRAM FILE SEARCH ER (PFS$).
.         CALL PFSER (PACKET,STATUS)
.
$(1),PFSER*.
 DO FTN , L         A3,A0.            SAVE CALLING SEQUENCE ADDRESS.
 DO FTN , L,H2      A0,0,A3.          GET PACKET ADDRESS.
 DO 1-FTN ,   SZ    A3.               FOR INDIRECT ADDRESSING.
 DO 1-FTN ,   L,U   A0,*0,X11.        GET PACKET ADDRESS.
          ER        PFS$.
 DO FTN , L,H2      A1,1,A3.          GET STATUS ADDRESS.
 DO FTN , S         A2,0,A1.          STORE STATUS.
 DO 1-FTN ,   S     A2,*1,X11.        STORE STATUS.
          J         3-3*FTN,X11.      RETURN.
.
.         GET THE NEXT WRITE LOCATION FOR A PROGRAM FILE.
.         CALL PFWLER (PACKET,NWL,STATUS)
.
$(1),PFWLER*.
 DO FTN , L         A3,A0.            SAVE CALLING SEQUENCE ADDRESS.
 DO FTN , L,H2      A0,0,A3.          GET PACKET ADDRESS.
 DO 1-FTN ,   SZ    A3.               FOR INDIRECT ADDRESSING.
 DO 1-FTN ,   L,U   A0,*0,X11.        GET PACKET ADDRESS.
          ER        PFWL$.            GET NEXT WRITE LOCATION.
          ON        FTN.
          L,H2      A0,1,A3.          GET WRITE LOCATION ADDRESS.
          S         A1,0,A0.          STORE WRITE LOCATION.
          L,H2      A0,2,A3.          GET STATUS ADDRESS.
          S         A2,0,A0.          STORE STATUS.
          OFF.
 DO 1-FTN ,   S     A1,*1,X11.        STORE WRITE LOCATION.
 DO 1-FTN ,   S     A2,*2,X11.        STORE STATUS.
          J         4-4*FTN,X11.
.
.         INSERT A NEW ELEMENT IN A PROGRAM FILE.
.         CALL PFIER (PACKET,NWL,STATUS)
.
$(1),PFIER*.
          ON        FTN.
          L         A3,A0.            SAVE CALLING SEQUENCE ADDRESS.
          LN,H2     A0,0,A3.          GET PACKET ADDRESS.
          L,H2      A1,1,A3.          GET WRITE LOCATION ADDRESS.
          L         A1,0,A1.          GET WRITE LOCATION.
          OFF.
          ON        1-FTN.
          SZ        A3.               FOR INDIRECT ADDRESSING.
          LN,U      A0,*0,X11.        GET PACKET ADDRESS.
          L         A1,*1,X11.        GET WRITE LOCATION.
          OFF.
          ER        PFI$.             INSERT NEW ELEMENT.
 DO FTN , L,H2      A1,2,A3.          GET STATUS ADDRESS.
 DO FTN , S         A2,0,A1.          STORE STATUS.
 DO 1-FTN ,   S     A2,*2,X11.        STORE STATUS.
          J         4-4*FTN,X11.
.
.         RETRIEVE THE SYMBIONT INDICATOR FROM NTAB$.
.         I=NTABDC(UNIT)
.
$(1),NTABDC*.
          ON        FTN.
          L,H2      A0,0,A0.          GET ARGUMENT ADDRESS.
          L         A0,0,A0.          GET UNIT NUMBER.
          L,S2      A0,F2FRT$,A0.     GET SYMBIONT INDICATOR.
          OFF.
          ON        1-FTN.
          SZ        A3.               FOR INDIRECT ADDRESSING.
          L         A0,*0,X11.        GET UNIT NUMBER.
          L,S2      A0,NTAB$,A0.      GET SYMBIONT INDICATOR.
          OFF.
          J         2-2*FTN,X11.      RETURN.
/.        PACK ONE CHARACTER PER WORD DATA INTO 9-TRACK FORMAT
.         ALWAYS USE "NCH" CHARACTERS (DEFINED BELOW).
.
.         CALL EXCHPA (BUFIN,BUF9T)
.         BUFIN IS THE INPUT BUFFER (ONE CHARACTER PER WORD)
.         BUF9T IS THE 9-TRACK FORMAT OUTPUT BUFFER
.
NCH       EQU       180.               180 CHARACTERS AT A TIME
$(1),EXCHPA*.
          ON        FTN.
          L         A3,A0.             SAVE CALLING SEQUENCE ADDRESS.
          L,H2      A0,0,A3.           GET BUFIN ADDRESS.
          L,H2      A1,1,A3.           GET BUF9T ADDRESS.
          OFF.
          ON        1-FTN.
          L,U       A1,*1,X11.         GET BUF9T ADDRESS.
          SZ        A3.                FOR INDIRECT ADDRESSING.
          L,U       A0,*0,X11.         GET BUFIN ADDRESS.
          OFF.
          LXI,U     A0,1.              INCREMENT 1 WORD EACH TIME
          LXI,U     A1,2.              INCREMENT 2 WORDS EACH TIME
          L,U       R2,0377.           8 BIT MASK
          L,U       R1,NCH/9-1.        NUMBER OF 9-CHARACTER GROUPS
.
PUTNXT    L,U       R3,8.              LOOP FOR 9 CHARACTERS
NXTOUT    LDSL      A3,8.              MAKE ROOM FOR NEXT CHARACTER
          MLU       A4,,*A0.           ADD IN NEXT CHARACTER
          S         A5,A4.             MOVE BACK INTO A4
          JGD       R3,NXTOUT.         GO ADD NEXT CHARACTER
          DS        A3,,*A1.           STORE DOUBLE WORD
          JGD       R1,PUTNXT.         NCH/9 OUTER LOOP TRAVERSALS
          J         3-3*FTN,X11.       RETURN
/.        PACK 12 CHARACTERS IN FIELDATA - FOR FILE, ELEMENT, VERSION NAMES.
.
.         CALL EXCHPN (RJASCI,FD,NCHAR)
.           RJASCI=RIGHT JUSTIFIED ASCII, ONE CHARACTER PER WORD.
.           FD=PACKED FIELDATA EQUIVALENT PRODUCED HERE.
.           NCHAR=NUMBER OF RJASCI.
.
$(1),EXCHPN*.
          ON        1-FTN.
          SZ        A3.               FOR ADDR=IND.
          L,U       A0,*0,X11.        ADDR OF RJASCI.
          L,U       A1,*1,X11.        ADDR OF FD.
          L         R1,*2,X11.        NCHAR.
          OFF.
          ON        FTN.
          L,H2      A1,2,A0.          ADDR OF NCHAR.
          L         R1,0,A1.          NCHAR.
          L,H2      A1,1,A0.          ADDR OF FD.
          L,H2      A0,0,A0.          ADDR OF RJASCI.
          OFF.
          A         A0,R1.            COMPUTE END OF
          AN,U      A0,1.              RJASCI VECTOR.
          LXI,XU    A0,-1.            PROCESS RJASCI RIGHT TO LEFT.
          L         A4,BLANKS.
          L         A5,A4.
          J         PNLT.
PNLOOP    L         A2,0,*A0.         GET RJASCI CHAR.
          L,S1      A3,AF,A2.         GET FD EQUIVALENT.
          DSL       A4,6.             TRIPLE
          LSSL      A4,6.              SHIFT
          DSL       A3,6.               RIGHT.
PNLT      JGD       R1,PNLOOP.
          DS        A4,0,A1.          STORE FD.
          J         4-4*FTN,X11.      RETURN.
/.        UNIVAC-1100 EXEC SDF INPUT ROUTINE FOR THE EXCHANGE PROGRAM.
.
.         STATUS=EXCH8I (WORK)
.         WORK IS THE 473 WORD WORK AREA REQUIRED BY EORSR.
.         STATUS IS AS FOR EORSRR EXCEPT NORMAL EOF = 0.
.
.         DEFINITIONS.
.
BANKWL    EQU       224.              WORD LENGTH OF I/O BUFFERS.
BANKSL    EQU       BANKWL//28.       SECTOR LENGTH OF I/O BUFFERS.
NX        EQUF      *0177777,*0,017.  REMOVE X REG FROM EQUFS.
.         WORK AREA
FCT       EQUF      0,A0.             SDFI WORK AREA.
EQCODE    EQUF      FCT+6,,S1.        EQUIPMENT CODE FROM FITEM$.
KEY       EQU       FCT+11.           OPEN FILE INDICATOR.
SAVX1     EQU       KEY+1.            SAVE AREA FOR X1.
SAVX11    EQU       SAVX1+1.          SAVE AREA FOR X11.
BANK1     EQU       SAVX11+1.         FIRST I/O BUFFER.
BANK2     EQU       BANK1+BANKWL.     SECOND I/O BUFFER
ETABLE    EQU       BANK2+BANKWL.     ELEMENT TABLE IF NEEDED
ETFILE    EQU       ETABLE.           ELEMENT FILE NAME.
ETELT     EQU       ETABLE+2.         ELEMENT NAME.
ETVER     EQU       ETABLE+6.         VERSION NAME.
ETETYP    EQUF      ETABLE+5,,H1.     ELEMENT TYPE.
ETELOC    EQU       ETABLE+10.        SECTOR LOCATION OF ELEMENT.
.         CALLING SEQUENCE PARAMETERS.
 DO FTN ,WORK EQUF  0,A0,H2.          WORK AREA ADDRESS.
 DO 1-FTN ,WORK EQUF *0,X11,U.        WORK AREA ADDRESS.
.         LOCAL USE OF WORK AREA.
AFD       EQUF      KEY,,S2.          ASCII/FD FLAG.
FILTYP    EQUF      KEY,,S3.          FILE TYPE
/.        SDDL DESCRIPTION OF PROCEDURE.
.
. PROCEDURE SDFASR TO READ SDF INTO ASCII, USING WORK, IMAGE, STATUS
.     THE WORK AREA CONTAINS THE FILE MODE (ELT/FILE/READ$) BY INTERPRETING
.     ELEMENT=0 MEANS FILE OR READ$, IF ELEMENT=0 THEN VERSION=0 MEANS FILE.
.     THE WORK AREA ALSO CONTAINS THE FILE CREATION TYPE (C,F,I,P,S,?) FROM A
.     TYPE 050 LABEL RECORD, IF ONE IS PRESENT.
.    LOOP
.       IF ELEMENT
.          CALL ELTR GIVING STATUS------------------------------------->(   )
.       ELSEIF FILE
.          CALL SDFR GIVING STATUS------------------------------------->(   )
.       ELSE
.          CALL READ$-------------------------------------------------->(   )
.          IF EOF
.             SET STATUS = 037
. <-----------EXITPROCEDURE
.          ELSE
.             SET ASCII / FD FLAG = ASCII
.    <--------EXITLOOP
.          ENDIF
.       ENDIF
.       IF STATUS NOT EQUAL 0
. <--------EXITPROCEDURE
.       ENDIF
.       IF RECORD TYPE = 050
.          SET FILE CREATION TYPE AND ASCII / FD FLAG FROM ICW
.    <-----CYCLE
.       ENDIF
.       IF RECORD TYPE = 042
.          SET ASCII / FD FLAG FROM ICW
.    <-----CYCLE
.       ENDIF
.       IF RECORD TYPE GREATER THAN 037
.    <-----CYCLE
.       ENDIF
.       SELECT FILE CREATION TYPE
.       CASE C OR I
.          SET ASCII / FD FLAG FROM BIT 0 OF ICW
.       CASE P
.          SET FIRST BYTE OF IMAGE FROM IMAGE SPACING IN T2 OF ICW
.          SET ASCII / FD FLAG FROM BIT 0 OF ICW
.       CASE S
.          IF S4 OF ICW NOT EQUAL ZERO
.    <--------CYCLE
.          ENDIF
.       ENDSELECT
.    <--EXITLOOP
.    ENDLOOP
.    STORE IMAGE IN ASCII, USE ASCII / FD FLAG TO DETERMINE IMAGE TYPE.
. <--EXITPROCEDURE
. ENDPROCEDURE
/.
$(1),EXCH8I* S      X11,SX11.
 DO 1-FTN , SZ      A3.               FOR INDIRECT ADDRESSING.
          L         A0,WORK.          GET WORK AREA ADDRESS.
          S         A0,WORKSV.
          L         A1,(1,0).
          S         A1,BYTE1.         BYTE LOCATION IN COMAND.
          LN,U      A1,1.
          S         A1,NCHCMD.        EOF INDICATOR.
          L,U       A1,040.           ASCII ' '.
          S         A1,COMAND.        IN CASE OF ZERO LENGTH IMAGE.
          L         A1,FCT.           FILE NAME.
          JZ        A1,READ$IN.       NO FILE NAME, USE ER AREAD$.
ELTLP.
 DO FTN , L,U       A0,WORKSV.        ADDRESS OF CALLING SEQUENCE.
          LMJ       X11,EORSRR.
 DO FTN ,$(6).
WORKSV    +         $-$.              ADDRESS OF WORK AREA.
          +         HOLCMD.           INPUT IMAGE AREA.
          +         ((180)).          MAXIMUM IMAGE LENGTH.
          +         ICW.              IMAGE CONTROL WORD.
          +         $-EXCH8I,0.       WALBACK.
 DO FTN ,$(1).
          TNE,U     A0,37.            TEST FOR EOF.
          J         EXITZ.            NORMAL EOF.
          JNZ       A0,EXITI.         ABNORMAL EOF.
          L         A0,WORKSV.        RESTORE WORK AREA ADDRESS.
          TN        ICW.              CONTROL OR DATA?
          J         GOTIMG.           DATA.
          L,S1      A1,ICW.           GET CONTROL RECORD TYPE.
          TE,U      A1,050.           LABEL RECORD?
          J         ELTLP.            NO.
          L,S3      A1,ICW.           GET FILE TYPE.
          TNZ       FILTYP.           DON'T STORE FILTYP MORE THAN ONCE.
          S         A1,FILTYP.        STORE FILE TYPE IN WORK AREA.
          J         ELTLP.            GET ANOTHER RECORD.
READ$IN   L         A0,(EXITZ,HOLCMD).
          ER        AREAD$.           READ IMAGE IN ASCII.
          TEP       A0,(1*/31).
          J         READ$IN.          SKIP INFOR.
          LSSL      A0,24.            MOVE WORD COUNT.
          J         GOTIMA.           GO PROCESS ASCII IMAGE.
GOTIMG    L         A1,FILTYP.        GET FILE TYPE.
          TE,U      A1,'C'.           CARD FILE?
          TNE,U     A1,'I'.           INPUT SYMBIONT FILE?
          J         CORIREC.          ONE OR THE OTHER.
          TNE,U     A1,'P'.           PRINT FILE?
          J         PREC.             YES.
          TE,U      A1,'X'.           FTN?
          TNE,U     A1,'F'.           FORTRAN?
          J         FREC.             YES.
          TZ,S4     ICW.              DELETED RECORD?
          J         ELTLP.            YES, GET ANOTHER RECORD.
FREC      L         A2,AFD.           GET ASCII/FD FLAG.
          J         TIM.              GO TEST IMAGE CODE.
PREC      L,S3      A1,ICW.
          LSSL      A1,6.
          A,S4      A1,ICW.           GET LINE SPACING FROM T2 OF ICW.
          L,U       A5,060.           ASCII '0'.
          TNE,U     A1,0.
          L,U       A5,053.           ASCII '+'.
          TNE,U     A1,1.
          L,U       A5,040.           ASCII ' '.
          TG,U      A1,47.            SKIP IF A1 .LE. 47
          L,U       A5,061.           ASCII '1'.
          L         A1,BYTE1.
          S         A5,COMAND,*A1.    STORE FORTRAN VERTICAL FORMAT CONTROL
          S         A1,BYTE1.         STORE INCREMENTED BYTE POINTER.
CORIREC   L         A1,ICW.
          AND,U     A1,1.             ASCII/FD FLAG IS BIT ZERO.
TIM       L         A0,ICW.
          JZ        A2,GOTIMF.        JUMP IF IMAGE FD.
GOTIMA    L         A2,(1,0).
          L         A1,BYTE1.         GET BYTE POINTER.
          SSL       A0,24.            RJ WORD COUNT.
          JZ        A0,ENDIMG.
          TG,U      A0,45.
          L,U       A0,44.            MAXIMUM CAPACITY IS 44 WORDS.
          AN,U      A0,1.
LOOPA     L,U       R1,3.             INNER LOOP COUNTER.
          L         A4,HOLCMD,*A2.    GET WORD OF 4 BYTES.
          SZ        A3.
          LDSL      A3,9.             GET ONE BYTE.
          S         A3,COMAND,*A1.
          JGD       R1,$-3.
          JGD       A0,LOOPA.
ENDIMG    L,U       A2,040.           ASCII ' '.
          S         A2,COMAND,A1.     GET READY TO STRIP OFF TRAILING BLANKS.
          LXI,XU    A1,-1.            SCAN BACKWARD.
          TNE       A2,COMAND,A1.     STRIP OFF TRAILING BLANKS.
          JMGI      A1,$-1.           LOOP FOR A WHILE.
          L,U       A2,1,A1.          INCREMENT POINTER TO MAKE COUNT.
          JNZ       A2,$+3.
          L,U       A2,1.             AT LEAST ONE BYTE.
          LXM,U     A1,0.
          S         A2,NCHCMD.        SAVE NUMBER OF CHARACTERS.
ASCHOL    L         A2,COMAND,A1.     GET ASCII CHARACTER.
          L         A2,XLATE,A2.      TRANSLATE TO HOLLERITH.
          S         A2,HOLCMD,A1.     STORE.
          JMGI      A1,ASCHOL.        LOOP FOR A WHILE.
EXITZ     SZ        A0.               INDICATE NORMAL EXIT.
EXITI     L         X11,SX11.
          J         2-2*FTN,X11.      RETURN.
GOTIMF    L         A2,(1,0).
          L         A1,BYTE1.
          SSL       A0,24.            POSITION WORD COUNT.
          JZ        A0,ENDIMG.
          TG,U      A0,30.
          L,U       A0,29.            MAXIMUM CAPACITY IS 29 WORDS.
          AN,U      A0,1.
LOOPF     L,U       R1,5.             INNER LOOP COUNTER.
          L         A4,HOLCMD,*A2.    GET ONE WORD OF 6 BYTES.
          SZ        A3.
          LDSL      A3,6.             GET ONE BYTE.
          L         A3,FA,A3.         CONVERT TO ASCII
          S         A3,COMAND,*A1.
          JGD       R1,$-4.
          JGD       A0,LOOPF.
          J         ENDIMG.
/.        UNIVAC-1100 EXEC SDF OUTPUT ROUTINE FOR THE EXCHANGE PROGRAM.
.
.         STATUS=EXCH8O (OUTPUT)
.         OUTPUT IS THE OUTPUT VECTOR, RJZF ASCII.
.         STATUS IS AS FOR EORSWW.
.
.         DEFINITIONS.
.
.         CALLING SEQUENCE PARAMETERS.
 DO FTN ,OUTPUT EQUF 0,A0,H2.         OUTPUT BUFFER ADDRESS.
 DO 1-FTN ,OUTPUT EQUF *0,X11,U.      OUTPUT BUFFER ADDRESS.
.
$(1),EXCH8O* S      X11,SX11.         SAVE X11.
 DO 1-FTN , SZ      A3.               FOR ADDR=IND.
          L         A1,OUTPUT.        GET ADDR OF OUTPUT VECTOR.
          LXI,U     A1,1.             PUT IN INCREMENTOR.
          L         R1,NCHOUT.        NUMBER OF CHARACTERS OF OUTPUT.
          L         A2,AFDFLG.        ASCII=1, FD=0.
          L         A0,(1,0).         POINTER INTO OUTPUT BUFFER.
          JZ        A2,PACKF.
          J         PACKA.
. ASCII PACKING LOOP.
PACKAL    L         A5,0,*A1.         GET CHAR OF ASCII.
          LSSL      A5,27.            LJ.
          LDSL      A4,9.             ADD TO ACCUMULATING STRING.
          JGD       R2,$+3.           WORD FULL?
          S         A4,BUFOUT,*A0.    PUT WORD IN OUTPUT BUFFER.
PACKA     L         R2,LOOPCT+1.      GET LOOP COUNTER.
          JGD       R1,PACKAL.
          J         FINL.
. FIELDATA PACKING LOOP.
PACKFL    L         A3,0,*A1.         GET CHAR OF FD.
          L         A5,AF,A3.         TRANSLATE TO FD.
          LDSL      A4,6.             ADD TO ACCUMULATING STRING.
          JGD       R2,$+3.           WORD FULL?
          S         A4,BUFOUT,*A0.    PUT WORKD IN OUTPUT BUFFER.
PACKF     L         R2,LOOPCT.        GET LOOP COUNTER.
          JGD       R1,PACKFL.
. FINISH UP PACKING, ADD TRAILING BLANKS TO LAST WORD.
FINL      L         A3,R2.
          TNE       A3,LOOPCT,A2.     HOW MUCH OF LOOP IS LEFT?
          J         FIN.              NONE.
          A,U       A3,1.
          MSI       A3,SHIFT,A2.      COMPUTE SHIFT.
          L         A5,BLANKS,A2.
          LDSL      A4,0,A3.          SHIFT IN TRAILING BLANKS.
          S         A4,BUFOUT,*A0.    STORE WORD WITH TRAILING BLANKS.
FIN       TZ        WORKOUT.          PUNCH?
          J         FILE.             NO.
          LSSL      A0,18.            CONSTRUCT PUNCH$ OR APUNCH$ PKT.
          LXM,U     A0,BUFOUT.
          JNZ       A2,ASCPCH.
          ER        PUNCH$.           FD PUNCH.
          SZ        A0.               CLEAR STATUS.
          J         EXITO.
ASCPCH    ER        APUNCH$.          ASCII PUNCH.
          SZ        A0.               CLEAR STATUS.
          J         EXITO.
. FILE OUTPUT.
FILE      LSSL      A0,24.
          S         A0,ICW.           STORE ICW.
 DO FTN , L,U       A0,CALSEQ.        CALLING SEQUENCE
          LMJ       X11,EORSWW.       WRITE SDF RECORD.
 DO FTN ,$(6),CALSEQ.
          +         WORKOUT.          WORK AREA ADDRESS.
          +         BUFOUT.           OUTPUT BUFFER.
          +         ICW.              IMAGE CONTROL WORD.
          +         $-EXCH8O,0.       WKBK.
 DO FTN ,$(1).
EXITO     L         X11,SX11.         RECOVER X11.
          J         2-2*FTN,X11.      RETURN.
/.        COMMON DEFINITIONS.
.
          INFO      2 'EXCHOC',3.
$(3).
BLKSQO    RES       1.                OUTPUT BLOCK SEQUENCE.
CBLCKO    RES       180.              OUTPUT CHARACTER OUTPUT BLOCK.
CCDBO     RES       1.                CURRENT OUTPUT CHARACTER POSITION.
CPCBO     RES       1.                CURRENT POSITION IN CBLCKO.
CWDBO     RES       1.                CURRENT OUTPUT WORD POSITION.
ITYPEO    RES       1.                OUTPUT RECORD TYPE.
LASTO     RES       1.                FLAG FOR LAST BLOCK OF TAPE.
LLPRGO    RES       1.                LOCATION OF LAST PROGRAM.
L1PRGO    RES       1.                LOCATION OF FIRST PROGRAM IN BLOCK.
L1RECO    RES       1.                LOCATION OF FIRST RECORD IN BLOCK.
MODEO     RES       1.                MODE OF OUTPUT RECORD.
NCCBO     RES       1.                NUMBER OF CHARACTERS TO PACK.
NCHOUT    RES       1.                NUMBER OF CHARACTERS IN OUTPUT RECORD.
NDATAO    RES       1.                NUMBER OF DATA CHARACTERS PER BLOCK.
NERRCO    RES       1.                ERROR DETECTION CHARACTERS PER BLOCK.
NLRECO    RES       1.                PROGRAM NUMBER OF LAST RECORD OUTPUT.
NWCBO     RES       1                 WORDS NEEDED FOR NCCBO CHARACTERS.
N1RECO    RES       1.                PROGRAM NUMBER OF FIRST RECORD IN BLOCK.
OUTREC    RES       180.              SPACE FOR OUTPUT RECORD.
OUTUPD    RES       1.                ASCII U (85) IF UPDATE OK.
REMVO     RES       1.                CHARACTER REMOVED FOR COMPRESSION.
.
          INFO      2 'EXCHPC',2.
$(2).
ACTION    RES       1.                EXCHIM/EXCHOU ACTION FLAG.
CHAR1L    RES       1.                CHARACTER AFTER LINE NUMBER ON LIST.
COMAND    RES       180.              ASCII INPUT BUFFER.
COMD      RES       4*40.             COMMAND TABLE.
EQUAL     RES       1.                LOCATION OF EQUAL SIGN IN COMMAND.
HOLCMD    RES       180.              HOLLERITH INPUT BUFFER.
ICOMD     RES       1.                COMMAND INDEX.
IDCUR     RES       1.                CURRENT SEQUENCE NUMBER.
IDOPTN    RES       1.                SEQUENCE NUMBERING OPTION.
IDNBRS    RES       4.                C1,C2,STEP,START FOR SEQUENCE NUMBERS.
IDTEXT    RES       40.               TEXT TO EMIT WITH SEQUENCE NUMBERS.
IDTXTL    RES       1.                LENGTH OF TEXT TO EMIT.
INDEX     RES       1.                SUM OF INDEXS - INDEXING FLAG.
INDEXS    RES       26.               INDIVIDUAL INDEX FLAGS.
INTOPN    RES       1.                INTAPE OPEN FLAG.
LIMIT     RES       1.                LIMIT OF PRED CONTROLLED SEARCH.
LINEO     RES       1.                OUTPUT LINE NUMBER (FOR LISTING).
MARGIN    RES       1.                RIGHT MARGIN OF COMMANDS.
MODIFY    RES       1.                MODIFIER FIELD OF COMMAND.
NCHCMD    RES       1.                NUMBER OF CHARACTERS OF INPUT.
NCOMDP    RES       1.                SIZE OF PORTABLE COMMAND TABLE.
NCOMDT    RES       1.                SIZE OF TOTAL COMMAND TABLE.
NERRG     RES       1.                GLOBAL ERROR FLAG.
NERRS     RES       1.                LOCAL ERROR FLAG.
NRWORK    RES       1.                NUMBER OF CONTROL RECORDS ON WORKF.
NUMBER    RES       1.                FIRST NUMBER FROM COMMAND PARAMETER FIELD.
OPTVAL    RES       26.               ALPHABETIC OPTION SELECTIONS.
OUTOPN    RES       1.                OUTAPE OPEN FLAG.
PHASE     RES       1.                PROGRAM OPERATION PHASE.
PRED      RES       42*8.             STORED PREDICATES.
SIGNAL    RES       1.                END OF TEXT SIGNAL.  INITIALLY -.
SITE      RES       40.               SITE.
TITLE     RES       40.               TITLE.
TODAY     RES       6.                DATE.
TRANS     RES       1.                CONTROLS TRANSITION BETWEEN SEGMENTS.
VERT      RES       1.                VERTICAL SPACING CONTROL FLAG.
.
          INFO      2 'EXCHXC',4.
$(4),XLATE RES      128.              TRANSLATE TABLE ASCII -> HOLLERITH.
 DO 1-FTN ,AF EQU   XLATE.            TRANSLATE TABLE ASCII -> FD.
.
          INFO      2 'EXEC8',5.
$(5).
AFDFLG    RES       1.                FD=0, ASCII=1 OUTPUT CODE.
WORKIN    RES       474*4.            INPUT WORK AREAS.
WORKOUT   RES       474.              OUTPUT WORK AREA.
.
.         SCRATCH AREAS.
.
$(0).
BYTE1     RES       1.
ICW       RES       1.
SX11      RES       1.
BUFOUT    RES       45.               OUTPUT BUFFER.
BLANKS    '      '.                   FD BLANKS.
          +         040,040,040,040.  ASCII BLANKS.
SHIFT     +         6.                FD SHIFT.
          +         9.                ASCII SHIFT.
LOOPCT    +         5.                FD LOOP COUNTER.
          +         3.                ASCII LOOP COUNTER.
.
.         TRANSLATE TABLE FROM FIELDATA TO ASCII.
.
          ASCII
FA.
          +         '@'.
          +         '['.
          +         ']'.
          +         '#'.
          +         '^'.
          +         ' '.
          +         'A'.
          +         'B'.
          +         'C'.
          +         'D'.
          +         'E'.
          +         'F'.
          +         'G'.
          +         'H'.
          +         'I'.
          +         'J'.
          +         'K'.
          +         'L'.
          +         'M'.
          +         'N'.
          +         'O'.
          +         'P'.
          +         'Q'.
          +         'R'.
          +         'S'.
          +         'T'.
          +         'U'.
          +         'V'.
          +         'W'.
          +         'X'.
          +         'Y'.
          +         'Z'.
          +         ')'.
          +         '-'.
          +         '+'.
          +         '<'.
          +         '='.
          +         '>'.
          +         '&'.
          +         '$'.
          +         '*'.
          +         '('.
          +         '%'.
          +         ':'.
          +         '?'.
          +         '!'.
          +         ','.
          +         '\'.
          +         '0'.
          +         '1'.
          +         '2'.
          +         '3'.
          +         '4'.
          +         '5'.
          +         '6'.
          +         '7'.
          +         '8'.
          +         '9'.
          +         ''''.
          +         ';'.
          +         '/'.
          +         '.'.
          +         '"'.
          +         '_'.
.
.         ASCII -> FD TRANSLATION.
.
          ON        FTN.
          FIELDATA.
AF.
 DO 32 ,  '$'.
          ' '.
          '!'.
          '"'.
          '#'.
          '$'.
          '%'.
          '&'.
          ''''.
          '('.
          ')'.
          '*'.
          '+'.
          ','.
          '-'.
          '.'.
          '/'.
I  DO 10 , + ('0'+I-1)*/30
          ':'.
          ';'.
          '<'.
          '='.
          '>'.
          '?'.
          '@'.
I  DO 26 , + ('A'+I-1)*/30
          '['.
          '\'.
          ']'.
          '^'.
          '_'.
          '@'.
I  DO 26 , + ('A'+I-1)*/30
          '['.
          '\'.
          ']'.
          '^'.
          '_'.
          OFF.
          END.
@HDG,P EORSR/1100
@MASM,SI EORSR/1100,,,FTN
/.
.         READ ELEMENTS OR SDF FILES.
.
.         S = EORSRO (WORK,ELT,VER) OPENS AN ELEMENT OR SDF FILE.
.           THE FIRST TWO WORDS OF WORK MUST BE THE FILENAME.
.           ELT DETERMINES WHETHER A FILE OR ELEMENT IS TO BE READ.
.           IF ELT = 0, ELT IS A SCALAR AND A FILE IS TO BE READ, IN
.             WHICH CASE WORK MUST BE AT LEAST 462 WORDS AND
.             VER IS IGNORED.
.           IF ELT NOT ZERO, IT IS THE FIRST WORD OF A TWO WORD VECTOR
.             CONTAINING THE ELEMENT NAME, VER IS THE TWO WORD VERSION
.             AND WORK MUST CONTAIN AT LEAST 474 WORDS.
.           S IS THE STATUS (DECIMAL):
.             00 = NORMAL COMPLETION,
.             1 - 32 = I/O ERROR,
.             33 = ELEMENT NOT FOUND,
.             34 = EXEC I/O ERROR,
.             35 = THE FILE CANNOT BE ASSIGNED, OR THE FILE CAN BE
.                  ASSIGNED BUT ELT NOT = ZERO AND THE FILE IS NOT A
.                  PROGRAM FILE.  IF THE FILE CANNOT BE ASSIGNED THE
.                  CSF$ STATUS IS RETURNED IN WORK(3).  IF THE FILE CAN
.                  BE ASSIGNED, WORK(3) IS NON-NEGATIVE.
.
.         S = EORSRR (WORK,IMAGE,MAXLEN,ICW) READS SDF FILE OR ELEMENT.
.           WORK IS AS FOR EORSRO (MUST NOT BE CHANGED BY USER),
.           IMAGE IS THE PLACE THE USER DESIRES THE IMAGE TO BE PLACED,
.           MAXLEN IS THE MAXIMUM NUMBER OF WORDS OF IMAGE TO BE
.             DELIVERED TO THE USER.  THE ACTUAL NUMBER OF WORDS
.             DELIVERED IS PART OF THE ICW.  IMAGE IS NOT SPACE FILLED,
.             BUT MAY BE TRUNCATED IF MAXLEN IS LESS THAN THE ACTUAL
.             RECORD SIZE.
.           ICW IS THE SDF IMAGE CONTROL WORD (SEE PRM VOLUME 3).
.           S IS AS FOR EORSRO, PLUS TWO MORE POSSIBLE VALUES:
.             36 = FILE OR ELEMENT NOT OPENED,
.             37 = END OF FILE ENCOUNTERED.
.
.         CALL EORSRC (WORK) STOPS ANYNCHRONOUS I/O AND
.           RELEASES THE ASSOCIATION OF WORK AND THE FILE OR ELEMENT.
.
/.        DEFINITIONS.
          AXR$.                       REGISTERS, ETC.
FTN       EQU       $SS($PAR(4),1,3)='FTN'. 1 = FTN LINKAGE, 0 = FOR LINKAGE.
BANKWL    EQU       224.              WORD LENGTH OF I/O BUFFERS.
BANKSL    EQU       BANKWL//28.       SECTOR LENGTH OF I/O BUFFERS.
NX        EQUF      *0177777,*0,017.  REMOVE X REG FROM EQUFS.
.         WORK AREA
FCT       EQUF      0,X1.             SDFI WORK AREA.
EQCODE    EQUF      FCT+6,,S1.        EQUIPMENT CODE FROM FACIL$.
KEY       EQU       FCT+11.           OPEN FILE INDICATOR.
FILELT    EQUF      KEY,,S1.          0=FILE, 1=ELT.
ASCFD     EQUF      KEY,,S2.          ASCII/FD CODE
SAVX1     EQU       KEY+1.            SAVE AREA FOR X1.
SAVX11    EQU       SAVX1+1.          SAVE AREA FOR X11.
 DO FTN ,SAVA3 EQUF SAVX1+1,,H1.      SAVE AREA FOR A3.
BANK1     EQU       SAVX11+1.         FIRST I/O BUFFER.
BANK2     EQU       BANK1+BANKWL.     SECOND I/O BUFFER
ETABLE    EQU       BANK2+BANKWL.     ELEMENT TABLE IF NEEDED
ETFILE    EQU       ETABLE.           ELEMENT FILE NAME.
ETELT     EQU       ETABLE+2.         ELEMENT NAME.
ETVER     EQU       ETABLE+6.         VERSION NAME.
ETETYP    EQUF      ETABLE+5,,H1.     ELEMENT TYPE.
ETELOC    EQU       ETABLE+10.        SECTOR LOCATION OF ELEMENT.
.         CALLING SEQUENCE PARAMETERS.
          ON        1-FTN.            ASSEMBLE IF FTN=0.
WORK      EQUF      *0,X11,U.         FCT ADDRESS.
ELT       EQUF      *1,X11.           FIRST WORD OF ELEMENT.
VER       EQUF      *2,X11.           VERSION NAME.
IMAGE     EQUF      *1,X11,U.         ADDRESS OF IMAGE.
MAXLEN    EQUF      *2,X11.           MAXIMUM WORDS OF IMAGE.
ICW       EQUF      *3,X11.           IMAGE CONTROL WORD.
          OFF.
          ON        FTN.              ASSEMBLE IF FTN=1.
WORK      EQUF      0,A3,H2.          FCT ADDRESS.
ELT       EQUF      1,A3,H2.          FIRST WORD OF ELEMENT.
VER       EQUF      2,A3,H2.          FIRST WORD OF VERSION.
IMAGE     EQUF      1,A3,H2.          ADDRESS OF IMAGE.
MAXLEN    EQUF      2,A3,H2.
ICW       EQUF      3,A3,H2.
          OFF.
.         RETURNS
RETO      EQUF      4*(1-FTN),X11.    RETURN FROM EORSRO.
RETR      EQUF      5*(1-FTN),X11.    RETURN FROM EORSRR.
RETC      EQUF      2*(1-FTN),X11.    RETURN FROM EORSRC.
.
/.        S = EORSRO (WORK,ELT,VER)
.
$(1),EORSRO*.
 DO 1-FTN , SZ      A3.               FOR ADDR=IND.
 DO FTN   , L       A3,A0.            GET CALLING SEQUENCE ADDRESS.
          L         A0,WORK.          ADDR OF FCT.
          S         X1,SAVX1**NX,A0.  SAVE X1.
          S         A0,X1.            SETUP FCT POINTER.
          S         X11,SAVX11.       SAVE X11.
          ER        FACIL$.           IS FILE OPEN?
          L         A1,EQCODE.
          JNZ       A1,GOTFILE.       JUMP IF DEVICE CODE.
          DL        A0,('@ASG,A      ').
          DS        A0,BANK1.
          DL        A0,FCT.           GET FILE NAME.
          DS        A0,BANK1+2.
          L,U       A0,BANK1.         USE I/O BUFFER FOR CSF$ IMAGE.
          LXI,U     A0,4.             LENGTH OF CSF$ IMAGE.
          ER        CSF$.             TRY TO ASSIGN FILE.
          JN        A0,NOFILE.        ERROR EXIT.
GOTFILE   SZ        R2.               INDICATE ASSIGNABLE FILE.
          L,U       A0,R$.            SETUP I/O PACKET FOR SDFI.
          S,S2      A0,FCT+3.         FUNCTION CODE = R$.
          SZ,S1     FCT+3.            STATUS (T2 WOULD BE PSR SENSITIVE).
          L,U       A0,BANKWL.        I/O BUFFER WORD LENGTH.
          S,H1      A0,FCT+4.
          L,U       A0,BANK2.
          LXI,U     A0,BANK1.
          S         A0,FCT+6.         I/O BUFFER ADDRESSES.
          L,U       A0,BANKSL.        I/O BUFFER SECTOR LENGTH.
          S,H1      A0,FCT+7.
          L,U       A0,1.
          S,H1      A0,FCT+8.         INCREMENTOR FOR BT.
          S,H1      A0,FCT+9.         INCREMENTOR FOR BT.
          SZ        KEY.              CLEAR OPEN, TYPE.
 DO 1-FTN , DL      A0,ELT.           GET ELEMENT NAME.
 DO FTN   , L       A0,ELT.           GET ADDRESS OF ELEMENT NAME.
 DO FTN   , DL      A0,0,A0.          GET ELEMENT NAME.
          JZ        A0,NOELT.         JUMP IF SDF FILE DESIRED.
.         SETUP PFS$ PACKET.
          DS        A0,ETELT.         STORE ELEMENT NAME.
 DO 1-FTN , DL      A0,VER.           GET VERSION.
 DO FTN   , L       A0,VER.           GET ADDRESS OF VERSION.
 DO FTN   , DL      A0,0,A0.          GET VERSION.
          DS        A0,ETVER.         STORE ELEMENT VERSION.
          DL        A0,FCT.
          DS        A0,ETFILE.        STORE FILE NAME.
          L,U       A0,1.             SYMBOLIC ELEMENTS.
          S         A0,ETETYP.        STORE ELEMENT TYPE.
          S         A0,FILELT.        INDICATE ELT.
          L,U       A0,ETABLE.        ADDRESS OF PFS$ PACKET.
          ER        PFS$.             DO PROGRAM FILE SEARCH.
          JNZ       A2,PFS$ERR.       JUMP IF ERROR.
          L         A0,ETELOC.        GET ELEMENT LOCATION.
NOELT     S         A0,FCT+5.         SECTOR ADDRESS (ZERO IF FILE).
          L,U       A0,FCT.           GET FCT ADDRESS INTO A0.
          LMJ       X11,SDFIO$.       OPEN FILE.
          J         SDFIO$ERR.        ERROR RETURN.
          SZ        A5.               NORMAL RETURN.
          L,U       A0,'OPN'.
          S         A0,KEY.           INDICATE WORK OPEN.
SDFIO$ERR L         A0,A5.            GET STATUS.
EXITO     L         X11,SAVX11.       RECOVER X11.
          L         X1,SAVX1.         RECOVER X1.
          J         RETO.             RETURN.
NOFILE    L,U       A2,3.
          S         A0,R2.            STORE CSF$ STATUS.
PFS$ERR   L,U       A0,32,A2.         SHIFT PFS$ ERROR CODES.
          S         R2,FCT+2.         WORK(3) = ASSIGN STATUS OR ZERO.
          J         EXITO.
/.        S = EORSRR (WORK,IMAGE,MAXLEN,ICW)
.
$(1),EORSRR*.
 DO 1-FTN , SZ      A3.               FOR ADDR=IND.
 DO FTN   , L       A3,A0.            GET ADDRESS OF CALLING SEQUENCE.
          L         A0,WORK.          GET FCT ADDRESS.
          S         X1,SAVX1**NX,A0.  SAVE X1.
          S         A0,X1.            PUT FCT ADDRESS IN X1.
          S         X11,SAVX11.       SAVE X11.
 DO FTN   , S       A3,SAVA3.         MUST SAVE A3 TO STORE ICW AFTER SAVING X11
          L,H2      A1,KEY.           IS FILE OPEN?
          TE,U      A1,'OPN'.
          J         EORSR$NOT.        JUMP IF NOT OPEN.
          L         A1,IMAGE.
          S,H2      A1,FCT+8.         STORE IMAGE ADDRESS.
 DO 1-FTN , L       A1,MAXLEN.        GET MAXIMUM IMAGE LENGTH.
 DO FTN   , L       A1,MAXLEN.        GET ADDRESS OF MAXIMUM IMAGE LENGTH.
 DO FTN   , L       A1,0,A1.          GET MAXIMUM IMAGE LENGTH.
          S,H2      A1,FCT+7.         STORE MAXIMUM IMAGE LENGTH.
          LMJ       X11,SDFI$.        READ (NOTE A0 = FCT ADDRESS).
          J         SDFI$ERR.         ERROR.
          J         SDFI$EOF.         EOF.
          L         A1,FCT+10.        GET ICW.
          SZ        A0.               NORMAL RETURN IF STATUS = 0.
          J         EXITR.
EORSR$NOT L,U       A0,36.            NOT OPEN.
          J         EXITR.
SDFI$EOF  L,U       A5,37.            STATUS CODE FOR EOF.
SDFI$ERR  L         A0,A5.            GET STATUS FROM SDFI.
EXITR     L         X11,SAVX11.       RECOVER X11.
 DO 1-FTN , SZ      A3.               FOR ADDR=IND.
 DO 1-FTN , S       A1,ICW.           STORE ICW.
 DO FTN   , L       A3,SAVA3.         RECOVER CALLING SEQUENCE ADDRESS.
 DO FTN   , L       A2,ICW.           GET ICW ADDRESS.
 DO FTN   , S       A1,0,A2.          STORE ICW.
          DSL       A1,30.
          SSL       A2,6.
          TE,U      A1,042.           ASCII/FD SWITCH?
          TNE,U     A1,050.           LABEL?
          S         A2,ASCFD.         YES, REMEMBER ASCII/FD CODE.
          L         X1,SAVX1.         RECOVER X1.
          J         RETR.             RETURN.
/.        CALL EORSRC (WORK)
.
$(1),EORSRC*.
 DO 1-FTN , SZ      A3.               FOR ADDR=IND.
 DO FTN   , L       A3,A0.            GET ADDRESS OF CALLING SEQUENCE.
          L         A0,WORK.          GET FCT ADDRESS.
          S         X1,SAVX1**NX,A0.  SAVE X1.
          S         A0,X1.            PUT FCT ADDRESS IN X1.
          L,H2      A1,KEY.
          TE,U      A1,'OPN'.         IS FILE OPEN?
          J         EXITC.            NO, SIMPLY EXIT.
          SZ        KEY.
          S         X11,SAVX11.       SAVE X11.
          LMJ       X11,SDFIC$.       CLOSE SDF I/O.
          L         X11,SAVX11.       RECOVER X11.
EXITC     L         X1,SAVX1.         RECOVER X1.
          J         RETC.             RETURN.
          END.
@HDG,P EORSW/1100
@MASM,SI EORSW/1100,,,FTN
/.
.         WRITE ELEMENTS OR SDF FILES.
.
.         S = EORSWO (WORK,ELT,VER) OPENS AN ELEMENT OR SDF FILE.
.           THE FIRST TWO WORDS OF WORK MUST BE THE FILENAME.
.           ELT DETERMINES WHETHER A FILE OR ELEMENT IS TO BE WRITTEN.
.             IF THE SECOND WORD OF ELT = ZERO, THE FIRST WORD IS THE STARTING
.             SECTOR ADDRESS OF THE FILE TO BE WRITTEN, WORK MUST BE 466
.             WORDS, AND VER IS IGNORED.  IF THE SECOND WORD OF ELT IS NOT ZERO,
.             AN ELEMENT IS TO BE WRITTEN, THE ELEMENT NAME IS CONTAINED IN THE
.             TWO WORDS OF ELT, AND WORK MUST BE 474 WORDS.
.           S IS THE STATUS (DECIMAL):
.             00 = NORMAL COMPLETION,
.             1 - 32 = I/O ERROR,
.             33 = ELEMENT NOT FOUND,
.             34 = EXEC I/O ERROR,
.             35 = FILE NOT ASSIGNABLE, IN WHICH CASE WORK(3) CONTAINS
.                  THE @ASG STATUS, OR ELT NOT = ZERO AND THE FILE IS
.                  NOT A PROGRAM FILE, IN WHICH CASE WORK(3) = 0.
.             37 = PROGRAM FILE OVERFLOW.
.           IF THE FILE IS NOT ASSIGNED, IT WILL BE ASSIGNED WITH NO OPTIONS.
.
.         S = EORSWW (WORK,IMAGE,ICW) WRITES SDF FILE OR ELEMENT.
.           WORK IS AS FOR EORSWO (MUST NOT BE CHANGED BY USER),
.           IMAGE IS THE LOCATION OF THE IMAGE TO BE WRITTEN,
.           ICW IS THE SDF IMAGE CONTROL WORD (SEE PRM VOLUME 3).
.           S IS AS FOR EORSWO, PLUS ONE MORE POSSIBLE VALUE:
.             36 = FILE OR ELEMENT NOT OPENED,
.
.         S = EORSWC (WORK,CYCLIM,HICYCLE,NCYCLE) STOPS ANYNCHRONOUS I/O AND
.           RELEASES THE ASSOCIATION OF WORK AND THE FILE OR ELEMENT.
.           CYCLIM IS THE MAXIMUM NUMBER OF CYCLES TO BE RETAINED FOR THE
.             ELEMENT OR FILE.  IT SHOULD BE AT LEAST 1 PLUS THE DIFFERENCE
.             BETWEEN THE LARGEST AND SMALLEST VALUES SUPPLIED IN S4 AND S6
.             OF ANY ICW.  IF ZERO HAS BEEN USED FOR THOSE FIELDS, A DEFAULT
.             OF 5 IS RECOMMENDED FOR CYCLIM.
.           HICYCL IS THE MAXIMUM VALUE SUPPLIED IN S4 OR S6 OF ANY ICW.  IF
.             EVERY ICW CONTAINED ZERO IN THESE FIELDS, A DEFAULT VALUE OF
.             ZERO IS RECOMMENDED.
.           NCYCLE IS THE NUMBER OF CYCLES THE USER CLAIMS ARE CONTAINED IN
.             THE ELEMENT OR FILE WRITTEN.  THIS IS THE MINIMUM VALUE THE
.             USER COULD HAVE SPECIFIED FOR CYCLIM.  IF S4 AND S6 OF EVERY
.             ICW WRITTEN CONTAINED ZERO, A DEFAULT VALUE OF 1 IS RECOMMENDED.
.           S IS AS FOR EORSWW.
.
.         IF YOU WANT TO CHANGE THE ELEMENT TYPE, IT IS IN S3 OF WORK(468).
.         IF YOU WANT TO CHANGE THE ELEMENT SUBTYPE, IT IS IN S1 OF WORK(472).
.         IF YOU WANT TO CHANGE THE DATE OF CREATION, IT IS IN WORK(474),
.           THE FORMAT IS AS FROM TDATE$ SHIFTED CIRCURLARLY 18 BITS.
.         THE DEFAULT ELEMENT TYPE IS SYMBOLIC, THE DEFAULT ELEMENT SUBTYPE
.         IS UNTYPED, THE DEFAULT DATE AND TIME IS THE CURRENT DATE AND TIME.
.         CHANGES MUST BE MADE BETWEEN CALLING EORSWO AND EORSWC.
/.        DEFINITIONS.
          AXR$.                       REGISTERS, ETC.
FTN       EQU       $SS($PAR(4),1,3)='FTN'. 1 = FTN LINKAGE, 0 = FOR LINKAGE.
BANKWL    EQU       224.              WORD LENGTH OF I/O BUFFERS.
BANKSL    EQU       BANKWL//28.       SECTOR LENGTH OF I/O BUFFERS.
NX        EQUF      *0177777,*0,017.  REMOVE X REG FROM EQUFS.
.         WORK AREA
FCT       EQUF      0,X1.             SDFO WORK AREA.
EQCODE    EQUF      FCT+6,,S1.        EQUIPMENT CODE FROM FACIL$.
KEY       EQU       FCT+11.           OPEN FILE INDICATOR.
FILELT    EQUF      KEY,,S1.          0=FILE, 1=ELT.
ASCFD     EQUF      KEY,,S2.          ASCII/FD CODE
SAVX1     EQU       KEY+1.            SAVE AREA FOR X1.
SAVX11    EQU       SAVX1+1.          SAVE AREA FOR X11.
 DO FTN ,SAVA3 EQUF SAVX1+1,,H1.      SAVE AREA FOR A3.
BANK1     EQU       SAVX11+1.         FIRST I/O BUFFER.
BANK2     EQU       BANK1+BANKWL.     SECOND I/O BUFFER
ETABLE    EQU       BANK2+BANKWL.     ELEMENT TABLE IF NEEDED
ETFILE    EQU       ETABLE.           ELEMENT FILE NAME.
ETELT     EQU       ETABLE+2.         ELEMENT NAME.
ETVER     EQU       ETABLE+6.         VERSION NAME.
ETETYP    EQUF      ETABLE+5,,H1.     ELEMENT TYPE.
ETCYCL    EQU       ETABLE+8.
ETELEN    EQUF      ETABLE+9,,H2.     ELEMENT LENGTH.
ETELOC    EQU       ETABLE+10.        SECTOR LOCATION OF ELEMENT.
ETEDAT    EQU       ETABLE+11.        TIME AND DATE.
.         CALLING SEQUENCE PARAMETERS.
          ON        1-FTN.            ASSEMBLE IF FTN=0.
WORK      EQUF      *0,X11,U.         FCT ADDRESS.
ELT       EQUF      *1,X11.           FIRST WORD OF ELEMENT.
VER       EQUF      *2,X11.           VERSION NAME.
IMAGE     EQUF      *1,X11,U.         ADDRESS OF IMAGE.
ICW       EQUF      *2,X11.           IMAGE CONTROL WORD.
CYCLIM    EQUF      *1,X11.           CYCLE LIMIT.
HICYCL    EQUF      *2,X11.           HIGHEST CYCLE NUMBER.
NCYCLE    EQUF      *3,X11.           NUMBER OF CYCLES.
          OFF.
          ON        FTN.              ASSEMBLE IF FTN=1.
WORK      EQUF      0,A3,H2.          FCT ADDRESS.
ELT       EQUF      1,A3,H2.          FIRST WORD OF ELEMENT NAME.
VER       EQUF      2,A3,H2.          FIRST WORD OF VERSION
IMAGE     EQUF      1,A3,H2.          ADDRESS OF IMAGE.
ICW       EQUF      2,A3,H2.          IMAGE CONTROL WORD.
CYCLIM    EQUF      1,A3,H2.          CYCLE LIMIT.
HICYCL    EQUF      2,A3,H2.          HIGHEST CYCLE NUMBER.
NCYCLE    EQUF      3,A3,H2.          NUMBER OF CYCLES.
          OFF.
.         RETURNS
RETO      EQUF      4*(1-FTN),X11.    RETURN FROM EORSWO.
RETW      EQUF      4*(1-FTN),X11.    RETURN FROM EORSWW.
RETC      EQUF      5*(1-FTN),X11.    RETURN FROM EORSWC.
.
/.        S = EORSWO (WORK,ELT,VER)
.
$(1),EORSWO*.
 DO 1-FTN , SZ      A3.               FOR ADDR=IND.
 DO FTN   , L       A3,A0.            GET CALLING SEQUENCE ADDRESS.
          L         A0,WORK.          ADDR OF FCT.
          S         X1,SAVX1**NX,A0.  SAVE X1.
          S         A0,X1.            SETUP FCT POINTER.
          S         X11,SAVX11.       SAVE X11.
          ER        FACIL$.           IS FILE OPEN?
          L         A1,EQCODE.
          JNZ       A1,FILASGD.       JUMP IF FILE ASG'D.
          L         A0,('@ASG  ').
          S         A0,ETFILE-1.
          DL        A0,FCT.
          DS        A0,ETFILE.        BUILD '@ASG  FILE'
          L,U       A0,ETFILE-1.
          LXI,U     A0,3.
          ER        CSF$.             ASSIGN FILE, IGNORE STATUS.
          JN        A0,NOFILE.        ERROR EXIT.
FILASGD   SZ        R2.               SIMULATE GOOD CSF$ STATUS.
          L,U       A0,W$.            SETUP I/O PACKET FOR SDFO.
          S,S2      A0,FCT+3.         FUNCTION CODE = R$.
          SZ,S1     FCT+3.            STATUS (T2 WOULD BE PSR SENSITIVE).
          L,U       A0,BANKWL.        I/O BUFFER WORD LENGTH.
          S,H1      A0,FCT+4.
          L,U       A0,BANK2.
          LXI,U     A0,BANK1.
          S         A0,FCT+6.         I/O BUFFER ADDRESSES.
          L,U       A0,BANKSL.        I/O BUFFER SECTOR LENGTH.
          S,H1      A0,FCT+7.
          L,U       A0,1.
          S,H1      A0,FCT+8.         INCREMENTORS FOR BT IN SDFO.
          S,H1      A0,FCT+9.
          SZ        KEY.              CLEAR OPEN, TYPE.
 DO 1-FTN , DL      A1,ELT.           GET ELEMENT NAME.
 DO FTN   , L       A1,ELT.           GET ADDRESS OF ELEMENT NAME.
 DO FTN   , DL      A1,0,A1.          GET ELEMENT NAME.
.         SETUP PFWL$ PACKET.
          DS        A1,ETELT.         STORE ELEMENT NAME.
          JZ        A2,NOELT.         JUMP IF SDF FILE DESIRED.
 DO 1-FTN , DL      A0,VER.           GET VERSION.
 DO FTN   , L       A0,VER.           GET ADDRESS OF VERSION.
 DO FTN   , DL      A0,0,A0.          GET VERSION.
          DS        A0,ETVER.         STORE ELEMENT VERSION.
          DL        A0,FCT.
          DS        A0,ETFILE.        STORE FILE NAME.
          L,U       A0,ETABLE.        ADDRESS OF PFWL$ PACKET.
          ER        PFWL$.            GET WRITE LOCATION.
          JNZ       A2,PFWL$ERR.      JUMP IF ERROR.
          L,U       A0,1.
          S         A0,ETETYP.        STORE ELEMENT TYPE=SYMBOLIC.
          S         A0,FILELT.        INDICATE ELT.
          SZ        ETEDAT.           USE CURRENT DATE AND TIME.
          SZ        ETELEN.           LENGTH IS ZERO NOW.
          S         A1,ETELOC.        STORE WRITE LOCATION IN ELT PKT.
NOELT     S         A1,FCT+5.         SECTOR ADDRESS (ZERO IF FILE).
          L,U       A0,FCT.           GET FCT ADDRESS INTO A0.
          LMJ       X11,SDFOO$.       OPEN FILE.
          L,U       A0,'OPN'.
          S         A0,KEY.           INDICATE WORK OPEN.
          SZ        A0.               INDICATE NORMAL STATUS.
EXITO     L         X11,SAVX11.       RECOVER X11.
          L         X1,SAVX1.         RECOVER X1.
          J         RETO.             RETURN.
NOFILE    L,U       A2,3.             GENERATE ERROR 35.
          S         A0,R2.            SAVE CSF$ STATUS.
PFWL$ERR  L,U       A0,32,A2.         SHIFT PFWL$ ERROR CODES.
          S         R2,FCT+2.         STORE @ASG STATUS IN WORK(3).
          J         EXITO.
/.        S = EORSWW (WORK,IMAGE,ICW)
.
$(1),EORSWW*.
 DO 1-FTN , SZ      A3.               FOR ADDR=IND.
 DO FTN   , L       A3,A0.            GET CALLING SEQUENCE ADDRESS.
          L         A0,WORK.          GET FCT ADDRESS.
          S         X1,SAVX1**NX,A0.  SAVE X1.
          S         A0,X1.            PUT FCT ADDRESS IN X1.
          S         X11,SAVX11.       SAVE X11.
          L,H2      A1,KEY.           IS FILE OPEN?
          TE,U      A1,'OPN'.
          J         EORSW$NOT.        JUMP IF NOT OPEN.
          L         A1,IMAGE.
          S,H2      A1,FCT+8.         STORE IMAGE ADDRESS.
          L         A1,ICW.
 DO FTN   , L       A1,0,A1.
          S         A1,FCT+10.        STORE ICW.
          DSL       A1,30.
          SSL       A2,6.
          TE,U      A1,042.           ASCII/FD SWITCH?
          TNE,U     A1,050.           LABEL?
          S         A2,ASCFD.         YES, REMEMBER ASCII/FD CODE.
          LMJ       X11,SDFO$.        WRITE (NOTE A0 = FCT ADDRESS).
          J         SDFO$ERR.         ERROR.
          SZ        A0.               CLEAR ERROR STATUS.
          J         EXITW.
EORSW$NOT L,U       A5,36.            NOT OPEN.
SDFO$ERR  L         A0,A5.            GET STATUS FROM SDFO.
EXITW     L         X11,SAVX11.       RECOVER X11.
          L         X1,SAVX1.         RECOVER X1.
          J         RETW.             RETURN.
/.        S = EORSWC (WORK,CYCLIM,HICYCL,NCYCLE)
.
$(1),EORSWC*.
 DO 1-FTN , SZ      A3.               FOR ADDR=IND.
 DO FTN   , L       A3,A0.            GET CALLING SEQUENCE ADDRESS.
          L         A0,WORK.          GET FCT ADDRESS.
          S         X1,SAVX1**NX,A0.  SAVE X1.
          S         A0,X1.            PUT FCT ADDRESS IN X1.
          S         X11,SAVX11.       SAVE X11.
 DO FTN   , S       A3,SAVA3.         MUST SAVE A3 AFTER SAVING X11.
          L,H2      A1,KEY.
          SZ        KEY.              MARK WORK AREA CLOSED.
          TE,U      A1,'OPN'.         IS FILE OPEN?
          J         EORSWC$NOT.       NO, RETURN ERROR STATUS.
          LMJ       X11,SDFOC$.       CLOSE FILE / ELT
          J         SDFOC$ERR.        ERROR RETURN.
          TNZ       ETELT+1.          FILE OR ELEMENT?
          J         EORSWC$F.         FILE.
          L         A1,FCT+5.         GET NEXT SECTOR ADDRESS.
          ANU       A1,ETELOC.        COMPUTE ELEMENT LENGTH.
          SM        A2,ETELEN.        STORE IN ELT TABLE.
          L         X11,SAVX11.       RECOVER X11.
 DO 1-FTN , SZ      A3.               FOR ADDR=IND.
 DO FTN   , L       A3,SAVA3.         RECOVER CALLING SEQUENCE ADDRESS.
          L         A0,CYCLIM.        CYCLE LIMIT.
 DO FTN   , L       A0,0,A0.
          LSSL      A0,12.
 DO 1-FTN , A       A0,HICYCL.        HIGH CYCLE.
 DO FTN   , L       A2,HICYCL.        HIGH CYCLE ADDRESS.
 DO FTN   , A       A0,0,A2.          HIGH CYCLE.
          LSSL      A0,12.
 DO 1-FTN , A       A0,NCYCLE.        NUMBER OF CYCLES.
 DO FTN   , L       A2,NCYCLE.        ADDRESS OF NUMBER OF CYCLES.
 DO FTN   , A       A0,0,A2.          NUMBER OF CYCLES.
          S         A0,ETCYCL.        STORE CYCLE WORD.
          LN,U      A0,ETABLE.        A0 = - ELEMENT TABLE ADDRESS.
          ER        PFI$.             INSERT ELEMENT.
          L         A0,A2.            GET STATUS.
          JZ        A0,PFI$OK.        JUMP IF NO ERROR.
          L,U       A5,32,A2.         SHIFT STATUS CODES.
SDFOC$ERR L         A0,A5.            GET STATUS FROM PFI$ OR SDFOC$.
PFI$OK    L         X11,SAVX11.       RECOVER X11.
          L         X1,SAVX1.         RECOVER X1.
          J         RETC.             RETURN.
EORSWC$F  SZ        A0.               SET STATUS ZERO FOR FILE CLOSED OK.
          J         PFI$OK.
EORSWC$NOT L,U      A0,36.            USE S = 36 IF WORK NOT OPEN.
          J         PFI$OK.
          END.
@HDG,P EXCHAH
@FTN,SVI EXCHAH
      SUBROUTINE EXCHAH (RECORD,NCHAR)
C
C     CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO
C     HOLLERITH FORMAT.
C     THIS PROGRAM IS NOT MACHINE SENSITIVE.
C
C     RECORD IS THE RECORD TO BE CONVERTED.  THE HOLLERITH IS STORED
C     IN RECORD ALSO
      INTEGER RECORD(1)
C
C     NCHAR IS THE NUMBER OF CHARACTERS TO BE CONVERTED
C
      INTEGER XLATE(128)
      COMMON /EXCHXC/ XLATE
C
C
      DO 10 I=1,NCHAR
      J=RECORD(I)
10    RECORD(I)=XLATE(J+1)
      RETURN
      END
@HDG,P EXCHSL
@FTN,SVI EXCHSL
      SUBROUTINE EXCHSL
C
C     LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS.
C
C     EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE
C     SEGMENT.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      RETURN
      END
@HDG,P EXCHTR
@FTN,SVI EXCHTR
      SUBROUTINE EXCHTR (IBLOCK,OBLOCK)
C
C     TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER.
C
      INTEGER IBLOCK(1), OBLOCK(1)
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4.
C
      CALL EXCHFO (1)
      CALL EXCHFO (2)
      WORKF=-IABS(WORKF)
C
10    IF (TRANS.LE.0) RETURN
      CALL EXCHSL
C     LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS.
      GO TO (11,12,13,14,15,16,17,18,19), TRANS
C     COMMAND PARSER
11    CALL EXCHC1 (IBLOCK,OBLOCK)
      GO TO 10
C     IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE
12    CALL EXCHC2
      GO TO 10
C     OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE.
13    CALL EXCHC3 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE.
14    CALL EXCHC4 (IBLOCK)
      GO TO 10
C     COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE.
15    CALL EXCHC5 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY TEXT FROM INTAPE TO OUTAPE
16    CALL EXCHC6 (IBLOCK,OBLOCK)
      GO TO 10
C     TEXT COMMAND
17    CALL EXCHC7 (IBLOCK,OBLOCK)
      GO TO 10
C     ERROR MESSAGES
18    CALL EXCHC8
      GO TO 10
C     QUIT
19    CALL EXCHC9 (IBLOCK,OBLOCK)
      GO TO 10
      END
@HDG,P EXCHGB
@FTN,SVI EXCHGB
      SUBROUTINE EXCHGB (ISTAT,DBLOCK)
C
C     READ A BLOCK FROM THE EXCHANGE TAPE.
C     IGNORE THE ERROR CONTROL SEGMENT.
C     CHECK THE BLOCK SEQUENCE NUMBER.
C     CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER,
C               OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
C
C     READ A BLOCK FROM INTAPE.
C
      BLKSQI=BLKSQI+1
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 160
C
C     GET INFORMATION OUT OF THE BLOCK HEADER.
C
      CCDBI=NERRCI
      CWDBI=NWCBI*(CCDBI/NCCBI)+1
      CPCBI=MOD(CCDBI,NCCBI)
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
      DO 110 JUMP=1,9
      CCDBI=CCDBI+1
      CPCBI=CPCBI+1
      IF (CCDBI.GT.NCDBI) GO TO 130
      IF (CPCBI.LE.NCCBI) GO TO 10
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
10    GO TO (20,30,40,50,60,70,80,90,100), JUMP
20    NEWBLK=256*CBLCKI(CPCBI)
      GO TO 110
30    NEWBLK=NEWBLK+CBLCKI(CPCBI)
      GO TO 110
40    LASTI=CBLCKI(CPCBI)
      GO TO 110
50    L1PRGI=256*CBLCKI(CPCBI)
      GO TO 110
60    L1PRGI=L1PRGI+CBLCKI(CPCBI)
      GO TO 110
70    N1RECI=256*CBLCKI(CPCBI)
      GO TO 110
80    N1RECI=N1RECI+CBLCKI(CPCBI)
      GO TO 110
90    L1RECI=256*CBLCKI(CPCBI)
      GO TO 110
100   L1RECI=L1RECI+CBLCKI(CPCBI)
110   CONTINUE
C
C     CHECK THE BLOCK SEQUENCE NUMBER.
C
      IF (BLKSQI.EQ.NEWBLK) GO TO 150
      ISTAT=1
      WRITE (PRINTR,120) NEWBLK,BLKSQI
120   FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I
     15//)
      BLKSQI=NEWBLK
      GO TO 160
C
C     FORMAT ERROR
C
130   ISTAT=2
      GO TO 160
C
C     CHECK L1PRGI AND L1RECI.
C
150   IF (L1PRGI.GT.NCDBI) GO TO 130
      IF (L1RECI.GT.NCDBI) GO TO 130
      ISTAT=0
160   RETURN
C
      END
@HDG,P EXCHGR
@FTN,SVI EXCHGR
      SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD)
C
C     GET A RECORD FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK).
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE
C               SPACE ALLOWED BY THE USER.  (POSITION IS STILL OK).
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C     THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM
C     CONTROL RECORDS.  NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS.
C
      ISTAT=0
      NCHACT=0
10    JUMP=1
      GO TO 260
20    NG=CBLCKI(CPCBI)
      IF (NG.EQ.0) GO TO 90
      IF (NG.NE.255) GO TO 30
C
C     END OF SHORT TAPE BLOCK.
C
      CCDBI=NCDBI
      GO TO 10
C
C     UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO
C     THE USER RECORD AREA.
C
30    ITYPEI=0
      IF (MODEI.EQ.0) GO TO 40
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG
40    IG=0
50    JUMP=2
      GO TO 260
60    NR=CBLCKI(CPCBI)
      IF (MODEI.EQ.0) GO TO 70
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR
      GO TO 160
70    IR=0
C     PUT REMVI INTO THE USER RECORD NR TIMES.
80    IF (IR.GE.NR) GO TO 160
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI
      IR=IR+1
      GO TO 80
C
C     THE NEXT RECORD IS A CONTROL RECORD.  FIND OUT WHAT KIND.
C
90    JUMP=3
      GO TO 260
100   ITYPEI=CBLCKI(CPCBI)
      IF (ITYPEI.LT.65) GO TO 250
C     65 = ASCII  A
      IF (ITYPEI.GT.90) GO TO 250
C     90 = ASCII  Z
      I=ITYPEI-64
C             A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
      GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160
     1,110,160,220,160,160,160,160,160,160,160,160), I
C       P   Q   R   S   T   U   V   W   X   Y   Z
C
C     P - PROGRAM HEADER
C
C     CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER
110   REMVI=32
C     RESET THE REMOVED CHARACTER TO ASCII BLANK.
      JUMP=4
      GO TO 260
120   L1PRGI=256*CBLCKI(CPCBI)
      JUMP=5
      GO TO 260
130   L1PRGI=L1PRGI+CBLCKI(CPCBI)
      JUMP=6
      GO TO 260
140   N1RECI=256*CBLCKI(CPCBI)
      JUMP=7
      GO TO 260
150   N1RECI=N1RECI+CBLCKI(CPCBI)
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
160   JUMP=8
      GO TO 260
170   NC=CBLCKI(CPCBI)
      IF (ITYPEI.NE.0) GO TO 180
      IF (MODEI.EQ.0) GO TO 180
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC
C     COPY NC CHARACTERS TO THE USER RECORD AREA.
180   IC=0
      JUMP=9
190   IF (IC.GE.NC) IF (ITYPEI) 240,210,240
      GO TO 260
200   NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI)
      IC=IC+1
      GO TO 190
210   IG=IG+1
      IF (IG-NG) 50,240,240
C
C     J - UPDATING AND END OF INPUT TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
220   JUMP=10
      GO TO 260
230   RECORD(1)=CBLCKI(CPCBI)
      NCHACT=1
      IF (ITYPEI.EQ.82) REMVI=RECORD(1)
C     82 = ASCII R
C
C     RETURN TO THE USER PROGRAM.
C
240   IF (NCHACT.GT.NCHMAX) ISTAT=4
      GO TO 290
C
C     CONTROL RECORD TYPE CANNOT BE DETERMINED.
C
250   ISTAT=5
      GO TO 290
C
C     GET A CHARACTER FROM CBLOCK.  UNPACK A NEW BLOCK IF NECESSARY.
C     READ MORE TAPE IF NECESSARY.
C
260   CPCBI=CPCBI+1
      CCDBI=CCDBI+1
      IF (CCDBI.LE.NCDBI) GO TO 270
      CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 290,260,290
270   IF (CPCBI.LE.NCCBI) GO TO 280
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
280   GO TO (20,60,100,120,130,140,150,170,200,230), JUMP
290   RETURN
C
      END
@HDG,P EXCHNP
@FTN,SVI EXCHNP
      SUBROUTINE EXCHNP (ISTAT,DBLOCK)
C
C     SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE
C     TAPE.
C     THIS MODULE IS MACHINE INSENSITIVE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
      ISTAT=0
      IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20
C
C     CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK.
C
10    IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20
C     76 = ASCII L
C
C     NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK.
      CCDBI=L1PRGI-1
      I=NWCBI*(CCDBI/NCCBI)+1
      IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI)
      CWDBI=I
      CPCBI=MOD(CCDBI,NCCBI)
      GO TO 40
C
C     NO MORE HEADERS IN THIS BLOCK.
C
20    CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 40,10,40
C
C     END OF FILE.
C
30    ISTAT=7
C
40    RETURN
C
      END
@HDG,P EXCHPB
@FTN,SVI EXCHPB
      SUBROUTINE EXCHPB (ISTAT,DBLOCK)
C
C     WRITE A BLOCK ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C     WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK.
      INTEGER WORK(9)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
C     PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK.
C
      BLKSQO=BLKSQO+1
      WORK(1)=BLKSQO/256
      WORK(2)=MOD(BLKSQO,256)
      WORK(3)=LASTO
      WORK(4)=L1PRGO/256
      WORK(5)=MOD(L1PRGO,256)
      WORK(6)=N1RECO/256
      WORK(7)=MOD(N1RECO,256)
      WORK(8)=L1RECO/256
      WORK(9)=MOD(L1RECO,256)
C
      CPCBO=MOD(NERRCO,NCCBO)
      CWDBO=(NERRCO/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
C
      DO 10 I=1,9
      CPCBO=CPCBO+1
      IF (CPCBO.LE.NCCBO) GO TO 10
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
      CWDBO=CWDBO+NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
      CPCBO=1
10    CBLCKO(CPCBO)=WORK(I)
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
C
C     WRITE THE DATA BLOCK ON TAPE.
C
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L).
C
      IF (LASTO.NE.76) GO TO 20
      ISTAT=3
      CALL EXCHWT (ISTAT,DBLOCK)
      GO TO 30
C
C     COMPUTE POINTERS FOR NEXT BLOCK OUT.
C
20    L1PRGO=0
      LLPRGO=0
      N1RECO=0
      L1RECO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
C
30    RETURN
C
      END
@HDG,P EXCHPR
@FTN,SVI EXCHPR
      SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD)
C
C     WRITE A RECORD ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A
C             TEXT RECORD CONTAINS MORE THAN 254 GROUPS.
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER GC,RC(255),CC(255)
C     GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      ISTAT=0
      INCHAR=0
C
C     DETERMINE THE RECORD TYPE.
C
      IF (NCHOUT.NE.255) GO TO 10
      ITYPEO=255
      GO TO 70
10    IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO
      IF (ITYPEO.NE.0) GO TO 30
C
C     DATA RECORD.
C
      IF (MODEO.NE.0) GO TO 170
C     COMPRESS THE RECORD.
      CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255)
      IF (GC.GE.255) GO TO 210
      IG=0
C     OUTPUT THE GROUP COUNT.
      CBLCKO(CPCBO)=GC
      JUMP=1
      GO TO 230
20    IG=IG+1
      IF (IG.GT.GC) GO TO 250
      NC=CC(IG)
      INCHAR=INCHAR+RC(IG)
C     OUTPUT REMOVED CHARACTER COUNT.
      CBLCKO(CPCBO)=RC(IG)
      JUMP=2
      GO TO 230
C
C     THE USER SAYS HE HAS A CONTROL RECORD TO WRITE.  FIND OUT
C     WHAT KIND.
C
30    IF (ITYPEO.LT.65) GO TO 220
C     65 = ASCII A
      IF (ITYPEO.GT.90) GO TO 220
C     90 = ASCII  Z
      I=ITYPEO-64
C             A  B  C  D  E  F  G  H  I  J   K  L  M  N  O  P  Q  R   S
      GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40,
     140,40,40,40,40,40,40), I
C      T  U  V  W  X  Y  Z
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE TYPE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
40    IF (NCHOUT-255) 100,100,210
C
C     END OF FILE.
C
50    IF (NERRCO+NDATAO+7-CCDBO) 70,80,80
C
C     P - PROGRAM HEADER.
C
60    IF (NCHOUT.GT.255) GO TO 210
      REMVO=32
C     RESET REMOVED CHARACTER TO ASCII BLANK.
      IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80
      IF (CCDBO.EQ.NERRCO+10) GO TO 80
C
C     END OF SHORT TAPE BLOCK.
C
70    CBLCKO(CPCBO)=255
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250
C     69 = ASCII E
C     80 = ASCII P
      L1RECO=CCDBO-NERRCO
80    IF (LLPRGO.EQ.0) GO TO 90
C     LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK.
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      NC=MOD(LLPRGO+1,NCCBO)
      NW=((LLPRGO+1)/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      CBLCKO(NC+1)=CCDBO/256
      IF (NC+1.LT.NCCBO) GO TO 85
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      NW=NW+NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      NC=-1
85    CBLCKO(NC+2)=MOD(CCDBO,256)
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      CALL EXCHUN (DBLOCK(CWDBO),CBLCKO)
C     UPDATE TABLE OF CONTENTS POINTERS
90    LLPRGO=CCDBO
      IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO
      NLRECO=NLRECO+1
      IF (N1RECO.EQ.0) N1RECO=NLRECO
100   CBLCKO(CPCBO)=0
      JUMP=3
      GO TO 230
110   CBLCKO(CPCBO)=ITYPEO
      JUMP=4
      GO TO 230
120   IF (ITYPEO.NE.69) GO TO 130
C     69 = ASCII E
      LASTO=76
      GO TO 70
130   IF (ITYPEO.NE.80) GO TO 170
C     80 = ASCII P
      CBLCKO(CPCBO)=0
      JUMP=5
      GO TO 230
140   CBLCKO(CPCBO)=0
      JUMP=6
      GO TO 230
150   CBLCKO(CPCBO)=NLRECO/256
      JUMP=7
      GO TO 230
160   CBLCKO(CPCBO)=MOD(NLRECO,256)
      JUMP=8
      GO TO 230
C
170   NC=NCHOUT
180   CBLCKO(CPCBO)=NC
      IC=0
      JUMP=9
C     PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD.
      IF (ITYPEO.EQ.82) GO TO 190
      IF (ITYPEO.EQ.74) GO TO 190
      IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230
190   IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250
      INCHAR=INCHAR+1
      IC=IC+1
      CBLCKO(CPCBO)=RECORD(INCHAR)
      GO TO 230
C
C     J - UPDATING AND END OF TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
200   NCHOUT=1
      IF (ITYPEO.EQ.82) REMVO=RECORD(1)
C     82 = ASCII R
      GO TO 100
C
C     RECORD TOO LONG.
C
210   ISTAT=4
      GO TO 250
C
C     UNKNOWN CONTROL RECORD TYPE.
C
220   ISTAT=5
      GO TO 250
C
C     INCREMENT THE OUTPUT BUFFER POINTERS.  PACK A CHARACTER BLOCK
C     IF NECESSARY.  WRITE A TAPE BLOCK IF NECESSARY.
C
230   CPCBO=CPCBO+1
      CCDBO=CCDBO+1
      IF (CPCBO.LE.NCCBO) GO TO 240
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CWDBO=CWDBO+NWCBO
      CPCBO=1
      IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 250
240   GO TO (20,180,110,120,140,150,160,170,190), JUMP
250   RETURN
C
      END
@HDG,P EXCHSC
@FTN,SVI EXCHSC
      SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL)
C
C     SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE
C     DATA TO BE REMOVED.  DIVIDE DATA INTO GROUPS CONSISTING OF
C     STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT
C     DATA.  THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE
C     REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP
C     ARE RECORDED IN RC() AND SC() RESPECTIVELY.  MAXSL IS THE
C     MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC().
C
      INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL
C
C     RC AND SC MUST BE AT LEAST (IMGLEN-1)//3.
C
      GC=1
      SC(1)=0
      RC(1)=0
      MODE=-1
      INPLEN=IABS(IMGLEN)
C
C     IDENTIFY DATA GROUPS.
C
      DO 110 I=1,INPLEN
      IF (MODE) 40,60,90
C
C     MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE.
C
40    IF (INPIMG(I).EQ.REMOVE) GO TO 50
C     SWITCH TO SIGNIFICANT DATA SCAN.
      MODE=1
      SC(GC)=1
      GO TO 110
C     CONTINUE REMOVE SCAN
50    RC(GC)=RC(GC)+1
      IF (RC(GC)-MAXSL) 110,95,110
C
C     MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY
C     ONE OCCURRENCE OF REMOVE.  CHANGE TO REMOVE MODE IF ANOTHER REMOVE
C     OCCURS OR BACK TO DATA MODE IF NOT.
C
60    IF (INPIMG(I).EQ.REMOVE) GO TO 80
C     SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT.
      MODE=1
      IF (SC(GC).GE.MAXSL-2) GO TO 70
      SC(GC)=SC(GC)+2
      GO TO 110
C     FULL GROUP
70    GC=GC+1
      RC(GC)=1
      SC(GC)=1
      GO TO 110
C     SWITCH TO REMOVE MODE.
80    GC=GC+1
      SC(GC)=0
      RC(GC)=2
      MODE=-1
      GO TO 110
C
C     MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA.
C
90    IF (INPIMG(I).EQ.REMOVE) GO TO 100
      SC(GC)=SC(GC)+1
      IF (SC(GC).NE.MAXSL) GO TO 110
C     FULL GROUP
      MODE=-1
95    IF (I.GE.INPLEN) GO TO 120
      GC=GC+1
      RC(GC)=0
      SC(GC)=0
      GO TO 110
100   MODE=0
110   CONTINUE
120   RETURN
C
      END
@HDG,P EXCHTP
@FTN,SVI EXCHTP
      SUBROUTINE EXCHTP (RECORD,LINEI)
C
C     MATERIALIZE INCLUDES IF INALT IS NON-ZERO.
C     CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE
C     AND THE PRINTER IF LISTING IS REQUESTED.
C     LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C
      INTEGER RECORD(1),LINEI
C
C     *****     LOCAL VARIABLES     ************************************
C
C COPY    DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR
C         SKIPPING TEXT NOT TO BE INCLUDED.
      INTEGER COPY
C DASH    CONTAINS '-' IN HOLLERITH.
      INTEGER DASH
C ENDMRK  HOLDS THE END SENTINEL.
      INTEGER ENDMRK(40)
C NCHEND  IS THE NUMBER OF CHARACTERS IN ENDMRK.
      INTEGER NCHEND
C NCHSAV  SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD.
      INTEGER NCHSAV
C NCHTAR  IS THE NUMBER OF CHARACTERS IN TARGET.
      INTEGER NCHTAR
C STAR    CONTAINS '*' IN HOLLERITH.
       INTEGER STAR
C TARGET  IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY).
      INTEGER TARGET(40)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL DATA     ***************************************
C
      DATA DASH /1H-/, STAR /1H*/
C
C     *****     PROCEDURES     *****************************************
C
      LINEO=LINEO+1
      IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190
      RECORD(180)=LINEO
      RECORD(179)=LINEI
      COPY=-1
C     COPY=-1 MEANS NOT COPYING INCLUDED TEXT.
      IF (ITYPEO.EQ.0) GO TO 110
C     PROCESS INCLUDE RECORD.
      DO 10 I=1,NCHOUT
10    RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I)
C     INSERT '-I '.
      RECORD(1)=45
      RECORD(2)=73
      RECORD(3)=32
      NCHOUT=NCHOUT+3
      IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110
C     STORE SEARCH TARGET
      NCHTAR=MIN0(NCHOUT,40)
      DO 20 I=1,NCHTAR
20    TARGET(I)=RECORD(I)
C     STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
      NCHSAV=NCHCMD
      DO 30 I=1,NUMBER
30    OUTREC(I)=COMAND(I)
      COPY=0
C     COPY=0 MEANS SKIPPING MODULE ON INALT FILE.
      INALT=IABS(INALT)
      NEOF=0
40    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
      IF (NCHCMD.LT.2) GO TO 40
      IF (COMAND(1).NE.45) GO TO 40
C     45 = ASCII -
      IF (COMAND(2).EQ.45) GO TO 130
      IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40
C     73 = ASCII I, 105 = ASCII LOWER CASE I.
C     COMPARE IMAGE WITH SEARCH TARGET.
      IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60
      DO 50 I=2,NCHTAR
      K=COMAND(I)
      IF (K.GT.96 .AND. K.LT.123) K=K-32
      IF (TARGET(I).NE.K) GO TO 60
50    CONTINUE
      NEOF=3
C     PREVENT SEARCH LOOP.
      COPY=1
C     COPY=1 MEANS COPYING INCLUDED TEXT.
60    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     STORE END OF INCLUDE MODULE SIGNAL.
      NCHEND=MIN0(40,NCHCMD)
      DO 70 I=1,NCHEND
70    ENDMRK(I)=COMAND(I)
      IF (COPY.EQ.0) GO TO 80
      CHAR1L=DASH
      NCHOUT=NCHTAR
      DO 75 I = 1,NCHOUT
75    COMAND(I)=TARGET(I)
      COMAND(180)=LINEO
      COMAND(179)=LINEI
C     GO PRINT TARGET.
      CALL EXCHTW (COMAND,-1)
      GO TO 120
C     COPY OR SKIP UNTIL ENDMRK SEEN AGAIN.
80    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF.
C     TEST FOR ENDMRK
      DO 90 I=1,NCHEND
      IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100
90    CONTINUE
      IF (COPY) 140,40,140
C     OUTPUT TEXT RECORD.
100   COMAND(180)=LINEO
      COMAND(179)=LINEI
      NCHOUT=NCHCMD
      CALL EXCHTW (COMAND,OPTI)
      GO TO 120
C     OUTPUT TEXT RECORD.
110   CALL EXCHTW (RECORD,1)
120   IF (COPY) 190,190,80
C     WE ONLY GET HERE WITH COPY .GE. 0.
130   NEOF=NEOF+1
      ACTION=2
C     ACTION = 2 MEANS REOPEN INALT.
      CALL EXCHIM
      IF (NEOF.LT.2) GO TO 40
140   INALT=-IABS(INALT)
      NCHCMD=1
      IF (COPY.GT.0) GO TO 170
C     PROCESS TARGET AS THOUGH IT WERE TEXT.
      NCHOUT=NCHTAR
C     SAVE TARGET FOR ERROR MESSAGE.
      DO 150 I=1,NCHTAR
150   COMAND(I)=TARGET(I)
      CALL EXCHTW (COMAND,1)
      CALL EXCHAH (TARGET,NCHTAR)
      WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR)
160   FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8
     10A1))
      NERRS=MAX0(NERRS,3)
C
C     RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
C
170   NCHCMD=NCHSAV
      DO 180 I=1,NUMBER
180   COMAND(I)=OUTREC(I)
C
190   CHAR1L=STAR
      RETURN
C
      END
@HDG,P EXCHTW
@FTN,SVI EXCHTW
      SUBROUTINE EXCHTW (RECORD,OPTION)
C
C     WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING
C     EXCHOU.  WRITE RECORD ON THE PRINTER IF LISTING REQUESTED.
C     RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C     IF OPTION = ZERO, WRITE TO FILE ONLY.
C     IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING.
C     IF OPTION .LT. ZERO, WRITE TO LISTING ONLY.
C
      INTEGER RECORD(1),OPTION
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     PROCEDURES     *****************************************
C
      LINEI=RECORD(179)
      IF (OPTION.LT.0) GO TO 130
C
C     INSERT IDENTIFICATION IF REQUESTED.
C
      IF (IDCOL2.LT.IDCOL1) GO TO 120
      IF (IDTXTL+IDSTEP.EQ.0) GO TO 120
      IF (NCHOUT.GE.IDCOL2) GO TO 20
      J=IDCOL2-1
C     FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2
      DO 10 I=NCHOUT,J
10    RECORD(I+1)=32
C     32 = ASCII BLANK.
20    NCHOUT=MAX0(NCHOUT,IDCOL2)
      N=-1
      IF (LINEI.EQ.0) GO TO 40
      IF (IDOPTN.NE.73) GO TO 40
C     73 = ASCII I.  IDENTIFY ONLY FROM INTAPE.
      N=(LINEI-1)*IDSTEP+IDSTRT
      GO TO 70
40    IF (IDOPTN.NE.79) GO TO 50
C     79 = ASCII O.  IDENTIFY ONLY TO OUTAPE.
      N=(LINEO-1)*IDSTEP+IDSTRT
      GO TO 70
50    IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70
C     67 = ASCII C, 70 = ASCII F.  IDENTIFY EVERYTHING.
      N=IDCUR
70    IF (N.LT.0) GO TO 120
      IF (IDTXTL.EQ.0) GO TO 100
      J=MIN0(IDCOL2,IDTXTL+IDCOL1-1)
      K=1
      DO 80 I=IDCOL1,J
      RECORD(I)=IDTEXT(K)
80    K=K+1
100   IF (IDSTEP.EQ.0) GO TO 120
      IDCUR=IDCUR+IDSTEP
      K=IDCOL2
110   RECORD(K)=MOD(N,10)+48
      N=N/10
      K=K-1
      IF (N.EQ.0) GO TO 120
      IF (K.GE.IDCOL1) GO TO 110
C
C     OUTPUT RECORD.
C
120   IF (OUFILE.NE.0) CALL EXCHOU (RECORD)
      IF (OPTION.EQ.0) GO TO 220
130   IF (OPTL.NE.0) GO TO 140
      IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220
140   CALL EXCHAH (RECORD,NCHOUT)
      IF (OPTV+VERT.NE.0) GO TO 200
      IF (PHASE.NE.8) GO TO 180
      IF (LINEI.EQ.0) GO TO 160
      WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
150   FORMAT (1X,2I5,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
160   WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
170   FORMAT (5H  NEW,I6,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
180   WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
190   FORMAT (1X,I5,A1,3X,110A1/(6H  CONT,4X,110A1))
      GO TO 220
200   WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT)
210   FORMAT (132A1)
220   RETURN
C
      END
@HDG,P EXCHC1
@FTN,SVI EXCHC1
      SUBROUTINE EXCHC1 (IBLOCK,OBLOCK)
C
C     COMMAND DECODER AND FORMAT VERIFIER.  SOME COMMANDS ARE ALSO
C     COMPLETELY PROCESSED HERE.
C
C     IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS.
C
      INTEGER IBLOCK(1),OBLOCK(1)
C
C
C     *****     LOCAL VARIABLES     ************************************
C
C ALLOW   TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED.  VALUES ARE
C         SUMS OF PERMITTED VALUES OF PHASE.
C         1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING,
C         8 = UPDATING.
C         ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A
C         PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR
C         MAY BE VOID (EQUAL SIGN IS LAST CHARACTER).
C         32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT.
      INTEGER ALLOW(35)
C BLANK   A CONSTANT.  1H .
      INTEGER BLANK
C DATE    IS THE DATE FROM UPDA=, DATE=, ORIG=.
      INTEGER DATE(3)
C DAYS    TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS.
      INTEGER DAYS(12)
C I       IS USED FREELY AS AN INDEX.
C J       IS USED FREELY AS AN INDEX.
C JUMP    USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE.
C K       IS USED FREELY AS AN INDEX.
C KDATE   IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD).
C KQUIT   IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD).
C KTEXT   IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD).
C N       IS USED FREELY AS AN INDEX.
C NCNREC  IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS.
C ND      IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER.
C NM      IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER.
C NY      IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER.
C TVAL    A VECTOR OF VALUES FOR TRANS.  INDEXED BY ICOMD.
      INTEGER TVAL(35)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL EQUIVALENCE     **********************************
C
      EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND)
C
C     *****     DATA STATEMENTS     ************************************
C
      DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/
      DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/
      DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/
      DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/
      DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/
      DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/
      DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/
      DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/
      DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/
      DATA BLANK /1H /
      DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/
      DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/
      DATA DAYS(11),DAYS(12) /30,31/
      DATA KDATE /5/
      DATA KQUIT /20/
      DATA KTEXT /27/
      DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/
      DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/
      DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/
      DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/
      DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/
      DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/
      DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/
C
C     *****     PROCEDURES     *****************************************
C
C     GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER.
C     ECHO IT IF THE E OPTION IS SET.  DETERMINE WHETHER IT IS A CHANGE
C     TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND.
C
10    NCNREC=0
20    ACTION=0
      IF (NCHCMD.LT.0) GO TO 220
      CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (OPTE.EQ.0) GO TO 27
      WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD)
23    FORMAT (1X,80A1)
      CHAR1L=0
27    NCHCMD=MIN0(NCHCMD,MARGIN)
      IF (PHASE.LT.4) SIGNAL=45
C     45 = ASCII -
      IF (COMAND(1).NE.45) GO TO 50
C     45 = ASCII -.  REQUEST TO CHANGE CONTROL RECORD.
      IF (PHASE.LT.4) GO TO 40
      WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD)
30    FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT
     1OR UPDATE/1X,80A1)
      NERRG=MAX0(NERRG,2)
      GO TO 200
40    ICOMD=0
      EQUAL=2
      TRANS=3
      GO TO 370
50    IF (COMAND(1).NE.42) GO TO 70
C     42 = ASCII *.  COMMENT RECORD.  JUST ECHO IT.
      NCHCMD=MAX0(NCHCMD,2)
      WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD)
60    FORMAT (A1,1H*,78A1/(1X,80A1))
      GO TO 10
C
C     SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR
C     EQUAL SIGN ARE FOUND.  LOOK UP THE WORD IN THE COMMAND NAME TABLE.
C
70    EQUAL=0
      DO 80 I=1,NCHCMD
      IF (COMAND(I).EQ.32) GO TO 80
C     32 = ASCII BLANK
      EQUAL=EQUAL+1
      ICOMD=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32
C     ABOVE STATEMENT CONVERTS TO UPPER CASE.
      COMAND(I)=32
      COMAND(EQUAL)=ICOMD
      IF (EQUAL.GE.4) GO TO 90
      IF (ICOMD.EQ.61) GO TO 90
C     61 = ASCII =.
      IF (ICOMD.EQ.44) GO TO 90
C     44 = ASCII ,.
80    CONTINUE
      IF (EQUAL.EQ.0) GO TO 185
90    DO 110 ICOMD=1,NCOMDT
      DO 100 K=1,EQUAL
      IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110
100   CONTINUE
      IF (EQUAL.EQ.4) GO TO 130
      IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130
C     32 = ASCII BLANK.
110   CONTINUE
C
C     UNRECOGNIZED COMMAND.
C
120   ICOMD=0
C
C     LOOK FOR AN EQUAL SIGN.  SET THE VARIABLE NAMED EQUAL TO ZERO IF
C     THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK
C     CHARACTER FOLLOWING THE EQUAL SIGN.
C
130   MODIFY=0
140   DO 150 I=EQUAL,NCHCMD
      K=COMAND(I)
      IF (K.EQ.61) GO TO 160
C     61 = ASCII =.
      IF (MODIFY.NE.0) GO TO 150
C     USE FIRST MODIFIER.
      IF (K.EQ.44) GO TO 160
C     44 = ASCII ,.
150   CONTINUE
      EQUAL=0
      GO TO 170
160   I=I+1
      EQUAL=I
      IF (I.GT.NCHCMD) GO TO 170
      IF (COMAND(I).EQ.32) GO TO 160
C     32 = ASCII BLANK
      IF (K.NE.44) GO TO 170
C     44 = ASCII ,.
      MODIFY=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32
C     CONVERT TO UPPER CASE.
      GO TO 140
170   IF (K.NE.61) EQUAL=0
C     61 = ASCII =.
      IF (ICOMD.EQ.0) GO TO 180
      IF (ICOMD.GT.NCOMDP) GO TO 180
      IF (EQUAL.GT.NCHCMD) GO TO 175
      IF (EQUAL.NE.0) GO TO 230
      IF (ALLOW(ICOMD)/64.NE.0) GO TO 230
175   IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690
C     PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK.
      NCHCMD=NCHCMD+1
      EQUAL=NCHCMD
      COMAND(NCHCMD)=32
C     32 = ASCII BLANK
      HOLCMD(NCHCMD)=BLANK
      GO TO 230
C
C     GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX.
C
180   CALL EXCHCX (0)
C     IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND.
      IF (ICOMD.NE.0) GO TO 730
185   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1))
      NERRG=MAX0(NERRG,5)
200   CHAR1L=0
      NCNREC=NCNREC+1
      IF (NCNREC.LE.20) GO TO 20
      WRITE (PRINTR,210)
210   FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU
     1MES TEXT COMMAND IS MISSING.)
      GO TO 270
C
C     END OF FILE - SIMULATE A QUIT COMMAND.
C
220   ICOMD=KQUIT
C
C     RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME.
C
230   IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240
      TRANS=TVAL(ICOMD)
C             1   2   3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300
     1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7
     230,370,730,370), ICOMD
C       16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
C     32  33  34  35
C
C     THE COMMAND IS NOT ALLOWED AT THIS TIME.
C
240   WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE
     1D./1X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
C     DECIDE WHETHER TO SKIP TEXT
260   IF (ICOMD.NE.KTEXT) GO TO 10
      IF (EQUAL.NE.0) GO TO 10
270   WRITE (PRINTR,280)
280   FORMAT (//15H0SKIPPING TEXT.)
290   CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (NCHCMD.LT.2) GO TO 290
      IF (COMAND(1).NE.SIGNAL) GO TO 290
      IF (COMAND(2).EQ.SIGNAL) GO TO 10
      IF (NCHCMD.LT.3) GO TO 290
      IF (COMAND(2).NE.61) GO TO 290
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 290
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING.
C     DATE=YYMMDD
C     ORIGIN=YYMMDD SITE
C     UPDATE=YYMMDD SITE
C     IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE
C     THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED.
C
300   IF (EQUAL+5.GT.NCHCMD) GO TO 700
      I=EQUAL
      DO 310 J=1,3
      DATE(J)=0
      DO 310 K=1,2
      N=COMAND(I)-48
      IF (N.LT.0) GO TO 320
      IF (N.GT.9) GO TO 320
      DATE(J)=10*DATE(J)+N
310   I=I+1
      IF (NM.EQ.0) GO TO 320
      IF (NM.GT.12) GO TO 320
      IF (ND.LE.0) GO TO 320
      DAYS(2)=28
      IF (MOD(NY,4).EQ.0) DAYS(2)=29
      IF (NY.EQ.0) DAYS(2)=28
      IF (ND.LE.DAYS(NM)) GO TO 440
320   IF (ICOMD.EQ.KDATE) GO TO 700
      IF (TODAY(1).EQ.32) GO TO 700
      I=MIN0(NCHCMD+6,180)
      NCHCMD=I
      J=I-6
      IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1
C     32 = ASCII BLANK
      IF (J.LT.EQUAL) GO TO 700
330   COMAND(I)=COMAND(J)
      HOLCMD(I)=HOLCMD(J)
      J=J-1
      I=I-1
      IF (J.GE.EQUAL) GO TO 330
      DO 340 I=1,6
      COMAND(I+EQUAL-1)=TODAY(I)
340   HOLCMD(I+EQUAL-1)=TODAY(I)
      CALL EXCHAH (HOLCMD(EQUAL),6)
      WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD)
345   FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1))
      NERRG=MAX0(NERRG,1)
      GO TO 440
C
C     REWIND INTAPE
C
350   IF (INTAPE.EQ.0) GO TO 680
      IF (INTOPN.NE.0) GO TO 360
      I=1
C     OPEN INTAPE IF NOT ALREADY OPEN.  DO NOT CHECK EXCH LABEL.
      CALL EXCHRT (I,IBLOCK)
C     IGNORE STATUS
360   I=2
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
      GO TO 725
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH
C     BEGINS WITH A NUMBER FOLLOWED BY A BLANK.
C
C     INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     INTAPE = NUMBER SYSTEM DEPENDENT DATA
C     LIMIT = NUMBER
C     MARGIN = NUMBER
C     OUTAPE = NUMBER SYSTEM DEPENDENT DATA
C     OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     PRINTER = NUMBER
C     READER = NUMBER
C     SKIP = NUMBER
C     TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL)
C     WORK = NUMBER
C
370   NUMBER=0
      IF (EQUAL.EQ.0) GO TO 440
      DO 410 J=EQUAL,NCHCMD
      IF (COMAND(J).EQ.32) GO TO 420
C     32 = ASCII BLANK
      N=COMAND(J)-48
C     48 = ASCII ZERO
      IF (N.GE.0) GO TO 400
380   WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD)
390   FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS.  NOT PROCESSED./
     11X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
      GO TO 260
400   IF (N.GT.9) GO TO 380
410   NUMBER=10*NUMBER+N
      EQUAL=NCHCMD+1
      GO TO 440
420   EQUAL=J
430   EQUAL=EQUAL+1
      IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440
C     32 = ASCII BLANK
C
C     PRELIMINARY FORMAT CHECKING IS COMPLETE
C
440   J=ICOMD+1
C             0  1   2  3  4  5   6  7  8   9  10 11  12 13 14  15  16
      GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6
     120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595),
     2J
C     17 18  19 20  21 22 23 24 25  26  27 28  29  30 31 32  33 34  35
C
C     DATE=YYMMDD
C
450   DO 460 I=1,6
460   TODAY(I)=COMAND(EQUAL+I-1)
      GO TO 10
C
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA.
C
470   I=INFILE
      J=1
      GO TO 500
C
C     INCLUDE = NUMBER SYSTEM DEPENDENT DATA.
C
480   I=INALT
      J=3
      INALT=IABS(INALT)
      GO TO 500
C
C     TEXT
C
490   I=INTEXT
      J=2
      IF (EQUAL.EQ.0) GO TO 560
C
C     OPEN AN INPUT FILE.
C
500   IF (NUMBER.EQ.0) GO TO 505
      IF (NUMBER.EQ.OUFILE) GO TO 710
      IF (NUMBER.EQ.OUTAPE) GO TO 710
505   IF (J.EQ.2) GO TO 510
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (I.NE.0) CALL EXCHIM
510   IF (J-2) 520,530,540
520   INFILE=NUMBER
      GO TO 550
530   INTEXT=NUMBER
      GO TO 550
540   INALT=NUMBER
550   IF (NUMBER.EQ.0) GO TO 560
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      CALL EXCHCX (J+1)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHIM
      ACTION=2
C     ACTION = 2 MEANS REWIND
      IF (J.EQ.3) CALL EXCHIM
      INALT=-IABS(INALT)
560   ACTION=0
C     ACTION = 0 MEANS READ TEXT
      GO TO 730
C
C     INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
570   IF (INTOPN.EQ.0) GO TO 580
C     CLOSE THE INPUT TAPE, IGNORE STATUS.
      I=4
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
580   INTAPE=NUMBER
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (INTAPE.NE.0) CALL EXCHCX (6)
      GO TO 725
C
C     LIMIT = NUMBER
C
590   LIMIT=NUMBER
      GO TO 10
C
C     MARGIN = NUMBER
C
C     MINIMUM MARGIN IS 60
595   MARGIN=MAX0(NUMBER,60)
      GO TO 10
C
C     OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
600   IF (OUTOPN.EQ.0) GO TO 610
C     WRITE AND END-OF-FILE MARK ON OUTAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (I,OBLOCK,OBLOCK)
C     IGNORE STATUS
      OUTOPN=0
      PHASE=1
610   OUTAPE=NUMBER
      OUTUPD=MODIFY
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (OUTAPE.NE.0) CALL EXCHCX (7)
      GO TO 730
C
C     OUTPUT =  NUMBER SYSTEM DEPENDENT INFORMATION
C
620   ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      OUFILE=NUMBER
      IDCUR=IDSTRT
      IF (OUFILE.EQ.0) GO TO 730
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND.
      CALL EXCHCX (5)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHOU (OUTREC)
      GO TO 730
C
C     PRINTER = NUMBER.
C
630   CALL EXCHFO (-2)
      PRINTR=NUMBER
      CALL EXCHFO (2)
      GO TO 10
C
C     READER = NUMBER.
C
640   IF (INFILE.NE.0) GO TO 670
      CALL EXCHFO (-1)
      READER=NUMBER
      CALL EXCHCX (1)
      CALL EXCHFO (1)
      GO TO 10
C
C     WORK = NUMBER
C
650   IF (WORKF.GT.0) CALL EXCHFO (-3)
      WORKF=NUMBER
C     WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4.
      GO TO 10
C
C     UPDATE
C
C     DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR
C     SIMPLY TO OUTPUT THE UPDATE COMMAND.
660   IF (PHASE.GE.4) TRANS=5
      GO TO 730
C
C     ERROR MESSAGES.
C
670   NUMBER=3
C     MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE.
      GO TO 720
680   NUMBER=4
C     MESSAGE 4 - INTAPE IS NOT DEFINED.
      GO TO 720
690   NUMBER=12
C     MESSAGE 12 - NO PARAMETER STRING.
      GO TO 720
700   NUMBER=13
C     MESSAGE 13 - IMPROPER DATE.
      GO TO 720
710   NUMBER=31
C     MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT.
C
C     RETURN TO ERROR MESSAGE SEGMENT.
C
720   TRANS=8
      GO TO 740
c
c     Indicate the WORK file is empty.
c
725   if (nrwork.le.0 .or. workf.le.0) go to 730
      REWIND WORKF
      NRWORK=0
C
C     IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP.
C
730   IF (TRANS.EQ.1) GO TO 10
740   RETURN
C
      END
@HDG,P EXCHCX/1100
@FTN,SVI EXCHCX/1100
      SUBROUTINE EXCHCX (REASON)
C
C     PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER
C     PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT,
C     INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS.
C     UNIVAC-1100 VERSION.
C
C     IF THE COMMAND IS 'ASCII', SET OUTPUT MODE TO ASCII;
C     IF THE COMMAND IS 'FIELDATA', SET OUTPUT MODE TO FIELDATA
C
      INTEGER REASON
C
C     REASON=0 FOR UNRECOGNIZED COMMAND.
C     REASON=1 BEFORE OPENING READER.
C     REASON=2 BEFORE OPENING INFILE.
C     REASON=3 BEFORE OPENING INTEXT.
C     REASON=4 BEFORE OPENING INALT.
C     REASON=5 BEFORE OPENING OUFILE.
C     REASON=6 BEFORE OPENING INTAPE.
C     REASON=7 BEFORE OPENING OUTAPE.
C
C     *****     EXTERNAL FUNCTIONS     *********************************
C
      INTEGER EORSRO
      INTEGER EXCHFN
C
C     *****     LOCAL VARIABLES     ************************************
C
C BLANK   CONTAINS A HOLLERITH BLANK.
      INTEGER BLANK
C BYPASS  IS A BYPASS (040) ICW.
      INTEGER BYPASS
C DUMMY   IS USED TO ACCESS A WORD REFERENCED BY ITS ADDRESS.
      INTEGER DUMMY(1)
C FDBLNK  IS 6 BLANKS IN FIELDATA CODE.
      INTEGER FDBLNK
C I       IS USED AS AN INDEX AND TEMPORARY VARIABLE.
      INTEGER I
C ICW     IS A FD/ASCII SWITCH ICW (042).
      INTEGER ICW
C IEOF    CONTAINS O77 IS S1 AND ZERO ELSEWHERE - EOF ICW.
      INTEGER IEOF
C IOPN    IS '@@@OPN' IN FIELDATA CODE.
      INTEGER IOPN
C J       IS USED AS AN INDEX AND TEMPORARY VARIABLE.
      INTEGER J
C N       IS USED AS AN INDEX AND TEMPORARY VARIABLE.
      INTEGER N
C PLUS    CONTAINS A HOLLERITH PLUS SIGN.
      INTEGER PLUS
C RHW     CONTAINS O777777 - MASK TO GET RIGHT HALFWORD.
      INTEGER RHW
C SLASH   CONTAINS A HOLLERITH SLASH.
      INTEGER SLASH
C
C KNAME AND NAMET ARE USED TO PROVIDE TEMPORARY COMPATIBILITY OF
C THE INSERT COMMAND WITH PREVIOUS VERSIONS OF THE PROGRAM.
C
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER AFDFLG,WORKS(474,5)
      INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2)
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXEC8/ AFDFLG,WORKS
      COMMON /EXEC8A/ FILES,ELTS,VERS,PFS
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL DATA     *****************************************
C
C     PUT COMMANDS INTO COMD AFTER NCOMDP.  THE POSITION OF THIS
C     DATA IN COMD MUST BE CHANGED IF NCOMDP IS CHANGED.
C
C                                                        A  S  C  I
      DATA COMD(1,36),COMD(2,36),COMD(3,36),COMD(4,36) /65,83,67,73/
C                                                        F  I  E  L
      DATA COMD(1,37),COMD(2,37),COMD(3,37),COMD(4,37) /70,73,69,76/
C
      DATA NCOMDT /37/
C
      DATA SLASH /1H//
      DATA RHW /O7777777/              @ RIGHT HALFWORD MASK
      DATA PLUS /1H+/
      DATA IOPN /O000000242523/        @ '@@@OPN' IN FIELDATA
      DATA IEOF /O770000000000/        @ EOF ICW
      DATA ICW /O420000000000/         @ ASCII/FD SWITCH ICW
      DATA FDBLNK /O050505050505/      @ FD BLANK
      DATA BYPASS /O400000000000/      @ BYPASS ICW
      DATA BLANK /1H /
C
C     *****     PROCEDURES     *****************************************
C
      IF (REASON.NE.0) GO TO 40
      IF (ICOMD.EQ.0) GO TO 220
      J=ICOMD-NCOMDP
      IF (AFDFLG.EQ.2-J) GO TO 220
      AFDFLG=2-J
      IF (AND(WORKS(12,5),RHW).NE.IOPN) GO TO 220     @ NOT OPEN
      ISTAT=EORSWW(WORKS(1,5),0,ICW+AFDFLG)
      IF (ISTAT.EQ.0) GO TO 220
      CALL EXCHEM (ISTAT)
      WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD)
30    FORMAT (' WHILE WRITING OUTPUT FILE'/(1X,80A1))
      GO TO 220
C
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND.
C
40    FILES(1,REASON)=EXCHFN(NUMBER)
      FILES(2,REASON)=FDBLNK
      IF (HOLCMD(EQUAL).EQ.PLUS) IF (REASON-5) 110,220,220
      ELTS(1,REASON)=FDBLNK
      ELTS(2,REASON)=FDBLNK
      IF (EQUAL.GT.NCHCMD.OR.EQUAL.EQ.0) GO TO 100
      VERS(1,REASON)=FDBLNK
      VERS(2,REASON)=FDBLNK
      IF (HOLCMD(EQUAL).EQ.SLASH) GO TO 100
      J=EQUAL+12
      DO 50 I=EQUAL,J
      IF (I.GT.NCHCMD) GO TO 60
      IF (HOLCMD(I).EQ.SLASH) GO TO 60
      IF (HOLCMD(I).EQ.BLANK) GO TO 60
50    CONTINUE
      I=J
60    J=I-EQUAL
      CALL EXCHPN (COMAND(EQUAL),ELTS(1,REASON),J)
      K=EQUAL+J
      IF (K.GT.NCHCMD) GO TO 100
      IF (HOLCMD(K).NE.SLASH) GO TO 100
70    K=K+1
      IF (HOLCMD(K).EQ.BLANK) GO TO 70
      J=K+12
      DO 80 I=K,J
      IF (I.GT.NCHCMD) GO TO 90
      IF (HOLCMD(I).EQ.BLANK) GO TO 90
80    CONTINUE
      I=J
90    J=I-K
      CALL EXCHPN (COMAND(K),VERS(1,REASON),J)
100   IF (REASON-5) ,220,170
C
C     OPEN INPUT.
C
C     IF THE ENTRY IN NTAB$ INDICATES THE UNIT IS ASSOCIATED WITH
C     A SYMBIONT UNIT THE FILE IS READ USING READ$.
C
C     IF THE UNIT IS NOT ASSOCIATED WITH A SYMBIONT FILE THE SYSTEM
C     DEPENDENT INFORMATION IS EXAMINED.  IF THERE IS NONE, THE UNIT
C     IS ASSUMED TO BE ASSOCIATED WITH AN SDF FILE, AND THE FILE IS
C     READ FROM THE BEGINNING (SECTOR ZERO IF DISK).  IF THE SYSTEM
C     DEPENDENT INFORMATION BEGINS WITH A + SIGN, THE FILE IS READ
C     FROM THE CURRENT POSITION.  OTHERWISE, THE SYSTEM DEPENDENT
C     INFORMATION IS TREATED AS A FILE/ELEMENT SPECIFICATION.
C
110   WORKS(1,REASON)=0
      IF (NTABDC(NUMBER).GE.32) GO TO 150   @ CHECK DEVICE CODE.
      WORKS(1,REASON)=FILES(1,REASON)
      WORKS(2,REASON)=FILES(2,REASON)
      IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 140
      IF (HOLCMD(EQUAL).NE.PLUS) GO TO 120
      N=AND(WORKS(10,REASON),RHW)      @ BUFFER IMAGE LOCATOR
      IF (WORKS(6,REASON)+N.EQ.0) GO TO 140
      I=223-(N-AND(WORKS(7,REASON),RHW))    @ REMAINING SPACE
      I=MOD(I,28)                      @ REM SPACE IN SECTOR OR EOF
      N=N-LOC(DUMMY)+1                 @ CHANGE N FROM ADDR TO SUBSCR.
C     IF EOF ICW (S1=077) CHANGE TO BYPASS ICW (S1=040, S2=LENGTH).
      IF (AND(DUMMY(N),IEOF).EQ.IEOF) DUMMY(N)=BYPASS+2**24*I
      GO TO 220
C
C     OPEN AN SDF ELEMENT TO READ
C
120   IF (ELTS(1,REASON).NE.FDBLNK) GO TO 150
      WRITE (PRINTR,130) (HOLCMD(I),I=1,NCHCMD)
130   FORMAT (//'0NO ELEMENT NAME, TREAT AS FILE.'/(1X,80A1))
      NERRG=MAX0(NERRG,5)
140   ELTS(1,REASON)=0
150   N=EORSRO(WORKS(1,REASON),ELTS(1,REASON),VERS(1,REASON))
      IF (N.EQ.0) GO TO 220
      call exchm2 (n,works(3,reason))
      WRITE (PRINTR,160) (HOLCMD(I),I=1,NCHCMD)
160   FORMAT (' WHILE OPENING INPUT ELEMENT OR FILE.  NOT OPENED.'/(1X,8
     10A1))
      GO TO 220
C
C     OPEN INTAPE OR OUTAPE.
C
C     ASSIGN FILE IF NOT ASSIGNED
170   CALL EXCHIO (FILES(1,REASON),0,0,0,0)
      PFS(10,REASON-5)=0
      PFS(11,REASON-5)=0
      IF (EQUAL.GT.NCHCMD.OR.EQUAL.EQ.0) GO TO 220
      DO 180 I=1,2
      PFS(I,REASON-5)=FILES(I,REASON)
      PFS(I+2,REASON-5)=ELTS(I,REASON)
180   PFS(I+6,REASON-5)=VERS(I,REASON)
      PFS(6,REASON-5)=2**18*7          @ OMN ELEMENT
      IF (REASON.GT.6) GO TO 200
C
C     OPEN INTAPE ELEMENT.
C
      CALL PFSER (PFS(1,1),I)
      IF (I.EQ.0) GO TO 220
      I=I+32
      call exchm2 (i,0)
      WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (' WHILE OPENING INTAPE.  NOT OPENED.'/(1X,80A1))
      INTAPE=0
      GO TO 220
C
C     OPEN OUTAPE ELEMENT.
C
200   CALL PFWLER (PFS(1,2),PFS(11,2),I)
      PFS(10,2)=PFS(11,2)
      IF (I.EQ.0) GO TO 220
      I=I+32
      call exchm2 (i,0)
      WRITE (PRINTR,210) (HOLCMD(I),I=1,NCHCMD)
210   FORMAT (' WHILE TRYING TO OPEN OUTAPE.  NOT OPENED.'/(1X,80A1))
      OUTAPE=0
      ELTS(1,7)=FDBLNK
C
220   RETURN
C
      END
@HDG,P EXCHC2
@FTN,SVI EXCHC2
      SUBROUTINE  EXCHC2
C
C     PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KINDE /32/
      DATA KOPTI /14/
      DATA KSITE /25/
C
C     FIGURE OUT WHICH COMMAND GOT US HERE.
C
      IF (ICOMD-KOPTI) 60,150,10
10    IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270
C
C     ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT
C     WHERE C1, C2, STEP AND START ARE INTEGERS.
C     STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP,
C     START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF
C     CHARACTERS OF TEXT IN IDTXTL.  IF AN ERROR OCCURS,
C     STORE ZERO IN IDSTEP AND IDTXTL.
C     IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO.
C
C     STORE THE MODIFIER IN IDOPTN.
C     IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE
C     PRODUCED ONLY FOR IMAGES FROM INTAPE.  IF THE O MODIFIER
C     IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES
C     WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT.  IF THE F
C     MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION
C     OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE
C     PRODUCED FOR ALL IMAGES OUTPUT.  IF THE C MODIFIER IS SPECIFIED,
C     SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH
C     RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR
C     ALL IMAGES OUTPUT.  IF NONE OF THE I, F, OR C MODIFIERS ARE
C     SPECIFIED, THE O MODIFIER IS ASSUMED.
C
C     IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED.
C     IF IDTXTL = ZERO, TEXT IS NOT EMITTED.
C     IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE
C     EMITTED.
C
C     CONVERT C1,C2,STEP,START
C
      IDOPTN=MODIFY
      IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79
C     70 = ASCII F, 73 = ASCII I, 79 = ASCII O.
      DO 40 J=1,4
      NUMBER=0
20    IF (EQUAL.GT.NCHCMD) GO TO 40
      IF (COMAND(EQUAL).EQ.44) GO TO 30
C     44 = ASCII ,
      I=COMAND(EQUAL)-48
      IF (I.LT.0) GO TO 350
      IF (I.GT.9) GO TO 350
      NUMBER=10*NUMBER+I
      EQUAL=EQUAL+1
      GO TO 20
30    EQUAL=EQUAL+1
40    IDNBRS(J)=NUMBER
      IDCUR=IDSTRT
      IDCOL1=MAX0(1,MIN0(IDCOL1,178))
      IDCOL2=MIN0(IDCOL2,178)
C
C     STORE TEXT.
C
      IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0)
      IF (IDTXTL.EQ.0) GO TO 330
      DO 50 J=1,IDTXTL
      IDTEXT(J)=COMAND(EQUAL)
50    EQUAL=EQUAL+1
      GO TO 330
C
C     INDEX = PARAMETER STRING
C
60    J=0
      IF (COMAND(EQUAL).NE.45) GO TO 70
C     45 = ASCII -
      J=-1
      EQUAL=EQUAL+1
70    N=0
      DO 80 I=1,26
80    INDEXS(I)=0
90    IF (EQUAL.GT.NCHCMD) GO TO 130
      I=COMAND(EQUAL)-64
      IF (I.EQ.-32) GO TO 120
C     32 = ASCII BLANK.
      IF (I.GE.32) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.LE.0) GO TO 100
      IF (I.LE.26) GO TO 110
100   N=EQUAL
      GO TO 120
110   INDEXS(I)=1
120   EQUAL=EQUAL+1
      GO TO 90
130   INDEX=0
      DO 140 I=1,26
      INDEXS(I)=IABS(INDEXS(I)+J)
140   INDEX=INDEX+INDEXS(I)
      IF (MODIFY.EQ.76) INDEX=-INDEX
C     76 = ASCII L.
      IF (N) 340,330,340
C
C     OPTION = PARAMETER STRING
C
150   IF (MODIFY.NE.0) GO TO 170
      DO 160 I=1,26
160   OPTVAL(I)=0
170   IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330
      I=1
      IF (MODIFY.EQ.67) I=0
C     67 = ASCII C.
      N=0
      DO 190 J=EQUAL,NCHCMD
      K=COMAND(J)
      IF (K.GE.96) K=K-32
C     CONVERT TO UPPER CASE.
      IF (K.EQ.32) GO TO 190
C     32 = ASCII BLANK
      IF (K.LT.65) GO TO 180
      IF (K.GT.90) GO TO 180
C     PROCESS ALPHABETIC OPTIONS.
      OPTVAL(K-64)=I
      GO TO 190
180   N=J
190   CONTINUE
      IF (N) 330,330,340
C
C     PROCESS PRED = ID REC A/X MASK STRING
C       WHERE ID = PREDICATE IDENTIFIER (A-H),
C       REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE,
C       A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH
C             IN EXACT POSITION,
C       MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE
C              TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED.
C       STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF
C                CONTROL RECORDS.
C
C     THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR
C     PREDICATE A, ETC.
C
C     PRED(1,*)=LENGTH OF STRING + 3
C     PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED.
C     PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND).
C     PRED(3,*)=RECORD TYPE.
C     PRED(4,*)=A/X
C     PRED(5,*)=MASK CHARACTER.
C     PRED(6..42,*)=STRING.
C
200   IF (EQUAL.NE.0) GO TO 240
C     LIST ALL ACTIVE PREDICATES.
      DO 230 I=1,8
      IF (PRED(1,I).EQ.0) GO TO 230
      J=PRED(1,I)+1
      COMAND(1)=I+64
      DO 210 K=2,J
210   COMAND(K)=PRED(K+1,I)
      CALL EXCHAH (COMAND,J)
      WRITE (PRINTR,220) (COMAND(K),K=1,J)
220   FORMAT (6H PRED=,42A1)
230   CONTINUE
      GO TO 330
C     SAVE PREDICATE IF VALID.
240   IF (NCHCMD.LE.EQUAL+3) GO TO 370
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.GT.72) GO TO 360
C     72 = ASCII H
      NUMBER=J-64
      PRED(1,NUMBER)=0
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.GT.90) GO TO 360
C     90 = ASCII Z
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.EQ.82) GO TO 360
C     82 = ASCII R
      PRED(3,NUMBER)=J
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.NE.65.AND.J.NE.88) GO TO 360
C     65 = ASCII A, 88 = ASCII X
      PRED(4,NUMBER)=J
      EQUAL=EQUAL+1
      PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40)
      I=4
      DO 250 J=EQUAL,NCHCMD
      I=I+1
      IF (I.GT.42) GO TO 330
      K=COMAND(J)
      IF (K.GT.96) K=K-32
C     CONVERT TO UPPER CASE.
250   PRED(I,NUMBER)=K
      GO TO 330
C
C     SITE = SITE NAME
C
260   JUMP=1
      GO TO 280
C
C     TITLE = OUTPUT TAPE TITLE
C
270   JUMP=2
280   K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 320 I=1,40
      IF (K.GT.NCHCMD) GO TO 290
      J=COMAND(K)
      K=K+1
      GO TO 300
290   J=32
C     32 = ASCII BLANK.
300   IF (JUMP.EQ.2) GO TO 310
      SITE(I)=J
      GO TO 320
310   TITLE(I)=J
320   CONTINUE
C
C     RETURN TO COMMAND DECODER.
C
330   TRANS=1
      GO TO 390
C
C     ERROR MESSAGES
C
340   NUMBER=14
C     MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED.
      EQUAL=N
      GO TO 380
350   IDSTEP=0
      IDTXTL=0
360   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED.
      GO TO 380
370   NUMBER=30
C     MESSAGE 30 - COMMAND IS INCOMPLETE.
C
380   TRANS=8
C
390   RETURN
C
      END
@HDG,P EXCHC3
@FTN,SVI EXCHC3
      SUBROUTINE EXCHC3 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE
C     COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES.
C
C     OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE
C     NAME COMMAND.
C
C     OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING
C     COPY, NAME OR UPDATE COMMANDS.
C
C ID      IS USED TO CONSTRUCT THE OUTPUT LABEL.
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                                    E  X  C  H
      DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/
C                                    A  N  G  E
      DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/
      DATA KNAME /9/
      DATA KSKIP /26/
C
C     OPEN INTAPE IF NECESSARY
C
      IF (INTOPN.NE.0) GO TO 70
      IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300
      IF (INTAPE.EQ.OUTAPE) GO TO 360
      CALL EXCHRH (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 310
      INTOPN=1
C     COPY THE LABEL TO A SAVE AREA.
      DO 10 I=1,180
10    LABELI(I)=CBLCKI(I)
      CALL EXCHAH (CBLCKI(13),138)
      WRITE (PRINTR,20)
20    FORMAT (25H0INPUT LABEL INFORMATION.)
      WRITE (PRINTR,30) (CBLCKI(I),I=13,104)
30    FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/
     1        20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1)
      IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150)
40    FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1)
      WRITE (PRINTR,50) NDATAI
50    FORMAT (28H DATA CHARACTERS PER BLOCK =,I6)
      IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI
60    FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6)
      CHAR1L=0
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 290
70    IF (ICOMD.EQ.KSKIP) GO TO 270
C
C     OPEN OUTAPE IF NECESSARY
C
80    IF (ICOMD.EQ.0) GO TO 90
      IF (ICOMD.LT.KNAME) GO TO 100
90    IF (INTAPE*OUTAPE.EQ.0) GO TO 100
      IF (OUTUPD.NE.85) GO TO 370
C     85 = ASCII U.
100   IF (OUTOPN.NE.0) GO TO 240
      IF (OUTAPE.EQ.0) GO TO 240
C     CONSTRUCT THE OUTPUT LABEL.
      IF (TODAY(1).EQ.0) GO TO 340
      IF (INTOPN.EQ.0) GO TO 160
      DO 110 I=1,180
110   CBLCKO(I)=LABELI(I)
      IF (TITLE(1).EQ.32) GO TO 130
C     32 = ASCII BLANK
      DO 120 I=1,40
120   CBLCKO(I+18)=TITLE(I)
130   IF (OUTUPD.NE.85) GO TO 220
C     85 = ASCII U.
      IF (SITE(1).EQ.0) GO TO 350
      DO 140 I=1,6
140   CBLCKO(I+104)=TODAY(I)
      DO 150 I=1,40
150   CBLCKO(I+110)=SITE(I)
      GO TO 220
160   IF (TITLE(1).EQ.32) GO TO 330
C     32 = ASCII BLANK
      IF (SITE(1).EQ.0) GO TO 350
      IF (INTAPE*OUTAPE.EQ.0) GO TO 170
      IF (INTAPE.EQ.OUTAPE) GO TO 360
170   DO 180 I=1,8
180   CBLCKO(I)=ID(I)
      DO 190 I=1,40
      CBLCKO(I+18)=TITLE(I)
190   CBLCKO(I+64)=SITE(I)
      DO 200 I=1,6
200   CBLCKO(I+58)=TODAY(I)
      DO 210 I=105,180
210   CBLCKO(I)=0
220   CALL EXCHWH (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 320
      OUTOPN=1
      CBLCKO(1)=CBLCKO(105)
      CALL EXCHAH (CBLCKO(13),138)
      WRITE (PRINTR,230)
      WRITE (PRINTR,30) (CBLCKO(I),I=13,104)
230   FORMAT (26H0OUTPUT LABEL INFORMATION.)
      IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150)
      WRITE (PRINTR,50) NDATAO
      IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO
      CHAR1L=0
240   IF (ICOMD-KNAME) 250,260,280
C
C     COPY
C
250   TRANS=4
      MODEI=1-MIN0(1,OUFILE+OPTL)
      IF (ICOMD.EQ.0) MODEI=0
      GO TO 390
C
C     NAME
C
260   TRANS=5
      IF (NRWORK.EQ.0) PHASE=4
      GO TO 390
C
C     SKIP
C
270   TRANS=4
      GO TO 390
C
C     UPDATE
C
280   TRANS=5
      MODEI=0
      GO TO 390
C
C     ERROR MESSAGES
C
290   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      EQUAL=ISTAT
      GO TO 380
300   NUMBER=4
C     MESSAGE 4 - INTAPE NOT DEFINED.
      GO TO 380
310   NUMBER=5
C     MESSAGE 5 - UNABLE TO OPEN INTAPE.
      EQUAL=ISTAT
      GO TO 380
320   NUMBER=6
C     MESSAGE 6 - UNABLE TO OPEN OUTAPE.
      EQUAL=ISTAT
      GO TO 380
330   NUMBER=7
C     MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE.
      GO TO 380
340   NUMBER=8
C     MESSAGE 8 - DATE NOT SUPPLIED.
      GO TO 380
350   NUMBER=9
C     MESSAGE 9 - SITE NOT SUPPLIED.
      GO TO 380
360   NUMBER=10
C     MESSAGE 10 - INTAPE = OUTAPE.
      GO TO 380
370   NUMBER=11
C     MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED.
380   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM
C
390   RETURN
C
      END
@HDG,P EXCHRH
@FTN,SVI EXCHRH
      SUBROUTINE EXCHRH (ISTAT,DBLOCK)
C
C     READ THE HEADER LABEL FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE
C               NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     OPEN THE INPUT TAPE.
C
      ISTAT=1
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     READ A BLOCK.
C
      NDATAI=171
      NERRCI=0
      BLKSQI=0
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     FIND OUT IF IT IS A PROPER LABEL.
C
      CALL EXCHUN (DBLOCK,CBLCKI)
      DO 10 I=1,8
      IF (CBLCKI(I).NE.ID(I)) GO TO 20
10    CONTINUE
C
C     GET READY TO READ THE REST OF THE TAPE.
C
      CCDBI=NCDBI
      NDATAI=256*CBLCKI(9)+CBLCKI(10)
      NERRCI=256*CBLCKI(11)+CBLCKI(12)
      LASTI=0
      L1PRGI=0
      ISTAT=0
      GO TO 30
C
C     NOT A LABEL.
C
20    ISTAT=6
C
C     CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK.
25    I=4
      CALL EXCHRT (I,DBLOCK)
C
30    RETURN
C
      END
@HDG,P EXCHWH
@FTN,SVI EXCHWH
      SUBROUTINE EXCHWH (ISTAT,DBLOCK)
C
C     WRITE A HEADER ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE
C               WRITTEN ARE NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     MAKE SURE IT IS A PROPER LABEL.
C
      DO 10 I=1,8
      IF (CBLCKO(I).NE.ID(I)) GO TO 30
10    CONTINUE
C
C     OPEN THE OUTPUT TAPE.
C
      ISTAT=1
      CALL EXCHWT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 40
C
C     CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR
C     CONTROL CHARACTERS
C
      CBLCKO(9)=NDATAO/256
      CBLCKO(10)=MOD(NDATAO,256)
      CBLCKO(11)=NERRCO/256
      CBLCKO(12)=MOD(NERRCO,256)
C
C     INSERT TODAYS DATE
C
      DO 20 I=1,6
20    CBLCKO(I+12)=TODAY(I)
C
C     WRITE THE BLOCK ON TAPE.
C
      BLKSQO=0
      CALL EXCHPA (CBLCKO,DBLOCK)
      CCDBO=180
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     GET READY TO WRITE THE REST OF THE FILE.
C
      L1PRGO=0
      LLPRGO=0
      N1RECO=0
      NLRECO=0
      L1RECO=0
      LASTO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      GO TO 40
C
C     NOT A PROPER LABEL.
C
30    ISTAT=6
C
40    RETURN
C
      END
@HDG,P EXCHC4
@FTN,SVI EXCHC4
      SUBROUTINE EXCHC4 (IBLOCK)
      INTEGER IBLOCK(1)
C
C     PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM
C     COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KCOPY /3/
C
C     ARE WE STARTING OR CONTINUING?
C
C     ICOMD.EQ.0  MEANS  CHANGE A CONTROL RECORD
C     ICOMD.GT.0  MEANS  SKIP OR COPY COMMAND BEGIN
C     ICOMD.EQ.-1 MEANS  CONTINUE COPY = NUMBERS
C     ICOMD.EQ.-2 MEANS  CONTINUE COPY = PREDICATE EXPRESSION
      NEWP=0
      IF (ITYPEI.EQ.80) VERT=0
C     80 = ASCII P.  WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO
C     IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON
C     THE WORK FILE.
      IF (ICOMD.EQ.0) GO TO 190
C     ICOMD=0 MEANS CHANGING A CONTROL RECORD.
      IF (ICOMD+1) 290,170,10
10    IF (ICOMD.EQ.KCOPY) GO TO 30
C
C     SKIP COMMAND.
C
      IF (INTOPN.LT.0) GO TO 430
      if (modify.eq.70) number=number+n1reci-1
c     70 = ASCII F.
      IF (NUMBER+1-N1RECI) 540,430,20
20    CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.EQ.69) GO TO 460
C     69 = ASCII E.
      IF (N1RECI-NUMBER) 20,20,430
C
C     COPY COMMAND FORMAT VERIFICATION.
C
30    IF (COMAND(EQUAL).LT.48) GO TO 180
C     48 = ASCII ZERO
      IF (COMAND(EQUAL).GT.57) GO TO 180
C     57 = ASCII NINE
C
C     COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS.
C     CONVERT THE NUMBERS AND STORE THEM IN COMAND.  IF THE NUMBER
C     IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER.
C
      ICOMD=-1
      I=0
      J=44
C     44 = ASCII COMMA
40    I=I+1
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 480
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=NUMBER
50    EQUAL=EQUAL+1
      IF (EQUAL.GT.NCHCMD) GO TO 60
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 60
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=10*COMAND(I)+NUMBER
      GO TO 50
60    IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70
70    IF (J.EQ.45) COMAND(I)=-COMAND(I)
C     45 = ASCII DASH
      IF (EQUAL.GT.NCHCMD) GO TO 90
      J=COMAND(EQUAL)
      IF (J.EQ.32 .OR. J.EQ.46) GO TO 90
C     32 = ASCII BLANK, 46 = ASCII PERIOD.
      IF (J.NE.44.AND.J.NE.45) GO TO 480
C     44 = ASCII COMMA, 45 = ASCII DASH
80    EQUAL=EQUAL+1
      IF (COMAND(EQUAL)-32) 40,80,40
C     32 = ASCII BLANK
90    NUMBER=I
C     FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE
C     POSITION IN COMAND CURRENTLY BEING EXAMINED.
      EQUAL=-1
100   EQUAL=EQUAL+1
      IF (EQUAL.GE.NUMBER) GO TO 470
      IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100
      IF (EQUAL.EQ.0) GO TO 120
      WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD)
110   FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H)
     1NOT COPIED./(1X,80A1))
      NERRG=MAX0(NERRG,5)
120   IF (COMAND(EQUAL+1).GT.0) GO TO 130
      EQUAL=EQUAL-1
      COMAND(EQUAL+1)=N1RECI
130   IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
C
C     PROCESS COPY = LIST OF NUMBERS
C
140   EQUAL=EQUAL+1
C     GO COPY THE PROGRAM IF IT IS THE RIGHT ONE.
150   IF (INTOPN.LT.0) GO TO 430
      IF (COMAND(EQUAL)-N1RECI) 170,420,160
C     SKIP TO DESIRED PROGRAM
160   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI-69) 150,460,150
C     69 = ASCII E
170   IF (EQUAL.GE.NUMBER) GO TO 430
      IF (COMAND(EQUAL+1).GE.0) GO TO 140
      COMAND(EQUAL)=IABS(COMAND(EQUAL))+1
      IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420
      EQUAL=EQUAL+1
      GO TO 170
C
C     COPY = SELECTION STRING OR CHANGE CONTROL RECORD.
C
180   ICOMD=-2
      IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
      NRWORK=-1
C
C     DETERMINE NEED TO OPEN WORK FILE.
C
190   IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0)
     1IF (ICOMD) 290,430,290
      IF (WORKF.EQ.0) GO TO 500
      I=IABS(WORKF)
      IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510
      IF (WORKF.GT.0) GO TO 200
      WORKF=I
      CALL EXCHFO (3)
200   IF (ICOMD.NE.0) GO TO 280
C
C     CHANGE CONTROL RECORD.
C
      if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520
c     69 = ascii E, 73 = ascii I.
      if (nrwork.eq.0) go to 210
      if (itypei.eq.80) go to 520
c     80 = ascii P
210   IF (NUMBER-NRWORK-1) 530,220,410
220   NCHACT=NCHCMD+1-EQUAL
      IF (NCHACT.GT.0) GO TO 230
      NCHACT=1
      INTREC(1)=32
C     32 = ASCII BLANK
      GO TO 425
230   DO 240 I=1,NCHACT
240   INTREC(I)=COMAND(EQUAL+I-1)
      GO TO 425
C
C     COPY = SELECTION EXPRESSION.
C
C     SKIP TO NEXT PROGRAM.
250   IF (INTOPN.LT.0) GO TO 430
      if (itypei.eq.69) go to 460
c     69 = ASCII E.
      do 260 i = 1, 8
260   pred(2,i)=0
      if (itypei.ne.80) go to 265
c     If the current record is a new program, don't skip it (we haven't
c     processed it yet).
      if (nrwork.gt.0 .and. workf.gt.0) rewind workf
      nrwork=min0(nrwork,0)
      newp=0
      go to 320
265   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      nxnewp=0
270   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.NE.80) GO TO 310
C     80 = ASCII P
      NEWP=nxnewp
c     Set NEWP non-zero when all control records for a module have been
c     seen.
      GO TO 320
280   NRWORK=MAX0(NRWORK,0)
290   DO 300 I=1,8
300   PRED(2,I)=0
c     NEWP is non-zero when all control records have been read.
310   if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1
C     69 = ASCII E, 73 = ASCII I.
320   nxnewp=1
      if (icomd.eq.0) if (newp) 520,210,520
      IF (LIMIT.EQ.0) GO TO 340
      IF (N1RECI.LE.LIMIT) GO TO 340
      WRITE (PRINTR,330) LIMIT
330   FORMAT (7H LIMIT=,I6,9H REACHED.)
      GO TO 430
340   IF (NEWP.EQ.0) GO TO 360
      CALL EXCHLX
C     EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'.
      NUMBER=NCHCMD
      IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415
C     73 = ASCII I.
      IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425
C     80 = ASCII P.
      IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425
C     83 = ASCII S.
      IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415
C     88 = ASCII X.
      IF (COMAND(180)) 450,250,420
C     CONTROL RECORD.  EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE.
360   I=1
      DO 400 NUMBER=1,8
      IF (PRED(1,NUMBER).EQ.0) GO TO 400
      IF (PRED(2,NUMBER).NE.0) GO TO 400
      IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390
      NM=PRED(1,NUMBER)-3
      IF (.NOT.(NCHACT.GT.0)) GO TO 390
      DO 385 L = 1, NCHACT
      DO 380 J = 1, NM
C
C     DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND
C     IN PREDICATE.
      IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380
      IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370
C
C     NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS.
      K=32
      GO TO 375
C     USE CHARACTER FROM CONTROL RECORD.
370   K=INTREC(J+L-1)
C
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (K.GT.96 .AND. K.LT.123) K=K-32
C
C     TEST FOR A MATCH ON A SINGLE CHARACTER.
C     IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE
C     PATTERN.  IF THE SEARCH MODE IS X, TERMINATE THE SEARCH.
375   IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390
380   CONTINUE
C
C     FOUND A MATCH IN CONTROL RECORD AND PREDICATE.
      PRED(2,NUMBER)=1
      GO TO 400
385   CONTINUE
390   I=0
400   CONTINUE
      IF (I.NE.0) newp=1
      IF (NRWORK.LT.0) GO TO 270
C     AT LEAST ONE FALSE PREDICATE.  WRITE THE CONTROL RECORD ON WORKF.
410   WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT)
      NRWORK=NRWORK+1
      GO TO 270
C
C     GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM.
C
415   ICOMD=-3
C     RETURN TO EXCHC1 AFTER COPYING MODULE.
420   TRANS=5
      GO TO 570
C
C     RETURN TO THE COMMAND PROCESSOR.
C
425   TRANS=1
C     REMEMBER CONTROL RECORDS ON WORKF.
      GO TO 570
430   TRANS=1
      IF (ICOMD+1) 560,570,570
C
C     ERROR MESSAGES.
C
440   NUMBER=1
C     MESSAGE 1 - I/O ERROR.
      EQUAL=ISTAT
      GO TO 550
450   NUMBER=-COMAND(180)
C     MESSAGES GENERATED BY EXCHLX
      GO TO 550
460   IF (INTOPN.LT.0) GO TO 430
      INTOPN=-1
      EQUAL=NUMBER
      NUMBER=15
C     MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE.
      GO TO 550
470   NUMBER=16
C     MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION.
      GO TO 550
480   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER
      GO TO 550
490   NUMBER=18
C     MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER.
      GO TO 550
500   NUMBER=19
C     MESSAGE 19 - WORK FILE NOT DEFINED.
      GO TO 550
510   NUMBER=20
C     MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE.
      GO TO 550
520   EQUAL=NUMBER
      NUMBER=21
C     MESSAGE 21 - CONTROL RECORD NOT PRESENT
      GO TO 550
530   NUMBER=22
C     MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER.
      GO TO 550
540   NUMBER=29
C     MESSAGE 29 - BACKWARD SKIP IGNORED.
C
C     RETURN TO THE ERROR MESSAGE PROCESSOR.
C
550   TRANS=8
      IF (ICOMD.EQ.0) GO TO 570
C
C     DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF.
C
560   IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
C
C     RETURN TO TRANSITION PROGRAM.
C
570   RETURN
C
      END
@HDG,P EXCHLX
@FTN,SVI EXCHLX
      SUBROUTINE EXCHLX
C
C     EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND.
C
C     THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE
C     STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM
C     COPY=LOGICAL EXPRESSION.  THE LOGICAL EXPRESSION CONSISTS OF THE
C     EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY
C     OPERATORS + - * / AND PARENEHESES.  THE PRIMARY SYMBOLS A-H ARE
C     LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE
C     STATEMENTS.  THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE
C     NULL PREDICATE, WHICH IS ALWAYS FALSE.  THE OPERATORS + - * / ARE
C     THE BINARY LOGICAL OPERATIONS   OR, OR NOT, AND, AND NOT
C     RESPECTIVELY.  THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE
C     PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL
C     PRIORITY.  THE RELATIVE PRIORITY MAY BE CHANGED BY USING
C     PARENTHESES.
C
C     WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY
C     FALSE.  AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL
C     FALSE PREDICATES IS DETERMINED.  ONCE TRUE, A PREDICATE REMAINS
C     TRUE.  THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND
C     A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE.  WHEN ALL ACTIVE
C     PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM
C     HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND
C     IS EVALUATED.  IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED.
C     IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED.  THIS PROCESS
C     CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM
C     NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED.
C
C     THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE
C     TABLE BELOW.  INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS
C     APPENDED TO THE END OF THE LOGICAL EXPRESSION.
C
C     PREVIOUS  I                 CURRENT TOKEN                   I
C      TOKEN    I + - * / I PRIMARY I    (    I    )    I  ELSE   I
C     ----------I---------I---------I---------I---------I---------I
C      + - * /  I  ERROR  I   OK    I   OK    I  ERROR  I  ERROR  I
C      PRIMARY  I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C         (     I  ERROR  I   OK    I   OK    I   OK    I  ERROR  I
C         )     I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C     ----------I---------I---------I---------I---------I---------I
C
C     CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING
C     A STACK AND THE PRECEDENCE TABLE BELOW.  TOS MEANS TOP-OF-STACK,
C     HOI MEANS HEAD-OF-INPUT.  THE STACK INITIALLY CONTAINS (.
C
C                  TOS       HOI
C      TOKEN   I  INDEX  I  INDEX  I
C     ---------I---------I---------I
C       + -    I    2    I    1    I
C       * /    I    4    I    3    I
C     PRIMARY  I    6    I    5    I
C        (     I    0    I    7    I
C        )     I   N/A   I    0    I
C     ---------I---------I---------I
C
C     WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS
C     PUSHED ONTO THE STACK.  WHEN THE TOS INDEX IS GREATER THAN THE HOI
C     INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY
C     SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT
C     PLACED IN THE SUFFIX LIST.  THEN THE RELATION OF THE TOS INDEX TO
C     THE HOI INDEX IS RE-EXAMINED.  WHEN THE TOS INDEX IS EQUAL TO THE
C     HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED.
C
C     *****     INTERNAL VARIABLES     *********************************
C
C CHTAB   RECOGNIZED CHARACTERS.  INTERNAL PROCESSES USE THE INDEX
C         INTO CHTAB.
C COLTAB  CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX.
C HOI     CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE.
C INFIX   IS THE CURRENT POSITION IN THE INFIX.
C IPREV   IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN.
C ISTACK  IS THE CURRENT STACK INDEX.
C ISUFIX  IS THE CURRENT SUFFIX INDEX.
C SYNTAX  CONTAINS THE SYNTAX RULES.
C TOS     CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE.
C
      INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     DATA STATEMENTS     ************************************
C
C                                                    A  B  C  D
      DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/
C                                                    E  F  G  H
      DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/
C                                                    N  +  -  *
      DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/
C                                                    /  (  )
      DATA CHTAB(13),CHTAB(14),CHTAB(15)           /47,40,41   /
C                                                       A B C D
      DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/
C                                                       E F G H
      DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/
C                                                       N + - *
      DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/
C                                                       / ( )
      DATA COLTAB(13),COLTAB(14),COLTAB(15)            /1,3,4  /
C                                                   A B C D E
      DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/
C                                                   F G H N +
      DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/
C                                                   - * / ( )
      DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/
C                 CURRENT TOKEN IS +-*/.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/
C                 CURRENT TOKEN IS PRIM.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/
C                 CURRENT TOKEN IS (.     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/
C                 CURRENT TOKEN IS ).     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/
C                                                   A B C D E
      DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/
C                                                   F G H N +
      DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/
C                                                   - * / ( )
      DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/
C
C     *****     PROCEDURES     *****************************************
C
C     COMAND IS USED FOR INFIX, STACK AND SUFFIX.  UPON COMPLETION,
C     COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE
C     OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE
C     EXPRESSION IS TRUE.
C
      ISTACK=NCHCMD+2
      COMAND(ISTACK)=14
      ISUFIX=181
      IPREV=3
      COMAND(NCHCMD+1)=41
      INFIX=EQUAL-1
C
C     GET A CHARACTER FROM INFIX.  LOOK UP IN CHTAB.  CHECK SYNTAX.
C
10    IF (INFIX.GT.NCHCMD) GO TO 180
      INFIX=INFIX+1
      J=COMAND(INFIX)
      IF (J.EQ.32) GO TO 10
C     32 = ASCII BLANK - IGNORE IT.
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      DO 20 I=1,15
      IF (CHTAB(I).EQ.J) GO TO 30
20    CONTINUE
      GO TO 230
30    J=COLTAB(I)
      IF (SYNTAX(IPREV,J)-1) 40,190,200
C
C     CONVERT INFIX TO SUFFIX
C
40    IPREV=J
50    J=COMAND(ISTACK)
      IF (TOS(J)-HOI(I)) 60,70,80
C     PUSH INFIX ONTO STACK
60    ISTACK=ISTACK+1
      COMAND(ISTACK)=I
      GO TO 10
C     DELETE TOP OF STACK
70    ISTACK=ISTACK-1
      IF (ISTACK.GT.NCHCMD+1) GO TO 10
      IF (INFIX-NCHCMD) 220,220,250
C     IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX.
C     IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX.
80    IF (J-9) 90,100,130
C     PRIMARY IS SYMBOL A-H
90    IF (PRED(1,J).EQ.0) GO TO 210
      J=PRED(2,J)
      GO TO 110
C     NULL PREDICATE
100   J=0
110   ISUFIX=ISUFIX-1
120   COMAND(ISUFIX)=J
      ISTACK=ISTACK-1
      GO TO 50
C     OPERATOR
130   J=J-9
      ISUFIX=ISUFIX+1
      GO TO (140,150,160,170), J
C             +   -   *   /
140   J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1)
      GO TO 120
150   J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1)
      GO TO 120
160   J=COMAND(ISUFIX)*COMAND(ISUFIX-1)
      GO TO 120
170   J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1))
      GO TO 120
C
180   COMAND(180)=-23
C     MESSAGE 23 - TOO MANY (
      GO TO 240
190   COMAND(180)=-24
C     MESSAGE 24 - MISSING PRIMARY
      GO TO 240
200   COMAND(180)=-25
C     MESSAGE 25 - MISSING OPERATOR
      GO TO 240
210   EQUAL=CHTAB(J)
      CALL EXCHAH (EQUAL,1)
      COMAND(180)=-26
C     MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE.
      GO TO 250
220   COMAND(180)=-27
C     MESSAGE 27 - TOO MANY )
      GO TO 240
230   COMAND(180)=-28
C     MESSAGE 28 - UNRECOGNIZED CHARACTER
C
240   EQUAL=INFIX
250   RETURN
C
      END
@HDG,P EXCHC5
@FTN,SVI EXCHC5
      SUBROUTINE EXCHC5 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE,
C     AND INDEX IF SELECTED.  COPY RECORDS FROM WORKF FIRST, IF ANY.
C     CREATE CONTROL RECORDS DEMANDED BY COMMANDS.
C
C     THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF
C     THE PARAMETER STRING.
C
C     AUTHOR
C     COMMENT
C     CONTROL (ITYPEO SET FROM MODIFY)
C     DATA TYPE
C     GROUPS
C     INSERT
C     KEYWORDS
C     MACHINE
C     ORIGIN
C     REFERENCES
C     REMOVE   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     SIGNAL   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     UPDATE
C
C     IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS
C     ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A
C     CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND.
C
C     *****     LOCAL VARIABLES     ************************************
C
C BLANK   CONTAINS A HOLLERITH BLANK.
      INTEGER BLANK
C C1      IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING.
      INTEGER C1
C COL1    THE FIRST COLUMN OF TEXT OF A CONTROL RECORD.  DERIVED FROM
C         EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE.
      INTEGER COL1
C I,J     USED FREELY AS INDICES.
      INTEGER I,J
C KCONT   THE INDEX IN COMD OF THE CONTROL COMMAND.
      INTEGER KCONT
C KNAME   IS THE INDEX IN COMD OF THE NAME COMMAND.
      INTEGER KNAME
C KTEXT   THE INDEX IN COMD OF THE TEXT COMMAND.
      INTEGER KTEXT
C KUPDA   THE INDEX IN COMD OF THE UPDATE COMMAND.
      INTEGER KUPDA
C LIST    CONTAINS THE WORD LIST IN ASCII.  USED FOR THE A OPTION.
      INTEGER LIST(4)
C NM      IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NM
C NOUT    IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NOUT
C NY      IS THE PROGRAM NUMBER.  IT IS THE NUMBER FROM INTAPE IF
C         OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE.
      INTEGER NY
C ONE     CONTAINS A HOLLERITH 1.
      INTEGER ONE
C REASON  REASON FOR COPYING A CONTROL RECORD.  1 = COPY COMMAND
C         PENDING.  2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8.
C         3 = COMMAND.
      INTEGER REASON
C RI      CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A
C         GIVEN RECORD TYPE.  RI IS SUBSCRIPTED BY (ITYPEO-64).
      INTEGER RI(26)
C RT      IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT.
      INTEGER RT(34)
C STAR    CONTAINS A HOLLERITH STAR.
      INTEGER STAR
C ZERO    CONTAINS A HOLLERITH ZERO.
      INTEGER ZERO
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL VARIABLE DATA     ********************************
C
      DATA BLANK /1H /
C                                            L  I  S  T
      DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/
C
      DATA KCONT /31/
      DATA KNAME /9/
      DATA KTEXT /27/
      DATA KUPDA/29/
      DATA ONE /1H1/
C                                                      A  B  C  D  E  F
      DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/
C                                                      G  H  I  J  K  L
      DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/
C                                                      M  N  O  P  Q  R
      DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/
C                                                      S  T  U  V  W  X
      DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/
C                                                      Y  Z
      DATA RI(25),RI(26)                             /31,31            /
C                                                     A  C     D     G
      DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/
C                                                           P     K
      DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/
C                                                     M     O
      DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/
C                                                              B  R
      DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/
C                                                                 S
      DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/
C                                                              J
      DATA RT(31),RT(32),RT(33),RT(34)              /-1, 0, 0,74/
C
      DATA STAR /1H*/
      DATA ZERO /1H0/
C
C     *****     PROCEDURES     *****************************************
C
      REASON=1
      NY=N1RECI
      IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1
C     ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P.
C     IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT.
      IF (PHASE.EQ.4) NY=0
C     NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER.  (IT IS PRINTED
C     IN THE INDEX).
      IF (ICOMD.LE.0) GO TO 10
      IF (PHASE.GE.4) GO TO 100
      IF (ICOMD.EQ.KNAME) GO TO 10
      IF (ICOMD.NE.KUPDA) GO TO 100
      REASON=2
      PHASE=8
10    IF (NRWORK.GT.0) REWIND WORKF
      NM=0
      NOUT=0
20    NM=NM+1
      IF (NM.LE.NRWORK) GO TO 60
30    IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230
C     69 = ASCII E, 73 = ASCII I.
      IF (NOUT.EQ.0) GO TO 40
      IF (ITYPEI.EQ.80) GO TO 230
C     80 = ASCII P.
      IF (NCHACT.NE.1) GO TO 40
      IF (INTREC(1).EQ.32) GO TO 220
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
40    ITYPEO=ITYPEI
      NCHOUT=NCHACT
      DO 50 J=1,NCHOUT
50    OUTREC(J+5)=INTREC(J)
      GO TO 70
60    READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT)
      IF (NCHOUT.NE.1) GO TO 70
      IF (NM.EQ.1) GO TO 70
      IF (OUTREC(6).EQ.32) GO TO 200
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
70    NOUT=NOUT+1
      J=RI(ITYPEO-64)
      DO 80 I=1,4
80    OUTREC(I)=COMD(I,J)
      OUTREC(5)=61
C     61 = ASCII =
      COL1=5
      IF (J.NE.KCONT) GO TO 130
      COL1=7
C     CONTROL,*=...  MOVE UP TWO CHARACTERS AND INSERT ITYPEO.
      DO 90 I=1,NCHOUT
90    OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I)
      OUTREC(5)=44
C     44 = ASCII COMMA.
      OUTREC(6)=ITYPEO
      OUTREC(7)=61
C     61 = ASCII =
      GO TO 130
100   IF (ICOMD.EQ.KTEXT) GO TO 240
      COL1=EQUAL-1
      NCHOUT=NCHCMD-COL1
      NRWORK=NRWORK+1
C     NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD.
      ITYPEO=RT(ICOMD)
      IF (ITYPEO.GT.0) GO TO 110
C     PROCESS CONTROL,TYPE=TEXT COMMAND.
      ITYPEO=MODIFY
      IF (RI(ITYPEO-64).NE.KCONT) GO TO 320
110   NOUT=NRWORK
      REASON=3
      DO 120 I=1,NCHCMD
120   OUTREC(I)=COMAND(I)
130   IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1)
C     74 = ASCII J.
      IF (ITYPEO.EQ.80) VERT=0
C     80 = ASCII P
      IF (ITYPEO.NE.68) GO TO 150
C     68 = ASCII D
      IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150
      DO 140 J=1,4
      I=OUTREC(J+COL1)
      IF (I.GT.96 .AND. I.LT.123) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.NE.LIST(J)) GO TO 150
140   CONTINUE
      VERT=1
C     GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE.
150   CALL EXCHCG (OUTREC(COL1+1))
      IF (OUTOPN.EQ.0) GO TO 160
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1))
      IF (ISTAT.NE.0) GO TO 340
      NY=NLRECO
160   NCHOUT=NCHOUT+COL1
C     TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER.
      OUTREC(180)=-NOUT
      IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC)
C     PRINT THE INDEX IF SELECTED.
      IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO
     1190
      IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190
      C1=BLANK
C     DOUBLE SKIP FOR PROGRAM HEADER (P).
      IF (ITYPEO.EQ.80) C1=ZERO
      IF (OPTV+VERT.NE.0) GO TO 170
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170
      IF (CHAR1L.NE.ONE) C1=ONE
      CHAR1L=ONE
170   CALL EXCHAH (OUTREC,NCHOUT)
      WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT)
180   FORMAT (A1,2I5,1H*,(3X,105A1))
190   IF (REASON.EQ.3) GO TO 310
200   IF (NM-NRWORK) 20,210,220
210   REWIND WORKF
      NRWORK=0
      GO TO 30
220   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT) 330,30,330
230   IF (REASON.EQ.2) GO TO 300
240   IF (OUFILE.EQ.0) GO TO 260
      DO 250 I=1,4
250   OUTREC(I)=COMD(I,KTEXT)
      OUTREC(180)=0
      NCHOUT=0
C     TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED.
      CALL EXCHCG (OUTREC)
      NCHOUT=4
      ACTION=2-OPTC-OPTC
C     ACTION = 2 MEANS START OF PROGRAM.
      CALL EXCHOU (OUTREC)
260   IF (OPTV+VERT.NE.0) GO TO 280
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280
      IF (OUTOPN.NE.0) NY=NLRECO
      I=BLANK
      IF (CHAR1L.NE.ONE) I=ONE
      WRITE (PRINTR,270) I,NY
270   FORMAT (A1,I5,1H*,8X,4HTEXT/)
280   CHAR1L=STAR
      NRWORK=MIN0(NRWORK,0)
      IF (IDOPTN.NE.67) IDCUR=IDSTRT
C     67 = ASCII C
      IF (ICOMD.EQ.KTEXT) GO TO 290
C
C     WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL
C     RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED.
C
      TRANS=6
      GO TO 370
C
C     WORKING ON A TEXT STATEMENT.
C
290   TRANS=7
      GO TO 370
C
C     WORKING ON AN UPDATE STATMENT.
C
300   NRWORK=NOUT
      GO TO 100
C
C     WRITING A SINGLE CONTROL RECORD.
C
310   TRANS=1
      GO TO 370
C
C     ERROR MESSAGES.
C
320   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER.
      GO TO 360
330   NUMBER=1
      GO TO 350
340   NUMBER=2
350   EQUAL=ISTAT
360   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM.
C
370   RETURN
C
      END
@HDG,P EXCHCG
@FTN,SVI EXCHCG
      SUBROUTINE EXCHCG (RECORD)
C
C     USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL.
C     WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED.
C     THIS IS THE PORTABLE VERSION.  IT DOES NOT DO ANYTHING.
C
      INTEGER RECORD(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      RETURN
      END
@HDG,P EXCHC6
@FTN,SVI EXCHC6
      SUBROUTINE EXCHC6 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE.
C
      INTEGER KNAME,ONE,SVHCMD(180)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KNAME /9/
      DATA ONE /1H1/
C
      LINEO=0
      NERRS=0
C     SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT.
      DO 5 I = 1,NCHCMD
5     SVHCMD(I)=HOLCMD(I)
      IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165
C     73 = ASCII I.  IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE
C     A VOID MODULE.
      IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10
      CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.EQ.7) GO TO 220
      IF (ISTAT) 250,160,250
10    MODEO=MODEI
      ITYPEO=0
      NBC=OPTL+OUFILE
      IF (INDEX.GT.0) NBC=1
20    NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTOPN.EQ.0) GO TO 120
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 260
C
C     CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD
C     INSTEAD OF BYTE-BY-BYTE).  WE CAN DO A BLOCK COPY IF
C     WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT
C     FILE AND NOT PRINTING THE INDEX.  ALSO, THE INPUT AND
C     OUTPUT CHARACTER POSITIONS MUST BE THE SAME.  IF THE
C     PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH
C     THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE
C     CURRENT POSITION IN THE BYTE BUFFER BE THE SAME.
C     WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE
C     LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T
C     KNOW THE LOCATION OF THE END-OF-FILE RECORD.
C
      IF (NBC.NE.0) GO TO 120
      IF (CPCBI+1.NE.CPCBO) GO TO 120
      IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120
C     WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF.
      IF (L1PRGI.EQ.0) GO TO 25
      IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30
25    IF (CCDBI+1.NE.CCDBO) GO TO 120
      IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120
C     WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE).
C     FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO.
30    LI=L1PRGI+NERRCI-1
      IF (L1PRGI.NE.0) GO TO 40
      LI=NERRCI+NDATAI+9
      IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1
40    IF (CPCBI.GE.NCCBI) GO TO 50
      IF (CCDBI.GE.LI) GO TO 160
      CPCBI=CPCBI+1
      CBLCKO(CPCBO)=CBLCKI(CPCBI)
      CPCBO=CPCBO+1
      CCDBI=CCDBI+1
      CCDBO=CCDBO+1
      GO TO 40
C     PACK COPIED BYTES.
50    CALL EXCHPA (CBLCKO,OBLOCK(CWDBO))
      CPCBO=1
      CPCBI=0
      CWDBO=CWDBO+NWCBO
      CWDBI=CWDBI+NWCBI
C     NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM
60    IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70
      IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=L1RECI
      CALL EXCHPB (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 260
70    IF (CCDBI.LT.LI) GO TO 80
      IF (L1PRGI.NE.0) GO TO 100
      CALL EXCHGB (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 250
      GO TO 30
80    NW=NWCBI*((LI-CCDBI)/NCCBI)
      IF (NW.EQ.0) GO TO 100
      DO 90 I=1,NW
      OBLOCK(CWDBO)=IBLOCK(CWDBI)
      CWDBO=CWDBO+1
90    CWDBI=CWDBI+1
100   CCDBO=CCDBO+LI-CCDBI
      CCDBI=LI
      IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60
      CPCBI=MOD(LI,NCCBI)
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      CALL EXCHUN (IBLOCK(CWDBI),CBLCKI)
      IF (CPCBI.EQ.0) GO TO 160
      DO 110 I=1,CPCBI
110   CBLCKO(I)=CBLCKI(I)
      GO TO 160
C
C     END OF BLOCK COPY CODE.
C
120   CALL EXCHTP (INTREC,LINEO)
160   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 250
      IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20
C     73 = ASCII I.
165   IF (OPTL.NE.0) GO TO 180
      IF (INDEX.LE.0) GO TO 195
      WRITE (PRINTR,170) LINEO
170   FORMAT (I9,14H IMAGES COPIED)
      GO TO 200
180   WRITE (PRINTR,190)
190   FORMAT (1H1)
195   CHAR1L=ONE
200   IF (OUFILE.EQ.0) GO TO 210
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
210   IF (ITYPEI.EQ.69) GO TO 220
C     69 = ASCII E
C
C     RETURN TO THE COPY CONTROL SEGMENT.
C
      DO 215 I=1,NCHCMD
215   HOLCMD(I)=SVHCMD(I)
      IF (ICOMD.EQ.-3) GO TO 240
C     ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE.
      TRANS=4
      IF (ICOMD.NE.KNAME) GO TO 280
C     MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME'
C     COMMAND SUBMITTED.  GO PROCESS 'NAME' COMMAND.
      TRANS=5
      PHASE=4
      GO TO 280
C
C     END OF FILE ON INPUT TAPE.
C
220   IF (INTOPN.LT.0) GO TO 240
      WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD)
230   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1))
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
240   TRANS=1
      GO TO 280
C
C     ERROR MESSAGES.
C
250   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      GO TO 270
260   NUMBER=2
C     MESSAGE 2 - I/O ERROR WRITING OUTAPE.
270   TRANS=8
      EQUAL=ISTAT
C
C     RETURN TO THE TRANSITION PROGRAM.
C
280   IF (NERRS.EQ.0) GO TO 300
      WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD)
290   FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./
     1(1X,80A1))
      NERRG=MAX0(NERRS,NERRG)
300   RETURN
C
      END
@HDG,P EXCHC7
@FTN,SVI EXCHC7
      SUBROUTINE EXCHC7 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
      INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40)
C
C     PROCESS THE TEXT COMMAND.
C
C MSG     IS USED TO PRINT A MESSAGE.
      INTEGER MSG(6,2)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/
      DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/
      DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/
      DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/
      DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/
C
      LINEI=1
      LINEO=0
      NERRS=0
      INEND=0
      CHAR1L=STAR
C
C     SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND
C
      K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 20 I=1,40
      IF (K.GT.NCHCMD) GO TO 10
      J=COMAND(K)
      K=K+1
      GO TO 20
10    J=32
C     32 = ASCII BLANK.
20    TXDISK(I)=J
      IF (INTOPN.LE.0) ITYPEI=0
C
C     MAIN PROCESSING LOOP
C
60    EDIT=0
70    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 80
C     NCHCMD.LT.0 MEANS END OF FILE.
      IF (NCHCMD.LT.2) GO TO 100
      IF (COMAND(1).NE.SIGNAL) GO TO 100
      IF (COMAND(2).EQ.SIGNAL) GO TO 80
      IF (COMAND(2).EQ.73) GO TO 370
      IF (COMAND(2).EQ.105) GO TO 370
C     73,105 = ASCII I - REQUEST TO INCLUDE TEXT.
      IF (NCHCMD.LT.3) GO TO 100
      IF (COMAND(2).NE.61) GO TO 100
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 70
C     END OF TEXT FILE.
80    IF (INTEXT.EQ.0) GO TO 90
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      CALL EXCHIM
      INTEXT=0
      NCHCMD=0
90    NCHCMD=MIN0(NCHCMD,0)
      IF (PHASE.NE.8) GO TO 660
      IF (INEND) 660,630,660
100   IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110
110   IF (EDIT.EQ.0) GO TO 450
C
C     PARTIAL LINE EDITOR.
C     INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED.
C     EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES
C     THE FIRST NON-BLANK CHARACTER AFTER N2.  N1 AND N2 ARE COLUMN
C     LIMITS UNDER WHICH TO PERFORM THE EDITING.  N1 AND ,N2 ARE
C     OPTIONAL.  IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT
C     LIMIT.  IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS
C     ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE.  WHEN
C     STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING
C     PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT
C     LENGTHS OF STRING1 AND STRING2.  THE THIRD DELIMITER IS
C     OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED
C     AFTER STRING2 IS INSERTED.
C
      IF (INEND.NE.0) GO TO 240
C     CONVERT COLUMN NUMBERS.
      NBR1=0
      NBR2=0
      I=0
120   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.EQ.44) GO TO 150
C     44 = ASCII COMMA
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR1=10*NBR1+J-48
      GO TO 120
130   WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD)
140   FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/
     1(1X,80A1))
      NERRS=2
      GO TO 70
150   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR2=10*NBR2+J-48
      GO TO 150
C     SCAN FOR DELIMITER
160   IF (J.NE.32) GO TO 170
C     32 = ASCII BLANK
      I=I+1
      J=COMAND(I)
      GO TO 160
170   D1=I
      NBR1=MIN0(NBR1,180)
      NBR2=MIN0(NBR2,180)
      IF (NBR1.EQ.0) NBR1=1
      IF (NBR2.EQ.0) GO TO 180
      IF (NBR2.LT.NBR1) GO TO 130
180   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      IF (COMAND(I).NE.J) GO TO 180
      D2=I
      D3=0
190   I=I+1
      IF (I.GT.NCHCMD) GO TO 200
      IF (COMAND(I).NE.J) GO TO 190
      D3=I
C     LOOK FOR SEARCH STRING (STRING1)
200   NUMBER=D2-D1-1
      J=NBR1
      IF (NUMBER.EQ.0) GO TO 260
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
210   DO 220 I=1,NUMBER
      IF (I+J-1.GT.NY) GO TO 240
      IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230
220   CONTINUE
      GO TO 260
230   J=J+1
      GO TO 210
240   WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1))
      NERRS=2
      GO TO 70
C     FOUND SEARCH STRING.  REPLACE WITH UPDATE STRING.
260   CHAR1L=PLUS
      IF (D3.NE.0) GO TO 300
C     NO THIRD DELIMITER.   REPLACE REST OF REGION.
      NY=NBR2
      IF (NY.EQ.0) NY=180
      D2=D2+1
      IF (D2.GT.NCHCMD) GO TO 280
      DO 270 I=D2,NCHCMD
      INTREC(J)=COMAND(I)
      J=J+1
      IF (J.GT.NY) GO TO 280
270   CONTINUE
280   IF (NBR2.NE.0) GO TO 290
      NCHACT=J-1
      GO TO 70
290   IF (J.GT.NBR2) GO TO 70
      INTREC(J)=32
C     32 = ASCII BLANK
      J=J+1
      GO TO 290
C     WE HAVE A THIRD DELIMITER.  REPLACE ONLY THE SEARCH STRING.
C     SHIFT THE REST OF THE REGION AS NECESSARY.
300   NUMBER=(D3-D2)-(D2-D1)
      IF (NUMBER) 310,350,330
C     SHIFT LEFT
310   I=J+D2-D1-1
      NY=MIN0(NBR2,NCHACT)
      IF (NY.EQ.0) NY=NCHACT
320   IF (I.GT.NY) GO TO 350
      INTREC(I+NUMBER)=INTREC(I)
C     NOTE - NUMBER .LT. 0 HERE
      INTREC(I)=32
C     32 = ASCII BLANK
      I=I+1
      GO TO 320
C     RIGHT SHIFT
330   I=NBR2
      IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180)
      NY=J+NUMBER
340   IF (I.LT.NY) GO TO 350
      INTREC(I)=INTREC(I-NUMBER)
      I=I-1
      GO TO 340
C     NO SHIFT NEEDED.
350   IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180)
      IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2)
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
C     MOVE UPDATE STRING (STRING2).
360   D2=D2+1
      IF (D2.GE.D3) GO TO 70
      INTREC(J)=COMAND(D2)
      J=J+1
      IF (J-NY) 360,360,70
C
C     REQUEST TO INCLUDE TEXT.  -I IN COLUMNS 1 AND 2.
C
370   IF (EDIT.EQ.0) GO TO 390
      WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD)
380   FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X
     1,80A1))
      NERRS=2
      GO TO 70
390   ITYPEO=73
C     73 = ASCII I
      IF (NCHCMD.GE.4) GO TO 410
      WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD)
400   FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A
     11))
      NERRS=2
      GO TO 70
410   DO 420 I=4,NCHCMD
      IF (COMAND(I).NE.32) GO TO 430
420   CONTINUE
C     CONVERT TO UPPER CASE.  WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM
430   K=0
      DO 440 J=I,NCHCMD
      IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32
      K=K+1
440   COMAND(K)=COMAND(J)
      NCHCMD=K
      GO TO 460
C
C     TEXT RECORD.
C
450   ITYPEO=0
460   NCHOUT=NCHCMD
      IF (OUTOPN.EQ.0) GO TO 470
      MODEO=0
      CALL EXCHPR (ISTAT,OBLOCK,COMAND)
      IF (ISTAT.NE.0) GO TO 770
470   CALL EXCHTP (COMAND,0)
      GO TO 70
C
C     APPARENT CHANGE CONTROL COMMAND
C
480   IF (INEND.EQ.0) GO TO 510
490   WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD)
500   FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT
     1 END./(1X,80A1))
      NERRS=1
      GO TO 70
510   NUMBER=1
      NBR1=0
      EDIT=0
      I=1
520   I=I+1
      IF (I.GT.NCHCMD) GO TO 600
      J=COMAND(I)
      IF (J.EQ.32) GO TO 600
C     32 = ASCII BLANK
      IF (EDIT.NE.0) GO TO 530
C     EDIT CONTROL MUST BE BLANK AFTER $.
      IF (J.EQ.44) GO TO 570
C     44 = ASCII COMMA
      IF (J.EQ.36) GO TO 560
C     36 = ASCII $
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.LE.57) GO TO 550
C     57 = ASCII 9
530   WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD)
540   FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1)
      NERRS=2
      GO TO 60
550   NBR1=10*NBR1+J-48
      GO TO 520
560   IF (NBR1.EQ.0) GO TO 530
      EDIT=1
      NBR1=NBR1-1
      GO TO 520
570   NUMBER=2
      NBR2=0
580   I=I+1
      IF (I.GT.NCHCMD) GO TO 590
      J=COMAND(I)
      IF (J.EQ.32) GO TO 590
C     32 = ASCII BLANK
      IF (IABS(J-44).EQ.1) GO TO 590
C     43 = ASCII +, 45 = ASCII -
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 530
C     57 = ASCII 9
      NBR2=10*NBR2+J-48
      GO TO 580
590   IF (NBR2.LT.NBR1) GO TO 530
      NBR1=NBR1-1
600   IF (NBR1.GE.LINEI-1) GO TO 620
      WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD)
610   FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1)
      NERRS=2
      GO TO 60
620   IF (NCHCMD.LE.0) GO TO 630
      IF (LINEI.LE.NBR1) GO TO 630
      IF (NUMBER.EQ.1) GO TO 70
C     SKIP INTAPE UNTIL NBR2 IS SKIPPED.
      MODEI=1
      IF (LINEI.GE.NBR2) MODEI=0
      IF (LINEI-NBR2) 650,650,70
C     COPY FROM INTAPE UNTIL NBR1 COPIED.
630   MODEO=MODEI
      NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTAPE.EQ.0) GO TO 640
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 770
640   CALL EXCHTP (INTREC,LINEI)
      MODEI=0
      IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650
      IF (LINEI.EQ.NBR1) GO TO 650
      MODEI=1
650   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 760
      LINEI=LINEI+1
      IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620
C     73 = ASCII I
      INEND=1
      IF (NCHCMD.LE.0) GO TO 660
      I=NBR2
      IF (NUMBER.EQ.1) I=NBR1
      IF (LINEI-I) 490,490,70
660   IF (NERRS.EQ.0) GO TO 675
      J=1
      IF (PHASE.EQ.8) J=2
      WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS
670   FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.)
675   NERRG=MAX0(NERRG,NERRS)
      IF (OPTL+OPTS.NE.0) GO TO 690
      IF (OUTAPE+OUFILE.EQ.0) LINEO=0
      IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO
680   FORMAT (I9,14H IMAGES COPIED)
      GO TO 710
690   WRITE (PRINTR,700)
700   FORMAT (1H1)
      CHAR1L=ONE
710   IF (OUFILE.EQ.0) GO TO 720
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
720   IF (ITYPEI.NE.69) GO TO 750
C     69 = ASCII E
C
C     END OF FILE ON INPUT TAPE (UPDATE MODE).
C
      IF (INTOPN.LT.0) GO TO 750
      DO 730 I=1,40
730   HOLCMD(I+1)=TXDISK(I)
      HOLCMD(1)=32
      IF (TXDISK(1).NE.32) HOLCMD(1)=61
C     32 = ASCII BLANK, 61 = ASCII =
      CALL EXCHAH (HOLCMD,41)
      WRITE (PRINTR,740) (HOLCMD(I),I=1,41)
740   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1)
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
750   TRANS=1
      GO TO 790
C
C     ERROR MESSAGES.
C
760   NUMBER=1
      GO TO 780
770   NUMBER=2
780   EQUAL=ISTAT
      TRANS=8
C
C     RETURN TO THE TRANSITION PROGRAM.
C
790   PHASE=2
      IF (OUTOPN.EQ.0) PHASE=1
      RETURN
C
      END
@HDG,P EXCHC8
@FTN,SVI EXCHC8
      SUBROUTINE EXCHC8
C
C     PRINT ERROR MESSAGES.
C
C     ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE
      INTEGER S(31)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/
      DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/
      DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/
      DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/
      DATA S(29),S(30),S(31)                         /4,5,5        /
C
C             1  2  3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4
     160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751),
     2NUMBER
C     16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
10    WRITE (PRINTR,20) EQUAL
20    FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.)
      GO TO 50
30    WRITE (PRINTR,40) EQUAL
40    FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.)
50    GO TO (60,80,100,120,140,160), EQUAL
60    WRITE (PRINTR,70)
70    FORMAT (22H BLOCK SEQUENCE ERROR.)
      GO TO 180
80    WRITE (PRINTR,90)
90    FORMAT (20H BLOCK IS TOO SHORT.)
      GO TO 180
100   WRITE (PRINTR,110)
110   FORMAT (11H I/O ERROR.)
      GO TO 180
120   WRITE (PRINTR,130)
130   FORMAT (18H RECORD TOO LARGE.)
      GO TO 180
140   WRITE (PRINTR,150)
150   FORMAT (21H UNKNOWN RECORD TYPE.)
      GO TO 180
160   WRITE (PRINTR,170)
170   FORMAT (25H FIRST BLOCK NOT A LABEL.)
      GO TO 760
180   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1)
      INFILE=0
C
C     RETURN TO QUIT SEGMENT.
C
      TRANS=9
      GO TO 800
C
200   WRITE (PRINTR,210)
210   FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.)
      GO TO 760
220   WRITE (PRINTR,230)
230   FORMAT (//20H0INTAPE NOT DEFINED.)
      GO TO 760
240   WRITE (PRINTR,250)
250   FORMAT (//23H0UNABLE TO OPEN INTAPE.)
      GO TO 10
260   WRITE (PRINTR,270)
270   FORMAT (//23H0UNABLE TO OPEN OUTAPE.)
      GO TO 30
280   WRITE (PRINTR,290)
290   FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.)
      GO TO 760
300   WRITE (PRINTR,310)
310   FORMAT (//19H0DATE NOT SUPPLIED.)
      GO TO 760
320   WRITE (PRINTR,330)
330   FORMAT (//19H0SITE NOT SUPPLIED.)
      GO TO 760
340   WRITE (PRINTR,350) INTAPE
350   FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4)
      GO TO 760
360   WRITE (PRINTR,370)
370   FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.)
      GO TO 760
380   WRITE (PRINTR,390)
390   FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.)
      GO TO 760
400   WRITE (PRINTR,410)
410   FORMAT (//27H0COMMAND HAS IMPROPER DATE.)
      GO TO 760
420   WRITE (PRINTR,430) EQUAL
430   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.)
      GO TO 780
440   WRITE (PRINTR,450)
450   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.)
      IF (ICOMD) 780,560,780
460   WRITE (PRINTR,470) N1RECI
470   FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO
     1N (,I5,2H).)
      GO TO 760
480   WRITE (PRINTR,490) EQUAL
490   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
500   WRITE (PRINTR,510)
510   FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.)
      GO TO 760
520   WRITE (PRINTR,530)
530   FORMAT (//23H0WORK FILE NOT DEFINED.)
      GO TO 760
540   WRITE (PRINTR,550)
550   FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.)
      GO TO 760
560   WRITE (PRINTR,570) EQUAL
570   FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.)
      GO TO 760
580   WRITE (PRINTR,590)
590   FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE
     1R.)
      GO TO 760
600   WRITE (PRINTR,610)
610   FORMAT (//12H0TOO MANY (.)
      GO TO 760
620   WRITE (PRINTR,630) EQUAL
630   FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.)
      GO TO 760
640   WRITE (PRINTR,650) EQUAL
650   FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.)
      GO TO 760
660   WRITE (PRINTR,670) EQUAL
670   FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.)
      GO TO 760
680   WRITE (PRINTR,690) EQUAL
690   FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.)
      GO TO 760
700   WRITE (PRINTR,710) EQUAL
710   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
720   WRITE (PRINTR,730) N1RECI
730   FORMAT (//21H0INTAPE POSITIONED AT,I5,25H.  BACKWARD SKIP IGNORED.
     1)
      GO TO 780
740   WRITE (PRINTR,750)
750   FORMAT (//23H0COMMAND IS INCOMPLETE.)
      GO TO 760
751   WRITE (PRINTR,752)
752   FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA
     1PE OR OUTPUT.)
760   WRITE (PRINTR,770)
770   FORMAT (23H COMMAND NOT PROCESSED.)
780   WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD)
790   FORMAT ((1X,80A1))
C
C     RETURN TO COMMAND PROCESSSOR.
C
      CHAR1L=0
      NERRS=MAX0(S(NUMBER),NERRS)
      NERRG=MAX0(NERRG,NERRS)
      TRANS=1
C
C     RETURN TO TRANSITION PROGRAM.
C
800   RETURN
C
      END
@HDG,P EXCHC9
@FTN,SVI EXCHC9
      SUBROUTINE EXCHC9 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO
C     ERRORS.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KQUIT /20/
C
      IF (INFILE.EQ.0) GO TO 10
      IF (MODIFY.NE.82) GO TO 5
C     82 = ASCII R
      ACTION=2
C     ACTION = 2 MEANS REWIND INFILE.
      CALL EXCHIM
5     ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      CALL EXCHIM
      INFILE=0
      NCHCMD=0
      GO TO 50
10    IF (OPTC*OUFILE.EQ.0) GO TO 20
      ACTION=0
      NCHOUT=4
      CALL EXCHOU (COMD(1,KQUIT))
20    ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      IF (OUTOPN.EQ.0) GO TO 30
C     WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC)
C     CLOSE THE INPUT TAPE.
30    IF (INTOPN.EQ.0) GO TO 40
      ISTAT=4
      CALL EXCHRT (ISTAT,OBLOCK)
C
C     RETURN TO MAIN PROGRAM.
C
40    TRANS=0
      IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG
45    FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.)
      GO TO 60
C
C     RETURN TO THE COMMAND DECODER.
C
50    TRANS=1
60    RETURN
C
      END
@HDG,P EXCHMAP
@MAP,SI EXCHMAP,EXCH
SEG  MAIN
     IN  EXCHMAIN,EXCHBD
SEG  EXCH$C1*,(MAIN)
     IN  EXCHC1,EXCHCX
SEG  EXCH$C2*,(MAIN)
     IN  EXCHC2
SEG  EXCH$C3*,(MAIN)
     IN  EXCHC3,EXCHRH,EXCHWH
SEG  EXCH$C4*,(MAIN)
     IN  EXCHC4,EXCHLX
SEG  EXCH$C5*,(MAIN)
     IN  EXCHC5,EXCHCG
SEG  EXCH$C6*,(MAIN)
     IN  EXCHC6
SEG  EXCH$C7*,(MAIN)
     IN  EXCHC7
SEG  EXCH$C8*,(MAIN)
     IN  EXCHC8
SEG  EXCH$C9*,(MAIN)
     IN  EXCHC9
END
=TES FILE=5
      PROGRAM TES
C========================
C EXCHANGE PROGRAMS
C DISTRIBUTED BY W. VAN SNYDER, JET PROPULSION LABORATORY
C
C THIS IS THE MAIN PROGRAM FOR THE VAX/VMS V2.4 IMPLEMENTATIONS
C
C KAREN HASKELL, SNLA -- JUNE, 1982
C AND R.J. HANSON.
C========================
C
      INTEGER IBLOCK(0900)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
C
       NWCBI = 45
       READER = 5
       PRINTR = 6
C      PROVIDE INITIAL CONDITIONS FOR SIMPLE PROGRAM.
       WORKF  = 7
       CALL EXCH (IBLOCK)
       STOP
       END
      BLOCK DATA
C
C     BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/
      DATA INTEXT /0/, INALT /0/
C
      DATA CHAR1L /1H1/
C                                                        A  U  T  H
      DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1)  /65,85,84,72/
C                                                        C  O  M  M
      DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2)  /67,79,77,77/
C                                                        C  O  P  Y
      DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3)  /67,79,80,89/
C                                                        D  A  T  A
      DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4)  /68,65,84,65/
C                                                        D  A  T  E
      DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5)  /68,65,84,69/
C                                                        G  R  O  U
      DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6)  /71,82,79,85/
C                                                        I  N  D  E
      DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7)  /73,78,68,69/
C                                                        I  N  P  U
      DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8)  /73,78,80,85/
C                                                        N  A  M  E
      DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9)  /78,65,77,69/
C                                                        I  N  T  A
      DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/
C                                                        K  E  Y  W
      DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/
C                                                        L  I  M  I
      DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/
C                                                        M  A  C  H
      DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/
C                                                        O  P  T  I
      DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/
C                                                        O  R  I  G
      DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/
C                                                        O  U  T  A
      DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/
C                                                        O  U  T  P
      DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/
C                                                        P  R  E  D
      DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/
C                                                        P  R  I  N
      DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/
C                                                        Q  U  I  T
      DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/
C                                                        R  E  A  D
      DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/
C                                                        R  E  F  E
      DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/
C                                                        R  E  M  O
      DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/
C                                                        R  E  W  I
      DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/
C                                                        S  I  T  E
      DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/
C                                                        S  K  I  P
      DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/
C                                                        T  E  X  T
      DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/
C                                                        T  I  T  L
      DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/
C                                                        U  P  D  A
      DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/
C                                                        W  O  R  K
      DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/
C                                                        C  O  N  T
      DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/
C                                                        I  D  E  N
      DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/
C                                                        I  N  C  L
      DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/
C                                                        S  I  G  N
      DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/
C                                                        M  A  R  G
      DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/
      DATA IDSTEP /0/, IDTXTL /0/
      DATA INDEX /0/
      DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/
      DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/
      DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/
      DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/
      DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/
      DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/
      DATA INDEXS(25),INDEXS(26)                       /0,0    /
      DATA INTOPN /0/
      DATA ITYPEI /0/
      DATA LIMIT /0/
      DATA MARGIN /180/
      DATA NCCBI /180/
      DATA NCCBO /180/
      DATA NCHCMD /0/
      DATA NCHMAX /180/
      DATA NCOMDP /35/
      DATA NCOMDT /35/
      DATA NDATAO /3591/
      DATA NERRCO /0/
      DATA NERRG /0/
      DATA NRWORK /0/
      DATA OUTOPN /0/
      DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/
      DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/
      DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/
      DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/
      DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/
      DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/
      DATA OPTVAL(25),OPTVAL(26)                       /0,0    /
      DATA PHASE /1/
C     INDICATE THAT NO PREDICATES ARE DEFINED.
      DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/
      DATA PRED(1,6),PRED(1,7),PRED(1,8)                     /0,0,0    /
      DATA SITE(1) /0/
      DATA TITLE(1) /32/
C     32 = ASCII BLANK
      DATA TODAY (1) /0/
      DATA TRANS /1/
      END
      SUBROUTINE EXCH (IBLOCK)
C
C     VAX/VMS INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM.
C     IT KNOWS HOW TO FETCH THE DATE FROM THE SYSTEM.
C
      INTEGER IBLOCK(1)
C
C     ALLOCATE SPACE FOR TAPE OUTPUT
C
      INTEGER OBLOCK(0900)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
       INTEGER MKDTTD,MKDTOD
C
C      MAKE DATE TENS DIGIT AND MAKE DATE ONES DIGIT.
       MKDTTD(M) = M/10 + 48
       MKDTOD(N) = MOD(N,10) + 48
C
       NWCBO = 45
       WORKF  = 7
      TABS='Y'
C
C      THIS PRESET IS NEEDED SO THAT THE CORRECT OPEN
C      SEQUENCE IS DONE FOR THE PRINTER AT THE BEGINNING.
      NCHCMD=0
      EQUAL=1
C     GET THE DATE FROM THE SYSTEM.
       CALL IDATE(I,J,K)
       TODAY(1) = MKDTTD(K)
       TODAY(2) = MKDTOD(K)
       TODAY(3) = MKDTTD(I)
       TODAY(4) = MKDTOD(I)
       TODAY(5) = MKDTTD(J)
       TODAY(6) = MKDTOD(J)
C
C      THE FOLLOWING SITE INFO. IS FOR SANDIA NATL. LABS. ONLY.
C
C      SITE(1)=83
C      SITE(2)=65
C      SITE(3)=78
C      SITE(4)=68
C      SITE(5)=73
C      SITE(6)=65
C      SITE(7)=32
C      SITE(8)=78
C      SITE(9)=97
C      SITE(10)=116
C      SITE(11)=108
C      SITE(12)=46
C      SITE(13)=32
C      SITE(14)=76
C      SITE(15)=97
C      SITE(16)=98
C      SITE(17)=115
C      SITE(18)=46
C      SITE(19)=32
C      SITE(20)=56
C      SITE(21)=55
C      SITE(22)=49
C      SITE(23)=56
C      SITE(24)=53
C      SITE(25)=32
C      SITE(26)=50
C      SITE(27)=54
C      SITE(28)=48
C      SITE(29)=48
C      SITE(30)=32
C      SITE(31)=86
C      SITE(32)=65
C      SITE(33)=88
C      DO 10 I=34,40
C  10  SITE(I)=32
C
C      END OF SANDIA LABS. SITE DEFN.
C
C      DEFINE THE COMMAND 'TABS='.
       NCOMDT=NCOMDP+1
       COMD(1,NCOMDT)=84
       COMD(2,NCOMDT)=65
       COMD(3,NCOMDT)=66
       COMD(4,NCOMDT)=83
       CALL EXCHTR (IBLOCK,OBLOCK)
       RETURN
       END
      SUBROUTINE EXCHAH (RECORD,NCHAR)
C
C     CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO
C     HOLLERITH FORMAT.
C
      INTEGER RECORD(1),NCHAR
      INTEGER BLANKZ,I
      DATA BLANKZ /'20202000'X/
C
      DO 10 I = 1, NCHAR
10    RECORD(I)=RECORD(I) + BLANKZ
C
      RETURN
      END
      SUBROUTINE EXCHFO (IOP)
C
C     VAX-11 USING VMS V2.4
C     THIS VERSION IS FOR THE COMPREHENSIVE PROGRAM ONLY.
C
C     OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM.
C     IOP LESS THAN    ZERO MEANS CLOSE FILE,
C     IOP GREATER THAN ZERO MEANS OPEN FILE.
C     IABS(IOP) = 1 MEANS READER,
C               = 2 MEANS PRINTER,
C               = 3 MEANS WORK FILE,
C               = 4 MEANS INFILE.  IOP = 4 IS USED ONLY BY THE
C                   BOOTSTRAP PROGRAM.
C
C
      INTEGER IOP, JUMP
      CHARACTER*11 PNAME
      CHARACTER*40 NAME
      logical OD
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      DATA PNAME/'EXCHXX.LIS '/
C
      JUMP=IABS(IOP)
      IF (IOP.LT.0) GO TO (10,20,30), JUMP
      GO TO (50,60,70), JUMP
C
C     CLOSE FILES.
10    GO TO 90
20    CLOSE (UNIT=PRINTR)
      GO TO 90
30    CLOSE (UNIT=WORKF)
      GO TO 90
C
C     OPEN FILES.
50    GO TO 90
60    CONTINUE
      K=MIN0(NCHCMD-EQUAL+1,40)
      IF(K.GT.0.AND.PRINTR.NE.6) THEN
        NAME=' '
        DO 65 I=1,K
        NAME(I:I)=CHAR(COMAND(EQUAL+I-1))
65      CONTINUE
      ELSE IF(PRINTR.EQ.6) THEN
        NAME='TT:'
      ELSE
        NAME=PNAME
        NAME(5:6)=CHAR(PRINTR/10+48)//CHAR(MOD(PRINTR,10)+48)
      END IF
      inquire (file=name,number=inum,opened=od)
      if (.not.od .or. (inum.ne.printr))
     1OPEN(UNIT=PRINTR,FILE=NAME,STATUS='UNKNOWN',ERR=100)
      GO TO 90
70    CONTINUE
      OPEN(UNIT=WORKF,DISP='DELETE',ERR=120,FORM=
     * 'UNFORMATTED',STATUS='UNKNOWN')
C
90    RETURN
C
100   print 110
110   FORMAT (' Unable to open PRINTER file.')
      GO TO 140
120   WRITE (PRINTR,130)
130   FORMAT (' Unable to open WORK file.')
140   STOP
      END
C========================
C EXCHANGE PROGRAM, VAX/VMS IMPLEMENTATION.
C
C READ A COMMAND OR TEXT IMAGE FROM    1. ALTERNATE CORRECTION FILE
C                                      2. TEXT FILE
C                                      3. INPUT FILE
C                                      4. SYSTEM READER
C IF READING FROM -READER-, PUT A PROMPT ON THE TERMINAL
C PUT THE HOLLERITH COMMAND IN HOLCMD
C PUT THE ASCII EQUIVALENT IN COMAND
C PUT THE NUMBER OF CHARACTERS IN NCHCMD
C IF END-OF-FILE IS SENSED, SET NCHCMD=-1
C IF THE VARIABLE -TABS- IS TRUE, KEEP THE TAB CHARACTERS
C
C ROUTINE READS 133 CHARACTER IMAGES
C========================
C
       SUBROUTINE EXCHIM
C
      INTEGER BLANK,BFILL,RDFILE
      INTEGER TMPLIN(133)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
       EQUIVALENCE (TMPLIN(1),COMAND(1))
       DATA BLANK/1H /
C
C    DETERMINE WHICH FILE TO WORK ON.
       RDFILE = INALT
       IF (RDFILE .GT. 0) GO TO 1000
       RDFILE = INTEXT
       IF (RDFILE .NE. 0) GO TO 1000
       RDFILE = INFILE
       IF (RDFILE .EQ. 0) RDFILE = READER
C
C   PERFORM ACTION.  FILES ARE OPENED IN EXCHCX.
1000   I = ACTION + 2
       GO TO (5000,4000,7000,2000),I
       RETURN
C
C   REWIND INALT
2000   REWIND RDFILE
       GO TO 7000
C
C   READ IN A LINE, MAPPING TABS IF NECESSARY
C
C      THE FOLLOWING TEST MUST BE CHANGED IF TTY IS OTHER THAN UNIT 5.
4000   IF (RDFILE .EQ. 5 .AND. PRINTR.EQ. 6) WRITE(PRINTR,601)
       READ (RDFILE,501,END=8000) M,(TMPLIN(I),I=1,M)
       NCHCMD=0
       IF (M .EQ. 0) GO TO 7000
       DO 4090 I=1,M
      IF(TABS.EQ.'Y') GO TO 4070
      IF((TMPLIN(I).AND."0177) .NE. 9) GO TO 4070
C          9 IS ASCII HT (HORIZONTAL TAB).
           BFILL = 8 - MOD(NCHCMD,8)
           DO 4040 J=1,BFILL
               NCHCMD=NCHCMD+1
               HOLCMD(NCHCMD)=BLANK
4040           CONTINUE
           GO TO 4090
4070       NCHCMD=NCHCMD+1
           HOLCMD(NCHCMD)=TMPLIN(I)
4090       CONTINUE
       DO 4190 I=1,NCHCMD
           COMAND(I) = HOLCMD(I) .AND. "0177
4190       CONTINUE
       M=NCHCMD
       DO 4200 I=1,M
           IF (COMAND(M-I+1).EQ.32) GO TO 4200
C          32 = ASCII BLANK.
           NCHCMD=M-I+1
           GO TO 7000
4200       CONTINUE
       NCHCMD=0
       GO TO 7000
C
C   CLOSE A FILE.
C      DO NOT CLOSE INPUT FILES IF 'T' OPTION SPECIFIED.
5000   IF (OPTVAL(20).EQ.0) CLOSE (UNIT=RDFILE)
C
7000   ACTION = 0
       RETURN
C
8000   NCHCMD = -1
       GO TO 7000
501    FORMAT(Q,133A1)
601    FORMAT('$*')
       END
      SUBROUTINE EXCHOU (OUTPUT)
C
C     NATIVE FORMAT OUTPUT PROGRAM. FOR THE TEXT EXCHANGE PROGRAM.
C     VAX/VMS IMPLEMENTATION.
C
C     OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN.
C     THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT.
C
C     THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180),
C     THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179).  IF OUTPUT(180)
C     IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE.  IF OUTPUT(180)
C     IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW
C     IMAGE.
C
      INTEGER OUTPUT(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C   DECIDE WHETHER TO OPEN, CLOSE OR WRITE.
C
      IF (ACTION.NE.0) IF (ACTION+1) 70,40,70
      WRITE (OUFILE,30) (OUTPUT(I),I=1,NCHOUT)
30    FORMAT (133A1)
      GO TO 70
40    CLOSE(UNIT=OUFILE)
C
70    ACTION=0
      RETURN
      END
      SUBROUTINE EXCHPA (BUFIN,BUF9T)
C
C     CHARACTER PACKING ROUTINE FOR THE VAX-11 SERIES MACHINES.
C     OPERATING SYSTEM VAX/VMS VERSION V2.1
C     THE BYTE DATA TYPE IS USED TO PACK THE CHARACTERS FROM THE
C     WORKING BUFFER BUFIN(*), WHERE THEY ARE STORED ONE CHARACTER
C     PER WORD, TO BUF9T(*).
C
C     WRITTEN BY R. J. HANSON AND K. H. HASKELL,
C     SANDIA LABS., JUNE,  1981.
C
      BYTE BUFIN(720),BUF9T(180)
C
      DO 10 I=1,180
      BUF9T(I)=BUFIN(4*I-3)
   10 CONTINUE
      RETURN
      END
      SUBROUTINE EXCHRT (ISTAT,INPBUF)
C
C     TAPE INPUT ROUTINE FOR THE VAX-11 SERIES MACHINES.
C     OPERATING SYSTEM VAX/VMS VERSION V2.4
C     NOTE -- INTEGER*4 IS ASSUMED DEFAULT.
C
C     KAREN HASKELL, SNLA -- JUNE, 1981
C     AND R. J. HANSON.
C     REVISED 820616 1500
C
C     INPUT PARAMETERS
C       ISTAT = 1  OPEN INPUT TAPE, NO REWIND
C             = 2  REWIND AND CLOSE INPUT TAPE
C             = 3  READ FROM TAPE INTO INPBUF(*)
C             = 4  CLOSE INPUT TAPE, NO REWIND
C       INPBUF -- THE BUFFER INTO WHICH THE DATA IS TO BE READ.
C
C     OUTPUT PARAMETERS
C       ISTAT = 0  IF NO ERRORS OCCURRED
C             = 3  IF ANY TYPE OF ERROR OCCURRED.
C                  (AN INFORMATIVE MESSAGE WILL USUALLY BE PRINTED)
C
      INTEGER ISTAT,INPBUF(1)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*40 FNAMES(3)
      CHARACTER*1 TABS
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
C
      IF ((ISTAT.LT.1) .OR. (ISTAT.GT.4)) GO TO 240
      GO TO (10,60,70,120), ISTAT
C
C     OPEN TAPE, NO REWIND
10    CONTINUE
      OPEN (UNIT=INTAPE,FILE=FNAMES(2),ERR=130,IOSTAT=IERR,
     * RECL=3600,STATUS='OLD',RECORDTYPE='VARIABLE',
     * CARRIAGECONTROL='NONE',READONLY)
      GO TO 230
C
C     REWIND AND CLOSE INPUT TAPE
60    CONTINUE
      REWIND (UNIT=INTAPE,ERR=150,IOSTAT=IERR)
      GO TO 230
C
C     READ INTO INPBUF
70    CONTINUE
      NCDBI=NDATAI+NERRCI+9
      NWORDS=(NCDBI+3)/4
      DO 110 I=1,2
C
C     READ A BUFFER FROM INTAPE INTO INPBUF.
       READ(INTAPE,80,END=100,ERR=100,IOSTAT=IERR)(INPBUF(J),J=1,NWORDS)
80    FORMAT(255(10A4))
       GO TO 230
C
C     ALLOW ONE END-OF-FILE IF EXPECTING LABEL.
100    IF (IERR.EQ.(-1).AND.BLKSQI.NE.0) GO TO 170
       IF (IERR.GT.0) GO TO 175
110   CONTINUE
      GO TO 170
C
C     CLOSE INPUT TAPE WITH NO REWIND.
120   CONTINUE
      GO TO 230
C
C     PROCESS ERROR CONDITIONS
130   CONTINUE
      IF (IERR .NE.(-1)) GO TO 140
      WRITE (PRINTR,180)
      GO TO 240
140   CONTINUE
      WRITE (PRINTR,190) IERR
      GO TO 240
C
150   CONTINUE
      IF (IERR .NE.(-1)) GO TO 160
      WRITE (PRINTR,200)
      GO TO 240
160   CONTINUE
      WRITE (PRINTR,210) IERR
      GO TO 240
C
170   CONTINUE
      IF (IERR.EQ.(-1)) WRITE (PRINTR,220)
      GO TO 240
C
175   CONTINUE
      WRITE (PRINTR,225) IERR
      GO TO 240
C
180   FORMAT ('0Attempted open at end-of-file on INTAPE')
190   FORMAT ('0Error condition occurred while opening INTAPE, IOSTAT=',
     * Z8)
200   FORMAT ('0End-of-file on close/rewind of INTAPE')
210   FORMAT ('0Error condition occurred with close/rewind on INTAPE, IO
     *STAT=',Z8)
220   FORMAT ('0Unexpected end-of-file on INTAPE.')
225   FORMAT ('0Error condition occurred while reading INTAPE, IOSTAT=',
     * Z8)
C
230   CONTINUE
      ISTAT=0
      RETURN
240   CONTINUE
      CALL LIB$SIGNAL (%VAL(IERR))
250   CONTINUE
      ISTAT=3
      RETURN
C
      END
      SUBROUTINE EXCHUN (BUF9T,BUFOUT)
C
C     CHARACTER UNPACKING ROUTINE FOR THE VAX-11 SERIES MACHINES.
C     OPERATING SYSTEM VAX/VMS VERSION V2.1
C     THE BYTE DATA TYPE IS USED TO UNPACK THE CHARACTERS FROM THE
C     INPUT BLOCK BUF9T(*) TO THE OUTPUT BUFFER BUFOUT(*), ONE
C     CHARACTER PER WORD.
C     NOTE -- INTEGER*4 IS ASSUMED DEFAULT.
C
C     WRITTEN BY R. J. HANSON AND K. H. HASKELL,
C     SANDIA LABS., JUNE,  1981.
C
      BYTE BUF9T(180),BUFOUT(720)
      BYTE IZERO
      DATA IZERO /'00'X/
C
      DO 10 I = 1, 180
      BUFOUT(4*I-3)=BUF9T(I)
      BUFOUT(4*I-2)=IZERO
      BUFOUT(4*I-1)=IZERO
      BUFOUT(4*I)=IZERO
   10 CONTINUE
      RETURN
      END
      SUBROUTINE EXCHWT(ISTAT,OUTBUF)
C
C     TAPE OUTPUT ROUTINE FOR THE VAX-11 SERIES MACHINES.
C     OPERATING SYSTEM VAX/VMS VERSION V2.4
C     NOTE -- INTEGER*4 IS ASSUMED DEFAULT.
C
C     KAREN HASKELL, SNLA -- JUNE,  1981
C     AND R. J. HANSON.
C     REVISED 820616 1500
C
C     INPUT PARAMETERS
C       ISTAT = 1  OPEN OUTPUT TAPE, NO REWIND
C             = 2  WRITE CONTENTS OF OUTBUF(*) TO OUTPUT TAPE
C             = 3  CLOSE OUTPUT TAPE, NO REWIND
C       OUTBUF -- THE BUFFER FROM WHICH THE DATA IS TO BE WRITTEN
C
C     OUTPUT PARAMETERS
C       ISTAT = 0  IF NO ERRORS OCCURRED
C             = 3  IF ANY TYPE OF ERROR OCCURRED
C                  (AN INFORMATIVE MESSAGE WILL USUALLY BE PRINTED)
C
      INTEGER ISTAT,OUTBUF(1)
      INTEGER EXPSIZ
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*40 FNAMES(3)
      CHARACTER*1 TABS
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
C
      IF ((ISTAT.LT.1) .OR. (ISTAT.GT.3)) GO TO 150
      GO TO (10,50,80), ISTAT
C
C     OPEN OUTAPE, NO REWIND.
10    CONTINUE
      OPEN (UNIT=OUTAPE,FILE=FNAMES(3),ERR=100,IOSTAT=IERR,
     * RECL=3600,STATUS='NEW',RECORDTYPE='VARIABLE',
     * CARRIAGECONTROL='NONE')
      GO TO 90
C
C     WRITE CONTENTS OF OUTBUF(*) TO OUTAPE
50    CONTINUE
      EXPSIZ=CCDBO
      IF (BLKSQO.NE.0) EXPSIZ=NDATAO+NERRCO+9
      NWORDS=(EXPSIZ+3)/4
      WRITE (OUTAPE,60,ERR=135,IOSTAT=IERR) (OUTBUF(I),I=1,NWORDS)
60    FORMAT(255(10A4))
      GO TO 90
C
C     CLOSE OUTAPE, NO REWIND.
80    CONTINUE
      CLOSE (UNIT=OUTAPE,ERR=120)
      GO TO 90
C
C     FUNCTION COMPLETED NORMALLY.
90    CONTINUE
      ISTAT=0
      RETURN
C
C     PROCESS ERROR CONDITIONS.
100   CONTINUE
      WRITE (PRINTR,110) IERR
110   FORMAT ('0Error condition occurred while opening OUTAPE, IOSTAT=',
     * Z8)
      GO TO 140
C
120   CONTINUE
      WRITE (PRINTR,130)
130   FORMAT ('0Error condition occurred while closing OUTAPE.')
C
135   CONTINUE
      WRITE (PRINTR,136) IERR
136   FORMAT ('0Error condition occurred while writing OUTAPE, IOSTAT=',
     * Z8)
C
140   CONTINUE
      CALL LIB$SIGNAL (%VAL(IERR))
150   CONTINUE
      ISTAT=3
      RETURN
      END
      SUBROUTINE EXCHSL
C
C     LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS.
C
C     EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE
C     SEGMENT.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      RETURN
      END
      SUBROUTINE EXCHTR (IBLOCK,OBLOCK)
C
C     TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER.
C
      INTEGER IBLOCK(1), OBLOCK(1)
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4.
C
      CALL EXCHFO (1)
      CALL EXCHFO (2)
      WORKF=-IABS(WORKF)
C
10    IF (TRANS.LE.0) RETURN
      CALL EXCHSL
C     LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS.
      GO TO (11,12,13,14,15,16,17,18,19), TRANS
C     COMMAND PARSER
11    CALL EXCHC1 (IBLOCK,OBLOCK)
      GO TO 10
C     IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE
12    CALL EXCHC2
      GO TO 10
C     OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE.
13    CALL EXCHC3 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE.
14    CALL EXCHC4 (IBLOCK)
      GO TO 10
C     COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE.
15    CALL EXCHC5 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY TEXT FROM INTAPE TO OUTAPE
16    CALL EXCHC6 (IBLOCK,OBLOCK)
      GO TO 10
C     TEXT COMMAND
17    CALL EXCHC7 (IBLOCK,OBLOCK)
      GO TO 10
C     ERROR MESSAGES
18    CALL EXCHC8
      GO TO 10
C     QUIT
19    CALL EXCHC9 (IBLOCK,OBLOCK)
      GO TO 10
      END
      SUBROUTINE EXCHGB (ISTAT,DBLOCK)
C
C     READ A BLOCK FROM THE EXCHANGE TAPE.
C     IGNORE THE ERROR CONTROL SEGMENT.
C     CHECK THE BLOCK SEQUENCE NUMBER.
C     CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER,
C               OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
C
C     READ A BLOCK FROM INTAPE.
C
      BLKSQI=BLKSQI+1
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 160
C
C     GET INFORMATION OUT OF THE BLOCK HEADER.
C
      CCDBI=NERRCI
      CWDBI=NWCBI*(CCDBI/NCCBI)+1
      CPCBI=MOD(CCDBI,NCCBI)
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
      DO 110 JUMP=1,9
      CCDBI=CCDBI+1
      CPCBI=CPCBI+1
      IF (CCDBI.GT.NCDBI) GO TO 130
      IF (CPCBI.LE.NCCBI) GO TO 10
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
10    GO TO (20,30,40,50,60,70,80,90,100), JUMP
20    NEWBLK=256*CBLCKI(CPCBI)
      GO TO 110
30    NEWBLK=NEWBLK+CBLCKI(CPCBI)
      GO TO 110
40    LASTI=CBLCKI(CPCBI)
      GO TO 110
50    L1PRGI=256*CBLCKI(CPCBI)
      GO TO 110
60    L1PRGI=L1PRGI+CBLCKI(CPCBI)
      GO TO 110
70    N1RECI=256*CBLCKI(CPCBI)
      GO TO 110
80    N1RECI=N1RECI+CBLCKI(CPCBI)
      GO TO 110
90    L1RECI=256*CBLCKI(CPCBI)
      GO TO 110
100   L1RECI=L1RECI+CBLCKI(CPCBI)
110   CONTINUE
C
C     CHECK THE BLOCK SEQUENCE NUMBER.
C
      IF (BLKSQI.EQ.NEWBLK) GO TO 150
      ISTAT=1
      WRITE (PRINTR,120) NEWBLK,BLKSQI
120   FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I
     15//)
      BLKSQI=NEWBLK
      GO TO 160
C
C     FORMAT ERROR
C
130   ISTAT=2
      GO TO 160
C
C     CHECK L1PRGI AND L1RECI.
C
150   IF (L1PRGI.GT.NCDBI) GO TO 130
      IF (L1RECI.GT.NCDBI) GO TO 130
      ISTAT=0
160   RETURN
C
      END
      SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD)
C
C     GET A RECORD FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK).
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE
C               SPACE ALLOWED BY THE USER.  (POSITION IS STILL OK).
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C     THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM
C     CONTROL RECORDS.  NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS.
C
      ISTAT=0
      NCHACT=0
10    JUMP=1
      GO TO 260
20    NG=CBLCKI(CPCBI)
      IF (NG.EQ.0) GO TO 90
      IF (NG.NE.255) GO TO 30
C
C     END OF SHORT TAPE BLOCK.
C
      CCDBI=NCDBI
      GO TO 10
C
C     UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO
C     THE USER RECORD AREA.
C
30    ITYPEI=0
      IF (MODEI.EQ.0) GO TO 40
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG
40    IG=0
50    JUMP=2
      GO TO 260
60    NR=CBLCKI(CPCBI)
      IF (MODEI.EQ.0) GO TO 70
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR
      GO TO 160
70    IR=0
C     PUT REMVI INTO THE USER RECORD NR TIMES.
80    IF (IR.GE.NR) GO TO 160
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI
      IR=IR+1
      GO TO 80
C
C     THE NEXT RECORD IS A CONTROL RECORD.  FIND OUT WHAT KIND.
C
90    JUMP=3
      GO TO 260
100   ITYPEI=CBLCKI(CPCBI)
      IF (ITYPEI.LT.65) GO TO 250
C     65 = ASCII  A
      IF (ITYPEI.GT.90) GO TO 250
C     90 = ASCII  Z
      I=ITYPEI-64
C             A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
      GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160
     1,110,160,220,160,160,160,160,160,160,160,160), I
C       P   Q   R   S   T   U   V   W   X   Y   Z
C
C     P - PROGRAM HEADER
C
C     CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER
110   REMVI=32
C     RESET THE REMOVED CHARACTER TO ASCII BLANK.
      JUMP=4
      GO TO 260
120   L1PRGI=256*CBLCKI(CPCBI)
      JUMP=5
      GO TO 260
130   L1PRGI=L1PRGI+CBLCKI(CPCBI)
      JUMP=6
      GO TO 260
140   N1RECI=256*CBLCKI(CPCBI)
      JUMP=7
      GO TO 260
150   N1RECI=N1RECI+CBLCKI(CPCBI)
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
160   JUMP=8
      GO TO 260
170   NC=CBLCKI(CPCBI)
      IF (ITYPEI.NE.0) GO TO 180
      IF (MODEI.EQ.0) GO TO 180
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC
C     COPY NC CHARACTERS TO THE USER RECORD AREA.
180   IC=0
      JUMP=9
190   IF (IC.GE.NC) IF (ITYPEI) 240,210,240
      GO TO 260
200   NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI)
      IC=IC+1
      GO TO 190
210   IG=IG+1
      IF (IG-NG) 50,240,240
C
C     J - UPDATING AND END OF INPUT TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
220   JUMP=10
      GO TO 260
230   RECORD(1)=CBLCKI(CPCBI)
      NCHACT=1
      IF (ITYPEI.EQ.82) REMVI=RECORD(1)
C     82 = ASCII R
C
C     RETURN TO THE USER PROGRAM.
C
240   IF (NCHACT.GT.NCHMAX) ISTAT=4
      GO TO 290
C
C     CONTROL RECORD TYPE CANNOT BE DETERMINED.
C
250   ISTAT=5
      GO TO 290
C
C     GET A CHARACTER FROM CBLOCK.  UNPACK A NEW BLOCK IF NECESSARY.
C     READ MORE TAPE IF NECESSARY.
C
260   CPCBI=CPCBI+1
      CCDBI=CCDBI+1
      IF (CCDBI.LE.NCDBI) GO TO 270
      CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 290,260,290
270   IF (CPCBI.LE.NCCBI) GO TO 280
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
280   GO TO (20,60,100,120,130,140,150,170,200,230), JUMP
290   RETURN
C
      END
      SUBROUTINE EXCHNP (ISTAT,DBLOCK)
C
C     SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE
C     TAPE.
C     THIS MODULE IS MACHINE INSENSITIVE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
      ISTAT=0
      IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20
C
C     CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK.
C
10    IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20
C     76 = ASCII L
C
C     NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK.
      CCDBI=L1PRGI-1
      I=NWCBI*(CCDBI/NCCBI)+1
      IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI)
      CWDBI=I
      CPCBI=MOD(CCDBI,NCCBI)
      GO TO 40
C
C     NO MORE HEADERS IN THIS BLOCK.
C
20    CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 40,10,40
C
C     END OF FILE.
C
30    ISTAT=7
C
40    RETURN
C
      END
      SUBROUTINE EXCHPB (ISTAT,DBLOCK)
C
C     WRITE A BLOCK ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C     WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK.
      INTEGER WORK(9)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
C     PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK.
C
      BLKSQO=BLKSQO+1
      WORK(1)=BLKSQO/256
      WORK(2)=MOD(BLKSQO,256)
      WORK(3)=LASTO
      WORK(4)=L1PRGO/256
      WORK(5)=MOD(L1PRGO,256)
      WORK(6)=N1RECO/256
      WORK(7)=MOD(N1RECO,256)
      WORK(8)=L1RECO/256
      WORK(9)=MOD(L1RECO,256)
C
      CPCBO=MOD(NERRCO,NCCBO)
      CWDBO=(NERRCO/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
C
      DO 10 I=1,9
      CPCBO=CPCBO+1
      IF (CPCBO.LE.NCCBO) GO TO 10
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
      CWDBO=CWDBO+NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
      CPCBO=1
10    CBLCKO(CPCBO)=WORK(I)
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
C
C     WRITE THE DATA BLOCK ON TAPE.
C
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L).
C
      IF (LASTO.NE.76) GO TO 20
      ISTAT=3
      CALL EXCHWT (ISTAT,DBLOCK)
      GO TO 30
C
C     COMPUTE POINTERS FOR NEXT BLOCK OUT.
C
20    L1PRGO=0
      LLPRGO=0
      N1RECO=0
      L1RECO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
C
30    RETURN
C
      END
      SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD)
C
C     WRITE A RECORD ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A
C             TEXT RECORD CONTAINS MORE THAN 254 GROUPS.
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER GC,RC(255),CC(255)
C     GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      ISTAT=0
      INCHAR=0
C
C     DETERMINE THE RECORD TYPE.
C
      IF (NCHOUT.NE.255) GO TO 10
      ITYPEO=255
      GO TO 70
10    IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO
      IF (ITYPEO.NE.0) GO TO 30
C
C     DATA RECORD.
C
      IF (MODEO.NE.0) GO TO 170
C     COMPRESS THE RECORD.
      CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255)
      IF (GC.GE.255) GO TO 210
      IG=0
C     OUTPUT THE GROUP COUNT.
      CBLCKO(CPCBO)=GC
      JUMP=1
      GO TO 230
20    IG=IG+1
      IF (IG.GT.GC) GO TO 250
      NC=CC(IG)
      INCHAR=INCHAR+RC(IG)
C     OUTPUT REMOVED CHARACTER COUNT.
      CBLCKO(CPCBO)=RC(IG)
      JUMP=2
      GO TO 230
C
C     THE USER SAYS HE HAS A CONTROL RECORD TO WRITE.  FIND OUT
C     WHAT KIND.
C
30    IF (ITYPEO.LT.65) GO TO 220
C     65 = ASCII A
      IF (ITYPEO.GT.90) GO TO 220
C     90 = ASCII  Z
      I=ITYPEO-64
C             A  B  C  D  E  F  G  H  I  J   K  L  M  N  O  P  Q  R   S
      GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40,
     140,40,40,40,40,40,40), I
C      T  U  V  W  X  Y  Z
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE TYPE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
40    IF (NCHOUT-255) 100,100,210
C
C     END OF FILE.
C
50    IF (NERRCO+NDATAO+7-CCDBO) 70,80,80
C
C     P - PROGRAM HEADER.
C
60    IF (NCHOUT.GT.255) GO TO 210
      REMVO=32
C     RESET REMOVED CHARACTER TO ASCII BLANK.
      IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80
      IF (CCDBO.EQ.NERRCO+10) GO TO 80
C
C     END OF SHORT TAPE BLOCK.
C
70    CBLCKO(CPCBO)=255
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250
C     69 = ASCII E
C     80 = ASCII P
      L1RECO=CCDBO-NERRCO
80    IF (LLPRGO.EQ.0) GO TO 90
C     LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK.
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      NC=MOD(LLPRGO+1,NCCBO)
      NW=((LLPRGO+1)/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      CBLCKO(NC+1)=CCDBO/256
      IF (NC+1.LT.NCCBO) GO TO 85
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      NW=NW+NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      NC=-1
85    CBLCKO(NC+2)=MOD(CCDBO,256)
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      CALL EXCHUN (DBLOCK(CWDBO),CBLCKO)
C     UPDATE TABLE OF CONTENTS POINTERS
90    LLPRGO=CCDBO
      IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO
      NLRECO=NLRECO+1
      IF (N1RECO.EQ.0) N1RECO=NLRECO
100   CBLCKO(CPCBO)=0
      JUMP=3
      GO TO 230
110   CBLCKO(CPCBO)=ITYPEO
      JUMP=4
      GO TO 230
120   IF (ITYPEO.NE.69) GO TO 130
C     69 = ASCII E
      LASTO=76
      GO TO 70
130   IF (ITYPEO.NE.80) GO TO 170
C     80 = ASCII P
      CBLCKO(CPCBO)=0
      JUMP=5
      GO TO 230
140   CBLCKO(CPCBO)=0
      JUMP=6
      GO TO 230
150   CBLCKO(CPCBO)=NLRECO/256
      JUMP=7
      GO TO 230
160   CBLCKO(CPCBO)=MOD(NLRECO,256)
      JUMP=8
      GO TO 230
C
170   NC=NCHOUT
180   CBLCKO(CPCBO)=NC
      IC=0
      JUMP=9
C     PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD.
      IF (ITYPEO.EQ.82) GO TO 190
      IF (ITYPEO.EQ.74) GO TO 190
      IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230
190   IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250
      INCHAR=INCHAR+1
      IC=IC+1
      CBLCKO(CPCBO)=RECORD(INCHAR)
      GO TO 230
C
C     J - UPDATING AND END OF TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
200   NCHOUT=1
      IF (ITYPEO.EQ.82) REMVO=RECORD(1)
C     82 = ASCII R
      GO TO 100
C
C     RECORD TOO LONG.
C
210   ISTAT=4
      GO TO 250
C
C     UNKNOWN CONTROL RECORD TYPE.
C
220   ISTAT=5
      GO TO 250
C
C     INCREMENT THE OUTPUT BUFFER POINTERS.  PACK A CHARACTER BLOCK
C     IF NECESSARY.  WRITE A TAPE BLOCK IF NECESSARY.
C
230   CPCBO=CPCBO+1
      CCDBO=CCDBO+1
      IF (CPCBO.LE.NCCBO) GO TO 240
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CWDBO=CWDBO+NWCBO
      CPCBO=1
      IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 250
240   GO TO (20,180,110,120,140,150,160,170,190), JUMP
250   RETURN
C
      END
      SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL)
C
C     SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE
C     DATA TO BE REMOVED.  DIVIDE DATA INTO GROUPS CONSISTING OF
C     STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT
C     DATA.  THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE
C     REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP
C     ARE RECORDED IN RC() AND SC() RESPECTIVELY.  MAXSL IS THE
C     MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC().
C
      INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL
C
C     RC AND SC MUST BE AT LEAST (IMGLEN-1)//3.
C
      GC=1
      SC(1)=0
      RC(1)=0
      MODE=-1
      INPLEN=IABS(IMGLEN)
C
C     IDENTIFY DATA GROUPS.
C
      DO 110 I=1,INPLEN
      IF (MODE) 40,60,90
C
C     MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE.
C
40    IF (INPIMG(I).EQ.REMOVE) GO TO 50
C     SWITCH TO SIGNIFICANT DATA SCAN.
      MODE=1
      SC(GC)=1
      GO TO 110
C     CONTINUE REMOVE SCAN
50    RC(GC)=RC(GC)+1
      IF (RC(GC)-MAXSL) 110,95,110
C
C     MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY
C     ONE OCCURRENCE OF REMOVE.  CHANGE TO REMOVE MODE IF ANOTHER REMOVE
C     OCCURS OR BACK TO DATA MODE IF NOT.
C
60    IF (INPIMG(I).EQ.REMOVE) GO TO 80
C     SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT.
      MODE=1
      IF (SC(GC).GE.MAXSL-2) GO TO 70
      SC(GC)=SC(GC)+2
      GO TO 110
C     FULL GROUP
70    GC=GC+1
      RC(GC)=1
      SC(GC)=1
      GO TO 110
C     SWITCH TO REMOVE MODE.
80    GC=GC+1
      SC(GC)=0
      RC(GC)=2
      MODE=-1
      GO TO 110
C
C     MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA.
C
90    IF (INPIMG(I).EQ.REMOVE) GO TO 100
      SC(GC)=SC(GC)+1
      IF (SC(GC).NE.MAXSL) GO TO 110
C     FULL GROUP
      MODE=-1
95    IF (I.GE.INPLEN) GO TO 120
      GC=GC+1
      RC(GC)=0
      SC(GC)=0
      GO TO 110
100   MODE=0
110   CONTINUE
120   RETURN
C
      END
      SUBROUTINE EXCHTP (RECORD,LINEI)
C
C     MATERIALIZE INCLUDES IF INALT IS NON-ZERO.
C     CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE
C     AND THE PRINTER IF LISTING IS REQUESTED.
C     LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C
      INTEGER RECORD(1),LINEI
C
C     *****     LOCAL VARIABLES     ************************************
C
C COPY    DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR
C         SKIPPING TEXT NOT TO BE INCLUDED.
      INTEGER COPY
C DASH    CONTAINS '-' IN HOLLERITH.
      INTEGER DASH
C ENDMRK  HOLDS THE END SENTINEL.
      INTEGER ENDMRK(40)
C NCHEND  IS THE NUMBER OF CHARACTERS IN ENDMRK.
      INTEGER NCHEND
C NCHSAV  SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD.
      INTEGER NCHSAV
C NCHTAR  IS THE NUMBER OF CHARACTERS IN TARGET.
      INTEGER NCHTAR
C STAR    CONTAINS '*' IN HOLLERITH.
       INTEGER STAR
C TARGET  IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY).
      INTEGER TARGET(40)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL DATA     ***************************************
C
      DATA DASH /1H-/, STAR /1H*/
C
C     *****     PROCEDURES     *****************************************
C
      LINEO=LINEO+1
      IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190
      RECORD(180)=LINEO
      RECORD(179)=LINEI
      COPY=-1
C     COPY=-1 MEANS NOT COPYING INCLUDED TEXT.
      IF (ITYPEO.EQ.0) GO TO 110
C     PROCESS INCLUDE RECORD.
      DO 10 I=1,NCHOUT
10    RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I)
C     INSERT '-I '.
      RECORD(1)=45
      RECORD(2)=73
      RECORD(3)=32
      NCHOUT=NCHOUT+3
      IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110
C     STORE SEARCH TARGET
      NCHTAR=MIN0(NCHOUT,40)
      DO 20 I=1,NCHTAR
20    TARGET(I)=RECORD(I)
C     STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
      NCHSAV=NCHCMD
      DO 30 I=1,NUMBER
30    OUTREC(I)=COMAND(I)
      COPY=0
C     COPY=0 MEANS SKIPPING MODULE ON INALT FILE.
      INALT=IABS(INALT)
      NEOF=0
40    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
      IF (NCHCMD.LT.2) GO TO 40
      IF (COMAND(1).NE.45) GO TO 40
C     45 = ASCII -
      IF (COMAND(2).EQ.45) GO TO 130
      IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40
C     73 = ASCII I, 105 = ASCII LOWER CASE I.
C     COMPARE IMAGE WITH SEARCH TARGET.
      IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60
      DO 50 I=2,NCHTAR
      K=COMAND(I)
      IF (K.GT.96 .AND. K.LT.123) K=K-32
      IF (TARGET(I).NE.K) GO TO 60
50    CONTINUE
      NEOF=3
C     PREVENT SEARCH LOOP.
      COPY=1
C     COPY=1 MEANS COPYING INCLUDED TEXT.
60    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     STORE END OF INCLUDE MODULE SIGNAL.
      NCHEND=MIN0(40,NCHCMD)
      DO 70 I=1,NCHEND
70    ENDMRK(I)=COMAND(I)
      IF (COPY.EQ.0) GO TO 80
      CHAR1L=DASH
      NCHOUT=NCHTAR
      DO 75 I = 1,NCHOUT
75    COMAND(I)=TARGET(I)
      COMAND(180)=LINEO
      COMAND(179)=LINEI
C     GO PRINT TARGET.
      CALL EXCHTW (COMAND,-1)
      GO TO 120
C     COPY OR SKIP UNTIL ENDMRK SEEN AGAIN.
80    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF.
C     TEST FOR ENDMRK
      DO 90 I=1,NCHEND
      IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100
90    CONTINUE
      IF (COPY) 140,40,140
C     OUTPUT TEXT RECORD.
100   COMAND(180)=LINEO
      COMAND(179)=LINEI
      NCHOUT=NCHCMD
      CALL EXCHTW (COMAND,OPTI)
      GO TO 120
C     OUTPUT TEXT RECORD.
110   CALL EXCHTW (RECORD,1)
120   IF (COPY) 190,190,80
C     WE ONLY GET HERE WITH COPY .GE. 0.
130   NEOF=NEOF+1
      ACTION=2
C     ACTION = 2 MEANS REOPEN INALT.
      CALL EXCHIM
      IF (NEOF.LT.2) GO TO 40
140   INALT=-IABS(INALT)
      NCHCMD=1
      IF (COPY.GT.0) GO TO 170
C     PROCESS TARGET AS THOUGH IT WERE TEXT.
      NCHOUT=NCHTAR
C     SAVE TARGET FOR ERROR MESSAGE.
      DO 150 I=1,NCHTAR
150   COMAND(I)=TARGET(I)
      CALL EXCHTW (COMAND,1)
      CALL EXCHAH (TARGET,NCHTAR)
      WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR)
160   FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8
     10A1))
      NERRS=MAX0(NERRS,3)
C
C     RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
C
170   NCHCMD=NCHSAV
      DO 180 I=1,NUMBER
180   COMAND(I)=OUTREC(I)
C
190   CHAR1L=STAR
      RETURN
C
      END
      SUBROUTINE EXCHTW (RECORD,OPTION)
C
C     WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING
C     EXCHOU.  WRITE RECORD ON THE PRINTER IF LISTING REQUESTED.
C     RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C     IF OPTION = ZERO, WRITE TO FILE ONLY.
C     IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING.
C     IF OPTION .LT. ZERO, WRITE TO LISTING ONLY.
C
      INTEGER RECORD(1),OPTION
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     PROCEDURES     *****************************************
C
      LINEI=RECORD(179)
      IF (OPTION.LT.0) GO TO 130
C
C     INSERT IDENTIFICATION IF REQUESTED.
C
      IF (IDCOL2.LT.IDCOL1) GO TO 120
      IF (IDTXTL+IDSTEP.EQ.0) GO TO 120
      IF (NCHOUT.GE.IDCOL2) GO TO 20
      J=IDCOL2-1
C     FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2
      DO 10 I=NCHOUT,J
10    RECORD(I+1)=32
C     32 = ASCII BLANK.
20    NCHOUT=MAX0(NCHOUT,IDCOL2)
      N=-1
      IF (LINEI.EQ.0) GO TO 40
      IF (IDOPTN.NE.73) GO TO 40
C     73 = ASCII I.  IDENTIFY ONLY FROM INTAPE.
      N=(LINEI-1)*IDSTEP+IDSTRT
      GO TO 70
40    IF (IDOPTN.NE.79) GO TO 50
C     79 = ASCII O.  IDENTIFY ONLY TO OUTAPE.
      N=(LINEO-1)*IDSTEP+IDSTRT
      GO TO 70
50    IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70
C     67 = ASCII C, 70 = ASCII F.  IDENTIFY EVERYTHING.
      N=IDCUR
70    IF (N.LT.0) GO TO 120
      IF (IDTXTL.EQ.0) GO TO 100
      J=MIN0(IDCOL2,IDTXTL+IDCOL1-1)
      K=1
      DO 80 I=IDCOL1,J
      RECORD(I)=IDTEXT(K)
80    K=K+1
100   IF (IDSTEP.EQ.0) GO TO 120
      IDCUR=IDCUR+IDSTEP
      K=IDCOL2
110   RECORD(K)=MOD(N,10)+48
      N=N/10
      K=K-1
      IF (N.EQ.0) GO TO 120
      IF (K.GE.IDCOL1) GO TO 110
C
C     OUTPUT RECORD.
C
120   IF (OUFILE.NE.0) CALL EXCHOU (RECORD)
      IF (OPTION.EQ.0) GO TO 220
130   IF (OPTL.NE.0) GO TO 140
      IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220
140   CALL EXCHAH (RECORD,NCHOUT)
      IF (OPTV+VERT.NE.0) GO TO 200
      IF (PHASE.NE.8) GO TO 180
      IF (LINEI.EQ.0) GO TO 160
      WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
150   FORMAT (1X,2I5,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
160   WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
170   FORMAT (5H  NEW,I6,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
180   WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
190   FORMAT (1X,I5,A1,3X,110A1/(6H  CONT,4X,110A1))
      GO TO 220
200   WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT)
210   FORMAT (132A1)
220   RETURN
C
      END
      SUBROUTINE EXCHC1 (IBLOCK,OBLOCK)
C
C     COMMAND DECODER AND FORMAT VERIFIER.  SOME COMMANDS ARE ALSO
C     COMPLETELY PROCESSED HERE.
C
C     IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS.
C
      INTEGER IBLOCK(1),OBLOCK(1)
C
C
C     *****     LOCAL VARIABLES     ************************************
C
C ALLOW   TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED.  VALUES ARE
C         SUMS OF PERMITTED VALUES OF PHASE.
C         1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING,
C         8 = UPDATING.
C         ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A
C         PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR
C         MAY BE VOID (EQUAL SIGN IS LAST CHARACTER).
C         32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT.
      INTEGER ALLOW(35)
C BLANK   A CONSTANT.  1H .
      INTEGER BLANK
C DATE    IS THE DATE FROM UPDA=, DATE=, ORIG=.
      INTEGER DATE(3)
C DAYS    TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS.
      INTEGER DAYS(12)
C I       IS USED FREELY AS AN INDEX.
C J       IS USED FREELY AS AN INDEX.
C JUMP    USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE.
C K       IS USED FREELY AS AN INDEX.
C KDATE   IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD).
C KQUIT   IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD).
C KTEXT   IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD).
C N       IS USED FREELY AS AN INDEX.
C NCNREC  IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS.
C ND      IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER.
C NM      IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER.
C NY      IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER.
C TVAL    A VECTOR OF VALUES FOR TRANS.  INDEXED BY ICOMD.
      INTEGER TVAL(35)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL EQUIVALENCE     **********************************
C
      EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND)
C
C     *****     DATA STATEMENTS     ************************************
C
      DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/
      DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/
      DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/
      DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/
      DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/
      DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/
      DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/
      DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/
      DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/
      DATA BLANK /1H /
      DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/
      DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/
      DATA DAYS(11),DAYS(12) /30,31/
      DATA KDATE /5/
      DATA KQUIT /20/
      DATA KTEXT /27/
      DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/
      DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/
      DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/
      DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/
      DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/
      DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/
      DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/
C
C     *****     PROCEDURES     *****************************************
C
C     GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER.
C     ECHO IT IF THE E OPTION IS SET.  DETERMINE WHETHER IT IS A CHANGE
C     TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND.
C
10    NCNREC=0
20    ACTION=0
      IF (NCHCMD.LT.0) GO TO 220
      CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (OPTE.EQ.0) GO TO 27
      WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD)
23    FORMAT (1X,80A1)
      CHAR1L=0
27    NCHCMD=MIN0(NCHCMD,MARGIN)
      IF (PHASE.LT.4) SIGNAL=45
C     45 = ASCII -
      IF (COMAND(1).NE.45) GO TO 50
C     45 = ASCII -.  REQUEST TO CHANGE CONTROL RECORD.
      IF (PHASE.LT.4) GO TO 40
      WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD)
30    FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT
     1OR UPDATE/1X,80A1)
      NERRG=MAX0(NERRG,2)
      GO TO 200
40    ICOMD=0
      EQUAL=2
      TRANS=3
      GO TO 370
50    IF (COMAND(1).NE.42) GO TO 70
C     42 = ASCII *.  COMMENT RECORD.  JUST ECHO IT.
      NCHCMD=MAX0(NCHCMD,2)
      WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD)
60    FORMAT (A1,1H*,78A1/(1X,80A1))
      GO TO 10
C
C     SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR
C     EQUAL SIGN ARE FOUND.  LOOK UP THE WORD IN THE COMMAND NAME TABLE.
C
70    EQUAL=0
      DO 80 I=1,NCHCMD
      IF (COMAND(I).EQ.32) GO TO 80
C     32 = ASCII BLANK
      EQUAL=EQUAL+1
      ICOMD=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32
C     ABOVE STATEMENT CONVERTS TO UPPER CASE.
      COMAND(I)=32
      COMAND(EQUAL)=ICOMD
      IF (EQUAL.GE.4) GO TO 90
      IF (ICOMD.EQ.61) GO TO 90
C     61 = ASCII =.
      IF (ICOMD.EQ.44) GO TO 90
C     44 = ASCII ,.
80    CONTINUE
      IF (EQUAL.EQ.0) GO TO 185
90    DO 110 ICOMD=1,NCOMDT
      DO 100 K=1,EQUAL
      IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110
100   CONTINUE
      IF (EQUAL.EQ.4) GO TO 130
      IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130
C     32 = ASCII BLANK.
110   CONTINUE
C
C     UNRECOGNIZED COMMAND.
C
120   ICOMD=0
C
C     LOOK FOR AN EQUAL SIGN.  SET THE VARIABLE NAMED EQUAL TO ZERO IF
C     THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK
C     CHARACTER FOLLOWING THE EQUAL SIGN.
C
130   MODIFY=0
140   DO 150 I=EQUAL,NCHCMD
      K=COMAND(I)
      IF (K.EQ.61) GO TO 160
C     61 = ASCII =.
      IF (MODIFY.NE.0) GO TO 150
C     USE FIRST MODIFIER.
      IF (K.EQ.44) GO TO 160
C     44 = ASCII ,.
150   CONTINUE
      EQUAL=0
      GO TO 170
160   I=I+1
      EQUAL=I
      IF (I.GT.NCHCMD) GO TO 170
      IF (COMAND(I).EQ.32) GO TO 160
C     32 = ASCII BLANK
      IF (K.NE.44) GO TO 170
C     44 = ASCII ,.
      MODIFY=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32
C     CONVERT TO UPPER CASE.
      GO TO 140
170   IF (K.NE.61) EQUAL=0
C     61 = ASCII =.
      IF (ICOMD.EQ.0) GO TO 180
      IF (ICOMD.GT.NCOMDP) GO TO 180
      IF (EQUAL.GT.NCHCMD) GO TO 175
      IF (EQUAL.NE.0) GO TO 230
      IF (ALLOW(ICOMD)/64.NE.0) GO TO 230
175   IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690
C     PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK.
      NCHCMD=NCHCMD+1
      EQUAL=NCHCMD
      COMAND(NCHCMD)=32
C     32 = ASCII BLANK
      HOLCMD(NCHCMD)=BLANK
      GO TO 230
C
C     GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX.
C
180   CALL EXCHCX (0)
C     IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND.
      IF (ICOMD.NE.0) GO TO 730
185   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1))
      NERRG=MAX0(NERRG,5)
200   CHAR1L=0
      NCNREC=NCNREC+1
      IF (NCNREC.LE.20) GO TO 20
      WRITE (PRINTR,210)
210   FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU
     1MES TEXT COMMAND IS MISSING.)
      GO TO 270
C
C     END OF FILE - SIMULATE A QUIT COMMAND.
C
220   ICOMD=KQUIT
C
C     RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME.
C
230   IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240
      TRANS=TVAL(ICOMD)
C             1   2   3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300
     1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7
     230,370,730,370), ICOMD
C       16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
C     32  33  34  35
C
C     THE COMMAND IS NOT ALLOWED AT THIS TIME.
C
240   WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE
     1D./1X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
C     DECIDE WHETHER TO SKIP TEXT
260   IF (ICOMD.NE.KTEXT) GO TO 10
      IF (EQUAL.NE.0) GO TO 10
270   WRITE (PRINTR,280)
280   FORMAT (//15H0SKIPPING TEXT.)
290   CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (NCHCMD.LT.2) GO TO 290
      IF (COMAND(1).NE.SIGNAL) GO TO 290
      IF (COMAND(2).EQ.SIGNAL) GO TO 10
      IF (NCHCMD.LT.3) GO TO 290
      IF (COMAND(2).NE.61) GO TO 290
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 290
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING.
C     DATE=YYMMDD
C     ORIGIN=YYMMDD SITE
C     UPDATE=YYMMDD SITE
C     IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE
C     THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED.
C
300   IF (EQUAL+5.GT.NCHCMD) GO TO 700
      I=EQUAL
      DO 310 J=1,3
      DATE(J)=0
      DO 310 K=1,2
      N=COMAND(I)-48
      IF (N.LT.0) GO TO 320
      IF (N.GT.9) GO TO 320
      DATE(J)=10*DATE(J)+N
310   I=I+1
      IF (NM.EQ.0) GO TO 320
      IF (NM.GT.12) GO TO 320
      IF (ND.LE.0) GO TO 320
      DAYS(2)=28
      IF (MOD(NY,4).EQ.0) DAYS(2)=29
      IF (NY.EQ.0) DAYS(2)=28
      IF (ND.LE.DAYS(NM)) GO TO 440
320   IF (ICOMD.EQ.KDATE) GO TO 700
      IF (TODAY(1).EQ.32) GO TO 700
      I=MIN0(NCHCMD+6,180)
      NCHCMD=I
      J=I-6
      IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1
C     32 = ASCII BLANK
      IF (J.LT.EQUAL) GO TO 700
330   COMAND(I)=COMAND(J)
      HOLCMD(I)=HOLCMD(J)
      J=J-1
      I=I-1
      IF (J.GE.EQUAL) GO TO 330
      DO 340 I=1,6
      COMAND(I+EQUAL-1)=TODAY(I)
340   HOLCMD(I+EQUAL-1)=TODAY(I)
      CALL EXCHAH (HOLCMD(EQUAL),6)
      WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD)
345   FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1))
      NERRG=MAX0(NERRG,1)
      GO TO 440
C
C     REWIND INTAPE
C
350   IF (INTAPE.EQ.0) GO TO 680
      IF (INTOPN.NE.0) GO TO 360
      I=1
C     OPEN INTAPE IF NOT ALREADY OPEN.  DO NOT CHECK EXCH LABEL.
      CALL EXCHRT (I,IBLOCK)
C     IGNORE STATUS
360   I=2
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
      GO TO 725
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH
C     BEGINS WITH A NUMBER FOLLOWED BY A BLANK.
C
C     INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     INTAPE = NUMBER SYSTEM DEPENDENT DATA
C     LIMIT = NUMBER
C     MARGIN = NUMBER
C     OUTAPE = NUMBER SYSTEM DEPENDENT DATA
C     OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     PRINTER = NUMBER
C     READER = NUMBER
C     SKIP = NUMBER
C     TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL)
C     WORK = NUMBER
C
370   NUMBER=0
      IF (EQUAL.EQ.0) GO TO 440
      DO 410 J=EQUAL,NCHCMD
      IF (COMAND(J).EQ.32) GO TO 420
C     32 = ASCII BLANK
      N=COMAND(J)-48
C     48 = ASCII ZERO
      IF (N.GE.0) GO TO 400
380   WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD)
390   FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS.  NOT PROCESSED./
     11X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
      GO TO 260
400   IF (N.GT.9) GO TO 380
410   NUMBER=10*NUMBER+N
      EQUAL=NCHCMD+1
      GO TO 440
420   EQUAL=J
430   EQUAL=EQUAL+1
      IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440
C     32 = ASCII BLANK
C
C     PRELIMINARY FORMAT CHECKING IS COMPLETE
C
440   J=ICOMD+1
C             0  1   2  3  4  5   6  7  8   9  10 11  12 13 14  15  16
      GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6
     120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595),
     2J
C     17 18  19 20  21 22 23 24 25  26  27 28  29  30 31 32  33 34  35
C
C     DATE=YYMMDD
C
450   DO 460 I=1,6
460   TODAY(I)=COMAND(EQUAL+I-1)
      GO TO 10
C
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA.
C
470   I=INFILE
      J=1
      GO TO 500
C
C     INCLUDE = NUMBER SYSTEM DEPENDENT DATA.
C
480   I=INALT
      J=3
      INALT=IABS(INALT)
      GO TO 500
C
C     TEXT
C
490   I=INTEXT
      J=2
      IF (EQUAL.EQ.0) GO TO 560
C
C     OPEN AN INPUT FILE.
C
500   IF (NUMBER.EQ.0) GO TO 505
      IF (NUMBER.EQ.OUFILE) GO TO 710
      IF (NUMBER.EQ.OUTAPE) GO TO 710
505   IF (J.EQ.2) GO TO 510
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (I.NE.0) CALL EXCHIM
510   IF (J-2) 520,530,540
520   INFILE=NUMBER
      GO TO 550
530   INTEXT=NUMBER
      GO TO 550
540   INALT=NUMBER
550   IF (NUMBER.EQ.0) GO TO 560
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      CALL EXCHCX (J+1)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHIM
      ACTION=2
C     ACTION = 2 MEANS REWIND
      IF (J.EQ.3) CALL EXCHIM
      INALT=-IABS(INALT)
560   ACTION=0
C     ACTION = 0 MEANS READ TEXT
      GO TO 730
C
C     INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
570   IF (INTOPN.EQ.0) GO TO 580
C     CLOSE THE INPUT TAPE, IGNORE STATUS.
      I=4
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
580   INTAPE=NUMBER
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (INTAPE.NE.0) CALL EXCHCX (6)
      GO TO 725
C
C     LIMIT = NUMBER
C
590   LIMIT=NUMBER
      GO TO 10
C
C     MARGIN = NUMBER
C
C     MINIMUM MARGIN IS 60
595   MARGIN=MAX0(NUMBER,60)
      GO TO 10
C
C     OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
600   IF (OUTOPN.EQ.0) GO TO 610
C     WRITE AND END-OF-FILE MARK ON OUTAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (I,OBLOCK,OBLOCK)
C     IGNORE STATUS
      OUTOPN=0
      PHASE=1
610   OUTAPE=NUMBER
      OUTUPD=MODIFY
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (OUTAPE.NE.0) CALL EXCHCX (7)
      GO TO 730
C
C     OUTPUT =  NUMBER SYSTEM DEPENDENT INFORMATION
C
620   ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      OUFILE=NUMBER
      IDCUR=IDSTRT
      IF (OUFILE.EQ.0) GO TO 730
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND.
      CALL EXCHCX (5)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHOU (OUTREC)
      GO TO 730
C
C     PRINTER = NUMBER.
C
630   CALL EXCHFO (-2)
      PRINTR=NUMBER
      CALL EXCHFO (2)
      GO TO 10
C
C     READER = NUMBER.
C
640   IF (INFILE.NE.0) GO TO 670
      CALL EXCHFO (-1)
      READER=NUMBER
      CALL EXCHCX (1)
      CALL EXCHFO (1)
      GO TO 10
C
C     WORK = NUMBER
C
650   IF (WORKF.GT.0) CALL EXCHFO (-3)
      WORKF=NUMBER
C     WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4.
      GO TO 10
C
C     UPDATE
C
C     DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR
C     SIMPLY TO OUTPUT THE UPDATE COMMAND.
660   IF (PHASE.GE.4) TRANS=5
      GO TO 730
C
C     ERROR MESSAGES.
C
670   NUMBER=3
C     MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE.
      GO TO 720
680   NUMBER=4
C     MESSAGE 4 - INTAPE IS NOT DEFINED.
      GO TO 720
690   NUMBER=12
C     MESSAGE 12 - NO PARAMETER STRING.
      GO TO 720
700   NUMBER=13
C     MESSAGE 13 - IMPROPER DATE.
      GO TO 720
710   NUMBER=31
C     MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT.
C
C     RETURN TO ERROR MESSAGE SEGMENT.
C
720   TRANS=8
      GO TO 740
c
c     Indicate the WORK file is empty.
c
725   if (nrwork.le.0 .or. workf.le.0) go to 730
      REWIND WORKF
      NRWORK=0
C
C     IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP.
C
730   IF (TRANS.EQ.1) GO TO 10
740   RETURN
C
      END
      SUBROUTINE EXCHCX (REASON)
C
C========================
C
C     PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER
C     PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT,
C     INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS.
C     VAX-11 VMS V2.4 VERSION
C     REVISED 820616 1500
C
C     RECOGNIZE THE TABS COMMAND.
C     TABS=Y or D MEANS HT IS DATA, TABS=N or T MEANS HT IS TAB.
C
      INTEGER REASON
C
C     REASON=0 FOR UNRECOGNIZED COMMAND.
C     REASON=1 BEFORE OPENING READER.
C     REASON=2 BEFORE OPENING INFILE (=INPUT FILE).
C     REASON=3 BEFORE OPENING INTEXT (=TEXT FILE).
C     REASON=4 BEFORE OPENING INALT  (=INCLUDE FILE).
C     REASON=5 BEFORE OPENING OUFILE (=OUTPUT FILE).
C     REASON=6 BEFORE OPENING INTAPE.
C     REASON=7 BEFORE OPENING OUTAPE.
C
C
C========================
C
      LOGICAL THERE
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
C
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      CHARACTER*11 FNMDEF(3)
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA FNMDEF(1)/'EXCHXX.TMP '/,FNMDEF(2)/'TEIOXX.TES '/,
     *     FNMDEF(3)/'TEIOXX.TES '/
C
      IF (REASON.NE.0) GO TO 10
C
C     COMMAND NOT RECOGNIZED BY EXCHC1.  IF ICOMD=0 IT IS NOT A
C     COMMAND, ELSE CHECK PARAMETER OF TABS COMMAND.
C
      IF (ICOMD.EQ.0) GO TO 150
      IF (EQUAL.EQ.0 .OR. EQUAL.GT.NCHCMD) GO TO 110
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
      IF (J.EQ.68 .OR. J.EQ.89) THEN
C       68 = ASCII D, 89 = ASCII Y.
        TABS='Y'
        GO TO 150
      END IF
      IF (J.EQ.78 .OR. J.EQ.84) THEN
C       78 = ASCII N, 84 = ASCII T.
        TABS='N'
        GO TO 150
      END IF
      GO TO 110
C
C     PROCESS SYSTEM DEPENDENT INFORMATION
10    J=MAX0(REASON-4,1)
      K=MIN0(NCHCMD-EQUAL+1,40)
      IF (K.GT.0) THEN
C
C       FIRST BLANK OUT FNAMES, THEN FILL IN FILE NAME FROM COMAND.
        FNAMES(J)=' '
        DO 20 I=1,K
          L=COMAND(EQUAL+I-1)
          IF (L.GT.96 .AND. L.LT.123) L=L-32
20        FNAMES(J)(I:I)=CHAR(L)
      ELSE
C
C       PLACE DEFAULT FILE NAMES IN FNAMES(*:*)
        FNAMES(J)=FNMDEF(J)
C
C       PUT ASCII FORM OF LOGICAL UNIT NUMBER INTO (DEFAULT) FILE NAME.
        FNAMES(J)(5:6)=CHAR(NUMBER/10+48)//CHAR(MOD(NUMBER,10)+48)
      END IF
      IF (REASON-5) 50,70,150
C
C     OPEN INPUT FILE.
C
50    CONTINUE
C
C     IF THE 'T' OPTION HAS BEEN SELECTED AND THE FILE IS ALREADY OPEN,
C     DON'T OPEN IT AGAIN.
C
      IF (OPTVAL(20).NE.0) THEN
        INQUIRE (FILE=FNAMES(1),OPENED=THERE,NUMBER=NUMOLD)
        IF (THERE .AND. NUMOLD.EQ.NUMBER) GO TO 150
      END IF
C     MAKE A SPECIAL TEST FOR READER=5=TT:.
      IF (REASON.EQ.1 .AND. READER.EQ. 5) THEN
      FNAMES(1)='TT:'
      OPEN (UNIT=NUMBER,FILE=FNAMES(1),STATUS='OLD',ERR=90,
     * IOSTAT=IER)
      ELSE
      OPEN (UNIT=NUMBER,FILE=FNAMES(1),STATUS='UNKNOWN',ERR=90,
     * IOSTAT=IER)
      END IF
      GO TO 150
C
C     OPEN OUTPUT FILE.
C
70    inquire (file=fnames(1),number=numold,opened=there)
      if (.not.there .or. (numold.ne.number))
     *open (unit=number,file=fnames(1),status='UNKNOWN',err=90,
     *iostat=ier)
      GO TO 150
C
C     ERROR WHILE OPENING FILE.
C
90    WRITE (PRINTR,100) IER,NUMBER,FNAMES(1)
100   FORMAT (//'0IOSTAT = ',Z8,', Unable to open unit',I3,' for file ',
     * A40)
      CALL LIB$SIGNAL(%VAL(IER))
      GO TO 130
C
C     ERROR WHILE PROCESSING TABS COMMAND.
C
110   WRITE (PRINTR,120)
120   FORMAT (//'0Missing or unrecognized parameter on TABS command.')
C
130   WRITE (PRINTR,140) (HOLCMD(I),I=1,NCHCMD)
140   FORMAT (1X,80A1)
C
150   CONTINUE
      RETURN
C
      END
      SUBROUTINE  EXCHC2
C
C     PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KINDE /32/
      DATA KOPTI /14/
      DATA KSITE /25/
C
C     FIGURE OUT WHICH COMMAND GOT US HERE.
C
      IF (ICOMD-KOPTI) 60,150,10
10    IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270
C
C     ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT
C     WHERE C1, C2, STEP AND START ARE INTEGERS.
C     STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP,
C     START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF
C     CHARACTERS OF TEXT IN IDTXTL.  IF AN ERROR OCCURS,
C     STORE ZERO IN IDSTEP AND IDTXTL.
C     IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO.
C
C     STORE THE MODIFIER IN IDOPTN.
C     IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE
C     PRODUCED ONLY FOR IMAGES FROM INTAPE.  IF THE O MODIFIER
C     IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES
C     WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT.  IF THE F
C     MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION
C     OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE
C     PRODUCED FOR ALL IMAGES OUTPUT.  IF THE C MODIFIER IS SPECIFIED,
C     SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH
C     RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR
C     ALL IMAGES OUTPUT.  IF NONE OF THE I, F, OR C MODIFIERS ARE
C     SPECIFIED, THE O MODIFIER IS ASSUMED.
C
C     IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED.
C     IF IDTXTL = ZERO, TEXT IS NOT EMITTED.
C     IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE
C     EMITTED.
C
C     CONVERT C1,C2,STEP,START
C
      IDOPTN=MODIFY
      IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79
C     70 = ASCII F, 73 = ASCII I, 79 = ASCII O.
      DO 40 J=1,4
      NUMBER=0
20    IF (EQUAL.GT.NCHCMD) GO TO 40
      IF (COMAND(EQUAL).EQ.44) GO TO 30
C     44 = ASCII ,
      I=COMAND(EQUAL)-48
      IF (I.LT.0) GO TO 350
      IF (I.GT.9) GO TO 350
      NUMBER=10*NUMBER+I
      EQUAL=EQUAL+1
      GO TO 20
30    EQUAL=EQUAL+1
40    IDNBRS(J)=NUMBER
      IDCUR=IDSTRT
      IDCOL1=MAX0(1,MIN0(IDCOL1,178))
      IDCOL2=MIN0(IDCOL2,178)
C
C     STORE TEXT.
C
      IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0)
      IF (IDTXTL.EQ.0) GO TO 330
      DO 50 J=1,IDTXTL
      IDTEXT(J)=COMAND(EQUAL)
50    EQUAL=EQUAL+1
      GO TO 330
C
C     INDEX = PARAMETER STRING
C
60    J=0
      IF (COMAND(EQUAL).NE.45) GO TO 70
C     45 = ASCII -
      J=-1
      EQUAL=EQUAL+1
70    N=0
      DO 80 I=1,26
80    INDEXS(I)=0
90    IF (EQUAL.GT.NCHCMD) GO TO 130
      I=COMAND(EQUAL)-64
      IF (I.EQ.-32) GO TO 120
C     32 = ASCII BLANK.
      IF (I.GE.32) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.LE.0) GO TO 100
      IF (I.LE.26) GO TO 110
100   N=EQUAL
      GO TO 120
110   INDEXS(I)=1
120   EQUAL=EQUAL+1
      GO TO 90
130   INDEX=0
      DO 140 I=1,26
      INDEXS(I)=IABS(INDEXS(I)+J)
140   INDEX=INDEX+INDEXS(I)
      IF (MODIFY.EQ.76) INDEX=-INDEX
C     76 = ASCII L.
      IF (N) 340,330,340
C
C     OPTION = PARAMETER STRING
C
150   IF (MODIFY.NE.0) GO TO 170
      DO 160 I=1,26
160   OPTVAL(I)=0
170   IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330
      I=1
      IF (MODIFY.EQ.67) I=0
C     67 = ASCII C.
      N=0
      DO 190 J=EQUAL,NCHCMD
      K=COMAND(J)
      IF (K.GE.96) K=K-32
C     CONVERT TO UPPER CASE.
      IF (K.EQ.32) GO TO 190
C     32 = ASCII BLANK
      IF (K.LT.65) GO TO 180
      IF (K.GT.90) GO TO 180
C     PROCESS ALPHABETIC OPTIONS.
      OPTVAL(K-64)=I
      GO TO 190
180   N=J
190   CONTINUE
      IF (N) 330,330,340
C
C     PROCESS PRED = ID REC A/X MASK STRING
C       WHERE ID = PREDICATE IDENTIFIER (A-H),
C       REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE,
C       A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH
C             IN EXACT POSITION,
C       MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE
C              TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED.
C       STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF
C                CONTROL RECORDS.
C
C     THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR
C     PREDICATE A, ETC.
C
C     PRED(1,*)=LENGTH OF STRING + 3
C     PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED.
C     PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND).
C     PRED(3,*)=RECORD TYPE.
C     PRED(4,*)=A/X
C     PRED(5,*)=MASK CHARACTER.
C     PRED(6..42,*)=STRING.
C
200   IF (EQUAL.NE.0) GO TO 240
C     LIST ALL ACTIVE PREDICATES.
      DO 230 I=1,8
      IF (PRED(1,I).EQ.0) GO TO 230
      J=PRED(1,I)+1
      COMAND(1)=I+64
      DO 210 K=2,J
210   COMAND(K)=PRED(K+1,I)
      CALL EXCHAH (COMAND,J)
      WRITE (PRINTR,220) (COMAND(K),K=1,J)
220   FORMAT (6H PRED=,42A1)
230   CONTINUE
      GO TO 330
C     SAVE PREDICATE IF VALID.
240   IF (NCHCMD.LE.EQUAL+3) GO TO 370
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.GT.72) GO TO 360
C     72 = ASCII H
      NUMBER=J-64
      PRED(1,NUMBER)=0
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.GT.90) GO TO 360
C     90 = ASCII Z
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.EQ.82) GO TO 360
C     82 = ASCII R
      PRED(3,NUMBER)=J
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.NE.65.AND.J.NE.88) GO TO 360
C     65 = ASCII A, 88 = ASCII X
      PRED(4,NUMBER)=J
      EQUAL=EQUAL+1
      PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40)
      I=4
      DO 250 J=EQUAL,NCHCMD
      I=I+1
      IF (I.GT.42) GO TO 330
      K=COMAND(J)
      IF (K.GT.96) K=K-32
C     CONVERT TO UPPER CASE.
250   PRED(I,NUMBER)=K
      GO TO 330
C
C     SITE = SITE NAME
C
260   JUMP=1
      GO TO 280
C
C     TITLE = OUTPUT TAPE TITLE
C
270   JUMP=2
280   K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 320 I=1,40
      IF (K.GT.NCHCMD) GO TO 290
      J=COMAND(K)
      K=K+1
      GO TO 300
290   J=32
C     32 = ASCII BLANK.
300   IF (JUMP.EQ.2) GO TO 310
      SITE(I)=J
      GO TO 320
310   TITLE(I)=J
320   CONTINUE
C
C     RETURN TO COMMAND DECODER.
C
330   TRANS=1
      GO TO 390
C
C     ERROR MESSAGES
C
340   NUMBER=14
C     MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED.
      EQUAL=N
      GO TO 380
350   IDSTEP=0
      IDTXTL=0
360   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED.
      GO TO 380
370   NUMBER=30
C     MESSAGE 30 - COMMAND IS INCOMPLETE.
C
380   TRANS=8
C
390   RETURN
C
      END
      SUBROUTINE EXCHC3 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE
C     COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES.
C
C     OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE
C     NAME COMMAND.
C
C     OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING
C     COPY, NAME OR UPDATE COMMANDS.
C
C ID      IS USED TO CONSTRUCT THE OUTPUT LABEL.
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                                    E  X  C  H
      DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/
C                                    A  N  G  E
      DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/
      DATA KNAME /9/
      DATA KSKIP /26/
C
C     OPEN INTAPE IF NECESSARY
C
      IF (INTOPN.NE.0) GO TO 70
      IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300
      IF (INTAPE.EQ.OUTAPE) GO TO 360
      CALL EXCHRH (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 310
      INTOPN=1
C     COPY THE LABEL TO A SAVE AREA.
      DO 10 I=1,180
10    LABELI(I)=CBLCKI(I)
      CALL EXCHAH (CBLCKI(13),138)
      WRITE (PRINTR,20)
20    FORMAT (25H0INPUT LABEL INFORMATION.)
      WRITE (PRINTR,30) (CBLCKI(I),I=13,104)
30    FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/
     1        20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1)
      IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150)
40    FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1)
      WRITE (PRINTR,50) NDATAI
50    FORMAT (28H DATA CHARACTERS PER BLOCK =,I6)
      IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI
60    FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6)
      CHAR1L=0
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 290
70    IF (ICOMD.EQ.KSKIP) GO TO 270
C
C     OPEN OUTAPE IF NECESSARY
C
80    IF (ICOMD.EQ.0) GO TO 90
      IF (ICOMD.LT.KNAME) GO TO 100
90    IF (INTAPE*OUTAPE.EQ.0) GO TO 100
      IF (OUTUPD.NE.85) GO TO 370
C     85 = ASCII U.
100   IF (OUTOPN.NE.0) GO TO 240
      IF (OUTAPE.EQ.0) GO TO 240
C     CONSTRUCT THE OUTPUT LABEL.
      IF (TODAY(1).EQ.0) GO TO 340
      IF (INTOPN.EQ.0) GO TO 160
      DO 110 I=1,180
110   CBLCKO(I)=LABELI(I)
      IF (TITLE(1).EQ.32) GO TO 130
C     32 = ASCII BLANK
      DO 120 I=1,40
120   CBLCKO(I+18)=TITLE(I)
130   IF (OUTUPD.NE.85) GO TO 220
C     85 = ASCII U.
      IF (SITE(1).EQ.0) GO TO 350
      DO 140 I=1,6
140   CBLCKO(I+104)=TODAY(I)
      DO 150 I=1,40
150   CBLCKO(I+110)=SITE(I)
      GO TO 220
160   IF (TITLE(1).EQ.32) GO TO 330
C     32 = ASCII BLANK
      IF (SITE(1).EQ.0) GO TO 350
      IF (INTAPE*OUTAPE.EQ.0) GO TO 170
      IF (INTAPE.EQ.OUTAPE) GO TO 360
170   DO 180 I=1,8
180   CBLCKO(I)=ID(I)
      DO 190 I=1,40
      CBLCKO(I+18)=TITLE(I)
190   CBLCKO(I+64)=SITE(I)
      DO 200 I=1,6
200   CBLCKO(I+58)=TODAY(I)
      DO 210 I=105,180
210   CBLCKO(I)=0
220   CALL EXCHWH (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 320
      OUTOPN=1
      CBLCKO(1)=CBLCKO(105)
      CALL EXCHAH (CBLCKO(13),138)
      WRITE (PRINTR,230)
      WRITE (PRINTR,30) (CBLCKO(I),I=13,104)
230   FORMAT (26H0OUTPUT LABEL INFORMATION.)
      IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150)
      WRITE (PRINTR,50) NDATAO
      IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO
      CHAR1L=0
240   IF (ICOMD-KNAME) 250,260,280
C
C     COPY
C
250   TRANS=4
      MODEI=1-MIN0(1,OUFILE+OPTL)
      IF (ICOMD.EQ.0) MODEI=0
      GO TO 390
C
C     NAME
C
260   TRANS=5
      IF (NRWORK.EQ.0) PHASE=4
      GO TO 390
C
C     SKIP
C
270   TRANS=4
      GO TO 390
C
C     UPDATE
C
280   TRANS=5
      MODEI=0
      GO TO 390
C
C     ERROR MESSAGES
C
290   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      EQUAL=ISTAT
      GO TO 380
300   NUMBER=4
C     MESSAGE 4 - INTAPE NOT DEFINED.
      GO TO 380
310   NUMBER=5
C     MESSAGE 5 - UNABLE TO OPEN INTAPE.
      EQUAL=ISTAT
      GO TO 380
320   NUMBER=6
C     MESSAGE 6 - UNABLE TO OPEN OUTAPE.
      EQUAL=ISTAT
      GO TO 380
330   NUMBER=7
C     MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE.
      GO TO 380
340   NUMBER=8
C     MESSAGE 8 - DATE NOT SUPPLIED.
      GO TO 380
350   NUMBER=9
C     MESSAGE 9 - SITE NOT SUPPLIED.
      GO TO 380
360   NUMBER=10
C     MESSAGE 10 - INTAPE = OUTAPE.
      GO TO 380
370   NUMBER=11
C     MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED.
380   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM
C
390   RETURN
C
      END
      SUBROUTINE EXCHRH (ISTAT,DBLOCK)
C
C     READ THE HEADER LABEL FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE
C               NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     OPEN THE INPUT TAPE.
C
      ISTAT=1
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     READ A BLOCK.
C
      NDATAI=171
      NERRCI=0
      BLKSQI=0
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     FIND OUT IF IT IS A PROPER LABEL.
C
      CALL EXCHUN (DBLOCK,CBLCKI)
      DO 10 I=1,8
      IF (CBLCKI(I).NE.ID(I)) GO TO 20
10    CONTINUE
C
C     GET READY TO READ THE REST OF THE TAPE.
C
      CCDBI=NCDBI
      NDATAI=256*CBLCKI(9)+CBLCKI(10)
      NERRCI=256*CBLCKI(11)+CBLCKI(12)
      LASTI=0
      L1PRGI=0
      ISTAT=0
      GO TO 30
C
C     NOT A LABEL.
C
20    ISTAT=6
C
C     CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK.
25    I=4
      CALL EXCHRT (I,DBLOCK)
C
30    RETURN
C
      END
      SUBROUTINE EXCHWH (ISTAT,DBLOCK)
C
C     WRITE A HEADER ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE
C               WRITTEN ARE NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     MAKE SURE IT IS A PROPER LABEL.
C
      DO 10 I=1,8
      IF (CBLCKO(I).NE.ID(I)) GO TO 30
10    CONTINUE
C
C     OPEN THE OUTPUT TAPE.
C
      ISTAT=1
      CALL EXCHWT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 40
C
C     CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR
C     CONTROL CHARACTERS
C
      CBLCKO(9)=NDATAO/256
      CBLCKO(10)=MOD(NDATAO,256)
      CBLCKO(11)=NERRCO/256
      CBLCKO(12)=MOD(NERRCO,256)
C
C     INSERT TODAYS DATE
C
      DO 20 I=1,6
20    CBLCKO(I+12)=TODAY(I)
C
C     WRITE THE BLOCK ON TAPE.
C
      BLKSQO=0
      CALL EXCHPA (CBLCKO,DBLOCK)
      CCDBO=180
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     GET READY TO WRITE THE REST OF THE FILE.
C
      L1PRGO=0
      LLPRGO=0
      N1RECO=0
      NLRECO=0
      L1RECO=0
      LASTO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      GO TO 40
C
C     NOT A PROPER LABEL.
C
30    ISTAT=6
C
40    RETURN
C
      END
      SUBROUTINE EXCHC4 (IBLOCK)
      INTEGER IBLOCK(1)
C
C     PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM
C     COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KCOPY /3/
C
C     ARE WE STARTING OR CONTINUING?
C
C     ICOMD.EQ.0  MEANS  CHANGE A CONTROL RECORD
C     ICOMD.GT.0  MEANS  SKIP OR COPY COMMAND BEGIN
C     ICOMD.EQ.-1 MEANS  CONTINUE COPY = NUMBERS
C     ICOMD.EQ.-2 MEANS  CONTINUE COPY = PREDICATE EXPRESSION
      NEWP=0
      IF (ITYPEI.EQ.80) VERT=0
C     80 = ASCII P.  WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO
C     IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON
C     THE WORK FILE.
      IF (ICOMD.EQ.0) GO TO 190
C     ICOMD=0 MEANS CHANGING A CONTROL RECORD.
      IF (ICOMD+1) 290,170,10
10    IF (ICOMD.EQ.KCOPY) GO TO 30
C
C     SKIP COMMAND.
C
      IF (INTOPN.LT.0) GO TO 430
      if (modify.eq.70) number=number+n1reci-1
c     70 = ASCII F.
      IF (NUMBER+1-N1RECI) 540,430,20
20    CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.EQ.69) GO TO 460
C     69 = ASCII E.
      IF (N1RECI-NUMBER) 20,20,430
C
C     COPY COMMAND FORMAT VERIFICATION.
C
30    IF (COMAND(EQUAL).LT.48) GO TO 180
C     48 = ASCII ZERO
      IF (COMAND(EQUAL).GT.57) GO TO 180
C     57 = ASCII NINE
C
C     COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS.
C     CONVERT THE NUMBERS AND STORE THEM IN COMAND.  IF THE NUMBER
C     IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER.
C
      ICOMD=-1
      I=0
      J=44
C     44 = ASCII COMMA
40    I=I+1
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 480
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=NUMBER
50    EQUAL=EQUAL+1
      IF (EQUAL.GT.NCHCMD) GO TO 60
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 60
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=10*COMAND(I)+NUMBER
      GO TO 50
60    IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70
70    IF (J.EQ.45) COMAND(I)=-COMAND(I)
C     45 = ASCII DASH
      IF (EQUAL.GT.NCHCMD) GO TO 90
      J=COMAND(EQUAL)
      IF (J.EQ.32 .OR. J.EQ.46) GO TO 90
C     32 = ASCII BLANK, 46 = ASCII PERIOD.
      IF (J.NE.44.AND.J.NE.45) GO TO 480
C     44 = ASCII COMMA, 45 = ASCII DASH
80    EQUAL=EQUAL+1
      IF (COMAND(EQUAL)-32) 40,80,40
C     32 = ASCII BLANK
90    NUMBER=I
C     FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE
C     POSITION IN COMAND CURRENTLY BEING EXAMINED.
      EQUAL=-1
100   EQUAL=EQUAL+1
      IF (EQUAL.GE.NUMBER) GO TO 470
      IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100
      IF (EQUAL.EQ.0) GO TO 120
      WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD)
110   FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H)
     1NOT COPIED./(1X,80A1))
      NERRG=MAX0(NERRG,5)
120   IF (COMAND(EQUAL+1).GT.0) GO TO 130
      EQUAL=EQUAL-1
      COMAND(EQUAL+1)=N1RECI
130   IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
C
C     PROCESS COPY = LIST OF NUMBERS
C
140   EQUAL=EQUAL+1
C     GO COPY THE PROGRAM IF IT IS THE RIGHT ONE.
150   IF (INTOPN.LT.0) GO TO 430
      IF (COMAND(EQUAL)-N1RECI) 170,420,160
C     SKIP TO DESIRED PROGRAM
160   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI-69) 150,460,150
C     69 = ASCII E
170   IF (EQUAL.GE.NUMBER) GO TO 430
      IF (COMAND(EQUAL+1).GE.0) GO TO 140
      COMAND(EQUAL)=IABS(COMAND(EQUAL))+1
      IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420
      EQUAL=EQUAL+1
      GO TO 170
C
C     COPY = SELECTION STRING OR CHANGE CONTROL RECORD.
C
180   ICOMD=-2
      IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
      NRWORK=-1
C
C     DETERMINE NEED TO OPEN WORK FILE.
C
190   IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0)
     1IF (ICOMD) 290,430,290
      IF (WORKF.EQ.0) GO TO 500
      I=IABS(WORKF)
      IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510
      IF (WORKF.GT.0) GO TO 200
      WORKF=I
      CALL EXCHFO (3)
200   IF (ICOMD.NE.0) GO TO 280
C
C     CHANGE CONTROL RECORD.
C
      if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520
c     69 = ascii E, 73 = ascii I.
      if (nrwork.eq.0) go to 210
      if (itypei.eq.80) go to 520
c     80 = ascii P
210   IF (NUMBER-NRWORK-1) 530,220,410
220   NCHACT=NCHCMD+1-EQUAL
      IF (NCHACT.GT.0) GO TO 230
      NCHACT=1
      INTREC(1)=32
C     32 = ASCII BLANK
      GO TO 425
230   DO 240 I=1,NCHACT
240   INTREC(I)=COMAND(EQUAL+I-1)
      GO TO 425
C
C     COPY = SELECTION EXPRESSION.
C
C     SKIP TO NEXT PROGRAM.
250   IF (INTOPN.LT.0) GO TO 430
      if (itypei.eq.69) go to 460
c     69 = ASCII E.
      do 260 i = 1, 8
260   pred(2,i)=0
      if (itypei.ne.80) go to 265
c     If the current record is a new program, don't skip it (we haven't
c     processed it yet).
      if (nrwork.gt.0 .and. workf.gt.0) rewind workf
      nrwork=min0(nrwork,0)
      newp=0
      go to 320
265   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      nxnewp=0
270   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.NE.80) GO TO 310
C     80 = ASCII P
      NEWP=nxnewp
c     Set NEWP non-zero when all control records for a module have been
c     seen.
      GO TO 320
280   NRWORK=MAX0(NRWORK,0)
290   DO 300 I=1,8
300   PRED(2,I)=0
c     NEWP is non-zero when all control records have been read.
310   if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1
C     69 = ASCII E, 73 = ASCII I.
320   nxnewp=1
      if (icomd.eq.0) if (newp) 520,210,520
      IF (LIMIT.EQ.0) GO TO 340
      IF (N1RECI.LE.LIMIT) GO TO 340
      WRITE (PRINTR,330) LIMIT
330   FORMAT (7H LIMIT=,I6,9H REACHED.)
      GO TO 430
340   IF (NEWP.EQ.0) GO TO 360
      CALL EXCHLX
C     EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'.
      NUMBER=NCHCMD
      IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415
C     73 = ASCII I.
      IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425
C     80 = ASCII P.
      IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425
C     83 = ASCII S.
      IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415
C     88 = ASCII X.
      IF (COMAND(180)) 450,250,420
C     CONTROL RECORD.  EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE.
360   I=1
      DO 400 NUMBER=1,8
      IF (PRED(1,NUMBER).EQ.0) GO TO 400
      IF (PRED(2,NUMBER).NE.0) GO TO 400
      IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390
      NM=PRED(1,NUMBER)-3
      IF (.NOT.(NCHACT.GT.0)) GO TO 390
      DO 385 L = 1, NCHACT
      DO 380 J = 1, NM
C
C     DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND
C     IN PREDICATE.
      IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380
      IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370
C
C     NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS.
      K=32
      GO TO 375
C     USE CHARACTER FROM CONTROL RECORD.
370   K=INTREC(J+L-1)
C
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (K.GT.96 .AND. K.LT.123) K=K-32
C
C     TEST FOR A MATCH ON A SINGLE CHARACTER.
C     IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE
C     PATTERN.  IF THE SEARCH MODE IS X, TERMINATE THE SEARCH.
375   IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390
380   CONTINUE
C
C     FOUND A MATCH IN CONTROL RECORD AND PREDICATE.
      PRED(2,NUMBER)=1
      GO TO 400
385   CONTINUE
390   I=0
400   CONTINUE
      IF (I.NE.0) newp=1
      IF (NRWORK.LT.0) GO TO 270
C     AT LEAST ONE FALSE PREDICATE.  WRITE THE CONTROL RECORD ON WORKF.
410   WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT)
      NRWORK=NRWORK+1
      GO TO 270
C
C     GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM.
C
415   ICOMD=-3
C     RETURN TO EXCHC1 AFTER COPYING MODULE.
420   TRANS=5
      GO TO 570
C
C     RETURN TO THE COMMAND PROCESSOR.
C
425   TRANS=1
C     REMEMBER CONTROL RECORDS ON WORKF.
      GO TO 570
430   TRANS=1
      IF (ICOMD+1) 560,570,570
C
C     ERROR MESSAGES.
C
440   NUMBER=1
C     MESSAGE 1 - I/O ERROR.
      EQUAL=ISTAT
      GO TO 550
450   NUMBER=-COMAND(180)
C     MESSAGES GENERATED BY EXCHLX
      GO TO 550
460   IF (INTOPN.LT.0) GO TO 430
      INTOPN=-1
      EQUAL=NUMBER
      NUMBER=15
C     MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE.
      GO TO 550
470   NUMBER=16
C     MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION.
      GO TO 550
480   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER
      GO TO 550
490   NUMBER=18
C     MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER.
      GO TO 550
500   NUMBER=19
C     MESSAGE 19 - WORK FILE NOT DEFINED.
      GO TO 550
510   NUMBER=20
C     MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE.
      GO TO 550
520   EQUAL=NUMBER
      NUMBER=21
C     MESSAGE 21 - CONTROL RECORD NOT PRESENT
      GO TO 550
530   NUMBER=22
C     MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER.
      GO TO 550
540   NUMBER=29
C     MESSAGE 29 - BACKWARD SKIP IGNORED.
C
C     RETURN TO THE ERROR MESSAGE PROCESSOR.
C
550   TRANS=8
      IF (ICOMD.EQ.0) GO TO 570
C
C     DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF.
C
560   IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
C
C     RETURN TO TRANSITION PROGRAM.
C
570   RETURN
C
      END
      SUBROUTINE EXCHLX
C
C     EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND.
C
C     THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE
C     STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM
C     COPY=LOGICAL EXPRESSION.  THE LOGICAL EXPRESSION CONSISTS OF THE
C     EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY
C     OPERATORS + - * / AND PARENEHESES.  THE PRIMARY SYMBOLS A-H ARE
C     LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE
C     STATEMENTS.  THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE
C     NULL PREDICATE, WHICH IS ALWAYS FALSE.  THE OPERATORS + - * / ARE
C     THE BINARY LOGICAL OPERATIONS   OR, OR NOT, AND, AND NOT
C     RESPECTIVELY.  THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE
C     PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL
C     PRIORITY.  THE RELATIVE PRIORITY MAY BE CHANGED BY USING
C     PARENTHESES.
C
C     WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY
C     FALSE.  AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL
C     FALSE PREDICATES IS DETERMINED.  ONCE TRUE, A PREDICATE REMAINS
C     TRUE.  THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND
C     A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE.  WHEN ALL ACTIVE
C     PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM
C     HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND
C     IS EVALUATED.  IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED.
C     IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED.  THIS PROCESS
C     CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM
C     NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED.
C
C     THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE
C     TABLE BELOW.  INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS
C     APPENDED TO THE END OF THE LOGICAL EXPRESSION.
C
C     PREVIOUS  I                 CURRENT TOKEN                   I
C      TOKEN    I + - * / I PRIMARY I    (    I    )    I  ELSE   I
C     ----------I---------I---------I---------I---------I---------I
C      + - * /  I  ERROR  I   OK    I   OK    I  ERROR  I  ERROR  I
C      PRIMARY  I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C         (     I  ERROR  I   OK    I   OK    I   OK    I  ERROR  I
C         )     I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C     ----------I---------I---------I---------I---------I---------I
C
C     CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING
C     A STACK AND THE PRECEDENCE TABLE BELOW.  TOS MEANS TOP-OF-STACK,
C     HOI MEANS HEAD-OF-INPUT.  THE STACK INITIALLY CONTAINS (.
C
C                  TOS       HOI
C      TOKEN   I  INDEX  I  INDEX  I
C     ---------I---------I---------I
C       + -    I    2    I    1    I
C       * /    I    4    I    3    I
C     PRIMARY  I    6    I    5    I
C        (     I    0    I    7    I
C        )     I   N/A   I    0    I
C     ---------I---------I---------I
C
C     WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS
C     PUSHED ONTO THE STACK.  WHEN THE TOS INDEX IS GREATER THAN THE HOI
C     INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY
C     SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT
C     PLACED IN THE SUFFIX LIST.  THEN THE RELATION OF THE TOS INDEX TO
C     THE HOI INDEX IS RE-EXAMINED.  WHEN THE TOS INDEX IS EQUAL TO THE
C     HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED.
C
C     *****     INTERNAL VARIABLES     *********************************
C
C CHTAB   RECOGNIZED CHARACTERS.  INTERNAL PROCESSES USE THE INDEX
C         INTO CHTAB.
C COLTAB  CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX.
C HOI     CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE.
C INFIX   IS THE CURRENT POSITION IN THE INFIX.
C IPREV   IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN.
C ISTACK  IS THE CURRENT STACK INDEX.
C ISUFIX  IS THE CURRENT SUFFIX INDEX.
C SYNTAX  CONTAINS THE SYNTAX RULES.
C TOS     CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE.
C
      INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     DATA STATEMENTS     ************************************
C
C                                                    A  B  C  D
      DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/
C                                                    E  F  G  H
      DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/
C                                                    N  +  -  *
      DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/
C                                                    /  (  )
      DATA CHTAB(13),CHTAB(14),CHTAB(15)           /47,40,41   /
C                                                       A B C D
      DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/
C                                                       E F G H
      DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/
C                                                       N + - *
      DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/
C                                                       / ( )
      DATA COLTAB(13),COLTAB(14),COLTAB(15)            /1,3,4  /
C                                                   A B C D E
      DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/
C                                                   F G H N +
      DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/
C                                                   - * / ( )
      DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/
C                 CURRENT TOKEN IS +-*/.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/
C                 CURRENT TOKEN IS PRIM.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/
C                 CURRENT TOKEN IS (.     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/
C                 CURRENT TOKEN IS ).     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/
C                                                   A B C D E
      DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/
C                                                   F G H N +
      DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/
C                                                   - * / ( )
      DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/
C
C     *****     PROCEDURES     *****************************************
C
C     COMAND IS USED FOR INFIX, STACK AND SUFFIX.  UPON COMPLETION,
C     COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE
C     OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE
C     EXPRESSION IS TRUE.
C
      ISTACK=NCHCMD+2
      COMAND(ISTACK)=14
      ISUFIX=181
      IPREV=3
      COMAND(NCHCMD+1)=41
      INFIX=EQUAL-1
C
C     GET A CHARACTER FROM INFIX.  LOOK UP IN CHTAB.  CHECK SYNTAX.
C
10    IF (INFIX.GT.NCHCMD) GO TO 180
      INFIX=INFIX+1
      J=COMAND(INFIX)
      IF (J.EQ.32) GO TO 10
C     32 = ASCII BLANK - IGNORE IT.
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      DO 20 I=1,15
      IF (CHTAB(I).EQ.J) GO TO 30
20    CONTINUE
      GO TO 230
30    J=COLTAB(I)
      IF (SYNTAX(IPREV,J)-1) 40,190,200
C
C     CONVERT INFIX TO SUFFIX
C
40    IPREV=J
50    J=COMAND(ISTACK)
      IF (TOS(J)-HOI(I)) 60,70,80
C     PUSH INFIX ONTO STACK
60    ISTACK=ISTACK+1
      COMAND(ISTACK)=I
      GO TO 10
C     DELETE TOP OF STACK
70    ISTACK=ISTACK-1
      IF (ISTACK.GT.NCHCMD+1) GO TO 10
      IF (INFIX-NCHCMD) 220,220,250
C     IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX.
C     IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX.
80    IF (J-9) 90,100,130
C     PRIMARY IS SYMBOL A-H
90    IF (PRED(1,J).EQ.0) GO TO 210
      J=PRED(2,J)
      GO TO 110
C     NULL PREDICATE
100   J=0
110   ISUFIX=ISUFIX-1
120   COMAND(ISUFIX)=J
      ISTACK=ISTACK-1
      GO TO 50
C     OPERATOR
130   J=J-9
      ISUFIX=ISUFIX+1
      GO TO (140,150,160,170), J
C             +   -   *   /
140   J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1)
      GO TO 120
150   J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1)
      GO TO 120
160   J=COMAND(ISUFIX)*COMAND(ISUFIX-1)
      GO TO 120
170   J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1))
      GO TO 120
C
180   COMAND(180)=-23
C     MESSAGE 23 - TOO MANY (
      GO TO 240
190   COMAND(180)=-24
C     MESSAGE 24 - MISSING PRIMARY
      GO TO 240
200   COMAND(180)=-25
C     MESSAGE 25 - MISSING OPERATOR
      GO TO 240
210   EQUAL=CHTAB(J)
      CALL EXCHAH (EQUAL,1)
      COMAND(180)=-26
C     MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE.
      GO TO 250
220   COMAND(180)=-27
C     MESSAGE 27 - TOO MANY )
      GO TO 240
230   COMAND(180)=-28
C     MESSAGE 28 - UNRECOGNIZED CHARACTER
C
240   EQUAL=INFIX
250   RETURN
C
      END
      SUBROUTINE EXCHC5 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE,
C     AND INDEX IF SELECTED.  COPY RECORDS FROM WORKF FIRST, IF ANY.
C     CREATE CONTROL RECORDS DEMANDED BY COMMANDS.
C
C     THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF
C     THE PARAMETER STRING.
C
C     AUTHOR
C     COMMENT
C     CONTROL (ITYPEO SET FROM MODIFY)
C     DATA TYPE
C     GROUPS
C     INSERT
C     KEYWORDS
C     MACHINE
C     ORIGIN
C     REFERENCES
C     REMOVE   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     SIGNAL   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     UPDATE
C
C     IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS
C     ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A
C     CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND.
C
C     *****     LOCAL VARIABLES     ************************************
C
C BLANK   CONTAINS A HOLLERITH BLANK.
      INTEGER BLANK
C C1      IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING.
      INTEGER C1
C COL1    THE FIRST COLUMN OF TEXT OF A CONTROL RECORD.  DERIVED FROM
C         EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE.
      INTEGER COL1
C I,J     USED FREELY AS INDICES.
      INTEGER I,J
C KCONT   THE INDEX IN COMD OF THE CONTROL COMMAND.
      INTEGER KCONT
C KNAME   IS THE INDEX IN COMD OF THE NAME COMMAND.
      INTEGER KNAME
C KTEXT   THE INDEX IN COMD OF THE TEXT COMMAND.
      INTEGER KTEXT
C KUPDA   THE INDEX IN COMD OF THE UPDATE COMMAND.
      INTEGER KUPDA
C LIST    CONTAINS THE WORD LIST IN ASCII.  USED FOR THE A OPTION.
      INTEGER LIST(4)
C NM      IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NM
C NOUT    IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NOUT
C NY      IS THE PROGRAM NUMBER.  IT IS THE NUMBER FROM INTAPE IF
C         OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE.
      INTEGER NY
C ONE     CONTAINS A HOLLERITH 1.
      INTEGER ONE
C REASON  REASON FOR COPYING A CONTROL RECORD.  1 = COPY COMMAND
C         PENDING.  2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8.
C         3 = COMMAND.
      INTEGER REASON
C RI      CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A
C         GIVEN RECORD TYPE.  RI IS SUBSCRIPTED BY (ITYPEO-64).
      INTEGER RI(26)
C RT      IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT.
      INTEGER RT(34)
C STAR    CONTAINS A HOLLERITH STAR.
      INTEGER STAR
C ZERO    CONTAINS A HOLLERITH ZERO.
      INTEGER ZERO
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL VARIABLE DATA     ********************************
C
      DATA BLANK /1H /
C                                            L  I  S  T
      DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/
C
      DATA KCONT /31/
      DATA KNAME /9/
      DATA KTEXT /27/
      DATA KUPDA/29/
      DATA ONE /1H1/
C                                                      A  B  C  D  E  F
      DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/
C                                                      G  H  I  J  K  L
      DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/
C                                                      M  N  O  P  Q  R
      DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/
C                                                      S  T  U  V  W  X
      DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/
C                                                      Y  Z
      DATA RI(25),RI(26)                             /31,31            /
C                                                     A  C     D     G
      DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/
C                                                           P     K
      DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/
C                                                     M     O
      DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/
C                                                              B  R
      DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/
C                                                                 S
      DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/
C                                                              J
      DATA RT(31),RT(32),RT(33),RT(34)              /-1, 0, 0,74/
C
      DATA STAR /1H*/
      DATA ZERO /1H0/
C
C     *****     PROCEDURES     *****************************************
C
      REASON=1
      NY=N1RECI
      IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1
C     ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P.
C     IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT.
      IF (PHASE.EQ.4) NY=0
C     NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER.  (IT IS PRINTED
C     IN THE INDEX).
      IF (ICOMD.LE.0) GO TO 10
      IF (PHASE.GE.4) GO TO 100
      IF (ICOMD.EQ.KNAME) GO TO 10
      IF (ICOMD.NE.KUPDA) GO TO 100
      REASON=2
      PHASE=8
10    IF (NRWORK.GT.0) REWIND WORKF
      NM=0
      NOUT=0
20    NM=NM+1
      IF (NM.LE.NRWORK) GO TO 60
30    IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230
C     69 = ASCII E, 73 = ASCII I.
      IF (NOUT.EQ.0) GO TO 40
      IF (ITYPEI.EQ.80) GO TO 230
C     80 = ASCII P.
      IF (NCHACT.NE.1) GO TO 40
      IF (INTREC(1).EQ.32) GO TO 220
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
40    ITYPEO=ITYPEI
      NCHOUT=NCHACT
      DO 50 J=1,NCHOUT
50    OUTREC(J+5)=INTREC(J)
      GO TO 70
60    READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT)
      IF (NCHOUT.NE.1) GO TO 70
      IF (NM.EQ.1) GO TO 70
      IF (OUTREC(6).EQ.32) GO TO 200
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
70    NOUT=NOUT+1
      J=RI(ITYPEO-64)
      DO 80 I=1,4
80    OUTREC(I)=COMD(I,J)
      OUTREC(5)=61
C     61 = ASCII =
      COL1=5
      IF (J.NE.KCONT) GO TO 130
      COL1=7
C     CONTROL,*=...  MOVE UP TWO CHARACTERS AND INSERT ITYPEO.
      DO 90 I=1,NCHOUT
90    OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I)
      OUTREC(5)=44
C     44 = ASCII COMMA.
      OUTREC(6)=ITYPEO
      OUTREC(7)=61
C     61 = ASCII =
      GO TO 130
100   IF (ICOMD.EQ.KTEXT) GO TO 240
      COL1=EQUAL-1
      NCHOUT=NCHCMD-COL1
      NRWORK=NRWORK+1
C     NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD.
      ITYPEO=RT(ICOMD)
      IF (ITYPEO.GT.0) GO TO 110
C     PROCESS CONTROL,TYPE=TEXT COMMAND.
      ITYPEO=MODIFY
      IF (RI(ITYPEO-64).NE.KCONT) GO TO 320
110   NOUT=NRWORK
      REASON=3
      DO 120 I=1,NCHCMD
120   OUTREC(I)=COMAND(I)
130   IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1)
C     74 = ASCII J.
      IF (ITYPEO.EQ.80) VERT=0
C     80 = ASCII P
      IF (ITYPEO.NE.68) GO TO 150
C     68 = ASCII D
      IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150
      DO 140 J=1,4
      I=OUTREC(J+COL1)
      IF (I.GT.96 .AND. I.LT.123) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.NE.LIST(J)) GO TO 150
140   CONTINUE
      VERT=1
C     GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE.
150   CALL EXCHCG (OUTREC(COL1+1))
      IF (OUTOPN.EQ.0) GO TO 160
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1))
      IF (ISTAT.NE.0) GO TO 340
      NY=NLRECO
160   NCHOUT=NCHOUT+COL1
C     TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER.
      OUTREC(180)=-NOUT
      IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC)
C     PRINT THE INDEX IF SELECTED.
      IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO
     1190
      IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190
      C1=BLANK
C     DOUBLE SKIP FOR PROGRAM HEADER (P).
      IF (ITYPEO.EQ.80) C1=ZERO
      IF (OPTV+VERT.NE.0) GO TO 170
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170
      IF (CHAR1L.NE.ONE) C1=ONE
      CHAR1L=ONE
170   CALL EXCHAH (OUTREC,NCHOUT)
      WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT)
180   FORMAT (A1,2I5,1H*,(3X,105A1))
190   IF (REASON.EQ.3) GO TO 310
200   IF (NM-NRWORK) 20,210,220
210   REWIND WORKF
      NRWORK=0
      GO TO 30
220   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT) 330,30,330
230   IF (REASON.EQ.2) GO TO 300
240   IF (OUFILE.EQ.0) GO TO 260
      DO 250 I=1,4
250   OUTREC(I)=COMD(I,KTEXT)
      OUTREC(180)=0
      NCHOUT=0
C     TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED.
      CALL EXCHCG (OUTREC)
      NCHOUT=4
      ACTION=2-OPTC-OPTC
C     ACTION = 2 MEANS START OF PROGRAM.
      CALL EXCHOU (OUTREC)
260   IF (OPTV+VERT.NE.0) GO TO 280
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280
      IF (OUTOPN.NE.0) NY=NLRECO
      I=BLANK
      IF (CHAR1L.NE.ONE) I=ONE
      WRITE (PRINTR,270) I,NY
270   FORMAT (A1,I5,1H*,8X,4HTEXT/)
280   CHAR1L=STAR
      NRWORK=MIN0(NRWORK,0)
      IF (IDOPTN.NE.67) IDCUR=IDSTRT
C     67 = ASCII C
      IF (ICOMD.EQ.KTEXT) GO TO 290
C
C     WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL
C     RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED.
C
      TRANS=6
      GO TO 370
C
C     WORKING ON A TEXT STATEMENT.
C
290   TRANS=7
      GO TO 370
C
C     WORKING ON AN UPDATE STATMENT.
C
300   NRWORK=NOUT
      GO TO 100
C
C     WRITING A SINGLE CONTROL RECORD.
C
310   TRANS=1
      GO TO 370
C
C     ERROR MESSAGES.
C
320   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER.
      GO TO 360
330   NUMBER=1
      GO TO 350
340   NUMBER=2
350   EQUAL=ISTAT
360   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM.
C
370   RETURN
C
      END
      SUBROUTINE EXCHCG (RECORD)
C
C     USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL.
C     WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED.
C     THIS IS THE PORTABLE VERSION.  IT DOES NOT DO ANYTHING.
C
      INTEGER RECORD(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      RETURN
      END
      SUBROUTINE EXCHC6 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE.
C
      INTEGER KNAME,ONE,SVHCMD(180)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KNAME /9/
      DATA ONE /1H1/
C
      LINEO=0
      NERRS=0
C     SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT.
      DO 5 I = 1,NCHCMD
5     SVHCMD(I)=HOLCMD(I)
      IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165
C     73 = ASCII I.  IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE
C     A VOID MODULE.
      IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10
      CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.EQ.7) GO TO 220
      IF (ISTAT) 250,160,250
10    MODEO=MODEI
      ITYPEO=0
      NBC=OPTL+OUFILE
      IF (INDEX.GT.0) NBC=1
20    NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTOPN.EQ.0) GO TO 120
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 260
C
C     CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD
C     INSTEAD OF BYTE-BY-BYTE).  WE CAN DO A BLOCK COPY IF
C     WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT
C     FILE AND NOT PRINTING THE INDEX.  ALSO, THE INPUT AND
C     OUTPUT CHARACTER POSITIONS MUST BE THE SAME.  IF THE
C     PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH
C     THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE
C     CURRENT POSITION IN THE BYTE BUFFER BE THE SAME.
C     WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE
C     LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T
C     KNOW THE LOCATION OF THE END-OF-FILE RECORD.
C
      IF (NBC.NE.0) GO TO 120
      IF (CPCBI+1.NE.CPCBO) GO TO 120
      IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120
C     WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF.
      IF (L1PRGI.EQ.0) GO TO 25
      IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30
25    IF (CCDBI+1.NE.CCDBO) GO TO 120
      IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120
C     WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE).
C     FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO.
30    LI=L1PRGI+NERRCI-1
      IF (L1PRGI.NE.0) GO TO 40
      LI=NERRCI+NDATAI+9
      IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1
40    IF (CPCBI.GE.NCCBI) GO TO 50
      IF (CCDBI.GE.LI) GO TO 160
      CPCBI=CPCBI+1
      CBLCKO(CPCBO)=CBLCKI(CPCBI)
      CPCBO=CPCBO+1
      CCDBI=CCDBI+1
      CCDBO=CCDBO+1
      GO TO 40
C     PACK COPIED BYTES.
50    CALL EXCHPA (CBLCKO,OBLOCK(CWDBO))
      CPCBO=1
      CPCBI=0
      CWDBO=CWDBO+NWCBO
      CWDBI=CWDBI+NWCBI
C     NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM
60    IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70
      IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=L1RECI
      CALL EXCHPB (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 260
70    IF (CCDBI.LT.LI) GO TO 80
      IF (L1PRGI.NE.0) GO TO 100
      CALL EXCHGB (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 250
      GO TO 30
80    NW=NWCBI*((LI-CCDBI)/NCCBI)
      IF (NW.EQ.0) GO TO 100
      DO 90 I=1,NW
      OBLOCK(CWDBO)=IBLOCK(CWDBI)
      CWDBO=CWDBO+1
90    CWDBI=CWDBI+1
100   CCDBO=CCDBO+LI-CCDBI
      CCDBI=LI
      IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60
      CPCBI=MOD(LI,NCCBI)
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      CALL EXCHUN (IBLOCK(CWDBI),CBLCKI)
      IF (CPCBI.EQ.0) GO TO 160
      DO 110 I=1,CPCBI
110   CBLCKO(I)=CBLCKI(I)
      GO TO 160
C
C     END OF BLOCK COPY CODE.
C
120   CALL EXCHTP (INTREC,LINEO)
160   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 250
      IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20
C     73 = ASCII I.
165   IF (OPTL.NE.0) GO TO 180
      IF (INDEX.LE.0) GO TO 195
      WRITE (PRINTR,170) LINEO
170   FORMAT (I9,14H IMAGES COPIED)
      GO TO 200
180   WRITE (PRINTR,190)
190   FORMAT (1H1)
195   CHAR1L=ONE
200   IF (OUFILE.EQ.0) GO TO 210
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
210   IF (ITYPEI.EQ.69) GO TO 220
C     69 = ASCII E
C
C     RETURN TO THE COPY CONTROL SEGMENT.
C
      DO 215 I=1,NCHCMD
215   HOLCMD(I)=SVHCMD(I)
      IF (ICOMD.EQ.-3) GO TO 240
C     ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE.
      TRANS=4
      IF (ICOMD.NE.KNAME) GO TO 280
C     MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME'
C     COMMAND SUBMITTED.  GO PROCESS 'NAME' COMMAND.
      TRANS=5
      PHASE=4
      GO TO 280
C
C     END OF FILE ON INPUT TAPE.
C
220   IF (INTOPN.LT.0) GO TO 240
      WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD)
230   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1))
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
240   TRANS=1
      GO TO 280
C
C     ERROR MESSAGES.
C
250   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      GO TO 270
260   NUMBER=2
C     MESSAGE 2 - I/O ERROR WRITING OUTAPE.
270   TRANS=8
      EQUAL=ISTAT
C
C     RETURN TO THE TRANSITION PROGRAM.
C
280   IF (NERRS.EQ.0) GO TO 300
      WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD)
290   FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./
     1(1X,80A1))
      NERRG=MAX0(NERRS,NERRG)
300   RETURN
C
      END
      SUBROUTINE EXCHC7 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
      INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40)
C
C     PROCESS THE TEXT COMMAND.
C
C MSG     IS USED TO PRINT A MESSAGE.
      INTEGER MSG(6,2)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/
      DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/
      DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/
      DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/
      DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/
C
      LINEI=1
      LINEO=0
      NERRS=0
      INEND=0
      CHAR1L=STAR
C
C     SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND
C
      K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 20 I=1,40
      IF (K.GT.NCHCMD) GO TO 10
      J=COMAND(K)
      K=K+1
      GO TO 20
10    J=32
C     32 = ASCII BLANK.
20    TXDISK(I)=J
      IF (INTOPN.LE.0) ITYPEI=0
C
C     MAIN PROCESSING LOOP
C
60    EDIT=0
70    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 80
C     NCHCMD.LT.0 MEANS END OF FILE.
      IF (NCHCMD.LT.2) GO TO 100
      IF (COMAND(1).NE.SIGNAL) GO TO 100
      IF (COMAND(2).EQ.SIGNAL) GO TO 80
      IF (COMAND(2).EQ.73) GO TO 370
      IF (COMAND(2).EQ.105) GO TO 370
C     73,105 = ASCII I - REQUEST TO INCLUDE TEXT.
      IF (NCHCMD.LT.3) GO TO 100
      IF (COMAND(2).NE.61) GO TO 100
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 70
C     END OF TEXT FILE.
80    IF (INTEXT.EQ.0) GO TO 90
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      CALL EXCHIM
      INTEXT=0
      NCHCMD=0
90    NCHCMD=MIN0(NCHCMD,0)
      IF (PHASE.NE.8) GO TO 660
      IF (INEND) 660,630,660
100   IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110
110   IF (EDIT.EQ.0) GO TO 450
C
C     PARTIAL LINE EDITOR.
C     INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED.
C     EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES
C     THE FIRST NON-BLANK CHARACTER AFTER N2.  N1 AND N2 ARE COLUMN
C     LIMITS UNDER WHICH TO PERFORM THE EDITING.  N1 AND ,N2 ARE
C     OPTIONAL.  IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT
C     LIMIT.  IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS
C     ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE.  WHEN
C     STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING
C     PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT
C     LENGTHS OF STRING1 AND STRING2.  THE THIRD DELIMITER IS
C     OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED
C     AFTER STRING2 IS INSERTED.
C
      IF (INEND.NE.0) GO TO 240
C     CONVERT COLUMN NUMBERS.
      NBR1=0
      NBR2=0
      I=0
120   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.EQ.44) GO TO 150
C     44 = ASCII COMMA
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR1=10*NBR1+J-48
      GO TO 120
130   WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD)
140   FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/
     1(1X,80A1))
      NERRS=2
      GO TO 70
150   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR2=10*NBR2+J-48
      GO TO 150
C     SCAN FOR DELIMITER
160   IF (J.NE.32) GO TO 170
C     32 = ASCII BLANK
      I=I+1
      J=COMAND(I)
      GO TO 160
170   D1=I
      NBR1=MIN0(NBR1,180)
      NBR2=MIN0(NBR2,180)
      IF (NBR1.EQ.0) NBR1=1
      IF (NBR2.EQ.0) GO TO 180
      IF (NBR2.LT.NBR1) GO TO 130
180   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      IF (COMAND(I).NE.J) GO TO 180
      D2=I
      D3=0
190   I=I+1
      IF (I.GT.NCHCMD) GO TO 200
      IF (COMAND(I).NE.J) GO TO 190
      D3=I
C     LOOK FOR SEARCH STRING (STRING1)
200   NUMBER=D2-D1-1
      J=NBR1
      IF (NUMBER.EQ.0) GO TO 260
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
210   DO 220 I=1,NUMBER
      IF (I+J-1.GT.NY) GO TO 240
      IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230
220   CONTINUE
      GO TO 260
230   J=J+1
      GO TO 210
240   WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1))
      NERRS=2
      GO TO 70
C     FOUND SEARCH STRING.  REPLACE WITH UPDATE STRING.
260   CHAR1L=PLUS
      IF (D3.NE.0) GO TO 300
C     NO THIRD DELIMITER.   REPLACE REST OF REGION.
      NY=NBR2
      IF (NY.EQ.0) NY=180
      D2=D2+1
      IF (D2.GT.NCHCMD) GO TO 280
      DO 270 I=D2,NCHCMD
      INTREC(J)=COMAND(I)
      J=J+1
      IF (J.GT.NY) GO TO 280
270   CONTINUE
280   IF (NBR2.NE.0) GO TO 290
      NCHACT=J-1
      GO TO 70
290   IF (J.GT.NBR2) GO TO 70
      INTREC(J)=32
C     32 = ASCII BLANK
      J=J+1
      GO TO 290
C     WE HAVE A THIRD DELIMITER.  REPLACE ONLY THE SEARCH STRING.
C     SHIFT THE REST OF THE REGION AS NECESSARY.
300   NUMBER=(D3-D2)-(D2-D1)
      IF (NUMBER) 310,350,330
C     SHIFT LEFT
310   I=J+D2-D1-1
      NY=MIN0(NBR2,NCHACT)
      IF (NY.EQ.0) NY=NCHACT
320   IF (I.GT.NY) GO TO 350
      INTREC(I+NUMBER)=INTREC(I)
C     NOTE - NUMBER .LT. 0 HERE
      INTREC(I)=32
C     32 = ASCII BLANK
      I=I+1
      GO TO 320
C     RIGHT SHIFT
330   I=NBR2
      IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180)
      NY=J+NUMBER
340   IF (I.LT.NY) GO TO 350
      INTREC(I)=INTREC(I-NUMBER)
      I=I-1
      GO TO 340
C     NO SHIFT NEEDED.
350   IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180)
      IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2)
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
C     MOVE UPDATE STRING (STRING2).
360   D2=D2+1
      IF (D2.GE.D3) GO TO 70
      INTREC(J)=COMAND(D2)
      J=J+1
      IF (J-NY) 360,360,70
C
C     REQUEST TO INCLUDE TEXT.  -I IN COLUMNS 1 AND 2.
C
370   IF (EDIT.EQ.0) GO TO 390
      WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD)
380   FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X
     1,80A1))
      NERRS=2
      GO TO 70
390   ITYPEO=73
C     73 = ASCII I
      IF (NCHCMD.GE.4) GO TO 410
      WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD)
400   FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A
     11))
      NERRS=2
      GO TO 70
410   DO 420 I=4,NCHCMD
      IF (COMAND(I).NE.32) GO TO 430
420   CONTINUE
C     CONVERT TO UPPER CASE.  WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM
430   K=0
      DO 440 J=I,NCHCMD
      IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32
      K=K+1
440   COMAND(K)=COMAND(J)
      NCHCMD=K
      GO TO 460
C
C     TEXT RECORD.
C
450   ITYPEO=0
460   NCHOUT=NCHCMD
      IF (OUTOPN.EQ.0) GO TO 470
      MODEO=0
      CALL EXCHPR (ISTAT,OBLOCK,COMAND)
      IF (ISTAT.NE.0) GO TO 770
470   CALL EXCHTP (COMAND,0)
      GO TO 70
C
C     APPARENT CHANGE CONTROL COMMAND
C
480   IF (INEND.EQ.0) GO TO 510
490   WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD)
500   FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT
     1 END./(1X,80A1))
      NERRS=1
      GO TO 70
510   NUMBER=1
      NBR1=0
      EDIT=0
      I=1
520   I=I+1
      IF (I.GT.NCHCMD) GO TO 600
      J=COMAND(I)
      IF (J.EQ.32) GO TO 600
C     32 = ASCII BLANK
      IF (EDIT.NE.0) GO TO 530
C     EDIT CONTROL MUST BE BLANK AFTER $.
      IF (J.EQ.44) GO TO 570
C     44 = ASCII COMMA
      IF (J.EQ.36) GO TO 560
C     36 = ASCII $
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.LE.57) GO TO 550
C     57 = ASCII 9
530   WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD)
540   FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1)
      NERRS=2
      GO TO 60
550   NBR1=10*NBR1+J-48
      GO TO 520
560   IF (NBR1.EQ.0) GO TO 530
      EDIT=1
      NBR1=NBR1-1
      GO TO 520
570   NUMBER=2
      NBR2=0
580   I=I+1
      IF (I.GT.NCHCMD) GO TO 590
      J=COMAND(I)
      IF (J.EQ.32) GO TO 590
C     32 = ASCII BLANK
      IF (IABS(J-44).EQ.1) GO TO 590
C     43 = ASCII +, 45 = ASCII -
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 530
C     57 = ASCII 9
      NBR2=10*NBR2+J-48
      GO TO 580
590   IF (NBR2.LT.NBR1) GO TO 530
      NBR1=NBR1-1
600   IF (NBR1.GE.LINEI-1) GO TO 620
      WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD)
610   FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1)
      NERRS=2
      GO TO 60
620   IF (NCHCMD.LE.0) GO TO 630
      IF (LINEI.LE.NBR1) GO TO 630
      IF (NUMBER.EQ.1) GO TO 70
C     SKIP INTAPE UNTIL NBR2 IS SKIPPED.
      MODEI=1
      IF (LINEI.GE.NBR2) MODEI=0
      IF (LINEI-NBR2) 650,650,70
C     COPY FROM INTAPE UNTIL NBR1 COPIED.
630   MODEO=MODEI
      NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTAPE.EQ.0) GO TO 640
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 770
640   CALL EXCHTP (INTREC,LINEI)
      MODEI=0
      IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650
      IF (LINEI.EQ.NBR1) GO TO 650
      MODEI=1
650   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 760
      LINEI=LINEI+1
      IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620
C     73 = ASCII I
      INEND=1
      IF (NCHCMD.LE.0) GO TO 660
      I=NBR2
      IF (NUMBER.EQ.1) I=NBR1
      IF (LINEI-I) 490,490,70
660   IF (NERRS.EQ.0) GO TO 675
      J=1
      IF (PHASE.EQ.8) J=2
      WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS
670   FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.)
675   NERRG=MAX0(NERRG,NERRS)
      IF (OPTL+OPTS.NE.0) GO TO 690
      IF (OUTAPE+OUFILE.EQ.0) LINEO=0
      IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO
680   FORMAT (I9,14H IMAGES COPIED)
      GO TO 710
690   WRITE (PRINTR,700)
700   FORMAT (1H1)
      CHAR1L=ONE
710   IF (OUFILE.EQ.0) GO TO 720
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
720   IF (ITYPEI.NE.69) GO TO 750
C     69 = ASCII E
C
C     END OF FILE ON INPUT TAPE (UPDATE MODE).
C
      IF (INTOPN.LT.0) GO TO 750
      DO 730 I=1,40
730   HOLCMD(I+1)=TXDISK(I)
      HOLCMD(1)=32
      IF (TXDISK(1).NE.32) HOLCMD(1)=61
C     32 = ASCII BLANK, 61 = ASCII =
      CALL EXCHAH (HOLCMD,41)
      WRITE (PRINTR,740) (HOLCMD(I),I=1,41)
740   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1)
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
750   TRANS=1
      GO TO 790
C
C     ERROR MESSAGES.
C
760   NUMBER=1
      GO TO 780
770   NUMBER=2
780   EQUAL=ISTAT
      TRANS=8
C
C     RETURN TO THE TRANSITION PROGRAM.
C
790   PHASE=2
      IF (OUTOPN.EQ.0) PHASE=1
      RETURN
C
      END
      SUBROUTINE EXCHC8
C
C     PRINT ERROR MESSAGES.
C
C     ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE
      INTEGER S(31)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/
      DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/
      DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/
      DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/
      DATA S(29),S(30),S(31)                         /4,5,5        /
C
C             1  2  3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4
     160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751),
     2NUMBER
C     16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
10    WRITE (PRINTR,20) EQUAL
20    FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.)
      GO TO 50
30    WRITE (PRINTR,40) EQUAL
40    FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.)
50    GO TO (60,80,100,120,140,160), EQUAL
60    WRITE (PRINTR,70)
70    FORMAT (22H BLOCK SEQUENCE ERROR.)
      GO TO 180
80    WRITE (PRINTR,90)
90    FORMAT (20H BLOCK IS TOO SHORT.)
      GO TO 180
100   WRITE (PRINTR,110)
110   FORMAT (11H I/O ERROR.)
      GO TO 180
120   WRITE (PRINTR,130)
130   FORMAT (18H RECORD TOO LARGE.)
      GO TO 180
140   WRITE (PRINTR,150)
150   FORMAT (21H UNKNOWN RECORD TYPE.)
      GO TO 180
160   WRITE (PRINTR,170)
170   FORMAT (25H FIRST BLOCK NOT A LABEL.)
      GO TO 760
180   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1)
      INFILE=0
C
C     RETURN TO QUIT SEGMENT.
C
      TRANS=9
      GO TO 800
C
200   WRITE (PRINTR,210)
210   FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.)
      GO TO 760
220   WRITE (PRINTR,230)
230   FORMAT (//20H0INTAPE NOT DEFINED.)
      GO TO 760
240   WRITE (PRINTR,250)
250   FORMAT (//23H0UNABLE TO OPEN INTAPE.)
      GO TO 10
260   WRITE (PRINTR,270)
270   FORMAT (//23H0UNABLE TO OPEN OUTAPE.)
      GO TO 30
280   WRITE (PRINTR,290)
290   FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.)
      GO TO 760
300   WRITE (PRINTR,310)
310   FORMAT (//19H0DATE NOT SUPPLIED.)
      GO TO 760
320   WRITE (PRINTR,330)
330   FORMAT (//19H0SITE NOT SUPPLIED.)
      GO TO 760
340   WRITE (PRINTR,350) INTAPE
350   FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4)
      GO TO 760
360   WRITE (PRINTR,370)
370   FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.)
      GO TO 760
380   WRITE (PRINTR,390)
390   FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.)
      GO TO 760
400   WRITE (PRINTR,410)
410   FORMAT (//27H0COMMAND HAS IMPROPER DATE.)
      GO TO 760
420   WRITE (PRINTR,430) EQUAL
430   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.)
      GO TO 780
440   WRITE (PRINTR,450)
450   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.)
      IF (ICOMD) 780,560,780
460   WRITE (PRINTR,470) N1RECI
470   FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO
     1N (,I5,2H).)
      GO TO 760
480   WRITE (PRINTR,490) EQUAL
490   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
500   WRITE (PRINTR,510)
510   FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.)
      GO TO 760
520   WRITE (PRINTR,530)
530   FORMAT (//23H0WORK FILE NOT DEFINED.)
      GO TO 760
540   WRITE (PRINTR,550)
550   FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.)
      GO TO 760
560   WRITE (PRINTR,570) EQUAL
570   FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.)
      GO TO 760
580   WRITE (PRINTR,590)
590   FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE
     1R.)
      GO TO 760
600   WRITE (PRINTR,610)
610   FORMAT (//12H0TOO MANY (.)
      GO TO 760
620   WRITE (PRINTR,630) EQUAL
630   FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.)
      GO TO 760
640   WRITE (PRINTR,650) EQUAL
650   FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.)
      GO TO 760
660   WRITE (PRINTR,670) EQUAL
670   FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.)
      GO TO 760
680   WRITE (PRINTR,690) EQUAL
690   FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.)
      GO TO 760
700   WRITE (PRINTR,710) EQUAL
710   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
720   WRITE (PRINTR,730) N1RECI
730   FORMAT (//21H0INTAPE POSITIONED AT,I5,25H.  BACKWARD SKIP IGNORED.
     1)
      GO TO 780
740   WRITE (PRINTR,750)
750   FORMAT (//23H0COMMAND IS INCOMPLETE.)
      GO TO 760
751   WRITE (PRINTR,752)
752   FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA
     1PE OR OUTPUT.)
760   WRITE (PRINTR,770)
770   FORMAT (23H COMMAND NOT PROCESSED.)
780   WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD)
790   FORMAT ((1X,80A1))
C
C     RETURN TO COMMAND PROCESSSOR.
C
      CHAR1L=0
      NERRS=MAX0(S(NUMBER),NERRS)
      NERRG=MAX0(NERRG,NERRS)
      TRANS=1
C
C     RETURN TO TRANSITION PROGRAM.
C
800   RETURN
C
      END
      SUBROUTINE EXCHC9 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO
C     ERRORS.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KQUIT /20/
C
      IF (INFILE.EQ.0) GO TO 10
      IF (MODIFY.NE.82) GO TO 5
C     82 = ASCII R
      ACTION=2
C     ACTION = 2 MEANS REWIND INFILE.
      CALL EXCHIM
5     ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      CALL EXCHIM
      INFILE=0
      NCHCMD=0
      GO TO 50
10    IF (OPTC*OUFILE.EQ.0) GO TO 20
      ACTION=0
      NCHOUT=4
      CALL EXCHOU (COMD(1,KQUIT))
20    ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      IF (OUTOPN.EQ.0) GO TO 30
C     WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC)
C     CLOSE THE INPUT TAPE.
30    IF (INTOPN.EQ.0) GO TO 40
      ISTAT=4
      CALL EXCHRT (ISTAT,OBLOCK)
C
C     RETURN TO MAIN PROGRAM.
C
40    TRANS=0
      IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG
45    FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.)
      GO TO 60
C
C     RETURN TO THE COMMAND DECODER.
C
50    TRANS=1
60    RETURN
C
      END
=TES FILE=6
! This is the HELP input file for the VAX/VMS
! version of TES.  Invoked with
! LIBRARY/CREATE/HELP
! Processor will prompt for file names.
! Prepared by R. Hanson, Aug., 1982
1 TES

  The TES supports those computing activities associated
  with archiving, retrieving, updating and exporting textual
  material.  It is a program that operates on files having
  a "universal" format and delivers and reads text files
  in native format on the host system.

  When asking for HELP on TES commands, the complete
  command is listed.  Only the first four (4) characters
  are required.  This is also true for the TES program.

  The symbols [ ] enclose optional specifications;
  the ( ) symbols enclose alternatives--choose one;
  the < > enclose a CHARACTER string;  FUN is a Fortran
  unit number;  the { } enclose an integer string;
  MN denotes a module number in a TES format file.

  Note:  Simultaneously, distinct positive Fortran unit numbers must
         be used.
2 AUTHORS
 R. J. Hanson, Division 1642, Sandia National Laboratories, 844-1715
   and
 W. V. Snyder, Jet Propulsion Laboratory, Pasadena, California
3 REFERENCES
 1.  W. V. Snyder and R. J. Hanson, "Text Exchange System: A
     Transportable System for Management and Exchange of Programs
     and Other Text," JPL internal document number 1846-108, Aug. 1981.

 2.  W. V. Snyder and R. J. Hanson, "Text Exchange System, Installation
     Instructions and Description of System Dependent Variants," JPL
     internal document number 1846-109, Aug. 1981.

 3.  W. V. Snyder and R. J. Hanson, "Text Exchange System, Program
     Descriptions," JPL internal document number 1846-110, Aug. 1981.
2 COMMANDS

3 INTAPE
INTAPE=FUN [<logical name>] Default name=TEIO{FUN}.TES;vers.
  Define TES format input file.
  If the identical INTAPE designation is used, and the read position
  is at End-of-File, an End-of-File is skipped.

3 INPUT
INPUT FILE=FUN [<logical name>] Default name=EXCH{FUN}.TMP;vers.
  Define native format file from which to read commands and
  text.  Goes to READER file for commands after completion.

3 INCLUDE
INCLUDE=FUN [<logical name>] Default name=EXCH{FUN}.TMP;vers.
  Define file to be searched for modules of text to be auto-
  matically inserted as text is copied to the user file.
  FUN=0 closes the INCLUDE file.

3 TEXT
TEXT
  Indicate the text of a module follows the command.

TEXT=FUN [<logical name>] Default name=EXCH{FUN}.TMP;vers.
  Define file containing the text of a module.

3 READER
READER=FUN [<logical name>] Default name=EXCH{FUN}.TMP;vers.
  Define native format file from which to read commands.  A
  default value is provided, FUN=5, <logical name>=TT:.
  If FUN=5 is used, <logical name> will be TT:
  Can contain text and other 'INPUT FILE=' commands but not
  other 'READER=' commands.  FUN must be positive.

3 MARGIN
MARGIN=integer
  Define last column of input to be examined when interpreting
  commands.   A default value (180) is provided.  This command
  does not limit input text line lengths.

3 SIGNAL
SIGNAL=<1 character>
  A character used in col. 1 of text to identify INCLUDE requests
  and corrections, and in cols. 1-2 to identify the end of text
  or correction input.  If this command is not given a dash (-)
  is used.  This command goes after NAME= command,
  and before TEXT or TEXT= command.

3 REMOVE
REMOVE=<1 character>
  A character to be removed to compress text.  This character
  is reinserted in OUTPUT files or other native text.  If this
  command is not given, excess blanks are removed.

3 QUIT
QUIT [,R]
  Stop reading commands and text from the file containing this
  command. If the R modifier is used the file is rewound.
  This command gracefully closes all the files used during execution.
3 EXIT

  Use QUIT.

3 STOP

  Use QUIT.

3 HALT

  Use QUIT.

3 REWIND

  Rewind the TES format input file, INTAPE.
  (When INTAPE is attached as a magnetic tape, this command rewinds
  the entire reel.)
3 SKIP

SKIP=MN

  Position the TES format input file immediately
  after module number MN.
3 LIMIT

LIMIT=MN

  Module number MN on the TES format input file is
  the last one to be examined when executing the
  second (predicate controlled) form of the COPY
  command.

3 OUTAPE

OUTAPE [,U]=FUN [<logical name>]
Default name = TEIO{FUN}.TES;vers.

  Define TES format output file. The [,U] qualifier is
  needed when text is being changed or merged.
  If an OUTAPE was already open it is closed and
  a new one then opened.  (If the same OUTAPE is
  designated, an End-of-File is written.)
  FUN=0 closes the OUTAPE.  Nothing further will be written
  to this file.

3 OUTPUT_FILE

OUTPUT FILE=FUN [<logical name>] Default name=EXCH{FUN}.TMP;vers.

  Define native format file to receive text.
  If an OUTPUT FILE was already open it is closed and a
  new one then opened.
  FUN=0 closes the OUTPUT FILE.  Nothing further will be
  written to this file.

3 PRINTER

PRINTER=FUN <logical name>. Default name=EXCH{FUN}.LIS;vers.
  Define native format file to receive listings, remarks
  or error messages.  Default of FUN=6 provided, with
  <logical name>=TT:.  If FUN=6 is used, <logical name>
  will be TT:.  FUN must be positive.

3 WORK_FILE

WORK FILE=FUN

  TES uses new file <FOR{FUN}.DAT;vers.> for work area.
  This file is deleted by TES when program terminates
  normally.
3 TITLE

TITLE=<string of no more than 40 characters>

  Provide a title for the TES format output file.
  If none provided uses TITLE from INTAPE, if one is
  currently assigned.

3 SITE

SITE=<string of no more than 40 characters>

  Indicates where the TES format file was written.
  This is provided automatically on this machine.
  The SITE information can be overwritten if desired.

3 DATE

DATE=integer

  The integer must be ANSI standard form of day:
  YYMMDD.  Used to note when OUTAPE was written.
  DATE is provided by the system but can be over-
  written if desired.

3 IDENTIFY

IDENTIFY OUTPUT [,modifier] = first col., last col.,
                              step,start,<label>

  Provide sequence and label information in native
  format output file.  All parameters are individually
   optional.
4 [,modifier]
/C
Sequence numbers are derived from the position of
the image in the output file relative to the position
of the output file at the time the IDENTIFY OUTPUT
command was issued, and (C)ontinue across module
boundaries.
/F
Sequence numbers are derived from the position of the
image in the output file relative to the (F)irst record
of the text module.
/I
Sequence numbers are derived from the position of the
image in the module in the TES format (I)nput file.
Images copied from INCLUDE modules receive a sequence
number derived from the position of the request to
include text.
/O
Sequence numbers are derived from the position the image
has or would have in the module in the TES format
(O)utput file.  Images copied from INCLUDE modules
receive a sequence number derived from the position
of the request to include text.
3 OPTION
OPTION [,modifier] = [<string of letters>]
Each letter in the string denotes an option.
Deselect options with command OPTI.
4 [<string of letters>]
/A
Used with the L or S option.  If a DATA TYPE control
record having the first four characters equal
"LIST" is associated with the module to be listed,
the modules is output as though the V option
were selected.
/C
Commands necessary to reproduce the text module and
its associated control records are copied to the native
format output file for each text module.
/E
Each command is echoed on the PRINTER file.
/I
If a module is to be listed because the L or S option
is selected, text copied from INCLUDE files is also
listed in expanded form.
/L
Text modules that are copied, inserted or updated are
listed on the PRINTER file.
/S
Text modules inserted or updated are listed on the
PRINTER file.
/V
When a module is listed because the L or S option
is selected, col. 1 of each image is used as
Fortran vertical spacing control.
4 [,modifier]
/A
This modifier parameter specifies options to be selected in
addition to options already in effect.
/C
This modifier parameter specifies options to be cleared or
deselected.
3 COPY
COPY=MN,MN-MN

Copy one or more modules or ranges of modules whose position
on the TES input file are known.  Information is copied to the
files defined by the OUTAPE and OUTPUT commands, and to the
PRINTER file under appropriate OPTION and INDEX selections.


COPY [,modifier] = <logical expression in variables defined by
                    PREDICATE= >

Copy selected modules between the current position of the TES
input file and the module specified in a LIMIT command, or the
end of the file if no LIMIT command was specified.  Copy those
modules that satisfy the terms of the logical expression and
the restrictions of the modifier.

In the logical expression letters A through H denote predicates.
The letter N denotes the NULL predicate (always false),
+ denotes logical OR, - denotes ORNOT, * denotes AND, and /
denotes ANDNOT.  Precedence of operators is as for algebraic
expressions, and parentheses may be used.
4 [,modifier]

/X
Copy e(X)actly the first module for which the logical
expression is TRUE.
/P
Copy modules (P)rior to but not including the first module for
which the logical expression is TRUE.
/I
Copy modules prior to and (I)ncluding the first module for
which the logical expression is TRUE.
/S
(S)kip all modules prior to the first module for which the
logical expression is TRUE.
3 PREDICATE
PREDICATE = <label, (A-H)><control record abbreviation>
            <search mode, (A or X)><mask character>
            <search target>

Define a logical variable, search mode, and search target to be
used in the second or predicate-controlled form of the COPY
command.  The search target is compared with the text of each
control record of the designated type according to the mode of
search.  Here (A) means (A)nywhere in the text of the control
record, and (X) means the target is found in e(X)actly that
specified position.

Letters are considered as all upper case for the purpose of
matching the search target and the text.  Positions of the
search target containing the mask character are treated as
though they are equal to the corresponding character in the
text.

If the search target is found in the control record text in the
sense defined, the logical variable is made TRUE.  All variables
are made FALSE at the beginning of processing each module.
They may become TRUE as defined above and they thereafter remain
TRUE until the next module is processed.
3 INDEX
INDEX [,L] =[-] [<list of control record abbreviations>]

Control records specified in the list of control record
abbreviations are listed on the PRINTER file as each
module is copied, inserted or updated.  If the list
begins with (-) all control records except those specified
are listed.  If the L modifier is used, the index information
is listed only if the corresponding module contents are listed.
Deselect index information with command INDE.
2 CONTROL_RECORDS
This information is defined by the user for organizing
the text modules that are on a TES format file.  A great
deal of organization is possible and the amount required
will vary with each application.

This information is normally inserted with the text modules
as they are written in the TES format output file.
Control records for a text module can be in any order,
except for the NAME = record which must be first.
The only control record that is absolutely required is
the NAME = record.  All other control records must be inserted
between the NAME = record and TEXT or TEXT = command.

Users may wish to define control records for their own
applications.  The format is:

CONTROL,<F(HLNQTUVWXYZ)> = <character string>
3 NAME

NAME = <character string>

This is the logical name associated with this module.
Its abbreviation for the second form of the COPY is P.
3 AUTHOR

AUTHOR = <character string>

This is the name or names of the persons associated with
this unit of text.
Its abbreviation for the second form of the COPY is A.
3 COMMENT

COMMENT = <character string>

This information can be any comments about the text
module.
Its abbreviation for the second form of the COPY is C.
3 DATA_TYPE

DATA TYPE = <character string>

This is the type of data that constitutes the text of the
module.
Its abbreviation for the second form of the COPY is D.
3 GROUP

GROUP = <character string>

This is a logical category for this text module.
Its abbreviation for the second form of the COPY is G.
3 KEYWORD

KEYWORD = <character string>

This is a list of keywords or phrases concerning the text
module.
Its abbreviation for the second form of the COPY is K.
3 MACHINE
MACHINE = <character string>

This is intended to denote machine dependencies associated with
the text in this module.
Its abbreviation for the second form of the COPY is M.
3 REFERENCES

REFERENCES = <character string>

This information is intended to provide bibliographic
references.  In the case of programs or other text this
can be used to indicate references to global or external
data, or to external subprograms.
Its abbreviation for the second form of the COPY is B.
3 UPDATE

UPDATE = YYMMDD <character string>

This information is intended to provide for careful record
keeping about changes to text modules.  The ANSI form of the
date is required.  This control record is required when
changing lines of text or editing lines of text in a module
using TES.
Its abbreviation for the second form of the COPY is S.

3 ORIGIN
ORIGIN = YYMMDD <character string>

This information is intended to provide the date and place
where a module of text was first written or first filed
in TES format.  The ANSI form of the date is required.
Its abbreviation for the second form of the COPY is O.
2 UPDATING
  Control records and text may be updated separately.
3 Control_Record_Updating
  Assume the input TES file is positioned immediately before
  the module containing control records to be updated.
  Control records may be removed or changed, or new control
  records may be introduced.  Requests to remove or change
  control records must be presented in order.  New control
  records can only be added to the end of the list.
4 Removing Control Records
  To remove the j'th control record use
  -j
  where '-' is in column 1, the integer j follows immediately,
  and contains no embedded spaces.  The module name record may
  not be removed.
4 Changing Control Records
  To replace the text of the j'th control record use
  -j <replacement text>
  where '-' is in column 1, the integer j follows immediately
  and contains no embedded spaces, and at least one space
  precedes the replacement text.  The format of the replacement
  text is not checked.  Thus, control records that should begin
  with a date may be changed so that they do not begin with a
  date.
4 Adding Control Records
  Control records are added by inserting them after an UPDATE
  command:

  UPDATE=YYMMDD <descriptive text>
  <new control records>
  TEXT
  <instructions to update text, if any, see Text_Updating>
  --

 or

  UPDATE=YYMMDD <descriptive text>
  <new control records>
  TEXT={FUN} [<logical name] file of instructions to update text.
3 Text_Updating
  Text updating is line oriented.  A line of text may be
  removed, changed, or replaced, or new lines of text may be
  introduced.  Requests to update text begin with a signal
  character that is usually '-'.  The signal character may
  be changed by using the SIGNAL command, or by the sequence
  '-=*' when a request to update text is expected, where '-'
  is the current signal and '*' is the new signal.  The latter
  method of changing the signal is not recorded in the output
  TES file.  In the following discussions of updating text,
  the current signal is denoted by '-'.
  Change requests must be presented in order.
4 Introducing New Lines of Text
  To introduce new lines of text after line k use
  -k
  <new lines of text>
  where '-' is in column 1, the integer k follows immediately,
  and contains no embedded spaces.  Examination of the change
  request stops when the space following k is examined,
  allowing comments to be included.  New lines of text
  continue until a line having '-' in column 1 is input.
4 Replacing or Removing Lines of Text
  To replace lines m through n of text use
  -m,n
  <lines of replacement text>
  where - is in column 1, the integers m and n follow
  immediately, and contain no embedded spaces.  Examination
  of the change request stops when the space following n is
  examined, allowing comments to be included.  New lines of
  text continue until a line having '-' in column 1 is input.
  To remove lines m through n of text do not supply any
  replacement text.
4 Changing a Line of Text
  To change line k of text use
  -k$
  <editing commands>
  where '-' is in column 1, the integer k follows immediately, and
  contains no embedded spaces.  Examination of the change request
  stops when the dollar sign following k is examined, allowing
  comments to be included.  Editing commands are of the form
  [n1[,n2]]/<old text>/<new text>[/]
  where the first appearance of <old text> between columns n1 and
  n2 is replaced by <new text>.  If the length of <old text> is dif-
  ferent from the length of <new text>, text following <old text>
  will be shifted accordingly within the range n1, n2.  If ',n2' is
  omitted the span of effect is from column n1 to the end of the image,
  and the length of the image may change.  If in addition 'n1' is
  omitted the span of effect is the entire image.  If the terminal
  delimiter (denoted by '/') is omitted text following <old text> is
  removed before <old text> is replaced by <new text>.  To allow <old
  text> and <new text> to contain almost any character, the delimiter
  denoted by '/' above may be any character other than a digit, comma,
  or space, that does not appear in <old text> or <new text>.  If
  '-' is used for the delimiter it must not appear in column 1.
  Editing commands continue until a line having '-' in column 1 is
  input.  If several editing commands are submitted, the target for
  each after the first is the result of the previous.
2 READ_EXAMPLES

3 1 Retrieve entire TES file contents
      * TO GET EVERY MODULE FROM A TES FILE (ON UNIT 10)
      * TO A SYMBOLIC TEXT FILE (ON UNIT 11)
      INTAPE=10 [VAX LOGICAL NAME]
      OUTPUT FILE=11
      COPY=1-999
      QUIT
  This shows the simplest method for retrieving every module from
  the TES file.  The assumption in this example is  that  there
  are  no  more  than  999  text modules on the file.  A more direct
  technique for getting the entire contents of the tape  involves  a
  form  of  the  predicate controlled copy.
  One uses the so-called NULL predicate, N=NULL=Nothing.

      * TO GET EVERY MODULE FROM A TES FILE (ON UNIT 10)
      * TO A SYMBOLIC TEXT FILE (ON UNIT 11) COPY (EVERYTHING).
      INTAPE=10 [VAX LOGICAL NAME]
      OUTPUT FILE=11
      * THE '-' OPERATOR IN THE NEXT COMMAND MEANS 'OR NOT'.
      COPY=N-N
      QUIT
3 2 What's on a TES input file??????????
      * TO LIST ALL CONTROL INFORMATION FOR MODULES ON A
      * TES FILE (ON UNIT 10) TO THE PRINTER FILE, USE THE
      * INDEX COMMAND AND REQUEST LISTING OF EVERY
      * CONTROL RECORD BY EXCLUDING NOTHING.
      INTAPE=10 [VAX LOGICAL NAME]
      INDEX=-
      COPY=N-N
      QUIT
3 3 Copy some text modules from a TES file
      * TO COPY SELECTED TEXT MODULES (SEQUENCE NUMBERS
      * KNOWN) FROM THE TES FILE, SELECT THE NUMBERS
      * NEEDED.  SUPPOSE MODULES 1,2,5 THROUGH 15 AND 100
      * ARE NEEDED.
      INTAPE=10 [VAX LOGICAL NAME]
      OUTPUT FILE=11
      COPY=1,2,5-15,100
      QUIT
3 4 Copy using selected control information
      * TO SELECT MODULES FROM A TES FILE CORRESPONDING
      * TO KEYWORDS OR PHRASES IN THE CONTROL INFORMATION USE
      * THE SECOND OR PREDICATE FORM OF THE COPY COMMAND.
      * FOR EXAMPLE ALL MODULES WITH A GROUP CONTROL RECORD
      * CONTAINING THE WORD "blas" CAN BE RETRIEVED FROM THE
      * TES FILE.
      INTAPE=10 [VAX LOGICAL NAME]
      OUTPUT FILE=11
      PREDICATE=BGA BLAS
      COPY=B
      QUIT
      * HERE THE ABOVE STRING "(B)(G)(A) BLAS" STANDS FOR LOGICAL
      * VARIABLE LABELED B, EXAMINING INFORMATION IN CONTROL
      * RECORDS G (=GROUP), (A)NYWHERE WITHIN THESE CONTROL RECORDS,
      * SEARCHING FOR THE STRING OF 4 CHARACTERS, BLAS.

3 5 Copy with three logical operands
      * COPY MODULES HAVING GROUP CONTROL RECORDS
      * CONTAINING THE STRING "blas", THAT DO NOT HAVE MACHINE
      * CONTROL RECORD CONTAINING THE STRING "ibm" AND DATA
      * CONTROL RECORD CONTAINING THE STRING "assembler".
      INTAPE=10 [VAX LOGICAL NAME]
      OUTPUT FILE=11
      PREDICATE=BGA BLAS
      PREDICATE=CMA IBM
      PREDICATE=DDA ASSEMBLER
      * THE '/' OPERATOR MEANS 'AND NOT'.
      * THE '*' OPERATOR MEANS 'AND'.
      COPY=B/(C*D)
      QUIT
3 6 Limit the number of modules processed
      * THE MODULES TO BE RETRIEVED ALL HAVE NUMBERS BETWEEN
      * 101 AND 150.  RESTRICTING PROCESSING ACTIVITY TO THIS
      * RANGE MAY REDUCE PROCESSING TIME.
      INTAPE=10 [VAX LOGICAL NAME]
      OUTPUT FILE=11
      * MOVE INPUT TAPE UP TO START OF MODULE 101.
      SKIP=100
      * LIMIT THE RANGE OF MODULE NUMBERS EXAMINED.
      LIMIT=150
      PREDICATE=BGA BLAS
      COPY=B
      QUIT
3 7 List module with line numbers
      * TEXT MODULE NUMBER 101 NEEDS TO BE UPDATED.
      * THE NUMBERS OF THE LINES ARE NEEDED SO THAT
      * THE UPDATES CAN BE INSERTED.
      INTAPE=10 [VAX LOGICAL NAME]
      OPTION=L
      COPY=101
      QUIT
3 8 Copy module with control records intact
      * MAJOR MODIFICATIONS ARE NEEDED IN TEXT MODULE NUMBERED
      * 101.  THE CONTROL RECORDS NEED TO BE KEPT INTACT WITH
      * THE TEXT MODULE. IT CAN BE REINSERTED INTO A TES
      * FILE LATER.
      INTAPE=10 [VAX LOGICAL NAME]
      OUTPUT FILE=11
      OPTION=C
      COPY=101
      QUIT
3 9 Copy module including another module
  Text module number 100 contains the line image
      -I COMMON VARIABLES
  This signals the TES that the block of text named COMMON VARIABLES
  is to be inserted into the output file at this place.  Text module
  number 101 contains the text to be inserted:
      -I COMMON VARIABLES
      CCC
            COMMON /BLOCK/ A,B,C
      CCC
      --

      INTAPE=10 [VAX LOGICAL NAME]
      OUTPUT FILE=11
      * GET MODULE TO BE INCLUDED INTO OUTPUT FILE=11.
      COPY=101
      * REDESIGNATE OUTPUT FILE AND ASSIGN THE INCLUDE FILE=11.
      OUTPUT FILE=12
      INCLUDE FILE=11
      * REWIND THE INPUT TAPE BECAUSE MODULE NUMBER 100
      * IS BEHIND THE READ POSITION.
      REWIND
      COPY=100
      QUIT
2 WRITE_EXAMPLES

3 1 Make duplicate of TES file
  A  duplicate  copy  of  an existing TES file is desired. The output
  file = 15.  The SITE and DATE signifying where  and  when
  the data was copied must be specified.  The SITE input card is not
  needed if the output file is to  contain  only  modules  from  the
  input  file.  It is good practice to include a SITE input whenever
  a modified form of a TES file  is  created.   The  TITLE  is
  copied from the input to the output file.
      INTAPE=10 [VAX LOGICAL NAME]
      OUTAPE=15
      SITE=(WHERE FILE IS BEING COPIED.)
      * TODAY IS CHRISTMAS DAY, 1979.
      DATE=791225
      * COPY EVERYTHING ON THE TES FILE.
      COPY=N-N
      QUIT
3 2 Put one module on TES file
  A  text  module consisting of a single Fortran subroutine
  is to be put on a TES file, unit = 15.

      OUTAPE=15
      TITLE=(NAME FOR THE FILE.)
      SITE=(WHERE FILE IS BEING WRITTEN.)
      DATE=(YYMMDD)
      * CONTROL RECORDS FOR THE NEW MODULE.
      NAME=(SUBROUTINE OR MODULE NAME.)
      ORIGIN=(YYMMDD)
      AUTHOR=(PERSON WHO WROTE THE SUBROUTINE.)
      DATA=FORTRAN
      * SUBROUTINE SOURCE CARDS START AFTER THE TEXT CARD.
      TEXT
             SUBROUTINE   .
             ...
             END
      --
      QUIT

3 3 Put several modules on TES file
  The following text is on unit = 11.
      ORIGIN=(YYMMDD SITE WHERE SUBROUTINES WERE WRITTEN.)
      AUTHOR=(PERSON WHO WROTE THE SUBROUTINES.)
      GROUP=(CLASSIFICATION OF THE SUBROUTINES.)
      REFERENCE=(JOURNAL ARTICLE RELEVENT TO THE SUBROUTINES.)
      DATA=FORTRAN
      MACHINE=PORTABLE
      KEYWORD=INDUSTRY-RECOGNIZED WORDS FOR THE PROGRAM FUNCTION.
      QUIT,R

  Then this is entered (on the terminal) for the subprograms.
      OUTAPE=15
      TITLE=(...)
      DATE=(YYMMDD)
      NAME=(SBNAME...)
      * GET CONSTANT CONTROL INFORMATION FROM FILE 11.
      INPUT FILE=11
      TEXT
             SUBROUTINE SBNAME(...)
             ...
             END
      --
      NAME=(...)
      INPUT FILE=11
      TEXT
             SUBROUTINE   .
             ...
             END
      --

      QUIT
3 4 Put modules from file onto TES file

  For  a  next  example we will modify the last example slightly.
  The only difference is that the subroutines  are  all   on
  unit number 12 as follows.
             SUBROUTINE SBNAME(...)
             ...
             END
      --
             SUBROUTINE   .
             ...
             END
      --
      QUIT

      NAME=(SBNAME...)
      * GET CONSTANT CONTROL INFORMATION FROM FILE 11.
      INPUT FILE=11
      * READ SUBROUTINE TEXT FROM UNIT 12.
      TEXT=12
      NAME=(...)
      INPUT FILE=11
      TEXT=12
      QUIT
3 5 Add module to the end of a TES file
  An existing TES file is on unit number 10.
  The TES output file is unit 15.  A new module is to be
  added to the end of the existing file to make a new file.
      INTAPE=10 [VAX LOGICAL NAME]
      OUTAPE,U=15
      TITLE=(...)
      SITE=(...)
      DATE=(YYMMDD)
      * GET THE OLD FILE CONTENTS TO THE NEW FILE.
      COPY=N-N
      * INSERT THE NEW MODULE ON THE NEW FILE
      NAME=(...)
      ORIGIN=(YYMMDD)
      AUTHOR=(...)
      DATA=FORTRAN
      TEXT
             SUBROUTINE   .
             ...
             END
      --
      QUIT
3 6 Updating entire lines on TES file

      INTAPE=10 [VAX LOGICAL NAME]
      OUTAPE,U=15
      TITLE=(...)
      DATE=(YYMMDD)
      * COPY THE MODULES THAT REQUIRE NO CHANGE.
      COPY=1-100
      * INSERT A CARD AT THE FRONT OF THE PROGRAM,
      * REMOVE LINE 5, INSERT A LINE AFTER LINE 7,
      * AND REPLACE LINE 9 THROUGH 11 BY FOUR NEW LINES.
      UPDATE=(YYMMDD)
      TEXT
      -0
      C      SOME COMMENT.
      -5,5
      -7
             A=0.
      -9,11
             B=0.
             C=0.
             D=0.
             E=0.
      --
      * COPY THE REMAINING MODULES THAT ARE UNCHANGED.
      COPY=N-N
      QUIT
3 7 Editing individual lines on TES file
  In this next example  the only difference from the last
  is that module number 101 needs editing.  The input for INTAPE,
  OUTAPE, etc. is identical through the UPDATE card.
      TEXT
      -27$ CHANGE REAL*4 TO REAL IN LINE 27.
      /REAL*4/REAL/
      --
      COPY=N-N
      QUIT
3 8 Updating control records on TES file
  In this next example the only difference from the last  example
  is  that  module  number  101  requires  changes  in  the  control
  information.  The input is identical through the COPY=1-100  card.
      * REMOVE CONTROL RECORD NUMBER 2, CHANGE CONTROL RECORD
      * NUMBER 4, AND INSERT A NEW GROUP CONTROL RECORD.
      -2
      -4 (NEW TEXT FOR CONTROL RECORD 4.)
      UPDATE=(YYMMDD)
      GROUP=(NEW GROUP CONTROL RECORD.)
      TEXT
      --
      COPY=N-N
      QUIT
3 9 Merge two TES files
  In this example one wants to take two  TES  files,  on units
  numbered  10  and 11, and merge them to write a merged  file
  file on unit number 15.
      INTAPE=10 [VAX LOGICAL NAME]
      OUTAPE,U=15
      TITLE=(...)
      SITE=(...)
      DATE=(YYMMDD)
      COPY=N-N
      * OPEN A NEW INTAPE ON FILE 11.
      INTAPE=11 [VAX LOGICAL NAME]
      COPY=N-N
      QUIT
2 TAPES

3 INPUT

1.  To COPY TES format files from an unlabelled magnetic tape:
       $MOUNT/FOREIGN/BLOCKSIZE=3700 MT:
       $COPY MT: [disk filename]
       $COPY MT: [disk filename]   (to copy the second TES file)

    Suggestion:  Use filenames of the form  'filename.TES;ver'  for
                 TES disk files.

2.  To use a TES format tape file as the INTAPE for the program:
       $MOUNT/FOREIGN/BLOCKSIZE=3700 MT: [dummy label] [VAX logical name]
       $TES
       *INTAPE=10 [VAX logical name]
         .
         .
         .
       *INTAPE=10 [VAX logical name]   (When at End-of-File on INTAPE,
         .                              reopening the same INTAPE allows
         .                              the next TES file on the tape to
         .                              be processed.)
       *QUIT


3 OUTPUT
1.  To COPY TES format files to an unlabelled magnetic tape:
       $MOUNT/FOREIGN/BLOCKSIZE=3700 MT:
       $COPY [disk filename] MT:
       $COPY [disk filename] MT:    (to copy a second TES file to tape)

2.  To use a magnetic tape as the OUTAPE for the program:

       $MOUNT/FOREIGN/BLOCKSIZE=3700 MT: [dummy label] [VAX logical name]
       $TES
       *OUTAPE=10 [VAX logical name]
         .
         .
         .
       *OUTAPE=10 [VAX logical name]    (Reopening the same OUTAPE unit
         .                               write an End-of-File on the tape.
         .                               A subsequent COPY command will
         .                               cause another TES file to be
       *QUIT                             created on the OUTAPE.)

=TES FILE=7
      PROGRAM TES
C THIS VERSION IS FOR UNIX (TM) UNDER THE F77 COMPILER.  IT WAS
C OBTAINED BY SUITABLY MODIFYING THE CORRESPONDING VAX/VMS VERSION.
C CHANGES FROM THE VAX/VMS VERSION INCLUDE:
C
C   * REPLACING FORTRAN OPEN, CLOSE, READ, WRITE, AND REWIND
C     STATEMENTS FOR TAPE INPUT/OUTPUT WITH CALLS ON SUBROUTINES TROPEN,
C     TWOPEN, TCLOSE, TREAD, TWRITE, AND TRWIND.
C   * ADDING A REWIND STATEMENT AFTER OTHER FILES ARE OPENED.
C   * PREVENTING UNIT 5 FROM BEING OPENED:  IT IS PRECONNECTED TO STDIN,
C     THE STANDARD INPUT.
C   * REPLACING BIT `.AND.' WITH A CALL ON SUBROUTINE 'AND'.
C   * CHANGING "'...'X" TO "X'...'" IN DATA STATEMENTS.
C   * OMITTING A FORMAT ITEM AND SETTING M=133 IN EXCHIM.
C   * COMMENTING OUT THE CONVERSION TO UPPER CASE OF THE FILE NAMES
C      IN EXCHCX.
C
C THE FILE OPENING CODE PICKS UP THE DESIRED FILE NAME FROM THE
C SYSTEM-DEPENDENT PART OF THE RELEVANT COMMAND.  IN PARTICULAR, IF AN
C ACTUAL TAPE IS TO BE WRITTEN, THE OUTAPE COMMAND SHOULD LOOK SOMETHING
C LIKE THIS:
C     OUTAPE=23 /DEV/NRMT1
C (WHERE THE ACTUAL PATH NAME SPECIFIED DEPENDS ON THE INSTALLATION).
C THE UNIT NUMBER SPECIFIED FOR THE INTAPE AND OUTAPE COMMANDS CAN BE
C ANY INTEGER; THE ONLY RESTRICTION IS THAT IF BOTH INTAPE AND OUTAPE
C ARE SPECIFIED, THEN THEY MUST HAVE DISTINCT UNIT NUMBERS.  NOTE THAT
C THE PATH NAME GIVEN IN THE INTAPE OR OUTAPE COMMAND CAN BE THAT OF A
C DISK FILE (PERHAPS OBTAINED FROM THE DD IN THE CASE OF INTAPE).
C UNFORTUNATELY, BECAUSE OF THE VARYING BLOCK SIZES WRITTEN BY TES, IF
C YOU WANT TO WRITE AN ACTUAL TAPE, THEN YOU MUST GIVE OUTAPE THE PATH
C NAME OF AN ACTUAL TAPE DRIVE (OR ELSE USE A SPECIAL PROGRAM TO COPY
C FROM TAPE TO DISK).  ANYWAY, FOR SIMPLY GETTING DATA FROM A TAPE, THE
C RECOMMENDED PROCEDURE IS:  (1) READ THE TAPE INTO A TEMPORARY DISK
C FILE, E.G. BY
C
C     DD IF=/DEV/NRMT1 IBS=3600 OF=TEMP.DISK.FILE
C
C (2) THEN INVOKE TES, SPECIFYING THE DISK FILE TO INTAPE, AS IN
C
C     TES
C     INTAPE=37 TEMP.DISK.FILE
C     ....
C
C THIS WAY, IF YOU HAVE TROUBLE WITH TES (E.G. IF YOU GET SOME COMMAND
C SYNTAX WRONG) OR IF YOU WANT TO EXTRACT DIFFERENT THINGS AT DIFFERENT
C TIMES, THEN YOU ONLY HAVE TO READ THE PHYSICAL TAPE ONCE.
C
C========================
C EXCHANGE PROGRAMS
C DISTRIBUTED BY W. VAN SNYDER, JET PROPULSION LABORATORY
C
C THIS IS THE MAIN PROGRAM FOR THE VAX/UNIX (BERKELEY) IMPLEMENTATIONS
C
C DAVID M. GAY
C BELL LABS., MAR., 1983.
C========================
C
      INTEGER IBLOCK(0900)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
C
C
       NWCBI = 45
       READER = 5
       PRINTR = 6
C      PROVIDE INITIAL CONDITIONS FOR SIMPLE PROGRAM.
       WORKF  = 7
       CALL EXCH (IBLOCK)
       STOP
       END
      BLOCK DATA
C
C     BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/
      DATA INTEXT /0/, INALT /0/
C
      DATA CHAR1L /1H1/
C                                                        A  U  T  H
      DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1)  /65,85,84,72/
C                                                        C  O  M  M
      DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2)  /67,79,77,77/
C                                                        C  O  P  Y
      DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3)  /67,79,80,89/
C                                                        D  A  T  A
      DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4)  /68,65,84,65/
C                                                        D  A  T  E
      DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5)  /68,65,84,69/
C                                                        G  R  O  U
      DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6)  /71,82,79,85/
C                                                        I  N  D  E
      DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7)  /73,78,68,69/
C                                                        I  N  P  U
      DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8)  /73,78,80,85/
C                                                        N  A  M  E
      DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9)  /78,65,77,69/
C                                                        I  N  T  A
      DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/
C                                                        K  E  Y  W
      DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/
C                                                        L  I  M  I
      DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/
C                                                        M  A  C  H
      DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/
C                                                        O  P  T  I
      DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/
C                                                        O  R  I  G
      DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/
C                                                        O  U  T  A
      DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/
C                                                        O  U  T  P
      DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/
C                                                        P  R  E  D
      DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/
C                                                        P  R  I  N
      DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/
C                                                        Q  U  I  T
      DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/
C                                                        R  E  A  D
      DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/
C                                                        R  E  F  E
      DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/
C                                                        R  E  M  O
      DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/
C                                                        R  E  W  I
      DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/
C                                                        S  I  T  E
      DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/
C                                                        S  K  I  P
      DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/
C                                                        T  E  X  T
      DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/
C                                                        T  I  T  L
      DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/
C                                                        U  P  D  A
      DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/
C                                                        W  O  R  K
      DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/
C                                                        C  O  N  T
      DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/
C                                                        I  D  E  N
      DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/
C                                                        I  N  C  L
      DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/
C                                                        S  I  G  N
      DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/
C                                                        M  A  R  G
      DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/
      DATA IDSTEP /0/, IDTXTL /0/
      DATA INDEX /0/
      DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/
      DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/
      DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/
      DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/
      DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/
      DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/
      DATA INDEXS(25),INDEXS(26)                       /0,0    /
      DATA INTOPN /0/
      DATA ITYPEI /0/
      DATA LIMIT /0/
      DATA MARGIN /180/
      DATA NCCBI /180/
      DATA NCCBO /180/
      DATA NCHCMD /0/
      DATA NCHMAX /180/
      DATA NCOMDP /35/
      DATA NCOMDT /35/
      DATA NDATAO /3591/
      DATA NERRCO /0/
      DATA NERRG /0/
      DATA NRWORK /0/
      DATA OUTOPN /0/
      DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/
      DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/
      DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/
      DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/
      DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/
      DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/
      DATA OPTVAL(25),OPTVAL(26)                       /0,0    /
      DATA PHASE /1/
C     INDICATE THAT NO PREDICATES ARE DEFINED.
      DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/
      DATA PRED(1,6),PRED(1,7),PRED(1,8)                     /0,0,0    /
      DATA SITE(1) /0/
      DATA TITLE(1) /32/
C     32 = ASCII BLANK
      DATA TODAY (1) /0/
      DATA TRANS /1/
      END
      SUBROUTINE EXCH (IBLOCK)
C
C     VAX/UNIX INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM.
C     IT KNOWS HOW TO FETCH THE DATE FROM THE SYSTEM.
C
      INTEGER IBLOCK(1)
C
C     ALLOCATE SPACE FOR TAPE OUTPUT
C
      INTEGER OBLOCK(0900)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
       INTEGER MKDTTD,MKDTOD
C
C      MAKE DATE TENS DIGIT AND MAKE DATE ONES DIGIT.
       MKDTTD(M) = M/10 + 48
       MKDTOD(N) = MOD(N,10) + 48
C
       NWCBO = 45
       WORKF  = 7
       TABS = 'Y'
C     THIS PRESET IS NEEDED SO THAT THE CORRECT OPEN
C     SEQUENCE IS DONE FOR THE PRINTER AT THE BEGINNING.
       NCHCMD=0
       EQUAL=1
C     GET THE DATE FROM THE SYSTEM.
       CALL IDATE(I,J,K)
       TODAY(1) = MKDTTD(K)
       TODAY(2) = MKDTOD(K)
       TODAY(3) = MKDTTD(I)
       TODAY(4) = MKDTOD(I)
       TODAY(5) = MKDTTD(J)
       TODAY(6) = MKDTOD(J)
C
C      THE FOLLOWING SITE INFO. IS FOR SANDIA NATL. LABS. ONLY.
C      SUGGEST YOU PUT YOU OWN SITE HERE AS ASCII SEQUENCE CODE
C      THAT IS MEANINGFUL TO YOU.
C
C      SITE(1)=83
C      SITE(2)=65
C      SITE(3)=78
C      SITE(4)=68
C      SITE(5)=73
C      SITE(6)=65
C      SITE(7)=32
C      SITE(8)=78
C      SITE(9)=97
C      SITE(10)=116
C      SITE(11)=108
C      SITE(12)=46
C      SITE(13)=32
C      SITE(14)=76
C      SITE(15)=97
C      SITE(16)=98
C      SITE(17)=115
C      SITE(18)=46
C      SITE(19)=32
C      SITE(20)=56
C      SITE(21)=55
C      SITE(22)=49
C      SITE(23)=56
C      SITE(24)=53
C      SITE(25)=32
C      SITE(26)=50
C      SITE(27)=54
C      SITE(28)=48
C      SITE(29)=48
C      SITE(30)=32
C      SITE(31)=86
C      SITE(32)=65
C      SITE(33)=88
C      DO 10 I=34,40
C  10  SITE(I)=32
C
C      END OF SANDIA LABS. SITE DEFN.
C
C      DEFINE THE COMMAND 'TABS='.
       NCOMDT=NCOMDP+1
       COMD(1,NCOMDT)=84
       COMD(2,NCOMDT)=65
       COMD(3,NCOMDT)=66
       COMD(4,NCOMDT)=83
       CALL EXCHTR (IBLOCK,OBLOCK)
       RETURN
       END
      SUBROUTINE EXCHAH (RECORD,NCHAR)
C
C     CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO
C     HOLLERITH FORMAT.
C
      INTEGER RECORD(1),NCHAR
      INTEGER BLANKZ,I
      DATA BLANKZ /X'20202000'/
C
      DO 10 I = 1, NCHAR
10    RECORD(I)=RECORD(I) + BLANKZ
C
      RETURN
      END
      SUBROUTINE EXCHFO (IOP)
C
C     DEC-VAX USING UNIX (BERKELEY)
C     THIS VERSION IS FOR THE COMPREHENSIVE PROGRAM ONLY.
C
C     OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM.
C     IOP LESS THAN    ZERO MEANS CLOSE FILE,
C     IOP GREATER THAN ZERO MEANS OPEN FILE.
C     IABS(IOP) = 1 MEANS READER,
C               = 2 MEANS PRINTER,
C               = 3 MEANS WORK FILE,
C               = 4 MEANS INFILE.  IOP = 4 IS USED ONLY BY THE
C                   BOOTSTRAP PROGRAM.
C
C
      INTEGER IOP, JUMP
      CHARACTER*11 PNAME
      CHARACTER*40 NAME
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      DATA PNAME/'EXCHXX.LIS '/
C
      JUMP=IABS(IOP)
      IF (IOP.LT.0) GO TO (10,20,30), JUMP
      GO TO (50,60,70), JUMP
C
C     CLOSE FILES.
10    GO TO 90
20    CLOSE (UNIT=PRINTR)
      GO TO 90
30    CLOSE (UNIT=WORKF)
      GO TO 90
C
C     OPEN FILES.
50    GO TO 90
60    CONTINUE
      K=MIN0(NCHCMD-EQUAL+1,40)
      IF(K.GT.0) THEN
        NAME=' '
        DO 65 I=1,K
        NAME(I:I)=CHAR(COMAND(EQUAL+I-1))
65      CONTINUE
      ELSE
        NAME=PNAME
        NAME(5:6)=CHAR(PRINTR/10+48)//CHAR(MOD(PRINTR,10)+48)
      END IF
      IF (PRINTR .NE. 6)
     1   OPEN(UNIT=PRINTR,FILE=NAME,STATUS='UNKNOWN',ERR=100)
      GO TO 90
70    CONTINUE
      OPEN(UNIT=WORKF,ERR=120,FORM='UNFORMATTED',STATUS='SCRATCH')
C
90    RETURN
C
100   WRITE (*,110)
110   FORMAT(' Unable to open PRINTER file.')
      GO TO 140
120   WRITE (PRINTR,130)
130   FORMAT(' Unable to open WORK file.')
140   STOP
      END
C========================
C EXCHANGE PROGRAM, VAX/UNIX IMPLEMENTATION.
C
C READ A COMMAND OR TEXT IMAGE FROM    1. ALTERNATE CORRECTION FILE
C                                      2. TEXT FILE
C                                      3. INPUT FILE
C                                      4. SYSTEM READER
C IF READING FROM -READER-, PUT A PROMPT ON THE TERMINAL
C PUT THE HOLLERITH COMMAND IN HOLCMD
C PUT THE ASCII EQUIVALENT IN COMAND
C PUT THE NUMBER OF CHARACTERS IN NCHCMD
C IF END-OF-FILE IS SENSED, SET NCHCMD=-1
C IF THE VARIABLE -TABS- IS TRUE, KEEP THE TAB CHARACTERS
C
C ROUTINE READS 133 CHARACTER IMAGES
C========================
C
       SUBROUTINE EXCHIM
C
      INTEGER BLANK,BFILL,RDFILE
      INTEGER TMPLIN(133)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
       EQUIVALENCE (TMPLIN(1),COMAND(1))
       DATA BLANK/1H /
C
C    DETERMINE WHICH FILE TO WORK ON.
       RDFILE = INALT
       IF (RDFILE .GT. 0) GO TO 1000
       RDFILE = INTEXT
       IF (RDFILE .NE. 0) GO TO 1000
       RDFILE = INFILE
       IF (RDFILE .EQ. 0) RDFILE = READER
C
C   PERFORM ACTION.  FILES ARE OPENED IN EXCHCX.
1000   I = ACTION + 2
       GO TO (5000,4000,7000,2000),I
       RETURN
C
C   REWIND INALT
2000   REWIND RDFILE
       GO TO 7000
C
C   READ IN A LINE, MAPPING TABS IF NECESSARY
C
C      THE FOLLOWING TEST MUST BE CHANGED IF TTY IS OTHER THAN UNIT 5.
4000   IF (RDFILE.EQ.5 .AND. PRINTR.EQ.6) WRITE (6,601)
       M = 133
       READ (RDFILE,501,END=8000) (TMPLIN(I),I=1,M)
       NCHCMD=0
       IF (M .EQ. 0) GO TO 7000
       DO 4090 I=1,M
           IF (TABS.EQ.'Y') GO TO  4070
           IF (AND(TMPLIN(I),127) .NE. 9) GO TO 4070
C          9 IS ASCII HT (HORIZONTAL TAB).
           BFILL = 8 - MOD(NCHCMD,8)
           DO 4040 J=1,BFILL
               NCHCMD=NCHCMD+1
               HOLCMD(NCHCMD)=BLANK
4040           CONTINUE
           GO TO 4090
4070       NCHCMD=NCHCMD+1
           HOLCMD(NCHCMD)=TMPLIN(I)
4090       CONTINUE
       DO 4190 I=1,NCHCMD
           COMAND(I) = AND(HOLCMD(I), 127)
4190       CONTINUE
      M=NCHCMD
      DO 4200 I=1,M
          IF(COMAND(M-I+1).EQ.32) GO TO 4200
C         32 = ASCII BLANK.
          NCHCMD=M-I+1
          GO TO 7000
4200  CONTINUE
      NCHCMD=0
       GO TO 7000
C
C   CLOSE A FILE.
5000   CLOSE(UNIT=RDFILE)
C
7000   ACTION = 0
       RETURN
C
8000   NCHCMD = -1
       GO TO 7000
501    FORMAT(133A1)
601    FORMAT('$*')
       END
      SUBROUTINE EXCHOU (OUTPUT)
C
C     NATIVE FORMAT OUTPUT PROGRAM. FOR THE TEXT EXCHANGE PROGRAM.
C     VAX/UNIX IMPLEMENTATION.
C
C     OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN.
C     THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT.
C
C     THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180),
C     THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179).  IF OUTPUT(180)
C     IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE.  IF OUTPUT(180)
C     IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW
C     IMAGE.
C
      INTEGER OUTPUT(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C   DECIDE WHETHER TO OPEN, CLOSE OR WRITE.
C
      IF (ACTION.NE.0) IF (ACTION+1) 70,40,70
      WRITE (OUFILE,30) (OUTPUT(I),I=1,NCHOUT)
30    FORMAT (133A1)
      GO TO 70
40    CLOSE(UNIT=OUFILE)
C
70    ACTION=0
      RETURN
      END
      SUBROUTINE EXCHPA (BUFIN,BUF9T)
C
C     CHARACTER PACKING ROUTINE FOR THE DEC-VAX SERIES MACHINES.
C     OPERATING SYSTEM VAX/UNIX VERSION (BERKELEY)
C     THE BYTE DATA TYPE IS USED TO PACK THE CHARACTERS FROM THE
C     WORKING BUFFER BUFIN(*), WHERE THEY ARE STORED ONE CHARACTER
C     PER WORD, TO BUF9T(*).
C
C
C DAVID M. GAY
C BELL LABS., MAR., 1983.
      CHARACTER*1 BUFIN(720),BUF9T(180)
C
      DO 10 I=1,180
      BUF9T(I)=BUFIN(4*I-3)
   10 CONTINUE
      RETURN
      END
      SUBROUTINE EXCHRT (ISTAT,INPBUF)
C
C     TAPE INPUT ROUTINE FOR THE DEC-VAX SERIES MACHINES.
C     OPERATING SYSTEM VAX/UNIX VERSION (BERKELEY)
C     NOTE -- INTEGER*4 IS ASSUMED DEFAULT.
C
C DAVID M. GAY
C BELL LABS., MAR., 1983.
C     REVISED 830510 1500
C
C     INPUT PARAMETERS
C       ISTAT = 1  OPEN INPUT TAPE, NO REWIND
C             = 2  REWIND AND CLOSE INPUT TAPE
C             = 3  READ FROM TAPE INTO INPBUF(*)
C             = 4  CLOSE INPUT TAPE, NO REWIND
C       INPBUF -- THE BUFFER INTO WHICH THE DATA IS TO BE READ.
C
C     OUTPUT PARAMETERS
C       ISTAT = 0  IF NO ERRORS OCCURRED
C             = 3  IF ANY TYPE OF ERROR OCCURRED.
C                  (AN INFORMATIVE MESSAGE WILL USUALLY BE PRINTED)
C
      INTEGER ISTAT,INPBUF(1)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*40 FNAMES(3)
      CHARACTER*1 TABS
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
C
      IF ((ISTAT.LT.1) .OR. (ISTAT.GT.4)) GO TO 240
      GO TO (10,60,70,120), ISTAT
C
C     OPEN TAPE, NO REWIND
10    CONTINUE
C     OPEN (UNIT=INTAPE,FILE=FNAMES(2),ERR=130,IOSTAT=IERR,
C    * RECL=3600,STATUS='OLD',RECORDTYPE='VARIABLE',
C    * CARRIAGECONTROL='NONE',READONLY)
      CALL TROPEN(INTAPE, IERR, FNAMES(2))
      GO TO 230
C
C     REWIND AND CLOSE INPUT TAPE
60    CONTINUE
C     REWIND (UNIT=INTAPE,ERR=150,IOSTAT=IERR)
      CALL TRWIND(INTAPE, IERR, *150)
      GO TO 230
C
C     READ INTO INPBUF
70    CONTINUE
      NCDBI=NDATAI+NERRCI+9
      NWORDS=(NCDBI+3)/4
      DO 110 I=1,2
C
C     READ A BUFFER FROM INTAPE INTO INPBUF.
C      READ(INTAPE,80,END=100,ERR=100,IOSTAT=IERR)(INPBUF(J),J=1,NWORDS)
      CALL TREAD(INTAPE, IERR, INPBUF, 4*NWORDS, *100)
80    FORMAT(255(10A4))
       GO TO 230
C
C     ALLOW ONE END-OF-FILE IF EXPECTING LABEL.
100    IF (IERR.EQ.(-1).AND.BLKSQI.NE.0) GO TO 170
       IF (IERR.GT.0) GO TO 175
110   CONTINUE
      GO TO 170
C
C     CLOSE INPUT TAPE WITH NO REWIND.
120   CONTINUE
      CALL TCLOSE(INTAPE, IERR, *230)
      GO TO 230
C
C     PROCESS ERROR CONDITIONS
130   CONTINUE
      IF (IERR .NE.(-1)) GO TO 140
      WRITE (PRINTR,180)
      GO TO 240
140   CONTINUE
      WRITE (PRINTR,190) IERR
      GO TO 240
C
150   CONTINUE
      IF (IERR .NE.(-1)) GO TO 160
      WRITE (PRINTR,200)
      GO TO 240
160   CONTINUE
      WRITE (PRINTR,210) IERR
      GO TO 240
C
170   CONTINUE
      IF (IERR.EQ.(-1)) WRITE (PRINTR,220)
      GO TO 240
C
175   CONTINUE
      WRITE (PRINTR,225) IERR
      GO TO 240
C
180   FORMAT ('0Attempted open at end-of-file on INTAPE')
190   FORMAT ('0Error condition occurred while opening INTAPE, IOSTAT=',
     * Z8)
200   FORMAT ('0End-of-file on close/rewind of INTAPE')
210   FORMAT ('0Error condition occurred with close/rewind on INTAPE, IO
     *STAT=',Z8)
220   FORMAT ('0Unexpected end-of-file on INTAPE.')
225   FORMAT ('0Error condition occurred while reading INTAPE, IOSTAT=',
     * Z8)
C
230   CONTINUE
      ISTAT=0
      RETURN
240   CONTINUE
250   CONTINUE
      ISTAT=3
      RETURN
C
      END
      SUBROUTINE EXCHUN (BUF9T,BUFOUT)
C
C     CHARACTER UNPACKING ROUTINE FOR THE DEC-VAX SERIES MACHINES.
C     OPERATING SYSTEM VAX/UNIX VERSION (BERKELEY)
C     THE BYTE DATA TYPE IS USED TO UNPACK THE CHARACTERS FROM THE
C     INPUT BLOCK BUF9T(*) TO THE OUTPUT BUFFER BUFOUT(*), ONE
C     CHARACTER PER WORD.
C     NOTE -- INTEGER*4 IS ASSUMED DEFAULT.
C
C DAVID M. GAY
C BELL LABS., MAR., 1983.
C
      CHARACTER*1 BUF9T(180),BUFOUT(720)
      CHARACTER*1 IZERO
      DATA IZERO /'\0'/
C
      DO 10 I = 1, 180
      BUFOUT(4*I-3)=BUF9T(I)
      BUFOUT(4*I-2)=IZERO
      BUFOUT(4*I-1)=IZERO
      BUFOUT(4*I)=IZERO
   10 CONTINUE
      RETURN
      END
      SUBROUTINE EXCHWT(ISTAT,OUTBUF)
C
C     TAPE OUTPUT ROUTINE FOR THE DEC-VAX SERIES MACHINES.
C     OPERATING SYSTEM VAX/UNIX VERSION (BERKELEY)
C     NOTE -- INTEGER*4 IS ASSUMED DEFAULT.
C
C DAVID M. GAY
C BELL LABS., MAR., 1983.
C     REVISED 830510 1500
C
C     INPUT PARAMETERS
C       ISTAT = 1  OPEN OUTPUT TAPE, NO REWIND
C             = 2  WRITE CONTENTS OF OUTBUF(*) TO OUTPUT TAPE
C             = 3  CLOSE OUTPUT TAPE, NO REWIND
C       OUTBUF -- THE BUFFER FROM WHICH THE DATA IS TO BE WRITTEN
C
C     OUTPUT PARAMETERS
C       ISTAT = 0  IF NO ERRORS OCCURRED
C             = 3  IF ANY TYPE OF ERROR OCCURRED
C                  (AN INFORMATIVE MESSAGE WILL USUALLY BE PRINTED)
C
      INTEGER ISTAT,OUTBUF(1)
      INTEGER EXPSIZ
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*40 FNAMES(3)
      CHARACTER*1 TABS
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
C
      IF ((ISTAT.LT.1) .OR. (ISTAT.GT.3)) GO TO 150
      GO TO (10,50,80), ISTAT
C
C     OPEN OUTAPE, NO REWIND.
10    CONTINUE
C     OPEN (UNIT=OUTAPE,FILE=FNAMES(3),ERR=100,IOSTAT=IERR,
C    * RECL=3600,STATUS='NEW',RECORDTYPE='VARIABLE',
C    * CARRIAGECONTROL='NONE')
      CALL TWOPEN(OUTAPE, IERR, FNAMES(3))
      GO TO 90
C
C     WRITE CONTENTS OF OUTBUF(*) TO OUTAPE
50    CONTINUE
      EXPSIZ=CCDBO
      IF (BLKSQO.NE.0) EXPSIZ=NDATAO+NERRCO+9
      NWORDS=(EXPSIZ+3)/4
C     WRITE (OUTAPE,60,ERR=135,IOSTAT=IERR) (OUTBUF(I),I=1,NWORDS)
      CALL TWRITE(OUTAPE, IERR, OUTBUF, 4*NWORDS, *135)
60    FORMAT(255(10A4))
      GO TO 90
C
C     CLOSE OUTAPE, NO REWIND.
80    CONTINUE
C     CLOSE (UNIT=OUTAPE,ERR=120)
      CALL TCLOSE(OUTAPE, IERR, *120)
      GO TO 90
C
C     FUNCTION COMPLETED NORMALLY.
90    CONTINUE
      ISTAT=0
      RETURN
C
C     PROCESS ERROR CONDITIONS.
100   CONTINUE
      WRITE (PRINTR,110) IERR
110   FORMAT ('0Error condition occurred while opening OUTAPE, IOSTAT=',
     * Z8)
      GO TO 140
C
120   CONTINUE
      WRITE (PRINTR,130)
130   FORMAT ('0Error condition occurred while closing OUTAPE.')
C
135   CONTINUE
      WRITE (PRINTR,136) IERR
136   FORMAT ('0Error condition occurred while writing OUTAPE, IOSTAT=',
     * Z8)
C
140   CONTINUE
150   CONTINUE
      ISTAT=3
      RETURN
      END
      SUBROUTINE EXCHSL
C
C     LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS.
C
C     EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE
C     SEGMENT.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      RETURN
      END
      SUBROUTINE EXCHTR (IBLOCK,OBLOCK)
C
C     TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER.
C
      INTEGER IBLOCK(1), OBLOCK(1)
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4.
C
      CALL EXCHFO (1)
      CALL EXCHFO (2)
      WORKF=-IABS(WORKF)
C
10    IF (TRANS.LE.0) RETURN
      CALL EXCHSL
C     LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS.
      GO TO (11,12,13,14,15,16,17,18,19), TRANS
C     COMMAND PARSER
11    CALL EXCHC1 (IBLOCK,OBLOCK)
      GO TO 10
C     IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE
12    CALL EXCHC2
      GO TO 10
C     OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE.
13    CALL EXCHC3 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE.
14    CALL EXCHC4 (IBLOCK)
      GO TO 10
C     COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE.
15    CALL EXCHC5 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY TEXT FROM INTAPE TO OUTAPE
16    CALL EXCHC6 (IBLOCK,OBLOCK)
      GO TO 10
C     TEXT COMMAND
17    CALL EXCHC7 (IBLOCK,OBLOCK)
      GO TO 10
C     ERROR MESSAGES
18    CALL EXCHC8
      GO TO 10
C     QUIT
19    CALL EXCHC9 (IBLOCK,OBLOCK)
      GO TO 10
      END
      SUBROUTINE EXCHGB (ISTAT,DBLOCK)
C
C     READ A BLOCK FROM THE EXCHANGE TAPE.
C     IGNORE THE ERROR CONTROL SEGMENT.
C     CHECK THE BLOCK SEQUENCE NUMBER.
C     CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER,
C               OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
C
C     READ A BLOCK FROM INTAPE.
C
      BLKSQI=BLKSQI+1
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 160
C
C     GET INFORMATION OUT OF THE BLOCK HEADER.
C
      CCDBI=NERRCI
      CWDBI=NWCBI*(CCDBI/NCCBI)+1
      CPCBI=MOD(CCDBI,NCCBI)
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
      DO 110 JUMP=1,9
      CCDBI=CCDBI+1
      CPCBI=CPCBI+1
      IF (CCDBI.GT.NCDBI) GO TO 130
      IF (CPCBI.LE.NCCBI) GO TO 10
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
10    GO TO (20,30,40,50,60,70,80,90,100), JUMP
20    NEWBLK=256*CBLCKI(CPCBI)
      GO TO 110
30    NEWBLK=NEWBLK+CBLCKI(CPCBI)
      GO TO 110
40    LASTI=CBLCKI(CPCBI)
      GO TO 110
50    L1PRGI=256*CBLCKI(CPCBI)
      GO TO 110
60    L1PRGI=L1PRGI+CBLCKI(CPCBI)
      GO TO 110
70    N1RECI=256*CBLCKI(CPCBI)
      GO TO 110
80    N1RECI=N1RECI+CBLCKI(CPCBI)
      GO TO 110
90    L1RECI=256*CBLCKI(CPCBI)
      GO TO 110
100   L1RECI=L1RECI+CBLCKI(CPCBI)
110   CONTINUE
C
C     CHECK THE BLOCK SEQUENCE NUMBER.
C
      IF (BLKSQI.EQ.NEWBLK) GO TO 150
      ISTAT=1
      WRITE (PRINTR,120) NEWBLK,BLKSQI
120   FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I
     15//)
      BLKSQI=NEWBLK
      GO TO 160
C
C     FORMAT ERROR
C
130   ISTAT=2
      GO TO 160
C
C     CHECK L1PRGI AND L1RECI.
C
150   IF (L1PRGI.GT.NCDBI) GO TO 130
      IF (L1RECI.GT.NCDBI) GO TO 130
      ISTAT=0
160   RETURN
C
      END
      SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD)
C
C     GET A RECORD FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK).
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE
C               SPACE ALLOWED BY THE USER.  (POSITION IS STILL OK).
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C     THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM
C     CONTROL RECORDS.  NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS.
C
      ISTAT=0
      NCHACT=0
10    JUMP=1
      GO TO 260
20    NG=CBLCKI(CPCBI)
      IF (NG.EQ.0) GO TO 90
      IF (NG.NE.255) GO TO 30
C
C     END OF SHORT TAPE BLOCK.
C
      CCDBI=NCDBI
      GO TO 10
C
C     UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO
C     THE USER RECORD AREA.
C
30    ITYPEI=0
      IF (MODEI.EQ.0) GO TO 40
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG
40    IG=0
50    JUMP=2
      GO TO 260
60    NR=CBLCKI(CPCBI)
      IF (MODEI.EQ.0) GO TO 70
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR
      GO TO 160
70    IR=0
C     PUT REMVI INTO THE USER RECORD NR TIMES.
80    IF (IR.GE.NR) GO TO 160
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI
      IR=IR+1
      GO TO 80
C
C     THE NEXT RECORD IS A CONTROL RECORD.  FIND OUT WHAT KIND.
C
90    JUMP=3
      GO TO 260
100   ITYPEI=CBLCKI(CPCBI)
      IF (ITYPEI.LT.65) GO TO 250
C     65 = ASCII  A
      IF (ITYPEI.GT.90) GO TO 250
C     90 = ASCII  Z
      I=ITYPEI-64
C             A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
      GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160
     1,110,160,220,160,160,160,160,160,160,160,160), I
C       P   Q   R   S   T   U   V   W   X   Y   Z
C
C     P - PROGRAM HEADER
C
C     CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER
110   REMVI=32
C     RESET THE REMOVED CHARACTER TO ASCII BLANK.
      JUMP=4
      GO TO 260
120   L1PRGI=256*CBLCKI(CPCBI)
      JUMP=5
      GO TO 260
130   L1PRGI=L1PRGI+CBLCKI(CPCBI)
      JUMP=6
      GO TO 260
140   N1RECI=256*CBLCKI(CPCBI)
      JUMP=7
      GO TO 260
150   N1RECI=N1RECI+CBLCKI(CPCBI)
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
160   JUMP=8
      GO TO 260
170   NC=CBLCKI(CPCBI)
      IF (ITYPEI.NE.0) GO TO 180
      IF (MODEI.EQ.0) GO TO 180
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC
C     COPY NC CHARACTERS TO THE USER RECORD AREA.
180   IC=0
      JUMP=9
190   IF (IC.GE.NC) IF (ITYPEI) 240,210,240
      GO TO 260
200   NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI)
      IC=IC+1
      GO TO 190
210   IG=IG+1
      IF (IG-NG) 50,240,240
C
C     J - UPDATING AND END OF INPUT TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
220   JUMP=10
      GO TO 260
230   RECORD(1)=CBLCKI(CPCBI)
      NCHACT=1
      IF (ITYPEI.EQ.82) REMVI=RECORD(1)
C     82 = ASCII R
C
C     RETURN TO THE USER PROGRAM.
C
240   IF (NCHACT.GT.NCHMAX) ISTAT=4
      GO TO 290
C
C     CONTROL RECORD TYPE CANNOT BE DETERMINED.
C
250   ISTAT=5
      GO TO 290
C
C     GET A CHARACTER FROM CBLOCK.  UNPACK A NEW BLOCK IF NECESSARY.
C     READ MORE TAPE IF NECESSARY.
C
260   CPCBI=CPCBI+1
      CCDBI=CCDBI+1
      IF (CCDBI.LE.NCDBI) GO TO 270
      CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 290,260,290
270   IF (CPCBI.LE.NCCBI) GO TO 280
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
280   GO TO (20,60,100,120,130,140,150,170,200,230), JUMP
290   RETURN
C
      END
      SUBROUTINE EXCHNP (ISTAT,DBLOCK)
C
C     SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE
C     TAPE.
C     THIS MODULE IS MACHINE INSENSITIVE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
      ISTAT=0
      IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20
C
C     CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK.
C
10    IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20
C     76 = ASCII L
C
C     NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK.
      CCDBI=L1PRGI-1
      I=NWCBI*(CCDBI/NCCBI)+1
      IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI)
      CWDBI=I
      CPCBI=MOD(CCDBI,NCCBI)
      GO TO 40
C
C     NO MORE HEADERS IN THIS BLOCK.
C
20    CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 40,10,40
C
C     END OF FILE.
C
30    ISTAT=7
C
40    RETURN
C
      END
      SUBROUTINE EXCHPB (ISTAT,DBLOCK)
C
C     WRITE A BLOCK ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C     WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK.
      INTEGER WORK(9)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
C     PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK.
C
      BLKSQO=BLKSQO+1
      WORK(1)=BLKSQO/256
      WORK(2)=MOD(BLKSQO,256)
      WORK(3)=LASTO
      WORK(4)=L1PRGO/256
      WORK(5)=MOD(L1PRGO,256)
      WORK(6)=N1RECO/256
      WORK(7)=MOD(N1RECO,256)
      WORK(8)=L1RECO/256
      WORK(9)=MOD(L1RECO,256)
C
      CPCBO=MOD(NERRCO,NCCBO)
      CWDBO=(NERRCO/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
C
      DO 10 I=1,9
      CPCBO=CPCBO+1
      IF (CPCBO.LE.NCCBO) GO TO 10
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
      CWDBO=CWDBO+NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
      CPCBO=1
10    CBLCKO(CPCBO)=WORK(I)
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
C
C     WRITE THE DATA BLOCK ON TAPE.
C
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L).
C
      IF (LASTO.NE.76) GO TO 20
      ISTAT=3
      CALL EXCHWT (ISTAT,DBLOCK)
      GO TO 30
C
C     COMPUTE POINTERS FOR NEXT BLOCK OUT.
C
20    L1PRGO=0
      LLPRGO=0
      N1RECO=0
      L1RECO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
C
30    RETURN
C
      END
      SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD)
C
C     WRITE A RECORD ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A
C             TEXT RECORD CONTAINS MORE THAN 254 GROUPS.
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER GC,RC(255),CC(255)
C     GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      ISTAT=0
      INCHAR=0
C
C     DETERMINE THE RECORD TYPE.
C
      IF (NCHOUT.NE.255) GO TO 10
      ITYPEO=255
      GO TO 70
10    IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO
      IF (ITYPEO.NE.0) GO TO 30
C
C     DATA RECORD.
C
      IF (MODEO.NE.0) GO TO 170
C     COMPRESS THE RECORD.
      CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255)
      IF (GC.GE.255) GO TO 210
      IG=0
C     OUTPUT THE GROUP COUNT.
      CBLCKO(CPCBO)=GC
      JUMP=1
      GO TO 230
20    IG=IG+1
      IF (IG.GT.GC) GO TO 250
      NC=CC(IG)
      INCHAR=INCHAR+RC(IG)
C     OUTPUT REMOVED CHARACTER COUNT.
      CBLCKO(CPCBO)=RC(IG)
      JUMP=2
      GO TO 230
C
C     THE USER SAYS HE HAS A CONTROL RECORD TO WRITE.  FIND OUT
C     WHAT KIND.
C
30    IF (ITYPEO.LT.65) GO TO 220
C     65 = ASCII A
      IF (ITYPEO.GT.90) GO TO 220
C     90 = ASCII  Z
      I=ITYPEO-64
C             A  B  C  D  E  F  G  H  I  J   K  L  M  N  O  P  Q  R   S
      GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40,
     140,40,40,40,40,40,40), I
C      T  U  V  W  X  Y  Z
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE TYPE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
40    IF (NCHOUT-255) 100,100,210
C
C     END OF FILE.
C
50    IF (NERRCO+NDATAO+7-CCDBO) 70,80,80
C
C     P - PROGRAM HEADER.
C
60    IF (NCHOUT.GT.255) GO TO 210
      REMVO=32
C     RESET REMOVED CHARACTER TO ASCII BLANK.
      IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80
      IF (CCDBO.EQ.NERRCO+10) GO TO 80
C
C     END OF SHORT TAPE BLOCK.
C
70    CBLCKO(CPCBO)=255
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250
C     69 = ASCII E
C     80 = ASCII P
      L1RECO=CCDBO-NERRCO
80    IF (LLPRGO.EQ.0) GO TO 90
C     LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK.
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      NC=MOD(LLPRGO+1,NCCBO)
      NW=((LLPRGO+1)/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      CBLCKO(NC+1)=CCDBO/256
      IF (NC+1.LT.NCCBO) GO TO 85
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      NW=NW+NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      NC=-1
85    CBLCKO(NC+2)=MOD(CCDBO,256)
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      CALL EXCHUN (DBLOCK(CWDBO),CBLCKO)
C     UPDATE TABLE OF CONTENTS POINTERS
90    LLPRGO=CCDBO
      IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO
      NLRECO=NLRECO+1
      IF (N1RECO.EQ.0) N1RECO=NLRECO
100   CBLCKO(CPCBO)=0
      JUMP=3
      GO TO 230
110   CBLCKO(CPCBO)=ITYPEO
      JUMP=4
      GO TO 230
120   IF (ITYPEO.NE.69) GO TO 130
C     69 = ASCII E
      LASTO=76
      GO TO 70
130   IF (ITYPEO.NE.80) GO TO 170
C     80 = ASCII P
      CBLCKO(CPCBO)=0
      JUMP=5
      GO TO 230
140   CBLCKO(CPCBO)=0
      JUMP=6
      GO TO 230
150   CBLCKO(CPCBO)=NLRECO/256
      JUMP=7
      GO TO 230
160   CBLCKO(CPCBO)=MOD(NLRECO,256)
      JUMP=8
      GO TO 230
C
170   NC=NCHOUT
180   CBLCKO(CPCBO)=NC
      IC=0
      JUMP=9
C     PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD.
      IF (ITYPEO.EQ.82) GO TO 190
      IF (ITYPEO.EQ.74) GO TO 190
      IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230
190   IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250
      INCHAR=INCHAR+1
      IC=IC+1
      CBLCKO(CPCBO)=RECORD(INCHAR)
      GO TO 230
C
C     J - UPDATING AND END OF TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
200   NCHOUT=1
      IF (ITYPEO.EQ.82) REMVO=RECORD(1)
C     82 = ASCII R
      GO TO 100
C
C     RECORD TOO LONG.
C
210   ISTAT=4
      GO TO 250
C
C     UNKNOWN CONTROL RECORD TYPE.
C
220   ISTAT=5
      GO TO 250
C
C     INCREMENT THE OUTPUT BUFFER POINTERS.  PACK A CHARACTER BLOCK
C     IF NECESSARY.  WRITE A TAPE BLOCK IF NECESSARY.
C
230   CPCBO=CPCBO+1
      CCDBO=CCDBO+1
      IF (CPCBO.LE.NCCBO) GO TO 240
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CWDBO=CWDBO+NWCBO
      CPCBO=1
      IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 250
240   GO TO (20,180,110,120,140,150,160,170,190), JUMP
250   RETURN
C
      END
      SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL)
C
C     SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE
C     DATA TO BE REMOVED.  DIVIDE DATA INTO GROUPS CONSISTING OF
C     STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT
C     DATA.  THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE
C     REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP
C     ARE RECORDED IN RC() AND SC() RESPECTIVELY.  MAXSL IS THE
C     MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC().
C
      INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL
C
C     RC AND SC MUST BE AT LEAST (IMGLEN-1)//3.
C
      GC=1
      SC(1)=0
      RC(1)=0
      MODE=-1
      INPLEN=IABS(IMGLEN)
C
C     IDENTIFY DATA GROUPS.
C
      DO 110 I=1,INPLEN
      IF (MODE) 40,60,90
C
C     MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE.
C
40    IF (INPIMG(I).EQ.REMOVE) GO TO 50
C     SWITCH TO SIGNIFICANT DATA SCAN.
      MODE=1
      SC(GC)=1
      GO TO 110
C     CONTINUE REMOVE SCAN
50    RC(GC)=RC(GC)+1
      IF (RC(GC)-MAXSL) 110,95,110
C
C     MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY
C     ONE OCCURRENCE OF REMOVE.  CHANGE TO REMOVE MODE IF ANOTHER REMOVE
C     OCCURS OR BACK TO DATA MODE IF NOT.
C
60    IF (INPIMG(I).EQ.REMOVE) GO TO 80
C     SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT.
      MODE=1
      IF (SC(GC).GE.MAXSL-2) GO TO 70
      SC(GC)=SC(GC)+2
      GO TO 110
C     FULL GROUP
70    GC=GC+1
      RC(GC)=1
      SC(GC)=1
      GO TO 110
C     SWITCH TO REMOVE MODE.
80    GC=GC+1
      SC(GC)=0
      RC(GC)=2
      MODE=-1
      GO TO 110
C
C     MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA.
C
90    IF (INPIMG(I).EQ.REMOVE) GO TO 100
      SC(GC)=SC(GC)+1
      IF (SC(GC).NE.MAXSL) GO TO 110
C     FULL GROUP
      MODE=-1
95    IF (I.GE.INPLEN) GO TO 120
      GC=GC+1
      RC(GC)=0
      SC(GC)=0
      GO TO 110
100   MODE=0
110   CONTINUE
120   RETURN
C
      END
      SUBROUTINE EXCHTP (RECORD,LINEI)
C
C     MATERIALIZE INCLUDES IF INALT IS NON-ZERO.
C     CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE
C     AND THE PRINTER IF LISTING IS REQUESTED.
C     LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C
      INTEGER RECORD(1),LINEI
C
C     *****     LOCAL VARIABLES     ************************************
C
C COPY    DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR
C         SKIPPING TEXT NOT TO BE INCLUDED.
      INTEGER COPY
C DASH    CONTAINS '-' IN HOLLERITH.
      INTEGER DASH
C ENDMRK  HOLDS THE END SENTINEL.
      INTEGER ENDMRK(40)
C NCHEND  IS THE NUMBER OF CHARACTERS IN ENDMRK.
      INTEGER NCHEND
C NCHSAV  SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD.
      INTEGER NCHSAV
C NCHTAR  IS THE NUMBER OF CHARACTERS IN TARGET.
      INTEGER NCHTAR
C STAR    CONTAINS '*' IN HOLLERITH.
       INTEGER STAR
C TARGET  IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY).
      INTEGER TARGET(40)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL DATA     ***************************************
C
      DATA DASH /1H-/, STAR /1H*/
C
C     *****     PROCEDURES     *****************************************
C
      LINEO=LINEO+1
      IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190
      RECORD(180)=LINEO
      RECORD(179)=LINEI
      COPY=-1
C     COPY=-1 MEANS NOT COPYING INCLUDED TEXT.
      IF (ITYPEO.EQ.0) GO TO 110
C     PROCESS INCLUDE RECORD.
      DO 10 I=1,NCHOUT
10    RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I)
C     INSERT '-I '.
      RECORD(1)=45
      RECORD(2)=73
      RECORD(3)=32
      NCHOUT=NCHOUT+3
      IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110
C     STORE SEARCH TARGET
      NCHTAR=MIN0(NCHOUT,40)
      DO 20 I=1,NCHTAR
20    TARGET(I)=RECORD(I)
C     STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
      NCHSAV=NCHCMD
      DO 30 I=1,NUMBER
30    OUTREC(I)=COMAND(I)
      COPY=0
C     COPY=0 MEANS SKIPPING MODULE ON INALT FILE.
      INALT=IABS(INALT)
      NEOF=0
40    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
      IF (NCHCMD.LT.2) GO TO 40
      IF (COMAND(1).NE.45) GO TO 40
C     45 = ASCII -
      IF (COMAND(2).EQ.45) GO TO 130
      IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40
C     73 = ASCII I, 105 = ASCII LOWER CASE I.
C     COMPARE IMAGE WITH SEARCH TARGET.
      IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60
      DO 50 I=2,NCHTAR
      K=COMAND(I)
      IF (K.GT.96 .AND. K.LT.123) K=K-32
      IF (TARGET(I).NE.K) GO TO 60
50    CONTINUE
      NEOF=3
C     PREVENT SEARCH LOOP.
      COPY=1
C     COPY=1 MEANS COPYING INCLUDED TEXT.
60    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     STORE END OF INCLUDE MODULE SIGNAL.
      NCHEND=MIN0(40,NCHCMD)
      DO 70 I=1,NCHEND
70    ENDMRK(I)=COMAND(I)
      IF (COPY.EQ.0) GO TO 80
      CHAR1L=DASH
      NCHOUT=NCHTAR
      DO 75 I = 1,NCHOUT
75    COMAND(I)=TARGET(I)
      COMAND(180)=LINEO
      COMAND(179)=LINEI
C     GO PRINT TARGET.
      CALL EXCHTW (COMAND,-1)
      GO TO 120
C     COPY OR SKIP UNTIL ENDMRK SEEN AGAIN.
80    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF.
C     TEST FOR ENDMRK
      DO 90 I=1,NCHEND
      IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100
90    CONTINUE
      IF (COPY) 140,40,140
C     OUTPUT TEXT RECORD.
100   COMAND(180)=LINEO
      COMAND(179)=LINEI
      NCHOUT=NCHCMD
      CALL EXCHTW (COMAND,OPTI)
      GO TO 120
C     OUTPUT TEXT RECORD.
110   CALL EXCHTW (RECORD,1)
120   IF (COPY) 190,190,80
C     WE ONLY GET HERE WITH COPY .GE. 0.
130   NEOF=NEOF+1
      ACTION=2
C     ACTION = 2 MEANS REOPEN INALT.
      CALL EXCHIM
      IF (NEOF.LT.2) GO TO 40
140   INALT=-IABS(INALT)
      NCHCMD=1
      IF (COPY.GT.0) GO TO 170
C     PROCESS TARGET AS THOUGH IT WERE TEXT.
      NCHOUT=NCHTAR
C     SAVE TARGET FOR ERROR MESSAGE.
      DO 150 I=1,NCHTAR
150   COMAND(I)=TARGET(I)
      CALL EXCHTW (COMAND,1)
      CALL EXCHAH (TARGET,NCHTAR)
      WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR)
160   FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8
     10A1))
      NERRS=MAX0(NERRS,3)
C
C     RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
C
170   NCHCMD=NCHSAV
      DO 180 I=1,NUMBER
180   COMAND(I)=OUTREC(I)
C
190   CHAR1L=STAR
      RETURN
C
      END
      SUBROUTINE EXCHTW (RECORD,OPTION)
C
C     WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING
C     EXCHOU.  WRITE RECORD ON THE PRINTER IF LISTING REQUESTED.
C     RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C     IF OPTION = ZERO, WRITE TO FILE ONLY.
C     IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING.
C     IF OPTION .LT. ZERO, WRITE TO LISTING ONLY.
C
      INTEGER RECORD(1),OPTION
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     PROCEDURES     *****************************************
C
      LINEI=RECORD(179)
      IF (OPTION.LT.0) GO TO 130
C
C     INSERT IDENTIFICATION IF REQUESTED.
C
      IF (IDCOL2.LT.IDCOL1) GO TO 120
      IF (IDTXTL+IDSTEP.EQ.0) GO TO 120
      IF (NCHOUT.GE.IDCOL2) GO TO 20
      J=IDCOL2-1
C     FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2
      DO 10 I=NCHOUT,J
10    RECORD(I+1)=32
C     32 = ASCII BLANK.
20    NCHOUT=MAX0(NCHOUT,IDCOL2)
      N=-1
      IF (LINEI.EQ.0) GO TO 40
      IF (IDOPTN.NE.73) GO TO 40
C     73 = ASCII I.  IDENTIFY ONLY FROM INTAPE.
      N=(LINEI-1)*IDSTEP+IDSTRT
      GO TO 70
40    IF (IDOPTN.NE.79) GO TO 50
C     79 = ASCII O.  IDENTIFY ONLY TO OUTAPE.
      N=(LINEO-1)*IDSTEP+IDSTRT
      GO TO 70
50    IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70
C     67 = ASCII C, 70 = ASCII F.  IDENTIFY EVERYTHING.
      N=IDCUR
70    IF (N.LT.0) GO TO 120
      IF (IDTXTL.EQ.0) GO TO 100
      J=MIN0(IDCOL2,IDTXTL+IDCOL1-1)
      K=1
      DO 80 I=IDCOL1,J
      RECORD(I)=IDTEXT(K)
80    K=K+1
100   IF (IDSTEP.EQ.0) GO TO 120
      IDCUR=IDCUR+IDSTEP
      K=IDCOL2
110   RECORD(K)=MOD(N,10)+48
      N=N/10
      K=K-1
      IF (N.EQ.0) GO TO 120
      IF (K.GE.IDCOL1) GO TO 110
C
C     OUTPUT RECORD.
C
120   IF (OUFILE.NE.0) CALL EXCHOU (RECORD)
      IF (OPTION.EQ.0) GO TO 220
130   IF (OPTL.NE.0) GO TO 140
      IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220
140   CALL EXCHAH (RECORD,NCHOUT)
      IF (OPTV+VERT.NE.0) GO TO 200
      IF (PHASE.NE.8) GO TO 180
      IF (LINEI.EQ.0) GO TO 160
      WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
150   FORMAT (1X,2I5,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
160   WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
170   FORMAT (5H  NEW,I6,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
180   WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
190   FORMAT (1X,I5,A1,3X,110A1/(6H  CONT,4X,110A1))
      GO TO 220
200   WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT)
210   FORMAT (132A1)
220   RETURN
C
      END
      SUBROUTINE EXCHC1 (IBLOCK,OBLOCK)
C
C     COMMAND DECODER AND FORMAT VERIFIER.  SOME COMMANDS ARE ALSO
C     COMPLETELY PROCESSED HERE.
C
C     IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS.
C
      INTEGER IBLOCK(1),OBLOCK(1)
C
C
C     *****     LOCAL VARIABLES     ************************************
C
C ALLOW   TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED.  VALUES ARE
C         SUMS OF PERMITTED VALUES OF PHASE.
C         1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING,
C         8 = UPDATING.
C         ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A
C         PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR
C         MAY BE VOID (EQUAL SIGN IS LAST CHARACTER).
C         32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT.
      INTEGER ALLOW(35)
C BLANK   A CONSTANT.  1H .
      INTEGER BLANK
C DATE    IS THE DATE FROM UPDA=, DATE=, ORIG=.
      INTEGER DATE(3)
C DAYS    TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS.
      INTEGER DAYS(12)
C I       IS USED FREELY AS AN INDEX.
C J       IS USED FREELY AS AN INDEX.
C JUMP    USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE.
C K       IS USED FREELY AS AN INDEX.
C KDATE   IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD).
C KQUIT   IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD).
C KTEXT   IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD).
C N       IS USED FREELY AS AN INDEX.
C NCNREC  IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS.
C ND      IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER.
C NM      IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER.
C NY      IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER.
C TVAL    A VECTOR OF VALUES FOR TRANS.  INDEXED BY ICOMD.
      INTEGER TVAL(35)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL EQUIVALENCE     **********************************
C
      EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND)
C
C     *****     DATA STATEMENTS     ************************************
C
      DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/
      DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/
      DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/
      DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/
      DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/
      DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/
      DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/
      DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/
      DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/
      DATA BLANK /1H /
      DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/
      DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/
      DATA DAYS(11),DAYS(12) /30,31/
      DATA KDATE /5/
      DATA KQUIT /20/
      DATA KTEXT /27/
      DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/
      DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/
      DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/
      DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/
      DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/
      DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/
      DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/
C
C     *****     PROCEDURES     *****************************************
C
C     GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER.
C     ECHO IT IF THE E OPTION IS SET.  DETERMINE WHETHER IT IS A CHANGE
C     TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND.
C
10    NCNREC=0
20    ACTION=0
      IF (NCHCMD.LT.0) GO TO 220
      CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (OPTE.EQ.0) GO TO 27
      WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD)
23    FORMAT (1X,80A1)
      CHAR1L=0
27    NCHCMD=MIN0(NCHCMD,MARGIN)
      IF (PHASE.LT.4) SIGNAL=45
C     45 = ASCII -
      IF (COMAND(1).NE.45) GO TO 50
C     45 = ASCII -.  REQUEST TO CHANGE CONTROL RECORD.
      IF (PHASE.LT.4) GO TO 40
      WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD)
30    FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT
     1OR UPDATE/1X,80A1)
      NERRG=MAX0(NERRG,2)
      GO TO 200
40    ICOMD=0
      EQUAL=2
      TRANS=3
      GO TO 370
50    IF (COMAND(1).NE.42) GO TO 70
C     42 = ASCII *.  COMMENT RECORD.  JUST ECHO IT.
      NCHCMD=MAX0(NCHCMD,2)
      WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD)
60    FORMAT (A1,1H*,78A1/(1X,80A1))
      GO TO 10
C
C     SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR
C     EQUAL SIGN ARE FOUND.  LOOK UP THE WORD IN THE COMMAND NAME TABLE.
C
70    EQUAL=0
      DO 80 I=1,NCHCMD
      IF (COMAND(I).EQ.32) GO TO 80
C     32 = ASCII BLANK
      EQUAL=EQUAL+1
      ICOMD=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32
C     ABOVE STATEMENT CONVERTS TO UPPER CASE.
      COMAND(I)=32
      COMAND(EQUAL)=ICOMD
      IF (EQUAL.GE.4) GO TO 90
      IF (ICOMD.EQ.61) GO TO 90
C     61 = ASCII =.
      IF (ICOMD.EQ.44) GO TO 90
C     44 = ASCII ,.
80    CONTINUE
      IF (EQUAL.EQ.0) GO TO 185
90    DO 110 ICOMD=1,NCOMDT
      DO 100 K=1,EQUAL
      IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110
100   CONTINUE
      IF (EQUAL.EQ.4) GO TO 130
      IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130
C     32 = ASCII BLANK.
110   CONTINUE
C
C     UNRECOGNIZED COMMAND.
C
120   ICOMD=0
C
C     LOOK FOR AN EQUAL SIGN.  SET THE VARIABLE NAMED EQUAL TO ZERO IF
C     THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK
C     CHARACTER FOLLOWING THE EQUAL SIGN.
C
130   MODIFY=0
140   DO 150 I=EQUAL,NCHCMD
      K=COMAND(I)
      IF (K.EQ.61) GO TO 160
C     61 = ASCII =.
      IF (MODIFY.NE.0) GO TO 150
C     USE FIRST MODIFIER.
      IF (K.EQ.44) GO TO 160
C     44 = ASCII ,.
150   CONTINUE
      EQUAL=0
      GO TO 170
160   I=I+1
      EQUAL=I
      IF (I.GT.NCHCMD) GO TO 170
      IF (COMAND(I).EQ.32) GO TO 160
C     32 = ASCII BLANK
      IF (K.NE.44) GO TO 170
C     44 = ASCII ,.
      MODIFY=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32
C     CONVERT TO UPPER CASE.
      GO TO 140
170   IF (K.NE.61) EQUAL=0
C     61 = ASCII =.
      IF (ICOMD.EQ.0) GO TO 180
      IF (ICOMD.GT.NCOMDP) GO TO 180
      IF (EQUAL.GT.NCHCMD) GO TO 175
      IF (EQUAL.NE.0) GO TO 230
      IF (ALLOW(ICOMD)/64.NE.0) GO TO 230
175   IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690
C     PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK.
      NCHCMD=NCHCMD+1
      EQUAL=NCHCMD
      COMAND(NCHCMD)=32
C     32 = ASCII BLANK
      HOLCMD(NCHCMD)=BLANK
      GO TO 230
C
C     GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX.
C
180   CALL EXCHCX (0)
C     IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND.
      IF (ICOMD.NE.0) GO TO 730
185   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1))
      NERRG=MAX0(NERRG,5)
200   CHAR1L=0
      NCNREC=NCNREC+1
      IF (NCNREC.LE.20) GO TO 20
      WRITE (PRINTR,210)
210   FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU
     1MES TEXT COMMAND IS MISSING.)
      GO TO 270
C
C     END OF FILE - SIMULATE A QUIT COMMAND.
C
220   ICOMD=KQUIT
C
C     RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME.
C
230   IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240
      TRANS=TVAL(ICOMD)
C             1   2   3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300
     1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7
     230,370,730,370), ICOMD
C       16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
C     32  33  34  35
C
C     THE COMMAND IS NOT ALLOWED AT THIS TIME.
C
240   WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE
     1D./1X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
C     DECIDE WHETHER TO SKIP TEXT
260   IF (ICOMD.NE.KTEXT) GO TO 10
      IF (EQUAL.NE.0) GO TO 10
270   WRITE (PRINTR,280)
280   FORMAT (//15H0SKIPPING TEXT.)
290   CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (NCHCMD.LT.2) GO TO 290
      IF (COMAND(1).NE.SIGNAL) GO TO 290
      IF (COMAND(2).EQ.SIGNAL) GO TO 10
      IF (NCHCMD.LT.3) GO TO 290
      IF (COMAND(2).NE.61) GO TO 290
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 290
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING.
C     DATE=YYMMDD
C     ORIGIN=YYMMDD SITE
C     UPDATE=YYMMDD SITE
C     IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE
C     THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED.
C
300   IF (EQUAL+5.GT.NCHCMD) GO TO 700
      I=EQUAL
      DO 310 J=1,3
      DATE(J)=0
      DO 310 K=1,2
      N=COMAND(I)-48
      IF (N.LT.0) GO TO 320
      IF (N.GT.9) GO TO 320
      DATE(J)=10*DATE(J)+N
310   I=I+1
      IF (NM.EQ.0) GO TO 320
      IF (NM.GT.12) GO TO 320
      IF (ND.LE.0) GO TO 320
      DAYS(2)=28
      IF (MOD(NY,4).EQ.0) DAYS(2)=29
      IF (NY.EQ.0) DAYS(2)=28
      IF (ND.LE.DAYS(NM)) GO TO 440
320   IF (ICOMD.EQ.KDATE) GO TO 700
      IF (TODAY(1).EQ.32) GO TO 700
      I=MIN0(NCHCMD+6,180)
      NCHCMD=I
      J=I-6
      IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1
C     32 = ASCII BLANK
      IF (J.LT.EQUAL) GO TO 700
330   COMAND(I)=COMAND(J)
      HOLCMD(I)=HOLCMD(J)
      J=J-1
      I=I-1
      IF (J.GE.EQUAL) GO TO 330
      DO 340 I=1,6
      COMAND(I+EQUAL-1)=TODAY(I)
340   HOLCMD(I+EQUAL-1)=TODAY(I)
      CALL EXCHAH (HOLCMD(EQUAL),6)
      WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD)
345   FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1))
      NERRG=MAX0(NERRG,1)
      GO TO 440
C
C     REWIND INTAPE
C
350   IF (INTAPE.EQ.0) GO TO 680
      IF (INTOPN.NE.0) GO TO 360
      I=1
C     OPEN INTAPE IF NOT ALREADY OPEN.  DO NOT CHECK EXCH LABEL.
      CALL EXCHRT (I,IBLOCK)
C     IGNORE STATUS
360   I=2
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
      GO TO 725
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH
C     BEGINS WITH A NUMBER FOLLOWED BY A BLANK.
C
C     INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     INTAPE = NUMBER SYSTEM DEPENDENT DATA
C     LIMIT = NUMBER
C     MARGIN = NUMBER
C     OUTAPE = NUMBER SYSTEM DEPENDENT DATA
C     OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     PRINTER = NUMBER
C     READER = NUMBER
C     SKIP = NUMBER
C     TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL)
C     WORK = NUMBER
C
370   NUMBER=0
      IF (EQUAL.EQ.0) GO TO 440
      DO 410 J=EQUAL,NCHCMD
      IF (COMAND(J).EQ.32) GO TO 420
C     32 = ASCII BLANK
      N=COMAND(J)-48
C     48 = ASCII ZERO
      IF (N.GE.0) GO TO 400
380   WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD)
390   FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS.  NOT PROCESSED./
     11X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
      GO TO 260
400   IF (N.GT.9) GO TO 380
410   NUMBER=10*NUMBER+N
      EQUAL=NCHCMD+1
      GO TO 440
420   EQUAL=J
430   EQUAL=EQUAL+1
      IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440
C     32 = ASCII BLANK
C
C     PRELIMINARY FORMAT CHECKING IS COMPLETE
C
440   J=ICOMD+1
C             0  1   2  3  4  5   6  7  8   9  10 11  12 13 14  15  16
      GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6
     120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595),
     2J
C     17 18  19 20  21 22 23 24 25  26  27 28  29  30 31 32  33 34  35
C
C     DATE=YYMMDD
C
450   DO 460 I=1,6
460   TODAY(I)=COMAND(EQUAL+I-1)
      GO TO 10
C
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA.
C
470   I=INFILE
      J=1
      GO TO 500
C
C     INCLUDE = NUMBER SYSTEM DEPENDENT DATA.
C
480   I=INALT
      J=3
      INALT=IABS(INALT)
      GO TO 500
C
C     TEXT
C
490   I=INTEXT
      J=2
      IF (EQUAL.EQ.0) GO TO 560
C
C     OPEN AN INPUT FILE.
C
500   IF (NUMBER.EQ.0) GO TO 505
      IF (NUMBER.EQ.OUFILE) GO TO 710
      IF (NUMBER.EQ.OUTAPE) GO TO 710
505   IF (J.EQ.2) GO TO 510
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (I.NE.0) CALL EXCHIM
510   IF (J-2) 520,530,540
520   INFILE=NUMBER
      GO TO 550
530   INTEXT=NUMBER
      GO TO 550
540   INALT=NUMBER
550   IF (NUMBER.EQ.0) GO TO 560
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      CALL EXCHCX (J+1)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHIM
      ACTION=2
C     ACTION = 2 MEANS REWIND
      IF (J.EQ.3) CALL EXCHIM
      INALT=-IABS(INALT)
560   ACTION=0
C     ACTION = 0 MEANS READ TEXT
      GO TO 730
C
C     INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
570   IF (INTOPN.EQ.0) GO TO 580
C     CLOSE THE INPUT TAPE, IGNORE STATUS.
      I=4
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
580   INTAPE=NUMBER
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (INTAPE.NE.0) CALL EXCHCX (6)
      GO TO 725
C
C     LIMIT = NUMBER
C
590   LIMIT=NUMBER
      GO TO 10
C
C     MARGIN = NUMBER
C
C     MINIMUM MARGIN IS 60
595   MARGIN=MAX0(NUMBER,60)
      GO TO 10
C
C     OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
600   IF (OUTOPN.EQ.0) GO TO 610
C     WRITE AND END-OF-FILE MARK ON OUTAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (I,OBLOCK,OBLOCK)
C     IGNORE STATUS
      OUTOPN=0
      PHASE=1
610   OUTAPE=NUMBER
      OUTUPD=MODIFY
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (OUTAPE.NE.0) CALL EXCHCX (7)
      GO TO 730
C
C     OUTPUT =  NUMBER SYSTEM DEPENDENT INFORMATION
C
620   ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      OUFILE=NUMBER
      IDCUR=IDSTRT
      IF (OUFILE.EQ.0) GO TO 730
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND.
      CALL EXCHCX (5)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHOU (OUTREC)
      GO TO 730
C
C     PRINTER = NUMBER.
C
630   CALL EXCHFO (-2)
      PRINTR=NUMBER
      CALL EXCHFO (2)
      GO TO 10
C
C     READER = NUMBER.
C
640   IF (INFILE.NE.0) GO TO 670
      CALL EXCHFO (-1)
      READER=NUMBER
      CALL EXCHCX (1)
      CALL EXCHFO (1)
      GO TO 10
C
C     WORK = NUMBER
C
650   IF (WORKF.GT.0) CALL EXCHFO (-3)
      WORKF=NUMBER
C     WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4.
      GO TO 10
C
C     UPDATE
C
C     DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR
C     SIMPLY TO OUTPUT THE UPDATE COMMAND.
660   IF (PHASE.GE.4) TRANS=5
      GO TO 730
C
C     ERROR MESSAGES.
C
670   NUMBER=3
C     MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE.
      GO TO 720
680   NUMBER=4
C     MESSAGE 4 - INTAPE IS NOT DEFINED.
      GO TO 720
690   NUMBER=12
C     MESSAGE 12 - NO PARAMETER STRING.
      GO TO 720
700   NUMBER=13
C     MESSAGE 13 - IMPROPER DATE.
      GO TO 720
710   NUMBER=31
C     MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT.
C
C     RETURN TO ERROR MESSAGE SEGMENT.
C
720   TRANS=8
      GO TO 740
c
c     Indicate the WORK file is empty.
c
725   if (nrwork.le.0 .or. workf.le.0) go to 730
      REWIND WORKF
      NRWORK=0
C
C     IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP.
C
730   IF (TRANS.EQ.1) GO TO 10
740   RETURN
C
      END
      SUBROUTINE EXCHCX (REASON)
C
C========================
C
C     PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER
C     PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT,
C     INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS.
C     DEC-VAX UNIX (BERKELEY) VERSION
C     REVISED 830510 1500
C
C     RECOGNIZE THE TABS COMMAND.
C     TABS=Y or D MEANS HT IS DATA, TABS=N or T MEANS HT IS TAB.
C
      INTEGER REASON
C
C     REASON=0 FOR UNRECOGNIZED COMMAND.
C     REASON=1 BEFORE OPENING READER.
C     REASON=2 BEFORE OPENING INFILE (=INPUT FILE).
C     REASON=3 BEFORE OPENING INTEXT (=TEXT FILE).
C     REASON=4 BEFORE OPENING INALT  (=INCLUDE FILE).
C     REASON=5 BEFORE OPENING OUFILE (=OUTPUT FILE).
C     REASON=6 BEFORE OPENING INTAPE.
C     REASON=7 BEFORE OPENING OUTAPE.
C
C
C========================
C
      logical THERE
c
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
C
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      CHARACTER*11 FNMDEF(3)
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCVAX/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA FNMDEF(1)/'EXCHXX.TMP '/,FNMDEF(2)/'EXCHXX.TMP '/,
     *     FNMDEF(3)/'EXCHXX.TMP '/
C
      IF (REASON.NE.0) GO TO 10
C
C     COMMAND NOT RECOGNIZED BY EXCHC1.  IF ICOMD=0 IT IS NOT A
C     COMMAND, ELSE CHECK PARAMETER OF TABS COMMAND.
C
      IF (ICOMD.EQ.0) GO TO 150
      IF (EQUAL.EQ.0 .OR. EQUAL.GT.NCHCMD) GO TO 110
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
      IF (J.EQ.68 .OR. J.EQ.89) THEN
C       68 = ASCII D, 89 = ASCII Y.
        TABS='Y'
        GO TO 150
      END IF
      IF (J.EQ.78 .OR. J.EQ.84) THEN
C       78 = ASCII N, 84 = ASCII T.
        TABS='N'
        GO TO 150
      END IF
      GO TO 110
C
C     PROCESS SYSTEM DEPENDENT INFORMATION
10    J=MAX0(REASON-4,1)
      K=MIN0(NCHCMD-EQUAL+1,40)
      IF (K.GT.0) THEN
C
C       FIRST BLANK OUT FNAMES, THEN FILL IN FILE NAME FROM COMAND.
        FNAMES(J)=' '
        DO 20 I=1,K
          L=COMAND(EQUAL+I-1)
          IF (L.GT.96 .AND. L.LT.123) L=L-32
20        FNAMES(J)(I:I)=CHAR(L)
      ELSE
C
C       PLACE DEFAULT FILE NAMES IN FNAMES(*:*)
        FNAMES(J)=FNMDEF(J)
C
C       PUT ASCII FORM OF LOGICAL UNIT NUMBER INTO (DEFAULT) FILE NAME.
        FNAMES(J)(5:6)=CHAR(NUMBER/10+48)//CHAR(MOD(NUMBER,10)+48)
      END IF
      IF (REASON-5) 50,70,150
C
C     OPEN INPUT FILE.
C
50    CONTINUE
c
c     If the 'T' option is selected and the file is already open,
c     don't open it again.
c
      if (optval(20).ne.0) then
        inquire (file=fnames(1),number=numold,opened=there)
        if (there .and. numold.eq.number) go to 150
      end if
c
C     MAKE A SPECIAL TEST FOR READER=5=TT:.
C     IF (REASON.EQ.1 .AND. READER.EQ. 5) THEN
C     FNAMES(1)='TT:'
      IF (NUMBER .NE. 5) THEN
         OPEN (UNIT=NUMBER,FILE=FNAMES(1),STATUS='OLD', ERR=90,
     *         IOSTAT=IER)
         REWIND NUMBER
         END IF
C     ELSE
C     OPEN (UNIT=NUMBER,FILE=FNAMES(1),STATUS='OLD',ERR=90,
C    * IOSTAT=IER)
C     END IF
      GO TO 150
C
C     OPEN OUTPUT FILE.
C
      inquire (file=fnames(1),number=numold,opened=there)
      if (.not.there .or. (numold.ne.number))
     *open (unit=number,file=fnames(1),status='UNKNOWN',err=90,
     *iostat=ier)
      GO TO 150
C
C     ERROR WHILE OPENING FILE.
C
90    WRITE (PRINTR,100) IER,NUMBER,FNAMES(1)
100   FORMAT (//'0IOSTAT = ',Z8,', Unable to open unit',I3,' for file ',
     * A40)
      GO TO 130
C
C     ERROR WHILE PROCESSING TABS COMMAND.
C
110   WRITE (PRINTR,120)
120   FORMAT (//'0Missing or unrecognized parameter on TABS command.')
C
130   WRITE (PRINTR,140) (HOLCMD(I),I=1,NCHCMD)
140   FORMAT (1X,80A1)
C
150   CONTINUE
      RETURN
C
      END
      SUBROUTINE  EXCHC2
C
C     PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KINDE /32/
      DATA KOPTI /14/
      DATA KSITE /25/
C
C     FIGURE OUT WHICH COMMAND GOT US HERE.
C
      IF (ICOMD-KOPTI) 60,150,10
10    IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270
C
C     ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT
C     WHERE C1, C2, STEP AND START ARE INTEGERS.
C     STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP,
C     START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF
C     CHARACTERS OF TEXT IN IDTXTL.  IF AN ERROR OCCURS,
C     STORE ZERO IN IDSTEP AND IDTXTL.
C     IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO.
C
C     STORE THE MODIFIER IN IDOPTN.
C     IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE
C     PRODUCED ONLY FOR IMAGES FROM INTAPE.  IF THE O MODIFIER
C     IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES
C     WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT.  IF THE F
C     MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION
C     OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE
C     PRODUCED FOR ALL IMAGES OUTPUT.  IF THE C MODIFIER IS SPECIFIED,
C     SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH
C     RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR
C     ALL IMAGES OUTPUT.  IF NONE OF THE I, F, OR C MODIFIERS ARE
C     SPECIFIED, THE O MODIFIER IS ASSUMED.
C
C     IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED.
C     IF IDTXTL = ZERO, TEXT IS NOT EMITTED.
C     IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE
C     EMITTED.
C
C     CONVERT C1,C2,STEP,START
C
      IDOPTN=MODIFY
      IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79
C     70 = ASCII F, 73 = ASCII I, 79 = ASCII O.
      DO 40 J=1,4
      NUMBER=0
20    IF (EQUAL.GT.NCHCMD) GO TO 40
      IF (COMAND(EQUAL).EQ.44) GO TO 30
C     44 = ASCII ,
      I=COMAND(EQUAL)-48
      IF (I.LT.0) GO TO 350
      IF (I.GT.9) GO TO 350
      NUMBER=10*NUMBER+I
      EQUAL=EQUAL+1
      GO TO 20
30    EQUAL=EQUAL+1
40    IDNBRS(J)=NUMBER
      IDCUR=IDSTRT
      IDCOL1=MAX0(1,MIN0(IDCOL1,178))
      IDCOL2=MIN0(IDCOL2,178)
C
C     STORE TEXT.
C
      IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0)
      IF (IDTXTL.EQ.0) GO TO 330
      DO 50 J=1,IDTXTL
      IDTEXT(J)=COMAND(EQUAL)
50    EQUAL=EQUAL+1
      GO TO 330
C
C     INDEX = PARAMETER STRING
C
60    J=0
      IF (COMAND(EQUAL).NE.45) GO TO 70
C     45 = ASCII -
      J=-1
      EQUAL=EQUAL+1
70    N=0
      DO 80 I=1,26
80    INDEXS(I)=0
90    IF (EQUAL.GT.NCHCMD) GO TO 130
      I=COMAND(EQUAL)-64
      IF (I.EQ.-32) GO TO 120
C     32 = ASCII BLANK.
      IF (I.GE.32) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.LE.0) GO TO 100
      IF (I.LE.26) GO TO 110
100   N=EQUAL
      GO TO 120
110   INDEXS(I)=1
120   EQUAL=EQUAL+1
      GO TO 90
130   INDEX=0
      DO 140 I=1,26
      INDEXS(I)=IABS(INDEXS(I)+J)
140   INDEX=INDEX+INDEXS(I)
      IF (MODIFY.EQ.76) INDEX=-INDEX
C     76 = ASCII L.
      IF (N) 340,330,340
C
C     OPTION = PARAMETER STRING
C
150   IF (MODIFY.NE.0) GO TO 170
      DO 160 I=1,26
160   OPTVAL(I)=0
170   IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330
      I=1
      IF (MODIFY.EQ.67) I=0
C     67 = ASCII C.
      N=0
      DO 190 J=EQUAL,NCHCMD
      K=COMAND(J)
      IF (K.GE.96) K=K-32
C     CONVERT TO UPPER CASE.
      IF (K.EQ.32) GO TO 190
C     32 = ASCII BLANK
      IF (K.LT.65) GO TO 180
      IF (K.GT.90) GO TO 180
C     PROCESS ALPHABETIC OPTIONS.
      OPTVAL(K-64)=I
      GO TO 190
180   N=J
190   CONTINUE
      IF (N) 330,330,340
C
C     PROCESS PRED = ID REC A/X MASK STRING
C       WHERE ID = PREDICATE IDENTIFIER (A-H),
C       REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE,
C       A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH
C             IN EXACT POSITION,
C       MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE
C              TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED.
C       STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF
C                CONTROL RECORDS.
C
C     THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR
C     PREDICATE A, ETC.
C
C     PRED(1,*)=LENGTH OF STRING + 3
C     PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED.
C     PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND).
C     PRED(3,*)=RECORD TYPE.
C     PRED(4,*)=A/X
C     PRED(5,*)=MASK CHARACTER.
C     PRED(6..42,*)=STRING.
C
200   IF (EQUAL.NE.0) GO TO 240
C     LIST ALL ACTIVE PREDICATES.
      DO 230 I=1,8
      IF (PRED(1,I).EQ.0) GO TO 230
      J=PRED(1,I)+1
      COMAND(1)=I+64
      DO 210 K=2,J
210   COMAND(K)=PRED(K+1,I)
      CALL EXCHAH (COMAND,J)
      WRITE (PRINTR,220) (COMAND(K),K=1,J)
220   FORMAT (6H PRED=,42A1)
230   CONTINUE
      GO TO 330
C     SAVE PREDICATE IF VALID.
240   IF (NCHCMD.LE.EQUAL+3) GO TO 370
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.GT.72) GO TO 360
C     72 = ASCII H
      NUMBER=J-64
      PRED(1,NUMBER)=0
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.GT.90) GO TO 360
C     90 = ASCII Z
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.EQ.82) GO TO 360
C     82 = ASCII R
      PRED(3,NUMBER)=J
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.NE.65.AND.J.NE.88) GO TO 360
C     65 = ASCII A, 88 = ASCII X
      PRED(4,NUMBER)=J
      EQUAL=EQUAL+1
      PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40)
      I=4
      DO 250 J=EQUAL,NCHCMD
      I=I+1
      IF (I.GT.42) GO TO 330
      K=COMAND(J)
      IF (K.GT.96) K=K-32
C     CONVERT TO UPPER CASE.
250   PRED(I,NUMBER)=K
      GO TO 330
C
C     SITE = SITE NAME
C
260   JUMP=1
      GO TO 280
C
C     TITLE = OUTPUT TAPE TITLE
C
270   JUMP=2
280   K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 320 I=1,40
      IF (K.GT.NCHCMD) GO TO 290
      J=COMAND(K)
      K=K+1
      GO TO 300
290   J=32
C     32 = ASCII BLANK.
300   IF (JUMP.EQ.2) GO TO 310
      SITE(I)=J
      GO TO 320
310   TITLE(I)=J
320   CONTINUE
C
C     RETURN TO COMMAND DECODER.
C
330   TRANS=1
      GO TO 390
C
C     ERROR MESSAGES
C
340   NUMBER=14
C     MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED.
      EQUAL=N
      GO TO 380
350   IDSTEP=0
      IDTXTL=0
360   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED.
      GO TO 380
370   NUMBER=30
C     MESSAGE 30 - COMMAND IS INCOMPLETE.
C
380   TRANS=8
C
390   RETURN
C
      END
      SUBROUTINE EXCHC3 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE
C     COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES.
C
C     OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE
C     NAME COMMAND.
C
C     OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING
C     COPY, NAME OR UPDATE COMMANDS.
C
C ID      IS USED TO CONSTRUCT THE OUTPUT LABEL.
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                                    E  X  C  H
      DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/
C                                    A  N  G  E
      DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/
      DATA KNAME /9/
      DATA KSKIP /26/
C
C     OPEN INTAPE IF NECESSARY
C
      IF (INTOPN.NE.0) GO TO 70
      IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300
      IF (INTAPE.EQ.OUTAPE) GO TO 360
      CALL EXCHRH (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 310
      INTOPN=1
C     COPY THE LABEL TO A SAVE AREA.
      DO 10 I=1,180
10    LABELI(I)=CBLCKI(I)
      CALL EXCHAH (CBLCKI(13),138)
      WRITE (PRINTR,20)
20    FORMAT (25H0INPUT LABEL INFORMATION.)
      WRITE (PRINTR,30) (CBLCKI(I),I=13,104)
30    FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/
     1        20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1)
      IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150)
40    FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1)
      WRITE (PRINTR,50) NDATAI
50    FORMAT (28H DATA CHARACTERS PER BLOCK =,I6)
      IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI
60    FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6)
      CHAR1L=0
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 290
70    IF (ICOMD.EQ.KSKIP) GO TO 270
C
C     OPEN OUTAPE IF NECESSARY
C
80    IF (ICOMD.EQ.0) GO TO 90
      IF (ICOMD.LT.KNAME) GO TO 100
90    IF (INTAPE*OUTAPE.EQ.0) GO TO 100
      IF (OUTUPD.NE.85) GO TO 370
C     85 = ASCII U.
100   IF (OUTOPN.NE.0) GO TO 240
      IF (OUTAPE.EQ.0) GO TO 240
C     CONSTRUCT THE OUTPUT LABEL.
      IF (TODAY(1).EQ.0) GO TO 340
      IF (INTOPN.EQ.0) GO TO 160
      DO 110 I=1,180
110   CBLCKO(I)=LABELI(I)
      IF (TITLE(1).EQ.32) GO TO 130
C     32 = ASCII BLANK
      DO 120 I=1,40
120   CBLCKO(I+18)=TITLE(I)
130   IF (OUTUPD.NE.85) GO TO 220
C     85 = ASCII U.
      IF (SITE(1).EQ.0) GO TO 350
      DO 140 I=1,6
140   CBLCKO(I+104)=TODAY(I)
      DO 150 I=1,40
150   CBLCKO(I+110)=SITE(I)
      GO TO 220
160   IF (TITLE(1).EQ.32) GO TO 330
C     32 = ASCII BLANK
      IF (SITE(1).EQ.0) GO TO 350
      IF (INTAPE*OUTAPE.EQ.0) GO TO 170
      IF (INTAPE.EQ.OUTAPE) GO TO 360
170   DO 180 I=1,8
180   CBLCKO(I)=ID(I)
      DO 190 I=1,40
      CBLCKO(I+18)=TITLE(I)
190   CBLCKO(I+64)=SITE(I)
      DO 200 I=1,6
200   CBLCKO(I+58)=TODAY(I)
      DO 210 I=105,180
210   CBLCKO(I)=0
220   CALL EXCHWH (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 320
      OUTOPN=1
      CBLCKO(1)=CBLCKO(105)
      CALL EXCHAH (CBLCKO(13),138)
      WRITE (PRINTR,230)
      WRITE (PRINTR,30) (CBLCKO(I),I=13,104)
230   FORMAT (26H0OUTPUT LABEL INFORMATION.)
      IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150)
      WRITE (PRINTR,50) NDATAO
      IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO
      CHAR1L=0
240   IF (ICOMD-KNAME) 250,260,280
C
C     COPY
C
250   TRANS=4
      MODEI=1-MIN0(1,OUFILE+OPTL)
      IF (ICOMD.EQ.0) MODEI=0
      GO TO 390
C
C     NAME
C
260   TRANS=5
      IF (NRWORK.EQ.0) PHASE=4
      GO TO 390
C
C     SKIP
C
270   TRANS=4
      GO TO 390
C
C     UPDATE
C
280   TRANS=5
      MODEI=0
      GO TO 390
C
C     ERROR MESSAGES
C
290   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      EQUAL=ISTAT
      GO TO 380
300   NUMBER=4
C     MESSAGE 4 - INTAPE NOT DEFINED.
      GO TO 380
310   NUMBER=5
C     MESSAGE 5 - UNABLE TO OPEN INTAPE.
      EQUAL=ISTAT
      GO TO 380
320   NUMBER=6
C     MESSAGE 6 - UNABLE TO OPEN OUTAPE.
      EQUAL=ISTAT
      GO TO 380
330   NUMBER=7
C     MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE.
      GO TO 380
340   NUMBER=8
C     MESSAGE 8 - DATE NOT SUPPLIED.
      GO TO 380
350   NUMBER=9
C     MESSAGE 9 - SITE NOT SUPPLIED.
      GO TO 380
360   NUMBER=10
C     MESSAGE 10 - INTAPE = OUTAPE.
      GO TO 380
370   NUMBER=11
C     MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED.
380   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM
C
390   RETURN
C
      END
      SUBROUTINE EXCHRH (ISTAT,DBLOCK)
C
C     READ THE HEADER LABEL FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE
C               NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     OPEN THE INPUT TAPE.
C
      ISTAT=1
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     READ A BLOCK.
C
      NDATAI=171
      NERRCI=0
      BLKSQI=0
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     FIND OUT IF IT IS A PROPER LABEL.
C
      CALL EXCHUN (DBLOCK,CBLCKI)
      DO 10 I=1,8
      IF (CBLCKI(I).NE.ID(I)) GO TO 20
10    CONTINUE
C
C     GET READY TO READ THE REST OF THE TAPE.
C
      CCDBI=NCDBI
      NDATAI=256*CBLCKI(9)+CBLCKI(10)
      NERRCI=256*CBLCKI(11)+CBLCKI(12)
      LASTI=0
      L1PRGI=0
      ISTAT=0
      GO TO 30
C
C     NOT A LABEL.
C
20    ISTAT=6
C
C     CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK.
25    I=4
      CALL EXCHRT (I,DBLOCK)
C
30    RETURN
C
      END
      SUBROUTINE EXCHWH (ISTAT,DBLOCK)
C
C     WRITE A HEADER ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE
C               WRITTEN ARE NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     MAKE SURE IT IS A PROPER LABEL.
C
      DO 10 I=1,8
      IF (CBLCKO(I).NE.ID(I)) GO TO 30
10    CONTINUE
C
C     OPEN THE OUTPUT TAPE.
C
      ISTAT=1
      CALL EXCHWT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 40
C
C     CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR
C     CONTROL CHARACTERS
C
      CBLCKO(9)=NDATAO/256
      CBLCKO(10)=MOD(NDATAO,256)
      CBLCKO(11)=NERRCO/256
      CBLCKO(12)=MOD(NERRCO,256)
C
C     INSERT TODAYS DATE
C
      DO 20 I=1,6
20    CBLCKO(I+12)=TODAY(I)
C
C     WRITE THE BLOCK ON TAPE.
C
      BLKSQO=0
      CALL EXCHPA (CBLCKO,DBLOCK)
      CCDBO=180
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     GET READY TO WRITE THE REST OF THE FILE.
C
      L1PRGO=0
      LLPRGO=0
      N1RECO=0
      NLRECO=0
      L1RECO=0
      LASTO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      GO TO 40
C
C     NOT A PROPER LABEL.
C
30    ISTAT=6
C
40    RETURN
C
      END
      SUBROUTINE EXCHC4 (IBLOCK)
      INTEGER IBLOCK(1)
C
C     PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM
C     COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KCOPY /3/
C
C     ARE WE STARTING OR CONTINUING?
C
C     ICOMD.EQ.0  MEANS  CHANGE A CONTROL RECORD
C     ICOMD.GT.0  MEANS  SKIP OR COPY COMMAND BEGIN
C     ICOMD.EQ.-1 MEANS  CONTINUE COPY = NUMBERS
C     ICOMD.EQ.-2 MEANS  CONTINUE COPY = PREDICATE EXPRESSION
      NEWP=0
      IF (ITYPEI.EQ.80) VERT=0
C     80 = ASCII P.  WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO
C     IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON
C     THE WORK FILE.
      IF (ICOMD.EQ.0) GO TO 190
C     ICOMD=0 MEANS CHANGING A CONTROL RECORD.
      IF (ICOMD+1) 290,170,10
10    IF (ICOMD.EQ.KCOPY) GO TO 30
C
C     SKIP COMMAND.
C
      IF (INTOPN.LT.0) GO TO 430
      if (modify.eq.70) number=number+n1reci-1
c     70 = ASCII F.
      IF (NUMBER+1-N1RECI) 540,430,20
20    CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.EQ.69) GO TO 460
C     69 = ASCII E.
      IF (N1RECI-NUMBER) 20,20,430
C
C     COPY COMMAND FORMAT VERIFICATION.
C
30    IF (COMAND(EQUAL).LT.48) GO TO 180
C     48 = ASCII ZERO
      IF (COMAND(EQUAL).GT.57) GO TO 180
C     57 = ASCII NINE
C
C     COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS.
C     CONVERT THE NUMBERS AND STORE THEM IN COMAND.  IF THE NUMBER
C     IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER.
C
      ICOMD=-1
      I=0
      J=44
C     44 = ASCII COMMA
40    I=I+1
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 480
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=NUMBER
50    EQUAL=EQUAL+1
      IF (EQUAL.GT.NCHCMD) GO TO 60
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 60
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=10*COMAND(I)+NUMBER
      GO TO 50
60    IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70
70    IF (J.EQ.45) COMAND(I)=-COMAND(I)
C     45 = ASCII DASH
      IF (EQUAL.GT.NCHCMD) GO TO 90
      J=COMAND(EQUAL)
      IF (J.EQ.32 .OR. J.EQ.46) GO TO 90
C     32 = ASCII BLANK, 46 = ASCII PERIOD.
      IF (J.NE.44.AND.J.NE.45) GO TO 480
C     44 = ASCII COMMA, 45 = ASCII DASH
80    EQUAL=EQUAL+1
      IF (COMAND(EQUAL)-32) 40,80,40
C     32 = ASCII BLANK
90    NUMBER=I
C     FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE
C     POSITION IN COMAND CURRENTLY BEING EXAMINED.
      EQUAL=-1
100   EQUAL=EQUAL+1
      IF (EQUAL.GE.NUMBER) GO TO 470
      IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100
      IF (EQUAL.EQ.0) GO TO 120
      WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD)
110   FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H)
     1NOT COPIED./(1X,80A1))
      NERRG=MAX0(NERRG,5)
120   IF (COMAND(EQUAL+1).GT.0) GO TO 130
      EQUAL=EQUAL-1
      COMAND(EQUAL+1)=N1RECI
130   IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
C
C     PROCESS COPY = LIST OF NUMBERS
C
140   EQUAL=EQUAL+1
C     GO COPY THE PROGRAM IF IT IS THE RIGHT ONE.
150   IF (INTOPN.LT.0) GO TO 430
      IF (COMAND(EQUAL)-N1RECI) 170,420,160
C     SKIP TO DESIRED PROGRAM
160   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI-69) 150,460,150
C     69 = ASCII E
170   IF (EQUAL.GE.NUMBER) GO TO 430
      IF (COMAND(EQUAL+1).GE.0) GO TO 140
      COMAND(EQUAL)=IABS(COMAND(EQUAL))+1
      IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420
      EQUAL=EQUAL+1
      GO TO 170
C
C     COPY = SELECTION STRING OR CHANGE CONTROL RECORD.
C
180   ICOMD=-2
      IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
      NRWORK=-1
C
C     DETERMINE NEED TO OPEN WORK FILE.
C
190   IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0)
     1IF (ICOMD) 290,430,290
      IF (WORKF.EQ.0) GO TO 500
      I=IABS(WORKF)
      IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510
      IF (WORKF.GT.0) GO TO 200
      WORKF=I
      CALL EXCHFO (3)
200   IF (ICOMD.NE.0) GO TO 280
C
C     CHANGE CONTROL RECORD.
C
      if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520
c     69 = ascii E, 73 = ascii I.
      if (nrwork.eq.0) go to 210
      if (itypei.eq.80) go to 520
c     80 = ascii P
210   IF (NUMBER-NRWORK-1) 530,220,410
220   NCHACT=NCHCMD+1-EQUAL
      IF (NCHACT.GT.0) GO TO 230
      NCHACT=1
      INTREC(1)=32
C     32 = ASCII BLANK
      GO TO 425
230   DO 240 I=1,NCHACT
240   INTREC(I)=COMAND(EQUAL+I-1)
      GO TO 425
C
C     COPY = SELECTION EXPRESSION.
C
C     SKIP TO NEXT PROGRAM.
250   IF (INTOPN.LT.0) GO TO 430
      if (itypei.eq.69) go to 460
c     69 = ASCII E.
      do 260 i = 1, 8
260   pred(2,i)=0
      if (itypei.ne.80) go to 265
c     If the current record is a new program, don't skip it (we haven't
c     processed it yet).
      if (nrwork.gt.0 .and. workf.gt.0) rewind workf
      nrwork=min0(nrwork,0)
      newp=0
      go to 320
265   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      nxnewp=0
270   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.NE.80) GO TO 310
C     80 = ASCII P
      NEWP=nxnewp
c     Set NEWP non-zero when all control records for a module have been
c     seen.
      GO TO 320
280   NRWORK=MAX0(NRWORK,0)
290   DO 300 I=1,8
300   PRED(2,I)=0
c     NEWP is non-zero when all control records have been read.
310   if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1
C     69 = ASCII E, 73 = ASCII I.
320   nxnewp=1
      if (icomd.eq.0) if (newp) 520,210,520
      IF (LIMIT.EQ.0) GO TO 340
      IF (N1RECI.LE.LIMIT) GO TO 340
      WRITE (PRINTR,330) LIMIT
330   FORMAT (7H LIMIT=,I6,9H REACHED.)
      GO TO 430
340   IF (NEWP.EQ.0) GO TO 360
      CALL EXCHLX
C     EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'.
      NUMBER=NCHCMD
      IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415
C     73 = ASCII I.
      IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425
C     80 = ASCII P.
      IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425
C     83 = ASCII S.
      IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415
C     88 = ASCII X.
      IF (COMAND(180)) 450,250,420
C     CONTROL RECORD.  EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE.
360   I=1
      DO 400 NUMBER=1,8
      IF (PRED(1,NUMBER).EQ.0) GO TO 400
      IF (PRED(2,NUMBER).NE.0) GO TO 400
      IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390
      NM=PRED(1,NUMBER)-3
      IF (.NOT.(NCHACT.GT.0)) GO TO 390
      DO 385 L = 1, NCHACT
      DO 380 J = 1, NM
C
C     DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND
C     IN PREDICATE.
      IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380
      IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370
C
C     NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS.
      K=32
      GO TO 375
C     USE CHARACTER FROM CONTROL RECORD.
370   K=INTREC(J+L-1)
C
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (K.GT.96 .AND. K.LT.123) K=K-32
C
C     TEST FOR A MATCH ON A SINGLE CHARACTER.
C     IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE
C     PATTERN.  IF THE SEARCH MODE IS X, TERMINATE THE SEARCH.
375   IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390
380   CONTINUE
C
C     FOUND A MATCH IN CONTROL RECORD AND PREDICATE.
      PRED(2,NUMBER)=1
      GO TO 400
385   CONTINUE
390   I=0
400   CONTINUE
      IF (I.NE.0) newp=1
      IF (NRWORK.LT.0) GO TO 270
C     AT LEAST ONE FALSE PREDICATE.  WRITE THE CONTROL RECORD ON WORKF.
410   WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT)
      NRWORK=NRWORK+1
      GO TO 270
C
C     GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM.
C
415   ICOMD=-3
C     RETURN TO EXCHC1 AFTER COPYING MODULE.
420   TRANS=5
      GO TO 570
C
C     RETURN TO THE COMMAND PROCESSOR.
C
425   TRANS=1
C     REMEMBER CONTROL RECORDS ON WORKF.
      GO TO 570
430   TRANS=1
      IF (ICOMD+1) 560,570,570
C
C     ERROR MESSAGES.
C
440   NUMBER=1
C     MESSAGE 1 - I/O ERROR.
      EQUAL=ISTAT
      GO TO 550
450   NUMBER=-COMAND(180)
C     MESSAGES GENERATED BY EXCHLX
      GO TO 550
460   IF (INTOPN.LT.0) GO TO 430
      INTOPN=-1
      EQUAL=NUMBER
      NUMBER=15
C     MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE.
      GO TO 550
470   NUMBER=16
C     MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION.
      GO TO 550
480   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER
      GO TO 550
490   NUMBER=18
C     MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER.
      GO TO 550
500   NUMBER=19
C     MESSAGE 19 - WORK FILE NOT DEFINED.
      GO TO 550
510   NUMBER=20
C     MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE.
      GO TO 550
520   EQUAL=NUMBER
      NUMBER=21
C     MESSAGE 21 - CONTROL RECORD NOT PRESENT
      GO TO 550
530   NUMBER=22
C     MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER.
      GO TO 550
540   NUMBER=29
C     MESSAGE 29 - BACKWARD SKIP IGNORED.
C
C     RETURN TO THE ERROR MESSAGE PROCESSOR.
C
550   TRANS=8
      IF (ICOMD.EQ.0) GO TO 570
C
C     DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF.
C
560   IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
C
C     RETURN TO TRANSITION PROGRAM.
C
570   RETURN
C
      END
      SUBROUTINE EXCHLX
C
C     EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND.
C
C     THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE
C     STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM
C     COPY=LOGICAL EXPRESSION.  THE LOGICAL EXPRESSION CONSISTS OF THE
C     EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY
C     OPERATORS + - * / AND PARENEHESES.  THE PRIMARY SYMBOLS A-H ARE
C     LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE
C     STATEMENTS.  THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE
C     NULL PREDICATE, WHICH IS ALWAYS FALSE.  THE OPERATORS + - * / ARE
C     THE BINARY LOGICAL OPERATIONS   OR, OR NOT, AND, AND NOT
C     RESPECTIVELY.  THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE
C     PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL
C     PRIORITY.  THE RELATIVE PRIORITY MAY BE CHANGED BY USING
C     PARENTHESES.
C
C     WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY
C     FALSE.  AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL
C     FALSE PREDICATES IS DETERMINED.  ONCE TRUE, A PREDICATE REMAINS
C     TRUE.  THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND
C     A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE.  WHEN ALL ACTIVE
C     PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM
C     HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND
C     IS EVALUATED.  IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED.
C     IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED.  THIS PROCESS
C     CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM
C     NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED.
C
C     THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE
C     TABLE BELOW.  INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS
C     APPENDED TO THE END OF THE LOGICAL EXPRESSION.
C
C     PREVIOUS  I                 CURRENT TOKEN                   I
C      TOKEN    I + - * / I PRIMARY I    (    I    )    I  ELSE   I
C     ----------I---------I---------I---------I---------I---------I
C      + - * /  I  ERROR  I   OK    I   OK    I  ERROR  I  ERROR  I
C      PRIMARY  I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C         (     I  ERROR  I   OK    I   OK    I   OK    I  ERROR  I
C         )     I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C     ----------I---------I---------I---------I---------I---------I
C
C     CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING
C     A STACK AND THE PRECEDENCE TABLE BELOW.  TOS MEANS TOP-OF-STACK,
C     HOI MEANS HEAD-OF-INPUT.  THE STACK INITIALLY CONTAINS (.
C
C                  TOS       HOI
C      TOKEN   I  INDEX  I  INDEX  I
C     ---------I---------I---------I
C       + -    I    2    I    1    I
C       * /    I    4    I    3    I
C     PRIMARY  I    6    I    5    I
C        (     I    0    I    7    I
C        )     I   N/A   I    0    I
C     ---------I---------I---------I
C
C     WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS
C     PUSHED ONTO THE STACK.  WHEN THE TOS INDEX IS GREATER THAN THE HOI
C     INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY
C     SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT
C     PLACED IN THE SUFFIX LIST.  THEN THE RELATION OF THE TOS INDEX TO
C     THE HOI INDEX IS RE-EXAMINED.  WHEN THE TOS INDEX IS EQUAL TO THE
C     HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED.
C
C     *****     INTERNAL VARIABLES     *********************************
C
C CHTAB   RECOGNIZED CHARACTERS.  INTERNAL PROCESSES USE THE INDEX
C         INTO CHTAB.
C COLTAB  CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX.
C HOI     CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE.
C INFIX   IS THE CURRENT POSITION IN THE INFIX.
C IPREV   IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN.
C ISTACK  IS THE CURRENT STACK INDEX.
C ISUFIX  IS THE CURRENT SUFFIX INDEX.
C SYNTAX  CONTAINS THE SYNTAX RULES.
C TOS     CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE.
C
      INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     DATA STATEMENTS     ************************************
C
C                                                    A  B  C  D
      DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/
C                                                    E  F  G  H
      DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/
C                                                    N  +  -  *
      DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/
C                                                    /  (  )
      DATA CHTAB(13),CHTAB(14),CHTAB(15)           /47,40,41   /
C                                                       A B C D
      DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/
C                                                       E F G H
      DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/
C                                                       N + - *
      DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/
C                                                       / ( )
      DATA COLTAB(13),COLTAB(14),COLTAB(15)            /1,3,4  /
C                                                   A B C D E
      DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/
C                                                   F G H N +
      DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/
C                                                   - * / ( )
      DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/
C                 CURRENT TOKEN IS +-*/.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/
C                 CURRENT TOKEN IS PRIM.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/
C                 CURRENT TOKEN IS (.     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/
C                 CURRENT TOKEN IS ).     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/
C                                                   A B C D E
      DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/
C                                                   F G H N +
      DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/
C                                                   - * / ( )
      DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/
C
C     *****     PROCEDURES     *****************************************
C
C     COMAND IS USED FOR INFIX, STACK AND SUFFIX.  UPON COMPLETION,
C     COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE
C     OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE
C     EXPRESSION IS TRUE.
C
      ISTACK=NCHCMD+2
      COMAND(ISTACK)=14
      ISUFIX=181
      IPREV=3
      COMAND(NCHCMD+1)=41
      INFIX=EQUAL-1
C
C     GET A CHARACTER FROM INFIX.  LOOK UP IN CHTAB.  CHECK SYNTAX.
C
10    IF (INFIX.GT.NCHCMD) GO TO 180
      INFIX=INFIX+1
      J=COMAND(INFIX)
      IF (J.EQ.32) GO TO 10
C     32 = ASCII BLANK - IGNORE IT.
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      DO 20 I=1,15
      IF (CHTAB(I).EQ.J) GO TO 30
20    CONTINUE
      GO TO 230
30    J=COLTAB(I)
      IF (SYNTAX(IPREV,J)-1) 40,190,200
C
C     CONVERT INFIX TO SUFFIX
C
40    IPREV=J
50    J=COMAND(ISTACK)
      IF (TOS(J)-HOI(I)) 60,70,80
C     PUSH INFIX ONTO STACK
60    ISTACK=ISTACK+1
      COMAND(ISTACK)=I
      GO TO 10
C     DELETE TOP OF STACK
70    ISTACK=ISTACK-1
      IF (ISTACK.GT.NCHCMD+1) GO TO 10
      IF (INFIX-NCHCMD) 220,220,250
C     IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX.
C     IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX.
80    IF (J-9) 90,100,130
C     PRIMARY IS SYMBOL A-H
90    IF (PRED(1,J).EQ.0) GO TO 210
      J=PRED(2,J)
      GO TO 110
C     NULL PREDICATE
100   J=0
110   ISUFIX=ISUFIX-1
120   COMAND(ISUFIX)=J
      ISTACK=ISTACK-1
      GO TO 50
C     OPERATOR
130   J=J-9
      ISUFIX=ISUFIX+1
      GO TO (140,150,160,170), J
C             +   -   *   /
140   J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1)
      GO TO 120
150   J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1)
      GO TO 120
160   J=COMAND(ISUFIX)*COMAND(ISUFIX-1)
      GO TO 120
170   J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1))
      GO TO 120
C
180   COMAND(180)=-23
C     MESSAGE 23 - TOO MANY (
      GO TO 240
190   COMAND(180)=-24
C     MESSAGE 24 - MISSING PRIMARY
      GO TO 240
200   COMAND(180)=-25
C     MESSAGE 25 - MISSING OPERATOR
      GO TO 240
210   EQUAL=CHTAB(J)
      CALL EXCHAH (EQUAL,1)
      COMAND(180)=-26
C     MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE.
      GO TO 250
220   COMAND(180)=-27
C     MESSAGE 27 - TOO MANY )
      GO TO 240
230   COMAND(180)=-28
C     MESSAGE 28 - UNRECOGNIZED CHARACTER
C
240   EQUAL=INFIX
250   RETURN
C
      END
      SUBROUTINE EXCHC5 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE,
C     AND INDEX IF SELECTED.  COPY RECORDS FROM WORKF FIRST, IF ANY.
C     CREATE CONTROL RECORDS DEMANDED BY COMMANDS.
C
C     THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF
C     THE PARAMETER STRING.
C
C     AUTHOR
C     COMMENT
C     CONTROL (ITYPEO SET FROM MODIFY)
C     DATA TYPE
C     GROUPS
C     INSERT
C     KEYWORDS
C     MACHINE
C     ORIGIN
C     REFERENCES
C     REMOVE   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     SIGNAL   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     UPDATE
C
C     IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS
C     ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A
C     CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND.
C
C     *****     LOCAL VARIABLES     ************************************
C
C BLANK   CONTAINS A HOLLERITH BLANK.
      INTEGER BLANK
C C1      IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING.
      INTEGER C1
C COL1    THE FIRST COLUMN OF TEXT OF A CONTROL RECORD.  DERIVED FROM
C         EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE.
      INTEGER COL1
C I,J     USED FREELY AS INDICES.
      INTEGER I,J
C KCONT   THE INDEX IN COMD OF THE CONTROL COMMAND.
      INTEGER KCONT
C KNAME   IS THE INDEX IN COMD OF THE NAME COMMAND.
      INTEGER KNAME
C KTEXT   THE INDEX IN COMD OF THE TEXT COMMAND.
      INTEGER KTEXT
C KUPDA   THE INDEX IN COMD OF THE UPDATE COMMAND.
      INTEGER KUPDA
C LIST    CONTAINS THE WORD LIST IN ASCII.  USED FOR THE A OPTION.
      INTEGER LIST(4)
C NM      IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NM
C NOUT    IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NOUT
C NY      IS THE PROGRAM NUMBER.  IT IS THE NUMBER FROM INTAPE IF
C         OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE.
      INTEGER NY
C ONE     CONTAINS A HOLLERITH 1.
      INTEGER ONE
C REASON  REASON FOR COPYING A CONTROL RECORD.  1 = COPY COMMAND
C         PENDING.  2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8.
C         3 = COMMAND.
      INTEGER REASON
C RI      CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A
C         GIVEN RECORD TYPE.  RI IS SUBSCRIPTED BY (ITYPEO-64).
      INTEGER RI(26)
C RT      IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT.
      INTEGER RT(34)
C STAR    CONTAINS A HOLLERITH STAR.
      INTEGER STAR
C ZERO    CONTAINS A HOLLERITH ZERO.
      INTEGER ZERO
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL VARIABLE DATA     ********************************
C
      DATA BLANK /1H /
C                                            L  I  S  T
      DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/
C
      DATA KCONT /31/
      DATA KNAME /9/
      DATA KTEXT /27/
      DATA KUPDA/29/
      DATA ONE /1H1/
C                                                      A  B  C  D  E  F
      DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/
C                                                      G  H  I  J  K  L
      DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/
C                                                      M  N  O  P  Q  R
      DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/
C                                                      S  T  U  V  W  X
      DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/
C                                                      Y  Z
      DATA RI(25),RI(26)                             /31,31            /
C                                                     A  C     D     G
      DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/
C                                                           P     K
      DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/
C                                                     M     O
      DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/
C                                                              B  R
      DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/
C                                                                 S
      DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/
C                                                              J
      DATA RT(31),RT(32),RT(33),RT(34)              /-1, 0, 0,74/
C
      DATA STAR /1H*/
      DATA ZERO /1H0/
C
C     *****     PROCEDURES     *****************************************
C
      REASON=1
      NY=N1RECI
      IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1
C     ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P.
C     IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT.
      IF (PHASE.EQ.4) NY=0
C     NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER.  (IT IS PRINTED
C     IN THE INDEX).
      IF (ICOMD.LE.0) GO TO 10
      IF (PHASE.GE.4) GO TO 100
      IF (ICOMD.EQ.KNAME) GO TO 10
      IF (ICOMD.NE.KUPDA) GO TO 100
      REASON=2
      PHASE=8
10    IF (NRWORK.GT.0) REWIND WORKF
      NM=0
      NOUT=0
20    NM=NM+1
      IF (NM.LE.NRWORK) GO TO 60
30    IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230
C     69 = ASCII E, 73 = ASCII I.
      IF (NOUT.EQ.0) GO TO 40
      IF (ITYPEI.EQ.80) GO TO 230
C     80 = ASCII P.
      IF (NCHACT.NE.1) GO TO 40
      IF (INTREC(1).EQ.32) GO TO 220
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
40    ITYPEO=ITYPEI
      NCHOUT=NCHACT
      DO 50 J=1,NCHOUT
50    OUTREC(J+5)=INTREC(J)
      GO TO 70
60    READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT)
      IF (NCHOUT.NE.1) GO TO 70
      IF (NM.EQ.1) GO TO 70
      IF (OUTREC(6).EQ.32) GO TO 200
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
70    NOUT=NOUT+1
      J=RI(ITYPEO-64)
      DO 80 I=1,4
80    OUTREC(I)=COMD(I,J)
      OUTREC(5)=61
C     61 = ASCII =
      COL1=5
      IF (J.NE.KCONT) GO TO 130
      COL1=7
C     CONTROL,*=...  MOVE UP TWO CHARACTERS AND INSERT ITYPEO.
      DO 90 I=1,NCHOUT
90    OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I)
      OUTREC(5)=44
C     44 = ASCII COMMA.
      OUTREC(6)=ITYPEO
      OUTREC(7)=61
C     61 = ASCII =
      GO TO 130
100   IF (ICOMD.EQ.KTEXT) GO TO 240
      COL1=EQUAL-1
      NCHOUT=NCHCMD-COL1
      NRWORK=NRWORK+1
C     NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD.
      ITYPEO=RT(ICOMD)
      IF (ITYPEO.GT.0) GO TO 110
C     PROCESS CONTROL,TYPE=TEXT COMMAND.
      ITYPEO=MODIFY
      IF (RI(ITYPEO-64).NE.KCONT) GO TO 320
110   NOUT=NRWORK
      REASON=3
      DO 120 I=1,NCHCMD
120   OUTREC(I)=COMAND(I)
130   IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1)
C     74 = ASCII J.
      IF (ITYPEO.EQ.80) VERT=0
C     80 = ASCII P
      IF (ITYPEO.NE.68) GO TO 150
C     68 = ASCII D
      IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150
      DO 140 J=1,4
      I=OUTREC(J+COL1)
      IF (I.GT.96 .AND. I.LT.123) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.NE.LIST(J)) GO TO 150
140   CONTINUE
      VERT=1
C     GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE.
150   CALL EXCHCG (OUTREC(COL1+1))
      IF (OUTOPN.EQ.0) GO TO 160
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1))
      IF (ISTAT.NE.0) GO TO 340
      NY=NLRECO
160   NCHOUT=NCHOUT+COL1
C     TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER.
      OUTREC(180)=-NOUT
      IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC)
C     PRINT THE INDEX IF SELECTED.
      IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO
     1190
      IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190
      C1=BLANK
C     DOUBLE SKIP FOR PROGRAM HEADER (P).
      IF (ITYPEO.EQ.80) C1=ZERO
      IF (OPTV+VERT.NE.0) GO TO 170
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170
      IF (CHAR1L.NE.ONE) C1=ONE
      CHAR1L=ONE
170   CALL EXCHAH (OUTREC,NCHOUT)
      WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT)
180   FORMAT (A1,2I5,1H*,(3X,105A1))
190   IF (REASON.EQ.3) GO TO 310
200   IF (NM-NRWORK) 20,210,220
210   REWIND WORKF
      NRWORK=0
      GO TO 30
220   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT) 330,30,330
230   IF (REASON.EQ.2) GO TO 300
240   IF (OUFILE.EQ.0) GO TO 260
      DO 250 I=1,4
250   OUTREC(I)=COMD(I,KTEXT)
      OUTREC(180)=0
      NCHOUT=0
C     TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED.
      CALL EXCHCG (OUTREC)
      NCHOUT=4
      ACTION=2-OPTC-OPTC
C     ACTION = 2 MEANS START OF PROGRAM.
      CALL EXCHOU (OUTREC)
260   IF (OPTV+VERT.NE.0) GO TO 280
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280
      IF (OUTOPN.NE.0) NY=NLRECO
      I=BLANK
      IF (CHAR1L.NE.ONE) I=ONE
      WRITE (PRINTR,270) I,NY
270   FORMAT (A1,I5,1H*,8X,4HTEXT/)
280   CHAR1L=STAR
      NRWORK=MIN0(NRWORK,0)
      IF (IDOPTN.NE.67) IDCUR=IDSTRT
C     67 = ASCII C
      IF (ICOMD.EQ.KTEXT) GO TO 290
C
C     WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL
C     RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED.
C
      TRANS=6
      GO TO 370
C
C     WORKING ON A TEXT STATEMENT.
C
290   TRANS=7
      GO TO 370
C
C     WORKING ON AN UPDATE STATMENT.
C
300   NRWORK=NOUT
      GO TO 100
C
C     WRITING A SINGLE CONTROL RECORD.
C
310   TRANS=1
      GO TO 370
C
C     ERROR MESSAGES.
C
320   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER.
      GO TO 360
330   NUMBER=1
      GO TO 350
340   NUMBER=2
350   EQUAL=ISTAT
360   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM.
C
370   RETURN
C
      END
      SUBROUTINE EXCHCG (RECORD)
C
C     USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL.
C     WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED.
C     THIS IS THE PORTABLE VERSION.  IT DOES NOT DO ANYTHING.
C
      INTEGER RECORD(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      RETURN
      END
      SUBROUTINE EXCHC6 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE.
C
      INTEGER KNAME,ONE,SVHCMD(180)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KNAME /9/
      DATA ONE /1H1/
C
      LINEO=0
      NERRS=0
C     SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT.
      DO 5 I = 1,NCHCMD
5     SVHCMD(I)=HOLCMD(I)
      IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165
C     73 = ASCII I.  IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE
C     A VOID MODULE.
      IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10
      CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.EQ.7) GO TO 220
      IF (ISTAT) 250,160,250
10    MODEO=MODEI
      ITYPEO=0
      NBC=OPTL+OUFILE
      IF (INDEX.GT.0) NBC=1
20    NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTOPN.EQ.0) GO TO 120
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 260
C
C     CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD
C     INSTEAD OF BYTE-BY-BYTE).  WE CAN DO A BLOCK COPY IF
C     WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT
C     FILE AND NOT PRINTING THE INDEX.  ALSO, THE INPUT AND
C     OUTPUT CHARACTER POSITIONS MUST BE THE SAME.  IF THE
C     PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH
C     THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE
C     CURRENT POSITION IN THE BYTE BUFFER BE THE SAME.
C     WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE
C     LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T
C     KNOW THE LOCATION OF THE END-OF-FILE RECORD.
C
      IF (NBC.NE.0) GO TO 120
      IF (CPCBI+1.NE.CPCBO) GO TO 120
      IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120
C     WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF.
      IF (L1PRGI.EQ.0) GO TO 25
      IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30
25    IF (CCDBI+1.NE.CCDBO) GO TO 120
      IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120
C     WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE).
C     FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO.
30    LI=L1PRGI+NERRCI-1
      IF (L1PRGI.NE.0) GO TO 40
      LI=NERRCI+NDATAI+9
      IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1
40    IF (CPCBI.GE.NCCBI) GO TO 50
      IF (CCDBI.GE.LI) GO TO 160
      CPCBI=CPCBI+1
      CBLCKO(CPCBO)=CBLCKI(CPCBI)
      CPCBO=CPCBO+1
      CCDBI=CCDBI+1
      CCDBO=CCDBO+1
      GO TO 40
C     PACK COPIED BYTES.
50    CALL EXCHPA (CBLCKO,OBLOCK(CWDBO))
      CPCBO=1
      CPCBI=0
      CWDBO=CWDBO+NWCBO
      CWDBI=CWDBI+NWCBI
C     NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM
60    IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70
      IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=L1RECI
      CALL EXCHPB (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 260
70    IF (CCDBI.LT.LI) GO TO 80
      IF (L1PRGI.NE.0) GO TO 100
      CALL EXCHGB (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 250
      GO TO 30
80    NW=NWCBI*((LI-CCDBI)/NCCBI)
      IF (NW.EQ.0) GO TO 100
      DO 90 I=1,NW
      OBLOCK(CWDBO)=IBLOCK(CWDBI)
      CWDBO=CWDBO+1
90    CWDBI=CWDBI+1
100   CCDBO=CCDBO+LI-CCDBI
      CCDBI=LI
      IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60
      CPCBI=MOD(LI,NCCBI)
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      CALL EXCHUN (IBLOCK(CWDBI),CBLCKI)
      IF (CPCBI.EQ.0) GO TO 160
      DO 110 I=1,CPCBI
110   CBLCKO(I)=CBLCKI(I)
      GO TO 160
C
C     END OF BLOCK COPY CODE.
C
120   CALL EXCHTP (INTREC,LINEO)
160   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 250
      IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20
C     73 = ASCII I.
165   IF (OPTL.NE.0) GO TO 180
      IF (INDEX.LE.0) GO TO 195
      WRITE (PRINTR,170) LINEO
170   FORMAT (I9,14H IMAGES COPIED)
      GO TO 200
180   WRITE (PRINTR,190)
190   FORMAT (1H1)
195   CHAR1L=ONE
200   IF (OUFILE.EQ.0) GO TO 210
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
210   IF (ITYPEI.EQ.69) GO TO 220
C     69 = ASCII E
C
C     RETURN TO THE COPY CONTROL SEGMENT.
C
      DO 215 I=1,NCHCMD
215   HOLCMD(I)=SVHCMD(I)
      IF (ICOMD.EQ.-3) GO TO 240
C     ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE.
      TRANS=4
      IF (ICOMD.NE.KNAME) GO TO 280
C     MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME'
C     COMMAND SUBMITTED.  GO PROCESS 'NAME' COMMAND.
      TRANS=5
      PHASE=4
      GO TO 280
C
C     END OF FILE ON INPUT TAPE.
C
220   IF (INTOPN.LT.0) GO TO 240
      WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD)
230   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1))
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
240   TRANS=1
      GO TO 280
C
C     ERROR MESSAGES.
C
250   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      GO TO 270
260   NUMBER=2
C     MESSAGE 2 - I/O ERROR WRITING OUTAPE.
270   TRANS=8
      EQUAL=ISTAT
C
C     RETURN TO THE TRANSITION PROGRAM.
C
280   IF (NERRS.EQ.0) GO TO 300
      WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD)
290   FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./
     1(1X,80A1))
      NERRG=MAX0(NERRS,NERRG)
300   RETURN
C
      END
      SUBROUTINE EXCHC7 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
      INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40)
C
C     PROCESS THE TEXT COMMAND.
C
C MSG     IS USED TO PRINT A MESSAGE.
      INTEGER MSG(6,2)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/
      DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/
      DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/
      DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/
      DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/
C
      LINEI=1
      LINEO=0
      NERRS=0
      INEND=0
      CHAR1L=STAR
C
C     SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND
C
      K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 20 I=1,40
      IF (K.GT.NCHCMD) GO TO 10
      J=COMAND(K)
      K=K+1
      GO TO 20
10    J=32
C     32 = ASCII BLANK.
20    TXDISK(I)=J
      IF (INTOPN.LE.0) ITYPEI=0
C
C     MAIN PROCESSING LOOP
C
60    EDIT=0
70    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 80
C     NCHCMD.LT.0 MEANS END OF FILE.
      IF (NCHCMD.LT.2) GO TO 100
      IF (COMAND(1).NE.SIGNAL) GO TO 100
      IF (COMAND(2).EQ.SIGNAL) GO TO 80
      IF (COMAND(2).EQ.73) GO TO 370
      IF (COMAND(2).EQ.105) GO TO 370
C     73,105 = ASCII I - REQUEST TO INCLUDE TEXT.
      IF (NCHCMD.LT.3) GO TO 100
      IF (COMAND(2).NE.61) GO TO 100
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 70
C     END OF TEXT FILE.
80    IF (INTEXT.EQ.0) GO TO 90
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      CALL EXCHIM
      INTEXT=0
      NCHCMD=0
90    NCHCMD=MIN0(NCHCMD,0)
      IF (PHASE.NE.8) GO TO 660
      IF (INEND) 660,630,660
100   IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110
110   IF (EDIT.EQ.0) GO TO 450
C
C     PARTIAL LINE EDITOR.
C     INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED.
C     EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES
C     THE FIRST NON-BLANK CHARACTER AFTER N2.  N1 AND N2 ARE COLUMN
C     LIMITS UNDER WHICH TO PERFORM THE EDITING.  N1 AND ,N2 ARE
C     OPTIONAL.  IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT
C     LIMIT.  IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS
C     ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE.  WHEN
C     STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING
C     PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT
C     LENGTHS OF STRING1 AND STRING2.  THE THIRD DELIMITER IS
C     OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED
C     AFTER STRING2 IS INSERTED.
C
      IF (INEND.NE.0) GO TO 240
C     CONVERT COLUMN NUMBERS.
      NBR1=0
      NBR2=0
      I=0
120   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.EQ.44) GO TO 150
C     44 = ASCII COMMA
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR1=10*NBR1+J-48
      GO TO 120
130   WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD)
140   FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/
     1(1X,80A1))
      NERRS=2
      GO TO 70
150   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR2=10*NBR2+J-48
      GO TO 150
C     SCAN FOR DELIMITER
160   IF (J.NE.32) GO TO 170
C     32 = ASCII BLANK
      I=I+1
      J=COMAND(I)
      GO TO 160
170   D1=I
      NBR1=MIN0(NBR1,180)
      NBR2=MIN0(NBR2,180)
      IF (NBR1.EQ.0) NBR1=1
      IF (NBR2.EQ.0) GO TO 180
      IF (NBR2.LT.NBR1) GO TO 130
180   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      IF (COMAND(I).NE.J) GO TO 180
      D2=I
      D3=0
190   I=I+1
      IF (I.GT.NCHCMD) GO TO 200
      IF (COMAND(I).NE.J) GO TO 190
      D3=I
C     LOOK FOR SEARCH STRING (STRING1)
200   NUMBER=D2-D1-1
      J=NBR1
      IF (NUMBER.EQ.0) GO TO 260
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
210   DO 220 I=1,NUMBER
      IF (I+J-1.GT.NY) GO TO 240
      IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230
220   CONTINUE
      GO TO 260
230   J=J+1
      GO TO 210
240   WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1))
      NERRS=2
      GO TO 70
C     FOUND SEARCH STRING.  REPLACE WITH UPDATE STRING.
260   CHAR1L=PLUS
      IF (D3.NE.0) GO TO 300
C     NO THIRD DELIMITER.   REPLACE REST OF REGION.
      NY=NBR2
      IF (NY.EQ.0) NY=180
      D2=D2+1
      IF (D2.GT.NCHCMD) GO TO 280
      DO 270 I=D2,NCHCMD
      INTREC(J)=COMAND(I)
      J=J+1
      IF (J.GT.NY) GO TO 280
270   CONTINUE
280   IF (NBR2.NE.0) GO TO 290
      NCHACT=J-1
      GO TO 70
290   IF (J.GT.NBR2) GO TO 70
      INTREC(J)=32
C     32 = ASCII BLANK
      J=J+1
      GO TO 290
C     WE HAVE A THIRD DELIMITER.  REPLACE ONLY THE SEARCH STRING.
C     SHIFT THE REST OF THE REGION AS NECESSARY.
300   NUMBER=(D3-D2)-(D2-D1)
      IF (NUMBER) 310,350,330
C     SHIFT LEFT
310   I=J+D2-D1-1
      NY=MIN0(NBR2,NCHACT)
      IF (NY.EQ.0) NY=NCHACT
320   IF (I.GT.NY) GO TO 350
      INTREC(I+NUMBER)=INTREC(I)
C     NOTE - NUMBER .LT. 0 HERE
      INTREC(I)=32
C     32 = ASCII BLANK
      I=I+1
      GO TO 320
C     RIGHT SHIFT
330   I=NBR2
      IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180)
      NY=J+NUMBER
340   IF (I.LT.NY) GO TO 350
      INTREC(I)=INTREC(I-NUMBER)
      I=I-1
      GO TO 340
C     NO SHIFT NEEDED.
350   IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180)
      IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2)
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
C     MOVE UPDATE STRING (STRING2).
360   D2=D2+1
      IF (D2.GE.D3) GO TO 70
      INTREC(J)=COMAND(D2)
      J=J+1
      IF (J-NY) 360,360,70
C
C     REQUEST TO INCLUDE TEXT.  -I IN COLUMNS 1 AND 2.
C
370   IF (EDIT.EQ.0) GO TO 390
      WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD)
380   FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X
     1,80A1))
      NERRS=2
      GO TO 70
390   ITYPEO=73
C     73 = ASCII I
      IF (NCHCMD.GE.4) GO TO 410
      WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD)
400   FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A
     11))
      NERRS=2
      GO TO 70
410   DO 420 I=4,NCHCMD
      IF (COMAND(I).NE.32) GO TO 430
420   CONTINUE
C     CONVERT TO UPPER CASE.  WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM
430   K=0
      DO 440 J=I,NCHCMD
      IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32
      K=K+1
440   COMAND(K)=COMAND(J)
      NCHCMD=K
      GO TO 460
C
C     TEXT RECORD.
C
450   ITYPEO=0
460   NCHOUT=NCHCMD
      IF (OUTOPN.EQ.0) GO TO 470
      MODEO=0
      CALL EXCHPR (ISTAT,OBLOCK,COMAND)
      IF (ISTAT.NE.0) GO TO 770
470   CALL EXCHTP (COMAND,0)
      GO TO 70
C
C     APPARENT CHANGE CONTROL COMMAND
C
480   IF (INEND.EQ.0) GO TO 510
490   WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD)
500   FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT
     1 END./(1X,80A1))
      NERRS=1
      GO TO 70
510   NUMBER=1
      NBR1=0
      EDIT=0
      I=1
520   I=I+1
      IF (I.GT.NCHCMD) GO TO 600
      J=COMAND(I)
      IF (J.EQ.32) GO TO 600
C     32 = ASCII BLANK
      IF (EDIT.NE.0) GO TO 530
C     EDIT CONTROL MUST BE BLANK AFTER $.
      IF (J.EQ.44) GO TO 570
C     44 = ASCII COMMA
      IF (J.EQ.36) GO TO 560
C     36 = ASCII $
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.LE.57) GO TO 550
C     57 = ASCII 9
530   WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD)
540   FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1)
      NERRS=2
      GO TO 60
550   NBR1=10*NBR1+J-48
      GO TO 520
560   IF (NBR1.EQ.0) GO TO 530
      EDIT=1
      NBR1=NBR1-1
      GO TO 520
570   NUMBER=2
      NBR2=0
580   I=I+1
      IF (I.GT.NCHCMD) GO TO 590
      J=COMAND(I)
      IF (J.EQ.32) GO TO 590
C     32 = ASCII BLANK
      IF (IABS(J-44).EQ.1) GO TO 590
C     43 = ASCII +, 45 = ASCII -
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 530
C     57 = ASCII 9
      NBR2=10*NBR2+J-48
      GO TO 580
590   IF (NBR2.LT.NBR1) GO TO 530
      NBR1=NBR1-1
600   IF (NBR1.GE.LINEI-1) GO TO 620
      WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD)
610   FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1)
      NERRS=2
      GO TO 60
620   IF (NCHCMD.LE.0) GO TO 630
      IF (LINEI.LE.NBR1) GO TO 630
      IF (NUMBER.EQ.1) GO TO 70
C     SKIP INTAPE UNTIL NBR2 IS SKIPPED.
      MODEI=1
      IF (LINEI.GE.NBR2) MODEI=0
      IF (LINEI-NBR2) 650,650,70
C     COPY FROM INTAPE UNTIL NBR1 COPIED.
630   MODEO=MODEI
      NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTAPE.EQ.0) GO TO 640
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 770
640   CALL EXCHTP (INTREC,LINEI)
      MODEI=0
      IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650
      IF (LINEI.EQ.NBR1) GO TO 650
      MODEI=1
650   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 760
      LINEI=LINEI+1
      IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620
C     73 = ASCII I
      INEND=1
      IF (NCHCMD.LE.0) GO TO 660
      I=NBR2
      IF (NUMBER.EQ.1) I=NBR1
      IF (LINEI-I) 490,490,70
660   IF (NERRS.EQ.0) GO TO 675
      J=1
      IF (PHASE.EQ.8) J=2
      WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS
670   FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.)
675   NERRG=MAX0(NERRG,NERRS)
      IF (OPTL+OPTS.NE.0) GO TO 690
      IF (OUTAPE+OUFILE.EQ.0) LINEO=0
      IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO
680   FORMAT (I9,14H IMAGES COPIED)
      GO TO 710
690   WRITE (PRINTR,700)
700   FORMAT (1H1)
      CHAR1L=ONE
710   IF (OUFILE.EQ.0) GO TO 720
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
720   IF (ITYPEI.NE.69) GO TO 750
C     69 = ASCII E
C
C     END OF FILE ON INPUT TAPE (UPDATE MODE).
C
      IF (INTOPN.LT.0) GO TO 750
      DO 730 I=1,40
730   HOLCMD(I+1)=TXDISK(I)
      HOLCMD(1)=32
      IF (TXDISK(1).NE.32) HOLCMD(1)=61
C     32 = ASCII BLANK, 61 = ASCII =
      CALL EXCHAH (HOLCMD,41)
      WRITE (PRINTR,740) (HOLCMD(I),I=1,41)
740   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1)
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
750   TRANS=1
      GO TO 790
C
C     ERROR MESSAGES.
C
760   NUMBER=1
      GO TO 780
770   NUMBER=2
780   EQUAL=ISTAT
      TRANS=8
C
C     RETURN TO THE TRANSITION PROGRAM.
C
790   PHASE=2
      IF (OUTOPN.EQ.0) PHASE=1
      RETURN
C
      END
      SUBROUTINE EXCHC8
C
C     PRINT ERROR MESSAGES.
C
C     ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE
      INTEGER S(31)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/
      DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/
      DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/
      DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/
      DATA S(29),S(30),S(31)                         /4,5,5        /
C
C             1  2  3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4
     160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751),
     2NUMBER
C     16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
10    WRITE (PRINTR,20) EQUAL
20    FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.)
      GO TO 50
30    WRITE (PRINTR,40) EQUAL
40    FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.)
50    GO TO (60,80,100,120,140,160), EQUAL
60    WRITE (PRINTR,70)
70    FORMAT (22H BLOCK SEQUENCE ERROR.)
      GO TO 180
80    WRITE (PRINTR,90)
90    FORMAT (20H BLOCK IS TOO SHORT.)
      GO TO 180
100   WRITE (PRINTR,110)
110   FORMAT (11H I/O ERROR.)
      GO TO 180
120   WRITE (PRINTR,130)
130   FORMAT (18H RECORD TOO LARGE.)
      GO TO 180
140   WRITE (PRINTR,150)
150   FORMAT (21H UNKNOWN RECORD TYPE.)
      GO TO 180
160   WRITE (PRINTR,170)
170   FORMAT (25H FIRST BLOCK NOT A LABEL.)
      GO TO 760
180   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1)
      INFILE=0
C
C     RETURN TO QUIT SEGMENT.
C
      TRANS=9
      GO TO 800
C
200   WRITE (PRINTR,210)
210   FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.)
      GO TO 760
220   WRITE (PRINTR,230)
230   FORMAT (//20H0INTAPE NOT DEFINED.)
      GO TO 760
240   WRITE (PRINTR,250)
250   FORMAT (//23H0UNABLE TO OPEN INTAPE.)
      GO TO 10
260   WRITE (PRINTR,270)
270   FORMAT (//23H0UNABLE TO OPEN OUTAPE.)
      GO TO 30
280   WRITE (PRINTR,290)
290   FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.)
      GO TO 760
300   WRITE (PRINTR,310)
310   FORMAT (//19H0DATE NOT SUPPLIED.)
      GO TO 760
320   WRITE (PRINTR,330)
330   FORMAT (//19H0SITE NOT SUPPLIED.)
      GO TO 760
340   WRITE (PRINTR,350) INTAPE
350   FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4)
      GO TO 760
360   WRITE (PRINTR,370)
370   FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.)
      GO TO 760
380   WRITE (PRINTR,390)
390   FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.)
      GO TO 760
400   WRITE (PRINTR,410)
410   FORMAT (//27H0COMMAND HAS IMPROPER DATE.)
      GO TO 760
420   WRITE (PRINTR,430) EQUAL
430   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.)
      GO TO 780
440   WRITE (PRINTR,450)
450   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.)
      IF (ICOMD) 780,560,780
460   WRITE (PRINTR,470) N1RECI
470   FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO
     1N (,I5,2H).)
      GO TO 760
480   WRITE (PRINTR,490) EQUAL
490   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
500   WRITE (PRINTR,510)
510   FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.)
      GO TO 760
520   WRITE (PRINTR,530)
530   FORMAT (//23H0WORK FILE NOT DEFINED.)
      GO TO 760
540   WRITE (PRINTR,550)
550   FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.)
      GO TO 760
560   WRITE (PRINTR,570) EQUAL
570   FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.)
      GO TO 760
580   WRITE (PRINTR,590)
590   FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE
     1R.)
      GO TO 760
600   WRITE (PRINTR,610)
610   FORMAT (//12H0TOO MANY (.)
      GO TO 760
620   WRITE (PRINTR,630) EQUAL
630   FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.)
      GO TO 760
640   WRITE (PRINTR,650) EQUAL
650   FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.)
      GO TO 760
660   WRITE (PRINTR,670) EQUAL
670   FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.)
      GO TO 760
680   WRITE (PRINTR,690) EQUAL
690   FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.)
      GO TO 760
700   WRITE (PRINTR,710) EQUAL
710   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
720   WRITE (PRINTR,730) N1RECI
730   FORMAT (//21H0INTAPE POSITIONED AT,I5,25H.  BACKWARD SKIP IGNORED.
     1)
      GO TO 780
740   WRITE (PRINTR,750)
750   FORMAT (//23H0COMMAND IS INCOMPLETE.)
      GO TO 760
751   WRITE (PRINTR,752)
752   FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA
     1PE OR OUTPUT.)
760   WRITE (PRINTR,770)
770   FORMAT (23H COMMAND NOT PROCESSED.)
780   WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD)
790   FORMAT ((1X,80A1))
C
C     RETURN TO COMMAND PROCESSSOR.
C
      CHAR1L=0
      NERRS=MAX0(S(NUMBER),NERRS)
      NERRG=MAX0(NERRG,NERRS)
      TRANS=1
C
C     RETURN TO TRANSITION PROGRAM.
C
800   RETURN
C
      END
      SUBROUTINE EXCHC9 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO
C     ERRORS.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KQUIT /20/
C
      IF (INFILE.EQ.0) GO TO 10
      IF (MODIFY.NE.82) GO TO 5
C     82 = ASCII R
      ACTION=2
C     ACTION = 2 MEANS REWIND INFILE.
      CALL EXCHIM
5     ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      CALL EXCHIM
      INFILE=0
      NCHCMD=0
      GO TO 50
10    IF (OPTC*OUFILE.EQ.0) GO TO 20
      ACTION=0
      NCHOUT=4
      CALL EXCHOU (COMD(1,KQUIT))
20    ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      IF (OUTOPN.EQ.0) GO TO 30
C     WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC)
C     CLOSE THE INPUT TAPE.
30    IF (INTOPN.EQ.0) GO TO 40
      ISTAT=4
      CALL EXCHRT (ISTAT,OBLOCK)
C
C     RETURN TO MAIN PROGRAM.
C
40    TRANS=0
      IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG
45    FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.)
      GO TO 60
C
C     RETURN TO THE COMMAND DECODER.
C
50    TRANS=1
60    RETURN
C
      END
=TES FILE=8
/* Subroutine idate(i,j,k) sets i to month, j to day of month,
   k to year minus 1900. */

#include <time.h>
#include <sys/types.h>
#include <sys/times.h>

struct tm *localtime();
long time();

int idate_(i, j, k)
long int *i, *j, *k;
{
struct tm *t;
long tloc;

tloc = time(0);
t = localtime(&tloc);
*i = t->tm_mon + 1;
*j = t->tm_mday;
*k = t->tm_year;
return 0;
}
/*  Fortran-callable tape read/write routines...
*
*  calling sequences:
*
*       tropen(unit, ierr, name, *errlab)
*       twopen(unit, ierr, name, *errlab)
*       tread (unit, ierr, buf, buflen, *errlab)
*       twrite(unit, ierr, buf, buflen, *errlab)
*       trwind(unit, ierr, *errlab)
*       tclose(unit, ierr, *errlab)
*
*  where the Fortran types are
*
*       integer unit, ierr, buflen
*       character*(*) name, buf
*
*  `unit' is similar to a standard Fortran i/o unit number, except
*    that there are no restrictions on its sign or magnitude and
*    it has a life independent of the true Fortran unit numbers.
*    Several tape files can be open at once:  the only limit is
*    that imposed by the operating system on how may files may
*    be open at once.
*
*  `ierr' is assigned a return code:  0 means all went well,
*    -1 means end of file (for tread), and other (negative) values
*    mean something went wrong.  For tread (only), positive
*    values of ierr are also possible, implying that buf was
*    filled with fewer than buflen characters.  (In this case
*    tread fills the remaining character positions of buf with
*    blanks.)
*
*  `name' must contain a valid path name.  Spaces, tabs, newlines,
*    and NULs terminate the pathname, though no such delimiter is
*    required.
*
*  `buf' can be of any type.
*
*  `errlab' is a label to which control will go if something goes
*    wrong.  This argument may be omitted.
*
*  Written by David M. Gay.
*/

#include <stdio.h>
/* The following three included files are not present in every version of UNIX.
*  They are used when TAPE rewind code in TRWIND is activated.
#include <ctype.h>
#include <sys/types.h>
#include <sys/mtio.h>
*/

struct openlist {
        struct openlist *next;
        long int unit;
        int fileds, mode;
        char fname[1];
        };

static struct openlist *first = NULL;
struct openlist *malloc();

int nlen(name, namelen)
register char *name;
register long int namelen;
{
register int i;
register char c;

for (i = 0; i < namelen; i++) {
        c = *name++;
        if (!c || c == ' ' || c == '\t' || c == '\n') break;
        }
return i;
}

int topen(unit, name, ierr, namelen, mode)
long int *unit, *ierr, namelen;
char *name;
int mode;
{
int i, nl;
long int u;
struct openlist *p;

u = *unit;

for (p = first; p != NULL; p = p->next) {
        if (p->unit == u) {
                if (strcmp(p->fname, name)) {
                        i = tclose_(unit, ierr);
                        if (i) return i;
                        break;
                        }
                else {if (p->mode == mode) break;
                      else {
                        if (mode) {  /* if opening for reading  and unit was
                                        open for writing */
                                i = tclose_(unit, ierr);
                                if (i) return i;
                                break;
                                }
                        else {
                              fprintf(stderr,
                               "tropen(%ld,'%s'): already open for writing\n",
                                u, p->fname);
                              *ierr = -2;
                              return 1;
                              }
                           }
                     }
                }
        }
nl = nlen(name, namelen);
p = malloc(nl + sizeof(struct openlist));
if (!p) {
        fprintf("topen: malloc fails!\n");
        *ierr = -3;
        return 1;
        }
for (i = 0; i < nl; i++) p->fname[i] = name[i];
p->fname[nl] = 0;
p->fileds = i = mode ? creat(p->fname,-1) : open(p->fname,0);
if (i < 0) {
        perror(p->fname);
        *ierr = -2;
        free(p);
        return 1;
        }
p->unit = u;
p->mode = mode;
p->next = first;
first = p;
return 0;
}

int tropen_(unit, ierr, name, namelen)
long int *unit, *ierr, namelen;
char *name;
{
return topen(unit, name, ierr, namelen, 0);
}

int twopen_(unit, ierr, name, namelen)
long int *unit, *ierr, namelen;
char *name;
{
return topen(unit, name, ierr, namelen, 1);
}

int tread_(unit, ierr, buf, len)
long int *unit, *len, *ierr;
char *buf;
{
struct openlist *p;
long int u;
int bs, i;

u = *unit;
for (p = first; p != NULL; p = p->next) {
        if (u == p->unit) {
                if (p->mode != 0) {
                        fprintf(stderr,
                        "tread attempted on unit %ld = open for writing\n",
                                u);
                        *ierr = -3;
                        return 1;
                        }
                bs = *len;
                if (bs <= 0) {
                        fprintf("tread called with buflen = %d\n", bs);
                        *ierr = -4;
                        return 1;
                        }
                i = read(p->fileds, buf, bs);
                *ierr = 0;
                if (i == bs) return 0;
                if (i == 0) {
                        *ierr = -1;
                        return 1;
                        }
                if (i > 0) {
                        *ierr = bs - i;
                        for (; i < bs; i++) buf[i] = ' ';
                        return 1;
                        }
                fprintf(stderr,"tread, unit %ld:  return code %d from ",
                        u, i);
                perror("read");
                *ierr = -4;
                return 1;
                }
        }
fprintf(stderr, "tread: unit %ld not open\n", u);
*ierr = -5;
return 1;
}

int twrite_(unit, ierr, buf, len)
long int *unit, *len, *ierr;
char *buf;
{
struct openlist *p;
long int u;
int bs, i;

u = *unit;
for (p = first; p != NULL; p = p->next) {
        if (u == p->unit) {
                if (p->mode != 1) {
                        fprintf(stderr,
                        "twrite attempted on unit %ld = open for reading\n",
                                u);
                        *ierr = -3;
                        return 1;
                        }
                bs = *len;
                if (bs <= 0) {
                        fprintf("twrite called with buflen = %d\n", bs);
                        *ierr = -4;
                        return 1;
                        }
                i = write(p->fileds, buf, bs);
                if (i == bs) {
                        *ierr = 0;
                        return 0;
                        }
                if (i >= 0) {
                        fprintf(stderr,
                        "twrite, unit %ld: %d bytes instead of %d written\n",
                                i, bs);
                        *ierr = -6;
                        return 1;
                        }
                fprintf(stderr,
                        "twrite, unit %ld:  return code %d from ", u, i);
                perror("write");
                *ierr = -4;
                return 1;
                }
        }
fprintf(stderr, "twrite: unit %ld not open\n", u);
*ierr = -5;
return 1;
}

int tclose_(unit, ierr)
long int *unit, *ierr;
{
struct openlist *p, *prev;
long int u;
int i;

u = *unit;
prev = (struct openlist *) &first;
for (p = first; p != NULL; p = p->next) {
        if (u == p->unit) {
                i = close(p->fileds);
                prev->next = p->next;
                free(p);
                if (i) {
                        fprintf(stderr,
                        "tclose, unit %ld:  Return code %d from ", u, i);
                        perror("close");
                        *ierr = -7;
                        return 1;
                        }
                *ierr = 0;
                return 0;
                }
        prev = p;
        }
fprintf(stderr, "tclose: unit %ld not open\n", u);
*ierr = -8;
return 1;
}

int trwind_(unit, ierr)
long int *unit, *ierr;
{
/* struct MTOP is used when TAPE rewind is activated.  IF the function
*  is provided by your version of UNIX, you should use REWIND carefully
*  because it will position the tape to load point, not necessarily to
*  the beginning of the file in use at the time the REWIND command was
*  issued.
struct mtop mtc;
*/
struct openlist *p;
long int u;
int i;
long lseek();

u = *unit;
*ierr = 0;
for (p = first; p != NULL; p = p->next) {
        if (u == p->unit) {
                /* The following 5 statements try to REWIND a TAPE.
                *  The REWIND function is not present in all versions
                *  of UNIX.  When present, it should be used carefully,
                *  because it positions the tape at load point, it does
                *  not seek back to the beginning of the file.
                mtc.mt_count = 1;
                mtc.mt_op = MTREW;
                i = ioct(p->fileds, MTIOCTOP, &mtc);
                if (i >= 0) return 0;
                if (i == -1) */
                  if (!lseek(p->fileds, 0L, 0)) return 0;
                fprintf(stderr, "trwind of unit %ld = ``%s''", u,
                        p->fname);
                perror(" failed");
                *ierr = -9;
                return 1;
                }
        }
fprintf(stderr, "trwind: unit %ld not open\n", u);
*ierr = -8;
return 1;
}
=TES FILE=9
        PROGRAM EXCHNG
C  PDP-10 IMPLEMENTATION OF JPL TAPE EXCHANGE PROGRAMS.
C  FOR TOPS-10 MONITOR V.603.A11 AND FORTRAN V.5A
C  THIS IS THE MAIN PROGRAM FOR BOTH PROGRAMS.
      INTEGER INBLOK(1800)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      DOUBLE PRECISION FNAMES(3)
      LOGICAL TABS
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      COMMON /EXCP10/ TABS,FNAMES
      FNAMES(2)='MTIN      '
C     ABOVE IS DEVICE FOR INTAPE IN SIMPLE PROGRAM.
      NWCBI=45
      PRINTR=5
      READER=5
      CALL EXCH (INBLOK)
      STOP
      END
      BLOCK DATA
C
C     BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/
      DATA INTEXT /0/, INALT /0/
C
      DATA CHAR1L /1H1/
C                                                        A  U  T  H
      DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1)  /65,85,84,72/
C                                                        C  O  M  M
      DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2)  /67,79,77,77/
C                                                        C  O  P  Y
      DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3)  /67,79,80,89/
C                                                        D  A  T  A
      DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4)  /68,65,84,65/
C                                                        D  A  T  E
      DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5)  /68,65,84,69/
C                                                        G  R  O  U
      DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6)  /71,82,79,85/
C                                                        I  N  D  E
      DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7)  /73,78,68,69/
C                                                        I  N  P  U
      DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8)  /73,78,80,85/
C                                                        N  A  M  E
      DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9)  /78,65,77,69/
C                                                        I  N  T  A
      DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/
C                                                        K  E  Y  W
      DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/
C                                                        L  I  M  I
      DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/
C                                                        M  A  C  H
      DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/
C                                                        O  P  T  I
      DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/
C                                                        O  R  I  G
      DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/
C                                                        O  U  T  A
      DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/
C                                                        O  U  T  P
      DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/
C                                                        P  R  E  D
      DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/
C                                                        P  R  I  N
      DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/
C                                                        Q  U  I  T
      DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/
C                                                        R  E  A  D
      DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/
C                                                        R  E  F  E
      DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/
C                                                        R  E  M  O
      DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/
C                                                        R  E  W  I
      DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/
C                                                        S  I  T  E
      DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/
C                                                        S  K  I  P
      DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/
C                                                        T  E  X  T
      DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/
C                                                        T  I  T  L
      DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/
C                                                        U  P  D  A
      DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/
C                                                        W  O  R  K
      DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/
C                                                        C  O  N  T
      DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/
C                                                        I  D  E  N
      DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/
C                                                        I  N  C  L
      DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/
C                                                        S  I  G  N
      DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/
C                                                        M  A  R  G
      DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/
      DATA IDSTEP /0/, IDTXTL /0/
      DATA INDEX /0/
      DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/
      DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/
      DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/
      DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/
      DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/
      DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/
      DATA INDEXS(25),INDEXS(26)                       /0,0    /
      DATA INTOPN /0/
      DATA ITYPEI /0/
      DATA LIMIT /0/
      DATA MARGIN /180/
      DATA NCCBI /180/
      DATA NCCBO /180/
      DATA NCHCMD /0/
      DATA NCHMAX /180/
      DATA NCOMDP /35/
      DATA NCOMDT /35/
      DATA NDATAO /3591/
      DATA NERRCO /0/
      DATA NERRG /0/
      DATA NRWORK /0/
      DATA OUTOPN /0/
      DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/
      DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/
      DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/
      DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/
      DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/
      DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/
      DATA OPTVAL(25),OPTVAL(26)                       /0,0    /
      DATA PHASE /1/
C     INDICATE THAT NO PREDICATES ARE DEFINED.
      DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/
      DATA PRED(1,6),PRED(1,7),PRED(1,8)                     /0,0,0    /
      DATA SITE(1) /0/
      DATA TITLE(1) /32/
C     32 = ASCII BLANK
      DATA TODAY (1) /0/
      DATA TRANS /1/
C
C     TRANSLATION TABLE FROM ASCII TO HOLLERITH.  USES ASCII GRAPHICS.
C     TRANSLATES CONTROL CHARACTERS (<32) TO '$'.
C     MAY NOT BE EXACTLY CORRECT FOR ALL MACHINES.
C
      DATA XLATE(1),  XLATE(2),  XLATE(3),  XLATE(4)  /1H$,1H$,1H$,1H$/
      DATA XLATE(5),  XLATE(6),  XLATE(7),  XLATE(8)  /1H$,1H$,1H$,1H$/
      DATA XLATE(9),  XLATE(10), XLATE(11), XLATE(12) /1H$,1H$,1H$,1H$/
      DATA XLATE(13), XLATE(14), XLATE(15), XLATE(16) /1H$,1H$,1H$,1H$/
      DATA XLATE(17), XLATE(18), XLATE(19), XLATE(20) /1H$,1H$,1H$,1H$/
      DATA XLATE(21), XLATE(22), XLATE(23), XLATE(24) /1H$,1H$,1H$,1H$/
      DATA XLATE(25), XLATE(26), XLATE(27), XLATE(28) /1H$,1H$,1H$,1H$/
      DATA XLATE(29), XLATE(30), XLATE(31), XLATE(32) /1H$,1H$,1H$,1H$/
      DATA XLATE(33), XLATE(34), XLATE(35), XLATE(36) /1H ,1H!,1H",1H#/
      DATA XLATE(37), XLATE(38), XLATE(39), XLATE(40) /1H$,1H%,1H&,1H'/
      DATA XLATE(41), XLATE(42), XLATE(43), XLATE(44) /1H(,1H),1H*,1H+/
      DATA XLATE(45), XLATE(46), XLATE(47), XLATE(48) /1H,,1H-,1H.,1H//
      DATA XLATE(49), XLATE(50), XLATE(51), XLATE(52) /1H0,1H1,1H2,1H3/
      DATA XLATE(53), XLATE(54), XLATE(55), XLATE(56) /1H4,1H5,1H6,1H7/
      DATA XLATE(57), XLATE(58), XLATE(59), XLATE(60) /1H8,1H9,1H:,1H;/
      DATA XLATE(61), XLATE(62), XLATE(63), XLATE(64) /1H<,1H=,1H>,1H?/
      DATA XLATE(65), XLATE(66), XLATE(67), XLATE(68) /1H@,1HA,1HB,1HC/
      DATA XLATE(69), XLATE(70), XLATE(71), XLATE(72) /1HD,1HE,1HF,1HG/
      DATA XLATE(73), XLATE(74), XLATE(75), XLATE(76) /1HH,1HI,1HJ,1HK/
      DATA XLATE(77), XLATE(78), XLATE(79), XLATE(80) /1HL,1HM,1HN,1HO/
      DATA XLATE(81), XLATE(82), XLATE(83), XLATE(84) /1HP,1HQ,1HR,1HS/
      DATA XLATE(85), XLATE(86), XLATE(87), XLATE(88) /1HT,1HU,1HV,1HW/
      DATA XLATE(89), XLATE(90), XLATE(91), XLATE(92) /1HX,1HY,1HZ,1H[/
      DATA XLATE(93), XLATE(94), XLATE(95), XLATE(96) /1H\,1H],1H^,1H_/
      DATA XLATE(97), XLATE(98), XLATE(99), XLATE(100)/1H`,1Ha,1Hb,1Hc/
      DATA XLATE(101),XLATE(102),XLATE(103),XLATE(104)/1Hd,1He,1Hf,1Hg/
      DATA XLATE(105),XLATE(106),XLATE(107),XLATE(108)/1Hh,1Hi,1Hj,1Hk/
      DATA XLATE(109),XLATE(110),XLATE(111),XLATE(112)/1Hl,1Hm,1Hn,1Ho/
      DATA XLATE(113),XLATE(114),XLATE(115),XLATE(116)/1Hp,1Hq,1Hr,1Hs/
      DATA XLATE(117),XLATE(118),XLATE(119),XLATE(120)/1Ht,1Hu,1Hv,1Hw/
      DATA XLATE(121),XLATE(122),XLATE(123),XLATE(124)/1Hx,1Hy,1Hz,1H{/
      DATA XLATE(125),XLATE(126),XLATE(127),XLATE(128)/1H|,1H},1H~,1H$/
      END
      SUBROUTINE EXCH (INBLOK)
C
C     PDP 10 INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM
C
        DIMENSION ICHAR(2)
        INTEGER DIGIT(10),MONTH(12)
      INTEGER INBLOK(1)
C
C     ALLOCATE SPACE FOR TAPE OUTPUT
C
      INTEGER OUTBLK(900)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER XLATE(128)
      LOGICAL TABS
      DOUBLE PRECISION FNAMES(3)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHXC/ XLATE
      COMMON /EXCP10/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
        DATA DIGIT(1),DIGIT(2),DIGIT(3),DIGIT(4),DIGIT(5),
     1       DIGIT(6),DIGIT(7),DIGIT(8),DIGIT(9),DIGIT(10)
     2  /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
        DATA MONTH(1),MONTH(2),MONTH(3),MONTH(4),MONTH(5),MONTH(6),
     1  MONTH(7),MONTH(8),MONTH(9),MONTH(10),MONTH(11),MONTH(12)
     2 /3HJAN,3HFEB,3HMAR,3HAPR,3HMAY,3HJUN,3HJUL,
     3 3HAUG,3HSEP,3HOCT,3HNOV,3HDEC /
C
        CALL DATE(ICHAR)
        DECODE(1,11,ICHAR) TODAY(5)
   11   FORMAT(A1)
        DECODE(2,12,ICHAR) TODAY(6)
   12   FORMAT(1X,A1)
        DECODE(6,13,ICHAR) TODAY(3)
   13   FORMAT(3X,A3)
        DECODE(3,14,ICHAR(2)) TODAY(1)
   14   FORMAT(2X,A1)
        DECODE(4,15,ICHAR(2)) TODAY(2)
   15   FORMAT(3X,A1)
        DO 25 J=1,2
        DO 20 I=1,10
        IF(TODAY(J).EQ.DIGIT(I)) GO TO 22
   20   CONTINUE
        I = 1
   22   CONTINUE
        TODAY(J) = 47+I
   25   CONTINUE
        DO 35 I=5,6
        DO 30 J=1,10
        IF(TODAY(I).EQ.DIGIT(J)) GO TO 32
   30   CONTINUE
        J = 1
   32   CONTINUE
        TODAY(I) = 47+J
   35   CONTINUE
        DO 40 I=1,12
        IF(TODAY(3).EQ.MONTH(I)) GO TO 42
   40   CONTINUE
   42   CONTINUE
        TODAY(3) = 48
        IF(I.GE.10) TODAY(3) = 49
        I=MOD(I,10)
        TODAY(4) = 48+I
C
C       SITE = SANDIA NATIONAL LABS IC/CAD, TOPS-20AN M
C
C       SITE(1) = 83
C       SITE(2) = 65
C       SITE(3) = 78
C       SITE(4) = 68
C       SITE(5) = 73
C       SITE(6) = 65
C       SITE(7) = 32
C       SITE(8) = 78
C       SITE(9) = 97
C       SITE(10) = 116
C       SITE(11) = 105
C       SITE(12) = 111
C       SITE(13) = 110
C       SITE(14) = 97
C       SITE(15) = 108
C       SITE(16) = 32
C       SITE(17) = 76
C       SITE(18) = 97
C       SITE(19) = 98
C       SITE(20) = 115
C       SITE(21) = 32
C       SITE(22) = 73
C       SITE(23) = 67
C       SITE(24) = 47
C       SITE(25) = 67
C       SITE(26) = 65
C       SITE(27) = 68
C       SITE(28) = 44
C       SITE(29) = 32
C       SITE(30) = 84
C       SITE(31) = 79
C       SITE(32) = 80
C       SITE(33) = 83
C       SITE(34) = 45
C       SITE(35) = 50
C       SITE(36) = 48
C       SITE(37) = 65
C       SITE(38) = 78
C       SITE(39) = 32
C       SITE(40) = 77
        TABS=.FALSE.
C       DEFINE THE COMMAND 'TABS='.
        NCOMDT=NCOMDP+1
        COMD(1,NCOMDT)=84
        COMD(2,NCOMDT)=65
        COMD(3,NCOMDT)=66
        COMD(4,NCOMDT)=83
        NWCBO=(NCCBO+3)/4
        WORKF=1
        FNAMES(3)='MTOUT     '
        CALL EXCHTR(INBLOK,OUTBLK)
        RETURN
        END
        SUBROUTINE EXCHFO(IOP)
C
C  DEC PDP-10 WITH TOPS-10 V.603A.11 MONITOR.  SHOULD WORK WITH
C  EARLIER MONITOR VERSIONS. DESIGNED FOR FORTRAN V5A,SHOULD WORK FOR EARLIER.
C
C  OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM
C  IOP<0 ====> CLOSE FILE
C  IOP>0 ====> OPEN FILE
C  IABS(IOP)=1 MEANS READER (USER TELETYPE)
C  IABS(IOP)=2 MEANS PRINTER (LINE PRINTER)
C  IABS(IOP)=3 MEANS WORKFILE (DISK)
C  IABS(IOP)=4 MEANS INPUT FILE (DISK) (BOOTSTRAP ONLY).
C  READER AND PRINTER ARE OPENED AS FILES IN CASE DISK INPUT OR OUTPUT
C  IS DESIRED.  IF READER=5,FILENAME WILL DEFAULT TO FOR05.DAT AND SIMILARLY
C  FOR THE PRINTER.  IN ORDER TO GET DISK I/O ON THE READER AND PRINTR UNITS,
C  THE USER MUST (IN MONITOR MODE) ASSIGN DSK:TTY OR ASSIGN
C  DSK: 5 (IF READER=5).  EITHER OF THESE COMMANDS WILL TAKE INPUT
C  FROM DSK:FOR05.DAT.  SIMILARLY,ASSIGN DSK: LPT OR
C  ASSIGN DSK: 3 WILL PUT OUTPUT ON DSK:FOR03.DAT.  IF MESSAGES ARE TO BE
C  PRINTED ON THE TELETYPE INSTEAD OF THE LINE PRINTER, ASSIGN TTY: 3 OR
C  ASSIGN TTY:LPT WILL CHANGE THE DEFAULT PRINTER DEVICE APPROPRIATELY.
C
        INTEGER IOP,JUMP
        DOUBLE PRECISION FNAME
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
        JUMP=IABS(IOP)
        IF (IOP.LT.0) GO TO (10,20,30,40),JUMP
        GO TO (50,60,70,80),JUMP
C
C  CLOSE FILES
   10   CLOSE (UNIT=READER)
        RETURN
   20   CLOSE (UNIT=PRINTR)
        RETURN
   30   CLOSE (UNIT=WORKF)
        RETURN
   40   CLOSE (UNIT=INFILE)
        RETURN
C
C  OPEN FILES
   50   OPEN (UNIT=READER,DEVICE='TTY',ACCESS='SEQINOUT')
        RETURN
   60   OPEN (UNIT=PRINTR,DEVICE='LPT',ACCESS='SEQOUT')
        RETURN
C  ASSUME UNIT NUMBER IS TWO DIGITS.
   70   I1=WORKF/10
        I2=MOD(WORKF,10)
        ENCODE (10,75,FNAME) I1,I2
   75   FORMAT ('EXCH',2I1,'.TMP')
        OPEN (UNIT=WORKF,DEVICE='DSK',ACCESS='SEQOUT',
     *        FILE=FNAME,MODE='ASCII',ERR=90)
        RETURN
C  ASSUME UNIT NUMBER IS TWO DIGITS.
   80   I1=INFILE/10
        I2=MOD(INFILE,10)
        ENCODE (10,75,FNAME) I1,I2
        OPEN (UNIT=INFILE,DEVICE='DSK',ACCESS='SEQINOUT',
     *        FILE=FNAME,MODE='ASCII',ERR=110)
        RETURN
   90   WRITE (PRINTR,100)
  100   FORMAT (' UNABLE TO OPEN WORKFILE.')
        STOP
  110   WRITE (PRINTR,120)
  120   FORMAT (' UNABLE TO OPEN INCLUDE FILE.')
        STOP
        END
      SUBROUTINE EXCHIM
C
C     READ A COMMAND OR TEXT IMAGE FROM  1.  ALTERNATE CORRECTION FILE,
C                                        2.  TEXT FILE,
C                                        3.  INPUT FILE,
C                                        4.  SYSTEM READER.
C     PUT THE HOLLERITH COMMAND IN HOLCMD,
C     PUT THE ASCII EQUIVALENT IN COMAND,
C     PUT THE NUMBER OF CHARACTERS IN NCHCMD.
C     IF A SYSTEM END-OF-FILE IS SENSED, SET NCHCMD=-1.
C
        INTEGER IBLNK,IBFIL,IRDFIL,ITMP,ITAB
      DOUBLE PRECISION FNAMES(3)
      LOGICAL TABS
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCP10/ TABS,FNAMES
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
        DATA IBLNK,ITAB/' ',"045004020100/
C       ABOVE, ITAB=HT + 4 BLANKS
C
C  WHICH FILE ARE WE HANDLING?
C
        IRDFIL=INALT
        IF (IRDFIL.GT.0)GO TO 100
        IRDFIL=INTEXT
        IF (IRDFIL.NE.0)GO TO 100
        IRDFIL=INFILE
        IF (IRDFIL.EQ.0)IRDFIL=READER
C
C  DO ACTION
C
  100   J=ACTION+2
C
C  CLOSE, READ FROM, OPEN OR REWIND A FILE.
C
        GO TO (500,400,700,200), J
C  REWIND INALT
C
  200   REWIND IRDFIL
        GO TO 700
C  READ A LINE,MAPPING TABS AS NEEDED
C
  400   NCPL=132
        DO 410 J = 1, NCPL
  410   COMAND(J)='    '
C  START WITH BLANKS
C
C PUT OUT PROMPT CHARACTER IF INPUT FILE IS TTY.
C THE FOLLOWING TEST MUST BE CHANGED IF UNIT 5 IS NOT TTY.
        IF (IRDFIL.EQ.5) WRITE (IRDFIL,410)
  410   FORMAT ($' *')
        READ (IRDFIL,420,END=800) (COMAND(J),J=1,NCPL)
  420   FORMAT(132A1)
C  NOW COUNT THE CHARACTERS,THEN DECODE THE TABS AND REVISE THE COUNT
C
        NCHCMD=0
        do 470 i = 1,ncpl
        IF (TABS)GO TO 450
        IF(COMAND(I).NE.ITAB) GO TO 450
C       ABOVE, DON'T WORRY IF NOT A TAB.
        IBFIL=8-MOD(NCHCMD,8)
        DO 460 J=1,IBFIL
        NCHCMD=NCHCMD+1
        HOLCMD(NCHCMD)=IBLNK
  460   CONTINUE
        GO TO 470
  450   NCHCMD=NCHCMD+1
        HOLCMD(NCHCMD)=COMAND(I)
  470   CONTINUE
        m=nchcmd
        do 475 i=1,m
        if (comand(m-i+1).eq.32) go to 475
c       32 = ASCII blank.
        nchcmd=m-i+1
        go to 480
  475   continue
        nchcmd=0
C  CONVERT HOLLERITH TO ASCII BY SHIFTING RIGHT 29 BITS
  480   DO 490 I=1,NCHCMD
        ITMP=HOLCMD(I)
        COMAND(I)=LSH(ITMP,-29)
  490   CONTINUE
C  WE'RE CAREFUL ABOVE TO COPY THE WORD BEFORE SHIFTING SO IT WON'T BE LOST.
        GO TO 700
C  CLOSE A FILE
  500   CLOSE(UNIT=IRDFIL)
  700   ACTION=0
        RETURN
C  ERROR OR END OF FILE
  800   NCHCMD=-1
        GO TO 700
        END
      SUBROUTINE EXCHOU (OUTPUT)
C
C     NATIVE FORMAT OUTPUT PROGRAM FOR THE TEXT EXCHANGE PROGRAM.
C  PDP-10 VERSION.  EXPECTS THE CHARACTERS AFTER THE LOGICAL UNIT
C  NUMBER TO BE A BLANK FOLLOWED BY A FILENAME.
C  WILL NOT FOR THE MOMENT ACCEPT DEVICES OR PPNS,ETC.
C
C     OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN.
C     THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT.
C
C     THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180),
C     THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179).  IF OUTPUT(180)
C     IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE.  IF OUTPUT(180)
C     IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW
C     IMAGE.
C
      INTEGER OUTPUT(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     DECIDE WHETHER TO OPEN, CLOSE OR WRITE.
C
      IF (ACTION.NE.0) IF (ACTION+1) 70,40,70
C     WRITE
      WRITE (OUFILE,30) (OUTPUT(I),I=1,NCHOUT)
30    FORMAT (132R1)
      GO TO 70
C     CLOSE
   40   CLOSE(UNIT=OUFILE,DISPOSE='SAVE')
C
   70   ACTION=0
        RETURN
        END
        SUBROUTINE EXCHPA(CHARS,OUTPOS)
C  PDP-10 IMPLEMENTATION OF TAPE EXCHANGE PROGRAM
C  PACKS CHARS FROM VECTOR CHARS INTO BUFFER STARTING AT POSITION OUTPOS,
C  4 8-BIT BYTES PER WORD,USING ASSEMBLER CODED BYTE MANIPULATION ROUTINES
C  IN BYTMNP.MAC
C
        INTEGER CHARS(NCCBO),OUTPOS(1),POINTE,P
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
        P=POINTE(8,OUTPOS,0)
        DO 100 J=1,NCCBO
        CALL STRBYT(CHARS(J),P)
  100   CONTINUE
        RETURN
        END
        SUBROUTINE EXCHRT(ISTAT,DBLOCK)
C
C  PDP-10 IMPLEMENTATION.  ERROR HANDLING SUBROUTINE (ERRSNS) EXISTS ONLY
C  FOR FORTRAN V5 OR LATER.
C
C  READ A BLOCK FROM, OR REWIND, THE EXCHANGE TAPE
C  INPUT:
C  ISTAT=1 MEANS OPEN WITH NO REWIND
C  ISTAT=2 MEANS REWIND(CLOSE WITH REWIND)
C  ISTAT=3 MEANS READ
C  ISTAT=4 MEANS CLOSE WITHOUT REWIND
C
C  OUTPUT:
C  ISTAT=0 IF EVERYTHING IS OK
C  ISTAT=3 IF AN I/O ERROR IS FOUND
C
C  DBLOCK IS RAW DATA BLOCK EXACTLY AS ON THE TAPE
        INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      LOGICAL TABS
      DOUBLE PRECISION FNAMES(3)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCP10/ TABS,FNAMES
C
        I=ISTAT
        ISTAT=0
        GO TO (10,50,20,55), I
C
C  OPEN THE TAPE FOR INPUT IN DUMP MODE USING INDUSTRY STANDARD FORMAT.
   10   IF (FNAMES(2).EQ.' ') FNAMES(2)='MTIN'
        CALL TAPOPN (INTAPE,'SEQIN',FNAMES(2),1800,ISTAT,ICHN)
        GO TO 80
C
C  READ A BLOCK
   20   I=0
30      NWORDS=(NDATAI+NERRCI+9+3)/4
C       ABOVE, NUMBER OF WORDS EXPECTED
        IEOF=0
        IERR=0
        CALL DMPIN (DBLOCK,ICHN,NWORDS,IEOF,IERR)
        IF (IEOF.NE.0) GO TO 35
        IF (IERR.NE.0) GO TO 60
C  SUCCESS
      NCDBI=NWORDS*4
        GO TO 80
C  END OF FILE ENCOUNTERED -- MAY GET ONE READING LABEL
C  ONLY ONE IS ALLOWED.
   35   IF (I.NE.0)GO TO 60
        IF(BLKSQI.NE.0) GO TO 60
C       ABOVE, LABEL ONLY AT BEGINNING OF TAPE
        I=1
        GO TO 30
C       ABOVE, GET REAL BLOCK IF LABEL
C  REWIND
   50   REWIND INTAPE
   55   CLOSE(UNIT=INTAPE,ERR=90)
        GO TO 80
C  ERROR IN READING
   60   CALL ERRSNS(II,JJ)
        WRITE(PRINTR,70)II,JJ
   70   FORMAT(//' READ ERROR ON INTAPE = ',2I6)
        ISTAT=3
   80   RETURN
   90   CALL ERRSNS(II,JJ)
        WRITE(PRINTR,95)II,JJ
   95   FORMAT(' ?EXCHRT:CAN''T CLOSE INTAPE,ERROR= ',2I6)
        ISTAT=3
        GO TO 80
C
        END
        SUBROUTINE EXCHUN(POSISH,CHARS)
C  PDP-10 IMPLEMENTAION OF TAPE EXCHANGE PROGRAM
C  UNPACKS NCCBI 8-BIT CHARACTERS STARTING FROM THE BEGINNING OF THE WORD
C  POSISH AND PUTS THEM,1 INTEGER PER WORD, INTO THE VECTOR CHARS
C  USES ASSEMBLER CODED BYTE MANIPULATION ROUTINES FROM BYTMNP.MAC
        INTEGER CHARS(NCCBI),POSISH(1),BYTE,POINTE,P
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
        P=POINTE(8,POSISH,0)
        DO 100 J=1,NCCBI
        CHARS(J)=BYTE(P)
  100   CONTINUE
        RETURN
        END
        SUBROUTINE EXCHWT(ISTAT,OUTBUF)
C  PDP-10 IMPLEMENTATION OF TAPE EXCHANGE PROGRAM.
C  ERROR HANDLING SUBROUTINE (ERRSNS) EXISTS ONLY FOR FORTRAN V5 OR LATER.
C
C  WRITE OUTPUT TAPE -- OPTIONS
C  INPUT:
C  ISTAT=1 MEANS OPEN WITH NO REWIND
C  ISTAT=2 MEANS WRITE
C  ISTAT=3 MEANS WRITE AN ENDFILE AND CLOSE WITHOUT REWIND
C  OUTUT:
C  ISTAT=0 MEANS ALL OK
C  ISTAT=3 MEANS ERRORS OCCURED
C
C  OUTBUF IS TAPE OUTPUT BUFFER
C
        INTEGER ISTAT,OUTBUF(1)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      LOGICAL TABS
      DOUBLE PRECISION FNAMES(3)
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCP10/ TABS,FNAMES
C
        I=ISTAT
        ISTAT=0
        NWORDS=(NDATAO+NERRCO+9+3)/4
        IF(BLKSQO.EQ.0) NWORDS=(CCDBO+3)/4
        GO TO (100,200,300), I
C
C  OPEN THE TAPE IN DUMP MODE FOR OUTPUT IN INDUSTRY STANDARD FORMAT
  100   IF (FNAMES(3).EQ.' ') FNAMES(3)='MTOUT'
        CALL TAPOPN (OUTAPE,'SEQOUT',FNAMES(3),NWORDS,ISTAT,ICHN)
        RETURN
C  WRITE THE TAPE.  ALWAYS WRITE A FULL BLOCK.
  200   IERR=0
        CALL DMPOUT (OUTBUF,ICHN,NWORDS,IERR)
        IF (IERR.NE.0) GO TO 900
        RETURN
  300   CLOSE(UNIT=OUTAPE,DISPOSE='SAVE',ERR=800)
        RETURN
C  ERROR HANDLING
  900   CALL ERRSNS(L,M)
        WRITE (PRINTR,920)L,M
  920   FORMAT(' ?EXCHWT: CAN''T WRITE TAPE,ERROR = ',2I6)
        ISTAT=3
        RETURN
  800   CALL ERRSNS(L,M)
        WRITE(PRINTR,820)L,M
  820   FORMAT(' ?EXCHWT: CAN''T CLOSE OUTAPE,ERROR= ',2I6)
        ISTAT=3
        RETURN
        END
        SUBROUTINE TAPOPN (NUNIT,TAPACS,TAPDEV,IBLK,ISTAT,ICHN)
        DOUBLE PRECISION TAPACS,TAPDEV
        INTEGER ICHN,ISTAT,NUNIT
C  PDP-10 IMPLEMENTATION FOR TAPE EXCHANGE PROGRAM
C  ERROR HANDLING SUBROUTINE (ERRSNS) EXISTS ONLY FOR FORTRAN V5 OR LATER.
C
C  A KLUDGY COMBINATION OF FORTRAN AND MACRO SUBROUTINES TO OPEN A MAGTAPE
C  AND SET UP FOR INDUSTRY STANDARD 9-TRACK TAPE IN 8-BIT ASCII
C  FORMAT.
C  ASSEMBLER-CODED ROUTINES TAPSET,CHNCHK AND CHNFND ARE IN TAPCHN.MAC
C
C  FIRST MUST TRICK FOROTS INTO TELLING WHICH SOFTWARE CHANNEL
C  IS ASSOCIATED WITH THIS UNIT NO.
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
  20    CALL CHNFND(ICHN,ISTAT)
        IF (ISTAT.EQ.3)GO TO 100
C  OPEN THE TAPE
        OPEN(UNIT=NUNIT,ACCESS=TAPACS,MODE='DUMP',DEVICE=TAPDEV,
     *          BLOCKSIZE=IBLK,ERR=100)
C  NOW MAKE SURE WE ACTUALLY GOT THE CHANNEL EXPECTED
        CALL CHNCHK(ICHN,TAPDEV,ISTAT)
        IF (ISTAT.EQ.3)GO TO 100
C  NOW SET UP FOR INDUSTRY STANDARD MODE
        CALL TAPSET(ICHN)
        RETURN
  100   CALL ERRSNS(I,J)
        WRITE(PRINTR,120)I,J,NUNIT
        ISTAT=3
  120   FORMAT(//' ?EXCHRT: CAN''T OPEN TAPE ',I6,X,'ERROR= ',2I6)
        RETURN
        END
      SUBROUTINE EXCHAH (RECORD,NCHAR)
C
C     CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO
C     HOLLERITH FORMAT.
C     THIS PROGRAM IS NOT MACHINE SENSITIVE.
C
C     RECORD IS THE RECORD TO BE CONVERTED.  THE HOLLERITH IS STORED
C     IN RECORD ALSO
      INTEGER RECORD(1)
C
C     NCHAR IS THE NUMBER OF CHARACTERS TO BE CONVERTED
C
      INTEGER XLATE(128)
      COMMON /EXCHXC/ XLATE
C
C
      DO 10 I=1,NCHAR
      J=RECORD(I)
10    RECORD(I)=XLATE(J+1)
      RETURN
      END
      SUBROUTINE EXCHSL
C
C     LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS.
C
C     EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE
C     SEGMENT.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      RETURN
      END
      SUBROUTINE EXCHTR (IBLOCK,OBLOCK)
C
C     TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER.
C
      INTEGER IBLOCK(1), OBLOCK(1)
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4.
C
      CALL EXCHFO (1)
      CALL EXCHFO (2)
      WORKF=-IABS(WORKF)
C
10    IF (TRANS.LE.0) RETURN
      CALL EXCHSL
C     LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS.
      GO TO (11,12,13,14,15,16,17,18,19), TRANS
C     COMMAND PARSER
11    CALL EXCHC1 (IBLOCK,OBLOCK)
      GO TO 10
C     IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE
12    CALL EXCHC2
      GO TO 10
C     OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE.
13    CALL EXCHC3 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE.
14    CALL EXCHC4 (IBLOCK)
      GO TO 10
C     COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE.
15    CALL EXCHC5 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY TEXT FROM INTAPE TO OUTAPE
16    CALL EXCHC6 (IBLOCK,OBLOCK)
      GO TO 10
C     TEXT COMMAND
17    CALL EXCHC7 (IBLOCK,OBLOCK)
      GO TO 10
C     ERROR MESSAGES
18    CALL EXCHC8
      GO TO 10
C     QUIT
19    CALL EXCHC9 (IBLOCK,OBLOCK)
      GO TO 10
      END
      SUBROUTINE EXCHGB (ISTAT,DBLOCK)
C
C     READ A BLOCK FROM THE EXCHANGE TAPE.
C     IGNORE THE ERROR CONTROL SEGMENT.
C     CHECK THE BLOCK SEQUENCE NUMBER.
C     CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER,
C               OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
C
C     READ A BLOCK FROM INTAPE.
C
      BLKSQI=BLKSQI+1
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 160
C
C     GET INFORMATION OUT OF THE BLOCK HEADER.
C
      CCDBI=NERRCI
      CWDBI=NWCBI*(CCDBI/NCCBI)+1
      CPCBI=MOD(CCDBI,NCCBI)
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
      DO 110 JUMP=1,9
      CCDBI=CCDBI+1
      CPCBI=CPCBI+1
      IF (CCDBI.GT.NCDBI) GO TO 130
      IF (CPCBI.LE.NCCBI) GO TO 10
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
10    GO TO (20,30,40,50,60,70,80,90,100), JUMP
20    NEWBLK=256*CBLCKI(CPCBI)
      GO TO 110
30    NEWBLK=NEWBLK+CBLCKI(CPCBI)
      GO TO 110
40    LASTI=CBLCKI(CPCBI)
      GO TO 110
50    L1PRGI=256*CBLCKI(CPCBI)
      GO TO 110
60    L1PRGI=L1PRGI+CBLCKI(CPCBI)
      GO TO 110
70    N1RECI=256*CBLCKI(CPCBI)
      GO TO 110
80    N1RECI=N1RECI+CBLCKI(CPCBI)
      GO TO 110
90    L1RECI=256*CBLCKI(CPCBI)
      GO TO 110
100   L1RECI=L1RECI+CBLCKI(CPCBI)
110   CONTINUE
C
C     CHECK THE BLOCK SEQUENCE NUMBER.
C
      IF (BLKSQI.EQ.NEWBLK) GO TO 150
      ISTAT=1
      WRITE (PRINTR,120) NEWBLK,BLKSQI
120   FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I
     15//)
      BLKSQI=NEWBLK
      GO TO 160
C
C     FORMAT ERROR
C
130   ISTAT=2
      GO TO 160
C
C     CHECK L1PRGI AND L1RECI.
C
150   IF (L1PRGI.GT.NCDBI) GO TO 130
      IF (L1RECI.GT.NCDBI) GO TO 130
      ISTAT=0
160   RETURN
C
      END
      SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD)
C
C     GET A RECORD FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK).
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE
C               SPACE ALLOWED BY THE USER.  (POSITION IS STILL OK).
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C     THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM
C     CONTROL RECORDS.  NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS.
C
      ISTAT=0
      NCHACT=0
10    JUMP=1
      GO TO 260
20    NG=CBLCKI(CPCBI)
      IF (NG.EQ.0) GO TO 90
      IF (NG.NE.255) GO TO 30
C
C     END OF SHORT TAPE BLOCK.
C
      CCDBI=NCDBI
      GO TO 10
C
C     UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO
C     THE USER RECORD AREA.
C
30    ITYPEI=0
      IF (MODEI.EQ.0) GO TO 40
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG
40    IG=0
50    JUMP=2
      GO TO 260
60    NR=CBLCKI(CPCBI)
      IF (MODEI.EQ.0) GO TO 70
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR
      GO TO 160
70    IR=0
C     PUT REMVI INTO THE USER RECORD NR TIMES.
80    IF (IR.GE.NR) GO TO 160
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI
      IR=IR+1
      GO TO 80
C
C     THE NEXT RECORD IS A CONTROL RECORD.  FIND OUT WHAT KIND.
C
90    JUMP=3
      GO TO 260
100   ITYPEI=CBLCKI(CPCBI)
      IF (ITYPEI.LT.65) GO TO 250
C     65 = ASCII  A
      IF (ITYPEI.GT.90) GO TO 250
C     90 = ASCII  Z
      I=ITYPEI-64
C             A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
      GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160
     1,110,160,220,160,160,160,160,160,160,160,160), I
C       P   Q   R   S   T   U   V   W   X   Y   Z
C
C     P - PROGRAM HEADER
C
C     CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER
110   REMVI=32
C     RESET THE REMOVED CHARACTER TO ASCII BLANK.
      JUMP=4
      GO TO 260
120   L1PRGI=256*CBLCKI(CPCBI)
      JUMP=5
      GO TO 260
130   L1PRGI=L1PRGI+CBLCKI(CPCBI)
      JUMP=6
      GO TO 260
140   N1RECI=256*CBLCKI(CPCBI)
      JUMP=7
      GO TO 260
150   N1RECI=N1RECI+CBLCKI(CPCBI)
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
160   JUMP=8
      GO TO 260
170   NC=CBLCKI(CPCBI)
      IF (ITYPEI.NE.0) GO TO 180
      IF (MODEI.EQ.0) GO TO 180
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC
C     COPY NC CHARACTERS TO THE USER RECORD AREA.
180   IC=0
      JUMP=9
190   IF (IC.GE.NC) IF (ITYPEI) 240,210,240
      GO TO 260
200   NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI)
      IC=IC+1
      GO TO 190
210   IG=IG+1
      IF (IG-NG) 50,240,240
C
C     J - UPDATING AND END OF INPUT TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
220   JUMP=10
      GO TO 260
230   RECORD(1)=CBLCKI(CPCBI)
      NCHACT=1
      IF (ITYPEI.EQ.82) REMVI=RECORD(1)
C     82 = ASCII R
C
C     RETURN TO THE USER PROGRAM.
C
240   IF (NCHACT.GT.NCHMAX) ISTAT=4
      GO TO 290
C
C     CONTROL RECORD TYPE CANNOT BE DETERMINED.
C
250   ISTAT=5
      GO TO 290
C
C     GET A CHARACTER FROM CBLOCK.  UNPACK A NEW BLOCK IF NECESSARY.
C     READ MORE TAPE IF NECESSARY.
C
260   CPCBI=CPCBI+1
      CCDBI=CCDBI+1
      IF (CCDBI.LE.NCDBI) GO TO 270
      CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 290,260,290
270   IF (CPCBI.LE.NCCBI) GO TO 280
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
280   GO TO (20,60,100,120,130,140,150,170,200,230), JUMP
290   RETURN
C
      END
      SUBROUTINE EXCHNP (ISTAT,DBLOCK)
C
C     SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE
C     TAPE.
C     THIS MODULE IS MACHINE INSENSITIVE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
      ISTAT=0
      IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20
C
C     CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK.
C
10    IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20
C     76 = ASCII L
C
C     NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK.
      CCDBI=L1PRGI-1
      I=NWCBI*(CCDBI/NCCBI)+1
      IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI)
      CWDBI=I
      CPCBI=MOD(CCDBI,NCCBI)
      GO TO 40
C
C     NO MORE HEADERS IN THIS BLOCK.
C
20    CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 40,10,40
C
C     END OF FILE.
C
30    ISTAT=7
C
40    RETURN
C
      END
      SUBROUTINE EXCHPB (ISTAT,DBLOCK)
C
C     WRITE A BLOCK ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C     WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK.
      INTEGER WORK(9)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
C     PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK.
C
      BLKSQO=BLKSQO+1
      WORK(1)=BLKSQO/256
      WORK(2)=MOD(BLKSQO,256)
      WORK(3)=LASTO
      WORK(4)=L1PRGO/256
      WORK(5)=MOD(L1PRGO,256)
      WORK(6)=N1RECO/256
      WORK(7)=MOD(N1RECO,256)
      WORK(8)=L1RECO/256
      WORK(9)=MOD(L1RECO,256)
C
      CPCBO=MOD(NERRCO,NCCBO)
      CWDBO=(NERRCO/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
C
      DO 10 I=1,9
      CPCBO=CPCBO+1
      IF (CPCBO.LE.NCCBO) GO TO 10
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
      CWDBO=CWDBO+NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
      CPCBO=1
10    CBLCKO(CPCBO)=WORK(I)
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
C
C     WRITE THE DATA BLOCK ON TAPE.
C
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L).
C
      IF (LASTO.NE.76) GO TO 20
      ISTAT=3
      CALL EXCHWT (ISTAT,DBLOCK)
      GO TO 30
C
C     COMPUTE POINTERS FOR NEXT BLOCK OUT.
C
20    L1PRGO=0
      LLPRGO=0
      N1RECO=0
      L1RECO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
C
30    RETURN
C
      END
      SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD)
C
C     WRITE A RECORD ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A
C             TEXT RECORD CONTAINS MORE THAN 254 GROUPS.
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER GC,RC(255),CC(255)
C     GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      ISTAT=0
      INCHAR=0
C
C     DETERMINE THE RECORD TYPE.
C
      IF (NCHOUT.NE.255) GO TO 10
      ITYPEO=255
      GO TO 70
10    IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO
      IF (ITYPEO.NE.0) GO TO 30
C
C     DATA RECORD.
C
      IF (MODEO.NE.0) GO TO 170
C     COMPRESS THE RECORD.
      CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255)
      IF (GC.GE.255) GO TO 210
      IG=0
C     OUTPUT THE GROUP COUNT.
      CBLCKO(CPCBO)=GC
      JUMP=1
      GO TO 230
20    IG=IG+1
      IF (IG.GT.GC) GO TO 250
      NC=CC(IG)
      INCHAR=INCHAR+RC(IG)
C     OUTPUT REMOVED CHARACTER COUNT.
      CBLCKO(CPCBO)=RC(IG)
      JUMP=2
      GO TO 230
C
C     THE USER SAYS HE HAS A CONTROL RECORD TO WRITE.  FIND OUT
C     WHAT KIND.
C
30    IF (ITYPEO.LT.65) GO TO 220
C     65 = ASCII A
      IF (ITYPEO.GT.90) GO TO 220
C     90 = ASCII  Z
      I=ITYPEO-64
C             A  B  C  D  E  F  G  H  I  J   K  L  M  N  O  P  Q  R   S
      GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40,
     140,40,40,40,40,40,40), I
C      T  U  V  W  X  Y  Z
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE TYPE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
40    IF (NCHOUT-255) 100,100,210
C
C     END OF FILE.
C
50    IF (NERRCO+NDATAO+7-CCDBO) 70,80,80
C
C     P - PROGRAM HEADER.
C
60    IF (NCHOUT.GT.255) GO TO 210
      REMVO=32
C     RESET REMOVED CHARACTER TO ASCII BLANK.
      IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80
      IF (CCDBO.EQ.NERRCO+10) GO TO 80
C
C     END OF SHORT TAPE BLOCK.
C
70    CBLCKO(CPCBO)=255
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250
C     69 = ASCII E
C     80 = ASCII P
      L1RECO=CCDBO-NERRCO
80    IF (LLPRGO.EQ.0) GO TO 90
C     LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK.
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      NC=MOD(LLPRGO+1,NCCBO)
      NW=((LLPRGO+1)/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      CBLCKO(NC+1)=CCDBO/256
      IF (NC+1.LT.NCCBO) GO TO 85
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      NW=NW+NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      NC=-1
85    CBLCKO(NC+2)=MOD(CCDBO,256)
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      CALL EXCHUN (DBLOCK(CWDBO),CBLCKO)
C     UPDATE TABLE OF CONTENTS POINTERS
90    LLPRGO=CCDBO
      IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO
      NLRECO=NLRECO+1
      IF (N1RECO.EQ.0) N1RECO=NLRECO
100   CBLCKO(CPCBO)=0
      JUMP=3
      GO TO 230
110   CBLCKO(CPCBO)=ITYPEO
      JUMP=4
      GO TO 230
120   IF (ITYPEO.NE.69) GO TO 130
C     69 = ASCII E
      LASTO=76
      GO TO 70
130   IF (ITYPEO.NE.80) GO TO 170
C     80 = ASCII P
      CBLCKO(CPCBO)=0
      JUMP=5
      GO TO 230
140   CBLCKO(CPCBO)=0
      JUMP=6
      GO TO 230
150   CBLCKO(CPCBO)=NLRECO/256
      JUMP=7
      GO TO 230
160   CBLCKO(CPCBO)=MOD(NLRECO,256)
      JUMP=8
      GO TO 230
C
170   NC=NCHOUT
180   CBLCKO(CPCBO)=NC
      IC=0
      JUMP=9
C     PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD.
      IF (ITYPEO.EQ.82) GO TO 190
      IF (ITYPEO.EQ.74) GO TO 190
      IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230
190   IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250
      INCHAR=INCHAR+1
      IC=IC+1
      CBLCKO(CPCBO)=RECORD(INCHAR)
      GO TO 230
C
C     J - UPDATING AND END OF TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
200   NCHOUT=1
      IF (ITYPEO.EQ.82) REMVO=RECORD(1)
C     82 = ASCII R
      GO TO 100
C
C     RECORD TOO LONG.
C
210   ISTAT=4
      GO TO 250
C
C     UNKNOWN CONTROL RECORD TYPE.
C
220   ISTAT=5
      GO TO 250
C
C     INCREMENT THE OUTPUT BUFFER POINTERS.  PACK A CHARACTER BLOCK
C     IF NECESSARY.  WRITE A TAPE BLOCK IF NECESSARY.
C
230   CPCBO=CPCBO+1
      CCDBO=CCDBO+1
      IF (CPCBO.LE.NCCBO) GO TO 240
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CWDBO=CWDBO+NWCBO
      CPCBO=1
      IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 250
240   GO TO (20,180,110,120,140,150,160,170,190), JUMP
250   RETURN
C
      END
      SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL)
C
C     SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE
C     DATA TO BE REMOVED.  DIVIDE DATA INTO GROUPS CONSISTING OF
C     STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT
C     DATA.  THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE
C     REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP
C     ARE RECORDED IN RC() AND SC() RESPECTIVELY.  MAXSL IS THE
C     MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC().
C
      INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL
C
C     RC AND SC MUST BE AT LEAST (IMGLEN-1)//3.
C
      GC=1
      SC(1)=0
      RC(1)=0
      MODE=-1
      INPLEN=IABS(IMGLEN)
C
C     IDENTIFY DATA GROUPS.
C
      DO 110 I=1,INPLEN
      IF (MODE) 40,60,90
C
C     MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE.
C
40    IF (INPIMG(I).EQ.REMOVE) GO TO 50
C     SWITCH TO SIGNIFICANT DATA SCAN.
      MODE=1
      SC(GC)=1
      GO TO 110
C     CONTINUE REMOVE SCAN
50    RC(GC)=RC(GC)+1
      IF (RC(GC)-MAXSL) 110,95,110
C
C     MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY
C     ONE OCCURRENCE OF REMOVE.  CHANGE TO REMOVE MODE IF ANOTHER REMOVE
C     OCCURS OR BACK TO DATA MODE IF NOT.
C
60    IF (INPIMG(I).EQ.REMOVE) GO TO 80
C     SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT.
      MODE=1
      IF (SC(GC).GE.MAXSL-2) GO TO 70
      SC(GC)=SC(GC)+2
      GO TO 110
C     FULL GROUP
70    GC=GC+1
      RC(GC)=1
      SC(GC)=1
      GO TO 110
C     SWITCH TO REMOVE MODE.
80    GC=GC+1
      SC(GC)=0
      RC(GC)=2
      MODE=-1
      GO TO 110
C
C     MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA.
C
90    IF (INPIMG(I).EQ.REMOVE) GO TO 100
      SC(GC)=SC(GC)+1
      IF (SC(GC).NE.MAXSL) GO TO 110
C     FULL GROUP
      MODE=-1
95    IF (I.GE.INPLEN) GO TO 120
      GC=GC+1
      RC(GC)=0
      SC(GC)=0
      GO TO 110
100   MODE=0
110   CONTINUE
120   RETURN
C
      END
      SUBROUTINE EXCHTP (RECORD,LINEI)
C
C     MATERIALIZE INCLUDES IF INALT IS NON-ZERO.
C     CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE
C     AND THE PRINTER IF LISTING IS REQUESTED.
C     LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C
      INTEGER RECORD(1),LINEI
C
C     *****     LOCAL VARIABLES     ************************************
C
C COPY    DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR
C         SKIPPING TEXT NOT TO BE INCLUDED.
      INTEGER COPY
C DASH    CONTAINS '-' IN HOLLERITH.
      INTEGER DASH
C ENDMRK  HOLDS THE END SENTINEL.
      INTEGER ENDMRK(40)
C NCHEND  IS THE NUMBER OF CHARACTERS IN ENDMRK.
      INTEGER NCHEND
C NCHSAV  SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD.
      INTEGER NCHSAV
C NCHTAR  IS THE NUMBER OF CHARACTERS IN TARGET.
      INTEGER NCHTAR
C STAR    CONTAINS '*' IN HOLLERITH.
       INTEGER STAR
C TARGET  IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY).
      INTEGER TARGET(40)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL DATA     ***************************************
C
      DATA DASH /1H-/, STAR /1H*/
C
C     *****     PROCEDURES     *****************************************
C
      LINEO=LINEO+1
      IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190
      RECORD(180)=LINEO
      RECORD(179)=LINEI
      COPY=-1
C     COPY=-1 MEANS NOT COPYING INCLUDED TEXT.
      IF (ITYPEO.EQ.0) GO TO 110
C     PROCESS INCLUDE RECORD.
      DO 10 I=1,NCHOUT
10    RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I)
C     INSERT '-I '.
      RECORD(1)=45
      RECORD(2)=73
      RECORD(3)=32
      NCHOUT=NCHOUT+3
      IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110
C     STORE SEARCH TARGET
      NCHTAR=MIN0(NCHOUT,40)
      DO 20 I=1,NCHTAR
20    TARGET(I)=RECORD(I)
C     STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
      NCHSAV=NCHCMD
      DO 30 I=1,NUMBER
30    OUTREC(I)=COMAND(I)
      COPY=0
C     COPY=0 MEANS SKIPPING MODULE ON INALT FILE.
      INALT=IABS(INALT)
      NEOF=0
40    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
      IF (NCHCMD.LT.2) GO TO 40
      IF (COMAND(1).NE.45) GO TO 40
C     45 = ASCII -
      IF (COMAND(2).EQ.45) GO TO 130
      IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40
C     73 = ASCII I, 105 = ASCII LOWER CASE I.
C     COMPARE IMAGE WITH SEARCH TARGET.
      IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60
      DO 50 I=2,NCHTAR
      K=COMAND(I)
      IF (K.GT.96 .AND. K.LT.123) K=K-32
      IF (TARGET(I).NE.K) GO TO 60
50    CONTINUE
      NEOF=3
C     PREVENT SEARCH LOOP.
      COPY=1
C     COPY=1 MEANS COPYING INCLUDED TEXT.
60    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     STORE END OF INCLUDE MODULE SIGNAL.
      NCHEND=MIN0(40,NCHCMD)
      DO 70 I=1,NCHEND
70    ENDMRK(I)=COMAND(I)
      IF (COPY.EQ.0) GO TO 80
      CHAR1L=DASH
      NCHOUT=NCHTAR
      DO 75 I = 1,NCHOUT
75    COMAND(I)=TARGET(I)
      COMAND(180)=LINEO
      COMAND(179)=LINEI
C     GO PRINT TARGET.
      CALL EXCHTW (COMAND,-1)
      GO TO 120
C     COPY OR SKIP UNTIL ENDMRK SEEN AGAIN.
80    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF.
C     TEST FOR ENDMRK
      DO 90 I=1,NCHEND
      IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100
90    CONTINUE
      IF (COPY) 140,40,140
C     OUTPUT TEXT RECORD.
100   COMAND(180)=LINEO
      COMAND(179)=LINEI
      NCHOUT=NCHCMD
      CALL EXCHTW (COMAND,OPTI)
      GO TO 120
C     OUTPUT TEXT RECORD.
110   CALL EXCHTW (RECORD,1)
120   IF (COPY) 190,190,80
C     WE ONLY GET HERE WITH COPY .GE. 0.
130   NEOF=NEOF+1
      ACTION=2
C     ACTION = 2 MEANS REOPEN INALT.
      CALL EXCHIM
      IF (NEOF.LT.2) GO TO 40
140   INALT=-IABS(INALT)
      NCHCMD=1
      IF (COPY.GT.0) GO TO 170
C     PROCESS TARGET AS THOUGH IT WERE TEXT.
      NCHOUT=NCHTAR
C     SAVE TARGET FOR ERROR MESSAGE.
      DO 150 I=1,NCHTAR
150   COMAND(I)=TARGET(I)
      CALL EXCHTW (COMAND,1)
      CALL EXCHAH (TARGET,NCHTAR)
      WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR)
160   FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8
     10A1))
      NERRS=MAX0(NERRS,3)
C
C     RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
C
170   NCHCMD=NCHSAV
      DO 180 I=1,NUMBER
180   COMAND(I)=OUTREC(I)
C
190   CHAR1L=STAR
      RETURN
C
      END
      SUBROUTINE EXCHTW (RECORD,OPTION)
C
C     WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING
C     EXCHOU.  WRITE RECORD ON THE PRINTER IF LISTING REQUESTED.
C     RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C     IF OPTION = ZERO, WRITE TO FILE ONLY.
C     IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING.
C     IF OPTION .LT. ZERO, WRITE TO LISTING ONLY.
C
      INTEGER RECORD(1),OPTION
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     PROCEDURES     *****************************************
C
      LINEI=RECORD(179)
      IF (OPTION.LT.0) GO TO 130
C
C     INSERT IDENTIFICATION IF REQUESTED.
C
      IF (IDCOL2.LT.IDCOL1) GO TO 120
      IF (IDTXTL+IDSTEP.EQ.0) GO TO 120
      IF (NCHOUT.GE.IDCOL2) GO TO 20
      J=IDCOL2-1
C     FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2
      DO 10 I=NCHOUT,J
10    RECORD(I+1)=32
C     32 = ASCII BLANK.
20    NCHOUT=MAX0(NCHOUT,IDCOL2)
      N=-1
      IF (LINEI.EQ.0) GO TO 40
      IF (IDOPTN.NE.73) GO TO 40
C     73 = ASCII I.  IDENTIFY ONLY FROM INTAPE.
      N=(LINEI-1)*IDSTEP+IDSTRT
      GO TO 70
40    IF (IDOPTN.NE.79) GO TO 50
C     79 = ASCII O.  IDENTIFY ONLY TO OUTAPE.
      N=(LINEO-1)*IDSTEP+IDSTRT
      GO TO 70
50    IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70
C     67 = ASCII C, 70 = ASCII F.  IDENTIFY EVERYTHING.
      N=IDCUR
70    IF (N.LT.0) GO TO 120
      IF (IDTXTL.EQ.0) GO TO 100
      J=MIN0(IDCOL2,IDTXTL+IDCOL1-1)
      K=1
      DO 80 I=IDCOL1,J
      RECORD(I)=IDTEXT(K)
80    K=K+1
100   IF (IDSTEP.EQ.0) GO TO 120
      IDCUR=IDCUR+IDSTEP
      K=IDCOL2
110   RECORD(K)=MOD(N,10)+48
      N=N/10
      K=K-1
      IF (N.EQ.0) GO TO 120
      IF (K.GE.IDCOL1) GO TO 110
C
C     OUTPUT RECORD.
C
120   IF (OUFILE.NE.0) CALL EXCHOU (RECORD)
      IF (OPTION.EQ.0) GO TO 220
130   IF (OPTL.NE.0) GO TO 140
      IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220
140   CALL EXCHAH (RECORD,NCHOUT)
      IF (OPTV+VERT.NE.0) GO TO 200
      IF (PHASE.NE.8) GO TO 180
      IF (LINEI.EQ.0) GO TO 160
      WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
150   FORMAT (1X,2I5,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
160   WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
170   FORMAT (5H  NEW,I6,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
180   WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
190   FORMAT (1X,I5,A1,3X,110A1/(6H  CONT,4X,110A1))
      GO TO 220
200   WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT)
210   FORMAT (132A1)
220   RETURN
C
      END
      SUBROUTINE EXCHC1 (IBLOCK,OBLOCK)
C
C     COMMAND DECODER AND FORMAT VERIFIER.  SOME COMMANDS ARE ALSO
C     COMPLETELY PROCESSED HERE.
C
C     IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS.
C
      INTEGER IBLOCK(1),OBLOCK(1)
C
C
C     *****     LOCAL VARIABLES     ************************************
C
C ALLOW   TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED.  VALUES ARE
C         SUMS OF PERMITTED VALUES OF PHASE.
C         1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING,
C         8 = UPDATING.
C         ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A
C         PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR
C         MAY BE VOID (EQUAL SIGN IS LAST CHARACTER).
C         32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT.
      INTEGER ALLOW(35)
C BLANK   A CONSTANT.  1H .
      INTEGER BLANK
C DATE    IS THE DATE FROM UPDA=, DATE=, ORIG=.
      INTEGER DATE(3)
C DAYS    TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS.
      INTEGER DAYS(12)
C I       IS USED FREELY AS AN INDEX.
C J       IS USED FREELY AS AN INDEX.
C JUMP    USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE.
C K       IS USED FREELY AS AN INDEX.
C KDATE   IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD).
C KQUIT   IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD).
C KTEXT   IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD).
C N       IS USED FREELY AS AN INDEX.
C NCNREC  IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS.
C ND      IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER.
C NM      IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER.
C NY      IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER.
C TVAL    A VECTOR OF VALUES FOR TRANS.  INDEXED BY ICOMD.
      INTEGER TVAL(35)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL EQUIVALENCE     **********************************
C
      EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND)
C
C     *****     DATA STATEMENTS     ************************************
C
      DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/
      DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/
      DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/
      DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/
      DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/
      DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/
      DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/
      DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/
      DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/
      DATA BLANK /1H /
      DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/
      DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/
      DATA DAYS(11),DAYS(12) /30,31/
      DATA KDATE /5/
      DATA KQUIT /20/
      DATA KTEXT /27/
      DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/
      DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/
      DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/
      DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/
      DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/
      DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/
      DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/
C
C     *****     PROCEDURES     *****************************************
C
C     GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER.
C     ECHO IT IF THE E OPTION IS SET.  DETERMINE WHETHER IT IS A CHANGE
C     TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND.
C
10    NCNREC=0
20    ACTION=0
      IF (NCHCMD.LT.0) GO TO 220
      CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (OPTE.EQ.0) GO TO 27
      WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD)
23    FORMAT (1X,80A1)
      CHAR1L=0
27    NCHCMD=MIN0(NCHCMD,MARGIN)
      IF (PHASE.LT.4) SIGNAL=45
C     45 = ASCII -
      IF (COMAND(1).NE.45) GO TO 50
C     45 = ASCII -.  REQUEST TO CHANGE CONTROL RECORD.
      IF (PHASE.LT.4) GO TO 40
      WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD)
30    FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT
     1OR UPDATE/1X,80A1)
      NERRG=MAX0(NERRG,2)
      GO TO 200
40    ICOMD=0
      EQUAL=2
      TRANS=3
      GO TO 370
50    IF (COMAND(1).NE.42) GO TO 70
C     42 = ASCII *.  COMMENT RECORD.  JUST ECHO IT.
      NCHCMD=MAX0(NCHCMD,2)
      WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD)
60    FORMAT (A1,1H*,78A1/(1X,80A1))
      GO TO 10
C
C     SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR
C     EQUAL SIGN ARE FOUND.  LOOK UP THE WORD IN THE COMMAND NAME TABLE.
C
70    EQUAL=0
      DO 80 I=1,NCHCMD
      IF (COMAND(I).EQ.32) GO TO 80
C     32 = ASCII BLANK
      EQUAL=EQUAL+1
      ICOMD=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32
C     ABOVE STATEMENT CONVERTS TO UPPER CASE.
      COMAND(I)=32
      COMAND(EQUAL)=ICOMD
      IF (EQUAL.GE.4) GO TO 90
      IF (ICOMD.EQ.61) GO TO 90
C     61 = ASCII =.
      IF (ICOMD.EQ.44) GO TO 90
C     44 = ASCII ,.
80    CONTINUE
      IF (EQUAL.EQ.0) GO TO 185
90    DO 110 ICOMD=1,NCOMDT
      DO 100 K=1,EQUAL
      IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110
100   CONTINUE
      IF (EQUAL.EQ.4) GO TO 130
      IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130
C     32 = ASCII BLANK.
110   CONTINUE
C
C     UNRECOGNIZED COMMAND.
C
120   ICOMD=0
C
C     LOOK FOR AN EQUAL SIGN.  SET THE VARIABLE NAMED EQUAL TO ZERO IF
C     THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK
C     CHARACTER FOLLOWING THE EQUAL SIGN.
C
130   MODIFY=0
140   DO 150 I=EQUAL,NCHCMD
      K=COMAND(I)
      IF (K.EQ.61) GO TO 160
C     61 = ASCII =.
      IF (MODIFY.NE.0) GO TO 150
C     USE FIRST MODIFIER.
      IF (K.EQ.44) GO TO 160
C     44 = ASCII ,.
150   CONTINUE
      EQUAL=0
      GO TO 170
160   I=I+1
      EQUAL=I
      IF (I.GT.NCHCMD) GO TO 170
      IF (COMAND(I).EQ.32) GO TO 160
C     32 = ASCII BLANK
      IF (K.NE.44) GO TO 170
C     44 = ASCII ,.
      MODIFY=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32
C     CONVERT TO UPPER CASE.
      GO TO 140
170   IF (K.NE.61) EQUAL=0
C     61 = ASCII =.
      IF (ICOMD.EQ.0) GO TO 180
      IF (ICOMD.GT.NCOMDP) GO TO 180
      IF (EQUAL.GT.NCHCMD) GO TO 175
      IF (EQUAL.NE.0) GO TO 230
      IF (ALLOW(ICOMD)/64.NE.0) GO TO 230
175   IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690
C     PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK.
      NCHCMD=NCHCMD+1
      EQUAL=NCHCMD
      COMAND(NCHCMD)=32
C     32 = ASCII BLANK
      HOLCMD(NCHCMD)=BLANK
      GO TO 230
C
C     GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX.
C
180   CALL EXCHCX (0)
C     IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND.
      IF (ICOMD.NE.0) GO TO 730
185   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1))
      NERRG=MAX0(NERRG,5)
200   CHAR1L=0
      NCNREC=NCNREC+1
      IF (NCNREC.LE.20) GO TO 20
      WRITE (PRINTR,210)
210   FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU
     1MES TEXT COMMAND IS MISSING.)
      GO TO 270
C
C     END OF FILE - SIMULATE A QUIT COMMAND.
C
220   ICOMD=KQUIT
C
C     RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME.
C
230   IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240
      TRANS=TVAL(ICOMD)
C             1   2   3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300
     1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7
     230,370,730,370), ICOMD
C       16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
C     32  33  34  35
C
C     THE COMMAND IS NOT ALLOWED AT THIS TIME.
C
240   WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE
     1D./1X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
C     DECIDE WHETHER TO SKIP TEXT
260   IF (ICOMD.NE.KTEXT) GO TO 10
      IF (EQUAL.NE.0) GO TO 10
270   WRITE (PRINTR,280)
280   FORMAT (//15H0SKIPPING TEXT.)
290   CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (NCHCMD.LT.2) GO TO 290
      IF (COMAND(1).NE.SIGNAL) GO TO 290
      IF (COMAND(2).EQ.SIGNAL) GO TO 10
      IF (NCHCMD.LT.3) GO TO 290
      IF (COMAND(2).NE.61) GO TO 290
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 290
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING.
C     DATE=YYMMDD
C     ORIGIN=YYMMDD SITE
C     UPDATE=YYMMDD SITE
C     IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE
C     THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED.
C
300   IF (EQUAL+5.GT.NCHCMD) GO TO 700
      I=EQUAL
      DO 310 J=1,3
      DATE(J)=0
      DO 310 K=1,2
      N=COMAND(I)-48
      IF (N.LT.0) GO TO 320
      IF (N.GT.9) GO TO 320
      DATE(J)=10*DATE(J)+N
310   I=I+1
      IF (NM.EQ.0) GO TO 320
      IF (NM.GT.12) GO TO 320
      IF (ND.LE.0) GO TO 320
      DAYS(2)=28
      IF (MOD(NY,4).EQ.0) DAYS(2)=29
      IF (NY.EQ.0) DAYS(2)=28
      IF (ND.LE.DAYS(NM)) GO TO 440
320   IF (ICOMD.EQ.KDATE) GO TO 700
      IF (TODAY(1).EQ.32) GO TO 700
      I=MIN0(NCHCMD+6,180)
      NCHCMD=I
      J=I-6
      IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1
C     32 = ASCII BLANK
      IF (J.LT.EQUAL) GO TO 700
330   COMAND(I)=COMAND(J)
      HOLCMD(I)=HOLCMD(J)
      J=J-1
      I=I-1
      IF (J.GE.EQUAL) GO TO 330
      DO 340 I=1,6
      COMAND(I+EQUAL-1)=TODAY(I)
340   HOLCMD(I+EQUAL-1)=TODAY(I)
      CALL EXCHAH (HOLCMD(EQUAL),6)
      WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD)
345   FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1))
      NERRG=MAX0(NERRG,1)
      GO TO 440
C
C     REWIND INTAPE
C
350   IF (INTAPE.EQ.0) GO TO 680
      IF (INTOPN.NE.0) GO TO 360
      I=1
C     OPEN INTAPE IF NOT ALREADY OPEN.  DO NOT CHECK EXCH LABEL.
      CALL EXCHRT (I,IBLOCK)
C     IGNORE STATUS
360   I=2
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
      GO TO 725
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH
C     BEGINS WITH A NUMBER FOLLOWED BY A BLANK.
C
C     INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     INTAPE = NUMBER SYSTEM DEPENDENT DATA
C     LIMIT = NUMBER
C     MARGIN = NUMBER
C     OUTAPE = NUMBER SYSTEM DEPENDENT DATA
C     OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     PRINTER = NUMBER
C     READER = NUMBER
C     SKIP = NUMBER
C     TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL)
C     WORK = NUMBER
C
370   NUMBER=0
      IF (EQUAL.EQ.0) GO TO 440
      DO 410 J=EQUAL,NCHCMD
      IF (COMAND(J).EQ.32) GO TO 420
C     32 = ASCII BLANK
      N=COMAND(J)-48
C     48 = ASCII ZERO
      IF (N.GE.0) GO TO 400
380   WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD)
390   FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS.  NOT PROCESSED./
     11X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
      GO TO 260
400   IF (N.GT.9) GO TO 380
410   NUMBER=10*NUMBER+N
      EQUAL=NCHCMD+1
      GO TO 440
420   EQUAL=J
430   EQUAL=EQUAL+1
      IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440
C     32 = ASCII BLANK
C
C     PRELIMINARY FORMAT CHECKING IS COMPLETE
C
440   J=ICOMD+1
C             0  1   2  3  4  5   6  7  8   9  10 11  12 13 14  15  16
      GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6
     120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595),
     2J
C     17 18  19 20  21 22 23 24 25  26  27 28  29  30 31 32  33 34  35
C
C     DATE=YYMMDD
C
450   DO 460 I=1,6
460   TODAY(I)=COMAND(EQUAL+I-1)
      GO TO 10
C
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA.
C
470   I=INFILE
      J=1
      GO TO 500
C
C     INCLUDE = NUMBER SYSTEM DEPENDENT DATA.
C
480   I=INALT
      J=3
      INALT=IABS(INALT)
      GO TO 500
C
C     TEXT
C
490   I=INTEXT
      J=2
      IF (EQUAL.EQ.0) GO TO 560
C
C     OPEN AN INPUT FILE.
C
500   IF (NUMBER.EQ.0) GO TO 505
      IF (NUMBER.EQ.OUFILE) GO TO 710
      IF (NUMBER.EQ.OUTAPE) GO TO 710
505   IF (J.EQ.2) GO TO 510
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (I.NE.0) CALL EXCHIM
510   IF (J-2) 520,530,540
520   INFILE=NUMBER
      GO TO 550
530   INTEXT=NUMBER
      GO TO 550
540   INALT=NUMBER
550   IF (NUMBER.EQ.0) GO TO 560
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      CALL EXCHCX (J+1)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHIM
      ACTION=2
C     ACTION = 2 MEANS REWIND
      IF (J.EQ.3) CALL EXCHIM
      INALT=-IABS(INALT)
560   ACTION=0
C     ACTION = 0 MEANS READ TEXT
      GO TO 730
C
C     INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
570   IF (INTOPN.EQ.0) GO TO 580
C     CLOSE THE INPUT TAPE, IGNORE STATUS.
      I=4
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
580   INTAPE=NUMBER
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (INTAPE.NE.0) CALL EXCHCX (6)
      GO TO 725
C
C     LIMIT = NUMBER
C
590   LIMIT=NUMBER
      GO TO 10
C
C     MARGIN = NUMBER
C
C     MINIMUM MARGIN IS 60
595   MARGIN=MAX0(NUMBER,60)
      GO TO 10
C
C     OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
600   IF (OUTOPN.EQ.0) GO TO 610
C     WRITE AND END-OF-FILE MARK ON OUTAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (I,OBLOCK,OBLOCK)
C     IGNORE STATUS
      OUTOPN=0
      PHASE=1
610   OUTAPE=NUMBER
      OUTUPD=MODIFY
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (OUTAPE.NE.0) CALL EXCHCX (7)
      GO TO 730
C
C     OUTPUT =  NUMBER SYSTEM DEPENDENT INFORMATION
C
620   ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      OUFILE=NUMBER
      IDCUR=IDSTRT
      IF (OUFILE.EQ.0) GO TO 730
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND.
      CALL EXCHCX (5)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHOU (OUTREC)
      GO TO 730
C
C     PRINTER = NUMBER.
C
630   CALL EXCHFO (-2)
      PRINTR=NUMBER
      CALL EXCHFO (2)
      GO TO 10
C
C     READER = NUMBER.
C
640   IF (INFILE.NE.0) GO TO 670
      CALL EXCHFO (-1)
      READER=NUMBER
      CALL EXCHCX (1)
      CALL EXCHFO (1)
      GO TO 10
C
C     WORK = NUMBER
C
650   IF (WORKF.GT.0) CALL EXCHFO (-3)
      WORKF=NUMBER
C     WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4.
      GO TO 10
C
C     UPDATE
C
C     DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR
C     SIMPLY TO OUTPUT THE UPDATE COMMAND.
660   IF (PHASE.GE.4) TRANS=5
      GO TO 730
C
C     ERROR MESSAGES.
C
670   NUMBER=3
C     MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE.
      GO TO 720
680   NUMBER=4
C     MESSAGE 4 - INTAPE IS NOT DEFINED.
      GO TO 720
690   NUMBER=12
C     MESSAGE 12 - NO PARAMETER STRING.
      GO TO 720
700   NUMBER=13
C     MESSAGE 13 - IMPROPER DATE.
      GO TO 720
710   NUMBER=31
C     MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT.
C
C     RETURN TO ERROR MESSAGE SEGMENT.
C
720   TRANS=8
      GO TO 740
c
c     Indicate the WORK file is empty.
c
725   if (nrwork.le.0 .or. workf.le.0) go to 730
      REWIND WORKF
      NRWORK=0
C
C     IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP.
C
730   IF (TRANS.EQ.1) GO TO 10
740   RETURN
C
      END
      SUBROUTINE EXCHCX (REASON)
C
C========================
C
C     PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER
C     PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT,
C     INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS.
C     DEC PDP-10 VERSION.
C
C     RECOGNIZE THE TABS COMMAND.
c     TABS=Y or D means HT is data, TABS=N or T means HT is tab.
C
      INTEGER REASON
C
C     REASON=0 FOR UNRECOGNIZED COMMAND.
C     REASON=1 BEFORE OPENING READER.
C     REASON=2 BEFORE OPENING INFILE.
C     REASON=3 BEFORE OPENING INTEXT.
C     REASON=4 BEFORE OPENING INALT.
C     REASON=5 BEFORE OPENING OUFILE.
C     REASON=6 BEFORE OPENING INTAPE.
C     REASON=7 BEFORE OPENING OUTAPE.
C
C
C========================
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      LOGICAL TABS
      DOUBLE PRECISION FNAMES(3)
      DOUBLE PRECISION DSKACS
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCRSX/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      IF (REASON.NE.0) GO TO 20
      IF (ICOMD.EQ.0) GO TO 140
C
C     COMMAND NOT RECOGNIZED BY EXCHC1 - IT MUST BE A TABS COMMAND.
C
      IF (EQUAL.EQ.0 .OR. EQUAL.GT.NCHCMD) GO TO 100
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
      IF (J.NE.68 .AND. J.NE.89) GO TO 10
C     68 = ASCII D, 89 = ASCII Y.
      TABS=.TRUE.
      GO TO 140
10    IF (J.NE.78 .AND. J.NE.84) GO TO 100
C     78 = ASCII N, 84 = ASCII T.
      TABS=.FALSE.
      GO TO 140
C
C     PROCESS SYSTEM DEPENDENT INFORMATION
C
20    J=MAX0(REASON-4,1)
      FNAMES(J)='          '
      K=MIN0(NCHCMD,EQUAL+9)
      IF (EQUAL.LE.K) ENCODE (10,30,FNAMES(J)) (HOLCMD(I),I=EQUAL,K)
30    FORMAT (10A1)
      IF (REASON-5) 40,50,140
C
C     OPEN INPUT.
C
40    DSKACS='SEQIN'
      GO TO 60
C
C     OPEN OUTPUT
C
50    DSKACS='SEQOUT'
C
60    OPEN (UNIT=NUMBER,FILE=FNAMES(1),DEVICE='DSK',ACCESS=DSKACS,
     * ERR=80)
      WRITE (PRINTR,70) NUMBER,DSKACS,FNAMES(1)
70    FORMAT (' OPENED',I3,' FOR ',A10,' ON ',A10)
      GO TO 140
C
C     ERROR WHILE OPENING FILE.
C
80    WRITE (PRINTR,90) NUMBER,FNAMES(1)
90    FORMAT (//'0UNABLE TO OPEN',I3,' FOR ',A10)
      GO TO 120
C
100   WRITE (PRINTR,110)
110   FORMAT ('Missing or unrecognized parameter on TABS command.')
120   WRITE (PRINTR,130) (HOLCMD(I),I=1,NCHCMD)
130   FORMAT (1X,80A1)
      NERRG=MAX0(NERRG,5)
140   RETURN
C
      END
      SUBROUTINE  EXCHC2
C
C     PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KINDE /32/
      DATA KOPTI /14/
      DATA KSITE /25/
C
C     FIGURE OUT WHICH COMMAND GOT US HERE.
C
      IF (ICOMD-KOPTI) 60,150,10
10    IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270
C
C     ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT
C     WHERE C1, C2, STEP AND START ARE INTEGERS.
C     STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP,
C     START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF
C     CHARACTERS OF TEXT IN IDTXTL.  IF AN ERROR OCCURS,
C     STORE ZERO IN IDSTEP AND IDTXTL.
C     IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO.
C
C     STORE THE MODIFIER IN IDOPTN.
C     IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE
C     PRODUCED ONLY FOR IMAGES FROM INTAPE.  IF THE O MODIFIER
C     IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES
C     WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT.  IF THE F
C     MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION
C     OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE
C     PRODUCED FOR ALL IMAGES OUTPUT.  IF THE C MODIFIER IS SPECIFIED,
C     SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH
C     RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR
C     ALL IMAGES OUTPUT.  IF NONE OF THE I, F, OR C MODIFIERS ARE
C     SPECIFIED, THE O MODIFIER IS ASSUMED.
C
C     IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED.
C     IF IDTXTL = ZERO, TEXT IS NOT EMITTED.
C     IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE
C     EMITTED.
C
C     CONVERT C1,C2,STEP,START
C
      IDOPTN=MODIFY
      IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79
C     70 = ASCII F, 73 = ASCII I, 79 = ASCII O.
      DO 40 J=1,4
      NUMBER=0
20    IF (EQUAL.GT.NCHCMD) GO TO 40
      IF (COMAND(EQUAL).EQ.44) GO TO 30
C     44 = ASCII ,
      I=COMAND(EQUAL)-48
      IF (I.LT.0) GO TO 350
      IF (I.GT.9) GO TO 350
      NUMBER=10*NUMBER+I
      EQUAL=EQUAL+1
      GO TO 20
30    EQUAL=EQUAL+1
40    IDNBRS(J)=NUMBER
      IDCUR=IDSTRT
      IDCOL1=MAX0(1,MIN0(IDCOL1,178))
      IDCOL2=MIN0(IDCOL2,178)
C
C     STORE TEXT.
C
      IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0)
      IF (IDTXTL.EQ.0) GO TO 330
      DO 50 J=1,IDTXTL
      IDTEXT(J)=COMAND(EQUAL)
50    EQUAL=EQUAL+1
      GO TO 330
C
C     INDEX = PARAMETER STRING
C
60    J=0
      IF (COMAND(EQUAL).NE.45) GO TO 70
C     45 = ASCII -
      J=-1
      EQUAL=EQUAL+1
70    N=0
      DO 80 I=1,26
80    INDEXS(I)=0
90    IF (EQUAL.GT.NCHCMD) GO TO 130
      I=COMAND(EQUAL)-64
      IF (I.EQ.-32) GO TO 120
C     32 = ASCII BLANK.
      IF (I.GE.32) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.LE.0) GO TO 100
      IF (I.LE.26) GO TO 110
100   N=EQUAL
      GO TO 120
110   INDEXS(I)=1
120   EQUAL=EQUAL+1
      GO TO 90
130   INDEX=0
      DO 140 I=1,26
      INDEXS(I)=IABS(INDEXS(I)+J)
140   INDEX=INDEX+INDEXS(I)
      IF (MODIFY.EQ.76) INDEX=-INDEX
C     76 = ASCII L.
      IF (N) 340,330,340
C
C     OPTION = PARAMETER STRING
C
150   IF (MODIFY.NE.0) GO TO 170
      DO 160 I=1,26
160   OPTVAL(I)=0
170   IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330
      I=1
      IF (MODIFY.EQ.67) I=0
C     67 = ASCII C.
      N=0
      DO 190 J=EQUAL,NCHCMD
      K=COMAND(J)
      IF (K.GE.96) K=K-32
C     CONVERT TO UPPER CASE.
      IF (K.EQ.32) GO TO 190
C     32 = ASCII BLANK
      IF (K.LT.65) GO TO 180
      IF (K.GT.90) GO TO 180
C     PROCESS ALPHABETIC OPTIONS.
      OPTVAL(K-64)=I
      GO TO 190
180   N=J
190   CONTINUE
      IF (N) 330,330,340
C
C     PROCESS PRED = ID REC A/X MASK STRING
C       WHERE ID = PREDICATE IDENTIFIER (A-H),
C       REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE,
C       A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH
C             IN EXACT POSITION,
C       MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE
C              TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED.
C       STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF
C                CONTROL RECORDS.
C
C     THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR
C     PREDICATE A, ETC.
C
C     PRED(1,*)=LENGTH OF STRING + 3
C     PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED.
C     PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND).
C     PRED(3,*)=RECORD TYPE.
C     PRED(4,*)=A/X
C     PRED(5,*)=MASK CHARACTER.
C     PRED(6..42,*)=STRING.
C
200   IF (EQUAL.NE.0) GO TO 240
C     LIST ALL ACTIVE PREDICATES.
      DO 230 I=1,8
      IF (PRED(1,I).EQ.0) GO TO 230
      J=PRED(1,I)+1
      COMAND(1)=I+64
      DO 210 K=2,J
210   COMAND(K)=PRED(K+1,I)
      CALL EXCHAH (COMAND,J)
      WRITE (PRINTR,220) (COMAND(K),K=1,J)
220   FORMAT (6H PRED=,42A1)
230   CONTINUE
      GO TO 330
C     SAVE PREDICATE IF VALID.
240   IF (NCHCMD.LE.EQUAL+3) GO TO 370
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.GT.72) GO TO 360
C     72 = ASCII H
      NUMBER=J-64
      PRED(1,NUMBER)=0
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.GT.90) GO TO 360
C     90 = ASCII Z
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.EQ.82) GO TO 360
C     82 = ASCII R
      PRED(3,NUMBER)=J
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.NE.65.AND.J.NE.88) GO TO 360
C     65 = ASCII A, 88 = ASCII X
      PRED(4,NUMBER)=J
      EQUAL=EQUAL+1
      PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40)
      I=4
      DO 250 J=EQUAL,NCHCMD
      I=I+1
      IF (I.GT.42) GO TO 330
      K=COMAND(J)
      IF (K.GT.96) K=K-32
C     CONVERT TO UPPER CASE.
250   PRED(I,NUMBER)=K
      GO TO 330
C
C     SITE = SITE NAME
C
260   JUMP=1
      GO TO 280
C
C     TITLE = OUTPUT TAPE TITLE
C
270   JUMP=2
280   K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 320 I=1,40
      IF (K.GT.NCHCMD) GO TO 290
      J=COMAND(K)
      K=K+1
      GO TO 300
290   J=32
C     32 = ASCII BLANK.
300   IF (JUMP.EQ.2) GO TO 310
      SITE(I)=J
      GO TO 320
310   TITLE(I)=J
320   CONTINUE
C
C     RETURN TO COMMAND DECODER.
C
330   TRANS=1
      GO TO 390
C
C     ERROR MESSAGES
C
340   NUMBER=14
C     MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED.
      EQUAL=N
      GO TO 380
350   IDSTEP=0
      IDTXTL=0
360   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED.
      GO TO 380
370   NUMBER=30
C     MESSAGE 30 - COMMAND IS INCOMPLETE.
C
380   TRANS=8
C
390   RETURN
C
      END
      SUBROUTINE EXCHC3 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE
C     COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES.
C
C     OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE
C     NAME COMMAND.
C
C     OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING
C     COPY, NAME OR UPDATE COMMANDS.
C
C ID      IS USED TO CONSTRUCT THE OUTPUT LABEL.
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                                    E  X  C  H
      DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/
C                                    A  N  G  E
      DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/
      DATA KNAME /9/
      DATA KSKIP /26/
C
C     OPEN INTAPE IF NECESSARY
C
      IF (INTOPN.NE.0) GO TO 70
      IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300
      IF (INTAPE.EQ.OUTAPE) GO TO 360
      CALL EXCHRH (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 310
      INTOPN=1
C     COPY THE LABEL TO A SAVE AREA.
      DO 10 I=1,180
10    LABELI(I)=CBLCKI(I)
      CALL EXCHAH (CBLCKI(13),138)
      WRITE (PRINTR,20)
20    FORMAT (25H0INPUT LABEL INFORMATION.)
      WRITE (PRINTR,30) (CBLCKI(I),I=13,104)
30    FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/
     1        20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1)
      IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150)
40    FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1)
      WRITE (PRINTR,50) NDATAI
50    FORMAT (28H DATA CHARACTERS PER BLOCK =,I6)
      IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI
60    FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6)
      CHAR1L=0
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 290
70    IF (ICOMD.EQ.KSKIP) GO TO 270
C
C     OPEN OUTAPE IF NECESSARY
C
80    IF (ICOMD.EQ.0) GO TO 90
      IF (ICOMD.LT.KNAME) GO TO 100
90    IF (INTAPE*OUTAPE.EQ.0) GO TO 100
      IF (OUTUPD.NE.85) GO TO 370
C     85 = ASCII U.
100   IF (OUTOPN.NE.0) GO TO 240
      IF (OUTAPE.EQ.0) GO TO 240
C     CONSTRUCT THE OUTPUT LABEL.
      IF (TODAY(1).EQ.0) GO TO 340
      IF (INTOPN.EQ.0) GO TO 160
      DO 110 I=1,180
110   CBLCKO(I)=LABELI(I)
      IF (TITLE(1).EQ.32) GO TO 130
C     32 = ASCII BLANK
      DO 120 I=1,40
120   CBLCKO(I+18)=TITLE(I)
130   IF (OUTUPD.NE.85) GO TO 220
C     85 = ASCII U.
      IF (SITE(1).EQ.0) GO TO 350
      DO 140 I=1,6
140   CBLCKO(I+104)=TODAY(I)
      DO 150 I=1,40
150   CBLCKO(I+110)=SITE(I)
      GO TO 220
160   IF (TITLE(1).EQ.32) GO TO 330
C     32 = ASCII BLANK
      IF (SITE(1).EQ.0) GO TO 350
      IF (INTAPE*OUTAPE.EQ.0) GO TO 170
      IF (INTAPE.EQ.OUTAPE) GO TO 360
170   DO 180 I=1,8
180   CBLCKO(I)=ID(I)
      DO 190 I=1,40
      CBLCKO(I+18)=TITLE(I)
190   CBLCKO(I+64)=SITE(I)
      DO 200 I=1,6
200   CBLCKO(I+58)=TODAY(I)
      DO 210 I=105,180
210   CBLCKO(I)=0
220   CALL EXCHWH (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 320
      OUTOPN=1
      CBLCKO(1)=CBLCKO(105)
      CALL EXCHAH (CBLCKO(13),138)
      WRITE (PRINTR,230)
      WRITE (PRINTR,30) (CBLCKO(I),I=13,104)
230   FORMAT (26H0OUTPUT LABEL INFORMATION.)
      IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150)
      WRITE (PRINTR,50) NDATAO
      IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO
      CHAR1L=0
240   IF (ICOMD-KNAME) 250,260,280
C
C     COPY
C
250   TRANS=4
      MODEI=1-MIN0(1,OUFILE+OPTL)
      IF (ICOMD.EQ.0) MODEI=0
      GO TO 390
C
C     NAME
C
260   TRANS=5
      IF (NRWORK.EQ.0) PHASE=4
      GO TO 390
C
C     SKIP
C
270   TRANS=4
      GO TO 390
C
C     UPDATE
C
280   TRANS=5
      MODEI=0
      GO TO 390
C
C     ERROR MESSAGES
C
290   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      EQUAL=ISTAT
      GO TO 380
300   NUMBER=4
C     MESSAGE 4 - INTAPE NOT DEFINED.
      GO TO 380
310   NUMBER=5
C     MESSAGE 5 - UNABLE TO OPEN INTAPE.
      EQUAL=ISTAT
      GO TO 380
320   NUMBER=6
C     MESSAGE 6 - UNABLE TO OPEN OUTAPE.
      EQUAL=ISTAT
      GO TO 380
330   NUMBER=7
C     MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE.
      GO TO 380
340   NUMBER=8
C     MESSAGE 8 - DATE NOT SUPPLIED.
      GO TO 380
350   NUMBER=9
C     MESSAGE 9 - SITE NOT SUPPLIED.
      GO TO 380
360   NUMBER=10
C     MESSAGE 10 - INTAPE = OUTAPE.
      GO TO 380
370   NUMBER=11
C     MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED.
380   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM
C
390   RETURN
C
      END
      SUBROUTINE EXCHRH (ISTAT,DBLOCK)
C
C     READ THE HEADER LABEL FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE
C               NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     OPEN THE INPUT TAPE.
C
      ISTAT=1
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     READ A BLOCK.
C
      NDATAI=171
      NERRCI=0
      BLKSQI=0
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     FIND OUT IF IT IS A PROPER LABEL.
C
      CALL EXCHUN (DBLOCK,CBLCKI)
      DO 10 I=1,8
      IF (CBLCKI(I).NE.ID(I)) GO TO 20
10    CONTINUE
C
C     GET READY TO READ THE REST OF THE TAPE.
C
      CCDBI=NCDBI
      NDATAI=256*CBLCKI(9)+CBLCKI(10)
      NERRCI=256*CBLCKI(11)+CBLCKI(12)
      LASTI=0
      L1PRGI=0
      ISTAT=0
      GO TO 30
C
C     NOT A LABEL.
C
20    ISTAT=6
C
C     CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK.
25    I=4
      CALL EXCHRT (I,DBLOCK)
C
30    RETURN
C
      END
      SUBROUTINE EXCHWH (ISTAT,DBLOCK)
C
C     WRITE A HEADER ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE
C               WRITTEN ARE NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     MAKE SURE IT IS A PROPER LABEL.
C
      DO 10 I=1,8
      IF (CBLCKO(I).NE.ID(I)) GO TO 30
10    CONTINUE
C
C     OPEN THE OUTPUT TAPE.
C
      ISTAT=1
      CALL EXCHWT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 40
C
C     CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR
C     CONTROL CHARACTERS
C
      CBLCKO(9)=NDATAO/256
      CBLCKO(10)=MOD(NDATAO,256)
      CBLCKO(11)=NERRCO/256
      CBLCKO(12)=MOD(NERRCO,256)
C
C     INSERT TODAYS DATE
C
      DO 20 I=1,6
20    CBLCKO(I+12)=TODAY(I)
C
C     WRITE THE BLOCK ON TAPE.
C
      BLKSQO=0
      CALL EXCHPA (CBLCKO,DBLOCK)
      CCDBO=180
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     GET READY TO WRITE THE REST OF THE FILE.
C
      L1PRGO=0
      LLPRGO=0
      N1RECO=0
      NLRECO=0
      L1RECO=0
      LASTO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      GO TO 40
C
C     NOT A PROPER LABEL.
C
30    ISTAT=6
C
40    RETURN
C
      END
      SUBROUTINE EXCHC4 (IBLOCK)
      INTEGER IBLOCK(1)
C
C     PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM
C     COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KCOPY /3/
C
C     ARE WE STARTING OR CONTINUING?
C
C     ICOMD.EQ.0  MEANS  CHANGE A CONTROL RECORD
C     ICOMD.GT.0  MEANS  SKIP OR COPY COMMAND BEGIN
C     ICOMD.EQ.-1 MEANS  CONTINUE COPY = NUMBERS
C     ICOMD.EQ.-2 MEANS  CONTINUE COPY = PREDICATE EXPRESSION
      NEWP=0
      IF (ITYPEI.EQ.80) VERT=0
C     80 = ASCII P.  WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO
C     IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON
C     THE WORK FILE.
      IF (ICOMD.EQ.0) GO TO 190
C     ICOMD=0 MEANS CHANGING A CONTROL RECORD.
      IF (ICOMD+1) 290,170,10
10    IF (ICOMD.EQ.KCOPY) GO TO 30
C
C     SKIP COMMAND.
C
      IF (INTOPN.LT.0) GO TO 430
      if (modify.eq.70) number=number+n1reci-1
c     70 = ASCII F.
      IF (NUMBER+1-N1RECI) 540,430,20
20    CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.EQ.69) GO TO 460
C     69 = ASCII E.
      IF (N1RECI-NUMBER) 20,20,430
C
C     COPY COMMAND FORMAT VERIFICATION.
C
30    IF (COMAND(EQUAL).LT.48) GO TO 180
C     48 = ASCII ZERO
      IF (COMAND(EQUAL).GT.57) GO TO 180
C     57 = ASCII NINE
C
C     COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS.
C     CONVERT THE NUMBERS AND STORE THEM IN COMAND.  IF THE NUMBER
C     IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER.
C
      ICOMD=-1
      I=0
      J=44
C     44 = ASCII COMMA
40    I=I+1
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 480
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=NUMBER
50    EQUAL=EQUAL+1
      IF (EQUAL.GT.NCHCMD) GO TO 60
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 60
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=10*COMAND(I)+NUMBER
      GO TO 50
60    IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70
70    IF (J.EQ.45) COMAND(I)=-COMAND(I)
C     45 = ASCII DASH
      IF (EQUAL.GT.NCHCMD) GO TO 90
      J=COMAND(EQUAL)
      IF (J.EQ.32 .OR. J.EQ.46) GO TO 90
C     32 = ASCII BLANK, 46 = ASCII PERIOD.
      IF (J.NE.44.AND.J.NE.45) GO TO 480
C     44 = ASCII COMMA, 45 = ASCII DASH
80    EQUAL=EQUAL+1
      IF (COMAND(EQUAL)-32) 40,80,40
C     32 = ASCII BLANK
90    NUMBER=I
C     FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE
C     POSITION IN COMAND CURRENTLY BEING EXAMINED.
      EQUAL=-1
100   EQUAL=EQUAL+1
      IF (EQUAL.GE.NUMBER) GO TO 470
      IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100
      IF (EQUAL.EQ.0) GO TO 120
      WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD)
110   FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H)
     1NOT COPIED./(1X,80A1))
      NERRG=MAX0(NERRG,5)
120   IF (COMAND(EQUAL+1).GT.0) GO TO 130
      EQUAL=EQUAL-1
      COMAND(EQUAL+1)=N1RECI
130   IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
C
C     PROCESS COPY = LIST OF NUMBERS
C
140   EQUAL=EQUAL+1
C     GO COPY THE PROGRAM IF IT IS THE RIGHT ONE.
150   IF (INTOPN.LT.0) GO TO 430
      IF (COMAND(EQUAL)-N1RECI) 170,420,160
C     SKIP TO DESIRED PROGRAM
160   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI-69) 150,460,150
C     69 = ASCII E
170   IF (EQUAL.GE.NUMBER) GO TO 430
      IF (COMAND(EQUAL+1).GE.0) GO TO 140
      COMAND(EQUAL)=IABS(COMAND(EQUAL))+1
      IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420
      EQUAL=EQUAL+1
      GO TO 170
C
C     COPY = SELECTION STRING OR CHANGE CONTROL RECORD.
C
180   ICOMD=-2
      IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
      NRWORK=-1
C
C     DETERMINE NEED TO OPEN WORK FILE.
C
190   IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0)
     1IF (ICOMD) 290,430,290
      IF (WORKF.EQ.0) GO TO 500
      I=IABS(WORKF)
      IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510
      IF (WORKF.GT.0) GO TO 200
      WORKF=I
      CALL EXCHFO (3)
200   IF (ICOMD.NE.0) GO TO 280
C
C     CHANGE CONTROL RECORD.
C
      if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520
c     69 = ascii E, 73 = ascii I.
      if (nrwork.eq.0) go to 210
      if (itypei.eq.80) go to 520
c     80 = ascii P
210   IF (NUMBER-NRWORK-1) 530,220,410
220   NCHACT=NCHCMD+1-EQUAL
      IF (NCHACT.GT.0) GO TO 230
      NCHACT=1
      INTREC(1)=32
C     32 = ASCII BLANK
      GO TO 425
230   DO 240 I=1,NCHACT
240   INTREC(I)=COMAND(EQUAL+I-1)
      GO TO 425
C
C     COPY = SELECTION EXPRESSION.
C
C     SKIP TO NEXT PROGRAM.
250   IF (INTOPN.LT.0) GO TO 430
      if (itypei.eq.69) go to 460
c     69 = ASCII E.
      do 260 i = 1, 8
260   pred(2,i)=0
      if (itypei.ne.80) go to 265
c     If the current record is a new program, don't skip it (we haven't
c     processed it yet).
      if (nrwork.gt.0 .and. workf.gt.0) rewind workf
      nrwork=min0(nrwork,0)
      newp=0
      go to 320
265   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      nxnewp=0
270   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.NE.80) GO TO 310
C     80 = ASCII P
      NEWP=nxnewp
c     Set NEWP non-zero when all control records for a module have been
c     seen.
      GO TO 320
280   NRWORK=MAX0(NRWORK,0)
290   DO 300 I=1,8
300   PRED(2,I)=0
c     NEWP is non-zero when all control records have been read.
310   if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1
C     69 = ASCII E, 73 = ASCII I.
320   nxnewp=1
      if (icomd.eq.0) if (newp) 520,210,520
      IF (LIMIT.EQ.0) GO TO 340
      IF (N1RECI.LE.LIMIT) GO TO 340
      WRITE (PRINTR,330) LIMIT
330   FORMAT (7H LIMIT=,I6,9H REACHED.)
      GO TO 430
340   IF (NEWP.EQ.0) GO TO 360
      CALL EXCHLX
C     EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'.
      NUMBER=NCHCMD
      IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415
C     73 = ASCII I.
      IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425
C     80 = ASCII P.
      IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425
C     83 = ASCII S.
      IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415
C     88 = ASCII X.
      IF (COMAND(180)) 450,250,420
C     CONTROL RECORD.  EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE.
360   I=1
      DO 400 NUMBER=1,8
      IF (PRED(1,NUMBER).EQ.0) GO TO 400
      IF (PRED(2,NUMBER).NE.0) GO TO 400
      IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390
      NM=PRED(1,NUMBER)-3
      IF (.NOT.(NCHACT.GT.0)) GO TO 390
      DO 385 L = 1, NCHACT
      DO 380 J = 1, NM
C
C     DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND
C     IN PREDICATE.
      IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380
      IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370
C
C     NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS.
      K=32
      GO TO 375
C     USE CHARACTER FROM CONTROL RECORD.
370   K=INTREC(J+L-1)
C
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (K.GT.96 .AND. K.LT.123) K=K-32
C
C     TEST FOR A MATCH ON A SINGLE CHARACTER.
C     IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE
C     PATTERN.  IF THE SEARCH MODE IS X, TERMINATE THE SEARCH.
375   IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390
380   CONTINUE
C
C     FOUND A MATCH IN CONTROL RECORD AND PREDICATE.
      PRED(2,NUMBER)=1
      GO TO 400
385   CONTINUE
390   I=0
400   CONTINUE
      IF (I.NE.0) newp=1
      IF (NRWORK.LT.0) GO TO 270
C     AT LEAST ONE FALSE PREDICATE.  WRITE THE CONTROL RECORD ON WORKF.
410   WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT)
      NRWORK=NRWORK+1
      GO TO 270
C
C     GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM.
C
415   ICOMD=-3
C     RETURN TO EXCHC1 AFTER COPYING MODULE.
420   TRANS=5
      GO TO 570
C
C     RETURN TO THE COMMAND PROCESSOR.
C
425   TRANS=1
C     REMEMBER CONTROL RECORDS ON WORKF.
      GO TO 570
430   TRANS=1
      IF (ICOMD+1) 560,570,570
C
C     ERROR MESSAGES.
C
440   NUMBER=1
C     MESSAGE 1 - I/O ERROR.
      EQUAL=ISTAT
      GO TO 550
450   NUMBER=-COMAND(180)
C     MESSAGES GENERATED BY EXCHLX
      GO TO 550
460   IF (INTOPN.LT.0) GO TO 430
      INTOPN=-1
      EQUAL=NUMBER
      NUMBER=15
C     MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE.
      GO TO 550
470   NUMBER=16
C     MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION.
      GO TO 550
480   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER
      GO TO 550
490   NUMBER=18
C     MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER.
      GO TO 550
500   NUMBER=19
C     MESSAGE 19 - WORK FILE NOT DEFINED.
      GO TO 550
510   NUMBER=20
C     MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE.
      GO TO 550
520   EQUAL=NUMBER
      NUMBER=21
C     MESSAGE 21 - CONTROL RECORD NOT PRESENT
      GO TO 550
530   NUMBER=22
C     MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER.
      GO TO 550
540   NUMBER=29
C     MESSAGE 29 - BACKWARD SKIP IGNORED.
C
C     RETURN TO THE ERROR MESSAGE PROCESSOR.
C
550   TRANS=8
      IF (ICOMD.EQ.0) GO TO 570
C
C     DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF.
C
560   IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
C
C     RETURN TO TRANSITION PROGRAM.
C
570   RETURN
C
      END
      SUBROUTINE EXCHLX
C
C     EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND.
C
C     THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE
C     STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM
C     COPY=LOGICAL EXPRESSION.  THE LOGICAL EXPRESSION CONSISTS OF THE
C     EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY
C     OPERATORS + - * / AND PARENEHESES.  THE PRIMARY SYMBOLS A-H ARE
C     LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE
C     STATEMENTS.  THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE
C     NULL PREDICATE, WHICH IS ALWAYS FALSE.  THE OPERATORS + - * / ARE
C     THE BINARY LOGICAL OPERATIONS   OR, OR NOT, AND, AND NOT
C     RESPECTIVELY.  THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE
C     PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL
C     PRIORITY.  THE RELATIVE PRIORITY MAY BE CHANGED BY USING
C     PARENTHESES.
C
C     WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY
C     FALSE.  AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL
C     FALSE PREDICATES IS DETERMINED.  ONCE TRUE, A PREDICATE REMAINS
C     TRUE.  THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND
C     A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE.  WHEN ALL ACTIVE
C     PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM
C     HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND
C     IS EVALUATED.  IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED.
C     IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED.  THIS PROCESS
C     CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM
C     NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED.
C
C     THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE
C     TABLE BELOW.  INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS
C     APPENDED TO THE END OF THE LOGICAL EXPRESSION.
C
C     PREVIOUS  I                 CURRENT TOKEN                   I
C      TOKEN    I + - * / I PRIMARY I    (    I    )    I  ELSE   I
C     ----------I---------I---------I---------I---------I---------I
C      + - * /  I  ERROR  I   OK    I   OK    I  ERROR  I  ERROR  I
C      PRIMARY  I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C         (     I  ERROR  I   OK    I   OK    I   OK    I  ERROR  I
C         )     I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C     ----------I---------I---------I---------I---------I---------I
C
C     CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING
C     A STACK AND THE PRECEDENCE TABLE BELOW.  TOS MEANS TOP-OF-STACK,
C     HOI MEANS HEAD-OF-INPUT.  THE STACK INITIALLY CONTAINS (.
C
C                  TOS       HOI
C      TOKEN   I  INDEX  I  INDEX  I
C     ---------I---------I---------I
C       + -    I    2    I    1    I
C       * /    I    4    I    3    I
C     PRIMARY  I    6    I    5    I
C        (     I    0    I    7    I
C        )     I   N/A   I    0    I
C     ---------I---------I---------I
C
C     WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS
C     PUSHED ONTO THE STACK.  WHEN THE TOS INDEX IS GREATER THAN THE HOI
C     INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY
C     SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT
C     PLACED IN THE SUFFIX LIST.  THEN THE RELATION OF THE TOS INDEX TO
C     THE HOI INDEX IS RE-EXAMINED.  WHEN THE TOS INDEX IS EQUAL TO THE
C     HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED.
C
C     *****     INTERNAL VARIABLES     *********************************
C
C CHTAB   RECOGNIZED CHARACTERS.  INTERNAL PROCESSES USE THE INDEX
C         INTO CHTAB.
C COLTAB  CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX.
C HOI     CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE.
C INFIX   IS THE CURRENT POSITION IN THE INFIX.
C IPREV   IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN.
C ISTACK  IS THE CURRENT STACK INDEX.
C ISUFIX  IS THE CURRENT SUFFIX INDEX.
C SYNTAX  CONTAINS THE SYNTAX RULES.
C TOS     CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE.
C
      INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     DATA STATEMENTS     ************************************
C
C                                                    A  B  C  D
      DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/
C                                                    E  F  G  H
      DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/
C                                                    N  +  -  *
      DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/
C                                                    /  (  )
      DATA CHTAB(13),CHTAB(14),CHTAB(15)           /47,40,41   /
C                                                       A B C D
      DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/
C                                                       E F G H
      DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/
C                                                       N + - *
      DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/
C                                                       / ( )
      DATA COLTAB(13),COLTAB(14),COLTAB(15)            /1,3,4  /
C                                                   A B C D E
      DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/
C                                                   F G H N +
      DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/
C                                                   - * / ( )
      DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/
C                 CURRENT TOKEN IS +-*/.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/
C                 CURRENT TOKEN IS PRIM.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/
C                 CURRENT TOKEN IS (.     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/
C                 CURRENT TOKEN IS ).     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/
C                                                   A B C D E
      DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/
C                                                   F G H N +
      DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/
C                                                   - * / ( )
      DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/
C
C     *****     PROCEDURES     *****************************************
C
C     COMAND IS USED FOR INFIX, STACK AND SUFFIX.  UPON COMPLETION,
C     COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE
C     OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE
C     EXPRESSION IS TRUE.
C
      ISTACK=NCHCMD+2
      COMAND(ISTACK)=14
      ISUFIX=181
      IPREV=3
      COMAND(NCHCMD+1)=41
      INFIX=EQUAL-1
C
C     GET A CHARACTER FROM INFIX.  LOOK UP IN CHTAB.  CHECK SYNTAX.
C
10    IF (INFIX.GT.NCHCMD) GO TO 180
      INFIX=INFIX+1
      J=COMAND(INFIX)
      IF (J.EQ.32) GO TO 10
C     32 = ASCII BLANK - IGNORE IT.
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      DO 20 I=1,15
      IF (CHTAB(I).EQ.J) GO TO 30
20    CONTINUE
      GO TO 230
30    J=COLTAB(I)
      IF (SYNTAX(IPREV,J)-1) 40,190,200
C
C     CONVERT INFIX TO SUFFIX
C
40    IPREV=J
50    J=COMAND(ISTACK)
      IF (TOS(J)-HOI(I)) 60,70,80
C     PUSH INFIX ONTO STACK
60    ISTACK=ISTACK+1
      COMAND(ISTACK)=I
      GO TO 10
C     DELETE TOP OF STACK
70    ISTACK=ISTACK-1
      IF (ISTACK.GT.NCHCMD+1) GO TO 10
      IF (INFIX-NCHCMD) 220,220,250
C     IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX.
C     IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX.
80    IF (J-9) 90,100,130
C     PRIMARY IS SYMBOL A-H
90    IF (PRED(1,J).EQ.0) GO TO 210
      J=PRED(2,J)
      GO TO 110
C     NULL PREDICATE
100   J=0
110   ISUFIX=ISUFIX-1
120   COMAND(ISUFIX)=J
      ISTACK=ISTACK-1
      GO TO 50
C     OPERATOR
130   J=J-9
      ISUFIX=ISUFIX+1
      GO TO (140,150,160,170), J
C             +   -   *   /
140   J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1)
      GO TO 120
150   J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1)
      GO TO 120
160   J=COMAND(ISUFIX)*COMAND(ISUFIX-1)
      GO TO 120
170   J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1))
      GO TO 120
C
180   COMAND(180)=-23
C     MESSAGE 23 - TOO MANY (
      GO TO 240
190   COMAND(180)=-24
C     MESSAGE 24 - MISSING PRIMARY
      GO TO 240
200   COMAND(180)=-25
C     MESSAGE 25 - MISSING OPERATOR
      GO TO 240
210   EQUAL=CHTAB(J)
      CALL EXCHAH (EQUAL,1)
      COMAND(180)=-26
C     MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE.
      GO TO 250
220   COMAND(180)=-27
C     MESSAGE 27 - TOO MANY )
      GO TO 240
230   COMAND(180)=-28
C     MESSAGE 28 - UNRECOGNIZED CHARACTER
C
240   EQUAL=INFIX
250   RETURN
C
      END
      SUBROUTINE EXCHC5 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE,
C     AND INDEX IF SELECTED.  COPY RECORDS FROM WORKF FIRST, IF ANY.
C     CREATE CONTROL RECORDS DEMANDED BY COMMANDS.
C
C     THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF
C     THE PARAMETER STRING.
C
C     AUTHOR
C     COMMENT
C     CONTROL (ITYPEO SET FROM MODIFY)
C     DATA TYPE
C     GROUPS
C     INSERT
C     KEYWORDS
C     MACHINE
C     ORIGIN
C     REFERENCES
C     REMOVE   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     SIGNAL   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     UPDATE
C
C     IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS
C     ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A
C     CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND.
C
C     *****     LOCAL VARIABLES     ************************************
C
C BLANK   CONTAINS A HOLLERITH BLANK.
      INTEGER BLANK
C C1      IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING.
      INTEGER C1
C COL1    THE FIRST COLUMN OF TEXT OF A CONTROL RECORD.  DERIVED FROM
C         EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE.
      INTEGER COL1
C I,J     USED FREELY AS INDICES.
      INTEGER I,J
C KCONT   THE INDEX IN COMD OF THE CONTROL COMMAND.
      INTEGER KCONT
C KNAME   IS THE INDEX IN COMD OF THE NAME COMMAND.
      INTEGER KNAME
C KTEXT   THE INDEX IN COMD OF THE TEXT COMMAND.
      INTEGER KTEXT
C KUPDA   THE INDEX IN COMD OF THE UPDATE COMMAND.
      INTEGER KUPDA
C LIST    CONTAINS THE WORD LIST IN ASCII.  USED FOR THE A OPTION.
      INTEGER LIST(4)
C NM      IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NM
C NOUT    IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NOUT
C NY      IS THE PROGRAM NUMBER.  IT IS THE NUMBER FROM INTAPE IF
C         OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE.
      INTEGER NY
C ONE     CONTAINS A HOLLERITH 1.
      INTEGER ONE
C REASON  REASON FOR COPYING A CONTROL RECORD.  1 = COPY COMMAND
C         PENDING.  2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8.
C         3 = COMMAND.
      INTEGER REASON
C RI      CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A
C         GIVEN RECORD TYPE.  RI IS SUBSCRIPTED BY (ITYPEO-64).
      INTEGER RI(26)
C RT      IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT.
      INTEGER RT(34)
C STAR    CONTAINS A HOLLERITH STAR.
      INTEGER STAR
C ZERO    CONTAINS A HOLLERITH ZERO.
      INTEGER ZERO
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL VARIABLE DATA     ********************************
C
      DATA BLANK /1H /
C                                            L  I  S  T
      DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/
C
      DATA KCONT /31/
      DATA KNAME /9/
      DATA KTEXT /27/
      DATA KUPDA/29/
      DATA ONE /1H1/
C                                                      A  B  C  D  E  F
      DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/
C                                                      G  H  I  J  K  L
      DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/
C                                                      M  N  O  P  Q  R
      DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/
C                                                      S  T  U  V  W  X
      DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/
C                                                      Y  Z
      DATA RI(25),RI(26)                             /31,31            /
C                                                     A  C     D     G
      DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/
C                                                           P     K
      DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/
C                                                     M     O
      DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/
C                                                              B  R
      DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/
C                                                                 S
      DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/
C                                                              J
      DATA RT(31),RT(32),RT(33),RT(34)              /-1, 0, 0,74/
C
      DATA STAR /1H*/
      DATA ZERO /1H0/
C
C     *****     PROCEDURES     *****************************************
C
      REASON=1
      NY=N1RECI
      IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1
C     ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P.
C     IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT.
      IF (PHASE.EQ.4) NY=0
C     NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER.  (IT IS PRINTED
C     IN THE INDEX).
      IF (ICOMD.LE.0) GO TO 10
      IF (PHASE.GE.4) GO TO 100
      IF (ICOMD.EQ.KNAME) GO TO 10
      IF (ICOMD.NE.KUPDA) GO TO 100
      REASON=2
      PHASE=8
10    IF (NRWORK.GT.0) REWIND WORKF
      NM=0
      NOUT=0
20    NM=NM+1
      IF (NM.LE.NRWORK) GO TO 60
30    IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230
C     69 = ASCII E, 73 = ASCII I.
      IF (NOUT.EQ.0) GO TO 40
      IF (ITYPEI.EQ.80) GO TO 230
C     80 = ASCII P.
      IF (NCHACT.NE.1) GO TO 40
      IF (INTREC(1).EQ.32) GO TO 220
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
40    ITYPEO=ITYPEI
      NCHOUT=NCHACT
      DO 50 J=1,NCHOUT
50    OUTREC(J+5)=INTREC(J)
      GO TO 70
60    READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT)
      IF (NCHOUT.NE.1) GO TO 70
      IF (NM.EQ.1) GO TO 70
      IF (OUTREC(6).EQ.32) GO TO 200
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
70    NOUT=NOUT+1
      J=RI(ITYPEO-64)
      DO 80 I=1,4
80    OUTREC(I)=COMD(I,J)
      OUTREC(5)=61
C     61 = ASCII =
      COL1=5
      IF (J.NE.KCONT) GO TO 130
      COL1=7
C     CONTROL,*=...  MOVE UP TWO CHARACTERS AND INSERT ITYPEO.
      DO 90 I=1,NCHOUT
90    OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I)
      OUTREC(5)=44
C     44 = ASCII COMMA.
      OUTREC(6)=ITYPEO
      OUTREC(7)=61
C     61 = ASCII =
      GO TO 130
100   IF (ICOMD.EQ.KTEXT) GO TO 240
      COL1=EQUAL-1
      NCHOUT=NCHCMD-COL1
      NRWORK=NRWORK+1
C     NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD.
      ITYPEO=RT(ICOMD)
      IF (ITYPEO.GT.0) GO TO 110
C     PROCESS CONTROL,TYPE=TEXT COMMAND.
      ITYPEO=MODIFY
      IF (RI(ITYPEO-64).NE.KCONT) GO TO 320
110   NOUT=NRWORK
      REASON=3
      DO 120 I=1,NCHCMD
120   OUTREC(I)=COMAND(I)
130   IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1)
C     74 = ASCII J.
      IF (ITYPEO.EQ.80) VERT=0
C     80 = ASCII P
      IF (ITYPEO.NE.68) GO TO 150
C     68 = ASCII D
      IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150
      DO 140 J=1,4
      I=OUTREC(J+COL1)
      IF (I.GT.96 .AND. I.LT.123) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.NE.LIST(J)) GO TO 150
140   CONTINUE
      VERT=1
C     GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE.
150   CALL EXCHCG (OUTREC(COL1+1))
      IF (OUTOPN.EQ.0) GO TO 160
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1))
      IF (ISTAT.NE.0) GO TO 340
      NY=NLRECO
160   NCHOUT=NCHOUT+COL1
C     TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER.
      OUTREC(180)=-NOUT
      IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC)
C     PRINT THE INDEX IF SELECTED.
      IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO
     1190
      IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190
      C1=BLANK
C     DOUBLE SKIP FOR PROGRAM HEADER (P).
      IF (ITYPEO.EQ.80) C1=ZERO
      IF (OPTV+VERT.NE.0) GO TO 170
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170
      IF (CHAR1L.NE.ONE) C1=ONE
      CHAR1L=ONE
170   CALL EXCHAH (OUTREC,NCHOUT)
      WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT)
180   FORMAT (A1,2I5,1H*,(3X,105A1))
190   IF (REASON.EQ.3) GO TO 310
200   IF (NM-NRWORK) 20,210,220
210   REWIND WORKF
      NRWORK=0
      GO TO 30
220   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT) 330,30,330
230   IF (REASON.EQ.2) GO TO 300
240   IF (OUFILE.EQ.0) GO TO 260
      DO 250 I=1,4
250   OUTREC(I)=COMD(I,KTEXT)
      OUTREC(180)=0
      NCHOUT=0
C     TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED.
      CALL EXCHCG (OUTREC)
      NCHOUT=4
      ACTION=2-OPTC-OPTC
C     ACTION = 2 MEANS START OF PROGRAM.
      CALL EXCHOU (OUTREC)
260   IF (OPTV+VERT.NE.0) GO TO 280
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280
      IF (OUTOPN.NE.0) NY=NLRECO
      I=BLANK
      IF (CHAR1L.NE.ONE) I=ONE
      WRITE (PRINTR,270) I,NY
270   FORMAT (A1,I5,1H*,8X,4HTEXT/)
280   CHAR1L=STAR
      NRWORK=MIN0(NRWORK,0)
      IF (IDOPTN.NE.67) IDCUR=IDSTRT
C     67 = ASCII C
      IF (ICOMD.EQ.KTEXT) GO TO 290
C
C     WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL
C     RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED.
C
      TRANS=6
      GO TO 370
C
C     WORKING ON A TEXT STATEMENT.
C
290   TRANS=7
      GO TO 370
C
C     WORKING ON AN UPDATE STATMENT.
C
300   NRWORK=NOUT
      GO TO 100
C
C     WRITING A SINGLE CONTROL RECORD.
C
310   TRANS=1
      GO TO 370
C
C     ERROR MESSAGES.
C
320   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER.
      GO TO 360
330   NUMBER=1
      GO TO 350
340   NUMBER=2
350   EQUAL=ISTAT
360   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM.
C
370   RETURN
C
      END
      SUBROUTINE EXCHCG (RECORD)
C
C     USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL.
C     WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED.
C     THIS IS THE PORTABLE VERSION.  IT DOES NOT DO ANYTHING.
C
      INTEGER RECORD(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      RETURN
      END
      SUBROUTINE EXCHC6 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE.
C
      INTEGER KNAME,ONE,SVHCMD(180)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KNAME /9/
      DATA ONE /1H1/
C
      LINEO=0
      NERRS=0
C     SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT.
      DO 5 I = 1,NCHCMD
5     SVHCMD(I)=HOLCMD(I)
      IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165
C     73 = ASCII I.  IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE
C     A VOID MODULE.
      IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10
      CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.EQ.7) GO TO 220
      IF (ISTAT) 250,160,250
10    MODEO=MODEI
      ITYPEO=0
      NBC=OPTL+OUFILE
      IF (INDEX.GT.0) NBC=1
20    NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTOPN.EQ.0) GO TO 120
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 260
C
C     CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD
C     INSTEAD OF BYTE-BY-BYTE).  WE CAN DO A BLOCK COPY IF
C     WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT
C     FILE AND NOT PRINTING THE INDEX.  ALSO, THE INPUT AND
C     OUTPUT CHARACTER POSITIONS MUST BE THE SAME.  IF THE
C     PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH
C     THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE
C     CURRENT POSITION IN THE BYTE BUFFER BE THE SAME.
C     WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE
C     LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T
C     KNOW THE LOCATION OF THE END-OF-FILE RECORD.
C
      IF (NBC.NE.0) GO TO 120
      IF (CPCBI+1.NE.CPCBO) GO TO 120
      IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120
C     WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF.
      IF (L1PRGI.EQ.0) GO TO 25
      IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30
25    IF (CCDBI+1.NE.CCDBO) GO TO 120
      IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120
C     WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE).
C     FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO.
30    LI=L1PRGI+NERRCI-1
      IF (L1PRGI.NE.0) GO TO 40
      LI=NERRCI+NDATAI+9
      IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1
40    IF (CPCBI.GE.NCCBI) GO TO 50
      IF (CCDBI.GE.LI) GO TO 160
      CPCBI=CPCBI+1
      CBLCKO(CPCBO)=CBLCKI(CPCBI)
      CPCBO=CPCBO+1
      CCDBI=CCDBI+1
      CCDBO=CCDBO+1
      GO TO 40
C     PACK COPIED BYTES.
50    CALL EXCHPA (CBLCKO,OBLOCK(CWDBO))
      CPCBO=1
      CPCBI=0
      CWDBO=CWDBO+NWCBO
      CWDBI=CWDBI+NWCBI
C     NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM
60    IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70
      IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=L1RECI
      CALL EXCHPB (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 260
70    IF (CCDBI.LT.LI) GO TO 80
      IF (L1PRGI.NE.0) GO TO 100
      CALL EXCHGB (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 250
      GO TO 30
80    NW=NWCBI*((LI-CCDBI)/NCCBI)
      IF (NW.EQ.0) GO TO 100
      DO 90 I=1,NW
      OBLOCK(CWDBO)=IBLOCK(CWDBI)
      CWDBO=CWDBO+1
90    CWDBI=CWDBI+1
100   CCDBO=CCDBO+LI-CCDBI
      CCDBI=LI
      IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60
      CPCBI=MOD(LI,NCCBI)
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      CALL EXCHUN (IBLOCK(CWDBI),CBLCKI)
      IF (CPCBI.EQ.0) GO TO 160
      DO 110 I=1,CPCBI
110   CBLCKO(I)=CBLCKI(I)
      GO TO 160
C
C     END OF BLOCK COPY CODE.
C
120   CALL EXCHTP (INTREC,LINEO)
160   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 250
      IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20
C     73 = ASCII I.
165   IF (OPTL.NE.0) GO TO 180
      IF (INDEX.LE.0) GO TO 195
      WRITE (PRINTR,170) LINEO
170   FORMAT (I9,14H IMAGES COPIED)
      GO TO 200
180   WRITE (PRINTR,190)
190   FORMAT (1H1)
195   CHAR1L=ONE
200   IF (OUFILE.EQ.0) GO TO 210
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
210   IF (ITYPEI.EQ.69) GO TO 220
C     69 = ASCII E
C
C     RETURN TO THE COPY CONTROL SEGMENT.
C
      DO 215 I=1,NCHCMD
215   HOLCMD(I)=SVHCMD(I)
      IF (ICOMD.EQ.-3) GO TO 240
C     ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE.
      TRANS=4
      IF (ICOMD.NE.KNAME) GO TO 280
C     MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME'
C     COMMAND SUBMITTED.  GO PROCESS 'NAME' COMMAND.
      TRANS=5
      PHASE=4
      GO TO 280
C
C     END OF FILE ON INPUT TAPE.
C
220   IF (INTOPN.LT.0) GO TO 240
      WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD)
230   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1))
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
240   TRANS=1
      GO TO 280
C
C     ERROR MESSAGES.
C
250   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      GO TO 270
260   NUMBER=2
C     MESSAGE 2 - I/O ERROR WRITING OUTAPE.
270   TRANS=8
      EQUAL=ISTAT
C
C     RETURN TO THE TRANSITION PROGRAM.
C
280   IF (NERRS.EQ.0) GO TO 300
      WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD)
290   FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./
     1(1X,80A1))
      NERRG=MAX0(NERRS,NERRG)
300   RETURN
C
      END
      SUBROUTINE EXCHC7 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
      INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40)
C
C     PROCESS THE TEXT COMMAND.
C
C MSG     IS USED TO PRINT A MESSAGE.
      INTEGER MSG(6,2)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/
      DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/
      DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/
      DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/
      DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/
C
      LINEI=1
      LINEO=0
      NERRS=0
      INEND=0
      CHAR1L=STAR
C
C     SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND
C
      K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 20 I=1,40
      IF (K.GT.NCHCMD) GO TO 10
      J=COMAND(K)
      K=K+1
      GO TO 20
10    J=32
C     32 = ASCII BLANK.
20    TXDISK(I)=J
      IF (INTOPN.LE.0) ITYPEI=0
C
C     MAIN PROCESSING LOOP
C
60    EDIT=0
70    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 80
C     NCHCMD.LT.0 MEANS END OF FILE.
      IF (NCHCMD.LT.2) GO TO 100
      IF (COMAND(1).NE.SIGNAL) GO TO 100
      IF (COMAND(2).EQ.SIGNAL) GO TO 80
      IF (COMAND(2).EQ.73) GO TO 370
      IF (COMAND(2).EQ.105) GO TO 370
C     73,105 = ASCII I - REQUEST TO INCLUDE TEXT.
      IF (NCHCMD.LT.3) GO TO 100
      IF (COMAND(2).NE.61) GO TO 100
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 70
C     END OF TEXT FILE.
80    IF (INTEXT.EQ.0) GO TO 90
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      CALL EXCHIM
      INTEXT=0
      NCHCMD=0
90    NCHCMD=MIN0(NCHCMD,0)
      IF (PHASE.NE.8) GO TO 660
      IF (INEND) 660,630,660
100   IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110
110   IF (EDIT.EQ.0) GO TO 450
C
C     PARTIAL LINE EDITOR.
C     INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED.
C     EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES
C     THE FIRST NON-BLANK CHARACTER AFTER N2.  N1 AND N2 ARE COLUMN
C     LIMITS UNDER WHICH TO PERFORM THE EDITING.  N1 AND ,N2 ARE
C     OPTIONAL.  IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT
C     LIMIT.  IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS
C     ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE.  WHEN
C     STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING
C     PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT
C     LENGTHS OF STRING1 AND STRING2.  THE THIRD DELIMITER IS
C     OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED
C     AFTER STRING2 IS INSERTED.
C
      IF (INEND.NE.0) GO TO 240
C     CONVERT COLUMN NUMBERS.
      NBR1=0
      NBR2=0
      I=0
120   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.EQ.44) GO TO 150
C     44 = ASCII COMMA
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR1=10*NBR1+J-48
      GO TO 120
130   WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD)
140   FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/
     1(1X,80A1))
      NERRS=2
      GO TO 70
150   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR2=10*NBR2+J-48
      GO TO 150
C     SCAN FOR DELIMITER
160   IF (J.NE.32) GO TO 170
C     32 = ASCII BLANK
      I=I+1
      J=COMAND(I)
      GO TO 160
170   D1=I
      NBR1=MIN0(NBR1,180)
      NBR2=MIN0(NBR2,180)
      IF (NBR1.EQ.0) NBR1=1
      IF (NBR2.EQ.0) GO TO 180
      IF (NBR2.LT.NBR1) GO TO 130
180   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      IF (COMAND(I).NE.J) GO TO 180
      D2=I
      D3=0
190   I=I+1
      IF (I.GT.NCHCMD) GO TO 200
      IF (COMAND(I).NE.J) GO TO 190
      D3=I
C     LOOK FOR SEARCH STRING (STRING1)
200   NUMBER=D2-D1-1
      J=NBR1
      IF (NUMBER.EQ.0) GO TO 260
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
210   DO 220 I=1,NUMBER
      IF (I+J-1.GT.NY) GO TO 240
      IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230
220   CONTINUE
      GO TO 260
230   J=J+1
      GO TO 210
240   WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1))
      NERRS=2
      GO TO 70
C     FOUND SEARCH STRING.  REPLACE WITH UPDATE STRING.
260   CHAR1L=PLUS
      IF (D3.NE.0) GO TO 300
C     NO THIRD DELIMITER.   REPLACE REST OF REGION.
      NY=NBR2
      IF (NY.EQ.0) NY=180
      D2=D2+1
      IF (D2.GT.NCHCMD) GO TO 280
      DO 270 I=D2,NCHCMD
      INTREC(J)=COMAND(I)
      J=J+1
      IF (J.GT.NY) GO TO 280
270   CONTINUE
280   IF (NBR2.NE.0) GO TO 290
      NCHACT=J-1
      GO TO 70
290   IF (J.GT.NBR2) GO TO 70
      INTREC(J)=32
C     32 = ASCII BLANK
      J=J+1
      GO TO 290
C     WE HAVE A THIRD DELIMITER.  REPLACE ONLY THE SEARCH STRING.
C     SHIFT THE REST OF THE REGION AS NECESSARY.
300   NUMBER=(D3-D2)-(D2-D1)
      IF (NUMBER) 310,350,330
C     SHIFT LEFT
310   I=J+D2-D1-1
      NY=MIN0(NBR2,NCHACT)
      IF (NY.EQ.0) NY=NCHACT
320   IF (I.GT.NY) GO TO 350
      INTREC(I+NUMBER)=INTREC(I)
C     NOTE - NUMBER .LT. 0 HERE
      INTREC(I)=32
C     32 = ASCII BLANK
      I=I+1
      GO TO 320
C     RIGHT SHIFT
330   I=NBR2
      IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180)
      NY=J+NUMBER
340   IF (I.LT.NY) GO TO 350
      INTREC(I)=INTREC(I-NUMBER)
      I=I-1
      GO TO 340
C     NO SHIFT NEEDED.
350   IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180)
      IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2)
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
C     MOVE UPDATE STRING (STRING2).
360   D2=D2+1
      IF (D2.GE.D3) GO TO 70
      INTREC(J)=COMAND(D2)
      J=J+1
      IF (J-NY) 360,360,70
C
C     REQUEST TO INCLUDE TEXT.  -I IN COLUMNS 1 AND 2.
C
370   IF (EDIT.EQ.0) GO TO 390
      WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD)
380   FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X
     1,80A1))
      NERRS=2
      GO TO 70
390   ITYPEO=73
C     73 = ASCII I
      IF (NCHCMD.GE.4) GO TO 410
      WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD)
400   FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A
     11))
      NERRS=2
      GO TO 70
410   DO 420 I=4,NCHCMD
      IF (COMAND(I).NE.32) GO TO 430
420   CONTINUE
C     CONVERT TO UPPER CASE.  WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM
430   K=0
      DO 440 J=I,NCHCMD
      IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32
      K=K+1
440   COMAND(K)=COMAND(J)
      NCHCMD=K
      GO TO 460
C
C     TEXT RECORD.
C
450   ITYPEO=0
460   NCHOUT=NCHCMD
      IF (OUTOPN.EQ.0) GO TO 470
      MODEO=0
      CALL EXCHPR (ISTAT,OBLOCK,COMAND)
      IF (ISTAT.NE.0) GO TO 770
470   CALL EXCHTP (COMAND,0)
      GO TO 70
C
C     APPARENT CHANGE CONTROL COMMAND
C
480   IF (INEND.EQ.0) GO TO 510
490   WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD)
500   FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT
     1 END./(1X,80A1))
      NERRS=1
      GO TO 70
510   NUMBER=1
      NBR1=0
      EDIT=0
      I=1
520   I=I+1
      IF (I.GT.NCHCMD) GO TO 600
      J=COMAND(I)
      IF (J.EQ.32) GO TO 600
C     32 = ASCII BLANK
      IF (EDIT.NE.0) GO TO 530
C     EDIT CONTROL MUST BE BLANK AFTER $.
      IF (J.EQ.44) GO TO 570
C     44 = ASCII COMMA
      IF (J.EQ.36) GO TO 560
C     36 = ASCII $
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.LE.57) GO TO 550
C     57 = ASCII 9
530   WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD)
540   FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1)
      NERRS=2
      GO TO 60
550   NBR1=10*NBR1+J-48
      GO TO 520
560   IF (NBR1.EQ.0) GO TO 530
      EDIT=1
      NBR1=NBR1-1
      GO TO 520
570   NUMBER=2
      NBR2=0
580   I=I+1
      IF (I.GT.NCHCMD) GO TO 590
      J=COMAND(I)
      IF (J.EQ.32) GO TO 590
C     32 = ASCII BLANK
      IF (IABS(J-44).EQ.1) GO TO 590
C     43 = ASCII +, 45 = ASCII -
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 530
C     57 = ASCII 9
      NBR2=10*NBR2+J-48
      GO TO 580
590   IF (NBR2.LT.NBR1) GO TO 530
      NBR1=NBR1-1
600   IF (NBR1.GE.LINEI-1) GO TO 620
      WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD)
610   FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1)
      NERRS=2
      GO TO 60
620   IF (NCHCMD.LE.0) GO TO 630
      IF (LINEI.LE.NBR1) GO TO 630
      IF (NUMBER.EQ.1) GO TO 70
C     SKIP INTAPE UNTIL NBR2 IS SKIPPED.
      MODEI=1
      IF (LINEI.GE.NBR2) MODEI=0
      IF (LINEI-NBR2) 650,650,70
C     COPY FROM INTAPE UNTIL NBR1 COPIED.
630   MODEO=MODEI
      NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTAPE.EQ.0) GO TO 640
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 770
640   CALL EXCHTP (INTREC,LINEI)
      MODEI=0
      IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650
      IF (LINEI.EQ.NBR1) GO TO 650
      MODEI=1
650   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 760
      LINEI=LINEI+1
      IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620
C     73 = ASCII I
      INEND=1
      IF (NCHCMD.LE.0) GO TO 660
      I=NBR2
      IF (NUMBER.EQ.1) I=NBR1
      IF (LINEI-I) 490,490,70
660   IF (NERRS.EQ.0) GO TO 675
      J=1
      IF (PHASE.EQ.8) J=2
      WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS
670   FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.)
675   NERRG=MAX0(NERRG,NERRS)
      IF (OPTL+OPTS.NE.0) GO TO 690
      IF (OUTAPE+OUFILE.EQ.0) LINEO=0
      IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO
680   FORMAT (I9,14H IMAGES COPIED)
      GO TO 710
690   WRITE (PRINTR,700)
700   FORMAT (1H1)
      CHAR1L=ONE
710   IF (OUFILE.EQ.0) GO TO 720
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
720   IF (ITYPEI.NE.69) GO TO 750
C     69 = ASCII E
C
C     END OF FILE ON INPUT TAPE (UPDATE MODE).
C
      IF (INTOPN.LT.0) GO TO 750
      DO 730 I=1,40
730   HOLCMD(I+1)=TXDISK(I)
      HOLCMD(1)=32
      IF (TXDISK(1).NE.32) HOLCMD(1)=61
C     32 = ASCII BLANK, 61 = ASCII =
      CALL EXCHAH (HOLCMD,41)
      WRITE (PRINTR,740) (HOLCMD(I),I=1,41)
740   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1)
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
750   TRANS=1
      GO TO 790
C
C     ERROR MESSAGES.
C
760   NUMBER=1
      GO TO 780
770   NUMBER=2
780   EQUAL=ISTAT
      TRANS=8
C
C     RETURN TO THE TRANSITION PROGRAM.
C
790   PHASE=2
      IF (OUTOPN.EQ.0) PHASE=1
      RETURN
C
      END
      SUBROUTINE EXCHC8
C
C     PRINT ERROR MESSAGES.
C
C     ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE
      INTEGER S(31)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/
      DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/
      DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/
      DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/
      DATA S(29),S(30),S(31)                         /4,5,5        /
C
C             1  2  3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4
     160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751),
     2NUMBER
C     16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
10    WRITE (PRINTR,20) EQUAL
20    FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.)
      GO TO 50
30    WRITE (PRINTR,40) EQUAL
40    FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.)
50    GO TO (60,80,100,120,140,160), EQUAL
60    WRITE (PRINTR,70)
70    FORMAT (22H BLOCK SEQUENCE ERROR.)
      GO TO 180
80    WRITE (PRINTR,90)
90    FORMAT (20H BLOCK IS TOO SHORT.)
      GO TO 180
100   WRITE (PRINTR,110)
110   FORMAT (11H I/O ERROR.)
      GO TO 180
120   WRITE (PRINTR,130)
130   FORMAT (18H RECORD TOO LARGE.)
      GO TO 180
140   WRITE (PRINTR,150)
150   FORMAT (21H UNKNOWN RECORD TYPE.)
      GO TO 180
160   WRITE (PRINTR,170)
170   FORMAT (25H FIRST BLOCK NOT A LABEL.)
      GO TO 760
180   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1)
      INFILE=0
C
C     RETURN TO QUIT SEGMENT.
C
      TRANS=9
      GO TO 800
C
200   WRITE (PRINTR,210)
210   FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.)
      GO TO 760
220   WRITE (PRINTR,230)
230   FORMAT (//20H0INTAPE NOT DEFINED.)
      GO TO 760
240   WRITE (PRINTR,250)
250   FORMAT (//23H0UNABLE TO OPEN INTAPE.)
      GO TO 10
260   WRITE (PRINTR,270)
270   FORMAT (//23H0UNABLE TO OPEN OUTAPE.)
      GO TO 30
280   WRITE (PRINTR,290)
290   FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.)
      GO TO 760
300   WRITE (PRINTR,310)
310   FORMAT (//19H0DATE NOT SUPPLIED.)
      GO TO 760
320   WRITE (PRINTR,330)
330   FORMAT (//19H0SITE NOT SUPPLIED.)
      GO TO 760
340   WRITE (PRINTR,350) INTAPE
350   FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4)
      GO TO 760
360   WRITE (PRINTR,370)
370   FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.)
      GO TO 760
380   WRITE (PRINTR,390)
390   FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.)
      GO TO 760
400   WRITE (PRINTR,410)
410   FORMAT (//27H0COMMAND HAS IMPROPER DATE.)
      GO TO 760
420   WRITE (PRINTR,430) EQUAL
430   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.)
      GO TO 780
440   WRITE (PRINTR,450)
450   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.)
      IF (ICOMD) 780,560,780
460   WRITE (PRINTR,470) N1RECI
470   FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO
     1N (,I5,2H).)
      GO TO 760
480   WRITE (PRINTR,490) EQUAL
490   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
500   WRITE (PRINTR,510)
510   FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.)
      GO TO 760
520   WRITE (PRINTR,530)
530   FORMAT (//23H0WORK FILE NOT DEFINED.)
      GO TO 760
540   WRITE (PRINTR,550)
550   FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.)
      GO TO 760
560   WRITE (PRINTR,570) EQUAL
570   FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.)
      GO TO 760
580   WRITE (PRINTR,590)
590   FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE
     1R.)
      GO TO 760
600   WRITE (PRINTR,610)
610   FORMAT (//12H0TOO MANY (.)
      GO TO 760
620   WRITE (PRINTR,630) EQUAL
630   FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.)
      GO TO 760
640   WRITE (PRINTR,650) EQUAL
650   FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.)
      GO TO 760
660   WRITE (PRINTR,670) EQUAL
670   FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.)
      GO TO 760
680   WRITE (PRINTR,690) EQUAL
690   FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.)
      GO TO 760
700   WRITE (PRINTR,710) EQUAL
710   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
720   WRITE (PRINTR,730) N1RECI
730   FORMAT (//21H0INTAPE POSITIONED AT,I5,25H.  BACKWARD SKIP IGNORED.
     1)
      GO TO 780
740   WRITE (PRINTR,750)
750   FORMAT (//23H0COMMAND IS INCOMPLETE.)
      GO TO 760
751   WRITE (PRINTR,752)
752   FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA
     1PE OR OUTPUT.)
760   WRITE (PRINTR,770)
770   FORMAT (23H COMMAND NOT PROCESSED.)
780   WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD)
790   FORMAT ((1X,80A1))
C
C     RETURN TO COMMAND PROCESSSOR.
C
      CHAR1L=0
      NERRS=MAX0(S(NUMBER),NERRS)
      NERRG=MAX0(NERRG,NERRS)
      TRANS=1
C
C     RETURN TO TRANSITION PROGRAM.
C
800   RETURN
C
      END
      SUBROUTINE EXCHC9 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO
C     ERRORS.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KQUIT /20/
C
      IF (INFILE.EQ.0) GO TO 10
      IF (MODIFY.NE.82) GO TO 5
C     82 = ASCII R
      ACTION=2
C     ACTION = 2 MEANS REWIND INFILE.
      CALL EXCHIM
5     ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      CALL EXCHIM
      INFILE=0
      NCHCMD=0
      GO TO 50
10    IF (OPTC*OUFILE.EQ.0) GO TO 20
      ACTION=0
      NCHOUT=4
      CALL EXCHOU (COMD(1,KQUIT))
20    ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      IF (OUTOPN.EQ.0) GO TO 30
C     WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC)
C     CLOSE THE INPUT TAPE.
30    IF (INTOPN.EQ.0) GO TO 40
      ISTAT=4
      CALL EXCHRT (ISTAT,OBLOCK)
C
C     RETURN TO MAIN PROGRAM.
C
40    TRANS=0
      IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG
45    FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.)
      GO TO 60
C
C     RETURN TO THE COMMAND DECODER.
C
50    TRANS=1
60    RETURN
C
      END
=TES FILE=10
        SUBTTL BYTE MANIPULATION ROUTINES - FORTRAN CALLABLE
;  CALLING SEQUENCES --
;       POINTE MAKES A BYTE POINTER VIA  P=POINTE(SIZ,PLACE,POS)
;WHERE P AND POINTE MUST BE THE SAME TYPE,SIZ,PLACE AND POS SHOULD
;BE INTEGERS.  SIZ IS THE BYTESIZE IN BITS.  PLACE IS THE VARIABLE INTO WHICH
;IT WILL BE PUT OR FROM WHICH IT WILL BE TAKEN.  POS IS THE BIT-POSITION IN PLAC
;AT WHICH THE BYTE STARTS (LEFT END OF WORD IS BIT 0).
;BEWARE --THE POINTER WILL NOT BE SET UP CORRECTLY IF PLACE HAS BEEN
;PASSED AS AN ARGUMENT TO THE CALLING PROGRAM **UNLESS** PLACE IS
;DIMENSIONED (1) IN THE PROGRAM THAT CALLS POINTE.  IN PDP-10 FORTRAN,
;THIS IS THE ONLY WAY TO CALL AN ARGUMENT BY LOCATION RATHER THAN BY VALUE.
;       L=BYTE(P) GETS THE BYTE POINTED TO BY THE POINTER IN P AND PUTS
;IT IN L.  L AND BYTE MUST BE OF THE SAME TYPE.
;       CALL STRBYT(L,P) STORES THE RIGHTHAND BYTE OF L INTO THE PLACE
;POINTED TO BY THE POINTER IN P.  THE BYTESIZE IS DETERMINED BY THE POINTER.
;       IN BOTH BYTE AND STRBYT,THE POINTER IS INCREMENTED TO POINT TO THE NEXT
;BYTE.
;       LSH SHIFTS A WORD'S BITS TO RIGHT OR LEFT,BRINGING IN ZEROES AS
;NEEDED.  IT IS CALLED BY J=LSH(I,N) WHERE I CONTAINS THE WORD TO
; BE SHIFTED,N IS THE NUMBER OF BITS TO SHIFT (POSITIVE MEANS LEFTWARD
;SHIFT,NEGATIVE MEANS RIGHTWARD) AND !!BOTH!! I AND J CONTAIN THE SHIFTED
;RESULT.  SO COPY FIRST BEFORE SHIFTING.
        ENTRY POINTE,BYTE,STRBYT,LSH
POINTE::        MOVE    @0(16)          ;GET FIRST ARGUMENT
        LSH     6               ;SHIFT LEFT SIX BITS
        MOVEI 1,44              ;LEFT POSITION FOR POINTER START
        SUB 1,@2(16)            ;ADJUST IT FOR 3RD ARGUMENT
        LSH 1,14                ;SHIFT IT LEFT
        ADD 1,0         ;COLLECT THE LEFT HALF
        MOVEI @1(16)            ;GET ADDRESS OF BYTE
        TSO 0,1                 ;MOVE INTO THE POINTER
        POPJ 17,                ;QUIT

BYTE::  ILDB @0(16)             ;PUT THE BYTE IN AC 0
        POPJ 17,

STRBYT::        MOVE @0(16)             ;GET BYTE
        IDPB @1(16)             ;PUT WHERE IT BELONGS
        POPJ 17,
LSH::   MOVE @0(16)             ;GET WORD TO BE SHIFTED
        MOVE 1,@1(16)           ;AND #BITS TO SHIFT
        LSH 0(1)                ;SHIFT
        MOVEM @0(16)            ;SAVE RESULT IN FIRST ARGUMENT
        POPJ 17,
        END
                SUBTTL VARIOUS DEVIOUS MACRO-10 SUBROUTINES TO SAFELY OPEN A
IFNDEF TOPS10,<TOPS10==0>
;TAPE FOR INDUSTRY STANDARD 8-BIT-BYTE MODE.
;       CALLING SEQUENCES --
;       CALL CHNFND(ICHN,ISTAT)  FINDS NEXT FREE CHANNEL FROM FOROTS AND PUTS
;NUMBER IN ICHN.  IF NO CHANNEL IS AVAILABLE ISTAT=3.
;       CALL CHNCHK(ICHN,TAPDEV,ISTAT) COMPARES THE DEVICE ON CHANNEL
;ICHN AND THAT ASSOCIATED WITH DEVICE TAPDEV.  IF THEY ARE THE SAME
;AND REFER TO A MAGTAPE WE OWN IN IMAGE MODE, IT IS ASSUMED THE CHANNEL
;NUMBER IS THAT ASSOCIATED WITH TAPDEV.  IF NO MATCH,OR
;DEVICE IS NOT A TAPE, ISTAT=3.
;       CALL TAPSET(ICHN) SETS THE TAPE FOR INDUSTRY STANDARD MODE,
;I.E.,800 BPI,ODD PARITY,8-BIT BYTES THAT GET PACKED 4 PER 36-BIT
;WORD IN THE TAPE BUFFER.
;       CALL DMPIN (BLOCK,ICHN,NWDS,IEOF,IERR)
;WHERE BLOCK IS AN ARRAY AT LEAST NWDS LONG INTO WHICH A RECORD IS READ FROM
;ICHN IN DUMP MODE.  IERR AND IEOF = ZERO IF OK, IERR = ERROR STATUS IF ERROR
;AND IEOF NOT EQUAL ZERO IF EOF.  EXTRA WORDS ARE IGNORED.
;       CALL DMPOUT (BLOCK,ICHN,NWDS,IERR)
;WHERE NWDS OF BLOCK ARE TO BE WRITTEN ON ICHN IN DUMP MODE.  IERR=0 IF
;NO ERRORS, ELSE IS SET TO THE FILE STATUS.
;
;************  WARNING  ***************
;
;THE DPB INSTRUCTIONS IN TAPSET, DMPIN AND DMPOUT MODIFY CODE.  HENCE THEY CAN
;CONFUSE DDT IF BREAKPOINTS ARE SET AT THE INSTRUCTIONS BEING MODIFIED (DDT
;PLANTS A JSR).  ALSO, THESE ROUTINES CANNOT BE MOVED TO THE HIGH SEGMENT.
        ENTRY CHNFND,CHNCHK,TAPSET
        SUBTTL CHNFND -- FIGURE OUT WHAT NEXT FREE CHANNEL IS
CHNFND::        MOVEM 16,ARGPT          ;SAVE ARGUMENT LIST POINTER
        MOVE 0,[100,,0]         ;SET UP CHANNEL BLOCK
        MOVEM 0,CHNBLK
        SETZ 0,
        MOVEI 16,CHNBLK         ;GET READY
        PUSHJ 17,ALCHN.##       ;ASK FOROTS FOR NEXT FREE I/O CHANNEL
        CAIGE                   ;IF NONE AVAILABLE
          JRST CHNERR           ;BIG TROUBLE
        MOVE 16,ARGPT           ;GET BACK THE ARGUMENT LIST
        MOVEM 0,@0(16)          ;RETURN THE CHANNEL NO.
        MOVEI 16,CHNBLK
        PUSHJ 17,DECHN.##       ;AND DO IT
        CAIGE
          JRST CHNERR           ;DIE ON ERRORS
        POPJ 17,
CHNERR: OUTSTR[ASCIZ/ ?CHNFND:NO CHANNEL AVAILABLE
/]
        MOVE 16,ARGPT
        MOVEI 3,3       ;MAKE ERROR CODE FOR ISTAT
        MOVEM 3,@2(16)          ;AND STORE IT
        POPJ 17,
ARGPT:  BLOCK 1
        -1,,0
        CHNBLK: BLOCK 1

        SUBTTL CHNCHK -- IS THERE A MAGTAPE ON ICHN AS EXPECTED?

CHNCHK::
IFN TOPS10,<
                MOVE 0,@0(16)             ;GET CHANNEL #
        DEVCHR 0,               ;WHAT DEVICE IS IT?
        MOVE 1,@1(16)           ;GET DEVICE NAME IN ASCII
        SETZB 5,4               ;CLEAR TEMP ACS
        MOVNI 6,5               ;NO MORE THAN 5 CHARS IN LOGICAL NAME
SIXCON: MOVE 2,[POINT 7,1]      ;CONVERSION TO SIXBIT-ASCII BYTE POINTER
        MOVE 3,[POINT 6,4]      ;SIXBIT BYTE POINTER
        ILDB 5,2                ;GET A CHARACTER
        SUBI 5,40               ;MAKE SIXBIT
        IDPB 5,3                ;SAVE
        AOSE 6                  ;GO ON WHEN DONE
        JRST SIXCON+2           ;LOOP WHEN NOT
        MOVE 1,4                ;HERE'S CORRECT DEVICE NAME
        DEVCHR 1,
        CAME 1,0                ;ARE THEY THE SAME?
          JRST DEVERR           ;WHOOPS
MTEST:  SETCA 1,                ;COMPLEMENT
        TDNE 1,[1B12!1B13!1B20] ;SEE IF ITS A MAGTAPE WE OWN IN DUMP MODE
          JRST DEVERR           ;CAN'T FIX THIS ERROR
        POPJ 17,
DEVERR: OUTSTR [ASCIZ/ ?CHNCHK:CAN'T MATCH CHANNEL TO DEVICE
/]
        MOVEI 3,3               ;ERROR CODE FOR ISTAT
        MOVEM 3,@2(16)          ;CAN'T FIX,ISTAT=3
>;END IFN TOPS10
        POPJ 17,

        SUBTTL TAPSET -- SET MAGTAP FOR INDUSTRY STANDARD 800-BPI 8-BIT-BYTES

TAPSET::        MOVE 0,@0(16)           ;GET CHANNEL NO.
        MOVE 1,[POINT 4,INDUST,12]      ;POINTER TO AC FIELD OF MTAPE INSTR.
        DPB 0,1                         ;PUT CHANNEL NUMBER THERE
        HRRI 1,GET                      ;POINT TO ACC OF GETSTS
        DPB 0,1                         ;INSERT CHANNEL NUMBER
        HRRI 1,SET                      ;POINT TO ACC OF SETSTS
        DPB 0,1                         ;INSERT CHANNEL NUMBER
INDUST: MTAPE 0,101                     ;SET UP FOR INDUSTRY STANDARD
GET:    GETSTS 0,5                      ;GET FILE STATUS
        IORI 5,17                       ;SET NEW BITS TO
SET:    SETSTS 0,(5)                    ;  CHANGE MODE TO .IODMP
        POPJ 17,
;
        SUBTTL DMPOUT - WRITE VARIABLE LENGTH DUMP MODE RECORDS.
;
DMPOUT:: MOVEI 0,@0(16)                 ;GET BLOCK
        SUBI 0,1                        ;FIND LOC JUST BEFORE IT
        MOVE 2,@1(16)                   ;GET CHANNEL NUMBER
        MOVE 1,[POINT 4,OUTT,12]        ;POINT TO OUT INSTR
        DPB 2,1                         ;PUT CHANNEL NUMBER THERE
        HRRI 1,GETO                     ;POINT TO GETSTS
        DPB 2,1                         ;PUT CHANNEL NUMBER THERE
        MOVE 1,@2(16)                   ;GET SIZE OF BLOCK
        MOVNS 1,1                       ;NEGATE
        MOVSS 1,1                       ;SWAP HALVES
        HRR 1,0                         ;NOW HAVE XWD (-LEN,BLK-1)
        MOVEM 1,COMD                    ;SAVE THE IOWD
OUTT:   OUT 0,COMD                      ;DO THE OUTPUT
        JRST [SETZM @3(16)              ;OK, CLEAR THE ERROR WORD
        POPJ 17,        ]               ;RETURN
GETO:   GETSTS 0,0                      ;GET FILE STATUS IF ERROR
        MOVEM 0,@3(16)                  ;SEND IT BACK VIA IERR
        POPJ 17,                        ;RETURN
COMD:   BLOCK 2                         ;DUMP MODE COMMAND LIST
;
        SUBTTL DMPIN - READ VARIABLE LENGTH DUMP MODE RECORDS
;
DMPIN:: MOVEI 0,@0(16)                  ;GET BLOCK
        SUBI 0,1                        ;FIND LOC JUST BEFORE IT
        MOVE 2,@1(16)                   ;GET CHANNEL NUMBER
        MOVE 1,[POINT 4,INN,12]         ;POINT TO ACC OF IN INSTRUCTION
        DPB 2,1                         ;PUT CHANNEL NUMBER THERE
        HRRI 1,SETI                     ;POINT TO SETSTS INSTR
        DPB 2,1                         ;PUT CHANNEL THERE
        HRRI 1,GETI                     ;POINT TO GETSTS INSTR
        DPB 2,1                         ;PUT CHANNEL THERE
        MOVE 1,@2(16)                   ;GET SIZE OF BLOCK
        MOVNS 1,1                       ;NEGATE
        MOVSS 1,1                       ;SWAP HALVES
        HRR 1,0                         ;NOW HAVE XWD (-LEN,BLOCK-1)
        MOVEM 1,COMDI                   ;SAVE THE IOWD
INN:    IN 0,COMDI                      ;DO THE INPUT
        JRST [SETZM @3(16)              ;OK, CLEAR THE EOF WORD
        SETZM @4(16)                    ;AND THE ERROR WORD
        POPJ 17,        ]               ;RETURN
GETI:GETSTS 0,0                         ;GET FILE STATUS IF ERROR
        MOVE 1,0                        ;MAKE A COPY
        MOVE 2,0                        ;AND ANOTHER
        ANDI 0,20000                    ;IS IT END OF FILE?
        MOVEM 0,@3(16)                  ;RETURN IT IN IEOF
        TRZ 1,77777                     ;IGNORE ALL BITS EXCEPT
                                        ;IO.IMP=ILLEGAL OPERATION
                                        ;IO.DER=DATA MISSED, TAPE BAD OR HUNG
                                        ;IO.DTE=PARITY ERROR
        MOVEM 1,@4(16)                  ;SEND BACK ERROR IF ANY OF ABOVE
        TRZ 2,760000                    ;TURN OFF ALL ERROR BITS
SETI:   SETSTS 0,0(2)                   ;TRY FOR ERROR RECOVERY
        POPJ 17,                        ;RETURN
COMDI:  BLOCK 2                         ;DUMP MODE COMMAND LIST
        END
=TES FILE=11
       BYTE IBLOCK(7200)
C========================
C EXCHANGE PROGRAMS
C DISTRIBUTED BY W. VAN SNYDER, JET PROPULSION LABORATORY
C
C THIS IS THE MAIN PROGRAM FOR THE RSX-11M V3 IMPLEMENTATIONS
C========================
C
      BYTE FNAMES(40,3)
       LOGICAL TABS
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCRSX/ TABS,FNAMES
C
C     DEFAULT DEVICE FOR INTAPE IN SIMPLE PROGRAM
      DATA FNAMES(1,2),FNAMES(2,2),FNAMES(3,2) /'M','T','0'/
      DATA FNAMES(4,2),FNAMES(5,2)             /':',0      /
C
       NWCBI = 90
       READER = 5
       PRINTR = 6
       CALL EXCH (IBLOCK)
       CALL EXIT
       END
      BLOCK DATA
C
C     BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/
      DATA INTEXT /0/, INALT /0/
C
      DATA CHAR1L /1H1/
C                                                        A  U  T  H
      DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1)  /65,85,84,72/
C                                                        C  O  M  M
      DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2)  /67,79,77,77/
C                                                        C  O  P  Y
      DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3)  /67,79,80,89/
C                                                        D  A  T  A
      DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4)  /68,65,84,65/
C                                                        D  A  T  E
      DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5)  /68,65,84,69/
C                                                        G  R  O  U
      DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6)  /71,82,79,85/
C                                                        I  N  D  E
      DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7)  /73,78,68,69/
C                                                        I  N  P  U
      DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8)  /73,78,80,85/
C                                                        N  A  M  E
      DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9)  /78,65,77,69/
C                                                        I  N  T  A
      DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/
C                                                        K  E  Y  W
      DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/
C                                                        L  I  M  I
      DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/
C                                                        M  A  C  H
      DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/
C                                                        O  P  T  I
      DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/
C                                                        O  R  I  G
      DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/
C                                                        O  U  T  A
      DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/
C                                                        O  U  T  P
      DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/
C                                                        P  R  E  D
      DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/
C                                                        P  R  I  N
      DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/
C                                                        Q  U  I  T
      DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/
C                                                        R  E  A  D
      DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/
C                                                        R  E  F  E
      DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/
C                                                        R  E  M  O
      DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/
C                                                        R  E  W  I
      DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/
C                                                        S  I  T  E
      DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/
C                                                        S  K  I  P
      DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/
C                                                        T  E  X  T
      DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/
C                                                        T  I  T  L
      DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/
C                                                        U  P  D  A
      DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/
C                                                        W  O  R  K
      DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/
C                                                        C  O  N  T
      DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/
C                                                        I  D  E  N
      DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/
C                                                        I  N  C  L
      DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/
C                                                        S  I  G  N
      DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/
C                                                        M  A  R  G
      DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/
      DATA IDSTEP /0/, IDTXTL /0/
      DATA INDEX /0/
      DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/
      DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/
      DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/
      DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/
      DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/
      DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/
      DATA INDEXS(25),INDEXS(26)                       /0,0    /
      DATA INTOPN /0/
      DATA ITYPEI /0/
      DATA LIMIT /0/
      DATA MARGIN /180/
      DATA NCCBI /180/
      DATA NCCBO /180/
      DATA NCHCMD /0/
      DATA NCHMAX /180/
      DATA NCOMDP /35/
      DATA NCOMDT /35/
      DATA NDATAO /3591/
      DATA NERRCO /0/
      DATA NERRG /0/
      DATA NRWORK /0/
      DATA OUTOPN /0/
      DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/
      DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/
      DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/
      DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/
      DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/
      DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/
      DATA OPTVAL(25),OPTVAL(26)                       /0,0    /
      DATA PHASE /1/
C     INDICATE THAT NO PREDICATES ARE DEFINED.
      DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/
      DATA PRED(1,6),PRED(1,7),PRED(1,8)                     /0,0,0    /
      DATA SITE(1) /0/
      DATA TITLE(1) /32/
C     32 = ASCII BLANK
      DATA TODAY (1) /0/
      DATA TRANS /1/
      END
      SUBROUTINE EXCH (IBLOCK)
C
C     PDP 11 INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM.
C     IT KNOWS HOW TO FETCH THE DATE FROM RSX.
C
      INTEGER IBLOCK(1)
C
C     ALLOCATE SPACE FOR TAPE OUTPUT
C
      BYTE OBLOCK(3600)
c
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      LOGICAL TABS
      BYTE FNAMES(40,3)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCRSX/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
c
       INTEGER MKDTTD,MKDTOD
c
c   make date tens digit and make date ones digit
       MKDTTD(M) = M/10 + 48
       MKDTOD(N) = MOD(N,10) + 48
c
       NWCBO = 90
       WORKF  = 7
       TABS = .TRUE.
C      DEFINE THE COMMAND 'TABS='.
       NCOMDT=NCOMDP+1
       COMD(1,NCOMDT)=84
       COMD(2,NCOMDT)=65
       COMD(3,NCOMDT)=66
       COMD(4,NCOMDT)=83
       CALL IDATE(I,J,K)
       TODAY(1) = MKDTTD(K)
       TODAY(2) = MKDTOD(K)
       TODAY(3) = MKDTTD(I)
       TODAY(4) = MKDTOD(I)
       TODAY(5) = MKDTTD(J)
       TODAY(6) = MKDTOD(J)
       WRITE (6,602) TODAY
       CALL EXCHTR(IBLOCK,OBLOCK)
       RETURN
  602  FORMAT('0EXCHANGE PROGRAM',/,' DEFAULT DATE IS ',2(2A1,'-'),2A1)
       END
      SUBROUTINE EXCHAH (RECORD,NCHAR)
C
C     CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO
C     HOLLERITH FORMAT.
C
C     THIS VERSION DOES NOTHING.  IT IS MEANT FOR USE ON MACHINES
C     THAT USE RIGHT JUSTIFIED ZERO FILLED ASCII AS THE INTERNAL
C     CHARACTER REPRESENTATION.  THE DEC PDP-11 UNDER RSX-11M-V3
C     STORES CHARACTERS THIS WAY.
C
      RETURN
      END
      SUBROUTINE EXCHFO (IOP)
C
C     DEC PDP-11 USING RSX-11M V3
C
C     OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM.
C     IOP LESS THAN ZERO MEANS CLOSE FILE, IOP GREATER THAN ZERO MEANS
C     OPEN FILE.  IABS(IOP) = 1 MEANS READER, = 2 MEANS PRINTER, = 3
C     MEANS WORK FILE, = 4 MEANS INFILE.  IOP = 4 IS USED ONLY BY THE
C     BOOTSTRAP PROGRAM.
C
C     ON RSX, RDIRECTION OF READER AND PRINTR TO ANYTHING
C     OTHER THAN TI: IS NOT ALLOWED
C
      INTEGER IOP, JUMP
      BYTE FNAME(10)
C
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      DATA FNAME(1),FNAME(2),FNAME(3),FNAME(4) /'E','X','C','H'/
      DATA FNAME(5),FNAME(6),FNAME(7),FNAME(8) /'0','0','.','T'/
      DATA FNAME(9),FNAME(10)                  /'M','P'/
C
      JUMP=IABS(IOP)
      IF (IOP.LT.0) GO TO (10,20,30,40), JUMP
      GO TO (50,60,70,80), JUMP
C
C     CLOSE FILES.
10    GO TO 90
20    GO TO 90
30    CLOSE (UNIT=WORKF)
      GO TO 90
40    CLOSE (UNIT=INFILE)
      GO TO 90
C
C     OPEN FILES.
50    GO TO 90
60    GO TO 90
C     ASSUME UNIT NUMBER IS TWO DIGITS.
70    FNAME(5)=WORKF/10+'0'
      FNAME(6)=MOD(WORKF,10)+'0'
      OPEN (UNIT=WORKF,NAME=FNAME,TYPE='SCRATCH',ERR=100)
      GO TO 90
C     ASSUME UNIT NUMBER IS TWO DIGITS.
80    FNAME(5)=INFILE/10+'0'
      FNAME(6)=MOD(INFILE,10)+'0'
      OPEN (UNIT=INFILE,NAME=FNAME,TYPE='SCRATCH',ERR=120)
C
90    RETURN
C
100   WRITE (PRINTR,110)
110   FORMAT (26H UNABLE TO OPEN WORK FILE.)
      STOP
120   WRITE (PRINTR,130)
130   FORMAT (29H UNABLE TO OPEN INCLUDE FILE.)
      STOP
      END
       subroutine EXCHIM
c========================
c EXCHANGE program, DEC RSX-11M implementation
c
c read a command or text image from    1. alternate correction file
c                                      2. text file
c                                      3. input file
c                                      4. system reader
c if reading from -reader-, put a prompt on the terminal
c put the Hollerith command in HOLCMD
c put the ASCII equivalent in COMAND
c put the number of characters in NCHCMD
c if end-of-file is sensed, set NCHCMD=-1
c if the variable -tabs- is true, keep the tab characters
c
c routine reads only 80 character images
c========================
c
       integer blank,bfill,rdfile
      BYTE TMPLIN(80)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      LOGICAL TABS
      BYTE FNAMES(40,3)
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCRSX/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
       equivalence (tmplin(1),comand(1))
       data blank/1h /
c
c    determine which file to work on
       rdfile = inalt
       if (rdfile .gt. 0) goto 1000
       rdfile = intext
       if (rdfile .ne. 0) goto 1000
       rdfile = infile
       if (rdfile .eq. 0) rdfile = reader
c
C   PERFORM ACTION.  FILES ARE OPENED IN EXCHCX.
1000   i = action + 2
       goto (5000,4000,7000,2000),i
       return
C
C   REWIND INALT
2000   REWIND RDFILE
       GO TO 7000
c
c   read in a line, mapping tabs if necessary
4000   if (rdfile .eq. reader) write (rdfile,601)
       read (rdfile,501,end=8000) m,tmplin
       nchcmd=0
       if (m.eq.0) goto 7000
       do 4090 i=1,m
           if (tabs) goto 4070
           if (tmplin(i) .ne. 9) goto 4070
           bfill = 8 - mod(nchcmd,8)
           do 4040 j=1,bfill
               nchcmd=nchcmd+1
               holcmd(nchcmd)=blank
4040           continue
           goto 4090
4070       nchcmd=nchcmd+1
           holcmd(nchcmd)=tmplin(i)
4090       continue
       do 4190 i=1,nchcmd
           comand(i) = holcmd(i) .and. "0177
4190       continue
       m=nchcmd
       do 4200 i=1,m
           if (comand(m-i+1).eq.32) go to 4200
c          32 = ASCII blank.
           nchcmd=m-i+1
           go to 7000
4200       continue
       nchcmd=0
       goto 7000
c
c   close a file
5000   close(unit=rdfile)
c
7000   action = 0
       return
c
8000   nchcmd = -1
       goto 7000
501    format(q,80a1)
601    format('$*')
       end
      SUBROUTINE EXCHOU (OUTPUT)
C
C     NATIVE FORMAT OUTPUT PROGRAM FOR THE TEXT EXCHANGE PROGRAM.
C     RSX-11M IMPLEMENTATION
C
C     OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN.
C     THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT.
C
C     THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180),
C     THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179).  IF OUTPUT(180)
C     IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE.  IF OUTPUT(180)
C     IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW
C     IMAGE.
C
      INTEGER OUTPUT(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C
C   DECIDE WHETHER TO OPEN, CLOSE OR WRITE.
C
      IF (ACTION.NE.0) IF (ACTION+1) 70,40,70
C
C   WRITE
      WRITE (OUFILE,30) (OUTPUT(I),I=1,NCHOUT)
30    FORMAT (132A1)
      GO TO 70
C
C   CLOSE
40    CLOSE(UNIT=OUFILE)
C
70    ACTION=0
      RETURN
      END
       subroutine EXCHRT (ISTAT,INPBUF)
c========================
c EXCHANGE program, DEC RSX-11M implementation
c this is the module EXCHRT
c
c parameters
c    istat     - what to do
c       = 1 :  open input tape, no rewind
c       = 2 :  rewind and close input tape
c       = 3 :  read in buffer
c       = 4 :  close input tape, no rewind
c    inpbuf    - the buffer
c
c values returned in -istat-
c    0 if no problems
c    3 on any error (-dotape()- will print specifics)
c
c========================
c
       integer istat,inpbuf(1)
c
       integer expsiz,tapeok
       logical tapatt
       integer dotape
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
c
       data tapatt/.FALSE./
c
D      write (printr,601) istat
       if ((istat.ge.1) .and. (istat.le.4)) goto 1100
       istat = 3
       return
1100   goto (2000,3000,4000,5000), istat
c
2000   call assign(intape,'MT0:')
       tapeok = dotape("001400,intape,0,0,printr)
       tapatt = .TRUE.
       goto 9000
c
3000   tapeok = dotape("002400,intape,0,0,printr)
       if (.not. tapatt) goto 3200
       if (tapeok .ge. 0) tapeok = dotape("002000,intape,0,0,printr)
       tapatt = .FALSE.
3200   call close(intape)
       goto 9000
c
4000   expsiz = ndatai + nerrci + 9
       ncdbi = expsiz
       tapeok = dotape("001000,intape,inpbuf,ncdbi,printr)
       ncdbi = min0(ncdbi,expsiz)
       goto 9000
c
5000   tapeok = dotape("002000,intape,0,0,printr)
       tapatt = .FALSE.
       call close(intape)
c
9000   istat = 0
       if (tapeok .lt. 0) istat = 3
D      write (printr,*) 'EXCHRT GOT',tapeok,' IS GIVING',istat
9999   return
D 601  format(' EXCHRT PERFORM',I2)
       end
       subroutine EXCHWT (ISTAT,OUTBUF)
c========================
c EXCHANGE program, DEC RSX-11M implementation
c this is the module EXCHWT
c
c parameters
c    istat     - what to do
c       = 1 :  open output tape, no rewind
c       = 2 :  write out buffer
c       = 3 :  close output tape, no rewind
c              writes 3 EOF marks on tape
c    outbuf    - the buffer
c
c values returned in -istat-
c    0 if no problems
c    3 on any error (-dotape()- will print specifics)
c
c========================
c
       integer istat,outbuf(1)
c
       integer expsiz,tapeok
       integer dotape
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
c
       if ((istat.ge.1) .and. (istat.le.3)) goto 1100
       istat = 3
       return
1100   goto (2000,3000,4000), istat
c
2000   call assign(outape,'MT1:')
       tapeok = dotape("001400,outape,0,0,printr)
       goto 9000
c
3000   expsiz = ccdbo
       if (blksqo .ne. 0) expsiz = ndatao + nerrco + 9
       tapeok = dotape("000400,outape,outbuf,expsiz,printr)
       goto 9000
c
4000   tapeok = dotape("003000,outape,0,0,printr)
       if (tapeok .ge. 0) tapeok = dotape("003000,outape,0,0,printr)
       if (tapeok .ge. 0) tapeok = dotape("003000,outape,0,0,printr)
       if (tapeok .ge. 0) tapeok = dotape("002000,outape,0,0,printr)
       call close(outape)
c
9000   istat = 0
       if (tapeok .lt. 0) istat = 3
D      write (printr,*) 'EXCHWT GOT',tapeok,' IS GIVING',istat
9999   return
D 601  format(' EXCHWT PERFORM',I2)
       end
c========================
c do something to a magtape
c routine is RSX-11M specific
c
c parameters
c      comand  - RSX I/O directive
c      lun     - logical unit number to perform operation
c      buffer  - array to be used as buffer, must be even address
c      nbytes  - number of bytes to be played with, should be even
c      errlun  - logical unit number for routine to write error message
c
c I/O directive codes
c      IO.ATT  001400  attach device
c      IO.DET  002000  detach device
c      IO.RLB  001000  read logical block
c      IO.WLB  000400  write logical block
c      IO.RWD  002400  rewind tape
c      IO.EOF  003000  write end of file
c
c returned values: DOTAPE
c      -1 on any error
c      number of bytes done if all OK
c========================
c
       integer function dotape(comand,lun,buffer,nbytes,errlun)
       integer comand,lun,buffer(1),nbytes,errlun
c
       integer params(6),status(2),ds,error
c
       dotape = 0
       call getadr(params,buffer)
       params(2) = nbytes
       call wtqio(comand,lun,1,,status,params,ds)
       error = status(1) .and. "0377
       if ((error .ge. "0200) .or. (ds .lt. 0)) goto 1140
       dotape = status(2)
       return
c
1140   dotape = -1
       write (errlun,601) error,comand
       return
  601  format('0TAPE PROCESSOR ERROR',O4,' FOR COMMAND',O7)
       end
      SUBROUTINE EXCHSL
C
C     LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS.
C
C     EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE
C     SEGMENT.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      RETURN
      END
      SUBROUTINE EXCHTR (IBLOCK,OBLOCK)
C
C     TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER.
C
      INTEGER IBLOCK(1), OBLOCK(1)
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4.
C
      CALL EXCHFO (1)
      CALL EXCHFO (2)
      WORKF=-IABS(WORKF)
C
10    IF (TRANS.LE.0) RETURN
      CALL EXCHSL
C     LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS.
      GO TO (11,12,13,14,15,16,17,18,19), TRANS
C     COMMAND PARSER
11    CALL EXCHC1 (IBLOCK,OBLOCK)
      GO TO 10
C     IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE
12    CALL EXCHC2
      GO TO 10
C     OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE.
13    CALL EXCHC3 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE.
14    CALL EXCHC4 (IBLOCK)
      GO TO 10
C     COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE.
15    CALL EXCHC5 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY TEXT FROM INTAPE TO OUTAPE
16    CALL EXCHC6 (IBLOCK,OBLOCK)
      GO TO 10
C     TEXT COMMAND
17    CALL EXCHC7 (IBLOCK,OBLOCK)
      GO TO 10
C     ERROR MESSAGES
18    CALL EXCHC8
      GO TO 10
C     QUIT
19    CALL EXCHC9 (IBLOCK,OBLOCK)
      GO TO 10
      END
      SUBROUTINE EXCHGB (ISTAT,DBLOCK)
C
C     READ A BLOCK FROM THE EXCHANGE TAPE.
C     IGNORE THE ERROR CONTROL SEGMENT.
C     CHECK THE BLOCK SEQUENCE NUMBER.
C     CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER,
C               OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
C
C     READ A BLOCK FROM INTAPE.
C
      BLKSQI=BLKSQI+1
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 160
C
C     GET INFORMATION OUT OF THE BLOCK HEADER.
C
      CCDBI=NERRCI
      CWDBI=NWCBI*(CCDBI/NCCBI)+1
      CPCBI=MOD(CCDBI,NCCBI)
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
      DO 110 JUMP=1,9
      CCDBI=CCDBI+1
      CPCBI=CPCBI+1
      IF (CCDBI.GT.NCDBI) GO TO 130
      IF (CPCBI.LE.NCCBI) GO TO 10
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
10    GO TO (20,30,40,50,60,70,80,90,100), JUMP
20    NEWBLK=256*CBLCKI(CPCBI)
      GO TO 110
30    NEWBLK=NEWBLK+CBLCKI(CPCBI)
      GO TO 110
40    LASTI=CBLCKI(CPCBI)
      GO TO 110
50    L1PRGI=256*CBLCKI(CPCBI)
      GO TO 110
60    L1PRGI=L1PRGI+CBLCKI(CPCBI)
      GO TO 110
70    N1RECI=256*CBLCKI(CPCBI)
      GO TO 110
80    N1RECI=N1RECI+CBLCKI(CPCBI)
      GO TO 110
90    L1RECI=256*CBLCKI(CPCBI)
      GO TO 110
100   L1RECI=L1RECI+CBLCKI(CPCBI)
110   CONTINUE
C
C     CHECK THE BLOCK SEQUENCE NUMBER.
C
      IF (BLKSQI.EQ.NEWBLK) GO TO 150
      ISTAT=1
      WRITE (PRINTR,120) NEWBLK,BLKSQI
120   FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I
     15//)
      BLKSQI=NEWBLK
      GO TO 160
C
C     FORMAT ERROR
C
130   ISTAT=2
      GO TO 160
C
C     CHECK L1PRGI AND L1RECI.
C
150   IF (L1PRGI.GT.NCDBI) GO TO 130
      IF (L1RECI.GT.NCDBI) GO TO 130
      ISTAT=0
160   RETURN
C
      END
      SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD)
C
C     GET A RECORD FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK).
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE
C               SPACE ALLOWED BY THE USER.  (POSITION IS STILL OK).
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C     THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM
C     CONTROL RECORDS.  NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS.
C
      ISTAT=0
      NCHACT=0
10    JUMP=1
      GO TO 260
20    NG=CBLCKI(CPCBI)
      IF (NG.EQ.0) GO TO 90
      IF (NG.NE.255) GO TO 30
C
C     END OF SHORT TAPE BLOCK.
C
      CCDBI=NCDBI
      GO TO 10
C
C     UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO
C     THE USER RECORD AREA.
C
30    ITYPEI=0
      IF (MODEI.EQ.0) GO TO 40
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG
40    IG=0
50    JUMP=2
      GO TO 260
60    NR=CBLCKI(CPCBI)
      IF (MODEI.EQ.0) GO TO 70
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR
      GO TO 160
70    IR=0
C     PUT REMVI INTO THE USER RECORD NR TIMES.
80    IF (IR.GE.NR) GO TO 160
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI
      IR=IR+1
      GO TO 80
C
C     THE NEXT RECORD IS A CONTROL RECORD.  FIND OUT WHAT KIND.
C
90    JUMP=3
      GO TO 260
100   ITYPEI=CBLCKI(CPCBI)
      IF (ITYPEI.LT.65) GO TO 250
C     65 = ASCII  A
      IF (ITYPEI.GT.90) GO TO 250
C     90 = ASCII  Z
      I=ITYPEI-64
C             A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
      GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160
     1,110,160,220,160,160,160,160,160,160,160,160), I
C       P   Q   R   S   T   U   V   W   X   Y   Z
C
C     P - PROGRAM HEADER
C
C     CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER
110   REMVI=32
C     RESET THE REMOVED CHARACTER TO ASCII BLANK.
      JUMP=4
      GO TO 260
120   L1PRGI=256*CBLCKI(CPCBI)
      JUMP=5
      GO TO 260
130   L1PRGI=L1PRGI+CBLCKI(CPCBI)
      JUMP=6
      GO TO 260
140   N1RECI=256*CBLCKI(CPCBI)
      JUMP=7
      GO TO 260
150   N1RECI=N1RECI+CBLCKI(CPCBI)
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
160   JUMP=8
      GO TO 260
170   NC=CBLCKI(CPCBI)
      IF (ITYPEI.NE.0) GO TO 180
      IF (MODEI.EQ.0) GO TO 180
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC
C     COPY NC CHARACTERS TO THE USER RECORD AREA.
180   IC=0
      JUMP=9
190   IF (IC.GE.NC) IF (ITYPEI) 240,210,240
      GO TO 260
200   NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI)
      IC=IC+1
      GO TO 190
210   IG=IG+1
      IF (IG-NG) 50,240,240
C
C     J - UPDATING AND END OF INPUT TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
220   JUMP=10
      GO TO 260
230   RECORD(1)=CBLCKI(CPCBI)
      NCHACT=1
      IF (ITYPEI.EQ.82) REMVI=RECORD(1)
C     82 = ASCII R
C
C     RETURN TO THE USER PROGRAM.
C
240   IF (NCHACT.GT.NCHMAX) ISTAT=4
      GO TO 290
C
C     CONTROL RECORD TYPE CANNOT BE DETERMINED.
C
250   ISTAT=5
      GO TO 290
C
C     GET A CHARACTER FROM CBLOCK.  UNPACK A NEW BLOCK IF NECESSARY.
C     READ MORE TAPE IF NECESSARY.
C
260   CPCBI=CPCBI+1
      CCDBI=CCDBI+1
      IF (CCDBI.LE.NCDBI) GO TO 270
      CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 290,260,290
270   IF (CPCBI.LE.NCCBI) GO TO 280
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
280   GO TO (20,60,100,120,130,140,150,170,200,230), JUMP
290   RETURN
C
      END
      SUBROUTINE EXCHNP (ISTAT,DBLOCK)
C
C     SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE
C     TAPE.
C     THIS MODULE IS MACHINE INSENSITIVE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
      ISTAT=0
      IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20
C
C     CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK.
C
10    IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20
C     76 = ASCII L
C
C     NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK.
      CCDBI=L1PRGI-1
      I=NWCBI*(CCDBI/NCCBI)+1
      IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI)
      CWDBI=I
      CPCBI=MOD(CCDBI,NCCBI)
      GO TO 40
C
C     NO MORE HEADERS IN THIS BLOCK.
C
20    CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 40,10,40
C
C     END OF FILE.
C
30    ISTAT=7
C
40    RETURN
C
      END
      SUBROUTINE EXCHPB (ISTAT,DBLOCK)
C
C     WRITE A BLOCK ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C     WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK.
      INTEGER WORK(9)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
C     PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK.
C
      BLKSQO=BLKSQO+1
      WORK(1)=BLKSQO/256
      WORK(2)=MOD(BLKSQO,256)
      WORK(3)=LASTO
      WORK(4)=L1PRGO/256
      WORK(5)=MOD(L1PRGO,256)
      WORK(6)=N1RECO/256
      WORK(7)=MOD(N1RECO,256)
      WORK(8)=L1RECO/256
      WORK(9)=MOD(L1RECO,256)
C
      CPCBO=MOD(NERRCO,NCCBO)
      CWDBO=(NERRCO/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
C
      DO 10 I=1,9
      CPCBO=CPCBO+1
      IF (CPCBO.LE.NCCBO) GO TO 10
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
      CWDBO=CWDBO+NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
      CPCBO=1
10    CBLCKO(CPCBO)=WORK(I)
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
C
C     WRITE THE DATA BLOCK ON TAPE.
C
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L).
C
      IF (LASTO.NE.76) GO TO 20
      ISTAT=3
      CALL EXCHWT (ISTAT,DBLOCK)
      GO TO 30
C
C     COMPUTE POINTERS FOR NEXT BLOCK OUT.
C
20    L1PRGO=0
      LLPRGO=0
      N1RECO=0
      L1RECO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
C
30    RETURN
C
      END
      SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD)
C
C     WRITE A RECORD ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A
C             TEXT RECORD CONTAINS MORE THAN 254 GROUPS.
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER GC,RC(255),CC(255)
C     GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      ISTAT=0
      INCHAR=0
C
C     DETERMINE THE RECORD TYPE.
C
      IF (NCHOUT.NE.255) GO TO 10
      ITYPEO=255
      GO TO 70
10    IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO
      IF (ITYPEO.NE.0) GO TO 30
C
C     DATA RECORD.
C
      IF (MODEO.NE.0) GO TO 170
C     COMPRESS THE RECORD.
      CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255)
      IF (GC.GE.255) GO TO 210
      IG=0
C     OUTPUT THE GROUP COUNT.
      CBLCKO(CPCBO)=GC
      JUMP=1
      GO TO 230
20    IG=IG+1
      IF (IG.GT.GC) GO TO 250
      NC=CC(IG)
      INCHAR=INCHAR+RC(IG)
C     OUTPUT REMOVED CHARACTER COUNT.
      CBLCKO(CPCBO)=RC(IG)
      JUMP=2
      GO TO 230
C
C     THE USER SAYS HE HAS A CONTROL RECORD TO WRITE.  FIND OUT
C     WHAT KIND.
C
30    IF (ITYPEO.LT.65) GO TO 220
C     65 = ASCII A
      IF (ITYPEO.GT.90) GO TO 220
C     90 = ASCII  Z
      I=ITYPEO-64
C             A  B  C  D  E  F  G  H  I  J   K  L  M  N  O  P  Q  R   S
      GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40,
     140,40,40,40,40,40,40), I
C      T  U  V  W  X  Y  Z
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE TYPE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
40    IF (NCHOUT-255) 100,100,210
C
C     END OF FILE.
C
50    IF (NERRCO+NDATAO+7-CCDBO) 70,80,80
C
C     P - PROGRAM HEADER.
C
60    IF (NCHOUT.GT.255) GO TO 210
      REMVO=32
C     RESET REMOVED CHARACTER TO ASCII BLANK.
      IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80
      IF (CCDBO.EQ.NERRCO+10) GO TO 80
C
C     END OF SHORT TAPE BLOCK.
C
70    CBLCKO(CPCBO)=255
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250
C     69 = ASCII E
C     80 = ASCII P
      L1RECO=CCDBO-NERRCO
80    IF (LLPRGO.EQ.0) GO TO 90
C     LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK.
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      NC=MOD(LLPRGO+1,NCCBO)
      NW=((LLPRGO+1)/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      CBLCKO(NC+1)=CCDBO/256
      IF (NC+1.LT.NCCBO) GO TO 85
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      NW=NW+NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      NC=-1
85    CBLCKO(NC+2)=MOD(CCDBO,256)
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      CALL EXCHUN (DBLOCK(CWDBO),CBLCKO)
C     UPDATE TABLE OF CONTENTS POINTERS
90    LLPRGO=CCDBO
      IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO
      NLRECO=NLRECO+1
      IF (N1RECO.EQ.0) N1RECO=NLRECO
100   CBLCKO(CPCBO)=0
      JUMP=3
      GO TO 230
110   CBLCKO(CPCBO)=ITYPEO
      JUMP=4
      GO TO 230
120   IF (ITYPEO.NE.69) GO TO 130
C     69 = ASCII E
      LASTO=76
      GO TO 70
130   IF (ITYPEO.NE.80) GO TO 170
C     80 = ASCII P
      CBLCKO(CPCBO)=0
      JUMP=5
      GO TO 230
140   CBLCKO(CPCBO)=0
      JUMP=6
      GO TO 230
150   CBLCKO(CPCBO)=NLRECO/256
      JUMP=7
      GO TO 230
160   CBLCKO(CPCBO)=MOD(NLRECO,256)
      JUMP=8
      GO TO 230
C
170   NC=NCHOUT
180   CBLCKO(CPCBO)=NC
      IC=0
      JUMP=9
C     PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD.
      IF (ITYPEO.EQ.82) GO TO 190
      IF (ITYPEO.EQ.74) GO TO 190
      IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230
190   IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250
      INCHAR=INCHAR+1
      IC=IC+1
      CBLCKO(CPCBO)=RECORD(INCHAR)
      GO TO 230
C
C     J - UPDATING AND END OF TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
200   NCHOUT=1
      IF (ITYPEO.EQ.82) REMVO=RECORD(1)
C     82 = ASCII R
      GO TO 100
C
C     RECORD TOO LONG.
C
210   ISTAT=4
      GO TO 250
C
C     UNKNOWN CONTROL RECORD TYPE.
C
220   ISTAT=5
      GO TO 250
C
C     INCREMENT THE OUTPUT BUFFER POINTERS.  PACK A CHARACTER BLOCK
C     IF NECESSARY.  WRITE A TAPE BLOCK IF NECESSARY.
C
230   CPCBO=CPCBO+1
      CCDBO=CCDBO+1
      IF (CPCBO.LE.NCCBO) GO TO 240
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CWDBO=CWDBO+NWCBO
      CPCBO=1
      IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 250
240   GO TO (20,180,110,120,140,150,160,170,190), JUMP
250   RETURN
C
      END
      SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL)
C
C     SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE
C     DATA TO BE REMOVED.  DIVIDE DATA INTO GROUPS CONSISTING OF
C     STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT
C     DATA.  THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE
C     REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP
C     ARE RECORDED IN RC() AND SC() RESPECTIVELY.  MAXSL IS THE
C     MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC().
C
      INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL
C
C     RC AND SC MUST BE AT LEAST (IMGLEN-1)//3.
C
      GC=1
      SC(1)=0
      RC(1)=0
      MODE=-1
      INPLEN=IABS(IMGLEN)
C
C     IDENTIFY DATA GROUPS.
C
      DO 110 I=1,INPLEN
      IF (MODE) 40,60,90
C
C     MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE.
C
40    IF (INPIMG(I).EQ.REMOVE) GO TO 50
C     SWITCH TO SIGNIFICANT DATA SCAN.
      MODE=1
      SC(GC)=1
      GO TO 110
C     CONTINUE REMOVE SCAN
50    RC(GC)=RC(GC)+1
      IF (RC(GC)-MAXSL) 110,95,110
C
C     MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY
C     ONE OCCURRENCE OF REMOVE.  CHANGE TO REMOVE MODE IF ANOTHER REMOVE
C     OCCURS OR BACK TO DATA MODE IF NOT.
C
60    IF (INPIMG(I).EQ.REMOVE) GO TO 80
C     SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT.
      MODE=1
      IF (SC(GC).GE.MAXSL-2) GO TO 70
      SC(GC)=SC(GC)+2
      GO TO 110
C     FULL GROUP
70    GC=GC+1
      RC(GC)=1
      SC(GC)=1
      GO TO 110
C     SWITCH TO REMOVE MODE.
80    GC=GC+1
      SC(GC)=0
      RC(GC)=2
      MODE=-1
      GO TO 110
C
C     MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA.
C
90    IF (INPIMG(I).EQ.REMOVE) GO TO 100
      SC(GC)=SC(GC)+1
      IF (SC(GC).NE.MAXSL) GO TO 110
C     FULL GROUP
      MODE=-1
95    IF (I.GE.INPLEN) GO TO 120
      GC=GC+1
      RC(GC)=0
      SC(GC)=0
      GO TO 110
100   MODE=0
110   CONTINUE
120   RETURN
C
      END
      SUBROUTINE EXCHTP (RECORD,LINEI)
C
C     MATERIALIZE INCLUDES IF INALT IS NON-ZERO.
C     CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE
C     AND THE PRINTER IF LISTING IS REQUESTED.
C     LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C
      INTEGER RECORD(1),LINEI
C
C     *****     LOCAL VARIABLES     ************************************
C
C COPY    DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR
C         SKIPPING TEXT NOT TO BE INCLUDED.
      INTEGER COPY
C DASH    CONTAINS '-' IN HOLLERITH.
      INTEGER DASH
C ENDMRK  HOLDS THE END SENTINEL.
      INTEGER ENDMRK(40)
C NCHEND  IS THE NUMBER OF CHARACTERS IN ENDMRK.
      INTEGER NCHEND
C NCHSAV  SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD.
      INTEGER NCHSAV
C NCHTAR  IS THE NUMBER OF CHARACTERS IN TARGET.
      INTEGER NCHTAR
C STAR    CONTAINS '*' IN HOLLERITH.
       INTEGER STAR
C TARGET  IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY).
      INTEGER TARGET(40)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL DATA     ***************************************
C
      DATA DASH /1H-/, STAR /1H*/
C
C     *****     PROCEDURES     *****************************************
C
      LINEO=LINEO+1
      IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190
      RECORD(180)=LINEO
      RECORD(179)=LINEI
      COPY=-1
C     COPY=-1 MEANS NOT COPYING INCLUDED TEXT.
      IF (ITYPEO.EQ.0) GO TO 110
C     PROCESS INCLUDE RECORD.
      DO 10 I=1,NCHOUT
10    RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I)
C     INSERT '-I '.
      RECORD(1)=45
      RECORD(2)=73
      RECORD(3)=32
      NCHOUT=NCHOUT+3
      IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110
C     STORE SEARCH TARGET
      NCHTAR=MIN0(NCHOUT,40)
      DO 20 I=1,NCHTAR
20    TARGET(I)=RECORD(I)
C     STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
      NCHSAV=NCHCMD
      DO 30 I=1,NUMBER
30    OUTREC(I)=COMAND(I)
      COPY=0
C     COPY=0 MEANS SKIPPING MODULE ON INALT FILE.
      INALT=IABS(INALT)
      NEOF=0
40    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
      IF (NCHCMD.LT.2) GO TO 40
      IF (COMAND(1).NE.45) GO TO 40
C     45 = ASCII -
      IF (COMAND(2).EQ.45) GO TO 130
      IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40
C     73 = ASCII I, 105 = ASCII LOWER CASE I.
C     COMPARE IMAGE WITH SEARCH TARGET.
      IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60
      DO 50 I=2,NCHTAR
      K=COMAND(I)
      IF (K.GT.96 .AND. K.LT.123) K=K-32
      IF (TARGET(I).NE.K) GO TO 60
50    CONTINUE
      NEOF=3
C     PREVENT SEARCH LOOP.
      COPY=1
C     COPY=1 MEANS COPYING INCLUDED TEXT.
60    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     STORE END OF INCLUDE MODULE SIGNAL.
      NCHEND=MIN0(40,NCHCMD)
      DO 70 I=1,NCHEND
70    ENDMRK(I)=COMAND(I)
      IF (COPY.EQ.0) GO TO 80
      CHAR1L=DASH
      NCHOUT=NCHTAR
      DO 75 I = 1,NCHOUT
75    COMAND(I)=TARGET(I)
      COMAND(180)=LINEO
      COMAND(179)=LINEI
C     GO PRINT TARGET.
      CALL EXCHTW (COMAND,-1)
      GO TO 120
C     COPY OR SKIP UNTIL ENDMRK SEEN AGAIN.
80    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF.
C     TEST FOR ENDMRK
      DO 90 I=1,NCHEND
      IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100
90    CONTINUE
      IF (COPY) 140,40,140
C     OUTPUT TEXT RECORD.
100   COMAND(180)=LINEO
      COMAND(179)=LINEI
      NCHOUT=NCHCMD
      CALL EXCHTW (COMAND,OPTI)
      GO TO 120
C     OUTPUT TEXT RECORD.
110   CALL EXCHTW (RECORD,1)
120   IF (COPY) 190,190,80
C     WE ONLY GET HERE WITH COPY .GE. 0.
130   NEOF=NEOF+1
      ACTION=2
C     ACTION = 2 MEANS REOPEN INALT.
      CALL EXCHIM
      IF (NEOF.LT.2) GO TO 40
140   INALT=-IABS(INALT)
      NCHCMD=1
      IF (COPY.GT.0) GO TO 170
C     PROCESS TARGET AS THOUGH IT WERE TEXT.
      NCHOUT=NCHTAR
C     SAVE TARGET FOR ERROR MESSAGE.
      DO 150 I=1,NCHTAR
150   COMAND(I)=TARGET(I)
      CALL EXCHTW (COMAND,1)
      CALL EXCHAH (TARGET,NCHTAR)
      WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR)
160   FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8
     10A1))
      NERRS=MAX0(NERRS,3)
C
C     RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
C
170   NCHCMD=NCHSAV
      DO 180 I=1,NUMBER
180   COMAND(I)=OUTREC(I)
C
190   CHAR1L=STAR
      RETURN
C
      END
      SUBROUTINE EXCHTW (RECORD,OPTION)
C
C     WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING
C     EXCHOU.  WRITE RECORD ON THE PRINTER IF LISTING REQUESTED.
C     RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C     IF OPTION = ZERO, WRITE TO FILE ONLY.
C     IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING.
C     IF OPTION .LT. ZERO, WRITE TO LISTING ONLY.
C
      INTEGER RECORD(1),OPTION
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     PROCEDURES     *****************************************
C
      LINEI=RECORD(179)
      IF (OPTION.LT.0) GO TO 130
C
C     INSERT IDENTIFICATION IF REQUESTED.
C
      IF (IDCOL2.LT.IDCOL1) GO TO 120
      IF (IDTXTL+IDSTEP.EQ.0) GO TO 120
      IF (NCHOUT.GE.IDCOL2) GO TO 20
      J=IDCOL2-1
C     FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2
      DO 10 I=NCHOUT,J
10    RECORD(I+1)=32
C     32 = ASCII BLANK.
20    NCHOUT=MAX0(NCHOUT,IDCOL2)
      N=-1
      IF (LINEI.EQ.0) GO TO 40
      IF (IDOPTN.NE.73) GO TO 40
C     73 = ASCII I.  IDENTIFY ONLY FROM INTAPE.
      N=(LINEI-1)*IDSTEP+IDSTRT
      GO TO 70
40    IF (IDOPTN.NE.79) GO TO 50
C     79 = ASCII O.  IDENTIFY ONLY TO OUTAPE.
      N=(LINEO-1)*IDSTEP+IDSTRT
      GO TO 70
50    IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70
C     67 = ASCII C, 70 = ASCII F.  IDENTIFY EVERYTHING.
      N=IDCUR
70    IF (N.LT.0) GO TO 120
      IF (IDTXTL.EQ.0) GO TO 100
      J=MIN0(IDCOL2,IDTXTL+IDCOL1-1)
      K=1
      DO 80 I=IDCOL1,J
      RECORD(I)=IDTEXT(K)
80    K=K+1
100   IF (IDSTEP.EQ.0) GO TO 120
      IDCUR=IDCUR+IDSTEP
      K=IDCOL2
110   RECORD(K)=MOD(N,10)+48
      N=N/10
      K=K-1
      IF (N.EQ.0) GO TO 120
      IF (K.GE.IDCOL1) GO TO 110
C
C     OUTPUT RECORD.
C
120   IF (OUFILE.NE.0) CALL EXCHOU (RECORD)
      IF (OPTION.EQ.0) GO TO 220
130   IF (OPTL.NE.0) GO TO 140
      IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220
140   CALL EXCHAH (RECORD,NCHOUT)
      IF (OPTV+VERT.NE.0) GO TO 200
      IF (PHASE.NE.8) GO TO 180
      IF (LINEI.EQ.0) GO TO 160
      WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
150   FORMAT (1X,2I5,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
160   WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
170   FORMAT (5H  NEW,I6,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
180   WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
190   FORMAT (1X,I5,A1,3X,110A1/(6H  CONT,4X,110A1))
      GO TO 220
200   WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT)
210   FORMAT (132A1)
220   RETURN
C
      END
      SUBROUTINE EXCHC1 (IBLOCK,OBLOCK)
C
C     COMMAND DECODER AND FORMAT VERIFIER.  SOME COMMANDS ARE ALSO
C     COMPLETELY PROCESSED HERE.
C
C     IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS.
C
      INTEGER IBLOCK(1),OBLOCK(1)
C
C
C     *****     LOCAL VARIABLES     ************************************
C
C ALLOW   TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED.  VALUES ARE
C         SUMS OF PERMITTED VALUES OF PHASE.
C         1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING,
C         8 = UPDATING.
C         ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A
C         PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR
C         MAY BE VOID (EQUAL SIGN IS LAST CHARACTER).
C         32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT.
      INTEGER ALLOW(35)
C BLANK   A CONSTANT.  1H .
      INTEGER BLANK
C DATE    IS THE DATE FROM UPDA=, DATE=, ORIG=.
      INTEGER DATE(3)
C DAYS    TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS.
      INTEGER DAYS(12)
C I       IS USED FREELY AS AN INDEX.
C J       IS USED FREELY AS AN INDEX.
C JUMP    USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE.
C K       IS USED FREELY AS AN INDEX.
C KDATE   IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD).
C KQUIT   IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD).
C KTEXT   IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD).
C N       IS USED FREELY AS AN INDEX.
C NCNREC  IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS.
C ND      IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER.
C NM      IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER.
C NY      IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER.
C TVAL    A VECTOR OF VALUES FOR TRANS.  INDEXED BY ICOMD.
      INTEGER TVAL(35)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL EQUIVALENCE     **********************************
C
      EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND)
C
C     *****     DATA STATEMENTS     ************************************
C
      DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/
      DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/
      DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/
      DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/
      DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/
      DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/
      DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/
      DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/
      DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/
      DATA BLANK /1H /
      DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/
      DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/
      DATA DAYS(11),DAYS(12) /30,31/
      DATA KDATE /5/
      DATA KQUIT /20/
      DATA KTEXT /27/
      DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/
      DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/
      DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/
      DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/
      DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/
      DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/
      DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/
C
C     *****     PROCEDURES     *****************************************
C
C     GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER.
C     ECHO IT IF THE E OPTION IS SET.  DETERMINE WHETHER IT IS A CHANGE
C     TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND.
C
10    NCNREC=0
20    ACTION=0
      IF (NCHCMD.LT.0) GO TO 220
      CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (OPTE.EQ.0) GO TO 27
      WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD)
23    FORMAT (1X,80A1)
      CHAR1L=0
27    NCHCMD=MIN0(NCHCMD,MARGIN)
      IF (PHASE.LT.4) SIGNAL=45
C     45 = ASCII -
      IF (COMAND(1).NE.45) GO TO 50
C     45 = ASCII -.  REQUEST TO CHANGE CONTROL RECORD.
      IF (PHASE.LT.4) GO TO 40
      WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD)
30    FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT
     1OR UPDATE/1X,80A1)
      NERRG=MAX0(NERRG,2)
      GO TO 200
40    ICOMD=0
      EQUAL=2
      TRANS=3
      GO TO 370
50    IF (COMAND(1).NE.42) GO TO 70
C     42 = ASCII *.  COMMENT RECORD.  JUST ECHO IT.
      NCHCMD=MAX0(NCHCMD,2)
      WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD)
60    FORMAT (A1,1H*,78A1/(1X,80A1))
      GO TO 10
C
C     SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR
C     EQUAL SIGN ARE FOUND.  LOOK UP THE WORD IN THE COMMAND NAME TABLE.
C
70    EQUAL=0
      DO 80 I=1,NCHCMD
      IF (COMAND(I).EQ.32) GO TO 80
C     32 = ASCII BLANK
      EQUAL=EQUAL+1
      ICOMD=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32
C     ABOVE STATEMENT CONVERTS TO UPPER CASE.
      COMAND(I)=32
      COMAND(EQUAL)=ICOMD
      IF (EQUAL.GE.4) GO TO 90
      IF (ICOMD.EQ.61) GO TO 90
C     61 = ASCII =.
      IF (ICOMD.EQ.44) GO TO 90
C     44 = ASCII ,.
80    CONTINUE
      IF (EQUAL.EQ.0) GO TO 185
90    DO 110 ICOMD=1,NCOMDT
      DO 100 K=1,EQUAL
      IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110
100   CONTINUE
      IF (EQUAL.EQ.4) GO TO 130
      IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130
C     32 = ASCII BLANK.
110   CONTINUE
C
C     UNRECOGNIZED COMMAND.
C
120   ICOMD=0
C
C     LOOK FOR AN EQUAL SIGN.  SET THE VARIABLE NAMED EQUAL TO ZERO IF
C     THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK
C     CHARACTER FOLLOWING THE EQUAL SIGN.
C
130   MODIFY=0
140   DO 150 I=EQUAL,NCHCMD
      K=COMAND(I)
      IF (K.EQ.61) GO TO 160
C     61 = ASCII =.
      IF (MODIFY.NE.0) GO TO 150
C     USE FIRST MODIFIER.
      IF (K.EQ.44) GO TO 160
C     44 = ASCII ,.
150   CONTINUE
      EQUAL=0
      GO TO 170
160   I=I+1
      EQUAL=I
      IF (I.GT.NCHCMD) GO TO 170
      IF (COMAND(I).EQ.32) GO TO 160
C     32 = ASCII BLANK
      IF (K.NE.44) GO TO 170
C     44 = ASCII ,.
      MODIFY=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32
C     CONVERT TO UPPER CASE.
      GO TO 140
170   IF (K.NE.61) EQUAL=0
C     61 = ASCII =.
      IF (ICOMD.EQ.0) GO TO 180
      IF (ICOMD.GT.NCOMDP) GO TO 180
      IF (EQUAL.GT.NCHCMD) GO TO 175
      IF (EQUAL.NE.0) GO TO 230
      IF (ALLOW(ICOMD)/64.NE.0) GO TO 230
175   IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690
C     PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK.
      NCHCMD=NCHCMD+1
      EQUAL=NCHCMD
      COMAND(NCHCMD)=32
C     32 = ASCII BLANK
      HOLCMD(NCHCMD)=BLANK
      GO TO 230
C
C     GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX.
C
180   CALL EXCHCX (0)
C     IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND.
      IF (ICOMD.NE.0) GO TO 730
185   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1))
      NERRG=MAX0(NERRG,5)
200   CHAR1L=0
      NCNREC=NCNREC+1
      IF (NCNREC.LE.20) GO TO 20
      WRITE (PRINTR,210)
210   FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU
     1MES TEXT COMMAND IS MISSING.)
      GO TO 270
C
C     END OF FILE - SIMULATE A QUIT COMMAND.
C
220   ICOMD=KQUIT
C
C     RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME.
C
230   IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240
      TRANS=TVAL(ICOMD)
C             1   2   3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300
     1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7
     230,370,730,370), ICOMD
C       16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
C     32  33  34  35
C
C     THE COMMAND IS NOT ALLOWED AT THIS TIME.
C
240   WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE
     1D./1X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
C     DECIDE WHETHER TO SKIP TEXT
260   IF (ICOMD.NE.KTEXT) GO TO 10
      IF (EQUAL.NE.0) GO TO 10
270   WRITE (PRINTR,280)
280   FORMAT (//15H0SKIPPING TEXT.)
290   CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (NCHCMD.LT.2) GO TO 290
      IF (COMAND(1).NE.SIGNAL) GO TO 290
      IF (COMAND(2).EQ.SIGNAL) GO TO 10
      IF (NCHCMD.LT.3) GO TO 290
      IF (COMAND(2).NE.61) GO TO 290
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 290
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING.
C     DATE=YYMMDD
C     ORIGIN=YYMMDD SITE
C     UPDATE=YYMMDD SITE
C     IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE
C     THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED.
C
300   IF (EQUAL+5.GT.NCHCMD) GO TO 700
      I=EQUAL
      DO 310 J=1,3
      DATE(J)=0
      DO 310 K=1,2
      N=COMAND(I)-48
      IF (N.LT.0) GO TO 320
      IF (N.GT.9) GO TO 320
      DATE(J)=10*DATE(J)+N
310   I=I+1
      IF (NM.EQ.0) GO TO 320
      IF (NM.GT.12) GO TO 320
      IF (ND.LE.0) GO TO 320
      DAYS(2)=28
      IF (MOD(NY,4).EQ.0) DAYS(2)=29
      IF (NY.EQ.0) DAYS(2)=28
      IF (ND.LE.DAYS(NM)) GO TO 440
320   IF (ICOMD.EQ.KDATE) GO TO 700
      IF (TODAY(1).EQ.32) GO TO 700
      I=MIN0(NCHCMD+6,180)
      NCHCMD=I
      J=I-6
      IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1
C     32 = ASCII BLANK
      IF (J.LT.EQUAL) GO TO 700
330   COMAND(I)=COMAND(J)
      HOLCMD(I)=HOLCMD(J)
      J=J-1
      I=I-1
      IF (J.GE.EQUAL) GO TO 330
      DO 340 I=1,6
      COMAND(I+EQUAL-1)=TODAY(I)
340   HOLCMD(I+EQUAL-1)=TODAY(I)
      CALL EXCHAH (HOLCMD(EQUAL),6)
      WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD)
345   FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1))
      NERRG=MAX0(NERRG,1)
      GO TO 440
C
C     REWIND INTAPE
C
350   IF (INTAPE.EQ.0) GO TO 680
      IF (INTOPN.NE.0) GO TO 360
      I=1
C     OPEN INTAPE IF NOT ALREADY OPEN.  DO NOT CHECK EXCH LABEL.
      CALL EXCHRT (I,IBLOCK)
C     IGNORE STATUS
360   I=2
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
      GO TO 725
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH
C     BEGINS WITH A NUMBER FOLLOWED BY A BLANK.
C
C     INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     INTAPE = NUMBER SYSTEM DEPENDENT DATA
C     LIMIT = NUMBER
C     MARGIN = NUMBER
C     OUTAPE = NUMBER SYSTEM DEPENDENT DATA
C     OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     PRINTER = NUMBER
C     READER = NUMBER
C     SKIP = NUMBER
C     TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL)
C     WORK = NUMBER
C
370   NUMBER=0
      IF (EQUAL.EQ.0) GO TO 440
      DO 410 J=EQUAL,NCHCMD
      IF (COMAND(J).EQ.32) GO TO 420
C     32 = ASCII BLANK
      N=COMAND(J)-48
C     48 = ASCII ZERO
      IF (N.GE.0) GO TO 400
380   WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD)
390   FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS.  NOT PROCESSED./
     11X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
      GO TO 260
400   IF (N.GT.9) GO TO 380
410   NUMBER=10*NUMBER+N
      EQUAL=NCHCMD+1
      GO TO 440
420   EQUAL=J
430   EQUAL=EQUAL+1
      IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440
C     32 = ASCII BLANK
C
C     PRELIMINARY FORMAT CHECKING IS COMPLETE
C
440   J=ICOMD+1
C             0  1   2  3  4  5   6  7  8   9  10 11  12 13 14  15  16
      GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6
     120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595),
     2J
C     17 18  19 20  21 22 23 24 25  26  27 28  29  30 31 32  33 34  35
C
C     DATE=YYMMDD
C
450   DO 460 I=1,6
460   TODAY(I)=COMAND(EQUAL+I-1)
      GO TO 10
C
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA.
C
470   I=INFILE
      J=1
      GO TO 500
C
C     INCLUDE = NUMBER SYSTEM DEPENDENT DATA.
C
480   I=INALT
      J=3
      INALT=IABS(INALT)
      GO TO 500
C
C     TEXT
C
490   I=INTEXT
      J=2
      IF (EQUAL.EQ.0) GO TO 560
C
C     OPEN AN INPUT FILE.
C
500   IF (NUMBER.EQ.0) GO TO 505
      IF (NUMBER.EQ.OUFILE) GO TO 710
      IF (NUMBER.EQ.OUTAPE) GO TO 710
505   IF (J.EQ.2) GO TO 510
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (I.NE.0) CALL EXCHIM
510   IF (J-2) 520,530,540
520   INFILE=NUMBER
      GO TO 550
530   INTEXT=NUMBER
      GO TO 550
540   INALT=NUMBER
550   IF (NUMBER.EQ.0) GO TO 560
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      CALL EXCHCX (J+1)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHIM
      ACTION=2
C     ACTION = 2 MEANS REWIND
      IF (J.EQ.3) CALL EXCHIM
      INALT=-IABS(INALT)
560   ACTION=0
C     ACTION = 0 MEANS READ TEXT
      GO TO 730
C
C     INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
570   IF (INTOPN.EQ.0) GO TO 580
C     CLOSE THE INPUT TAPE, IGNORE STATUS.
      I=4
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
580   INTAPE=NUMBER
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (INTAPE.NE.0) CALL EXCHCX (6)
      GO TO 725
C
C     LIMIT = NUMBER
C
590   LIMIT=NUMBER
      GO TO 10
C
C     MARGIN = NUMBER
C
C     MINIMUM MARGIN IS 60
595   MARGIN=MAX0(NUMBER,60)
      GO TO 10
C
C     OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
600   IF (OUTOPN.EQ.0) GO TO 610
C     WRITE AND END-OF-FILE MARK ON OUTAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (I,OBLOCK,OBLOCK)
C     IGNORE STATUS
      OUTOPN=0
      PHASE=1
610   OUTAPE=NUMBER
      OUTUPD=MODIFY
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (OUTAPE.NE.0) CALL EXCHCX (7)
      GO TO 730
C
C     OUTPUT =  NUMBER SYSTEM DEPENDENT INFORMATION
C
620   ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      OUFILE=NUMBER
      IDCUR=IDSTRT
      IF (OUFILE.EQ.0) GO TO 730
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND.
      CALL EXCHCX (5)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHOU (OUTREC)
      GO TO 730
C
C     PRINTER = NUMBER.
C
630   CALL EXCHFO (-2)
      PRINTR=NUMBER
      CALL EXCHFO (2)
      GO TO 10
C
C     READER = NUMBER.
C
640   IF (INFILE.NE.0) GO TO 670
      CALL EXCHFO (-1)
      READER=NUMBER
      CALL EXCHCX (1)
      CALL EXCHFO (1)
      GO TO 10
C
C     WORK = NUMBER
C
650   IF (WORKF.GT.0) CALL EXCHFO (-3)
      WORKF=NUMBER
C     WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4.
      GO TO 10
C
C     UPDATE
C
C     DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR
C     SIMPLY TO OUTPUT THE UPDATE COMMAND.
660   IF (PHASE.GE.4) TRANS=5
      GO TO 730
C
C     ERROR MESSAGES.
C
670   NUMBER=3
C     MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE.
      GO TO 720
680   NUMBER=4
C     MESSAGE 4 - INTAPE IS NOT DEFINED.
      GO TO 720
690   NUMBER=12
C     MESSAGE 12 - NO PARAMETER STRING.
      GO TO 720
700   NUMBER=13
C     MESSAGE 13 - IMPROPER DATE.
      GO TO 720
710   NUMBER=31
C     MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT.
C
C     RETURN TO ERROR MESSAGE SEGMENT.
C
720   TRANS=8
      GO TO 740
c
c     Indicate the WORK file is empty.
c
725   if (nrwork.le.0 .or. workf.le.0) go to 730
      REWIND WORKF
      NRWORK=0
C
C     IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP.
C
730   IF (TRANS.EQ.1) GO TO 10
740   RETURN
C
      END
      SUBROUTINE EXCHCX (REASON)
C
C========================
C
C     PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER
C     PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT,
C     INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS.
C     DEC PDP-11 RSX-11M VERSION.
C
C     RECOGNIZE THE TABS COMMAND.
c     TABS=Y or D means HT is data, TABS=N or T means HT is tab.
C
      INTEGER REASON
C
C     REASON=0 FOR UNRECOGNIZED COMMAND.
C     REASON=1 BEFORE OPENING READER.
C     REASON=2 BEFORE OPENING INFILE.
C     REASON=3 BEFORE OPENING INTEXT.
C     REASON=4 BEFORE OPENING INALT.
C     REASON=5 BEFORE OPENING OUFILE.
C     REASON=6 BEFORE OPENING INTAPE.
C     REASON=7 BEFORE OPENING OUTAPE.
C
C
C========================
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      LOGICAL TABS
      BYTE FNAMES(40,3)
      BYTE DEFLTS(10,3)
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCRSX/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA DEFLTS(1,1),DEFLTS(2,1),DEFLTS(3,1),DEFLTS(4,1),DEFLTS(5,1),
     1     DEFLTS(6,1),DEFLTS(7,1),DEFLTS(8,1),DEFLTS(9,1),DEFLTS(10,1)
     2     /'E', 'X', 'C', 'H', '0', '0', '.', 'T', 'M', 'P'/
C
      DATA DEFLTS(1,2),DEFLTS(2,2),DEFLTS(3,2),DEFLTS(4,2),DEFLTS(5,2),
     1     DEFLTS(6,2),DEFLTS(7,2),DEFLTS(8,2),DEFLTS(9,2),DEFLTS(10,2)
     2     /'M', 'T', '0', ':', 6*0/
C
      DATA DEFLTS(1,3),DEFLTS(2,3),DEFLTS(3,3),DEFLTS(4,3),DEFLTS(5,3),
     1     DEFLTS(6,3),DEFLTS(7,3),DEFLTS(8,3),DEFLTS(9,3),DEFLTS(10,3)
     2     /'M', 'T', '1', ':', 6*0/
C
C                                                        T  A  B  S
      DATA COMD(1,36),COMD(2,36),COMD(3,36),COMD(4,36) /84,65,66,83/
      DATA NCOMDT /36/
C
      IF (REASON.NE.0) GO TO 10
C
C     COMMAND NOT RECOGNIZED BY EXCHC1.  IF ICOMD=0 IT IS NOT A
C     COMMAND, ELSE CHECK PARAMETER OF TABS COMMAND.
C
      IF (ICOMD.EQ.0) GO TO 150
      IF (EQUAL.EQ.0 .OR. EQUAL.GT.NCHCMD) GO TO 110
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
      IF (J.NE.68 .AND. J.NE.89) GO TO 5
C     68 = ASCII D, 89 = ASCII Y.
      TABS=.TRUE.
      GO TO 150
5     IF (J.NE.78 .AND. J.NE.84) GO TO 110
C     78 = ASCII N, 84 = ASCII T.
      TABS=.FALSE.
      GO TO 150
C
C     PROCESS SYSTEM DEPENDENT INFORMATION
C
10    J=MAX0(REASON-4,1)
      FNAMES(1,J)=' '
      FNAMES(2,J)=' '
      K=MIN0(NCHCMD-EQUAL+1,40)
      IF (K.LE.0) GO TO 42
      DO 20 I=1,K
20    FNAMES(I,J)=COMAND(EQUAL+I-1)
      K=MAX0(K,2)
      FNAMES(K+1,J)=0
      DO 40 I=3,K
      IF (FNAMES(I,J).NE.' ') GO TO 40
      FNAMES(I,J)=0
      K=J-1
      GO TO 45
40    CONTINUE
      GO TO 45
C
C     INSERT DEFAULT FILE NAMES IF NONE SPECIFIED.  FOR NATIVE FORMAT
C     FILES, USE EXCHNN.TMP, WHERE NN IS THE UNIT NUMBER.  FOR
C     INTAPE USE MT0:.  FOR OUTAPE USE MT1:.
C
42    DO 43 I = 1, 10
43    FNAMES(I,J)=DEFLTS(I,J)
      IF (REASON.GT.5) GO TO 150
      FNAMES(11,1)=0
      FNAMES(1,5)=48+NUMBER/10
      FNAMES(1,6)=48+MOD(NUMBER,10)
45    IF (REASON-5) 50,70,150
C
C     OPEN INPUT FILE.
C
50    OPEN (UNIT=NUMBER,NAME=FNAMES(1,1),TYPE='OLD',READONLY,ERR=90)
      WRITE (PRINTR,60) NUMBER,(FNAMES(I,1),I=1,K)
60    FORMAT (10H OPEN UNIT,I3,16H FOR INPUT FROM ,40A1)
      GO TO 150
C
C     OPEN OUTPUT FILE.
C
70    OPEN (UNIT=NUMBER,NAME=FNAMES(1,1),TYPE='NEW',ERR=90)
      WRITE (PRINTR,80) NUMBER,(FNAMES(I,1),I=1,K)
80    FORMAT (10H OPEN UNIT,I3,15H FOR OUTPUT TO ,40A1)
      GO TO 150
C
C     ERROR WHILE OPENING FILE.
C
90    WRITE (PRINTR,100) NUMBER,(FNAMES(I,1),I=1,K)
100   FORMAT (//20H0UNABLE TO OPEN UNIT,I3,10H FOR FILE ,40A1)
      GO TO 130
C
C     ERROR WHILE PROCESSING TABS COMMAND.
C
110   WRITE (PRINTR,120)
110   FORMAT ('Missing or unrecognized parameter on TABS command.')
C
130   WRITE (PRINTR,140) (HOLCMD(I),I=1,NCHCMD)
140   FORMAT (1X,80A1)
      NERRG=MAX0(NERRG,5)
C
150   RETURN
C
      END
      SUBROUTINE  EXCHC2
C
C     PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KINDE /32/
      DATA KOPTI /14/
      DATA KSITE /25/
C
C     FIGURE OUT WHICH COMMAND GOT US HERE.
C
      IF (ICOMD-KOPTI) 60,150,10
10    IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270
C
C     ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT
C     WHERE C1, C2, STEP AND START ARE INTEGERS.
C     STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP,
C     START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF
C     CHARACTERS OF TEXT IN IDTXTL.  IF AN ERROR OCCURS,
C     STORE ZERO IN IDSTEP AND IDTXTL.
C     IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO.
C
C     STORE THE MODIFIER IN IDOPTN.
C     IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE
C     PRODUCED ONLY FOR IMAGES FROM INTAPE.  IF THE O MODIFIER
C     IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES
C     WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT.  IF THE F
C     MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION
C     OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE
C     PRODUCED FOR ALL IMAGES OUTPUT.  IF THE C MODIFIER IS SPECIFIED,
C     SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH
C     RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR
C     ALL IMAGES OUTPUT.  IF NONE OF THE I, F, OR C MODIFIERS ARE
C     SPECIFIED, THE O MODIFIER IS ASSUMED.
C
C     IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED.
C     IF IDTXTL = ZERO, TEXT IS NOT EMITTED.
C     IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE
C     EMITTED.
C
C     CONVERT C1,C2,STEP,START
C
      IDOPTN=MODIFY
      IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79
C     70 = ASCII F, 73 = ASCII I, 79 = ASCII O.
      DO 40 J=1,4
      NUMBER=0
20    IF (EQUAL.GT.NCHCMD) GO TO 40
      IF (COMAND(EQUAL).EQ.44) GO TO 30
C     44 = ASCII ,
      I=COMAND(EQUAL)-48
      IF (I.LT.0) GO TO 350
      IF (I.GT.9) GO TO 350
      NUMBER=10*NUMBER+I
      EQUAL=EQUAL+1
      GO TO 20
30    EQUAL=EQUAL+1
40    IDNBRS(J)=NUMBER
      IDCUR=IDSTRT
      IDCOL1=MAX0(1,MIN0(IDCOL1,178))
      IDCOL2=MIN0(IDCOL2,178)
C
C     STORE TEXT.
C
      IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0)
      IF (IDTXTL.EQ.0) GO TO 330
      DO 50 J=1,IDTXTL
      IDTEXT(J)=COMAND(EQUAL)
50    EQUAL=EQUAL+1
      GO TO 330
C
C     INDEX = PARAMETER STRING
C
60    J=0
      IF (COMAND(EQUAL).NE.45) GO TO 70
C     45 = ASCII -
      J=-1
      EQUAL=EQUAL+1
70    N=0
      DO 80 I=1,26
80    INDEXS(I)=0
90    IF (EQUAL.GT.NCHCMD) GO TO 130
      I=COMAND(EQUAL)-64
      IF (I.EQ.-32) GO TO 120
C     32 = ASCII BLANK.
      IF (I.GE.32) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.LE.0) GO TO 100
      IF (I.LE.26) GO TO 110
100   N=EQUAL
      GO TO 120
110   INDEXS(I)=1
120   EQUAL=EQUAL+1
      GO TO 90
130   INDEX=0
      DO 140 I=1,26
      INDEXS(I)=IABS(INDEXS(I)+J)
140   INDEX=INDEX+INDEXS(I)
      IF (MODIFY.EQ.76) INDEX=-INDEX
C     76 = ASCII L.
      IF (N) 340,330,340
C
C     OPTION = PARAMETER STRING
C
150   IF (MODIFY.NE.0) GO TO 170
      DO 160 I=1,26
160   OPTVAL(I)=0
170   IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330
      I=1
      IF (MODIFY.EQ.67) I=0
C     67 = ASCII C.
      N=0
      DO 190 J=EQUAL,NCHCMD
      K=COMAND(J)
      IF (K.GE.96) K=K-32
C     CONVERT TO UPPER CASE.
      IF (K.EQ.32) GO TO 190
C     32 = ASCII BLANK
      IF (K.LT.65) GO TO 180
      IF (K.GT.90) GO TO 180
C     PROCESS ALPHABETIC OPTIONS.
      OPTVAL(K-64)=I
      GO TO 190
180   N=J
190   CONTINUE
      IF (N) 330,330,340
C
C     PROCESS PRED = ID REC A/X MASK STRING
C       WHERE ID = PREDICATE IDENTIFIER (A-H),
C       REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE,
C       A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH
C             IN EXACT POSITION,
C       MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE
C              TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED.
C       STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF
C                CONTROL RECORDS.
C
C     THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR
C     PREDICATE A, ETC.
C
C     PRED(1,*)=LENGTH OF STRING + 3
C     PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED.
C     PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND).
C     PRED(3,*)=RECORD TYPE.
C     PRED(4,*)=A/X
C     PRED(5,*)=MASK CHARACTER.
C     PRED(6..42,*)=STRING.
C
200   IF (EQUAL.NE.0) GO TO 240
C     LIST ALL ACTIVE PREDICATES.
      DO 230 I=1,8
      IF (PRED(1,I).EQ.0) GO TO 230
      J=PRED(1,I)+1
      COMAND(1)=I+64
      DO 210 K=2,J
210   COMAND(K)=PRED(K+1,I)
      CALL EXCHAH (COMAND,J)
      WRITE (PRINTR,220) (COMAND(K),K=1,J)
220   FORMAT (6H PRED=,42A1)
230   CONTINUE
      GO TO 330
C     SAVE PREDICATE IF VALID.
240   IF (NCHCMD.LE.EQUAL+3) GO TO 370
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.GT.72) GO TO 360
C     72 = ASCII H
      NUMBER=J-64
      PRED(1,NUMBER)=0
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.GT.90) GO TO 360
C     90 = ASCII Z
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.EQ.82) GO TO 360
C     82 = ASCII R
      PRED(3,NUMBER)=J
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.NE.65.AND.J.NE.88) GO TO 360
C     65 = ASCII A, 88 = ASCII X
      PRED(4,NUMBER)=J
      EQUAL=EQUAL+1
      PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40)
      I=4
      DO 250 J=EQUAL,NCHCMD
      I=I+1
      IF (I.GT.42) GO TO 330
      K=COMAND(J)
      IF (K.GT.96) K=K-32
C     CONVERT TO UPPER CASE.
250   PRED(I,NUMBER)=K
      GO TO 330
C
C     SITE = SITE NAME
C
260   JUMP=1
      GO TO 280
C
C     TITLE = OUTPUT TAPE TITLE
C
270   JUMP=2
280   K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 320 I=1,40
      IF (K.GT.NCHCMD) GO TO 290
      J=COMAND(K)
      K=K+1
      GO TO 300
290   J=32
C     32 = ASCII BLANK.
300   IF (JUMP.EQ.2) GO TO 310
      SITE(I)=J
      GO TO 320
310   TITLE(I)=J
320   CONTINUE
C
C     RETURN TO COMMAND DECODER.
C
330   TRANS=1
      GO TO 390
C
C     ERROR MESSAGES
C
340   NUMBER=14
C     MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED.
      EQUAL=N
      GO TO 380
350   IDSTEP=0
      IDTXTL=0
360   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED.
      GO TO 380
370   NUMBER=30
C     MESSAGE 30 - COMMAND IS INCOMPLETE.
C
380   TRANS=8
C
390   RETURN
C
      END
      SUBROUTINE EXCHC3 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE
C     COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES.
C
C     OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE
C     NAME COMMAND.
C
C     OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING
C     COPY, NAME OR UPDATE COMMANDS.
C
C ID      IS USED TO CONSTRUCT THE OUTPUT LABEL.
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                                    E  X  C  H
      DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/
C                                    A  N  G  E
      DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/
      DATA KNAME /9/
      DATA KSKIP /26/
C
C     OPEN INTAPE IF NECESSARY
C
      IF (INTOPN.NE.0) GO TO 70
      IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300
      IF (INTAPE.EQ.OUTAPE) GO TO 360
      CALL EXCHRH (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 310
      INTOPN=1
C     COPY THE LABEL TO A SAVE AREA.
      DO 10 I=1,180
10    LABELI(I)=CBLCKI(I)
      CALL EXCHAH (CBLCKI(13),138)
      WRITE (PRINTR,20)
20    FORMAT (25H0INPUT LABEL INFORMATION.)
      WRITE (PRINTR,30) (CBLCKI(I),I=13,104)
30    FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/
     1        20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1)
      IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150)
40    FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1)
      WRITE (PRINTR,50) NDATAI
50    FORMAT (28H DATA CHARACTERS PER BLOCK =,I6)
      IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI
60    FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6)
      CHAR1L=0
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 290
70    IF (ICOMD.EQ.KSKIP) GO TO 270
C
C     OPEN OUTAPE IF NECESSARY
C
80    IF (ICOMD.EQ.0) GO TO 90
      IF (ICOMD.LT.KNAME) GO TO 100
90    IF (INTAPE*OUTAPE.EQ.0) GO TO 100
      IF (OUTUPD.NE.85) GO TO 370
C     85 = ASCII U.
100   IF (OUTOPN.NE.0) GO TO 240
      IF (OUTAPE.EQ.0) GO TO 240
C     CONSTRUCT THE OUTPUT LABEL.
      IF (TODAY(1).EQ.0) GO TO 340
      IF (INTOPN.EQ.0) GO TO 160
      DO 110 I=1,180
110   CBLCKO(I)=LABELI(I)
      IF (TITLE(1).EQ.32) GO TO 130
C     32 = ASCII BLANK
      DO 120 I=1,40
120   CBLCKO(I+18)=TITLE(I)
130   IF (OUTUPD.NE.85) GO TO 220
C     85 = ASCII U.
      IF (SITE(1).EQ.0) GO TO 350
      DO 140 I=1,6
140   CBLCKO(I+104)=TODAY(I)
      DO 150 I=1,40
150   CBLCKO(I+110)=SITE(I)
      GO TO 220
160   IF (TITLE(1).EQ.32) GO TO 330
C     32 = ASCII BLANK
      IF (SITE(1).EQ.0) GO TO 350
      IF (INTAPE*OUTAPE.EQ.0) GO TO 170
      IF (INTAPE.EQ.OUTAPE) GO TO 360
170   DO 180 I=1,8
180   CBLCKO(I)=ID(I)
      DO 190 I=1,40
      CBLCKO(I+18)=TITLE(I)
190   CBLCKO(I+64)=SITE(I)
      DO 200 I=1,6
200   CBLCKO(I+58)=TODAY(I)
      DO 210 I=105,180
210   CBLCKO(I)=0
220   CALL EXCHWH (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 320
      OUTOPN=1
      CBLCKO(1)=CBLCKO(105)
      CALL EXCHAH (CBLCKO(13),138)
      WRITE (PRINTR,230)
      WRITE (PRINTR,30) (CBLCKO(I),I=13,104)
230   FORMAT (26H0OUTPUT LABEL INFORMATION.)
      IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150)
      WRITE (PRINTR,50) NDATAO
      IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO
      CHAR1L=0
240   IF (ICOMD-KNAME) 250,260,280
C
C     COPY
C
250   TRANS=4
      MODEI=1-MIN0(1,OUFILE+OPTL)
      IF (ICOMD.EQ.0) MODEI=0
      GO TO 390
C
C     NAME
C
260   TRANS=5
      IF (NRWORK.EQ.0) PHASE=4
      GO TO 390
C
C     SKIP
C
270   TRANS=4
      GO TO 390
C
C     UPDATE
C
280   TRANS=5
      MODEI=0
      GO TO 390
C
C     ERROR MESSAGES
C
290   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      EQUAL=ISTAT
      GO TO 380
300   NUMBER=4
C     MESSAGE 4 - INTAPE NOT DEFINED.
      GO TO 380
310   NUMBER=5
C     MESSAGE 5 - UNABLE TO OPEN INTAPE.
      EQUAL=ISTAT
      GO TO 380
320   NUMBER=6
C     MESSAGE 6 - UNABLE TO OPEN OUTAPE.
      EQUAL=ISTAT
      GO TO 380
330   NUMBER=7
C     MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE.
      GO TO 380
340   NUMBER=8
C     MESSAGE 8 - DATE NOT SUPPLIED.
      GO TO 380
350   NUMBER=9
C     MESSAGE 9 - SITE NOT SUPPLIED.
      GO TO 380
360   NUMBER=10
C     MESSAGE 10 - INTAPE = OUTAPE.
      GO TO 380
370   NUMBER=11
C     MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED.
380   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM
C
390   RETURN
C
      END
      SUBROUTINE EXCHRH (ISTAT,DBLOCK)
C
C     READ THE HEADER LABEL FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE
C               NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     OPEN THE INPUT TAPE.
C
      ISTAT=1
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     READ A BLOCK.
C
      NDATAI=171
      NERRCI=0
      BLKSQI=0
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     FIND OUT IF IT IS A PROPER LABEL.
C
      CALL EXCHUN (DBLOCK,CBLCKI)
      DO 10 I=1,8
      IF (CBLCKI(I).NE.ID(I)) GO TO 20
10    CONTINUE
C
C     GET READY TO READ THE REST OF THE TAPE.
C
      CCDBI=NCDBI
      NDATAI=256*CBLCKI(9)+CBLCKI(10)
      NERRCI=256*CBLCKI(11)+CBLCKI(12)
      LASTI=0
      L1PRGI=0
      ISTAT=0
      GO TO 30
C
C     NOT A LABEL.
C
20    ISTAT=6
C
C     CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK.
25    I=4
      CALL EXCHRT (I,DBLOCK)
C
30    RETURN
C
      END
      SUBROUTINE EXCHWH (ISTAT,DBLOCK)
C
C     WRITE A HEADER ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE
C               WRITTEN ARE NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     MAKE SURE IT IS A PROPER LABEL.
C
      DO 10 I=1,8
      IF (CBLCKO(I).NE.ID(I)) GO TO 30
10    CONTINUE
C
C     OPEN THE OUTPUT TAPE.
C
      ISTAT=1
      CALL EXCHWT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 40
C
C     CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR
C     CONTROL CHARACTERS
C
      CBLCKO(9)=NDATAO/256
      CBLCKO(10)=MOD(NDATAO,256)
      CBLCKO(11)=NERRCO/256
      CBLCKO(12)=MOD(NERRCO,256)
C
C     INSERT TODAYS DATE
C
      DO 20 I=1,6
20    CBLCKO(I+12)=TODAY(I)
C
C     WRITE THE BLOCK ON TAPE.
C
      BLKSQO=0
      CALL EXCHPA (CBLCKO,DBLOCK)
      CCDBO=180
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     GET READY TO WRITE THE REST OF THE FILE.
C
      L1PRGO=0
      LLPRGO=0
      N1RECO=0
      NLRECO=0
      L1RECO=0
      LASTO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      GO TO 40
C
C     NOT A PROPER LABEL.
C
30    ISTAT=6
C
40    RETURN
C
      END
      SUBROUTINE EXCHC4 (IBLOCK)
      INTEGER IBLOCK(1)
C
C     PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM
C     COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KCOPY /3/
C
C     ARE WE STARTING OR CONTINUING?
C
C     ICOMD.EQ.0  MEANS  CHANGE A CONTROL RECORD
C     ICOMD.GT.0  MEANS  SKIP OR COPY COMMAND BEGIN
C     ICOMD.EQ.-1 MEANS  CONTINUE COPY = NUMBERS
C     ICOMD.EQ.-2 MEANS  CONTINUE COPY = PREDICATE EXPRESSION
      NEWP=0
      IF (ITYPEI.EQ.80) VERT=0
C     80 = ASCII P.  WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO
C     IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON
C     THE WORK FILE.
      IF (ICOMD.EQ.0) GO TO 190
C     ICOMD=0 MEANS CHANGING A CONTROL RECORD.
      IF (ICOMD+1) 290,170,10
10    IF (ICOMD.EQ.KCOPY) GO TO 30
C
C     SKIP COMMAND.
C
      IF (INTOPN.LT.0) GO TO 430
      if (modify.eq.70) number=number+n1reci-1
c     70 = ASCII F.
      IF (NUMBER+1-N1RECI) 540,430,20
20    CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.EQ.69) GO TO 460
C     69 = ASCII E.
      IF (N1RECI-NUMBER) 20,20,430
C
C     COPY COMMAND FORMAT VERIFICATION.
C
30    IF (COMAND(EQUAL).LT.48) GO TO 180
C     48 = ASCII ZERO
      IF (COMAND(EQUAL).GT.57) GO TO 180
C     57 = ASCII NINE
C
C     COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS.
C     CONVERT THE NUMBERS AND STORE THEM IN COMAND.  IF THE NUMBER
C     IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER.
C
      ICOMD=-1
      I=0
      J=44
C     44 = ASCII COMMA
40    I=I+1
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 480
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=NUMBER
50    EQUAL=EQUAL+1
      IF (EQUAL.GT.NCHCMD) GO TO 60
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 60
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=10*COMAND(I)+NUMBER
      GO TO 50
60    IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70
70    IF (J.EQ.45) COMAND(I)=-COMAND(I)
C     45 = ASCII DASH
      IF (EQUAL.GT.NCHCMD) GO TO 90
      J=COMAND(EQUAL)
      IF (J.EQ.32 .OR. J.EQ.46) GO TO 90
C     32 = ASCII BLANK, 46 = ASCII PERIOD.
      IF (J.NE.44.AND.J.NE.45) GO TO 480
C     44 = ASCII COMMA, 45 = ASCII DASH
80    EQUAL=EQUAL+1
      IF (COMAND(EQUAL)-32) 40,80,40
C     32 = ASCII BLANK
90    NUMBER=I
C     FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE
C     POSITION IN COMAND CURRENTLY BEING EXAMINED.
      EQUAL=-1
100   EQUAL=EQUAL+1
      IF (EQUAL.GE.NUMBER) GO TO 470
      IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100
      IF (EQUAL.EQ.0) GO TO 120
      WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD)
110   FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H)
     1NOT COPIED./(1X,80A1))
      NERRG=MAX0(NERRG,5)
120   IF (COMAND(EQUAL+1).GT.0) GO TO 130
      EQUAL=EQUAL-1
      COMAND(EQUAL+1)=N1RECI
130   IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
C
C     PROCESS COPY = LIST OF NUMBERS
C
140   EQUAL=EQUAL+1
C     GO COPY THE PROGRAM IF IT IS THE RIGHT ONE.
150   IF (INTOPN.LT.0) GO TO 430
      IF (COMAND(EQUAL)-N1RECI) 170,420,160
C     SKIP TO DESIRED PROGRAM
160   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI-69) 150,460,150
C     69 = ASCII E
170   IF (EQUAL.GE.NUMBER) GO TO 430
      IF (COMAND(EQUAL+1).GE.0) GO TO 140
      COMAND(EQUAL)=IABS(COMAND(EQUAL))+1
      IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420
      EQUAL=EQUAL+1
      GO TO 170
C
C     COPY = SELECTION STRING OR CHANGE CONTROL RECORD.
C
180   ICOMD=-2
      IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
      NRWORK=-1
C
C     DETERMINE NEED TO OPEN WORK FILE.
C
190   IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0)
     1IF (ICOMD) 290,430,290
      IF (WORKF.EQ.0) GO TO 500
      I=IABS(WORKF)
      IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510
      IF (WORKF.GT.0) GO TO 200
      WORKF=I
      CALL EXCHFO (3)
200   IF (ICOMD.NE.0) GO TO 280
C
C     CHANGE CONTROL RECORD.
C
      if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520
c     69 = ascii E, 73 = ascii I.
      if (nrwork.eq.0) go to 210
      if (itypei.eq.80) go to 520
c     80 = ascii P
210   IF (NUMBER-NRWORK-1) 530,220,410
220   NCHACT=NCHCMD+1-EQUAL
      IF (NCHACT.GT.0) GO TO 230
      NCHACT=1
      INTREC(1)=32
C     32 = ASCII BLANK
      GO TO 425
230   DO 240 I=1,NCHACT
240   INTREC(I)=COMAND(EQUAL+I-1)
      GO TO 425
C
C     COPY = SELECTION EXPRESSION.
C
C     SKIP TO NEXT PROGRAM.
250   IF (INTOPN.LT.0) GO TO 430
      if (itypei.eq.69) go to 460
c     69 = ASCII E.
      do 260 i = 1, 8
260   pred(2,i)=0
      if (itypei.ne.80) go to 265
c     If the current record is a new program, don't skip it (we haven't
c     processed it yet).
      if (nrwork.gt.0 .and. workf.gt.0) rewind workf
      nrwork=min0(nrwork,0)
      newp=0
      go to 320
265   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      nxnewp=0
270   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.NE.80) GO TO 310
C     80 = ASCII P
      NEWP=nxnewp
c     Set NEWP non-zero when all control records for a module have been
c     seen.
      GO TO 320
280   NRWORK=MAX0(NRWORK,0)
290   DO 300 I=1,8
300   PRED(2,I)=0
c     NEWP is non-zero when all control records have been read.
310   if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1
C     69 = ASCII E, 73 = ASCII I.
320   nxnewp=1
      if (icomd.eq.0) if (newp) 520,210,520
      IF (LIMIT.EQ.0) GO TO 340
      IF (N1RECI.LE.LIMIT) GO TO 340
      WRITE (PRINTR,330) LIMIT
330   FORMAT (7H LIMIT=,I6,9H REACHED.)
      GO TO 430
340   IF (NEWP.EQ.0) GO TO 360
      CALL EXCHLX
C     EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'.
      NUMBER=NCHCMD
      IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415
C     73 = ASCII I.
      IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425
C     80 = ASCII P.
      IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425
C     83 = ASCII S.
      IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415
C     88 = ASCII X.
      IF (COMAND(180)) 450,250,420
C     CONTROL RECORD.  EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE.
360   I=1
      DO 400 NUMBER=1,8
      IF (PRED(1,NUMBER).EQ.0) GO TO 400
      IF (PRED(2,NUMBER).NE.0) GO TO 400
      IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390
      NM=PRED(1,NUMBER)-3
      IF (.NOT.(NCHACT.GT.0)) GO TO 390
      DO 385 L = 1, NCHACT
      DO 380 J = 1, NM
C
C     DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND
C     IN PREDICATE.
      IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380
      IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370
C
C     NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS.
      K=32
      GO TO 375
C     USE CHARACTER FROM CONTROL RECORD.
370   K=INTREC(J+L-1)
C
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (K.GT.96 .AND. K.LT.123) K=K-32
C
C     TEST FOR A MATCH ON A SINGLE CHARACTER.
C     IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE
C     PATTERN.  IF THE SEARCH MODE IS X, TERMINATE THE SEARCH.
375   IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390
380   CONTINUE
C
C     FOUND A MATCH IN CONTROL RECORD AND PREDICATE.
      PRED(2,NUMBER)=1
      GO TO 400
385   CONTINUE
390   I=0
400   CONTINUE
      IF (I.NE.0) newp=1
      IF (NRWORK.LT.0) GO TO 270
C     AT LEAST ONE FALSE PREDICATE.  WRITE THE CONTROL RECORD ON WORKF.
410   WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT)
      NRWORK=NRWORK+1
      GO TO 270
C
C     GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM.
C
415   ICOMD=-3
C     RETURN TO EXCHC1 AFTER COPYING MODULE.
420   TRANS=5
      GO TO 570
C
C     RETURN TO THE COMMAND PROCESSOR.
C
425   TRANS=1
C     REMEMBER CONTROL RECORDS ON WORKF.
      GO TO 570
430   TRANS=1
      IF (ICOMD+1) 560,570,570
C
C     ERROR MESSAGES.
C
440   NUMBER=1
C     MESSAGE 1 - I/O ERROR.
      EQUAL=ISTAT
      GO TO 550
450   NUMBER=-COMAND(180)
C     MESSAGES GENERATED BY EXCHLX
      GO TO 550
460   IF (INTOPN.LT.0) GO TO 430
      INTOPN=-1
      EQUAL=NUMBER
      NUMBER=15
C     MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE.
      GO TO 550
470   NUMBER=16
C     MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION.
      GO TO 550
480   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER
      GO TO 550
490   NUMBER=18
C     MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER.
      GO TO 550
500   NUMBER=19
C     MESSAGE 19 - WORK FILE NOT DEFINED.
      GO TO 550
510   NUMBER=20
C     MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE.
      GO TO 550
520   EQUAL=NUMBER
      NUMBER=21
C     MESSAGE 21 - CONTROL RECORD NOT PRESENT
      GO TO 550
530   NUMBER=22
C     MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER.
      GO TO 550
540   NUMBER=29
C     MESSAGE 29 - BACKWARD SKIP IGNORED.
C
C     RETURN TO THE ERROR MESSAGE PROCESSOR.
C
550   TRANS=8
      IF (ICOMD.EQ.0) GO TO 570
C
C     DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF.
C
560   IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
C
C     RETURN TO TRANSITION PROGRAM.
C
570   RETURN
C
      END
      SUBROUTINE EXCHLX
C
C     EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND.
C
C     THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE
C     STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM
C     COPY=LOGICAL EXPRESSION.  THE LOGICAL EXPRESSION CONSISTS OF THE
C     EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY
C     OPERATORS + - * / AND PARENEHESES.  THE PRIMARY SYMBOLS A-H ARE
C     LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE
C     STATEMENTS.  THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE
C     NULL PREDICATE, WHICH IS ALWAYS FALSE.  THE OPERATORS + - * / ARE
C     THE BINARY LOGICAL OPERATIONS   OR, OR NOT, AND, AND NOT
C     RESPECTIVELY.  THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE
C     PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL
C     PRIORITY.  THE RELATIVE PRIORITY MAY BE CHANGED BY USING
C     PARENTHESES.
C
C     WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY
C     FALSE.  AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL
C     FALSE PREDICATES IS DETERMINED.  ONCE TRUE, A PREDICATE REMAINS
C     TRUE.  THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND
C     A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE.  WHEN ALL ACTIVE
C     PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM
C     HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND
C     IS EVALUATED.  IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED.
C     IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED.  THIS PROCESS
C     CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM
C     NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED.
C
C     THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE
C     TABLE BELOW.  INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS
C     APPENDED TO THE END OF THE LOGICAL EXPRESSION.
C
C     PREVIOUS  I                 CURRENT TOKEN                   I
C      TOKEN    I + - * / I PRIMARY I    (    I    )    I  ELSE   I
C     ----------I---------I---------I---------I---------I---------I
C      + - * /  I  ERROR  I   OK    I   OK    I  ERROR  I  ERROR  I
C      PRIMARY  I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C         (     I  ERROR  I   OK    I   OK    I   OK    I  ERROR  I
C         )     I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C     ----------I---------I---------I---------I---------I---------I
C
C     CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING
C     A STACK AND THE PRECEDENCE TABLE BELOW.  TOS MEANS TOP-OF-STACK,
C     HOI MEANS HEAD-OF-INPUT.  THE STACK INITIALLY CONTAINS (.
C
C                  TOS       HOI
C      TOKEN   I  INDEX  I  INDEX  I
C     ---------I---------I---------I
C       + -    I    2    I    1    I
C       * /    I    4    I    3    I
C     PRIMARY  I    6    I    5    I
C        (     I    0    I    7    I
C        )     I   N/A   I    0    I
C     ---------I---------I---------I
C
C     WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS
C     PUSHED ONTO THE STACK.  WHEN THE TOS INDEX IS GREATER THAN THE HOI
C     INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY
C     SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT
C     PLACED IN THE SUFFIX LIST.  THEN THE RELATION OF THE TOS INDEX TO
C     THE HOI INDEX IS RE-EXAMINED.  WHEN THE TOS INDEX IS EQUAL TO THE
C     HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED.
C
C     *****     INTERNAL VARIABLES     *********************************
C
C CHTAB   RECOGNIZED CHARACTERS.  INTERNAL PROCESSES USE THE INDEX
C         INTO CHTAB.
C COLTAB  CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX.
C HOI     CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE.
C INFIX   IS THE CURRENT POSITION IN THE INFIX.
C IPREV   IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN.
C ISTACK  IS THE CURRENT STACK INDEX.
C ISUFIX  IS THE CURRENT SUFFIX INDEX.
C SYNTAX  CONTAINS THE SYNTAX RULES.
C TOS     CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE.
C
      INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     DATA STATEMENTS     ************************************
C
C                                                    A  B  C  D
      DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/
C                                                    E  F  G  H
      DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/
C                                                    N  +  -  *
      DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/
C                                                    /  (  )
      DATA CHTAB(13),CHTAB(14),CHTAB(15)           /47,40,41   /
C                                                       A B C D
      DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/
C                                                       E F G H
      DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/
C                                                       N + - *
      DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/
C                                                       / ( )
      DATA COLTAB(13),COLTAB(14),COLTAB(15)            /1,3,4  /
C                                                   A B C D E
      DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/
C                                                   F G H N +
      DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/
C                                                   - * / ( )
      DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/
C                 CURRENT TOKEN IS +-*/.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/
C                 CURRENT TOKEN IS PRIM.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/
C                 CURRENT TOKEN IS (.     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/
C                 CURRENT TOKEN IS ).     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/
C                                                   A B C D E
      DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/
C                                                   F G H N +
      DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/
C                                                   - * / ( )
      DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/
C
C     *****     PROCEDURES     *****************************************
C
C     COMAND IS USED FOR INFIX, STACK AND SUFFIX.  UPON COMPLETION,
C     COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE
C     OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE
C     EXPRESSION IS TRUE.
C
      ISTACK=NCHCMD+2
      COMAND(ISTACK)=14
      ISUFIX=181
      IPREV=3
      COMAND(NCHCMD+1)=41
      INFIX=EQUAL-1
C
C     GET A CHARACTER FROM INFIX.  LOOK UP IN CHTAB.  CHECK SYNTAX.
C
10    IF (INFIX.GT.NCHCMD) GO TO 180
      INFIX=INFIX+1
      J=COMAND(INFIX)
      IF (J.EQ.32) GO TO 10
C     32 = ASCII BLANK - IGNORE IT.
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      DO 20 I=1,15
      IF (CHTAB(I).EQ.J) GO TO 30
20    CONTINUE
      GO TO 230
30    J=COLTAB(I)
      IF (SYNTAX(IPREV,J)-1) 40,190,200
C
C     CONVERT INFIX TO SUFFIX
C
40    IPREV=J
50    J=COMAND(ISTACK)
      IF (TOS(J)-HOI(I)) 60,70,80
C     PUSH INFIX ONTO STACK
60    ISTACK=ISTACK+1
      COMAND(ISTACK)=I
      GO TO 10
C     DELETE TOP OF STACK
70    ISTACK=ISTACK-1
      IF (ISTACK.GT.NCHCMD+1) GO TO 10
      IF (INFIX-NCHCMD) 220,220,250
C     IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX.
C     IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX.
80    IF (J-9) 90,100,130
C     PRIMARY IS SYMBOL A-H
90    IF (PRED(1,J).EQ.0) GO TO 210
      J=PRED(2,J)
      GO TO 110
C     NULL PREDICATE
100   J=0
110   ISUFIX=ISUFIX-1
120   COMAND(ISUFIX)=J
      ISTACK=ISTACK-1
      GO TO 50
C     OPERATOR
130   J=J-9
      ISUFIX=ISUFIX+1
      GO TO (140,150,160,170), J
C             +   -   *   /
140   J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1)
      GO TO 120
150   J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1)
      GO TO 120
160   J=COMAND(ISUFIX)*COMAND(ISUFIX-1)
      GO TO 120
170   J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1))
      GO TO 120
C
180   COMAND(180)=-23
C     MESSAGE 23 - TOO MANY (
      GO TO 240
190   COMAND(180)=-24
C     MESSAGE 24 - MISSING PRIMARY
      GO TO 240
200   COMAND(180)=-25
C     MESSAGE 25 - MISSING OPERATOR
      GO TO 240
210   EQUAL=CHTAB(J)
      CALL EXCHAH (EQUAL,1)
      COMAND(180)=-26
C     MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE.
      GO TO 250
220   COMAND(180)=-27
C     MESSAGE 27 - TOO MANY )
      GO TO 240
230   COMAND(180)=-28
C     MESSAGE 28 - UNRECOGNIZED CHARACTER
C
240   EQUAL=INFIX
250   RETURN
C
      END
      SUBROUTINE EXCHC5 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE,
C     AND INDEX IF SELECTED.  COPY RECORDS FROM WORKF FIRST, IF ANY.
C     CREATE CONTROL RECORDS DEMANDED BY COMMANDS.
C
C     THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF
C     THE PARAMETER STRING.
C
C     AUTHOR
C     COMMENT
C     CONTROL (ITYPEO SET FROM MODIFY)
C     DATA TYPE
C     GROUPS
C     INSERT
C     KEYWORDS
C     MACHINE
C     ORIGIN
C     REFERENCES
C     REMOVE   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     SIGNAL   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     UPDATE
C
C     IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS
C     ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A
C     CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND.
C
C     *****     LOCAL VARIABLES     ************************************
C
C BLANK   CONTAINS A HOLLERITH BLANK.
      INTEGER BLANK
C C1      IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING.
      INTEGER C1
C COL1    THE FIRST COLUMN OF TEXT OF A CONTROL RECORD.  DERIVED FROM
C         EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE.
      INTEGER COL1
C I,J     USED FREELY AS INDICES.
      INTEGER I,J
C KCONT   THE INDEX IN COMD OF THE CONTROL COMMAND.
      INTEGER KCONT
C KNAME   IS THE INDEX IN COMD OF THE NAME COMMAND.
      INTEGER KNAME
C KTEXT   THE INDEX IN COMD OF THE TEXT COMMAND.
      INTEGER KTEXT
C KUPDA   THE INDEX IN COMD OF THE UPDATE COMMAND.
      INTEGER KUPDA
C LIST    CONTAINS THE WORD LIST IN ASCII.  USED FOR THE A OPTION.
      INTEGER LIST(4)
C NM      IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NM
C NOUT    IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NOUT
C NY      IS THE PROGRAM NUMBER.  IT IS THE NUMBER FROM INTAPE IF
C         OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE.
      INTEGER NY
C ONE     CONTAINS A HOLLERITH 1.
      INTEGER ONE
C REASON  REASON FOR COPYING A CONTROL RECORD.  1 = COPY COMMAND
C         PENDING.  2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8.
C         3 = COMMAND.
      INTEGER REASON
C RI      CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A
C         GIVEN RECORD TYPE.  RI IS SUBSCRIPTED BY (ITYPEO-64).
      INTEGER RI(26)
C RT      IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT.
      INTEGER RT(34)
C STAR    CONTAINS A HOLLERITH STAR.
      INTEGER STAR
C ZERO    CONTAINS A HOLLERITH ZERO.
      INTEGER ZERO
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL VARIABLE DATA     ********************************
C
      DATA BLANK /1H /
C                                            L  I  S  T
      DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/
C
      DATA KCONT /31/
      DATA KNAME /9/
      DATA KTEXT /27/
      DATA KUPDA/29/
      DATA ONE /1H1/
C                                                      A  B  C  D  E  F
      DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/
C                                                      G  H  I  J  K  L
      DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/
C                                                      M  N  O  P  Q  R
      DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/
C                                                      S  T  U  V  W  X
      DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/
C                                                      Y  Z
      DATA RI(25),RI(26)                             /31,31            /
C                                                     A  C     D     G
      DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/
C                                                           P     K
      DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/
C                                                     M     O
      DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/
C                                                              B  R
      DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/
C                                                                 S
      DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/
C                                                              J
      DATA RT(31),RT(32),RT(33),RT(34)              /-1, 0, 0,74/
C
      DATA STAR /1H*/
      DATA ZERO /1H0/
C
C     *****     PROCEDURES     *****************************************
C
      REASON=1
      NY=N1RECI
      IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1
C     ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P.
C     IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT.
      IF (PHASE.EQ.4) NY=0
C     NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER.  (IT IS PRINTED
C     IN THE INDEX).
      IF (ICOMD.LE.0) GO TO 10
      IF (PHASE.GE.4) GO TO 100
      IF (ICOMD.EQ.KNAME) GO TO 10
      IF (ICOMD.NE.KUPDA) GO TO 100
      REASON=2
      PHASE=8
10    IF (NRWORK.GT.0) REWIND WORKF
      NM=0
      NOUT=0
20    NM=NM+1
      IF (NM.LE.NRWORK) GO TO 60
30    IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230
C     69 = ASCII E, 73 = ASCII I.
      IF (NOUT.EQ.0) GO TO 40
      IF (ITYPEI.EQ.80) GO TO 230
C     80 = ASCII P.
      IF (NCHACT.NE.1) GO TO 40
      IF (INTREC(1).EQ.32) GO TO 220
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
40    ITYPEO=ITYPEI
      NCHOUT=NCHACT
      DO 50 J=1,NCHOUT
50    OUTREC(J+5)=INTREC(J)
      GO TO 70
60    READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT)
      IF (NCHOUT.NE.1) GO TO 70
      IF (NM.EQ.1) GO TO 70
      IF (OUTREC(6).EQ.32) GO TO 200
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
70    NOUT=NOUT+1
      J=RI(ITYPEO-64)
      DO 80 I=1,4
80    OUTREC(I)=COMD(I,J)
      OUTREC(5)=61
C     61 = ASCII =
      COL1=5
      IF (J.NE.KCONT) GO TO 130
      COL1=7
C     CONTROL,*=...  MOVE UP TWO CHARACTERS AND INSERT ITYPEO.
      DO 90 I=1,NCHOUT
90    OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I)
      OUTREC(5)=44
C     44 = ASCII COMMA.
      OUTREC(6)=ITYPEO
      OUTREC(7)=61
C     61 = ASCII =
      GO TO 130
100   IF (ICOMD.EQ.KTEXT) GO TO 240
      COL1=EQUAL-1
      NCHOUT=NCHCMD-COL1
      NRWORK=NRWORK+1
C     NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD.
      ITYPEO=RT(ICOMD)
      IF (ITYPEO.GT.0) GO TO 110
C     PROCESS CONTROL,TYPE=TEXT COMMAND.
      ITYPEO=MODIFY
      IF (RI(ITYPEO-64).NE.KCONT) GO TO 320
110   NOUT=NRWORK
      REASON=3
      DO 120 I=1,NCHCMD
120   OUTREC(I)=COMAND(I)
130   IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1)
C     74 = ASCII J.
      IF (ITYPEO.EQ.80) VERT=0
C     80 = ASCII P
      IF (ITYPEO.NE.68) GO TO 150
C     68 = ASCII D
      IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150
      DO 140 J=1,4
      I=OUTREC(J+COL1)
      IF (I.GT.96 .AND. I.LT.123) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.NE.LIST(J)) GO TO 150
140   CONTINUE
      VERT=1
C     GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE.
150   CALL EXCHCG (OUTREC(COL1+1))
      IF (OUTOPN.EQ.0) GO TO 160
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1))
      IF (ISTAT.NE.0) GO TO 340
      NY=NLRECO
160   NCHOUT=NCHOUT+COL1
C     TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER.
      OUTREC(180)=-NOUT
      IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC)
C     PRINT THE INDEX IF SELECTED.
      IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO
     1190
      IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190
      C1=BLANK
C     DOUBLE SKIP FOR PROGRAM HEADER (P).
      IF (ITYPEO.EQ.80) C1=ZERO
      IF (OPTV+VERT.NE.0) GO TO 170
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170
      IF (CHAR1L.NE.ONE) C1=ONE
      CHAR1L=ONE
170   CALL EXCHAH (OUTREC,NCHOUT)
      WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT)
180   FORMAT (A1,2I5,1H*,(3X,105A1))
190   IF (REASON.EQ.3) GO TO 310
200   IF (NM-NRWORK) 20,210,220
210   REWIND WORKF
      NRWORK=0
      GO TO 30
220   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT) 330,30,330
230   IF (REASON.EQ.2) GO TO 300
240   IF (OUFILE.EQ.0) GO TO 260
      DO 250 I=1,4
250   OUTREC(I)=COMD(I,KTEXT)
      OUTREC(180)=0
      NCHOUT=0
C     TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED.
      CALL EXCHCG (OUTREC)
      NCHOUT=4
      ACTION=2-OPTC-OPTC
C     ACTION = 2 MEANS START OF PROGRAM.
      CALL EXCHOU (OUTREC)
260   IF (OPTV+VERT.NE.0) GO TO 280
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280
      IF (OUTOPN.NE.0) NY=NLRECO
      I=BLANK
      IF (CHAR1L.NE.ONE) I=ONE
      WRITE (PRINTR,270) I,NY
270   FORMAT (A1,I5,1H*,8X,4HTEXT/)
280   CHAR1L=STAR
      NRWORK=MIN0(NRWORK,0)
      IF (IDOPTN.NE.67) IDCUR=IDSTRT
C     67 = ASCII C
      IF (ICOMD.EQ.KTEXT) GO TO 290
C
C     WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL
C     RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED.
C
      TRANS=6
      GO TO 370
C
C     WORKING ON A TEXT STATEMENT.
C
290   TRANS=7
      GO TO 370
C
C     WORKING ON AN UPDATE STATMENT.
C
300   NRWORK=NOUT
      GO TO 100
C
C     WRITING A SINGLE CONTROL RECORD.
C
310   TRANS=1
      GO TO 370
C
C     ERROR MESSAGES.
C
320   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER.
      GO TO 360
330   NUMBER=1
      GO TO 350
340   NUMBER=2
350   EQUAL=ISTAT
360   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM.
C
370   RETURN
C
      END
      SUBROUTINE EXCHCG (RECORD)
C
C     USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL.
C     WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED.
C     THIS IS THE PORTABLE VERSION.  IT DOES NOT DO ANYTHING.
C
      INTEGER RECORD(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      RETURN
      END
      SUBROUTINE EXCHC6 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE.
C
      INTEGER KNAME,ONE,SVHCMD(180)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KNAME /9/
      DATA ONE /1H1/
C
      LINEO=0
      NERRS=0
C     SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT.
      DO 5 I = 1,NCHCMD
5     SVHCMD(I)=HOLCMD(I)
      IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165
C     73 = ASCII I.  IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE
C     A VOID MODULE.
      IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10
      CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.EQ.7) GO TO 220
      IF (ISTAT) 250,160,250
10    MODEO=MODEI
      ITYPEO=0
      NBC=OPTL+OUFILE
      IF (INDEX.GT.0) NBC=1
20    NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTOPN.EQ.0) GO TO 120
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 260
C
C     CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD
C     INSTEAD OF BYTE-BY-BYTE).  WE CAN DO A BLOCK COPY IF
C     WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT
C     FILE AND NOT PRINTING THE INDEX.  ALSO, THE INPUT AND
C     OUTPUT CHARACTER POSITIONS MUST BE THE SAME.  IF THE
C     PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH
C     THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE
C     CURRENT POSITION IN THE BYTE BUFFER BE THE SAME.
C     WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE
C     LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T
C     KNOW THE LOCATION OF THE END-OF-FILE RECORD.
C
      IF (NBC.NE.0) GO TO 120
      IF (CPCBI+1.NE.CPCBO) GO TO 120
      IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120
C     WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF.
      IF (L1PRGI.EQ.0) GO TO 25
      IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30
25    IF (CCDBI+1.NE.CCDBO) GO TO 120
      IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120
C     WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE).
C     FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO.
30    LI=L1PRGI+NERRCI-1
      IF (L1PRGI.NE.0) GO TO 40
      LI=NERRCI+NDATAI+9
      IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1
40    IF (CPCBI.GE.NCCBI) GO TO 50
      IF (CCDBI.GE.LI) GO TO 160
      CPCBI=CPCBI+1
      CBLCKO(CPCBO)=CBLCKI(CPCBI)
      CPCBO=CPCBO+1
      CCDBI=CCDBI+1
      CCDBO=CCDBO+1
      GO TO 40
C     PACK COPIED BYTES.
50    CALL EXCHPA (CBLCKO,OBLOCK(CWDBO))
      CPCBO=1
      CPCBI=0
      CWDBO=CWDBO+NWCBO
      CWDBI=CWDBI+NWCBI
C     NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM
60    IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70
      IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=L1RECI
      CALL EXCHPB (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 260
70    IF (CCDBI.LT.LI) GO TO 80
      IF (L1PRGI.NE.0) GO TO 100
      CALL EXCHGB (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 250
      GO TO 30
80    NW=NWCBI*((LI-CCDBI)/NCCBI)
      IF (NW.EQ.0) GO TO 100
      DO 90 I=1,NW
      OBLOCK(CWDBO)=IBLOCK(CWDBI)
      CWDBO=CWDBO+1
90    CWDBI=CWDBI+1
100   CCDBO=CCDBO+LI-CCDBI
      CCDBI=LI
      IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60
      CPCBI=MOD(LI,NCCBI)
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      CALL EXCHUN (IBLOCK(CWDBI),CBLCKI)
      IF (CPCBI.EQ.0) GO TO 160
      DO 110 I=1,CPCBI
110   CBLCKO(I)=CBLCKI(I)
      GO TO 160
C
C     END OF BLOCK COPY CODE.
C
120   CALL EXCHTP (INTREC,LINEO)
160   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 250
      IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20
C     73 = ASCII I.
165   IF (OPTL.NE.0) GO TO 180
      IF (INDEX.LE.0) GO TO 195
      WRITE (PRINTR,170) LINEO
170   FORMAT (I9,14H IMAGES COPIED)
      GO TO 200
180   WRITE (PRINTR,190)
190   FORMAT (1H1)
195   CHAR1L=ONE
200   IF (OUFILE.EQ.0) GO TO 210
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
210   IF (ITYPEI.EQ.69) GO TO 220
C     69 = ASCII E
C
C     RETURN TO THE COPY CONTROL SEGMENT.
C
      DO 215 I=1,NCHCMD
215   HOLCMD(I)=SVHCMD(I)
      IF (ICOMD.EQ.-3) GO TO 240
C     ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE.
      TRANS=4
      IF (ICOMD.NE.KNAME) GO TO 280
C     MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME'
C     COMMAND SUBMITTED.  GO PROCESS 'NAME' COMMAND.
      TRANS=5
      PHASE=4
      GO TO 280
C
C     END OF FILE ON INPUT TAPE.
C
220   IF (INTOPN.LT.0) GO TO 240
      WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD)
230   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1))
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
240   TRANS=1
      GO TO 280
C
C     ERROR MESSAGES.
C
250   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      GO TO 270
260   NUMBER=2
C     MESSAGE 2 - I/O ERROR WRITING OUTAPE.
270   TRANS=8
      EQUAL=ISTAT
C
C     RETURN TO THE TRANSITION PROGRAM.
C
280   IF (NERRS.EQ.0) GO TO 300
      WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD)
290   FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./
     1(1X,80A1))
      NERRG=MAX0(NERRS,NERRG)
300   RETURN
C
      END
      SUBROUTINE EXCHC7 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
      INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40)
C
C     PROCESS THE TEXT COMMAND.
C
C MSG     IS USED TO PRINT A MESSAGE.
      INTEGER MSG(6,2)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/
      DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/
      DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/
      DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/
      DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/
C
      LINEI=1
      LINEO=0
      NERRS=0
      INEND=0
      CHAR1L=STAR
C
C     SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND
C
      K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 20 I=1,40
      IF (K.GT.NCHCMD) GO TO 10
      J=COMAND(K)
      K=K+1
      GO TO 20
10    J=32
C     32 = ASCII BLANK.
20    TXDISK(I)=J
      IF (INTOPN.LE.0) ITYPEI=0
C
C     MAIN PROCESSING LOOP
C
60    EDIT=0
70    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 80
C     NCHCMD.LT.0 MEANS END OF FILE.
      IF (NCHCMD.LT.2) GO TO 100
      IF (COMAND(1).NE.SIGNAL) GO TO 100
      IF (COMAND(2).EQ.SIGNAL) GO TO 80
      IF (COMAND(2).EQ.73) GO TO 370
      IF (COMAND(2).EQ.105) GO TO 370
C     73,105 = ASCII I - REQUEST TO INCLUDE TEXT.
      IF (NCHCMD.LT.3) GO TO 100
      IF (COMAND(2).NE.61) GO TO 100
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 70
C     END OF TEXT FILE.
80    IF (INTEXT.EQ.0) GO TO 90
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      CALL EXCHIM
      INTEXT=0
      NCHCMD=0
90    NCHCMD=MIN0(NCHCMD,0)
      IF (PHASE.NE.8) GO TO 660
      IF (INEND) 660,630,660
100   IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110
110   IF (EDIT.EQ.0) GO TO 450
C
C     PARTIAL LINE EDITOR.
C     INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED.
C     EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES
C     THE FIRST NON-BLANK CHARACTER AFTER N2.  N1 AND N2 ARE COLUMN
C     LIMITS UNDER WHICH TO PERFORM THE EDITING.  N1 AND ,N2 ARE
C     OPTIONAL.  IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT
C     LIMIT.  IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS
C     ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE.  WHEN
C     STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING
C     PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT
C     LENGTHS OF STRING1 AND STRING2.  THE THIRD DELIMITER IS
C     OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED
C     AFTER STRING2 IS INSERTED.
C
      IF (INEND.NE.0) GO TO 240
C     CONVERT COLUMN NUMBERS.
      NBR1=0
      NBR2=0
      I=0
120   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.EQ.44) GO TO 150
C     44 = ASCII COMMA
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR1=10*NBR1+J-48
      GO TO 120
130   WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD)
140   FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/
     1(1X,80A1))
      NERRS=2
      GO TO 70
150   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR2=10*NBR2+J-48
      GO TO 150
C     SCAN FOR DELIMITER
160   IF (J.NE.32) GO TO 170
C     32 = ASCII BLANK
      I=I+1
      J=COMAND(I)
      GO TO 160
170   D1=I
      NBR1=MIN0(NBR1,180)
      NBR2=MIN0(NBR2,180)
      IF (NBR1.EQ.0) NBR1=1
      IF (NBR2.EQ.0) GO TO 180
      IF (NBR2.LT.NBR1) GO TO 130
180   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      IF (COMAND(I).NE.J) GO TO 180
      D2=I
      D3=0
190   I=I+1
      IF (I.GT.NCHCMD) GO TO 200
      IF (COMAND(I).NE.J) GO TO 190
      D3=I
C     LOOK FOR SEARCH STRING (STRING1)
200   NUMBER=D2-D1-1
      J=NBR1
      IF (NUMBER.EQ.0) GO TO 260
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
210   DO 220 I=1,NUMBER
      IF (I+J-1.GT.NY) GO TO 240
      IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230
220   CONTINUE
      GO TO 260
230   J=J+1
      GO TO 210
240   WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1))
      NERRS=2
      GO TO 70
C     FOUND SEARCH STRING.  REPLACE WITH UPDATE STRING.
260   CHAR1L=PLUS
      IF (D3.NE.0) GO TO 300
C     NO THIRD DELIMITER.   REPLACE REST OF REGION.
      NY=NBR2
      IF (NY.EQ.0) NY=180
      D2=D2+1
      IF (D2.GT.NCHCMD) GO TO 280
      DO 270 I=D2,NCHCMD
      INTREC(J)=COMAND(I)
      J=J+1
      IF (J.GT.NY) GO TO 280
270   CONTINUE
280   IF (NBR2.NE.0) GO TO 290
      NCHACT=J-1
      GO TO 70
290   IF (J.GT.NBR2) GO TO 70
      INTREC(J)=32
C     32 = ASCII BLANK
      J=J+1
      GO TO 290
C     WE HAVE A THIRD DELIMITER.  REPLACE ONLY THE SEARCH STRING.
C     SHIFT THE REST OF THE REGION AS NECESSARY.
300   NUMBER=(D3-D2)-(D2-D1)
      IF (NUMBER) 310,350,330
C     SHIFT LEFT
310   I=J+D2-D1-1
      NY=MIN0(NBR2,NCHACT)
      IF (NY.EQ.0) NY=NCHACT
320   IF (I.GT.NY) GO TO 350
      INTREC(I+NUMBER)=INTREC(I)
C     NOTE - NUMBER .LT. 0 HERE
      INTREC(I)=32
C     32 = ASCII BLANK
      I=I+1
      GO TO 320
C     RIGHT SHIFT
330   I=NBR2
      IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180)
      NY=J+NUMBER
340   IF (I.LT.NY) GO TO 350
      INTREC(I)=INTREC(I-NUMBER)
      I=I-1
      GO TO 340
C     NO SHIFT NEEDED.
350   IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180)
      IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2)
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
C     MOVE UPDATE STRING (STRING2).
360   D2=D2+1
      IF (D2.GE.D3) GO TO 70
      INTREC(J)=COMAND(D2)
      J=J+1
      IF (J-NY) 360,360,70
C
C     REQUEST TO INCLUDE TEXT.  -I IN COLUMNS 1 AND 2.
C
370   IF (EDIT.EQ.0) GO TO 390
      WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD)
380   FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X
     1,80A1))
      NERRS=2
      GO TO 70
390   ITYPEO=73
C     73 = ASCII I
      IF (NCHCMD.GE.4) GO TO 410
      WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD)
400   FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A
     11))
      NERRS=2
      GO TO 70
410   DO 420 I=4,NCHCMD
      IF (COMAND(I).NE.32) GO TO 430
420   CONTINUE
C     CONVERT TO UPPER CASE.  WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM
430   K=0
      DO 440 J=I,NCHCMD
      IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32
      K=K+1
440   COMAND(K)=COMAND(J)
      NCHCMD=K
      GO TO 460
C
C     TEXT RECORD.
C
450   ITYPEO=0
460   NCHOUT=NCHCMD
      IF (OUTOPN.EQ.0) GO TO 470
      MODEO=0
      CALL EXCHPR (ISTAT,OBLOCK,COMAND)
      IF (ISTAT.NE.0) GO TO 770
470   CALL EXCHTP (COMAND,0)
      GO TO 70
C
C     APPARENT CHANGE CONTROL COMMAND
C
480   IF (INEND.EQ.0) GO TO 510
490   WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD)
500   FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT
     1 END./(1X,80A1))
      NERRS=1
      GO TO 70
510   NUMBER=1
      NBR1=0
      EDIT=0
      I=1
520   I=I+1
      IF (I.GT.NCHCMD) GO TO 600
      J=COMAND(I)
      IF (J.EQ.32) GO TO 600
C     32 = ASCII BLANK
      IF (EDIT.NE.0) GO TO 530
C     EDIT CONTROL MUST BE BLANK AFTER $.
      IF (J.EQ.44) GO TO 570
C     44 = ASCII COMMA
      IF (J.EQ.36) GO TO 560
C     36 = ASCII $
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.LE.57) GO TO 550
C     57 = ASCII 9
530   WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD)
540   FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1)
      NERRS=2
      GO TO 60
550   NBR1=10*NBR1+J-48
      GO TO 520
560   IF (NBR1.EQ.0) GO TO 530
      EDIT=1
      NBR1=NBR1-1
      GO TO 520
570   NUMBER=2
      NBR2=0
580   I=I+1
      IF (I.GT.NCHCMD) GO TO 590
      J=COMAND(I)
      IF (J.EQ.32) GO TO 590
C     32 = ASCII BLANK
      IF (IABS(J-44).EQ.1) GO TO 590
C     43 = ASCII +, 45 = ASCII -
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 530
C     57 = ASCII 9
      NBR2=10*NBR2+J-48
      GO TO 580
590   IF (NBR2.LT.NBR1) GO TO 530
      NBR1=NBR1-1
600   IF (NBR1.GE.LINEI-1) GO TO 620
      WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD)
610   FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1)
      NERRS=2
      GO TO 60
620   IF (NCHCMD.LE.0) GO TO 630
      IF (LINEI.LE.NBR1) GO TO 630
      IF (NUMBER.EQ.1) GO TO 70
C     SKIP INTAPE UNTIL NBR2 IS SKIPPED.
      MODEI=1
      IF (LINEI.GE.NBR2) MODEI=0
      IF (LINEI-NBR2) 650,650,70
C     COPY FROM INTAPE UNTIL NBR1 COPIED.
630   MODEO=MODEI
      NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTAPE.EQ.0) GO TO 640
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 770
640   CALL EXCHTP (INTREC,LINEI)
      MODEI=0
      IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650
      IF (LINEI.EQ.NBR1) GO TO 650
      MODEI=1
650   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 760
      LINEI=LINEI+1
      IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620
C     73 = ASCII I
      INEND=1
      IF (NCHCMD.LE.0) GO TO 660
      I=NBR2
      IF (NUMBER.EQ.1) I=NBR1
      IF (LINEI-I) 490,490,70
660   IF (NERRS.EQ.0) GO TO 675
      J=1
      IF (PHASE.EQ.8) J=2
      WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS
670   FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.)
675   NERRG=MAX0(NERRG,NERRS)
      IF (OPTL+OPTS.NE.0) GO TO 690
      IF (OUTAPE+OUFILE.EQ.0) LINEO=0
      IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO
680   FORMAT (I9,14H IMAGES COPIED)
      GO TO 710
690   WRITE (PRINTR,700)
700   FORMAT (1H1)
      CHAR1L=ONE
710   IF (OUFILE.EQ.0) GO TO 720
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
720   IF (ITYPEI.NE.69) GO TO 750
C     69 = ASCII E
C
C     END OF FILE ON INPUT TAPE (UPDATE MODE).
C
      IF (INTOPN.LT.0) GO TO 750
      DO 730 I=1,40
730   HOLCMD(I+1)=TXDISK(I)
      HOLCMD(1)=32
      IF (TXDISK(1).NE.32) HOLCMD(1)=61
C     32 = ASCII BLANK, 61 = ASCII =
      CALL EXCHAH (HOLCMD,41)
      WRITE (PRINTR,740) (HOLCMD(I),I=1,41)
740   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1)
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
750   TRANS=1
      GO TO 790
C
C     ERROR MESSAGES.
C
760   NUMBER=1
      GO TO 780
770   NUMBER=2
780   EQUAL=ISTAT
      TRANS=8
C
C     RETURN TO THE TRANSITION PROGRAM.
C
790   PHASE=2
      IF (OUTOPN.EQ.0) PHASE=1
      RETURN
C
      END
      SUBROUTINE EXCHC8
C
C     PRINT ERROR MESSAGES.
C
C     ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE
      INTEGER S(31)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/
      DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/
      DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/
      DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/
      DATA S(29),S(30),S(31)                         /4,5,5        /
C
C             1  2  3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4
     160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751),
     2NUMBER
C     16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
10    WRITE (PRINTR,20) EQUAL
20    FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.)
      GO TO 50
30    WRITE (PRINTR,40) EQUAL
40    FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.)
50    GO TO (60,80,100,120,140,160), EQUAL
60    WRITE (PRINTR,70)
70    FORMAT (22H BLOCK SEQUENCE ERROR.)
      GO TO 180
80    WRITE (PRINTR,90)
90    FORMAT (20H BLOCK IS TOO SHORT.)
      GO TO 180
100   WRITE (PRINTR,110)
110   FORMAT (11H I/O ERROR.)
      GO TO 180
120   WRITE (PRINTR,130)
130   FORMAT (18H RECORD TOO LARGE.)
      GO TO 180
140   WRITE (PRINTR,150)
150   FORMAT (21H UNKNOWN RECORD TYPE.)
      GO TO 180
160   WRITE (PRINTR,170)
170   FORMAT (25H FIRST BLOCK NOT A LABEL.)
      GO TO 760
180   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1)
      INFILE=0
C
C     RETURN TO QUIT SEGMENT.
C
      TRANS=9
      GO TO 800
C
200   WRITE (PRINTR,210)
210   FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.)
      GO TO 760
220   WRITE (PRINTR,230)
230   FORMAT (//20H0INTAPE NOT DEFINED.)
      GO TO 760
240   WRITE (PRINTR,250)
250   FORMAT (//23H0UNABLE TO OPEN INTAPE.)
      GO TO 10
260   WRITE (PRINTR,270)
270   FORMAT (//23H0UNABLE TO OPEN OUTAPE.)
      GO TO 30
280   WRITE (PRINTR,290)
290   FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.)
      GO TO 760
300   WRITE (PRINTR,310)
310   FORMAT (//19H0DATE NOT SUPPLIED.)
      GO TO 760
320   WRITE (PRINTR,330)
330   FORMAT (//19H0SITE NOT SUPPLIED.)
      GO TO 760
340   WRITE (PRINTR,350) INTAPE
350   FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4)
      GO TO 760
360   WRITE (PRINTR,370)
370   FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.)
      GO TO 760
380   WRITE (PRINTR,390)
390   FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.)
      GO TO 760
400   WRITE (PRINTR,410)
410   FORMAT (//27H0COMMAND HAS IMPROPER DATE.)
      GO TO 760
420   WRITE (PRINTR,430) EQUAL
430   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.)
      GO TO 780
440   WRITE (PRINTR,450)
450   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.)
      IF (ICOMD) 780,560,780
460   WRITE (PRINTR,470) N1RECI
470   FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO
     1N (,I5,2H).)
      GO TO 760
480   WRITE (PRINTR,490) EQUAL
490   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
500   WRITE (PRINTR,510)
510   FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.)
      GO TO 760
520   WRITE (PRINTR,530)
530   FORMAT (//23H0WORK FILE NOT DEFINED.)
      GO TO 760
540   WRITE (PRINTR,550)
550   FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.)
      GO TO 760
560   WRITE (PRINTR,570) EQUAL
570   FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.)
      GO TO 760
580   WRITE (PRINTR,590)
590   FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE
     1R.)
      GO TO 760
600   WRITE (PRINTR,610)
610   FORMAT (//12H0TOO MANY (.)
      GO TO 760
620   WRITE (PRINTR,630) EQUAL
630   FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.)
      GO TO 760
640   WRITE (PRINTR,650) EQUAL
650   FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.)
      GO TO 760
660   WRITE (PRINTR,670) EQUAL
670   FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.)
      GO TO 760
680   WRITE (PRINTR,690) EQUAL
690   FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.)
      GO TO 760
700   WRITE (PRINTR,710) EQUAL
710   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
720   WRITE (PRINTR,730) N1RECI
730   FORMAT (//21H0INTAPE POSITIONED AT,I5,25H.  BACKWARD SKIP IGNORED.
     1)
      GO TO 780
740   WRITE (PRINTR,750)
750   FORMAT (//23H0COMMAND IS INCOMPLETE.)
      GO TO 760
751   WRITE (PRINTR,752)
752   FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA
     1PE OR OUTPUT.)
760   WRITE (PRINTR,770)
770   FORMAT (23H COMMAND NOT PROCESSED.)
780   WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD)
790   FORMAT ((1X,80A1))
C
C     RETURN TO COMMAND PROCESSSOR.
C
      CHAR1L=0
      NERRS=MAX0(S(NUMBER),NERRS)
      NERRG=MAX0(NERRG,NERRS)
      TRANS=1
C
C     RETURN TO TRANSITION PROGRAM.
C
800   RETURN
C
      END
      SUBROUTINE EXCHC9 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO
C     ERRORS.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KQUIT /20/
C
      IF (INFILE.EQ.0) GO TO 10
      IF (MODIFY.NE.82) GO TO 5
C     82 = ASCII R
      ACTION=2
C     ACTION = 2 MEANS REWIND INFILE.
      CALL EXCHIM
5     ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      CALL EXCHIM
      INFILE=0
      NCHCMD=0
      GO TO 50
10    IF (OPTC*OUFILE.EQ.0) GO TO 20
      ACTION=0
      NCHOUT=4
      CALL EXCHOU (COMD(1,KQUIT))
20    ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      IF (OUTOPN.EQ.0) GO TO 30
C     WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC)
C     CLOSE THE INPUT TAPE.
30    IF (INTOPN.EQ.0) GO TO 40
      ISTAT=4
      CALL EXCHRT (ISTAT,OBLOCK)
C
C     RETURN TO MAIN PROGRAM.
C
40    TRANS=0
      IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG
45    FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.)
      GO TO 60
C
C     RETURN TO THE COMMAND DECODER.
C
50    TRANS=1
60    RETURN
C
      END
=TES FILE=12
.ENABL LC
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; EXCHANGE program, DEC RSX-11M implementation
; these are assembly language modules to play
; with bytes in various places
; note: these routines require that the FORTRAN common blocks were
; compiled as 2 byte integers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
       .TITLE  EXCMAC
       .IDENT  /NC/

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; module EXCHPA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
       .PSECT  EXCHOC,RW,D,GBL,OVR
EXCHOC:        .BLKW   382.

       .PSECT
EXCHPA::

       MOV     2(R5),R4        ; CHARS
       MOV     4(R5),R3        ; OUTBUF
       MOV     EXCHOC+380.,R2  ; how many
       BLE     67$

10$:   MOVB    (R4)+,(R3)+     ; move it
       INC     R4              ; integer addresses jump by 2
       SOB     R2,10$          ; done?
67$:   RTS     PC
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; module EXCHUN
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
       .PSECT  EXCHIC,RW,D,GBL,OVR
EXCHIC:        .BLKW   17.

       .PSECT
EXCHUN::

       MOV     2(R5),R4        ; INPBUF
       MOV     4(R5),R3        ; CHARS
       MOV     EXCHIC+16.,R2   ; how many
       BLE     77$

10$:   MOVB    (R4)+,(R3)+     ; move it
       CLRB    (R3)+           ; clear top half
       SOB     R2,10$          ; done?
77$:   RTS     PC
       .END
=TES FILE=14
; build the EXCHANGE program
PD:EXCH,EXCH/-SP=PD:EXCH/MP
; we hope the user doesn't use any unit numbers higher than 15
UNITS=15
;
; program uses a lot of files
ACTFIL=9
;
MAXBUF=134
TASK=EXCH
ASG=TI:5:6
//
; OVERLAY DESCRIPTION FOR THE EXCHANGE PROGRAM
; file exch =(main prog, exch, exchfo, exchou, exchsl, exchcx)
;  exchrouts=(exchrt, exchwt, dotape)
;  exchbd   =(block data subprogram)
;  exchmac  =(asmexch)
; The subprograms not listed are in file exch/lb as a library.
       .ROOT   PD:EXCH-PD:EXCHMAC-CHUNK-*(S1,S2,S3,S4,S5,S6,S7,S8,S9)
CHUNK: .FCTR   PD:EXCHBD-PD:EXCH/LB:EXCHTR-PD:EXCHROUTS
S1:    .FCTR   PD:EXCH/LB:EXCHC1-PD:EXCH/LB
S2:    .FCTR   PD:EXCH/LB:EXCHC2-PD:EXCH/LB
S3:    .FCTR   PD:EXCH/LB:EXCHC3-PD:EXCH/LB
S4:    .FCTR   PD:EXCH/LB:EXCHC4-PD:EXCH/LB
S5:    .FCTR   PD:EXCH/LB:EXCHC5-PD:EXCH/LB
S6:    .FCTR   PD:EXCH/LB:EXCHC6-PD:EXCH/LB
S7:    .FCTR   PD:EXCH/LB:EXCHC7-PD:EXCH/LB
S8:    .FCTR   PD:EXCH/LB:EXCHC8-PD:EXCH/LB
S9:    .FCTR   PD:EXCH/LB:EXCHC9-PD:EXCH/LB
       .END
=TES FILE=14
      PROGRAM TES
C========================
C EXCHANGE PROGRAMS
C DISTRIBUTED BY W. VAN SNYDER, JET PROPULSION LABORATORY
C
C THIS IS THE MAIN PROGRAM FOR THE DATA GENERAL MV/8000
C IMPLEMENTATION.
C
C R. HANSON, MAY, 1982.
C========================
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER IBLOCK(0900)
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCDGN/ TABS,FNAMES
C
       NWCBI = 45
       READER = 5
       PRINTR = 6
C      PROVIDE INITIAL CONDITIONS FOR SIMPLE PROGRAM.
       WORKF  = 7
       CALL EXCH (IBLOCK)
       STOP
       END
      BLOCK DATA
C
C     BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/
      DATA INTEXT /0/, INALT /0/
C
      DATA CHAR1L /1H1/
C                                                        A  U  T  H
      DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1)  /65,85,84,72/
C                                                        C  O  M  M
      DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2)  /67,79,77,77/
C                                                        C  O  P  Y
      DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3)  /67,79,80,89/
C                                                        D  A  T  A
      DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4)  /68,65,84,65/
C                                                        D  A  T  E
      DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5)  /68,65,84,69/
C                                                        G  R  O  U
      DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6)  /71,82,79,85/
C                                                        I  N  D  E
      DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7)  /73,78,68,69/
C                                                        I  N  P  U
      DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8)  /73,78,80,85/
C                                                        N  A  M  E
      DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9)  /78,65,77,69/
C                                                        I  N  T  A
      DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/
C                                                        K  E  Y  W
      DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/
C                                                        L  I  M  I
      DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/
C                                                        M  A  C  H
      DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/
C                                                        O  P  T  I
      DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/
C                                                        O  R  I  G
      DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/
C                                                        O  U  T  A
      DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/
C                                                        O  U  T  P
      DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/
C                                                        P  R  E  D
      DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/
C                                                        P  R  I  N
      DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/
C                                                        Q  U  I  T
      DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/
C                                                        R  E  A  D
      DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/
C                                                        R  E  F  E
      DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/
C                                                        R  E  M  O
      DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/
C                                                        R  E  W  I
      DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/
C                                                        S  I  T  E
      DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/
C                                                        S  K  I  P
      DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/
C                                                        T  E  X  T
      DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/
C                                                        T  I  T  L
      DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/
C                                                        U  P  D  A
      DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/
C                                                        W  O  R  K
      DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/
C                                                        C  O  N  T
      DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/
C                                                        I  D  E  N
      DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/
C                                                        I  N  C  L
      DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/
C                                                        S  I  G  N
      DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/
C                                                        M  A  R  G
      DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/
      DATA IDSTEP /0/, IDTXTL /0/
      DATA INDEX /0/
      DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/
      DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/
      DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/
      DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/
      DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/
      DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/
      DATA INDEXS(25),INDEXS(26)                       /0,0    /
      DATA INTOPN /0/
      DATA ITYPEI /0/
      DATA LIMIT /0/
      DATA MARGIN /180/
      DATA NCCBI /180/
      DATA NCCBO /180/
      DATA NCHCMD /0/
      DATA NCHMAX /180/
      DATA NCOMDP /35/
      DATA NCOMDT /35/
      DATA NDATAO /3591/
      DATA NERRCO /0/
      DATA NERRG /0/
      DATA NRWORK /0/
      DATA OUTOPN /0/
      DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/
      DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/
      DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/
      DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/
      DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/
      DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/
      DATA OPTVAL(25),OPTVAL(26)                       /0,0    /
      DATA PHASE /1/
C     INDICATE THAT NO PREDICATES ARE DEFINED.
      DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/
      DATA PRED(1,6),PRED(1,7),PRED(1,8)                     /0,0,0    /
      DATA SITE(1) /0/
      DATA TITLE(1) /32/
C     32 = ASCII BLANK
      DATA TODAY (1) /0/
      DATA TRANS /1/
      END
      SUBROUTINE EXCH (IBLOCK)
C
C     DATA GENERAL MV/8000 INTERFACE TO COMPREHENSIVE PROGRAM.
C     IT KNOWS HOW TO FETCH THE DATE FROM THE SYSTEM.
C
      INTEGER IBLOCK(1)
      INTEGER IDATE(3)
C
C     ALLOCATE SPACE FOR TAPE OUTPUT
C
      INTEGER OBLOCK(0900)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCDGN/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
       NWCBO = 45
       WORKF  = 7
      TABS='Y'
c
c     this preset is needed so that the right open
c     sequence is done for the printr unit at the start.
      nchcmd=0
      equal=1
C
C       GET THE DATE INTO THE ARRAY TODAY(*).
      CALL DATE(IDATE)
      TODAY(1)=MOD(IDATE(1),100)/10
      TODAY(2)=MOD(MOD(IDATE(1),100),10)
      TODAY(3)=IDATE(2)/10
      TODAY(4)=MOD(IDATE(2),10)
      TODAY(5)=IDATE(3)/10
      TODAY(6)=MOD(IDATE(3),10)
      DO 10 I=1,6
10    TODAY(I)=TODAY(I)+48
C
C      THE FOLLOWING SITE INFO. IS FOR IMSL, INC. ONLY.
C
C
C      DO 20 I=1,40
C20    SITE(I)=32
C
C     DEFINE THE AUTO-SITE FOR IMSL, INC.
C     SITE(1)=73
C     SITE(2)=77
C     SITE(3)=83
C     SITE(4)=76
C     SITE(5)=44
C     SITE(7)=73
C     SITE(8)=110
C     SITE(9)=99
C     SITE(10)=46
C     SITE(13)=77
C     SITE(14)=86
C     SITE(15)=47
C     SITE(16)=56
C     SITE(17)=48
C     SITE(18)=48
C     SITE(19)=48
C     SITE(20)=44
C     SITE(22)=72
C     SITE(23)=111
C     SITE(24)=117
C     SITE(25)=115
C     SITE(26)=116
C     SITE(27)=111
C     SITE(28)=110
C     SITE(29)=44
C     SITE(31)=84
C     SITE(32)=88
C     SITE(34)=55
C     SITE(35)=55
C     SITE(36)=48
C     SITE(37)=51
C     SITE(38)=54
C     DEFINE THE COMMAND 'TABS='.
       NCOMDT=NCOMDP+1
       COMD(1,NCOMDT)=84
       COMD(2,NCOMDT)=65
       COMD(3,NCOMDT)=66
       COMD(4,NCOMDT)=83
       CALL EXCHTR (IBLOCK,OBLOCK)
       RETURN
       END
      SUBROUTINE EXCHAH (RECORD,NCHAR)
C
C     CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO
C     HOLLERITH FORMAT.
C     THIS VERSION FOR THE DATA GENERAL MV/8000.
C     R. J. HANSON, MAY, 1982.
C
      INTEGER RECORD(1),NCHAR
C
      DO 10 I = 1, NCHAR
10      RECORD(I)=IOR(ISHFT(RECORD(I),24),00202020K)
C
      RETURN
      END
      SUBROUTINE EXCHFO (IOP)
C
C     DATA GENERAL MV/8000.
C     THIS VERSION IS FOR THE COMPREHENSIVE PROGRAM ONLY.
C
C     OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM.
C     IOP LESS THAN    ZERO MEANS CLOSE FILE,
C     IOP GREATER THAN ZERO MEANS OPEN FILE.
C     IABS(IOP) = 1 MEANS READER,
C               = 2 MEANS PRINTER,
C               = 3 MEANS WORK FILE,
C               = 4 MEANS INFILE.  IOP = 4 IS USED ONLY BY THE
C                   BOOTSTRAP PROGRAM.
C
C
      character*11 pname
      character*40 name
      INTEGER IOP, JUMP
      logical OD
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      data pname/'tespxx.ls  '/
C
      JUMP=IABS(IOP)
      IF (IOP.LT.0) GO TO (10,20,30), JUMP
      GO TO (50,60,70), JUMP
C
C     CLOSE FILES.
10    GO TO 90
20    continue
      close(unit=printr)
      go to 90
30    CLOSE (UNIT=WORKF)
      GO TO 90
C
C     OPEN FILES.
50    GO TO 90
60    continue
      k=min0(nchcmd-equal+1,40)
      if(k.gt.0 .and. printr.ne.6) then
       name=' '
       do 65 I=1,k
       l=comand(equal+i-1)
       name(i:i)=char(l)
65     continue
      else if(printr.eq.6) then
      name='@console'
      else
C     ASSUME UNIT NUMBER IS NO MORE THAN 2 DIGITS.
      name=pname
      NAME(5:6)=CHAR(PRINTR/10+48)//CHAR(MOD(PRINTR,10)+48)
      end if
      inquire (file=name,number=inum,opened=od)
      if (.not.od .or. (inum.ne.printr))
     1open(unit=printr,file=name,status='UNKNOWN'err=100)
      go to 90
C
70    CONTINUE
      OPEN (UNIT=WORKF,STATUS='SCRATCH',ERR=120,
     * FORM='UNFORMATTED',RECFM='DYNAMIC')
C
90    RETURN
C
100   print 110
110   format (' Unable to open PRINTER.')
120   WRITE (PRINTR,130)
130   FORMAT (26H UNABLE TO OPEN WORK FILE.)
      STOP
      END
      SUBROUTINE EXCHFO (IOP)
C
C     VAX-11 USING VMS V2.4
C     THIS VERSION IS FOR THE SIMPLE PROGRAM ONLY.
C
C     OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM.
C     IOP LESS THAN    ZERO MEANS CLOSE FILE,
C     IOP GREATER THAN ZERO MEANS OPEN FILE.
C     IABS(IOP) = 1 MEANS READER,
C               = 2 MEANS PRINTER,
C               = 3 MEANS WORK FILE,
C               = 4 MEANS INFILE.  IOP = 4 IS USED ONLY BY THE
C                   BOOTSTRAP PROGRAM.
C
C
      INTEGER IOP, JUMP
      CHARACTER *11 PNAME
C
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
      JUMP=IABS(IOP)
      IF (IOP.LT.0) GO TO (10,20,30,40), JUMP
      GO TO (50,60,70,80), JUMP
C
C     CLOSE FILES.
10    GO TO 90
20    GO TO 90
30    CLOSE (UNIT=WORKF)
      GO TO 90
40    CLOSE (UNIT=INFILE)
      GO TO 90
C
C     OPEN FILES.
50    GO TO 90
60    GO TO 90
C
C     ASSUME UNIT NUMBER IS TWO DIGITS.
70    CONTINUE
      PNAME='EXCHXX.TMP '
      PNAME(5:6)=CHAR(WORKF/10+48)//CHAR(MOD(WORKF,10)+48)
      open (unit=workf,file=pname,status='NEW',err=100)
      GO TO 90
C
C     ASSUME UNIT NUMBER IS TWO DIGITS.
80    CONTINUE
      PNAME='EXCHXX.TMP '
      PNAME(5:6)=CHAR(INFILE/10+48)//CHAR(MOD(INFILE,10)+48)
      open (unit=infile,file=pname,status='UNKNOWN',err=120)
C
90    RETURN
C
100   WRITE (PRINTR,110)
110   FORMAT(' Unable to open work file.')
      STOP
120   WRITE (PRINTR,130)
130   FORMAT(' Unable to open INCLUDE file.')
      STOP
      END
C========================
C EXCHANGE PROGRAM, DATA GENERAL MV/8000 IMPLEMENTATION.
C
C READ A COMMAND OR TEXT IMAGE FROM    1. ALTERNATE CORRECTION FILE
C                                      2. TEXT FILE
C                                      3. INPUT FILE
C                                      4. SYSTEM READER
C IF READING FROM -READER-, PUT A PROMPT ON THE TERMINAL
C PUT THE HOLLERITH COMMAND IN HOLCMD
C PUT THE ASCII EQUIVALENT IN COMAND
C PUT THE NUMBER OF CHARACTERS IN NCHCMD
C IF END-OF-FILE IS SENSED, SET NCHCMD=-1
C IF THE VARIABLE -TABS- IS 'Y', KEEP THE TAB CHARACTERS
C
C ROUTINE READS 133 CHARACTER IMAGES
C========================
C
       SUBROUTINE EXCHIM
C
      INTEGER BLANK,BFILL,RDFILE
      INTEGER TMPLIN(133)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCDGN/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
       EQUIVALENCE (TMPLIN(1),COMAND(1))
       DATA BLANK/1H /
C
C    DETERMINE WHICH FILE TO WORK ON.
       RDFILE = INALT
       IF (RDFILE .GT. 0) GO TO 1000
       RDFILE = INTEXT
       IF (RDFILE .NE. 0) GO TO 1000
       RDFILE = INFILE
       IF (RDFILE .EQ. 0) RDFILE = READER
C
C   PERFORM ACTION.  FILES ARE OPENED IN EXCHCX.
1000   I = ACTION + 2
       GO TO (5000,4000,7000,2000),I
       RETURN
C
C   REWIND INALT
2000   REWIND RDFILE
       GO TO 7000
C
C   READ IN A LINE, MAPPING TABS IF NECESSARY
C
C      THE FOLLOWING TEST MUST BE CHANGED IF TTY IS OTHER THAN UNIT 5.
4000   IF (RDFILE .EQ. 5.and.printr.eq.6) WRITE (6     ,601)
      M=133
       READ (RDFILE,501,END=8000) (TMPLIN(I),I=1,M)
       NCHCMD=0
       DO 4090 I=1,M
           IF (TABS.EQ.'Y') GO TO  4070
           IF (IAND(ISHFT(TMPLIN(I),-24),177K) .NE. 9) GO TO 4070
C          9 IS ASCII HT (HORIZONTAL TAB).
           BFILL = 8 - MOD(NCHCMD,8)
           DO 4040 J=1,BFILL
               NCHCMD=NCHCMD+1
               HOLCMD(NCHCMD)=BLANK
4040           CONTINUE
           GO TO 4090
4070       NCHCMD=NCHCMD+1
           HOLCMD(NCHCMD)=TMPLIN(I)
4090       CONTINUE
       DO 4190 I=1,NCHCMD
      COMAND(I)=IAND(ISHFT(HOLCMD(I),-24),177K)
4190       CONTINUE
      m=nchcmd
      do 4200 i=1,m
      if(comand(m-i+1).eq.32) go to 4200
      nchcmd=m-i+1
      go to 7000
4200  continue
      nchcmd=0
       GO TO 7000
C
C   CLOSE A FILE.
C      DO NOT CLOSE INPUT FILES IF 'T' OPTION SPECIFIED.
5000   IF (OPTVAL(20).EQ.0) CLOSE (UNIT=RDFILE)
C
7000   ACTION = 0
       RETURN
C
8000   NCHCMD = -1
       GO TO 7000
501    FORMAT(133A1)
601    FORMAT($' *' $)
       END
      SUBROUTINE EXCHOU (OUTPUT)
C
C     NATIVE FORMAT OUTPUT PROGRAM. FOR THE TEXT EXCHANGE PROGRAM.
C     DATA GENERAL MV/8000 VERSION.
C
C     OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN.
C     THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT.
C
C     THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180),
C     THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179).  IF OUTPUT(180)
C     IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE.  IF OUTPUT(180)
C     IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW
C     IMAGE.
C
      INTEGER OUTPUT(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C   DECIDE WHETHER TO OPEN, CLOSE OR WRITE.
C
      IF (ACTION.NE.0) IF (ACTION+1) 70,40,70
      CALL EXCHAH(OUTPUT,NCHOUT)
      WRITE (OUFILE,30) (OUTPUT(I),I=1,NCHOUT)
30    FORMAT (133A1)
      GO TO 70
40    CLOSE(UNIT=OUFILE)
C
70    ACTION=0
      RETURN
      END
      SUBROUTINE EXCHPA (BUFIN,BUF9T)
C
C     CHARACTER PACKING ROUTINE FOR THE DATA GENERAL
C     MV/8000 SERIES MACHINES.
C     WRITTEN BY R. HANSON, MAY, 1982.
C
      INTEGER BUFIN(180),BUF9T(45)
      DO 20 I=1,45
         BUF9T(I)=0
         DO 10 J=1,4
            BUF9T(I)=IOR(BUF9T(I),ISHFT(BUFIN(4*I-4+J),32-8*J))
10          CONTINUE
20       CONTINUE
      RETURN
      END
      SUBROUTINE EXCHRT (ISTAT,INPBUF)
C
C     TAPE OR DISK INPUT FOR THE DATA GENERAL MV/8000 MACHINES.
C     NOTE -- INTEGER*4 IS ASSUMED DEFAULT.
C     WRITTEN BY R. HANSON, MAY, 1982.
C
C
C     INPUT PARAMETERS
C       ISTAT = 1  OPEN INPUT TAPE, NO REWIND
C             = 2  REWIND AND CLOSE INPUT TAPE
C             = 3  READ FROM TAPE INTO INPBUF(*)
C             = 4  CLOSE INPUT TAPE, NO REWIND
C       INPBUF -- THE BUFFER INTO WHICH THE DATA IS TO BE READ.
C
C     OUTPUT PARAMETERS
C       ISTAT = 0  IF NO ERRORS OCCURRED
C             = 3  IF ANY TYPE OF ERROR OCCURRED.
C                  (AN INFORMATIVE MESSAGE WILL USUALLY BE PRINTED)
C
      INTEGER ISTAT,INPBUF(1)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCDGN/ TABS,FNAMES
C
      IF ((ISTAT.LT.1) .OR. (ISTAT.GT.4)) GO TO 240
      GO TO (10,60,70,120), ISTAT
C
C     OPEN TAPE, NO REWIND
10    CONTINUE
      OPEN (UNIT=INTAPE,FILE=FNAMES(2),RECFM='DYNAMIC',
     *      FORM='UNFORMATTED',STATUS='OLD',IOINTENT='INPUT',
     * err=130,iostat=ierr,MODE='BINARY',BLOCKSIZE=3600)
      GO TO 230
C
C     REWIND AND CLOSE INPUT TAPE
60    CONTINUE
      REWIND (UNIT=INTAPE,ERR=150,IOSTAT=IERR)
      GO TO 230
C
C     READ INTO INPBUF
70    CONTINUE
      NCDBI=NDATAI+NERRCI+9
      nwords=(ncdbi+3)/4
C
      DO 110 I = 1, 2
C
C     READ A BUFFER FROM INTAPE INTO INPBUF.
      READ(INTAPE,ERR=100,END=100,IOSTAT=IERR) (INPBUF(J),J=1,NWORDS)

      GO TO 230
C
C     ALLOW ONE END-OF-FILE IF EXPECTING LABEL.
100   IF (IERR.EQ.(-1).AND.BLKSQI.NE.0) GO TO 170
      IF (IERR.GT.0) GO TO 175
110   CONTINUE
      GO TO 170
C
C     CLOSE INPUT TAPE WITH NO REWIND.
120   CONTINUE
      GO TO 230
C
C     PROCESS ERROR CONDITIONS
130   CONTINUE
      IF (IERR .NE.(-1)) GO TO 140
      WRITE (PRINTR,180)
      GO TO 240
140   CONTINUE
      WRITE (PRINTR,190) IERR
      GO TO 240
C
150   CONTINUE
      IF (IERR .NE.(-1)) GO TO 160
      WRITE (PRINTR,200)
      GO TO 240
160   CONTINUE
      WRITE (PRINTR,210) IERR
      GO TO 240
C
170   CONTINUE
      IF (IERR.EQ.(-1)) WRITE (PRINTR,220)
      GO TO 240
C
175   CONTINUE
      WRITE (PRINTR,225) IERR
      GO TO 240
C
180   FORMAT ('0Attempted open at end-of-file on INTAPE')
190   FORMAT ('0Error condition occurred while opening INTAPE, IOSTAT=',
     * Z8)
200   FORMAT ('0End-of-file on close/rewind of INTAPE')
210   FORMAT ('0Error condition occurred with close/rewind on INTAPE, IO
     *STAT=',Z8)
220   FORMAT ('0Unexpected end-of-file on INTAPE.')
225   FORMAT ('0Error condition occurred while reading INTAPE, IOSTAT=',
     * Z8)
C
230   CONTINUE
      ISTAT=0
      RETURN
240   CONTINUE
250   CONTINUE
      ISTAT=3
      RETURN
C
      END
      SUBROUTINE EXCHUN (BUF9T,BUFOUT)
C
C     CHARACTER UNPACKING ROUTINE FOR THE DATA GENERAL
C     MV/8000 SERIES MACHINES.
C     UNPACK THE CHARS. FROM BUF9T(*) TO BUFOUT(*).
C     WRITTEN BY R. HANSON, MAY, 1982.
C
      INTEGER BUF9T(45),BUFOUT(180)
      DATA MASK/377K/
      DO 20 I=1,45
         DO 10 J=1,4
            BUFOUT(4*I+1-J)=IAND(ISHFT(BUF9T(I),8-8*J),MASK)
10          CONTINUE
20       CONTINUE
      RETURN
      END
      SUBROUTINE EXCHWT(ISTAT,OUTBUF)
C
C     TAPE OR DISK OUTPUT ROUTINE FOR THE DATA GENERAL
C     MV/8000 SERIES MACHINES.
C     NOTE -- INTEGER*4 IS ASSUMED DEFAULT.
C
C     R. HANSON, MAY, 1982.
C
C     INPUT PARAMETERS
C       ISTAT = 1  OPEN OUTPUT TAPE, NO REWIND
C             = 2  WRITE CONTENTS OF OUTBUF(*) TO OUTPUT TAPE
C             = 3  CLOSE OUTPUT TAPE, NO REWIND
C       OUTBUF -- THE BUFFER FROM WHICH THE DATA IS TO BE WRITTEN
C
C     OUTPUT PARAMETERS
C       ISTAT = 0  IF NO ERRORS OCCURRED
C             = 3  IF ANY TYPE OF ERROR OCCURRED
C                  (AN INFORMATIVE MESSAGE WILL USUALLY BE PRINTED)
C
      INTEGER ISTAT,OUTBUF(1)
      INTEGER EXPSIZ
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      CHARACTER*1 TABS
      CHARACTER*40 FNAMES(3)
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCDGN/ TABS,FNAMES
C
      IF ((ISTAT.LT.1) .OR. (ISTAT.GT.3)) GO TO 150
      GO TO (10,50,80), ISTAT
C
C     OPEN OUTAPE, NO REWIND.
10    CONTINUE
      OPEN (UNIT=OUTAPE,FILE=FNAMES(3),RECFM='DYNAMIC',
     *      FORM='UNFORMATTED',STATUS='NEW',
     * err=100,iostat=ierr,MODE='BINARY',BLOCKSIZE=180)
      GO TO 90
C
C     WRITE CONTENTS OF OUTBUF(*) TO OUTAPE
50    CONTINUE
      EXPSIZ=CCDBO
      IF (BLKSQO.NE.0) EXPSIZ=NDATAO+NERRCO+9
      NWORDS=(EXPSIZ+3)/4
      WRITE (OUTAPE,ERR=135,IOSTAT=IERR) (OUTBUF(I),I=1,NWORDS)
      IF (BLKSQO.NE.0) GO TO 90
C
C     REOPEN OUTAPE WITH BLOCKSIZE=3600
C
      CLOSE (UNIT=OUTAPE,ERR=120)
      OPEN (UNIT=OUTAPE,FILE=FNAMES(3),RECFM='DYNAMIC',
     *      FORM='UNFORMATTED',STATUS='old',
     * err=100,iostat=ierr,MODE='BINARY',BLOCKSIZE=3600,POSITION='END')
      GO TO 90
C
C     CLOSE OUTAPE, NO REWIND.
80    CONTINUE
      CLOSE (UNIT=OUTAPE,ERR=120)
      GO TO 90
C
C     FUNCTION COMPLETED NORMALLY.
90    CONTINUE
      ISTAT=0
      RETURN
C
C     PROCESS ERROR CONDITIONS.
100   CONTINUE
      WRITE (PRINTR,110) IERR
110   FORMAT ('0Error condition occurred while opening OUTAPE, IOSTAT=',
     * Z8)
      GO TO 140
C
120   CONTINUE
      WRITE (PRINTR,130)
130   FORMAT ('0Error condition occurred while closing OUTAPE.')
C
135   CONTINUE
      WRITE (PRINTR,136) IERR
136   FORMAT('0Error condition occurred while writing OUTAPE, IOSTAT=',
     * Z8)
C
140   CONTINUE
150   CONTINUE
      ISTAT=3
      RETURN
      END
      SUBROUTINE EXCHSL
C
C     LOAD THE SEGMENT NECESSARY BEFORE THE COMPUTED GO TO ON TRANS.
C
C     EACH OF EXCHC1 THROUGH EXCHC9 SHOULD BE IN A SEPARATE
C     SEGMENT.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      RETURN
      END
      SUBROUTINE EXCHTR (IBLOCK,OBLOCK)
C
C     TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER.
C
      INTEGER IBLOCK(1), OBLOCK(1)
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     OPEN READER AND PRINTER, FLAG WORKF TO BE OPENED BY EXCHC4.
C
      CALL EXCHFO (1)
      CALL EXCHFO (2)
      WORKF=-IABS(WORKF)
C
10    IF (TRANS.LE.0) RETURN
      CALL EXCHSL
C     LOAD THE SEGMENT CONTAINING THE SUBROUTINE NEEDED FOR TRANS.
      GO TO (11,12,13,14,15,16,17,18,19), TRANS
C     COMMAND PARSER
11    CALL EXCHC1 (IBLOCK,OBLOCK)
      GO TO 10
C     IDENT, INDEX, OPTION, PREDICATE, SITE, TITLE
12    CALL EXCHC2
      GO TO 10
C     OPEN INTAPE AND OUTAPE FOR -N, COPY, NAME, SKIP, UPDATE.
13    CALL EXCHC3 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY AND SKIP COMMANDS, CONTROL RECORD UPDATE.
14    CALL EXCHC4 (IBLOCK)
      GO TO 10
C     COPY CONTROL RECORDS FROM INTAPE OR COMMAND TO OUTAPE.
15    CALL EXCHC5 (IBLOCK,OBLOCK)
      GO TO 10
C     COPY TEXT FROM INTAPE TO OUTAPE
16    CALL EXCHC6 (IBLOCK,OBLOCK)
      GO TO 10
C     TEXT COMMAND
17    CALL EXCHC7 (IBLOCK,OBLOCK)
      GO TO 10
C     ERROR MESSAGES
18    CALL EXCHC8
      GO TO 10
C     QUIT
19    CALL EXCHC9 (IBLOCK,OBLOCK)
      GO TO 10
      END
      SUBROUTINE EXCHGB (ISTAT,DBLOCK)
C
C     READ A BLOCK FROM THE EXCHANGE TAPE.
C     IGNORE THE ERROR CONTROL SEGMENT.
C     CHECK THE BLOCK SEQUENCE NUMBER.
C     CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER,
C               OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
C
C     READ A BLOCK FROM INTAPE.
C
      BLKSQI=BLKSQI+1
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 160
C
C     GET INFORMATION OUT OF THE BLOCK HEADER.
C
      CCDBI=NERRCI
      CWDBI=NWCBI*(CCDBI/NCCBI)+1
      CPCBI=MOD(CCDBI,NCCBI)
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
      DO 110 JUMP=1,9
      CCDBI=CCDBI+1
      CPCBI=CPCBI+1
      IF (CCDBI.GT.NCDBI) GO TO 130
      IF (CPCBI.LE.NCCBI) GO TO 10
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
10    GO TO (20,30,40,50,60,70,80,90,100), JUMP
20    NEWBLK=256*CBLCKI(CPCBI)
      GO TO 110
30    NEWBLK=NEWBLK+CBLCKI(CPCBI)
      GO TO 110
40    LASTI=CBLCKI(CPCBI)
      GO TO 110
50    L1PRGI=256*CBLCKI(CPCBI)
      GO TO 110
60    L1PRGI=L1PRGI+CBLCKI(CPCBI)
      GO TO 110
70    N1RECI=256*CBLCKI(CPCBI)
      GO TO 110
80    N1RECI=N1RECI+CBLCKI(CPCBI)
      GO TO 110
90    L1RECI=256*CBLCKI(CPCBI)
      GO TO 110
100   L1RECI=L1RECI+CBLCKI(CPCBI)
110   CONTINUE
C
C     CHECK THE BLOCK SEQUENCE NUMBER.
C
      IF (BLKSQI.EQ.NEWBLK) GO TO 150
      ISTAT=1
      WRITE (PRINTR,120) NEWBLK,BLKSQI
120   FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I
     15//)
      BLKSQI=NEWBLK
      GO TO 160
C
C     FORMAT ERROR
C
130   ISTAT=2
      GO TO 160
C
C     CHECK L1PRGI AND L1RECI.
C
150   IF (L1PRGI.GT.NCDBI) GO TO 130
      IF (L1RECI.GT.NCDBI) GO TO 130
      ISTAT=0
160   RETURN
C
      END
      SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD)
C
C     GET A RECORD FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK).
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE
C               SPACE ALLOWED BY THE USER.  (POSITION IS STILL OK).
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C     THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM
C     CONTROL RECORDS.  NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS.
C
      ISTAT=0
      NCHACT=0
10    JUMP=1
      GO TO 260
20    NG=CBLCKI(CPCBI)
      IF (NG.EQ.0) GO TO 90
      IF (NG.NE.255) GO TO 30
C
C     END OF SHORT TAPE BLOCK.
C
      CCDBI=NCDBI
      GO TO 10
C
C     UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO
C     THE USER RECORD AREA.
C
30    ITYPEI=0
      IF (MODEI.EQ.0) GO TO 40
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG
40    IG=0
50    JUMP=2
      GO TO 260
60    NR=CBLCKI(CPCBI)
      IF (MODEI.EQ.0) GO TO 70
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR
      GO TO 160
70    IR=0
C     PUT REMVI INTO THE USER RECORD NR TIMES.
80    IF (IR.GE.NR) GO TO 160
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI
      IR=IR+1
      GO TO 80
C
C     THE NEXT RECORD IS A CONTROL RECORD.  FIND OUT WHAT KIND.
C
90    JUMP=3
      GO TO 260
100   ITYPEI=CBLCKI(CPCBI)
      IF (ITYPEI.LT.65) GO TO 250
C     65 = ASCII  A
      IF (ITYPEI.GT.90) GO TO 250
C     90 = ASCII  Z
      I=ITYPEI-64
C             A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
      GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160
     1,110,160,220,160,160,160,160,160,160,160,160), I
C       P   Q   R   S   T   U   V   W   X   Y   Z
C
C     P - PROGRAM HEADER
C
C     CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER
110   REMVI=32
C     RESET THE REMOVED CHARACTER TO ASCII BLANK.
      JUMP=4
      GO TO 260
120   L1PRGI=256*CBLCKI(CPCBI)
      JUMP=5
      GO TO 260
130   L1PRGI=L1PRGI+CBLCKI(CPCBI)
      JUMP=6
      GO TO 260
140   N1RECI=256*CBLCKI(CPCBI)
      JUMP=7
      GO TO 260
150   N1RECI=N1RECI+CBLCKI(CPCBI)
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
160   JUMP=8
      GO TO 260
170   NC=CBLCKI(CPCBI)
      IF (ITYPEI.NE.0) GO TO 180
      IF (MODEI.EQ.0) GO TO 180
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC
C     COPY NC CHARACTERS TO THE USER RECORD AREA.
180   IC=0
      JUMP=9
190   IF (IC.GE.NC) IF (ITYPEI) 240,210,240
      GO TO 260
200   NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI)
      IC=IC+1
      GO TO 190
210   IG=IG+1
      IF (IG-NG) 50,240,240
C
C     J - UPDATING AND END OF INPUT TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
220   JUMP=10
      GO TO 260
230   RECORD(1)=CBLCKI(CPCBI)
      NCHACT=1
      IF (ITYPEI.EQ.82) REMVI=RECORD(1)
C     82 = ASCII R
C
C     RETURN TO THE USER PROGRAM.
C
240   IF (NCHACT.GT.NCHMAX) ISTAT=4
      GO TO 290
C
C     CONTROL RECORD TYPE CANNOT BE DETERMINED.
C
250   ISTAT=5
      GO TO 290
C
C     GET A CHARACTER FROM CBLOCK.  UNPACK A NEW BLOCK IF NECESSARY.
C     READ MORE TAPE IF NECESSARY.
C
260   CPCBI=CPCBI+1
      CCDBI=CCDBI+1
      IF (CCDBI.LE.NCDBI) GO TO 270
      CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 290,260,290
270   IF (CPCBI.LE.NCCBI) GO TO 280
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
280   GO TO (20,60,100,120,130,140,150,170,200,230), JUMP
290   RETURN
C
      END
      SUBROUTINE EXCHNP (ISTAT,DBLOCK)
C
C     SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE
C     TAPE.
C     THIS MODULE IS MACHINE INSENSITIVE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
      ISTAT=0
      IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20
C
C     CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK.
C
10    IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20
C     76 = ASCII L
C
C     NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK.
      CCDBI=L1PRGI-1
      I=NWCBI*(CCDBI/NCCBI)+1
      IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI)
      CWDBI=I
      CPCBI=MOD(CCDBI,NCCBI)
      GO TO 40
C
C     NO MORE HEADERS IN THIS BLOCK.
C
20    CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 40,10,40
C
C     END OF FILE.
C
30    ISTAT=7
C
40    RETURN
C
      END
      SUBROUTINE EXCHPB (ISTAT,DBLOCK)
C
C     WRITE A BLOCK ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C     WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK.
      INTEGER WORK(9)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
C     PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK.
C
      BLKSQO=BLKSQO+1
      WORK(1)=BLKSQO/256
      WORK(2)=MOD(BLKSQO,256)
      WORK(3)=LASTO
      WORK(4)=L1PRGO/256
      WORK(5)=MOD(L1PRGO,256)
      WORK(6)=N1RECO/256
      WORK(7)=MOD(N1RECO,256)
      WORK(8)=L1RECO/256
      WORK(9)=MOD(L1RECO,256)
C
      CPCBO=MOD(NERRCO,NCCBO)
      CWDBO=(NERRCO/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
C
      DO 10 I=1,9
      CPCBO=CPCBO+1
      IF (CPCBO.LE.NCCBO) GO TO 10
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
      CWDBO=CWDBO+NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
      CPCBO=1
10    CBLCKO(CPCBO)=WORK(I)
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
C
C     WRITE THE DATA BLOCK ON TAPE.
C
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L).
C
      IF (LASTO.NE.76) GO TO 20
      ISTAT=3
      CALL EXCHWT (ISTAT,DBLOCK)
      GO TO 30
C
C     COMPUTE POINTERS FOR NEXT BLOCK OUT.
C
20    L1PRGO=0
      LLPRGO=0
      N1RECO=0
      L1RECO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
C
30    RETURN
C
      END
      SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD)
C
C     WRITE A RECORD ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A
C             TEXT RECORD CONTAINS MORE THAN 254 GROUPS.
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER GC,RC(255),CC(255)
C     GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      ISTAT=0
      INCHAR=0
C
C     DETERMINE THE RECORD TYPE.
C
      IF (NCHOUT.NE.255) GO TO 10
      ITYPEO=255
      GO TO 70
10    IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO
      IF (ITYPEO.NE.0) GO TO 30
C
C     DATA RECORD.
C
      IF (MODEO.NE.0) GO TO 170
C     COMPRESS THE RECORD.
      CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255)
      IF (GC.GE.255) GO TO 210
      IG=0
C     OUTPUT THE GROUP COUNT.
      CBLCKO(CPCBO)=GC
      JUMP=1
      GO TO 230
20    IG=IG+1
      IF (IG.GT.GC) GO TO 250
      NC=CC(IG)
      INCHAR=INCHAR+RC(IG)
C     OUTPUT REMOVED CHARACTER COUNT.
      CBLCKO(CPCBO)=RC(IG)
      JUMP=2
      GO TO 230
C
C     THE USER SAYS HE HAS A CONTROL RECORD TO WRITE.  FIND OUT
C     WHAT KIND.
C
30    IF (ITYPEO.LT.65) GO TO 220
C     65 = ASCII A
      IF (ITYPEO.GT.90) GO TO 220
C     90 = ASCII  Z
      I=ITYPEO-64
C             A  B  C  D  E  F  G  H  I  J   K  L  M  N  O  P  Q  R   S
      GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40,
     140,40,40,40,40,40,40), I
C      T  U  V  W  X  Y  Z
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE TYPE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
40    IF (NCHOUT-255) 100,100,210
C
C     END OF FILE.
C
50    IF (NERRCO+NDATAO+7-CCDBO) 70,80,80
C
C     P - PROGRAM HEADER.
C
60    IF (NCHOUT.GT.255) GO TO 210
      REMVO=32
C     RESET REMOVED CHARACTER TO ASCII BLANK.
      IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80
      IF (CCDBO.EQ.NERRCO+10) GO TO 80
C
C     END OF SHORT TAPE BLOCK.
C
70    CBLCKO(CPCBO)=255
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250
C     69 = ASCII E
C     80 = ASCII P
      L1RECO=CCDBO-NERRCO
80    IF (LLPRGO.EQ.0) GO TO 90
C     LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK.
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      NC=MOD(LLPRGO+1,NCCBO)
      NW=((LLPRGO+1)/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      CBLCKO(NC+1)=CCDBO/256
      IF (NC+1.LT.NCCBO) GO TO 85
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      NW=NW+NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      NC=-1
85    CBLCKO(NC+2)=MOD(CCDBO,256)
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      CALL EXCHUN (DBLOCK(CWDBO),CBLCKO)
C     UPDATE TABLE OF CONTENTS POINTERS
90    LLPRGO=CCDBO
      IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO
      NLRECO=NLRECO+1
      IF (N1RECO.EQ.0) N1RECO=NLRECO
100   CBLCKO(CPCBO)=0
      JUMP=3
      GO TO 230
110   CBLCKO(CPCBO)=ITYPEO
      JUMP=4
      GO TO 230
120   IF (ITYPEO.NE.69) GO TO 130
C     69 = ASCII E
      LASTO=76
      GO TO 70
130   IF (ITYPEO.NE.80) GO TO 170
C     80 = ASCII P
      CBLCKO(CPCBO)=0
      JUMP=5
      GO TO 230
140   CBLCKO(CPCBO)=0
      JUMP=6
      GO TO 230
150   CBLCKO(CPCBO)=NLRECO/256
      JUMP=7
      GO TO 230
160   CBLCKO(CPCBO)=MOD(NLRECO,256)
      JUMP=8
      GO TO 230
C
170   NC=NCHOUT
180   CBLCKO(CPCBO)=NC
      IC=0
      JUMP=9
C     PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD.
      IF (ITYPEO.EQ.82) GO TO 190
      IF (ITYPEO.EQ.74) GO TO 190
      IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230
190   IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250
      INCHAR=INCHAR+1
      IC=IC+1
      CBLCKO(CPCBO)=RECORD(INCHAR)
      GO TO 230
C
C     J - UPDATING AND END OF TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
200   NCHOUT=1
      IF (ITYPEO.EQ.82) REMVO=RECORD(1)
C     82 = ASCII R
      GO TO 100
C
C     RECORD TOO LONG.
C
210   ISTAT=4
      GO TO 250
C
C     UNKNOWN CONTROL RECORD TYPE.
C
220   ISTAT=5
      GO TO 250
C
C     INCREMENT THE OUTPUT BUFFER POINTERS.  PACK A CHARACTER BLOCK
C     IF NECESSARY.  WRITE A TAPE BLOCK IF NECESSARY.
C
230   CPCBO=CPCBO+1
      CCDBO=CCDBO+1
      IF (CPCBO.LE.NCCBO) GO TO 240
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CWDBO=CWDBO+NWCBO
      CPCBO=1
      IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 250
240   GO TO (20,180,110,120,140,150,160,170,190), JUMP
250   RETURN
C
      END
      SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL)
C
C     SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE
C     DATA TO BE REMOVED.  DIVIDE DATA INTO GROUPS CONSISTING OF
C     STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT
C     DATA.  THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE
C     REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP
C     ARE RECORDED IN RC() AND SC() RESPECTIVELY.  MAXSL IS THE
C     MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC().
C
      INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL
C
C     RC AND SC MUST BE AT LEAST (IMGLEN-1)//3.
C
      GC=1
      SC(1)=0
      RC(1)=0
      MODE=-1
      INPLEN=IABS(IMGLEN)
C
C     IDENTIFY DATA GROUPS.
C
      DO 110 I=1,INPLEN
      IF (MODE) 40,60,90
C
C     MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE.
C
40    IF (INPIMG(I).EQ.REMOVE) GO TO 50
C     SWITCH TO SIGNIFICANT DATA SCAN.
      MODE=1
      SC(GC)=1
      GO TO 110
C     CONTINUE REMOVE SCAN
50    RC(GC)=RC(GC)+1
      IF (RC(GC)-MAXSL) 110,95,110
C
C     MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY
C     ONE OCCURRENCE OF REMOVE.  CHANGE TO REMOVE MODE IF ANOTHER REMOVE
C     OCCURS OR BACK TO DATA MODE IF NOT.
C
60    IF (INPIMG(I).EQ.REMOVE) GO TO 80
C     SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT.
      MODE=1
      IF (SC(GC).GE.MAXSL-2) GO TO 70
      SC(GC)=SC(GC)+2
      GO TO 110
C     FULL GROUP
70    GC=GC+1
      RC(GC)=1
      SC(GC)=1
      GO TO 110
C     SWITCH TO REMOVE MODE.
80    GC=GC+1
      SC(GC)=0
      RC(GC)=2
      MODE=-1
      GO TO 110
C
C     MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA.
C
90    IF (INPIMG(I).EQ.REMOVE) GO TO 100
      SC(GC)=SC(GC)+1
      IF (SC(GC).NE.MAXSL) GO TO 110
C     FULL GROUP
      MODE=-1
95    IF (I.GE.INPLEN) GO TO 120
      GC=GC+1
      RC(GC)=0
      SC(GC)=0
      GO TO 110
100   MODE=0
110   CONTINUE
120   RETURN
C
      END
      SUBROUTINE EXCHTP (RECORD,LINEI)
C
C     MATERIALIZE INCLUDES IF INALT IS NON-ZERO.
C     CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE
C     AND THE PRINTER IF LISTING IS REQUESTED.
C     LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C
      INTEGER RECORD(1),LINEI
C
C     *****     LOCAL VARIABLES     ************************************
C
C COPY    DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR
C         SKIPPING TEXT NOT TO BE INCLUDED.
      INTEGER COPY
C DASH    CONTAINS '-' IN HOLLERITH.
      INTEGER DASH
C ENDMRK  HOLDS THE END SENTINEL.
      INTEGER ENDMRK(40)
C NCHEND  IS THE NUMBER OF CHARACTERS IN ENDMRK.
      INTEGER NCHEND
C NCHSAV  SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD.
      INTEGER NCHSAV
C NCHTAR  IS THE NUMBER OF CHARACTERS IN TARGET.
      INTEGER NCHTAR
C STAR    CONTAINS '*' IN HOLLERITH.
       INTEGER STAR
C TARGET  IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY).
      INTEGER TARGET(40)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL DATA     ***************************************
C
      DATA DASH /1H-/, STAR /1H*/
C
C     *****     PROCEDURES     *****************************************
C
      LINEO=LINEO+1
      IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190
      RECORD(180)=LINEO
      RECORD(179)=LINEI
      COPY=-1
C     COPY=-1 MEANS NOT COPYING INCLUDED TEXT.
      IF (ITYPEO.EQ.0) GO TO 110
C     PROCESS INCLUDE RECORD.
      DO 10 I=1,NCHOUT
10    RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I)
C     INSERT '-I '.
      RECORD(1)=45
      RECORD(2)=73
      RECORD(3)=32
      NCHOUT=NCHOUT+3
      IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110
C     STORE SEARCH TARGET
      NCHTAR=MIN0(NCHOUT,40)
      DO 20 I=1,NCHTAR
20    TARGET(I)=RECORD(I)
C     STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
      NCHSAV=NCHCMD
      DO 30 I=1,NUMBER
30    OUTREC(I)=COMAND(I)
      COPY=0
C     COPY=0 MEANS SKIPPING MODULE ON INALT FILE.
      INALT=IABS(INALT)
      NEOF=0
40    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
      IF (NCHCMD.LT.2) GO TO 40
      IF (COMAND(1).NE.45) GO TO 40
C     45 = ASCII -
      IF (COMAND(2).EQ.45) GO TO 130
      IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40
C     73 = ASCII I, 105 = ASCII LOWER CASE I.
C     COMPARE IMAGE WITH SEARCH TARGET.
      IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60
      DO 50 I=2,NCHTAR
      K=COMAND(I)
      IF (K.GT.96 .AND. K.LT.123) K=K-32
      IF (TARGET(I).NE.K) GO TO 60
50    CONTINUE
      NEOF=3
C     PREVENT SEARCH LOOP.
      COPY=1
C     COPY=1 MEANS COPYING INCLUDED TEXT.
60    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     STORE END OF INCLUDE MODULE SIGNAL.
      NCHEND=MIN0(40,NCHCMD)
      DO 70 I=1,NCHEND
70    ENDMRK(I)=COMAND(I)
      IF (COPY.EQ.0) GO TO 80
      CHAR1L=DASH
      NCHOUT=NCHTAR
      DO 75 I = 1,NCHOUT
75    COMAND(I)=TARGET(I)
      COMAND(180)=LINEO
      COMAND(179)=LINEI
C     GO PRINT TARGET.
      CALL EXCHTW (COMAND,-1)
      GO TO 120
C     COPY OR SKIP UNTIL ENDMRK SEEN AGAIN.
80    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF.
C     TEST FOR ENDMRK
      DO 90 I=1,NCHEND
      IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100
90    CONTINUE
      IF (COPY) 140,40,140
C     OUTPUT TEXT RECORD.
100   COMAND(180)=LINEO
      COMAND(179)=LINEI
      NCHOUT=NCHCMD
      CALL EXCHTW (COMAND,OPTI)
      GO TO 120
C     OUTPUT TEXT RECORD.
110   CALL EXCHTW (RECORD,1)
120   IF (COPY) 190,190,80
C     WE ONLY GET HERE WITH COPY .GE. 0.
130   NEOF=NEOF+1
      ACTION=2
C     ACTION = 2 MEANS REOPEN INALT.
      CALL EXCHIM
      IF (NEOF.LT.2) GO TO 40
140   INALT=-IABS(INALT)
      NCHCMD=1
      IF (COPY.GT.0) GO TO 170
C     PROCESS TARGET AS THOUGH IT WERE TEXT.
      NCHOUT=NCHTAR
C     SAVE TARGET FOR ERROR MESSAGE.
      DO 150 I=1,NCHTAR
150   COMAND(I)=TARGET(I)
      CALL EXCHTW (COMAND,1)
      CALL EXCHAH (TARGET,NCHTAR)
      WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR)
160   FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8
     10A1))
      NERRS=MAX0(NERRS,3)
C
C     RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
C
170   NCHCMD=NCHSAV
      DO 180 I=1,NUMBER
180   COMAND(I)=OUTREC(I)
C
190   CHAR1L=STAR
      RETURN
C
      END
      SUBROUTINE EXCHTW (RECORD,OPTION)
C
C     WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING
C     EXCHOU.  WRITE RECORD ON THE PRINTER IF LISTING REQUESTED.
C     RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C     IF OPTION = ZERO, WRITE TO FILE ONLY.
C     IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING.
C     IF OPTION .LT. ZERO, WRITE TO LISTING ONLY.
C
      INTEGER RECORD(1),OPTION
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     PROCEDURES     *****************************************
C
      LINEI=RECORD(179)
      IF (OPTION.LT.0) GO TO 130
C
C     INSERT IDENTIFICATION IF REQUESTED.
C
      IF (IDCOL2.LT.IDCOL1) GO TO 120
      IF (IDTXTL+IDSTEP.EQ.0) GO TO 120
      IF (NCHOUT.GE.IDCOL2) GO TO 20
      J=IDCOL2-1
C     FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2
      DO 10 I=NCHOUT,J
10    RECORD(I+1)=32
C     32 = ASCII BLANK.
20    NCHOUT=MAX0(NCHOUT,IDCOL2)
      N=-1
      IF (LINEI.EQ.0) GO TO 40
      IF (IDOPTN.NE.73) GO TO 40
C     73 = ASCII I.  IDENTIFY ONLY FROM INTAPE.
      N=(LINEI-1)*IDSTEP+IDSTRT
      GO TO 70
40    IF (IDOPTN.NE.79) GO TO 50
C     79 = ASCII O.  IDENTIFY ONLY TO OUTAPE.
      N=(LINEO-1)*IDSTEP+IDSTRT
      GO TO 70
50    IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70
C     67 = ASCII C, 70 = ASCII F.  IDENTIFY EVERYTHING.
      N=IDCUR
70    IF (N.LT.0) GO TO 120
      IF (IDTXTL.EQ.0) GO TO 100
      J=MIN0(IDCOL2,IDTXTL+IDCOL1-1)
      K=1
      DO 80 I=IDCOL1,J
      RECORD(I)=IDTEXT(K)
80    K=K+1
100   IF (IDSTEP.EQ.0) GO TO 120
      IDCUR=IDCUR+IDSTEP
      K=IDCOL2
110   RECORD(K)=MOD(N,10)+48
      N=N/10
      K=K-1
      IF (N.EQ.0) GO TO 120
      IF (K.GE.IDCOL1) GO TO 110
C
C     OUTPUT RECORD.
C
120   IF (OUFILE.NE.0) CALL EXCHOU (RECORD)
      IF (OPTION.EQ.0) GO TO 220
130   IF (OPTL.NE.0) GO TO 140
      IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220
140   CALL EXCHAH (RECORD,NCHOUT)
      IF (OPTV+VERT.NE.0) GO TO 200
      IF (PHASE.NE.8) GO TO 180
      IF (LINEI.EQ.0) GO TO 160
      WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
150   FORMAT (1X,2I5,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
160   WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
170   FORMAT (5H  NEW,I6,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
180   WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
190   FORMAT (1X,I5,A1,3X,110A1/(6H  CONT,4X,110A1))
      GO TO 220
200   WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT)
210   FORMAT (132A1)
220   RETURN
C
      END
      SUBROUTINE EXCHC1 (IBLOCK,OBLOCK)
C
C     COMMAND DECODER AND FORMAT VERIFIER.  SOME COMMANDS ARE ALSO
C     COMPLETELY PROCESSED HERE.
C
C     IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS.
C
      INTEGER IBLOCK(1),OBLOCK(1)
C
C
C     *****     LOCAL VARIABLES     ************************************
C
C ALLOW   TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED.  VALUES ARE
C         SUMS OF PERMITTED VALUES OF PHASE.
C         1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING,
C         8 = UPDATING.
C         ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A
C         PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR
C         MAY BE VOID (EQUAL SIGN IS LAST CHARACTER).
C         32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT.
      INTEGER ALLOW(35)
C BLANK   A CONSTANT.  1H .
      INTEGER BLANK
C DATE    IS THE DATE FROM UPDA=, DATE=, ORIG=.
      INTEGER DATE(3)
C DAYS    TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS.
      INTEGER DAYS(12)
C I       IS USED FREELY AS AN INDEX.
C J       IS USED FREELY AS AN INDEX.
C JUMP    USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE.
C K       IS USED FREELY AS AN INDEX.
C KDATE   IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD).
C KQUIT   IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD).
C KTEXT   IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD).
C N       IS USED FREELY AS AN INDEX.
C NCNREC  IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS.
C ND      IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER.
C NM      IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER.
C NY      IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER.
C TVAL    A VECTOR OF VALUES FOR TRANS.  INDEXED BY ICOMD.
      INTEGER TVAL(35)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL EQUIVALENCE     **********************************
C
      EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND)
C
C     *****     DATA STATEMENTS     ************************************
C
      DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/
      DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/
      DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/
      DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/
      DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/
      DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/
      DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/
      DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/
      DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/
      DATA BLANK /1H /
      DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/
      DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/
      DATA DAYS(11),DAYS(12) /30,31/
      DATA KDATE /5/
      DATA KQUIT /20/
      DATA KTEXT /27/
      DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/
      DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/
      DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/
      DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/
      DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/
      DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/
      DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/
C
C     *****     PROCEDURES     *****************************************
C
C     GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER.
C     ECHO IT IF THE E OPTION IS SET.  DETERMINE WHETHER IT IS A CHANGE
C     TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND.
C
10    NCNREC=0
20    ACTION=0
      IF (NCHCMD.LT.0) GO TO 220
      CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (OPTE.EQ.0) GO TO 27
      WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD)
23    FORMAT (1X,80A1)
      CHAR1L=0
27    NCHCMD=MIN0(NCHCMD,MARGIN)
      IF (PHASE.LT.4) SIGNAL=45
C     45 = ASCII -
      IF (COMAND(1).NE.45) GO TO 50
C     45 = ASCII -.  REQUEST TO CHANGE CONTROL RECORD.
      IF (PHASE.LT.4) GO TO 40
      WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD)
30    FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT
     1OR UPDATE/1X,80A1)
      NERRG=MAX0(NERRG,2)
      GO TO 200
40    ICOMD=0
      EQUAL=2
      TRANS=3
      GO TO 370
50    IF (COMAND(1).NE.42) GO TO 70
C     42 = ASCII *.  COMMENT RECORD.  JUST ECHO IT.
      NCHCMD=MAX0(NCHCMD,2)
      WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD)
60    FORMAT (A1,1H*,78A1/(1X,80A1))
      GO TO 10
C
C     SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR
C     EQUAL SIGN ARE FOUND.  LOOK UP THE WORD IN THE COMMAND NAME TABLE.
C
70    EQUAL=0
      DO 80 I=1,NCHCMD
      IF (COMAND(I).EQ.32) GO TO 80
C     32 = ASCII BLANK
      EQUAL=EQUAL+1
      ICOMD=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32
C     ABOVE STATEMENT CONVERTS TO UPPER CASE.
      COMAND(I)=32
      COMAND(EQUAL)=ICOMD
      IF (EQUAL.GE.4) GO TO 90
      IF (ICOMD.EQ.61) GO TO 90
C     61 = ASCII =.
      IF (ICOMD.EQ.44) GO TO 90
C     44 = ASCII ,.
80    CONTINUE
      IF (EQUAL.EQ.0) GO TO 185
90    DO 110 ICOMD=1,NCOMDT
      DO 100 K=1,EQUAL
      IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110
100   CONTINUE
      IF (EQUAL.EQ.4) GO TO 130
      IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130
C     32 = ASCII BLANK.
110   CONTINUE
C
C     UNRECOGNIZED COMMAND.
C
120   ICOMD=0
C
C     LOOK FOR AN EQUAL SIGN.  SET THE VARIABLE NAMED EQUAL TO ZERO IF
C     THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK
C     CHARACTER FOLLOWING THE EQUAL SIGN.
C
130   MODIFY=0
140   DO 150 I=EQUAL,NCHCMD
      K=COMAND(I)
      IF (K.EQ.61) GO TO 160
C     61 = ASCII =.
      IF (MODIFY.NE.0) GO TO 150
C     USE FIRST MODIFIER.
      IF (K.EQ.44) GO TO 160
C     44 = ASCII ,.
150   CONTINUE
      EQUAL=0
      GO TO 170
160   I=I+1
      EQUAL=I
      IF (I.GT.NCHCMD) GO TO 170
      IF (COMAND(I).EQ.32) GO TO 160
C     32 = ASCII BLANK
      IF (K.NE.44) GO TO 170
C     44 = ASCII ,.
      MODIFY=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32
C     CONVERT TO UPPER CASE.
      GO TO 140
170   IF (K.NE.61) EQUAL=0
C     61 = ASCII =.
      IF (ICOMD.EQ.0) GO TO 180
      IF (ICOMD.GT.NCOMDP) GO TO 180
      IF (EQUAL.GT.NCHCMD) GO TO 175
      IF (EQUAL.NE.0) GO TO 230
      IF (ALLOW(ICOMD)/64.NE.0) GO TO 230
175   IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690
C     PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK.
      NCHCMD=NCHCMD+1
      EQUAL=NCHCMD
      COMAND(NCHCMD)=32
C     32 = ASCII BLANK
      HOLCMD(NCHCMD)=BLANK
      GO TO 230
C
C     GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX.
C
180   CALL EXCHCX (0)
C     IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND.
      IF (ICOMD.NE.0) GO TO 730
185   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1))
      NERRG=MAX0(NERRG,5)
200   CHAR1L=0
      NCNREC=NCNREC+1
      IF (NCNREC.LE.20) GO TO 20
      WRITE (PRINTR,210)
210   FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU
     1MES TEXT COMMAND IS MISSING.)
      GO TO 270
C
C     END OF FILE - SIMULATE A QUIT COMMAND.
C
220   ICOMD=KQUIT
C
C     RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME.
C
230   IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240
      TRANS=TVAL(ICOMD)
C             1   2   3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300
     1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7
     230,370,730,370), ICOMD
C       16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
C     32  33  34  35
C
C     THE COMMAND IS NOT ALLOWED AT THIS TIME.
C
240   WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE
     1D./1X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
C     DECIDE WHETHER TO SKIP TEXT
260   IF (ICOMD.NE.KTEXT) GO TO 10
      IF (EQUAL.NE.0) GO TO 10
270   WRITE (PRINTR,280)
280   FORMAT (//15H0SKIPPING TEXT.)
290   CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (NCHCMD.LT.2) GO TO 290
      IF (COMAND(1).NE.SIGNAL) GO TO 290
      IF (COMAND(2).EQ.SIGNAL) GO TO 10
      IF (NCHCMD.LT.3) GO TO 290
      IF (COMAND(2).NE.61) GO TO 290
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 290
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING.
C     DATE=YYMMDD
C     ORIGIN=YYMMDD SITE
C     UPDATE=YYMMDD SITE
C     IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE
C     THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED.
C
300   IF (EQUAL+5.GT.NCHCMD) GO TO 700
      I=EQUAL
      DO 310 J=1,3
      DATE(J)=0
      DO 310 K=1,2
      N=COMAND(I)-48
      IF (N.LT.0) GO TO 320
      IF (N.GT.9) GO TO 320
      DATE(J)=10*DATE(J)+N
310   I=I+1
      IF (NM.EQ.0) GO TO 320
      IF (NM.GT.12) GO TO 320
      IF (ND.LE.0) GO TO 320
      DAYS(2)=28
      IF (MOD(NY,4).EQ.0) DAYS(2)=29
      IF (NY.EQ.0) DAYS(2)=28
      IF (ND.LE.DAYS(NM)) GO TO 440
320   IF (ICOMD.EQ.KDATE) GO TO 700
      IF (TODAY(1).EQ.32) GO TO 700
      I=MIN0(NCHCMD+6,180)
      NCHCMD=I
      J=I-6
      IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1
C     32 = ASCII BLANK
      IF (J.LT.EQUAL) GO TO 700
330   COMAND(I)=COMAND(J)
      HOLCMD(I)=HOLCMD(J)
      J=J-1
      I=I-1
      IF (J.GE.EQUAL) GO TO 330
      DO 340 I=1,6
      COMAND(I+EQUAL-1)=TODAY(I)
340   HOLCMD(I+EQUAL-1)=TODAY(I)
      CALL EXCHAH (HOLCMD(EQUAL),6)
      WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD)
345   FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1))
      NERRG=MAX0(NERRG,1)
      GO TO 440
C
C     REWIND INTAPE
C
350   IF (INTAPE.EQ.0) GO TO 680
      IF (INTOPN.NE.0) GO TO 360
      I=1
C     OPEN INTAPE IF NOT ALREADY OPEN.  DO NOT CHECK EXCH LABEL.
      CALL EXCHRT (I,IBLOCK)
C     IGNORE STATUS
360   I=2
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
      GO TO 725
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH
C     BEGINS WITH A NUMBER FOLLOWED BY A BLANK.
C
C     INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     INTAPE = NUMBER SYSTEM DEPENDENT DATA
C     LIMIT = NUMBER
C     MARGIN = NUMBER
C     OUTAPE = NUMBER SYSTEM DEPENDENT DATA
C     OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     PRINTER = NUMBER
C     READER = NUMBER
C     SKIP = NUMBER
C     TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL)
C     WORK = NUMBER
C
370   NUMBER=0
      IF (EQUAL.EQ.0) GO TO 440
      DO 410 J=EQUAL,NCHCMD
      IF (COMAND(J).EQ.32) GO TO 420
C     32 = ASCII BLANK
      N=COMAND(J)-48
C     48 = ASCII ZERO
      IF (N.GE.0) GO TO 400
380   WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD)
390   FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS.  NOT PROCESSED./
     11X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
      GO TO 260
400   IF (N.GT.9) GO TO 380
410   NUMBER=10*NUMBER+N
      EQUAL=NCHCMD+1
      GO TO 440
420   EQUAL=J
430   EQUAL=EQUAL+1
      IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440
C     32 = ASCII BLANK
C
C     PRELIMINARY FORMAT CHECKING IS COMPLETE
C
440   J=ICOMD+1
C             0  1   2  3  4  5   6  7  8   9  10 11  12 13 14  15  16
      GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6
     120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595),
     2J
C     17 18  19 20  21 22 23 24 25  26  27 28  29  30 31 32  33 34  35
C
C     DATE=YYMMDD
C
450   DO 460 I=1,6
460   TODAY(I)=COMAND(EQUAL+I-1)
      GO TO 10
C
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA.
C
470   I=INFILE
      J=1
      GO TO 500
C
C     INCLUDE = NUMBER SYSTEM DEPENDENT DATA.
C
480   I=INALT
      J=3
      INALT=IABS(INALT)
      GO TO 500
C
C     TEXT
C
490   I=INTEXT
      J=2
      IF (EQUAL.EQ.0) GO TO 560
C
C     OPEN AN INPUT FILE.
C
500   IF (NUMBER.EQ.0) GO TO 505
      IF (NUMBER.EQ.OUFILE) GO TO 710
      IF (NUMBER.EQ.OUTAPE) GO TO 710
505   IF (J.EQ.2) GO TO 510
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (I.NE.0) CALL EXCHIM
510   IF (J-2) 520,530,540
520   INFILE=NUMBER
      GO TO 550
530   INTEXT=NUMBER
      GO TO 550
540   INALT=NUMBER
550   IF (NUMBER.EQ.0) GO TO 560
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      CALL EXCHCX (J+1)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHIM
      ACTION=2
C     ACTION = 2 MEANS REWIND
      IF (J.EQ.3) CALL EXCHIM
      INALT=-IABS(INALT)
560   ACTION=0
C     ACTION = 0 MEANS READ TEXT
      GO TO 730
C
C     INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
570   IF (INTOPN.EQ.0) GO TO 580
C     CLOSE THE INPUT TAPE, IGNORE STATUS.
      I=4
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
580   INTAPE=NUMBER
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (INTAPE.NE.0) CALL EXCHCX (6)
      GO TO 725
C
C     LIMIT = NUMBER
C
590   LIMIT=NUMBER
      GO TO 10
C
C     MARGIN = NUMBER
C
C     MINIMUM MARGIN IS 60
595   MARGIN=MAX0(NUMBER,60)
      GO TO 10
C
C     OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
600   IF (OUTOPN.EQ.0) GO TO 610
C     WRITE AND END-OF-FILE MARK ON OUTAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (I,OBLOCK,OBLOCK)
C     IGNORE STATUS
      OUTOPN=0
      PHASE=1
610   OUTAPE=NUMBER
      OUTUPD=MODIFY
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (OUTAPE.NE.0) CALL EXCHCX (7)
      GO TO 730
C
C     OUTPUT =  NUMBER SYSTEM DEPENDENT INFORMATION
C
620   ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      OUFILE=NUMBER
      IDCUR=IDSTRT
      IF (OUFILE.EQ.0) GO TO 730
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND.
      CALL EXCHCX (5)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHOU (OUTREC)
      GO TO 730
C
C     PRINTER = NUMBER.
C
630   CALL EXCHFO (-2)
      PRINTR=NUMBER
      CALL EXCHFO (2)
      GO TO 10
C
C     READER = NUMBER.
C
640   IF (INFILE.NE.0) GO TO 670
      CALL EXCHFO (-1)
      READER=NUMBER
      CALL EXCHCX (1)
      CALL EXCHFO (1)
      GO TO 10
C
C     WORK = NUMBER
C
650   IF (WORKF.GT.0) CALL EXCHFO (-3)
      WORKF=NUMBER
C     WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4.
      GO TO 10
C
C     UPDATE
C
C     DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR
C     SIMPLY TO OUTPUT THE UPDATE COMMAND.
660   IF (PHASE.GE.4) TRANS=5
      GO TO 730
C
C     ERROR MESSAGES.
C
670   NUMBER=3
C     MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE.
      GO TO 720
680   NUMBER=4
C     MESSAGE 4 - INTAPE IS NOT DEFINED.
      GO TO 720
690   NUMBER=12
C     MESSAGE 12 - NO PARAMETER STRING.
      GO TO 720
700   NUMBER=13
C     MESSAGE 13 - IMPROPER DATE.
      GO TO 720
710   NUMBER=31
C     MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT.
C
C     RETURN TO ERROR MESSAGE SEGMENT.
C
720   TRANS=8
      GO TO 740
c
c     Indicate the WORK file is empty.
c
725   if (nrwork.le.0 .or. workf.le.0) go to 730
      REWIND WORKF
      NRWORK=0
C
C     IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP.
C
730   IF (TRANS.EQ.1) GO TO 10
740   RETURN
C
      END
      SUBROUTINE EXCHCX (REASON)
C
C========================
C
C     PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER
C     PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT,
C     INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS.
C     DATA GENERAL MV/8000 VERSION.
C
C     RECOGNIZE THE TABS COMMAND.
C     TABS=D OR Y MEANS HT IS DATA, TABS=N OR T MEANS HT IS TAB.
C
      INTEGER REASON
C
C     REASON=0 FOR UNRECOGNIZED COMMAND.
C     REASON=1 BEFORE OPENING READER.
C     REASON=2 BEFORE OPENING INFILE (=INPUT FILE).
C     REASON=3 BEFORE OPENING INTEXT (=TEXT FILE).
C     REASON=4 BEFORE OPENING INALT  (=INCLUDE FILE).
C     REASON=5 BEFORE OPENING OUFILE (=OUTPUT FILE).
C     REASON=6 BEFORE OPENING INTAPE.
C     REASON=7 BEFORE OPENING OUTAPE.
C
C
C========================
C
      LOGICAL THERE
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
C
      character*1  tabs
      character*40 fnames(3)
      character*11 fnmdef(3)
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      COMMON /EXCDGN/ TABS,FNAMES
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
       data fnmdef(1)/'exchxx.tmp'/
       data fnmdef(2)/'TEIOXX.TES '/
       data fnmdef(3)/'teioxx.TES '/
C
      IF (REASON.NE.0) GO TO 10
C
C     COMMAND NOT RECOGNIZED BY EXCHC1.  IF ICOMD=0 IT IS NOT A
C     COMMAND, ELSE CHECK PARAMETER OF TABS COMMAND.
C
      IF (ICOMD.EQ.0) GO TO 150
      IF (EQUAL.EQ.0 .OR. EQUAL.GT.NCHCMD) GO TO 110
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
      IF (J.EQ.68 .OR. J.EQ.89) THEN
C       68 = ASCII D, 89 = ASCII Y.
        TABS='Y'
        GO TO 150
      END IF
      IF (J.EQ.78 .OR. J.EQ.84) THEN
C       78 = ASCII N, 84 = ASCII T.
        TABS='N'
        GO TO 150
      END IF
      GO TO 110
C
C     PROCESS SYSTEM DEPENDENT INFORMATION
10    J=MAX0(REASON-4,1)
      K=MIN0(NCHCMD-EQUAL+1,40)
      IF (K.GT.0) THEN
C
C       FIRST BLANK OUT FNAMES, THEN FILL IN FILE NAME FROM COMAND.
        FNAMES(J)=' '
        DO 20 I=1,K
          L=COMAND(EQUAL+I-1)
          IF (L.GT.96 .AND. L.LT.123) L=L-32
20        FNAMES(J)(I:I)=CHAR(L)
      ELSE
C
C       PLACE DEFAULT FILE NAMES IN FNAMES(*:*)
        FNAMES(J)=FNMDEF(J)
C
C       PUT ASCII FORM OF LOGICAL UNIT NUMBER INTO (DEFAULT) FILE NAME.
        FNAMES(J)(5:6)=CHAR(NUMBER/10+48)//CHAR(MOD(NUMBER,10)+48)
      END IF
      IF (REASON-5) 50,70,150
C
C     OPEN INPUT FILE.
C
50    continue
c
c     If the 'T' option has been selected and the file is already open,
c     don't open it again.
c
      if (optval(20).ne.0) then
        inquire (file=fnames(1),opened=there,number=numold)
        if (there .and. numold.eq.number) go to 150
      end if
c
c     make a special check for reader=@console=unit 5.
      if (reason.eq.1 .and. reader.eq.5) fnames(1)='@console'
      OPEN (UNIT=NUMBER,FILE=FNAMES(1),STATUS='OLD',ERR=90,
     * IOINTENT='INPUT',IOSTAT=IER,recfm='ds',
     * form='formatted',pad='yes')
      GO TO 150
C
C     OPEN OUTPUT FILE.
C
70    if (reason.eq.5 .and. number.eq.6) fnames(1)='@CONSOLE'
      inquire (file=fnames(1),number=numold,opened=there)
      if (.not.there .or. (numold.ne.number))
     *OPEN (UNIT=NUMBER,FILE=FNAMES(1),STATUS='UNKNOWN',ERR=90,
     * IOSTAT=IER)
      GO TO 150
C
C     ERROR WHILE OPENING FILE.
C
90    WRITE(PRINTR,100) IER,NUMBER,FNAMES(1)
100   FORMAT (//'0IOSTAT = ',Z8,', Unable to open unit',I3,' for file '
     1,A40)
      GO TO 130
C
C     ERROR WHILE PROCESSING TABS COMMAND.
C
110   WRITE (PRINTR,120)
120   FORMAT (//'0Missing or unrecognized parameter on TABS command.')
C
130   WRITE (PRINTR,140) (HOLCMD(I),I=1,NCHCMD)
140   FORMAT (1X,80A1)
C
150   CONTINUE
      RETURN
C
      END
      SUBROUTINE  EXCHC2
C
C     PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KINDE /32/
      DATA KOPTI /14/
      DATA KSITE /25/
C
C     FIGURE OUT WHICH COMMAND GOT US HERE.
C
      IF (ICOMD-KOPTI) 60,150,10
10    IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270
C
C     ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT
C     WHERE C1, C2, STEP AND START ARE INTEGERS.
C     STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP,
C     START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF
C     CHARACTERS OF TEXT IN IDTXTL.  IF AN ERROR OCCURS,
C     STORE ZERO IN IDSTEP AND IDTXTL.
C     IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO.
C
C     STORE THE MODIFIER IN IDOPTN.
C     IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE
C     PRODUCED ONLY FOR IMAGES FROM INTAPE.  IF THE O MODIFIER
C     IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES
C     WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT.  IF THE F
C     MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION
C     OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE
C     PRODUCED FOR ALL IMAGES OUTPUT.  IF THE C MODIFIER IS SPECIFIED,
C     SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH
C     RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR
C     ALL IMAGES OUTPUT.  IF NONE OF THE I, F, OR C MODIFIERS ARE
C     SPECIFIED, THE O MODIFIER IS ASSUMED.
C
C     IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED.
C     IF IDTXTL = ZERO, TEXT IS NOT EMITTED.
C     IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE
C     EMITTED.
C
C     CONVERT C1,C2,STEP,START
C
      IDOPTN=MODIFY
      IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79
C     70 = ASCII F, 73 = ASCII I, 79 = ASCII O.
      DO 40 J=1,4
      NUMBER=0
20    IF (EQUAL.GT.NCHCMD) GO TO 40
      IF (COMAND(EQUAL).EQ.44) GO TO 30
C     44 = ASCII ,
      I=COMAND(EQUAL)-48
      IF (I.LT.0) GO TO 350
      IF (I.GT.9) GO TO 350
      NUMBER=10*NUMBER+I
      EQUAL=EQUAL+1
      GO TO 20
30    EQUAL=EQUAL+1
40    IDNBRS(J)=NUMBER
      IDCUR=IDSTRT
      IDCOL1=MAX0(1,MIN0(IDCOL1,178))
      IDCOL2=MIN0(IDCOL2,178)
C
C     STORE TEXT.
C
      IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0)
      IF (IDTXTL.EQ.0) GO TO 330
      DO 50 J=1,IDTXTL
      IDTEXT(J)=COMAND(EQUAL)
50    EQUAL=EQUAL+1
      GO TO 330
C
C     INDEX = PARAMETER STRING
C
60    J=0
      IF (COMAND(EQUAL).NE.45) GO TO 70
C     45 = ASCII -
      J=-1
      EQUAL=EQUAL+1
70    N=0
      DO 80 I=1,26
80    INDEXS(I)=0
90    IF (EQUAL.GT.NCHCMD) GO TO 130
      I=COMAND(EQUAL)-64
      IF (I.EQ.-32) GO TO 120
C     32 = ASCII BLANK.
      IF (I.GE.32) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.LE.0) GO TO 100
      IF (I.LE.26) GO TO 110
100   N=EQUAL
      GO TO 120
110   INDEXS(I)=1
120   EQUAL=EQUAL+1
      GO TO 90
130   INDEX=0
      DO 140 I=1,26
      INDEXS(I)=IABS(INDEXS(I)+J)
140   INDEX=INDEX+INDEXS(I)
      IF (MODIFY.EQ.76) INDEX=-INDEX
C     76 = ASCII L.
      IF (N) 340,330,340
C
C     OPTION = PARAMETER STRING
C
150   IF (MODIFY.NE.0) GO TO 170
      DO 160 I=1,26
160   OPTVAL(I)=0
170   IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330
      I=1
      IF (MODIFY.EQ.67) I=0
C     67 = ASCII C.
      N=0
      DO 190 J=EQUAL,NCHCMD
      K=COMAND(J)
      IF (K.GE.96) K=K-32
C     CONVERT TO UPPER CASE.
      IF (K.EQ.32) GO TO 190
C     32 = ASCII BLANK
      IF (K.LT.65) GO TO 180
      IF (K.GT.90) GO TO 180
C     PROCESS ALPHABETIC OPTIONS.
      OPTVAL(K-64)=I
      GO TO 190
180   N=J
190   CONTINUE
      IF (N) 330,330,340
C
C     PROCESS PRED = ID REC A/X MASK STRING
C       WHERE ID = PREDICATE IDENTIFIER (A-H),
C       REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE,
C       A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH
C             IN EXACT POSITION,
C       MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE
C              TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED.
C       STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF
C                CONTROL RECORDS.
C
C     THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR
C     PREDICATE A, ETC.
C
C     PRED(1,*)=LENGTH OF STRING + 3
C     PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED.
C     PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND).
C     PRED(3,*)=RECORD TYPE.
C     PRED(4,*)=A/X
C     PRED(5,*)=MASK CHARACTER.
C     PRED(6..42,*)=STRING.
C
200   IF (EQUAL.NE.0) GO TO 240
C     LIST ALL ACTIVE PREDICATES.
      DO 230 I=1,8
      IF (PRED(1,I).EQ.0) GO TO 230
      J=PRED(1,I)+1
      COMAND(1)=I+64
      DO 210 K=2,J
210   COMAND(K)=PRED(K+1,I)
      CALL EXCHAH (COMAND,J)
      WRITE (PRINTR,220) (COMAND(K),K=1,J)
220   FORMAT (6H PRED=,42A1)
230   CONTINUE
      GO TO 330
C     SAVE PREDICATE IF VALID.
240   IF (NCHCMD.LE.EQUAL+3) GO TO 370
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.GT.72) GO TO 360
C     72 = ASCII H
      NUMBER=J-64
      PRED(1,NUMBER)=0
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.GT.90) GO TO 360
C     90 = ASCII Z
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.EQ.82) GO TO 360
C     82 = ASCII R
      PRED(3,NUMBER)=J
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.NE.65.AND.J.NE.88) GO TO 360
C     65 = ASCII A, 88 = ASCII X
      PRED(4,NUMBER)=J
      EQUAL=EQUAL+1
      PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40)
      I=4
      DO 250 J=EQUAL,NCHCMD
      I=I+1
      IF (I.GT.42) GO TO 330
      K=COMAND(J)
      IF (K.GT.96) K=K-32
C     CONVERT TO UPPER CASE.
250   PRED(I,NUMBER)=K
      GO TO 330
C
C     SITE = SITE NAME
C
260   JUMP=1
      GO TO 280
C
C     TITLE = OUTPUT TAPE TITLE
C
270   JUMP=2
280   K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 320 I=1,40
      IF (K.GT.NCHCMD) GO TO 290
      J=COMAND(K)
      K=K+1
      GO TO 300
290   J=32
C     32 = ASCII BLANK.
300   IF (JUMP.EQ.2) GO TO 310
      SITE(I)=J
      GO TO 320
310   TITLE(I)=J
320   CONTINUE
C
C     RETURN TO COMMAND DECODER.
C
330   TRANS=1
      GO TO 390
C
C     ERROR MESSAGES
C
340   NUMBER=14
C     MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED.
      EQUAL=N
      GO TO 380
350   IDSTEP=0
      IDTXTL=0
360   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED.
      GO TO 380
370   NUMBER=30
C     MESSAGE 30 - COMMAND IS INCOMPLETE.
C
380   TRANS=8
C
390   RETURN
C
      END
      SUBROUTINE EXCHC3 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE
C     COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES.
C
C     OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE
C     NAME COMMAND.
C
C     OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING
C     COPY, NAME OR UPDATE COMMANDS.
C
C ID      IS USED TO CONSTRUCT THE OUTPUT LABEL.
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                                    E  X  C  H
      DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/
C                                    A  N  G  E
      DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/
      DATA KNAME /9/
      DATA KSKIP /26/
C
C     OPEN INTAPE IF NECESSARY
C
      IF (INTOPN.NE.0) GO TO 70
      IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300
      IF (INTAPE.EQ.OUTAPE) GO TO 360
      CALL EXCHRH (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 310
      INTOPN=1
C     COPY THE LABEL TO A SAVE AREA.
      DO 10 I=1,180
10    LABELI(I)=CBLCKI(I)
      CALL EXCHAH (CBLCKI(13),138)
      WRITE (PRINTR,20)
20    FORMAT (25H0INPUT LABEL INFORMATION.)
      WRITE (PRINTR,30) (CBLCKI(I),I=13,104)
30    FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/
     1        20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1)
      IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150)
40    FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1)
      WRITE (PRINTR,50) NDATAI
50    FORMAT (28H DATA CHARACTERS PER BLOCK =,I6)
      IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI
60    FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6)
      CHAR1L=0
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 290
70    IF (ICOMD.EQ.KSKIP) GO TO 270
C
C     OPEN OUTAPE IF NECESSARY
C
80    IF (ICOMD.EQ.0) GO TO 90
      IF (ICOMD.LT.KNAME) GO TO 100
90    IF (INTAPE*OUTAPE.EQ.0) GO TO 100
      IF (OUTUPD.NE.85) GO TO 370
C     85 = ASCII U.
100   IF (OUTOPN.NE.0) GO TO 240
      IF (OUTAPE.EQ.0) GO TO 240
C     CONSTRUCT THE OUTPUT LABEL.
      IF (TODAY(1).EQ.0) GO TO 340
      IF (INTOPN.EQ.0) GO TO 160
      DO 110 I=1,180
110   CBLCKO(I)=LABELI(I)
      IF (TITLE(1).EQ.32) GO TO 130
C     32 = ASCII BLANK
      DO 120 I=1,40
120   CBLCKO(I+18)=TITLE(I)
130   IF (OUTUPD.NE.85) GO TO 220
C     85 = ASCII U.
      IF (SITE(1).EQ.0) GO TO 350
      DO 140 I=1,6
140   CBLCKO(I+104)=TODAY(I)
      DO 150 I=1,40
150   CBLCKO(I+110)=SITE(I)
      GO TO 220
160   IF (TITLE(1).EQ.32) GO TO 330
C     32 = ASCII BLANK
      IF (SITE(1).EQ.0) GO TO 350
      IF (INTAPE*OUTAPE.EQ.0) GO TO 170
      IF (INTAPE.EQ.OUTAPE) GO TO 360
170   DO 180 I=1,8
180   CBLCKO(I)=ID(I)
      DO 190 I=1,40
      CBLCKO(I+18)=TITLE(I)
190   CBLCKO(I+64)=SITE(I)
      DO 200 I=1,6
200   CBLCKO(I+58)=TODAY(I)
      DO 210 I=105,180
210   CBLCKO(I)=0
220   CALL EXCHWH (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 320
      OUTOPN=1
      CBLCKO(1)=CBLCKO(105)
      CALL EXCHAH (CBLCKO(13),138)
      WRITE (PRINTR,230)
      WRITE (PRINTR,30) (CBLCKO(I),I=13,104)
230   FORMAT (26H0OUTPUT LABEL INFORMATION.)
      IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150)
      WRITE (PRINTR,50) NDATAO
      IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO
      CHAR1L=0
240   IF (ICOMD-KNAME) 250,260,280
C
C     COPY
C
250   TRANS=4
      MODEI=1-MIN0(1,OUFILE+OPTL)
      IF (ICOMD.EQ.0) MODEI=0
      GO TO 390
C
C     NAME
C
260   TRANS=5
      IF (NRWORK.EQ.0) PHASE=4
      GO TO 390
C
C     SKIP
C
270   TRANS=4
      GO TO 390
C
C     UPDATE
C
280   TRANS=5
      MODEI=0
      GO TO 390
C
C     ERROR MESSAGES
C
290   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      EQUAL=ISTAT
      GO TO 380
300   NUMBER=4
C     MESSAGE 4 - INTAPE NOT DEFINED.
      GO TO 380
310   NUMBER=5
C     MESSAGE 5 - UNABLE TO OPEN INTAPE.
      EQUAL=ISTAT
      GO TO 380
320   NUMBER=6
C     MESSAGE 6 - UNABLE TO OPEN OUTAPE.
      EQUAL=ISTAT
      GO TO 380
330   NUMBER=7
C     MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE.
      GO TO 380
340   NUMBER=8
C     MESSAGE 8 - DATE NOT SUPPLIED.
      GO TO 380
350   NUMBER=9
C     MESSAGE 9 - SITE NOT SUPPLIED.
      GO TO 380
360   NUMBER=10
C     MESSAGE 10 - INTAPE = OUTAPE.
      GO TO 380
370   NUMBER=11
C     MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED.
380   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM
C
390   RETURN
C
      END
      SUBROUTINE EXCHRH (ISTAT,DBLOCK)
C
C     READ THE HEADER LABEL FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE
C               NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     OPEN THE INPUT TAPE.
C
      ISTAT=1
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     READ A BLOCK.
C
      NDATAI=171
      NERRCI=0
      BLKSQI=0
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     FIND OUT IF IT IS A PROPER LABEL.
C
      CALL EXCHUN (DBLOCK,CBLCKI)
      DO 10 I=1,8
      IF (CBLCKI(I).NE.ID(I)) GO TO 20
10    CONTINUE
C
C     GET READY TO READ THE REST OF THE TAPE.
C
      CCDBI=NCDBI
      NDATAI=256*CBLCKI(9)+CBLCKI(10)
      NERRCI=256*CBLCKI(11)+CBLCKI(12)
      LASTI=0
      L1PRGI=0
      ISTAT=0
      GO TO 30
C
C     NOT A LABEL.
C
20    ISTAT=6
C
C     CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK.
25    I=4
      CALL EXCHRT (I,DBLOCK)
C
30    RETURN
C
      END
      SUBROUTINE EXCHWH (ISTAT,DBLOCK)
C
C     WRITE A HEADER ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE
C               WRITTEN ARE NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     MAKE SURE IT IS A PROPER LABEL.
C
      DO 10 I=1,8
      IF (CBLCKO(I).NE.ID(I)) GO TO 30
10    CONTINUE
C
C     OPEN THE OUTPUT TAPE.
C
      ISTAT=1
      CALL EXCHWT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 40
C
C     CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR
C     CONTROL CHARACTERS
C
      CBLCKO(9)=NDATAO/256
      CBLCKO(10)=MOD(NDATAO,256)
      CBLCKO(11)=NERRCO/256
      CBLCKO(12)=MOD(NERRCO,256)
C
C     INSERT TODAYS DATE
C
      DO 20 I=1,6
20    CBLCKO(I+12)=TODAY(I)
C
C     WRITE THE BLOCK ON TAPE.
C
      BLKSQO=0
      CALL EXCHPA (CBLCKO,DBLOCK)
      CCDBO=180
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     GET READY TO WRITE THE REST OF THE FILE.
C
      L1PRGO=0
      LLPRGO=0
      N1RECO=0
      NLRECO=0
      L1RECO=0
      LASTO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      GO TO 40
C
C     NOT A PROPER LABEL.
C
30    ISTAT=6
C
40    RETURN
C
      END
      SUBROUTINE EXCHC4 (IBLOCK)
      INTEGER IBLOCK(1)
C
C     PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM
C     COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KCOPY /3/
C
C     ARE WE STARTING OR CONTINUING?
C
C     ICOMD.EQ.0  MEANS  CHANGE A CONTROL RECORD
C     ICOMD.GT.0  MEANS  SKIP OR COPY COMMAND BEGIN
C     ICOMD.EQ.-1 MEANS  CONTINUE COPY = NUMBERS
C     ICOMD.EQ.-2 MEANS  CONTINUE COPY = PREDICATE EXPRESSION
      NEWP=0
      IF (ITYPEI.EQ.80) VERT=0
C     80 = ASCII P.  WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO
C     IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON
C     THE WORK FILE.
      IF (ICOMD.EQ.0) GO TO 190
C     ICOMD=0 MEANS CHANGING A CONTROL RECORD.
      IF (ICOMD+1) 290,170,10
10    IF (ICOMD.EQ.KCOPY) GO TO 30
C
C     SKIP COMMAND.
C
      IF (INTOPN.LT.0) GO TO 430
      if (modify.eq.70) number=number+n1reci-1
c     70 = ASCII F.
      IF (NUMBER+1-N1RECI) 540,430,20
20    CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.EQ.69) GO TO 460
C     69 = ASCII E.
      IF (N1RECI-NUMBER) 20,20,430
C
C     COPY COMMAND FORMAT VERIFICATION.
C
30    IF (COMAND(EQUAL).LT.48) GO TO 180
C     48 = ASCII ZERO
      IF (COMAND(EQUAL).GT.57) GO TO 180
C     57 = ASCII NINE
C
C     COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS.
C     CONVERT THE NUMBERS AND STORE THEM IN COMAND.  IF THE NUMBER
C     IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER.
C
      ICOMD=-1
      I=0
      J=44
C     44 = ASCII COMMA
40    I=I+1
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 480
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=NUMBER
50    EQUAL=EQUAL+1
      IF (EQUAL.GT.NCHCMD) GO TO 60
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 60
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=10*COMAND(I)+NUMBER
      GO TO 50
60    IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70
70    IF (J.EQ.45) COMAND(I)=-COMAND(I)
C     45 = ASCII DASH
      IF (EQUAL.GT.NCHCMD) GO TO 90
      J=COMAND(EQUAL)
      IF (J.EQ.32 .OR. J.EQ.46) GO TO 90
C     32 = ASCII BLANK, 46 = ASCII PERIOD.
      IF (J.NE.44.AND.J.NE.45) GO TO 480
C     44 = ASCII COMMA, 45 = ASCII DASH
80    EQUAL=EQUAL+1
      IF (COMAND(EQUAL)-32) 40,80,40
C     32 = ASCII BLANK
90    NUMBER=I
C     FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE
C     POSITION IN COMAND CURRENTLY BEING EXAMINED.
      EQUAL=-1
100   EQUAL=EQUAL+1
      IF (EQUAL.GE.NUMBER) GO TO 470
      IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100
      IF (EQUAL.EQ.0) GO TO 120
      WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD)
110   FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H)
     1NOT COPIED./(1X,80A1))
      NERRG=MAX0(NERRG,5)
120   IF (COMAND(EQUAL+1).GT.0) GO TO 130
      EQUAL=EQUAL-1
      COMAND(EQUAL+1)=N1RECI
130   IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
C
C     PROCESS COPY = LIST OF NUMBERS
C
140   EQUAL=EQUAL+1
C     GO COPY THE PROGRAM IF IT IS THE RIGHT ONE.
150   IF (INTOPN.LT.0) GO TO 430
      IF (COMAND(EQUAL)-N1RECI) 170,420,160
C     SKIP TO DESIRED PROGRAM
160   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI-69) 150,460,150
C     69 = ASCII E
170   IF (EQUAL.GE.NUMBER) GO TO 430
      IF (COMAND(EQUAL+1).GE.0) GO TO 140
      COMAND(EQUAL)=IABS(COMAND(EQUAL))+1
      IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420
      EQUAL=EQUAL+1
      GO TO 170
C
C     COPY = SELECTION STRING OR CHANGE CONTROL RECORD.
C
180   ICOMD=-2
      IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
      NRWORK=-1
C
C     DETERMINE NEED TO OPEN WORK FILE.
C
190   IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0)
     1IF (ICOMD) 290,430,290
      IF (WORKF.EQ.0) GO TO 500
      I=IABS(WORKF)
      IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510
      IF (WORKF.GT.0) GO TO 200
      WORKF=I
      CALL EXCHFO (3)
200   IF (ICOMD.NE.0) GO TO 280
C
C     CHANGE CONTROL RECORD.
C
      if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520
c     69 = ascii E, 73 = ascii I.
      if (nrwork.eq.0) go to 210
      if (itypei.eq.80) go to 520
c     80 = ascii P
210   IF (NUMBER-NRWORK-1) 530,220,410
220   NCHACT=NCHCMD+1-EQUAL
      IF (NCHACT.GT.0) GO TO 230
      NCHACT=1
      INTREC(1)=32
C     32 = ASCII BLANK
      GO TO 425
230   DO 240 I=1,NCHACT
240   INTREC(I)=COMAND(EQUAL+I-1)
      GO TO 425
C
C     COPY = SELECTION EXPRESSION.
C
C     SKIP TO NEXT PROGRAM.
250   IF (INTOPN.LT.0) GO TO 430
      if (itypei.eq.69) go to 460
c     69 = ASCII E.
      do 260 i = 1, 8
260   pred(2,i)=0
      if (itypei.ne.80) go to 265
c     If the current record is a new program, don't skip it (we haven't
c     processed it yet).
      if (nrwork.gt.0 .and. workf.gt.0) rewind workf
      nrwork=min0(nrwork,0)
      newp=0
      go to 320
265   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      nxnewp=0
270   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.NE.80) GO TO 310
C     80 = ASCII P
      NEWP=nxnewp
c     Set NEWP non-zero when all control records for a module have been
c     seen.
      GO TO 320
280   NRWORK=MAX0(NRWORK,0)
290   DO 300 I=1,8
300   PRED(2,I)=0
c     NEWP is non-zero when all control records have been read.
310   if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1
C     69 = ASCII E, 73 = ASCII I.
320   nxnewp=1
      if (icomd.eq.0) if (newp) 520,210,520
      IF (LIMIT.EQ.0) GO TO 340
      IF (N1RECI.LE.LIMIT) GO TO 340
      WRITE (PRINTR,330) LIMIT
330   FORMAT (7H LIMIT=,I6,9H REACHED.)
      GO TO 430
340   IF (NEWP.EQ.0) GO TO 360
      CALL EXCHLX
C     EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'.
      NUMBER=NCHCMD
      IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415
C     73 = ASCII I.
      IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425
C     80 = ASCII P.
      IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425
C     83 = ASCII S.
      IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415
C     88 = ASCII X.
      IF (COMAND(180)) 450,250,420
C     CONTROL RECORD.  EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE.
360   I=1
      DO 400 NUMBER=1,8
      IF (PRED(1,NUMBER).EQ.0) GO TO 400
      IF (PRED(2,NUMBER).NE.0) GO TO 400
      IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390
      NM=PRED(1,NUMBER)-3
      IF (.NOT.(NCHACT.GT.0)) GO TO 390
      DO 385 L = 1, NCHACT
      DO 380 J = 1, NM
C
C     DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND
C     IN PREDICATE.
      IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380
      IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370
C
C     NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS.
      K=32
      GO TO 375
C     USE CHARACTER FROM CONTROL RECORD.
370   K=INTREC(J+L-1)
C
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (K.GT.96 .AND. K.LT.123) K=K-32
C
C     TEST FOR A MATCH ON A SINGLE CHARACTER.
C     IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE
C     PATTERN.  IF THE SEARCH MODE IS X, TERMINATE THE SEARCH.
375   IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390
380   CONTINUE
C
C     FOUND A MATCH IN CONTROL RECORD AND PREDICATE.
      PRED(2,NUMBER)=1
      GO TO 400
385   CONTINUE
390   I=0
400   CONTINUE
      IF (I.NE.0) newp=1
      IF (NRWORK.LT.0) GO TO 270
C     AT LEAST ONE FALSE PREDICATE.  WRITE THE CONTROL RECORD ON WORKF.
410   WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT)
      NRWORK=NRWORK+1
      GO TO 270
C
C     GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM.
C
415   ICOMD=-3
C     RETURN TO EXCHC1 AFTER COPYING MODULE.
420   TRANS=5
      GO TO 570
C
C     RETURN TO THE COMMAND PROCESSOR.
C
425   TRANS=1
C     REMEMBER CONTROL RECORDS ON WORKF.
      GO TO 570
430   TRANS=1
      IF (ICOMD+1) 560,570,570
C
C     ERROR MESSAGES.
C
440   NUMBER=1
C     MESSAGE 1 - I/O ERROR.
      EQUAL=ISTAT
      GO TO 550
450   NUMBER=-COMAND(180)
C     MESSAGES GENERATED BY EXCHLX
      GO TO 550
460   IF (INTOPN.LT.0) GO TO 430
      INTOPN=-1
      EQUAL=NUMBER
      NUMBER=15
C     MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE.
      GO TO 550
470   NUMBER=16
C     MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION.
      GO TO 550
480   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER
      GO TO 550
490   NUMBER=18
C     MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER.
      GO TO 550
500   NUMBER=19
C     MESSAGE 19 - WORK FILE NOT DEFINED.
      GO TO 550
510   NUMBER=20
C     MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE.
      GO TO 550
520   EQUAL=NUMBER
      NUMBER=21
C     MESSAGE 21 - CONTROL RECORD NOT PRESENT
      GO TO 550
530   NUMBER=22
C     MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER.
      GO TO 550
540   NUMBER=29
C     MESSAGE 29 - BACKWARD SKIP IGNORED.
C
C     RETURN TO THE ERROR MESSAGE PROCESSOR.
C
550   TRANS=8
      IF (ICOMD.EQ.0) GO TO 570
C
C     DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF.
C
560   IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
C
C     RETURN TO TRANSITION PROGRAM.
C
570   RETURN
C
      END
      SUBROUTINE EXCHLX
C
C     EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND.
C
C     THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE
C     STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM
C     COPY=LOGICAL EXPRESSION.  THE LOGICAL EXPRESSION CONSISTS OF THE
C     EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY
C     OPERATORS + - * / AND PARENEHESES.  THE PRIMARY SYMBOLS A-H ARE
C     LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE
C     STATEMENTS.  THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE
C     NULL PREDICATE, WHICH IS ALWAYS FALSE.  THE OPERATORS + - * / ARE
C     THE BINARY LOGICAL OPERATIONS   OR, OR NOT, AND, AND NOT
C     RESPECTIVELY.  THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE
C     PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL
C     PRIORITY.  THE RELATIVE PRIORITY MAY BE CHANGED BY USING
C     PARENTHESES.
C
C     WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY
C     FALSE.  AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL
C     FALSE PREDICATES IS DETERMINED.  ONCE TRUE, A PREDICATE REMAINS
C     TRUE.  THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND
C     A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE.  WHEN ALL ACTIVE
C     PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM
C     HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND
C     IS EVALUATED.  IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED.
C     IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED.  THIS PROCESS
C     CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM
C     NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED.
C
C     THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE
C     TABLE BELOW.  INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS
C     APPENDED TO THE END OF THE LOGICAL EXPRESSION.
C
C     PREVIOUS  I                 CURRENT TOKEN                   I
C      TOKEN    I + - * / I PRIMARY I    (    I    )    I  ELSE   I
C     ----------I---------I---------I---------I---------I---------I
C      + - * /  I  ERROR  I   OK    I   OK    I  ERROR  I  ERROR  I
C      PRIMARY  I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C         (     I  ERROR  I   OK    I   OK    I   OK    I  ERROR  I
C         )     I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C     ----------I---------I---------I---------I---------I---------I
C
C     CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING
C     A STACK AND THE PRECEDENCE TABLE BELOW.  TOS MEANS TOP-OF-STACK,
C     HOI MEANS HEAD-OF-INPUT.  THE STACK INITIALLY CONTAINS (.
C
C                  TOS       HOI
C      TOKEN   I  INDEX  I  INDEX  I
C     ---------I---------I---------I
C       + -    I    2    I    1    I
C       * /    I    4    I    3    I
C     PRIMARY  I    6    I    5    I
C        (     I    0    I    7    I
C        )     I   N/A   I    0    I
C     ---------I---------I---------I
C
C     WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS
C     PUSHED ONTO THE STACK.  WHEN THE TOS INDEX IS GREATER THAN THE HOI
C     INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY
C     SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT
C     PLACED IN THE SUFFIX LIST.  THEN THE RELATION OF THE TOS INDEX TO
C     THE HOI INDEX IS RE-EXAMINED.  WHEN THE TOS INDEX IS EQUAL TO THE
C     HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED.
C
C     *****     INTERNAL VARIABLES     *********************************
C
C CHTAB   RECOGNIZED CHARACTERS.  INTERNAL PROCESSES USE THE INDEX
C         INTO CHTAB.
C COLTAB  CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX.
C HOI     CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE.
C INFIX   IS THE CURRENT POSITION IN THE INFIX.
C IPREV   IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN.
C ISTACK  IS THE CURRENT STACK INDEX.
C ISUFIX  IS THE CURRENT SUFFIX INDEX.
C SYNTAX  CONTAINS THE SYNTAX RULES.
C TOS     CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE.
C
      INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     DATA STATEMENTS     ************************************
C
C                                                    A  B  C  D
      DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/
C                                                    E  F  G  H
      DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/
C                                                    N  +  -  *
      DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/
C                                                    /  (  )
      DATA CHTAB(13),CHTAB(14),CHTAB(15)           /47,40,41   /
C                                                       A B C D
      DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/
C                                                       E F G H
      DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/
C                                                       N + - *
      DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/
C                                                       / ( )
      DATA COLTAB(13),COLTAB(14),COLTAB(15)            /1,3,4  /
C                                                   A B C D E
      DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/
C                                                   F G H N +
      DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/
C                                                   - * / ( )
      DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/
C                 CURRENT TOKEN IS +-*/.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/
C                 CURRENT TOKEN IS PRIM.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/
C                 CURRENT TOKEN IS (.     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/
C                 CURRENT TOKEN IS ).     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/
C                                                   A B C D E
      DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/
C                                                   F G H N +
      DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/
C                                                   - * / ( )
      DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/
C
C     *****     PROCEDURES     *****************************************
C
C     COMAND IS USED FOR INFIX, STACK AND SUFFIX.  UPON COMPLETION,
C     COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE
C     OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE
C     EXPRESSION IS TRUE.
C
      ISTACK=NCHCMD+2
      COMAND(ISTACK)=14
      ISUFIX=181
      IPREV=3
      COMAND(NCHCMD+1)=41
      INFIX=EQUAL-1
C
C     GET A CHARACTER FROM INFIX.  LOOK UP IN CHTAB.  CHECK SYNTAX.
C
10    IF (INFIX.GT.NCHCMD) GO TO 180
      INFIX=INFIX+1
      J=COMAND(INFIX)
      IF (J.EQ.32) GO TO 10
C     32 = ASCII BLANK - IGNORE IT.
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      DO 20 I=1,15
      IF (CHTAB(I).EQ.J) GO TO 30
20    CONTINUE
      GO TO 230
30    J=COLTAB(I)
      IF (SYNTAX(IPREV,J)-1) 40,190,200
C
C     CONVERT INFIX TO SUFFIX
C
40    IPREV=J
50    J=COMAND(ISTACK)
      IF (TOS(J)-HOI(I)) 60,70,80
C     PUSH INFIX ONTO STACK
60    ISTACK=ISTACK+1
      COMAND(ISTACK)=I
      GO TO 10
C     DELETE TOP OF STACK
70    ISTACK=ISTACK-1
      IF (ISTACK.GT.NCHCMD+1) GO TO 10
      IF (INFIX-NCHCMD) 220,220,250
C     IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX.
C     IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX.
80    IF (J-9) 90,100,130
C     PRIMARY IS SYMBOL A-H
90    IF (PRED(1,J).EQ.0) GO TO 210
      J=PRED(2,J)
      GO TO 110
C     NULL PREDICATE
100   J=0
110   ISUFIX=ISUFIX-1
120   COMAND(ISUFIX)=J
      ISTACK=ISTACK-1
      GO TO 50
C     OPERATOR
130   J=J-9
      ISUFIX=ISUFIX+1
      GO TO (140,150,160,170), J
C             +   -   *   /
140   J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1)
      GO TO 120
150   J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1)
      GO TO 120
160   J=COMAND(ISUFIX)*COMAND(ISUFIX-1)
      GO TO 120
170   J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1))
      GO TO 120
C
180   COMAND(180)=-23
C     MESSAGE 23 - TOO MANY (
      GO TO 240
190   COMAND(180)=-24
C     MESSAGE 24 - MISSING PRIMARY
      GO TO 240
200   COMAND(180)=-25
C     MESSAGE 25 - MISSING OPERATOR
      GO TO 240
210   EQUAL=CHTAB(J)
      CALL EXCHAH (EQUAL,1)
      COMAND(180)=-26
C     MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE.
      GO TO 250
220   COMAND(180)=-27
C     MESSAGE 27 - TOO MANY )
      GO TO 240
230   COMAND(180)=-28
C     MESSAGE 28 - UNRECOGNIZED CHARACTER
C
240   EQUAL=INFIX
250   RETURN
C
      END
      SUBROUTINE EXCHC5 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE,
C     AND INDEX IF SELECTED.  COPY RECORDS FROM WORKF FIRST, IF ANY.
C     CREATE CONTROL RECORDS DEMANDED BY COMMANDS.
C
C     THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF
C     THE PARAMETER STRING.
C
C     AUTHOR
C     COMMENT
C     CONTROL (ITYPEO SET FROM MODIFY)
C     DATA TYPE
C     GROUPS
C     INSERT
C     KEYWORDS
C     MACHINE
C     ORIGIN
C     REFERENCES
C     REMOVE   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     SIGNAL   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     UPDATE
C
C     IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS
C     ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A
C     CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND.
C
C     *****     LOCAL VARIABLES     ************************************
C
C BLANK   CONTAINS A HOLLERITH BLANK.
      INTEGER BLANK
C C1      IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING.
      INTEGER C1
C COL1    THE FIRST COLUMN OF TEXT OF A CONTROL RECORD.  DERIVED FROM
C         EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE.
      INTEGER COL1
C I,J     USED FREELY AS INDICES.
      INTEGER I,J
C KCONT   THE INDEX IN COMD OF THE CONTROL COMMAND.
      INTEGER KCONT
C KNAME   IS THE INDEX IN COMD OF THE NAME COMMAND.
      INTEGER KNAME
C KTEXT   THE INDEX IN COMD OF THE TEXT COMMAND.
      INTEGER KTEXT
C KUPDA   THE INDEX IN COMD OF THE UPDATE COMMAND.
      INTEGER KUPDA
C LIST    CONTAINS THE WORD LIST IN ASCII.  USED FOR THE A OPTION.
      INTEGER LIST(4)
C NM      IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NM
C NOUT    IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NOUT
C NY      IS THE PROGRAM NUMBER.  IT IS THE NUMBER FROM INTAPE IF
C         OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE.
      INTEGER NY
C ONE     CONTAINS A HOLLERITH 1.
      INTEGER ONE
C REASON  REASON FOR COPYING A CONTROL RECORD.  1 = COPY COMMAND
C         PENDING.  2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8.
C         3 = COMMAND.
      INTEGER REASON
C RI      CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A
C         GIVEN RECORD TYPE.  RI IS SUBSCRIPTED BY (ITYPEO-64).
      INTEGER RI(26)
C RT      IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT.
      INTEGER RT(34)
C STAR    CONTAINS A HOLLERITH STAR.
      INTEGER STAR
C ZERO    CONTAINS A HOLLERITH ZERO.
      INTEGER ZERO
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL VARIABLE DATA     ********************************
C
      DATA BLANK /1H /
C                                            L  I  S  T
      DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/
C
      DATA KCONT /31/
      DATA KNAME /9/
      DATA KTEXT /27/
      DATA KUPDA/29/
      DATA ONE /1H1/
C                                                      A  B  C  D  E  F
      DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/
C                                                      G  H  I  J  K  L
      DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/
C                                                      M  N  O  P  Q  R
      DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/
C                                                      S  T  U  V  W  X
      DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/
C                                                      Y  Z
      DATA RI(25),RI(26)                             /31,31            /
C                                                     A  C     D     G
      DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/
C                                                           P     K
      DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/
C                                                     M     O
      DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/
C                                                              B  R
      DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/
C                                                                 S
      DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/
C                                                              J
      DATA RT(31),RT(32),RT(33),RT(34)              /-1, 0, 0,74/
C
      DATA STAR /1H*/
      DATA ZERO /1H0/
C
C     *****     PROCEDURES     *****************************************
C
      REASON=1
      NY=N1RECI
      IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1
C     ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P.
C     IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT.
      IF (PHASE.EQ.4) NY=0
C     NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER.  (IT IS PRINTED
C     IN THE INDEX).
      IF (ICOMD.LE.0) GO TO 10
      IF (PHASE.GE.4) GO TO 100
      IF (ICOMD.EQ.KNAME) GO TO 10
      IF (ICOMD.NE.KUPDA) GO TO 100
      REASON=2
      PHASE=8
10    IF (NRWORK.GT.0) REWIND WORKF
      NM=0
      NOUT=0
20    NM=NM+1
      IF (NM.LE.NRWORK) GO TO 60
30    IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230
C     69 = ASCII E, 73 = ASCII I.
      IF (NOUT.EQ.0) GO TO 40
      IF (ITYPEI.EQ.80) GO TO 230
C     80 = ASCII P.
      IF (NCHACT.NE.1) GO TO 40
      IF (INTREC(1).EQ.32) GO TO 220
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
40    ITYPEO=ITYPEI
      NCHOUT=NCHACT
      DO 50 J=1,NCHOUT
50    OUTREC(J+5)=INTREC(J)
      GO TO 70
60    READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT)
      IF (NCHOUT.NE.1) GO TO 70
      IF (NM.EQ.1) GO TO 70
      IF (OUTREC(6).EQ.32) GO TO 200
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
70    NOUT=NOUT+1
      J=RI(ITYPEO-64)
      DO 80 I=1,4
80    OUTREC(I)=COMD(I,J)
      OUTREC(5)=61
C     61 = ASCII =
      COL1=5
      IF (J.NE.KCONT) GO TO 130
      COL1=7
C     CONTROL,*=...  MOVE UP TWO CHARACTERS AND INSERT ITYPEO.
      DO 90 I=1,NCHOUT
90    OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I)
      OUTREC(5)=44
C     44 = ASCII COMMA.
      OUTREC(6)=ITYPEO
      OUTREC(7)=61
C     61 = ASCII =
      GO TO 130
100   IF (ICOMD.EQ.KTEXT) GO TO 240
      COL1=EQUAL-1
      NCHOUT=NCHCMD-COL1
      NRWORK=NRWORK+1
C     NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD.
      ITYPEO=RT(ICOMD)
      IF (ITYPEO.GT.0) GO TO 110
C     PROCESS CONTROL,TYPE=TEXT COMMAND.
      ITYPEO=MODIFY
      IF (RI(ITYPEO-64).NE.KCONT) GO TO 320
110   NOUT=NRWORK
      REASON=3
      DO 120 I=1,NCHCMD
120   OUTREC(I)=COMAND(I)
130   IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1)
C     74 = ASCII J.
      IF (ITYPEO.EQ.80) VERT=0
C     80 = ASCII P
      IF (ITYPEO.NE.68) GO TO 150
C     68 = ASCII D
      IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150
      DO 140 J=1,4
      I=OUTREC(J+COL1)
      IF (I.GT.96 .AND. I.LT.123) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.NE.LIST(J)) GO TO 150
140   CONTINUE
      VERT=1
C     GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE.
150   CALL EXCHCG (OUTREC(COL1+1))
      IF (OUTOPN.EQ.0) GO TO 160
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1))
      IF (ISTAT.NE.0) GO TO 340
      NY=NLRECO
160   NCHOUT=NCHOUT+COL1
C     TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER.
      OUTREC(180)=-NOUT
      IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC)
C     PRINT THE INDEX IF SELECTED.
      IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO
     1190
      IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190
      C1=BLANK
C     DOUBLE SKIP FOR PROGRAM HEADER (P).
      IF (ITYPEO.EQ.80) C1=ZERO
      IF (OPTV+VERT.NE.0) GO TO 170
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170
      IF (CHAR1L.NE.ONE) C1=ONE
      CHAR1L=ONE
170   CALL EXCHAH (OUTREC,NCHOUT)
      WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT)
180   FORMAT (A1,2I5,1H*,(3X,105A1))
190   IF (REASON.EQ.3) GO TO 310
200   IF (NM-NRWORK) 20,210,220
210   REWIND WORKF
      NRWORK=0
      GO TO 30
220   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT) 330,30,330
230   IF (REASON.EQ.2) GO TO 300
240   IF (OUFILE.EQ.0) GO TO 260
      DO 250 I=1,4
250   OUTREC(I)=COMD(I,KTEXT)
      OUTREC(180)=0
      NCHOUT=0
C     TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED.
      CALL EXCHCG (OUTREC)
      NCHOUT=4
      ACTION=2-OPTC-OPTC
C     ACTION = 2 MEANS START OF PROGRAM.
      CALL EXCHOU (OUTREC)
260   IF (OPTV+VERT.NE.0) GO TO 280
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280
      IF (OUTOPN.NE.0) NY=NLRECO
      I=BLANK
      IF (CHAR1L.NE.ONE) I=ONE
      WRITE (PRINTR,270) I,NY
270   FORMAT (A1,I5,1H*,8X,4HTEXT/)
280   CHAR1L=STAR
      NRWORK=MIN0(NRWORK,0)
      IF (IDOPTN.NE.67) IDCUR=IDSTRT
C     67 = ASCII C
      IF (ICOMD.EQ.KTEXT) GO TO 290
C
C     WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL
C     RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED.
C
      TRANS=6
      GO TO 370
C
C     WORKING ON A TEXT STATEMENT.
C
290   TRANS=7
      GO TO 370
C
C     WORKING ON AN UPDATE STATMENT.
C
300   NRWORK=NOUT
      GO TO 100
C
C     WRITING A SINGLE CONTROL RECORD.
C
310   TRANS=1
      GO TO 370
C
C     ERROR MESSAGES.
C
320   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER.
      GO TO 360
330   NUMBER=1
      GO TO 350
340   NUMBER=2
350   EQUAL=ISTAT
360   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM.
C
370   RETURN
C
      END
      SUBROUTINE EXCHCG (RECORD)
C
C     USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL.
C     WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED.
C     THIS IS THE PORTABLE VERSION.  IT DOES NOT DO ANYTHING.
C
      INTEGER RECORD(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      RETURN
      END
      SUBROUTINE EXCHC6 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE.
C
      INTEGER KNAME,ONE,SVHCMD(180)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KNAME /9/
      DATA ONE /1H1/
C
      LINEO=0
      NERRS=0
C     SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT.
      DO 5 I = 1,NCHCMD
5     SVHCMD(I)=HOLCMD(I)
      IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165
C     73 = ASCII I.  IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE
C     A VOID MODULE.
      IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10
      CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.EQ.7) GO TO 220
      IF (ISTAT) 250,160,250
10    MODEO=MODEI
      ITYPEO=0
      NBC=OPTL+OUFILE
      IF (INDEX.GT.0) NBC=1
20    NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTOPN.EQ.0) GO TO 120
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 260
C
C     CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD
C     INSTEAD OF BYTE-BY-BYTE).  WE CAN DO A BLOCK COPY IF
C     WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT
C     FILE AND NOT PRINTING THE INDEX.  ALSO, THE INPUT AND
C     OUTPUT CHARACTER POSITIONS MUST BE THE SAME.  IF THE
C     PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH
C     THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE
C     CURRENT POSITION IN THE BYTE BUFFER BE THE SAME.
C     WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE
C     LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T
C     KNOW THE LOCATION OF THE END-OF-FILE RECORD.
C
      IF (NBC.NE.0) GO TO 120
      IF (CPCBI+1.NE.CPCBO) GO TO 120
      IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120
C     WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF.
      IF (L1PRGI.EQ.0) GO TO 25
      IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30
25    IF (CCDBI+1.NE.CCDBO) GO TO 120
      IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120
C     WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE).
C     FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO.
30    LI=L1PRGI+NERRCI-1
      IF (L1PRGI.NE.0) GO TO 40
      LI=NERRCI+NDATAI+9
      IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1
40    IF (CPCBI.GE.NCCBI) GO TO 50
      IF (CCDBI.GE.LI) GO TO 160
      CPCBI=CPCBI+1
      CBLCKO(CPCBO)=CBLCKI(CPCBI)
      CPCBO=CPCBO+1
      CCDBI=CCDBI+1
      CCDBO=CCDBO+1
      GO TO 40
C     PACK COPIED BYTES.
50    CALL EXCHPA (CBLCKO,OBLOCK(CWDBO))
      CPCBO=1
      CPCBI=0
      CWDBO=CWDBO+NWCBO
      CWDBI=CWDBI+NWCBI
C     NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM
60    IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70
      IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=L1RECI
      CALL EXCHPB (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 260
70    IF (CCDBI.LT.LI) GO TO 80
      IF (L1PRGI.NE.0) GO TO 100
      CALL EXCHGB (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 250
      GO TO 30
80    NW=NWCBI*((LI-CCDBI)/NCCBI)
      IF (NW.EQ.0) GO TO 100
      DO 90 I=1,NW
      OBLOCK(CWDBO)=IBLOCK(CWDBI)
      CWDBO=CWDBO+1
90    CWDBI=CWDBI+1
100   CCDBO=CCDBO+LI-CCDBI
      CCDBI=LI
      IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60
      CPCBI=MOD(LI,NCCBI)
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      CALL EXCHUN (IBLOCK(CWDBI),CBLCKI)
      IF (CPCBI.EQ.0) GO TO 160
      DO 110 I=1,CPCBI
110   CBLCKO(I)=CBLCKI(I)
      GO TO 160
C
C     END OF BLOCK COPY CODE.
C
120   CALL EXCHTP (INTREC,LINEO)
160   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 250
      IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20
C     73 = ASCII I.
165   IF (OPTL.NE.0) GO TO 180
      IF (INDEX.LE.0) GO TO 195
      WRITE (PRINTR,170) LINEO
170   FORMAT (I9,14H IMAGES COPIED)
      GO TO 200
180   WRITE (PRINTR,190)
190   FORMAT (1H1)
195   CHAR1L=ONE
200   IF (OUFILE.EQ.0) GO TO 210
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
210   IF (ITYPEI.EQ.69) GO TO 220
C     69 = ASCII E
C
C     RETURN TO THE COPY CONTROL SEGMENT.
C
      DO 215 I=1,NCHCMD
215   HOLCMD(I)=SVHCMD(I)
      IF (ICOMD.EQ.-3) GO TO 240
C     ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE.
      TRANS=4
      IF (ICOMD.NE.KNAME) GO TO 280
C     MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME'
C     COMMAND SUBMITTED.  GO PROCESS 'NAME' COMMAND.
      TRANS=5
      PHASE=4
      GO TO 280
C
C     END OF FILE ON INPUT TAPE.
C
220   IF (INTOPN.LT.0) GO TO 240
      WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD)
230   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1))
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
240   TRANS=1
      GO TO 280
C
C     ERROR MESSAGES.
C
250   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      GO TO 270
260   NUMBER=2
C     MESSAGE 2 - I/O ERROR WRITING OUTAPE.
270   TRANS=8
      EQUAL=ISTAT
C
C     RETURN TO THE TRANSITION PROGRAM.
C
280   IF (NERRS.EQ.0) GO TO 300
      WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD)
290   FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./
     1(1X,80A1))
      NERRG=MAX0(NERRS,NERRG)
300   RETURN
C
      END
      SUBROUTINE EXCHC7 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
      INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40)
C
C     PROCESS THE TEXT COMMAND.
C
C MSG     IS USED TO PRINT A MESSAGE.
      INTEGER MSG(6,2)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/
      DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/
      DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/
      DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/
      DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/
C
      LINEI=1
      LINEO=0
      NERRS=0
      INEND=0
      CHAR1L=STAR
C
C     SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND
C
      K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 20 I=1,40
      IF (K.GT.NCHCMD) GO TO 10
      J=COMAND(K)
      K=K+1
      GO TO 20
10    J=32
C     32 = ASCII BLANK.
20    TXDISK(I)=J
      IF (INTOPN.LE.0) ITYPEI=0
C
C     MAIN PROCESSING LOOP
C
60    EDIT=0
70    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 80
C     NCHCMD.LT.0 MEANS END OF FILE.
      IF (NCHCMD.LT.2) GO TO 100
      IF (COMAND(1).NE.SIGNAL) GO TO 100
      IF (COMAND(2).EQ.SIGNAL) GO TO 80
      IF (COMAND(2).EQ.73) GO TO 370
      IF (COMAND(2).EQ.105) GO TO 370
C     73,105 = ASCII I - REQUEST TO INCLUDE TEXT.
      IF (NCHCMD.LT.3) GO TO 100
      IF (COMAND(2).NE.61) GO TO 100
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 70
C     END OF TEXT FILE.
80    IF (INTEXT.EQ.0) GO TO 90
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      CALL EXCHIM
      INTEXT=0
      NCHCMD=0
90    NCHCMD=MIN0(NCHCMD,0)
      IF (PHASE.NE.8) GO TO 660
      IF (INEND) 660,630,660
100   IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110
110   IF (EDIT.EQ.0) GO TO 450
C
C     PARTIAL LINE EDITOR.
C     INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED.
C     EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES
C     THE FIRST NON-BLANK CHARACTER AFTER N2.  N1 AND N2 ARE COLUMN
C     LIMITS UNDER WHICH TO PERFORM THE EDITING.  N1 AND ,N2 ARE
C     OPTIONAL.  IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT
C     LIMIT.  IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS
C     ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE.  WHEN
C     STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING
C     PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT
C     LENGTHS OF STRING1 AND STRING2.  THE THIRD DELIMITER IS
C     OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED
C     AFTER STRING2 IS INSERTED.
C
      IF (INEND.NE.0) GO TO 240
C     CONVERT COLUMN NUMBERS.
      NBR1=0
      NBR2=0
      I=0
120   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.EQ.44) GO TO 150
C     44 = ASCII COMMA
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR1=10*NBR1+J-48
      GO TO 120
130   WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD)
140   FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/
     1(1X,80A1))
      NERRS=2
      GO TO 70
150   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR2=10*NBR2+J-48
      GO TO 150
C     SCAN FOR DELIMITER
160   IF (J.NE.32) GO TO 170
C     32 = ASCII BLANK
      I=I+1
      J=COMAND(I)
      GO TO 160
170   D1=I
      NBR1=MIN0(NBR1,180)
      NBR2=MIN0(NBR2,180)
      IF (NBR1.EQ.0) NBR1=1
      IF (NBR2.EQ.0) GO TO 180
      IF (NBR2.LT.NBR1) GO TO 130
180   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      IF (COMAND(I).NE.J) GO TO 180
      D2=I
      D3=0
190   I=I+1
      IF (I.GT.NCHCMD) GO TO 200
      IF (COMAND(I).NE.J) GO TO 190
      D3=I
C     LOOK FOR SEARCH STRING (STRING1)
200   NUMBER=D2-D1-1
      J=NBR1
      IF (NUMBER.EQ.0) GO TO 260
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
210   DO 220 I=1,NUMBER
      IF (I+J-1.GT.NY) GO TO 240
      IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230
220   CONTINUE
      GO TO 260
230   J=J+1
      GO TO 210
240   WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1))
      NERRS=2
      GO TO 70
C     FOUND SEARCH STRING.  REPLACE WITH UPDATE STRING.
260   CHAR1L=PLUS
      IF (D3.NE.0) GO TO 300
C     NO THIRD DELIMITER.   REPLACE REST OF REGION.
      NY=NBR2
      IF (NY.EQ.0) NY=180
      D2=D2+1
      IF (D2.GT.NCHCMD) GO TO 280
      DO 270 I=D2,NCHCMD
      INTREC(J)=COMAND(I)
      J=J+1
      IF (J.GT.NY) GO TO 280
270   CONTINUE
280   IF (NBR2.NE.0) GO TO 290
      NCHACT=J-1
      GO TO 70
290   IF (J.GT.NBR2) GO TO 70
      INTREC(J)=32
C     32 = ASCII BLANK
      J=J+1
      GO TO 290
C     WE HAVE A THIRD DELIMITER.  REPLACE ONLY THE SEARCH STRING.
C     SHIFT THE REST OF THE REGION AS NECESSARY.
300   NUMBER=(D3-D2)-(D2-D1)
      IF (NUMBER) 310,350,330
C     SHIFT LEFT
310   I=J+D2-D1-1
      NY=MIN0(NBR2,NCHACT)
      IF (NY.EQ.0) NY=NCHACT
320   IF (I.GT.NY) GO TO 350
      INTREC(I+NUMBER)=INTREC(I)
C     NOTE - NUMBER .LT. 0 HERE
      INTREC(I)=32
C     32 = ASCII BLANK
      I=I+1
      GO TO 320
C     RIGHT SHIFT
330   I=NBR2
      IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180)
      NY=J+NUMBER
340   IF (I.LT.NY) GO TO 350
      INTREC(I)=INTREC(I-NUMBER)
      I=I-1
      GO TO 340
C     NO SHIFT NEEDED.
350   IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180)
      IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2)
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
C     MOVE UPDATE STRING (STRING2).
360   D2=D2+1
      IF (D2.GE.D3) GO TO 70
      INTREC(J)=COMAND(D2)
      J=J+1
      IF (J-NY) 360,360,70
C
C     REQUEST TO INCLUDE TEXT.  -I IN COLUMNS 1 AND 2.
C
370   IF (EDIT.EQ.0) GO TO 390
      WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD)
380   FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X
     1,80A1))
      NERRS=2
      GO TO 70
390   ITYPEO=73
C     73 = ASCII I
      IF (NCHCMD.GE.4) GO TO 410
      WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD)
400   FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A
     11))
      NERRS=2
      GO TO 70
410   DO 420 I=4,NCHCMD
      IF (COMAND(I).NE.32) GO TO 430
420   CONTINUE
C     CONVERT TO UPPER CASE.  WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM
430   K=0
      DO 440 J=I,NCHCMD
      IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32
      K=K+1
440   COMAND(K)=COMAND(J)
      NCHCMD=K
      GO TO 460
C
C     TEXT RECORD.
C
450   ITYPEO=0
460   NCHOUT=NCHCMD
      IF (OUTOPN.EQ.0) GO TO 470
      MODEO=0
      CALL EXCHPR (ISTAT,OBLOCK,COMAND)
      IF (ISTAT.NE.0) GO TO 770
470   CALL EXCHTP (COMAND,0)
      GO TO 70
C
C     APPARENT CHANGE CONTROL COMMAND
C
480   IF (INEND.EQ.0) GO TO 510
490   WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD)
500   FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT
     1 END./(1X,80A1))
      NERRS=1
      GO TO 70
510   NUMBER=1
      NBR1=0
      EDIT=0
      I=1
520   I=I+1
      IF (I.GT.NCHCMD) GO TO 600
      J=COMAND(I)
      IF (J.EQ.32) GO TO 600
C     32 = ASCII BLANK
      IF (EDIT.NE.0) GO TO 530
C     EDIT CONTROL MUST BE BLANK AFTER $.
      IF (J.EQ.44) GO TO 570
C     44 = ASCII COMMA
      IF (J.EQ.36) GO TO 560
C     36 = ASCII $
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.LE.57) GO TO 550
C     57 = ASCII 9
530   WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD)
540   FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1)
      NERRS=2
      GO TO 60
550   NBR1=10*NBR1+J-48
      GO TO 520
560   IF (NBR1.EQ.0) GO TO 530
      EDIT=1
      NBR1=NBR1-1
      GO TO 520
570   NUMBER=2
      NBR2=0
580   I=I+1
      IF (I.GT.NCHCMD) GO TO 590
      J=COMAND(I)
      IF (J.EQ.32) GO TO 590
C     32 = ASCII BLANK
      IF (IABS(J-44).EQ.1) GO TO 590
C     43 = ASCII +, 45 = ASCII -
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 530
C     57 = ASCII 9
      NBR2=10*NBR2+J-48
      GO TO 580
590   IF (NBR2.LT.NBR1) GO TO 530
      NBR1=NBR1-1
600   IF (NBR1.GE.LINEI-1) GO TO 620
      WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD)
610   FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1)
      NERRS=2
      GO TO 60
620   IF (NCHCMD.LE.0) GO TO 630
      IF (LINEI.LE.NBR1) GO TO 630
      IF (NUMBER.EQ.1) GO TO 70
C     SKIP INTAPE UNTIL NBR2 IS SKIPPED.
      MODEI=1
      IF (LINEI.GE.NBR2) MODEI=0
      IF (LINEI-NBR2) 650,650,70
C     COPY FROM INTAPE UNTIL NBR1 COPIED.
630   MODEO=MODEI
      NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTAPE.EQ.0) GO TO 640
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 770
640   CALL EXCHTP (INTREC,LINEI)
      MODEI=0
      IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650
      IF (LINEI.EQ.NBR1) GO TO 650
      MODEI=1
650   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 760
      LINEI=LINEI+1
      IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620
C     73 = ASCII I
      INEND=1
      IF (NCHCMD.LE.0) GO TO 660
      I=NBR2
      IF (NUMBER.EQ.1) I=NBR1
      IF (LINEI-I) 490,490,70
660   IF (NERRS.EQ.0) GO TO 675
      J=1
      IF (PHASE.EQ.8) J=2
      WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS
670   FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.)
675   NERRG=MAX0(NERRG,NERRS)
      IF (OPTL+OPTS.NE.0) GO TO 690
      IF (OUTAPE+OUFILE.EQ.0) LINEO=0
      IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO
680   FORMAT (I9,14H IMAGES COPIED)
      GO TO 710
690   WRITE (PRINTR,700)
700   FORMAT (1H1)
      CHAR1L=ONE
710   IF (OUFILE.EQ.0) GO TO 720
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
720   IF (ITYPEI.NE.69) GO TO 750
C     69 = ASCII E
C
C     END OF FILE ON INPUT TAPE (UPDATE MODE).
C
      IF (INTOPN.LT.0) GO TO 750
      DO 730 I=1,40
730   HOLCMD(I+1)=TXDISK(I)
      HOLCMD(1)=32
      IF (TXDISK(1).NE.32) HOLCMD(1)=61
C     32 = ASCII BLANK, 61 = ASCII =
      CALL EXCHAH (HOLCMD,41)
      WRITE (PRINTR,740) (HOLCMD(I),I=1,41)
740   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1)
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
750   TRANS=1
      GO TO 790
C
C     ERROR MESSAGES.
C
760   NUMBER=1
      GO TO 780
770   NUMBER=2
780   EQUAL=ISTAT
      TRANS=8
C
C     RETURN TO THE TRANSITION PROGRAM.
C
790   PHASE=2
      IF (OUTOPN.EQ.0) PHASE=1
      RETURN
C
      END
      SUBROUTINE EXCHC8
C
C     PRINT ERROR MESSAGES.
C
C     ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE
      INTEGER S(31)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/
      DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/
      DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/
      DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/
      DATA S(29),S(30),S(31)                         /4,5,5        /
C
C             1  2  3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4
     160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751),
     2NUMBER
C     16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
10    WRITE (PRINTR,20) EQUAL
20    FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.)
      GO TO 50
30    WRITE (PRINTR,40) EQUAL
40    FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.)
50    GO TO (60,80,100,120,140,160), EQUAL
60    WRITE (PRINTR,70)
70    FORMAT (22H BLOCK SEQUENCE ERROR.)
      GO TO 180
80    WRITE (PRINTR,90)
90    FORMAT (20H BLOCK IS TOO SHORT.)
      GO TO 180
100   WRITE (PRINTR,110)
110   FORMAT (11H I/O ERROR.)
      GO TO 180
120   WRITE (PRINTR,130)
130   FORMAT (18H RECORD TOO LARGE.)
      GO TO 180
140   WRITE (PRINTR,150)
150   FORMAT (21H UNKNOWN RECORD TYPE.)
      GO TO 180
160   WRITE (PRINTR,170)
170   FORMAT (25H FIRST BLOCK NOT A LABEL.)
      GO TO 760
180   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1)
      INFILE=0
C
C     RETURN TO QUIT SEGMENT.
C
      TRANS=9
      GO TO 800
C
200   WRITE (PRINTR,210)
210   FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.)
      GO TO 760
220   WRITE (PRINTR,230)
230   FORMAT (//20H0INTAPE NOT DEFINED.)
      GO TO 760
240   WRITE (PRINTR,250)
250   FORMAT (//23H0UNABLE TO OPEN INTAPE.)
      GO TO 10
260   WRITE (PRINTR,270)
270   FORMAT (//23H0UNABLE TO OPEN OUTAPE.)
      GO TO 30
280   WRITE (PRINTR,290)
290   FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.)
      GO TO 760
300   WRITE (PRINTR,310)
310   FORMAT (//19H0DATE NOT SUPPLIED.)
      GO TO 760
320   WRITE (PRINTR,330)
330   FORMAT (//19H0SITE NOT SUPPLIED.)
      GO TO 760
340   WRITE (PRINTR,350) INTAPE
350   FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4)
      GO TO 760
360   WRITE (PRINTR,370)
370   FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.)
      GO TO 760
380   WRITE (PRINTR,390)
390   FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.)
      GO TO 760
400   WRITE (PRINTR,410)
410   FORMAT (//27H0COMMAND HAS IMPROPER DATE.)
      GO TO 760
420   WRITE (PRINTR,430) EQUAL
430   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.)
      GO TO 780
440   WRITE (PRINTR,450)
450   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.)
      IF (ICOMD) 780,560,780
460   WRITE (PRINTR,470) N1RECI
470   FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO
     1N (,I5,2H).)
      GO TO 760
480   WRITE (PRINTR,490) EQUAL
490   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
500   WRITE (PRINTR,510)
510   FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.)
      GO TO 760
520   WRITE (PRINTR,530)
530   FORMAT (//23H0WORK FILE NOT DEFINED.)
      GO TO 760
540   WRITE (PRINTR,550)
550   FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.)
      GO TO 760
560   WRITE (PRINTR,570) EQUAL
570   FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.)
      GO TO 760
580   WRITE (PRINTR,590)
590   FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE
     1R.)
      GO TO 760
600   WRITE (PRINTR,610)
610   FORMAT (//12H0TOO MANY (.)
      GO TO 760
620   WRITE (PRINTR,630) EQUAL
630   FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.)
      GO TO 760
640   WRITE (PRINTR,650) EQUAL
650   FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.)
      GO TO 760
660   WRITE (PRINTR,670) EQUAL
670   FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.)
      GO TO 760
680   WRITE (PRINTR,690) EQUAL
690   FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.)
      GO TO 760
700   WRITE (PRINTR,710) EQUAL
710   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
720   WRITE (PRINTR,730) N1RECI
730   FORMAT (//21H0INTAPE POSITIONED AT,I5,25H.  BACKWARD SKIP IGNORED.
     1)
      GO TO 780
740   WRITE (PRINTR,750)
750   FORMAT (//23H0COMMAND IS INCOMPLETE.)
      GO TO 760
751   WRITE (PRINTR,752)
752   FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA
     1PE OR OUTPUT.)
760   WRITE (PRINTR,770)
770   FORMAT (23H COMMAND NOT PROCESSED.)
780   WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD)
790   FORMAT ((1X,80A1))
C
C     RETURN TO COMMAND PROCESSSOR.
C
      CHAR1L=0
      NERRS=MAX0(S(NUMBER),NERRS)
      NERRG=MAX0(NERRG,NERRS)
      TRANS=1
C
C     RETURN TO TRANSITION PROGRAM.
C
800   RETURN
C
      END
      SUBROUTINE EXCHC9 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO
C     ERRORS.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KQUIT /20/
C
      IF (INFILE.EQ.0) GO TO 10
      IF (MODIFY.NE.82) GO TO 5
C     82 = ASCII R
      ACTION=2
C     ACTION = 2 MEANS REWIND INFILE.
      CALL EXCHIM
5     ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      CALL EXCHIM
      INFILE=0
      NCHCMD=0
      GO TO 50
10    IF (OPTC*OUFILE.EQ.0) GO TO 20
      ACTION=0
      NCHOUT=4
      CALL EXCHOU (COMD(1,KQUIT))
20    ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      IF (OUTOPN.EQ.0) GO TO 30
C     WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC)
C     CLOSE THE INPUT TAPE.
30    IF (INTOPN.EQ.0) GO TO 40
      ISTAT=4
      CALL EXCHRT (ISTAT,OBLOCK)
C
C     RETURN TO MAIN PROGRAM.
C
40    TRANS=0
      IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG
45    FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.)
      GO TO 60
C
C     RETURN TO THE COMMAND DECODER.
C
50    TRANS=1
60    RETURN
C
      END
=TES FILE=15
/FORT,M,L,B
C     VARIAN 620 - 7X MAIN PROGRAM FOR TEXT EXCHANGE PROGRAMS.
C
C     THE FOLLOWING STATEMENT ALLOCATES SPACE FOR TAPE INPUT.
C
      INTEGER IBLOCK(3600)
C
C     COMMON BLOCKS /EXCHOC/ AND /EXCHPC/ ARE NOT NEEDED IN THE
C     SIMPLE PROGRAM, BUT LMGEN REQUIRES THAT THEY BE PUT IN THE
C     MAIN PROGRAM OF THE COMPREHENSIVE PROGRAM.
C
      INTEGER DEFALT(4)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      INTEGER FNAMES(4,3)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      COMMON /FNAMES/ FNAMES
      DATA DEFALT(1),DEFALT(2),DEFALT(3),DEFALT(4) /2HEX,2HCH,2HIN,0/
C
C     ASSIGN DEFAULT FILE NAME FOR INTAPE FILE.
C
      DO 10 I = 1,4
10    FNAMES(I,2)=DEFALT(I)
C     GET FILE NAME FROM GLOBAL FCB.
      IF (INTAPE.LE.10) CALL XHGFCB (INTAPE,FNAMES(1,2))
C
      NWCBI=90
      READER=2
      PRINTR=5
      CALL EXCH (IBLOCK)
      CALL EXIT
      END
      BLOCK DATA
C
C     BLOCK DATA FOR THE TAPE EXCHANGE PROGRAM.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA INTAPE /0/, OUTAPE /0/, INFILE /0/, OUFILE /0/
      DATA INTEXT /0/, INALT /0/
C
      DATA CHAR1L /1H1/
C                                                        A  U  T  H
      DATA COMD(1,1) ,COMD(2,1) ,COMD(3,1) ,COMD(4,1)  /65,85,84,72/
C                                                        C  O  M  M
      DATA COMD(1,2) ,COMD(2,2) ,COMD(3,2) ,COMD(4,2)  /67,79,77,77/
C                                                        C  O  P  Y
      DATA COMD(1,3) ,COMD(2,3) ,COMD(3,3) ,COMD(4,3)  /67,79,80,89/
C                                                        D  A  T  A
      DATA COMD(1,4) ,COMD(2,4) ,COMD(3,4) ,COMD(4,4)  /68,65,84,65/
C                                                        D  A  T  E
      DATA COMD(1,5) ,COMD(2,5) ,COMD(3,5) ,COMD(4,5)  /68,65,84,69/
C                                                        G  R  O  U
      DATA COMD(1,6) ,COMD(2,6) ,COMD(3,6) ,COMD(4,6)  /71,82,79,85/
C                                                        I  N  D  E
      DATA COMD(1,7) ,COMD(2,7) ,COMD(3,7) ,COMD(4,7)  /73,78,68,69/
C                                                        I  N  P  U
      DATA COMD(1,8), COMD(2,8), COMD(3,8), COMD(4,8)  /73,78,80,85/
C                                                        N  A  M  E
      DATA COMD(1,9), COMD(2,9), COMD(3,9), COMD(4,9)  /78,65,77,69/
C                                                        I  N  T  A
      DATA COMD(1,10),COMD(2,10),COMD(3,10),COMD(4,10) /73,78,84,65/
C                                                        K  E  Y  W
      DATA COMD(1,11),COMD(2,11),COMD(3,11),COMD(4,11) /75,69,89,87/
C                                                        L  I  M  I
      DATA COMD(1,12),COMD(2,12),COMD(3,12),COMD(4,12) /76,73,77,73/
C                                                        M  A  C  H
      DATA COMD(1,13),COMD(2,13),COMD(3,13),COMD(4,13) /77,65,67,72/
C                                                        O  P  T  I
      DATA COMD(1,14),COMD(2,14),COMD(3,14),COMD(4,14) /79,80,84,73/
C                                                        O  R  I  G
      DATA COMD(1,15),COMD(2,15),COMD(3,15),COMD(4,15) /79,82,73,71/
C                                                        O  U  T  A
      DATA COMD(1,16),COMD(2,16),COMD(3,16),COMD(4,16) /79,85,84,65/
C                                                        O  U  T  P
      DATA COMD(1,17),COMD(2,17),COMD(3,17),COMD(4,17) /79,85,84,80/
C                                                        P  R  E  D
      DATA COMD(1,18),COMD(2,18),COMD(3,18),COMD(4,18) /80,82,69,68/
C                                                        P  R  I  N
      DATA COMD(1,19),COMD(2,19),COMD(3,19),COMD(4,19) /80,82,73,78/
C                                                        Q  U  I  T
      DATA COMD(1,20),COMD(2,20),COMD(3,20),COMD(4,20) /81,85,73,84/
C                                                        R  E  A  D
      DATA COMD(1,21),COMD(2,21),COMD(3,21),COMD(4,21) /82,69,65,68/
C                                                        R  E  F  E
      DATA COMD(1,22),COMD(2,22),COMD(3,22),COMD(4,22) /82,69,70,69/
C                                                        R  E  M  O
      DATA COMD(1,23),COMD(2,23),COMD(3,23),COMD(4,23) /82,69,77,79/
C                                                        R  E  W  I
      DATA COMD(1,24),COMD(2,24),COMD(3,24),COMD(4,24) /82,69,87,73/
C                                                        S  I  T  E
      DATA COMD(1,25),COMD(2,25),COMD(3,25),COMD(4,25) /83,73,84,69/
C                                                        S  K  I  P
      DATA COMD(1,26),COMD(2,26),COMD(3,26),COMD(4,26) /83,75,73,80/
C                                                        T  E  X  T
      DATA COMD(1,27),COMD(2,27),COMD(3,27),COMD(4,27) /84,69,88,84/
C                                                        T  I  T  L
      DATA COMD(1,28),COMD(2,28),COMD(3,28),COMD(4,28) /84,73,84,76/
C                                                        U  P  D  A
      DATA COMD(1,29),COMD(2,29),COMD(3,29),COMD(4,29) /85,80,68,65/
C                                                        W  O  R  K
      DATA COMD(1,30),COMD(2,30),COMD(3,30),COMD(4,30) /87,79,82,75/
C                                                        C  O  N  T
      DATA COMD(1,31),COMD(2,31),COMD(3,31),COMD(4,31) /67,79,78,84/
C                                                        I  D  E  N
      DATA COMD(1,32),COMD(2,32),COMD(3,32),COMD(4,32) /73,68,69,78/
C                                                        I  N  C  L
      DATA COMD(1,33),COMD(2,33),COMD(3,33),COMD(4,33) /73,78,67,76/
C                                                        S  I  G  N
      DATA COMD(1,34),COMD(2,34),COMD(3,34),COMD(4,34) /83,73,71,78/
C                                                        M  A  R  G
      DATA COMD(1,35),COMD(2,35),COMD(3,35),COMD(4,35) /77,65,82,71/
      DATA IDSTEP /0/, IDTXTL /0/
      DATA INDEX /0/
      DATA INDEXS( 1),INDEXS( 2),INDEXS( 3),INDEXS( 4) /0,0,0,0/
      DATA INDEXS( 5),INDEXS( 6),INDEXS( 7),INDEXS( 8) /0,0,0,0/
      DATA INDEXS( 9),INDEXS(10),INDEXS(11),INDEXS(12) /0,0,0,0/
      DATA INDEXS(13),INDEXS(14),INDEXS(15),INDEXS(16) /0,0,0,0/
      DATA INDEXS(17),INDEXS(18),INDEXS(19),INDEXS(20) /0,0,0,0/
      DATA INDEXS(21),INDEXS(22),INDEXS(23),INDEXS(24) /0,0,0,0/
      DATA INDEXS(25),INDEXS(26)                       /0,0    /
      DATA INTOPN /0/
      DATA ITYPEI /0/
      DATA LIMIT /0/
      DATA MARGIN /180/
      DATA NCCBI /180/
      DATA NCCBO /180/
      DATA NCHCMD /0/
      DATA NCHMAX /180/
      DATA NCOMDP /35/
      DATA NCOMDT /35/
      DATA NDATAO /3591/
      DATA NERRCO /0/
      DATA NERRG /0/
      DATA NRWORK /0/
      DATA OUTOPN /0/
      DATA OPTVAL( 1),OPTVAL( 2),OPTVAL( 3),OPTVAL( 4) /0,0,0,0/
      DATA OPTVAL( 5),OPTVAL( 6),OPTVAL( 7),OPTVAL( 8) /0,0,0,0/
      DATA OPTVAL( 9),OPTVAL(10),OPTVAL(11),OPTVAL(12) /0,0,0,0/
      DATA OPTVAL(13),OPTVAL(14),OPTVAL(15),OPTVAL(16) /0,0,0,0/
      DATA OPTVAL(17),OPTVAL(18),OPTVAL(19),OPTVAL(20) /0,0,0,0/
      DATA OPTVAL(21),OPTVAL(22),OPTVAL(23),OPTVAL(24) /0,0,0,0/
      DATA OPTVAL(25),OPTVAL(26)                       /0,0    /
      DATA PHASE /1/
C     INDICATE THAT NO PREDICATES ARE DEFINED.
      DATA PRED(1,1),PRED(1,2),PRED(1,3),PRED(1,4),PRED(1,5) /0,0,0,0,0/
      DATA PRED(1,6),PRED(1,7),PRED(1,8)                     /0,0,0    /
      DATA SITE(1) /0/
      DATA TITLE(1) /32/
C     32 = ASCII BLANK
      DATA TODAY (1) /0/
      DATA TRANS /1/
      END
      SUBROUTINE EXCH (IBLOCK)
C
C     SPERRY 620/7X INTERFACE TO COMPREHENSIVE EXCHANGE PROGRAM
C
      INTEGER IBLOCK(1)
C
C     ALLOCATE SPACE FOR TAPE OUTPUT
C
      INTEGER OBLOCK(1800)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      NWCBO=90
      WORKF=8
      CALL EXCHTR (IBLOCK,OBLOCK)
      RETURN
      END
      SUBROUTINE EXCHAH (RECORD,NCHAR)
C
C     CONVERT A RECORD MADE OF INTEGERS REPRESENTING ASCII CHARACTERS TO
C     HOLLERITH FORMAT.
C     THIS PROGRAM IS FOR THE SPERRY 620/7X COMPUTERS ONLY.
C
C     RECORD IS THE RECORD TO BE CONVERTED.  THE HOLLERITH IS STORED
C     IN RECORD ALSO
      INTEGER RECORD(1)
C
C     NCHAR IS THE NUMBER OF CHARACTERS TO BE CONVERTED
C
      INTEGER SIGN
      DATA SIGN /Z8000/
C
      DO 10 I=1,NCHAR
10    RECORD(I)=SIGN .OR. (256*RECORD(I))
      RETURN
      END
      SUBROUTINE  EXCHIM
C
C     READ A COMMAND OR TEXT IMAGE FROM  1.  ALTERNATE CORRECTION FILE,
C                                        2.  TEXT FILE,
C                                        3.  INPUT FILE,
C                                        4.  SYSTEM READER.
C     PUT THE HOLLERITH COMMAND IN HOLCMD,
C     PUT THE ASCII EQUIVALENT IN COMAND,
C     PUT THE NUMBER OF CHARACTERS IN NCHCMD.
C     IF A SYSTEM END-OF-FILE IS SENSED, SET NCHCMD=-1.
C
C     THIS IS THE SPERRY 620 / 7X VERSION.
C
      INTEGER BLANK,NOSIGN,SIGNS
      INTEGER BUFFS(120,3),FILE(6),IFCB(14,3),LUN(3),NCHR(4)
      INTEGER FNAMES(4,3)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /FNAMES/ FNAMES
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA BLANK /2H  /, NOSIGN /Z7FFF/, SIGNS /Z8080/
      DATA LUN(1),LUN(2),LUN(3) /0,0,0/
      DATA NCHR(1),NCHR(2),NCHR(3),NCHR(4) /80,80,80,80/
C
C     DETERMINE WHICH FILE TO READ.
C
      I=INALT
      NF=1
      IF (I.GT.0) GO TO 10
      I=INTEXT
      NF=2
      IF (I.NE.0) GO TO 10
      I=INFILE
      NF=3
      IF (I.NE.0) GO TO 10
      I=READER
      NF=4
10    IF (ACTION.NE.2) IF (ACTION) 90,20,70
C     READER IS NEVER REWOUND
      IF (LUN(NF).NE.I) REWIND I
      IFCB(4,NF)=1
      GO TO 90
C     READ
20    NCHCMD=NCHR(NF)
      READ (I,30,END=80,ERR=80) (HOLCMD(J),J=1,NCHCMD)
30    FORMAT (180A1)
40    IF (HOLCMD(NCHCMD).NE.BLANK) GO TO 50
      NCHCMD=NCHCMD-1
      IF (NCHCMD.NE.1) GO TO 40
50    DO 60 I=1,NCHCMD
60    COMAND(I)=(HOLCMD(I).AND.NOSIGN)/256
      GO TO 90
C     OPEN
70    IF (EQUAL.GT.NCHCMD.OR.EQUAL.EQ.0) GO TO 90
      IF (LUN(NF).EQ.I) CALL V$CLOS (I,0)
      LUN(NF)=I
      IFCB(8)=FNAMES(1,1)
      IFCB(9)=FNAMES(2,1)
      IFCB(10)=FNAMES(3,1)
      IFCB(3)=FNAMES(4,1)
      IREC=120
      IF (MODIFY.EQ.66) IREC=NCHR(NF)/2
      CALL V$OPNB (I,I,IFCB(1,NF),0,IREC,BUFFS(1,NF),0)
      GO TO 90
80    NCHCMD=-1
90    ACTION=0
      RETURN
C
      END
      SUBROUTINE EXCHOU (OUTPUT)
C
C     NATIVE FORMAT OUTPUT PROGRAM FOR THE TEXT EXCHANGE PROGRAM.
C     SPERRY (EX-VARIAN) 620, 7X VERSION.
C
C     OUTPUT IS THE RECORD (IN ASCII) TO BE WRITTEN.
C     THE NUMBER OF CHARACTERS TO BE WRITTEN IS IN NCHOUT.
C
C     THE NEW SEQUENCE NUMBER OF THE IMAGE IS IN OUTPUT(180),
C     THE ORIGINAL SEQUENCE NUMBER IS IN OUTPUT(179).  IF OUTPUT(180)
C     IS LESS THAN ONE, THE IMAGE IS A CONTROL IMAGE.  IF OUTPUT(180)
C     IS GREATER THAN ZERO AND OUTPUT(179) IS ZERO, THE IMAGE IS A NEW
C     IMAGE.
C
      INTEGER OUTPUT(1)
      INTEGER WORK(240),BLANK,DEVTYP,DISK,POSN,SIGN
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA BLANK /1H /, DISK /2HD0/, SIGN /Z8000/
C
C     DECIDE WHETHER TO OPEN, CLOSE OR WRITE.
C
      IF (ACTION) 70,10,110
C     WRITE NCHOUT CHARACTERS TO OUFILE.
10    IF (DEVTYP.EQ.DISK) GO TO 30
      DO 20 I=1,NCHOUT
20    WORK(I)=SIGN.OR.(256*OUTPUT(I))
      WRITE (OUFILE,40) (WORK(I),I=1,NCHOUT)
      GO TO 130
C     OUTPUT IS PACKED DISK.  ASSUME 80 CHARACTER IMAGES.
30    DO 60 I=1,80
      J=32
      IF (I.LE.NCHOUT) J=OUTPUT(I)
      IF (POSN.LT.240) GO TO 50
      WRITE (OUFILE,40) WORK
40    FORMAT (240A1)
      POSN=0
50    POSN=POSN+1
60    WORK(POSN)=SIGN.OR.(256*J)
      GO TO 130
C     CLOSE OUTPUT OR GET TO SECTOR SYNC.
70    IF (POSN.EQ.0) GO TO 100
      IF (POSN.GE.240) GO TO 90
      DO 80 I=POSN,239
80    WORK(I+1)=BLANK
90    WRITE (OUFILE,40) WORK
100   IF (IABS(ACTION).NE.2) END FILE OUFILE
      GO TO 120
C     OPEN OUTPUT
110   CALL XHDEVI (OUFILE,DEVTYP)
      DEVTYP=DEVTYP.AND.(-16)
120   POSN=0
130   ACTION=0
      RETURN
C
      END
      SUBROUTINE EXCHRT (ISTAT,DBLOCK)
C
C     VARIAN 620, 7X, USING VORTEX
C
C     READ A BLOCK FROM, OR REWIND, THE EXCHANGE TAPE.
C     INPUT:
C     ISTAT = 1 MEANS OPEN WITH NO REWIND.
C     ISTAT = 2 MEANS REWIND (CLOSE WITH REWIND).
C     ISTAT = 3 MEANS READ.
C     ISTAT = 4 MEANS CLOSE WITH NO REWIND.
C
C     OUTPUT:
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR WAS DETECTED.
C
C     DBLOCK IS THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
C
      INTEGER DBLOCK(1)
      INTEGER IFCB(10)
C
      INTEGER FNAMES(4,3)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /FNAMES/ FNAMES
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
      I=ISTAT
      ISTAT=0
      GO TO (10,70,20,130), I
C
C     OPEN FILE.  MAY BE DISK.
C
10    IFCB(3)=768+FNAMES(4,2)
      IFCB(8)=FNAMES(1,2)
      IFCB(9)=FNAMES(2,2)
      IFCB(10)=FNAMES(3,2)
      CALL XHOPEN (INTAPE,IFCB)
      IFCB(4)=1
C     REWIND IF DISK.
      GO TO 130
C
C     READ A BLOCK.
C
20    NWORDS=(NDATAI+NERRCI+10)/2
      I=0
30    CALL XHREAD (INTAPE,IFCB,NWORDS,DBLOCK,ISTAT)
      IF (ISTAT) 40,60,130
40    IF (BLKSQI.NE.0) GO TO 50
      IF (I.NE.0) GO TO 50
C     ALLOW ONE END OF FILE MARK WHEN READING HEADER.
      I=1
      GO TO 30
50    ISTAT=3
      GO TO 130
60    NCDBI=NWORDS+NWORDS
      IFCB(4)=IFCB(4)+1
      IF (BLKSQI.NE.0) IFCB(4)=IFCB(4)+(NWORDS-1)/120
C     UPDATE DISK ADDRESS
      GO TO 130
C
C     REWIND.
C
70    CALL XHREW (INTAPE,IFCB)
C
130   RETURN
C
      END
      SUBROUTINE EXCHTR (IBLOCK,OBLOCK)
C
C     TRANSFER FROM ONE COMMAND PROCESSING ROUTINE TO ANOTHER.
C     SPERRY 620, 7X VERSION.
C
      INTEGER IBLOCK(1), OBLOCK(1)
C
      INTEGER SEGS(9),SEGNAM(3)
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA SEGS( 1),SEGS( 2),SEGS( 3),SEGS( 4) /2HV1,2HV2,2HV3,2HV4/
      DATA SEGS( 5),SEGS( 6),SEGS( 7),SEGS( 8) /2HV5,2HV6,2HV7,2HV8/
      DATA SEGS(9) /2HV9/
      DATA SEGNAM(1),SEGNAM(2),SEGNAM(3) /2HEX,2HCH,2HV*/
C
      WORKF=-IABS(WORKF)
10    IF (TRANS.LE.0) RETURN
      SEGNAM(3)=SEGS(TRANS)
C
C     LOAD THE SEGMENT, JUMP TO IT, PASS PARAMETERS.
C
      GO TO (40,20,40,30,40,40,40,20,40), TRANS
C             1  2  3  4  5  6  7  8  9
20    CALL OVLAY (0,1,SEGNAM)
      GO TO 10
30    CALL OVLAY (0,1,SEGNAM,IBLOCK)
      GO TO 10
40    CALL OVLAY (0,1,SEGNAM,IBLOCK,OBLOCK)
      GO TO 10
      END
      SUBROUTINE EXCHWT (ISTAT,DBLOCK)
C
C     VARIAN 620, 7X, USING VORTEX.
C
C     WRITE A BLOCK ON THE EXCHANGE TAPE.
C
C     INPUT:
C     ISTAT = 1 MEANS OPEN OUTPUT WITH NO REWIND
C     ISTAT = 2 MEANS WRITE
C     ISTAT = 3 MEANS WRITE END FILE AND CLOSE WITH NO REWIND.
C
C     OUTPUT:
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ON
C              TAPE).
      INTEGER DBLOCK(1)
      INTEGER OFCB(10)
C
      INTEGER FNAMES(4,3)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /FNAMES/ FNAMES
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
      I=ISTAT
      ISTAT=0
      GO TO (10,20,30), I
C
C     OPEN OUTPUT.  MAY BE DISK.
C
10    OFCB(3)=768+FNAMES(4,3)
      OFCB(8)=FNAMES(1,3)
      OFCB(9)=FNAMES(2,3)
      OFCB(10)=FNAMES(3,3)
      CALL XHOPEN (OUTAPE,OFCB)
      OFCB(4)=1
C     REWIND IF DISK.
      GO TO 100
C
C     WRITE
C
20    NWORDS=(CCDBO+1)/2
      IF (BLKSQO.NE.0) NWORDS=(NDATAO+NERRCO+10)/2
      CALL XHWRIT (OUTAPE,OFCB,NWORDS,DBLOCK,ISTAT)
      OFCB(4)=OFCB(4)+1
      IF (BLKSQO.NE.0) OFCB(4)=OFCB(4)+(NWORDS-1)/120
C     UPDATE DISK ADDRESS.
      GO TO 100
C
C     CLOSE WITH NO REWIND (END FILE).
C
30    CALL XHCLOZ (OUTAPE,OFCB)
      WRITE (PRINTR,40) BLKSQO,OUTAPE
40    FORMAT (I6,23H BLOCKS WRITTEN ON TAPE,I4)
      GO TO 100
C
100   RETURN
C
      END
/WEOF,BO
/DASMR
*
*      VARIAN 620, 7X ASSEMBLER MODULES FOR THE TAPE EXCHANGE PROGRAM.
*
NCH    EQU     180           NUMBER OF CHARACTERS TO PACK/UNPACK
       EXT     $SE
*
*      PACK NCH RIGHT JUSTIFIED CHARACTERS INTO WORDS.
*      CALL EXCHPA (BUFC,BUFW)
*
       NAME    EXCHPA
PACKL  LDAE*   BUFCP         GET A CHARACTER
       INR     BUFCP         BUMP CHARACTER POINTER
       LRLA    8             LEFT JUSTIFY
       ORAE*   BUFCP         ADD ANOTHER CHARACTER
       INR     BUFCP         BUMP CHARACTER POINTER
       STAE*   BUFWP         STORE A WORD
       INR     BUFWP         BUMP WORD POINTER
       DXR                   DECREMENT LOOP COUNTER
       JXNZ    PACKL         LOOP UNTIL DONE
       JMP     *-*           RETURN
EXCHPA BES     0             ENTRY
       CALL    $SE,2         UNTANGLE CALLING SEQUENCE
BUFCP  DATA    0             CHARACTER POINTER
BUFWP  DATA    0             WORD POINTER
       LDX     NCHDAT        LOOP COUNTER
       JMP     PACKL
       EJEC
*      UNPACK WORDS INTO NCH RIGHT JUSTIFIED CHARACTERS
*      CALL EXCHUN (BUFW,BUFC)
*
       NAME    EXCHUN
UNPKL  LDAE*   BUFWU         GET A WORD
       INR     BUFWU         BUMP WORD POINTER
       LLSR    8             SPLIT WORD INTO
       LSRB    8                TWO CHARACTERS
       STAE*   BUFCU         STORE A CHARACTER
       INR     BUFCU         BUMP CHARACTER POINTER
       STBE*   BUFCU         STORE ANOTHER CHARACTER
       INR     BUFCU         BUMP CHARACTER POINTER
       DXR                   DECREMENT LOOP COUNTER
       JXNZ    UNPKL         LOOP UNTIL DONE
       JMP     *-*           RETURN
EXCHUN BES     0             ENTRY
       CALL    $SE,2         UNTANGLE CALLING SEQUENCE
BUFWU  DATA    0             WORD BUFFER
BUFCU  DATA    0             CHARACTER BUFFER
       LDX     NCHDAT        LOOP COUNTER
       JMP     UNPKL
NCHDAT DATA    NCH/2         LOOP COUNTER FOR PACK AND UNPACK
       EJEC
*
*      VORTEX I/O INTERFACE ROUTINES.
*
BS8    EQU     0431          BIT 8 SET
RHW    EQU     0463          RIGHT HALFWORD MASK
THREE  EQU     0464          CONSTANT 3
*
*      CALL XHOPEN (UNITOP,OPFCB)
*      UNITOP=UNIT TO BE OPENED,
*      OPFCB=FILE CONTROL BLOCK.
*
       NAME    XHOPEN
XHOP1  LDB     OPFCB
       STB     OPMAC+4       STORE USER FCB IN OPEN MACRO
       JSR     UNIT,1        PUT FORTRAN UNIT NUMBER IN OPEN MACRO.
       MZE     UNITOP
OPMAC  OPEN    *-*,*-*,0,1   OPEN WITH NO REWIND
       JMP     *-*           RETURN
XHOPEN BES     0             ENTRY / RETURN
       CALL    $SE,2         UNTANGLE CALLING SEQUENCE
UNITOP DATA    0             FORTRAN UNIT
OPFCB  DATA    0             ADDRESS OF USER FCB
       JMP     XHOP1
       EJEC
*      CALL XHGFCB (UNITGF,GFNAME) TO GET FILE NAME FROM GLOBAL FCB.
*      UNITGF=UNIT NUMBER.
*      GFNAME=RETURNS FILE NAME IN FIRST 3 WORDS, KEY IN FOURTH WORD.
*
       NAME    XHGFCB
XHGF1  LDXE*   UNITGF        GET UNIT NUMBER
       LDXE    FCBS,1        GET FCB ADDRESS FOR UNIT
       JXZ     XHGFX         EXIT IF NO GLOBAL FCB
       LDB     GFNAME        GET ADDRESS OF USERS FILE NAME
       LDA     7,1           GET FIRST WORD OF FILE NAME
       STA     0,2
       LDA     8,1           GET SECOND WORD OF FILE NAME
       STA     1,2
       LDA     9,1           GET THIRD WORD OF FILE NAME
       STA     2,2
       LDA     2,1
       ANA     RHW           GET KEY FROM GLOBAL FCB
       STA     3,2
XHGFX  JMP     *-*           RETURN
XHGFCB BES     0
       CALL    $SE,2         UNTANGLE CALLING SEQUENCE
UNITGF DATA    0             ADDRESS OF UNIT
GFNAME DATA    0             ADDRESS OF USER FILE NAME
       JMP     XHGF1
*
       EXT     PIFCB,BIFCB,BOFCB,SSFCB,GOFCB,POFCB
FCBS   DATA    0,0,0,0,PIFCB,0,BIFCB,BOFCB,SSFCB,GOFCB,POFCB
       EJEC
*
*      CALL XHREAD (UNITRD,RDFCB,NWREAD,IBLOCK,ISTAT)
*      UNITRD=FORTRAN UNIT NUMBER.
*      RDFCB=USERS FILE CONTROL BLOCK.
*      NWREAD=INPUT - NUMBER OF WORDS TO READ,
*             OUTPUT - ACTUAL NUMBER OF WORDS READ.
*      IBLOCK=AREA TO READ INTO.
*      ISTAT=0 IF OK, 3 IF ERROR BIT SET IN READ MACRO.
*
       NAME    XHREAD
XHR1   LDX     RDFCB
       STX     RDMAC+4       PUT USER FCB ADDRESS IN READ MACRO
       LDAE*   NWREAD        NUMBER OF WORDS TO READ
       STA     0,1
       LDA     IBLOCK        BUFFER ADDRESS
       STA     1,1
       JSR     UNIT,1        PUT FORTRAN UNIT NUMBER IN MACRO
       MZE     UNITRD
RDMAC  READ    *-*,*-*,0,0   READ
RDSTAT STAT    RDMAC,RDERR,RDEOF,RDERR,RDSTAT
       LDAE    RDMAC+5       ACTUAL NUMBER OF WORDS READ
       STAE*   NWREAD
       TZA                   NORMAL READ COMPLETE
       DATA    01006         SKIP NEXT WORD
RDERR  LDA     THREE         I/O ERROR
       DATA    01006         SKIP NEXT WORD
RDEOF  DECR    1             END OF FILE MARK.
       STAE*   ISTAT         STORE STATUS IN CALLING PROGRAM
       JMP     *-*
XHREAD BES     0             ENTRY/RETURN
       CALL    $SE,5         UNTANGLE CALLING SEQUENCE
UNITRD DATA    0             FORTRAN UNIT
RDFCB  DATA    0             USERS FCB ADDRESS
NWREAD DATA    0             NUMBER OF WORDS TO READ
IBLOCK DATA    0             BUFFER
ISTAT  DATA    0             STATUS FLAG
       JMP     XHR1
       EJEC
*      CALL XHREW (UNITRW,RWFCB)
*      UNITRW=UNIT TO REWIND
*      RWFCB=USERS FILE CONTROL BLOCK.
*
       NAME    XHREW
XHREW1 LDX     RWFCB
       STX     REWMAC+4      STORE USERS FCB ADDRESS IN REWIND MACRO
       JSR     UNIT,1        PUT FORTRAN UNIT NUMBER IN MACRO
       MZE     UNITRW
REWMAC REW     *-*,*-*,0     REWIND
       JMP     *-*           RETURN
XHREW  BES     0             ENTRY
       CALL    $SE,2         UNTANGLE CALLING SEQUENCE
UNITRW DATA    0
RWFCB  DATA    0             USERS FILE CONTROL BLOCK ADDRESS
       JMP     XHREW1
       EJEC
*      CALL XHWRIT (UNITWR,WRFCB,NWWRIT,OBLOCK,OSTAT)
*      UNITWR=FORTRAN UNIT TO WRITE ON
*      WRFCB=USERS FILE CONTROL BLOCK
*      NWWRIT=NUMBER OF WORDS TO WRITE
*      OUTPUT BUFFER
*      OUTPUT STATUS INDICATOR
*
       NAME    XHWRIT
XHWRT1 LDX     WRFCB
       STX     WRMAC+4       STORE USERS FCB ADDRESS IN WRITE MACRO
       LDAE*   NWWRIT        NUMBER OF WORDS TO WRITE
       STA     0,1
       LDA     OBLOCK        OUTPUT BUFFER
       STA     1,1
       JSR     UNIT,1        PUT FORTRAN UNIT NUMBER IN MACRO
       MZE     UNITWR
WRMAC  WRITE   *-*,*-*,0,0   WRITE
       LDAE    WRMAC+2       STATUS, ETC
       ANA     BS8           ERROR BIT
       JAZ     *+3
       LDA     THREE
       STAE*   OSTAT         STATUS INDICATOR
       JMP     *-*           RETURN
XHWRIT BES     0             ENTRY
       CALL    $SE,5         UNTANGLE CALLING SEQUENCE
UNITWR DATA    0
WRFCB  DATA    0
NWWRIT DATA    0
OBLOCK DATA    0
OSTAT  DATA    0
       JMP     XHWRT1
       EJEC
*      CALL XHCLOZ (UNITCL,CLZFCB)
*      UNITCL=FORTRAN UNIT NUMBER TO CLOSE
*      CLZFCB=USERS FILE CONTROL BLOCK
*
       NAME    XHCLOZ
XHCLZ1 LDX     CLZFCB
       STX     CLZMAC+4      PUT USERS FCB ADDRESS IN CLOSE MACRO
       JSR     UNIT,1        PUT FORTRAN UNIT NUMBER IN MACRO
       MZE     UNITCL
CLZMAC CLOSE   *-*,*-*,0,1   CLOSE WITH UPDATE (END FILE TAPE)
       JMP     *-*           RETURN
XHCLOZ BES     0             ENTRY
       CALL    $SE,2         UNTANGLE CALLING SEQUENCE
UNITCL DATA    0
CLZFCB DATA    0
       JMP     XHCLZ1
       EJEC
*      PUT THE UNIT NUMBER INTO THE I/O MACRO.
*      JSR     UNIT,1
*      DATA    ADDRESS OF UNIT NUMBER
*      I/O MACRO
*
UNIT   LDAE*   0,1           GET THE UNIT NUMBER
       LLSR    8             PUT IT IN B(8-15)
       LDA     4,1           GET WORD 3 OF THE MACRO
       LSRA    8             PUT OP CODE, ETC IN A(0-7)
       LLSR    8             PUT OP CODE, UNIT NUMBER TOGETHER
       STB     4,1           PUT THEM IN WORD 3 OF THE MACRO
       IJMP    1,1           GO DO THE I/O
       SPAC
       EJEC
*      FIND THE LUN EQUIVALENT TO A TWO CHARACTER NAME
*      CALL XHLUN (NAME,LUN)
*      NAME=TWO CHARACTER NAME (2A1 FORMAT)
*      LUN=EQUIVALENT LUN (OUTPUT).
*
V$LUNT EQU     0345
       NAME    XHLUN
XHLUN1 LDB     XHNAME        ADDRESS OF NAME
       LDA     0,2           FIRST CHARACTER OF NAME
       LDB     1,2           SECOND CHARACTER OF NAME
       LSRA    8             PACK TWO CHARACTERS TOGETHER
       LLRL    8
       STA     XHNAME
       TZA
       LDB     XHLUN#        ADDRESS OF LUN
       STA     0,2           DEFAULT LUN = 0 IN CASE NO FIND
       LDX     V$LUNT        ADDRESS OF LUN TABLE
XHLUN2 LDA     0,1
       JAZ*    XHLUN         JUMP IF END OF TABLE
       IXR
       IXR
       SUB     XHNAME
       JANZ    XHLUN2        LOOP IF NOT EQUAL
       DXR
       LDA     0,1           PICK UP EQUIVALENT LUN
       STA     0,2           STORE LUN IN CALLING PROGRAM
       JMP     *-*
XHLUN  BES     0             ENTRY / RETURN
       CALL    $SE,2         UNTANGLE CALLING SEQUENCE
XHNAME DATA    0             ADDRESS OF NAME
XHLUN# DATA    0             ADDRESS OF EQUIVALENT LUN #
       JMP     XHLUN1
       EJEC
*      GET THE EQUIPMENT CODE FOR A LUN
*      CALL XHDEVI (LUN,DEVICE)
*      LUN=LOGICAL UNIT NUMBER
*      DEVICE=FIRST TWO CHARACTERS OF EQUIPMENT CODE.
*
V$LUT1 EQU     0400          ADDRESS OF FIRST LUT BASE
V$DSTB EQU     0355          ADDRESS OF DST BASE
       NAME    XHDEVI
XHDEV1 LDAE*   XHDLUN
       DAR
       STA     XHDLUN
       SUB     =100          LUN LE 100
       TZB
       JAN     XHDEV2        YES
       STA     XHDLUN
       IBR
       SUB     =79           101 LE LUN LE 179
       JAN     XHDEV2        YES
       STA     XHDLUN
       IBR
XHDEV2 SUBE*   V$LUT1,2      SUBTRACT COUNT FOR LUT
       JAP     XHDEV3        JUMP IF LUN TOO BIG FOR LUT
       LDA     XHDLUN
       IAR
       ADD     V$LUT1,2
       TAB
       LDA     0,2           GET DST INDEX
       ANA     RHW           (CURRENT ASSIGNMENT IS IN RHW)
       DAR
       STA     XHDLUN
       ASLA    1
       ADD     XHDLUN        COMPUTE DISPLACEMENT
       ADD     V$DSTB        ADD DST BASE
       TAB
       LDA     1,2           GET DEVICE CODE
       DATA    01006         SKIP NEXT WORD
XHDEV3 TZA
       STAE*   XHDNAM        STORE DEVICE NAME IN CALLING PROGRAM
       JMP     *-*
XHDEVI BES     0             ENTRY / RETURN
       CALL    $SE,2         UNTANGLE CALLING SEQUENCE
XHDLUN DATA    0             LUN
XHDNAM DATA    0             DEVICE NAME
       JMP     XHDEV1
       END
       TITLE   OVLAY
*      INTEFRACE FROM FORTRAN TO VORTEX OVLAY MACRO.
*
*      CALL OVLAY (TYPE,RELOAD,SEGNAM,P1,P2,...)
*      TYPE=0 FOR LOAD & EXECUTE, .NE.0 FOR LOAD & RETURN.
*      RELOAD=0 TO LOAD ALWAYS, .NE.0 TO LOAD ONLY IF NOT LOADED.
*      SEGNAM=3-WORD HOLLERITH SEGMENT NAME.
*      THE RETURN POINT OF THE SEGMENT IS SET TO P1.  THUS WHEN TYPE=0
*      PARAMETERS MAY BE PASSED TO THE SEGMENT.  DO NOT USE P1,P2,...
*      WHEN TYPE .NE. 0.
*
*      AFTER THE SEGMENT IS LOADED, THE LOAD ADDRESS IS IN THE
*      EXTERNALLY AVAILABLE SYMBOL OV$ENT.
*
       EXT     $SE
       EXT     $RTENM
       NAME    OVLAY,OV$ENT
OVLAY1 LDAE*   RELOAD        GET RELOAD FLAG.
       LDX     SEGNAM        GET ADDRESS OF SEGMENT NAME
       JAZ     OVLAY2        FORCE LOAD.
       LDA     0,1
       SUB     OVMAC+3       SEGNAM SAME AS LAST SEGNAM LOADED?
       JANZ    OVLAY2        NO
       LDA     1,1
       SUB     OVMAC+4
       JANZ    OVLAY2        NO
       LDA     2,1
       SUB     OVMAC+5
       JAZ     OVLAY3        SAME.  DO NOT LOAD AGAIN.
OVLAY2 LDBI    OVMAC+3       TO ADDRESS
       CALL    $RTENM        MOVE SEGNAM.  X=FROM ADDRESS
OVMAC  OVLAY   1,*-*,*-*,*-* LOAD SEGMENT, DO NOT JUMP TO IT.
       STX     OV$ENT        STORE LOAD ADDRESS
OVLAY3 LDAE*   TYPE          LOAD / EXECUTE OR LOAD / RETURN ?
       JANZ*   OVLAY         LOAD / RETURN
       LDA     OVLAY
       LDX     OV$ENT        GET ENTRY ADDRESS
       STA     0,1           SAVE RETURN ADDRESS
       IJMP    1,1           OVLAY SETS X TO SEGMENT ENTRY
OV$ENT DATA    *-*           ENTRY ADDRESS (PROVIDED BY V$EXEC).
OVLAY  ENTR
       CALL    $SE,3         UNTANGLE CALLING SEQUENCE
TYPE   DATA    0
RELOAD DATA    0
SEGNAM DATA    0
       JMP     OVLAY1
       END
/WEOF,BO
/FORT,M,L,B
      SUBROUTINE EXCHFO (IOP)
C
C     OPEN AND CLOSE FILES FOR EXCHANGE PROGRAM.
C     IOP LESS THAN ZERO MEANS CLOSE FILE, IOP GREATER THAN ZERO MEANS
C     OPEN FILE.  IABS(IOP) = 1 MEANS READER, = 2 MEANS PRINTER, = 3
C     MEANS WORK FILE, = 4 MEANS INFILE.  IOP = 4 IS USED ONLY BY THE
C     BOOTSTRAP PROGRAM.
C
      INTEGER IOP
C
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
      RETURN
C
      END
      SUBROUTINE EXCHGB (ISTAT,DBLOCK)
C
C     READ A BLOCK FROM THE EXCHANGE TAPE.
C     IGNORE THE ERROR CONTROL SEGMENT.
C     CHECK THE BLOCK SEQUENCE NUMBER.
C     CONVERT THE NUMBERS AT THE HEAD OF THE BLOCK.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK IS TOO SHORT TO CONTAIN THE BLOCK HEADER,
C               OR IF L1PRGI OR L1RECI POINTS OUTSIDE OF THE BLOCK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
C
C
C     READ A BLOCK FROM INTAPE.
C
      BLKSQI=BLKSQI+1
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 160
C
C     GET INFORMATION OUT OF THE BLOCK HEADER.
C
      CCDBI=NERRCI
      CWDBI=NWCBI*(CCDBI/NCCBI)+1
      CPCBI=MOD(CCDBI,NCCBI)
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
      DO 110 JUMP=1,9
      CCDBI=CCDBI+1
      CPCBI=CPCBI+1
      IF (CCDBI.GT.NCDBI) GO TO 130
      IF (CPCBI.LE.NCCBI) GO TO 10
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
10    GO TO (20,30,40,50,60,70,80,90,100), JUMP
20    NEWBLK=256*CBLCKI(CPCBI)
      GO TO 110
30    NEWBLK=NEWBLK+CBLCKI(CPCBI)
      GO TO 110
40    LASTI=CBLCKI(CPCBI)
      GO TO 110
50    L1PRGI=256*CBLCKI(CPCBI)
      GO TO 110
60    L1PRGI=L1PRGI+CBLCKI(CPCBI)
      GO TO 110
70    N1RECI=256*CBLCKI(CPCBI)
      GO TO 110
80    N1RECI=N1RECI+CBLCKI(CPCBI)
      GO TO 110
90    L1RECI=256*CBLCKI(CPCBI)
      GO TO 110
100   L1RECI=L1RECI+CBLCKI(CPCBI)
110   CONTINUE
C
C     CHECK THE BLOCK SEQUENCE NUMBER.
C
      IF (BLKSQI.EQ.NEWBLK) GO TO 150
      ISTAT=1
      WRITE (PRINTR,120) NEWBLK,BLKSQI
120   FORMAT (//26H0BLOCK SEQUENCE NUMBER WAS,I5,18H, SHOULD HAVE BEEN,I
     15//)
      BLKSQI=NEWBLK
      GO TO 160
C
C     FORMAT ERROR
C
130   ISTAT=2
      GO TO 160
C
C     CHECK L1PRGI AND L1RECI.
C
150   IF (L1PRGI.GT.NCDBI) GO TO 130
      IF (L1RECI.GT.NCDBI) GO TO 130
      ISTAT=0
160   RETURN
C
      END
      SUBROUTINE EXCHGR (ISTAT,DBLOCK,RECORD)
C
C     GET A RECORD FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 1 IF THE BLOCK SEQUENCE NUMBER IS WRONG.
C     ISTAT = 2 IF THE BLOCK FORMAT IS WRONG (SEE GETBLK).
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF THE ACTUAL LENGTH OF THE RECORD IS GREATER THAN THE
C               SPACE ALLOWED BY THE USER.  (POSITION IS STILL OK).
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C     THE FIRST CHARACTER OF THE RECORD SEPARATES DATA RECORDS FROM
C     CONTROL RECORDS.  NON-ZERO IS THE GROUP COUNT FOR DATA RECORDS.
C
      ISTAT=0
      NCHACT=0
10    JUMP=1
      GO TO 260
20    NG=CBLCKI(CPCBI)
      IF (NG.EQ.0) GO TO 90
      IF (NG.NE.255) GO TO 30
C
C     END OF SHORT TAPE BLOCK.
C
      CCDBI=NCDBI
      GO TO 10
C
C     UNPACK (IF MODEI.EQ.0) OR COPY (IF MODEI.NE.0) A DATA RECORD TO
C     THE USER RECORD AREA.
C
30    ITYPEI=0
      IF (MODEI.EQ.0) GO TO 40
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NG
40    IG=0
50    JUMP=2
      GO TO 260
60    NR=CBLCKI(CPCBI)
      IF (MODEI.EQ.0) GO TO 70
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NR
      GO TO 160
70    IR=0
C     PUT REMVI INTO THE USER RECORD NR TIMES.
80    IF (IR.GE.NR) GO TO 160
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=REMVI
      IR=IR+1
      GO TO 80
C
C     THE NEXT RECORD IS A CONTROL RECORD.  FIND OUT WHAT KIND.
C
90    JUMP=3
      GO TO 260
100   ITYPEI=CBLCKI(CPCBI)
      IF (ITYPEI.LT.65) GO TO 250
C     65 = ASCII  A
      IF (ITYPEI.GT.90) GO TO 250
C     90 = ASCII  Z
      I=ITYPEI-64
C             A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
      GO TO (160,160,160,160,290,160,160,160,160,220,160,160,160,160,160
     1,110,160,220,160,160,160,160,160,160,160,160), I
C       P   Q   R   S   T   U   V   W   X   Y   Z
C
C     P - PROGRAM HEADER
C
C     CONVERT THE NEXT HEADER ADDRESS AND THE PROGRAM NUMBER
110   REMVI=32
C     RESET THE REMOVED CHARACTER TO ASCII BLANK.
      JUMP=4
      GO TO 260
120   L1PRGI=256*CBLCKI(CPCBI)
      JUMP=5
      GO TO 260
130   L1PRGI=L1PRGI+CBLCKI(CPCBI)
      JUMP=6
      GO TO 260
140   N1RECI=256*CBLCKI(CPCBI)
      JUMP=7
      GO TO 260
150   N1RECI=N1RECI+CBLCKI(CPCBI)
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
160   JUMP=8
      GO TO 260
170   NC=CBLCKI(CPCBI)
      IF (ITYPEI.NE.0) GO TO 180
      IF (MODEI.EQ.0) GO TO 180
      NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=NC
C     COPY NC CHARACTERS TO THE USER RECORD AREA.
180   IC=0
      JUMP=9
190   IF (IC.GE.NC) IF (ITYPEI) 240,210,240
      GO TO 260
200   NCHACT=NCHACT+1
      IF (NCHACT.LE.NCHMAX) RECORD(NCHACT)=CBLCKI(CPCBI)
      IC=IC+1
      GO TO 190
210   IG=IG+1
      IF (IG-NG) 50,240,240
C
C     J - UPDATING AND END OF INPUT TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
220   JUMP=10
      GO TO 260
230   RECORD(1)=CBLCKI(CPCBI)
      NCHACT=1
      IF (ITYPEI.EQ.82) REMVI=RECORD(1)
C     82 = ASCII R
C
C     RETURN TO THE USER PROGRAM.
C
240   IF (NCHACT.GT.NCHMAX) ISTAT=4
      GO TO 290
C
C     CONTROL RECORD TYPE CANNOT BE DETERMINED.
C
250   ISTAT=5
      GO TO 290
C
C     GET A CHARACTER FROM CBLOCK.  UNPACK A NEW BLOCK IF NECESSARY.
C     READ MORE TAPE IF NECESSARY.
C
260   CPCBI=CPCBI+1
      CCDBI=CCDBI+1
      IF (CCDBI.LE.NCDBI) GO TO 270
      CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 290,260,290
270   IF (CPCBI.LE.NCCBI) GO TO 280
      CWDBI=CWDBI+NWCBI
      CPCBI=1
      CALL EXCHUN (DBLOCK(CWDBI),CBLCKI)
280   GO TO (20,60,100,120,130,140,150,170,200,230), JUMP
290   RETURN
C
      END
      SUBROUTINE EXCHNP (ISTAT,DBLOCK)
C
C     SET POINTERS TO READ THE NEXT PROGRAM HEADER FROM THE EXCHANGE
C     TAPE.
C     THIS MODULE IS MACHINE INSENSITIVE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 7 IF THERE ARE NO MORE PROGRAM HEADERS IN THE FILE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      IF (IABS(NRWORK)*WORKF.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
      ISTAT=0
      IF (CCDBI.GE.NCDBI) IF (LASTI-76) 20,30,20
C
C     CHECK FOR END OF FILE OR LAST HEADER IN THE BLOCK.
C
10    IF (L1PRGI.EQ.0) IF (LASTI-76) 20,30,20
C     76 = ASCII L
C
C     NEITHER END OF FILE NOR LAST HEADER IN THE BLOCK.
      CCDBI=L1PRGI-1
      I=NWCBI*(CCDBI/NCCBI)+1
      IF (I.NE.CWDBI) CALL EXCHUN (DBLOCK(I),CBLCKI)
      CWDBI=I
      CPCBI=MOD(CCDBI,NCCBI)
      GO TO 40
C
C     NO MORE HEADERS IN THIS BLOCK.
C
20    CALL EXCHGB (ISTAT,DBLOCK)
      IF (ISTAT) 40,10,40
C
C     END OF FILE.
C
30    ISTAT=7
C
40    RETURN
C
      END
      SUBROUTINE EXCHPB (ISTAT,DBLOCK)
C
C     WRITE A BLOCK ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C     WORK = THE NINE STRUCTURE CHARACTERS OF THE BLOCK.
      INTEGER WORK(9)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
C     PUT ERROR RECOVERY AND TABLE OF CONTENTS NUMBERS INTO BLOCK.
C
      BLKSQO=BLKSQO+1
      WORK(1)=BLKSQO/256
      WORK(2)=MOD(BLKSQO,256)
      WORK(3)=LASTO
      WORK(4)=L1PRGO/256
      WORK(5)=MOD(L1PRGO,256)
      WORK(6)=N1RECO/256
      WORK(7)=MOD(N1RECO,256)
      WORK(8)=L1RECO/256
      WORK(9)=MOD(L1RECO,256)
C
      CPCBO=MOD(NERRCO,NCCBO)
      CWDBO=(NERRCO/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
C
      DO 10 I=1,9
      CPCBO=CPCBO+1
      IF (CPCBO.LE.NCCBO) GO TO 10
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
      CWDBO=CWDBO+NWCBO
      CALL EXCHUN (DBLOCK(CWDBO+1),CBLCKO)
      CPCBO=1
10    CBLCKO(CPCBO)=WORK(I)
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO+1))
C
C     WRITE THE DATA BLOCK ON TAPE.
C
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     CLOSE THE OUTPUT TAPE IF LASTO=76 (ASCII L).
C
      IF (LASTO.NE.76) GO TO 20
      ISTAT=3
      CALL EXCHWT (ISTAT,DBLOCK)
      GO TO 30
C
C     COMPUTE POINTERS FOR NEXT BLOCK OUT.
C
20    L1PRGO=0
      LLPRGO=0
      N1RECO=0
      L1RECO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
C
30    RETURN
C
      END
      SUBROUTINE EXCHPR (ISTAT,DBLOCK,RECORD)
C
C     WRITE A RECORD ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 4 IF A SINGLE TEXT STRING EXCEEDS 255 CHARACTERS, OR A
C             TEXT RECORD CONTAINS MORE THAN 254 GROUPS.
C     ISTAT = 5 IF THE RECORD TYPE CANNOT BE DETERMINED.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
C
C     RECORD = THE USERS RECORD AREA.
      INTEGER RECORD(1)
C
      INTEGER GC,RC(255),CC(255)
C     GC = GROUP COUNT, RC = REMOVED COUNT, CC = CHARACTER COUNT
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      ISTAT=0
      INCHAR=0
C
C     DETERMINE THE RECORD TYPE.
C
      IF (NCHOUT.NE.255) GO TO 10
      ITYPEO=255
      GO TO 70
10    IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=CCDBO-NERRCO
      IF (ITYPEO.NE.0) GO TO 30
C
C     DATA RECORD.
C
      IF (MODEO.NE.0) GO TO 170
C     COMPRESS THE RECORD.
      CALL EXCHSC (RECORD,NCHOUT,REMVO,GC,RC,CC,255)
      IF (GC.GE.255) GO TO 210
      IG=0
C     OUTPUT THE GROUP COUNT.
      CBLCKO(CPCBO)=GC
      JUMP=1
      GO TO 230
20    IG=IG+1
      IF (IG.GT.GC) GO TO 250
      NC=CC(IG)
      INCHAR=INCHAR+RC(IG)
C     OUTPUT REMOVED CHARACTER COUNT.
      CBLCKO(CPCBO)=RC(IG)
      JUMP=2
      GO TO 230
C
C     THE USER SAYS HE HAS A CONTROL RECORD TO WRITE.  FIND OUT
C     WHAT KIND.
C
30    IF (ITYPEO.LT.65) GO TO 220
C     65 = ASCII A
      IF (ITYPEO.GT.90) GO TO 220
C     90 = ASCII  Z
      I=ITYPEO-64
C             A  B  C  D  E  F  G  H  I  J   K  L  M  N  O  P  Q  R   S
      GO TO (40,40,40,40,50,40,40,40,40,200,40,40,40,40,40,60,40,200,40,
     140,40,40,40,40,40,40), I
C      T  U  V  W  X  Y  Z
C
C     A - AUTHOR
C     B - BIBLIOGRAPHIC REFERENCE
C     C - COMMENTS
C     D - DATA TYPE
C     G - GROUPS
C     I - INCLUDE TEXT REQUEST
C     K - KEYWORDS
C     M - MACHINE TYPE
C     O - ORIGINATING SITE
C     S - UPDATING SITE
C     FHLNQTUVWXYZ - UNSPECIFIED TYPES
C
40    IF (NCHOUT-255) 100,100,210
C
C     END OF FILE.
C
50    IF (NERRCO+NDATAO+7-CCDBO) 70,80,80
C
C     P - PROGRAM HEADER.
C
60    IF (NCHOUT.GT.255) GO TO 210
      REMVO=32
C     RESET REMOVED CHARACTER TO ASCII BLANK.
      IF (MOD(NLRECO,10).NE.9) IF (NDATAO+NERRCO-CCDBO) 70,80,80
      IF (CCDBO.EQ.NERRCO+10) GO TO 80
C
C     END OF SHORT TAPE BLOCK.
C
70    CBLCKO(CPCBO)=255
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT+LASTO+IABS((ITYPEO-80)*(ITYPEO-69)).NE.0) GO TO 250
C     69 = ASCII E
C     80 = ASCII P
      L1RECO=CCDBO-NERRCO
80    IF (LLPRGO.EQ.0) GO TO 90
C     LINK THIS PROGRAM HEADER TO THE PREVIOUS ONE IN THIS BLOCK.
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      NC=MOD(LLPRGO+1,NCCBO)
      NW=((LLPRGO+1)/NCCBO)*NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      CBLCKO(NC+1)=CCDBO/256
      IF (NC+1.LT.NCCBO) GO TO 85
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      NW=NW+NWCBO
      CALL EXCHUN (DBLOCK(NW+1),CBLCKO)
      NC=-1
85    CBLCKO(NC+2)=MOD(CCDBO,256)
      CALL EXCHPA (CBLCKO,DBLOCK(NW+1))
      CALL EXCHUN (DBLOCK(CWDBO),CBLCKO)
C     UPDATE TABLE OF CONTENTS POINTERS
90    LLPRGO=CCDBO
      IF (L1PRGO.EQ.0) L1PRGO=CCDBO-NERRCO
      NLRECO=NLRECO+1
      IF (N1RECO.EQ.0) N1RECO=NLRECO
100   CBLCKO(CPCBO)=0
      JUMP=3
      GO TO 230
110   CBLCKO(CPCBO)=ITYPEO
      JUMP=4
      GO TO 230
120   IF (ITYPEO.NE.69) GO TO 130
C     69 = ASCII E
      LASTO=76
      GO TO 70
130   IF (ITYPEO.NE.80) GO TO 170
C     80 = ASCII P
      CBLCKO(CPCBO)=0
      JUMP=5
      GO TO 230
140   CBLCKO(CPCBO)=0
      JUMP=6
      GO TO 230
150   CBLCKO(CPCBO)=NLRECO/256
      JUMP=7
      GO TO 230
160   CBLCKO(CPCBO)=MOD(NLRECO,256)
      JUMP=8
      GO TO 230
C
170   NC=NCHOUT
180   CBLCKO(CPCBO)=NC
      IC=0
      JUMP=9
C     PUT OUT TEXT STRING LENGTH IF NOT 'R' OR 'J' RECORD.
      IF (ITYPEO.EQ.82) GO TO 190
      IF (ITYPEO.EQ.74) GO TO 190
      IF (ITYPEO.NE.0.OR.MODEO.EQ.0) GO TO 230
190   IF (IC.GE.NC) IF (ITYPEO+IABS(MODEO)) 250,20,250
      INCHAR=INCHAR+1
      IC=IC+1
      CBLCKO(CPCBO)=RECORD(INCHAR)
      GO TO 230
C
C     J - UPDATING AND END OF TEXT SIGNAL.
C     R - CHANGE REMOVED CHARACTER.
C
200   NCHOUT=1
      IF (ITYPEO.EQ.82) REMVO=RECORD(1)
C     82 = ASCII R
      GO TO 100
C
C     RECORD TOO LONG.
C
210   ISTAT=4
      GO TO 250
C
C     UNKNOWN CONTROL RECORD TYPE.
C
220   ISTAT=5
      GO TO 250
C
C     INCREMENT THE OUTPUT BUFFER POINTERS.  PACK A CHARACTER BLOCK
C     IF NECESSARY.  WRITE A TAPE BLOCK IF NECESSARY.
C
230   CPCBO=CPCBO+1
      CCDBO=CCDBO+1
      IF (CPCBO.LE.NCCBO) GO TO 240
      CALL EXCHPA (CBLCKO,DBLOCK(CWDBO))
      CWDBO=CWDBO+NWCBO
      CPCBO=1
      IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 240
      CALL EXCHPB (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 250
240   GO TO (20,180,110,120,140,150,160,170,190), JUMP
250   RETURN
C
      END
      SUBROUTINE EXCHSC (INPIMG,IMGLEN,REMOVE,GC,RC,SC,MAXSL)
C
C     SCAN THE INPUT IMAGE AND COUNT CONSECUTIVE OCCURRENCES OF THE
C     DATA TO BE REMOVED.  DIVIDE DATA INTO GROUPS CONSISTING OF
C     STRINGS OF DATA TO BE REMOVED FOLLOWED BY STRINGS OF SIGNIFICANT
C     DATA.  THE NUMBER OF SUCH GROUPS IS RECORDED IN GC, AND THE
C     REMOVED DATA COUNT AND SIGNIFICANT DATA COUNT FOR EACH GROUP
C     ARE RECORDED IN RC() AND SC() RESPECTIVELY.  MAXSL IS THE
C     MAXIMUM STRING LENGTH WHICH WILL BE PLACED IN RC() OR SC().
C
      INTEGER INPIMG(1),IMGLEN,REMOVE,GC,RC(1),SC(1),MAXSL
C
C     RC AND SC MUST BE AT LEAST (IMGLEN-1)//3.
C
      GC=1
      SC(1)=0
      RC(1)=0
      MODE=-1
      INPLEN=IABS(IMGLEN)
C
C     IDENTIFY DATA GROUPS.
C
      DO 110 I=1,INPLEN
      IF (MODE) 40,60,90
C
C     MODE.LT.0 MEANS WORKING ON A STRING OF REMOVE.
C
40    IF (INPIMG(I).EQ.REMOVE) GO TO 50
C     SWITCH TO SIGNIFICANT DATA SCAN.
      MODE=1
      SC(GC)=1
      GO TO 110
C     CONTINUE REMOVE SCAN
50    RC(GC)=RC(GC)+1
      IF (RC(GC)-MAXSL) 110,95,110
C
C     MODE = 0 MEANS WORKING ON A SIGNIFICANT DATA STRING FOLLOWED BY
C     ONE OCCURRENCE OF REMOVE.  CHANGE TO REMOVE MODE IF ANOTHER REMOVE
C     OCCURS OR BACK TO DATA MODE IF NOT.
C
60    IF (INPIMG(I).EQ.REMOVE) GO TO 80
C     SINGLE REMOVE EMBEDDED IN SIGNIFICANT DATA STRING - IGNORE IT.
      MODE=1
      IF (SC(GC).GE.MAXSL-2) GO TO 70
      SC(GC)=SC(GC)+2
      GO TO 110
C     FULL GROUP
70    GC=GC+1
      RC(GC)=1
      SC(GC)=1
      GO TO 110
C     SWITCH TO REMOVE MODE.
80    GC=GC+1
      SC(GC)=0
      RC(GC)=2
      MODE=-1
      GO TO 110
C
C     MODE.GT.0 MEANS WORKING ON A STRING OF SIGNIFICANT DATA.
C
90    IF (INPIMG(I).EQ.REMOVE) GO TO 100
      SC(GC)=SC(GC)+1
      IF (SC(GC).NE.MAXSL) GO TO 110
C     FULL GROUP
      MODE=-1
95    IF (I.GE.INPLEN) GO TO 120
      GC=GC+1
      RC(GC)=0
      SC(GC)=0
      GO TO 110
100   MODE=0
110   CONTINUE
120   RETURN
C
      END
      SUBROUTINE EXCHTP (RECORD,LINEI)
C
C     MATERIALIZE INCLUDES IF INALT IS NON-ZERO.
C     CALL EXCHTW TO WRITE RECORDS ON THE NATIVE FORMAT FILE
C     AND THE PRINTER IF LISTING IS REQUESTED.
C     LINEI IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C
      INTEGER RECORD(1),LINEI
C
C     *****     LOCAL VARIABLES     ************************************
C
C COPY    DENOTES WHETHER COPYING TEXT, SEARCHING FOR TARGET, OR
C         SKIPPING TEXT NOT TO BE INCLUDED.
      INTEGER COPY
C DASH    CONTAINS '-' IN HOLLERITH.
      INTEGER DASH
C ENDMRK  HOLDS THE END SENTINEL.
      INTEGER ENDMRK(40)
C NCHEND  IS THE NUMBER OF CHARACTERS IN ENDMRK.
      INTEGER NCHEND
C NCHSAV  SAVES NCHCMD BECAUSE EXCHIM CLOBBERS NCHCMD.
      INTEGER NCHSAV
C NCHTAR  IS THE NUMBER OF CHARACTERS IN TARGET.
      INTEGER NCHTAR
C STAR    CONTAINS '*' IN HOLLERITH.
       INTEGER STAR
C TARGET  IS THE SEARCH TARGET (INCLUDE BLOCK IDENTITY).
      INTEGER TARGET(40)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL DATA     ***************************************
C
      DATA DASH /1H-/, STAR /1H*/
C
C     *****     PROCEDURES     *****************************************
C
      LINEO=LINEO+1
      IF (OUFILE+OPTL.EQ.0.AND.(OPTS.EQ.0.OR.PHASE.LT.4)) GO TO 190
      RECORD(180)=LINEO
      RECORD(179)=LINEI
      COPY=-1
C     COPY=-1 MEANS NOT COPYING INCLUDED TEXT.
      IF (ITYPEO.EQ.0) GO TO 110
C     PROCESS INCLUDE RECORD.
      DO 10 I=1,NCHOUT
10    RECORD(NCHOUT+4-I)=RECORD(NCHOUT+1-I)
C     INSERT '-I '.
      RECORD(1)=45
      RECORD(2)=73
      RECORD(3)=32
      NCHOUT=NCHOUT+3
      IF (INALT*(OUFILE+OPTI).EQ.0) GO TO 110
C     STORE SEARCH TARGET
      NCHTAR=MIN0(NCHOUT,40)
      DO 20 I=1,NCHTAR
20    TARGET(I)=RECORD(I)
C     STORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
      NCHSAV=NCHCMD
      DO 30 I=1,NUMBER
30    OUTREC(I)=COMAND(I)
      COPY=0
C     COPY=0 MEANS SKIPPING MODULE ON INALT FILE.
      INALT=IABS(INALT)
      NEOF=0
40    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
      IF (NCHCMD.LT.2) GO TO 40
      IF (COMAND(1).NE.45) GO TO 40
C     45 = ASCII -
      IF (COMAND(2).EQ.45) GO TO 130
      IF (COMAND(2).NE.73.AND.COMAND(2).NE.105) GO TO 40
C     73 = ASCII I, 105 = ASCII LOWER CASE I.
C     COMPARE IMAGE WITH SEARCH TARGET.
      IF (MIN0(NCHCMD,40).NE.NCHTAR) GO TO 60
      DO 50 I=2,NCHTAR
      K=COMAND(I)
      IF (K.GT.96 .AND. K.LT.123) K=K-32
      IF (TARGET(I).NE.K) GO TO 60
50    CONTINUE
      NEOF=3
C     PREVENT SEARCH LOOP.
      COPY=1
C     COPY=1 MEANS COPYING INCLUDED TEXT.
60    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     STORE END OF INCLUDE MODULE SIGNAL.
      NCHEND=MIN0(40,NCHCMD)
      DO 70 I=1,NCHEND
70    ENDMRK(I)=COMAND(I)
      IF (COPY.EQ.0) GO TO 80
      CHAR1L=DASH
      NCHOUT=NCHTAR
      DO 75 I = 1,NCHOUT
75    COMAND(I)=TARGET(I)
      COMAND(180)=LINEO
      COMAND(179)=LINEI
C     GO PRINT TARGET.
      CALL EXCHTW (COMAND,-1)
      GO TO 120
C     COPY OR SKIP UNTIL ENDMRK SEEN AGAIN.
80    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 130
C     BODY OF INCLUDE MAY NOT CONTAIN EOF IF EXCHIM CANNOT DETECT EOF.
C     TEST FOR ENDMRK
      DO 90 I=1,NCHEND
      IF (ENDMRK(I).NE.COMAND(I)) IF (COPY) 100,80,100
90    CONTINUE
      IF (COPY) 140,40,140
C     OUTPUT TEXT RECORD.
100   COMAND(180)=LINEO
      COMAND(179)=LINEI
      NCHOUT=NCHCMD
      CALL EXCHTW (COMAND,OPTI)
      GO TO 120
C     OUTPUT TEXT RECORD.
110   CALL EXCHTW (RECORD,1)
120   IF (COPY) 190,190,80
C     WE ONLY GET HERE WITH COPY .GE. 0.
130   NEOF=NEOF+1
      ACTION=2
C     ACTION = 2 MEANS REOPEN INALT.
      CALL EXCHIM
      IF (NEOF.LT.2) GO TO 40
140   INALT=-IABS(INALT)
      NCHCMD=1
      IF (COPY.GT.0) GO TO 170
C     PROCESS TARGET AS THOUGH IT WERE TEXT.
      NCHOUT=NCHTAR
C     SAVE TARGET FOR ERROR MESSAGE.
      DO 150 I=1,NCHTAR
150   COMAND(I)=TARGET(I)
      CALL EXCHTW (COMAND,1)
      CALL EXCHAH (TARGET,NCHTAR)
      WRITE (PRINTR,160) (TARGET(I),I=1,NCHTAR)
160   FORMAT (//47H0SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE./(1X,8
     10A1))
      NERRS=MAX0(NERRS,3)
C
C     RESTORE COMAND AND NCHCMD (EXCHC6 STILL NEEDS THEM).
C
170   NCHCMD=NCHSAV
      DO 180 I=1,NUMBER
180   COMAND(I)=OUTREC(I)
C
190   CHAR1L=STAR
      RETURN
C
      END
      SUBROUTINE EXCHTW (RECORD,OPTION)
C
C     WRITE RECORD ON THE NATIVE FORMAT OUTPUT FILE BY CALLING
C     EXCHOU.  WRITE RECORD ON THE PRINTER IF LISTING REQUESTED.
C     RECORD(179) IS THE LINE NUMBER FROM THE INPUT MODULE, OR ZERO FOR
C     NEW TEXT.
C     IF OPTION = ZERO, WRITE TO FILE ONLY.
C     IF OPTION .GT. ZERO, WRITE TO FILE AND LISTING.
C     IF OPTION .LT. ZERO, WRITE TO LISTING ONLY.
C
      INTEGER RECORD(1),OPTION
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     PROCEDURES     *****************************************
C
      LINEI=RECORD(179)
      IF (OPTION.LT.0) GO TO 130
C
C     INSERT IDENTIFICATION IF REQUESTED.
C
      IF (IDCOL2.LT.IDCOL1) GO TO 120
      IF (IDTXTL+IDSTEP.EQ.0) GO TO 120
      IF (NCHOUT.GE.IDCOL2) GO TO 20
      J=IDCOL2-1
C     FILL END OF RECORD WITH BLANKS IF NCHOUT .LT. IDCOL2
      DO 10 I=NCHOUT,J
10    RECORD(I+1)=32
C     32 = ASCII BLANK.
20    NCHOUT=MAX0(NCHOUT,IDCOL2)
      N=-1
      IF (LINEI.EQ.0) GO TO 40
      IF (IDOPTN.NE.73) GO TO 40
C     73 = ASCII I.  IDENTIFY ONLY FROM INTAPE.
      N=(LINEI-1)*IDSTEP+IDSTRT
      GO TO 70
40    IF (IDOPTN.NE.79) GO TO 50
C     79 = ASCII O.  IDENTIFY ONLY TO OUTAPE.
      N=(LINEO-1)*IDSTEP+IDSTRT
      GO TO 70
50    IF (IDOPTN.NE.67.AND.IDOPTN.NE.70) GO TO 70
C     67 = ASCII C, 70 = ASCII F.  IDENTIFY EVERYTHING.
      N=IDCUR
70    IF (N.LT.0) GO TO 120
      IF (IDTXTL.EQ.0) GO TO 100
      J=MIN0(IDCOL2,IDTXTL+IDCOL1-1)
      K=1
      DO 80 I=IDCOL1,J
      RECORD(I)=IDTEXT(K)
80    K=K+1
100   IF (IDSTEP.EQ.0) GO TO 120
      IDCUR=IDCUR+IDSTEP
      K=IDCOL2
110   RECORD(K)=MOD(N,10)+48
      N=N/10
      K=K-1
      IF (N.EQ.0) GO TO 120
      IF (K.GE.IDCOL1) GO TO 110
C
C     OUTPUT RECORD.
C
120   IF (OUFILE.NE.0) CALL EXCHOU (RECORD)
      IF (OPTION.EQ.0) GO TO 220
130   IF (OPTL.NE.0) GO TO 140
      IF (PHASE.LT.4.OR.OPTS.EQ.0) GO TO 220
140   CALL EXCHAH (RECORD,NCHOUT)
      IF (OPTV+VERT.NE.0) GO TO 200
      IF (PHASE.NE.8) GO TO 180
      IF (LINEI.EQ.0) GO TO 160
      WRITE (PRINTR,150) LINEI,LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
150   FORMAT (1X,2I5,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
160   WRITE (PRINTR,170) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
170   FORMAT (5H  NEW,I6,A1,3X,105A1/(6H  CONT,9X,105A1))
      GO TO 220
180   WRITE (PRINTR,190) LINEO,CHAR1L,(RECORD(I),I=1,NCHOUT)
190   FORMAT (1X,I5,A1,3X,110A1/(6H  CONT,4X,110A1))
      GO TO 220
200   WRITE (PRINTR,210) (RECORD(I),I=1,NCHOUT)
210   FORMAT (132A1)
220   RETURN
C
      END
/WEOF,BO
/FORT,M,L,B
      SUBROUTINE EXCHC1 (IBLOCK,OBLOCK)
C
C     COMMAND DECODER AND FORMAT VERIFIER.  SOME COMMANDS ARE ALSO
C     COMPLETELY PROCESSED HERE.
C
C     IBLOCK AND OBLOCK ARE TAPE I/O BLOCKS.
C
      INTEGER IBLOCK(1),OBLOCK(1)
C
C
C     *****     LOCAL VARIABLES     ************************************
C
C ALLOW   TABLE TO DETERMINE WHETHER A COMMAND IS ALLOWED.  VALUES ARE
C         SUMS OF PERMITTED VALUES OF PHASE.
C         1 = INITIALIZATION, 2 = BETWEEN PROGRAMS, 4 = INSERTING,
C         8 = UPDATING.
C         ALSO STORED IN THIS TABLE ARE FLAGS INDICATING WHETHER A
C         PARAMETER STRING MAY BE ENTIRELY ABSENT (NO EQUAL SIGN), OR
C         MAY BE VOID (EQUAL SIGN IS LAST CHARACTER).
C         32 = PARAMETER MAY BE VOID, 64 = PARAMETER MAY BE ABSENT.
      INTEGER ALLOW(35)
C BLANK   A CONSTANT.  1H .
      INTEGER BLANK
C DATE    IS THE DATE FROM UPDA=, DATE=, ORIG=.
      INTEGER DATE(3)
C DAYS    TABLE OF DAYS PER MONTH TO VERIFY DATE FIELDS.
      INTEGER DAYS(12)
C I       IS USED FREELY AS AN INDEX.
C J       IS USED FREELY AS AN INDEX.
C JUMP    USED TO CONTROL COMMUNICATION WITH AN INTERNAL SUBROUTINE.
C K       IS USED FREELY AS AN INDEX.
C KDATE   IS THE INDEX OF THE DATE COMMAND IN THE COMMAND TABLE (COMD).
C KQUIT   IS THE INDEX OF THE QUIT COMMAND IN THE COMMAND TABLE (COMD).
C KTEXT   IS THE INDEX OF THE TEXT COMMAND IN THE COMMAND TABLE (COMD).
C N       IS USED FREELY AS AN INDEX.
C NCNREC  IS THE NUMBER OF CONSECUTIVE NON RECOGNIZED COMMANDS.
C ND      IS USED DURING ANALYSIS OF DATES TO HOLD THE DAY NUMBER.
C NM      IS USED DURING ANALYSIS OF DATES TO HOLD THE MONTH NUMBER.
C NY      IS USED DURING ANALYSIS OF DATES TO HOLD THE YEAR NUMBER.
C TVAL    A VECTOR OF VALUES FOR TRANS.  INDEXED BY ICOMD.
      INTEGER TVAL(35)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL EQUIVALENCE     **********************************
C
      EQUIVALENCE (DATE(1),NY), (DATE(2),NM), (DATE(3),ND)
C
C     *****     DATA STATEMENTS     ************************************
C
      DATA ALLOW(1),ALLOW(2),ALLOW(3),ALLOW(4) /12,12,3,4/
      DATA ALLOW(5),ALLOW(6),ALLOW(7),ALLOW(8) /15,12,35,15/
      DATA ALLOW(9),ALLOW(10),ALLOW(11),ALLOW(12) /3,3,12,15/
      DATA ALLOW(13),ALLOW(14),ALLOW(15),ALLOW(16) /12,47,4,3/
      DATA ALLOW(17),ALLOW(18),ALLOW(19),ALLOW(20) /3,79,15,79/
      DATA ALLOW(21),ALLOW(22),ALLOW(23),ALLOW(24) /15,12,36,67/
      DATA ALLOW(25),ALLOW(26),ALLOW(27),ALLOW(28) /47,3,76,47/
      DATA ALLOW(29),ALLOW(30),ALLOW(31),ALLOW(32) /15,3,12,47/
      DATA ALLOW(33),ALLOW(34),ALLOW(35) /47,12,1/
      DATA BLANK /1H /
      DATA DAYS(1),DAYS(2),DAYS(3),DAYS(4),DAYS(5) /31,0,31,30,31/
      DATA DAYS(6),DAYS(7),DAYS(8),DAYS(9),DAYS(10) /30,31,31,30,31/
      DATA DAYS(11),DAYS(12) /30,31/
      DATA KDATE /5/
      DATA KQUIT /20/
      DATA KTEXT /27/
      DATA TVAL(01),TVAL(02),TVAL(03),TVAL(04),TVAL(05) /5,5,3,5,1/
      DATA TVAL(06),TVAL(07),TVAL(08),TVAL(09),TVAL(10) /5,2,1,3,1/
      DATA TVAL(11),TVAL(12),TVAL(13),TVAL(14),TVAL(15) /5,1,5,2,5/
      DATA TVAL(16),TVAL(17),TVAL(18),TVAL(19),TVAL(20) /1,1,2,1,9/
      DATA TVAL(21),TVAL(22),TVAL(23),TVAL(24),TVAL(25) /1,5,5,1,2/
      DATA TVAL(26),TVAL(27),TVAL(28),TVAL(29),TVAL(30) /3,5,2,3,1/
      DATA TVAL(31),TVAL(32),TVAL(33),TVAL(34),TVAL(35) /5,2,1,5,1/
C
C     *****     PROCEDURES     *****************************************
C
C     GO GET AN IMAGE FROM THE INPUT FILE OR THE SYSTEM READER.
C     ECHO IT IF THE E OPTION IS SET.  DETERMINE WHETHER IT IS A CHANGE
C     TO CONTROL RECORDS, A COMMENT, OR LOOKS LIKE A COMMAND.
C
10    NCNREC=0
20    ACTION=0
      IF (NCHCMD.LT.0) GO TO 220
      CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (OPTE.EQ.0) GO TO 27
      WRITE (PRINTR,23) (HOLCMD(I),I=1,NCHCMD)
23    FORMAT (1X,80A1)
      CHAR1L=0
27    NCHCMD=MIN0(NCHCMD,MARGIN)
      IF (PHASE.LT.4) SIGNAL=45
C     45 = ASCII -
      IF (COMAND(1).NE.45) GO TO 50
C     45 = ASCII -.  REQUEST TO CHANGE CONTROL RECORD.
      IF (PHASE.LT.4) GO TO 40
      WRITE (PRINTR,30) (HOLCMD(I),I=1,NCHCMD)
30    FORMAT (//62H0CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT
     1OR UPDATE/1X,80A1)
      NERRG=MAX0(NERRG,2)
      GO TO 200
40    ICOMD=0
      EQUAL=2
      TRANS=3
      GO TO 370
50    IF (COMAND(1).NE.42) GO TO 70
C     42 = ASCII *.  COMMENT RECORD.  JUST ECHO IT.
      NCHCMD=MAX0(NCHCMD,2)
      WRITE (PRINTR,60) (HOLCMD(I),I=2,NCHCMD)
60    FORMAT (A1,1H*,78A1/(1X,80A1))
      GO TO 10
C
C     SQUASH OUT BLANKS UNTIL 4 SIGNIFICANT CHARACTERS OR A COMMA OR
C     EQUAL SIGN ARE FOUND.  LOOK UP THE WORD IN THE COMMAND NAME TABLE.
C
70    EQUAL=0
      DO 80 I=1,NCHCMD
      IF (COMAND(I).EQ.32) GO TO 80
C     32 = ASCII BLANK
      EQUAL=EQUAL+1
      ICOMD=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (ICOMD.GT.96 .AND. ICOMD.LT.123) ICOMD=ICOMD-32
C     ABOVE STATEMENT CONVERTS TO UPPER CASE.
      COMAND(I)=32
      COMAND(EQUAL)=ICOMD
      IF (EQUAL.GE.4) GO TO 90
      IF (ICOMD.EQ.61) GO TO 90
C     61 = ASCII =.
      IF (ICOMD.EQ.44) GO TO 90
C     44 = ASCII ,.
80    CONTINUE
      IF (EQUAL.EQ.0) GO TO 185
90    DO 110 ICOMD=1,NCOMDT
      DO 100 K=1,EQUAL
      IF (COMAND(K).NE.COMD(K,ICOMD)) GO TO 110
100   CONTINUE
      IF (EQUAL.EQ.4) GO TO 130
      IF (COMD(EQUAL+1,ICOMD).EQ.32) GO TO 130
C     32 = ASCII BLANK.
110   CONTINUE
C
C     UNRECOGNIZED COMMAND.
C
120   ICOMD=0
C
C     LOOK FOR AN EQUAL SIGN.  SET THE VARIABLE NAMED EQUAL TO ZERO IF
C     THERE IS NONE, OR TO THE COLUMN CONTAINING THE FIRST NON-BLANK
C     CHARACTER FOLLOWING THE EQUAL SIGN.
C
130   MODIFY=0
140   DO 150 I=EQUAL,NCHCMD
      K=COMAND(I)
      IF (K.EQ.61) GO TO 160
C     61 = ASCII =.
      IF (MODIFY.NE.0) GO TO 150
C     USE FIRST MODIFIER.
      IF (K.EQ.44) GO TO 160
C     44 = ASCII ,.
150   CONTINUE
      EQUAL=0
      GO TO 170
160   I=I+1
      EQUAL=I
      IF (I.GT.NCHCMD) GO TO 170
      IF (COMAND(I).EQ.32) GO TO 160
C     32 = ASCII BLANK
      IF (K.NE.44) GO TO 170
C     44 = ASCII ,.
      MODIFY=COMAND(I)
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (MODIFY.GT.96 .AND. MODIFY.LT.123) MODIFY=MODIFY-32
C     CONVERT TO UPPER CASE.
      GO TO 140
170   IF (K.NE.61) EQUAL=0
C     61 = ASCII =.
      IF (ICOMD.EQ.0) GO TO 180
      IF (ICOMD.GT.NCOMDP) GO TO 180
      IF (EQUAL.GT.NCHCMD) GO TO 175
      IF (EQUAL.NE.0) GO TO 230
      IF (ALLOW(ICOMD)/64.NE.0) GO TO 230
175   IF (MOD(ALLOW(ICOMD)/32,2).EQ.0) GO TO 690
C     PARAMETER STRING MAY BE VOID - SIMULATE ONE BLANK.
      NCHCMD=NCHCMD+1
      EQUAL=NCHCMD
      COMAND(NCHCMD)=32
C     32 = ASCII BLANK
      HOLCMD(NCHCMD)=BLANK
      GO TO 230
C
C     GIVE UNRECOGNIZED COMMANDS TO USER VIA EXCHCX.
C
180   CALL EXCHCX (0)
C     IF ICOMD NOT EQUAL ZERO, EXCHCX RECOGNIZED A COMMAND.
      IF (ICOMD.NE.0) GO TO 730
185   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (//21H0UNRECOGNIZED COMMAND/(1X,80A1))
      NERRG=MAX0(NERRG,5)
200   CHAR1L=0
      NCNREC=NCNREC+1
      IF (NCNREC.LE.20) GO TO 20
      WRITE (PRINTR,210)
210   FORMAT (//36H0MORE THAN 20 UNRECOGNIZED COMMANDS,/41H PROGRAM ASSU
     1MES TEXT COMMAND IS MISSING.)
      GO TO 270
C
C     END OF FILE - SIMULATE A QUIT COMMAND.
C
220   ICOMD=KQUIT
C
C     RECOGNIZED COMMAND - SEE IF IT IS PERMITTED AT THIS TIME.
C
230   IF (MOD(ALLOW(ICOMD)/PHASE,2).EQ.0) GO TO 240
      TRANS=TVAL(ICOMD)
C             1   2   3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (730,730,730,730,300,730,730,370,730,370,730,370,730,730,300
     1,370,370,730,370,730,370,730,730,350,730,370,370,730,300,370,730,7
     230,370,730,370), ICOMD
C       16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
C     32  33  34  35
C
C     THE COMMAND IS NOT ALLOWED AT THIS TIME.
C
240   WRITE (PRINTR,250) (HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//55H0COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACE
     1D./1X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
C     DECIDE WHETHER TO SKIP TEXT
260   IF (ICOMD.NE.KTEXT) GO TO 10
      IF (EQUAL.NE.0) GO TO 10
270   WRITE (PRINTR,280)
280   FORMAT (//15H0SKIPPING TEXT.)
290   CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 220
      IF (NCHCMD.LT.2) GO TO 290
      IF (COMAND(1).NE.SIGNAL) GO TO 290
      IF (COMAND(2).EQ.SIGNAL) GO TO 10
      IF (NCHCMD.LT.3) GO TO 290
      IF (COMAND(2).NE.61) GO TO 290
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 290
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING.
C     DATE=YYMMDD
C     ORIGIN=YYMMDD SITE
C     UPDATE=YYMMDD SITE
C     IF THE ORIGIN OR UPDATE COMMAND DOES NOT BEGIN WITH A DATE
C     THE DATE SUPPLIED BY THE DATE COMMAND WILL BE USED.
C
300   IF (EQUAL+5.GT.NCHCMD) GO TO 700
      I=EQUAL
      DO 310 J=1,3
      DATE(J)=0
      DO 310 K=1,2
      N=COMAND(I)-48
      IF (N.LT.0) GO TO 320
      IF (N.GT.9) GO TO 320
      DATE(J)=10*DATE(J)+N
310   I=I+1
      IF (NM.EQ.0) GO TO 320
      IF (NM.GT.12) GO TO 320
      IF (ND.LE.0) GO TO 320
      DAYS(2)=28
      IF (MOD(NY,4).EQ.0) DAYS(2)=29
      IF (NY.EQ.0) DAYS(2)=28
      IF (ND.LE.DAYS(NM)) GO TO 440
320   IF (ICOMD.EQ.KDATE) GO TO 700
      IF (TODAY(1).EQ.32) GO TO 700
      I=MIN0(NCHCMD+6,180)
      NCHCMD=I
      J=I-6
      IF (COMAND(EQUAL-1).EQ.32) EQUAL=EQUAL-1
C     32 = ASCII BLANK
      IF (J.LT.EQUAL) GO TO 700
330   COMAND(I)=COMAND(J)
      HOLCMD(I)=HOLCMD(J)
      J=J-1
      I=I-1
      IF (J.GE.EQUAL) GO TO 330
      DO 340 I=1,6
      COMAND(I+EQUAL-1)=TODAY(I)
340   HOLCMD(I+EQUAL-1)=TODAY(I)
      CALL EXCHAH (HOLCMD(EQUAL),6)
      WRITE (PRINTR,345) (HOLCMD(I),I=1,NCHCMD)
345   FORMAT (//34H0CURRENT DATE INSERTED IN COMMAND./(1X,80A1))
      NERRG=MAX0(NERRG,1)
      GO TO 440
C
C     REWIND INTAPE
C
350   IF (INTAPE.EQ.0) GO TO 680
      IF (INTOPN.NE.0) GO TO 360
      I=1
C     OPEN INTAPE IF NOT ALREADY OPEN.  DO NOT CHECK EXCH LABEL.
      CALL EXCHRT (I,IBLOCK)
C     IGNORE STATUS
360   I=2
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
      GO TO 725
C
C     THE FOLLOWING COMMANDS MUST HAVE A PARAMETER STRING WHICH
C     BEGINS WITH A NUMBER FOLLOWED BY A BLANK.
C
C     INCLUDE FILE = NUMBER SYSTEM DEPENDENT DATA
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     INTAPE = NUMBER SYSTEM DEPENDENT DATA
C     LIMIT = NUMBER
C     MARGIN = NUMBER
C     OUTAPE = NUMBER SYSTEM DEPENDENT DATA
C     OUTPUT FILE = NUMBER SYSTEM DEPENDENT DATA
C     PRINTER = NUMBER
C     READER = NUMBER
C     SKIP = NUMBER
C     TEXT = NUMBER SYSTEM DEPENDENT DATA (PARAMETER IS OPTIONAL)
C     WORK = NUMBER
C
370   NUMBER=0
      IF (EQUAL.EQ.0) GO TO 440
      DO 410 J=EQUAL,NCHCMD
      IF (COMAND(J).EQ.32) GO TO 420
C     32 = ASCII BLANK
      N=COMAND(J)-48
C     48 = ASCII ZERO
      IF (N.GE.0) GO TO 400
380   WRITE (PRINTR,390) (HOLCMD(I),I=1,NCHCMD)
390   FORMAT (//52H0PARAMETER MUST BEGIN WITH INTEGERS.  NOT PROCESSED./
     11X,80A1)
      NERRG=MAX0(NERRG,5)
      CHAR1L=0
      GO TO 260
400   IF (N.GT.9) GO TO 380
410   NUMBER=10*NUMBER+N
      EQUAL=NCHCMD+1
      GO TO 440
420   EQUAL=J
430   EQUAL=EQUAL+1
      IF (EQUAL.LE.NCHCMD) IF (COMAND(EQUAL)-32) 440,430,440
C     32 = ASCII BLANK
C
C     PRELIMINARY FORMAT CHECKING IS COMPLETE
C
440   J=ICOMD+1
C             0  1   2  3  4  5   6  7  8   9  10 11  12 13 14  15  16
      GO TO (740,10,10,10,10,450,10,10,470,10,570,10,590,10,10,730,600,6
     120,10,630,10,640,10,10,10,10,725,490,10,660,650,10,10,480,10,595),
     2J
C     17 18  19 20  21 22 23 24 25  26  27 28  29  30 31 32  33 34  35
C
C     DATE=YYMMDD
C
450   DO 460 I=1,6
460   TODAY(I)=COMAND(EQUAL+I-1)
      GO TO 10
C
C     INPUT FILE = NUMBER SYSTEM DEPENDENT DATA.
C
470   I=INFILE
      J=1
      GO TO 500
C
C     INCLUDE = NUMBER SYSTEM DEPENDENT DATA.
C
480   I=INALT
      J=3
      INALT=IABS(INALT)
      GO TO 500
C
C     TEXT
C
490   I=INTEXT
      J=2
      IF (EQUAL.EQ.0) GO TO 560
C
C     OPEN AN INPUT FILE.
C
500   IF (NUMBER.EQ.0) GO TO 505
      IF (NUMBER.EQ.OUFILE) GO TO 710
      IF (NUMBER.EQ.OUTAPE) GO TO 710
505   IF (J.EQ.2) GO TO 510
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (I.NE.0) CALL EXCHIM
510   IF (J-2) 520,530,540
520   INFILE=NUMBER
      GO TO 550
530   INTEXT=NUMBER
      GO TO 550
540   INALT=NUMBER
550   IF (NUMBER.EQ.0) GO TO 560
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      CALL EXCHCX (J+1)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHIM
      ACTION=2
C     ACTION = 2 MEANS REWIND
      IF (J.EQ.3) CALL EXCHIM
      INALT=-IABS(INALT)
560   ACTION=0
C     ACTION = 0 MEANS READ TEXT
      GO TO 730
C
C     INTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
570   IF (INTOPN.EQ.0) GO TO 580
C     CLOSE THE INPUT TAPE, IGNORE STATUS.
      I=4
      CALL EXCHRT (I,IBLOCK)
      INTOPN=0
580   INTAPE=NUMBER
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (INTAPE.NE.0) CALL EXCHCX (6)
      GO TO 725
C
C     LIMIT = NUMBER
C
590   LIMIT=NUMBER
      GO TO 10
C
C     MARGIN = NUMBER
C
C     MINIMUM MARGIN IS 60
595   MARGIN=MAX0(NUMBER,60)
      GO TO 10
C
C     OUTAPE = NUMBER SYSTEM DEPENDENT INFORMATION
C
600   IF (OUTOPN.EQ.0) GO TO 610
C     WRITE AND END-OF-FILE MARK ON OUTAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (I,OBLOCK,OBLOCK)
C     IGNORE STATUS
      OUTOPN=0
      PHASE=1
610   OUTAPE=NUMBER
      OUTUPD=MODIFY
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND
      IF (OUTAPE.NE.0) CALL EXCHCX (7)
      GO TO 730
C
C     OUTPUT =  NUMBER SYSTEM DEPENDENT INFORMATION
C
620   ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      OUFILE=NUMBER
      IDCUR=IDSTRT
      IF (OUFILE.EQ.0) GO TO 730
C     STORE SYSTEM DEPENDENT INFORMATION FROM COMMAND.
      CALL EXCHCX (5)
      ACTION=1
C     ACTION = 1 MEANS OPEN FILE.
      CALL EXCHOU (OUTREC)
      GO TO 730
C
C     PRINTER = NUMBER.
C
630   CALL EXCHFO (-2)
      PRINTR=NUMBER
      CALL EXCHFO (2)
      GO TO 10
C
C     READER = NUMBER.
C
640   IF (INFILE.NE.0) GO TO 670
      CALL EXCHFO (-1)
      READER=NUMBER
      CALL EXCHCX (1)
      CALL EXCHFO (1)
      GO TO 10
C
C     WORK = NUMBER
C
650   IF (WORKF.GT.0) CALL EXCHFO (-3)
      WORKF=NUMBER
C     WORKF IS NOT OPENED HERE, IT IS OPENED IN EXCHC4.
      GO TO 10
C
C     UPDATE
C
C     DECIDE WHETHER TO START UPDATE BY COPYING CONTROL RECORDS OR
C     SIMPLY TO OUTPUT THE UPDATE COMMAND.
660   IF (PHASE.GE.4) TRANS=5
      GO TO 730
C
C     ERROR MESSAGES.
C
670   NUMBER=3
C     MESSAGE 3 - COMMAND MAY NOT APPEAR IN INPUT FILE.
      GO TO 720
680   NUMBER=4
C     MESSAGE 4 - INTAPE IS NOT DEFINED.
      GO TO 720
690   NUMBER=12
C     MESSAGE 12 - NO PARAMETER STRING.
      GO TO 720
700   NUMBER=13
C     MESSAGE 13 - IMPROPER DATE.
      GO TO 720
710   NUMBER=31
C     MESSAGE 31 - INPUT, INCLUDE OR TEXT = OUTAPE OR OUTPUT.
C
C     RETURN TO ERROR MESSAGE SEGMENT.
C
720   TRANS=8
      GO TO 740
c
c     Indicate the WORK file is empty.
c
725   if (nrwork.le.0 .or. workf.le.0) go to 730
      REWIND WORKF
      NRWORK=0
C
C     IF WE NEED A NEW SEGMENT, RETURN TO EXCHTR, ELSE LOOP.
C
730   IF (TRANS.EQ.1) GO TO 10
740   RETURN
C
      END
      SUBROUTINE EXCHCX (REASON)
C
C     PROCESS COMMANDS NOT RECOGNIZED BY EXCHC1, OR PERFORM USER
C     PROCESSING OF SYSTEM DEPENDENT INFORMATION FROM INPUT, TEXT,
C     INCLUDE, OUTPUT, INTAPE, AND OUTAPE COMMANDS.
C     SPERRY 620/7X VERSION.
C
      INTEGER REASON
C
C     REASON=0 FOR UNRECOGNIZED COMMAND.
C     REASON=1 BEFORE OPENING READER.
C     REASON=2 BEFORE OPENING INFILE.
C     REASON=3 BEFORE OPENING INTEXT.
C     REASON=4 BEFORE OPENING INALT.
C     REASON=5 BEFORE OPENING OUFILE.
C     REASON=6 BEFORE OPENING INTAPE.
C     REASON=7 BEFORE OPENING OUTAPE.
C
C     FNAMES(1..3,*) ARE SET TO THE FILE NAME FOUND AFTER THE
C     UNIT NUMBER.  FNAMES(4,*) ARE SET TO THE KEY FOUND AFTER
C     A COMMA FOUND AFTER THE FILE NAME, IF ANY, ELSE ZERO.
C
C     FNAMES(*,1) ARE FOR INPUT OR OUTPUT NATIVE FORMAT FILES.
C     FNAMES(*,2) ARE FOR INTAPE.
C     FNAMES(*,3) ARE FOR OUTAPE.
C
C     IF NO FILE NAME IS PRESENT, THE UNIT IS NOT A GLOBAL UNIT,
C     OR THE GLOBAL UNIT IS NOT POSITIONED BY /PFILE,
C     FNAMES(1..2,*)='EXCH', FNAMES(3,1)='  ', FNAMES(3,2)='IN',
C     FNAMES(3,3)='OU', AND FNAMES(4,*)=0.
C
      INTEGER BLANK,DEFALT(2),DEFLTS(3),FILE(6),SIGNS
      INTEGER FNAMES(4,3)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /FNAMES/ FNAMES
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA BLANK /2H  /
      DATA SIGNS /Z8080/
      DATA DEFALT(1), DEFALT(2) /2HEX,2HCH/
      DATA DEFLTS(1),DEFLTS(2),DEFLTS(3) /2H  ,2HIN,2HOU/
C
      IF (REASON.EQ.0) GO TO 90
C
C     PROCESS SYSTEM DEPENDENT INFORMATION
C
      J=MAX0(1,REASON-4)
      IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 50
      DO 10 I = 1,6
10    FILE(I)=32
      N=MIN0(EQUAL+5,NCHCMD)
      I=0
      DO 20 K = EQUAL,N
      I=I+1
      IF (COMAND(K).EQ.32) GO TO 30
      IF (COMAND(K).EQ.44) GO TO 30
20    FILE(I)=COMAND(K)
      K=N+1
30    FNAMES(4,J)=0
      IF (K.LT.NCHCMD.AND.COMAND(K).EQ.44) FNAMES(4,J)=COMAND(K+1)+128
      FNAMES(1,J)=(FILE(1)*256+FILE(2)) .OR. SIGNS
      FNAMES(2,J)=(FILE(3)*256+FILE(4)) .OR. SIGNS
      FNAMES(3,J)=(FILE(5)*256+FILE(6)) .OR. SIGNS
      GO TO 90
C
C     NO SYSTEM DEPENDENT INFORMATION PRESENT.  SET FNAMES(1,J) TO
C     THE CONTENTS OF THE SYSTEM FCB IF THE UNIT NUMBER IS .LE. 10.
C     SET FNAMES TO DEFAULT VALUE IF THE UNIT NUMBER IS .GT. 10.
C
50    FNAMES(1,J)=0
      IF (NUMBER.GT.10) GO TO 60
      CALL XHGFCB (NUMBER,FNAMES(1,J))
      IF (FNAMES(1,J).EQ.BLANK) GO TO 60
      IF (FNAMES(1,J).NE.0) GO TO 90
60    FNAMES(1,J)=DEFALT(1)
      FNAMES(2,J)=DEFALT(2)
      FNAMES(3,J)=DEFLTS(J)
      FNAMES(4,J)=0
C
90    RETURN
      END
/WEOF,BO
/FORT,M,L,B
      SUBROUTINE  EXCHC2
C
C     PROCESS IDENT, INDEX, OPTION, PRED, SITE AND TITLE COMMANDS.
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KINDE /32/
      DATA KOPTI /14/
      DATA KSITE /25/
C
C     FIGURE OUT WHICH COMMAND GOT US HERE.
C
      IF (ICOMD-KOPTI) 60,150,10
10    IF (ICOMD.NE.KINDE) IF (ICOMD-KSITE) 200,260,270
C
C     ANALYZE IDENTIFY=C1,C2,STEP,START,TEXT
C     WHERE C1, C2, STEP AND START ARE INTEGERS.
C     STORE C1 IN IDCOL1, C2 IN IDCOL2, STEP IN IDSTEP,
C     START IN IDSTRT, TEXT IN IDTEXT, AND THE NUMBER OF
C     CHARACTERS OF TEXT IN IDTXTL.  IF AN ERROR OCCURS,
C     STORE ZERO IN IDSTEP AND IDTXTL.
C     IF ANY PARAMETER IS OMITTED, THE CORRESPONDING VALUE IS ZERO.
C
C     STORE THE MODIFIER IN IDOPTN.
C     IF THE I MODIFIER IS SELECTED, SEQUENCE NUMBERS ARE
C     PRODUCED ONLY FOR IMAGES FROM INTAPE.  IF THE O MODIFIER
C     IS SELECTED, SEQUENCE NUMBERS ARE PRODUCED FOR ALL IMAGES
C     WRITTEN ON OUTAPE, BUT NOT FOR INCLUDED TEXT.  IF THE F
C     MODIFIER IS SELECTED, SEQUENCE NUMBERS DERIVED FROM THE POSITION
C     OF IMAGES WITH RESPECT TO THE BEGINNING OF THE MODULE ARE
C     PRODUCED FOR ALL IMAGES OUTPUT.  IF THE C MODIFIER IS SPECIFIED,
C     SEQUENCE NUMBERS DERIVED FROM THE POSITION OF THE IMAGES WITH
C     RESPECT TO THE BEGINNING OF THE OUTPUT FILE ARE PRODUCED FOR
C     ALL IMAGES OUTPUT.  IF NONE OF THE I, F, OR C MODIFIERS ARE
C     SPECIFIED, THE O MODIFIER IS ASSUMED.
C
C     IF IDSTEP = ZERO, SEQUENCE NUMBERS ARE NOT PRODUCED.
C     IF IDTXTL = ZERO, TEXT IS NOT EMITTED.
C     IF IDCOL1 .GT. IDCOL2, NEITHER SEQUENCE NUMBERS NOR TEXT ARE
C     EMITTED.
C
C     CONVERT C1,C2,STEP,START
C
      IDOPTN=MODIFY
      IF (IDOPTN.NE.67.AND.IDOPTN.NE.70.AND.IDOPTN.NE.73) IDOPTN=79
C     70 = ASCII F, 73 = ASCII I, 79 = ASCII O.
      DO 40 J=1,4
      NUMBER=0
20    IF (EQUAL.GT.NCHCMD) GO TO 40
      IF (COMAND(EQUAL).EQ.44) GO TO 30
C     44 = ASCII ,
      I=COMAND(EQUAL)-48
      IF (I.LT.0) GO TO 350
      IF (I.GT.9) GO TO 350
      NUMBER=10*NUMBER+I
      EQUAL=EQUAL+1
      GO TO 20
30    EQUAL=EQUAL+1
40    IDNBRS(J)=NUMBER
      IDCUR=IDSTRT
      IDCOL1=MAX0(1,MIN0(IDCOL1,178))
      IDCOL2=MIN0(IDCOL2,178)
C
C     STORE TEXT.
C
      IDTXTL=MAX0(MIN0(NCHCMD+1-EQUAL,40),0)
      IF (IDTXTL.EQ.0) GO TO 330
      DO 50 J=1,IDTXTL
      IDTEXT(J)=COMAND(EQUAL)
50    EQUAL=EQUAL+1
      GO TO 330
C
C     INDEX = PARAMETER STRING
C
60    J=0
      IF (COMAND(EQUAL).NE.45) GO TO 70
C     45 = ASCII -
      J=-1
      EQUAL=EQUAL+1
70    N=0
      DO 80 I=1,26
80    INDEXS(I)=0
90    IF (EQUAL.GT.NCHCMD) GO TO 130
      I=COMAND(EQUAL)-64
      IF (I.EQ.-32) GO TO 120
C     32 = ASCII BLANK.
      IF (I.GE.32) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.LE.0) GO TO 100
      IF (I.LE.26) GO TO 110
100   N=EQUAL
      GO TO 120
110   INDEXS(I)=1
120   EQUAL=EQUAL+1
      GO TO 90
130   INDEX=0
      DO 140 I=1,26
      INDEXS(I)=IABS(INDEXS(I)+J)
140   INDEX=INDEX+INDEXS(I)
      IF (MODIFY.EQ.76) INDEX=-INDEX
C     76 = ASCII L.
      IF (N) 340,330,340
C
C     OPTION = PARAMETER STRING
C
150   IF (MODIFY.NE.0) GO TO 170
      DO 160 I=1,26
160   OPTVAL(I)=0
170   IF (EQUAL.EQ.0.OR.EQUAL.GT.NCHCMD) GO TO 330
      I=1
      IF (MODIFY.EQ.67) I=0
C     67 = ASCII C.
      N=0
      DO 190 J=EQUAL,NCHCMD
      K=COMAND(J)
      IF (K.GE.96) K=K-32
C     CONVERT TO UPPER CASE.
      IF (K.EQ.32) GO TO 190
C     32 = ASCII BLANK
      IF (K.LT.65) GO TO 180
      IF (K.GT.90) GO TO 180
C     PROCESS ALPHABETIC OPTIONS.
      OPTVAL(K-64)=I
      GO TO 190
180   N=J
190   CONTINUE
      IF (N) 330,330,340
C
C     PROCESS PRED = ID REC A/X MASK STRING
C       WHERE ID = PREDICATE IDENTIFIER (A-H),
C       REC = CONTROL RECORD TYPE TO WHICH PREDICATE IS APPLICABLE,
C       A/X = A TO ALLOW MATCH IN ANY POSITION, X TO REQUIRE MATCH
C             IN EXACT POSITION,
C       MASK = A SINGLE CHARACTER USED TO INDICATE POSITIONS OF THE
C              TEXT OF A RECORD THAT ARE NOT TO BE EXAMINED.
C       STRING = A STRING OF TEXT TO BE COMPARED TO THE TEXT OF
C                CONTROL RECORDS.
C
C     THE PREDICATES ARE STORED IN PRED(*,N) WHERE N IS 1 FOR
C     PREDICATE A, ETC.
C
C     PRED(1,*)=LENGTH OF STRING + 3
C     PRED(1,*)=STRING LENGTH+3, OR ZERO IF PREDICATE UNDEFINED.
C     PRED(2,*)=TRUTH VALUE (USED DURING EXAMINATION OF COPY COMMAND).
C     PRED(3,*)=RECORD TYPE.
C     PRED(4,*)=A/X
C     PRED(5,*)=MASK CHARACTER.
C     PRED(6..42,*)=STRING.
C
200   IF (EQUAL.NE.0) GO TO 240
C     LIST ALL ACTIVE PREDICATES.
      DO 230 I=1,8
      IF (PRED(1,I).EQ.0) GO TO 230
      J=PRED(1,I)+1
      COMAND(1)=I+64
      DO 210 K=2,J
210   COMAND(K)=PRED(K+1,I)
      CALL EXCHAH (COMAND,J)
      WRITE (PRINTR,220) (COMAND(K),K=1,J)
220   FORMAT (6H PRED=,42A1)
230   CONTINUE
      GO TO 330
C     SAVE PREDICATE IF VALID.
240   IF (NCHCMD.LE.EQUAL+3) GO TO 370
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.GT.72) GO TO 360
C     72 = ASCII H
      NUMBER=J-64
      PRED(1,NUMBER)=0
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.GT.90) GO TO 360
C     90 = ASCII Z
      IF (J.LT.65) GO TO 360
C     65 = ASCII A
      IF (J.EQ.82) GO TO 360
C     82 = ASCII R
      PRED(3,NUMBER)=J
      EQUAL=EQUAL+1
      J=COMAND(EQUAL)
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      IF (J.NE.65.AND.J.NE.88) GO TO 360
C     65 = ASCII A, 88 = ASCII X
      PRED(4,NUMBER)=J
      EQUAL=EQUAL+1
      PRED(1,NUMBER)=MIN0(NCHCMD-EQUAL+3,40)
      I=4
      DO 250 J=EQUAL,NCHCMD
      I=I+1
      IF (I.GT.42) GO TO 330
      K=COMAND(J)
      IF (K.GT.96) K=K-32
C     CONVERT TO UPPER CASE.
250   PRED(I,NUMBER)=K
      GO TO 330
C
C     SITE = SITE NAME
C
260   JUMP=1
      GO TO 280
C
C     TITLE = OUTPUT TAPE TITLE
C
270   JUMP=2
280   K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 320 I=1,40
      IF (K.GT.NCHCMD) GO TO 290
      J=COMAND(K)
      K=K+1
      GO TO 300
290   J=32
C     32 = ASCII BLANK.
300   IF (JUMP.EQ.2) GO TO 310
      SITE(I)=J
      GO TO 320
310   TITLE(I)=J
320   CONTINUE
C
C     RETURN TO COMMAND DECODER.
C
330   TRANS=1
      GO TO 390
C
C     ERROR MESSAGES
C
340   NUMBER=14
C     MESSAGE 14 - UNRECOGNIZED CHARACTER IGNORED.
      EQUAL=N
      GO TO 380
350   IDSTEP=0
      IDTXTL=0
360   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER - COMMAND NOT PROCESSED.
      GO TO 380
370   NUMBER=30
C     MESSAGE 30 - COMMAND IS INCOMPLETE.
C
380   TRANS=8
C
390   RETURN
C
      END
/WEOF,BO
/FORT,M,L,B
      SUBROUTINE EXCHC3 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     MAKE SURE THE INPUT TAPE IS OPEN BEFORE STARTING THE
C     COPY, SKIP OR UPDATE COMMANDS, OR CONTROL RECORD UPDATES.
C
C     OPEN THE INPUT TAPE IF IT IS DEFINED BEFORE STARTING THE
C     NAME COMMAND.
C
C     OPEN THE OUTPUT TAPE IF IT IS DEFINED BEFORE STARTING
C     COPY, NAME OR UPDATE COMMANDS.
C
C ID      IS USED TO CONSTRUCT THE OUTPUT LABEL.
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                                    E  X  C  H
      DATA ID(1),ID(2),ID(3),ID(4) /69,88,67,72/
C                                    A  N  G  E
      DATA ID(5),ID(6),ID(7),ID(8) /65,78,71,69/
      DATA KNAME /9/
      DATA KSKIP /26/
C
C     OPEN INTAPE IF NECESSARY
C
      IF (INTOPN.NE.0) GO TO 70
      IF (INTAPE.EQ.0) IF (ICOMD-KNAME) 300,80,300
      IF (INTAPE.EQ.OUTAPE) GO TO 360
      CALL EXCHRH (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 310
      INTOPN=1
C     COPY THE LABEL TO A SAVE AREA.
      DO 10 I=1,180
10    LABELI(I)=CBLCKI(I)
      CALL EXCHAH (CBLCKI(13),138)
      WRITE (PRINTR,20)
20    FORMAT (25H0INPUT LABEL INFORMATION.)
      WRITE (PRINTR,30) (CBLCKI(I),I=13,104)
30    FORMAT (14H TAPE WRITTEN ,6A1,10H, TITLE = ,40A1/
     1        20H ORIGINALLY WRITTEN ,6A1,4H BY ,40A1)
      IF (LABELI(105).NE.0) WRITE (PRINTR,40) (CBLCKI(I),I=105,150)
40    FORMAT (13H LAST UPDATE ,6A1,4H BY ,40A1)
      WRITE (PRINTR,50) NDATAI
50    FORMAT (28H DATA CHARACTERS PER BLOCK =,I6)
      IF (NERRCI.NE.0) WRITE (PRINTR,60) NERRCI
60    FORMAT (40H ERROR CORRECTION CHARACTERS PER BLOCK =,I6)
      CHAR1L=0
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 290
70    IF (ICOMD.EQ.KSKIP) GO TO 270
C
C     OPEN OUTAPE IF NECESSARY
C
80    IF (ICOMD.EQ.0) GO TO 90
      IF (ICOMD.LT.KNAME) GO TO 100
90    IF (INTAPE*OUTAPE.EQ.0) GO TO 100
      IF (OUTUPD.NE.85) GO TO 370
C     85 = ASCII U.
100   IF (OUTOPN.NE.0) GO TO 240
      IF (OUTAPE.EQ.0) GO TO 240
C     CONSTRUCT THE OUTPUT LABEL.
      IF (TODAY(1).EQ.0) GO TO 340
      IF (INTOPN.EQ.0) GO TO 160
      DO 110 I=1,180
110   CBLCKO(I)=LABELI(I)
      IF (TITLE(1).EQ.32) GO TO 130
C     32 = ASCII BLANK
      DO 120 I=1,40
120   CBLCKO(I+18)=TITLE(I)
130   IF (OUTUPD.NE.85) GO TO 220
C     85 = ASCII U.
      IF (SITE(1).EQ.0) GO TO 350
      DO 140 I=1,6
140   CBLCKO(I+104)=TODAY(I)
      DO 150 I=1,40
150   CBLCKO(I+110)=SITE(I)
      GO TO 220
160   IF (TITLE(1).EQ.32) GO TO 330
C     32 = ASCII BLANK
      IF (SITE(1).EQ.0) GO TO 350
      IF (INTAPE*OUTAPE.EQ.0) GO TO 170
      IF (INTAPE.EQ.OUTAPE) GO TO 360
170   DO 180 I=1,8
180   CBLCKO(I)=ID(I)
      DO 190 I=1,40
      CBLCKO(I+18)=TITLE(I)
190   CBLCKO(I+64)=SITE(I)
      DO 200 I=1,6
200   CBLCKO(I+58)=TODAY(I)
      DO 210 I=105,180
210   CBLCKO(I)=0
220   CALL EXCHWH (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 320
      OUTOPN=1
      CBLCKO(1)=CBLCKO(105)
      CALL EXCHAH (CBLCKO(13),138)
      WRITE (PRINTR,230)
      WRITE (PRINTR,30) (CBLCKO(I),I=13,104)
230   FORMAT (26H0OUTPUT LABEL INFORMATION.)
      IF (CBLCKO(1).NE.0) WRITE (PRINTR,40) (CBLCKO(I),I=105,150)
      WRITE (PRINTR,50) NDATAO
      IF (NERRCO.NE.0) WRITE (PRINTR,60) NERRCO
      CHAR1L=0
240   IF (ICOMD-KNAME) 250,260,280
C
C     COPY
C
250   TRANS=4
      MODEI=1-MIN0(1,OUFILE+OPTL)
      IF (ICOMD.EQ.0) MODEI=0
      GO TO 390
C
C     NAME
C
260   TRANS=5
      IF (NRWORK.EQ.0) PHASE=4
      GO TO 390
C
C     SKIP
C
270   TRANS=4
      GO TO 390
C
C     UPDATE
C
280   TRANS=5
      MODEI=0
      GO TO 390
C
C     ERROR MESSAGES
C
290   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      EQUAL=ISTAT
      GO TO 380
300   NUMBER=4
C     MESSAGE 4 - INTAPE NOT DEFINED.
      GO TO 380
310   NUMBER=5
C     MESSAGE 5 - UNABLE TO OPEN INTAPE.
      EQUAL=ISTAT
      GO TO 380
320   NUMBER=6
C     MESSAGE 6 - UNABLE TO OPEN OUTAPE.
      EQUAL=ISTAT
      GO TO 380
330   NUMBER=7
C     MESSAGE 7 - TITLE NOT PROVIDED FOR OUTAPE.
      GO TO 380
340   NUMBER=8
C     MESSAGE 8 - DATE NOT SUPPLIED.
      GO TO 380
350   NUMBER=9
C     MESSAGE 9 - SITE NOT SUPPLIED.
      GO TO 380
360   NUMBER=10
C     MESSAGE 10 - INTAPE = OUTAPE.
      GO TO 380
370   NUMBER=11
C     MESSAGE 11 - U MODIFIER OF OUTAPE COMMAND NOT SELECTED.
380   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM
C
390   RETURN
C
      END
      SUBROUTINE EXCHRH (ISTAT,DBLOCK)
C
C     READ THE HEADER LABEL FROM THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL ARE
C               NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT COMES FROM THE TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     OPEN THE INPUT TAPE.
C
      ISTAT=1
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     READ A BLOCK.
C
      NDATAI=171
      NERRCI=0
      BLKSQI=0
      ISTAT=3
      CALL EXCHRT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 25
C
C     FIND OUT IF IT IS A PROPER LABEL.
C
      CALL EXCHUN (DBLOCK,CBLCKI)
      DO 10 I=1,8
      IF (CBLCKI(I).NE.ID(I)) GO TO 20
10    CONTINUE
C
C     GET READY TO READ THE REST OF THE TAPE.
C
      CCDBI=NCDBI
      NDATAI=256*CBLCKI(9)+CBLCKI(10)
      NERRCI=256*CBLCKI(11)+CBLCKI(12)
      LASTI=0
      L1PRGI=0
      ISTAT=0
      GO TO 30
C
C     NOT A LABEL.
C
20    ISTAT=6
C
C     CLOSE INTAPE WITH NO REWIND IF LABEL NOT OK.
25    I=4
      CALL EXCHRT (I,DBLOCK)
C
30    RETURN
C
      END
      SUBROUTINE EXCHWH (ISTAT,DBLOCK)
C
C     WRITE A HEADER ONTO THE EXCHANGE TAPE.
C
C     ISTAT = 0 IF EVERYTHING IS OK.
C     ISTAT = 3 IF AN I/O ERROR OCCURRED.
C     ISTAT = 6 IF THE FIRST EIGHT CHARACTERS OF THE LABEL TO BE
C               WRITTEN ARE NOT EQUAL EXCHANGE.
C
C     DBLOCK = THE RAW DATA BLOCK (EXACTLY AS IT IS TO BE WRITTEN ONTO
C              TAPE).
      INTEGER DBLOCK(1)
      INTEGER ID(8)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C                  E           X           C           H
      DATA ID(1) /69/, ID(2) /88/, ID(3) /67/, ID(4) /72/
C                  A           N           G           E
      DATA ID(5) /65/, ID(6) /78/, ID(7) /71/, ID(8) /69/
C
C     MAKE SURE IT IS A PROPER LABEL.
C
      DO 10 I=1,8
      IF (CBLCKO(I).NE.ID(I)) GO TO 30
10    CONTINUE
C
C     OPEN THE OUTPUT TAPE.
C
      ISTAT=1
      CALL EXCHWT (ISTAT,DBLOCK)
      IF (ISTAT.NE.0) GO TO 40
C
C     CONVERT THE NUMBER OF DATA CHARACTERS AND THE NUMBER OF ERROR
C     CONTROL CHARACTERS
C
      CBLCKO(9)=NDATAO/256
      CBLCKO(10)=MOD(NDATAO,256)
      CBLCKO(11)=NERRCO/256
      CBLCKO(12)=MOD(NERRCO,256)
C
C     INSERT TODAYS DATE
C
      DO 20 I=1,6
20    CBLCKO(I+12)=TODAY(I)
C
C     WRITE THE BLOCK ON TAPE.
C
      BLKSQO=0
      CALL EXCHPA (CBLCKO,DBLOCK)
      CCDBO=180
      ISTAT=2
      CALL EXCHWT (ISTAT,DBLOCK)
C
C     GET READY TO WRITE THE REST OF THE FILE.
C
      L1PRGO=0
      LLPRGO=0
      N1RECO=0
      NLRECO=0
      L1RECO=0
      LASTO=0
      CCDBO=NERRCO+10
      CWDBO=NWCBO*((CCDBO-1)/NCCBO)+1
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      GO TO 40
C
C     NOT A PROPER LABEL.
C
30    ISTAT=6
C
40    RETURN
C
      END
/WEOF,BO
/FORT,M,L,B
      SUBROUTINE EXCHC4 (IBLOCK)
      INTEGER IBLOCK(1)
C
C     PROCESS SKIP COMMAND, CONTROL RECORD UPDATE, PERFORM
C     COPY COMMAND FORMAT VERIFICATION, DECIDE WHICH PROGRAMS TO COPY.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA KCOPY /3/
C
C     ARE WE STARTING OR CONTINUING?
C
C     ICOMD.EQ.0  MEANS  CHANGE A CONTROL RECORD
C     ICOMD.GT.0  MEANS  SKIP OR COPY COMMAND BEGIN
C     ICOMD.EQ.-1 MEANS  CONTINUE COPY = NUMBERS
C     ICOMD.EQ.-2 MEANS  CONTINUE COPY = PREDICATE EXPRESSION
      NEWP=0
      IF (ITYPEI.EQ.80) VERT=0
C     80 = ASCII P.  WE NEED THIS TEST HERE AS WELL AS TESTING ITYPEO
C     IN EXCHC5 BECAUSE WE DO NOT ALWAYS WRITE CONTROL RECORDS ON
C     THE WORK FILE.
      IF (ICOMD.EQ.0) GO TO 190
C     ICOMD=0 MEANS CHANGING A CONTROL RECORD.
      IF (ICOMD+1) 290,170,10
10    IF (ICOMD.EQ.KCOPY) GO TO 30
C
C     SKIP COMMAND.
C
      IF (INTOPN.LT.0) GO TO 430
      if (modify.eq.70) number=number+n1reci-1
c     70 = ASCII F.
      IF (NUMBER+1-N1RECI) 540,430,20
20    CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.EQ.69) GO TO 460
C     69 = ASCII E.
      IF (N1RECI-NUMBER) 20,20,430
C
C     COPY COMMAND FORMAT VERIFICATION.
C
30    IF (COMAND(EQUAL).LT.48) GO TO 180
C     48 = ASCII ZERO
      IF (COMAND(EQUAL).GT.57) GO TO 180
C     57 = ASCII NINE
C
C     COPY = LIST OF PROGRAM NUMBERS SEPARATED BY DASHES AND COMMAS.
C     CONVERT THE NUMBERS AND STORE THEM IN COMAND.  IF THE NUMBER
C     IS PRECEEDED BY A DASH, STORE THE NEGATIVE OF THE NUMBER.
C
      ICOMD=-1
      I=0
      J=44
C     44 = ASCII COMMA
40    I=I+1
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 480
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=NUMBER
50    EQUAL=EQUAL+1
      IF (EQUAL.GT.NCHCMD) GO TO 60
      NUMBER=COMAND(EQUAL)-48
C     48 = ASCII ZERO
      IF (NUMBER.LT.0) GO TO 60
      IF (NUMBER.GT.9) GO TO 480
      COMAND(I)=10*COMAND(I)+NUMBER
      GO TO 50
60    IF (I.NE.1) IF (COMAND(I)-IABS(COMAND(I-1))) 490,490,70
70    IF (J.EQ.45) COMAND(I)=-COMAND(I)
C     45 = ASCII DASH
      IF (EQUAL.GT.NCHCMD) GO TO 90
      J=COMAND(EQUAL)
      IF (J.EQ.32 .OR. J.EQ.46) GO TO 90
C     32 = ASCII BLANK, 46 = ASCII PERIOD.
      IF (J.NE.44.AND.J.NE.45) GO TO 480
C     44 = ASCII COMMA, 45 = ASCII DASH
80    EQUAL=EQUAL+1
      IF (COMAND(EQUAL)-32) 40,80,40
C     32 = ASCII BLANK
90    NUMBER=I
C     FOR THE REST OF THIS COMMAND, EQUAL IS THE POINTER TO THE
C     POSITION IN COMAND CURRENTLY BEING EXAMINED.
      EQUAL=-1
100   EQUAL=EQUAL+1
      IF (EQUAL.GE.NUMBER) GO TO 470
      IF (IABS(COMAND(EQUAL+1)).LT.N1RECI) GO TO 100
      IF (EQUAL.EQ.0) GO TO 120
      WRITE (PRINTR,110) N1RECI,(HOLCMD(I),I=1,NCHCMD)
110   FORMAT (//44H0MODULES PRECEDING CURRENT INTAPE POSITION (,I5,13H)
     1NOT COPIED./(1X,80A1))
      NERRG=MAX0(NERRG,5)
120   IF (COMAND(EQUAL+1).GT.0) GO TO 130
      EQUAL=EQUAL-1
      COMAND(EQUAL+1)=N1RECI
130   IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
C
C     PROCESS COPY = LIST OF NUMBERS
C
140   EQUAL=EQUAL+1
C     GO COPY THE PROGRAM IF IT IS THE RIGHT ONE.
150   IF (INTOPN.LT.0) GO TO 430
      IF (COMAND(EQUAL)-N1RECI) 170,420,160
C     SKIP TO DESIRED PROGRAM
160   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI-69) 150,460,150
C     69 = ASCII E
170   IF (EQUAL.GE.NUMBER) GO TO 430
      IF (COMAND(EQUAL+1).GE.0) GO TO 140
      COMAND(EQUAL)=IABS(COMAND(EQUAL))+1
      IF (COMAND(EQUAL)+COMAND(EQUAL+1).LE.0) GO TO 420
      EQUAL=EQUAL+1
      GO TO 170
C
C     COPY = SELECTION STRING OR CHANGE CONTROL RECORD.
C
180   ICOMD=-2
      IF (NRWORK.GT.0) GO TO 420
C     IF CONTROL RECORDS MODIFIED, ASSUME PROGRAM IS TO BE COPIED.
      NRWORK=-1
C
C     DETERMINE NEED TO OPEN WORK FILE.
C
190   IF (IABS(INDEX)+OUTAPE+OUFILE*OPTC+OPTL*OPTA.EQ.0)
     1IF (ICOMD) 290,430,290
      IF (WORKF.EQ.0) GO TO 500
      I=IABS(WORKF)
      IF ((I-INTAPE)*(I-OUTAPE)*(I-OUFILE).EQ.0) GO TO 510
      IF (WORKF.GT.0) GO TO 200
      WORKF=I
      CALL EXCHFO (3)
200   IF (ICOMD.NE.0) GO TO 280
C
C     CHANGE CONTROL RECORD.
C
      if (itypei*(itypei-69)*(itypei-73).eq.0) go to 520
c     69 = ascii E, 73 = ascii I.
      if (nrwork.eq.0) go to 210
      if (itypei.eq.80) go to 520
c     80 = ascii P
210   IF (NUMBER-NRWORK-1) 530,220,410
220   NCHACT=NCHCMD+1-EQUAL
      IF (NCHACT.GT.0) GO TO 230
      NCHACT=1
      INTREC(1)=32
C     32 = ASCII BLANK
      GO TO 425
230   DO 240 I=1,NCHACT
240   INTREC(I)=COMAND(EQUAL+I-1)
      GO TO 425
C
C     COPY = SELECTION EXPRESSION.
C
C     SKIP TO NEXT PROGRAM.
250   IF (INTOPN.LT.0) GO TO 430
      if (itypei.eq.69) go to 460
c     69 = ASCII E.
      do 260 i = 1, 8
260   pred(2,i)=0
      if (itypei.ne.80) go to 265
c     If the current record is a new program, don't skip it (we haven't
c     processed it yet).
      if (nrwork.gt.0 .and. workf.gt.0) rewind workf
      nrwork=min0(nrwork,0)
      newp=0
      go to 320
265   CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) IF (ISTAT-7) 440,460,440
      nxnewp=0
270   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 440
      IF (ITYPEI.NE.80) GO TO 310
C     80 = ASCII P
      NEWP=nxnewp
c     Set NEWP non-zero when all control records for a module have been
c     seen.
      GO TO 320
280   NRWORK=MAX0(NRWORK,0)
290   DO 300 I=1,8
300   PRED(2,I)=0
c     NEWP is non-zero when all control records have been read.
310   if (itypei*(itypei-69)*(itypei-73).eq.0) newp=1
C     69 = ASCII E, 73 = ASCII I.
320   nxnewp=1
      if (icomd.eq.0) if (newp) 520,210,520
      IF (LIMIT.EQ.0) GO TO 340
      IF (N1RECI.LE.LIMIT) GO TO 340
      WRITE (PRINTR,330) LIMIT
330   FORMAT (7H LIMIT=,I6,9H REACHED.)
      GO TO 430
340   IF (NEWP.EQ.0) GO TO 360
      CALL EXCHLX
C     EXCHTP PRESERVES 'NUMBER' WORDS OF 'COMAND'.
      NUMBER=NCHCMD
      IF (MODIFY.EQ.73) IF (COMAND(180)) 450,420,415
C     73 = ASCII I.
      IF (MODIFY.EQ.80) IF (COMAND(180)) 450,420,425
C     80 = ASCII P.
      IF (MODIFY.EQ.83) IF (COMAND(180)) 450,250,425
C     83 = ASCII S.
      IF (MODIFY.EQ.88) IF (COMAND(180)) 450,250,415
C     88 = ASCII X.
      IF (COMAND(180)) 450,250,420
C     CONTROL RECORD.  EVALUATE ACTIVE PREDICATES WHICH ARE STILL FALSE.
360   I=1
      DO 400 NUMBER=1,8
      IF (PRED(1,NUMBER).EQ.0) GO TO 400
      IF (PRED(2,NUMBER).NE.0) GO TO 400
      IF (PRED(3,NUMBER).NE.ITYPEI) GO TO 390
      NM=PRED(1,NUMBER)-3
      IF (.NOT.(NCHACT.GT.0)) GO TO 390
      DO 385 L = 1, NCHACT
      DO 380 J = 1, NM
C
C     DO NOT TEST CHARACTER IN CONTROL RECORD IF MASK CHARACTER FOUND
C     IN PREDICATE.
      IF (PRED(J+5,NUMBER).EQ.PRED(5,NUMBER)) GO TO 380
      IF (.NOT.(J+L-1.GT.NCHACT)) GO TO 370
C
C     NO MORE CHARACTERS, IMPLICITLY PAD CONTROL RECORD WITH BLANKS.
      K=32
      GO TO 375
C     USE CHARACTER FROM CONTROL RECORD.
370   K=INTREC(J+L-1)
C
C     CONVERT LOWER CASE LETTERS TO UPPER CASE.
      IF (K.GT.96 .AND. K.LT.123) K=K-32
C
C     TEST FOR A MATCH ON A SINGLE CHARACTER.
C     IF THERE IS NO MATCH, AND THE SEARCH MODE IS 'A' (65), SHIFT THE
C     PATTERN.  IF THE SEARCH MODE IS X, TERMINATE THE SEARCH.
375   IF (PRED(J+5,NUMBER).NE.K) IF (PRED(4,NUMBER)-65) 390,385,390
380   CONTINUE
C
C     FOUND A MATCH IN CONTROL RECORD AND PREDICATE.
      PRED(2,NUMBER)=1
      GO TO 400
385   CONTINUE
390   I=0
400   CONTINUE
      IF (I.NE.0) newp=1
      IF (NRWORK.LT.0) GO TO 270
C     AT LEAST ONE FALSE PREDICATE.  WRITE THE CONTROL RECORD ON WORKF.
410   WRITE (WORKF) ITYPEI,NCHACT,(INTREC(J),J=1,NCHACT)
      NRWORK=NRWORK+1
      GO TO 270
C
C     GO COPY THE CONTROL RECORDS ASSOCIATED WITH A PROGRAM.
C
415   ICOMD=-3
C     RETURN TO EXCHC1 AFTER COPYING MODULE.
420   TRANS=5
      GO TO 570
C
C     RETURN TO THE COMMAND PROCESSOR.
C
425   TRANS=1
C     REMEMBER CONTROL RECORDS ON WORKF.
      GO TO 570
430   TRANS=1
      IF (ICOMD+1) 560,570,570
C
C     ERROR MESSAGES.
C
440   NUMBER=1
C     MESSAGE 1 - I/O ERROR.
      EQUAL=ISTAT
      GO TO 550
450   NUMBER=-COMAND(180)
C     MESSAGES GENERATED BY EXCHLX
      GO TO 550
460   IF (INTOPN.LT.0) GO TO 430
      INTOPN=-1
      EQUAL=NUMBER
      NUMBER=15
C     MESSAGE 15 - END OF FILE ENCOUNTERED ON INPUT TAPE.
      GO TO 550
470   NUMBER=16
C     MESSAGE 16 - ALL MODULES PRECEDE CURRENT POSITION.
      GO TO 550
480   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER
      GO TO 550
490   NUMBER=18
C     MESSAGE 18 - PROGRAM NUMBERS NOT IN ORDER.
      GO TO 550
500   NUMBER=19
C     MESSAGE 19 - WORK FILE NOT DEFINED.
      GO TO 550
510   NUMBER=20
C     MESSAGE 20 - WORK = INTAPE OR OUTAPE OR OUFILE.
      GO TO 550
520   EQUAL=NUMBER
      NUMBER=21
C     MESSAGE 21 - CONTROL RECORD NOT PRESENT
      GO TO 550
530   NUMBER=22
C     MESSAGE 22 - CONTROL RECORD CHANGE REQUESTS NOT IN ORDER.
      GO TO 550
540   NUMBER=29
C     MESSAGE 29 - BACKWARD SKIP IGNORED.
C
C     RETURN TO THE ERROR MESSAGE PROCESSOR.
C
550   TRANS=8
      IF (ICOMD.EQ.0) GO TO 570
C
C     DON'T CLAIM THAT CONTROL RECORDS REMAIN ON WORKF.
C
560   IF (WORKF.GT.0 .AND. NRWORK.GT.0) REWIND WORKF
      NRWORK=MIN0(NRWORK,0)
C
C     RETURN TO TRANSITION PROGRAM.
C
570   RETURN
C
      END
      SUBROUTINE EXCHLX
C
C     EVALUATE THE LOGICAL EXPRESSION ON THE COPY COMMAND.
C
C     THE CONTENT SELECTED COPY OPERATION IS CONTROLLED BY THE PREDICATE
C     STATEMENTS, LIMIT STATEMENT, AND THE COPY STATEMENT OF THE FORM
C     COPY=LOGICAL EXPRESSION.  THE LOGICAL EXPRESSION CONSISTS OF THE
C     EIGHT PRIMARY SYMBOLS A-H, THE NULL PRIMARY SYMBOL N, THE BINARY
C     OPERATORS + - * / AND PARENEHESES.  THE PRIMARY SYMBOLS A-H ARE
C     LABELS USED TO DISTINGUISH PREDICATES SUPPLIED BY PREDICATE
C     STATEMENTS.  THE NULL PRIMARY SYMBOL N IS A LABEL TO DESIGNATE THE
C     NULL PREDICATE, WHICH IS ALWAYS FALSE.  THE OPERATORS + - * / ARE
C     THE BINARY LOGICAL OPERATIONS   OR, OR NOT, AND, AND NOT
C     RESPECTIVELY.  THE OPERATORS * / HAVE EQUAL PRIORITY AND ARE
C     PERFORMED BEFORE THE OPERATORS + -, WHICH ALSO HAVE EQUAL
C     PRIORITY.  THE RELATIVE PRIORITY MAY BE CHANGED BY USING
C     PARENTHESES.
C
C     WHEN PROCESSING OF A PROGRAM BEGINS, ALL PREDICATES ARE INITIALLY
C     FALSE.  AS EACH CONTROL RECORD IS EXAMINED, THE TRUTH OF ALL
C     FALSE PREDICATES IS DETERMINED.  ONCE TRUE, A PREDICATE REMAINS
C     TRUE.  THUS A TRUE PREDICATE IS ONE WHICH IS TRUE AT ANY TIME, AND
C     A FALSE PREDICATE IS ONE WHICH IS NEVER TRUE.  WHEN ALL ACTIVE
C     PREDICATES ARE TRUE, OR WHEN ALL CONTROL RECORDS FOR A PROGRAM
C     HAVE BEEN EXAMINED, THE LOGICAL EXPRESSION FROM THE COPY COMMAND
C     IS EVALUATED.  IF THE EXPRESSION IS TRUE, THE PROGRAM IS COPIED.
C     IF THE EXPRESSION IS FALSE, THE PROGRAM IS SKIPPED.  THIS PROCESS
C     CONTINUES UNTIL THE END OF THE FILE IS REACHED, OR THE PROGRAM
C     NUMBER WHICH APPEARS ON THE LIMIT COMMAND IS PROCESSED.
C
C     THE SYNTAX RULES FOR THE LOGICAL EXPRESSION ARE EXPRESSED IN THE
C     TABLE BELOW.  INITIALLY, THE PREVIOUS TOKEN IS (, AND ) IS
C     APPENDED TO THE END OF THE LOGICAL EXPRESSION.
C
C     PREVIOUS  I                 CURRENT TOKEN                   I
C      TOKEN    I + - * / I PRIMARY I    (    I    )    I  ELSE   I
C     ----------I---------I---------I---------I---------I---------I
C      + - * /  I  ERROR  I   OK    I   OK    I  ERROR  I  ERROR  I
C      PRIMARY  I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C         (     I  ERROR  I   OK    I   OK    I   OK    I  ERROR  I
C         )     I   OK    I  ERROR  I  ERROR  I   OK    I  ERROR  I
C     ----------I---------I---------I---------I---------I---------I
C
C     CONVERSION FROM INFIX TO SUFFIX NOTATION IS PERFORMED USING
C     A STACK AND THE PRECEDENCE TABLE BELOW.  TOS MEANS TOP-OF-STACK,
C     HOI MEANS HEAD-OF-INPUT.  THE STACK INITIALLY CONTAINS (.
C
C                  TOS       HOI
C      TOKEN   I  INDEX  I  INDEX  I
C     ---------I---------I---------I
C       + -    I    2    I    1    I
C       * /    I    4    I    3    I
C     PRIMARY  I    6    I    5    I
C        (     I    0    I    7    I
C        )     I   N/A   I    0    I
C     ---------I---------I---------I
C
C     WHEN THE TOS INDEX IS LESS THAN THE HOI INDEX, THE INPUT TOKEN IS
C     PUSHED ONTO THE STACK.  WHEN THE TOS INDEX IS GREATER THAN THE HOI
C     INDEX, THE TOP ENTRY OF THE STACK IS EVALUATED (IF IT IS A PRIMARY
C     SYMBOL), OR PERFORMED (IF IT IS AN OPERATOR), AND THE RESULT
C     PLACED IN THE SUFFIX LIST.  THEN THE RELATION OF THE TOS INDEX TO
C     THE HOI INDEX IS RE-EXAMINED.  WHEN THE TOS INDEX IS EQUAL TO THE
C     HOI INDEX, THE TOP ENTRY OF THE STACK IS DELETED.
C
C     *****     INTERNAL VARIABLES     *********************************
C
C CHTAB   RECOGNIZED CHARACTERS.  INTERNAL PROCESSES USE THE INDEX
C         INTO CHTAB.
C COLTAB  CONVERTS INDEX OF CHTAB INTO COLUMN INDEX FOR SYNTAX.
C HOI     CONVERTS INDEX OF CHTAB INTO HEAD-OF-INPUT PRECEDENCE.
C INFIX   IS THE CURRENT POSITION IN THE INFIX.
C IPREV   IS THE SYNTAX TABLE COLUMN INDEX OF THE PREVIOUS TOKEN.
C ISTACK  IS THE CURRENT STACK INDEX.
C ISUFIX  IS THE CURRENT SUFFIX INDEX.
C SYNTAX  CONTAINS THE SYNTAX RULES.
C TOS     CONVERTS INDEX OF CHTAB INTO TOP-OF-STACK PRECEDENCE.
C
      INTEGER CHTAB(15),COLTAB(15),HOI(15),SYNTAX(4,4),TOS(15)
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     DATA STATEMENTS     ************************************
C
C                                                    A  B  C  D
      DATA CHTAB( 1),CHTAB( 2),CHTAB( 3),CHTAB( 4) /65,66,67,68/
C                                                    E  F  G  H
      DATA CHTAB( 5),CHTAB( 6),CHTAB( 7),CHTAB( 8) /69,70,71,72/
C                                                    N  +  -  *
      DATA CHTAB( 9),CHTAB(10),CHTAB(11),CHTAB(12) /78,43,45,42/
C                                                    /  (  )
      DATA CHTAB(13),CHTAB(14),CHTAB(15)           /47,40,41   /
C                                                       A B C D
      DATA COLTAB( 1),COLTAB( 2),COLTAB( 3),COLTAB( 4) /2,2,2,2/
C                                                       E F G H
      DATA COLTAB( 5),COLTAB( 6),COLTAB( 7),COLTAB( 8) /2,2,2,2/
C                                                       N + - *
      DATA COLTAB( 9),COLTAB(10),COLTAB(11),COLTAB(12) /2,1,1,1/
C                                                       / ( )
      DATA COLTAB(13),COLTAB(14),COLTAB(15)            /1,3,4  /
C                                                   A B C D E
      DATA HOI( 1),HOI( 2),HOI( 3),HOI( 4),HOI( 5) /5,5,5,5,5/
C                                                   F G H N +
      DATA HOI( 6),HOI( 7),HOI( 8),HOI( 9),HOI(10) /5,5,5,5,1/
C                                                   - * / ( )
      DATA HOI(11),HOI(12),HOI(13),HOI(14),HOI(15) /1,3,3,7,0/
C                 CURRENT TOKEN IS +-*/.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(1,1),SYNTAX(1,2),SYNTAX(1,3),SYNTAX(1,4) /1,0,0,1/
C                 CURRENT TOKEN IS PRIM.  NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(2,1),SYNTAX(2,2),SYNTAX(2,3),SYNTAX(2,4) /0,2,2,0/
C                 CURRENT TOKEN IS (.     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(3,1),SYNTAX(3,2),SYNTAX(3,3),SYNTAX(3,4) /1,0,0,0/
C                 CURRENT TOKEN IS ).     NEXT TOKEN IS  +-*/ P ( )
      DATA SYNTAX(4,1),SYNTAX(4,2),SYNTAX(4,3),SYNTAX(4,4) /0,2,2,0/
C                                                   A B C D E
      DATA TOS( 1),TOS( 2),TOS( 3),TOS( 4),TOS( 5) /6,6,6,6,6/
C                                                   F G H N +
      DATA TOS( 6),TOS( 7),TOS( 8),TOS( 9),TOS(10) /6,6,6,6,2/
C                                                   - * / ( )
      DATA TOS(11),TOS(12),TOS(13),TOS(14),TOS(15) /2,4,4,0,0/
C
C     *****     PROCEDURES     *****************************************
C
C     COMAND IS USED FOR INFIX, STACK AND SUFFIX.  UPON COMPLETION,
C     COMAND(180) CONTAINS -1 IF AN ERROR OCCURRED, 0 IF THE VALUE
C     OF THE EXPRESSION IS FALSE AND +1 IF THE VALUE OF THE
C     EXPRESSION IS TRUE.
C
      ISTACK=NCHCMD+2
      COMAND(ISTACK)=14
      ISUFIX=181
      IPREV=3
      COMAND(NCHCMD+1)=41
      INFIX=EQUAL-1
C
C     GET A CHARACTER FROM INFIX.  LOOK UP IN CHTAB.  CHECK SYNTAX.
C
10    IF (INFIX.GT.NCHCMD) GO TO 180
      INFIX=INFIX+1
      J=COMAND(INFIX)
      IF (J.EQ.32) GO TO 10
C     32 = ASCII BLANK - IGNORE IT.
      IF (J.GT.96) J=J-32
C     CONVERT TO UPPER CASE.
      DO 20 I=1,15
      IF (CHTAB(I).EQ.J) GO TO 30
20    CONTINUE
      GO TO 230
30    J=COLTAB(I)
      IF (SYNTAX(IPREV,J)-1) 40,190,200
C
C     CONVERT INFIX TO SUFFIX
C
40    IPREV=J
50    J=COMAND(ISTACK)
      IF (TOS(J)-HOI(I)) 60,70,80
C     PUSH INFIX ONTO STACK
60    ISTACK=ISTACK+1
      COMAND(ISTACK)=I
      GO TO 10
C     DELETE TOP OF STACK
70    ISTACK=ISTACK-1
      IF (ISTACK.GT.NCHCMD+1) GO TO 10
      IF (INFIX-NCHCMD) 220,220,250
C     IF TOS IS PRIMARY, PUT ITS VALUE INTO SUFFIX.
C     IF TOS IS OPERATOR, DO OPERATION ON TWO LAST ENTRIES IN SUFFIX.
80    IF (J-9) 90,100,130
C     PRIMARY IS SYMBOL A-H
90    IF (PRED(1,J).EQ.0) GO TO 210
      J=PRED(2,J)
      GO TO 110
C     NULL PREDICATE
100   J=0
110   ISUFIX=ISUFIX-1
120   COMAND(ISUFIX)=J
      ISTACK=ISTACK-1
      GO TO 50
C     OPERATOR
130   J=J-9
      ISUFIX=ISUFIX+1
      GO TO (140,150,160,170), J
C             +   -   *   /
140   J=MIN0(COMAND(ISUFIX)+COMAND(ISUFIX-1),1)
      GO TO 120
150   J=MIN0(COMAND(ISUFIX)+1-COMAND(ISUFIX-1),1)
      GO TO 120
160   J=COMAND(ISUFIX)*COMAND(ISUFIX-1)
      GO TO 120
170   J=COMAND(ISUFIX)*(1-COMAND(ISUFIX-1))
      GO TO 120
C
180   COMAND(180)=-23
C     MESSAGE 23 - TOO MANY (
      GO TO 240
190   COMAND(180)=-24
C     MESSAGE 24 - MISSING PRIMARY
      GO TO 240
200   COMAND(180)=-25
C     MESSAGE 25 - MISSING OPERATOR
      GO TO 240
210   EQUAL=CHTAB(J)
      CALL EXCHAH (EQUAL,1)
      COMAND(180)=-26
C     MESSAGE 26 - REFERENCE TO UNDEFINED PREDICATE.
      GO TO 250
220   COMAND(180)=-27
C     MESSAGE 27 - TOO MANY )
      GO TO 240
230   COMAND(180)=-28
C     MESSAGE 28 - UNRECOGNIZED CHARACTER
C
240   EQUAL=INFIX
250   RETURN
C
      END
/WEOF,BO
/FORT,M,L,B
      SUBROUTINE EXCHC5 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY CONTROL RECORDS FROM INTAPE TO OUTAPE, OUTPUT FILE,
C     AND INDEX IF SELECTED.  COPY RECORDS FROM WORKF FIRST, IF ANY.
C     CREATE CONTROL RECORDS DEMANDED BY COMMANDS.
C
C     THE FOLLOWING COMMANDS GENERATE A CONTROL RECORD CONSISTING OF
C     THE PARAMETER STRING.
C
C     AUTHOR
C     COMMENT
C     CONTROL (ITYPEO SET FROM MODIFY)
C     DATA TYPE
C     GROUPS
C     INSERT
C     KEYWORDS
C     MACHINE
C     ORIGIN
C     REFERENCES
C     REMOVE   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     SIGNAL   (FIRST CHARACTER OF PARAMETER STRING ONLY)
C     UPDATE
C
C     IF UPDATE OCCURS WHEN PHASE NOT YET EQUAL 8, ALL CONTROL RECORDS
C     ARE FIRST COPIED AS THOUGH A COPY COMMAND WERE PENDING, AND A
C     CONTROL RECORD IS CREATED FOR THE UPDATE COMMAND.
C
C     *****     LOCAL VARIABLES     ************************************
C
C BLANK   CONTAINS A HOLLERITH BLANK.
      INTEGER BLANK
C C1      IS USED FOR VERTICAL FORMAT CONTROL DURING INDEX PRINTING.
      INTEGER C1
C COL1    THE FIRST COLUMN OF TEXT OF A CONTROL RECORD.  DERIVED FROM
C         EQUAL FOR COMMANDS, AND 5 FOR CONTROL RECORDS FROM INTAPE.
      INTEGER COL1
C I,J     USED FREELY AS INDICES.
      INTEGER I,J
C KCONT   THE INDEX IN COMD OF THE CONTROL COMMAND.
      INTEGER KCONT
C KNAME   IS THE INDEX IN COMD OF THE NAME COMMAND.
      INTEGER KNAME
C KTEXT   THE INDEX IN COMD OF THE TEXT COMMAND.
      INTEGER KTEXT
C KUPDA   THE INDEX IN COMD OF THE UPDATE COMMAND.
      INTEGER KUPDA
C LIST    CONTAINS THE WORD LIST IN ASCII.  USED FOR THE A OPTION.
      INTEGER LIST(4)
C NM      IS THE INDEX OF THE INPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NM
C NOUT    IS THE INDEX OF THE OUTPUT CONTROL RECORD BEING PROCESSED.
      INTEGER NOUT
C NY      IS THE PROGRAM NUMBER.  IT IS THE NUMBER FROM INTAPE IF
C         OUTAPE IS NOT DEFINED, ELSE IT IS THE NUMBER FOR OUTAPE.
      INTEGER NY
C ONE     CONTAINS A HOLLERITH 1.
      INTEGER ONE
C REASON  REASON FOR COPYING A CONTROL RECORD.  1 = COPY COMMAND
C         PENDING.  2 = UPDATE COMMAND AND PHASE NOT YET EQUAL 8.
C         3 = COMMAND.
      INTEGER REASON
C RI      CONTAINS THE INDEX IN COMD OF THE COMMAND THAT PRODUCES A
C         GIVEN RECORD TYPE.  RI IS SUBSCRIPTED BY (ITYPEO-64).
      INTEGER RI(26)
C RT      IS THE RECORD TYPE GENERATED BY A CONTROL STATEMENT.
      INTEGER RT(34)
C STAR    CONTAINS A HOLLERITH STAR.
      INTEGER STAR
C ZERO    CONTAINS A HOLLERITH ZERO.
      INTEGER ZERO
C
C     *****     COMMON VARIABLES     ***********************************
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
C     *****     LOCAL VARIABLE DATA     ********************************
C
      DATA BLANK /1H /
C                                            L  I  S  T
      DATA LIST(1),LIST(2),LIST(3),LIST(4) /76,73,83,84/
C
      DATA KCONT /31/
      DATA KNAME /9/
      DATA KTEXT /27/
      DATA KUPDA/29/
      DATA ONE /1H1/
C                                                      A  B  C  D  E  F
      DATA RI( 1),RI( 2),RI( 3),RI( 4),RI( 5),RI( 6) / 1,22, 2, 4,20,31/
C                                                      G  H  I  J  K  L
      DATA RI( 7),RI( 8),RI( 9),RI(10),RI(11),RI(12) / 6,31,-1,34,11,31/
C                                                      M  N  O  P  Q  R
      DATA RI(13),RI(14),RI(15),RI(16),RI(17),RI(18) /13,31,15, 9,31,23/
C                                                      S  T  U  V  W  X
      DATA RI(19),RI(20),RI(21),RI(22),RI(23),RI(24) /29,31,31,31,31,31/
C                                                      Y  Z
      DATA RI(25),RI(26)                             /31,31            /
C                                                     A  C     D     G
      DATA RT(1), RT(2), RT(3), RT(4), RT(5), RT(6) /65,67, 0,68, 0,71/
C                                                           P     K
      DATA RT(7), RT(8), RT(9), RT(10),RT(11),RT(12)/ 0, 0,80, 0,75, 0/
C                                                     M     O
      DATA RT(13),RT(14),RT(15),RT(16),RT(17),RT(18)/77, 0,79, 0, 0, 0/
C                                                              B  R
      DATA RT(19),RT(20),RT(21),RT(22),RT(23),RT(24)/ 0, 0, 0,66,82, 0/
C                                                                 S
      DATA RT(25),RT(26),RT(27),RT(28),RT(29),RT(30)/ 0, 0, 0, 0,83, 0/
C                                                              J
      DATA RT(31),RT(32),RT(33),RT(34)              /-1, 0, 0,74/
C
      DATA STAR /1H*/
      DATA ZERO /1H0/
C
C     *****     PROCEDURES     *****************************************
C
      REASON=1
      NY=N1RECI
      IF (ICOMD.LE.-2 .AND. ITYPEI.EQ.80) NY=NY-1
C     ICOMD .LE. -2 MEANS PREDICATE-CONTROLLED COPY, 80 = ASCII P.
C     IF BOTH CONDITIONS ABOVE ARE TRUE, THE CURRENT MODULE HAS NO TEXT.
      IF (PHASE.EQ.4) NY=0
C     NY IS USED IN THIS REGION FOR THE PROGRAM NUMBER.  (IT IS PRINTED
C     IN THE INDEX).
      IF (ICOMD.LE.0) GO TO 10
      IF (PHASE.GE.4) GO TO 100
      IF (ICOMD.EQ.KNAME) GO TO 10
      IF (ICOMD.NE.KUPDA) GO TO 100
      REASON=2
      PHASE=8
10    IF (NRWORK.GT.0) REWIND WORKF
      NM=0
      NOUT=0
20    NM=NM+1
      IF (NM.LE.NRWORK) GO TO 60
30    IF (ITYPEI*(ITYPEI-69)*(ITYPEI-73).EQ.0) GO TO 230
C     69 = ASCII E, 73 = ASCII I.
      IF (NOUT.EQ.0) GO TO 40
      IF (ITYPEI.EQ.80) GO TO 230
C     80 = ASCII P.
      IF (NCHACT.NE.1) GO TO 40
      IF (INTREC(1).EQ.32) GO TO 220
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
40    ITYPEO=ITYPEI
      NCHOUT=NCHACT
      DO 50 J=1,NCHOUT
50    OUTREC(J+5)=INTREC(J)
      GO TO 70
60    READ (WORKF) ITYPEO,NCHOUT,(OUTREC(J+5),J=1,NCHOUT)
      IF (NCHOUT.NE.1) GO TO 70
      IF (NM.EQ.1) GO TO 70
      IF (OUTREC(6).EQ.32) GO TO 200
C     32 = ASCII BLANK.  DELETE BLANK CONTROL RECORDS.
70    NOUT=NOUT+1
      J=RI(ITYPEO-64)
      DO 80 I=1,4
80    OUTREC(I)=COMD(I,J)
      OUTREC(5)=61
C     61 = ASCII =
      COL1=5
      IF (J.NE.KCONT) GO TO 130
      COL1=7
C     CONTROL,*=...  MOVE UP TWO CHARACTERS AND INSERT ITYPEO.
      DO 90 I=1,NCHOUT
90    OUTREC(NCHOUT+8-I)=OUTREC(NCHOUT+6-I)
      OUTREC(5)=44
C     44 = ASCII COMMA.
      OUTREC(6)=ITYPEO
      OUTREC(7)=61
C     61 = ASCII =
      GO TO 130
100   IF (ICOMD.EQ.KTEXT) GO TO 240
      COL1=EQUAL-1
      NCHOUT=NCHCMD-COL1
      NRWORK=NRWORK+1
C     NRWORK IS USED HERE AS THE SEQUENCE OF THE CONTROL RECORD.
      ITYPEO=RT(ICOMD)
      IF (ITYPEO.GT.0) GO TO 110
C     PROCESS CONTROL,TYPE=TEXT COMMAND.
      ITYPEO=MODIFY
      IF (RI(ITYPEO-64).NE.KCONT) GO TO 320
110   NOUT=NRWORK
      REASON=3
      DO 120 I=1,NCHCMD
120   OUTREC(I)=COMAND(I)
130   IF (ITYPEO.EQ.74) SIGNAL=OUTREC(COL1+1)
C     74 = ASCII J.
      IF (ITYPEO.EQ.80) VERT=0
C     80 = ASCII P
      IF (ITYPEO.NE.68) GO TO 150
C     68 = ASCII D
      IF (OPTA*OPTL*(1-OPTV).EQ.0) GO TO 150
      DO 140 J=1,4
      I=OUTREC(J+COL1)
      IF (I.GT.96 .AND. I.LT.123) I=I-32
C     CONVERT TO UPPER CASE.
      IF (I.NE.LIST(J)) GO TO 150
140   CONTINUE
      VERT=1
C     GENERATE CONTROL (JCL) RECORDS - EXCHCG MAY BE SYSTEM SENSITIVE.
150   CALL EXCHCG (OUTREC(COL1+1))
      IF (OUTOPN.EQ.0) GO TO 160
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC(COL1+1))
      IF (ISTAT.NE.0) GO TO 340
      NY=NLRECO
160   NCHOUT=NCHOUT+COL1
C     TELL EXCHOU THE CONTROL RECORD SEQUENCE NUMBER.
      OUTREC(180)=-NOUT
      IF (OPTC*OUFILE.NE.0) CALL EXCHOU (OUTREC)
C     PRINT THE INDEX IF SELECTED.
      IF (INDEX.LE.0.AND.OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO
     1190
      IF (INDEXS(ITYPEO-64).EQ.0) GO TO 190
      C1=BLANK
C     DOUBLE SKIP FOR PROGRAM HEADER (P).
      IF (ITYPEO.EQ.80) C1=ZERO
      IF (OPTV+VERT.NE.0) GO TO 170
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 170
      IF (CHAR1L.NE.ONE) C1=ONE
      CHAR1L=ONE
170   CALL EXCHAH (OUTREC,NCHOUT)
      WRITE (PRINTR,180) C1,NY,NOUT,(OUTREC(N),N=1,NCHOUT)
180   FORMAT (A1,2I5,1H*,(3X,105A1))
190   IF (REASON.EQ.3) GO TO 310
200   IF (NM-NRWORK) 20,210,220
210   REWIND WORKF
      NRWORK=0
      GO TO 30
220   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT) 330,30,330
230   IF (REASON.EQ.2) GO TO 300
240   IF (OUFILE.EQ.0) GO TO 260
      DO 250 I=1,4
250   OUTREC(I)=COMD(I,KTEXT)
      OUTREC(180)=0
      NCHOUT=0
C     TELL EXCHCG ALL CONTROL RECORDS HAVE BEEN PROCESSED.
      CALL EXCHCG (OUTREC)
      NCHOUT=4
      ACTION=2-OPTC-OPTC
C     ACTION = 2 MEANS START OF PROGRAM.
      CALL EXCHOU (OUTREC)
260   IF (OPTV+VERT.NE.0) GO TO 280
      IF (OPTL.EQ.0.AND.(PHASE.LT.4.OR.OPTS.EQ.0)) GO TO 280
      IF (OUTOPN.NE.0) NY=NLRECO
      I=BLANK
      IF (CHAR1L.NE.ONE) I=ONE
      WRITE (PRINTR,270) I,NY
270   FORMAT (A1,I5,1H*,8X,4HTEXT/)
280   CHAR1L=STAR
      NRWORK=MIN0(NRWORK,0)
      IF (IDOPTN.NE.67) IDCUR=IDSTRT
C     67 = ASCII C
      IF (ICOMD.EQ.KTEXT) GO TO 290
C
C     WORKING ON A COPY STATEMENT, OR COPYING A MODULE BECAUSE CONTROL
C     RECORDS HAD BEEN CHANGED, AND A 'NAME' COMMAND WAS SUBMITTED.
C
      TRANS=6
      GO TO 370
C
C     WORKING ON A TEXT STATEMENT.
C
290   TRANS=7
      GO TO 370
C
C     WORKING ON AN UPDATE STATMENT.
C
300   NRWORK=NOUT
      GO TO 100
C
C     WRITING A SINGLE CONTROL RECORD.
C
310   TRANS=1
      GO TO 370
C
C     ERROR MESSAGES.
C
320   NUMBER=17
C     MESSAGE 17 - UNRECOGNIZED CHARACTER.
      GO TO 360
330   NUMBER=1
      GO TO 350
340   NUMBER=2
350   EQUAL=ISTAT
360   TRANS=8
C
C     RETURN TO TRANSITION PROGRAM.
C
370   RETURN
C
      END
      SUBROUTINE EXCHCG (RECORD)
C
C     USE RECORD(1-NCHOUT) AND ITYPEO TO GENERATE JCL.
C     WHEN NCHOUT=0, ALL CONTROL IMAGES HAVE PREVIOUSLY BEEN PROCESSED.
C     THIS IS THE PORTABLE VERSION.  IT DOES NOT DO ANYTHING.
C
      INTEGER RECORD(1)
C
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
C
      RETURN
      END
/WEOF,BO
/FORT,M,L,B
      SUBROUTINE EXCHC6 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     COPY THE PROGRAM TEXT FROM INTAPE TO OUTAPE.
C
      INTEGER KNAME,ONE,SVHCMD(180)
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KNAME /9/
      DATA ONE /1H1/
C
      LINEO=0
      NERRS=0
C     SAVE COMMAND IN CASE WE GO SEARCHING FOR INCLUDED TEXT.
      DO 5 I = 1,NCHCMD
5     SVHCMD(I)=HOLCMD(I)
      IF (ITYPEI*(ITYPEI-73).NE.0) GO TO 165
C     73 = ASCII I.  IF WE GET HERE WITHOUT TEXT OR INCLUDE, WE HAVE
C     A VOID MODULE.
      IF (OPTL+OUTAPE+OUFILE.NE.0) GO TO 10
      CALL EXCHNP (ISTAT,IBLOCK)
      IF (ISTAT.EQ.7) GO TO 220
      IF (ISTAT) 250,160,250
10    MODEO=MODEI
      ITYPEO=0
      NBC=OPTL+OUFILE
      IF (INDEX.GT.0) NBC=1
20    NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTOPN.EQ.0) GO TO 120
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 260
C
C     CHECK WHETHER WE CAN DO A BLOCK COPY (WORD-BY-WORD
C     INSTEAD OF BYTE-BY-BYTE).  WE CAN DO A BLOCK COPY IF
C     WE ARE NOT DOING A LISTING, NOT CREATING AN OUTPUT
C     FILE AND NOT PRINTING THE INDEX.  ALSO, THE INPUT AND
C     OUTPUT CHARACTER POSITIONS MUST BE THE SAME.  IF THE
C     PROGRAM IS SMALL ENOUGH TO BE ENTIRELY CONTAINED IN BOTH
C     THE INPUT AND OUTPUT BLOCKS, THEN IT IS ENOUGH THAT THE
C     CURRENT POSITION IN THE BYTE BUFFER BE THE SAME.
C     WE CAN'T DO A BLOCK COPY IF THE CURRENT PROGRAM IS THE
C     LAST ONE, AND IT ENDS IN THIS BLOCK BECAUSE WE DON'T
C     KNOW THE LOCATION OF THE END-OF-FILE RECORD.
C
      IF (NBC.NE.0) GO TO 120
      IF (CPCBI+1.NE.CPCBO) GO TO 120
      IF (LASTI.EQ.76.AND.L1PRGI.EQ.0) GO TO 120
C     WE DON'T KNOW WHERE TO STOP WHEN NEXT PROG IS EOF.
      IF (L1PRGI.EQ.0) GO TO 25
      IF (NERRCO+NDATAO+9-CCDBO.GE.L1PRGI+NERRCI-CCDBI) GO TO 30
25    IF (CCDBI+1.NE.CCDBO) GO TO 120
      IF (NERRCO.NE.NERRCI.OR.NDATAO.NE.NDATAI) GO TO 120
C     WE CAN DO A BLOCK COPY (WORD-BY-WORD INSTEAD OF BYTE-BY-BYTE).
C     FIRST COPY REMAINING BYTES IN CBLCKI TO CBLCKO.
30    LI=L1PRGI+NERRCI-1
      IF (L1PRGI.NE.0) GO TO 40
      LI=NERRCI+NDATAI+9
      IF (LASTI.EQ.76) LI=L1RECI+NERRCI-1
40    IF (CPCBI.GE.NCCBI) GO TO 50
      IF (CCDBI.GE.LI) GO TO 160
      CPCBI=CPCBI+1
      CBLCKO(CPCBO)=CBLCKI(CPCBI)
      CPCBO=CPCBO+1
      CCDBI=CCDBI+1
      CCDBO=CCDBO+1
      GO TO 40
C     PACK COPIED BYTES.
50    CALL EXCHPA (CBLCKO,OBLOCK(CWDBO))
      CPCBO=1
      CPCBI=0
      CWDBO=CWDBO+NWCBO
      CWDBI=CWDBI+NWCBI
C     NOW COPY WORDS TO THE END OF THE CURRENT PROGRAM
60    IF (CCDBO.LT.NERRCO+NDATAO+10) GO TO 70
      IF (N1RECO.EQ.0) N1RECO=NLRECO
      IF (L1RECO.EQ.0) L1RECO=L1RECI
      CALL EXCHPB (ISTAT,OBLOCK)
      IF (ISTAT.NE.0) GO TO 260
70    IF (CCDBI.LT.LI) GO TO 80
      IF (L1PRGI.NE.0) GO TO 100
      CALL EXCHGB (ISTAT,IBLOCK)
      IF (ISTAT.NE.0) GO TO 250
      GO TO 30
80    NW=NWCBI*((LI-CCDBI)/NCCBI)
      IF (NW.EQ.0) GO TO 100
      DO 90 I=1,NW
      OBLOCK(CWDBO)=IBLOCK(CWDBI)
      CWDBO=CWDBO+1
90    CWDBI=CWDBI+1
100   CCDBO=CCDBO+LI-CCDBI
      CCDBI=LI
      IF (L1PRGI.EQ.0.AND.LASTI.NE.76) GO TO 60
      CPCBI=MOD(LI,NCCBI)
      CPCBO=MOD(CCDBO-1,NCCBO)+1
      CALL EXCHUN (IBLOCK(CWDBI),CBLCKI)
      IF (CPCBI.EQ.0) GO TO 160
      DO 110 I=1,CPCBI
110   CBLCKO(I)=CBLCKI(I)
      GO TO 160
C
C     END OF BLOCK COPY CODE.
C
120   CALL EXCHTP (INTREC,LINEO)
160   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 250
      IF (ITYPEI*(ITYPEI-73).EQ.0) GO TO 20
C     73 = ASCII I.
165   IF (OPTL.NE.0) GO TO 180
      IF (INDEX.LE.0) GO TO 195
      WRITE (PRINTR,170) LINEO
170   FORMAT (I9,14H IMAGES COPIED)
      GO TO 200
180   WRITE (PRINTR,190)
190   FORMAT (1H1)
195   CHAR1L=ONE
200   IF (OUFILE.EQ.0) GO TO 210
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
210   IF (ITYPEI.EQ.69) GO TO 220
C     69 = ASCII E
C
C     RETURN TO THE COPY CONTROL SEGMENT.
C
      DO 215 I=1,NCHCMD
215   HOLCMD(I)=SVHCMD(I)
      IF (ICOMD.EQ.-3) GO TO 240
C     ICOMD=-3 MEANS COPY,I OR COPY,X AND TRUE EXPRESSION VALUE.
      TRANS=4
      IF (ICOMD.NE.KNAME) GO TO 280
C     MODULE COPIED BECAUSE CONTROL RECORDS CHANGED, THEN 'NAME'
C     COMMAND SUBMITTED.  GO PROCESS 'NAME' COMMAND.
      TRANS=5
      PHASE=4
      GO TO 280
C
C     END OF FILE ON INPUT TAPE.
C
220   IF (INTOPN.LT.0) GO TO 240
      WRITE (PRINTR,230) (SVHCMD(I),I=1,NCHCMD)
230   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./(1X,80A1))
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
240   TRANS=1
      GO TO 280
C
C     ERROR MESSAGES.
C
250   NUMBER=1
C     MESSAGE 1 - I/O ERROR READING INTAPE.
      GO TO 270
260   NUMBER=2
C     MESSAGE 2 - I/O ERROR WRITING OUTAPE.
270   TRANS=8
      EQUAL=ISTAT
C
C     RETURN TO THE TRANSITION PROGRAM.
C
280   IF (NERRS.EQ.0) GO TO 300
      WRITE (PRINTR,290) NERRS,(SVHCMD(I),I=1,NCHCMD)
290   FORMAT (//39H0MAXIMUM ERROR SEVERITY DURING COPY WAS,I2,1H./
     1(1X,80A1))
      NERRG=MAX0(NERRS,NERRG)
300   RETURN
C
      END
/WEOF,BO
/FORT,M,L,B
      SUBROUTINE EXCHC7 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
      INTEGER D1,D2,D3,EDIT,ONE,PLUS,STAR,TXDISK(40)
C
C     PROCESS THE TEXT COMMAND.
C
C MSG     IS USED TO PRINT A MESSAGE.
      INTEGER MSG(6,2)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA ONE /1H1/, PLUS /1H+/, STAR /1H*/
      DATA MSG(1,1),MSG(2,1),MSG(3,1) /1HI,1HN,1HS/
      DATA MSG(4,1),MSG(5,1),MSG(6,1) /1HE,1HR,1HT/
      DATA MSG(1,2),MSG(2,2),MSG(3,2) /1HU,1HP,1HD/
      DATA MSG(4,2),MSG(5,2),MSG(6,2) /1HA,1HT,1HE/
C
      LINEI=1
      LINEO=0
      NERRS=0
      INEND=0
      CHAR1L=STAR
C
C     SAVE SYSTEM DEPENDENT INFO FROM TEXT COMMAND
C
      K=EQUAL
      IF (K.EQ.0) K=NCHCMD+1
      DO 20 I=1,40
      IF (K.GT.NCHCMD) GO TO 10
      J=COMAND(K)
      K=K+1
      GO TO 20
10    J=32
C     32 = ASCII BLANK.
20    TXDISK(I)=J
      IF (INTOPN.LE.0) ITYPEI=0
C
C     MAIN PROCESSING LOOP
C
60    EDIT=0
70    CALL EXCHIM
      IF (NCHCMD.LT.0) GO TO 80
C     NCHCMD.LT.0 MEANS END OF FILE.
      IF (NCHCMD.LT.2) GO TO 100
      IF (COMAND(1).NE.SIGNAL) GO TO 100
      IF (COMAND(2).EQ.SIGNAL) GO TO 80
      IF (COMAND(2).EQ.73) GO TO 370
      IF (COMAND(2).EQ.105) GO TO 370
C     73,105 = ASCII I - REQUEST TO INCLUDE TEXT.
      IF (NCHCMD.LT.3) GO TO 100
      IF (COMAND(2).NE.61) GO TO 100
C     61 = ASCII =
      SIGNAL=COMAND(3)
      GO TO 70
C     END OF TEXT FILE.
80    IF (INTEXT.EQ.0) GO TO 90
      ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE
      CALL EXCHIM
      INTEXT=0
      NCHCMD=0
90    NCHCMD=MIN0(NCHCMD,0)
      IF (PHASE.NE.8) GO TO 660
      IF (INEND) 660,630,660
100   IF (PHASE.EQ.8) IF (COMAND(1)-SIGNAL) 110,480,110
110   IF (EDIT.EQ.0) GO TO 450
C
C     PARTIAL LINE EDITOR.
C     INVOKED BY -LINE$ WHERE LINE IS THE LINE NUMBER TO BE EDITED.
C     EDIT IS CONTROLLED BY N1,N2 /STRING1/STRING2/ WHERE / DENOTES
C     THE FIRST NON-BLANK CHARACTER AFTER N2.  N1 AND N2 ARE COLUMN
C     LIMITS UNDER WHICH TO PERFORM THE EDITING.  N1 AND ,N2 ARE
C     OPTIONAL.  IF N1 IS NOT SPECIFIED, COLUMN 1 IS USED AS THE LEFT
C     LIMIT.  IF ,N2 IS NOT SPECIFIED, THE END OF THE IMAGE IS
C     ASSUMED AS THE RIGHT LIMIT, AND THE IMAGE SIZE CAN CHANGE.  WHEN
C     STRING1 IS FOUND, IT IS REPLACED BY STRING2, WITH SHIFTING TAKING
C     PLACE AS NECESSARY (BETWEEN N1 AND N2) TO ACCOUNT FOR DIFFERENT
C     LENGTHS OF STRING1 AND STRING2.  THE THIRD DELIMITER IS
C     OPTIONAL, IN WHICH CASE THE REMAINDER OF (N1,N2) IS CLEARED
C     AFTER STRING2 IS INSERTED.
C
      IF (INEND.NE.0) GO TO 240
C     CONVERT COLUMN NUMBERS.
      NBR1=0
      NBR2=0
      I=0
120   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.EQ.44) GO TO 150
C     44 = ASCII COMMA
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR1=10*NBR1+J-48
      GO TO 120
130   WRITE (PRINTR,140) LINEI,I,(HOLCMD(I),I=1,NCHCMD)
140   FORMAT (//8H0AT LINE,I6,35H, EDIT CONTROL FORMAT ERROR, COLUMN,I6/
     1(1X,80A1))
      NERRS=2
      GO TO 70
150   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      J=COMAND(I)
      IF (J.LT.48) GO TO 160
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 160
C     57 = ASCII NINE
      NBR2=10*NBR2+J-48
      GO TO 150
C     SCAN FOR DELIMITER
160   IF (J.NE.32) GO TO 170
C     32 = ASCII BLANK
      I=I+1
      J=COMAND(I)
      GO TO 160
170   D1=I
      NBR1=MIN0(NBR1,180)
      NBR2=MIN0(NBR2,180)
      IF (NBR1.EQ.0) NBR1=1
      IF (NBR2.EQ.0) GO TO 180
      IF (NBR2.LT.NBR1) GO TO 130
180   I=I+1
      IF (I.GT.NCHCMD) GO TO 130
      IF (COMAND(I).NE.J) GO TO 180
      D2=I
      D3=0
190   I=I+1
      IF (I.GT.NCHCMD) GO TO 200
      IF (COMAND(I).NE.J) GO TO 190
      D3=I
C     LOOK FOR SEARCH STRING (STRING1)
200   NUMBER=D2-D1-1
      J=NBR1
      IF (NUMBER.EQ.0) GO TO 260
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
210   DO 220 I=1,NUMBER
      IF (I+J-1.GT.NY) GO TO 240
      IF (INTREC(I+J-1).NE.COMAND(I+D1)) GO TO 230
220   CONTINUE
      GO TO 260
230   J=J+1
      GO TO 210
240   WRITE (PRINTR,250) LINEI,(HOLCMD(I),I=1,NCHCMD)
250   FORMAT (//8H0AT LINE,I6,27H, NO FIND ON SEARCH STRING./(1X,80A1))
      NERRS=2
      GO TO 70
C     FOUND SEARCH STRING.  REPLACE WITH UPDATE STRING.
260   CHAR1L=PLUS
      IF (D3.NE.0) GO TO 300
C     NO THIRD DELIMITER.   REPLACE REST OF REGION.
      NY=NBR2
      IF (NY.EQ.0) NY=180
      D2=D2+1
      IF (D2.GT.NCHCMD) GO TO 280
      DO 270 I=D2,NCHCMD
      INTREC(J)=COMAND(I)
      J=J+1
      IF (J.GT.NY) GO TO 280
270   CONTINUE
280   IF (NBR2.NE.0) GO TO 290
      NCHACT=J-1
      GO TO 70
290   IF (J.GT.NBR2) GO TO 70
      INTREC(J)=32
C     32 = ASCII BLANK
      J=J+1
      GO TO 290
C     WE HAVE A THIRD DELIMITER.  REPLACE ONLY THE SEARCH STRING.
C     SHIFT THE REST OF THE REGION AS NECESSARY.
300   NUMBER=(D3-D2)-(D2-D1)
      IF (NUMBER) 310,350,330
C     SHIFT LEFT
310   I=J+D2-D1-1
      NY=MIN0(NBR2,NCHACT)
      IF (NY.EQ.0) NY=NCHACT
320   IF (I.GT.NY) GO TO 350
      INTREC(I+NUMBER)=INTREC(I)
C     NOTE - NUMBER .LT. 0 HERE
      INTREC(I)=32
C     32 = ASCII BLANK
      I=I+1
      GO TO 320
C     RIGHT SHIFT
330   I=NBR2
      IF (I.EQ.0) I=MIN0(NCHACT+NUMBER,180)
      NY=J+NUMBER
340   IF (I.LT.NY) GO TO 350
      INTREC(I)=INTREC(I-NUMBER)
      I=I-1
      GO TO 340
C     NO SHIFT NEEDED.
350   IF (NBR2.EQ.0) NCHACT=MIN0(NCHACT+NUMBER,180)
      IF (NBR2.GE.NCHACT) NCHACT=MIN0(NCHACT+NUMBER,NBR2)
      NY=NBR2
      IF (NY.EQ.0) NY=NCHACT
C     MOVE UPDATE STRING (STRING2).
360   D2=D2+1
      IF (D2.GE.D3) GO TO 70
      INTREC(J)=COMAND(D2)
      J=J+1
      IF (J-NY) 360,360,70
C
C     REQUEST TO INCLUDE TEXT.  -I IN COLUMNS 1 AND 2.
C
370   IF (EDIT.EQ.0) GO TO 390
      WRITE (PRINTR,380) (HOLCMD(I),I=1,NCHCMD)
380   FORMAT (//49H0REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT./(1X
     1,80A1))
      NERRS=2
      GO TO 70
390   ITYPEO=73
C     73 = ASCII I
      IF (NCHCMD.GE.4) GO TO 410
      WRITE (PRINTR,400) (HOLCMD(I),I=1,NCHCMD)
400   FORMAT (//45H0NO TARGET STRING ON REQUEST TO INCLUDE TEXT./(1X,80A
     11))
      NERRS=2
      GO TO 70
410   DO 420 I=4,NCHCMD
      IF (COMAND(I).NE.32) GO TO 430
420   CONTINUE
C     CONVERT TO UPPER CASE.  WE NEVER EXIT THE ABOVE LOOP AT THE BOTTOM
430   K=0
      DO 440 J=I,NCHCMD
      IF (COMAND(J).GT.95) COMAND(J)=COMAND(J)-32
      K=K+1
440   COMAND(K)=COMAND(J)
      NCHCMD=K
      GO TO 460
C
C     TEXT RECORD.
C
450   ITYPEO=0
460   NCHOUT=NCHCMD
      IF (OUTOPN.EQ.0) GO TO 470
      MODEO=0
      CALL EXCHPR (ISTAT,OBLOCK,COMAND)
      IF (ISTAT.NE.0) GO TO 770
470   CALL EXCHTP (COMAND,0)
      GO TO 70
C
C     APPARENT CHANGE CONTROL COMMAND
C
480   IF (INEND.EQ.0) GO TO 510
490   WRITE (PRINTR,500) (HOLCMD(I),I=1,NCHCMD)
500   FORMAT (//58H0ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT
     1 END./(1X,80A1))
      NERRS=1
      GO TO 70
510   NUMBER=1
      NBR1=0
      EDIT=0
      I=1
520   I=I+1
      IF (I.GT.NCHCMD) GO TO 600
      J=COMAND(I)
      IF (J.EQ.32) GO TO 600
C     32 = ASCII BLANK
      IF (EDIT.NE.0) GO TO 530
C     EDIT CONTROL MUST BE BLANK AFTER $.
      IF (J.EQ.44) GO TO 570
C     44 = ASCII COMMA
      IF (J.EQ.36) GO TO 560
C     36 = ASCII $
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.LE.57) GO TO 550
C     57 = ASCII 9
530   WRITE (PRINTR,540) I,(HOLCMD(I),I=1,NCHCMD)
540   FORMAT (//36H0CHANGE CONTROL FORMAT ERROR, COLUMN,I3/1X,80A1)
      NERRS=2
      GO TO 60
550   NBR1=10*NBR1+J-48
      GO TO 520
560   IF (NBR1.EQ.0) GO TO 530
      EDIT=1
      NBR1=NBR1-1
      GO TO 520
570   NUMBER=2
      NBR2=0
580   I=I+1
      IF (I.GT.NCHCMD) GO TO 590
      J=COMAND(I)
      IF (J.EQ.32) GO TO 590
C     32 = ASCII BLANK
      IF (IABS(J-44).EQ.1) GO TO 590
C     43 = ASCII +, 45 = ASCII -
      IF (J.LT.48) GO TO 530
C     48 = ASCII ZERO
      IF (J.GT.57) GO TO 530
C     57 = ASCII 9
      NBR2=10*NBR2+J-48
      GO TO 580
590   IF (NBR2.LT.NBR1) GO TO 530
      NBR1=NBR1-1
600   IF (NBR1.GE.LINEI-1) GO TO 620
      WRITE (PRINTR,610) (HOLCMD(I),I=1,NCHCMD)
610   FORMAT (//30H0CHANGE CONTROL SEQUENCE ERROR/1X,80A1)
      NERRS=2
      GO TO 60
620   IF (NCHCMD.LE.0) GO TO 630
      IF (LINEI.LE.NBR1) GO TO 630
      IF (NUMBER.EQ.1) GO TO 70
C     SKIP INTAPE UNTIL NBR2 IS SKIPPED.
      MODEI=1
      IF (LINEI.GE.NBR2) MODEI=0
      IF (LINEI-NBR2) 650,650,70
C     COPY FROM INTAPE UNTIL NBR1 COPIED.
630   MODEO=MODEI
      NCHOUT=NCHACT
      ITYPEO=ITYPEI
      IF (OUTAPE.EQ.0) GO TO 640
      CALL EXCHPR (ISTAT,OBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 770
640   CALL EXCHTP (INTREC,LINEI)
      MODEI=0
      IF (OPTL+OPTS+OUFILE.NE.0) GO TO 650
      IF (LINEI.EQ.NBR1) GO TO 650
      MODEI=1
650   CALL EXCHGR (ISTAT,IBLOCK,INTREC)
      IF (ISTAT.NE.0) GO TO 760
      LINEI=LINEI+1
      IF (ITYPEI.EQ.0.OR.ITYPEI.EQ.73) GO TO 620
C     73 = ASCII I
      INEND=1
      IF (NCHCMD.LE.0) GO TO 660
      I=NBR2
      IF (NUMBER.EQ.1) I=NBR1
      IF (LINEI-I) 490,490,70
660   IF (NERRS.EQ.0) GO TO 675
      J=1
      IF (PHASE.EQ.8) J=2
      WRITE (PRINTR,670) (MSG(I,J),I=1,6),NERRS
670   FORMAT (//31H0MAXIMUM ERROR SEVERITY DURING ,6A1,4H WAS,I2,1H.)
675   NERRG=MAX0(NERRG,NERRS)
      IF (OPTL+OPTS.NE.0) GO TO 690
      IF (OUTAPE+OUFILE.EQ.0) LINEO=0
      IF (INDEX.GT.0) WRITE (PRINTR,680) LINEO
680   FORMAT (I9,14H IMAGES COPIED)
      GO TO 710
690   WRITE (PRINTR,700)
700   FORMAT (1H1)
      CHAR1L=ONE
710   IF (OUFILE.EQ.0) GO TO 720
      OUTREC(1)=SIGNAL
      OUTREC(2)=SIGNAL
      NCHOUT=2
      OUTREC(180)=0
      ACTION=OPTC+OPTC-2
C     ACTION = -2 MEANS END OF PROGRAM.
      CALL EXCHOU (OUTREC)
720   IF (ITYPEI.NE.69) GO TO 750
C     69 = ASCII E
C
C     END OF FILE ON INPUT TAPE (UPDATE MODE).
C
      IF (INTOPN.LT.0) GO TO 750
      DO 730 I=1,40
730   HOLCMD(I+1)=TXDISK(I)
      HOLCMD(1)=32
      IF (TXDISK(1).NE.32) HOLCMD(1)=61
C     32 = ASCII BLANK, 61 = ASCII =
      CALL EXCHAH (HOLCMD,41)
      WRITE (PRINTR,740) (HOLCMD(I),I=1,41)
740   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE./5H TEXT,41A1)
      INTOPN=-1
C
C     RETURN TO THE COMMAND DECODER.
C
750   TRANS=1
      GO TO 790
C
C     ERROR MESSAGES.
C
760   NUMBER=1
      GO TO 780
770   NUMBER=2
780   EQUAL=ISTAT
      TRANS=8
C
C     RETURN TO THE TRANSITION PROGRAM.
C
790   PHASE=2
      IF (OUTOPN.EQ.0) PHASE=1
      RETURN
C
      END
/WEOF,BO
/FORT,M,L,B
      SUBROUTINE EXCHC8
C
C     PRINT ERROR MESSAGES.
C
C     ARRAY S CONTAINS THE SEVERITY FOR EACH MESSAGE
      INTEGER S(31)
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
C
      DATA S(01),S(02),S(03),S(04),S(05),S(06),S(07) /9,9,5,6,6,6,6/
      DATA S(08),S(09),S(10),S(11),S(12),S(13),S(14) /6,6,6,5,5,5,1/
      DATA S(15),S(16),S(17),S(18),S(19),S(20),S(21) /0,4,5,5,6,6,2/
      DATA S(22),S(23),S(24),S(25),S(26),S(27),S(28) /2,5,5,5,5,5,5/
      DATA S(29),S(30),S(31)                         /4,5,5        /
C
C             1  2  3   4   5   6   7   8   9   10  11  12  13  14  15
      GO TO (10,30,200,220,240,260,280,300,320,340,360,380,400,420,440,4
     160,480,500,520,540,560,580,600,620,640,660,680,700,720,740,751),
     2NUMBER
C     16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
10    WRITE (PRINTR,20) EQUAL
20    FORMAT (//6H0ERROR,I2,29H WHILE TRYING TO READ INTAPE.)
      GO TO 50
30    WRITE (PRINTR,40) EQUAL
40    FORMAT (//6H0ERROR,I2,30H WHILE TRYING TO WRITE OUTAPE.)
50    GO TO (60,80,100,120,140,160), EQUAL
60    WRITE (PRINTR,70)
70    FORMAT (22H BLOCK SEQUENCE ERROR.)
      GO TO 180
80    WRITE (PRINTR,90)
90    FORMAT (20H BLOCK IS TOO SHORT.)
      GO TO 180
100   WRITE (PRINTR,110)
110   FORMAT (11H I/O ERROR.)
      GO TO 180
120   WRITE (PRINTR,130)
130   FORMAT (18H RECORD TOO LARGE.)
      GO TO 180
140   WRITE (PRINTR,150)
150   FORMAT (21H UNKNOWN RECORD TYPE.)
      GO TO 180
160   WRITE (PRINTR,170)
170   FORMAT (25H FIRST BLOCK NOT A LABEL.)
      GO TO 760
180   WRITE (PRINTR,190) (HOLCMD(I),I=1,NCHCMD)
190   FORMAT (30H PROGRAM EXECUTION TERMINATED./1X,80A1)
      INFILE=0
C
C     RETURN TO QUIT SEGMENT.
C
      TRANS=9
      GO TO 800
C
200   WRITE (PRINTR,210)
210   FORMAT (//38H0COMMAND MAY NOT APPEAR IN INPUT FILE.)
      GO TO 760
220   WRITE (PRINTR,230)
230   FORMAT (//20H0INTAPE NOT DEFINED.)
      GO TO 760
240   WRITE (PRINTR,250)
250   FORMAT (//23H0UNABLE TO OPEN INTAPE.)
      GO TO 10
260   WRITE (PRINTR,270)
270   FORMAT (//23H0UNABLE TO OPEN OUTAPE.)
      GO TO 30
280   WRITE (PRINTR,290)
290   FORMAT (//36H0TITLE NOT PROVIDED FOR OUTPUT TAPE.)
      GO TO 760
300   WRITE (PRINTR,310)
310   FORMAT (//19H0DATE NOT SUPPLIED.)
      GO TO 760
320   WRITE (PRINTR,330)
330   FORMAT (//19H0SITE NOT SUPPLIED.)
      GO TO 760
340   WRITE (PRINTR,350) INTAPE
350   FORMAT (//29H0INTAPE AND OUTAPE BOTH EQUAL,I4)
      GO TO 760
360   WRITE (PRINTR,370)
370   FORMAT (//43H0U MODIFIER OF OUTAPE COMMAND NOT SELECTED.)
      GO TO 760
380   WRITE (PRINTR,390)
390   FORMAT (//38H0COMMAND MUST HAVE A PARAMETER STRING.)
      GO TO 760
400   WRITE (PRINTR,410)
410   FORMAT (//27H0COMMAND HAS IMPROPER DATE.)
      GO TO 760
420   WRITE (PRINTR,430) EQUAL
430   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,9H IGNORED.)
      GO TO 780
440   WRITE (PRINTR,450)
450   FORMAT (//39H0END OF FILE ENCOUNTERED ON INPUT TAPE.)
      IF (ICOMD) 780,560,780
460   WRITE (PRINTR,470) N1RECI
470   FORMAT (//56H0ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITIO
     1N (,I5,2H).)
      GO TO 760
480   WRITE (PRINTR,490) EQUAL
490   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
500   WRITE (PRINTR,510)
510   FORMAT (//29H0MODULE NUMBERS NOT IN ORDER.)
      GO TO 760
520   WRITE (PRINTR,530)
530   FORMAT (//23H0WORK FILE NOT DEFINED.)
      GO TO 760
540   WRITE (PRINTR,550)
550   FORMAT (//40H0WORK = INTAPE OR OUTAPE OR OUTPUT FILE.)
      GO TO 760
560   WRITE (PRINTR,570) EQUAL
570   FORMAT (//15H0CONTROL RECORD,I4,13H NOT PRESENT.)
      GO TO 760
580   WRITE (PRINTR,590)
590   FORMAT (//55H0CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDE
     1R.)
      GO TO 760
600   WRITE (PRINTR,610)
610   FORMAT (//12H0TOO MANY (.)
      GO TO 760
620   WRITE (PRINTR,630) EQUAL
630   FORMAT (//37H0MISSING PRIMARY SYMBOL BEFORE COLUMN,I3,1H.)
      GO TO 760
640   WRITE (PRINTR,650) EQUAL
650   FORMAT (//31H0MISSING OPERATOR BEFORE COLUMN,I3,1H.)
      GO TO 760
660   WRITE (PRINTR,670) EQUAL
670   FORMAT (//34H0REFERENCE TO UNDEFINED PREDICATE ,A1,1H.)
      GO TO 760
680   WRITE (PRINTR,690) EQUAL
690   FORMAT (//30H0TOO MANY ) DETECTED IN COLUMN,I3,1H.)
      GO TO 760
700   WRITE (PRINTR,710) EQUAL
710   FORMAT (//33H0UNRECOGNIZED CHARACTER IN COLUMN,I3,1H.)
      GO TO 760
720   WRITE (PRINTR,730) N1RECI
730   FORMAT (//21H0INTAPE POSITIONED AT,I5,25H.  BACKWARD SKIP IGNORED.
     1)
      GO TO 780
740   WRITE (PRINTR,750)
750   FORMAT (//23H0COMMAND IS INCOMPLETE.)
      GO TO 760
751   WRITE (PRINTR,752)
752   FORMAT (//66H0INPUT, INCLUDE OR TEXT MAY NOT BE MADE EQUAL TO OUTA
     1PE OR OUTPUT.)
760   WRITE (PRINTR,770)
770   FORMAT (23H COMMAND NOT PROCESSED.)
780   WRITE (PRINTR,790) (HOLCMD(I),I=1,NCHCMD)
790   FORMAT ((1X,80A1))
C
C     RETURN TO COMMAND PROCESSSOR.
C
      CHAR1L=0
      NERRS=MAX0(S(NUMBER),NERRS)
      NERRG=MAX0(NERRG,NERRS)
      TRANS=1
C
C     RETURN TO TRANSITION PROGRAM.
C
800   RETURN
C
      END
/WEOF,BO
/FORT,M,L,B
      SUBROUTINE EXCHC9 (IBLOCK,OBLOCK)
      INTEGER IBLOCK(1),OBLOCK(1)
C
C     PROCESS EXPLICIT QUIT COMMANDS AND IMPLICIT QUIT COMMANDS DUE TO
C     ERRORS.
C
      INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
     1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
      INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
     1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
     2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
      INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
     1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
     2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,
     3        NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),OUTOPN,PHASE,
     4        PRED(42,8),SIGNAL,SITE(40),TITLE(40),TODAY(6),TRANS,VERT
      INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
      INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
      INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
     1        WORKF
      COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
     1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
     2       ITYPEI,MODEI,REMVI,LABELI,INTREC
      COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
     1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
     2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
      COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
     1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
     2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,NERRS,
     3       NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,TITLE,
     4       TODAY,TRANS,VERT
      COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
     1       INALT,WORKF
      EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
      EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
      EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
      EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
      EQUIVALENCE (OPTVAL(22),OPTV)
      DATA KQUIT /20/
C
      IF (INFILE.EQ.0) GO TO 10
      IF (MODIFY.NE.82) GO TO 5
C     82 = ASCII R
      ACTION=2
C     ACTION = 2 MEANS REWIND INFILE.
      CALL EXCHIM
5     ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      CALL EXCHIM
      INFILE=0
      NCHCMD=0
      GO TO 50
10    IF (OPTC*OUFILE.EQ.0) GO TO 20
      ACTION=0
      NCHOUT=4
      CALL EXCHOU (COMD(1,KQUIT))
20    ACTION=-1
C     ACTION = -1 MEANS CLOSE FILE.
      IF (OUFILE.NE.0) CALL EXCHOU (OUTREC)
      IF (OUTOPN.EQ.0) GO TO 30
C     WRITE AN END-OF-FILE RECORD ON THE OUTPUT TAPE.
      ITYPEO=69
C     69 = ASCII E
      CALL EXCHPR (ISTAT,OBLOCK,OUTREC)
C     CLOSE THE INPUT TAPE.
30    IF (INTOPN.EQ.0) GO TO 40
      ISTAT=4
      CALL EXCHRT (ISTAT,OBLOCK)
C
C     RETURN TO MAIN PROGRAM.
C
40    TRANS=0
      IF (NERRG.NE.0) WRITE (PRINTR,45) NERRG
45    FORMAT (//27H0MAXIMUM ERROR SEVERITY WAS,I2,1H.)
      GO TO 60
C
C     RETURN TO THE COMMAND DECODER.
C
50    TRANS=1
60    RETURN
C
      END
/WEOF,BO
/WEOF,BO
/REW,BO
/FMAIN
DELETE,BL,E,EXCH
/LMGEN
TIDB,EXCH,1,9
LD,BO
LD,BO
LD,BO
LIB
OV,EXCHV1
LD,BO
LIB
OV,EXCHV2
LD,BO
LIB
OV,EXCHV3
LD,BO
LIB
OV,EXCHV4
LD,BO
LIB
OV,EXCHV5
LD,BO
LIB
OV,EXCHV6
LD,BO
LIB
OV,EXCHV7
LD,BO
LIB
OV,EXCHV8
LD,BO
LIB
OV,EXCHV9
LD,BO
LIB
END,BL,E
/REW,BO
/FINI
=TES FILE=16
1
0.
 .
0
0
0
0
                                  Text Exchange System
0                              A Transportable System for
                               Management and Exchange of
                                Programs and Other Text
0
                                      Section 366
                                        1846-108
0
0
0                                    June 22, 1983
0
0
0
                                     W. V. Snyder *
                               Jet Propulsion Laboratory
                                   Pasadena, CA 91109
0
                                    R. J. Hanson **
                              Sandia National Laboratories
                                 Albuquerque, NM 87185
0
0
0
0
                           California Institute of Technology
                               Jet Propulsion Laboratory
                                  4800 Oak Grove Drive
                                   Pasadena, CA 91109
0.
 .
1
0.
 .
0
0
0
0
0
0
                *  This  work represents the results of one phase of research
                   carried out at the Jet Propulsion  Laboratory,  California
                   Institute  of  Technology,  under  Contract No. NAS 7-100,
                   sponsored  by   the   National   Aeronautics   and   Space
                   Administration.
0
0               ** Work  performed  under  the  auspices  of  Sandia National
                   Laboratories, Albuquerque, New Mexico 87185 for the United
                   States Department of Energy under Contract AT(29-1)-789.
0
0
0
0
0
0
0
0
0
0
0
0
0
0.
 .
1
                                  Text Exchange System
 .
 .
                                   System Description
0          1.  Abstract
0
                The Text Exchange System (TES) provides a method to  exchange
           and  maintain  organized  information.  The system consists of the
           definition of a format for information storage  and  two  computer
           programs.   A  comprehensive  program is used to create, read, and
           maintain TES files.  To allow the TES to be distributed on a  tape
           in  the TES format, a much smaller program capable only of reading
           magnetic tape is also available.   The  programs  are  written  in
           Fortran   and   designed   for   portability,   but  a  few  small
           machine-dependent modules, available  for  several  machines,  are
           required.    Although  the  comprehensive  program  recognizes  35
           commands, information may be read from a TES format file by  using
           as  few as three commands.  In addition to its use for information
           exhange on magnetic tape, we expect the system to be  helpful  for
           maintaining libraries of text.
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0.
 .
                                          1-1
1
                                  Text Exchange System
 .
 .
                                   System Description
0          2.  Introduction
0
                 Computer  Software  is  usually  exchanged between different
           computer facilities using punched cards or magnetic tape.  For  up
           to  about  1000  images,  cards are cheaper and probably easier to
           deal with.  A frequent problem with cards is the variety of  punch
           codes.   One  also has the occasional minor nuisance of repunching
           cards damaged  in  transit,  or  reordering  cards  disordered  in
           transit.   When  the  amount  of  information  to  be  transmitted
           requires more  than  about  1000  card  images,  tape  is  usually
           cheaper.
                One  who  has  received  information  on   tape   from   many
           correspondents  has  probably  experienced  the  nuisance of tapes
           written in various densities, both parity modes, several character
           codes,  and  having  a variety of block and record lengths.  There
           are three  obvious  solutions  to  this  problem.   Most  computer
           centers  have  access  to  a  program that can handle fixed length
           records, written in fixed length blocks, using a popular character
           code  such as EBCDIC (used on IBM 360 and 370 machines).  When the
           characteristics of the medium are  correctly  specified,  one  may
           expect some success with such a program.
               Unfortunately, the recording format or medium  characteristics
           are   not  always  provided  by  the  sender,  and  are  sometimes
           incorrect.  Another solution is for a  standards  organization  to
           promulgate   a   standard   for   recording   format   and  medium
           characteristics.  Then if such information is  not  provided,  the
           standard would be a reasonable guess.
                A better solution is a transportable  program  to  enforce  a
           standard  recording  format.   This  relieves  the  sender  of the
           responsibility  for  sending  detailed   information   about   the
           recording  format  with  the  tape.   (He  must,  of course, still
           describe the medium by telling the receiver the recording  density
           and  whether the tape is a seven- or nine-track tape).  Since some
           binary numeric information is recorded, only odd parity tapes  may
           be used with the TES programs.
                Simple  programs  such  as  described  above  usually  cannot
           continue  processing  after  discovering a parity error on a tape.
           This renders a tape file containing  a  parity  error  essentially
           worthless, even though only a small fraction of the information is
           corrupted.  Methods for error recovery  are  available  [1].   The
           extra  information  required for error recovery may be stored in a
           form compatible with the other goals of the TES, but the efficient
           processing  of  this information is usually machine dependent.  In
           addition,  some  operating  systems   prohibit   user   controlled
           operations after detecting an error on a tape.  Therefore, the TES
           allows error recovery information to be included, but the programs
           do not process it.
 .
 .
                                          2-1
1
                                  Text Exchange System
 .
 .
                                   System Description
0               Although the problem of dealing with variable and  frequently
           uncertain  physical  characteristics  of  the  recording medium is
           irritating, the problem that can consume the most time is the lack
           of  organization  of  information  on the tapes received.  One may
           receive programs in several languages,  subprograms  with  several
           test  drivers, multiple versions of a program, test data, computer
           output, and documentation, with no indication  of  the  boundaries
           between  the  units of information, or of the type of the units of
           information.  In  such  situations,  much  effort  must  be  spent
           organizing  the  information  before it can be used.  The goals of
           the  TES  are  therefore  to  enforce  a  recording   format   for
           information   storage   on   magnetic   tape,  and  to  provide  a
           transportable management system for textual information.
               To organize the information, each program, subprogram, listing
           or  data  group  is  recorded  as  a  separate  module  of   text.
           Descriptive  information,  called control information, is recorded
           with each module.  The  minimum  information  required  with  each
           module  is  a  name.  For more complete description of the module,
           one may record the  data  type  (language  for  modules  that  are
           programs),   machine  type,  authors'  names  and  addresses,  and
           bibliographic references.   To  organize  programs  consisting  of
           several  modules,  one may record the names of groups of which the
           module is a member, and keywords related to the module.  To record
           information   that  does  not  fall  into  any  of  the  specified
           categories, one may include comments.  All control information  is
           recorded with the text of the module.  The control information and
           the text may be examined and updated separately, but  they  remain
           together on the tape.
               To maintain modules, a simple but flexible updating  mechanism
           is  provided,  and a brief updating history is recorded as part of
           the control information.  As an aid to maintenance and development
           of  programs consisting of several modules, constant text (such as
           global variable declarations) may be automatically inserted in the
           correct  position when the program text is copied from an exchange
           tape to a user file.
                  Operations   of   the  comprehensive  exchange  program are
           controlled by a collection of  simple  commands.   The  system  is
           designed  to  be especially easy to use by the receiver of a tape.
           For example, to copy all text from an  exchange  tape  to  a  user
           file, only three commands are required:
0            INTAPE=10    Define the exchange tape Fortran unit number.
             OUTPUT=11    Define the user file Fortran unit number.
             COPY=1-999   Copy modules 1-999 to the user file.  If there  are
                          fewer  than 999 modules present, only those present
                          are copied.
0
 .
 .
                                          2-2
1
                                  Text Exchange System
 .
 .
                                   System Description
0          3.  User's Guide for the Comprehensive Program
0
                 The  casual  or  occasional  user  of  the  program may find
           sufficient information to accomplish most simple tasks in  chapter
           4.   The  serious  user, who plans frequent use of the program and
           therefore requires  detailed  knowledge,  may  find  this  section
           easier  to  understand  if  chapter  4  is  studied  prior  to, or
           concurrent with, the study of this chapter.
0
           3.1.  Processing Sequence
0
                 The  program  operation  has  four  phases:  initialization,
           operations between  text  modules,  inserting  text  modules,  and
           updating  text modules.  The program remains in the initialization
           phase until a text module is inserted or updated.  Then the  third
           or fourth phase is entered.  The second phase then alternates with
           either the third or fourth phase.
                 Since  each module consists of separately identified control
           information and text, the insert and  update  phases  are  further
           divided  into two steps.  In the insert phase, control information
           is inserted first, then text is inserted.  In  the  update  phase,
           control  information  is  updated  first,  then  text  is updated.
           Commands are not  recognized  while  text  is  being  inserted  or
           updated,   allowing   modules   consisting   of   commands  to  be
           constructed.
                Some  commands  provide information used during processing of
           later commands, and some commands may be used only during  certain
           phases.   Restrictions  on  the  order  of commands and the phases
           during which they may be submitted are summarized below, and noted
           in the description of the individual commands.
0
           Command         Phases   Remarks
           AUTHOR            3,4
           COMMENT           3,4
           CONTROL RECORD    3,4
           COPY              1,2    Must be preceded by  an  INTAPE  command.
                                    Must   be   preceded  by  SITE  and  DATE
                                    commands if the output exchange  tape  is
                                    defined.  A TITLE command may be supplied
                                    to  replace  the  title  from  the  input
                                    exchange  tape.   The  second form of the
                                    COPY command  must  be  preceded  by  any
                                    necessary   PREDICATE,   LIMIT   or  WORK
                                    commands.
 .
 .
                                          3-1
1
                                  Text Exchange System
 .
 .
                                   System Description
0          DATA TYPE         3,4
           DATE              Any
           GROUP             3,4
           IDENTIFY OUTPUT   Any
           INCLUDE FILE      Any
           INDEX             Any
           INPUT FILE        Any
           INTAPE            1,2
           KEYWORD           3,4
           LIMIT             Any
           MACHINE           3,4
           MARGIN            Any
           NAME              1,2    Initiates  third phase.  Must be preceded
                                    by SITE and DATE commands if  the  output
                                    exchange  tape is defined; if in addition
                                    the input exchange tape is not defined, a
                                    TITLE command must be supplied.
           OPTION            Any
           ORIGIN            3,4
           OUTAPE            1,2
           OUTPUT FILE       1,2
           PREDICATE         Any
           PRINTER           Any
           QUIT              Any
           READER            Any    May not appear in the data source defined
                                    by the INPUT FILE command.
           REFERENCE         3,4
           REMOVE            3,4
           REWIND            1,2    Must be preceded by INTAPE command.
           SIGNAL            3,4
           SITE              Any
           SKIP              1,2    Must be preceded by INTAPE command.
           TEXT              3,4
           TITLE             Any
           UPDATE            Any    When submitted during the first or second
                                    phase, the  fourth  phase  is  initiated.
                                    The UPDATE command must be preceded by an
                                    INTAPE  command,  and  may  need  to   be
                                    preceded by SITE, DATE and TITLE commands
                                    as described for the NAME command.
           WORK              Any
0
           3.2.  General Command Syntax
0
                Operation of the comprehensive exchange program  is  directed
           by  simple  commands.   All commands have the same basic syntactic
 .
 .
                                          3-2
1
                                  Text Exchange System
 .
 .
                                   System Description
0          structure, although some commands may not use all available parts:
0               Command word,Modifier=Parameter.
0          The  command  word  describes  an  action  to  be  performed,   or
           identifies  information  describing  the  operational environment.
           The program examines only the first four characters of the command
           word,  ignoring blanks, and stopping when a comma or equal sign is
           found.  The modifier is  a  single  letter  that  selects  one  of
           several   slightly   different  responses  to  the  command.   The
           parameter provides environmental or control information needed  to
           perform  the  command  or  a  later  command.   Spaces  before the
           parameter are ignored, but spaces  within  the  parameter  may  be
           significant.  The simplest form of the parameter is a text string,
           usually in commands that generate  control  images  on  the  tape.
           Some  commands  require that the parameter begin with a date.  The
           form of the date is a series of six digits: the first two are  the
           year,  the  next  two are the month, and the last two are the day.
           Most of the commands that provide a Fortran unit number to be used
           as  a  data  source  or  destination  also  allow specification of
           information that may be used by system dependent  modules  of  the
           program  to  provide  significant  operational  convenience.   The
           system dependent information  follows  the  unit  number,  and  is
           separated  from the unit number by at least one space.  The system
           dependent information may  be  required.   Consult  [2]  for  more
           information.
                When actions or variations  of  actions  are  selected  by  a
           letter, as in the modifier field described above, or the parameter
           field  of some commands, upper case letters and lower case letters
           have the same meaning.
                 Information  describing  the intended action of the commands
           may be included, to help the human reader, by  starting  an  input
           image  with an asterisk.  The second character is used for Fortran
           vertical format control, and the remainder of the image is  simply
           printed.   A  comment  indicated  by  an  image  beginning with an
           asterisk may appear during any command processing phase of program
           execution.
0
           3.3.  Control Record References
0
               Control record types may be referenced by  the  INDEX  command
           (section  3.4.4),  the  PREDICATE  command (section 3.5.2), or the
           table of contents produced by the simple program (section 4.2.1 of
           [2]).    The   reference   consists   of  a  single  letter.   The
           correspondence between letters and control record types  is  shown
           below.
 .
 .
                                          3-3
1
                                  Text Exchange System
 .
 .
                                   System Description
0             A = Author of the text module.
              B = Bibliographic reference.
              C = Comment.
              D = Data type of the  text  module,  e.g.  Assembler,  Fortran,
                  Algol, data, list, etc.
              G = Group of which the text module is a member.   This  control
                  record  facilitates  processing collections of related text
                  modules.
              J = Signal  denoting  change  control  or  end  of  text,  when
                  inserting  or  updating  text  modules.   Consult  sections
                  3.5.3.2 and 3.5.4.3.
              K = Keywords associated with the text module.
              M = Machine type.  This is usually associated with text modules
                  that are programs.
              O = Date and site where the text module originated.
              P = Name of the text module.  (The TES was originally  intended
                  for  exchange of programs only.  The use of the letter P to
                  denote  the  name  of  a  text  module  is   retained   for
                  compatibility with earlier versions of the programs.)
              R = The character removed to compress the  text.   The  default
                  value for each text module is a space.
              S = The date and site where the text module was updated.
           Control records denoted by  the  letters  E  and  I  have  special
           meaning  to  the  programs  and  may not be referenced by INDEX or
           PREDICATE commands.  Control records denoted by other letters have
           no  predefined  meaning, but may be produced by the CONTROL RECORD
           command.
0
           3.4.  Commands for Defining the Environment
0
                A complete description of the operating environment  requires
           supplying  the date the program is executed, identification of the
           site at which the program is executed, identification of any tapes
           to  be  written,  definition of data sources and destinations, and
           selection of global options that affect command action.
0
           3.4.1.  General Environment Description
0
           The two commands  described  here  may  be  submitted  during  any
           command processing phase.
0           DATE=   Provides the date the program is executed.  The parameter
             is a date consisting  of  6  digits  (YYMMDD)  as  described  in
             section 3.2.  Required only if exchange tapes are to be written.
 .
 .
                                          3-4
1
                                  Text Exchange System
 .
 .
                                   System Description
0            The date may  be  provided  automatically  by  system  dependent
             actions.  Consult [2] and site documentation.
0           SITE=  Provides the site where  the  program  is  executed.   The
             parameter  consists  of  up  to 40 characters, which are written
             into the label of  exchange  tapes.   This  is  required  if  an
             exchange  tape is to be created, or if an existing exchange tape
             is to be copied  to  a  new  exchange  tape  with  additions  or
             changes.   It  is  not  needed  if an exchange tape is not being
             written, or if an existing exchange tape is to be  copied  to  a
             new  exchange  tape  without  changing any modules, but possibly
             omitting some modules.  A default value for the  SITE  parameter
             may be provided by site dependent actions of the program.
0           MARGIN= Specifies the maximum number of columns of input examined
             during interpretation of commands.  The default value is usually
             180, but consult [2] and  site  dependent  documentation.   This
             command  may be used to prevent examination of part of the image
             containing   information   not   acceptable   to   the   command
             interpreter.   Some  text  editors,  for  example,  include line
             numbers in columns 73 to 80.  To prevent the command interpreter
             from  attempting  to  interpret these line numbers, use MARGIN =
             72.
0
           3.4.2.  Defining Data Sources
0
            READER=  Provides a  Fortran  unit  number  from  which  to  read
             subsequent  commands  and text.  The parameter is an integer.  A
             default is provided by the system dependent  environment.   This
             command  may  appear  during  any  command  processing  phase of
             program execution, but may not appear in the data source defined
             by the INPUT FILE command.
0           INPUT FILE= Provides a Fortran unit number  from  which  to  read
             subsequent commands and text.  Different from the READER command
             in that its action is temporary.  When the end of the input file
             is  sensed,  either in a system dependent way, by recognition of
             the QUIT command, or by specifying INPUT FILE  =  0,  subsequent
             commands  and text are once again obtained from the Fortran unit
             defined by the READER command.   The  parameter  is  an  integer
             followed  by  system  dependent  information.   This command may
             appear during any command processing phase of program execution.
0           INTAPE=  Provides a Fortran unit number denoting an exchange tape
             to be read.  The parameter is  an  integer  followed  by  system
             dependent  information.   This  command  may  appear only during
 .
 .
                                          3-5
1
                                  Text Exchange System
 .
 .
                                   System Description
0            initialization or between modules.
0           INCLUDE  FILE=  Provides a Fortran unit number to search for text
             to be included  when  a  native  format  output  file  is  being
             written.   The  parameter  is  an  integer  followed  by  system
             dependent information.   This  command  may  appear  during  any
             command  processing phase of program execution.  Consult section
             3.5.5.
0           TEXT=   Notifies  the  program  that input of descriptive control
             information associated with a text module is complete, and  that
             input of the text of the module or corrections is to begin.  The
             parameter  may  be  an  integer  followed  by  system  dependent
             information,  providing  the  Fortran unit number of a file from
             which to read text  or  corrections.   If  the  equal  sign  and
             parameter  are  omitted,  text  or  corrections  follow the TEXT
             command.  This command may only  appear  during  the  insert  or
             update phases of program execution.
0
           3.4.3.  Defining Data Destinations
0
            PRINTER=  Provides a Fortran unit number for all printed listings
             and  program  messages.  The parameter is an integer.  A default
             is provided by the system dependent environment.   This  command
             may  appear  during  any  command  processing  phase  of program
             execution.
0           OUTAPE=  Provides a Fortran unit number denoting an exchange tape
             to be written.  The output exchange tape is not opened  until  a
             COPY,  NAME  or  UPDATE  command  is executed.  When the tape is
             opened,  information  supplied  by  the  DATE,  SITE  and  TITLE
             commands  is also used.  The parameter is an integer followed by
             system dependent information.   This  command  may  appear  only
             during initialization or between modules.  If OUTAPE is provided
             when a unit number is known for the output  exchange  tape,  and
             information  has  been  written on the output exchange tape, the
             current tape is closed by writing an end of file mark,  and  the
             newly  specified  tape is opened, even if the new unit number is
             the same as the current unit number.
                If the 'U' modifier is selected, the date and site of program
             execution are written in the 'last update performed'  fields  of
             the  output  tape  label,  and modules may be inserted, updated,
             copied or deleted.  If the 'U' modifier  is  not  selected,  the
             date and site of program execution are not recorded in the 'last
             update performed' fields of the output tape label,  and  modules
             may  not  be inserted or updated, although they may be copied or
 .
 .
                                          3-6
1
                                  Text Exchange System
 .
 .
                                   System Description
0            deleted.
0           TITLE=   Provides  a  title  for  the  output exchange tape.  The
             parameter is a string of  up  to  40  characters.   A  title  is
             required  if  the  output  tape is defined and the input tape is
             not.  It is optional if the input tape is defined.  If provided,
             the  parameter  of  this command is always used for the title of
             the output tape.  If not provided, the title of the  input  tape
             is  used  for the output tape.  If the parameter is omitted, any
             previously stored title is discarded.  This command  may  appear
             during any command processing phase.
0           OUTPUT FILE=  Provides a Fortran unit number denoting a  file  to
             be  written  in the native format of the host.  The parameter is
             an integer followed by  system  dependent  information.   If  an
             OUTPUT FILE is defined at the time this command is provided, the
             current output file is closed by writing an end  of  file  mark,
             even  if  the unit number of the current output file is the same
             as specified on the  OUTPUT  FILE  command.   This  command  may
             appear  only during the initialization phase or between modules.
0           IDENTIFY OUTPUT=  Provides specifications for  emitting  sequence
             numbers  and  constant  text in the images written to the native
             format output file.  The parameter is four integers separated by
             commas,  followed  by a comma and up to 40 characters of text to
             be emitted, e.g.  'C1,C2,STEP,START,IDTEXT',  where  C1  is  the
             first  column  of  the output to be occupied by sequence numbers
             and emitted text;  C2 is the last  such  column;   STEP  is  the
             difference  between  successive  sequence numbers;  START is the
             first  sequence  number  to  produce;  and  IDTEXT  is   emitted
             beginning  in  column  C1  and continuing to column C2.  Leading
             spaces of IDTEXT are  significant.   If  IDTEXT  is  too  short,
             remaining  columns  between  C1  and  C2 are filled with spaces.
             Excess text is ignored.  After IDTEXT is  emitted,  the  decimal
             representation of the sequence number is produced beginning with
             the low order digit, and stored right justified in  the  defined
             columns.   Production  of  digits  ceases  after  the high-order
             significant digit is produced.  This results  in  production  of
             sequence  numbers  with  leading  zeros  suppressed.  If leading
             zeros are desired, zeros must be  supplied  in  the  appropriate
             positions  of  IDTEXT.  All parts of the parameter are optional.
             If any of the integers are omitted, they are assumed to be zero.
             If  IDTEXT is omitted, no text is emitted between columns C1 and
             C2 before sequence  numbers  are  produced.   C1  is  internally
             restricted to be between 1 and 178.  C2 is internally restricted
             to be between zero and 178.  If C1 is  greater  than  C2  (which
             will become true if both are omitted), neither text nor sequence
             numbers will be emitted.  If STEP is zero sequence  numbers  are
 .
 .
                                          3-7
1
                                  Text Exchange System
 .
 .
                                   System Description
0            not produced.
                The modifier determines whether to produce  sequence  numbers
             corresponding  to the input tape, the output tape, or the native
             format output file.   If  the  'I'  modifier  is  selected,  the
             sequence  numbers are computed by adding START to the product of
             STEP and one less than the position of the  image  in  the  text
             module  on  the input exchange tape.  If the image came from the
             input stream (because the  module  is  being  inserted,  or  the
             module  is  being  updated  and  the  image  is a new image), no
             sequence number is produced and IDTEXT is not emitted.   If  the
             image  is  produced  as  the result of a request to include text
             from the INCLUDE FILE, the  sequence  number  of  the  image  is
             derived  from the position of the request on the input tape.  As
             for normal text, no sequence number is produced  and  IDTEXT  is
             not emitted if the request came from the input stream.
                If the 'O' modifier is selected,  the  sequence  numbers  are
             computed  by  adding  START  to the product of STEP and one less
             than the position of the image in the text module on the  output
             exchange  tape  (or  if the output exchange tape is not defined,
             the position the image would have if it were  defined).   Images
             produced  as  a  result  of  a  request to include text from the
             INCLUDE FILE receive a sequence number derived from the position
             of the request on the output tape.
                If the 'F' modifier is selected,  the  sequence  numbers  are
             computed  by  adding  START  to the product of STEP and one less
             than the position of the image in the native format output file,
             relative  to  the  position  of the beginning of the text of the
             module.
                 If  the  'C'  modifier is selected, the sequence numbers are
             computed by adding START to the product of  STEP  and  one  less
             than the position of the image in the native format output file,
             relative to the position of the output  file  at  the  time  the
             IDENTIFY OUTPUT command was specified.  (When the output file is
             redefined, the reference position is changed to zero).
                If no modifiers are selected, the 'O' modifier is assumed.
                This command may appear during any command  processing  phase
             of program execution.
0
           3.4.4.  Selecting Global Options
0
            OPTION=  Selects  global  options.   The  parameter  consists  of
             letters.  Individual letters select individual options.  Some of
             the letters select options exercised by the  portable  parts  of
             the  program.   Other  letters  may  select options exercised by
             system  dependent  parts  of  the  program.   All  options   are
             initially   deselected,  unless  initially  selected  by  system
 .
 .
                                          3-8
1
                                  Text Exchange System
 .
 .
                                   System Description
0            dependent initialization of the environment.   Consult  [2]  for
             such  information.   If  no  modifiers are selected, all options
             (including options having meaning only to system dependent parts
             of the program) are cleared (deselected) before the parameter is
             examined.  If the 'C' modifier is selected, letters appearing in
             the  parameter  denote  options  to  be  cleared.   If any other
             modifier is selected, letters appearing in the parameter  denote
             options  to  be selected in addition to those already in effect.
             The modifier is processed if  the  parameter  is  omitted.   All
             options may be deselected by using no modifier and no parameter.
             This command may appear  in  any  command  processing  phase  of
             program  execution.   Options exercised by the portable parts of
             the program are described below.
              A = Used in conjunction with the 'L' or 'S' options.  If a data
                  type  control  record  having  the  first  four  characters
                  exactly equal 'LIST' is associated  with  a  module  to  be
                  listed,  and  the  'A'  option  is  selected, the module is
                  printed as though the 'V' option had also been selected.
              C = If  the  'C'  option  is selected, commands used to produce
                  control information are produced in  association  with  any
                  modules  written  on the native format output file.  If the
                  'C' option is not selected, only text  is  written  on  the
                  output  file.  Control information is always written on the
                  output exchange tape.
              E = If  the  'E' option is selected all commands submitted will
                  be printed.  If the 'E' option is not selected commands are
                  printed only when they cause an error.
              I = If the 'I' option is selected, and a module is to be listed
                  because  the  'L'  or 'S' option is also selected, then any
                  images included from the INCLUDE FILE are also listed.   If
                  the 'I' option is not selected, only the request to include
                  text is listed.
              L = If  the  'L'  option  is selected, all text modules copied,
                  inserted, or updated are listed.  If the 'L' option is  not
                  selected,  modules  copied will not be listed, but inserted
                  or updated modules may be.  Consult the description of  the
                  'S' option.
              S = If the 'S' option is selected, inserted and updated modules
                  will be listed.  If the 'S' option is not selected, listing
                  is completely controlled by the 'L' option.
              V = If  the  'V'  option  is  selected,  modules  to  be listed
                  (because the 'L' or 'S' options are selected) will use  the
                  first  character  of each image for Fortran vertical format
                  control.  If the 'V' option is not selected,  modules  will
                  be  listed  with  sequence  numbers.  The effect of the 'V'
                  option may be  obtained  automatically  by  using  the  'A'
                  option.
0.
 .
                                          3-9
1
                                  Text Exchange System
 .
 .
                                   System Description
0           INDEX=  Selects control information to be printed as text modules
             are inserted,  updated  or  copied.   If  the  'L'  modifier  is
             selected,   such   information  will  only  be  printed  if  the
             associated module is to be listed (the appropriate  option  must
             be  in effect at the time the control information is processed).
             The  parameter  is  a  sequence  of  letters  selecting  control
             information  to be printed.  The parameter may also begin with a
             dash, which means all control information except that  indicated
             by following letters is to be printed.  If the parameter is void
             no index information is  printed.   The  correspondence  between
             letters  in the parameter and control record types was explained
             in section 3.3.  This command  may  appear  during  any  command
             processing phase of program execution.
0
           3.5.  Defining the Program Action
0
                The program can perform  five  basic  actions:  position  the
           input  tape,  copy selected text modules, insert new text modules,
           update control records, and update existing text modules.
0
           3.5.1.  Positioning the Input Exchange Tape
0
            SKIP=  Positions the input tape after the specified text  module,
             if  no  modifier  is  specified,  or  forward past the specified
             number of text modules if the  F  modifier  is  specified.   The
             parameter  is  an  integer.  This command may appear only during
             the initialization phase or between modules.
0           REWIND   Rewinds the input exchange tape.  There is no parameter.
             This command may appear only during the initialization phase  or
             between modules.
0
           3.5.2.  Copying Selected Text Modules
0
            COPY=   Causes  text modules to be copied from the input exchange
             tape to the output exchange tape (if defined), the native format
             output  file (if defined), and the printer (if the 'L' option is
             selected).  This command may appear only in  the  initialization
             phase or between modules.  The parameter may have two formats.
                The first format of the  parameter  is  a  list  of  integers
             separated by commas or dashes.  The integers denote text modules
             according to their position on the  input  exchange  tape.   The
 .
 .
                                          3-10
1
                                  Text Exchange System
 .
 .
                                   System Description
0            integers must be specified in strictly increasing order.  If two
             integers  in  the  parameter  are  separated by a dash, the text
             modules denoted by  both  integers,  and  all  intervening  text
             modules, are to be copied.
                The second format of the parameter is a  logical  expression.
             The  environment  of this form of the COPY command is controlled
             by the LIMIT, PREDICATE and WORK commands described below.   The
             logical   expression  consists  of  logical  variables,  logical
             operators, and parentheses.  The logical variables  are  denoted
             by the letters A through H, and the letter N.  Before processing
             of each  text  module  is  begun,  the  values  of  the  logical
             variables  A  through  H are made FALSE.  As the control records
             associated with a text module are processed, the information  in
             the  control  records  is  examined  as  specified  by PREDICATE
             commands, and the values of the logical variables  A  through  H
             may  be changed to TRUE.  The value of the logical variable N is
             always FALSE.  When all control records associated with  a  text
             module have been examined, or when all defined logical variables
             (except N) have  the  value  TRUE,  the  logical  expression  is
             evaluated.   The  operators  that  may  appear  in  the  logical
             expression are +, -, *, and /, which denote OR, OR NOT, AND, AND
             NOT  respectively.  The * and / operators bind to their operands
             with the same strength, and the + and - operators bind to  their
             operands  with the same strength.  The * and / operators bind to
             their operands more strongly than the  +  and  -  operators.   A
             sequence  of  operators  of  equal binding strength is evaluated
             from  left  to  right.   The  normal  binding  strength  may  be
             superceded by the use of parentheses.
               Processing of text modules  by  the  second  form  of  a  COPY
             command  ceases  at the end of the input exchange tape, or after
             the text module specified by the LIMIT command.  If one  of  the
             I,  P,  S  or  X  modifiers  is  selected,  processing may cease
             earlier.  The effect of a modifier is shown below.
0            None   All  modules for which the logical expression is true are
                copied.
             I  All  modules  prior  to  and (I)ncluding the first module for
                which the logical expression is true are copied.  Exactly one
                module may be copied by COPY,I=N-N.
             P  Modules (P)rior to the first module  for  which  the  logical
                expression is true are copied.
             X  E(X)actly one module is copied, the first  module  for  which
                the logical expression is true.
             S  No modules are copied.
0            If  the  P  or  S modifiers are selected the input exchange tape
             will be positioned after the control records of the first module
             for  which  the logical expression is true.  The control records
 .
 .
                                          3-11
1
                                  Text Exchange System
 .
 .
                                   System Description
0            of this module may therefore not be changed.   If  a  module  is
             inserted  or copied at this point, the module at which the input
             exchange tape is positioned will be copied before the module  is
             inserted,  achieving  the  effect  of  the I or X modifier.  If,
             however, a SKIP, REWIND or INTAPE command intervenes the  module
             cannot  be  copied.   The  P  and  S modifiers are primarily for
             positioning the tape before update  operations.   If  any  other
             modifier  is  selected,  or  no  modifier is selected, the input
             exchange tape will be positioned before the control  records  of
             the first module after the last module copied.
                Under certain conditions a more efficient method for  copying
             the  text of a module will be used automatically, by leaving the
             information read from the input exchange tape  in  the  internal
             (machine sensitive, non portable) form.  This may not be done if
             a nearby prior module has been updated, if control  records  are
             to  be  printed because of an INDEX command, or if text is to be
             printed.
0           LIMIT=   Specifies the maximum text module number to be processed
             by a COPY command having a logical expression as the  parameter.
             The  parameter is an integer.  If the LIMIT command has not been
             specified, or the value of  the  parameter  is  zero,  the  COPY
             command continues processing until the end of the input exchange
             tape is detected.  This command may appear  during  any  command
             processing phase of program execution.
0           PREDICATE=  Specifies criteria for determining  the  value  of  a
             logical  variable  used  in the second form of the COPY command.
             The  parameter  is  a  sequence  of  characters  of   the   form
             VRPMtarget.   V is the name of a logical variable (A through H).
             R denotes a control record type (section 3.3).   P  may  be  the
             letter  A to indicate that the value of logical variable V is to
             be changed to TRUE if target appears  (A)nywhere  in  a  control
             record  of  the specified type, or the letter X to indicate that
             the value of logical variable V is to  be  changed  to  TRUE  if
             target  appears in e(X)actly the specified position in a control
             record of the specified type.  M is a mask  character  that  may
             appear  anywhere  in  target  to indicate that characters in the
             corresponding position of the  control  record  are  not  to  be
             compared  to  target.   For example, if the mask character is *,
             and target is A*B, then a sequence consisting of the  letter  A,
             followed  by  any character, followed by the letter B, appearing
             in a control record, is equal to  target.   If  target  contains
             more  than 37 characters, only the first 37 are used.  If target
             contains  fewer  than  37  characters,  omitted  characters  are
             assumed  to  be  the  mask  character.   If significant trailing
             blanks are needed in target they must  be  followed  by  a  mask
             character.   When  comparing target to the contents of a control
 .
 .
                                          3-12
1
                                  Text Exchange System
 .
 .
                                   System Description
0            record, a lower case letter is considered to  be  equal  to  the
             corresponding   upper  case  letter.   If  the  equal  sign  and
             parameter are omitted all active predicates are  printed.   This
             command  may  appear  during  any  command  processing  phase of
             program execution.
0           WORK=   Defines  a  Fortran  unit  number  for a file used during
             execution of a COPY command of the second form.   The  parameter
             is  an  integer.   A  default  value  is usually provided by the
             system dependent environment, consult  [2].   This  command  may
             appear during any phase of program execution.
0
           3.5.3.  Inserting Text Modules
0
           If the input and output exchange  tapes  are  both  defined,  text
           modules  may  only be inserted if the U modifier was selected when
           the output exchange tape was defined.  Consult the description  of
           the OUTAPE command in section 3.4.3.
0
           3.5.3.1.  Inserting Control Information
0
            NAME=   Indicates  that control information associated with a new
             text module is to be input.  The parameter is the  name  of  the
             text   module.    This   command  may  appear  only  during  the
             initialization phase  or  between  modules,  and  initiates  the
             insert phase.
0          The  following  commands  may  appear  only  during  the   control
           information  processing  part  of  the  insert or update phases of
           program execution.
0           AUTHOR=  The parameter specifies the author of the text module.
0           COMMENT=   Allows  inclusion of narrative descriptive information
             as part of  the  control  information  associated  with  a  text
             module.
0           CONTROL RECORD= Produces a control record other than those having
             a  predefined  meaning.   The modifier is a letter that provides
             the control record type, and may  not  be  any  of  the  letters
             corresponding  to predefined control records (section 3.3).  The
             parameter is the content of the control record.
0           DATA  TYPE=  The parameter specifies the type of data the text of
 .
 .
                                          3-13
1
                                  Text Exchange System
 .
 .
                                   System Description
0            the module represents.  E.g. Fortran, data, list, text.
0           GROUP=   The  parameter  specifies groups of modules of which the
             current module is a member.  This is to facilitate management of
             collections of modules.
0           KEYWORD=  The parameter specifies keywords and phrases describing
             the   text   module.    This  is  to  facilitate  management  of
             collections of modules.
0           MACHINE=  The parameter specifies machine types for which modules
             that are programs were designed, or have been tested.
0           ORIGIN=   The  parameter  should  begin with the date (YYMMDD) on
             which the module was created, and in addition provides the  site
             at  which  the module was created.  If the date is not specified
             the date provided by the DATE command is inserted and a  message
             is printed.
0           REFERENCE=   The  parameter  provides  bibliographic   references
             relevant to the text module.
0           REMOVE=  The parameter  is  a  single  character  specifying  the
             character  to  be  removed  to  compress  the  text.  Characters
             removed to compress the text are automatically re-inserted  when
             the  text  is copied to the native format output file.  If there
             is no REMOVE command associated with a text module,  blanks  are
             removed.
0           SIGNAL=  The parameter  is  a  single  character  specifying  the
             character  used  in the first column of text to identify include
             requests and corrections, and in the first two columns  of  text
             to identify the end of text or correction input.  If there is no
             SIGNAL command associated with a text module, a  dash  is  used.
             The signal character may be changed during processing of text or
             corrections, as described in sections 3.5.3.2 and 3.5.4.3.
0           UPDATE=   The  parameter  should  begin with the date (YYMMDD) on
             which the module was updated, and in addition provides the  site
             at  which  the module was updated.  If the date is not specified
             the date provided by the DATE command is inserted and a  message
             is printed.
0
0
0
 .
 .
                                          3-14
1
                                  Text Exchange System
 .
 .
                                   System Description
0          3.5.3.2.  Inserting the Text of New Modules
0
                 When  all  control information associated with a text module
           has been processed, input of the text of the module  is  initiated
           by  the  TEXT  command.   Input  of  text continues until a signal
           character is found in the first two columns of an image, or an end
           of file is sensed in a system dependent way.  The portable version
           of the program cannot sense an end of file  in  the  text  stream.
           The  signal  character is initially defined by the SIGNAL command,
           or is a dash if there is no SIGNAL  command  associated  with  the
           text   module.    The  signal  character  may  be  changed  during
           processing of the text by the appearance of  '-=*'  in  the  first
           three columns of an image, where - is the current signal, and * is
           the new signal.  Changes of the signal character  accomplished  by
           this  method  are  not recorded on the exchange tape or the native
           format output file.
0
           3.5.4.  Updating Text Modules
0
           If the input and output exchange  tapes  are  both  defined,  text
           modules  may only be updated if the U modifier was selected at the
           time  the  output  exchange  tape  was   defined.    Consult   the
           description of the OUTAPE command in section 3.4.3.
0
           3.5.4.1.  Updating Control Information
0
                 Assume  that  the  input  exchange tape is positioned at the
           beginning of  the  control  information  associated  with  a  text
           module.  The phase of program execution is thus the initialization
           phase or between modules.  To  change  the  j'th  control  record,
           provide  an  image  containing  a  dash  in column 1, the number j
           beginning in column 2, at least one blank, and the new content  of
           the  control  record.   If  the  new  content is void, the control
           record is deleted (unless it is the module name  control  record).
           Modifications  of  control records must be specified in increasing
           order.  The type of a control record  may  not  be  changed.   The
           format  of  the  new  content  of  control records is not checked;
           control records that should begin with a date may accidentally  be
           changed so that they do not begin with a date.
                The  changed  control  record,  and  prior  control   records
           associated with the current text module, are not accessible by the
           COPY command of the second form.  If a COPY command of the  second
           form  is  submitted  immediately  after control records associated
 .
 .
                                          3-15
1
                                  Text Exchange System
 .
 .
                                   System Description
0          with the current text module have been  changed  or  deleted,  the
           text module is copied without examining the logical expression.
                Changing a control record by the method described  here  does
           not  guarantee that the module will be written to the defined data
           destinations.  The module must be copied, either explicitly  using
           a  copy  command  of  the  first  form, or implicitly using a copy
           command of the second form, or the text of the module updated,  to
           insure   that   the   module   is  written  to  the  defined  data
           destinations.
0
           3.5.4.2.  Adding Control Information
0
                If the UPDATE  command,  described  in  section  3.5.3.1,  is
           provided  during  the initialization phase or between modules, the
           update phase is initiated.  First, control information  associated
           with  the  text  module  at  which  the  input  exchange  tape  is
           positioned is copied, and the UPDATE command is processed as  when
           inserting  a  new  module.   Then,  the  appearance  of any of the
           commands described in section 3.5.3.1, except  the  NAME  command,
           may be used to augment the control information associated with the
           text module.  The TEXT command indicates that all additions to the
           control  information  have  been  provided, and corrections to the
           text of the module follow.
0
           3.5.4.3.  Updating the Text of a Module
0
           The  text of a module may be updated after the control information
           has been modified or augmented.  Corrections  to  the  text  of  a
           module may insert new lines of text, replace old lines of text, or
           modify old lines of text.  Instructions provided to the program to
           direct the updating process refer to the position of images in the
           text module on the input  exchange  tape.   Updating  instructions
           begin  with  a  signal  character.   The  signal  character may be
           provided by a SIGNAL command associated with the text module.   If
           no SIGNAL command is provided, the signal character is initially a
           dash.  The signal character may be changed  during  processing  of
           updating  instructions  by  an image containing '-=*' in the first
           three columns, where - is the current signal, and  *  is  the  new
           signal.   Such changes of the signal character are not recorded on
           the output exchange tape or native format  output  file.   In  the
           descriptions  below,  the current signal character is denoted by a
           dash.
                 There  are  three  forms of instructions to update text.  To
           insert text after the k'th image of  a  text  module,  provide  an
 .
 .
                                          3-16
1
                                  Text Exchange System
 .
 .
                                   System Description
0          instruction  beginning with '-k '.  Examination of the instruction
           stops when the space following the  number  k  is  detected.   All
           images following the instruction until another instruction appears
           are inserted after the k'th image of the text module.
                To replace the i'th through j'th images  of  a  text  module,
           provide an instruction beginning with '-i,j '.  Examination of the
           instruction stops  when  the  space  following  the  number  j  is
           detected.   All  images  following  the  instruction until another
           instruction appears replace images i through j of the text module.
           To delete images i through  j,  do  not  provide  any  replacement
           images.
                To modify the  k'th  image  of  a  text  module,  provide  an
           instruction beginning with '-k$ '.  Examination of the instruction
           stops when the space after the dollar sign  is  detected.   Images
           following  the  instruction  until  another  instruction  is input
           specify modifications of the k'th line of the  text  module.   The
           change  specifications are of the form 'N1,N2/old text/new text/'.
           N1 and N2 are integers specifying a range of columns of the  input
           image  to  be  changed.   If ',N2' is omitted the range of columns
           extends from column N1 to the end of the image; if  'N1'  is  also
           omitted,  all  columns  of the image are to be considered.  In the
           range of columns defined by N1 and N2 (or the default range),  the
           leftmost  occurrence  of 'old text' is replaced by 'new text'.  If
           the lengths of 'old text'  and  'new  text'  are  different,  text
           following  'old  text' in the image will be shifted appropriately.
           If ',N2' is omitted, the length of the image may change.  To allow
           'old text' and 'new text' to contain almost any character, the '/'
           appearing in the description above  denotes  any  character  other
           than  a digit, comma, or space.  (If N1 and N2 are both omitted, a
           dash may only be used if the change specification does  not  begin
           in  column 1).  This character delimits 'old text' and 'new text',
           and may not appear in either string.  If the final delimiter  (the
           third slash in the description) is omitted, columns following 'old
           text' are changed to spaces before 'old text' is replaced by  'new
           text'.   After  modifying an image, the modified image rather than
           the input image is the subject of further modifications.
0
           3.5.5.  Including Text from Alternate Sources
0
                 Collections of related programs frequently contain groups of
           statements  that  must  be  the  same  in  every  member  of   the
           collection.   To  facilitate  maintenance of such collections, the
           exchange program provides a method to include  text  automatically
           from a source specified by the INCLUDE FILE command.
0
 .
 .
                                          3-17
1
                                  Text Exchange System
 .
 .
                                   System Description
0          3.5.5.1.  Format of Request to Include Text
0
                The position in the text of the module at which text from the
           source identified by the INCLUDE FILE command is to be inserted is
           identified by a control record on the input exchange tape, or by a
           request  in  the  text  stream.   The  request  in the text stream
           generates the appropriate control record on  the  output  exchange
           tape.   The  request  for  text  to be included begins with '-I ',
           where '-' is the  current  signal,  and  at  least  one  space  is
           required  after  the  I.  The text to be included is identified by
           the remainder of the request.  The string of  characters  starting
           with  the first non-space character after column 3, and consisting
           of at most 40 characters, is called a search target.   The  source
           identified  by  the  INCLUDE  FILE  command  is searched until the
           search target is found, and the text associated  with  the  search
           target  is  then  copied to the native format output file.  If the
           INCLUDE FILE is not defined, or the search target  is  not  found,
           the request is written on the native format output file.
0
           3.5.5.2.  Format of Information on the INCLUDE FILE
0
                The structure of information on the INCLUDE  FILE  is  rigid.
           Information    is   divided   into   identifiable   groups.    The
           identification of a group consists of the sequence  '-I'  followed
           by  exactly  one  blank,  followed by up to 40 characters of text.
           The first image following the group identification defines the end
           marker  for that group, consisting of up to 40 characters of text.
           The body of the group follows, and consists of all text until  the
           end  marker  defined above is found.  The INCLUDE FILE is searched
           sequentially.  Thus, if several groups are to be  included  during
           output  of  several  text  modules,  requests  to include text are
           processed most efficiently if they appear in the same order as the
           text  groups  are  stored  on  the  INCLUDE  FILE.  The end of the
           INCLUDE FILE may be sensed in a system dependent way,  or  by  the
           sequence   '--'   appearing  when  text  group  identification  is
           expected.
0
           3.5.6.  The QUIT Command
0
                The end of input cannot be sensed in  a  portable  way.   The
           QUIT  command  provides a method to indicate the end of input.  If
           the QUIT command  appears  in  the  file  defined  by  the  READER
           command,  all  files  are closed and program execution ceases.  If
 .
 .
                                          3-18
1
                                  Text Exchange System
 .
 .
                                   System Description
0          the QUIT command appears in the file defined  by  the  INPUT  FILE
           command,  subsequent  commands and text are obtained from the file
           defined by the READER command.  In addition, when the QUIT command
           appears  in  the  file  defined  by  the INPUT FILE command, the R
           modifier may be selected to indicate that the file defined by  the
           INPUT  FILE  command  is to be rewound.  A QUIT command may appear
           during any command processing phase of program execution.
0
           3.6.  Printed Output of the Comprehensive Program
0
0
           3.6.1.  Format of Tape Label Information
0
                When exchange tapes are written the title of  the  tape,  the
           site  at  which  it  was  written,  and the date are recorded in a
           special record at the beginning of the tape, called a label.  When
           exchange  tapes  are  read  or  written  the  label information is
           printed.  The format of the display of tape label  information  is
           shown below.
0             TAPE WRITTEN yymmdd, TITLE=user title            line 1
              ORIGINALLY WRITTEN yymmdd BY site                line 2
              LAST UPDATE yymmdd BY site                       line 3
              DATA CHARACTERS PER BLOCK = nnnnn                line 4
              ERROR CORRECTION CHARACTERS PER BLOCK = nnnnn    line 5
0          The date in line 1 above is the date the tape was written, even if
           no changes were made to the contents of the tape.   The  title  in
           line  1  is  the  title  provided  for the tape, either by a TITLE
           command or from the title of an input exchange tape.  The date  in
           line  2  is  the  date the tape was originally created from native
           format information without using an input exchange tape.  The site
           in line 2 is the site supplied by a SITE command when the tape was
           originally written.  The date in line 3 is the date the  tape  was
           last updated or added to.  The site in line 3 is the site supplied
           by a SITE command when the tape was updated.  The  information  in
           line  3 is put in the tape label when the U modifier of the OUTAPE
           command is selected.  The number  in  line  4  is  the  number  of
           characters  used  to  record  data.  Since the text is compressed,
           this is not necessarily equal to the number  of  significant  text
           characters  per  block.   The  number  in  line 5 is the number of
           characters  appended  to  each  block  for  error  detection   and
           correction  purposes.   If  this  number  is  zero  line  5 is not
           printed.  The total number of characters  in  each  block  is  the
 .
 .
                                          3-19
1
                                  Text Exchange System
 .
 .
                                   System Description
0          number in line 4, plus the number in line 5 if any, plus 9.
0
           3.6.2.  Format of Index Information
0
                Index information is  printed  using  one  line  per  control
           record  associated  with  the text module.  Each line of the index
           appears as
0          mmmm nnnn*   type=text
0          where mmmm is a module number, nnnn is the ordinal position of the
           control record in the index for the module, type is the first four
           letters of the command used to generate the  control  record,  and
           text is the text provided by that command.  The module number that
           is printed depends upon whether  the  input  and  output  exchange
           tapes  are  defined.   If  the  output  tape is defined the module
           number is the ordinal position of the module on the  output  tape.
           If  the  output  tape  is  not defined and a COPY command is being
           processed the module number is the ordinal position of the  module
           on the input tape.  If the output tape is not defined and a module
           is being inserted the module number is zero.
0          If the text of the module is to be listed the index is followed by
0          mmmm*        TEXT
0          where mmmm is the module number,  and  one  blank  line.   If  the
           module is not to be listed the index is followed by
0             nnnnn IMAGES COPIED
0          where  nnnnn  is the number of images written on the native format
           output file or output exchange tape.  If  neither  destination  is
           defined nnnnn is zero.
0
           3.6.3.  Format of List of a Module
0
                If the V option is selected, or the A option is selected  for
           a  module  having  the  text  of  the last associated DATA control
           record equal to LIST, column 1 of each image of the module is used
           for  a  vertical  format  control character by the Fortran library
           output procedures of the host machine, and  the  content  of  each
           image  from  column 2 to the end is printed.  On some machines the
           text is printed beginning in column 2 of the listing, and on other
 .
 .
                                          3-20
1
                                  Text Exchange System
 .
 .
                                   System Description
0          machines it begins in column 1.
                Otherwise the text is printed  with  line  numbers.   If  the
           module is not being updated text lines are printed as
0          nnnn*   text
0          where  nnnn  is  the  ordinal  position  of the image on the input
           exchange tape (if a COPY command is being executed) or the ordinal
           position  of  the  image  in  the  data source defined by the TEXT
           command (if a module is being inserted).  If the line of text came
           from the source defined by the INCLUDE FILE command nnnn refers to
           the position of the request causing text to be included,  and  the
           asterisk is replaced by a dash.
0          If the module is being updated text lines are printed as
0          mmmm nnnn*   text
0          where  mmmm  is  the  ordinal  position  of the image on the input
           exchange tape if the image came from the input exchange  tape,  or
           'NEW  '  if  the  image  is  a  new image, and nnnn is the ordinal
           position of the image on the output exchange tape (if  the  output
           exchange  tape is not defined nnnn is the position the image would
           have if the tape were defined).  If the text  image  is  an  image
           partially  modified  by  corrections  specified  using  '-n$'  the
           asterisk is replaced by a plus sign.  If the text image came  from
           the source defined by the INCLUDE FILE command mmmm and nnnn refer
           to the position of the request causing text to  be  included,  and
           the asterisk is replaced by a dash.
0
           3.6.4.  Informative Messages
0
           Most informative messages are preceded by three  blank  lines  and
           followed by the command being processed.
0          END OF FILE ENCOUNTERED ON INPUT TAPE
             Self explanatory.
0          LIMIT=nnnnnn REACHED.
             The  module  number  specified  by  a  LIMIT  command  has  been
             processed  during  the execution of a copy command of the second
             form.
0          MAXIMUM ERROR SEVERITY DURING COPY WAS n.
           MAXIMUM ERROR SEVERITY DURING INSERT WAS n.
           MAXIMUM ERROR SEVERITY DURING UPDATE WAS n.
 .
 .
                                          3-21
1
                                  Text Exchange System
 .
 .
                                   System Description
0            At least one error occurred during  the  named  process.   Error
             messages are described in the next section.
0          MAXIMUM ERROR SEVERITY WAS n.
             This  message  can  only  be printed when the program stops.  It
             means that at least one  error  occurred.   Error  messages  are
             described in the next section.
0          MORE THAN 20 UNRECOGNIZED COMMANDS,
           PROGRAM ASSUMES TEXT COMMAND IS MISSING.
             If this message appears while processing a text module the  text
             processing  phase  is not entered until a text command is found.
             If a text command really is missing, control records,  text  and
             corrections  intended for the next module will be applied to the
             current module.  The contents of the output exchange tape  could
             be badly confused.
0          SKIPPING TEXT
             Is printed when a TEXT command is improperly placed, prohibiting
             the processing of the text, or when the program believes that  a
             text command is missing.
0
           3.6.5.  Error Messages
0
                 Errors  detected by the program are of varying severity.  In
           the descriptions below, the severity of each message is noted with
           the message.  The error severity is not printed by the program.
0          4 ALL SPECIFIED MODULES PRECEDE CURRENT INTAPE POSITION.
             All module numbers specified by a COPY command of the first form
             are  smaller  than the module number at which the input exchange
             tape is positioned.
0          2 AT LINE mmmmm, EDIT CONTROL FORMAT ERROR, COLUMN nnnnn
             A format error  has  been  detected  while  processing  an  edit
             request  following  a  change  control  instruction  of the form
             '-mmmmm$'.  Edit requests are of the form  N1,N2/target/replace/
             where  N1  and  N2  are  optional integers, and / represents the
             first character that is not a blank, digit or comma.   A  format
             error  is  detected  if N1 is greater than N2 or there are fewer
             than two of the delimiters represented here by /.
0          2 AT LINE mmmmm, NO FIND ON SEARCH STRING.
             The  string  represented  by  'target'  was  not   found   while
             processing  an  edit  request  of the form N1,N2/target/replace/
             following a change control instruction of the form '-mmmmm$'.
 .
 .
                                          3-22
1
                                  Text Exchange System
 .
 .
                                   System Description
0          1 ATTEMPT TO CHANGE OUTSIDE FILE, NEW TEXT APPENDED AT END.
             A change control instruction of the form '-m', '-k,l'  or  '-j$'
             is  being  processed,  and  one  of the integers j, k, l or m is
             greater than the number of lines of text in the  module  on  the
             input  exchange  tape.  If there is any text following the first
             two of these instructions it is  appended  at  the  end  of  the
             output  module.   If any edit requests follow the change control
             request of the form '-j$' the message 'AT LINE mmmmm, NO FIND ON
             SEARCH STRING.' will be produced.
0          9 BLOCK IS TOO SHORT.
             A  block of information read from the input exchange tape is too
             short to contain crucial structural information.
0          9 BLOCK SEQUENCE NUMBER WAS nnnnn, SHOULD HAVE BEEN mmmmm
             BLOCK SEQUENCE ERROR
             If this message is produced while reading an input exchange tape
             the  block  sequence  number  expected to be read from the input
             exchange tape was not the block sequence  number  actually  read
             from  the  input  exchange  tape.   This is usually caused by an
             input data transfer  error  that  was  not  detected.   If  this
             message  is  produced  while  writing an output exchange tape it
             probably means a program error has occurred.
0          2 CHANGE CONTROL FORMAT ERROR, COLUMN nn
             A change control instruction of the form '-m' or '-k,l' is being
             processed  and  one  of  the integers m, k or l does not consist
             entirely of digits, or a change control instruction of the  form
             '-j$'  is  being  processed  and  either  the integer j does not
             consist entirely of digits or the $ is not followed by a  blank.
0          2 CHANGE CONTROL SEQUENCE ERROR
             A change control instruction of the from '-m', '-k,l'  or  '-j$'
             is  being processed and one of the integers j, k, l or m is less
             than such an integer specified  by  a  previous  change  control
             instruction.
0          2 CHANGE TO CONTROL RECORDS NOT ALLOWED DURING INSERT OR UPDATE
             A  request  of  the form '-n text' to change control record n of
             the text module at which the input exchange tape  is  positioned
             has   been   detected  while  processing  control  records  when
             inserting or updating a text module.  If a text module is  being
             inserted  there  are  no  control  records to change.  If a text
             module is  being  updated  all  control  records  on  the  input
             exchange  tape  have already been processed.  This error message
             may appear if a TEXT command is accidentally  omitted  after  an
             UPDATE command.
0.
 .
                                          3-23
1
                                  Text Exchange System
 .
 .
                                   System Description
0          5 COMMAND HAS IMPROPER DATE.
             A DATE, ORIGIN or UPDATE command is being processed and the date
             does not consist entirely of digits, or the  integers  represent
             impossible  dates  (e.g.  the  month number is greater than 12).
             This message is produced by ORIGIN or UPDATE  commands  only  if
             the current date has not been supplied.
0          5 COMMAND IS INCOMPLETE.
             A  PREDICATE command is being processed and the parameter is too
             short to contain the variable name, record  type,  and  position
             indicator.
0          5 COMMAND MAY NOT APPEAR IN INPUT FILE.
             A  READER  command  appeared in a file defined by the INPUT FILE
             command.
0          5 COMMAND MUST HAVE A PARAMETER STRING.
             A command that must have a parameter either  contains  no  equal
             sign, or the equal sign is the last character of the command.
0          5 COMMAND NOT ALLOWED AT THIS TIME - PROBABLY MISPLACED
             A command has been detected during a processing phase when it is
             not allowed.  The command may be misplaced, or  another  command
             such as NAME or UPDATE may have been omitted.
0          - COMMAND NOT PROCESSED.
             This  message appears only with other messages and has no single
             error severity.
0          2 CONTROL RECORD CHANGE REQUESTS NOT IN ASCENDING ORDER.
             A control record change request of the form '-n text'  is  being
             processed and the integer n is less than or equal to the integer
             on a previous control record  change  request  for  the  current
             module.
0          2 CONTROL RECORD nnn NOT PRESENT.
             A  control  record change request of the form '-n text' is being
             processed and the integer  n  is  greater  than  the  number  of
             control records associated with the current module.
0          1 CURRENT DATE INSERTED IN COMMAND.
             An ORIGIN or UPDATE command is being processed and the first six
             characters of the parameter do not represent a date.   The  date
             supplied   by   the   DATE   command   or  by  system  dependent
             initialization is inserted into the command.
0          6 DATE NOT SUPPLIED.
             The date has not been supplied by a DATE command  or  by  system
 .
 .
                                          3-24
1
                                  Text Exchange System
 .
 .
                                   System Description
0            dependent  initialization.   The  date  is required when writing
             exchange tapes.
0          9 ERROR n WHILE TRYING TO READ INTAPE.
           9 ERROR n WHILE TRYING TO WRITE OUTAPE.
             An  error  has  occurred while performing the specified input or
             output operation.  Further description of the error condition is
             provided by an additional message.
0          9 FIRST BLOCK NOT A LABEL.
             The  first block of information on an input exchange tape is not
             an exchange tape label.   If  this  message  is  produced  while
             trying to read an input exchange tape it may have been caused by
             an input data transfer error that was not detected, by incorrect
             specification  to the operating system of the characteristics of
             the medium, or by an attempt to read  a  tape  that  is  not  an
             exchange  tape.   If  this  message  is produced while trying to
             write an output exchange tape it probably means a program  error
             has occurred.
0          9 I/O ERROR.
             An  input  or  output  error  has  been  detected  by the system
             dependent subprograms for reading or writing exchange tapes.
0          5 INPUT, INCLUDE OR TEXT MAY  NOT  BE  MADE  EQUAL  TO  OUTAPE  OR
             OUTPUT.
             The  program does not allow INPUT, INCLUDE or TEXT files to have
             the same unit number as OUTAPE or OUTPUT files.
0          6 INTAPE AND OUTAPE BOTH EQUAL nnn
             The program does not allow the input and output  exchange  tapes
             to have the same unit number.
0          6 INTAPE NOT DEFINED.
             A  COPY,  REWIND,  SKIP  or  UPDATE command, or a control record
             change request  was  detected  when  no  unit  number  had  been
             provided for the input exchange tape.
0          5 INTAPE POSITIONED AT nnnn.  BACKWARD SKIP IGNORED.
             If  a  backward  skip is really desired a REWIND command must be
             used.
0          5 MISSING OPERATOR BEFORE COLUMN nn.
             A COPY command of the second  form  is  being  processed  and  a
             logical  variable  name  (A-H,N)  or  left  parenthesis  follows
             another variable name or right parenthesis.
0          5 MISSING PRIMARY SYMBOL BEFORE COLUMN nn.
 .
 .
                                          3-25
1
                                  Text Exchange System
 .
 .
                                   System Description
0            A COPY command of the second form  is  being  processed  and  an
             operator is the first character of the logical expression, there
             are two adjacent operators in  the  logical  expression,  or  an
             operator  follows  a  left  parenthesis.   A primary symbol is a
             logical variable (A-H,N) or a  logical  expression  enclosed  in
             parentheses.
0          5 MODULE NUMBERS NOT IN ORDER.
             A COPY command of the first form is being processed and the list
             of modules to  be  copied  does  not  consist  of  an  ascending
             sequence of integers.
0          5 MODULES PRECEDING CURRENT INTAPE POSITION (nnnnn) NOT COPIED.
             A  COPY command of the first form is being processed and some of
             the specified module numbers are less than the module number  at
             which the input exchange tape is positioned.
0          2 NO TARGET STRING ON REQUEST TO INCLUDE TEXT.
             A  request of the from '-I (search target)' to include text from
             the source defined by the INCLUDE FILE command did  not  have  a
             string of characters to identify the text to be included.
0          5 PARAMETER MUST BEGIN WITH INTEGERS.  NOT PROCESSED.
             Self explanatory.
0          - PROGRAM EXECUTION TERMINATED.
             This  message  appears only with other error messages and has no
             single error severity.
0          9 RECORD TOO LARGE.
             A record on the input exchange tape, or a record to  be  written
             on  the output exchange tape, contains more than 180 characters.
             In the former case, this is usually the result of an  undetected
             input data transfer error.  In the latter case it is probably an
             indication of program error.
0          5 REFERENCE TO UNDEFINED PREDICATE x.
             A COPY command of the second form is  being  processed  and  the
             logical  expression  contains  a logical variable (A-H) that has
             not been defined by a PREDICATE command.
0          2 REQUEST TO INCLUDE TEXT NOT ALLOWED DURING EDIT.
             A request of the from '-I (search target)' to include text  from
             the source defined by the INCLUDE FILE command has been detected
             while processing edit requests after a change control command of
             the form '-j$'.
0          3 SEARCH TARGET CANNOT BE FOUND ON INCLUDE FILE.
 .
 .
                                          3-26
1
                                  Text Exchange System
 .
 .
                                   System Description
0            A  request of the form '-I (search target)' to include text from
             the  source  defined  by  the  INCLUDE  FILE  command  is  being
             processed,  but  the  text  named by the search target cannot be
             found.  The request to include text will be output in  place  of
             the desired text.
0          6 SITE NOT SUPPLIED.
             If an exchange tape is being modified (as indicated by selection
             of the U modifier of the OUTAPE command) or created from  native
             format data (as indicated by the absence of a definition for the
             input exchange tape) the site at which the tape is being written
             must be supplied.
0          6 TITLE NOT PROVIDED FOR OUTPUT TAPE.
             A  title  has not been provided for the output tape, either by a
             TITLE command or from an input exchange tape.
0          5 TOO MANY (.
           5 TOO MANY ) DETECTED IN COLUMN nn.
             A  COPY  command  of  the  second  form  is  being processed and
             parentheses do not balance in the logical expression.
0          5 U MODIFIER OF OUTAPE COMMAND NOT SELECTED.
             A NAME or UPDATE command, or  a  request  to  change  a  control
             record  has  been  detected  while  neither  of the unit numbers
             defined by the INTAPE or OUTAPE commands  is  zero,  and  the  U
             modifier of the OUTAPE command was not selected.  Changes (other
             than omission of modules) are not allowed if the date  and  site
             of  the changes has not been recorded in the label of the output
             exchange tape.
0          6 UNABLE TO OPEN INTAPE.
           6 UNABLE TO OPEN OUTAPE.
             These  errors  usually  occur as the result of some other error,
             such as an input data transfer error.
0          9 UNKNOWN RECORD TYPE.
             A record that is neither a  text  record  nor  a  valid  control
             record  has  been  detected.   If detected on the input exchange
             tape, it usually means that an input data transfer error was not
             detected.   If detected while trying to write an output exchange
             tape, it probably means a program error has occurred.
0          5 UNRECOGNIZED COMMAND
             May mean that a TEXT command has been omitted.  If more that  20
             successive  unrecognized  commands  are encountered, the program
             assumes that a TEXT command has been omitted.  The  contents  of
             the   output  exchange  tape  will  almost  certainly  be  badly
 .
 .
                                          3-27
1
                                  Text Exchange System
 .
 .
                                   System Description
0            confused.
0          5 UNRECOGNIZED CHARACTER IN COLUMN nn
           1 UNRECOGNIZED CHARACTER IN COLUMN nn IGNORED.
             Self explanatory.
0          6 WORK = INTAPE OR OUTAPE OR OUTPUT FILE.
             The  program  does not allow the work file to have the same unit
             number as the input exchange tape, the output exchange tape,  or
             the native format output file.
0          6 WORK FILE NOT DEFINED.
             A  COPY  command  of  the  second  form or a request to change a
             control record has been  encountered,  and  no  value  has  been
             provided  for  the  work  file,  either  by a WORK command or by
             system dependent initialization.
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
 .
 .
                                          3-28
1
                                  Text Exchange System
 .
 .
                                   System Description
0          4.  Usage Examples for Comprehensive Program
0
0
           4.1.  Reading Exchange Tapes
0
0
           4.1.1.  Ex R.1 Retrieve entire tape contents
0
0              * TO GET EVERY MODULE FROM AN EXCHANGE TAPE (ON UNIT 10)
               * TO A SYMBOLIC TEXT FILE (ON UNIT 11)
0              INTAPE=10
               OUTPUT FILE=11
               COPY=1-999
               QUIT
0          Ex. R.1 shows the simplest method for retrieving every module from
           the exchange tape.  The assumption in this example is  that  there
           are  no  more  than  999  text modules on the tape.  A more direct
           technique for getting the entire contents of the tape  involves  a
           form  of  the  predicate controlled copy, section 3.5.2.  One uses
           the so-called NULL predicate, N=NULL=Nothing.
0              * TO GET EVERY MODULE FROM AN EXCHANGE TAPE (ON UNIT 10)
               * TO A SYMBOLIC TEXT FILE (ON UNIT 11) COPY (EVERYTHING).
0              INTAPE=10
               OUTPUT FILE=11
               * THE '-' OPERATOR IN THE NEXT COMMAND MEANS 'OR NOT'.
               COPY=N-N
               QUIT
0
0          4.1.2.  Ex R.2 What's on an exchange tape?
0
0              * TO LIST ALL CONTROL INFORMATION FOR MODULES ON AN
               * EXCHANGE TAPE (ON UNIT 10) TO THE PRINTER FILE, USE THE
               * INDEX COMMAND AND REQUEST LISTING OF EVERY
               * CONTROL RECORD BY EXCLUDING NOTHING.
 .
 .
                                          4-1
1
                                  Text Exchange System
 .
 .
                                   System Description
0
               INTAPE=10
               INDEX=-
               COPY=N-N
               QUIT
0
0          4.1.3.  Ex R.3 Copy some text modules from exchange tape
0
0              * TO COPY SELECTED TEXT MODULES (TAPE SEQUENCE NUMBERS
               * KNOWN) FROM THE EXCHANGE TAPE, SELECT THE NUMBERS
               * NEEDED.  SUPPOSE MODULES 1,2,5 THROUGH 15 AND 100
               * ARE NEEDED.
0              INTAPE=10
               OUTPUT FILE=11
               COPY=1,2,5-15,100
               QUIT
0
0          4.1.4.  Ex R.4 Copy using selected control information
0
0
           4.1.4.1.  Ex R.4.1 Copy with one logical operand
0
0              * TO SELECT MODULES FROM AN EXCHANGE TAPE CORRESPONDING
               * TO KEYWORDS OR PHRASES IN THE CONTROL INFORMATION USE
               * THE SECOND OR PREDICATE FORM OF THE COPY COMMAND.
               * FOR EXAMPLE ALL MODULES WITH A GROUP CONTROL RECORD
               * CONTAINING THE WORD BLAS CAN BE RETRIEVED FROM THE
               * EXCHANGE TAPE.
0              INTAPE=10
               OUTPUT FILE=11
               PREDICATE=BGA BLAS
               COPY=B
               QUIT
0              * HERE THE ABOVE STRING (B)(G)(A) BLAS STANDS FOR LOGICAL
               * VARIABLE LABELED B, EXAMINING INFORMATION IN CONTROL
 .
 .
                                          4-2
1
                                  Text Exchange System
 .
 .
                                   System Description
0              * RECORDS G (=GROUP), (A)NYWHERE WITHIN THESE CONTROL RECORDS,
               * SEARCHING FOR THE STRING OF 4 CHARACTERS, BLAS.
0
           4.1.4.2.  Ex R.4.2 Copy with three logical operands
0
               * COPY MODULES HAVING GROUP CONTROL RECORDS
               * CONTAINING THE STRING BLAS, THAT DO NOT HAVE MACHINE
               * CONTROL RECORD CONTAINING THE STRING IBM AND DATA
               * CONTROL RECORD CONTAINING THE STRING ASSEMBLER.
0              INTAPE=10
               OUTPUT FILE=11
               PREDICATE=BGA BLAS
               PREDICATE=CMA IBM
               PREDICATE=DDA ASSEMBLER
               * THE '/' OPERATOR MEANS 'AND NOT'.
               * THE '*' OPERATOR MEANS 'AND'.
               COPY=B/(C*D)
               QUIT
0
           4.1.5.  Ex R.5 Limit the number of modules processed
0
0              * THE MODULES TO BE RETRIEVED ALL HAVE NUMBERS BETWEEN
               * 101 AND 150.  RESTRICTING PROCESSING ACTIVITY TO THIS
               * RANGE MAY REDUCE PROCESSING TIME.
0              INTAPE=10
               OUTPUT FILE=11
               * MOVE INPUT TAPE UP TO START OF MODULE 101.
               SKIP=100
               * LIMIT THE RANGE OF MODULE NUMBERS EXAMINED.
               LIMIT=150
               PREDICATE=BGA BLAS
               COPY=B
               QUIT
0
           4.1.6.  Ex R.6 List module with line numbers
0
0              * TEXT MODULE NUMBER 101 NEEDS TO BE UPDATED.
               * THE NUMBERS OF THE LINES ARE NEEDED SO THAT
 .
 .
                                          4-3
1
                                  Text Exchange System
 .
 .
                                   System Description
0              * THE UPDATES CAN BE INSERTED.
0              INTAPE=10
               OPTION=L
               COPY=101
               QUIT
0
0          4.1.7.  Ex R.7 Copy module with control records intact
0
0              * MAJOR MODIFICATIONS ARE NEEDED IN TEXT MODULE NUMBERED
               * 101.  THE CONTROL RECORDS NEED TO BE KEPT INTACT WITH
               * THE TEXT MODULE.
0              INTAPE=10
               OUTPUT FILE=11
               OPTION=C
               COPY=101
               QUIT
0
           4.1.8.  Ex R.8 Copy module including another module
0
           Text module number 100 contains the line image
0              -I COMMON VARIABLES
0          This signals the TES that the block of text named COMMON VARIABLES
           is to be inserted into the output file at this place.  Text module
           number 101 contains the text to be inserted:
0              -I COMMON VARIABLES
               CCC
                     COMMON /BLOCK/ A,B,C
               CCC
               --
0          The first step for this process is reading module number 101  into
           an output file.  This is followed by a redesignation of the output
           file.  The include file is next defined.  Finally a copy of module
           number 100 is made.
0              INTAPE=10
               OUTPUT FILE=11
 .
 .
                                          4-4
1
                                  Text Exchange System
 .
 .
                                   System Description
0              * GET MODULE TO BE INCLUDED INTO OUTPUT FILE=11.
               COPY=101
               * REDESIGNATE OUTPUT FILE AND ASSIGN THE INCLUDE FILE=11.
0              OUTPUT FILE=12
               INCLUDE FILE=11
               * REWIND THE INPUT TAPE BECAUSE MODULE NUMBER 100
               * IS BEHIND THE READ POSITION.
               REWIND
               COPY=100
               QUIT
0
           4.2.  Writing Exchange Texts
0
0
           4.2.1.  Ex W.1 Make duplicate of exchange tape
0
           A  duplicate  copy  of  an existing exchange tape is desired.  The
           exchange tape reel is mounted on file number 10.  The  fresh  tape
           reel  that  will  have  the  contents of the tape written on it is
           mounted on file 15.  The SITE and DATE signifying where  and  when
           the data was copied must be specified.  The SITE input card is not
           needed if the output tape is to  contain  only  modules  from  the
           input  tape.  It is good practice to include a SITE input whenever
           a modified form of an exchange tape  is  created.   The  TITLE  is
           copied from the input to the output tape.
0              INTAPE=10
               OUTAPE=15
               SITE=(WHERE TAPE IS BEING COPIED.)
               * TODAY IS CHRISTMAS DAY, 1979.
               DATE=791225
               * COPY EVERYTHING ON THE EXCH TAPE.
               COPY=N-N
               QUIT
0
           4.2.2.  Ex W.2 Initially make an exchange tape
0
0
0
 .
 .
                                          4-5
1
                                  Text Exchange System
 .
 .
                                   System Description
0          4.2.2.1.  Ex W.2.1 Put one module on EXCH tape
0
           A  text  module consisting of a single Fortran subroutine is to be
           put on an exchange tape mounted on file number 15.
0              OUTAPE=15
               TITLE=(NAME FOR THE TAPE REEL.)
               SITE=(WHERE TAPE IS BEING WRITTEN.)
               DATE=(YYMMDD)
               * CONTROL RECORDS FOR THE NEW MODULE.
               NAME=(SUBROUTINE OR MODULE NAME.)
               ORIGIN=(YYMMDD)
               AUTHOR=(PERSON WHO WROTE THE SUBROUTINE.)
               DATA=FORTRAN
               * SUBROUTINE SOURCE CARDS START AFTER THE TEXT CARD.
               TEXT
                      SUBROUTINE ...
                      ...
                      END
               --
               QUIT
0
0          4.2.2.2.  Ex W.2.2 Put several modules on EXCH tape
0
           For  a  second  example in this section we consider the problem of
           writing  several  subroutines  on  an  EXCH  tape.   The   control
           information  for  each module is largely the same.  Only the names
           of the modules are different.  To do this effectively we  put  the
           constant  control  information  on  file  number  11.   This  file
           contains the lines
0              ORIGIN=(YYMMDD SITE WHERE SUBROUTINES WERE WRITTEN.)
               AUTHOR=(PERSON WHO WROTE THE SUBROUTINES.)
               GROUP=(CLASSIFICATION OF THE SUBROUTINES.)
               REFERENCE=(JOURNAL ARTICLE RELEVENT TO THE SUBROUTINES.)
               DATA=FORTRAN
               MACHINE=PORTABLE
               KEYWORD=(INDUSTRY-RECOGNIZED WORDS FOR THE PROGRAM FUNCTION.)
               COMMENT=(REMARKS ON FEATURES OR LIMITATIONS OF THE PROGRAM.)
               * REWIND THE FILE WHEN IT HAS BEEN READ.
               QUIT,R
0          The  writing  of the exchange tape, mounted on file number 15, can
           now be illustrated.
 .
 .
                                          4-6
1
                                  Text Exchange System
 .
 .
                                   System Description
0              OUTAPE=15
               TITLE=(...)
               SITE=(...)
               DATE=(YYMMDD)
               NAME=(SBNAME...)
               * GET CONSTANT CONTROL INFORMATION FROM FILE 11.
               INPUT FILE=11
               TEXT
                      SUBROUTINE SBNAME(...)
                        ...
                      END
               --
               NAME=(...)
               INPUT FILE=11
               TEXT
                      SUBROUTINE ...
                        ...
                      END
               --
                         ...
               QUIT
0
0
           4.2.2.3.  Ex W.2.3 Put modules from file onto tape
0
           For  a  third  example we will modify the second example slightly.
           The only difference is that the subroutines  are  all  located  on
           file number 12 as follows.
0                     SUBROUTINE SBNAME(...)
                        ...
                      END
               --
                      SUBROUTINE ...
                        ...
                      END
               --
                        ...
               QUIT
0          After defining the OUTAPE, TITLE, SITE and DATE input as shown  in
           the examples W.2.1 and W.2.2, the remaining input is
0              NAME=(SBNAME...)
               * GET CONSTANT CONTROL INFORMATION FROM FILE 11.
 .
 .
                                          4-7
1
                                  Text Exchange System
 .
 .
                                   System Description
0              INPUT FILE=11
               * READ SUBROUTINE TEXT FROM FILE 12.
               TEXT=12
0              NAME=(...)
               INPUT FILE=11
               * THIS USAGE ASSUMES THAT FILE 12 STAYS POSITIONED.
               * THIS IS TRUE FOR THE PORTABLE VERSION OF THE PROGRAM.
               TEXT=12
                         ...
               QUIT
0
           4.2.3.  Ex W.3 Add module to the end of an EXCH tape
0
           An existing exchange tape is mounted on file number 10.   A  fresh
           reel is mounted on file number 15.  A new module is to be added to
           the end of the new tape.
0              INTAPE=10
               OUTAPE,U=15
               TITLE=(...)
               SITE=(...)
               DATE=(YYMMDD)
               * GET THE OLD TAPE CONTENTS TO THE NEW TAPE.
               COPY=N-N
               * INSERT THE NEW MODULE ON THE NEW TAPE
               NAME=(...)
               ORIGIN=(YYMMDD)
               AUTHOR=(...)
               DATA=FORTRAN
               TEXT
                      SUBROUTINE ...
                        ...
                      END
               --
               QUIT
0
0          4.2.4.  Ex W.4 Updating modules on EXCH tape
0
0
0
 .
 .
                                          4-8
1
                                  Text Exchange System
 .
 .
                                   System Description
0          4.2.4.1.  Ex W.4.1 Updating entire lines on EXCH tape
0
           In  this  example  module  number 101 is a Fortran subroutine that
           requires a number of  changes.   The  existing  exchange  tape  is
           mounted on file number 10.  A fresh reel is mounted on file number
           15.
0              INTAPE=10
               OUTAPE,U=15
               TITLE=(...)
               SITE=(...)
               DATE=(YYMMDD)
               * COPY THE MODULES THAT REQUIRE NO CHANGE.
               COPY=1-100
               * INSERT A CARD AT THE FRONT OF THE PROGRAM,
               * REMOVE LINE 5, INSERT A LINE AFTER LINE 7,
               * AND REPLACE LINE 9 THROUGH 11 BY FOUR NEW LINES.
0              UPDATE=(YYMMDD)
               TEXT
               -0
               C      SOME COMMENT.
               -5,5
               -7
                      A=0.
               -9,11
                      B=0.
                      C=0.
                      D=0.
                      E=0.
               --
               * COPY THE REMAINING MODULES THAT ARE UNCHANGED.
               COPY=N-N
               QUIT
0
0          4.2.4.2.  Ex W.4.2 Editing individual lines on EXCH tape
0
           In this second example the only difference from the first  example
           is that module number 101 requires editing.  The input for INTAPE,
           OUTAPE, etc. is identical through the UPDATE card.
0              TEXT
               -27$ CHANGE REAL*4 TO REAL IN LINE 27.
               /REAL*4/REAL/
 .
 .
                                          4-9
1
                                  Text Exchange System
 .
 .
                                   System Description
0              --
               COPY=N-N
               QUIT
0
           4.2.4.3.  Ex W.4.3 Updating control records on EXCH tape
0
           In this third example the only difference from the  first  example
           is  that  module  number  101  requires  changes  in  the  control
           information.  The input is identical through the COPY=1-100  card.
0              * REMOVE CONTROL RECORD NUMBER 2, CHANGE CONTROL RECORD
               * NUMBER 4, AND INSERT A NEW GROUP CONTROL RECORD.
               -2
               -4 (NEW TEXT FOR CONTROL RECORD 4.)
               UPDATE=(YYMMDD)
               GROUP=(NEW GROUP CONTROL RECORD.)
               TEXT
               --
               COPY=N-N
               QUIT
0
           4.2.5.  Ex W.5 Merge two EXCH tapes
0
           In this example one wants to take two  exchange  tapes,  on  files
           numbered  10  and 11, and merge them to write a fresh reel on file
           number 15.
0              INTAPE=10
               OUTAPE,U=15
               TITLE=(...)
               SITE=(...)
               DATE=(YYMMDD)
               COPY=N-N
               * OPEN A NEW INTAPE ON FILE 11.
               INTAPE=11
               COPY=N-N
               QUIT
0
0
0
0.
 .
                                          4-10
1
                                  Text Exchange System
 .
 .
                                   System Description
0          5.  Reporting Errors Discovered in the TES
0
           If errors are discovered in the TES,  the  authors  would  greatly
           appreciate  accurate reporting of the circumstances of the errors.
           To facilitate correction of the error, reproduce  the  environment
           of  the  error as accurately as possible.  In particular, describe
           the desired  action,  provide  all  commands  used,  describe  the
           result,  and if possible provide the input exchange tape in use at
           the time of  the  error.   To  the  extent  possible,  all  errors
           reported will be given prompt attention.
0          Report errors to:
0              W. V. Snyder
               Mail Stop 171-249
               Jet Propulsion Laboratory
               4800 Oak Grove Drive
               Pasadena, CA 91109
0              Telephone 213/354-6271, or FTS 792-6271.
0
0
0
0
0
0
0
0
0
0
0
0
0
0.
 .
                                          5-1
1
                                  Text Exchange System
 .
 .
                                   System Description
0          6.  Suggesting Changes to the TES
0
           Several extensions of the TES have been proposed.  Suggestions for
           changes to the TES should be forwarded to Snyder.
0          * Implement  error detection and correction in a portable way that
             is compatible with efficient machine dependent processing.
0          * Implement a command that allows text to be written on the native
             format  output  file  but  not  the  output exchange tape.  This
             command  could  be  used  to  place  operating  system   control
             statements on the native format output file.
0          * Provide  separate files for messages and listings.  If the files
             have different unit numbers, messages would be printed  on  both
             files.  Listings would be printed only on the listing file.
0          * Implement  a  command  to  save  the  state  of the program (the
             contents of the tape buffers and all common blocks).  This would
             allow  concurrent reading and writing of several exchange tapes,
             or temporarily leaving the exchange program to perform a  system
             dependent task.
0          * Implement  a  WHAT  command  to print everything known about the
             environment - unit numbers, machine sensitive file names, title,
             site,  date,  predicates,  parameters of the IDENTIFY OUTPUT and
             LIMIT commands,  options,  index  selections,  and  any  machine
             sensitive environmental information.
0          * Print  a  page  heading while making a listing (without vertical
             format control).  The page heading would consist of  the  module
             number  and  the  text of the module name record.  A page length
             command would be useful in this respect.
0          * Some versions would benefit from an INPUT WIDTH command.
0          * The Univac 1100 version would  benefit  from  an  automatic  JCL
             generator.
0
0
0
0
0.
 .
                                          6-1
1
                                  Text Exchange System
 .
 .
                                   System Description
0          7.  Acknowledgments
0
           Several individuals  have  contributed  to  both  the  design  and
           implementation  of  the TES.  T. Aird of IMSL, Incorporated helped
           with the development of system  sensitive  modules  for  the  Data
           General MV/8000.  Modules for the Cray-1 using COS were written by
           A. Elsbernd of System Development Corporation at  Sandia  National
           Laboratories.   Modules  for  the  DECSystem-20 using TOPS-20 were
           written by P. Gaffney at Oak Ridge National  Laboratory.   Modules
           for the DEC VAX using Berkeley UNIX (TM) were written by D. Gay at
           Bell Laboratories in Murray Hill, NJ.  Modules for the DEC  PDP-11
           using  RSX-11m  were  written  by  J.  Gomez at the Jet Propulsion
           Laboratory.  Modules for the DEC PDP-10 using TOPS-10 were written
           by  J.  Greif  at  the  California  Institute of Technology and J.
           Wisniewski at Sandia National  Laboratories.   K.  H.  Haskell  at
           Sandia  National  Laboratories assisted in the implementations for
           the CDC 6000/7000 using SCOPE and NOS, IBM 360/370  using  OS  and
           DEC VAX using VMS.  F. T. Krogh at JPL contributed ideas regarding
           the command syntax and the needed capabilities of the system.  The
           authors  have  also  implemented  the  system  for Univac 1100 and
           modified the work of some of the contributors mentioned above.
0
0
0
0
0
0
0
0
0
0
0
0
0
 .
 .
                                          7-1
1
                                  Text Exchange System
 .
 .
                                   System Description
0          8.  References
0
           1.  Robert  McEliece,  "The  Theory  of  Information  and Coding",
               Addison-Wesley, 1971.
           2.  W.  V.  Snyder  and  R.  J.  Hanson,  "Text  Exchange  System,
               Installation Instructions and Description of System  Dependent
               Variants,"   Jet   Propulsion   Laboratory  internal  document
               1846-109.
           3.  W.  V. Snyder and R. J. Hanson, "Text Exchange System, Program
               Descriptions," Jet  Propulsion  Laboratory  internal  document
               1846-110.
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
 .
 .
                                          8-1
1
                                  Text Exchange System
 .
 .
                                   Table of contents
0
           1.  Abstract                                                   1-1
0          2.  Introduction                                               2-1
0          3.  User's Guide for the Comprehensive Program                 3-1
               3.1.  Processing Sequence                                  3-1
               3.2.  General Command Syntax                               3-2
               3.3.  Control Record References                            3-3
               3.4.  Commands for Defining the Environment                3-4
               3.4.1.  General Environment Description                    3-4
               3.4.2.  Defining Data Sources                              3-5
               3.4.3.  Defining Data Destinations                         3-6
               3.4.4.  Selecting Global Options                           3-8
               3.5.  Defining the Program Action                         3-10
               3.5.1.  Positioning the Input Exchange Tape               3-10
               3.5.2.  Copying Selected Text Modules                     3-10
               3.5.3.  Inserting Text Modules                            3-13
               3.5.3.1.  Inserting Control Information                   3-13
               3.5.3.2.  Inserting the Text of New Modules               3-15
               3.5.4.  Updating Text Modules                             3-15
               3.5.4.1.  Updating Control Information                    3-15
               3.5.4.2.  Adding Control Information                      3-16
               3.5.4.3.  Updating the Text of a Module                   3-16
               3.5.5.  Including Text from Alternate Sources             3-17
               3.5.5.1.  Format of Request to Include Text               3-18
               3.5.5.2.  Format of Information on the INCLUDE FILE       3-18
               3.5.6.  The QUIT Command                                  3-18
               3.6.  Printed Output of the Comprehensive Program         3-19
               3.6.1.  Format of Tape Label Information                  3-19
               3.6.2.  Format of Index Information                       3-20
               3.6.3.  Format of List of a Module                        3-20
               3.6.4.  Informative Messages                              3-21
               3.6.5.  Error Messages                                    3-22
0          4.  Usage Examples for Comprehensive Program                   4-1
               4.1.  Reading Exchange Tapes                               4-1
               4.1.1.  Ex R.1 Retrieve entire tape contents               4-1
               4.1.2.  Ex R.2 What's on an exchange tape?                 4-1
               4.1.3.  Ex R.3 Copy some text modules from exchange tape   4-2
               4.1.4.  Ex R.4 Copy using selected control information     4-2
               4.1.4.1.  Ex R.4.1 Copy with one logical operand           4-2
               4.1.4.2.  Ex R.4.2 Copy with three logical operands        4-3
               4.1.5.  Ex R.5 Limit the number of modules processed       4-3
               4.1.6.  Ex R.6 List module with line numbers               4-3
               4.1.7.  Ex R.7 Copy module with control records intact     4-4
               4.1.8.  Ex R.8 Copy module including another module        4-4
               4.2.  Writing Exchange Texts                               4-5
 .
 .
                                           1
1
                                  Text Exchange System
 .
 .
                                   Table of contents
0              4.2.1.  Ex W.1 Make duplicate of exchange tape             4-5
               4.2.2.  Ex W.2 Initially make an exchange tape             4-5
               4.2.2.1.  Ex W.2.1 Put one module on EXCH tape             4-6
               4.2.2.2.  Ex W.2.2 Put several modules on EXCH tape        4-6
               4.2.2.3.  Ex W.2.3 Put modules from file onto tape         4-7
               4.2.3.  Ex W.3 Add module to the end of an EXCH tape       4-8
               4.2.4.  Ex W.4 Updating modules on EXCH tape               4-8
               4.2.4.1.  Ex W.4.1 Updating entire lines on EXCH tape      4-9
               4.2.4.2.  Ex W.4.2 Editing individual lines on EXCH tape   4-9
               4.2.4.3.  Ex W.4.3 Updating control records on EXCH tape  4-10
               4.2.5.  Ex W.5 Merge two EXCH tapes                       4-10
0          5.  Reporting Errors Discovered in the TES                     5-1
0          6.  Suggesting Changes to the TES                              6-1
0          7.  Acknowledgments                                            7-1
0          8.  References                                                 8-1
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0.
 .
                                           2
1
                                  Text Exchange System
 .
 .
                                         Index
0
           Adding text to a module                        3.5.           3-16
           AUTHOR=author of text module.                  3.5.           3-13
0          Command Sequence                               3.1.            3-1
           COMMENT=...                                    3.5.           3-13
           Comments about commands begin with *           3.2.            3-3
           Control Record References                      3.3.            3-3
           CONTROL RECORD,type=...                        3.5.           3-13
           COPY,IPSX=logical expression                   3.5.           3-11
           COPY=                                          3.5.           3-10
           COPY=list of module positions                  3.5.           3-10
0          DATA=data type                                 3.5.           3-13
           DATE=yymmdd                                    3.4.            3-4
0          Error Messages, Comprehensive Program          3.6.           3-22
           Ex R.1 Retrieve entire tape contents           4.1.            4-1
           Ex R.2 What's on an exchange tape?             4.1.            4-1
           Ex R.3 Copy some text modules from EXCH Tape   4.1.            4-2
           Ex R.4 Copy using selected control information 4.1.            4-2
           Ex R.4.1 Copy with one logical operand         4.1.            4-2
           Ex R.4.2 Copy with three logical operands      4.1.            4-3
           Ex R.5 Limit the number of modules processed   4.1.            4-3
           Ex R.6 List module with line numbers           4.1.            4-3
           Ex R.7 Copy module with control records intact 4.1.            4-4
           Ex R.8 Copy module including another module    4.1.            4-4
           Ex W.1 Make duplicate of exchange tape         4.2.            4-5
           Ex W.2 Initially make an exchange tape         4.2.            4-5
           Ex W.2.1 Put one module on EXCH tape           4.2.            4-6
           Ex W.2.2 Put several modules on EXCH tape      4.2.            4-6
           Ex W.2.3 Put modules from file onto tape       4.2.            4-7
           Ex W.3 Add module to the end of an EXCH tape   4.2.            4-8
           Ex W.4 Updating modules on EXCH tape           4.2.            4-8
           Ex W.4.1 Updating entire lines on EXCH tape    4.2.            4-9
           Ex W.4.2 Editing individual lines on EXCH tape 4.2.            4-9
           Ex W.4.3 Updating control records on EXCH tape 4.2.           4-10
           Ex W.5 Merge two EXCH tapes                    4.2.           4-10
0          Format of Index Information                    3.6.           3-20
           Format of List of a Module                     3.6.           3-20
           Format of Tape Label Information               3.6.           3-19
0          GROUP=membership list                          3.5.           3-14
0          IDENTIFY OUTPUT,IOFC=C1,C2,STEP,START,IDTEXT   3.4.            3-7
           INCLUDE FILE format                            3.5.           3-18
           INCLUDE FILE=unit number system info           3.4.            3-6
 .
 .
                                           1
1
                                  Text Exchange System
 .
 .
                                         Index
0          Include text request format                    3.5.           3-18
           INDEX[,L]=(-)control record type selectors     3.4.           3-10
           Informative Messages, Comprehensive Program    3.6.           3-21
           INPUT FILE=unit number system info             3.4.            3-5
           INTAPE=unit number system info                 3.4.            3-5
0          KEYWORD=key words and phrases                  3.5.           3-14
0          LIMIT=text module number                       3.5.           3-12
0          MACHINE=machine type                           3.5.           3-14
           MARGIN=Command margin                          3.4.            3-5
           Modifying text images                          3.5.           3-17
0          NAME=text module name                          3.5.           3-13
0          OPTION=ACEILSV and other characters            3.4.            3-8
           ORIGIN=yymmdd site                             3.5.           3-14
           OUTAPE=unit number system info                 3.4.            3-6
           OUTPUT FILE=unit number system info            3.4.            3-7
0          PREDICATE=VRPMtarget                           3.5.           3-12
           PRINTER=unit number                            3.4.            3-6
0          QUIT[,R]                                       3.5.           3-18
0          READER=unit number                             3.4.            3-5
           REFERENCE=bibliographic references             3.5.           3-14
           REMOVE=character to remove for compression     3.5.           3-14
           Replacing text in a module                     3.5.           3-17
           Reporting Errors Discovered in the TES         5.              5-1
           REWIND                                         3.5.           3-10
0          SIGNAL=signal character                        3.5.           3-14
           SITE=40 characters                             3.4.            3-5
           SKIP[,F]=module number                         3.5.           3-10
0          Text of New Modules                            3.5.           3-15
           TEXT=unit number system info                   3.4.            3-6
           TITLE=40 characters                            3.4.            3-7
0          UPDATE=yymmdd site (insert)                    3.5.           3-14
           UPDATE=yymmdd site (updating)                  3.5.           3-16
           Updating Control Information                   3.5.           3-15
           Updating the Text of a Module                  3.5.           3-16
0          WORK=unit number                               3.5.           3-13
0.
 .
                                           2

1
0.
 .
0
0
0
0
0                                 Text Exchange System
0                              Installation Instructions
                                   and Description of
                               System Dependent Variants
0                                     Section 366
                                        1846-109
0
0
0                                   October 11, 1983
0
0
0
                                     W. V. Snyder *
                               Jet Propulsion Laboratory
                                   Pasadena, CA 91109
0
                                    R. J. Hanson **
                              Sandia National Laboratories
                                 Albuquerque, NM 87185
0
0
0
0
                           California Institute of Technology
                               Jet Propulsion Laboratory
                                  4800 Oak Grove Drive
                                   Pasadena, CA 91109
0.
 .
1
0.
 .
0
0
0
0
0
0
                *  This  work represents the results of one phase of research
                   carried out at the Jet Propulsion  Laboratory,  California
                   Institute  of  Technology,  under  Contract No. NAS 7-100,
                   sponsored  by   the   National   Aeronautics   and   Space
                   Administration.
0
0               ** Work  performed  under  the  auspices  of  Sandia National
                   Laboratories, Albuquerque, New Mexico 87185 for the United
                   States Department of Energy under Contract AT(29-1)-789.
0
0
0
0
0
0
0
0
0
0
0
0
0
0.
 .
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          1.  Abstract
0
                The Text Exchange System (TES) provides a method to  exchange
           and  maintain  organized  information.  The system consists of the
           definition of a format for information storage  and  two  computer
           programs.   A  comprehensive  program is used to create, read, and
           maintain TES files.  To allow the TES to be distributed on a  tape
           in  the TES format, a much smaller program capable only of reading
           magnetic tape is also available.   The  programs  are  written  in
           Fortran   and   designed   for   portability,   but  a  few  small
           machine-dependent modules, available  for  several  machines,  are
           required.    Although  the  comprehensive  program  recognizes  35
           commands, information may be read from a TES format file by  using
           as  few as three commands.  In addition to its use for information
           exhange on magnetic tape, we expect the system to be  helpful  for
           maintaining libraries of text.
               This document describes the use of system  dependent  variants
           of  the  TES  programs,  and  provides an installation guide.  The
           programs are described in greater detail in [1].   It  is  assumed
           here that the reader is familiar with [2].
0
0
0
0
0
0
0
0
0
0
0
0
0
0.
 .
                                          1-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          2.  Machine or System Sensitive Modules
0
           The simple tape exchange program consists of eleven program units.
           The comprehensive tape exchange program consists of more  than  35
           program units (the number of program units depends on the computer
           system).  Some of these  modules  are  always  machine  or  system
           sensitive.   Some  may be usable in the portable (usually trivial)
           form  on  some  machines  while  machine  sensitive  versions  are
           required  on  other  machines.  Some may be usable in the portable
           form on most machines, but significant operational convenience  or
           improved   performance  may  be  provided  by  machine  or  system
           dependent modifications.  Most modules, however, are usable on all
           machines  in the portable form, and no significant improvements in
           convenience or performance can be achieved by  machine  or  system
           dependent modifications.
0
           2.1.  Internal Representation of Characters
0
           Character information is stored on exchange tapes using the  seven
           bit ASCII code for a character, stored in the low order seven bits
           of an eight bit frame with the high  order  bit  zero.   The  high
           order  bit  is  not  necessarily zero in every frame, because some
           binary numeric information  is  also  stored  on  the  tape.   The
           internal  character  representation used by both exchange programs
           is  the  integer  equivalent  for  the  ASCII  [3]  code  of  each
           character.   Thus,  for  example,  the  letter  A  (upper case) is
           represented by the integer 65.
0
           2.2.  System Dependent Information from Commands
0
           In   the   comprehensive   exchange   program,   system  dependent
           information  may  be  provided  by  some   commands   [2].    This
           information  is  stored  in two representations in the 180 element
           Fortran type INTEGER vectors COMAND and HOLCMD in the named COMMON
           block  /EXCHPC/.   COMAND  contains  the  command  in the internal
           character representation described  above.   HOLCMD  contains  the
           command in the normal character representation of the host machine
           (the representation used if input is read  using  'A1'  format  or
           character  data  is  declared  using  '1H'  notation).  The system
           dependent information begins  in  the  command  at  the  character
           position indicated by the variable EQUAL in the named COMMON block
           /EXCHPC/, and the last  non-blank  character  of  the  command  is
           indicated  by  the  variable  NCHCMD  in  the  named  COMMON block
 .
 .
                                          2-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          /EXCHPC/.  If EQUAL is zero, or if EQUAL is greater  than  NCHCMD,
           there is no system dependent information in the command.
0          The  command  is  available  when the system dependent subroutines
           EXCHFO, EXCHIM and EXCHOU are called to open native format  files.
           To  provide one point for processing system dependent information,
           the  system  dependent  subroutine  EXCHCX  is  also  called  when
           processing  READER,  INPUT  FILE, TEXT, INCLUDE FILE, OUTPUT FILE,
           INTAPE and OUTAPE  commands.   The  system  dependent  information
           available  on  INTAPE and OUTAPE commands may be processed only in
           EXCHCX.  The  system  dependent  information  available  on  other
           commands  may  be  processed  in  EXCHCX  or  the system dependent
           subroutine EXCHFO, EXCHIM or EXCHOU, as appropriate.  Consult  the
           description of EXCHCX for further information.
0
           2.3.  Modules that are Sensitive to All Machines
0
           Five  modules  of  the  comprehensive  program must be provided in
           machine sensitive form for every machine type.   The  modules  for
           reading  tape  and  unpacking  characters  are  also needed by the
           simple program.
0
           2.3.1.  Main Program Unit
0
           The  main  program  unit  is  the same for both programs.  It must
           provide space for tape input and values  for  several  machine  or
           system sensitive parameters.
0          Physical  records  on  exchange  tapes  (the unit of data transfer
           between tape and the  main  memory  of  the  computer)  contain  a
           multiple  of  180  characters,  each  consisting  of  8 bits.  For
           computer word sizes of 8, 12, 16, 24, 32, 36, 48 and 60 bits, this
           amount  of  data will exactly fill the last computer word required
           to hold the data.  Thus, there should be  no  problems  caused  by
           requirements  to  transfer  partial words between tape and memory.
           The main program  must  provide  sufficient  space  to  read  3600
           eight-bit  characters in the format used for transfer between tape
           and main memory.  This format may depend upon the  design  of  the
           module used to read tape, EXCHRT, described below.
0          The  parameters  that  must  have values provided are variables in
           named COMMON blocks.  A listing of the current  contents  of  each
           named  COMMON  block  should  accompany  each  transmittal  of the
           exchange programs to a new site.  The variable in the named COMMON
 .
 .
                                          2-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          block /EXCHIC/ that must have an initial value provided is:
0           NWCBI, the number of Fortran type INTEGER words occupied by NCCBI
             characters.   This  probably can be computed as (NCCBI*8)/WSIZE,
             where WSIZE denotes the number of bits of a Fortran type INTEGER
             word  provided by input data transfers.  The method of computing
             the value of NWCBI may depend on the system dependent subprogram
             EXCHRT described below.
0          The  variables  in  the named COMMON block /EXCHUC/ that must have
           initial values provided are:
0           PRINTR  Provides the default Fortran unit number for the printer.
0           READER Provides the default Fortran unit number for the reader.
0          When initialization of the environment is complete,  execution  of
           either program is initiated by
0                CALL EXCH (IBLOCK)
0          where IBLOCK is the space provided for tape input.
0          When  execution  of the exchange program is complete, EXCH returns
           to the main program unit.  The main program  unit  may  then  stop
           program execution or initiate another process.
0
           2.3.2.  Interface to the Comprehensive Program
0
           As  described  above,  the  system  dependent  main  program  unit
           executes
0                CALL EXCH (IBLOCK)
0          after  providing  initial  values  for  several  parameters.   The
           portable  part  of  the simple program is a subroutine named EXCH.
           To interface between the system dependent main  program  unit  and
           the  comprehensive  exchange  program,  a  subroutine EXCH must be
           provided.  This subroutine has  responsibilities  similar  to  the
           system dependent main program unit: it must provide space for tape
           output,  and  initial  values  for  several  machine  and   system
           dependent  parameters.   It  may  provide  a default value for the
           site, and may fetch the date from  the  operating  system.   Other
           machine sensitive initialization of the environment, such as using
           information from the operating system  command  that  invoked  the
           exchange program to provide initial values for parameters normally
 .
 .
                                          2-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          provided by exchange program commands is also possible.
0          The interface subprogram must provide sufficient  space  to  write
           3600  eight-bit characters in the format used for transfer between
           main memory and tape.  This format may depend on the design of the
           module used to write tape, EXCHWT, described below.
0          The  parameters  that  must  have values provided are variables in
           named COMMON blocks.  The variables  in  the  named  COMMON  block
           /EXCHOC/ that must have initial values provided are:
0           NDATAO Is the number of data characters per output  block.   This
             is  usually  nine  characters  less  than  the nominal number of
             characters per tape block.  If an error correction code is used,
             the value of this variable must be further reduced by the number
             of characters of error correction information, provided  by  the
             variable  NERRCO  described below.  That is, NDATAO + NERRCO + 9
             must be the number of characters in the output tape block.  This
             variable  usually has the value 3591, provided by the block data
             subprogram noted in the description of NCCBI.
0           NERRCO Is the number of characters added to each tape  block  for
             error detection and correction.  NDATAO + NERRCO + 9 must be the
             number of characters in the output tape  block.   This  variable
             usually   has  the  value  zero,  provided  by  the  block  data
             subprogram noted in the description of NCCBI.
0           NWCBO Is the number of Fortran type  INTEGER  words  occupied  by
             NCCBO   characters.    This   probably   can   be   computed  as
             (NCCBO*8)/WSIZE, where WSIZE denotes the number  of  bits  of  a
             Fortran  type  INTEGER word used for output data transfers.  The
             method of computing the value of NWCBO may depend on the  system
             dependent subprogram EXCHWT described below.
0          The variable in the named COMMON block /EXCHUC/ that must have  an
           initial value provided is:
0           WORKF Provides the default Fortran unit number for the work file.
0          When  initialization  of the environment is complete, execution of
           the comprehensive exchange program is initiated by
0               CALL EXCHTR (IBLOCK,OBLOCK)
0          where IBLOCK is the space provided for  tape  input  by  the  main
           program unit, and OBLOCK is the space provided for tape output.
0          When execution of the exchange program is complete, EXCHTR returns
 .
 .
                                          2-4
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          to the interface subroutine EXCH.  EXCH should return to the  main
           program unit, but may stop or initiate another process.
0
           2.3.3.  Character Unpacking in Both Programs
0
           The  machine  sensitive  subprogram  EXCHUN is required to extract
           individual eight bit characters from the block of  input  provided
           by  the  machine  sensitive subprogram EXCHRT described below, and
           store them in the representation described above.  This extraction
           usually involves unpacking characters, several of which are stored
           in each word, and storing individual characters  in  single  words
           using  the  internal  character  representation  described  above.
           Since  the  internal  representation   of   characters   and   the
           representation of characters on exchange tapes uses the same code,
           extracting characters may involve shifting and masking,  but  will
           not  require  character  code  translation.  To reduce the cost of
           subprogram linkage, EXCHUN must unpack NCCBI characters each  time
           it  is  called.   The  value  of  NCCBI is not changed by portable
           subprograms of either exchange program.  If the value of NCCBI  is
           not  changed  by machine sensitive subprograms, the use of a local
           constant to determine the number of characters to  unpack  may  be
           more  efficient  than using NCCBI.  The exact format of the packed
           information depends on the input data transfer method used by  the
           machine sensitive subprogram EXCHRT described below.  Unpacking of
           NCCBI characters always begins at a word boundary.  The subprogram
           EXCHUN is invoked by
0               CALL EXCHUN (INPBUF,CHARS)
0          where  INPBUF  is  part  of  the  tape input buffer, and EXCHUN is
           responsible for placing the NCCBI characters beginning  at  INPBUF
           into  the  Fortran  type  INTEGER  vector  CHARS, one per word, as
           described above.
0
           2.3.4.  Character Packing in the Comprehensive Program
0
           The machine  sensitive  subprogram  EXCHPA  is  required  to  pack
           individual  characters  in the representation described above into
           the form necessary for output by the machine sensitive  subprogram
           EXCHWT    described   below.    Since   the   internal   character
           representation and the representation of  characters  on  exchange
           tapes  uses  the  same  code,  packing  the characters may involve
           shifting and masking, but will not involve code  translation.   To
           reduce  the  cost  of  subprogram  linkage  EXCHPA must pack NCCBO
 .
 .
                                          2-5
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          characters each time it is called.  The  value  of  NCCBO  is  not
           changed  by  portable subprograms of the exchange program.  If the
           value of NCCBO is not changed by  machine  sensitive  subprograms,
           the  use of a local constant to determine the number of characters
           to pack may be more efficient than using NCCBO.  The exact  format
           of  the  packed  information  depends  on the output data transfer
           method used by the machine sensitive subprogram  EXCHWT  described
           below.   Packed  information  is always stored beginning at a word
           boundary.  The subprogram EXCHPA is invoked by
0               CALL EXCHPA (CHARS,OUTBUF)
0          where EXCHPA is  responsible  for  placing  the  NCCBO  characters
           stored in the Fortran type INTEGER vector CHARS in the part of the
           output tape buffer denoted by OUTBUF using the format required  by
           EXCHWT.
0
           2.3.5.  Reading Exchange Tapes
0
           Since  the run time Fortran input/output services of most computer
           systems enforce a system dependent format for  input  and  output,
           and  the  exchange tape has a fixed system independent format, the
           machine sensitive subprogram EXCHRT is  needed  to  read  exchange
           tapes.  The subprogram EXCHRT is invoked by
0               CALL EXCHRT (ISTAT,DBLOCK)
0          where  ISTAT  is a scalar in-out INTEGER variable and DBLOCK is an
           output INTEGER vector.  EXCHRT must perform one of four functions,
           determined by ISTAT, each time it is invoked.
0           ISTAT=1 Means open the file designated by the unit number  INTAPE
             in  the  named  COMMON  block /EXCHUC/ for input with no rewind.
             Information stored by a call to EXCHCX may be  used  to  provide
             operational convenience.  Note, however, that EXCHCX is not part
             of the simple program.  Thus, if EXCHRT uses  such  information,
             there   must   be   some  method  of  determining  whether  such
             information has been provided.  The information probably will be
             passed  from  EXCHCX  to  EXCHRT  by using COMMON variables.  An
             appropriate initial value should be provided  for  these  COMMON
             variables by the system dependent main program unit.
0           ISTAT=2  Means  rewind  the  file  designated  by the unit number
             INTAPE.  (Close with rewind, because this request is followed by
             a request with ISTAT=1).
0.
 .
                                          2-6
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0           ISTAT=3 Means read a block of NDATAI + NERRCI + 9 characters from
             the file designated by the unit number  INTAPE.   The  variables
             NDATAI and NERRCI are in the named COMMON block /EXCHIC/.  Every
             character of the block must be stored in DBLOCK  in  the  format
             necessary   for  EXCHUN,  described  above.   If  possible,  the
             variable NCDBI in the named COMMON block /EXCHIC/ should be  set
             to  the  number  of  characters  actually  transferred.  If this
             number is not available, set NCDBI equal to NDATAI + NERRCI + 9.
             If  an  exchange  format  label  is  expected,  indicated by the
             variable BLKSQI in the named COMMON block /EXCHIC/  equal  zero,
             allow  a  single  end  of file mark.  Otherwise, treat an end of
             file mark as an error.  If NERRCI is not zero, NERRCI characters
             beginning  in the first character position of DBLOCK may be used
             for error detection or correction [4].
0           ISTAT=4 Means close with no rewind.
0          The  variable  ISTAT  is  also  used  to  return the status of the
           operation to the calling program.  If errors occur  EXCHRT  should
           write  a  message  on  the  Fortran unit identified by the INTEGER
           variable PRINTR in the named COMMON block /EXCHUC/.  If no  errors
           occur,  or if only trivial errors occur, set ISTAT equal zero.  If
           catastrophic errors occur, set ISTAT equal 3.  Do not set ISTAT to
           any other values.
0
           2.3.6.  Writing Exchange Tapes
0
           Since  the  run  time Fortran input/output system of most computer
           systems enforces a system dependent format for input  and  output,
           and  the  exchange tape has a fixed system independent format, the
           machine sensitive subprogram EXCHWT is needed  to  write  exchange
           tapes.  The subprogram EXCHWT is invoked by
0               CALL EXCHWT (ISTAT,DBLOCK)
0          where  ISTAT is a scalar in-out INTEGER variable, and DBLOCK is an
           input INTEGER vector.  EXCHWT must perform one of three functions,
           determined by ISTAT, each time it is invoked.
0           ISTAT=1 Means open the file designated by the unit number  OUTAPE
             in  the  named  COMMON block /EXCHUC/ for output with no rewind.
             Information stored by a call to EXCHCX may be  used  to  provide
             operational  convenience.   This  information  will  usually  be
             passed from EXCHCX to EXCHWT by using COMMON variables.
0           ISTAT=2 Means write a block of NDATAO +  NERRCO  +  9  characters
 .
 .
                                          2-7
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0            from  DBLOCK  to  the file designated by the unit number OUTAPE.
             The variables NDATAO and NERRCO are in the  named  COMMON  block
             /EXCHOC/.   NERRCO  characters of error detection and correction
             may be  stored  in  DBLOCK  beginning  in  the  first  character
             position.  Every character in DBLOCK must then be transferred to
             the file, and no information may be appended to the block.
0           ISTAT=3 Means write an end  of  file  mark  and  close  the  file
             designated by the unit number OUTAPE with no rewind.
0          The variable ISTAT is also  used  to  return  the  status  of  the
           operation  to  the calling program.  If errors occur EXCHWT should
           write a message on the Fortran  file  identified  by  the  INTEGER
           variable  PRINTR in the named COMMON block /EXCHUC/.  If no errors
           occur, or if only trivial errors occur, set ISTAT equal zero.   If
           catastrophic errors occur, set ISTAT equal 3.  Do not set ISTAT to
           any other values.
0
           2.4.  Modules that may be Machine Sensitive
0
           Six modules of the comprehensive program and three modules of  the
           simple  program  may  be  required in machine sensitive form.  The
           module EXCHFO is used by both programs but may be different in the
           two programs.
0
           2.4.1.  Block Data in the Simple Program
0
           The block data subprogram of the simple program, identified on the
           exchange program distribution tape as EXCHBX, contains a translate
           table  from  the  internal (ASCII) representation of characters to
           the hollerith representation of the host  machine.   Two  versions
           are  provided  on  the  distribution  tape,  one  having hollerith
           symbols for only the 47 characters defined in the ANSI Fortran  66
           standard  [5],  the  other having graphics for 95 ASCII characters
           (including space).  When the  simple  program  is  distributed  on
           cards  special  attention should be given to this program unit, as
           the most frequent problem with punched cards is getting the  punch
           codes correct.
0
0
0
 .
 .
                                          2-8
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          2.4.2.  Block Data in the Comprehensive Program
0
           The block data subprogram of the comprehensive program, identified
           on the exchange program distribution tape as  EXCHBD,  contains  a
           translate  table similar to the table in the block data subprogram
           of the simple program.  Two versions of EXCHBD are  provided,  one
           having  a full ASCII translate table as for EXCHBX, and one having
           no translate table (consult section 2.5).  Since  the  modules  of
           the  comprehensive  program  are  always  copied from the exchange
           distribution tape by using the simple program, the translate table
           in  the  simple  program  completely determines the content of the
           translate table in EXCHBD.
0          The array COMD in the named COMMON  block  /EXCHPC/  contains  the
           first  four  letters  of commands to be recognized by EXCHC1.  The
           array contains space for 40 commands  but  only  34  commands  are
           recognized  by  the portable version of the comprehensive program.
           The extra space may be used to assist in the recognition of system
           dependent  commands.   If  such  commands  are  placed in COMD the
           variable NCOMDT in the  named  COMMON  block  /EXCHPC/  should  be
           changed to indicate the total number of commands in COMD.  Consult
           the description of EXCHCX for more information.
0
           2.4.3.  Opening and Closing Native Format Files
0
           Some Fortran run time systems require that Fortran files be opened
           and  closed  by  using  a  non-portable statement.  The subroutine
           EXCHFO is called when some  of  these  files  must  be  opened  or
           closed.   In most systems, EXCHFO is trivial, consisting of only a
           return statement.  EXCHFO is invoked by
0               CALL EXCHFO (IOP)
0          where IOP is an INTEGER scalar.  If IOP is positive, a file is  to
           be  opened.   If  IOP  is  negative,  a file is to be closed.  The
           absolute value of IOP determines the file to open or  close.   The
           files  are  identified  by  a  Fortran unit number, indicated by a
           variable in the named COMMON block /EXCHUC/.  If IABS(IOP)  is  1,
           open  or  close the file identified by READER.  If IABS(IOP) is 2,
           open or close the file identified by PRINTR.  If IABS(IOP)  is  3,
           open  or  close  the file identified by WORKF.  If IABS(IOP) is 4,
           open or close the file identified by INFILE.  EXCHFO  is  used  by
           both  the  simple  and  comprehensive  programs.   In  the  simple
           program, WORKF is used for formatted output.  In the comprehensive
           program,  WORKF  is used for unformatted output and input.  EXCHFO
 .
 .
                                          2-9
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          is called with IABS(IOP) equal 4 only when EXCHFO is part  of  the
           simple program.
0          In  the comprehensive program, the system dependent information in
           the READER FILE, WORK FILE or PRINTER  commands  may  be  used  to
           provide operational convenience (consult section 2.2).
0
           2.4.4.  Reading Native Format Files
0
           The  subprogram  EXCHIM  is  used  by the comprehensive program to
           perform operations on native format input files.  When  EXCHIM  is
           invoked by
0               CALL EXCHIM
0          the  operation  to  be performed is determined by the value of the
           INTEGER variable ACTION in the named COMMON  block  /EXCHPC/.   If
           ACTION  is  -1 a native format file is to be closed.  If ACTION is
           zero a native format file is to be read.  If ACTION is +1 a native
           format file is to be opened.  If ACTION is +2 a native format file
           is to be rewound.  The file upon which to  act  is  determined  by
           examining  the  unit  numbers  indicated  by  the variables INALT,
           INTEXT, INFILE and READER in the named COMMON  block  /EXCHUC/  in
           the  order  shown,  and  acting  upon the file associated with the
           first  positive  unit  number.   The  rewind  operation  is  never
           requested  for  the  READER and INTEXT files.  After the requested
           operation has been performed, ACTION must be set to zero.
0          Data read when ACTION is zero is to be placed in the  180  element
           Fortran type INTEGER vectors COMAND and HOLCMD in the named COMMON
           block /EXCHPC/, storing one character per  element.   HOLCMD  must
           contain   the   representation  used  by  the  host  machine  when
           characters are read using 'A1' format.  COMAND  must  contain  the
           integer  equivalent  of  the  characters in HOLCMD as described in
           section 2.1.  The portable version of EXCHIM translates  only  the
           47 characters defined by the ANSI Fortran 66 standard [5], using a
           very slow method.  A more  complete  translation,  or  significant
           improvement  in performance, may be achieved by a system dependent
           translation method.  The position of the last non-blank  character
           must  be stored in the INTEGER variable NCHCMD in the named COMMON
           block /EXCHPC/.  If an end of file mark is detected while  reading
           data, NCHCMD must be set to -1.
0          In  some  systems  files  must be opened and closed by executing a
           non-portable statement.  Such statements are not possible  in  the
           (almost) portable version of EXCHIM.
 .
 .
                                          2-10
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          When  an input native format file is to be opened (ACTION=+1), the
           command causing the file to be opened is still  stored  in  COMAND
           and   HOLCMD   (consult   section   2.2).   The  system  dependent
           information may be  used  at  this  time  to  provide  operational
           convenience.   The  system  dependent  information  may instead be
           processed by the system  sensitive  subprogram  EXCHCX,  described
           below.
0
           2.4.5.  Writing Native Format Files
0
           The  subprogram  EXCHOU  is  used  by the comprehensive program to
           write the native format file indicated by the unit  number  OUFILE
           in  the  named  COMMON block /EXCHUC/.  In some systems it is also
           necessary to open and close Fortran files by using a  non-portable
           statement,  and  take  special  actions at the beginning of end of
           text modules.  Such processing is not  possible  in  the  (almost)
           portable version of EXCHOU.  When EXCHOU is invoked by
0               CALL EXCHOU (OUTPUT)
0          the  action  to be performed is determined by the INTEGER variable
           ACTION in the named COMMON block /EXCHPC/.  If ACTION is  -2,  the
           end  of  a  text  module has been processed.  If ACTION is -1, the
           file is to be closed.  If ACTION is zero, data in the type INTEGER
           vector  OUTPUT  is to be written on the file.  If ACTION is +1 the
           file is to be opened.  if ACTION is +2 the first line  of  a  text
           module will be the next output.
0          When  data  are  to be written, the number of characters is in the
           INTEGER variable  NCHOUT  in  the  named  COMMON  block  /EXCHPC/.
           (NCHOUT  is  always  less  than 178).  The elements of the INTEGER
           vector OUTPUT are individual characters represented by the integer
           equivalent  of  the  ASCII  code  [3].   This  representation must
           usually be converted to the normal hollerith representation of the
           host machine.  If OUTPUT(180) is less than one, the data in OUTPUT
           represent a control record.  If OUTPUT(180) is greater than  zero,
           the data in OUTPUT represent a text image.
0          When the file associated with the Fortran unit number OUFILE is to
           be opened (ACTION=+1) the OUTPUT FILE command is still  stored  in
           the  INTEGER vectors COMAND and HOLCMD (consult section 2.2).  The
           system dependent information from the OUTPUT FILE command  may  be
           used  at this time to provide operational convenience.  The system
           dependent information may  instead  be  processed  by  the  system
           sensitive subprogram EXCHCX, described below.
0.
 .
                                          2-11
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          2.4.6.  Segmentation of the Compehensive Program
0
           The major operations of the comprehensive program are performed by
           9 subprograms that need not occupy main memory simultaneously.  In
           minicomputer  systems it is usually necessary to allow only one of
           these subprograms to occupy memory at a time, due to  memory  size
           limitations.   In  some systems loading of non-resident parts of a
           program must be initiated by explicit program action.  Before  any
           of  the  potentially  non-resident  segments  of  the  program are
           entered, the subprogram EXCHSL is invoked by
0               CALL EXCHSL
0          to allow the program to request the segment to be loaded.  In most
           systems, EXCHSL is trivial, consisting of only a return statement.
           The segment to be loaded is determined  by  the  INTEGER  variable
           TRANS in the named COMMON block /EXCHPC/, as shown below.
0           Value of TRANS     Contents of Segment
                  1            EXCHC1, EXCHCX
                  2            EXCHC2
                  3            EXCHC3, EXCHRH, EXCHWH
                  4            EXCHC4, EXCHLX
                  5            EXCHC5, EXCHCG
                  6            EXCHC6
                  7            EXCHC7
                  8            EXCHC8
                  9            EXCHC9
0          In  the  Sperry  V-70  VORTEX  system, the operations of loading a
           non-resident segment and passing control to  it  are  inseparable.
           Due  to memory size limitations, the segment loading was performed
           in EXCHTR, and EXCHSL was deleted.  This may also be  required  in
           other systems.
0
           2.5.  Optional System Dependent Enhancements
0
           Several  subprograms  of the comprehensive program may be modified
           in system  dependent  ways  to  provide  operational  convenience,
           enhanced  performance,  or  capabilities  having meaning only in a
           system dependent  context.   Such  modifications  of  the  modules
           EXCHIM, EXCHOU, EXCHRT, EXCHWT, and EXCHFO were discussed above.
0
0.
 .
                                          2-12
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          2.5.1.  Conversion of Character Codes for Output
0
           The subprogram EXCHAH is invoked by
0               CALL EXCHAH (RECORD,NCHAR)
0          where  NCHAR  is  an  INTEGER  scalar  indicating  the  number  of
           characters in the INTEGER in-out vector  RECORD  to  be  converted
           from  the  internal  ASCII representation [3] to the host system's
           hollerith representation.  The portable version of EXCHAH uses the
           translate table provided in the block data subprogram EXCHBD.  But
           in some systems, the internal hollerith  representation  uses  the
           ASCII   code,   and   the  translation  from  the  internal  ASCII
           representation may therefore be performed without  the  use  of  a
           translate table.  If a version of EXCHAH is provided that does not
           require a translate table, and the translate table is not used  by
           any  other  system  dependent  modules, the translate table may be
           removed.  (The translate table is stored in the named COMMON block
           /EXCHXC/  and  is probably referenced only in the main program and
           EXCHBD).
0
           2.5.2.  System Dependent Command Processing
0
0
           2.5.2.1.  Extra Commands in the Comprehensive Program
0
           When commands are being processed by the comprehensive program and
           an  input  image  does  not  contain  a  command recognized by the
           portable command interpreter the subroutine EXCHCX is invoked by
0               CALL EXCHCX (0)
0          to examine the input image.  The input image is stored  in  COMAND
           and  HOLCMD  by  EXCHIM (consult the description of the method for
           reading native format files).  If the input image is not a  system
           dependent  command  EXCHCX  should make sure the variable ICOMD in
           the named COMMON block /EXCHPC/ is zero, and return.  If the image
           is  a system dependent command certain processing performed by the
           portable command interpreter may be useful.  The command word  may
           be recognized by EXCHC1 if the variable NCOMDT in the named COMMON
           block /EXCHPC/ is greater than the variable NCOMDP  in  the  named
           COMMON block /EXCHPC/ and locations in the array COMD in the named
           COMMON block  /EXCHPC/  have  been  provided  appropriate  values.
 .
 .
                                          2-13
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          Examination of the subprograms EXCHBD, EXCHC1 and system dependent
           variants of EXCHCX should provide sufficient understanding of  the
           changes  necessary.   If  the command word is recognized by EXCHC1
           the variable ICOMD in the named  COMMON  block  /EXCHPC/  will  be
           greater  than  NCOMDP  and  less  than  or  equal  to NCOMDP.  The
           modifier character  of  the  command  is  stored  in  the  INTEGER
           variable  MODIFY  in  the  named COMMON block /EXCHPC/.  MODIFY is
           zero if no modifier  was  selected.   The  position  of  the  last
           non-blank  character  of  the  image  is  indicated by the INTEGER
           variable NCHCMD in the named COMMON block /EXCHPC/.   The  INTEGER
           variable  EQUAL  in  the named COMMON block /EXCHPC/ indicates the
           position of the first non-blank character following the equal sign
           in the image, is zero if no equal sign appears in the image, or is
           greater than NCHCMD if  the  equal  sign  is  the  last  non-blank
           character of the image.
0          System dependent commands have been used to indicate the character
           code to use for native format output (UNIVAC 1100 version), and to
           indicate  whether the horizontal tab character (ASCII 9) is a data
           character or is to be replaced by the appropriate number of spaces
           (DEC  PDP-10, PDP-11, VAX/VMS and VAX/UNIX versions and DG MV/8000
           AOS/VS version).
0
           2.5.2.2.  Processing of System Dependent Information
0
           When   certain   commands   that   may  contain  system  dependent
           information are recognized by  EXCHC1  the  subroutine  EXCHCX  is
           invoked by
0                CALL EXCHCX (REASON)
0          where  the  value  of  reason  is  determined by the command being
           processed, as shown in the table below.
0            Value of REASON     Command
                   1             READER
                   2             INPUT FILE
                   3             TEXT
                   4             INCLUDE FILE
                   5             OUTPUT FILE
                   6             INTAPE
                   7             OUTAPE
0          This  provides  a  common  point  for  processing system dependent
           information from commands.  In some systems EXCHC1 and EXCHCX will
           be part of a nonresident segment.  When EXCHCX is invoked any file
 .
 .
                                          2-14
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          defined by a previous occurrence of the  command  will  have  been
           closed,  and the file to be defined by the command will not yet be
           opened.  The file defined by the READER command may be  opened  in
           EXCHCX  or  EXCHFO.   The files defined by the INPUT FILE, TEXT or
           INCLUDE FILE commands may be opened in EXCHIM or EXCHCX.  The file
           defined  by  the  OUTPUT  FILE  command may be opened in EXCHOU or
           EXCHCX.  The system dependent information provided by  the  INTAPE
           and  OUTAPE  commands  must  be  processed  in  EXCHCX because the
           command is not available when EXCHRT or EXCHWT is called  to  open
           the  file defined by the command.  The file defined by the command
           should not be opened by EXCHCX.
0
           2.5.3.  System Dependent Use of Control Records
0
           Before each control record is written on the output exchange tape,
           the subprogram EXCHCG is invoked by
0               CALL EXCHCG (OUTREC)
0          to allow system dependent processing of control records.  The type
           of the control record is indicated by the INTEGER variable  ITYPEO
           in  the  named  COMMON  block /EXCHPC/ and the text of the control
           record is contained in the INTEGER vector OUTREC, both  using  the
           internal representation (ASCII) of the comprehensive program.  The
           number of characters of text of the control record is indicated by
           the  INTEGER  variable  NCHOUT in the named COMMON block /EXCHPC/.
           If NCHOUT is zero a control record is not being processed;  NCHOUT
           equal zero means all control records associated with a text module
           have previously been processed and processing of text is to begin.
           EXCHCG   may  be  used  for  automatic  creation  of  job  control
           statements.
0
0
0
0
0
0
0
0.
 .
                                          2-15
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          3.  Installation Instructions
0
0
           3.1.  Organization of the Distribution Tape
0
           The first file  of  the  exchange  program  distribution  tape  is
           written  using the comprehensive exchange program, and may be read
           using either program.  The second and following files of the  tape
           contain  job  control statements and machine sensitive versions of
           the complete simple program, written in a format  intended  to  be
           easy  to  read  by  each  machine for which the programs have been
           implemented.  The exact number of files, and  the  format  of  the
           individual  files  may change as the programs evolve.  If the tape
           is long enough, all files will be recorded a second time.
0          The first file of the tape contains all modules of  both  programs
           for  all  machines  for  which the programs have been implemented,
           documentation (including this document), and some  small  programs
           for  exchanging  text  on punched cards.  Although the modules are
           all part of a single file, they are recorded in  clusters  on  the
           tape.   The  number  of clusters and the number of modules in each
           cluster may change as the programs evolve.  In general, the  first
           file of the tape contains:
0           Machine dependent declarations.  These  should  NOT  include  the
            '--' sentinel at the end of the module because it is difficult to
            remove before processing by the simple program.
0           Fortran declarations for the named COMMON blocks in the  portable
            subprograms of both programs.
0           Machine sensitive versions of the main program unit.
0           The simple exchange program.
0           Two  versions  of  the  BLOCK DATA subprogram EXCHBX, part of the
            simple program.
0           Two versions of the BLOCK DATA subprogram  EXCHBD,  part  of  the
            comprehensive program.
0           Machine sensitive and machine specific modules (except EXCHCX and
            EXCHCG) for both programs, grouped by machine.
0           Portable versions of modules for which machine sensitive versions
 .
 .
                                          3-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0           may or may not be included.  Do not use the portable version if a
            machine sensitive version is included.
0           Machine insensitive modules of the root segment.
0           Modules  of  the  non-resident  segments  (including  EXCHCX  and
            EXCHCG), in the order shown in section 2.4.6.
0           Documentation.
0           Job Control Language statements for several machines.
0           Small related programs.
0          An index of the first file of the  exchange  program  distribution
           tape, and a description of the other files, should accompany every
           transmittal of the tape.
0
           3.2.  Constructing the Simple Program
0
                If your machine  is  one  for  which  the  machine  sensitive
           modules  have been written, constructing the simple program should
           not be difficult.  If you receive the  simple  program  on  cards,
           steps 1 through 3 are not needed.  The instructions below are only
           a general guide; they may need modification for your machine.
             1.  The content and format of  the  distribution  tape  will  be
                 explained in a cover letter.  Determine the file(s) you need
                 to copy from the distribution tape.
             2.  The  format  of the necessary files of the distribution tape
                 should be convenient for your machine.  Copy  the  necessary
                 program  text  files  to files of the format most convenient
                 for the compiler (and assembler if necessary).
             3.  Copy  the file containing job control statements, if any, to
                 a medium accessible by your text editor.
             4.  Examine the translate table in the block data subprogram, if
                 included in your version of the simple  program.   (See  the
                 section  titled  "Contents  of the Simple Program" in one of
                 chapters 6-14, as  appropriate).   The  translate  table  is
                 contained  in  the  128  element  vector XLATE in the common
                 block  /EXCHXC/,  and  provided  values  by  a  BLOCK   DATA
                 subprogram.   It  is indexed by one more than the ASCII code
                 [3] for a character to be translated to the  character  code
                 of  the  host  machine.   The table may have been damaged by
                 incorrect or incomplete translations of  the  program  text.
                 Some  machines  and  compilers  do  not support the complete
                 ASCII graphic set.  If your  system  does  not  support  the
 .
 .
                                          3-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0                complete  ASCII  graphic  set,  there  is  probably a system
                 standard translation from ASCII  to  the  supported  graphic
                 set.   It  is  important  to  get the translate table right,
                 because it is used  to  translate  the  character  codes  on
                 exchange  tapes  to  the  correct  character  code  for your
                 system.  The value of each element of  the  translate  table
                 should be:
                   1 through 32 - all dollar signs ($);
                   33 - blank;
                   34 - exclamation point (!);
                   35 - double quote (");
                   36 - number sign (#);
                   37 - dollar sign ($);
                   38 - percent sign (%);
                   39 - ampersand (&);
                   40 - apostrophe (');
                   41 - left parenthesis (();
                   42 - right parenthesis ());
                   43 - asterisk (*);
                   44 - plus sign (+);
                   45 - comma (,);
                   46 - minus sign (-);
                   47 - period (.);
                   48 - slash (/);
                   49 through 58 - digits zero through nine;
                   59 - colon (:);
                   60 - semicolon (;);
                   61 - less than sign (<);
                   62 - equal sign (=);
                   63 - greater than sign (>);
                   64 - question mark (?);
                   65 - commercial at sign (@);
                   66 through 91 - upper case alphabet;
                   92 - left square bracket ([);
                   93 - backward slash (\);
                   94 - right square bracket (]);
                   95 - circumflex (^);
                   96 - underscore (_);
                   97 - accent grave (`);
                   98 through 123 - lower case alphabet;
                   124 - left curly bracket ({);
                   125 - vertical bar (|);
                   126 - right curly bracket (});
                   127 - tilde (~);
                   128 - dollar sign ($);
             5.  Make any necessary changes to the job control statements  to
                 accomodate  site  dependent  equipment codes, file names and
                 tape reel numbers.
 .
 .
                                          3-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0            6.  Use  the  job  control statements to compile and execute the
                 simple program.  Executing the  simple  program,  using  the
                 input provided, copies the text of the comprehensive program
                 from the distribution tape;  see section 3.3 below.
                If the machine sensitive modules have not  been  written  for
           your  machine,  consult  chapter  2  for  specifications  of these
           modules.  Information in chapters 6-14 may also be helpful.   When
           the  machine  sensitive  modules  are  written,  copy the complete
           simple program for any machine from  the  distribution  tape,  and
           substitute your machine sensitive modules.
0
           3.3.  Constructing the Comprehensive Program
0
                 The  comprehensive  program  is distributed only on exchange
           format tapes.  Constructing the comprehensive program is therefore
           a bootstrap process:
             1.  Construct the simple program (see above).
             2.  Use the simple program to copy the  required  modules  to  a
                 file  having  the  format of the host machine (called native
                 format below).  Copying  the  modules  requires  two  steps,
                 performed by the simple program in one execution:
                 A.  Copy  some  common  program  text (variable declarations
                     etc.) from the first few  modules  of  the  distribution
                     tape  to a native format file.  The modules to be copied
                     depend on the machine.
                 B.  Copy  the  program  text from the distribution tape to a
                     native  format  file.   The  simple  program   must   be
                     instructed  to insert the common program text as needed.
                     See sections 4.2 and 5.4.
             3.  Use the simple program to copy job  control  statements,  if
                 provided, to a native format file.
             4.  Make any necessary changes to the job control statements  to
                 accomodate  site  dependent  equipment codes, file names and
                 tape reel numbers.
             5.  Use  the job control statements to compile the comprehensive
                 program.
0
0
0
0
0
 .
 .
                                          3-4
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          4.  User's Guide for the Simple Program
0
0
           4.1.  Functional Overview of the Simple Program
0
                The simple  tape  exchange  program  is  a  relatively  small
           program  that  provides  a  basic capability for transferring text
           from an Exchange tape to a native format output file and  printing
           descriptive information for all text modules copied.  This program
           requires four machine sensitive  subprograms  that  are  presently
           available   for   several   machine  types.   See  chapter  1  for
           installation details.
                This program references three files:  an input Exchange tape,
           an output native format file  and  an  optional  "include"  native
           format  file.   By  using appropriate commands one can copy all or
           selected modules from the Exchange tape to the output file.
                Literal text can be inserted from the command stream into the
           output file.  This would normally be used to insert command  lines
           that have meaning to the host operating system.
                The Exchange tape  may  contain  one  or  more  instances  of
           "include"  text in some modules.  These segments of "include" text
           may be  referenced  by  name  from  one  or  more  other  modules.
           Commands are provided so one can initially copy the "include" text
           to the "include" file.  Thereafter whenever a module being  copied
           from the Exchange tape to the native format output file contains a
           reference to a named segment of "include" text the referenced text
           will be copied from the "include" file to the native format output
           file at that point.   The  syntax  for  defining  and  referencing
           "include" segments is described in section 3.5.5 of [2].
0
           4.2.  Command Repertoire of the Simple Program
0
                  The   program  accepts  control  images  in  three formats,
           designated A, B and C.
                 The first image must be an A image and this must be the only
           A image.  The A image is read using a Fortran format  (3I5,4X,A1).
0             Image Columns      Meaning
             1-5, rt justified   The  Fortran  unit  number  for  the   input
                                 Exchange tape.
            6-10, rt justified   The  Fortran  unit  number  for  the  native
                                 format  output  file.   If  the  unit number
                                 specified in columns 11-15 is  greater  than
 .
 .
                                          4-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0                                zero,  this  unit  will not be used until op
                                 code 6 (described below) is executed.
           11-15, rt justified   If  greater  than  zero  this is the Fortran
                                 unit number of  the  "include"  file.   This
                                 file  will  be used for native format output
                                 until  op  code  6  (described   below)   is
                                 executed.
           20                    A  single  character,  called  C1   in   the
                                 following descriptions.
0               The second command image must  be  a  B  image.   A  B  image
           contains  an  op  code  of  0,  1, 2, ... or 9 in column 1 and may
           contain arbitrary text in columns 2-80.  The op  code  selects  an
           operation to be performed and determines the command that follows:
0           Op    Next
           Codes  Input  Operation
             0      B    Op  codes  0  and  2  cause  an  80  character image
             2      C    consisting  of  the  character  C1  from the A image
                         followed by the contents of columns 2-80 of  this  B
                         image  to  be  inserted  in the native format output
                         file.
0            1      B    Op  codes  1  and  3  cause  a  79  character  image
             3      C    consisting  of  columns  2-80  of this B image to be
                         inserted in columns 1-79 of the native format output
                         file.
0            4      C    No operation.
0            5      B    Rewind the input Exchange tape.
0            6      B    If  the  "include"  file is currently being used for
                         native format output, and some text has been written
                         on  the "include" file, write an end of file mark on
                         the "include" file and rewind it.  In any case,  use
                         the  output  file  for  all  further  native  format
                         output.  A previously prepared  "include"  file  may
                         therefore be used by specifying op code 6 before any
                         other operations.
0          7,8,9  None   Write an  end-of-file  mark  on  the  native  format
                         output file and terminate processing.
0               A C image triggers transmission  of  text  modules  from  the
           input  Exchange  tape to the native format output file.  A C image
           follows a B image with op code 2, 3 or 4 and is always followed by
           a B image.
 .
 .
                                          4-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0               A C image contains up to eight pairs of 5 digit numbers  that
           select  up  to  eight ranges of modules to be copied.  The Fortran
           format used to read C images is (16I5).
                If the first number of any pair is zero or negative, the pair
           of numbers is ignored.  If the first number of a pair is  positive
           but  the  second  number  is  negative the magnitude of the second
           number indicates the end of the range and an end-of-file  mark  is
           written  on  the  native  format  output  file after this range of
           modules has been copied.  This program does not  prohibit  further
           writing  after an end-of-file mark is written on the native format
           output file.  The host operating  system  may,  however,  prohibit
           such further writing.
                The modules to be accessed on the input tape as the result of
           left-to-right scanning of C images must be in increasing numerical
           sequence.  Out-of-sequence retrieval from the input  tape  may  be
           accomplished  by  use of op code 5 whenever the input tape must be
           rewound.
0
           4.3.  Printed Output of the Simple Program
0
0
           4.3.1.  Table of Contents of the EXCH Tape.
0
           The  simple  tape  exchange  program  produces a table of contents
           listing describing all modules copied from  the  EXCH  tape.   The
           entries  in  the  table  of  contents consist of three parts:  The
           module number, the control  record  type,  and  the  text  of  the
           control record.  Control record types are described in section 3.3
           of [2].
0
           4.3.2.  Error Messages
0
           SELECTIONS nnnnn-nnnnn NOT INCREASING.
             The module numbers indicated by input  C  are  not  provided  in
             increasing order.
0          TEXT TO BE INCLUDED CANNOT BE FOUND.
           -I (search target)
             There is an image '-I (search target)'  in  some  module  to  be
             copied  from  the  input  EXCH  tape, and the text identified by
             (search target) cannot be found on the include file.
0.
 .
                                          4-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          BLOCK SEQUENCE NUMBER WAS nnnnn, SHOULD HAVE BEEN mmmmm
             The block sequence number on the EXCH tape was not the  expected
             value.
0          ERROR n WHILE TRYING TO ...
             An  error occurred while trying to perform an input operation on
             the EXCH tape.  The values of n (always between 1 and 6) mean:
                1. The block sequence number on the EXCH  tape  was  not  the
                   expected value.
                2. The block read from the EXCH tape was too short to contain
                   crucial structural information.
                3. An error was reported by the supporting operating  system.
                4. A  record  on  the  EXCH  tape  will  not fit in the space
                   allowed  in  the  program.   Space  is  allowed  for   180
                   characters.
                5. The  type  of  a  record  on  the  EXCH  tape  cannot   be
                   determined.
                6. The first block of the EXCH tape is not a TES label.
0          Other  error messages may be produced by system dependent modules.
           Consult appropriate chapters of this document for  description  of
           these messages.
0          Consult [3] for detailed information on the EXCH tape format.
0
           4.3.3.  Informative Messages
0
           END FILE AND REWIND INCLUDE FILE.
             Means  that  an end of file mark has been written on the include
             file, and the include file has been rewound.  The  include  file
             may  subsequently  be  searched  for  text  to be included while
             copying modules from the exchange tape.
0          END-OF-FILE MARK WRITTEN.
             Means that an end of file mark has been written  on  the  native
             format output file.
0          PROGRAM EXECUTION TERMINATED.
             Means  the  program has stopped operation.  If there is no prior
             error message, program execution terminated  normally,  and  the
             output file should be usable.
0          Other informative messages may be  produced  by  system  dependent
           modules.   Consult  appropriate  chapters  of  this  document  for
           description of these messages.
0.
 .
                                          4-4
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          5.  Reading Exchange Tapes with the Simple Program
0
0
           5.1.  Ex. R.0.1 Simple read of EXCH tape, IBM 360/370
0
           In  this example we suppose that modules numbered 1 through 50 and
           101 through 150 are needed.  The input exchange tape is mounted on
           file  number  10.   The  output modules will be on file number 11,
           followed by two end  of  file  marks.   The  input  needed  is  as
           follows.
0              123456789012345678901234567890              Column alignment
                  10   11    0                             input A
               4                                           input B
                   1   50  101 -150                        input C
               9                                           input B
0
           5.2.  Ex. R.0.2 Simple read of EXCH tape, CDC 6000-7000
0
           The problem here is the same one as in Ex. R.0.1,  except  that  a
           CDC PROGRAM statement must be placed on the output file before the
           first module.  The input needed is as follows.
0              123456789012345678901234567890              Column alignment
                  10   11    0                             input A
               0     PROGRAM (INPUT,OUTPUT,TAPE5=INPUT,    input B
               2    1         TAPE6=OUTPUT)                input B
                   1   50  101 -150                        input C
               9                                           input B
0
           5.3.  Ex. R.0.3 Simple read of EXCH tape, UNIVAC 1100
0
           In this example we suppose that modules  number  50  and  101  are
           needed.   The  input  tape  and  output file numbers are 10 and 11
           respectively.  Since each of the two modules are  Fortran  program
           units,  it  is desirable to insert @FOR,IS MAIN in front of module
           number 50,  and  @FOR,IS  SUB  in  front  of  module  number  101.
           Following  execution of the simple program these two program units
           may be compiled by using the UNIVAC 1100  control  statement  @ADD
           11.
0.
 .
                                          5-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0              123456789012345678901234567890              Column alignment
                  10   11    0    @                        input A
               2FOR,IS MAIN                                input B
                  50   50                                  input C
               2FOR,IS SUB                                 input B
                 101  101                                  input C
               9                                           input B
0
           5.4.  Ex. R.0.4 Simple read with include, IBM 360/370
0
           This example is different from Ex. R.0.1  only  in  one  important
           respect.  Several of the modules contain the line image
0              -I FILE/NAME
0          indicating  that  text  identified by FILE/NAME is to be inserted.
           The block of text identified by FILE/NAME is part of module number
           51.  The steps are:
           1.  Copy module 51 to file 12.
           2.  Append an image containing only -- to file 12.  This image  is
               used  as an end marker, and is required.  It may already be in
               module 51, but it does not hurt to append it here just  to  be
               safe.
           3.  Write an end of file mark on file  12,  rewind  file  12,  and
               search  file 12 for text to be included while writing file 11.
           4.  copy modules 1-50 and 101-150 to file 11.
           The input needed is as follows.
0              123456789012345678901234567890              Column alignment
                  10   11   12                             input A
               4                                           input B
                  51   51                                  input C
               1--                                         input B
               6                                           input B
               5                                           input B
               4                                           input B
                   1   50  101 -150                        input C
               9                                           input B
0
0
0
0
 .
 .
                                          5-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          6.  IBM System/360
0
0
           6.1.  System Dependent Information from Commands
0
           The IBM System/360 version of the comprehensive  exchange  program
           does  not  examine the parts of command images reserved for system
           dependent information.
0
           6.2.  Default Values for File Unit Numbers
0
           The default value for the READER file  is  unit  5.   The  default
           falue  for  the PRINTER file is unit 6.  The default value for the
           WORK file is unit 8.
0
           6.3.  Default Value for the Command Margin
0
           The default value for the command margin is 72.  This value may be
           changed by the MARGIN command.
0
           6.4.  Information Provided by the Environment
0
           The DATE is not provided by the system dependent environment.  The
           SITE may be provided.  Consult site dependent documentation.
0
           6.5.  Interpretation of Option Letters
0
           The IBM System/360 version of the comprehensive  exchange  program
           is not affected by any option letters other than those interpreted
           by the portable parts of the program.
0
           6.6.  Special Commands
0
           The IBM System/360 version of the comprehensive  exchange  program
           does  not  interpret  any commands other than those interpreted by
 .
 .
                                          6-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          the portable parts of the program.
0
           6.7.  Interface to OS/MVT
0
0
           6.7.1.  Job Control Language Statements for OS/MVT
0
           The  Job  Control  Language  Statements  shown  below  declare two
           exchange tapes, and  a  work  file  needed  by  the  comprehensive
           exchange  program.  The input exchange tape is Fortran unit 9, the
           output exchange tape is Fortran unit 10,  and  the  work  file  is
           Fortran unit 8.
0          Exchange  tapes  are always unlabelled, having a blocksize of 3600
           bytes, and unspecified recording format.  The DCB parameter  DEN=X
           specifies  the  recording density, where X is 0 if the tape is 200
           BPI, X is 1 if the tape is 556 BPI, X is 2 if the tape is 800 BPI,
           and  X is 3 if the tape is 1600 BPI.  Densities of 200 and 556 BPI
           are only available on 7 track tapes; 800 BPI is available on 7  or
           9  track  tapes; 1600 BPI is only available on 9 track tapes.  The
           UNIT parameter specifies the device type.  The values of the  UNIT
           parameter  are  site dependent.  The data set (file) to be used by
           the program is specified by the first LABEL parameter.  The VOLUME
           parameter specifies the tape reel identity.
0          The  comprehensive  exchange  program  is  assumed  to  be  in the
           catalogued data set EXCH(ABS).
0          //GO          EXEC PGM=EXCH(ABS)
           //GO.FT09F001   DD DSNAME=TAPE9,DISP=(OLD,PASS),LABEL=(1,BLP,,IN),
           //                 DCB=(BLKSIZE=3600,RECFM=U,DEN=3),UNIT=TAPE,
           //                 VOLUME=SER=IBMTPE
           //GO.FT10F001   DD DSNAME=TAPE10,DISP=(OLD,PASS),LABEL=(1,BLP),
           //                 DCB=(BLKSIZE=3600,RECFM=U,DEN=3),UNIT=TAPE,
           //                 VOLUME=SER=IBMNEW
           //GO.FT08F001   DD DSNAME=WORKF,DISP=(NEW,DELETE),UNIT=SYSSQ,
           //                 DCB=(BLKSIZE=7000,LRECL=800,RECFM=VB),
           //                 SPACE=(TRK,(2,2))
           //GO.SYSIN      DD *
           INTAPE=9
           OUTAPE=10
           DATE=(YYMMDD)
           COPY=N-N
           QUIT
 .
 .
                                          6-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          /*
0          Commands are read from the data set defined for GO.SYSIN.  In  the
           above JCL sample, GO.SYSIN is the JCL stream.
0
           6.7.2.  Input/Output Interface
0
           All input and output is performed by the Fortran I/O library.  End
           of file marks are detected automatically; QUIT commands  and  '--'
           sentinels are optional at the end of input files.
0
           6.8.  Contents of the Simple Program
0
           The simple exchange program for the IBM System/360 consists of the
           machine sensitive main program unit; the simple exchange  program,
           identified  on  the distribution tape as EXCHSP; the ASCII version
           of the BLOCK DATA subprogram EXCHBX; machine sensitive versions of
           EXCHRT and EXCHUN; portable versions of EXCHAH and EXCHFO; and the
           machine insensitive modules EXCHGB, EXCHGR and EXCHRH.
0
           6.9.  Contents of the Comprehensive Program
0
           The comprehensive exchange program for the IBM System/360 consists
           of  the  machine  sensitive  main  program;  the  ASCII version of
           EXCHBD;  machine  sensitive  versions  of  EXCH,  EXCHUN,  EXCHPA,
           EXCHRT,  EXCHWT,  EXCHIM  and EXCHOU; portable versions of EXCHAH,
           EXCHFO,  EXCHSL,  EXCHTR,  EXCHCX  and  EXCHCG;  and  the  machine
           insensitive   modules  EXCHGB,  EXCHGR,  EXCHNP,  EXCHPB,  EXCHPR,
           EXCHSC, EXCHTP, EXCHTW, EXCHC1, EXCHC2,  EXCHC3,  EXCHRH,  EXCHWH,
           EXCHC4, EXCHLX, EXCHC5, EXCHC6, EXCHC7, EXCHC8 and EXCHC9.
0
           6.10.  Error Messages
0
           The IBM System/360  versions  of  the  exchange  programs  do  not
           produce  any  error  messages  other  than  those  produced by the
           portable versions.
0
0
 .
 .
                                          6-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          7.  Univac 1100
0
0
           7.1.  System Dependent Information from Commands
0
                The Univac 1100 version of the comprehensive exchange program
           interprets the parts of commands  reserved  for  system  dependent
           information  when the file associated with the Fortran unit number
           specified by the command is a disk or Fastrand file.   The  system
           dependent information must not be supplied for tape files.
                For the INTAPE and  OUTAPE  commands,  the  system  dependent
           information provides the name of an OMNIBUS element in the program
           file associated with the Fortran unit number.  If the element name
           is  omitted,  the  file associated with the Fortran unit number is
           assumed not to be a program file.
                  For  the  INPUT  FILE,  INCLUDE FILE, OUTPUT FILE, and TEXT
           commands, the system dependent information provides the name of  a
           SYMBOLIC element in the program file specified by the Fortran unit
           number.  If the element name is omitted, the Fortran  unit  number
           is  assumed to designate an SDF data file prepared by the exchange
           program, the Univac DATA processor, a Fortran V program, an  ASCII
           Fortran  (FTN)  program,  or  a  symbiont  file.   If  the  system
           dependent information begins with a + sign, input  or  output  (as
           appropriate)  will  continue  on  the  designated file AT THE DISK
           ADDRESS LAST USED FOR DATA TRANSFER ON THE FILE LAST SPECIFIED  BY
           THE SAME COMMAND.  DO NOT USE A DIFFERENT UNIT NUMBER!
0
           7.2.  Default Values for File Unit Numbers
0
           The  default  value  for  the  READER file is unit 5.  The default
           value for the PRINTER file is unit 6.  The default value  for  the
           WORK file is unit 9.
0
           7.3.  Information Provided by the Environment
0
           The  DATE  is  provided  by the system dependent environment.  The
           SITE may be provided.  Consult site dependent documentation.   The
           option field of the processor call statement or @XQT statement may
           be used to provide options usually provided by the OPTION command.
0
 .
 .
                                          7-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          7.4.  Interpretation of Option Letters
0
           The Univac 1100 version of the comprehensive exchange  program  is
           not affected by any option letters other than those interpreted by
           the portable parts of the program.
0
           7.5.  Special Commands
0
           The Univac 1100 version  of  the  comprehensive  exchange  program
           recognizes  two  commands  in  addition to those recognized by the
           portable parts of the program.  Neither command has  a  parameter.
           The   ASCII   command   causes  all  further  SDF  output  to  use
           quarter-word ASCII code.  The FIELDATA command causes all  further
           SDF output to use sixth-word FIELDATA code.  The initial condition
           of the program  is  to  output  ASCII  code.   (But  consult  site
           dependent  documentation).   The  character  code  of SDF input is
           determined automatically.
0
           7.6.  Native Format (SDF) Files
0
           The Univac 1100 version of the exchange program may read SDF files
           or elements prepared by the standard system processors (e.g. DATA,
           ELT, ED, FOR), SDF files produced by formatted writes  in  FOR  or
           FTN  programs, symbiont files prepared by EXEC using @FILE, @BRKPT
           or alternate print or punch files.  When reading print files, line
           spacings of zero one, or two cause Fortran vertical format control
           characters of +, blank and zero respectively, to  be  prefixed  to
           the  image.  Line spacing greater than 2 causes a Fortran vertical
           format control character of 1 to be prefixed to the image.
0
           7.7.  Interface to EXEC
0
0
           7.7.1.  Executive Control Statements
0
           Assume the exchange program  is  stored  in  the  catalogued  file
           Q*F.EXCH,  a 9 track 800 BPI exchange tape having reel number INEX
           is to be read, an output exchange format OMNIBUS element is to  be
           written  in  Q*E.EXOUT, and SDF output is to be written in Q*S.SDF
 .
 .
                                          7-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          using  ASCII  code.   The  executive  control   statements   below
           illustrate a possible specification.
0          @ASG,A Q*F.
           @ASG,TJ IN,U9H,INEX      . EXCHANGE TAPES ARE ALWAYS UNLABELLED.
           @ASG,UP Q*E.
           @ASG,UP Q*S.
           @USE 10,IN
           @USE 11,Q*E
           @USE 12,Q*S
           @Q*F.EXCH,options        . @XQT,options Q*F.EXCH WOULD ALSO WORK.
           INTAPE=10
           OUTAPE=11 EXOUT
           OUTPUT=12 SDF
           ASCII
0
0          7.7.2.  Input/Output Interface
0
           Input and output for exchange format or SDF files and elements are
           performed by assembly language subroutines (which may be useful in
           other applications).   Input  files,  or  files  containing  input
           elements  must  be  assigned prior to use.  Output files, or files
           containing output elements, are assigned with no  options  by  the
           interface subprograms if they are not assigned prior to use.
0          End  of  file marks are detected in input files; QUIT commands and
           '--' sentinels are optional at the end of input files or elements.
0
           7.8.  Contents of the Simple Program
0
           The simple exchange program for the UNIVAC 1100  consists  of  the
           machine  sensitive main program unit; the simple exchange program,
           identified on the distribution tape as EXCHSP; the  ASCII  version
           of the BLOCK DATA subprogram EXCHBX; the machine sensitive version
           of EXCHRT; the machine specific module ASMEXCH1; portable versions
           of  EXCHAH and EXCHFO; and the machine insensitive modules EXCHGB,
           EXCHGR and EXCHRH.  The Fortran modules may be compiled with  @FOR
           or  @FTN.   The assembler module must be assembled with @ASM.  The
           subprogram linkage generated  by  the  FOR  and  FTN  comilers  is
           different.   The symbol 'FTN' is used in ASMEXCH1 to determine the
           linkage.   This  symbol  is  defined  in  the  machine   dependent
           declarations  in the block identified by '-I UNIVAC-FTN/FOR'.  The
           tape is distributed with this symbol having the value 1.   If  the
 .
 .
                                          7-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          Fortran  modules  are  compiled with the FOR compiler the value of
           FTN must be changed to zero.
0
           7.9.  Contents of the Comprehensive Program
0
           The comprehensive exchange program for the UNIVAC 1100 consists of
           the  machine  sensitive main program; the ASCII version of EXCHBD;
           machine sensitive versions of EXCH, EXCHRT, EXCHWT, EXCHIM, EXCHOU
           and  EXCHCX;  machine specific modules EXCHEM, ASMEXCH1, ASMEXCH2,
           EORSR and EORSW; portable  versions  of  EXCHAH,  EXCHFO,  EXCHSL,
           EXCHTR  and  EXCHCG  and  the  machine insensitive modules EXCHGB,
           EXCHGR, EXCHNP, EXCHPB, EXCHPR, EXCHSC,  EXCHTP,  EXCHTW,  EXCHC1,
           EXCHC2,  EXCHC3,  EXCHRH,  EXCHWH, EXCHC4, EXCHLX, EXCHC5, EXCHC6,
           EXCHC7, EXCHC8, and EXCHC9.  The Fortran modules may  be  compiled
           with  @FOR  or @FTN.  The assembler modules must be assembled with
           @ASM.  The  subprogram  linkage  generated  by  the  FOR  and  FTN
           compilers is different.  The symbol 'FTN' is used in the assembler
           modules to determine the linkage.  This symbol is defined  in  the
           machine  dependent  declarations  in  the  block identified by '-I
           UNIVAC-FTN/FOR'.  The tape is distributed with this symbol  having
           the  value  1.   If  the Fortran modules are compiled with the FOR
           compiler the value of FTN must  be  changed  to  zero.   When  the
           modules are compiled or assembled the relocatable output should be
           placed in TPF$, using the name from the index on the  distribution
           tape  for the element name.  If this is done the MAP directives in
           the module EXCHMAP  may  be  used  to  collect  the  comprehensive
           program.
0
           7.10.  Error Messages
0
           The severity  is  shown  in  the  description  of  error  messages
           produced  by the Univac-1100 sensitive subprograms of the exchange
           programs.  The error severity is not printed by the program.
0          6 ELEMENT NOT FOUND
             WHILE TRYING TO ...
             The  element described by the system dependent information could
             not be found in the program file indicated by  the  unit  number
             while trying to perform the described action.
0          6 EXEC I/O ERROR
             WHILE TRYING TO ...
             EXEC  encountered  an  unspecified  input  or output error while
             trying to perform the  described  action  on  the  program  file
 .
 .
                                          7-4
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0            indicated by the unit number.
0          6 FILE NOT ASSIGNED OR NOT PF
             WHILE TRYING TO ...
             The  file indicated by the unit number either is not assigned or
             is not a program file.
0          6 FILE/ELEMENT NOT OPENED
             WHILE TRYING TO ...
             This message almost certainly means that  a  program  error  has
             occurred.
0          5 IMPROPER ELEMENT NAME, OPEN FILE
             The  element  name  provided  on  an  OUTPUT FILE command is not
             proper.  Use the file indicated by the unit  number  as  an  SDF
             file.
0          6 I/O ERROR STATUS = nn
             WHILE TRYING TO ...
             An  Input  or  Output error has occurred while trying to perform
             the described operation.  The octal number 'nn' is the EXEC  I/O
             error code described in [6].
0          6 NO ELEMENT NAME, TREAT AS FILE
             The element name provided on a READER, INPUT FILE, TEXT, INCLUDE
             FILE, INTAPE or OUTAPE command is improper.
0          6 PROGRAM FILE OVERFLOW
             WHILE TRYING TO ...
             The program file indicated by the unit number  is  probably  too
             small.  make it bigger.
0
           7.11.  Informative Messages
0
           The message
0          mmmmm BLOCKS WRITTEN ON TAPE nnn
0          provides the number of blocks written on the exchange format  disk
           or  tape  file indicated by the unit number nnn.  The number mmmmm
           is the number of blocks  that  contain  data;  the  label  is  not
           counted.   This  message  is printed when the output exchange disk
           file or tape is closed.
0
0.
 .
                                          7-5
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          8.  CDC 6000/7000 Using NOS or SCOPE
0
0
           8.1.  System Dependent Information from Commands
0
           The  CDC  6000/7000  version of the comprehensive exchange program
           does not examine the parts of command images reserved  for  system
           dependent information.
0
           8.2.  Default Values for File Unit Numbers
0
           The  default  value  for  the  READER file is unit 5.  The default
           value for the PRINTER file is unit 6.  The default value  for  the
           WORK file is unit 7.
0
           8.3.  Information Provided by the Environment
0
           The DATE is provided by the system dependent environment using the
           subprogram DATE() from the CDC Fortran library.  The SITE  may  be
           provided.  Consult site dependent documentation.
0
           8.4.  Interpretation of Option Letters
0
           The CDC 6000/7000 version of the comprehensive exchange program is
           not affected by any option letters other than those interpreted by
           the portable parts of the program.
0
           8.5.  Special Commands
0
           The  CDC  6000/7000  NOS  and  SCOPE versions of the comprehensive
           exchange program recognize two special commands:  6BIT and  12BIT.
           These  commands are used to obtain conversion between the CDC 12/6
           bit code and ASCII, using the translate table in section 3.2.
0          For example, the two 6 bit characters "^A" can mean lower case "a"
           for  CDC  machines using the NOS operating system when the user is
           operating in "ASCII" mode.  This pair, however, means exactly "^A"
 .
 .
                                          8-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          when  the  user is operating in "NORMAL" mode.  The user who wants
           to retrieve or store a  text  module  that  uses  the  full  ASCII
           character set shown in section 3.2 must use the 12/6 bit character
           set.  Translation using the 12/6 bit character set is  enabled  by
           executing the command 12BIT before processing text.
0          For example, to copy an upper/lower case document from text module
           1 of an exchange tape 10 to CDC output file 11:
0                INTAPE=10
                 OUTPUT FILE=11
                 12BIT
                 COPY=1
0          To  copy  a  CDC upper/lower case document from the CDC file 11 to
           text module 1 of an exchange tape 15:
0                OUTAPE,U=15
                 12BIT
                 NAME=(Document's identifying name)
                 TEXT=11
0          Some further processing of the output files may be required before
           files in 12/6 bit code can be printed.  For example,  on  NOS  the
           user may need to execute the NOS command
0                FCOPY(P=file-in-12/6-bit-code,N=file-to-print).
0          Then file-to-print, now in CDC 12/8 bit code, is ROUTEd or sent to
           an upper/lower case printer.
0          The effects of executing the command 6BIT,  when  storing  a  text
           module,  are  to  convert  each 6 bit code to its ASCII equivalent
           using the table.  Conversely, when copying text modules into a CDC
           file,  lower case letters and special characters not in the CDC 64
           character graphic set will be mapped into approximate  upper  case
           counterparts.   For  example,  lower  case letters appear as upper
           case letters, etc.  The nominal setting is 6BIT.  Users can switch
           back  and  forth  between  the  two translation modes by executing
           either command at any time during processing.
0          If a CDC "ASCII" mode input stream, containing 12/6 bit code pairs
           such  as "^A" is supplied to the exchange program when in the 6BIT
           mode, each 6 bit character will be separately converted  to  ASCII
           and  stored  on the tape.  Thus a user of equipment other than CDC
           equipment would find for example "^A" on the tape instead of  "a".
           Thus,  a  CDC  "ASCII" mode stream stored on an exchange tape with
           the 6BIT command in effect could only be correctly interpreted  as
 .
 .
                                          8-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          ASCII  data  by  a  user of CDC equipment, using "ASCII" mode, but
           with the 6BIT command in effect.
0          The translations between CDC 12/6 bit code and ASCII use the table
           below.
0          CDC 12/6 bit code     ASCII equivalent
                 @D              59 - colon (:)
                 @A              65 - commercial at sign (@)
                 @B              95 - circumflex (^)
                 @G              97 - accent grave (`)
                 ^A,...,^Z       90,...,123 - lower case alphabet
                 ^0              124 - left curly bracket({)
                 ^1              125 - vertical bar (|)
                 ^2              126 - right curly bracket (})
                 ^3              127 - tilde (~)
                 ^(Display code equivalent of ASCII code + 32)
                                 0,...,31 - ASCII Control codes.
0
           8.6.  Interface to NOS or SCOPE
0
0
           8.6.1.  Job Control Statements for NOS
0
           Assume  the  exchange  program is stored in the direct access file
           EXCH.  A 9 track 1600 BPI  (unlabelled)  exchange  tape  known  as
           INEXCH  is  to  be copied to the local file TAPE15.  The following
           control statements show how this might be done.
0          ATTACH,EXCH.
           LABEL,TAPE10,NT,F=S,D=PE,PO=R,LB=KU,VSN=INEXCH.
           EXCH.
           COMMENT. ENTER THREE LINES: INTA=10, OUTA=15, COPY=N-N.
0
           8.6.2.  Job Control Statements for SCOPE
0
           Assume the exchange program is stored in cycle 1 of the file EXCH,
           and that a 7 track 800 BPI exchange tape known as INEXCH  on  file
           10 is to be copied to a 9 track 1600 BPI PE exchange tape known as
           OUEXCH on file 11.  The control statements shown below  illustrate
           a possible specification.
0.
 .
                                          8-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          ATTACH,EXCH,EXCH,CY=1.
           FILE,TAPE10,RT=U,BT=K.
           REQUEST,TAPE10,HY,VSN=INEXCH. RING OUT.
           FILE,TAPE11,RT=U,BT=K.
           REQUEST,TAPE11,PE,VSN=OUEXCH. RING IN.
           EXCH.
           COMMENT.  REPLACE THIS WITH 7-8-9.
           INTAPE=10
           OUTAPE=11
           DATE=(YYMMDD)
           COPY=N-N
           QUIT
           COMMENT.  REPLACE THIS WITH 7-8-9.
           COMMENT.  REPLACE THIS WITH 6-7-8-9.
           COMMENT.  REPLACE THIS WITH 6-7-8-9.
0
           8.6.3.  Program Statement
0
           The  simple and comprehensive exchange programs have the same main
           program unit.  The PROGRAM statement in this program unit is shown
           below.
0              PROGRAM EXCHMN (INPUT=/180,OUTPUT=/180,TAPE5=INPUT,
              1                TAPE6=OUTPUT,INTAPE,OUTAPE,TAPE7,
              2                TAPE10=/180,TAPE11=/180,TAPE12=/180,
              3                TAPE13=/180,TAPE14=/180,TAPE15=/180)
0          Thus  the  files  INPUT,  OUTPUT,  TAPE10,  ..., TAPE15 can handle
           individual records with at most 180 6 bit characters.
0
           8.6.4.  Input/Output Interface
0
           Exchange tapes and exchange format disk files are read and written
           using  Fortran BUFFER IN and BUFFER OUT statements.  Native format
           files are read and written using Fortran formatted read and  write
           statements.   End of file marks are detected in input files;  QUIT
           commands and '--' sentinels are  optional  at  the  end  of  input
           files.
0
0
0
 .
 .
                                          8-4
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          8.7.  Contents of the Simple Program
0
           The  simple exchange program for the CDC 6000/7000 consists of the
           machine sensitive main program unit; the simple exchange  program,
           identified  on  the distribution tape as EXCHSP; the ASCII version
           of the BLOCK DATA subprogram EXCHBX; machine sensitive versions of
           EXCHUN  and  EXCHRT;   portable versions of EXCHAH and EXCHFO; and
           the machine insensitive modules EXCHGB, EXCHGR and EXCHRH.
0
           8.8.  Contents of the Comprehensive Program
0
           The comprehensive exchange program for the CDC 6000/7000  consists
           of  the  machine  sensitive  main  program;  the  ASCII version of
           EXCHBD;  machine  sensitive  versions  of  EXCH,  EXCHUN,  EXCHPA,
           EXCHRT,  EXCHWT,  EXCHIM  and EXCHOU; portable versions of EXCHAH,
           EXCHFO,  EXCHSL,  EXCHTR,  EXCHCX  and  EXCHCG;  and  the  machine
           insensitive   modules  EXCHGB,  EXCHGR,  EXCHNP,  EXCHPB,  EXCHPR,
           EXCHSC, EXCHTP, EXCHTW, EXCHC1, EXCHC2,  EXCHC3,  EXCHRH,  EXCHWH,
           EXCHC4, EXCHLX, EXCHC5, EXCHC6, EXCHC7, EXCHC8 and EXCHC9.
0
           8.9.  Error Messages
0
           The CDC 6000/7000 versions of the exchange  programs  produce  the
           self explanatory error messages
0           EOF ENCOUNTERED ON INPUT TAPE
            PARITY ERROR ENCOUNTERED ON INPUT TAPE
            EOF ENCOUNTERED ON EXCHANGE OUTPUT TAPE
            PARITY ERROR ENCOUNTERED ON EXCHANGE OUTPUT TAPE
0          These messages are always followed by the messages
0           ERROR n WHILE TRYING TO READ INTAPE.
0          or
0           ERROR n WHILE TRYING TO WRITE OUTAPE.
0          The latter messages are described in section 3.6.5 of [2].
0
0
 .
 .
                                          8-5
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          9.  DEC PDP-10 using TOPS 10
0
0
           9.1.  System Dependent Information from Commands
0
           The  DEC PDP-10 version of the comprehensive exchange program uses
           the system dependent information from READER, INPUT FILE,  INCLUDE
           FILE,  OUTPUT  FILE,  TEXT,  INTAPE  and  OUTAPE commands for file
           names.  If no file name is specified on an instance of one of  the
           first five commands above, the system default name of FORxx.DAT is
           used, where xx is the Fortran logical unit number.   Logical  unit
           numbers  greater than or equal to 20 default to disk (DSK:) files.
           The user should consult the Fortran manual for the default devices
           (e.g.  printer,  TTY,  disk,  tape)  associated  with each Fortran
           logical unit number.  The user may  override  the  default  device
           association by using the DEFINE command at the monitor level.
0          If  no file name is specified on the INTAPE command, it is assumed
           that one wishes to access a tape, and a  logical  device  name  of
           'MTIN'  is  used.   Similarly, if no file name is specified on the
           OUTAPE command, it is assumed that one wishes to  access  a  tape,
           and  a  logical  device  name  of  'MTOUT' is used.  The file name
           provided (or implied) on the INTAPE or OUTAPE command must be  the
           same as the logical device name provided on the MOUNT command used
           to request TOPS 10 to assign the tape.  Since  the  tape  exchange
           system  assumes  that  INTAPE  and  OUTAPE  are  assigned  to tape
           devices, the user must redefine the logical device names  (at  the
           monitor level) if the file associated with either INTAPE or OUTAPE
           is not tape.  If, for example, the  file  associated  with  INTAPE
           were  on disk, one must DEFINE MTIN: DSK: before invoking the tape
           exchange program.
0          If more than 10 characters are provided for a file  name  only  10
           are used.
0
           9.2.  Default Values for File Unit Numbers
0
           The  default  value  for  the  READER file is unit 5.  The default
           value for the PRINTER file is unit 5.  The default value  for  the
           Work file is unit 1.
0
0.
 .
                                          9-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          9.3.  Information Provided by the Environment
0
           The  DATE  is  provided  by the system dependent environment.  The
           SITE may be provided.  Consult site dependent documentation.
0
           9.4.  Interpretation of Option Letters
0
           The DEC PDP-10 version of the comprehensive  exchange  program  is
           not affected by any option letters other than those interpreted by
           the portable parts of the program.
0
           9.5.  Special Commands
0
           The DEC PDP-10  version  of  the  comprehensive  exchange  program
           interprets  one  command  in  addition to those interpreted by the
           portable parts of the program.  The TABS command specifies whether
           tab  characters (ASCII HT) appearing in text read from the sources
           specified by  the  READER,  INPUT  FILE,  INCLUDE  FILE,  or  TEXT
           commands  are  data  characters or horizontal tabulation requests.
           The parameter is a single letter.  If the letter is Y the ASCII HT
           character  is  a  data character.  If the letter is N the ASCII HT
           character is a  horizontal  tabulation  request.   In  the  latter
           circumstance  ASCII  HT  characters are converted to the number of
           blanks required so that the next character is stored in a position
           that  is  the  smallest multiple of 8 that is larger than the last
           position used for  input  text.   The  initial  condition  of  the
           program  is  to  interpret ASCII HT characters as data characters.
           Other values of the first character  of  the  parameter  cause  an
           error  message.   Only  the  first  character  of the parameter is
           examined.
0
           9.6.  Interface to TOPS-10
0
0
           9.6.1.  Job Control Statements for TOPS-10
0
           The exchange program cannot skip files.   Suppose  one  wishes  to
           copy an exchange file from the second file of a tape.  PIP must be
           used  to  position  the  exchange  tape.   The  JCL  shown   below
 .
 .
                                          9-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          illustrates  a  possible specification.  (The TOPS 20 form of some
           commands is slightly different).
0           .MOUNT MTA1: TPIN/REELID:INTAPE/WLOCK
            .MOUNT MTA2: TPOUT/REELID:OUTAPE/WENABLE
            .R PIP
            TPIN:(M#2A)=
            ^C
            .RU EXCHNG
            SITE=...
            INTAPE=17 TPIN
            OUTAPE=18 TPOUT
            OUTPUT FILE=21 PROGS.FOR
            COPY=2-76
            QUIT
            .PRINT PROGS.FOR
0
           9.6.2.  Input/Output Interface
0
           Exchange tapes and exchange format disk files are read and written
           using assembly language subroutines.  Native format files are read
           and written using Fortran formatted  read  and  write  statements.
           Since   FOROTS  reserves  most  unit  numbers  less  than  20  for
           attachment to specific devices,  native  format  files  should  be
           accessed  using  unit  numbers of 20 or greater.  The maximum unit
           number is a site dependent parameter.
0          The output file and the include file in the  simple  program,  and
           the  work  file in the comprehensive program, are opened using the
           file name 'EXCHnn.TMP', where 'nn' is the unit number.
0          End of file marks are detected in input files; QUIT  commands  and
           '--' sentinels are optional at the end of input files.
0
           9.6.3.  An Error in the Fortran Library
0
           There  is  an  error  in  the  Fortran  library  service of rewind
           statements at some sites.  The rewind  statement  apparently  uses
           the correspondences
0                                     16 = MTA000:
                                      17 = MTA001:
                                      18 = MTA002:
0.
 .
                                          9-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          instead  of  associating  the Fortran unit number with a device by
           using a logical device association.  One may  need  to  specify  a
           logical  unit  number  on  the  INTAPE command that depends on the
           device where the input exchange tape is mounted.   Otherwise,  the
           wrong tape could be rewound, or a FOROTS error produced.
0
           9.7.  Contents of the Simple Program
0
           The  simple  exchange  program  for the DEC PDP-10 consists of the
           machine sensitive main program unit; the simple exchange  program,
           identified  on  the distribution tape as EXCHSP; the ASCII version
           of the BLOCK DATA subprogram EXCHBX; machine sensitive versions of
           EXCHFO,  EXCHRT  and  EXCHUN;  the portable version of EXCHAH; the
           machine specific  modules  TAPOPN,  BYTMNP  and  TAPCHN;  and  the
           machine insensitive modules EXCHGB, EXCHGR and EXCHRH.
0
           9.8.  Contents of the Comprehensive Program
0
           The  comprehensive exchange program for the DEC PDP-10 consists of
           the machine sensitive main program  unit;  the  ASCII  version  of
           EXCHBD;  machine  sensitive  versions  of  EXCH,  EXCHFO,  EXCHIM,
           EXCHOU,  EXCHPA,  EXCHRT,  EXCHUN,  EXCHWT  and  EXCHCX;   machine
           specific  modules  TAPOPN, BYTMNP and TAPCHN; portable versions of
           EXCHAH, EXCHSL, EXCHTR and EXCHCG;  and  the  machine  insensitive
           modules  EXCHGB,  EXCHGR,  EXCHNP, EXCHPB, EXCHPR, EXCHSC, EXCHTP,
           EXCHTW, EXCHC1, EXCHC2, EXCHC3, EXCHRH,  EXCHWH,  EXCHC4,  EXCHLX,
           EXCHC5, EXCHC6, EXCHC7, EXCHC8 and EXCHC9.
0
           9.9.  Error Messages
0
           ?CHNCHK:CAN'T MATCH CHANNEL TO DEVICE
             Is produced if FOROTS used a different channel for exchange tape
             input or output than the channel expected to be used.
0          ?CHNFND:NO CHANNEL AVAILABLE
             Is produced when an input or  output  exchange  tape  is  to  be
             opened and no input/output channel is available.
0          ?EXCHRT:CAN'T CLOSE INTAPE,ERROR= iiiiii jjjjj
           ?EXCHWT:CAN'T CLOSE OUTAPE,ERROR= iiiiii jjjjj
           ?EXCHWT: CAN'T WRITE TAPE,ERROR = iiiiii jjjjj
           READ ERROR ON INTAPE = iiiiii jjjjj
 .
 .
                                          9-4
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0            Are produced when errors are encountered  during  operations  on
             the  input  or  output  exchange  tapes.  The numbers iiiiii and
             jjjjj are produced by the system subroutine ERRSNS.
0          UNABLE TO OPEN INCLUDE FILE.
             Is produced only by the simple program.  The program stops after
             producing this message.
0          UNABLE TO OPEN nn FOR ...
             Is  produced  only  by  the  comprehensive program when a native
             format file cannot be opened.  The message has error severity 5.
             If  input  or output is attempted on the file, TOPS-10 will kill
             the program.
0          UNABLE TO OPEN WORKFILE.
             May be produced by either program.  If it  is  produced  by  the
             simple  program,  it  means the output file could not be opened.
             The programs stop after producing this message.
0          UNRECOGNIZED PARAMETER ON TABS COMMAND
             Is printed by the comprehensive program if the parameter on  the
             tabs  command  is neither N nor Y.  The interpretation of the HT
             character is not changed.
0
           9.10.  Informative Messages
0
           OPEN nn FOR   access   ON filename
             Is produced by  the  comprehensive  program  whenever  a  native
             format  file  is  opened.   'nn' is the unit number, 'access' is
             either 'SEQIN' or  'SEQOUT',  and  'filename'  is  the  filename
             specified by the command.
0
0
0
0
0
0
0
0.
 .
                                          9-5
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          10.  DEC PDP-11 using RSX-11M V3
0
0
           10.1.  System Dependent Information from Commands
0
           The DEC PDP-11 version of the comprehensive exchange program uses
           the system dependent information from READER, INPUT FILE, INCLUDE
           FILE, OUTPUT FILE and TEXT commands for file names.  If no file
           name is specified, a file name of all spaces is used.
0
           10.2.  Default Values for File Unit Numbers
0
           The default value for the READER file is unit 5.  The default
           value for the PRINTER file is unit 6.  The default value for the
           WORK file is unit 7.
0
           10.3.  Information Provided by the Environment
0
           The DATE is provided by the system dependent environment.  The
           SITE may be provided.  Consult site dependent documentation.
0
           10.4.  Interpretation of Option Letters
0
           The DEC PDP-11 version of the comprehensive exchange program is
           not affected by any option letters other than those interpreted by
           the portable parts of the program.
0
           10.5.  Special Commands
0
           The DEC PDP-11 version of the comprehensive exchange program
           interprets one command in addition to those interpreted by the
           portable parts of the program.  The TABS command specifies whether
           tab characters (ASCII HT) appearing in text read from the sources
           specified by the READER, INPUT FILE, INCLUDE FILE, or TEXT
           commands are data characters or horizontal tabulation requests.
           The parameter is a single letter.  If the letter is Y the ASCII HT
           character is a data character.  If the letter is N, the ASCII HT
 .
 .
                                          10-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          character is a horizontal tabulation request.  In the latter
           circumstance, ASCII HT characters are converted to the number of
           blanks required so that the next character is stored in a position
           that is the smallest multiple of 8 that is larger than the last
           position used for input text.  The initial condition of the
           program is to interpret ASCII HT characters as data characters.
           Other values of the first character of the parameter cause an
           error message.  Only the first character of the parameter is
           examined.
0
           10.6.  Interface to RSX-11M V3
0
0
           10.6.1.  Job Control Statements for RSX-11M V3
0
           The DEC PDP-11 RSX-11M version of the comprehensive exchange
           program knows about two exchange tape units.  It thinks the input
           exchange tape is MT0: and the output exchange tape is MT1:.  Thus,
           the user must direct these device names to the proper physical
           device before executing the program.
0          Suppose the input exchange tape is on physical tape unit 1, the
           output exchange tape is on physical tape unit 4, and the exchange
           program is known as $EXCH.  The MCR commands below illustrate a
           possible specification.
0          >ASN MT1:=MT0:
           >ASN MT4:=MT1:
           >RUN $EXCH
           ...  (exchange program commands)  ...
           >ASN =MT0:
           >ASN =MT1:
0          The last two commands cancel the  associations  of  exchange  tape
           logical units with physical units.
0
           10.6.2.  Input/Output Interface
0
           Exchange tapes and exchange format disk files are read and written
           using the WTQIO system subroutine [7].  Native  format  files  are
           read   and   written   using  Fortran  formatted  read  and  write
           statements.  The output file and the include file  in  the  simple
 .
 .
                                          10-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          program,  and  the  work  file  in  the comprehensive program, are
           opened using the file name 'EXCHnn.TMP', where 'nn'  is  the  unit
           number.   End  of  file  marks  are  detected in input files; QUIT
           commands and '--' sentinels are  optional  at  the  end  of  input
           files.
0
           10.7.  Contents of the Simple Program
0
           The  simple  exchange  program  for the DEC PDP-11 consists of the
           machine sensitive main program unit; the simple exchange  program,
           identified  on  the distribution tape as EXCHSP; machine sensitive
           versions of  EXCHAH,  EXCHFO  and  EXCHRT;  the  machine  specific
           modules  DOTAPE  and  ASMEXCH; and the machine insensitive modules
           EXCHGB, EXCHGR and EXCHRH.
0
           10.8.  Contents of the Comprehensive Program
0
           The comprehensive exchange program for the DEC PDP-11 consists  of
           the  machine  sensitive  main  program unit; the version of EXCHBD
           having no translate table; machine  sensitive  versions  of  EXCH,
           EXCHFO, EXCHAH, EXCHRT, EXCHWT, EXCHIM, EXCHOU and EXCHCX; machine
           specific modules DOTAPE and ASMEXCH; portable versions of  EXCHSL,
           EXCHTR  and  EXCHCG;  and  the machine insensitive modules EXCHGB,
           EXCHGR, EXCHNP, EXCHPB, EXCHPR, EXCHSC,  EXCHTP,  EXCHTW,  EXCHC1,
           EXCHC2,  EXCHC3,  EXCHRH,  EXCHWH, EXCHC4, EXCHLX, EXCHC5, EXCHC6,
           EXCHC7, EXCHC8 and EXCHC9.  RSX  TKB  commands  for  building  the
           comprehensive  program task and defining the overlay structure are
           contained  in  the  machine  specific   modules   TASK-BUILD   and
           OVLAY-STRU respectively.
0
           10.9.  Error Messages
0
           TAPE PROCESSOR ERROR mmmm FOR COMMAND nnnnnn
             May  be produced by the subroutine DOTAPE after a call to WTQIO.
             Consult [7] for a description of mmmm and nnnnnn.  This  message
             is  followed  by a message produced by the portable parts of the
             comprehensive exchange program, described in  section  3.6.5  of
             [2].
0          UNABLE TO OPEN INCLUDE FILE
             Is produced only by the simple program.  The program stops after
             producing this message.
 .
 .
                                          10-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          UNABLE TO OPEN UNIT nn FOR FILE ...
             Is produced only by the  comprehensive  program  when  a  native
             format file cannot be opened.  The message has error severity 5.
             If input or output is attempted on the file, RSX will  kill  the
             program.
0          UNABLE TO OPEN WORK FILE
             May  be  produced  by  either program.  If it is produced by the
             simple program, it means the output file could  not  be  opened.
             The programs stop after producing this message.
0          UNRECOGNIZED PARAMETER ON TABS COMMAND
             Is  printed by the comprehensive program if the parameter on the
             tabs command is neither N nor Y.  The interpretation of  the  HT
             character is not changed.
0
           10.10.  Informative Messages
0
           EXCHANGE PROGRAM
           DEFAULT DATE IS yy-mm-dd
             Is printed by the comprehensive  program  when  initiated.   The
             date  is fetched from RSX.  If you want to use a different date,
             use the DATE command, described in section 3.4.1 of [2].
0          The messages
           OPEN UNIT nn FOR INPUT FROM ...
           OPEN UNIT nn FOR OUTPUT TO ...
             Are produced by the comprehensive program  whenever  a  file  is
             opened.
0
0
0
0
0
0
0
0
0.
 .
                                          10-4
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          11.  DEC VAX-11 using VMS
0
0
           11.1.  System Dependent Information from Commands
0
           The  DEC  VAX-11  using  VMS version of the comprehensive exchange
           program  uses  the  system  dependent  information  from   READER,
           PRINTER,  INPUT  FILE, INCLUDE FILE, OUTPUT FILE, TEXT, INTAPE and
           OUTAPE commands for file names.  If no file name is specified, the
           following defaults are used.
0          Suppose NN (or NNN) denote the decimal digits of a unit number.
0            TES Command                          Default File Name
0            READER=NN   (NN .NE. 5)              EXCHNN.TMP;Version #
             PRINTER=NN  (NN .NE. 6)              EXCHNN.LIS;Version #
0            WORK FILE=NNN                        FORNNN.DAT;Version #
               (Default name is only possible name, and is deleted
               after the job is completed.)
             INCLUDE FILE=NN                      EXCHNN.TMP;Version #
             TEXT=NN                              EXCHNN.TMP;Version #
             INPUT FILE=NN                        EXCHNN.TMP;Version #
             OUTPUT FILE=NN                       EXCHNN.TMP;Version #
0            INTAPE=NN                            TEIONN.TES;Version #
             OUTAPE=NN                            TEIONN.TES;Version #
0          The  input,  output and include files in the simple version of the
           program are assigned to files named EXCHNN.TMP;Version #.
0
           11.2.  Default Values for File Unit Numbers
0
           The default value for the READER file  is  unit  5.   The  default
           value  for  the PRINTER file is unit 6.  The default value for the
           WORK file is unit 7.
0
0
0
 .
 .
                                          11-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          11.3.  Information Provided by the Environment
0
           The DATE is provided by the  system  dependent  environment.   The
           SITE may be provided.  Consult site dependent documentation.
0
           11.4.  Interpretation of Option Letters
0
           The  DEC  VAX-11  using  VMS version of the comprehensive exchange
           program is affected only by the selection  of  option  T  and  the
           option  selections  to which the portable parts of the program are
           sensitive.  If the T option is selected when an input file  is  to
           be opened, and the file is already open, it is not re-opened.
0
           11.5.  Special Commands
0
           The  DEC  VAX-11  using  VMS version of the comprehensive exchange
           program interprets one command in addition to those interpreted by
           the  portable  parts  of  the program.  The TABS command specifies
           whether tab characters (ASCII HT = 09) appearing in text read from
           the  sources specified by the READER, INPUT FILE, INCLUDE FILE, or
           TEXT  commands  are  data  characters  or  horizontal   tabulation
           requests.   The  parameter is a single letter.  If the letter is D
           or Y the ASCII HT character is a data character.  If the letter is
           T or N, the ASCII HT character is a horizontal tabulation request.
           In the latter circumstance, ASCII HT characters are  converted  to
           the number of blanks required so that the next character is stored
           in a position that is the smallest multiple of 8  that  is  larger
           than the last position used for input text.  The initial condition
           of the program  is  to  interpret  ASCII  HT  characters  as  data
           characters.   Other values of the first character of the parameter
           cause an error message.  Only the first character of the parameter
           is examined.
0
           11.6.  Interface to VMS
0
0
0
0
 .
 .
                                          11-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          11.6.1.  Job Control Statements for VMS
0
           Exchange format files can be read from magnetic tape or disk files
           by either the simple or comprehensive exchange programs.  Exchange
           format  files can be written on magnetic tape or disk files by the
           comprehensive program.  Four common uses of the exchange  programs
           are illustrated below.
0
           11.6.1.1.  Using the Simple Program
0
           $MOUNT/FOREIGN/NOWRITE/DENSITY=1600/BLOCK=3600 MT0: DL EXCHNN.TMP
0          The  reel  is  mounted on the tape drive before the MOUNT command,
           see [8], is executed.  The tape is write disabled.  The name  "DL"
           on  the MOUNT command is a dummy label.  This specification may be
           necessary on some systems and prohibited on others.  The number NN
           in  "EXCHNN.TMP" is the Fortran unit number for the input exchange
           tape file.
0
           11.6.1.2.  Copying an Exchange Format Tape to a Disk File
0
           $MOUNT/FOREIGN/NOWRITE/BLOCK=3600 MT0: DL TAPEIN
0          The reel is mounted on the tape drive before  the  MOUNT  command,
           see [8], is executed.  The tape is write-disabled.
0          $RUN TES
0          (The compiled and linked comprehensive program is in TES.EXE.)
0          *INTAPE=10 TAPEIN            (At most 40 characters in file name)
           *OUTAPE=11                   (Output to disk file TEIO11.TES;1)
           *COPY=N-N
           *QUIT
0          The asterisk before each command above is not part of the input to
           the comprehensive program;  it is a prompt character  supplied  by
           the comprehensive program.
0          The  name  "DL"  on  the  MOUNT  command  is  a dummy label.  This
           specification may be necessary on some systems and  prohibited  on
           others.  The name "TAPEIN" is the file name for the input exchange
           tape  file.   The  file  names  on  the  MOUNT  command  and   the
 .
 .
                                          11-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          comprehensive program INTAPE command must agree exactly.
0
           11.6.1.3.  Copying an Exchange Format Disk File to a Tape
0
           $MOUNT/FOREIGN/WRITE/DENSITY=1600/BLOCK=3600 MT0: DL TAPEOUT
0          The  reel  is  mounted on the tape drive before the MOUNT command,
           see [8], is executed.  The tape is write-enabled.
0          $RUN TES
0          (The compiled and linked comprehensive program is in TES.EXE.)
0          *INTAPE=11                   (From disk file TEIO11.TES;1)
           *OUTAPE=12 TAPEOUT
           *COPY=N-N
           *QUIT
0          As above, the asterisk shown here is a prompt  character  supplied
           by the comprehensive program, not part of the input.
0          The  name  "DL"  on  the  MOUNT  command  is  a dummy label.  This
           specification may be necessary on some systems and  prohibited  on
           others.   The  name  "TAPEOUT"  is  the  file  name for the output
           exchange file.  The file  names  on  the  MOUNT  command  and  the
           comprehensive program OUTAPE command must agree exactly.
0
           11.6.1.4.  Copying an Exchange Format Disk File to Another
0
           $RUN TES
           *INTAPE=11                   (Disk file is TEIO11.TES;1)
           *OUTAPE=13 NEWFILE.DAT;1     (Disk file is NEWFILE.DAT;1)
           *COPY=N-N
           *QUIT
0
           11.6.2.  Input/Output Interface
0
           Exchange format files are read from or written to magnetic tape or
           internal disk files using Fortran formatted write  statements  and
           "A" format.  The files are opened using variable record length and
           no carriage control.  Native format files  are  read  and  written
           using  Fortran formatted read and write statements and "A" format.
 .
 .
                                          11-4
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          End of file marks are detected in input files; QUIT  commands  and
           '--' sentinels are optional at the end of input files.
0
           11.7.  Contents of the Simple Program
0
           The  simple exchange program for the DEC VAX-11 using VMS consists
           of the machine sensitive main program unit;  the  simple  exchange
           program,  identified  on  the distribution tape as EXCHSP; machine
           sensitive versions of EXCHAH,  EXCHFO  (special  version  for  the
           simple  program)  and  EXCHRT; the machine specific module EXCHUN;
           and the machine insensitive modules EXCHGB, EXCHGR and EXCHRH.   A
           special  version  of EXCHFO is used for the simple program because
           of differences  between  the  simple  and  comprehensive  exchange
           programs  to  which  VMS fortran is sensitive but most systems are
           not.
0
           11.8.  Contents of the Comprehensive Program
0
           The comprehensive exchange program for the DEC  VAX-11  using  VMS
           consists  of  the machine sensitive main program unit; the version
           of EXCHBD having no translate table; machine sensitive versions of
           EXCH,  EXCHFO,  EXCHAH,  EXCHUN,  EXCHPA,  EXCHRT, EXCHWT, EXCHIM,
           EXCHOU and EXCHCX; portable versions of EXCHSL, EXCHTR and EXCHCG;
           and  the  machine  insensitive  modules  EXCHGB,  EXCHGR,  EXCHNP,
           EXCHPB, EXCHPR, EXCHSC, EXCHTP, EXCHTW,  EXCHC1,  EXCHC2,  EXCHC3,
           EXCHRH, EXCHWH, EXCHC4, EXCHLX, EXCHC5, EXCHC6, EXCHC7, EXCHC8 and
           EXCHC9.
0
           11.9.  Error Messages
0
           Attempted open at end-of-file on INTAPE
             May be produced by either program when an exchange  format  file
             on  magnetic tape or disk cannot be opened because the device is
             positioned at the end-of-file signal.
0          End-of-file on close/rewind of INTAPE
             May be produced by either program,  but  probably  only  if  the
             operating system is confused.
0          Error condition occurred while closing OUTAPE, IOSTAT=ZZZZZZZZ
             May  be  produced  only by the comprehensive program if an error
             occurs while closing an output  exchange  format  tape  or  disk
 .
 .
                                          11-5
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0            file.   ZZZZZZZZ is the I/O error status returned by the Fortran
             runtime library.  Consult [9] for a description of ZZZZZZZZ.
0          Error condition occurred while opening INTAPE, IOSTAT=ZZZZZZZZ
             May be produced by either  program  if  an  error  occurs  while
             opening an input exchange format tape or disk file.  ZZZZZZZZ is
             the I/O error status returned by the  Fortran  runtime  library.
             Consult [9] for a description of ZZZZZZZZ.
0          Error condition occurred while opening OUTAPE, IOSTAT=ZZZZZZ
             May  be  produced  only by the comprehensive program if an error
             occurs while opening an output  exchange  format  tape  or  disk
             file.   ZZZZZZZZ is the I/O error status returned by the Fortran
             runtime library.  Consult [9] for a description of ZZZZZZZZ.
0          Error condition occurred while reading INTAPE, IOSTAT=ZZZZZZZZ
             May be produced by either  program  if  an  error  occurs  while
             reading  from  an  input  exchange  format  tape  or  disk file.
             ZZZZZZZZ is the I/O error status returned by the Fortran runtime
             library.  Consult [9] for a description of ZZZZZZZZ.
0          Error condition occurred while writing OUTAPE, IOSTAT=ZZZZZZZZ
             May  be  produced  only by the comprehensive program if an error
             occurs while writing an output  exchange  format  tape  or  disk
             file.   ZZZZZZZZ is the I/O error status returned by the Fortran
             runtime library.  Consult [9] for a description of ZZZZZZZZ.
0          Error   condition   occurred   with   close/rewind   of    INTAPE,
             IOSTAT=ZZZZZZZZ
             May  be  produced  by  either  program  if an error occurs while
             rewinding an input exchange format tape or disk file.   ZZZZZZZZ
             is the I/O error status returned by the Fortran runtime library.
             Consult [9] for a description of ZZZZZZZZ.
0          UNABLE TO OPEN INCLUDE FILE
             Is produced only by the simple program.  The program stops after
             producing this message.
0          UNABLE TO OPEN UNIT nn FOR FILE ...
             Is  produced  only  by  the  comprehensive program when a native
             format file cannot be opened.  The message has error severity 5.
             If  input or output is attempted on the file, VMS will terminate
             the program.
0          UNABLE TO OPEN WORK FILE
             May be produced by either program.  If it  is  produced  by  the
             simple  program,  it  means the output file could not be opened.
             The programs stop after producing this message.
 .
 .
                                          11-6
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          Unexpected end-of-file on INTAPE.
             May be produced by either program if an  end-of-file  signal  is
             returned  when  reading  an  input  exchange format tape or disk
             file.  Since the exchange format defines an end-of-file  record,
             the  end of file signal provided by hardware should only be read
             before an exchange format label record.
0          UNRECOGNIZED PARAMETER ON TABS COMMAND
             Is printed by the comprehensive program if the parameter on  the
             tabs  command is not D, N, T or Y.  The interpretation of the HT
             character is not changed.
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0.
 .
                                          11-7
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          12.  DEC VAX-11 using UNIX (TM)
0
0
           12.1.  System Dependent Information from Commands
0
           The DEC VAX-11  using  UNIX  (TM)  version  of  the  comprehensive
           exchange  program  uses  the  system  dependent  information  from
           READER, PRINTER, INPUT FILE,  INCLUDE  FILE,  OUTPUT  FILE,  TEXT,
           INTAPE  and  OUTAPE  commands  for file names.  If no file name is
           specified, the following defaults are used.
0          Suppose NN denote the decimal digits of a unit number.
0            TES Command                          Default File Name
0            READER=NN   (NN .NE. 5)              EXCHNN.TMP
             PRINTER=NN  (NN .NE. 6)              EXCHNN.LIS
0            WORK FILE=NN                         tmp.Fnnnnn
               (Default name is only possible name, and is deleted
               after the job is completed.  The number nnnnn in the
               generated file name depends on the process ID.)
             INCLUDE FILE=NN                      EXCHNN.TMP
             TEXT=NN                              EXCHNN.TMP
             INPUT FILE=NN                        EXCHNN.TMP
             OUTPUT FILE=NN                       EXCHNN.TMP
0            INTAPE=NN                            EXCHNN.TMP
             OUTAPE=NN                            EXCHNN.TMP
0          The  input,  output and include files in the simple version of the
           program are assigned to files named EXCHNN.TMP.
0
           12.2.  Default Values for File Unit Numbers
0
           The default value for the READER file  is  unit  5.   The  default
           value  for  the PRINTER file is unit 6.  The default value for the
           WORK file is unit 7.
0
0
0.
 .
                                          12-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          12.3.  Information Provided by the Environment
0
           The DATE is provided by the  system  dependent  environment.   The
           SITE  is  not  provided  by  the  distributed  version, but may be
           provided as a result of a local change.   Consult  site  dependent
           documentation.
0
           12.4.  Interpretation of Option Letters
0
           The  DEC  VAX-11  using  UNIX  (TM)  version  of the comprehensive
           exchange program is affected only by the selection of option T and
           the  option  selections to which the portable parts of the program
           are sensitive.  If the T option is selected when an input file  is
           to be opened, and the file is already open, it is not re-opened.
0
           12.5.  Special Commands
0
           The  DEC  VAX-11  using  UNIX  (TM)  version  of the comprehensive
           exchange program interprets  one  command  in  addition  to  those
           interpreted  by  the  portable  parts  of  the  program.  The TABS
           command specifies whether tab characters (ASCII HT = 09) appearing
           in text read from the sources specified by the READER, INPUT FILE,
           INCLUDE FILE, or TEXT commands are data characters  or  horizontal
           tabulation  requests.   The  parameter is a single letter.  If the
           letter is D or Y the ASCII HT character is a data  character.   If
           the  letter  is  T  or  N,  the ASCII HT character is a horizontal
           tabulation  request.   In  the  latter  circumstance,   ASCII   HT
           characters  are converted to the number of blanks required so that
           the next character is stored in a position that  is  the  smallest
           multiple of 8 that is larger than the last position used for input
           text.  The initial condition of the program is to interpret  ASCII
           HT  characters  as  data  characters.   Other  values of the first
           character of the parameter cause an error message.  Only the first
           character of the parameter is examined.
0
           12.6.  Interface to UNIX (TM)
0
0
0
 .
 .
                                          12-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          12.6.1.  Job Control Statements for UNIX (TM)
0
           Exchange format files can be read from magnetic tape or disk files
           by either the simple or comprehensive exchange programs.  Exchange
           format  files can be written on magnetic tape or disk files by the
           comprehensive program.  When using the comprehensive program,  TES
           format  tapes  may  be read and written directly by specifying the
           path name of the tape drive on which the reel is  mounted  in  the
           INTAPE  or  OUTAPE command as appropriate.  For example, if a tape
           reel on which a TES format file is to be written has been  mounted
           on  a  tape drive for which the path name is "/dev/nrmt1" then the
           tape file may be  written  directly  from  the  comprehensive  TES
           program by specifying
0          OUTAPE=NN /dev/nrmt1
0          where  NN  is  the  desired  Fortran  unit number.  When using the
           simple TES program, and in many cases when using the comprehensive
           TES  program, one may desire to copy TES format tape files to disk
           before use, and from disk to tape after use.  Four common uses  of
           the exchange programs are illustrated below.
0
           12.6.1.1.  Copying an Exchange Format Tape to a Disk File
0
           The reel is mounted on the tape drive, and the contents are copied
           to disk by
0           dd if=/dev/nrmt1 ibs=3600 of=temp.disk.file
0          where "/dev/nrmt1" is the path name of the tape drive on which the
           reel  is mounted, and "temp.disk.file" is the disk file into which
           the contents of the tape are to be copied.  The  TES  format  disk
           file may then be accessed in the comprehensive TES program by
0          INTAPE=NN temp.disk.file
0          where  NN  is  the desired Fortran unit number, and temp.disk.file
           contains the contents copied from a TES format tape.
0
           12.6.1.2.  Using the Simple Program
0
           For simplest usage, the TES format tape file should be copied to a
           disk  file,  as  described in the previous section.  The disk file
 .
 .
                                          12-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          name denoted above  by  "temp.disk.file"  should  be  "EXCHNN.TMP"
           where  NN  is the Fortran unit number to be used for the input TES
           format file when the simple program is executed.
0
           12.6.1.3.  Copying an Exchange Format Disk File to a Tape
0
           The reel is mounted on the tape drive, and the contents of  a  TES
           format disk file may be copied to the tape reel by
0           d2tap
            temp.disk.file
            /dev/nrmt1
0          where  "temp.disk.file" is the name of a disk file created by TES,
           and "/dev/nrmt1" is the path name of the tape drive on  which  the
           reel  is  mounted.   The  path  name  of  the  tape  drive is site
           dependent.   The  program  "d2tap"  is  provided  with   the   TES
           distribution.
0
           12.6.1.4.  Copying an Exchange Format Disk File to Another
0
           TES
           *INTAPE=11                   (Disk file is EXCH11.TMP)
           *OUTAPE=13 NEWFILE.DAT       (Disk file is NEWFILE.DAT)
           *COPY=N-N
           *QUIT
0          The asterisks in the example above are not input;  they are prompt
           characters provided by TES.
0
           12.6.2.  Input/Output Interface
0
           Exchange format files are read from or written to magnetic tape or
           internal  disk  files  using  special subprograms written in the C
           programming language.  Native format files are  read  and  written
           using  Fortran formatted read and write statements and "A" format.
           End of file is detected in input files;  QUIT  commands  and  '--'
           sentinels are optional at the end of input files.
0
0
 .
 .
                                          12-4
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          12.7.  Contents of the Simple Program
0
           The  simple  exchange  program  for the DEC VAX-11 using UNIX (TM)
           consists of the machine sensitive main program  unit;  the  simple
           exchange  program,  identified on the distribution tape as EXCHSP;
           machine sensitive versions of EXCHAH, EXCHFO (special version  for
           the  simple  program)  and  EXCHRT;  the  machine specific modules
           EXCHUN and TAPEIO (The latter  written  in  C);  and  the  machine
           insensitive  modules EXCHGB, EXCHGR and EXCHRH.  A special version
           of EXCHFO is used for the simple program  because  of  differences
           between  the  simple  and comprehensive exchange programs to which
           UNIX (TM) fortran is sensitive but most systems are not.
0
           12.8.  Contents of the Comprehensive Program
0
           The comprehensive exchange program for the DEC VAX-11  using  UNIX
           (TM)  consists  of  the  machine  sensitive main program unit; the
           version of EXCHBD having no  translate  table;  machine  sensitive
           versions  of EXCH, EXCHFO, EXCHAH, EXCHUN, EXCHPA, EXCHRT, EXCHWT,
           EXCHIM, EXCHOU, EXCHCX, TAPEIO and IDATE (the last two are written
           in  C);  portable  versions  of EXCHSL, EXCHTR and EXCHCG; and the
           machine  insensitive  modules  EXCHGB,  EXCHGR,  EXCHNP,   EXCHPB,
           EXCHPR,  EXCHSC,  EXCHTP,  EXCHTW, EXCHC1, EXCHC2, EXCHC3, EXCHRH,
           EXCHWH, EXCHC4, EXCHLX, EXCHC5, EXCHC6, EXCHC7, EXCHC8 and EXCHC9.
0
           12.9.  Error Messages
0
           Error  messages  produced  by  the UNIX (TM) version of TES do not
           contain any code numbers, and are all self explanatory.
0
0
0
0
0
0
0
 .
 .
                                          12-5
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          13.  Data General MV/8000 using AOS/VS
0
0
           13.1.  System Dependent Information from Commands
0
           The Data General MV/8000 using AOS/VS version of the comprehensive
           exchange  program  uses  the  system  dependent  information  from
           READER,  PRINTER,  INPUT  FILE,  INCLUDE  FILE, OUTPUT FILE, TEXT,
           INTAPE and OUTAPE commands for file names.  If  no  file  name  is
           specified, the following defaults are used.
0          Suppose NN (or NNN) denote the decimal digits of a unit number.
0            TES Command                          Default File Name
0            READER=NN   (NN .NE. 5)              TESPNN.LS
             PRINTER=NN  (NN .NE. 6)              EXCHNN.TMP
0            WORK FILE=NNN                        ?PID.F77.SCRATCH.NNN.TMP
               (Default name is only possible name, and is deleted
               after the job is completed.)
             INCLUDE FILE=NN                      EXCHNN.TMP
             TEXT=NN                              EXCHNN.TMP
             INPUT FILE=NN                        EXCHNN.TMP
             OUTPUT FILE=NN                       EXCHNN.TMP
0            INTAPE=NN                            TEIONN.TES
             OUTAPE=NN                            TEIONN.TES
0          The  input,  output and include files in the simple version of the
           program are assigned to files named EXCHNN.TMP.
0
           13.2.  Default Values for File Unit Numbers
0
           The default value  for  the  READER  file  is  unit  5,  device  =
           @CONSOLE.   The  default  value  for  the  PRINTER file is unit 6,
           device = @CONSOLE.  The default value for the WORK file is unit 7.
0
0
0
 .
 .
                                          13-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          13.3.  Information Provided by the Environment
0
           The DATE is provided by the  system  dependent  environment.   The
           SITE may be provided.  Consult site dependent documentation.
0
           13.4.  Interpretation of Option Letters
0
           The Data General MV/8000 using AOS/VS version of the comprehensive
           exchange program is affected only by the selection of option T and
           the  option  selections to which the portable parts of the program
           are sensitive.  If the T option is selected when an input file  is
           to be opened, and the file is already open, it is not re-opened.
0
           13.5.  Special Commands
0
           The Data General MV/8000 using AOS/VS version of the comprehensive
           exchange program interprets  one  command  in  addition  to  those
           interpreted  by  the  portable  parts  of  the  program.  The TABS
           command specifies whether tab characters (ASCII HT = 09) appearing
           in text read from the sources specified by the READER, INPUT FILE,
           INCLUDE FILE, or TEXT commands are data characters  or  horizontal
           tabulation  requests.   The  parameter is a single letter.  If the
           letter is D or Y the ASCII HT character is a data  character.   If
           the  letter  is  T  or  N,  the ASCII HT character is a horizontal
           tabulation  request.   In  the  latter  circumstance,   ASCII   HT
           characters  are converted to the number of blanks required so that
           the next character is stored in a position that  is  the  smallest
           multiple of 8 that is larger than the last position used for input
           text.  The initial condition of the program is to interpret  ASCII
           HT  characters  as  data  characters.   Other  values of the first
           character of the parameter cause an error message.  Only the first
           character of the parameter is examined.
0
           13.6.  Interface to AOS/VS
0
0
0
0
 .
 .
                                          13-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          13.6.1.  Job Control Statements for AOS/VS
0
           Exchange format files can be read from magnetic tape or disk files
           by either the simple or comprehensive exchange programs.  Exchange
           format  files can be written on magnetic tape or disk files by the
           comprehensive program.  Four common uses of the exchange  programs
           are illustrated below.
0
           13.6.1.1.  Using the Simple Program
0
           The  reel  is  mounted on the tape drive before the X TES command,
           see [10], is executed.  The tape is write disabled if the reel has
           no ring.
0
           13.6.1.2.  Copying an Exchange Format Tape to a Disk File
0
           The  reel  is  mounted on the tape drive before the X TES command,
           see [10], is executed.  The tape is write disabled if the reel has
           no ring.
0          )X TES
0          (The compiled and linked comprehensive program is in TES.PR.)
0          *INTAPE=10 @MTD0:0           (At most 40 characters in file name)
           *OUTAPE=11                   (Output to disk file TEIO11.TES)
           *COPY=N-N
           *QUIT
0          The asterisk before each command above is not part of the input to
           the comprehensive program;  it is a prompt character  supplied  by
           the comprehensive program.
0
           13.6.1.3.  Copying an Exchange Format Disk File to a Tape
0
           The  reel  is  mounted on the tape drive before the X TES command,
           see [10], is executed.  The tape is write-enabled.
0          )X TES
0          (The compiled and linked comprehensive program is in TES.PR.)
 .
 .
                                          13-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          *INTAPE=11                   (From disk file TEIO11.TES)
           *OUTAPE=12 @MTD0:0
           *COPY=N-N
           *QUIT
0          As above, the asterisk shown here is a prompt  character  supplied
           by the comprehensive program, not part of the input.
0
           13.6.1.4.  Copying an Exchange Format Disk File to Another
0
           )X TES
           *INTAPE=11                   (Disk file is TEIO11.TES)
           *OUTAPE=13 NEWFILE.DAT       (Disk file is NEWFILE.DAT)
           *COPY=N-N
           *QUIT
0
           13.6.2.  Input/Output Interface
0
           Exchange format files are read from or written to magnetic tape or
           internal disk files using Fortran formatted write  statements  and
           "A" format.  The files are opened using variable record length and
           no carriage control.  Native format files  are  read  and  written
           using  Fortran formatted read and write statements and "A" format.
           End of file marks are detected in input files; QUIT  commands  and
           '--' sentinels are optional at the end of input files.
0
           13.7.  Contents of the Simple Program
0
           The  simple  exchange  program  for the Data General MV/8000 using
           AOS/VS consists the  machine  sensitive  main  program  unit;  the
           simple  exchange  program,  identified on the distribution tape as
           EXCHSP; machine sensitive  versions  of  EXCHAH,  EXCHFO  (special
           version  for  the simple program) and EXCHRT; the machine specific
           module EXCHUN; and the machine insensitive modules EXCHGB,  EXCHGR
           and  EXCHRH.   A  special version of EXCHFO is used for the simple
           program  because   of   differences   between   the   simple   and
           comprehensive   exchange  programs  to  which  AOS/VS  fortran  is
           sensitive but most systems are not.
0
0
 .
 .
                                          13-4
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          13.8.  Contents of the Comprehensive Program
0
           The comprehensive exchange program for the  Data  General  MV/8000
           using  AOS/VS consists of the machine sensitive main program unit;
           the version of EXCHBD having no translate table; machine sensitive
           versions  of EXCH, EXCHFO, EXCHAH, EXCHUN, EXCHPA, EXCHRT, EXCHWT,
           EXCHIM, EXCHOU and EXCHCX; portable versions of EXCHSL, EXCHTR and
           EXCHCG;  and  the  machine  insensitive  modules  EXCHGB,  EXCHGR,
           EXCHNP, EXCHPB, EXCHPR, EXCHSC, EXCHTP,  EXCHTW,  EXCHC1,  EXCHC2,
           EXCHC3,  EXCHRH,  EXCHWH,  EXCHC4, EXCHLX, EXCHC5, EXCHC6, EXCHC7,
           EXCHC8  and  EXCHC9.   The  subprogram  EXCH  calls   the   system
           subprogram DATE from the common runtime library.
0
           13.9.  Error Messages
0
           Attempted open at end-of-file on INTAPE
             May  be  produced by either program when an exchange format file
             on magnetic tape or disk cannot be opened because the device  is
             positioned at the end-of-file signal.
0          End-of-file on close/rewind of INTAPE
             May  be  produced  by  either  program, but probably only if the
             operating system is confused.
0          Error condition occurred while closing OUTAPE, IOSTAT=ZZZZZZZZ
             May be produced only by the comprehensive program  if  an  error
             occurs  while  closing  an  output  exchange format tape or disk
             file.  ZZZZZZZZ is the I/O error status returned by the  Fortran
             runtime  library.   Consult  a list of Fortran runtime or AOS/VS
             System errors for a description of  ZZZZZZZZ.   One  can  access
             this list on-line by
0              )MESSAGE ZZZZZZZZ
0            The system tries to tell you what went wrong.
0          Error condition occurred while opening INTAPE, IOSTAT=ZZZZZZZZ
             May  be  produced  by  either  program  if an error occurs while
             opening an input exchange format tape or disk file.  ZZZZZZZZ is
             the  I/O  error  status returned by the Fortran runtime library.
             The meaning of ZZZZZZZZ may be discovered as described above.
0          Error condition occurred while opening OUTAPE, IOSTAT=ZZZZZZ
             May be produced only by the comprehensive program  if  an  error
             occurs  while  opening  an  output  exchange format tape or disk
 .
 .
                                          13-5
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0            file.  ZZZZZZZZ is the I/O error status returned by the  Fortran
             runtime  library.   The meaning of ZZZZZZZZ may be discovered as
             described above.
0          Error condition occurred while reading INTAPE, IOSTAT=ZZZZZZZZ
             May be produced by either  program  if  an  error  occurs  while
             reading  from  an  input  exchange  format  tape  or  disk file.
             ZZZZZZZZ is the I/O error status returned by the Fortran runtime
             library.  The meaning of ZZZZZZZZ may be discovered as described
             above.
0          Error condition occurred while writing OUTAPE, IOSTAT=ZZZZZZZZ
             May be produced only by the comprehensive program  if  an  error
             occurs  while  writing  an  output  exchange format tape or disk
             file.  ZZZZZZZZ is the I/O error status returned by the  Fortran
             runtime  library.   The meaning of ZZZZZZZZ may be discovered as
             described above.
0          Error   condition   occurred   with   close/rewind   of    INTAPE,
             IOSTAT=ZZZZZZZZ
             May  be  produced  by  either  program  if an error occurs while
             rewinding an input exchange format tape or disk file.   ZZZZZZZZ
             is the I/O error status returned by the Fortran runtime library.
             The meaning of ZZZZZZZZ may be discovered as described above.
0          UNABLE TO OPEN INCLUDE FILE
             Is produced only by the simple program.  The program stops after
             producing this message.
0          UNABLE TO OPEN UNIT nn FOR FILE ...
             Is  produced  only  by  the  comprehensive program when a native
             format file cannot be opened.  The message has error severity 5.
             If  input  or  output  is  attempted  on  the  file, AOS/VS will
             terminate the program.
0          UNABLE TO OPEN WORK FILE
             May be produced by either program.  If it  is  produced  by  the
             simple  program,  it  means the output file could not be opened.
             The programs stop after producing this message.
0          Unexpected end-of-file on INTAPE.
             May be produced by either program if an  end-of-file  signal  is
             returned  when  reading  an  input  exchange format tape or disk
             file.  Since the exchange format defines an end-of-file  record,
             the  end of file signal provided by hardware should only be read
             before an exchange format label record.
0          UNRECOGNIZED PARAMETER ON TABS COMMAND
 .
 .
                                          13-6
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0            Is printed by the comprehensive program if the parameter on  the
             tabs  command is not D, N, T or Y.  The interpretation of the HT
             character is not changed.
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0.
 .
                                          13-7
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          14.  Sperry Univac (ex Varian) V-70 using VORTEX
0
0
           14.1.  System Dependent Information from Commands
0
           The Sperry Univac  V-70  version  of  the  comprehensive  exchange
           program uses system dependent information from READER, INPUT FILE,
           TEXT INCLUDE FILE, OUTPUT FILE, INTAPE  and  OUTAPE  commands  for
           file  names, when the device designated by the Fortran unit number
           is a disk partition.  A file name should not be specified  if  the
           device  is  tape.   If  the  device  is  disk  and no file name is
           provided the file name used depends on the unit  number.   If  the
           unit  number is less than 11, a file name is fetched from a system
           FCB.  If the unit number is greater than 10, a default  file  name
           is used.  The first 4 characters are EXCH; the last two characters
           are blanks if the command is an INTAPE  or  OUTAPE  command;   the
           last  two  characters  are  'IN' if the command is a READER, INPUT
           FILE, TEXT or INCLUDE FILE command; the last  two  characters  are
           'OU' if the command is an OUTPUT FILE command.
0
           14.2.  Default Values for File Unit Numbers
0
           The default value for the READER file is unit 2 (SI).  The default
           value for the PRINTER file is unit 5 (LO).  The default value  for
           the  WORK  file  is  unit  8  (SS).   Note that in standard VORTEX
           systems, SS and PO (10) refer to the same disk partition.  If COPY
           commands  of  the second form are to be used or if control records
           are to be changed, either the WORK file and the OUTPUT file should
           not be assigned to SS and PO respectively, or one of SS or PO must
           be assigned to a different partition.  The WORK file is not opened
           by  the  program;  if  it  is to be used for the reasons described
           above it must first be opened with a /PFILE command,  or  assigned
           to tape.
0
           14.3.  Information Provided by the Environment
0
           The DATE is not provided by the system dependent environment.  The
           SITE may be provided.  Consult site dependent documentation.
0
0.
 .
                                          14-1
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          14.4.  Interpretation of Option Letters
0
           The Sperry Univac  V-70  version  of  the  comprehensive  exchange
           program  is  not  affected  by any option letters other than those
           interpreted by the portable parts of the program.
0
           14.5.  Special Commands
0
           The Sperry Univac  V-70  version  of  the  comprehensive  exchange
           program   does   not  interpret  any  commands  other  than  those
           interpreted by the portable parts of the program.
0
           14.6.  Interface to VORTEX
0
0
           14.6.1.  Job Control Language Statements for VORTEX
0
           Suppose the exchange program is in BL as EXCH, an exchange tape is
           on the tape device MT0,  blocked  native  format  text  is  to  be
           written  in  the file PO on the system partition PO (configured as
           LUN 10), and an exchange format file is to be written in the  file
           XCH1 on the disk partition denoted by LUN 21.  The file must first
           be created by FMAIN.  Suppose it is known that the  exchange  tape
           has  53  blocks.   The  Job  Control Statements below illustrate a
           possible specification.
0          /ASSIGN,20,MT0
           /FMAIN
           DELETE,21,,XCH1
           CREATE,21,,XCH1,1800,55 .   LEAVE A LITTLE EXTRA SPACE
           /PFILE,PO,,PO
           /LOAD,EXCH
           INTAPE=20
           OUTAPE=21 XCH1
           OUTPUT FILE=10
0
0
0
 .
 .
                                          14-2
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          14.6.2.  Input/Output Interface
0
           Input and Output for exchange tapes and exchange format disk files
           are performed by assembly language (DASMR) subprograms.  Input and
           output  for native format files are performed by Fortran formatted
           read and write statements.  End of  file  marks  are  detected  in
           input files;  QUIT commands and '--' sentinels are optional at the
           end of input files.
0
           14.6.3.  Restrictions
0
           The current  Sperry  Univac  V-70  version  of  the  comprehensive
           exchange  program assumes all text images input from native format
           files are 80 characters long.  Native format input may be  blocked
           or  unblocked.   If  the input is blocked the 'B' modifier must be
           selected on the READER, INPUT FILE, TEXT or INCLUDE file  command.
           In  any  case,  the  input is assumed to be 80 characters.  Native
           format output to disk files will be blocked, and the image will be
           expanded  to  80  characters  with  blanks,  or  truncated  to  80
           characters.  Native format output to tape will be  unblocked,  and
           the record length will be variable.
0
           14.7.  Contents of the Simple Program
0
           The  simple  exchange  program for the Sperry V-70 consists of the
           machine  sensitive  main  program  unit;   the   simple   program,
           identified  on  the distribution tape as EXCHSP; machine sensitive
           versions  of  EXCHAH  and  EXCHRT;  the  machine  specific  module
           ASMEXCH;   the   portable  version  of  EXCHFO;  and  the  machine
           insensitive modules EXCHGB, EXCHGR and EXCHRH.
0
           14.8.  Contents of the Comprehensive Program
0
           The comprehensive exchange program for the Sperry V-70 consists of
           the  machine  sensitive main program; the version of EXCHBD having
           no translate table; machine sensitive versions  of  EXCH,  EXCHAH,
           EXCHTR,   EXCHRT,  EXCHWT,  EXCHIM,  EXCHOU  and  EXCHCX;  machine
           specific modules  ASMEXCH  and  OVLAY;  the  portable  version  of
           EXCHCG;  and  the  machine  insensitive  modules  EXCHGB,  EXCHGR,
           EXCHNP, EXCHPB, EXCHPR, EXCHSC, EXCHTP,  EXCHTW,  EXCHC1,  EXCHC2,
           EXCHC3,  EXCHRH,  EXCHWH,  EXCHC4, EXCHLX, EXCHC5, EXCHC6, EXCHC7,
 .
 .
                                          14-3
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          EXCHC8 and EXCHC9.  The non-resident segments must be  constructed
           as  described  in  section  2.4.6.   The names of the segments are
           known by EXCHTR and must be as shown below.
0           Value of TRANS    Segment Name
                  1              EXCHV1
                  2              EXCHV2
                  3              EXCHV3
                  4              EXCHV4
                  5              EXCHV5
                  6              EXCHV6
                  7              EXCHV7
                  8              EXCHV8
                  9              EXCHV9
0          When  the modules are compiled or assembled the relocatable output
           should be written on a magnetic tape.  Assume BO is assigned to  a
           tape.   Then  the  first file should be the relocatable output for
           the machine sensitive Fortran modules of  the  root  segment,  the
           second  file should be the relocatable output for DASMR modules of
           the root segment, the third file should be the relocatable  output
           for  portable  or  machine insensitive Fortran modules of the root
           segment, and the next 9 files should be the relocatable output for
           Fortran  modules  of each of the non-resident segments.  If the BO
           file is prepared this  way,  the  module  LMGEN  may  be  used  to
           construct the comprehensive program.  The program will be filed in
           BL with the name EXCH.  LMGEN will produce 9  LG16  errors,  which
           may be ignored.
0
           14.9.  Error Messages
0
           No error messages are produced by the Sperry  620/7x  versions  of
           the  exchange  programs  other than those produced by the portable
           parts of the programs.
0
           14.10.  Informative Messages
0
           The message
0          mmmmm BLOCKS WRITTEN ON TAPE nnn
0          is printed when the output exchange tape is  closed.   The  number
           mmmmm is the number of data blocks written on unit nnn.  The label
           is not counted.
 .
 .
                                          14-4
1
                                  Text Exchange System
 .
 .
                               System Dependent Variants
0          15.  References
0
           1.  W.  V. Snyder and R. J. Hanson, "Text Exchange System, Program
               Descriptions," Jet  Propulsion  Laboratory  internal  document
               number 1846-110.
           2.  W. V. Snyder and  R.  J.  Hanson,  "Text  Exchange  System,  A
               Transportable  System  for Management and Exchange of Programs
               and Other Text," Jet Propulsion Laboratory  internal  document
               number 1846-108.
           3.  "Code  for  Information  Interchange,"   Standard   X3.4-1977,
               American National Standards Institute, New York, 1977.
           4.  Robert McEliece,  "The  Theory  of  Information  and  Coding,"
               Addison-Wesley, 1971.
           5.  "USA Standard Fortran," Standard X3.9-1966, American  National
               Standards Institute, New York, 1966.
           6.  "Sperry Univac 1100 Executive  System  Programmer  Reference,"
               Sperry Univac document number UP-4144, Volume 2, Appendix C.
           7.  "RSX-11M  Executive  Reference  Manual,"   Digital   Equipment
               Corporation document number AA-2544D-TC.
           8.  "VAX/VMS Command Language  User's  Guide,"  Digital  Equipment
               Corporation   document  number  AA-D023B-TE,  March  1980,  pp
               224-234.
           9.  "VAX/VMS  System Services Reference Manual," Digital Equipment
               Corporation  document  number  AA-D018B-TE,  March  1980,   pp
               142-143.
           10. "CLI User's manual," Data General Corporation document  number
               093-000-122-05, various dates April 1976 to May 1982, pp 2-10.
0
0
0
0
0
0
0
0
0
0
 .
 .
                                          15-1
1
                                  Text Exchange System
 .
 .
                                   Table of contents
0
           1.  Abstract                                                   1-1
0          2.  Machine or System Sensitive Modules                        2-1
               2.1.  Internal Representation of Characters                2-1
               2.2.  System Dependent Information from Commands           2-1
               2.3.  Modules that are Sensitive to All Machines           2-2
               2.3.1.  Main Program Unit                                  2-2
               2.3.2.  Interface to the Comprehensive Program             2-3
               2.3.3.  Character Unpacking in Both Programs               2-5
               2.3.4.  Character Packing in the Comprehensive Program     2-5
               2.3.5.  Reading Exchange Tapes                             2-6
               2.3.6.  Writing Exchange Tapes                             2-7
               2.4.  Modules that may be Machine Sensitive                2-8
               2.4.1.  Block Data in the Simple Program                   2-8
               2.4.2.  Block Data in the Comprehensive Program            2-9
               2.4.3.  Opening and Closing Native Format Files            2-9
               2.4.4.  Reading Native Format Files                       2-10
               2.4.5.  Writing Native Format Files                       2-11
               2.4.6.  Segmentation of the Compehensive Program          2-12
               2.5.  Optional System Dependent Enhancements              2-12
               2.5.1.  Conversion of Character Codes for Output          2-13
               2.5.2.  System Dependent Command Processing               2-13
               2.5.2.1.  Extra Commands in the Comprehensive Program     2-13
               2.5.2.2.  Processing of System Dependent Information      2-14
               2.5.3.  System Dependent Use of Control Records           2-15
0          3.  Installation Instructions                                  3-1
               3.1.  Organization of the Distribution Tape                3-1
               3.2.  Constructing the Simple Program                      3-2
               3.3.  Constructing the Comprehensive Program               3-4
0          4.  User's Guide for the Simple Program                        4-1
               4.1.  Functional Overview of the Simple Program            4-1
               4.2.  Command Repertoire of the Simple Program             4-1
               4.3.  Printed Output of the Simple Program                 4-3
               4.3.1.  Table of Contents of the EXCH Tape.                4-3
               4.3.2.  Error Messages                                     4-3
               4.3.3.  Informative Messages                               4-4
0          5.  Reading Exchange Tapes with the Simple Program             5-1
               5.1.  Ex. R.0.1 Simple read of EXCH tape, IBM 360/370      5-1
               5.2.  Ex. R.0.2 Simple read of EXCH tape, CDC 6000-7000    5-1
               5.3.  Ex. R.0.3 Simple read of EXCH tape, UNIVAC 1100      5-1
               5.4.  Ex. R.0.4 Simple read with include, IBM 360/370      5-2
0          6.  IBM System/360                                             6-1
               6.1.  System Dependent Information from Commands           6-1
 .
 .
                                           1
1
                                  Text Exchange System
 .
 .
                                   Table of contents
0              6.2.  Default Values for File Unit Numbers                 6-1
               6.3.  Default Value for the Command Margin                 6-1
               6.4.  Information Provided by the Environment              6-1
               6.5.  Interpretation of Option Letters                     6-1
               6.6.  Special Commands                                     6-1
               6.7.  Interface to OS/MVT                                  6-2
               6.7.1.  Job Control Language Statements for OS/MVT         6-2
               6.7.2.  Input/Output Interface                             6-3
               6.8.  Contents of the Simple Program                       6-3
               6.9.  Contents of the Comprehensive Program                6-3
               6.10.  Error Messages                                      6-3
0          7.  Univac 1100                                                7-1
               7.1.  System Dependent Information from Commands           7-1
               7.2.  Default Values for File Unit Numbers                 7-1
               7.3.  Information Provided by the Environment              7-1
               7.4.  Interpretation of Option Letters                     7-2
               7.5.  Special Commands                                     7-2
               7.6.  Native Format (SDF) Files                            7-2
               7.7.  Interface to EXEC                                    7-2
               7.7.1.  Executive Control Statements                       7-2
               7.7.2.  Input/Output Interface                             7-3
               7.8.  Contents of the Simple Program                       7-3
               7.9.  Contents of the Comprehensive Program                7-4
               7.10.  Error Messages                                      7-4
               7.11.  Informative Messages                                7-5
0          8.  CDC 6000/7000 Using NOS or SCOPE                           8-1
               8.1.  System Dependent Information from Commands           8-1
               8.2.  Default Values for File Unit Numbers                 8-1
               8.3.  Information Provided by the Environment              8-1
               8.4.  Interpretation of Option Letters                     8-1
               8.5.  Special Commands                                     8-1
               8.6.  Interface to NOS or SCOPE                            8-3
               8.6.1.  Job Control Statements for NOS                     8-3
               8.6.2.  Job Control Statements for SCOPE                   8-3
               8.6.3.  Program Statement                                  8-4
               8.6.4.  Input/Output Interface                             8-4
               8.7.  Contents of the Simple Program                       8-5
               8.8.  Contents of the Comprehensive Program                8-5
               8.9.  Error Messages                                       8-5
0          9.  DEC PDP-10 using TOPS 10                                   9-1
               9.1.  System Dependent Information from Commands           9-1
               9.2.  Default Values for File Unit Numbers                 9-1
               9.3.  Information Provided by the Environment              9-2
               9.4.  Interpretation of Option Letters                     9-2
               9.5.  Special Commands                                     9-2
 .
 .
                                           2
1
                                  Text Exchange System
 .
 .
                                   Table of contents
0              9.6.  Interface to TOPS-10                                 9-2
               9.6.1.  Job Control Statements for TOPS-10                 9-2
               9.6.2.  Input/Output Interface                             9-3
               9.6.3.  An Error in the Fortran Library                    9-3
               9.7.  Contents of the Simple Program                       9-4
               9.8.  Contents of the Comprehensive Program                9-4
               9.9.  Error Messages                                       9-4
               9.10.  Informative Messages                                9-5
0          10.  DEC PDP-11 using RSX-11M V3                              10-1
               10.1.  System Dependent Information from Commands         10-1
               10.2.  Default Values for File Unit Numbers               10-1
               10.3.  Information Provided by the Environment            10-1
               10.4.  Interpretation of Option Letters                   10-1
               10.5.  Special Commands                                   10-1
               10.6.  Interface to RSX-11M V3                            10-2
               10.6.1.  Job Control Statements for RSX-11M V3            10-2
               10.6.2.  Input/Output Interface                           10-2
               10.7.  Contents of the Simple Program                     10-3
               10.8.  Contents of the Comprehensive Program              10-3
               10.9.  Error Messages                                     10-3
               10.10.  Informative Messages                              10-4
0          11.  DEC VAX-11 using VMS                                     11-1
               11.1.  System Dependent Information from Commands         11-1
               11.2.  Default Values for File Unit Numbers               11-1
               11.3.  Information Provided by the Environment            11-2
               11.4.  Interpretation of Option Letters                   11-2
               11.5.  Special Commands                                   11-2
               11.6.  Interface to VMS                                   11-2
               11.6.1.  Job Control Statements for VMS                   11-3
               11.6.1.1.  Using the Simple Program                       11-3
               11.6.1.2.  Copying an Exchange Format Tape to a Disk Fil  11-3
               11.6.1.3.  Copying an Exchange Format Disk File to a Tap  11-4
               11.6.1.4.  Copying an Exchange Format Disk File to Anoth  11-4
               11.6.2.  Input/Output Interface                           11-4
               11.7.  Contents of the Simple Program                     11-5
               11.8.  Contents of the Comprehensive Program              11-5
               11.9.  Error Messages                                     11-5
0          12.  DEC VAX-11 using UNIX (TM)                               12-1
               12.1.  System Dependent Information from Commands         12-1
               12.2.  Default Values for File Unit Numbers               12-1
               12.3.  Information Provided by the Environment            12-2
               12.4.  Interpretation of Option Letters                   12-2
               12.5.  Special Commands                                   12-2
               12.6.  Interface to UNIX (TM)                             12-2
               12.6.1.  Job Control Statements for UNIX (TM)             12-3
 .
 .
                                           3
1
                                  Text Exchange System
 .
 .
                                   Table of contents
0              12.6.1.1.  Copying an Exchange Format Tape to a Disk Fil  12-3
               12.6.1.2.  Using the Simple Program                       12-3
               12.6.1.3.  Copying an Exchange Format Disk File to a Tap  12-4
               12.6.1.4.  Copying an Exchange Format Disk File to Anoth  12-4
               12.6.2.  Input/Output Interface                           12-4
               12.7.  Contents of the Simple Program                     12-5
               12.8.  Contents of the Comprehensive Program              12-5
               12.9.  Error Messages                                     12-5
0          13.  Data General MV/8000 using AOS/VS                        13-1
               13.1.  System Dependent Information from Commands         13-1
               13.2.  Default Values for File Unit Numbers               13-1
               13.3.  Information Provided by the Environment            13-2
               13.4.  Interpretation of Option Letters                   13-2
               13.5.  Special Commands                                   13-2
               13.6.  Interface to AOS/VS                                13-2
               13.6.1.  Job Control Statements for AOS/VS                13-3
               13.6.1.1.  Using the Simple Program                       13-3
               13.6.1.2.  Copying an Exchange Format Tape to a Disk Fil  13-3
               13.6.1.3.  Copying an Exchange Format Disk File to a Tap  13-3
               13.6.1.4.  Copying an Exchange Format Disk File to Anoth  13-4
               13.6.2.  Input/Output Interface                           13-4
               13.7.  Contents of the Simple Program                     13-4
               13.8.  Contents of the Comprehensive Program              13-5
               13.9.  Error Messages                                     13-5
0          14.  Sperry Univac (ex Varian) V-70 using VORTEX              14-1
               14.1.  System Dependent Information from Commands         14-1
               14.2.  Default Values for File Unit Numbers               14-1
               14.3.  Information Provided by the Environment            14-1
               14.4.  Interpretation of Option Letters                   14-2
               14.5.  Special Commands                                   14-2
               14.6.  Interface to VORTEX                                14-2
               14.6.1.  Job Control Language Statements for VORTEX       14-2
               14.6.2.  Input/Output Interface                           14-3
               14.6.3.  Restrictions                                     14-3
               14.7.  Contents of the Simple Program                     14-3
               14.8.  Contents of the Comprehensive Program              14-3
               14.9.  Error Messages                                     14-4
               14.10.  Informative Messages                              14-4
0          15.  References                                               15-1
0
0
0
 .
 .
                                           4
1
                                  Text Exchange System
 .
 .
                                         Index
0
           Block Data in the Comprehensive Program        2.4.            2-9
           Block Data in the Simple Program               2.4.            2-8
0          CDC 6000/7000 NOS Control Statements sample    8.6.            8-3
           CDC 6000/7000 SCOPE Control Statements sample  8.6.            8-4
           Character Packing in the Comprehensive Program 2.3.            2-5
           Character Unpacking in Both Exchange Programs  2.3.            2-5
           Conversion of Character Codes for Output       2.5.           2-13
0          Data General MV/8000 AOS/VS Job Control Samples13.6.          13-3
           DEC PDP-10 JCL sample                          9.6.            9-2
           DEC PDP-11 RSX-11M Control Statements sample   10.6.          10-2
           DEC VAX/UNIX (TM) Job Control Samples          12.6.          12-3
           DEC VAX/VMS Job Control Samples                11.6.          11-3
           Distribution Tape                              3.1.            3-1
0          Error Messages, CDC 6000/7000 versions         8.9.            8-5
           Error Messages, Data General MV/8000 using AOS/13.9.          13-5
           Error Messages, DEC PDP-10 versions            9.9.            9-4
           Error Messages, DEC PDP-11 versions            10.9.          10-3
           Error Messages, DEC VAX-11 using UNIX (TM) vers12.9.          12-5
           Error Messages, DEC VAX-11 using VMS versions  11.9.          11-5
           Error Messages, IBM System/360 versions        6.10.           6-3
           Error Messages, Simple Program                 4.3.            4-3
           Error Messages, Sperry Univac V-70 versions    14.9.          14-4
           Error Messages, Univac-1100 versions           7.10.           7-4
           Ex R.0.1 Simple read of EXCH tape, IBM 360/370 5.1.            5-1
           Ex R.0.2 Simple read of EXCH tape, CDC 6/7000  5.2.            5-1
           Ex R.0.3 Simple read of EXCH tape, UNIVAC 1100 5.3.            5-1
           Ex R.0.4 Simple read with include, IBM 360/370 5.4.            5-2
           EXCH Specification                             2.3.            2-3
           EXCHAH Specification                           2.5.           2-13
           EXCHBD Specification                           2.4.            2-9
           EXCHBX Specification                           2.4.            2-8
           EXCHCG Specification                           2.5.           2-15
           EXCHCX Specification                           2.5.           2-13
           EXCHFO Specification                           2.4.            2-9
           EXCHIM Specification                           2.4.           2-10
           EXCHOU Specification                           2.4.           2-11
           EXCHPA Specification                           2.3.            2-5
           EXCHRT Specification                           2.3.            2-6
           EXCHSL Specification                           2.4.           2-12
           EXCHTR Modification                            2.4.           2-12
           EXCHUN Specification                           2.3.            2-5
           EXCHWT Specification                           2.3.            2-7
           Extra Commands in the Comprehensive Program    2.5.           2-13
0.
 .
                                           1
1
                                  Text Exchange System
 .
 .
                                         Index
0          IBM System/360 JCL sample                      6.7.            6-2
           Informative Messages, Simple Program           4.3.            4-4
           Interface to the Comprehensive Program         2.3.            2-3
           Internal Representation of Characters          2.1.            2-1
0          Main Program Unit                              2.3.            2-2
0          Opening and Closing Native Format Files        2.4.            2-9
0          Processing of System Dependent Information     2.5.           2-14
0          Reading Exchange Tapes                         2.3.            2-6
           Reading Native Format Files                    2.4.           2-10
0          Segmentation of the Comprehensive Program      2.4.           2-12
           Sperry Univac V-70 VORTEX JCL sample           14.6.          14-2
           System Dependent Command Processing            2.5.           2-13
           System Dependent Information from Commands     2.2.            2-1
           System Dependent Use of Control Records        2.5.           2-15
0          Univac 1100 Executive Control sample           7.7.            7-2
0          Varian V-70 VORTEX JCL sample                  14.6.          14-2
0          Writing Exchange Tapes                         2.3.            2-7
           Writing Native Format Files                    2.4.           2-11
0
0
0
0
0
0
0
0
0
0
0
 .
 .
                                           2
1
=TES FILE=18
1
0.
 .
0
0
0
0
0                                 Text Exchange System
0                                 Program Descriptions
0
0                                     Section 366
                                        1846-110
0
0
0                                  September 22, 1981
0
0
0
                                     W. V. Snyder *
                               Jet Propulsion Laboratory
                                   Pasadena, CA 91109
0
                                    R. J. Hanson **
                              Sandia National Laboratories
                                 Albuquerque, NM 87185
0
0
0
0
                           California Institute of Technology
                               Jet Propulsion Laboratory
                                  4800 Oak Grove Drive
                                   Pasadena, CA 91109
0.
 .
1
0.
 .
0
0
0
0
0
0
                *  This  work represents the results of one phase of research
                   carried out at the Jet Propulsion  Laboratory,  California
                   Institute  of  Technology,  under  Contract No. NAS 7-100,
                   sponsored  by   the   National   Aeronautics   and   Space
                   Administration.
0
0               ** Work  performed  under  the  auspices  of  Sandia National
                   Laboratories, Albuquerque, New Mexico 87185 for the United
                   States Department of Energy under Contract AT(29-1)-789.
0
0
0
0
0
0
0
0
0
0
0
0
0
0.
 .
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          1.  Abstract
0
                The Text Exchange System (TES) provides a method to  exchange
           and  maintain  organized  information.  The system consists of the
           definition of a format for information storage  and  two  computer
           programs.   A  comprehensive  program is used to create, read, and
           maintain TES files.  To allow the TES to be distributed on a  tape
           in  the TES format, a much smaller program capable only of reading
           magnetic tape is also available.   The  programs  are  written  in
           Fortran   and   designed   for   portability,   but  a  few  small
           machine-dependent modules, available  for  several  machines,  are
           required.    Although  the  comprehensive  program  recognizes  35
           commands, information may be read from a TES format file by  using
           as  few as three commands.  In addition to its use for information
           exhange on magnetic tape, we expect the system to be  helpful  for
           maintaining libraries of text.
                This document describes the tape format and the  programs  of
           the  TES.   It is assumed that the reader is familiar with [1] and
           [2].
0
0
0
0
0
0
0
0
0
0
0
0
0
0
 .
 .
                                          1-1
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          2.  Tape Format
0
           The tape format does not depend on the number  of  tracks  on  the
           tape.   Information  is  recorded  by  the tape exchange system in
           blocks containing a multiple of 180  characters,  each  containing
           eight  bits.   Blocks of this size exactly fill an integral number
           of computer words if the word size is 8, 12, 16, 24, 30,  32,  36,
           48  or 60 bits.  Character information is recorded using the ASCII
           code [3].  Numeric information is recorded as eight or sixteen bit
           unsigned  binary  integers.  Since numeric information may contain
           enough zero bits to cause a frame of  the  tape  to  contain  only
           zeros,  tapes  produced  by  the  exchange program must be written
           using odd parity.  (A frame of all zeros is used by tape transport
           hardware  to  mark the end of the block.)  Two kinds of blocks are
           written on the tape.  The first is a label giving some information
           about the tape.  The others contain text modules.
0
           2.1.  Tape Label Format
0
           The  first  block of each file of an exchange tape is a label that
           identifies the file and provides information about where and  when
           it was written.
           Characters   Content of field
            1-8         The word 'EXCHANGE' to verify that  the  block  is  a
                        label.
            9-10        A  16  bit  number  specifying  the  number  of  data
                        characters per block, called NDC below.
            11-12       A 16  bit  number  specifying  the  number  of  error
                        correction characters per block, called NEC below.
            13-18       The date the tape was written (yymmdd in ASCII).
            19-58       The title.
            59-64       The date the tape  was  created  from  native  format
                        information (yymmdd in ASCII).
            65-104      The site at which the tape was  created  from  native
                        format information.
            105-110     The date  the  last  insertion  or  update  was  made
                        (yymmdd in ASCII).
            111-150     The site where the last insertion or update was made.
            151-180     Not used.
0
0
0
 .
 .
                                          2-1
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          2.2.  Data Block Format
0
           To improve storage efficiency on tape and reduce processing  time,
           data  is stored in large blocks.  The block size is nominally 3600
           characters, but may easily  be  changed.   The  programs  use  the
           numbers NDC and NEC stored in the label to compute the block size.
           The block size should not be made  greater  than  3600  characters
           because  CDC  systems  using  SCOPE require local modifications to
           read blocks of more than 511 words.
0          Each block is divided into  three  segments.   The  first  segment
           contains  NEC  characters that may be used for error detection and
           correction information [4].  The portable parts  of  the  programs
           neither  examine  nor  change  this  segment.   The second segment
           contains  nine  characters  of  structure  information.   In   the
           description  below, character positions are relative to the end of
           the error correction segment.
           Characters   Content of field
            1-2         A 16 bit block sequence number.
            3           An ASCII L (76) if the block is the last block  of  a
                        file, or zero if the block is not the last block.
            4-5         A 16 bit number indicating  the  position  (including
                        the structure segment but excluding the error control
                        segment) of the first text module name record in  the
                        block  (see  below), or zero if no text modules begin
                        in the block.
            6-7         A  16 bit number giving the text module number of the
                        first complete record in the block.
            8-9         A  16  bit  number  indicating  the  position (as for
                        characters 4 and  5  above)  of  the  first  complete
                        record in the block.
           The  third  segment  contains  no more than NDC characters of text
           records and control records.
0
           2.3.  Text Record Format
0
           Redundant characters of text records are removed to conserve space
           on  tape.   The  format  of  text  records  allows these redundant
           characters  to  be  recovered.   Text  records  are  divided  into
           sequences of significant characters containing no sequences of two
           or more consecutive occurrences of the redundant  character.   The
           first character of a text record is an eight bit number indicating
           the number of such groups of data.  A record  that  contains  only
           redundant  characters  will  have  one  such  group  of data.  The
           precise  format  of  a  text  record  is  best  described   by   a
 .
 .
                                          2-2
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          hypothetical program to replace the removed characters.  We assume
           that 'INPUT' fetches  one  eight  bit  character  from  the  input
           stream,  and 'OUTPUT' stores one eight bit character in the output
           stream.
0          INPUT NG, the number of text groups
           FOR G = 1 to NG
             INPUT NR, the number of removed characters
             INPUT NS, the number of significant characters
             IF (NR > 0) THEN
               FOR R = 1 to NR
                 OUTPUT removed character
               END FOR
             END IF
             IF (NS > 0) THEN
               FOR S = 1 to NS
                 INPUT significant character
                 OUTPUT significant character
               END FOR
             END IF
           END FOR
0
0          2.4.  Control Record Format
0
           Control  records are distinguished from text records by having the
           group count described above equal zero or 255.  If the group count
           is  255  the record consists only of the group count character and
           indicates the end of a block.  If the  group  count  is  zero  the
           second  character  of  the  record  is  an upper case ASCII letter
           identifying the control record type.
           Letter       Control Record Type
             A          Author.
             B          Bibliographic reference.
             C          Comment.
             D          Data type.
             E          End of file.
             G          Groups of which the module is a member.
             I          Request to include text from alternate source.
             J          Character used  to  signal  end  of  text  or  update
                        instructions.
             K          Keywords.
             M          Machine type.
             O          Date and site where the text  module  was  originally
                        written.
             P          Text module name (program name).
 .
 .
                                          2-3
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0            R          Character removed to compress the text.
             S          Date and site where the text module was updated.
             Other      Text having user defined meaning.
           Control  record  type  E  contains  no other text.  Control record
           types J  and  R  contain  one  additional  character.   The  third
           character  of  control record types other than E, J, P and R is an
           eight bit number giving the number of characters of  text  in  the
           record.  The format of control record type P is shown below.
           Characters   Content of field
            1           Zero (indicating a control record).
            2           Upper case ASCII P (80).
            3-4         A 16 bit number indicating  the  position  (including
                        the   structure   segment  but  excluding  the  error
                        correction segment) of  the  next  text  module  name
                        record  that  begins in the same block, or zero if no
                        further text modules begin in the same block.
            5-6         A 16 bit text module number.
            7           An eight bit number giving the number  of  characters
                        of text of the name of the module.
            8-end       The name of the text module.
0
           2.5.  Text Module Format
0
           Text modules consist of text and related control records.  Control
           records associated with the text module, other than control record
           type  I,  precede  the module.  The module name record (type P) is
           always the first control record.  The exchange programs,  however,
           assume  that  any  control record other than type I or the control
           record identified by a group count of 255 defines  the  end  of  a
           module.
0
0
0
0
0
0
0
0
 .
 .
                                          2-4
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          3.  Program Description
0
0
           3.1.  Common Blocks Used by the Portable Subprograms
0
           Most of the communication  between  subprograms  of  the  exchange
           programs uses named COMMON blocks.
0
           3.1.1.  Named COMMON /EXCHIC/
0
           The  named COMMON block /EXCHIC/ is used for communication related
           to reading exchange tapes.   The  declarations  for  /EXCHIC/  are
           contained in the blocks of text identified by '-I EXCHIC/TYPE' and
           '-I EXCHIC/COMMON' in the text module identified on  the  exchange
           program distribution tape as DECLARATIONS.
0           INTEGER NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,NWCBI,
           1        NCCBI,CPCBI,CBLCKI(180),CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
           2        ITYPEI,MODEI,REMVI,LABELI(180),INTREC(180)
            COMMON /EXCHIC/ NDATAI,NERRCI,BLKSQI,LASTI,L1PRGI,N1RECI,L1RECI,
           1       NWCBI,NCCBI,CPCBI,CBLCKI,CCDBI,CWDBI,NCDBI,NCHMAX,NCHACT,
           2       ITYPEI,MODEI,REMVI,LABELI,INTREC
0          The use of each variable is described below.
0          NDATAI = Maximum number of data characters per block.
           NERRCI = Number of error correction characters per block.
           BLKSQI = Sequence number of the last block read.
           LASTI  = ASCII L (76) if the last block read was the last block of
            a file.
           L1PRGI  =  Location  of  the  next  text module name record in the
            current block, or zero if no further text modules  begin  in  the
            current block.
           N1RECI = Text module number of the first complete  record  in  the
            current block.
           L1RECI = Location of the first  complete  record  in  the  current
            block.
           NWCBI = Number of Fortran type INTEGER  words  occupied  by  NCCBI
            characters.
           NCCBI = Number of characters to unpack at one time.
           CPCBI = Current position in CBLCKI.
           CBLCKI = Character block (unpacked characters).
           CCDBI = Current character position in the input tape buffer.
 .
 .
                                          3-1
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          CWDBI = Current word position in the input tape buffer.
           NCDBI  =  Number  of characters placed in the input tape buffer by
            the last read operation.
           NCHACT  =  Size  in  characters of the last record provided to the
            user.
           NCHMAX = Maximum size record that can be passed to the user.
           ITYPEI = Type of record passed to the  user:  zero  means  a  text
            record,  non-zero  is  the  upper case ASCII letter identifying a
            control record.
           MODEI  =  Zero  if  the  user  wants  characters removed from text
            records replaced, non-zero if the  user  wants  text  records  in
            compressed form.  (Control records are not compressed).
           REMVI =  Character  removed  to  compress  the  text,  and  to  be
            re-inserted  to  recover  the original text.  REMVI is changed to
            blank (32) while processing the module name record (type P).
           LABELI = Label read from the input tape.
           INTREC = A record read from the input tape.  Not all records  read
            from the input tape are stored in INTREC.
0
           3.1.2.  Named COMMON /EXCHOC/
0
           The named COMMON block /EXCHOC/ is used for communication  related
           to  writing  exchange  tapes.   The  declarations for /EXCHOC/ are
           contained in the blocks of text identified by '-I EXCHOC/TYPE' and
           '-I  EXCHOC/COMMON'  in the text module identified on the exchange
           program distribution tape as DECLARATIONS.
0           INTEGER BLKSQO,CBLCKO(180),CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,LLPRGO,
           1        L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,NLRECO,
           2        NWCBO,N1RECO,OUTREC(180),OUTUPD,REMVO
            COMMON /EXCHOC/ BLKSQO,CBLCKO,CCDBO,CPCBO,CWDBO,ITYPEO,LASTO,
           1       LLPRGO,L1PRGO,L1RECO,MODEO,NCCBO,NCHOUT,NDATAO,NERRCO,
           2       NLRECO,NWCBO,N1RECO,OUTREC,OUTUPD,REMVO
0          The use of each variable is described below.
0          BLKSQO = Sequence number of the last block written.
           CBLCKO = Character block (unpacked characters).
           CCDBO = Current character position in the output tape buffer.
           CPCBO = Current position in CBLCKO.
           CWDBO = Current word position in the output tape buffer.
           ITYPEO = Type of record to be written on  the  output  tape:  zero
            means  a  text  record,  non-zero  is the upper case ASCII letter
            identifying a control record.
           LASTO  = ASCII L (76) if the block to be written is the last block
            of a file.
 .
 .
                                          3-2
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          LLPRGO  =  Location  of  the  last  text module name record in the
            current block, or zero if there are no previous text module  name
            records in the current block.
           L1PRGO = Location of the first module name record in  the  current
            block, or zero if no modules begin in the current block.
           L1RECO = Location of the first complete record in the block.
           MODEO  =  Zero  if  the  record  is  to  be compressed by having a
            specified character removed,  non-zero  if  the  compression  has
            already  been  performed.  In the latter case, a text record must
            be in the format described in section 2.3.
           NCCBO = Number of characters to pack at one time.
           NCHOUT = Number of characters in a record to  be  written  on  the
            output tape.
           NDATAO = Number of data characters per block.
           NERRCO = Number of error correction characters per block.
           NLRECO = Module number of the last record started in  the  current
            block.
           NWCBO = Number of Fortran type INTEGER  words  occupied  by  NCCBI
            characters.
           N1RECO = Module number of the first complete record that begins in
            the current block.
           OUTREC = A record to be written on the output tape.  A record that
            is not stored in OUTREC may also be written on the output tape.
           OUTUPD = Zero if the U modifier of  the  OUTAPE  command  was  not
            selected,  ASCII  U  (85) if the U modifier of the OUTAPE command
            was selected.
           REMVO  =  Character  to  remove  to  compress  the text.  REMVO is
            changed to blank (32) while processing  the  module  name  record
            (type P).
0
           3.1.3.  Named COMMON /EXCHPC/
0
           The named COMMON block /EXCHPC/ is used for communication  related
           to   processing  commands.   The  declarations  for  /EXCHPC/  are
           contained in blocks of text identified by  '-I  EXCHPC/TYPE',  '-I
           EXCHPC/COMMON/  and  '-I  EXCHPC/EQUIVALENCE'  in  the text module
           identified  on  the  exchange   program   distribution   tape   as
           DECLARATIONS.
0           INTEGER ACTION,CHAR1L,COMAND(180),COMD(4,40),EQUAL,HOLCMD(180),
           1        ICOMD,IDCUR,IDOPTN,IDNBRS(4),IDTEXT(40),IDTXTL,INDEX,
           2        INDEXS(26),INTOPN,LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,
           3        N,NCOMDP,NCOMDT,NERRG,NERRS,NRWORK,NUMBER,OPTVAL(26),
           4        OUTOPN,PHASE,PRED(42,8),SIGNAL,SITE(40),TITLE(40),
           5        TODAY(6),TRANS,VERT
            INTEGER IDCOL1,IDCOL2,IDSTEP,IDSTRT
 .
 .
                                          3-3
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0           INTEGER OPTA,OPTC,OPTE,OPTI,OPTL,OPTS,OPTV
            COMMON /EXCHPC/ ACTION,CHAR1L,COMAND,COMD,EQUAL,HOLCMD,ICOMD,
           1       IDCUR,IDOPTN,IDNBRS,IDTEXT,IDTXTL,INDEX,INDEXS,INTOPN,
           2       LIMIT,LINEO,MARGIN,MODIFY,NCHCMD,NCOMDP,NCOMDT,NERRG,
           3       NERRS,NRWORK,NUMBER,OPTVAL,OUTOPN,PHASE,PRED,SIGNAL,SITE,
           4       TITLE,TODAY,TRANS,VERT
            EQUIVALENCE (IDNBRS(1),IDCOL1),(IDNBRS(2),IDCOL2)
            EQUIVALENCE (IDNBRS(3),IDSTEP),(IDNBRS(4),IDSTRT)
            EQUIVALENCE (OPTVAL(1),OPTA),(OPTVAL(3),OPTC),(OPTVAL(5),OPTE)
            EQUIVALENCE (OPTVAL(9),OPTI),(OPTVAL(12),OPTL),(OPTVAL(19),OPTS)
            EQUIVALENCE (OPTVAL(22),OPTV)
           The use of each variable is described below.
0          ACTION = Used for communication with the machine sensitive modules
            EXCHIM and EXCHOU.  Consult [2].
           CHAR1L  =  Indicates  the first character of a printed line.  Used
            between modules to determine  whether  a  page  eject  is  needed
            before  printing  the  index.   Used  while  printing  modules to
            determine whether to print an asterisk, plus sign, or minus  sign
            after the line sequence number.
           COMAND = A line of text  read  from  the  source  defined  by  the
            READER, INPUT FILE, TEXT or INCLUDE FILE command.  The characters
            of the line are stored in COMAND using one  character  per  word,
            right justified, zero filled.
           COMD = Commands recognized by EXCHC1.
           EQUAL  =  Position  in  COMAND  of  the  beginning  of  a  command
            parameter.  If there is no equal sign in  the  command  EQUAL  is
            zero.   If  there  is  an  equal  sign but no parameter EQUAL and
            NCHCMD are both the position of the  first  character  after  the
            equal  sign, which has been changed to a blank.  While processing
            system dependent information from commands EQUAL is the  position
            of  the  first  non-blank  after  the  first blank after the unit
            number, or is greater than NCHCMD if there is no system dependent
            information.   EQUAL  is  also  used  to  transmit  error  status
            information to EXCHC8.
           HOLCMD  =  Hollerith  equivalent  of  the  information  in  COMAND
            (Suitable for printing using FORMAT (120A1).)
           ICOMD  =  Command index.  If a command has been found by EXCHC1 in
            COMD ICOMD is the location of the command in COMD.  If a  control
            record  change  request  has  been  recognized by EXCHC1 ICOMD is
            zero.  ICOMD  is  also  used  to  control  communication  between
            EXCHC4,  EXCHC5  and  EXCHC6:  while processing a COPY command of
            the first form ICOMD is -1; while processing a  COPY  command  of
            the second form ICOMD is -2.
           IDCUR = Current value of  the  sequence  number  to  produce  when
            identifying  output  using  the  IDENT  command  with  the C or F
            modifiers.  IDCUR is changed to zero when processing of the  text
            of a module begins if IDOPTN is not equal C (67).
 .
 .
                                          3-4
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          IDOPTN = Modifier from the IDENT command.
           IDNBRS = Four numbers from the IDENT command.
           IDTEXT = Text from the IDENT command.
           IDTXTL = Number of characters stored in IDTEXT.
           INDEX = IABS(INDEX) is the sum of elements of INDEXS.  If INDEX  <
            zero the L modifier of the INDEX command was selected.
           INDEXS = A vector indicating  which  control  records  are  to  be
            printed  in the index.  An element having zero value means do not
            print a control record.  An element having value one means  print
            a control record.  INDEXS(1) is used for control record A, etc.
           INTOPN = Zero if INTAPE has not been opened,  one  if  INTAPE  has
            been opened.
           LIMIT = Number specified by the LIMIT command.
           LINEO  =  Line  number  of text module being produced by insert or
            update.
           MARGIN  =  The  column  number  of the last column to examine when
            interpreting commands.  This is given the value  180  in  EXCHBD,
            but  may  be  changed by the MARGIN command or by machine or site
            dependent  code.   In  particular,  the  IBM  System/360  version
            changes MARGIN to 72 in EXCH.
           MODIFY = Modifier character of the current comand.
           NCHCMD  = Number of characters in the current command, or -1 if an
            end of file was detected in a native format data source.
           NCOMDP  = Number of commands that may be processed by the portable
            parts of the program.
           NCOMDT = Total number of commands stored in COMD.  NCOMDT must not
            be less than NCOMDP.  Consult the specification of EXCHCX in [2].
           NERRG = Maximum error severity.
           NERRS  =  Maximum  error  severity  encountered   while   copying,
            inserting or updating the current text module.
           NRWORK = Between modules, or while examining the  control  records
            of a module during the processing of a COPY command of the second
            form, NRWORK is the number of control records stored on the  file
            defined by the WORK FILE command (or the appropriate default unit
            number).  While printing the index NRWORK is the ordinal position
            in the current text module of the control record being processed.
           NUMBER = A number  from  the  beginning  of  the  parameter  of  a
            command.   NUMBER  is  also  used  to  transmit the error message
            number to EXCHC8.
           OPTVAL  = A vector of option values.  An element having zero value
            indicates the option has not been selected.   An  element  having
            value  one  indicates the option has been selected.  OPTVAL(1) is
            for the A option, etc.
           OUTOPN = Zero if the output exchange tape has not been opened, one
            if it has been opened.
           PHASE  =  Processing  phase:   1  during initialization, 2 between
            modules, 4 while inserting a module, 8 while updating a module.
           PRED  =  Information  stored by PREDICATE commands.  PRED(1..42,I)
 .
 .
                                          3-5
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0           stores information for  logical  variable  A  if  I  is  1,  etc.
            PRED(1,*)-3  is the length of the search string, PRED(2,*) is the
            truth value computed by EXCHC4 while examining  control  records,
            PRED(3,*)  is  the  record  type  to which the predicate applies,
            PRED(4,*) is A (65) if the predicate  is  true  when  the  search
            string  is  found  anywhere  in a control record or X (88) if the
            predicate is true only when the search string  is  found  in  the
            specified   position,   PRED(5,*)  is  the  mask  character,  and
            PRED(6..42,*) is the search string.
           SIGNAL  = Character that indicates an update instruction (PHASE=8)
            or the end of text (PHASE=4 or  PHASE=8).   May  be  input  by  a
            SIGNAL  command or by the sequence -=* in a text module or update
            instruction sequence where - is the current value of SIGNAL and *
            is  the  new  value.   SIGNAL  is changed to - while processing a
            module name record (type P).
           SITE = String stored by the SITE command.
           TODAY = Date stored by the DATE command (yymmdd).
           TRANS  =  Indicates  to  EXCHTR  which  of  EXCHC1-EXCHC9 to call.
            TRANS=1 means call EXCHC1, etc.   TRANS=0  means  return  to  the
            machine sensitive interface subprogram EXCH.
           VERT = Zero if the A option was not selected or a  data  (type  D)
            control record having the first 4 characters equal 'LIST' was not
            found, one if the A option was  selected  and  a  data  (type  D)
            control  record  having  the  first 4 characters equal 'LIST' was
            found.  Used to control printing using  the  first  character  of
            text images for vertical format control.
0
           3.1.4.  Named COMMON /EXCHUC/
0
           The  named  COMMON  block  /EXCHUC/  contains  Fortran  file  unit
           numbers.  The declarations for /EXCHUC/ are contained in blocks of
           text identified by '-I EXCHUC/TYPE' and '-I EXCHUC/COMMON' in  the
           text  module  identified on the exchange program distribution tape
           as DECLARATIONS.
0           INTEGER INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,INALT,
           1        WORKF
            COMMON /EXCHUC/ INTAPE,OUTAPE,INFILE,OUFILE,PRINTR,READER,INTEXT,
           1       INALT,WORKF
0          The use of each variable is described below.
0          INTAPE = Unit number for the input exchange tape.
           OUTAPE = Unit number for the output exchange tape.
           INFILE = Unit number defined by the INPUT FILE command.
           OUFILE = Unit number defined by the OUTPUT FILE command.
 .
 .
                                          3-6
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          PRINTR  =  Unit  number for printed output, defined by the PRINTER
            command.
           READER  =  Unit  number  for  native  format input, defined by the
            READER command.
           INTEXT = Unit number defined by the TEXT command.
           INALT = Unit number defined by the INCLUDE FILE command.  INALT is
            negative  except  while processing a request to include text from
            the file defined by IABS(INALT).
           WORKF  =  Unit  number  of the work file, defined by the WORK FILE
            command.
0
           3.1.5.  Named COMMON /EXCHXC/
0
           The named COMMON block /EXCHXC/ contains a table to translate from
           ASCII character code to Hollerith code.  It may not be  needed  in
           some versions of the exchange programs.
0          INTEGER XLATE(128)
           COMMON /EXCHXC/ XLATE
0          XLATE  =  Table  to  translate  from ASCII to Hollerith.  XLATE is
            subscripted using 1 plus the ASCII code of the  character  to  be
            translated.   The  value  of the elements of XLATE is supplied by
            BLOCK DATA subprograms.
0
           3.2.  Common Blocks Used by Machine Sensitive Versions
0
0
           3.2.1.  Common Blocks Used by Univac-1100 Subprograms
0
0
           3.2.1.1.  Named COMMON /EXEC8/
0
           The  named  COMMON  block  /EXEC8/ is used by Univac-1100 specific
           subprograms of the  comprehensive  program  for  some  information
           relative to native format input and output.
0          INTEGER AFDFLG,WORKS(474,5)
           COMMON /EXEC8/ AFDFLG,WORKS
0.
 .
                                          3-7
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          AFDFLG = Zero if Fieldata character code is to be used for output,
            one if quarter word ASCII code is to be used for output.
           WORKS = work areas used for SDF input and output.  WORKS(1..474,1)
            is for input from the READER file.  WORKS(1..474,2) is for  input
            from  the INPUT file.  WORKS(1..474,3) is for input from the TEXT
            file.  WORKS(1..474,4)  is  for  input  from  the  INCLUDE  file.
            WORKS(1..474,5)  is  for the OUTPUT file.  The detailed format of
            WORKS(1..474,*) is defined in the modules EORSR and EORSW.
0
           3.2.1.2.  Named COMMON /EXEC8A/
0
           The named COMMON block /EXEC8A/ contains some information used for
           native format  input  and  output  and  for  reading  and  writing
           exchange format disk files.
0          INTEGER FILES(2,7),ELTS(2,7),VERS(2,7),PFS(12,2)
           COMMON /EXEC8A/ FILES,ELTS,VERS,PFS
0          FILES  =  File  names derived from unit numbers.  FILES(1..2,1) is
            for  the  READER.   FILES(1..2,2)  is   for   the   INPUT   file.
            FILES(1..2,3)  is  for  the  TEXT file.  FILES(1..2,4) is for the
            INCLUDE  file.    FILES(1..2,5)   is   for   the   OUTPUT   file.
            FILES(1..2,6) is for INTAPE.  FILES(1..2,7) is for OUTAPE.
           ELTS =  Element  names  from  system  dependent  information  from
            commands.   Columns  of ELTS are used as for FILES.  There are no
            commands in the simple program, so ELTS(1,6) is set  to  fieldata
            blanks in the main program, indicating that exchange format input
            does not come from a disk file OMNIBUS element.
           VERS  =  Version  names  from  system  dependent  information from
            commands.  Columns of VERS are used as for FILES.
           PFS  =  Program file search packets (See section 11.3.1.1 of [5]).
            PFS(1..12,1) is used when INTAPE refers to a  disk  file  OMNIBUS
            element.   PFS(1..12,2) is used when OUTAPE refers to a disk file
            OMNIBUS element.  While reading an OMNIBUS element, PFS(11,1)  is
            the  current  sector address, and PFS(10,1) is the sector address
            of the beginning  of  the  OMNIBUS  element.   While  writing  an
            omnibus  element,  PFS(10,2)  is  the current sector address, and
            PFS(11,2) is the sector address of the beginning of  the  OMNIBUS
            element.
0
           3.2.2.  Common Block Used by CDC 6000/7000 Subprograms
0
           The  named  COMMON  block  /CDCMDE/  contains   system   dependent
           information from commands.
 .
 .
                                          3-8
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          INTEGER CDCMDE
           COMMON /CDCMDE/ CDCMDE
0          CDCMDE is equal 1 when using 6BIT character conversion, and 2 when
           using  12/6  bit  character  conversion.  (See section 8.5 of [2])
           CDCMDE is set to 1 in the main program.
0
           3.2.3.  Common Block Used by DEC PDP-10 Subprograms
0
           The  named  COMMON  block  /EXCP10/  contains   system   dependent
           information from commands.
0          LOGICAL TABS
           DOUBLE PRECISION FNAMES(3)
           COMMON /EXCP10/ TABS,FNAMES
0          TABS = .TRUE. if ASCII  HT  characters  are  data  characters,  or
            .FALSE.  if ASCII HT characters are tabulation requests.  TABS is
            set by EXCH and EXCHCX, and examined by EXCHIM.
           FNAMES = File names derived from system dependent information from
            commands.  FNAMES(1) contains information from  the  most  recent
            READER,  INPUT  FILE,  TEXT, INCLUDE FILE or OUTPUT file command.
            FNAMES(2)  contains  information  from  the  most  recent  INTAPE
            command.   FNAMES(3)  contains  information  from the most recent
            OUTAPE command.
0
           3.2.4.  Common Block Used by DEC PDP-11 Subprograms
0
           The   named   COMMON  block  /EXCRSX/  contains  system  dependent
           information from commands.
0          LOGICAL TABS
           BYTE FNAMES(40,3)
           COMMON /EXCRSX/ TABS,FNAMES
0          TABS  =  .TRUE.  if  ASCII  HT  characters are data characters, or
            .FALSE.  if  ASCII  HT  characters  are   horizontal   tabulation
            requests.
           FNAMES = File names derived from system dependent information from
            commands.   FNAMES(1..40,1)  contains  information  from the most
            recent READER, INPUT FILE, TEXT,  INCLUDE  FILE  or  OUTPUT  FILE
            command.   FNAMES(1..40,2)  contains  information  from  the most
            recent INTAPE command.  FNAMES(1..40,3) contains information from
            the most recent OUTAPE command.
 .
 .
                                          3-9
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          3.2.5.  Common Block used by the DEC VAX/VMS Subprograms.
0
0
           3.2.5.1.  Named COMMON /EXCVAX/
0
           The named COMMON block /EXCVAX/ contains system dependent
           information from commands.
0          CHARACTER TABS
           CHARACTER*40 FNAMES(3)
           COMMON /EXCVAX/ TABS,FNAMES
0          TABS = 'Y' if ASCII HT characters are data characters, or  'N'  if
            ASCII  HT characters are horizontal tabulation requests.  TABS is
            set equal to 'Y' by a TABS=D or TABS=Y command, and is set  equal
            to  'N' by a TABS=T or TABS=N command.  The initial value is 'Y'.
           FNAMES = File names derived from system dependent information from
            commands.   FNAMES(1)  contains  information from the most recent
            READER, INPUT FILE, TEXT, INCLUDE FILE, or OUTPUT  FILE  command.
            FNAMES(2)  contains  information  from  the  most  recent  INTAPE
            command.  FNAMES(3) contains information  from  the  most  recent
            OUTAPE command.
0
           3.2.6.  Common Block used by Sperry V-70 Subprograms
0
           The   named   COMMON  block  /FNAMES/  contains  system  dependent
           information from commands.
0          INTEGER FNAMES(4,3)
           COMMON /FNAMES/ FNAMES
0          FNAMES(1..3,*)  =  File  names,  FNAMES(4,*)  =  Protection  keys.
            FNAMES(1..4,1)  contains information from the most recent READER,
            INPUT  FILE,  TEXT,  INCLUDE  FILE  or   OUTPUT   FILE   command.
            FNAMES(1..4,2)  contains  information from the most recent INTAPE
            command.   FNAMES(1..4,3)  contains  information  from  the  most
            recent OUTAPE command.
0
0
0
 .
 .
                                          3-10
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          3.3.  Program Structure
0
           This  section  describes  the  general  program  structures.   The
           detailed  structure of intermodule references and common block use
           depends on the machine sensitive modules.
0          Both exchange programs  use  a  common  main  program  unit.   The
           responsibilities  of  the  main program unit are described in [2].
           The main program calls a subprogram EXCH.
0
           3.3.1.  Structure of the Simple Program
0
           In the simple program, the subprogram EXCH is the main worker.  It
           is  identified  on  the  program distribution tape as EXCHSP.  The
           remainder of the portable parts of the  simple  program  are  also
           modules  of  the  comprehensive  program,  and  are  described  in
           sections 3.4 and 3.5, and [2].  The subprograms  that  are  called
           directly by EXCH in the simple program are EXCHAH, EXCHFO, EXCHGR,
           EXCHRH and EXCHRT.
0
           3.3.2.  Structure of the Comprehensive Program
0
           In the comprehensive program, the  subprogram  EXCH  is  simply  a
           machine  sensitive interface to the remainder of the program.  The
           responsibilities of EXCH are described in [2].  The  comprehensive
           program is designed to be executable in a small memory.  The major
           functions of the program are controlled by a command decoder.   If
           a  conventional  program  structure were used, the command decoder
           would call each of the subsidiary worker subprograms directly,  as
           needed.   But  the  command decoder is large, and not needed while
           subsidiary workers  are  performing  their  tasks.   By  using  an
           unorthodox  method  for  communication between the command decoder
           and the subsidiary workers, the subsidiary workers may share  main
           memory with the command decoder.
0          When  the  command  decoder  completes  analysis of a command, the
           necessary sequence of  execution  of  the  subsidiary  workers  is
           known.   The  first  step  in  this  sequence is remembered by the
           variable TRANS in the  named  COMMON  block  /EXCHPC/.   When  the
           interface  subprogram  EXCH enters the subprogram EXCHTR, TRANS is
           equal to 1, meaning that the command  decoder  is  to  be  called.
           When  the  command decoder returns to EXCHTR, TRANS has some other
           value.  If TRANS is zero,  EXCHTR  is  to  return.   If  TRANS  is
 .
 .
                                          3-11
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          non-zero, EXCHTR is to call EXCHCj, where j is the value of TRANS.
0          All information necessary for processing the commands is stored in
           named COMMON blocks.  This allows the subsidiary workers  and  the
           command  decoder  to  occupy  the  same  memory space at different
           times.  As the work of the subsidiary workers proceeds,  they  may
           pass  control  from  one to another by changing the value of TRANS
           and returning to EXCHTR.  When the task is complete, the value  of
           TRANS  is changed to 1 and the command decoder is re-entered.  The
           general responsibilities  of  each  subsidiary  worker  are  shown
           below.   The subsidiary workers are described in greater detail in
           section 3.4.
0          Subprogram   Responsibilities
             EXCHC1     Command decoder.
             EXCHC2     Process several simple commands.
             EXCHC3     Open INTAPE and OUTAPE.
             EXCHC4     Supervise SKIP and COPY commands.
             EXCHC5     Create or copy control records.
             EXCHC6     Copy text of modules.
             EXCHC7     Insert or update text.
             EXCHC8     Print error messages.
             EXCHC9     Process the QUIT command.
0          The  services of other subprograms are needed during processing by
           the above nine subprograms.  Some of the service  subprograms  are
           referenced  by  only  one  of the worker subprograms, and some are
           referenced by several workers.  When memory space  is  restricted,
           and  the  program  is therefore segmented, the service subprograms
           that are referenced by only one worker  are  placed  in  the  same
           segment  as  the  worker,  and  the  service  subprograms that are
           referenced by several workers are placed in the resident  segment.
           The  general  responsibilities of the portable service subprograms
           are described below.  The machine  sensitive  service  subprograms
           are described in [2].
0          Subprogram   Responsibilities
             EXCHGB     Get a block of data from an exchange tape.
             EXCHGR     Get a single record of data from an exchange tape.
             EXCHLX     Evaluate  the  logical  expression on a copy command.
                        Referenced only by EXCHC4.
             EXCHNP     Skip to the next module name record.
             EXCHPB     Put a block of data on an exchange tape.
             EXCHPR     Put a single record of data on an exchange tape.
             EXCHRH     Read the label from  an  exchange  tape.   Referenced
                        only by EXCHC3.
             EXCHSC     Scan text to perform compression.
             EXCHTP     Process text records for native format output.
 .
 .
                                          3-12
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0            EXCHTW     Write text records in native format and on printer.
             EXCHWH     Write a label onto an exchange tape.  Referenced only
                        by EXCHC3.
0
0          3.4.  Worker Subprograms
0
0
           3.4.1.  EXCHC1
0
           EXCHC1  performs  most  examination and decoding of commands.  The
           major functions of EXCHC1 are shown below.
           1.  Fetch input using EXCHIM.  Determine whether an  end  of  file
               was sensed in a machine dependent way.
           2.  Identify  requests  to  change   control   records,   transfer
               processing to EXCHC3 via EXCHTR.
           3.  Identify and process comment commands (Asterisk in column  1).
           4.  Find the command word.  Find the modifier.  Find the beginning
               of the parameter.
           5.  If the parameter is omitted, decide whether that is allowed.
           6.  Make sure the command is allowed during the current processing
               phase.
           7.  Perform preliminary  processing  of  the  parameter,  such  as
               converting  a number from a character string representation to
               internal integer representation.
           8.  Process  the  command.  Some commands are processed in EXCHC1.
               Call EXCHCX to perform machine dependent  processing  of  some
               commands.   Transfer  control  to another worker via EXCHTR if
               necessary.
0
           3.4.2.  EXCHC2
0
           EXCHC2  processes IDENTIFY OUTPUT, INDEX, OPTION, PREDICATE, SITE,
           and TITLE commands.  Processing of these  commands  involves  some
           format verification, and storing information in COMMON blocks.
0
           3.4.3.  EXCHC3
0
           EXCHC3  makes  sure  the  input  exchange  tape is open (the label
           processed) before allowing processing of  COPY,  SKIP,  or  UPDATE
 .
 .
                                          3-13
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          commands,  or  requests  to  change control records.  If the input
           exchange tape is defined when a NAME  command  is  processed,  the
           tape  is  opened.   If the output tape is defined, it is opened (a
           label written) if not already open before processing of COPY, NAME
           or  UPDATE  commands  proceeds.   The  information in the label is
           printed at the time a tape is opened.  Control is  transferred  to
           EXCHC4 via EXCHTR to continue processing of COPY or SKIP commands,
           or requests to change control records.  Control is transferred  to
           EXCHC5  via  EXCHTR  to  continue  processing  of  NAME and UPDATE
           commands.
0
           3.4.4.  EXCHC4
0
           EXCHC4 processes requests to  change  control  records,  the  SKIP
           command,   positions   the  input  exchange  tape  for  processing
           requested by a COPY command of  the  first  form,  and  determines
           which  modules are to be processed by a COPY command of the second
           form.  SKIP commands are processed by  calling  EXCHNP  until  the
           desired module has been skipped.
0          The  parameter  of  the  COPY  command is examined and transformed
           before processing continues.  After the format  of  the  parameter
           has  been  verified,  and  the information transformed to internal
           form, the value of ICOMD is changed to -1 for a  COPY  command  of
           the  first  form,  or to -2 for a COPY command of the second form.
           For a COPY command of the first form, the input exchange  tape  is
           positioned  before  the  control  records of the next module to be
           copied, and control is transferred to EXCHC5 via EXCHTR.
0          For a COPY command of the second  form,  the  control  records  of
           modules are examined and the truth of predicates determined.  When
           all control records have been examined, or all  active  predicates
           are true, the logical expression on the COPY command is evaluated.
           If the value of the expression and the command  modifier  indicate
           that  the module is to be copied, control is transferred to EXCHC5
           via  EXCHTR.   Otherwise,  the  next  module  is  examined.   This
           continues until the end of the input exchange tape is encountered,
           or the module number specified  by  the  LIMIT  command  has  been
           processed.   While  the  control  records  of  a  module are being
           examined, they are stored on the file defined by the WORK  command
           or  the  associated  default value.  The number of control records
           stored on the work file is stored in the variable  NRWORK  in  the
           named  COMMON  block  /EXCHPC/.  After the module has been copied,
           control returns to EXCHC4 from EXCHC6 via EXCHTR.   The  value  of
           ICOMD  determines  whether  the parameter is to be examined (ICOMD
           positive), or  a  COPY  command  is  already  in  progress  (ICOMD
 .
 .
                                          3-14
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          negative).
0
           3.4.5.  EXCHC5
0
           EXCHC5  is responsible for copying control records associated with
           modules to be copied as determined by EXCHC4, for copying  control
           records  when  an  UPDATE command changes the program operation to
           the fourth (update) phase, and for creating control  records  from
           information  contained  in  commands during the third (insert) and
           fourth phases of program  execution.   When  control  records  are
           being  copied,  any  control  records  on the work file are copied
           before control records on the input exchange tape are copied.   If
           a  NAME command is submitted when there are control records on the
           work file, the associated module is copied before the insert phase
           is  entered.   After  the control records associated with a module
           have been copied, control is transferred to EXCHC6 via  EXCHTR  to
           copy the text of a module selected by a COPY command, or to EXCHC7
           via EXCHTR to insert or update text during  the  third  of  fourth
           phases of program execution.
0
           3.4.6.  EXCHC6
0
           EXCHC6  copies  text of modules selected by COPY commands.  If the
           text of the module is not to be printed, not to be written on  the
           native  format output file, and an index is not to be printed, the
           boundaries between lines of text need not be recognized.  In  this
           case,  if the position of characters in computer words is the same
           for the input and output exchange tapes, the text  of  the  module
           may  remain  in  the internal representation of the host computer.
           This  method  of  copying  the  text,  called  a  block  copy,  is
           significantly  faster  than  copying  the  text one character at a
           time.  After the text is copied, control is transferred to  EXCHC4
           via  EXCHTR  if  ICOMD is not equal -3.  If ICOMD is equal -3, the
           last module requested by a COPY command of the  second  form  with
           the  I or X modifier has been copied, so control is transferred to
           EXCHC1 via EXCHTR.
0
           3.4.7.  EXCHC7
0
           EXCHC7 is responsible  for  inserting  text  of  new  modules  and
           updating  text  of existing modules.  If a request to include text
           from the file defined by the INCLUDE FILE command  is  encountered
 .
 .
                                          3-15
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          in  the  text  to  be inserted (during either the insert or update
           phase), a special control record (type I) is created.   After  the
           text is processed, control is transferred to EXCHC1 via EXCHTR.
0
           3.4.8.  EXCHC8
0
           EXCHC8 is responsible for printing most error messages.  The error
           message to be printed is determined by the value of  the  variable
           NUMBER  in  the  named COMMON block /EXCHPC/.  Some error messages
           contain numeric information.  Most such numeric information is the
           information  normally  stored  in variables in COMMON blocks.  But
           the  variable  that  indicates  the  status  of  an   input/output
           operation  is  a  local  variable.   The value of this variable is
           transfered to  the  variable  EQUAL  in  the  named  COMMON  block
           /EXCHPC/  before  EXCHC8  is entered.  After the error message has
           been printed, control is  transferred  to  EXCHC1  or  EXCHC9  via
           EXCHTR, depending on the message number.
0
           3.4.9.  EXCHC9
0
           EXCHC9 processes the QUIT command, QUIT commands implied by end of
           file marks sensed in machine dependent  ways,  and  QUIT  commands
           implied  by  the  occurrence  of catastrophic errors.  If the QUIT
           command is sensed in the file defined by the INPUT  FILE  command,
           the  file  is  closed (with rewind if the R modifier is selected),
           and control is transferred to EXCHC1  via  EXCHTR.   If  the  QUIT
           command  is encountered in the file defined by the READER command,
           all open files are  closed  and  control  is  transferred  to  the
           machine dependent interface subprogram EXCH via EXCHTR.
0
           3.5.  Service Subprograms
0
           The  responsibilities  of  the service subprograms EXCHAH, EXCHCG,
           EXCHCX, EXCHFO, EXCHIM, EXCHOU, EXCHPA,  EXCHRT,  EXCHSL,  EXCHUN,
           and  EXCHWT  are  described  in  [2].  There is some redundancy of
           responsibility of the  subprograms  EXCHCX,  EXCHFO,  EXCHIM,  and
           EXCHOU.   These subprograms are sufficiently simple, however, that
           minor machine dependent deviations  from  the  usual  division  of
           responsibility are immediately apparent.
0
0.
 .
                                          3-16
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          3.5.1.  EXCHGB
0
           EXCHGB  is responsible for fetching a block of data from the input
           exchange tape by calling EXCHRT.  When a  block  is  fetched,  the
           nine  characters of structural information in the beginning of the
           block are extracted and examined.  The block  sequence  number  is
           checked, and the variables L1PRGI, L1RECI, and N1RECI in the named
           COMMON block /EXCHIC/ are set.
0
           3.5.2.  EXCHGR
0
           EXCHGR is responsible for fetching a single record from the  input
           exchange  tape.   The  subprograms EXCHGB and EXCHUN are called if
           necessary.  If the record is a  control  record,  some  processing
           depending  on  the  control  record type is performed before it is
           passed to the user.  If the record is a text record, the  variable
           MODEI  in  the  named COMMON block /EXCHIC/ determines whether the
           record is returned to the caller in  compressed  form  or  in  the
           original form.
0
           3.5.3.  EXCHLX
0
           EXCHLX  evaluates  the logical expression on a COPY command of the
           second form.  The logical expression is first converted  to  early
           operator   reverse   Polish   notation  using  a  simple  operator
           precedence parser.  The Polish  representation  is  then  used  to
           evaluate   the   expression.   During  the  conversion  to  Polish
           notation, and during the evaluation of the expression,  the  array
           COMAND  in  the  named COMMON block /EXCHPC/ is used for temporary
           storage.  This does  not  normally  overlap  the  command  storage
           because  commands  are  short, and the scratch space starts at the
           last element of the array and expands into earlier elements.
0
           3.5.4.  EXCHNP
0
           EXCHNP is responsible for  positioning  the  input  exchange  tape
           before  the  next  module name record.  The variable L1PRGI in the
           named COMMON block /EXCHIC/ is used.  If it is zero, a  new  block
           is  fetched  by  calling EXCHGB.  If it is not zero, the character
           position from which to fetch the next character is changed to  the
           value  of L1PRGI.  The module name record must later be fetched by
 .
 .
                                          3-17
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          calling EXCHGR.
0
           3.5.5.  EXCHPB
0
           EXCHPB is used to put a block of data on the output exchange tape.
           The  nine characters of structural information are appended before
           the block is written on the output tape.  The block is written  by
           calling EXCHWT.
0
           3.5.6.  EXCHPR
0
           EXCHPR is used to put a single record on the output exchange tape.
           If the record is a control record, some  processing  dependent  on
           the  control  record  type  is performed.  If the record is a text
           record, the variable MODEO in  the  named  COMMON  block  /EXCHOC/
           indicates  whether the record is compressed or in its normal form.
           If the record is  not  compressed,  EXCHSC  is  called  to  locate
           sequences of redundant occurrences of the character to be removed.
           Data   are   converted   to   the   internal   machine   sensitive
           representation  as  necessary  by calling EXCHPA.  When a block is
           filled, EXCHPB is called.
0
           3.5.7.  EXCHRH
0
           EXCHRH reads the first block  from  the  input  exchange  tape  by
           calling  EXCHRT,  and makes sure it is a label.  If it is a label,
           the variables NDATAI and NERRCI in the named COMMON block /EXCHIC/
           are set to values specified in the label.
0
           3.5.8.  EXCHSC
0
           EXCHSC  scans  text  to  be written on the output exchange tape to
           detect sequences of redundant occurrences of the character  to  be
           removed  to  compress the text.  EXCHSC uses only calling sequence
           variables, and may  therefore  be  useful  in  other  applications
           without change.
0
0
 .
 .
                                          3-18
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          3.5.9.  EXCHTP
0
           EXCHTP  processes  text  before it is written on the native format
           output file or printed.   The  tasks  of  EXCHTP  are  to  replace
           requests  to  include  text from the file specified by the INCLUDE
           FILE command by the identified text, and to insert  identification
           requested by the IDENTIFY OUTPUT command.
0
           3.5.10.  EXCHTW
0
           EXCHTW decides whether a text image is to be written on the native
           format output file, and if so calls EXCHOU.  Then the  text  image
           is printed if the appropriate listing option is selected.
0
           3.5.11.  EXCHWH
0
           EXCHWH  writes  a  label  on  the  output exchange tape by calling
           EXCHWT.
0
0
0
0
0
0
0
0
0
0
0
0
0.
 .
                                          3-19
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          4.  Suggesting Changes to the TES
0
           Several  extensions  have  been  proposed  to  the  TES.   Changes
           affecting   the   use   of  the  program  are  discussed  in  [1].
           Suggestions for changes to the TES should be reported to:
0              W. V. Snyder
               Mail Stop 125-128
               Jet Propulsion Laboratory
               Pasadena, CA 91103
0              Telephone 213/354-6271, or FTS 792-6271.
0          * Split the common block  EXCHPC  into  several  pieces,  so  that
             common variables are accessible only in subprograms where access
             is necessary.
0          * Provide an internal option to produce native format  output  and
             fetch  native  format input using reverse communication with the
             machine specific main program.  This would  allow  the  exchange
             program to be used as a subroutine of another program.
0          * Require  the  machine  sensitive  main  program  to  inform  the
             portable subprograms of the amount of space  allocated  for  the
             input  tape buffer.  EXCHRH could then insure that data from the
             input exchange tape is not placed outside the allocated space by
             examining  this  number and the numbers NDATAI, NERRCI and NWCBI
             after reading a label.
0
0
0
0
0
0
0
0
0
0.
 .
                                          4-1
1
                                  Text Exchange System
 .
 .
                                  Program Descriptions
0          5.  References
0
           1.  W. V. Snyder and  R.  J.  Hanson,  "Text  Exchange  System,  A
               Transportable  System  for Management and Exchange of Programs
               and Other Text," Jet Propulsion Laboratory  internal  document
               number 1846-108.
           2.  W.  V.  Snyder  and  R.  J.  Hanson,  "Text  Exchange  System,
               Installation  Instructions and Description of System Dependent
               Variants," Jet Propulsion Laboratory internal document  number
               1846-109.
           3.  "Code  for  Information  Interchange,"   Standard   X3.4-1977,
               American National Standards Institute, New York, 1977.
           4.  Robert McEliece,  "The  Theory  of  Information  and  Coding,"
               Addison-Wesley, 1977.
           5.  "Sperry Univac 1100 Executive  System  Programmer  Reference,"
               Sperry Univac document number UP-4144, Volume 3.
           6.  "VAX/VMS System Services Reference Manual," Digital  Equipment
               Corporation   document  number  AA-D018B-TE,  March  1980,  pp
               142-143.
0
0
0
0
0
0
0
0
0
0
0
0
0
0
 .
 .
                                          5-1
1
                                  Text Exchange System
 .
 .
                                   Table of contents
0
           1.  Abstract                                                   1-1
0          2.  Tape Format                                                2-1
               2.1.  Tape Label Format                                    2-1
               2.2.  Data Block Format                                    2-2
               2.3.  Text Record Format                                   2-2
               2.4.  Control Record Format                                2-3
               2.5.  Text Module Format                                   2-4
0          3.  Program Description                                        3-1
               3.1.  Common Blocks Used by the Portable Subprograms       3-1
               3.1.1.  Named COMMON /EXCHIC/                              3-1
               3.1.2.  Named COMMON /EXCHOC/                              3-2
               3.1.3.  Named COMMON /EXCHPC/                              3-3
               3.1.4.  Named COMMON /EXCHUC/                              3-6
               3.1.5.  Named COMMON /EXCHXC/                              3-7
               3.2.  Common Blocks Used by Machine Sensitive Versions     3-7
               3.2.1.  Common Blocks Used by Univac-1100 Subprograms      3-7
               3.2.1.1.  Named COMMON /EXEC8/                             3-7
               3.2.1.2.  Named COMMON /EXEC8A/                            3-8
               3.2.2.  Common Block Used by CDC 6000/7000 Subprograms     3-8
               3.2.3.  Common Block Used by DEC PDP-10 Subprograms        3-9
               3.2.4.  Common Block Used by DEC PDP-11 Subprograms        3-9
               3.2.5.  Common Block used by the DEC VAX/VMS Subprograms  3-10
               3.2.5.1.  Named COMMON /EXCVAX/                           3-10
               3.2.6.  Common Block used by Sperry V-70 Subprograms      3-10
               3.3.  Program Structure                                   3-11
               3.3.1.  Structure of the Simple Program                   3-11
               3.3.2.  Structure of the Comprehensive Program            3-11
               3.4.  Worker Subprograms                                  3-13
               3.4.1.  EXCHC1                                            3-13
               3.4.2.  EXCHC2                                            3-13
               3.4.3.  EXCHC3                                            3-13
               3.4.4.  EXCHC4                                            3-14
               3.4.5.  EXCHC5                                            3-15
               3.4.6.  EXCHC6                                            3-15
               3.4.7.  EXCHC7                                            3-15
               3.4.8.  EXCHC8                                            3-16
               3.4.9.  EXCHC9                                            3-16
               3.5.  Service Subprograms                                 3-16
               3.5.1.  EXCHGB                                            3-17
               3.5.2.  EXCHGR                                            3-17
               3.5.3.  EXCHLX                                            3-17
               3.5.4.  EXCHNP                                            3-17
               3.5.5.  EXCHPB                                            3-18
               3.5.6.  EXCHPR                                            3-18
               3.5.7.  EXCHRH                                            3-18
 .
 .
                                           1
1
                                  Text Exchange System
 .
 .
                                   Table of contents
0              3.5.8.  EXCHSC                                            3-18
               3.5.9.  EXCHTP                                            3-19
               3.5.10.  EXCHTW                                           3-19
               3.5.11.  EXCHWH                                           3-19
0          4.  Suggesting Changes to the TES                              4-1
0          5.  References                                                 5-1
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
 .
 .
                                           2
1
