C****************************************************************************
C
C
C     MAIN PROGRAM
C
      BYTE    IPAL(4),REST(73),PATNUM(80),TITLE(80),COMP(80),
     C        ISYM(8,20),IBUF(8,20)
      BYTE    E,O,T,P,B,H,S,L,N,Q,U,F,C,R,A,
     C        BB,CC,DD,EE,FF,II,NN,OO,PP,RR,SS,TT,UU,
     C        IPAGE,FNAME(11),MYLINE(80),
     C        INOAI,IOT,INOO,CR,LF,IOP,CLRS
      LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR,
     C        LFIX,LFIRST,LMATCH,LFUSES(32,64),LPHASE(20),LBUF(20),
     C        LPROD(80),LSAME,LACT,LOPERR,LINP,LPRD,LHEAD
      COMMON  LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR
      COMMON /PGE/ IPAGE(80,100)
      COMMON /FTEST/ IFUNCT,IDESC,IEND
      DATA E/'E'/,O/'O'/,T/'T'/,P/'P'/,B/'B'/,H/'H'/,S/'S'/,L/'L'/,
     C     N/'N'/,Q/'Q'/,U/'U'/,F/'F'/,C/'C'/,R/'R'/,A/'A'/
      DATA BB/'B'/,CC/'C'/,DD/'D'/,EE/'E'/,FF/'F'/,II/'I'/,NN/'N'/,
     C     OO/'O'/,PP/'P'/,RR/'R'/,SS/'S'/,TT/'T'/,UU/'U'/
      DATA CR/X'0D'/,LF/X'0A'/,CLRS/X'0C'/

 999  IFUNCT=0
      IDESC=0
      LSAME=.FALSE.
      LACT=.FALSE.
      LOPERR=.FALSE.
      LINP=.FALSE.
      LPRD=.FALSE.
      LHEAD=.FALSE.
C
      WRITE(1,3)CLRS
    3	FORMAT(' ',A1,'  PAL ASSEMBLER  VERSION  3.1    ',/////)
  530	CALL GFNAME(FNAME,INUNIT,.TRUE.)
	CALL OPEN(6,FNAME,INUNIT)
      READ(6,10,END=500) IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP
   10 FORMAT(4A1,A1,A1,A1,73A1,/,80A1,/,80A1,/,80A1)
	GOTO 510
 500	WRITE(1,520)
        ENDFILE 6
 520	FORMAT(' FILE DOESN''T EXIST, REENTER',/)
	GOTO 530

C
 510  WRITE(1,511) IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP
 511  FORMAT(' '4A1,A1,A1,A1,73A1,/,' ',80A1,/,
     C       ' ',80A1,/,' ',80A1)
      DO 15 J=1,100
          READ(6,11,END=16) MYLINE
   11     FORMAT(80A1)
	WRITE(1,561)MYLINE
 561	FORMAT(' ',80A1)
	DO 560 I = 1,80
	IPAGE(I,J) = ' '
 560	IF(.NOT.((MYLINE(I).EQ.CR).OR.(MYLINE(I).EQ.LF)))
     C     IPAGE(I,J) = MYLINE(I)

      IF(     IFUNCT.EQ.0 .AND.IPAGE(1,J).EQ.FF.AND.
     C    IPAGE(3,J).EQ.NN.AND.IPAGE(5,J).EQ.TT.AND.
     C    IPAGE(7,J).EQ.OO.AND.IPAGE(10,J) .EQ.TT ) IFUNCT=J
      IF(      IDESC.EQ.0 .AND.IPAGE(1,J).EQ.DD.AND.
     C    IPAGE(3,J).EQ.SS.AND.IPAGE(5,J).EQ.RR.AND.
     C    IPAGE(7,J).EQ.PP.AND.IPAGE(10,J) .EQ.OO ) IDESC=J
   15 CONTINUE
   16 IEND=J-1
      CALL INITLZ(INOAI,IOT,INOO,ITYPE,LFUSES,IC,IL,IBLOW,LFIX)
      ILE=IL+1
      IF(ITYPE.NE.0) GO TO 17
          WRITE(1,18) IPAL,INOAI,IOT,INOO
   18     FORMAT(/,' PAL PART TYPE ',4A1,A1,A1,A1,' IS INCORRECT')
          STOP ERROR
   17 DO 20 J=1,20
   20     CALL GETSYM(LPHASE,ISYM,J,IC,IL,LFIX)
          IF(.NOT.(LEQUAL.OR.LLEFT.OR.LAND.OR.LOR.OR.LRIGHT)) GO TO 24
              WRITE(1,23)
   23         FORMAT(/,' LESS THAN 20 PIN NAMES IN PIN LIST')
              STOP ERROR
   24 ILE=IL
   25 CALL GETSYM(LBUF,IBUF,1,IC,IL,LFIX)
   28     IF(.NOT.LEQUAL) GO TO 25
          COUNT=0
          ILL=IL
          CALL MATCH(IMATCH,IBUF,ISYM)
          IF( IMATCH.EQ.0 ) GO TO 100
          IPRD=IMATCH
          LSAME = ( (     LPHASE(IMATCH)).AND.(     LBUF(1)).OR.
     C              (.NOT.LPHASE(IMATCH)).AND.(.NOT.LBUF(1)) )
          IF( IOT.EQ.H.AND.(.NOT.LSAME) )                 LACT=.TRUE.
          IF( (.NOT.(IOT.EQ.H.OR.IOT.EQ.C)).AND.(LSAME) ) LACT=.TRUE.
          IF( (ITYPE.EQ.1.OR.ITYPE.EQ.5.OR.ITYPE.EQ.6).AND.IOT.NE.A.
     C    AND.(IMATCH.LT.12.OR.IMATCH.GT.19) ) LOPERR=.TRUE.
          IF(  ITYPE.EQ.2.AND.(IMATCH.LT.13.OR.IMATCH.GT.18) )
     C                                         LOPERR=.TRUE.
          IF(  ITYPE.EQ.3.AND.(IMATCH.LT.14.OR.IMATCH.GT.17) )
     C                                         LOPERR=.TRUE.
          IF(  ITYPE.EQ.4.AND.(IMATCH.LT.15.OR.IMATCH.GT.16) )
     C                                         LOPERR=.TRUE.
          IF( (LACT).OR.(LOPERR) ) GO TO 100
          I88PRO=(19-IMATCH)*8 + 1
          IF(IOT.EQ.C) I88PRO=25
          IC=0
   30       CALL INCR(IC,IL,LFIX)
            IF( .NOT.(LEQUAL.OR.LLEFT) ) GO TO 30
            LPROD(I88PRO)=.TRUE.
            IF(.NOT.LLEFT) CALL SLIP(LFUSES,I88PRO,INOAI,IOT,INOO,IBLOW)
            DO 70 I8PRO=1,16
                COUNT = COUNT + 1
                IPROD = I88PRO + I8PRO - 1
                LPROD(IPROD)=.TRUE.
                LFIRST=.TRUE.
   50             ILL=IL
                  CALL GETSYM(LBUF,IBUF,1,IC,IL,LFIX)
                IF( (ITYPE.EQ.1.OR.ITYPE.EQ.2.AND.IPRD.GT.13
     C               .AND.IPRD.LT.18).AND.COUNT.GT.2 ) LPRD=.TRUE.
                IF( (ITYPE.EQ.3.OR.ITYPE.EQ.2.AND.(IPRD.EQ.13.OR.
     C               IPRD.EQ.18)).AND.COUNT.GT.4 ) LPRD=.TRUE.
                IF( IOT.NE.A.AND.IOT.NE.C.AND.COUNT.GT.8 ) LPRD=.TRUE.
                IF( .NOT.LPRD ) GO TO 69
                IF(IL.NE.IFUNCT.AND.IL.NE.IDESC) ILL=IL
                IPROD = IPROD - 1
                GO TO 118
   69             IF(LFIX) GO TO 59
                  CALL MATCH(IMATCH,IBUF,ISYM)
                  IF( ITYPE.EQ.1.AND.IMATCH.GT.11 ) LINP=.TRUE.
                  IF( ITYPE.EQ.2.AND.(IMATCH.GT.12.AND.IMATCH.LT.19) )
     C                LINP=.TRUE.
                  IF( ITYPE.EQ.3.AND.(IMATCH.GT.13.AND.IMATCH.LT.18) )
     C                LINP=.TRUE.
                ILL=IL
                IF(LINP) GO TO 100
                IF( IMATCH.EQ.0 ) GO TO 100
                IF( IMATCH.EQ.10.OR.IMATCH.EQ.99 ) GO TO 64
                IF(.NOT.LFIRST) GO TO 58
                    LFIRST=.FALSE.
                    DO 56 I=1,32
                        IBLOW = IBLOW + 1
   56                   LFUSES(I,IPROD)=.TRUE.
   58           CALL IXLATE(IINPUT,IMATCH,LPHASE,LBUF,ITYPE)
                IF(IINPUT.LE.0) GO TO 60
                IBLOW = IBLOW - 1
                LFUSES(IINPUT,IPROD)=.FALSE.
                CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.FALSE.,ITYPE,
     C                    LPROD,IOP,IBLOW)
                GO TO 60
   59           CALL FIXSYM(LBUF,IBUF,IC,IL,LFIRST,LFUSES,IBLOW,
     C                      IPROD,LFIX)
   60           IF(LAND) GO TO 50
   64         IF(.NOT.LRIGHT) GO TO 68
   66           CALL INCR(IC,IL,LFIX)
                IF(.NOT.LEQUAL)  GO TO 66
   68         IF( .NOT.(LOR.OR.LEQUAL) ) GO TO 74
   70         CONTINUE
   74     ILL=IL
          CALL GETSYM(LBUF,IBUF,1,IC,IL,LFIX)
          IF(LLEFT.OR.LEQUAL) GO TO 28
  100 IF( ILL.EQ.IFUNCT.OR.ILL.EQ.IDESC ) GO TO 102
      ILERR=ILL+4
      WRITE(1,101) (IBUF(I,1),I=1,8),ILERR,(IPAGE(I,ILL),I=1,79)
  101 FORMAT(' ERROR SYMBOL = ',8A1,'     IN LINE NUMBER ',I3,
     C       /,' ',80A1)
      IF( (LACT).AND.(     LSAME).AND.(.NOT.LOPERR) )
     C         WRITE(1,103) IPAL,INOAI,IOT,INOO
  103 FORMAT(' OUTPUT MUST BE INVERTED SINCE ',4A1,A1,A1,A1,
     C       ' IS AN ACTIVE LOW DEVICE')
      IF( (LACT).AND.(.NOT.LSAME).AND.(.NOT.LOPERR) )
     C         WRITE(1,109) IPAL,INOAI,IOT,INOO
  109 FORMAT(' OUTPUT CANNOT BE INVERTED SINCE ',4A1,A1,A1,A1,
     C       ' IS AN ACTIVE HIGH DEVICE')
      IF( (LOPERR).AND.IMATCH.NE.0 )
     C         WRITE(1,105) IMATCH,IPAL,INOAI,IOT,INOO
  105 FORMAT(' THIS PIN NUMBER ',I2,' IS AN INVALID OUTPUT PIN',
     C       ' FOR ',4A1,A1,A1,A1)
      IF(LINP) WRITE(1,115) IMATCH,IPAL,INOAI,IOT,INOO
  115 FORMAT(' THIS PIN NUMBER ',I2,' IS AN INVALID INPUT PIN',
     C       ' FOR ',4A1,A1,A1,A1)
  118 ILERR=ILL+4
      IF(LPRD) WRITE(1,119)
     C (ISYM(I,IPRD),I=1,8),IPRD,ILERR,(IPAGE(I,ILL),I=1,79)
  119 FORMAT(' OUTPUT PIN NAME = ',8A1,' OUTPUT PIN NUMBER = ',I2,
     C       ' MINTERM IN LINE NUMBER ',I3,/,' ',80A1)
      IF( LPRD.AND.COUNT.LT.8 )
     C         WRITE(1,116) IPROD,IPAL,INOAI,IOT,INOO
  116 FORMAT(' THIS PRODUCT LINE NUMBER ',I2,' IS NOT VALID',
     C       ' FOR ',4A1,A1,A1,A1)
      IF( LPRD.AND.COUNT.GT.8 )
     C         WRITE(1,117) IPAL,INOAI,IOT,INOO
  117 FORMAT(' MAXIMUM OF 8 PRODUCTS LINES ARE VALID FOR ',4A1,A1,A1,A1,
     C       ' TOO MANY MINTERMS ARE SPECIFIED IN THIS EQUATION')
      STOP ERROR
  102 IF(ITYPE.LE.4) CALL TWEEK(ITYPE,IOT,LFUSES)
      ENDFILE 6
  108 WRITE(1,106)
  106 FORMAT(' OPERATION CODES:')
      WRITE(1,107)
  107 FORMAT(/,'  E=ECHO  O=PINOUT  P=PLOT    B=BRIEF  ',
     C       /,'  H=HEX   L=BHLF    N=BNPF    Q=QUIT    S=SIMULATE')
      WRITE(1,110)
  110 FORMAT(' ENTER OPERATION CODE:')
      READ(1,120) IOP
  120 FORMAT(A1)
      IF(IOP.EQ.E) CALL ECHO(IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,
     C                       COMP)
      IF(IOP.EQ.O) CALL PINOUT(IPAL,INOAI,IOT,INOO,TITLE)
      IF(IOP.EQ.P) CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.TRUE.,ITYPE,
     C                       LPROD,IOP,IBLOW)
      IF(IOP.EQ.B) CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.TRUE.,ITYPE,
     C                       LPROD,IOP,IBLOW)
      IF(IOP.EQ.H) CALL HEX(LFUSES)
      IF(IOP.EQ.L) CALL BINR(LFUSES,H,L)
      IF(IOP.EQ.N) CALL BINR(LFUSES,P,N)
C     IF(IOP.EQ.R) GOTO 999
      IF(IOP.EQ.S) CALL TEST(LPHASE,LBUF,TITLE,IC,IL,ILE,ISYM,IBUF,
     C                       ITYPE,INOO,LFIX)
      IF(IOP.NE.Q) GO TO 108
      STOP
      END
C
C************************************************************************
C
      SUBROUTINE INITLZ(INOAI,IOT,INOO,ITYPE,LFUSES,IC,IL,IBLOW,LFIX)
      BYTE    INOAI,IOT,INOO
      LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR,
     C        LFIX,LFUSES(32,64)
	BYTE IPAGE,H,L,C,R,X,A,I0,I2,I4,I6,I8,INOAI,IOT,INOO
      COMMON  LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR
      COMMON /PGE/ IPAGE(80,100)
      DATA H/'H'/,L/'L'/,C/'C'/,R/'R'/,X/'X'/,A/'A'/
     C     I0/'0'/,I2/'2'/,I4/'4'/,I6/'6'/,I8/'8'/
      DO 20 J=1,64
         DO 20 I=1,32
   20       LFUSES(I,J)=.FALSE.
      IBLOW=0
      IC=0
      IL=1
      ITYPE=0
      IF(  INOAI.EQ.I0 )                            ITYPE=1
      IF(  INOAI.EQ.I2 )                            ITYPE=2
      IF(  INOAI.EQ.I4 )                            ITYPE=3
      IF( (INOAI.EQ.I6) )                           ITYPE=4
      IF( (INOAI.EQ.I6).AND.(INOO.EQ.I8) )          ITYPE=5
      IF( (IOT.EQ.R).OR.(IOT.EQ.X).OR.(IOT.EQ.A) )  ITYPE=6
      IF( .NOT.(IOT.EQ.H.OR.IOT.EQ.L.OR.IOT.EQ.C
     C      .OR.IOT.EQ.R.OR.IOT.EQ.X.OR.IOT.EQ.A) ) ITYPE=0
      CALL INCR(IC,IL,LFIX)
      RETURN
      END
C
C*************************************************************************
C
      SUBROUTINE INCR(IC,IL,LFIX)
      LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR,
     C        LFIX,LX1
	BYTE  IPAGE,IBLANK,ILEFT,IAND,IOR,COMENT,ISLASH,IEQUAL,
     C        IRIGHT,ICOLON
      COMMON  LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR
      COMMON /PGE/ IPAGE(80,100)
      DATA IBLANK/' '/,ILEFT/'('/,IAND/'*'/,IOR/'+'/,COMENT/';'/,
     C     ISLASH/'/'/,IEQUAL/'='/,IRIGHT/')'/,ICOLON/':'/
      LBLANK=.FALSE.
      LXOR=.FALSE.
      LXNOR=.FALSE.
      LX1=.FALSE.
      LRIGHT=.FALSE.
   10 IC=IC+1
      IF( IC.LE.79.AND.IPAGE(IC,IL).NE.COMENT ) GO TO 30
      IL=IL+1
   20 IC=0
      GO TO 10
   30 IF( IPAGE(IC,IL).EQ.ICOLON.AND.(LFIX) ) RETURN
      IF( IPAGE(IC,IL).NE.IBLANK ) GO TO 31
          LBLANK=.TRUE.
          GO TO 10
   31 IF( IPAGE(IC,IL).NE.ICOLON ) GO TO 32
      IF( (LXOR).OR.(LXNOR) )  GO TO 33
      LX1=.TRUE.
      GO TO 10
   33 IF(LXOR)  LOR=.TRUE.
      IF(LXNOR) LAND=.TRUE.
      RETURN
   32 IF( .NOT.(LX1.AND.(IPAGE(IC,IL).EQ.IOR.OR.IPAGE(IC,IL).EQ.IAND)) )
     C     GO TO 34
      IF( IPAGE(IC,IL).EQ.IOR  ) LXOR=.TRUE.
      IF( IPAGE(IC,IL).EQ.IAND ) LXNOR=.TRUE.
      GO TO 10
   34 LLEFT =( IPAGE(IC,IL).EQ.ILEFT  )
      LAND  =( IPAGE(IC,IL).EQ.IAND   )
      LOR   =( IPAGE(IC,IL).EQ. IOR   )
      LSLASH=( IPAGE(IC,IL).EQ.ISLASH )
      LEQUAL=( IPAGE(IC,IL).EQ.IEQUAL )
      LRIGHT=( IPAGE(IC,IL).EQ.IRIGHT )
      RETURN
      END
C
C************************************************************************
C
      SUBROUTINE GETSYM(LPHASE,ISYM,J,IC,IL,LFIX)
      BYTE    ISYM(8,20)
      LOGICAL LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR,
     C        LFIX,LPHASE(20)
	BYTE  IPAGE,IBLANK
      COMMON  LBLANK,LLEFT,LAND,LOR,LSLASH,LEQUAL,LRIGHT,LXOR,LXNOR
      COMMON /PGE/ IPAGE(80,100)
      DATA IBLANK/' '/
      LFIX=.FALSE.
      IF( .NOT.(LLEFT.OR.LAND.OR.LOR.OR.LEQUAL.OR.LRIGHT) ) GO TO 10
      CALL INCR(IC,IL,LFIX)
      IF(LLEFT) GO TO 60
   10 LPHASE(J)=( .NOT.LSLASH )
      IF(LPHASE(J)) GO TO 15
      CALL INCR(IC,IL,LFIX)
   15 DO 20 I=1,8
   20     ISYM(I,J)=IBLANK
   25 DO 30 I=1,7
   30     ISYM(I,J)=ISYM(I+1,J)
      ISYM(8,J)=IPAGE(IC,IL)
      CALL INCR(IC,IL,LFIX)
      IF( LLEFT.OR.LBLANK.OR.LAND.OR.LOR.OR.LRIGHT.OR.LEQUAL ) RETURN
      GO TO 25
   60 LFIX=.TRUE.
      RETURN
      END
C
C***************************************************************************
C
      SUBROUTINE MATCH(IMATCH,IBUF,ISYM)
      BYTE    IBUF(8,20),ISYM(8,20)
      LOGICAL LMATCH
	BYTE  C,A,R,Y
      DATA C/'C'/,A/'A'/,R/'R'/,Y/'Y'/
      IMATCH=0
      DO 20 J=1,20
          LMATCH=.TRUE.
          DO 10 I=1,8
   10         LMATCH=LMATCH.AND.(IBUF(I,1).EQ.ISYM(I,J))
          IF(LMATCH) IMATCH=J
   20     CONTINUE
      IF( IBUF(3,1).EQ.C.AND.IBUF(4,1).EQ.A.AND.IBUF(5,1).EQ.R.AND.
     C    IBUF(6,1).EQ.R.AND.IBUF(7,1).EQ.Y ) IMATCH=99
      RETURN
      END
C
C**********************************************************************
C
      SUBROUTINE IXLATE(IINPUT,IMATCH,LPHASE,LBUF,ITYPE)
      BYTE    ITABLE(20,6)
      LOGICAL LPHASE(20),LBUF(20)
      DATA    ITABLE/
     C   3, 1, 5, 9,13,17,21,25,29,-10,31,-1,-1,-1,-1,-1,-1,-1,-1,-20,
     C   3, 1, 5, 9,13,17,21,25,29,-10,31,27,-1,-1,-1,-1,-1,-1, 7,-20,
     C   3, 1, 5, 9,13,17,21,25,29,-10,31,27,23,-1,-1,-1,-1,11, 7,-20,
     C   3, 1, 5, 9,13,17,21,25,29,-10,31,27,23,19,-1,-1,15,11, 7,-20,
     C   3, 1, 5, 9,13,17,21,25,29,-10,31,-1,27,23,19,15,11, 7,-1,-20,
     C  -1, 1, 5, 9,13,17,21,25,29,-10,-1,31,27,23,19,15,11, 7, 3,-20/
      IINPUT=0
      IBUBL=0
      IF(((     LPHASE(IMATCH)).AND.(.NOT.LBUF(1))).OR.
     C   ((.NOT.LPHASE(IMATCH)).AND.(     LBUF(1)))) IBUBL=1
      IF( ITABLE(IMATCH,ITYPE).GT.0 ) IINPUT=ITABLE(IMATCH,ITYPE)+IBUBL
      RETURN
      END
C
C************************************************************************
C
      SUBROUTINE PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,LDUMP,ITYPE,
     C                LPROD,IOP,IBLOW)
      BYTE    IBUF(8,20),IOUT(64),TITLE(80)
      LOGICAL LBUF(20),LFUSES(32,64),LDUMP,LPROD(80)
	BYTE  ISAVE(64,32),IAND,IOR,ISLASH,
     C        IDASH,X,IBLANK,P,B,HIFANT,IOP,CLRS
      DATA ISAVE/2048*' '/,IAND/'*'/,IOR/'+'/,ISLASH/'/'/,
     C     IDASH/'-'/,X/'X'/,IBLANK/' '/,P/'P'/,B/'B'/,
     C     HIFANT/'O'/,CLRS/X'0C'/
      IF(.NOT.LDUMP) GO TO 4
    4 IF(LDUMP) GO TO 60
      IF(ISAVE(IPROD,1).NE.IBLANK) RETURN
      IF( LBUF(1) ) GO TO 5
      DO 30 J=1,31
   30     ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
      ISAVE(IPROD,32)=ISLASH
    5 DO 20 I=1,8
         IF( ISAVE(IPROD,1).NE.IBLANK ) RETURN
          IF( IBUF(I,1).EQ.IBLANK ) GO TO 20
          DO 10 J=1,31
   10         ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
          ISAVE(IPROD,32)=IBUF(I,1)
   20     CONTINUE
      IF(ISAVE(IPROD,1).NE.IBLANK) RETURN
   40 DO 50 J=1,31
   50     ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
      ISAVE(IPROD,32)=IAND
      RETURN
   60 WRITE(1,62) CLRS,TITLE
   62 FORMAT(' ',A1,80A1,//,
     C '                11 1111 1111 2222 2222 2233',/,
     C '    0123 4567 8901 2345 6789 0123 4567 8901',/)
      DO 100 I88PRO=1,57,8
          DO 94 I8PRO=1,8
              IPROD=I88PRO+I8PRO-1
              ISAVE(IPROD,32)=IBLANK
              DO 70 I=1,32
                  IF( ISAVE(IPROD,1).NE.IBLANK ) GO TO 70
                  DO 65 J=1,31
                      ISAVE(IPROD,J)=ISAVE(IPROD,J+1)
   65                 CONTINUE
                  ISAVE(IPROD,32)=IBLANK
   70         CONTINUE
              DO 80 I=1,32
                  IOUT(I)=X
                  IF( LFUSES(I,IPROD) ) IOUT(I)=IDASH
                  IOUT(I+32)=ISAVE(IPROD,I)
   80         CONTINUE
              IF(ITYPE.LE.4) CALL FANTOM(ITYPE,IOUT,IPROD,I8PRO)
              IPROD=IPROD-1
              DO 85 J=1,32
                  IF( IOP.EQ.B.AND.IOUT(J).EQ.HIFANT ) IOUT(J)=IBLANK
   85         CONTINUE
              IF( (IOP.EQ.P).OR.(IOP.EQ.B.AND.(LPROD(IPROD+1))) )
     C        WRITE(1,90) IPROD,IOUT
   90         FORMAT(' ',I2,8(' ',4A1),' ',32A1)
   94         CONTINUE
          WRITE(1,96)
   96     FORMAT(1X)
  100     CONTINUE
      WRITE(1,110)
  110 FORMAT(/,
     C' LEGEND:  X : FUSE NOT BLOWN (L,N,0)   - : FUSE BLOWN   (H,P,1)')
      IF( IOP.EQ.P.AND.ITYPE.LE.4 ) WRITE(1,111)
  111 FORMAT(
     C'          0 : PHANTOM FUSE   (L,N,0)   O : PHANTOM FUSE (H,P,1)')
      WRITE(1,112) IBLOW
  112 FORMAT(/,' NUMBER OF FUSES BLOWN = ',I4)
      WRITE(1,113)
  113 FORMAT(////)
      RETURN
      END
C
C*************************************************************************
C
      SUBROUTINE TWEEK(ITYPE,IOT,LFUSES)
      BYTE    IOT
      LOGICAL LFUSES(32,64)
	BYTE  L,C
      DATA L/'L'/,C/'C'/
      IF(ITYPE.GE.4) GO TO 20
      DO 10 IPROD=1,64
          LFUSES(15,IPROD)=.TRUE.
          LFUSES(16,IPROD)=.TRUE.
          LFUSES(19,IPROD)=.TRUE.
          LFUSES(20,IPROD)=.TRUE.
          IF(ITYPE.GE.3) GO TO 10
          LFUSES(11,IPROD)=.TRUE.
          LFUSES(12,IPROD)=.TRUE.
          LFUSES(23,IPROD)=.TRUE.
          LFUSES(24,IPROD)=.TRUE.
          IF(ITYPE.GE.2) GO TO 10
          LFUSES( 7,IPROD)=.TRUE.
          LFUSES( 8,IPROD)=.TRUE.
          LFUSES(27,IPROD)=.TRUE.
          LFUSES(28,IPROD)=.TRUE.
   10     CONTINUE
      DO 18 IINPUT=7,28
          DO 12 IPROD=1,57,8
              LFUSES(IINPUT,IPROD+4)=.FALSE.
              LFUSES(IINPUT,IPROD+5)=.FALSE.
              LFUSES(IINPUT,IPROD+6)=.FALSE.
   12         LFUSES(IINPUT,IPROD+7)=.FALSE.
          IF(ITYPE.GE.3) GO TO 18
          DO 14 IPROD=17,41,8
              LFUSES(IINPUT,IPROD+2)=.FALSE.
   14         LFUSES(IINPUT,IPROD+3)=.FALSE.
          IF(ITYPE.GE.2) GO TO 18
          DO 16 IPROD=1,57,8
              LFUSES(IINPUT,IPROD+2)=.FALSE.
   16         LFUSES(IINPUT,IPROD+3)=.FALSE.
   18 CONTINUE
   20 IF( (ITYPE.EQ.1) .OR. ((ITYPE.EQ.4).AND.(IOT.EQ.L)) ) RETURN
      DO 99 IINPUT=1,32
          DO 30 IPROD=1,8
              LFUSES(IINPUT,IPROD+ 0)= (IOT.NE.L)
   30         IF(IOT.NE.C) LFUSES(IINPUT,IPROD+56)= (IOT.NE.L)
          IF(ITYPE.LE.2) GO TO 99
          DO 40 IPROD=1,8
              LFUSES(IINPUT,IPROD+ 8)= (IOT.NE.L)
   40         IF(IOT.NE.C) LFUSES(IINPUT,IPROD+48)= (IOT.NE.L)
          IF(ITYPE.LE.3) GO TO 99
          DO 50 IPROD=1,8
              LFUSES(IINPUT,IPROD+16)= (IOT.NE.L)
   50         IF(IOT.NE.C) LFUSES(IINPUT,IPROD+40)= (IOT.NE.L)
   99     CONTINUE
      RETURN
      END
C
C************************************************************************
C
      SUBROUTINE SLIP(LFUSES,I88PRO,INOAI,IOT,INOO,IBLOW)
      LOGICAL LFUSES(32,64)
	BYTE  R,I1,I2,I4,I6,I8,IOT,INOO,INOAI
      DATA R/'R'/,I1/'1'/,I2/'2'/,I4/'4'/,I6/'6'/,I8/'8'/
      IF( (INOAI.NE.I6) .OR. (INOO.EQ.I1) .OR.  (INOO.EQ.I2) .OR.
     C    ( (IOT.EQ.R).AND.(INOO.EQ.I8) ) .OR.
     C    ( (I88PRO.GE. 9).AND.(I88PRO.LE.49).AND.(INOO.EQ.I6) ) .OR.
     C    ( (I88PRO.GE.17).AND.(I88PRO.LE.41).AND.(INOO.EQ.I4)) ) RETURN
      DO 10 I=1,32
      IBLOW = IBLOW + 1
   10 LFUSES(I,I88PRO) = .TRUE.
      I88PRO = I88PRO + 1
      RETURN
      END
C
C*************************************************************************
C
      SUBROUTINE FANTOM(ITYPE,IOUT,IPROD,I8PRO)
      BYTE    IOUT(64)
	BYTE  X,IDASH,LOFANT,HIFANT
      DATA X/'X'/,IDASH/'-'/,LOFANT/'0'/,HIFANT/'O'/
      DO 10 I=1,32
          IF( IOUT(I).EQ.IDASH ) IOUT(I)=HIFANT
          IF( IOUT(I).EQ.X )     IOUT(I)=LOFANT
   10 CONTINUE
      IF((ITYPE.EQ.4).AND.((IPROD.LE.24).OR.(IPROD.GE.41))) RETURN
      IF((ITYPE.EQ.3).AND.((IPROD.LE.16).OR.(IPROD.GE.45))) RETURN
      IF((ITYPE.EQ.2).AND.((IPROD.LE. 8).OR.(IPROD.GE.53))) RETURN
      IF((ITYPE.LE.3).AND.(I8PRO.GE.5)) RETURN
      IF((ITYPE.LE.2).AND.(IPROD.GE.19).AND.(IPROD.LE.48).AND.
     C   (I8PRO.GE.3)) RETURN
      IF((ITYPE.EQ.1).AND.(I8PRO.GE.3)) RETURN
      DO 50 I=1,32
        IF(((I.EQ.15).OR.(I.EQ.16).OR.(I.EQ.19).OR.(I.EQ.20)).AND.
     C   (ITYPE.LE.3)) GO TO 50
        IF(((I.EQ.11).OR.(I.EQ.12).OR.(I.EQ.23).OR.(I.EQ.24)).AND.
     C   (ITYPE.LE.2)) GO TO 50
        IF(((I.EQ. 7).OR.(I.EQ. 8).OR.(I.EQ.27).OR.(I.EQ.28)).AND.
     C   (ITYPE.LE.1)) GO TO 50
        IF( IOUT(I).EQ.HIFANT ) IOUT(I)=IDASH
        IF( IOUT(I).EQ.LOFANT ) IOUT(I)=X
   50 CONTINUE
      RETURN
      END
C
C****************************************************************************
C	*****************************************************************
	SUBROUTINE DATAIO (TEXT,NUMBER)
	LOGICAL TEXT(1)
	INTEGER NUMBER
	EXTERNAL PUNCH
	DO 10 I= 1, NUMBER
 10	CALL PUNCH(TEXT(I))
	RETURN
	END
C      ***********************************************************
C      ***********************************************************
C      ***********************************************************
       LOGICAL FUNCTION IHEXA(I)
       LOGICAL STRNG(16)
       DATA STRNG/'0','1','2','3','4','5','6','7','8','9',
     1  'A','B','C','D','E','F'/
       M=MOD(I,16)+1
       IHEXA=STRNG(M)
       RETURN
       END
C    **********
       SUBROUTINE HEX(LFUSES)
       LOGICAL LFUSES(32,64)
       LOGICAL    ITEMP(64),IHEXA
	LOGICAL T(128)
	LOGICAL STX,ETX,NULL(50),DC1,READER
	EXTERNAL READER
	DATA STX/X'02'/,ETX/X'03'/,NULL/50*X'00'/,DC1/X'11'/
	WRITE(1,81)
   81	FORMAT(' DATA I/O SETUP:'/' TYPE ''SELECT 50,ENTER''')
	WRITE(1,82)
   82	FORMAT(' TYPE ''SELECT D2,ENTER''')
	WRITE(1,83)
   83	FORMAT(' THEN PRESS ''START'' BUTTON ')
   87   IF(READER(0).XOR.DC1) GOTO 87
	WRITE(1,88)
   88   FORMAT(' STARTING TRANSMISSION')
	ENCODE(T,70)STX
	CALL DATAIO(T,1)
       DO 40 I=1,33,32
       INC=I-1
       DO 40 IPROD=1,7,2
       DO 20 J=1,2
       DO 20 IINPUT=1,32
       IHEX=0
       M=IPROD+INC+J-1
         IF(LFUSES(IINPUT,M+ 0)) IHEX=IHEX+1
         IF(LFUSES(IINPUT,M+ 8)) IHEX=IHEX+2
         IF(LFUSES(IINPUT,M+16)) IHEX=IHEX+4
         IF(LFUSES(IINPUT,M+24)) IHEX=IHEX+8
       M=IINPUT+32*(J-1)
   20  ITEMP(M)=IHEXA(IHEX)
	ENCODE(T,60)ITEMP
   40	CALL DATAIO(T,128)
	ENCODE(T,80)ETX,NULL
	CALL DATAIO(T,51)
   60  FORMAT(64(A1,' '))
   70	FORMAT(A1)
   80	FORMAT(51A1)
       RETURN
       END
C
C*************************************************************************
C
      SUBROUTINE ECHO(IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP)
      BYTE    IPAL(4),REST(73),PATNUM(80),TITLE(80),COMP(79)
	BYTE  IPAGE,INOAI,IOT,INOO,CLRS
      COMMON /PGE/ IPAGE(80,100)
      COMMON /FTEST/ IFUNCT,IDESC,IEND
	DATA  CLRS/X'0C'/
      WRITE(1,10)CLRS,IPAL,INOAI,IOT,INOO,REST,PATNUM,TITLE,COMP
   10 FORMAT(' ',A1,4A1,A1,A1,A1,73A1,/,' ',80A1,/,' ',80A1,/,' ',80A1)
      DO 30 J=1,IEND
           WRITE(1,20) (IPAGE(I,J),I=1,80)
   20      FORMAT(' ',80A1)
   30 CONTINUE
      RETURN
      END
C
C******************************************************************************
C
      SUBROUTINE BINR(LFUSES,H,L)
      BYTE    ITEMP(4,8),H,L,CLRS
      LOGICAL LFUSES(32,64)
	DATA CLRS/X'0C'/
      WRITE(1,10)CLRS
   10 FORMAT(' ',A1)
      DO 20 I=1,33,32
      INC=I-1
        DO 20 IPROD=1,8
            DO 20 J=1,25,8
              DO 15 K=1,8
                IINPUT=J+K-1
                ITEMP(1,K)=L
                ITEMP(2,K)=L
                ITEMP(3,K)=L
                ITEMP(4,K)=L
		MYINX = IPROD + INC
                IF(LFUSES(IINPUT,MYINX +  0)) ITEMP(4,K)=H
                IF(LFUSES(IINPUT,MYINX +  8)) ITEMP(3,K)=H
                IF(LFUSES(IINPUT,MYINX + 16)) ITEMP(2,K)=H
                IF(LFUSES(IINPUT,MYINX + 24)) ITEMP(1,K)=H
   15           CONTINUE
   20         WRITE(1,30) ITEMP
   30         FORMAT(' ',8('B',4A1,'F '))
      WRITE(1,10)
      RETURN
      END
C
C**************************************************************************
C
      SUBROUTINE PINOUT(IPAL,INOAI,IOT,INOO,TITLE)
      BYTE    IPAL(4),TITLE(80),PIN(8,20),IIN(7,2)
	BYTE  IPAGE,IBLANK,ISTAR,INOAI,IOT,INOO,CLRS
      COMMON /PGE/ IPAGE(80,100)
      DATA IBLANK/' '/,ISTAR/'*'/,CLRS/X'0C'/
      DO 10 J=1,20
          DO 5 I=1,8
    5         PIN(I,J)=IBLANK
   10 CONTINUE
   15 DO 25 J=1,2
          DO 20 I=1,7
   20         IIN(I,J)=IBLANK
   25 CONTINUE
      IIN(2,1)=IPAL(1)
      IIN(4,1)=IPAL(2)
      IIN(6,1)=IPAL(3)
      IIN(1,2)=IPAL(4)
      IIN(3,2)=INOAI
      IIN(5,2)=IOT
      IIN(7,2)=INOO
      J=0
      IL=0
   30 IC=0
      IL=IL+1
   35 IC=IC+1
   40 IF( IC.GT.80 ) GO TO 30
      IF( IPAGE(IC,IL).EQ.IBLANK ) GO TO 35
      J=J+1
      IF(J.GT.20) GO TO 60
      DO 55 I=1,8
          PIN(I,J)=IPAGE(IC,IL)
          IC=IC+1
          IF( IC.GT.80 ) GO TO 40
          IF( IPAGE(IC,IL).EQ.IBLANK ) GO TO 40
   55 CONTINUE
   60 DO 75 J=1,10
          II=0
   65     II=II+1
          IF(II.EQ.9) GO TO 75
          IF( PIN(II,J).NE.IBLANK ) GO TO 65
          I=9
   70     I=I-1
          II=II-1
          PIN(I,J)=PIN(II,J)
          PIN(II,J)=IBLANK
          IF(II.NE.1) GO TO 70
   75 CONTINUE
      WRITE(1,76)CLRS,TITLE
   76 FORMAT(' ',A1,80A1)
      WRITE(1,78) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
     C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
     C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
     C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
   78 FORMAT(/,' ',14X,14A1,3X,14A1,
     C       /,' ',14X,A1,13X,A1,1X,A1,13X,A1)
      JJ=20
      DO 88 J=1,10
          WRITE(1,80) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
   80 FORMAT(' ',11X,4A1,29X,4A1)
      WRITE(1,81) (PIN(I,J),I=1,8),ISTAR,J,ISTAR,
     C     (IIN(I,1),I=1,7),ISTAR,JJ,ISTAR,(PIN(I,JJ),I=1,8)
   81 FORMAT(' ',8A1,3X,A1,I2,A1,11X,7A1,11X,A1,I2,A1,3X,8A1)
      WRITE(1,82) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
   82 FORMAT(' ',11X,4A1,29X,4A1)
      WRITE(1,84) ISTAR,(IIN(I,2),I=1,7),ISTAR
   84 FORMAT(' ',14X,A1,11X,7A1,11X,A1)
      DO 86 II=1,2
          DO 85 I=1,7
   85         IIN(I,II)=IBLANK
   86 CONTINUE
      JJ=JJ-1
   88 CONTINUE
      WRITE(1,90) ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
     C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
     C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,
     C            ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR,ISTAR
   90 FORMAT(' ',14X,31A1)
      RETURN
      END
C
C*****************************************************************************
C
      SUBROUTINE FIXSYM(LBUF,IBUF,IC,IL,LFIRST,LFUSES,IBLOW,IPROD,LFIX)
      LOGICAL LBUF(20),LFUSES(32,64),LFIRST,LMATCH,LFIX
      BYTE    IBUF(8,20),FIXBUF(8)
	BYTE  IPAGE,A,B,ISLASH,IOR,IBLANK,IRIGHT,IAND,
     C        N,Q,N0,N1,N2,N3,ICOLON,TABLE(5,14)
      COMMON /PGE/ IPAGE(80,100)
      DATA A/'A'/,B/'B'/,ISLASH/'/'/,IOR/'+'/,IBLANK/' '/,IRIGHT/')'/,
     C        IAND/'*'/,N/'N'/,Q/'Q'/,N0/'0'/,N1/'1'/,N2/'2'/,N3/'3'/,
     C      ICOLON/':'/
      DATA    TABLE      /      ' ','A','+','/','B',' ',' ','A','+','B',
     C      ' ',' ',' ',' ','A','/','A','+','/','B',' ',' ',' ','/','B',
     C      'A',':','+',':','B',' ','A','*','/','B',' ','/','A','+','B',
     C      'A',':','*',':','B',' ',' ',' ',' ','B',' ',' ','A','*','B',
     C      ' ',' ',' ','/','A','/','A','*','/','B',' ','/','A','*','B'/
      IINPUT=0
      DO 20 I=1,8
          IBUF(I,1)=IBLANK
   20     FIXBUF(I)=IBLANK
   21 CALL INCR(IC,IL,LFIX)
      I=IPAGE(IC,IL)
      IF(I.EQ.IRIGHT) GO TO 40
      IF(I.EQ.N0) IINPUT=8
      IF(I.EQ.N1) IINPUT=12
      IF(I.EQ.N2) IINPUT=16
      IF(I.EQ.N3) IINPUT=20
      DO 24 J=1,7
   24     IBUF(J,1)=IBUF(J+1,1)
      IBUF(8,1)=I
      IF(.NOT. ( (I.EQ.A).OR.(I.EQ.B).OR.(I.EQ.ISLASH).OR.(I.EQ.IOR)
     C       .OR.(I.EQ.IAND).OR.(I.EQ.ICOLON) ) )  GO TO 21
      DO 30 I=1,4
   30     FIXBUF(I)=FIXBUF(I+1)
      FIXBUF(5)=IPAGE(IC,IL)
      GO TO 21
   40 IMATCH=0
      DO 60 J=1,14
          LMATCH=.TRUE.
          DO 50 I=1,5
   50         LMATCH=LMATCH .AND. ( FIXBUF(I).EQ.TABLE(I,J) )
   60     IF(LMATCH) IMATCH=J
      IF(IMATCH.EQ.0) GO TO 100
      IF(.NOT.LFIRST) GO TO 85
          LFIRST=.FALSE.
          DO 80 I=1,32
              LFUSES(I,IPROD)=.TRUE.
   80         IBLOW = IBLOW + 1
   85 DO 90 I=1,4
          IF( (IMATCH-7).LE.0 ) GO TO 90
          MYINX = IINPUT + I
          LFUSES(MYINX,IPROD)=.FALSE.
          IBLOW = IBLOW - 1
          IMATCH=IMATCH-8
   90 IMATCH=IMATCH+IMATCH
      LBUF(1)=.TRUE.
      CALL PLOT(LBUF,IBUF,LFUSES,IPROD,TITLE,.FALSE.,ITYPE,
     C          LPROD,IOP,IBLOW)
  100 LFIX=.FALSE.
      CALL INCR(IC,IL,LFIX)
      RETURN
      END
