SUBROUTINE FMTRB INTEGER RCOUNT INTEGER RTYPE INTEGER RSTYPE INTEGER RTMAX INTEGER RSZMAX INTEGER RECORD (41) INTEGER RSIZE INTEGER RSIZES (20) INTEGER ICLP02 COMMON /RECORD/ RCOUNT COMMON /RECORD/ RTYPE COMMON /RECORD/ RSTYPE COMMON /RECORD/ RTMAX COMMON /RECORD/ RSZMAX COMMON /RECORD/ RECORD COMMON /RECORD/ RSIZE COMMON /RECORD/ RSIZES COMMON /RECORD/ ICLP02 INTEGER ECODE INTEGER CMCHAN INTEGER RBCHAN INTEGER OBCHAN INTEGER MPCHAN INTEGER DBCHAN INTEGER TTYIN INTEGER TTYOUT COMMON /IODEFN/ ECODE COMMON /IODEFN/ CMCHAN COMMON /IODEFN/ RBCHAN COMMON /IODEFN/ OBCHAN COMMON /IODEFN/ MPCHAN COMMON /IODEFN/ DBCHAN COMMON /IODEFN/ TTYIN COMMON /IODEFN/ TTYOUT INTEGER CHAR INTEGER CHMASK INTEGER CR, LF INTEGER CRLF INTEGER BLANK, PERIOD INTEGER BLANKS, DASHES, COLONS, SLASHS INTEGER ACH, BCH, CCH, DCH, ECH, FCH INTEGER GCH, HCH, ICH, JCH, KCH, LCH INTEGER MCH, NCH, OCH, PCH, QCH, RCH INTEGER SCH, TCH, UCH, VCH, WCH, XCH INTEGER YCH, ZCH INTEGER LBRACE, RBRACE INTEGER LBRACK, RBRACK INTEGER ICLP04 COMMON /CHARAC/ CHAR COMMON /CHARAC/ CHMASK COMMON /CHARAC/ CR, LF COMMON /CHARAC/ CRLF COMMON /CHARAC/ BLANK, PERIOD COMMON /CHARAC/ BLANKS, DASHES, COLONS, SLASHS COMMON /CHARAC/ ACH, BCH, CCH, DCH, ECH, FCH COMMON /CHARAC/ GCH, HCH, ICH, JCH, KCH, LCH COMMON /CHARAC/ MCH, NCH, OCH, PCH, QCH, RCH COMMON /CHARAC/ SCH, TCH, UCH, VCH, WCH, XCH COMMON /CHARAC/ YCH, ZCH COMMON /CHARAC/ LBRACE, RBRACE COMMON /CHARAC/ LBRACK, RBRACK COMMON /CHARAC/ ICLP04 LOGICAL ERX, EOF INTEGER RBTEXT (82) INTEGER GCHAR INTEGER LINES INTEGER I, J CONTINUE 13012 CONTINUE CALL SET (DASHES, RBTEXT, 20) CALL WRLIN (MPCHAN, RBTEXT, 40) CALL SET (BLANKS, RBTEXT, 82) LINES = 1 CALL GRCORD (ERX, EOF) IF (ERX) GO TO 9998 IF (EOF) GO TO 9999 GO TO (100,200,300,400,500,600,700,800,900,1000,1100,1200,1300,140 10,1500,1600,1700,1800,1900,2000) RTYPE 100 CONTINUE CALL MOVE (RECORD(2), RBTEXT(3), 8) GO TO 5000 200 CONTINUE LINES = 0 GO TO 5000 300 CONTINUE CALL EHX (RECORD(2), RBTEXT, 5,8) GO TO 5000 400 CONTINUE LINES = 2 CALL MOVE (RECORD(2), RBTEXT(3), 40) GO TO 5000 500 CONTINUE CALL EHX (RECORD(2), RBTEXT, 5,8) CALL EHX (RECORD(3), RBTEXT, 9,12) CALL MOVE (RECORD(4), RBTEXT(7), 8) GO TO 5000 600 CONTINUE GO TO 500 700 CONTINUE CALL EHX (RECORD(2), RBTEXT, 5,8) CALL EHX (RECORD(3), RBTEXT, 9,12) CALL EHX (RECORD(4), RBTEXT, 13,16) CALL MOVE (RECORD(5), RBTEXT(9), 8) GO TO 5000 800 CONTINUE GO TO 700 900 CONTINUE CALL EHX (RECORD(2), RBTEXT, 5,8) CALL MOVE (RECORD(3), RBTEXT(5), 8) GO TO 5000 1000 CONTINUE LINES = (RSTYPE+19)/20 DO 13014 I = 1, RSTYPE CALL EHX (RECORD(I+1), RBTEXT(2*I+1), 1,4) 13014 CONTINUE GO TO 5000 1100 CONTINUE CALL EHX (RECORD(2), RBTEXT, 5,8) CALL EHX (RECORD(3), RBTEXT, 9,12) GO TO 5000 1200 CONTINUE CALL EHX (RECORD(2), RBTEXT, 5,8) CALL EHX (RECORD(3), RBTEXT, 9,12) CALL EHX (RECORD(4), RBTEXT, 13,16) GO TO 5000 1300 CONTINUE GO TO 1200 1400 CONTINUE GO TO 1100 1500 CONTINUE CALL EHX (RECORD(2), RBTEXT, 5,8) GO TO 5000 1600 CONTINUE GO TO 1500 1700 CONTINUE GO TO 1100 1800 CONTINUE GO TO 500 1900 CONTINUE 2000 CONTINUE LINES = 0 5000 CONTINUE CALL EHX (RTYPE, RBTEXT, 1, 2) CALL EHX (RSTYPE, RBTEXT, 3, 4) CALL WRLIN (MPCHAN, RBTEXT, 4) IF (LINES .NE. 0) CALL WRLIN (MPCHAN, RBTEXT (3), 40) IF (LINES .EQ. 2) CALL WRLIN (MPCHAN, RBTEXT (23), 40) GO TO 13012 9998 CONTINUE 9999 CONTINUE RETURN END