C THIS IS FILE 2 OF THE SOFTWARE TOOLS FROM LBL
C
C BLOCK DATA - INITIALIZE GLOBAL VARIABLES
C
       BLOCK DATA
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG

       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       DATA EXTBLK /1H /, INTBLK /32/
       DATA EXTDIG(1) /1H0/, INTDIG(1) /48/
       DATA EXTDIG(2) /1H1/, INTDIG(2) /49/
       DATA EXTDIG(3) /1H2/, INTDIG(3) /50/
       DATA EXTDIG(4) /1H3/, INTDIG(4) /51/
       DATA EXTDIG(5) /1H4/, INTDIG(5) /52/
       DATA EXTDIG(6) /1H5/, INTDIG(6) /53/
       DATA EXTDIG(7) /1H6/, INTDIG(7) /54/
       DATA EXTDIG(8) /1H7/, INTDIG(8) /55/
       DATA EXTDIG(9) /1H8/, INTDIG(9) /56/
       DATA EXTDIG(10) /1H9/, INTDIG(10) /57/
       DATA EXTLET(1) /1HA/, INTLET(1) /97/
       DATA EXTLET(2) /1HB/, INTLET(2) /98/
       DATA EXTLET(3) /1HC/, INTLET(3) /99/
       DATA EXTLET(4) /1HD/, INTLET(4) /100/
       DATA EXTLET(5) /1HE/, INTLET(5) /101/
       DATA EXTLET(6) /1HF/, INTLET(6) /102/
       DATA EXTLET(7) /1HG/, INTLET(7) /103/
       DATA EXTLET(8) /1HH/, INTLET(8) /104/
       DATA EXTLET(9) /1HI/, INTLET(9) /105/
       DATA EXTLET(10) /1HJ/, INTLET(10) /106/
       DATA EXTLET(11) /1HK/, INTLET(11) /107/
       DATA EXTLET(12) /1HL/, INTLET(12) /108/
       DATA EXTLET(13) /1HM/, INTLET(13) /109/
       DATA EXTLET(14) /1HN/, INTLET(14) /110/
       DATA EXTLET(15) /1HO/, INTLET(15) /111/
       DATA EXTLET(16) /1HP/, INTLET(16) /112/
       DATA EXTLET(17) /1HQ/, INTLET(17) /113/
       DATA EXTLET(18) /1HR/, INTLET(18) /114/
       DATA EXTLET(19) /1HS/, INTLET(19) /115/
       DATA EXTLET(20) /1HT/, INTLET(20) /116/
       DATA EXTLET(21) /1HU/, INTLET(21) /117/
       DATA EXTLET(22) /1HV/, INTLET(22) /118/
       DATA EXTLET(23) /1HW/, INTLET(23) /119/
       DATA EXTLET(24) /1HX/, INTLET(24) /120/
       DATA EXTLET(25) /1HY/, INTLET(25) /121/
       DATA EXTLET(26) /1HZ/, INTLET(26) /122/
       DATA EXTBIG(1) /1HA/, INTBIG(1) /65/
       DATA EXTBIG(2) /1HB/, INTBIG(2) /66/
       DATA EXTBIG(3) /1HC/, INTBIG(3) /67/
       DATA EXTBIG(4) /1HD/, INTBIG(4) /68/
       DATA EXTBIG(5) /1HE/, INTBIG(5) /69/
       DATA EXTBIG(6) /1HF/, INTBIG(6) /70/
       DATA EXTBIG(7) /1HG/, INTBIG(7) /71/
       DATA EXTBIG(8) /1HH/, INTBIG(8) /72/
       DATA EXTBIG(9) /1HI/, INTBIG(9) /73/
       DATA EXTBIG(10) /1HJ/, INTBIG(10) /74/
       DATA EXTBIG(11) /1HK/, INTBIG(11) /75/
       DATA EXTBIG(12) /1HL/, INTBIG(12) /76/
       DATA EXTBIG(13) /1HM/, INTBIG(13) /77/
       DATA EXTBIG(14) /1HN/, INTBIG(14) /78/

       DATA EXTBIG(15) /1HO/, INTBIG(15) /79/
       DATA EXTBIG(16) /1HP/, INTBIG(16) /80/
       DATA EXTBIG(17) /1HQ/, INTBIG(17) /81/
       DATA EXTBIG(18) /1HR/, INTBIG(18) /82/
       DATA EXTBIG(19) /1HS/, INTBIG(19) /83/
       DATA EXTBIG(20) /1HT/, INTBIG(20) /84/
       DATA EXTBIG(21) /1HU/, INTBIG(21) /85/
       DATA EXTBIG(22) /1HV/, INTBIG(22) /86/
       DATA EXTBIG(23) /1HW/, INTBIG(23) /87/
       DATA EXTBIG(24) /1HX/, INTBIG(24) /88/
       DATA EXTBIG(25) /1HY/, INTBIG(25) /89/
       DATA EXTBIG(26) /1HZ/, INTBIG(26) /90/
       DATA EXTCHR(1) /1H^/, INTCHR(1) /33/
       DATA EXTCHR(2) /1H"/, INTCHR(2) /34/
       DATA EXTCHR(3) /1H#/, INTCHR(3) /35/
       DATA EXTCHR(4) /1H$/, INTCHR(4) /36/
       DATA EXTCHR(5) /1H%/, INTCHR(5) /37/
       DATA EXTCHR(6) /1H&/, INTCHR(6) /38/
       DATA EXTCHR(7) /1H'/, INTCHR(7) /39/
       DATA EXTCHR(8) /1H(/, INTCHR(8) /40/
       DATA EXTCHR(9) /1H)/, INTCHR(9) /41/
       DATA EXTCHR(10) /1H*/, INTCHR(10) /42/
       DATA EXTCHR(11) /1H+/, INTCHR(11) /43/
       DATA EXTCHR(12) /1H,/, INTCHR(12) /44/
       DATA EXTCHR(13) /1H-/, INTCHR(13) /45/
       DATA EXTCHR(14) /1H./, INTCHR(14) /46/
       DATA EXTCHR(15) /1H//, INTCHR(15) /47/
       DATA EXTCHR(16) /1H:/, INTCHR(16) /58/
       DATA EXTCHR(17) /1H;/, INTCHR(17) /59/
       DATA EXTCHR(18) /1H</, INTCHR(18) /60/
       DATA EXTCHR(19) /1H=/, INTCHR(19) /61/
       DATA EXTCHR(20) /1H>/, INTCHR(20) /62/
       DATA EXTCHR(21) /1H?/, INTCHR(21) /63/
       DATA EXTCHR(22) /1H@/, INTCHR(22) /64/
       DATA EXTCHR(23) /1H /, INTCHR(23) /91/
       DATA EXTCHR(24) /1H /, INTCHR(24) /92/
       DATA EXTCHR(25) /1H!/, INTCHR(25) /93/
       DATA EXTCHR(26) /1H_/, INTCHR(26) /95/
       DATA EXTCHR(27) /1H{/, INTCHR(27) /123/
       DATA EXTCHR(28) /1H|/, INTCHR(28) /124/
       DATA EXTCHR(29) /1H}/, INTCHR(29) /125/
       DATA EXTCHR(30) /1H/, INTCHR(30) /8/
       DATA EXTCHR(31) /1H   /, INTCHR(31) /9/
       DATA EXTCHR(32) /1H\/, INTCHR(32) /33/
       DATA EXTCHR(33) /1H~/, INTCHR(33) /33/
       END
C
C COPY - COPY STANDARD INPUT TO STANDARD OUTPUT
      INTEGER C, GETCH
C
10    CONTINUE
C                       10003 INDICATES AN EOF
      IF (GETCH(C,5) .EQ. 10003)  GO TO 25
      CALL PUTCH (C, 6)
      GO TO 10
C

25    CONTINUE
      STOP
      END
C
C GETCH - GET CHARACTERS FROM FILE
C
       INTEGER FUNCTION GETCH(C, F)
       INTEGER INMAP
       INTEGER BUF(81), C
       INTEGER F, I, LASTC
       DATA LASTC /81/, BUF(81) /10/
       IF(.NOT.(BUF(LASTC) .EQ. 10 .OR. LASTC .GE. 81))   GOTO 23114
       READ(F, 1, END=10) (BUF(I), I = 1, 80)
1         FORMAT(80 A1)
       CONTINUE
       I = 1
23116  IF(.NOT.( I .LE. 80))   GOTO 23118
       BUF(I) = INMAP(BUF(I))
23117   I = I + 1
       GOTO 23116
23118  CONTINUE
       CONTINUE
       I = 80
23119  IF(.NOT.( I .GT. 0)) GOTO 23121
       IF(.NOT.(BUF(I) .NE. 32))  GOTO 23122
       GOTO 23121
23122  CONTINUE
23120   I = I - 1
       GOTO 23119
23121  CONTINUE
       BUF(I+1) = 10
       LASTC = 0
23114  CONTINUE
       LASTC = LASTC + 1
       C = BUF(LASTC)
       GETCH = C
       RETURN
10        C = 10003
       GETCH = 10003
       RETURN
       END
C PUTCH (INTERIM VERSION)  PUT CHARACTERS
C
       SUBROUTINE PUTCH(C, F)
       INTEGER BUF(81), C
       INTEGER OUTMAP
       INTEGER F, I, LASTC
       DATA LASTC /0/
       IF(.NOT.(LASTC .GE. 81 .OR. C .EQ. 10))   GOTO 23342
       IF(.NOT.( LASTC .LE. 0 ))  GOTO 23344
       WRITE(F,2)
2         FORMAT(/)
       GOTO 23345
23344  CONTINUE
       WRITE(F, 1) (BUF(I), I = 1, LASTC)
1         FORMAT(80 A1)

23345  CONTINUE
       LASTC = 0
23342  CONTINUE
       IF(.NOT.(C .NE. 10)) GOTO 23346
       LASTC = LASTC + 1
       BUF(LASTC) = OUTMAP(C)
23346  CONTINUE
       RETURN
       END
C
C INMAP - CONVERT LEFT ADJUSTED EXTERNAL REP TO RIGHT ADJ ASCII
C
       INTEGER FUNCTION INMAP(INCHAR)
       INTEGER I, INCHAR
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V
     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       IF(.NOT.(INCHAR .EQ. EXTBLK)) GOTO 23194
       INMAP = INTBLK
       RETURN
23194  CONTINUE
       DO23196I = 1, 10

       IF(.NOT.(INCHAR .EQ. EXTDIG(I))) GOTO 23198
       INMAP = INTDIG(I)
       RETURN
23198  CONTINUE
23196  CONTINUE
23197  CONTINUE
       DO23200I = 1, 26
       IF(.NOT.(INCHAR .EQ. EXTLET(I))) GOTO 23202
       INMAP = INTLET(I)
       RETURN
23202  CONTINUE
23200  CONTINUE
23201  CONTINUE
       DO23204I = 1, 26
       IF(.NOT.(INCHAR .EQ. EXTBIG(I))) GOTO 23206
       INMAP = INTBIG(I)
       RETURN
23206  CONTINUE
23204  CONTINUE
23205  CONTINUE
       DO23208I = 1, 33
       IF(.NOT.(INCHAR .EQ. EXTCHR(I))) GOTO 23210
       INMAP = INTCHR(I)
       RETURN
23210  CONTINUE
23208  CONTINUE
23209  CONTINUE
       INMAP = INCHAR
       RETURN
       END
C
C
C OUTMAP - CONVERT RIGHT ADJ ASCII TO LEFT ADJUSTED EXTERNAL REP
C
       INTEGER FUNCTION OUTMAP(INCHAR)
       INTEGER I, INCHAR
       COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
     *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
       INTEGER EXTDIG
       INTEGER INTDIG
       INTEGER EXTLET
       INTEGER INTLET
       INTEGER EXTBIG
       INTEGER INTBIG
       INTEGER EXTCHR
       INTEGER INTCHR
       INTEGER EXTBLK
       INTEGER INTBLK
       COMMON /CDEFIO/ BP, BUF(300)
       INTEGER BP
       INTEGER BUF
       COMMON /CFOR/ FORDEP, FORSTK(200)
       INTEGER FORDEP
       INTEGER FORSTK
       COMMON /CKEYWD/ SDO, SIF, SELSE, SWHILE, SBREAK, SNEXT, SFOR, SRE
     *PT, SUNTIL, VDO, VIF, VELSE, VWHILE, VBREAK, VNEXT, VFOR, VREPT, V

     *UNTIL
       INTEGER SDO(3), SIF(3), SELSE(5), SWHILE(6), SBREAK(6), SNEXT(5)
       INTEGER SFOR(4), SREPT(7), SUNTIL(6)
       INTEGER VDO(2), VIF(2), VELSE(2), VWHILE(2), VBREAK(2), VNEXT(2)
       INTEGER VFOR(2), VREPT(2), VUNTIL(2)
       COMMON /CLINE/ LEVEL, LINECT(5), INFILE(5)
       INTEGER LEVEL
       INTEGER LINECT
       INTEGER INFILE
       COMMON /CLOOK/ LASTP, LASTT, NAMPTR(200), TABLE(1500)
       INTEGER LASTP
       INTEGER LASTT
       INTEGER NAMPTR
       INTEGER TABLE
       COMMON /COUTLN/ OUTP, OUTBUF(81)
       INTEGER OUTP
       INTEGER OUTBUF
       IF(.NOT.(INCHAR .EQ. INTBLK)) GOTO 23270
       OUTMAP = EXTBLK
       RETURN
23270  CONTINUE
       DO23272I = 1, 10
       IF(.NOT.(INCHAR .EQ. INTDIG(I))) GOTO 23274
       OUTMAP = EXTDIG(I)
       RETURN
23274  CONTINUE
23272  CONTINUE
23273  CONTINUE
       DO23276I = 1, 26
       IF(.NOT.(INCHAR .EQ. INTLET(I))) GOTO 23278
       OUTMAP = EXTLET(I)
       RETURN
23278  CONTINUE
23276  CONTINUE
23277  CONTINUE
       DO23280I = 1, 26
       IF(.NOT.(INCHAR .EQ. INTBIG(I))) GOTO 23282
       OUTMAP = EXTBIG(I)
       RETURN
23282  CONTINUE
23280  CONTINUE
23281  CONTINUE
       DO23284I = 1, 33
       IF(.NOT.(INCHAR .EQ. INTCHR(I))) GOTO 23286
       OUTMAP = EXTCHR(I)
       RETURN
23286  CONTINUE
23284  CONTINUE
23285  CONTINUE
       OUTMAP = INCHAR
       RETURN
       END