00040024 PROGRAM RATFOR0028C ******************0028C * FILE=RATRT.RAT *0028C ******************0005C0080C====================== RT11-DEC VERSION OF RATFOR ========================0005C0073C THIS FILE CONTAINS THE COMPUTER/SYSTEM SPECIFIC PARTS OF RATFOR0005C0073C This is the "driver" module for RATFOR for RT-11 V3B or later. This0077C version of RATFOR was derived from RATFOR-11 Version 20 (PCN# 94) which0061C was implemented by David Sykes (see below) for RSX-11M.0005C^^^^^^^^^^^^^^^^0074C The RT-11 CSI provides virtually the same services as the "ICSI.RAT"0075C module used with the RSX version. The switches are only one character0068C long instead of two and negation of switches is not supported.0074C There is no print spooler. So the switches have changed from the RSX0014C version:0005C0071C /C - Compress FORTRAN output by dropping blanks0062C /D{:n} - Process debug lines to level "n".0064C If ":n" not given, n defaults to 1.^^^^^0074C /H - Display switch information at user's terminal0078C /L:FOR - Include generated FORTRAN code on RATFOR listing.0079C /L:DEF - Include symbolic constant table in RATFOR listing.0073C /L:LC - Output generated FORTRAN code in lower case.0080C /L:CND - Include code within unsatisfied IFDEF's in listing.0076C /R - Retain define table from previous command line.0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0073C The "/GO" switch of the RSX-11 version has been replaced by two new0060C switches (/F and /X) which take advantage of the RT-110041C DEC Command Language System (DCLS):0005C0077C /F - Pass RT-11 a "FORTRAN filename" command line, so0073C that the FORTRAN compiler will automatically0076C process RATFOR's generated code. The "filename"0076C is the same as the first filename in the RATFOR^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0042C command line.0076C /X - Pass RT-11 a "EXECUTE/FORTRAN filename" command0074C line. This causes a complete compile,link and0076C run sequence to follow RATFOR's completion. The0074C "filename" is derived as in the /F switch. In0053C RATDEF.RT, there is a DEFINE which defines0055C a filespec for the /LINKLIBRARY switch. It is0045C currently defined as SY:FOROTS.OBJ.0005C^^^^^^^^^^^^0073C In the interest of cleanliness, the old style "CALL ASSIGN" I/O has0074C been deleted. All file hookups use the "OPEN" statements. This means0075C that this version will run under FORTRAN-11/RT-11 Version 2 or later,0035C but not under old Version 1C.0005C0074C Wherever possible, the original RATRSX.RAT code has been left alone.0054C The new RT-11 code is not identified explicitly.0005C0040C RATFOR-11/RSX Version 20 courtesy:0005C0020C David P. Sykes0039C American Management Systems, Inc.^^^^^^^^^^^^^0023C 1515 Wilson Blvd.0026C Arlington Va. 222090020C (703) 841-60860005C0023C RT-11 Conversion:0005C0021C Robert B. Denny0032C Creative System Design Co.0039C 3452 E. Foothill Blvd. Suite 6010026C Pasadena, Ca. 911070020C (213) 355-68360005C0060C Experimental Version X20.0 13-Mar-80 Initial version0066C Experimental Version X20.1 18-Mar-80 Many fixes throughout0065C Experimental Version X20.2 21-Mar-80 I'm getting there...0072C Experimental Version X20.3 22-Mar-80 Fix handling, it runs.^^^^0073C Prototype Version Y20.4 25-Mar-80 Audit cleanup. For Spring 800038C DECUS. "V" revision when we0034C get field test results.0005C0005C0079C==========================================================================0005C0005C0076CFILE=DEFIN.RAT ===== GENERAL CHARACTER SET DEFINITIONS ===============0048C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT.0005C0045C ******************0043C FILE=RATDEF.RT0045C ******************0005C^0075C==============DEFINITIONS FOR RT-11 RATFOR PREPROCESSOR===============0005C0044CLINK LIBRARY FOR COMPILE/LINK/GO OPTION0005C0080C===========================================================================0054C ******************************0054C * R A T F O R / R T - 1 1 *0054C ******************************0005C0019C MAIN PROGRAM:0005C0074C CONTAINS CODE TO HANDLE USER/OS INTERFACE, GETTING THE COMMAND LINE,^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0068C PARSING THE COMMAND LINE, ACTING ON "IMMEDIATE" SWITCHES, FILE0020C HANDLING, ETC.0005C0021C Robert B. Denny0032C Creative System Design Co.0039C 3452 E. Foothill Blvd. Suite 6010026C Pasadena, Ca. 911070020C (213) 355-68360005C0073C Prototype Version Y20.4 25-Mar-80 Audit cleanup. For Spring 800038C DECUS. "V" revision when we0034C get field test results.0005C0005C0022 INTEGER DOIT0021 INTEGER ERR0024 INTEGER BADOPT0034 LOGICAL * 1 PROMPT ( 6 )^^^^^^^^^^^^^^^^^^^^0035 LOGICAL * 1 FTNFIL ( 16 )0005C0039C FILE = CFILES.RT FOR RT-11 RATFOR0073 COMMON / FILES / SPEC, SWITCH, DEFEXT, LSTOPT, F4CODE, DEFTAB, 0020 $FSPEC, CLB0029 INTEGER SPEC ( 39 )0034 INTEGER SWITCH ( 4, 10 )0030 INTEGER DEFEXT ( 4 )0030 INTEGER LSTOPT ( 4 )0024 INTEGER F4CODE0024 INTEGER DEFTAB0034 LOGICAL * 1 FSPEC ( 16 )0032 LOGICAL * 1 CLB ( 84 )0005C0059C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP76^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0074 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, 0015 $DEBUG0021 INTEGER LST0023 INTEGER PLINE0022 INTEGER PAGE0024 INTEGER ERRORS0024 INTEGER OUTPUT0023 INTEGER IFPNT0023 INTEGER DEBUG0005C0036C FILE= CUCLC.RAT FOR RATFOR0037 COMMON / CUCLC / LC, COMPRS0020 INTEGER LC0024 INTEGER COMPRS0005C0030 LOGICAL * 1 REF (26)0075 DATA REF/1H ,1H ,1H ,1H ,1H ,1H ,1HR,1HA,1HT,1HF,1HO,1HR,1H ,1HE,^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0056 $1HR,1HR,1HO,1HR,1HS,1H ,1HF,1HO,1HU,1HN,1HD,0/0048 DATA DEFEXT / 3RRAT, 3RFOR, 3RLST, 0 /0051 DATA LSTOPT / 3RCND, 3RDEF, 3RFOR, 2RLC /0054 DATA PROMPT / 1HR, 1HA, 1HT, 1H>, 1H , 128 /0005C0032C SWITCH DATA INITIALIZATION0005C0038 DATA SWITCH ( 1, 1 ) / 1HC /0038 DATA SWITCH ( 1, 2 ) / 1HD /0038 DATA SWITCH ( 1, 3 ) / 1HF /0038 DATA SWITCH ( 1, 4 ) / 1HH /0038 DATA SWITCH ( 1, 5 ) / 1HL /0038 DATA SWITCH ( 1, 6 ) / 1HL /^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0038 DATA SWITCH ( 1, 7 ) / 1HL /0038 DATA SWITCH ( 1, 8 ) / 1HL /0038 DATA SWITCH ( 1, 9 ) / 1HR /0039 DATA SWITCH ( 1, 10 ) / 1HX /0005C0079C==========================================================================0005C0019C *** START ***0005C0047 CALL PRINT ( 19HRATFOR/RT-11 Y20.4 )0005C0054C THIS PROGRAM RUNS UNTIL ^C OR FATAL ERROR, SO...001820000 CONTINUE0023 CLB ( 1 ) = 00020 CALL HEADR0005C0049C GET THE COMMAND LINE, DO IMMEDIATE SWITCHES0005C0020 BADOPT = 00029 DO 20003 I = 1, 390024 SPEC ( I ) = 0001820003 CONTINUE001820004 CONTINUE0021 CALL RCTRLO0028 CALL PRINT ( ' ' )0036 CALL GTLIN ( CLB, PROMPT )0052 I = ICSI ( SPEC, DEFEXT, CLB, SWITCH, 10 )0041 GO TO ( 10, 11, 12, 13 ), I + 10005C005710 IF (.NOT.( SWITCH ( 2, 4 ) .GT. 0 )) GOTO 200050021 CALL RATHLP0020 GOTO 200010005C001820005 CONTINUE0071 IF (.NOT.( SPEC ( 1 ) .EQ. 0 .AND. SPEC ( 6 ) .EQ. 0 )) GOTO 0015 $200070020 GOTO 200010005C^^^^^^^^0065C-------------------- DO NORMAL SWITCHES --------------------0005C0042C ** LIST OPTIONS DEFAULT TO 'NO' **001820007 CONTINUE0019 IFPNT = 00016 LC = 00020 F4CODE = 00020 DEFTAB = 00005C0077C GET UP TO 4 /L:xxx SWITCHES. ABORT CLI INTERPRETATION IF ILLEGAL OPT.0005C0018 CONTINUE0016 I = 5007220009 IF (.NOT.( SWITCH ( 2, I ) .GT. 0 .AND. I .LE. 8 .AND. BADOPT 0029 $.EQ. 0)) GOTO 200110068 IF (.NOT.( SWITCH ( 4, I ) .EQ. LSTOPT ( 1 ) )) GOTO 20012^^^^^^^^^^^^^^^^^0019 IFPNT = 10020 GOTO 20010001820012 CONTINUE0068 IF (.NOT.( SWITCH ( 4, I ) .EQ. LSTOPT ( 2 ) )) GOTO 200140020 DEFTAB = 10020 GOTO 20010001820014 CONTINUE0068 IF (.NOT.( SWITCH ( 4, I ) .EQ. LSTOPT ( 3 ) )) GOTO 200160020 F4CODE = 10020 GOTO 20010001820016 CONTINUE0068 IF (.NOT.( SWITCH ( 4, I ) .EQ. LSTOPT ( 4 ) )) GOTO 200180016 LC = 10020 GOTO 20010001820018 CONTINUE0020 BADOPT = 1001820019 CONTINUE0005C002020010 I = I + 1 ^^^^^^^^^^^^^^^^^^0020 GOTO 20009001820011 CONTINUE0048 IF (.NOT.( BADOPT .EQ. 1 )) GOTO 200200055 CALL PRINT ( 'Bad /L:xxx option, try again' )0020 GOTO 200010005C0005C001820020 CONTINUE0057 IF (.NOT.( SWITCH ( 2, 1 ) .GT. 0 )) GOTO 200220020 COMPRS = 10020 GOTO 20023001820022 CONTINUE0020 COMPRS = 00005C001820023 CONTINUE0057 IF (.NOT.( SWITCH ( 2, 2 ) .LE. 0 )) GOTO 200240022 DEBUG = 99990020 GOTO 20025001820024 CONTINUE^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0057 IF (.NOT.( SWITCH ( 2, 2 ) .EQ. 2 )) GOTO 200260033 DEBUG = SWITCH ( 4, 2 )0020 GOTO 20027001820026 CONTINUE0019 DEBUG = 10005C001820027 CONTINUE001820025 CONTINUE0057 IF (.NOT.( SWITCH ( 2, 9 ) .GT. 0 )) GOTO 200280018 DOIT = 00020 GOTO 20029001820028 CONTINUE0018 DOIT = 10005C0073C ** OTHER SWITCHES (/F, /X) CHECKED PRIOR TO TRYING NEXT CMD LINE **0005C0005C0072C---------------------OPEN FORTRAN OUTPUT FILE----------------------0005C0005C001820029 CONTINUE^^^^^0052 IF (.NOT.( SPEC ( 1 ) .NE. 0 )) GOTO 200300027 CALL FSCONV ( 1 )0047 CALL SCOPY ( FSPEC, FTNFIL, 16, ERR )0075 OPEN ( UNIT = 8, NAME = FSPEC, TYPE = 'NEW', INITIALSIZE = SPEC (0026 $ 5 ), ERR = 20 )0020 OUTPUT = 10020 GOTO 20031001820030 CONTINUE0072 IF (.NOT.( F4CODE .EQ. 1 .AND. SPEC ( 6 ) .NE. 0 )) GOTO 200320075 OPEN ( UNIT = 8, NAME = 'RATSCR.DAT', TYPE = 'SCRATCH', ERR = 21 0011 $)0020 OUTPUT = 10020 GOTO 20033001820032 CONTINUE^^^^^^^^^^^0020 OUTPUT = 00005C0005C0072C------------------------OPEN LISTING FILE--------------------------0005C0005C001820033 CONTINUE001820031 CONTINUE0052 IF (.NOT.( SPEC ( 6 ) .NE. 0 )) GOTO 200340027 CALL FSCONV ( 6 )0075 OPEN ( UNIT = 6, NAME = FSPEC, TYPE = 'NEW', INITIALSIZE = SPEC (0053 $ 10 ), CARRIAGECONTROL = 'LIST', ERR = 22 )0023 LST ( 1 ) = 10020 GOTO 20035001820034 CONTINUE0023 LST ( 1 ) = 00005C0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0072C--------------------PROCESS ALL INPUT FILES------------------------0005C0005C001820035 CONTINUE0029 CALL RATGO ( DOIT )0018 CONTINUE0017 J = 16006720036 IF (.NOT.( SPEC ( J ) .NE. 0 .AND. J .LE. 36)) GOTO 200380027 CALL FSCONV ( J )0065 OPEN ( UNIT = 1, NAME = FSPEC, TYPE = 'OLD', ERR = 23 )0020 CALL PARSE0028 CLOSE ( UNIT = 1 )0020 GOTO 200370005C005323 CALL PRINT ( 'Open failure on input file' )0030 CALL PRINT ( FSPEC )0020 GOTO 200380005C0005C^^^0072C----------------FINISH UP FOR THIS COMMAND LINE--------------------0005C0005C002020037 J = J + 4 0020 GOTO 20036001820038 CONTINUE0048 IF (.NOT.( DEFTAB .EQ. 1 )) GOTO 200390021 CALL DEFLST001820039 CONTINUE0048 IF (.NOT.( F4CODE .EQ. 1 )) GOTO 200410021 CALL DUMPIT001820041 CONTINUE0051 IF (.NOT.( LST ( 1 ) .EQ. 1 )) GOTO 200430028 CLOSE ( UNIT = 6 )0005C001820043 CONTINUE0048 IF (.NOT.( ERRORS .GT. 0 )) GOTO 200450021 CALL RCTRLO^^^^^^^^^^^^^^^^^^^^^^^^^^^0045 CALL SITOC ( ERRORS, REF ( 1 ), 5 )0028 CALL PRINT ( REF )0055 CLOSE ( UNIT = 8, DISP = 'DELETE', ERR = 30 )001830 CONTINUE0020 GOTO 20046001820045 CONTINUE0038 CLOSE ( UNIT = 8, ERR = 31 )001831 CONTINUE0005C0005C0072C---------------CHAIN TO FORTRAN OR FORTRAN/LINK/GO-----------------0005C0005C001820046 CONTINUE0072 IF (.NOT.( SWITCH ( 2, 3 ) .NE. 0 .AND. OUTPUT .EQ. 1 )) GOTO 0015 $200470057 CALL SCOPY ( 'FORTRAN/NOSWAP ', SPEC, 81, ERR )^^^^^^^^^^^^^^^^^^itoc(int, str, size) integer abs, mod integer d, i, int, intval, j, k, size character str(size) # string digits "0123456789" integer digits(11) data digits(1) /DIG0/ data digits(2) /DIG1/ data digits(3) /DIG2/ data digits(4) /DIG3/ data digits(5) /DIG4/ data digits(6) /DIG5/ data digits(7) /DIG6/ data digits(8) /DIG7/ data digits(9) /DIG8/ data digits(10) /DIG9/ data digits(11) /EOS/ intval = abs(int) str(1) = EOS i = 1 repeat0082C=======================REPEAT FOR NEW COMMAND LINE===========================0005C001820049 CONTINUE0020 GOTO 200010005C0082C=============================================================================0005C0037C ERRORS COME HERE BEFORE LOOPING0005C005111 CALL PRINT ( 'Syntax error, try again.' )0020 GOTO 20001005312 CALL PRINT ( 'Unknown device, try again.' )0020 GOTO 20001005113 CALL PRINT ( 'Option error, try again.' )0020 GOTO 20001^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^006220 CALL PRINT ( 'Open failure on FORTRAN output file' )0020 GOTO 20001006521 CALL PRINT ( 'Open failure on scratch file, unit DK:' )0020 GOTO 20001005222 CALL PRINT ( 'Open failure on list file' )0020 GOTO 200010005C002020001 GOTO 20000001820002 CONTINUE0013 END0005 00040033 SUBROUTINE FSCONV ( I )0005C0077C FSCONV -- CONVERT RAD50 FILESPECS FROM ICSI TO ASCII STRING FOR FORTRAN0005C0011C CALL:0020C CALL FSCONV(I)0005C0013C INPUTS:^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0065C I = ELEMENT IN "SPECS" USED BY ICSI OF START OF RAD50 SPEC.0005C0014C OUTPUTS:0061C ASCII FILESPEC STRING IN COMMON CHARACTER ARRAY "FSPEC"0005C0014C COMMONS:0049C FILES -- HAS ARRAYS AND SWITCHES FOR FILES.0005C0023C SUBROUTINES USED:0020C R50ASC (SYSF4)0005C0021C Robert B. Denny0032C Creative System Design Co.0039C 3452 E. Foothill Blvd. Suite 6010026C Pasadena, Ca. 911070020C (213) 355-68360005C0073C Prototype Version Y20.4 25-Mar-80 Audit cleanup. For Spring 80^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0038C DECUS. "V" revision when we0034C get field test results.0065C------------------------------------------------------------0005C0005C0039C FILE = CFILES.RT FOR RT-11 RATFOR0073 COMMON / FILES / SPEC, SWITCH, DEFEXT, LSTOPT, F4CODE, DEFTAB, 0020 $FSPEC, CLB0029 INTEGER SPEC ( 39 )0034 INTEGER SWITCH ( 4, 10 )0030 INTEGER DEFEXT ( 4 )0030 INTEGER LSTOPT ( 4 )0024 INTEGER F4CODE0024 INTEGER DEFTAB0034 LOGICAL * 1 FSPEC ( 16 )^^^^^^^^^^^^^^^^^^^^^^^^^^^^0032 LOGICAL * 1 CLB ( 84 )0005C0029 DO 20051 J = 1, 160027 FSPEC ( J ) = 1H 001820051 CONTINUE001820052 CONTINUE0052 CALL R50ASC ( 3, SPEC ( I ), FSPEC ( 1 ) )0033 DO 20053 J = 4, 2, - 10059 IF (.NOT.( FSPEC ( J - 1 ) .NE. 1H )) GOTO 200550020 GOTO 20054001820055 CONTINUE001820053 CONTINUE001820054 CONTINUE0027 FSPEC ( J ) = 1H:0060 CALL R50ASC ( 6, SPEC ( I + 1 ), FSPEC ( J + 1 ) )0019 K = J + 70033 DO 20057 J = K, 4, - 1^^^^^^^^^^^^^^^^^^^^^^^^^^0059 IF (.NOT.( FSPEC ( J - 1 ) .NE. 1H )) GOTO 200590020 GOTO 20058001820059 CONTINUE001820057 CONTINUE001820058 CONTINUE0027 FSPEC ( J ) = 1H.0060 CALL R50ASC ( 3, SPEC ( I + 3 ), FSPEC ( J + 1 ) )0029 FSPEC ( J + 4 ) = 00005C0016 RETURN0013 END0005 00040027 SUBROUTINE DUMPIT0005C0063C DUMPIT - TO LIST GENERATED FORTRAN SOURCE CODE ON PRINTER0005C0005C0028 INTEGER FLINE, ERR0030 LOGICAL * 1 FF ( 2 )0026 LOGICAL * 1 LERR0005C^^^^^^^^^^^^^^^^^^^^^^^^^^0035C FILE=CPRTLN.RAT FOR RATFOR0063 COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )0024 INTEGER FORTYP0023 INTEGER IFTYP0023 INTEGER READY0028 LOGICAL * 1 PRTBUF0005C0027 DATA FF / 12, 0 /0005C0018 REWIND 80034 CALL RATLST ( FF, 0, 0 )0019 FLINE = 0001820061 CONTINUE0045 CALL GETSTR ( 8, PRTBUF, 90, LERR )0046 IF (.NOT.( LERR .NE. 0 )) GOTO 200640048 IF (.NOT.( LERR .EQ. - 1 )) GOTO 200660020 GOTO 20063001820066 CONTINUE^^^^^^^^^^^^^0063 CALL ERROR ( 35HError reading .FOR file for listing )001820067 CONTINUE0020 GOTO 20065001820064 CONTINUE0055 IF (.NOT.( PRTBUF ( 1 ) .EQ. 12 )) GOTO 200680019 FLINE = 0001820068 CONTINUE0073 IF (.NOT.( PRTBUF ( 1 ) .EQ. 67 .OR. PRTBUF ( 6 ) .EQ. 36 .OR. 0044 $PRTBUF ( 1 ) .EQ. 12 )) GOTO 200700038 CALL RATLST ( PRTBUF, 0, 0 )0020 GOTO 20071001820070 CONTINUE0027 FLINE = FLINE + 10042 CALL RATLST ( PRTBUF, 0, FLINE )^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0071 IF (.NOT.( ( PRTBUF ( 7 ) .EQ. 73 .AND. PRTBUF ( 8 ) .EQ. 70 0075 $.AND. PRTBUF ( 9 ) .EQ. 32 ) .OR. ( PRTBUF ( 7 ) .EQ. 105 .AND. 0074 $PRTBUF ( 8 ) .EQ. 102 .AND. PRTBUF ( 9 ) .EQ. 32 ) )) GOTO 200720027 FLINE = FLINE + 1001820072 CONTINUE001820071 CONTINUE001820065 CONTINUE0005C002020062 GOTO 20061001820063 CONTINUE0016 RETURN0013 END0005 00040042 INTEGER FUNCTION GETLIN ( BUFR )0005C0069C GETLIN - TO READ IN ANOTHER LINE FROM THE INPUT FILE FOR NGETCH^^^^^^^^^^^^^^0062C# IF LINE BEGINS WITH A '%' IN COL. 1, TRANSFER IT TO THE0068C# OUTPUT FILE WITH NO PROCESSING AT ALL EXCEPT DELETE THE '%'.0070C# ALSO, TRANSFER FULL LINE COMMENTS ('#' IN COL 1) TO OUTPUT FILE0072C# ALSO, LIST EACH LINE AS IT IS READ.EXCEPT WITHIN UNDEFINED IFDEFS0040C# IF THE /N:CND SWITCH IS PRESENT.0069C INTERPRET DEBUG LINES ("?" IN COL 1) AS WELL. PROCESS THEM IF0075C THE LEVEL SPECIFIED IN THE SECOND COL IS >= SPECIFIED DEBUG LEVEL.0005C0026C ----REVISION #1----^^^^^^^^^^^^^^^^^^^^^^^^^0072C FIX HANDLING OF FORMFEEDS. REMOVE FROM THE INPUT BUFFER AND FORCE0027C NEW PAGE IN LISTING.0018C R. B. DENNY0016C 22-MAR-800035C MAKES RATFOR/RT VERSION 20.30026C -------------------0005C0030 INTEGER I, ERR, SLEN0033 LOGICAL * 1 BUFR ( 91 )0026 LOGICAL * 1 LERR0005C0041C FILE = CLINE.RAT FOR RATFOR.RAT0065C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING0067 COMMON / CLINE / LEVEL, INFILE ( 3 ), LINECT, INIF, FTNLN0023 INTEGER LEVEL^^^^^^^^^^^^^^^^^^^^^^^0024 INTEGER INFILE0024 INTEGER LINECT0022 INTEGER INIF0023 INTEGER FTNLN0005C0035C FILE=CPRTLN.RAT FOR RATFOR0063 COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )0024 INTEGER FORTYP0023 INTEGER IFTYP0023 INTEGER READY0028 LOGICAL * 1 PRTBUF0005C0059C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP760074 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, 0015 $DEBUG0021 INTEGER LST0023 INTEGER PLINE^^^^^^^^^^^^^^^^^^^^^0022 INTEGER PAGE0024 INTEGER ERRORS0024 INTEGER OUTPUT0023 INTEGER IFPNT0023 INTEGER DEBUG0005C0036C FILE= CUCLC.RAT FOR RATFOR0037 COMMON / CUCLC / LC, COMPRS0020 INTEGER LC0024 INTEGER COMPRS0005C0032 LOGICAL * 1 DLEVL (11)0005C0063 DATA DLEVL/1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H ,0/0020 GETLIN = 1001820074 CONTINUE0021 CALL PRTLIN0058 CALL GETSTR ( INFILE ( LEVEL ), BUFR, 90, LERR )0046 IF (.NOT.( LERR .NE. 0 )) GOTO 20077^^^^^^0048 IF (.NOT.( LERR .EQ. - 1 )) GOTO 200790026 GETLIN = ( - 3 )0016 RETURN001820079 CONTINUE0053 CALL ERROR ( 25HError reading input file. )001820080 CONTINUE0020 GOTO 20078001820077 CONTINUE0029 CALL STRIM ( BUFR )0005C0052C# SPECIAL HANDLING OF RATFOR PROCESSOR FEATURES0005C0032 I = INDEX ( BUFR, 12 )0043 IF (.NOT.( I .GT. 0 )) GOTO 200810022 PLINE = 99990027 J = SLEN ( BUFR )0043 IF (.NOT.( J .EQ. 1 )) GOTO 200830019 READY = 0^^^^^^^^^^^^^^^^^^0020 GOTO 20075001820083 CONTINUE0043 IF (.NOT.( I .EQ. J )) GOTO 200850024 BUFR ( I ) = 00020 GOTO 20086001820085 CONTINUE0032 DO 20087 K = I, J - 10037 BUFR ( K ) = BUFR ( K + 1 )001820087 CONTINUE001820088 CONTINUE0024 BUFR ( J ) = 0001820086 CONTINUE0005C001820081 CONTINUE0046 CALL SCOPY ( BUFR, PRTBUF, 90, ERR )0019 READY = 10005C0053 IF (.NOT.( BUFR ( 1 ) .EQ. 63 )) GOTO 200890073 IF (.NOT.( INDEX ( DLEVL, BUFR ( 2 ) ) .GE. DEBUG )) GOTO 20091^^^0025 BUFR ( 1 ) = 320025 BUFR ( 2 ) = 320020 GOTO 20092001820091 CONTINUE0020 GOTO 200750005C001820092 CONTINUE001820089 CONTINUE0073 IF (.NOT.( BUFR ( 1 ) .NE. 37 .AND. BUFR ( 1 ) .NE. 35 )) GOTO 0015 $200930020 GOTO 200760005C001820093 CONTINUE0046 IF (.NOT.( INIF .EQ. 1 )) GOTO 200950020 GOTO 20075001820095 CONTINUE0053 IF (.NOT.( BUFR ( 1 ) .EQ. 37 )) GOTO 200970042 CALL PUTLIN ( BUFR ( 2 ), 8, 0 )0027 FTNLN = FTNLN + 10020 GOTO 20098^^^^^^001820097 CONTINUE0048 IF (.NOT.( COMPRS .EQ. 0 )) GOTO 200990025 BUFR ( 1 ) = 670036 CALL PUTLIN ( BUFR, 8, 0 )001820099 CONTINUE001820098 CONTINUE001820096 CONTINUE001820078 CONTINUE0005C002020075 GOTO 20074001820076 CONTINUE0016 RETURN0013 END0005 00040043 SUBROUTINE GETNAM ( BUFR, LSTIT )0005C0053C GETNAM - GET THE FILE NAME OF AN INCLUDED FILE.0083C INCLUDE/NL FILE AND INCLUDE FILE/NL BOTH OK, BUT 2ND WON'T BE LISTED RIGHT.0005C0037C LEFT ALONE FROM THE RSX VERSION0005C^0005C0034 INTEGER LSTIT, LEN, SKIP0047 LOGICAL * 1 NGETCH, CHAR, BUFR ( 16 )0005C0017 LEN = 00018 SKIP = 00019 LSTIT = 10005C0048CSINCE THE STRING MAY CONTAIN SEVERAL TOKENS0063C AND EVEN SEMICOLONS, FORCE READ THE REST OF THIS LINE AND0039C TAKE IT TO BE THE FILE NAME SPEC.0005C007520101 IF (.NOT.( NGETCH ( CHAR ) .NE. 10 .AND. CHAR .NE. 35 .AND. LEN 0031 $.LT. 16 )) GOTO 201020065 IF (.NOT.( SKIP .EQ. 1 .AND. CHAR .EQ. 32 )) GOTO 201030018 SKIP = 0^^^^^^^^^^^^^^^^^^0020 GOTO 20104001820103 CONTINUE0047 IF (.NOT.( CHAR .EQ. 47 )) GOTO 201050018 SKIP = 10019 LSTIT = 00020 GOTO 20106001820105 CONTINUE0073 IF (.NOT.( CHAR .NE. 32 .AND. CHAR .NE. 9 .AND. SKIP .EQ. 0 )) 0020 $GOTO 201070023 LEN = LEN + 10029 BUFR ( LEN ) = CHAR001820107 CONTINUE001820106 CONTINUE001820104 CONTINUE0020 GOTO 20101001820102 CONTINUE0030 CALL PUTBAK ( CHAR )0005C0030 BUFR ( LEN + 1 ) = 00005C0016 RETURN0013 END0005 0004^^^^^^^0026 SUBROUTINE HEADR0005C0064C HEADR - TO FILL IN DAY,DATE,TIME FOR RATLST'S PAGE HEADER.0005C0040C REMOVED DAY OF WEEK CODE FOR RT-110005C0005C0038C FILE = CDATIM.RAT FOR RATFOR0040 COMMON / CDATIM / DATIM ( 25 )0027 LOGICAL * 1 DATIM0005C0033 DATA DATIM / 25 * 1H /0005C0035 CALL DATE ( DATIM ( 6 ) )0036 CALL TIME ( DATIM ( 17 ) )0026 DATIM ( 25 ) = 00005C0016 RETURN0013 END0005 00040026 SUBROUTINE OPENI0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0049C OPENI - TO OPEN INCLUDED FILES FOR RATFOR.0005C0067C THE LUN FOR EACH INPUT FILE IS STORED IN INFILE(LEVEL),WHERE0058C LEVEL IS THE INCLUSION LEVEL (BASIC INPUT FILE=1).0068C CURRENTLY, THE LUN=THE INCLUSION LEVEL; INFILE(LEVEL)=LEVEL.0072C IF THE INCLUDE FILE ISN'T FOUND AND THERE WAS NO DEVICE SPECIFIED0072C (I.E., "DK:" DEFAULT), ANOTHER ATTEMPT IS MADE WITH "SY:" AS THE0061C DEVICE. THIS ALLOWS COMMON INCLUDES TO BE KEPT ON SY:0005C0046 LOGICAL * 1 BUFR ( 16 ), BUF2 ( 16 )^^^^^^^^^0025 INTEGER I, IERR0005C0041C FILE = CLINE.RAT FOR RATFOR.RAT0065C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING0067 COMMON / CLINE / LEVEL, INFILE ( 3 ), LINECT, INIF, FTNLN0023 INTEGER LEVEL0024 INTEGER INFILE0024 INTEGER LINECT0022 INTEGER INIF0023 INTEGER FTNLN0005C0059C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP760074 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, 0015 $DEBUG0021 INTEGER LST^^^^^^^^^^^^^^^^^^^0023 INTEGER PLINE0022 INTEGER PAGE0024 INTEGER ERRORS0024 INTEGER OUTPUT0023 INTEGER IFPNT0023 INTEGER DEBUG0005C0029 LOGICAL * 1 RAT (5)0005C0037 DATA RAT/1H.,1HR,1HA,1HT,0/0047 IF (.NOT.( LEVEL .GE. 3 )) GOTO 201090056 CALL ERROR ( 28HINCLUDE's too deeply nested. )0005C001820109 CONTINUE0037 CALL GETNAM ( BUFR, LSTIT )0027 LEVEL = LEVEL + 10034 INFILE ( LEVEL ) = LEVEL0031 LST ( LEVEL ) = LSTIT0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0060 IF (.NOT.( INDEX ( BUFR, 46 ) .EQ. 0 )) GOTO 201110048 CALL SJOIN ( BUFR, RAT, 16 - 1, IERR )0005C001820111 CONTINUE0021 CALL ERRSNS0072 OPEN ( UNIT = INFILE ( LEVEL ), NAME = BUFR, READONLY, TYPE = 0027 $'OLD', ERR = 11 )0016 RETURN0005C003011 CALL ERRSNS ( IERR )0074 IF (.NOT.( IERR .EQ. 28 .AND. INDEX ( BUFR, 58 ) .EQ. 0 )) GOTO 0015 $201130024 BUF2 ( 1 ) = 00037 CALL SINSRT ( 3HSY:, BUF2 )0049 CALL SJOIN ( BUF2, BUFR, 16 - 1, IERR )^^^^^^^^^^^0021 CALL ERRSNS0072 OPEN ( UNIT = INFILE ( LEVEL ), NAME = BUF2, READONLY, TYPE = 0027 $'OLD', ERR = 12 )0016 RETURN0005C0057C IF WE GOT THIS FAR, ALL EFFORTS TO OPEN FILE FAILED001820113 CONTINUE005612 CALL ERROR ( 28HOpen failure on INCLUDE file )0016 RETURN0005C0013 END0005 00040027 SUBROUTINE PRTLIN0005C0059C PRTLIN - PRINT A LINE OF SOURCE ON THE RATFOR LISTING0005C0077C IF LISTING (BOTH IN GENERAL AND AT THIS PARTICULAR TIME), FIGURE OUT IF^^^^^^^^^^^^^^^^^^^^^^^^0080C THIS LINE (WHICH IS THE ONE JUST PROCESSED, ONE BEHIND THE ONE JUST READ)0079C NEEDS RATFOR LINE NUMBER, FTN LINE NUMBER, BOTH, OR NEITHER. CALL RATLST0076C TO PRINT THE LINE WITH THE CORRECT NUMBER(S). ALSO CONVERT COMMENTS TO0084C LOWER CASE, IF NEEDED. ALSO KEEP FTN LINE NUMBERS STRAIGHT (NO SMALL PROBLEM).0078C ARRANGE TO ALWAYS PRINT IFDEF,IFNOTDEF,ENDIF LINES WITH RATFOR NUMBERS,0053C TO LIST PROPERLY, THESE MUST BE IN UPPER CASE.^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0064C NOTE THAT DUMPIT AND DEFLST ALSO USE PRTBUF TO SAVE SPACE.0005C0005C0051 INTEGER EQLS, I, FUDGE, KLUGE, FORCIF, IT0005C0041C FILE = CLINE.RAT FOR RATFOR.RAT0065C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING0067 COMMON / CLINE / LEVEL, INFILE ( 3 ), LINECT, INIF, FTNLN0023 INTEGER LEVEL0024 INTEGER INFILE0024 INTEGER LINECT0022 INTEGER INIF0023 INTEGER FTNLN0005C0035C FILE=CPRTLN.RAT FOR RATFOR^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0063 COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 91 )0024 INTEGER FORTYP0023 INTEGER IFTYP0023 INTEGER READY0028 LOGICAL * 1 PRTBUF0005C0059C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP760074 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, 0015 $DEBUG0021 INTEGER LST0023 INTEGER PLINE0022 INTEGER PAGE0024 INTEGER ERRORS0024 INTEGER OUTPUT0023 INTEGER IFPNT0023 INTEGER DEBUG0005C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0036C FILE= CUCLC.RAT FOR RATFOR0037 COMMON / CUCLC / LC, COMPRS0020 INTEGER LC0024 INTEGER COMPRS0005C0032 LOGICAL * 1 DLEVL (11)0031 LOGICAL * 1 INCLU (8)0031 LOGICAL * 1 ENDIF (9)0032 LOGICAL * 1 IFDEFS (6)0031 LOGICAL * 1 IFNOT (9)0030 LOGICAL * 1 DEFI (7)0030 LOGICAL * 1 MACR (6)0005C0063 DATA DLEVL/1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H ,0/0051 DATA INCLU/1HI,1HN,1HC,1HL,1HU,1HD,1HE,0/^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0055 DATA ENDIF/1HE,1HN,1HD,1HI,1HF,1HD,1HE,1HF,0/0044 DATA IFDEFS/1HI,1HF,1HD,1HE,1HF,0/0055 DATA IFNOT/1HI,1HF,1HN,1HO,1HT,1HD,1HE,1HF,0/0046 DATA DEFI/1HD,1HE,1HF,1HI,1HN,1HE,0/0042 DATA MACR/1HM,1HA,1HC,1HR,1HO,0/0070 IF (.NOT.( LST ( 1 ) .EQ. 1 .AND. READY .EQ. 1 )) GOTO 201150018 CONTINUE0017 IT = 1007520117 IF (.NOT.( PRTBUF ( IT ) .EQ. 32 .OR. PRTBUF ( IT ) .EQ. 9)) GOTO0016 $ 20119002220118 IT = IT + 1 0020 GOTO 20117001820119 CONTINUE^^^^^^^^^^^^^^0075 IF (.NOT.( ( EQLS ( PRTBUF ( IT ), IFDEFS ) .EQ. 1 ) .OR. ( EQLS 0057 $( PRTBUF ( IT ), IFNOT ) .EQ. 1 ) )) GOTO 201200020 FORCIF = 10020 GOTO 20121001820120 CONTINUE0020 FORCIF = 00005C001820121 CONTINUE0073 IF (.NOT.( INIF .EQ. 0 .OR. IFPNT .EQ. 1 .OR. FORCIF .EQ. 1 )) 0020 $GOTO 201220044 IF (.NOT.( LC .EQ. 1 )) GOTO 201240034 I = INDEX ( PRTBUF, 35 )0043 IF (.NOT.( I .GT. 0 )) GOTO 201260040 CALL FOLD ( PRTBUF ( I + 1 ) )001820126 CONTINUE0005C^^0037C DON'T NUMBER UNPROCESSED LINES0005C001820124 CONTINUE0071 IF (.NOT.( ( PRTBUF ( 1 ) .EQ. 35 ) .OR. ( INIF .EQ. 1 .AND. 0075 $FORCIF .EQ. 0 ) .OR. ( PRTBUF ( 1 ) .EQ. 63 .AND. INDEX ( DLEVL,0052 $ PRTBUF ( 2 ) ) .LT. DEBUG ) )) GOTO 201280038 CALL RATLST ( PRTBUF, 0, 0 )0005C0074C RATFOR LINE NUMBER ONLY ON UNPROCESSED LINES AND PROCESSOR FEATURES0005C0020 GOTO 20129001820128 CONTINUE0075 IF (.NOT.( ( EQLS ( PRTBUF ( IT ), ENDIF ) .EQ. 1 ) .OR. ( EQLS ^^^^^^^^^^^^^^^^^^^0073 $( PRTBUF ( IT ), MACR ) .EQ. 1 ) .OR. ( EQLS ( PRTBUF ( IT ), 0073 $DEFI ) .EQ. 1 ) .OR. ( EQLS ( PRTBUF ( IT ), INCLU ) .EQ. 1 ) 0042 $.OR. FORCIF .EQ. 1 )) GOTO 201300074 IF (.NOT.( ( LEVEL .GT. 1 ) .AND. ( PRTBUF ( IT + 7 ) .EQ. 47 ) 0071 $.AND. ( EQLS ( PRTBUF ( IT ), INCLU ) .EQ. 1 ) )) GOTO 201320019 KLUGE = 10027 LST ( LEVEL ) = 10020 GOTO 20133001820132 CONTINUE0019 KLUGE = 0001820133 CONTINUE0043 CALL RATLST ( PRTBUF, LINECT, 0 )^^^^^^^^^^^^^^^0029 LINECT = LINECT + 10047 IF (.NOT.( KLUGE .EQ. 1 )) GOTO 201340027 LST ( LEVEL ) = 0001820134 CONTINUE0005C0062C RATFOR AND FORTRAN NUMBERS ON LINES THAT GENERATED CODE0005C0020 GOTO 20131001820130 CONTINUE0048 IF (.NOT.( FORTYP .EQ. 1 )) GOTO 201360019 FUDGE = 10020 GOTO 20137001820136 CONTINUE0019 FUDGE = 0001820137 CONTINUE0055 CALL RATLST ( PRTBUF, LINECT, FTNLN - FUDGE )0029 LINECT = LINECT + 10047 IF (.NOT.( IFTYP .EQ. 1 )) GOTO 20138^^^^^^^^0027 FTNLN = FTNLN + 1001820138 CONTINUE0005C001820131 CONTINUE001820129 CONTINUE0019 READY = 0001820122 CONTINUE0019 IFTYP = 00020 FORTYP = 00005C001820115 CONTINUE0016 RETURN0013 END0005 00040048 SUBROUTINE PUTLIN ( BUF, FIL, FMTCHR )0005C0058C PUTLIN - WRITE A LINE OF FORTRAN CODE TO OUTPUT FILE0005C0079C IF OUTPUT IS TO FORTRAN FILE (STDOUT), MAKE FINAL DECISION ABOUT OUTPUT.0084C IF OUTPUT IS TO ANOTHER FILE (EG LISTING), ASSUME CALLER HAS ALREADY DECIDED.0005C0005C0026 INTEGER ERR, FIL0040 LOGICAL * 1 BUF ( 91 ), FMTCHR0059C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP760074 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, 0015 $DEBUG0021 INTEGER LST0023 INTEGER PLINE0022 INTEGER PAGE0024 INTEGER ERRORS0024 INTEGER OUTPUT0023 INTEGER IFPNT0023 INTEGER DEBUG0005C0005C0075 IF (.NOT.( ( OUTPUT .EQ. 1 .AND. FIL .EQ. 8 ) .OR. FIL .NE. 8 )) 0020 $GOTO 20140^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0047 CALL PUTSTR ( FIL, BUF, FMTCHR, ERR )0045 IF (.NOT.( ERR .EQ. 0 )) GOTO 201420016 RETURN001820142 CONTINUE0054 CALL ERROR ( 26HText output error - PUTLIN )001820143 CONTINUE0005C001820140 CONTINUE0016 RETURN0013 END0005 00040049 SUBROUTINE RATLST ( BUFR, LINE, FLINE )0005C0065C RATLST - TO PRINT A LINE ON LISTING & DO PAGE HOUSEKEEPING.0005C0005C0045 INTEGER N, LINE, SITOC, JUNK, FLINE0048 LOGICAL * 1 BUFR ( 1 ), OUTBUF ( 133 )0005C^^^^^^^^^^^^^^^^^^^^^^^^^^0039C FILE = CFILES.RT FOR RT-11 RATFOR0073 COMMON / FILES / SPEC, SWITCH, DEFEXT, LSTOPT, F4CODE, DEFTAB, 0020 $FSPEC, CLB0029 INTEGER SPEC ( 39 )0034 INTEGER SWITCH ( 4, 10 )0030 INTEGER DEFEXT ( 4 )0030 INTEGER LSTOPT ( 4 )0024 INTEGER F4CODE0024 INTEGER DEFTAB0034 LOGICAL * 1 FSPEC ( 16 )0032 LOGICAL * 1 CLB ( 84 )0005C0059C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP760074 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, ^^^^^0015 $DEBUG0021 INTEGER LST0023 INTEGER PLINE0022 INTEGER PAGE0024 INTEGER ERRORS0024 INTEGER OUTPUT0023 INTEGER IFPNT0023 INTEGER DEBUG0005C0041C FILE = CLINE.RAT FOR RATFOR.RAT0065C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING0067 COMMON / CLINE / LEVEL, INFILE ( 3 ), LINECT, INIF, FTNLN0023 INTEGER LEVEL0024 INTEGER INFILE0024 INTEGER LINECT0022 INTEGER INIF0023 INTEGER FTNLN0005C0038C FILE = CDATIM.RAT FOR RATFOR0040 COMMON / CDATIM / DATIM ( 25 )0027 LOGICAL * 1 DATIM0005C0033 LOGICAL * 1 STARSS (13)0005C0062C ERRORS (LINE=HUGE) WITHIN INCLUDED/NL FILES ARE LISTED,0005C0072 DATA STARSS/1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,1H*,0/0016 N = 1004620144 IF (.NOT.( N .LE. LEVEL)) GOTO 201460072 IF (.NOT.( LST ( N ) .EQ. 0 .AND. LINE .LE. 9999 )) GOTO 201470016 RETURN0005C001820147 CONTINUE002020145 N = N + 1 0020 GOTO 20144001820146 CONTINUE^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0072 IF (.NOT.( PLINE .GT. 57 .OR. BUFR ( 1 ) .EQ. 12 )) GOTO 201490027 OUTBUF ( 1 ) = 120026 OUTBUF ( 2 ) = 00039 CALL PUTLIN ( OUTBUF, 6, 32 )0027 OUTBUF ( 1 ) = 320039 CALL PUTLIN ( OUTBUF, 6, 32 )0039 CALL PUTLIN ( OUTBUF, 6, 32 )0039 CALL PUTLIN ( OUTBUF, 6, 32 )0025 PAGE = PAGE + 10034 CALL SPAD ( OUTBUF, 77 )0062 CALL SINSRT ( 19HRATFOR/RT-11 Y20.4, OUTBUF ( 1 ) )0046 CALL SINSRT ( DATIM, OUTBUF ( 35 ) )^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^0047 CALL SINSRT ( 4HPAGE, OUTBUF ( 71 ) )0049 JUNK = SITOC ( PAGE, OUTBUF ( 77 ), 4 )0039 CALL PUTLIN ( OUTBUF, 6, 32 )0036 CALL PUTLIN ( CLB, 6, 32 )0027 OUTBUF ( 1 ) = 320026 OUTBUF ( 2 ) = 00039 CALL PUTLIN ( OUTBUF, 6, 32 )0039 CALL PUTLIN ( OUTBUF, 6, 32 )0019 PLINE = 60053 IF (.NOT.( BUFR ( 1 ) .EQ. 12 )) GOTO 201510016 RETURN001820151 CONTINUE001820149 CONTINUE0026 OUTBUF ( 1 ) = 00033 CALL SPAD ( OUTBUF, 7 )^^^^^^^^^^^^^^^^^^^^^^^^^^^0047 IF (.NOT.( FLINE .GT. 0 )) GOTO 201530027 OUTBUF ( 1 ) = 400046 N = SITOC ( FLINE, OUTBUF ( 2 ), 4 )0031 OUTBUF ( N + 2 ) = 41001820153 CONTINUE0046 IF (.NOT.( LINE .GT. 0 )) GOTO 201550049 IF (.NOT.( LINE .GT. 9999 )) GOTO 201570049 CALL SCOPY ( STARSS, OUTBUF, 15, JUNK )0020 GOTO 20158001820157 CONTINUE0048 JUNK = SITOC ( LINE, OUTBUF ( 7 ), 5 )001820158 CONTINUE001820155 CONTINUE0034 CALL SPAD ( OUTBUF, 21 )0016 N = 1^^^^^^^^^^^^^^^^^^^^^^^^^^^004220159 IF (.NOT.( N .LE. 3)) GOTO 201610051 IF (.NOT.( N .LE. LEVEL - 1 )) GOTO 201620032 OUTBUF ( 11 + N ) = 42001820162 CONTINUE002020160 N = N + 1 0020 GOTO 20159001820161 CONTINUE0062 CALL SCOPY ( BUFR, OUTBUF ( 14 + 3 ), 132 - 14 - 3 )0039 CALL PUTLIN ( OUTBUF, 6, 32 )0027 PLINE = PLINE + 10016 RETURN0013 END0005 00040035 SUBROUTINE SYNERR ( MSG )0005C0041C SYNERR - REPORT RATFOR SYNTAX ERROR0005C0005C0047 LOGICAL * 1 BUFOUT ( 91 ), MSG ( 91 )^^^^^^^0026 INTEGER I, LASTC0040 EQUIVALENCE ( BUFOUT, HEADER )0041C FILE= COUTLN.RAT FOR RATFOR.RAT0047 COMMON / COUTLN / OUTP, OUTBUF ( 91 )0022 INTEGER OUTP0028 LOGICAL * 1 OUTBUF0059C FILE = CLIST. RAT FOR RATFOR.RAT ; SYKES,26SEP760074 COMMON / CLIST / LST ( 3 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, 0015 $DEBUG0021 INTEGER LST0023 INTEGER PLINE0022 INTEGER PAGE0024 INTEGER ERRORS0024 INTEGER OUTPUT0023 INTEGER IFPNT0023 INTEGER DEBUG0033 LOGICAL * 1 HEADER (19)0005C0075 DATA HEADER/1HC,1H*,1H*,1H*,1HR,1HA,1HT,1HF,1HO,1HR,1H ,1HE,1HR,10031 $HR,1HO,1HR,1H:,1H ,0/0020 LASTC = 190016 I = 1007420164 IF (.NOT.( MSG ( I ) .NE. 0 .AND. MSG ( I ) .NE. 46 .AND. LASTC 0030 $.LT. 90)) GOTO 201660038 BUFOUT ( LASTC ) = MSG ( I )0027 LASTC = LASTC + 1002020165 I = I + 1 0020 GOTO 20164001820166 CONTINUE0030 BUFOUT ( LASTC ) = 00029 ERRORS = ERRORS + 10005C0029C OUTPUT TO STANDARD FILE0005C^^^^^^^0046 IF (.NOT.( OUTP .GT. 0 )) GOTO 201670021 CALL OUTDON001820167 CONTINUE0038 CALL PUTLIN ( BUFOUT, 8, 0 )0005C0045C OUTPUT TO TERMINAL AND (MAYBE) LISTFILE0005C0051 IF (.NOT.( LST ( 1 ) .EQ. 1 )) GOTO 201690048 CALL RATLST ( BUFOUT ( 2 ), 32767, 0 )001820169 CONTINUE0021 CALL RCTRLO0037 CALL PRINT ( BUFOUT ( 2 ) )0005C0016 RETURN0013 END0005 0004^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^