      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
