*DECK EXPAND
         PROGRAM   EXPAND (USRMAC=65,USRBPS=65,EXPTXT=65, 
     1                     ERMSGF=65,OTFIL1=65,OTFIL2=65, 
     2                     OUTPUT=65, 
     3   TAPE1=USRMAC,TAPE2=USRBPS,TAPE3=EXPTXT,
     4   TAPE11=ERMSGF, 
     5   TAPE21=OTFIL1,TAPE22=OTFIL2) 
* 
**************************************************
* *                                            * *
*   ******************************************   *
*   *                                        *   *
*   *   COPYRIGHT CONTROL DATA CORPPRATION   *   *
*   *         1979, 1980, 1981, 1982         *   *
*   *                                        *   *
*   ******************************************   *
* *                                            * *
**************************************************
* 
         IMPLICIT INTEGER (A-Z) 
* 
         DIMENSION LVLCHRS(5),LEV1MNE(4),LEV2MNE(3),LEV2MSK(3)
         DIMENSION MACLINE(80),BPSLINE(80),TXTLINE(80),NEWLINE(80)
         DIMENSION VTDEFS(8),VTDFMSK(8),VTDMPID(3)
         DIMENSION TSDEFS(10),TSDFMSK(10) 
         DIMENSION SIZDEFS(4),PICBEAN(4)
C 
      DIMENSION CPYRITE(6)
      DATA CPYRITE / "COPYRIGHT ", "CONTROL DA", "TA CORP.  ",
     X              "1979, 1980", ", 1981, 19", "82" /
C 
         DATA USRMACF/1/,USRBPSF/2/,EXPTXTF/3/, 
     1   ERRMSGF/11/
         DATA OTFBASE/20/,MAXOTF/2/ 
         DATA MAXLEV1/4/,LEV1MNE/"SYS","VRD","LFD","PLS"/ 
         DATA MAXLEV2/3/,LEV2MNE/"VT","SZ","TS"/
         DATA LEV2MSK/1,2,4/,REQDLV2/3/ 
         DATA MAXLVCH/5/,LVLCHRS/"/","+","=","-","."/ 
         DATA MXVTDFS/8/,VTDEFS/"F","L","R","D","T","C","P","I"/
         DATA VTDFMSK/1,1,1,2,4,10B,20B,40B/,REQDVTD/1/ 
         DATA VTDMPID/10000B,30000B,20000B/ 
         DATA MXSZDFS/4/,SIZDEFS/"65K","81K","96K","128K"/
         DATA PICBEAN/"0F","13","17","1F"/
         DATA MXTSDFS/10/,TSDEFS/"A","M","H","B","T","XP","XA", 
     1   "1","2","3"/ 
         DATA TSDFMSK/1,2,4,10B,20B,40B,100B, 
     1   100000B,40000B,20000B/ 
         DATA MXLTRKS/8/,MXRTRKS/4/ 
         DATA SBSTSYM/"_"/,ASCSPC2/20040B/
* 
*        GET THE USERS MACRO NAME 
* 
10100    CONTINUE 
         REWIND USRMACF 
         READ (USRMACF,1010) MACLINE
1010     FORMAT (80A1)
* 
*        ERROR IF EOF 
* 
         IF (EOF (USRMACF) .NE. 0) GO TO 60100
         MCLNDSP = 1
         GO TO (60220,60110,10110), 
     1   GETOKEN (MACLINE,MCLNDSP,MACTYPE,DELIMTR,TKNLTH,ERRMSGF) 
* 
10110    CONTINUE 
         DO 10120 I = 1,MAXLEV1 
         IF (LEV1MNE(I) .EQ. MACTYPE) 
     1   GO TO (20100,30100,50100,70100), I 
10120    CONTINUE 
* 
         GO TO 60110
* 
*        MACRO TYPE IS /SYS/
* 
20100    CONTINUE 
         IF (DELIMTR .NE. ".") GO TO 60110
* 
*        NOW FIND THE /SYS/ ENTRY IN /USRBPS/ 
* 
         REWIND USRBPSF 
20110    CONTINUE 
         READ (USRBPSF,1010) BPSLINE
         IF (EOF (USRBPSF) .NE. 0) GO TO 60300
         IF (BPSLINE(1) .EQ. "*") GO TO 20110 
         IF (BPSLINE(1) .EQ. "+") GO TO 20110 
         BPLNDSP = 1
         BPTKRTN = 1
         GO TO 40100
* 
20120    CONTINUE 
         IF (TOKEN .NE. MACTYPE) GO TO 20110
         IF (DELIMTR .EQ. ".") GO TO 20130
         IF (DELIMTR .EQ. ",") GO TO 20130
         IF (DELIMTR .NE. "=") GO TO 60170
* 
*        /SYS/ ENTRY FOUND IN USRBPS, FIND AND WRITE DEFAULT TEXT 
* 
20130    CONTINUE 
         GO TO (60180,20140), 
     1   POSNTXT (EXPTXTF,1,LVLCHRS,MAXLVCH,MACTYPE,0,0)
* 
20140    CONTINUE 
         GO TO (60180,20160,20150), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
20150    CONTINUE 
         WRITE (OTFILE,1010) TXTLINE
         GO TO 20140
* 
*        PROCESS THE FRONT PART OF THE /SYS/ DEFINITION IF PRESENT
* 
20160    CONTINUE 
         IF (DELIMTR .EQ. ".") GO TO 20260
         IF (DELIMTR .EQ. ",") GO TO 20250
         VTPROC = 0 
20170    CONTINUE 
         BPTKRTN = 2
         GO TO 40100
* 
20180    CONTINUE 
         IF ((DELIMTR .NE. "/") .AND. 
     1   (DELIMTR .NE. ",") .AND. 
     2   (DELIMTR .NE. ".")) GO TO 60170
20190    CONTINUE 
         DO 20200 I = 3,MXVTDFS 
         IF (TOKEN .EQ. VTDEFS(I)) GO TO 20210
20200    CONTINUE 
* 
         GO TO 60170
* 
20210    CONTINUE 
         J = VTDFMSK(I) 
         IF ((J .AND. VTPROC) .NE. 0) GO TO 60170 
         VTPROC = VTPROC .OR. J 
* 
*        FIND AND WRITE TEXT
* 
         GO TO (60180,20220), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,TOKEN,0)
* 
20220    CONTINUE 
         GO TO (60180,20240,20230), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
20230    CONTINUE 
         WRITE (OTFILE,1010) TXTLINE
         GO TO 20220
* 
*        DONE WITH ONE DEF, CHECK FOR MORE
* 
20240    CONTINUE 
         IF (DELIMTR .EQ. "/") GO TO 20170
* 
*        DONE WITH FRONT PART OF /SYS/, CHECK FOR BACK PART 
* 
20250    CONTINUE 
         IF (DELIMTR .EQ. ",") GO TO 20290
* 
*        NO BACK PART (TIPS)
* 
20260    CONTINUE 
         GO TO (60180,20270), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"NOTIPS",0) 
* 
20270    CONTINUE 
         GO TO (60180,99999,20280), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
20280    CONTINUE 
         WRITE (OTFILE,1010) TXTLINE
         GO TO 20270
* 
*        PROCESS BACK PART (TIP DEFS) 
* 
20290    CONTINUE 
         BPTKRTN = 3
         GO TO 40100
* 
20300    CONTINUE 
         IF (TOKEN .NE. "TS") GO TO 60170 
         IF (DELIMTR .NE. "=") GO TO 60170
         TSPROC = 0 
* 
*        /TS/ FOUND IN USRBPS, WRITE DEFAULT TEXT 
* 
         GO TO (60180,20310), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,TOKEN,0)
* 
20310    CONTINUE 
         GO TO (60180,20330,20320), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
20320    CONTINUE 
         WRITE (OTFILE,1010) TXTLINE
         GO TO 20310
* 
*        GET AND PROCESS INDIVIDUAL TIP DEFS
* 
20330    CONTINUE 
         BPTKRTN = 4
         GO TO 40100
* 
20340    CONTINUE 
         IF ((DELIMTR .NE. "/") .AND. 
     1   (DELIMTR .NE. ".")) GO TO 60170
         DO 20350 I = 1,MXTSDFS 
         IF (TOKEN .EQ. TSDEFS(I)) GO TO 20360
20350    CONTINUE 
* 
         GO TO 60170
* 
20360    CONTINUE 
         IF ((TSPROC .AND. TSDFMSK(I)) .NE. 0) GO TO 60170
         TSPROC = TSPROC .OR. TSDFMSK(I)
* 
*        GET AND WRITE TEXT 
* 
         GO TO (60180,20370), 
     1   POSNTXT (EXPTXTF,3,LVLCHRS,MAXLVCH,MACTYPE,"TS",TOKEN) 
* 
20370    CONTINUE 
         GO TO (60180,20390,20380), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
20380    CONTINUE 
         WRITE (OTFILE,1010) TXTLINE
         GO TO 20370
* 
*        DONE WITH TEXT FOR THIS TIP, CHECK FOR MORE TIPS 
* 
20390    CONTINUE 
         IF (DELIMTR .EQ. "/") GO TO 20330
         GO TO 99999
* 
*        MACRO TYPE IS /VRD/
* 
30100    CONTINUE 
         IF (DELIMTR .NE. "=") GO TO 60110
* 
*        PICK UP THE VRD NAME FROM THE USERS MACRO CALL 
* 
         GO TO (60110,60110,30110), 
     1   GETOKEN (MACLINE,MCLNDSP,VRDNAME,MCLNDLM,TKNLTH,ERRMSGF) 
* 
30110    CONTINUE 
         IF (MCLNDLM .EQ. ",") GO TO 30120
         IF (MCLNDLM .NE. ".") GO TO 60110
30120    CONTINUE 
         IF (TKNLTH .NE. 3) GO TO 60270 
         DECODE (3,3010,VRDNAME) VRDNMR1,VRDNMR2,VRDNMR3
3010     FORMAT (3R1) 
         IF ((VRDNMR1 .LT. 1RA) .OR. (VRDNMR1 .GT. 1RZ)) GO TO 60290
* 
*        NOW FIND IT IN /USRBPS/
* 
         REWIND USRBPSF 
30130    CONTINUE 
         READ (USRBPSF,1010) BPSLINE
         IF (EOF (USRBPSF) .NE. 0) GO TO 60240
         IF (BPSLINE(1) .EQ. "*") GO TO 30130 
         IF (BPSLINE(1) .EQ. "+") GO TO 30130 
         BPLNDSP = 1
         BPTKRTN = 5
         GO TO 40100
* 
30140    CONTINUE 
         IF (TOKEN .NE. MACTYPE) GO TO 30130
         IF (DELIMTR .NE. "=") GO TO 60170
* 
*        NOW GET THE VRD NAME FROM /USRBPS/ 
* 
         BPTKRTN = 6
         GO TO 40100
* 
30150    CONTINUE 
         IF (DELIMTR .NE. ",") GO TO 60170
         IF (TOKEN .NE. VRDNAME) GO TO 30130
         VRDNMLT = TKNLTH 
         LEVTKLT = 0
         IF (MCLNDLM .EQ. ".") GO TO 30180
* 
*        PROCESS THE REST OF THE USERS MACRO CALL 
* 
         GO TO (60110,60110,30160), 
     1   GETOKEN (MACLINE,MCLNDSP,TOKEN,DELIMTR,TKNLTH,ERRMSGF) 
* 
30160    CONTINUE 
         IF (DELIMTR .NE. "=") GO TO 60110
         IF (TOKEN .NE. "LEV") GO TO 60110
         GO TO (60110,60110,30170), 
     1   GETOKEN (MACLINE,MCLNDSP,LEVTKN,DELIMTR,LEVTKLT,ERRMSGF) 
* 
30170    CONTINUE 
         IF (DELIMTR .NE. ".") GO TO 60110
         IF (LEVTKLT .GT. 3) GO TO 60110
         ENCODE (4,3011,FMT) LEVTKLT
3011     FORMAT ("(R",I1,")") 
         DECODE (LEVTKLT,FMT,LEVTKN) CCLEV
* 
*        VRD NAME FOUND IN /USRBPS/, FIND AND WRITE DEFAULT TEXT
* 
30180    CONTINUE 
         GO TO (60180,30190), 
     1   POSNTXT (EXPTXTF,1,LVLCHRS,MAXLVCH,MACTYPE,0,0)
* 
30190    CONTINUE 
         GO TO (60180,30220,30200), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
30200    CONTINUE 
         GO TO (60200,30210), 
     1   GENLINE (TXTLINE,80,VRDNAME,VRDNMLT,1,NEWLINE,OTLNLTH, 
     2   SBSTSYM) 
* 
30210    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 30190
* 
30220    CONTINUE 
* 
*        PROCESS THE FRONT PART OF THE /VRD/ DEFINITION FROM /USRBPS/ 
* 
         LV2PROC = 0
         TSPROC = 0 
30230    CONTINUE 
         BPTKRTN = 7
         GO TO 40100
* 
30240    CONTINUE 
         IF (DELIMTR .NE. "=") GO TO 60170
         LV2NAME = TOKEN
         DO 30250 LEV2IDX = 1,MAXLEV2 
         IF (LV2NAME .EQ. LEV2MNE(LEV2IDX)) GO TO 30260 
30250    CONTINUE 
         GO TO 60170
* 
*        SEE IF ALREADY PROCESSED 
* 
30260    CONTINUE 
         J = LEV2MSK(LEV2IDX) 
         IF (AND (J,LV2PROC) .NE. 0) GO TO 60170
         LV2PROC = LV2PROC .OR. J 
         GO TO (30270,30370,30440), LEV2IDX 
* 
*        /VT/ FOUND IN /USRBPS/ 
* 
30270    CONTINUE 
         VTPROC = 0 
30280    CONTINUE 
         BPTKRTN = 8
         GO TO 40100
* 
30290    CONTINUE 
         IF ((DELIMTR .NE. "/") .AND. 
     1   (DELIMTR .NE. ",") .AND. 
     2   (DELIMTR .NE. ".")) GO TO 60170
         DO 30300 I = 1,MXVTDFS 
         IF (TOKEN .EQ. VTDEFS(I)) GO TO 30310
30300    CONTINUE 
* 
         GO TO 60170
* 
30310    CONTINUE 
         J = VTDFMSK(I) 
         IF (AND (J,VTPROC) .NE. 0) GO TO 60170 
         VTPROC = VTPROC .OR. J 
         IF (J .NE. VTDFMSK(1)) GO TO 30320 
         VRDTYPE = TOKEN
         VRDINDX = I
30320    CONTINUE 
* 
*        POSITION /EXPTXT/
* 
         GO TO (60180,30330), 
     1   POSNTXT (EXPTXTF,3,LVLCHRS,MAXLVCH,MACTYPE,LV2NAME,TOKEN)
* 
*        NOW READ A TEXT LINE 
* 
30330    CONTINUE 
         GO TO (60180,30350,30340), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
*        WRITE OUT THE TEXT LINE
* 
30340    CONTINUE 
         WRITE (OTFILE,1010) TXTLINE
         GO TO 30330
* 
*        NO MORE TEXT TO EXPAND 
* 
30350    CONTINUE 
         IF (DELIMTR .EQ. "/") GO TO 30280
         J = VTPROC .AND. REQDVTD 
         IF (J .NE. REQDVTD) GO TO 60170
30360    CONTINUE 
         IF (DELIMTR .EQ. ",") GO TO 30230
         J = LV2PROC .AND. REQDLV2
         IF (J .EQ. REQDLV2) GO TO 30540
         GO TO 60170
* 
*        /SZ/ FOUND IN /USRBPS/ 
* 
30370    CONTINUE 
         BPTKRTN = 9
         GO TO 40100
* 
30380    CONTINUE 
         IF ((DELIMTR .NE. ",") .AND. 
     1   (DELIMTR .NE. ".")) GO TO 60170
         DO 30390 I = 1,MXSZDFS 
         IF (TOKEN .EQ. SIZDEFS(I)) GO TO 30400 
30390    CONTINUE 
* 
         GO TO 60170
* 
*        POSITION /EXPTXT/
* 
30400    CONTINUE 
         J = TKNLTH-1 
         ENCODE (4,3040,FMT) J
3040     FORMAT ("(Z",I1,")") 
         DECODE (J,FMT,TOKEN) SIZEHEX 
         EAMM = PICBEAN(I)
         GO TO (60180,30410), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,LV2NAME,0)
* 
*        GET TEXT LINE
* 
30410    CONTINUE 
         GO TO (60180,30360,30420), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
*        EXPAND AND WRITE OUT TEXT LINE 
* 
30420    CONTINUE 
         GO TO (60200,30430), 
     1   GENLINE (TXTLINE,80,TOKEN,TKNLTH,1,NEWLINE,OTLNLTH,
     2   SBSTSYM) 
* 
30430    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 30410
* 
*        /TS/ FOUND IN /USRBPS/, FIND AND WRITE DEFAULT TEXT
* 
30440    CONTINUE 
         GO TO (60180,30450), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,LV2NAME,0)
* 
30450    CONTINUE 
         GO TO (60180,30470,30460), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
30460    CONTINUE 
         WRITE (OTFILE,1010) TXTLINE
         GO TO 30450
* 
30470    CONTINUE 
         BPTKRTN = 10 
         GO TO 40100
* 
30480    CONTINUE 
         IF ((DELIMTR .NE. "/") .AND. 
     1   (DELIMTR .NE. ",") .AND. 
     2   (DELIMTR .NE. ".")) GO TO 60170
         DO 30490 I = 1,MXTSDFS 
         IF (TOKEN .EQ. TSDEFS(I)) GO TO 30500
30490    CONTINUE 
* 
         GO TO 60170
* 
30500    CONTINUE 
         IF ((TSPROC .AND. TSDFMSK(I)) .NE. 0) GO TO 60170
         TSPROC = TSPROC .OR. TSDFMSK(I)
* 
*        POSITION /EXPTXT/
* 
         GO TO (60180,30510), 
     1   POSNTXT (EXPTXTF,3,LVLCHRS,MAXLVCH,MACTYPE,LV2NAME,TOKEN)
* 
*        EXPAND TEXT
* 
30510    CONTINUE 
         GO TO (60180,30530,30520), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
*        WRITE OUT TEXT LINE
* 
30520    CONTINUE 
         WRITE (OTFILE,1010) TXTLINE
         GO TO 30510
* 
*        NO MORE TEXT 
* 
30530    CONTINUE 
         IF (DELIMTR .EQ. "/") GO TO 30470
         GO TO 30360
* 
*        FRONT PART OF /VRD/ DEFINITION DONE
*          (FROM 30360) 
* 
30540    CONTINUE 
         GO TO (60180,30550), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"LV2END1",0)
* 
30550    CONTINUE 
         GO TO (60180,30580,30560), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
30560    CONTINUE 
         I = SIZEHEX+VTDMPID(VRDINDX) 
         ENCODE (4,3060,J) I
         GO TO (60200,30570), 
     1   GENLINE (TXTLINE,80,J,4,1,NEWLINE,OTLNLTH,SBSTSYM) 
* 
30570    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 30550
* 
30580    CONTINUE 
         GO TO (60180,30590), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"LV2END2",0)
* 
30590    CONTINUE 
         GO TO (60180,30620,30600), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
30600    CONTINUE 
         ENCODE (4,3060,I) TSPROC 
3060     FORMAT (Z4)
         GO TO (60200,30610), 
     1   GENLINE (TXTLINE,80,I,4,1,NEWLINE,OTLNLTH,SBSTSYM) 
* 
30610    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 30590
* 
30620    CONTINUE 
         IF (LEVTKLT .EQ. 0) GO TO 30710
         CCLEV0 = ASCSPC2 
         CCLEV1 = ASCSPC2 
         I = CCLEV .AND. 77B
         J = 0
         IF ((I .GE. 1RA) .AND. (I .LE. 1RZ)) J = I+40B 
         IF ((I .GE. 1R0) .AND. (I .LE. 1R9)) J = I-13B 
         IF (J .EQ. 0) GO TO 60110
         CCLEV1 = CCLEV1+J
         IF (LEVTKLT .EQ. 1) GO TO 30630
         I = SHIFT (CCLEV,-6) 
         J = I .AND. 77B
         K = 0
         IF ((J .GE. 1RA) .AND. (J .LE. 1RZ)) K = J+40B 
         IF ((J .GE. 1R0) .AND. (J .LE. 1R9)) K = J-13B 
         IF (K .EQ. 0) GO TO 60110
         L = SHIFT (K,8)
         CCLEV1 = CCLEV1+L
         IF (LEVTKLT .EQ. 2) GO TO 30630
         I = SHIFT (CCLEV,-12)
         J = I .AND. 77B
         K = 0
         IF ((J .GE. 1RA) .AND. (J .LE. 1RZ)) K = J+40B 
         IF ((J .GE. 1R0) .AND. (J .LE. 1R9)) K = J-13B 
         IF (K .EQ. 0) GO TO 60110
         CCLEV0 = CCLEV0+K
30630    CONTINUE 
         GO TO (60180,30640), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"LV2END3",0)
* 
30640    CONTINUE 
         GO TO (60180,30670,30650), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
30650    CONTINUE 
         ENCODE (4,3060,I) CCLEV0 
         GO TO (60200,30660), 
     1   GENLINE (TXTLINE,80,I,4,1,NEWLINE,OTLNLTH,SBSTSYM) 
* 
30660    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 30640
* 
30670    CONTINUE 
         GO TO (60180,30680), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"LV2END4",0)
* 
30680    CONTINUE 
         GO TO (60180,30710,30690), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
30690    CONTINUE 
         ENCODE (4,3060,I) CCLEV1 
         GO TO (60200,30700), 
     1   GENLINE (TXTLINE,80,I,4,1,NEWLINE,OTLNLTH,SBSTSYM) 
* 
30700    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 30680
* 
30710    CONTINUE 
         GO TO (60180,30720), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"LV2END5",0)
* 
30720    CONTINUE 
         GO TO (60180,30750,30730), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
30730    CONTINUE 
         GO TO (60200,30740), 
     1   GENLINE (TXTLINE,80,VRDNAME,VRDNMLT,1,NEWLINE,OTLNLTH, 
     2   SBSTSYM) 
* 
30740    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 30720
* 
30750    CONTINUE 
* 
*        PICB STUFF 
* 
         DECODE (2,3070,EAMM) A,B 
3070     FORMAT (2A1) 
         GO TO (60180,30760), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"L2ENDM1",0)
* 
30760    CONTINUE 
         GO TO (60180,30790,30770), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
30770    CONTINUE 
         GO TO (60200,30780), 
     1   GENLINE (TXTLINE,80,A,1,1,NEWLINE,OTLNLTH,SBSTSYM) 
* 
30780    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 30760
* 
30790    CONTINUE 
         GO TO (60180,30800), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"L2ENDM2",0)
* 
30800    CONTINUE 
         GO TO (60180,30830,30810), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
30810    CONTINUE 
         GO TO (60200,30820), 
     1   GENLINE (TXTLINE,80,B,1,1,NEWLINE,OTLNLTH,SBSTSYM) 
* 
30820    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 30800
* 
30830    CONTINUE 
         A = VRDNMR1+100B 
         ENCODE (2,3080,L8MACN) A 
3080     FORMAT (Z2)
         A = 0
         IF ((VRDNMR2 .GE. 1RA) .AND. (VRDNMR2 .LE. 1RZ)) 
     1   A = VRDNMR2+100B 
         IF ((VRDNMR2 .GE. 1R0) .AND. (VRDNMR2 .LE. 1R9)) 
     1   A = VRDNMR2+25B
         IF (A .EQ. 0) GO TO 60110
         B = 0
         IF ((VRDNMR3 .GE. 1RA) .AND. (VRDNMR3 .LE. 1RZ)) 
     1   B = VRDNMR3+100B 
         IF ((VRDNMR3 .GE. 1R0) .AND. (VRDNMR3 .LE. 1R9)) 
     1   B = VRDNMR3+25B
         IF (B .EQ. 0) GO TO 60110
         C = SHIFT (A,8)+B
         ENCODE (4,3060,R16MACN) C
         GO TO (60180,30840), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"L2ENDM3",0)
* 
30840    CONTINUE 
         GO TO (60180,30870,30850), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
30850    CONTINUE 
         GO TO (60200,30860), 
     1   GENLINE (TXTLINE,80,L8MACN,2,1,NEWLINE,OTLNLTH,SBSTSYM)
* 
30860    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 30840
* 
30870    CONTINUE 
         GO TO (60180,30880), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"L2ENDM4",0)
* 
30880    CONTINUE 
         GO TO (60180,99999,30890), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
30890    CONTINUE 
         GO TO (60200,30900), 
     1   GENLINE (TXTLINE,80,R16MACN,4,1,NEWLINE,OTLNLTH,SBSTSYM) 
* 
30900    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 30880
* 
*        ROUTINE GETS A TOKEN FROM /USRBPS/ 
*          RETURN VIA /BPTKRTN/ 
* 
40100    CONTINUE 
         GO TO (60140,40110,40120), 
     1   GETOKEN (BPSLINE,BPLNDSP,TOKEN,DELIMTR,TKNLTH,ERRMSGF) 
* 
*        END OF LINE
* 
40110    CONTINUE 
         READ (USRBPSF,1010) BPSLINE
         IF (EOF (USRBPSF) .NE. 0) GO TO 60140
         IF (BPSLINE(1) .NE. "+") GO TO 60170 
         BPLNDSP = 2
         GO TO 40100
* 
40120    CONTINUE 
         GO TO (20120,20180,20300,20340,30140,30150,30240,30290,
     1   30380,30480,50140,50150,50270,50290,70120,70160), BPTKRTN
* 
*        MACRO TYPE IS /LFD/
* 
50100    CONTINUE 
         IF (DELIMTR .NE. "=") GO TO 60110
* 
*        PICK UP THE LFD NAME FROM THE USERS MACRO CALL 
* 
         GO TO (60110,60110,50110), 
     1   GETOKEN (MACLINE,MCLNDSP,LFDNAME,MCLNDLM,TKNLTH,ERRMSGF) 
* 
50110    CONTINUE 
         IF (MCLNDLM .EQ. ",") GO TO 50120
         IF (MCLNDLM .NE. ".") GO TO 60110
* 
*        NOW FIND IT IN /USRBPS/
* 
50120    CONTINUE 
         REWIND USRBPSF 
50130    CONTINUE 
         READ (USRBPSF,1010) BPSLINE
         IF (EOF (USRBPSF) .NE. 0) GO TO 60260
         IF (BPSLINE(1) .EQ. "*") GO TO 50130 
         IF (BPSLINE(1) .EQ. "+") GO TO 50130 
         BPLNDSP = 1
         BPTKRTN = 11 
         GO TO 40100
* 
50140    CONTINUE 
         IF (TOKEN .NE. MACTYPE) GO TO 50130
         IF (DELIMTR .NE. "=") GO TO 60170
* 
*        NOW GET THE LFD NAME FROM /USRBPS/ 
* 
         BPTKRTN = 12 
         GO TO 40100
* 
50150    CONTINUE 
         IF (DELIMTR .EQ. ",") GO TO 50160
         IF (DELIMTR .NE. ".") GO TO 60170
50160    CONTINUE 
         IF (TOKEN .NE. LFDNAME) GO TO 50130
* 
*        PROCESS THE REST OF THE USERS MACRO CALL 
* 
         CLTKLTH = 0
         UPNTKLT = 0
         BPLNDLM = DELIMTR
         IF (MCLNDLM .NE. ",") GO TO 50190
         GO TO (60110,60110,50170), 
     1   GETOKEN (MACLINE,MCLNDSP,TOKEN,DELIMTR,TKNLTH,ERRMSGF) 
* 
50170    CONTINUE 
         IF (DELIMTR .NE. "=") GO TO 60110
         IF (TOKEN .NE. "LEV") GO TO 60110
         GO TO (60110,60110,50180), 
     1   GETOKEN (MACLINE,MCLNDSP,CLTKN,MCLNDLM,CLTKLTH,ERRMSGF)
* 
50180    CONTINUE 
         IF (MCLNDLM .NE. ".") GO TO 60110
50190    CONTINUE 
* 
*        NOW FIND AND WRITE THE DEFAULTS
* 
         GO TO (60180,50240), 
     1   POSNTXT (EXPTXTF,1,LVLCHRS,MAXLVCH,MACTYPE,0,0)
* 
*        GET TEXT LINE
* 
50240    CONTINUE 
         GO TO (60180,50260,50250), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
50250    CONTINUE 
         WRITE (OTFILE,1010) TXTLINE
         GO TO 50240
* 
*        DONE WITH DEFAULTS, DO USER LMS IF PRESENT 
* 
50260    CONTINUE 
         IF (BPLNDLM .EQ. ".") GO TO 99999
         BPTKRTN = 13 
         GO TO 40100
* 
50270    CONTINUE 
         IF (DELIMTR .NE. "=") GO TO 60170
         IF (TOKEN .NE. "LM") GO TO 60170 
* 
*        READ AND EVALUATE A /LM/ PARAMETER FROM /USRBPS/ 
* 
50280    CONTINUE 
         BPTKRTN = 14 
         GO TO 40100
* 
50290    CONTINUE 
         IF (DELIMTR .EQ. ".") GO TO 50300
         IF (DELIMTR .NE. "/") GO TO 60170
50300    CONTINUE 
         IF (TKNLTH .GT. 3) GO TO 60170 
* 
*        NOW POSITION /EXPTXTF/ 
* 
         GO TO (60180,50310), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"HLPREST",0)
* 
*        GET TEXT LINE
* 
50310    CONTINUE 
         GO TO (60180,50360,50320), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
*        EXPAND AND WRITE HELPER TEXT 
* 
50320    CONTINUE 
         GO TO (60200,50330), 
     1   GENLINE (TXTLINE,80,TOKEN,TKNLTH,2,NEWLINE,OTLNLTH,
     2   SBSTSYM) 
* 
50330    CONTINUE 
         GO TO (60200,50340), 
     1   GENLINE (NEWLINE,OTLNLTH,CLTKN,CLTKLTH,1,TXTLINE,
     2   OTLNLTH,SBSTSYM) 
* 
50340    CONTINUE 
         GO TO (60200,50350), 
     1   GENLINE (TXTLINE,OTLNLTH,UNPNTKN,UPNTKLT,1,NEWLINE,
     2   OTLNLTH,SBSTSYM) 
* 
50350    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 50310
* 
*        NOW GO FOR LFG TEXT
* 
50360    CONTINUE 
         GO TO (60180,50370), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"LFGREST",0)
* 
50370    CONTINUE 
         GO TO (60180,50400,50380), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
50380    CONTINUE 
         GO TO (60200,50390), 
     1   GENLINE (TXTLINE,80,TOKEN,TKNLTH,2,NEWLINE,OTLNLTH,
     2   SBSTSYM) 
* 
50390    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 50370
* 
*        SEE IF DONE WITH /USRBPS/ LINE 
* 
50400    CONTINUE 
         IF (DELIMTR .NE. ".") GO TO 50280
         GO TO 99999
* 
*        ERROR PROCESSORS 
* 
60100    CONTINUE 
         WRITE (ERRMSGF,6010) 
6010     FORMAT (" EMPTY MACRO CALL FILE")
         CALL MESSAGE (" EXPAND ERRORS")
         GO TO 88888
* 
* 
* 
60110    CONTINUE 
         ERRFLAG = 1
60120    CONTINUE 
         WRITE (ERRMSGF,6011) 
6011     FORMAT (" ERROR IN MACRO CALL")
60130    CONTINUE 
         CALL MESSAGE (" EXPAND ERRORS")
         GO TO 60230
* 
* 
* 
60140    CONTINUE 
         ERRFLAG = 1
60150    CONTINUE 
         WRITE (ERRMSGF,6012) 
6012     FORMAT (" ERROR IN USERBPS FILE")
60160    CONTINUE 
         CALL MESSAGE (" ERROR(S) IN USERBPS FILE") 
         GO TO 60230
* 
* 
* 
60170    CONTINUE 
         ERRFLAG = 3
         GO TO 60150
* 
* 
* 
60180    CONTINUE 
         ERRFLAG = 3
60190    CONTINUE 
         WRITE (ERRMSGF,6013) 
6013     FORMAT (" ERROR IN MACRO TEXT FILE") 
         GO TO 60130
* 
* 
* 
60200    CONTINUE 
         ERRFLAG = 3
60210    CONTINUE 
         WRITE (ERRMSGF,6020) 
6020     FORMAT (" LINE TOO LONG AFTER SUBSTITUTION") 
         GO TO 60130
* 
* 
* 
60220    CONTINUE 
         ERRFLAG = 0
         GO TO 60120
* 
* 
* 
60230    CONTINUE 
         IF (AND (ERRFLAG,1) .NE. 0)
     1   CALL PRTERLN (MACLINE,MCLNDSP,ERRMSGF) 
         IF (AND (ERRFLAG,2) .NE. 0)
     1   CALL PRTERLN (BPSLINE,BPLNDSP,ERRMSGF) 
         GO TO 88888
* 
* 
* 
60240    CONTINUE 
         WRITE (ERRMSGF,6021) VRDNAME 
6021     FORMAT (" VARIANT NAME ",A3," NOT FOUND IN USERBPS") 
60250    CONTINUE 
         CALL MESSAGE (" ERROR(S) IN USERBPS FILE") 
         GO TO 88888
* 
* 
* 
60260    CONTINUE 
         WRITE (ERRMSGF,6022) LFDNAME 
6022     FORMAT (" LOAD FILE NAME ",A3," NOT FOUND IN USERBPS") 
         GO TO 60250
* 
* 
* 
60270    CONTINUE 
         WRITE (ERRMSGF,6023) 
6023     FORMAT (" ERROR - VARIANT NAME MUST BE EXACTLY ",
     1   "3 CHARACTERS LONG") 
60280    CONTINUE 
         ERRFLAG = 1
         GO TO 60130
* 
* 
* 
60290    CONTINUE 
         WRITE (ERRMSGF,6024) 
6024     FORMAT (" ERROR - VARIANT NAME MUST BEGIN WITH ",
     1   "ALPHABETIC CHARACTER")
         GO TO 60280
* 
* 
* 
60300    CONTINUE 
         WRITE (ERRMSGF,6030) 
6030     FORMAT (" SYSTEM DEFINITION (SYS) ENTRY ", 
     1   "NOT FOUND IN USERBPS")
         GO TO 60250
* 
* 
* 
60310    CONTINUE 
         WRITE (ERRMSGF,6040) 
6040     FORMAT (" EXTRA PL-S DEFINITION (PLS) ENTRY ", 
     1   "NOT FOUND IN USERBPS")
         GO TO 60250
* 
*        MACRO TYPE IS /PLS/
* 
70100    CONTINUE 
         IF (DELIMTR .NE. ".") GO TO 60110
* 
*        FIND THE /PLS/ ENTRY IN /USRBPS/ 
* 
         REWIND USRBPSF 
70110    CONTINUE 
         READ (USRBPSF,1010) BPSLINE
         IF (EOF (USRBPSF) .NE. 0) GO TO 60310
         A = BPSLINE(1) 
         IF ((A .EQ. "*") .OR. (A .EQ. "+")) GO TO 70110
         BPLNDSP = 1
         BPTKRTN = 15 
         GO TO 40100
* 
70120    CONTINUE 
         IF (TOKEN .NE. MACTYPE) GO TO 70110
         IF (DELIMTR .NE. "=") GO TO 60170
* 
*        /PLS/ ENTRY FOUND IN /USRBPS/, WRITE FRONT DEFAULT TEXT
* 
         GO TO (60180,70130), 
     1   POSNTXT (EXPTXTF,1,LVLCHRS,MAXLVCH,MACTYPE,0,0)
* 
70130    CONTINUE 
         GO TO (60180,70150,70140), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
70140    CONTINUE 
         WRITE (OTFILE,1010) TXTLINE
         GO TO 70130
* 
*        DONE WITH FRONT DEFAULT TEXT, DO FILE NAMES
* 
70150    CONTINUE 
         BPTKRTN = 16 
         GO TO 40100
* 
70160    CONTINUE 
         IF ((DELIMTR .NE. "/") .AND. 
     1   (DELIMTR .NE. ".")) GO TO 60170
         IF (TKNLTH .GT. 7) GO TO 60170 
         GO TO (60180,70170), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"PLSMAIN",0)
* 
70170    CONTINUE 
         GO TO (60180,70200,70180), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
70180    CONTINUE 
         GO TO (60200,70190), 
     1   GENLINE (TXTLINE,80,TOKEN,TKNLTH,1,NEWLINE,OTLNLTH,
     2   SBSTSYM) 
* 
70190    CONTINUE 
         WRITE (OTFILE,1010) (NEWLINE(I), I = 1,OTLNLTH)
         GO TO 70170
* 
70200    CONTINUE 
         IF (DELIMTR .EQ. "/") GO TO 70150
* 
*        NOW WRITE END DEFAULT TEXT 
* 
         GO TO (60180,70210), 
     1   POSNTXT (EXPTXTF,2,LVLCHRS,MAXLVCH,MACTYPE,"PLSEND",0) 
* 
70210    CONTINUE 
         GO TO (60180,99999,70220), 
     1   GETXTLN (EXPTXTF,TXTLINE,LVLCHRS,MAXLVCH,OTFILE,MAXOTF,
     2   OTFBASE,ERRMSGF) 
* 
70220    CONTINUE 
         WRITE (OTFILE,1010) TXTLINE
         GO TO 70210
* 
* 
* 
88888    CONTINUE 
         CALL ABORT 
* 
* 
* 
99999    CONTINUE 
         END
* 
* 
* 
         FUNCTION   GETOKEN (LINE,DISP,TOKEN,DELIMTR,TKNLTH,ERRMSGF)
* 
*        RETURNS - 1 = ERROR FOUND, MSG ON /ERRRMSGF/ 
*                  2 = END OF LINE
*                  3 = SYMBOL FOUND 
* 
         IMPLICIT INTEGER (A-Z) 
* 
         DIMENSION LINE(80),SYMBOL(10)
* 
10100    CONTINUE 
         TKNLTH = 0 
         GETOKEN = 2
         IF (DISP .LT. 1) RETURN
         IF (DISP .GT. 80) RETURN 
* 
*        LOOK FOR DELIMITER, PICKING UP CHARS, SKIPPING BLANKS
* 
         DO 10200 I = DISP,80 
         J = LINE(I)
         IF (J .EQ. 1H ) GO TO 10200
         CHAR = SHIFT (J,6) .AND. 77B 
         IF (CHAR .GT. 44B) GO TO 11100 
         TKNLTH = TKNLTH+1
         IF (TKNLTH .GT. 10) GO TO 14100
         SYMBOL(TKNLTH) = J 
10200    CONTINUE 
* 
*        END OF LINE
* 
         IF (TKNLTH .NE. 0) GO TO 12100 
         RETURN 
* 
*        DELIMITER FOUND, FORM SYMBOL TOKEN 
* 
11100    CONTINUE 
         IF (TKNLTH .EQ. 0) GO TO 13100 
         DELIMTR = J
         DISP = I+1 
         ENCODE (TKNLTH,1110,TOKEN) (SYMBOL(I), I = 1,TKNLTH) 
1110     FORMAT (10A1)
  
         GETOKEN = 3
         RETURN 
* 
*        INCOMPLETE SYMBOL (END OF LINE BEFORE DELIMITER) 
* 
12100    CONTINUE 
         WRITE (ERRMSGF,1210) 
1210     FORMAT (" INCOMPLETE SYMBOL")
         I = 80 
         GO TO 14200
* 
*        NIL SYMBOL (NO CHARACTERS BEFORE DELIMITER)
* 
13100    CONTINUE 
         WRITE (ERRMSGF,1310) 
1310     FORMAT (" NIL SYMBOL") 
         GO TO 14200
* 
*        SYMBOL TOO BIG (.GT. 10 CHARS) 
* 
14100    CONTINUE 
         WRITE (ERRMSGF,1410) 
1410     FORMAT (" SYMBOL TOO BIG") 
14200    CONTINUE 
         GETOKEN = 1
         CALL PRTERLN (LINE,I,ERRMSGF)
99999    CONTINUE 
         END
* 
* 
* 
         SUBROUTINE   PRTERLN (ERRLINE,POSNPTR,ERRMSGF) 
* 
*        OUTPUTS AN ERRORED LINE TO THE ERROR MESSAGE FILE, TOGETHER WIT
*        A POSITION POINTER.
* 
         IMPLICIT INTEGER (A-Z) 
* 
         DIMENSION ERRLINE (80) 
* 
10100    CONTINUE 
         WRITE (ERRMSGF,1010) ERRLINE 
1010     FORMAT (1X,80A1) 
         IF (POSNPTR .LT. 1) RETURN 
         ENCODE (9,1030,FMT) POSNPTR
1030     FORMAT ("(",I2,"X,1H')") 
         WRITE (ERRMSGF,FMT)
99999    CONTINUE 
         END
* 
* 
* 
         FUNCTION   POSNTXT (UNIT,LEVEL,LVLCHRS,MAXLVCH,LEV1MNE,
     1                       LEV2MNE,LEV3MNE) 
* 
*        RETURNS - 1 = NOT FOUND
*                  2 = FOUND
* 
         IMPLICIT INTEGER (A-Z) 
* 
         DIMENSION LVLCHRS(5),LEVXMNE(3)
* 
10100    CONTINUE 
         POSNTXT = 1
         IF (LEVEL .LT. 1) RETURN 
         IF (LEVEL .GT. MAXLVCH) RETURN 
         LEVXMNE(1) = LEV1MNE 
         LEVXMNE(2) = LEV2MNE 
         LEVXMNE(3) = LEV3MNE 
         REWIND UNIT
         DO 11100 I = 1,LEVEL 
10200    CONTINUE 
         READ (UNIT,1010) CHR,MNE 
1010     FORMAT (A1,A10)
         IF (EOF (UNIT) .NE. 0) RETURN
         IF ((CHR .EQ. "*") .AND. (MNE .EQ. "SYNTAX CHK"))
     1   GO TO 12100
         IF (CHR .NE. LVLCHRS(I)) GO TO 10300 
         IF (MNE .EQ. LEVXMNE(I)) GO TO 11100 
10300    CONTINUE 
         IF (I .EQ. 1) GO TO 10200
         J = I-1
         DO 10400 K = 1,J 
         IF (CHR .EQ. LVLCHRS(K)) RETURN
10400    CONTINUE 
* 
         GO TO 10200
* 
11100    CONTINUE 
* 
12100    CONTINUE 
         POSNTXT = 2
99999    CONTINUE 
         END
* 
* 
* 
         FUNCTION   GETXTLN (UNIT,LINE,LVLCHRS,MAXLVCH,OTFILE,
     1                       MAXOTF,OTFBASE,ERRMSGF)
* 
*        RETURNS - 1 = ERROR
*                  2 = NO MORE
*                  3 = LINE PRESENT (79 CHARS IN 80)
* 
         IMPLICIT INTEGER (A-Z) 
* 
         DIMENSION LINE(80),LVLCHRS(4)
* 
10100    CONTINUE 
         GETXTLN = 2
10200    CONTINUE 
         READ (UNIT,1010) CHR,LINE
1010     FORMAT (81A1)
         IF (EOF (UNIT) .NE. 0) RETURN
         DO 10300 I = 1,MAXLVCH 
         IF (CHR .EQ. LVLCHRS(I)) GO TO 10400 
10300    CONTINUE 
* 
         GO TO 10200
* 
10400    CONTINUE 
         IF (I .LT. 4) RETURN 
         IF (I .NE. 4) GO TO 12100
* 
*        CHECK FOR /FILE/ STATEMENT 
* 
         LNDISP = 1 
         GO TO (10500,10500,11100), 
     1   GETOKEN (LINE,LNDISP,CHECK,DELIMTR,TKNLTH,ERRMSGF) 
* 
10500    CONTINUE 
         GETXTLN = 1
         RETURN 
* 
11100    CONTINUE 
         IF (CHECK .NE. "FILE") GO TO 10500 
         IF (DELIMTR .NE. "=") GO TO 10500
         IF (LNDISP .GT. 79) GO TO 10500
         DECODE (1,1110,LINE(LNDISP)) OTFILE
1110     FORMAT (I1)
         IF (OTFILE .LT. 1) GO TO 10500 
         IF (OTFILE .GT. MAXOTF) GO TO 10500
         OTFILE = OTFILE+OTFBASE
         GO TO 10200
* 
*        LEVEL 5 FOUND
* 
12100    CONTINUE 
         GETXTLN = 3
99999    CONTINUE 
         END
* 
* 
* 
         FUNCTION   GENLINE (INLINE,INLNLTH,TOKEN,TKNLTH,NBRSUBS, 
     1                       OTLINE,OTLNLTH,SBSTSYM)
* 
*        GENERATES AN OUTPUT LINE OF TEXT, ALLOWING UP TO /NBRSUBS/ 
*        SUBSTITUTIONS OF ONE SYMBOL. 
* 
*        RETURNS - 1 = ERROR (SUBSTITUTION OVERRAN OUTPUT LINE) 
*                  2 = OK 
* 
         IMPLICIT INTEGER (A-Z) 
* 
         DIMENSION INLINE(80),OTLINE(80)
* 
10100    CONTINUE 
         GENLINE = 1
         OTPTR = 1
         OKTOSUB = NBRSUBS
         DO 10600 INPTR = 1,INLNLTH 
         IF (OKTOSUB .EQ. 0) GO TO 10200
         IF (INLINE(INPTR) .EQ. SBSTSYM) GO TO 10300
10200    CONTINUE 
         OTLINE(OTPTR) = INLINE(INPTR)
         OTPTR = OTPTR+1
         GO TO 10500
* 
10300    CONTINUE 
         IF (TKNLTH .LT. 1) GO TO 10400 
         J = OTPTR+TKNLTH-1 
         IF (J .GT. 80) RETURN
         DECODE (TKNLTH,1010,TOKEN) (OTLINE(I), I = OTPTR,J)
1010     FORMAT (80A1)
         OTPTR = OTPTR+TKNLTH 
10400    CONTINUE 
         OKTOSUB = OKTOSUB-1
10500    CONTINUE 
         IF (OTPTR .GT. 80) GO TO 10700 
10600    CONTINUE 
* 
10700    CONTINUE 
         OTLNLTH = OTPTR-1
         GENLINE = 2
99999    CONTINUE 
         END
* 
* 
* 
         FUNCTION   CKNUM (TOKEN,TKNLTH,INTEGER)
* 
*        THIS FUNCTION CHECKS A TOKEN FOR BEING NUMERIC (POSITIVE INTEGE
*        WITH NO SIGN, MAX 10 DIGITS).  IF SO, CONVERTS TO INTEGER FORM.
* 
*        RETURNS - 0 = BAD
*                  1 = OK 
* 
         IMPLICIT INTEGER (A-Z) 
* 
         DIMENSION A1ARY(10)
* 
10100    CONTINUE 
         CKNUM = 0
         IF (TKNLTH .LT. 1) RETURN
         IF (TKNLTH .GT. 10) RETURN 
         DECODE (TKNLTH,1010,TOKEN) (A1ARY(I), I = 1,TKNLTH)
1010     FORMAT (10A1)
         DO 10200 I = 1,TKNLTH
         J = A1ARY(I) 
         IF ((J .LT. "0") .OR. (J .GT. "9")) RETURN 
10200    CONTINUE 
* 
         ENCODE (5,1020,FMT) TKNLTH 
1020     FORMAT ("(I",I2,")") 
         DECODE (TKNLTH,FMT,TOKEN) INTEGER
         CKNUM = 1
99999    CONTINUE 
         END
* 
* 
* 
         FUNCTION   CKHEX (TOKEN,TKNLTH,INTEGER)
* 
*        THIS FUNCTION CHECKS A TOKEN FOR BEING A VALID HEX NUMBER
*        (MAX 10 CHARS).  IF SO, CONVERTS TO INTEGER FORM.
* 
*        RETURNS - 0 = BAD
*                  1 = OK 
* 
         IMPLICIT INTEGER (A-Z) 
* 
         DIMENSION A1ARY(10)
* 
10100    CONTINUE 
         CKHEX = 0
         IF (TKNLTH .LT. 1) RETURN
         IF (TKNLTH .GT. 10) RETURN 
         DECODE (TKNLTH,1010,TOKEN) (A1ARY(I), I = 1,TKNLTH)
1010     FORMAT (10A1)
         DO 10200 I = 1,TKNLTH
         J = A1ARY(I) 
         IF ((J .GE. "0") .AND. (J .LE. "9")) GO TO 10200 
         IF ((J .LT. "A") .OR. (J .GT. "Z")) RETURN 
10200    CONTINUE 
* 
         ENCODE (5,1020,FMT) TKNLTH 
1020     FORMAT ("(Z",I2,")") 
         DECODE (TKNLTH,FMT,TOKEN) INTEGER
         CKHEX = 1
99999    CONTINUE 
         END
* 
* 
* 
          IDENT  ABTMSG 
          SYSCOM B1 
          SST 
          TITLE  ABORT/MESSAGE - ISSUE MESSAGE AND/OR ABORT.
          ENTRY  ABORT
          ENTRY  MESSAGE
 ABORT    SPACE  4,10 
**        ABORT - ABORT CPU PROGRAM.
* 
*         R.L. STRASSBURG          81/04/17.
*         R.W. HEIN                81/05/13.
* 
*         ENTRY  NONE.
* 
*         FORTRAN CALL. 
*                CALL ABORT 
* 
*         EXIT   TO SYSTEM VIA *ABT*.  ALL FILES WITH POINTERS IN 
*                *FLSHCON* WILL BE FLUSHED (HAVE EOR WRITTEN).
* 
*         USES   A - 1, 2, 3, 4, 5. 
*                B - 1. 
*                X - 0, 1, 2, 3, 4, 5.
* 
*         CALLS  WRITER, ABORT MACROS.
* 
*         NOTE - NAMES OF FILES TO BE FLUSHED MUST BE ASSEMBLED 
*                INTO AREA *FLSHCON*. 
  
 FLSHCON  BSS    0
          CON    =XERMSGF#
          CON    =XOTFIL1#
          CON    =XOTFIL2#
          CON    0
  
 ABORT    PS                 ENTRY. 
          SB1    1
          SA5    FLSHCON-1
 ABT1     SA5    A5+B1       GET LIST ENTRY 
          ZR     X5,ABT2     IF END OF LIST 
          MX0    42 
          SA1    X5 
          BX1    X0*X1
          ZR     X1,ABT1     IF NO FILE NAME IN FET 
          SA1    X5+B1       FIRST
          SA2    A1+B1       IN 
          SA3    A2+B1       OUT
          SA4    A3+B1       LIMIT
          SX1    X1          EXTEND SIGN
          SX4    X4 
          ZR     X1,ABT1     IF FIRST=0 
          ZR     X2,ABT1     IF IN=0
          ZR     X3,ABT1     IF OUT=0 
          ZR     X4,ABT1     IF LIMIT=0 
          WRITER X5          DUMP BUFFER
          EQ     ABT1        CK NEXT ENTRY
  
 ABT2     ABORT 
 MESSAGE  SPACE  4,10 
**        MESSAGE - ISSUE DAYFILE AND/OR B-DISPLAY MESSAGE. 
* 
*         R.L. STRASSBURG          81/05/05.
* 
*         ENTRY  (X1) = MESSAGE ADDRESS.
*                ((A1)+1) = MESSAGE OPTION (OPTIONAL).
* 
*         FORTRAN CALL. 
*         1. CALL MESSAGE (MSG) 
*         2. CALL MESSAGE (MSG,OPT) 
* 
*         FORM 1 - ISSUE MESSAGE *MSG* WITH OPTION=0. 
*         FORM 2 - ISSUE MESSAGE *MSG* WITH OPTION *OPT*. 
* 
*         EXIT   NONE.
* 
*         USES   A - 1, 2.
*                B - NONE.
*                X - 1, 2.
* 
*         CALLS  MESSAGE MACRO. 
  
 MESSAGE  PS                 ENTRY/EXIT.
          SA2    A1+1        GET OPTION 
          ZR     X2,MSG1     IF DEFAULT OPTION
          SA2    X2          GET OPTION 
 MSG1     MESSAGE X1,X2 
          EQ     MESSAGE
  
         END
