      SUBROUTINE POUT
C   
C   
C     THIS ROUTINE PUNCHES THE PROM INFORMATION IN THE
C     SPECIFIED FORMAT, EITHER DATA I/O HEX OR BNPF
C   
C   
      REAL IVAL,IVAL1,IVAL2,NOFF,NTDEP(64),NINST,INSCT
      DIMENSION IBNPF(2)
      COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMREC,IMFLE,IPFLE,IPREC,ITERM
      COMMON IMBUF(128),IPBUF(80),IN(128),ILBUF(80),IWBUF(128),IFREC
      COMMON ISBIT,ICHBT,ICHWD,NBIT,NINST,NDONT,NCOL,NROW,NOFF,IBAT
      COMMON LODLC,IEND,NBITT,IPS,IPE,IPLEN,IPASS,IROW,LCTL,MXREC
      COMMON NPLIN,IWSEC,MSEC,IPROM,INDEX,IBITS,IBITE,LCOLS,LCOLE
      COMMON INSCT,IVAL,IVAL1,IVAL2,MCOL,NPCNT,ICHAR,MSIZE,NWORD,ILLEN
      COMMON LMAP,LLIST,LPCH,INVRT,LHEX,LFILE,NAMEF(4),IERR,ICOL,ICNT
      COMMON NPWID(32),NTWID(32),NPDEP(64),NTDEP,NVAL,MESSN,MESSF
      COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRF,ICHRN,ICHRR,ICHR0,ICHR1
      COMMON ICHRX,IBLNK,ICOMM,IAST,IDOLR,IEQUL,IMIN,IADDR(4),NUMS(16)
C   
      DATA IBNPF(1),IBNPF(2) /1HN,1HP/
C   
C     *ENTRY PARAMETERS
C     IEND  - 1 = END OF PROM
C     IPLEN - OUTPUT RECORD LENGTH
C     IPROM - PROM NUMBER
C     LHEX  - 0=BNPF,1=HEX
C     LODLC - -1 = START OF PROM
C     NPCNT - NUMBER OF PROM WORDS ON CURRENT LINE
C     NPLIN - PROMS WORDS PER LINE COUNT
C 
C     *EXIT PARAMETERS
C     IPLEN - ADJUSTED TO CORRECT RECORD LENGTH 
C     NPCNT - INCREMENTED BY ONE OR SET TO ZERO 
C 
C 
      IF(LODLC-1) 100,100,200 
C     INITIALIZE FOR START OF PROM OUTPUT 
100   CALL TAPEC(0) 
      LL = IPROM
      ID = 1000 
      DO 110 I=1,4
      L = LL/ID 
      LL = LL-L*ID
      ID = ID/10
      L = L+1 
      IPBUF(I) = NUMS(L)
110   CONTINUE
      IPLEN = 4 
      CALL INOUT(5) 
      CALL TAPEC(0) 
      IF(LHEX) 130,130,120
120   CALL TAPEC(1) 
130   LODLC = 2 
      NPCNT = 0 
      IPLEN = 0 
C 
200   IF(LHEX) 210,210,1000 
210   IF(IEND) 250,250,220
220   IF(IPLEN) 500,500,300 
250   IPLEN = IPLEN+1 
      IPBUF(IPLEN) = ICHRB
      DO 260 I=IPS,IPE
      IPLEN = IPLEN+1 
      K = IWBUF(I)+1
      IPBUF(IPLEN) = IBNPF(K) 
260   CONTINUE
      IPLEN = IPLEN+1 
      IPBUF(IPLEN) = ICHRF
      NPCNT = NPCNT+1 
      IF(NPCNT-NPLIN) 400,300,300 
C 
C     OUTPUT NEXT PROM RECORD 
C 
300   CALL INOUT(5) 
      NPCNT = 0 
      IPLEN = 0 
      GO TO 500 
400   IPLEN = IPLEN+1 
      IPBUF(IPLEN) = IBLNK
500   IF(IEND) 9000,9000,510
510   CALL TAPEC(0) 
      GO TO 9000
C 
C     OUTPUT PROM IN HEX FORMAT 
C 
1000  IF(IEND) 1050,1050,1010 
1010  IF(IPLEN) 1280,1280,1260
C     CHECK IF NEED ANY EXTRA BITS FOR 4 OR 8 BITS PROMS
1050  IDIF = IPE-IPS
      LL = 4
      IF(IDIF-3) 1070,1070,1060 
1060  LL = (1+IDIF/8)*8 
C     CHECK IF HAVE ENOUGH BITS 
1070  K = LL-(IDIF+1) 
      IF(K) 1200,1200,1110
1110  II = IPE
      DO 1120 I=1,K 
      II = II+1 
      IWBUF(II) = NDONT 
1120  CONTINUE
C     FORM HEX CHARACTERS 
1200  IF(LL-4) 1210,1210,1300 
C 
C     OUTPUT FOR 4 BIT PROMS
C 
1210  NVAL = 0
      DO 1220 I=1,4 
      K = IPS+I-1 
      NVAL = NVAL+NVAL+IWBUF(K) 
1220  CONTINUE
      NPCNT = NPCNT+1 
      NVAL = NVAL+1 
      IPLEN = IPLEN+1 
      IPBUF(IPLEN) = NUMS(NVAL) 
      IPLEN = IPLEN+1 
      IPBUF(IPLEN) = IBLNK
      IF(NPCNT-32) 9000,1260,1260 
C     OUTPUT NEXT RECORD
1260  CALL INOUT(5) 
      NPCNT = 0 
      IPLEN = 0 
      IF(IEND) 9000,9000,1280 
1280  CALL TAPEC(2) 
1290  CALL TAPEC(0) 
      GO TO 9000
C 
C 
C     OUTPUT FOR 8 OR MORE BITS 
1300  LL = LL/8 
      IS = IPS
      DO 1380 I=1,LL
      DO 1330 JJ=1,2
      NVAL = 0
      DO 1320 J=1,4 
      NVAL = NVAL+NVAL+IWBUF(IS)
      IS = IS+1 
1320  CONTINUE
      NVAL = NVAL+1 
      IPLEN = IPLEN+1 
      IPBUF(IPLEN) = NUMS(NVAL) 
1330  CONTINUE
      NPCNT = NPCNT+1 
      IPLEN = IPLEN+1 
      IPBUF(IPLEN) = IBLNK
      IF(NPCNT-16) 1380,1360,1360 
C     OUTPUT NEXT RECORD
1360  CALL INOUT(5) 
      NPCNT = 0 
      IPLEN = 0
1380  CONTINUE
C 
9000  RETURN
      END 
      SUBROUTINE OUTST
C 
C 
C     THIS ROUTINE IS USED TO OUTPUT THE OBJECT MODULE
C     IN THE STEP ENGINEERING FORMAT
C 
C 
      REAL IVAL,IVAL1,IVAL2,NOFF,NTDEP(64),NINST,INSCT
      COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMREC,IMFLE,IPFLE,IPREC,ITERM 
      COMMON IMBUF(128),IPBUF(80),IN(128),ILBUF(80),IWBUF(128),IFREC
      COMMON ISBIT,ICHBT,ICHWD,NBIT,NINST,NDONT,NCOL,NROW,NOFF,IBAT 
      COMMON LODLC,IEND,NBITT,IPS,IPE,IPLEN,IPASS,IROW,LCTL,MXREC 
      COMMON NPLIN,IWSEC,MSEC,IPROM,INDEX,IBITS,IBITE,LCOLS,LCOLE 
      COMMON INSCT,IVAL,IVAL1,IVAL2,MCOL,NPCNT,ICHAR,MSIZE,NWORD,ILLEN
      COMMON LMAP,LLIST,LPCH,INVRT,LHEX,LFILE,NAMEF(4),IERR,ICOL,ICNT 
      COMMON NPWID(32),NTWID(32),NPDEP(64),NTDEP,NVAL,MESSN,MESSF 
      COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRF,ICHRN,ICHRR,ICHR0,ICHR1
      COMMON ICHRX,IBLNK,ICOMM,IAST,IDOLR,IEQUL,IMIN,IADDR(4),NUMS(16)
      DATA ICOLN /1H:/
C 
C     *ENTRY PARAMETERS 
C     IEND  - 1 = END OF PROM 
C     IN    - CONTAINS BIT INFORMATION
C 
C     *EXIT PARAMETERS
C     IERR  - RETURN STATUS 
C             0 = VALID RETURN
C             1 = INPUT RECORD ERROR
C     ONE MICROWORD IN STEP FORMAT IS OUTPUT
C 
C 
      IERR = 0
      IPLEN = 1 
      IPBUF(1) = ICOLN
      IF(IEND .EQ. 1) GO TO 400 
C     FORM BITS 
      ICKSM = 0 
      DO 40 I=1,NBIT
      ICHAR = IN(I) 
      NN = 0
      IF(ICHAR .EQ. ICHR0) GO TO 10 
      NN = 1
      IF(ICHAR .EQ. ICHR1) GO TO 10 
      NN = NDONT
      IF(ICHAR-ICHRX) 910,20,910
10    IF(INVRT .EQ. 1) GO TO 20 
      NN = 1-NN 
20    IN(I) = NN
40    CONTINUE
C     FORM OUTPUT FORMAT
      IC = 1+(NBIT-1)/8 
      IDIF = IC*8-NBIT
      IVAL = IC 
      ICKSM = ICKSM+IC
      CALL AHEX
      IPBUF(2) = IADDR(3) 
      IPBUF(3) = IADDR(4)
      IVAL = NOFF+INSCT 
      N = IVAL/256. 
      ICKSM = ICKSM+N 
      IVAL1 = N 
      N = IVAL-IVAL1*256. 
      ICKSM = ICKSM+N 
      CALL AHEX
      IPLEN = 3 
      DO 110 I=1,4
      IPLEN = IPLEN+1 
      IPBUF(IPLEN) = IADDR(I) 
110   CONTINUE
      IPBUF(8) = ICHR0
      IPBUF(9) = ICHR0
      IPLEN = 9 
      ICOL = -IDIF
      DO 240 I=1,IC 
      DO 240 LL=1,2 
      N = 0 
      DO 220 K=1,4
      ICOL = ICOL+1 
      NN = NDONT
      IF(ICOL .LE. 0) GO TO 210 
      NN = IN(ICOL) 
210   N = N+N+NN
220   CONTINUE
      ICKSM = ICKSM+N 
      IF(LL .EQ. 2) GO TO 230 
      ICKSM = ICKSM+15*N
230   N = N+1 
      IPLEN = IPLEN+1 
      IPBUF(IPLEN) = NUMS(N)
240   CONTINUE
      IVAL1 = ICKSM 
      IVAL = 65536.-IVAL1 
      CALL AHEX
      IPLEN = IPLEN+1 
      IPBUF(IPLEN) = IADDR(3) 
      IPLEN = IPLEN+1 
      IPBUF(IPLEN) = IADDR(4)
      GO TO 500 
C 
C     OUTPUT END RECORD 
C 
400   DO 410 I=1,7
      IPLEN = IPLEN+1 
      IPBUF(IPLEN) = ICHR0
410   CONTINUE
      IPBUF(9) = ICHR1
      IPBUF(10) = NUMS(16)
      IPBUF(11) = NUMS(16)
      IPLEN = 11
500   CALL INOUT(5) 
      GO TO 990 
C 
C     INPUT DATA ERROR
C 
910   IERR = 1
990   RETURN
      END
      SUBROUTINE LOUT
C   
C   
C     THIS ROUTINE IS USED TO OUTPUT THE PROM LISTING.
C   
C   
      REAL IVAL,IVAL1,IVAL2,NOFF,NTDEP(64),NINST,INSCT
      COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMREC,IMFLE,IPFLE,IPREC,ITERM
      COMMON IMBUF(128),IPBUF(80),IN(128),ILBUF(80),IWBUF(128),IFREC
      COMMON ISBIT,ICHBT,ICHWD,NBIT,NINST,NDONT,NCOL,NROW,NOFF,IBAT
      COMMON LODLC,IEND,NBITT,IPS,IPE,IPLEN,IPASS,IROW,LCTL,MXREC
      COMMON NPLIN,IWSEC,MSEC,IPROM,INDEX,IBITS,IBITE,LCOLS,LCOLE
      COMMON INSCT,IVAL,IVAL1,IVAL2,MCOL,NPCNT,ICHAR,MSIZE,NWORD,ILLEN
      COMMON LMAP,LLIST,LPCH,INVRT,LHEX,LFILE,NAMEF(4),IERR,ICOL,ICNT
      COMMON NPWID(32),NTWID(32),NPDEP(64),NTDEP,NVAL,MESSN,MESSF
      COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRF,ICHRN,ICHRR,ICHR0,ICHR1
      COMMON ICHRX,IBLNK,ICOMM,IAST,IDOLR,IEQUL,IMIN,IADDR(4),NUMS(16)
C 
C     *ENTRY PARAMETERS 
C     IEND  - END OF LISTING FLAG 
C     IPROM - PROM NUMBER 
C     IPE   - ENDING BIT OF PROM
C     IPS   - STARTING BIT OF PROM
C     LODLC - START OF LISTING FLAG 
C 
C 
      IF(IEND) 50,50,900
50    IF(LODLC) 100,100,200 
C     INITIALIZE FOR LISTING OUTPUT OF NEXT PROM
100   WRITE(IPRT,1000) IPROM
1000  FORMAT(//,2X,2HPC,4X,3HADD,3X,4HPROM,2X,I4) 
      LODLC = 1 
200   IVAL2 = ICNT
      IVAL = NTDEP(IROW)+NOFF+IVAL2
      CALL AHEX
      DO 210 I=1,4
      ILBUF(I) = IADDR(I) 
210   CONTINUE
      IVAL = ICNT 
      CALL AHEX
      ILLEN = 4 
      DO 220 I=1,4
      ILLEN = ILLEN+1 
      ILBUF(ILLEN) = IADDR(I) 
220   CONTINUE
      IDIF = IPE-IPS+1
      IS = IPS
      DO 240 I=1,IDIF 
      ILLEN = ILLEN+1 
      K = IWBUF(IS)+1 
      ILBUF(ILLEN) = NUMS(K)
      IS = IS+1 
240   CONTINUE
      DO 260 I=1,3
      ILLEN = ILLEN+1 
      ILBUF(ILLEN) = IBLNK
260   CONTINUE
      IF(IDIF-32) 300,300,500 
C     FORM OCTAL AND HEXADECIMAL DIGITS 
300   LL = 1+(IDIF-1)/4 
      IS = IPE+1-LL*4 
      DO 360 I=1,LL 
      NVAL = 0
      DO 340 J=1,4
      IV = 0
      IF(IS-IPS) 320,310,310
310   IV = IWBUF(IS)
320   NVAL = NVAL+NVAL+IV 
      IS = IS+1 
340   CONTINUE
      NVAL = NVAL+1 
      ILLEN = ILLEN+1 
      ILBUF(ILLEN) = NUMS(NVAL) 
360   CONTINUE
      DO 380 I=1,3
      ILLEN = ILLEN+1 
      ILBUF(ILLEN) = IBLNK
380   CONTINUE
C     FORM OCTAL DIGITS 
      LL = 1+(IDIF-1)/3 
      IS = IPE+1-LL*3 
      DO 460 I=1,LL 
      NVAL = 0
      DO 440 J=1,3
      IV = 0
      IF(IS-IPS) 420,410,410
410   IV = IWBUF(IS)
420   NVAL = NVAL+NVAL+IV 
      IS = IS+1 
440   CONTINUE
      NVAL = NVAL+1 
      ILLEN = ILLEN+1 
      ILBUF(ILLEN) = NUMS(NVAL) 
460   CONTINUE
C 
C     OUTPUT LISTING
500   WRITE(IPRT,1010) (ILBUF(I),I=1,ILLEN) 
1010  FORMAT(1X,4A1,2X,4A1,3X,80A1) 
900   RETURN
      END 
      SUBROUTINE EQUAT
C 
C 
C     THIS ROUTINE EQUATES A LOGICAL DEVICE NUMBER TO A FILE NAME 
C     SO THAT AN OBJECT MODULE MAY BE READ FROM A DISK FILE.
C     THIS ROUTINE MAY HAVE TO BE CHANGED FOR SOME COMPUTERS. 
C     SEE THE OPERATION NOTES FOR DETAILS 
C 
C 
      REAL IVAL,IVAL1,IVAL2,NOFF,NTDEP(64),NINST,INSCT
      DIMENSION IFNAM(20),INC(80) 
      COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMREC,IMFLE,IPFLE,IPREC,ITERM 
      COMMON IMBUF(128),IPBUF(80),IN(128),ILBUF(80),IWBUF(128),IFREC
      COMMON ISBIT,ICHBT,ICHWD,NBIT,NINST,NDONT,NCOL,NROW,NOFF,IBAT 
      COMMON LODLC,IEND,NBITT,IPS,IPE,IPLEN,IPASS,IROW,LCTL,MXREC 
      COMMON NPLIN,IWSEC,MSEC,IPROM,INDEX,IBITS,IBITE,LCOLS,LCOLE 
      COMMON INSCT,IVAL,IVAL1,IVAL2,MCOL,NPCNT,ICHAR,MSIZE,NWORD,ILLEN
      COMMON LMAP,LLIST,LPCH,INVRT,LHEX,LFILE,NAMEF(4),IERR,ICOL,ICNT 
      COMMON NPWID(32),NTWID(32),NPDEP(64),NTDEP,NVAL,MESSN,MESSF 
      COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRF,ICHRN,ICHRR,ICHR0,ICHR1
      COMMON ICHRX,IBLNK,ICOMM,IAST,IDOLR,IEQUL,IMIN,IADDR(4),NUMS(16)
      EQUIVALENCE (ICOL,JCOL),(IN(1),INC(1))
      DATA IDIV /1H// 
C 
C     *ENTRY PARAMETERS 
C     ICOL  - STARTING POINT OF NAME
C     IN    - BUFFER THAT CONTAINS FILE NAME
C 
C     *EXIT PARAMETERS
C     ICOL  - ENDING COLUMN OF FILE NAME
C     IERR  - RETURN STATUS 
C             0 = VALID FILE FOUND
C             1 = FILE NOT FOUND
C     IPBUF - CONTAINS FILE NAME IN A1 FORMAT 
C     NAMEF - CONTAINS ARRAY NAME IN PACKED HOLLERITH 
C 
C 
      RETURN
      END
      SUBROUTINE TAPEC(ICTL)
C   
C   
C     THIS ROUTINE IS USED TO OUTPUT THE SPECIAL CHARACTERS
C     SOH (1), ETX (3) OR NUL (0).  THESE CHARACTERS MUST
C     BE PUNCHED AS ONE PAPER TAPE CHARACTER FOR THE OBJECT MODULE.
C     SINCE THESE ARE NOT STANDARD CHARACTERS THAT MAY BE DEFINED
C     IN A DATA STATEMENT, OTHER MEANS MUST BE TAKEN TO DEFINE
C     THE CORRECT VARIABLES WHICH CAN BE OUTPUT.
C     IN AN ASCII MACHINE (MOST 16 BIT COMPUTERS), IT IS SUFFICIENT
C     TO PLACE THE VALUE 0, 1 OR 3 IN THE CORRECT POSITION IN THE
C     COMPUTER WORD SO IT MAY BE OUTPUT IN A1 FORMAT.  THIS IS THE
C     CASE SINCE IN AN ASCII MACHINE, TO OUTPUT AN ASCII PAPER
C     TAPE, THE BIT PATTERN IN THE COMPUTER WORD IS PUNCHED
C     DIRECTLY ON THE TAPE WITH NO CONVERSION AS IT WOULD BE FOR
C     SAY AN EBCDIC MACHINE.  FOR ANY PARTICULAR MACHINE SOME METHOD
C     EXITS FOR PUNCHING THESE CHARACTERS WHICH CAN THEN BE USED
C     IN THIS SUBROUTINE.  SOME COMPUTERS HAVE A SUBROUTINE
C     TO OUTPUT ANY BINARY CODE ON PAPER TAPE.
C   
C     NOTE - FOR AN ASCII MACHINE WHICH IS ASSUMED FOR THIS
C     SUBROUTINE AS IT EXISTS, THE VALUES FOR SOH,ETX AND NUL ARE
C     FORMED IN THE CORRECT POSITION OF THE COMPUTER WORD BY THE
C     SUBTRACTION OF TWO STANDARD CHARACTERS.  E.G. SOH (1) CAN
C     BE FORMED BY THE CHARACTER B MINUS THE CHARACTER A SINCE
C     THEIR ASCII CODES ARE DIFFERENT BY THE VALUE 1.
C   
C   
      REAL IVAL,IVAL1,IVAL2,NOFF,NTDEP(64),NINST,INSCT
      COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMREC,IMFLE,IPFLE,IPREC,ITERM
      COMMON IMBUF(128),IPBUF(80),IN(128),ILBUF(80),IWBUF(128),IFREC
      COMMON ISBIT,ICHBT,ICHWD,NBIT,NINST,NDONT,NCOL,NROW,NOFF,IBAT
      COMMON LODLC,IEND,NBITT,IPS,IPE,IPLEN,IPASS,IROW,LCTL,MXREC
      COMMON NPLIN,IWSEC,MSEC,IPROM,INDEX,IBITS,IBITE,LCOLS,LCOLE
      COMMON INSCT,IVAL,IVAL1,IVAL2,MCOL,NPCNT,ICHAR,MSIZE,NWORD,ILLEN
      COMMON LMAP,LLIST,LPCH,INVRT,LHEX,LFILE,NAMEF(4),IERR,ICOL,ICNT
      COMMON NPWID(32),NTWID(32),NPDEP(64),NTDEP,NVAL,MESSN,MESSF
      COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRF,ICHRN,ICHRR,ICHR0,ICHR1
      COMMON ICHRX,IBLNK,ICOMM,IAST,IDOLR,IEQUL,IMIN,IADDR(4),NUMS(16)
C   
C     *ENTRY PARAMETERS
C     ICTL  - PUNCH CONTROL
C             0 = PUNCH NUL LEADER OR TRAILER
C             1 = PUNCH SOH
C             2 = PUNCH ETX
C   
C   
      INUL = 0
      ISOH = 257
      IETX = 771
      IF(ICTL-1) 100,200,300
C     PUNCH LEADER OR TRAILER
100   DO 110 I=1,60
      IPBUF(I) = INUL
110   CONTINUE
      IPLEN = 60
      GO TO 360
C     PUNCH SOH
200   IPBUF(1) = ISOH
      GO TO 350
C     PUNCH ETX
300   IPBUF(1) = IETX
350   IPLEN = 1
360   CALL INOUT(5)
      END
      SUBROUTINE AHEX
C   
C   
C     THIS SUBROUTINE CONVERTS A VALUE BETWEEN 0-65535 INTO 4
C     HEXADECIMAL CHARACTERS.  VALUES OUTSIDE THIS RANGE ARE
C     RETURNED AS ASTERISKS.
C   
C   
      REAL IHVAL,J1
      REAL IVAL,IVAL1,IVAL2,NOFF,NTDEP(64),NINST,INSCT
      COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMREC,IMFLE,IPFLE,IPREC,ITERM
      COMMON IMBUF(128),IPBUF(80),IN(128),ILBUF(80),IWBUF(128),IFREC
      COMMON ISBIT,ICHBT,ICHWD,NBIT,NINST,NDONT,NCOL,NROW,NOFF,IBAT
      COMMON LODLC,IEND,NBITT,IPS,IPE,IPLEN,IPASS,IROW,LCTL,MXREC
      COMMON NPLIN,IWSEC,MSEC,IPROM,INDEX,IBITS,IBITE,LCOLS,LCOLE
      COMMON INSCT,IVAL,IVAL1,IVAL2,MCOL,NPCNT,ICHAR,MSIZE,NWORD,ILLEN
      COMMON LMAP,LLIST,LPCH,INVRT,LHEX,LFILE,NAMEF(4),IERR,ICOL,ICNT
      COMMON NPWID(32),NTWID(32),NPDEP(64),NTDEP,NVAL,MESSN,MESSF
      COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRF,ICHRN,ICHRR,ICHR0,ICHR1
      COMMON ICHRX,IBLNK,ICOMM,IAST,IDOLR,IEQUL,IMIN,IADDR(4),NUMS(16)
C   
C     *ENTRY PARAMETERS 
C     IVAL  - VALUE TO CONVERT
C 
C     *EXIT PARAMETERS
C     IADDR - CONTAINS 4 CHARACTERS 
C     CHARACTERS SET TO * IF OUT OF RANGE 
C 
C 
      J1 = 4096.
      IF(IVAL) 20,5,5 
5     IF(IVAL-65536.) 10,20,20
10    IHVAL = IVAL
      DO 15 J=1,4 
      M1 = IHVAL/J1 
      IVAL2 = M1
      IHVAL = IHVAL-IVAL2*J1
      J1 = J1/16. 
      M1 = M1+1 
      IADDR(J) = NUMS(M1) 
15    CONTINUE
      RETURN
20    DO 25 J=1,4 
      IADDR(J) = IAST 
25    CONTINUE
      RETURN
      END 
      SUBROUTINE MESS 
C 
C 
C     THIS ROUTINE OUTPUTS ALL PROGRAM MESSAGES.
C 
C 
      REAL IVAL,IVAL1,IVAL2,NOFF,NTDEP(64),NINST,INSCT
      COMMON ICRD,IPRT,IPCH,IRDR,IFIL,IMREC,IMFLE,IPFLE,IPREC,ITERM 
      COMMON IMBUF(128),IPBUF(80),IN(128),ILBUF(80),IWBUF(128),IFREC
      COMMON ISBIT,ICHBT,ICHWD,NBIT,NINST,NDONT,NCOL,NROW,NOFF,IBAT 
      COMMON LODLC,IEND,NBITT,IPS,IPE,IPLEN,IPASS,IROW,LCTL,MXREC 
      COMMON NPLIN,IWSEC,MSEC,IPROM,INDEX,IBITS,IBITE,LCOLS,LCOLE 
      COMMON INSCT,IVAL,IVAL1,IVAL2,MCOL,NPCNT,ICHAR,MSIZE,NWORD,ILLEN
      COMMON LMAP,LLIST,LPCH,INVRT,LHEX,LFILE,NAMEF(4),IERR,ICOL,ICNT 
      COMMON NPWID(32),NTWID(32),NPDEP(64),NTDEP,NVAL,MESSN,MESSF 
      COMMON ICHRA,ICHRB,ICHRC,ICHRD,ICHRF,ICHRN,ICHRR,ICHR0,ICHR1
      COMMON ICHRX,IBLNK,ICOMM,IAST,IDOLR,IEQUL,IMIN,IADDR(4),NUMS(16)
C 
C     *ENTRY PARAMETERS 
C     MESSN - MESSAGE NUMBER
C 
C     *EXIT PARAMETERS
C     MESSF - MESSAGE FLAG - SET TO 1 
C 
C 
      GO TO(100,200,300,400,500,600,700,800,900,
     1  1000,1100,1200,1300,1400),MESSN 
C 
C     SYNTAX ERROR OR ILLEGAL CHARACTER 
100   WRITE(ITERM,110)
110   FORMAT(34H SYNTAX ERROR OR ILLEGAL CHARACTER) 
      GO TO 9000
200   WRITE(ITERM,210)
210   FORMAT(27H INVALID OBJECT FILE HEADER)
C     INVALID OBJECT FILE HEADER
      GO TO 9000
C     VALUE ERROR 
300   WRITE(ITERM,310)
310   FORMAT(12H VALUE ERROR) 
      GO TO 9000
C     TOO MANY PROM COLUMNS 
400   WRITE(ITERM,410)
410   FORMAT(22H TOO MANY PROM COLUMNS) 
      GO TO 9000
C     MICROWORD WIDTH ERROR 
500   WRITE(ITERM,510)
510   FORMAT(22H MICROWORD WIDTH ERROR) 
      GO TO 9000
C     TOO MANY PROM ROWS
600   WRITE(ITERM,610)
610   FORMAT(19H TOO MANY PROM ROWS)
      GO TO 9000
C     DEPTH ERROR 
700   WRITE(ITERM,710)
710   FORMAT(12H DEPTH ERROR) 
      GO TO 9000
C     INVALID OBJECT INPUT
800   WRITE(ITERM,810)
810   FORMAT(21H INVALID OBJECT INPUT)
      GO TO 9000
C     INVALID OPTION
900   WRITE(ITERM,910)
910   FORMAT(15H INVALID OPTION)
      GO TO 9000
C     INVALID ADDRESS 
1000  WRITE(ITERM,1010) 
1010  FORMAT(16H INVALID ADDRESS) 
      GO TO 9000
C     MAP VALUE TOO LARGE OR SAMLL
1100  WRITE(ITERM,1110) 
1110  FORMAT(29H MAP VALUE TOO LARGE OR SMALL)
      GO TO 9000
C     FILE NOT FOUND
1200  WRITE(ITERM,1210) 
1210  FORMAT(15H FILE NOT FOUND)
      GO TO 9000
C     EOF ON COMMAND INPUT
1300  WRITE(ITERM,1310) 
1310  FORMAT(' END OF FILE ON COMMAND INPUT') 
      GO TO 9000
C     EOF ON OBJECT INPUT 
1400  WRITE(ITERM,1410) 
1410  FORMAT(' END OF FILE ON OBJECT INPUT')
C 
9000  MESSF = 1 
      RETURN
      END 
T')
C 
9000  MESSF = 1 
      RETURN
      END 
