c%%A-RCB-0047-SL-18-1    RAT -- EXPLANATIONS
c   
c   
c   Ratfor translates programs written in the Ratfor language
c   into Fortran.  The design of both the Ratfor language and this 
c   preprocessor are given by Kernighan and Plauger in their book
c   "Software Tools" (Addison-Wesley, Toronto, 1976).  This version
c   of Ratfor is described in A-RCB-0091-SP-1.  It is essentially
c   the same as the language desribed by Kernighan and Plauger
c   except that:
c     1)  two new statements, DEFINELIST and BREAK GROUP, are implemented,
c     2)  the continuation convention is slightly different,
c     3)  only ' can delimit holleriths (" is used for octal constants),
c     4)  >> is used for .GT. and << for .LT. since < and > have other
c         meanings to the F4P compiler.
c
c   Ratfor reads the input line-by-line and breaks each line into
c   a string of characters.  These characters are re-assembled into
c   tokens:  names, hollerith constants, and special characters which
c   stand alone (e.g. ., *, {).  When a name token is found, Ratfor
c   tries to replace it by its DEFINEd value; if this is possible the 
c   definition is pushed back into the input and rescanned.  Subroutine
c   PUTBAK replaces characters in the input stream with the co-operation
c   of the input routine, GETCHR.  The ability to put strings back into
c   the input is heavily used in Ratfor.  
c
c   The first token on each line is encoded as an integer which is then
c   used to classify the current statement.  Ratfor statements cause
c   special information describing the statement to be stacked.  If
c   the statement is BREAK, NEXT, }, or non-Ratfor it is scanned till the end.
c   Then Ratfor goes down its stacks until a { stack entry or the beginning 
c   of the stacks is found.  As it scans, Ratfor produces the Fortran needed to
c   close off each entry on the stack.  
c
c   Fortran output code is assembled character-by-character in an output
c   buffer.  When there are 72 characters of data in the buffer, it is dumped
c   and a continuation card automatically started.
c
c
c   Ratfor does a lot of string manipulation. All strings are stored
c   in LOGICAL*1 vectors with a null ("000) byte at the end to mark
c   the end.  (Terminating string constants with a null is standard
c   Fortran and RSX practice.)  Two other ASCII control characters 
c   are used internally:  "004 is returned by the GETCHR routine 
c   at the end of file and "012 is sent by GETCHR at the end of a line.
c
c
c   The subroutines comprising Ratfor are grouped in this order:
c
c     1) setup,
c     2) string manipulation,     
c     3) input,
c     4) output,
c     5) parsing,
c     6) scanning (token builders),
c     7) error message printer.
c%^



c The integer encoding scheme for key Ratfor tokens is:
c
c      1          ]
c      2          ;
c      3          [
c      4          "004    (end of file-must be 4)
c      5          non-Ratfor statement
c      6          statement label (string of digits at start of statement)
c      7          IF
c      8          ELSE
c      9          WHILE
c     10          REPEAT
c     11          UNTIL
c     12          FOR
c     13          DO
c     14          BREAK
c     15          NEXT
c     16          DEFINE
c     17          INCLUDE
c     18          DEFINELIST
c
c%^



c  Here is the Fortran code resulting from the various Ratfor statements:
c
c  Ratfor                Fortran                         Comments
c
c  IF (EXPR)             IF (.NOT.(EXPR)) GO TO L1
c     S1                    S1
c  ELSE              L3  GO TO L2                        L3 in case S1 ends in
C     S2             L1  CONTINUE
c                           S2                           branch.  Prevents
c                    L2  CONTINUE                        "unreachable code"
c                                                        error message.
c  
c  REPEAT                CONTINUE                        Holds REPEAT'S label.
c    S1              L1  CONTINUE
c                           S1
c                    L3  GO TO L1                        L3 for NEXT in loop.
c                    L2  CONTINUE                        L2 for BREAK.
c
c  REPEAT                CONTINUE
c     S1             L1  CONTINUE
c  UNTIL (EXPR)             S1
c                    L3  IF(.NOT.(EXPR))GO TO L1
c                    L2  CONTINUE
c
c  WHILE (EXPR)          CONTINUE                        For WHILE'S label.
c     S1             L1  IF(.NOT.(EXPR))GO TO L2          L1 for NEXT, loop.
c                           S1
c                        GO TO L1
c                    L2  CONTINUE                        For BREAK.
c   
c  DO LIMITS             DO L1 LIMITS
c     S1                    S1
c                    L1  CONTINUE                        For NEXT, DO.
c                    L2  CONTINUE                        For BREAK.
c
c  FOR(I;EXPR;R)         I                               Initialize.
c     S1                 GO TO L3                        Skip re-init 1st.  
c                    L1  R                               Re-initialize.
c                    L3  IF(.NOT.(EXPR))GO TO L2         Top of Loop Test.
c                           S1
c                        GO TO L1
c                    L2  CONTINUE                        For BREAK.


c
c  BREAK                 GO TO L2                        L2 past loop end. 
c
c  NEXT                  GO TO L1                        All but REPEAT loops.
c                    or  GO TO L3                        Repeat loops.
c
c  BREAK GROUP           GO TO L1
c
c  }                 L1  CONTINUE                        For BREAK GROUP.
c
c
c When a Ratfor statement is found, L1 is obtained and stacked.  We always
c have L2=L1+1 and L3=L1+2.

C%%A-RCB-0047-SL-18-1   RAT -- MAIN PROGRAM
C
C RATFOR IS A PREPROCESSOR FOR FORTRAN PROGRAMS WHICH
C ALLOWS MODERN CONTROL STRUCTURES LIKE IF-ELSE, WHILE,
C REPEAT-UNTIL, FOR, BREAK, AND NEXT.  
C
C
C
	LOGICAL SETUP
C
5	IF (.NOT. SETUP(JUNK)) CALL EXIT
	CALL PARSE
	GO TO 5
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE INIT
	SUBROUTINE INIT
C
C INIT SHARED DATA
C
	LOGICAL*1 BUF(101), BAKBUF(501), OUTBUF(80), TABLE(2048)
	LOGICAL*1 CTIME(8),CDATE(9)
	LOGICAL LSTEND,LISTSW(3)
	INTEGER NAMES(257), LONG(257),PAGE,FREE
	COMMON /LUNS/ LUNIN,      !RATFOR SOURCE INPUT
	1             LUNOUT,     !FORTRAN OUTPUT
	2             LUNLST,     !RATFOR LISTING
	3             LUNTTY      !TI: FOR ERRORS, MESSAGES
	COMMON /INPUT/ BUF,       !INPUT BUFFER
	1	       BAKBUF,    !CHARS REPLACED IN INPUT BUFFER
	2              NOWBUF,    !CURRENT POSITION IN INPUT BUFFER
	3              NOWBAK,    !CURRENT POSITION IN PUT BACK BUFFER
	4              LNGTH      !SIZE INPUT RECORD-FOR ERROR MESSAGER
	COMMON /CLINE/ LINECT,    !RATFOR LINE NUMBER
	1              NUMERR,    !COUNTS RATFOR ERRORS
	2              LINF4P,    !FORTRAN STATEMENT LINE NUMBER
	3              LINES      !NUMBER OF LINES LISTED ON CURRENT PAGE
	COMMON /OUT/   OUTBUF,    !OUTPUT FORTRAN RECORD BUFFER
	1              IP         !CURRENT POSTION IN OUTPUT BUFFER
	COMMON /DEFN/  NAMES,     !HASH TABLE POINTERS FOR DEFINE
	1              LONG,      !LENGTH OF NAMES
	2              TABLE,     !HOLD AREA FOR DEFINED NAMES & TEXT
	3              FREE       !FIRST FREE BYTE IN TABLE
	COMMON /HEAD/  PAGE,      !CURRENT LISTING PAGE
	1              CTIME,     !TIME FOR HEADER
	2              CDATE      !DATE FOR HEADER
	COMMON /LASTAT/ LSTEND    !TRUE IFF LAST STATEMENT WAS END
	COMMON /SWLIST/ LISTSW    !LISTSW(LUNIN) .TRUE. IF LUNIN TO BE LISTED
	DATA LUNIN,LUNOUT,LUNLST,LUNTTY/ 1,4,6,5/
	LISTSW(1) = .TRUE.
	LISTSW(2) = .FALSE.
	LISTSW(3) = .FALSE.
	LSTEND=.TRUE.
	LUNIN=1
	LUNOUT=4
	LUNLST=6
	LUNTTY=5
	PAGE=1
	CALL TIME(CTIME)
	CALL DATE(CDATE)
	NOWBUF=0
	NOWBAK=0
	LINECT=0
	NUMERR=0
	LINF4P=1
	LINES=999
	IP=0
	DO 10 I=1,257
	   NAMES(I)=0
10	CONTINUE
	FREE=1
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- INTEGER FUNCTION LENGTH(STR)
	INTEGER FUNCTION LENGTH(STR)
C
C LENGTH RETURNS THE LENGTH OF THE STRING STR.  MUCH OF THIS RATFOR
C PROCESSOR USES STRING MANIPULATION.  ALL STRINGS ARE STORED
C IN LOGICAL*1 VECTORS WITH A "000 PLACED AT THE END OF THE
C STRING TO MARK THE END.  
C
	LOGICAL*1 STR(1000)
	LENGTH=0
	DO 10 I=1,1000
	   IF(STR(I) .EQ. "000)RETURN
	   LENGTH=LENGTH+1
10	CONTINUE
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- LOGICAL FUNCTION EQUAL(S1,S2)
	LOGICAL FUNCTION EQUAL(S1,S2)
	LOGICAL*1 S1(1000), S2(1000)
C
C EQUAL RETURNS .TRUE. IFF S1 AND S2 COMPARE AS EQUAL.
C
	EQUAL=.FALSE.
	DO 10 I=1,1000
	   IF(S1(I) .NE. S2(I)) RETURN
	   IF(S1(I) .EQ. "000)GO TO 20
10	CONTINUE
20	EQUAL = .TRUE.
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- LOGICAL FUNCTION ALLDIG(LEXSTR)
	LOGICAL FUNCTION ALLDIG(LEXSTR)
	LOGICAL*1 LEXSTR(101)
C
C ALLDIG RETURNS .TRUE. IFF ITS ARGUMENT STRING IS ENTIRELY DIGITS.
C
	ALLDIG=.FALSE.
	DO 10 I=1,1000
	   IF(LEXSTR(I) .EQ. "000)GO TO 20
	   IF(LEXSTR(I) .LT. "060  .OR.  LEXSTR(I) .GT. "071)RETURN
10	CONTINUE
20	ALLDIG=.TRUE.
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- LOGICAL*1 FUNCTION TYPE(C)
	LOGICAL*1 FUNCTION TYPE(C)
	LOGICAL*1 C
C
C TYPE RETURNS 'A' IF C IS ALPHABETIC, '0' IF C IS A DIGIT,
C AND C ITSELF OTHERWISE.
C
	TYPE=C
	IF(C .GE. "060 .AND. C .LE. "071)TYPE='0'
	IF((C .GE. "141  .AND.  C .LE. "172)
	1 .OR. (C .GE. "101  .AND.  C .LE. "132)) TYPE='A'
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- INTEGER FUNCTION ITOC(NUM,OUT,N)
	INTEGER FUNCTION ITOC(NUM,OUT,N)
	INTEGER NUM,N
	LOGICAL*1 OUT(N), DIGITS(10)
	DATA DIGITS/'0','1','2','3','4','5','6','7','8','9'/
C
C ITOC CONVERTS THE ARGUMENT NUM INTO AN UNSIGNED LOGICAL*1 STRING
C WHICH IS STORED IN OUT. THE FUNCTION RETURNS THE STRING LENGTH.
C OUT CAN HOLD UP TO N LOGICAL*1S; IF MORE ARE REQUIRED TRUNCATION
C OCCURS.
C
	K = IABS(NUM)
	J = N
	ITOC=0
10	OUT(J) = DIGITS(MOD(K,10)+1)
	   J=J-1
	   K=K/10
	   ITOC=ITOC+1
	IF(K .GT. 0  .AND.  J .GT. 0) GO TO 10
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- LOGICAL FUNCTION SETUP(JUNK)
	LOGICAL FUNCTION SETUP(JUNK)
	PARAMETER YES=1, NO=0
	LOGICAL*1 FOUT(41),FLST(41),CJUNK(1)
	LOGICAL NOMORE
	COMMON /LUNS/ LUNIN,LUNOUT,LUNLST,LUNTTY
C
C ATTACH LUNS
C
10	CALL ERRSET(43,,.FALSE.,,.FALSE.)
	CALL ERRSET(29,,.FALSE.,,.FALSE.)
	IF(LUNOUT .GT. 0) CLOSE(UNIT=LUNOUT)
	IF(LUNLST .GT. 0) CLOSE(UNIT=LUNLST)
	CLOSE(UNIT=LUNTTY)
	CLOSE(UNIT=LUNIN)
C
	CALL INIT
C
	OPEN(UNIT=LUNTTY,NAME='TI:',ERR=120)
	CALL ASSIGN(LUNLST,'SY:')
	CLOSE(UNIT=LUNLST)                  !JUST SET DEFAULT DEVICE
	IF (NXTMCR(LUNTTY,'RAT',7,NUMOUT) .EQ. YES) GO TO 20
	   SETUP = .FALSE.
	   RETURN
20	IF (NUMOUT .LE. 2) GO TO 30
	   CALL MCRERR(LUNTTY,'RAT','TOO MANY OUTPUTS.  MAX:  2')
	   GO TO 10
30	IF (NUMOUT .LT. 2) GO TO 40
	   JUNK = NXTFIL('.FTN',FOUT,41,CJUNK,1)
	   JUNK = NXTFIL('.LST',FLST,41,CJUNK,1)
	GO TO 50
40	IF (NUMOUT .EQ. 1) JUNK = NXTFIL('.FTN',FOUT,41,CJUNK,1)
	IF (NUMOUT .EQ. 0) FOUT(1) = "000
	FLST(1) = "000
C
50	IF (FLST(1) .EQ. "000) LUNLST = 0
	IF (FOUT(1) .EQ. "000) LUNOUT = 0
	IF (FOUT(1) .NE. "000)
	1   OPEN(UNIT=LUNOUT,NAME=FOUT,ERR=100,CARRIAGECONTROL='LIST',
	2        TYPE='NEW')
	IF (FLST(1) .NE. "000)
	1   OPEN(UNIT=LUNLST,NAME=FLST,ERR=110,TYPE='NEW')
	CALL NEWINP(NOMORE)
	IF (NOMORE) GO TO 10
	SETUP = .TRUE.
	RETURN
C
100	CALL CANT(LUNTTY,'RAT',FOUT)
	GO TO 10
110	CALL CANT(LUNTTY,'RAT',FLST)
	IF (LUNOUT .GT. 0) CLOSE (UNIT=LUNOUT,DISP='DELETE')
	GO TO 10
120	CALL CANT(LUNTTY,'RAT','TI:')      
	GO TO 10
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE NEWINP(NOMORE)
	SUBROUTINE NEWINP(NOMORE)
	PARAMETER NO=0
	LOGICAL NOMORE
	LOGICAL*1 FN(42),CJUNK(1)
	COMMON /FNMIN/ FN
	COMMON /LUNS/ LUNIN,LUNOUT,LUNLST,LUNTTY
C
C NEWINP USES NXTFIL TO OPEN THE NEXT INPUT FILE ON THE MCR LINE.
C NOMORE IS RETURNED AS .TRUE. IFF ALL INPUT FILES ARE EXHAUSTED.
C
	NOMORE=.TRUE.
	CLOSE(UNIT=LUNIN)
	IF( LUNIN .LE. 1 ) GO TO 10
	   LUNIN=LUNIN-1
	   NOMORE=.FALSE.
	   RETURN
10	IF (NXTFIL('.RAT',FN,42,CJUNK,1) .EQ. NO) RETURN
	IF (FN(1) .EQ. "000) GO TO 10
	OPEN(UNIT=LUNIN,NAME=FN,ERR=20,READONLY,TYPE='OLD')
	NOMORE=.FALSE.
	RETURN
20	CALL CANT(LUNTTY,'RAT',FN)
	NOMORE=.TRUE.
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- LOGICAL*1 FUNCTION GETCHR(C)
	LOGICAL*1 FUNCTION GETCHR(C)
	LOGICAL*1 C,BAKBUF(501),BUF(101)
	LOGICAL LISTSW(3)
	COMMON /LUNS/ LUNIN,LUNOUT,LUNLST,LUNTTY
	COMMON /SWLIST/ LISTSW
	COMMON /INPUT/ BUF,BAKBUF,NOWBUF,NOWBAK,LNGTH
	COMMON /CLINE/ LINECT,NUMERR,LINF4P,LINES
C
C GETCHR RETURNS THE NEXT INPUT CHAR IN GETCHR AND C. AT EOF, "004 IS 
C SENT; AT END OF LINE "012 (LINEFEED) IS SENT. NOTE THAT SUBROUTINE
C PUTBAK ALLOWS CHARS TO BE RETURNED TO THE INPUT STREAM.
C
	IF(NOWBAK .LE. 0)GO TO 20      !JUMP IF PUTBAK CHAR BUFFER EMPTY
	   C=BAKBUF(NOWBAK)
	   GETCHR=C
	   NOWBAK=NOWBAK-1
	RETURN
20	IF(NOWBUF .LE. 0  .OR. NOWBUF .GT. N)GO TO 50 !EMPTY INPUT BUFFER
	   C=BUF(NOWBUF)
	   GETCHR=C
	   NOWBUF=NOWBUF+1
	RETURN
C
50	CONTINUE
	READ(LUNIN,60,END=80)N,BUF
60	FORMAT(Q,101A1)
	IF(N .GT. 100)N = 100
	IF(N .LE. 0)GO TO 50
	LNGTH=N
	IF (BUF(1).NE.'#' .AND. BUF(1).NE."014)LINECT=LINECT+1
	IF (LUNLST.GT.0 .AND. N.GT.0 .AND. LISTSW(LUNIN))
	1 CALL LISTER(LUNLST,BUF,N)
	IF(BUF(1) .EQ. '#' .OR. BUF(1).EQ."014)GO TO 50
	N=N+1
	BUF(N)="012
	NOWBUF=1
	NOWBAK=0
	GO TO 20
80	C="004
	GETCHR=C
	NOWBUF=0
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE SKIPLF
	SUBROUTINE SKIPLF
	LOGICAL*1 GETCHR,C
C
C SKIP INPUT STREAM PAST NEXT LINEFEED (IE UNTIL NEXT STATEMENT)
C
10	IF(GETCHR(C) .EQ. "004)GO TO 20
	   IF(C .NE. "012)GO TO 10
	RETURN
20	CALL PUTBAK(C)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE PUTBAK(C)
	SUBROUTINE PUTBAK(C)
	LOGICAL*1 C,BAKBUF(501),BUF(101)
	COMMON /INPUT/ BUF,BAKBUF,NOWBUF,NOWBAK,LNGTH
C
C PUTS LOGICAL*1 C BACK INTO INPUT STREAM
C
	IF(NOWBAK .GE. 501)CALL ERROR('PUSHBACK BUFFER OVERFLOW-ABORT#')
	NOWBAK=NOWBAK+1
	BAKBUF(NOWBAK)=C
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE PBSTR(STR)
	SUBROUTINE PBSTR(STR)
	LOGICAL*1 STR(1000)
C
C PUTS STRING STR BACK INTO INPUT. NOTE THAT STRING MUST BE
C PUT BACK IN REVERSE ORDER SO THAT IT IS RESCANNED IN RIGHT ORDER.
C
	I=LENGTH(STR)
10	IF(I .LE. 0)RETURN
	   CALL PUTBAK(STR(I))
	   I=I-1
	GO TO 10
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE LISTER(LUN,OUT,LONG)
	SUBROUTINE LISTER(LUN,OUT,LONG)
	LOGICAL*1 OUT(LONG),CTIME(8),CDATE(9),CC,HOLD(6),FN(42)
	INTEGER LINES,LONG,LUN,PAGE
	COMMON /CLINE/ LINECT,NUMERR,LINF4P,LINES
	COMMON /HEAD/ PAGE,CTIME,CDATE
	COMMON /FNMIN/ FN
	DATA CC/' '/, HOLD/5*' ', ')'/
C
C PUTS THE LONG LOGICAL*1S OF OUT ONTO UNIT LUN, COUNTING
C LINES AND PAGES
C
	IF (OUT(1) .NE. "014) GO TO 1
	   LINES = 999
           RETURN
1	IF(LINES .LT. 50)GO TO 10
	   WRITE(LUN,5) CC,CDATE,CTIME,PAGE,(FN(II),II=1,LENGTH(FN))
5	   FORMAT(A1,'RATFOR VERSION 2',48X,9A1,5X,8A1,15X,'PAGE',I4,
	1   T24,42A1)
	   WRITE (LUN,5)                   ! PUT IN A BLANK LINE
	   PAGE=PAGE+1
	   CC='1'               !DON'T EJECT PRINTER FOR 1ST HEADER
	   LINES=0
10	LINES=LINES+1
	HOLD(1)=' '
	HOLD(2)=' '
	HOLD(3)=' '
	HOLD(4)=' '
	LNG=ITOC(LINF4P,HOLD(2),4)
	HOLD(5-LNG)='('
	IF(OUT(1) .NE. '#')WRITE(LUN,15) HOLD,LINECT,OUT
	IF(OUT(1) .EQ. '#')WRITE(LUN,20)OUT
15	FORMAT(' ',6A1,5X,I4,9X,100A1)
20	FORMAT(25X,100A1)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE OUTGO(LAB)
	SUBROUTINE OUTGO(LAB)
	INTEGER LAB
	LOGICAL*1 GO(5)
	DATA GO/ 'G','O','T','O',"000/
C
C OUTPUT STATEMENT GOTO LAB
C
	CALL OUTTAB
	CALL OUTSTR(GO)
	CALL OUTNUM(LAB)
	CALL OUTDON
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE OUTCON(LAB)
	SUBROUTINE OUTCON(LAB)
	INTEGER LAB
	LOGICAL*1 CONT(9)
	DATA CONT/'C','O','N','T','I','N','U','E',"000/
C
C PUT OUT CONTINUE STATEMENT, LABELLED BY LAB IF ITS NON-ZERO
C
	IF(LAB .GT. 0)CALL OUTNUM(LAB)
	CALL OUTTAB
	CALL OUTSTR(CONT)
	CALL OUTDON
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE OUTNUM(N)
	SUBROUTINE OUTNUM(N)
	INTEGER N,LONG
	LOGICAL*1 HOLD(6)
	DATA HOLD(6) /"000/
C
C PUT N INTO OUTPUT
C
	LONG=ITOC(N,HOLD,5)
	CALL OUTSTR(HOLD(6-LONG))
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE IFGO(LAB)
	SUBROUTINE IFGO(LAB)
	INTEGER LAB,NPAR
	LOGICAL*1 IFNOT(10),TOK,LEXSTR(101),NXTOK,TOK2,BRACKS(3)
	DATA IFNOT/'I','F','(','.','N','O','T','.','(',"000/
	DATA BRACKS/')',')',"000/
C
C COLLECT LOGICAL EXPRESSION AND PUT OUT IF(.NOT.(EXPRESSION))GOTO LAB
C
	LABOR=0                   !BECOMES NON-ZERO IF FIND !!
	CALL OUTTAB
	CALL OUTSTR(IFNOT)
	IF(NXTOK(LEXSTR,101).NE. '(')GO TO 100
	NPAR=1
10	TOK=NXTOK(LEXSTR,101)
	   IF(TOK .EQ. "004 .OR. TOK .EQ. "012)GO TO 100
	   IF(TOK .EQ. '(')NPAR=NPAR+1
	   IF(TOK .EQ. ')')NPAR=NPAR-1
	   IF(TOK .NE. '&'  .AND.  TOK .NE. "041)GO TO 30  !"041 = !
	      TOK2=NXTOK(LEXSTR,101)
	      IF(TOK .NE. TOK2)GO TO 25
	      IF(NPAR .GT. 1)GO TO 110
	      CALL OUTSTR(BRACKS)
	      IF(TOK .EQ. '&')CALL OUTGO(LAB)
	      IF(TOK .EQ. '&')GO TO 20
	         IF(LABOR .LE. 0)LABOR=LABGEN(1)
	         LABTMP=LABGEN(1)
	         CALL OUTGO(LABTMP)
	         CALL OUTGO(LABOR)
	         CALL OUTNUM(LABTMP)
20	      CALL OUTTAB
	      CALL OUTSTR(IFNOT)
	      GO TO 10
25	      CALL PBSTR(LEXSTR)
	      LEXSTR(1)=TOK
	      LEXSTR(2)="000
30	   CALL OUTSTR(LEXSTR)
	IF(NPAR .GT. 0)GO TO 10
	CALL OUTCH(')')
	CALL OUTGO(LAB)
	IF(LABOR .GT. 0)CALL OUTCON(LABOR)
	RETURN
C
100	CALL ERROR('UNBALANCED PARENTHESES IN LOGICAL EXPRESSION%')
	CALL PUTBAK(TOK)
	GO TO 115
110	CALL ERROR('UNBALANCED PARENTHESES BEFORE && OR !!%')
115	CALL SKIPLF
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- INTEGER FUNCTION LABGEN(NUM)
	INTEGER FUNCTION LABGEN(NUM)
	INTEGER LABEL,NUM
	DATA LABEL/23000/
C
C RESERVE NUM LABELS, RETURN FIRST ONE
C
	IF(LABEL+NUM .GT. 24000)LABEL=23000
	LABGEN=LABEL
	LABEL=LABEL+NUM
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE EATUP
	SUBROUTINE EATUP
	LOGICAL*1 NXTOK, TOK(101),T
C
C PASS LOGICAL*1S TO OUTPUT UNTIL END OF STATEMENT
C
10	T = NXTOK(TOK,101)
	   IF(T .EQ. ';' .OR. T .EQ. "012)RETURN
	   IF(T .EQ. "004 .OR. T .EQ. '[' .OR. T .EQ. ']')GO TO 20
	   CALL OUTSTR(TOK)
	GO TO 10
C
20	IF(T .EQ. "004)CALL ERROR('UNEXPECTED EOF%')
	CALL PUTBAK(T)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE OUTSTR(STR)
	SUBROUTINE OUTSTR(STR)
	LOGICAL*1 STR(1000),OSPEC2(15)
	LOGICAL INHOLL,SWITCH
	DATA OSPEC2/'.','A','N','D','.','.','N','O','T','.','.','O','R','.',
	1 ' '/
C
C OUTPUTS STRING STR, TRANSLATING ANY &'S, !'S, ^'S WHICH AREN'T IN HOLLERITHS
C
	INHOLL=.FALSE.
	DO 100 I=1,1000
	   IF(STR(I) .EQ. "000)RETURN
	   IF(INHOLL) GO TO 70
	   K=1
	   IF(STR(I) .EQ. '&')GO TO 30
	   K=6
	   IF(STR(I) .EQ. '^')GO TO 30
	   K=11
	   IF(STR(I) .EQ. "41)GO TO 30
	   IF(STR(I) .EQ. '''')INHOLL=.TRUE.
	   IF(INHOLL) SWITCH=.FALSE.
	   CALL OUTCH(STR(I))
	GO TO 100
30	   DO 35 J=K,K+4
	      CALL OUTCH(OSPEC2(J))
35	   CONTINUE
	GO TO 100
C
70	   IF(STR(I) .EQ. '''')SWITCH=.NOT. SWITCH
	   IF(STR(I+1) .NE. '''' .AND. SWITCH)INHOLL=.FALSE.
	   CALL OUTCH(STR(I))
100	CONTINUE
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE OUTCH(C)
	SUBROUTINE OUTCH(C)
	LOGICAL*1 C,OUTBUF(80)
	COMMON /OUT/ OUTBUF,IP
C
C PUT LOGICAL*1 C INTO OUTPUT BUFFER AND GENERATE ANY REQUIRED CONTINUATION
C
	IF(IP .LT. 72)GO TO 10
	CALL OUTDON
	DO 5 IP=1,5
	   OUTBUF(IP)=' '
5	CONTINUE
	OUTBUF(6)='1'
	IP=6
10	IP=IP+1
	OUTBUF(IP)=C
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE OUTTAB
	SUBROUTINE OUTTAB
	LOGICAL*1 OUTBUF(80)
	COMMON /OUT/ OUTBUF,IP
C 
C MAKE SURE OUTPUT POINTER PAST COLUMN 6
C
10	IF(IP .GE. 6)RETURN
	   CALL OUTCH(' ')
	GO TO 10
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE OUTDON
	SUBROUTINE OUTDON
	LOGICAL*1 OUTBUF(80)
	COMMON /OUT/ OUTBUF ,IP
	COMMON /LUNS/ LUNIN,LUNOUT,LUNLST,LUNTTY
	COMMON /CLINE/ LINECT,NUMERR,LINF4P,LINES
C
C OUTPUT FORTRAN "CARD", PUT RATFOR STATEMENT NUMBER ON END AFTER !
C
	IF(IP .LE. 0) GO TO 20
	IF(OUTBUF(6) .NE. '1')LINF4P=LINF4P+1
	IF(LUNOUT .LE. 0)GO TO 20
	   DO 5 I=IP+1,IP+7
	      OUTBUF(I)=' '
5	   CONTINUE
	   OUTBUF(IP+3)='!'
	   JUNK=ITOC(LINECT,OUTBUF(IP+4),4)
	   IP=IP+7
	   WRITE(LUNOUT,10) (OUTBUF(I),I=1,IP)
10	   FORMAT(80A1)
20	IP=0
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE PARSE
	SUBROUTINE PARSE
	LOGICAL*1 LEXSTR(101)
	INTEGER LEX,LABVAL(50),LEXTYP(50),SP,TOKEN,LAB
	LOGICAL NOMORE,ERR
	COMMON /LUNS/ LUNIN,LUNOUT,LUNLST,LUNTTY
	COMMON /CLINE/ LINECT,NUMERR,LINF4P,LINES
C
C GET 1ST TOKEN ON STATEMENT, USE CHKRAT TO CHECK FOR AND HANDLE
C RATFOR STATEMENTS.  THEN, WHEN GET TO END OF STATEMENT, USE
C UNSTAK TO PRODUCE ANY REQUIRED FORTRAN TO CLOSE LOOPS, IF'S, ELSE'S.
C
	SP=1
	LEXTYP(1)="004
5	TOKEN=LEX(LEXSTR)
	   IF(TOKEN .EQ. "004)GO TO 300
	   CALL CHKRAT(LEXTYP(SP),LABVAL(SP),LEXSTR,TOKEN,LAB,ERR)
	   IF(ERR  .OR. TOKEN .GT. 15) GO TO 5
C
	   IF( TOKEN .GT. 13
	1    .OR.(TOKEN .LT. 7 .AND. TOKEN .NE. 3))GO TO 150
	      SP=SP+1                      !START OF RATFOR STATEMENT
	      IF(SP .GT. 50)CALL ERROR('STACK OVERFLOW - ABORT#')
	      IF(TOKEN .EQ. 3)LAB=LABGEN(1)
	      LEXTYP(SP)=TOKEN             !SO REMEMBER TYPE OF STATEMENT
	      LABVAL(SP)=LAB               !AND FORTRAN LABEL USED
	   IF( TOKEN .NE. 11)GO TO 200
150	      IF(TOKEN .NE. 1) GO TO 160   !HERE TILL 200 HANDLES END OF STATE.
	         IF(LEXTYP(SP) .NE. 3)CALL ERROR('MISSING [%')
	         IF(LEXTYP(SP) .EQ. 3)CALL OUTCON(LABVAL(SP))
	         IF(LEXTYP(SP) .EQ. 3)SP=SP-1            !POP [ OFF STACK
	      GO TO 170
160	      IF(TOKEN .EQ. 5)CALL OTHERC(LEXSTR,SP)  !SOME DUMB NON-RATFOR 
	      IF(TOKEN .EQ. 15  .OR.  TOKEN .EQ. 14)
	1       CALL BRKNXT(SP,LEXTYP,LABVAL,TOKEN,LEXSTR)
170	      TOKEN=LEX(LEXSTR)                    !PEEK AT NEXT TOKEN
	      CALL PBSTR(LEXSTR)
	      CALL UNSTAK(SP,LEXTYP,LABVAL,TOKEN)   !HANDLES END OF STATE.
200	GO TO 5
C
300	CALL NEWINP(NOMORE)                          !EOF-LOOK FOR NEXT INPUT
	IF(.NOT. NOMORE)GO TO 5                      !EXCUSE DOUBLE NEGATIVE
	IF(SP .NE. 1)CALL ERROR('UNEXPECTED EOF-UNCLOSED LOOPS%')
	IF(NUMERR .GT. 0)WRITE(LUNTTY,310)NUMERR
310	FORMAT('0RAT --',I4,' ERRORS DETECTED'/)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE CHKRAT(LEXTYP,LABVAL,LEXSTR,TOKEN,LAB,ERR)
	SUBROUTINE CHKRAT(LEXTYP,LABVAL,LEXSTR,TOKEN,LAB,ERR)
	INTEGER LEXTYP,LABVAL,TOKEN,LAB
	LOGICAL*1 LEXSTR(101)
	LOGICAL ERR
C
C IF TOKEN NAMES RATFOR STATEMENT, CALL SUBROUTINE TO HANDLE
C
	ERR=.FALSE.
	IX = TOKEN-5
	IF(IX .LE. 0 .OR. IX .GT. 13)RETURN
	GOTO(10,20,30,40,50,60,70,80,85,85,90,100,110),IX
10	CALL LABELC(LEXSTR)                       !HANDLE LABELS
	RETURN
20	CALL IFCODE(LAB)                          !IF STATEMENT
	RETURN
30	IF(LEXTYP .EQ. 7)GO TO 35
	   CALL ERROR('NO IF FOR THIS ELSE%')
	   ERR=.TRUE.
	RETURN
35	   CALL ELSEIF(LABVAL)
	RETURN
40	CALL WHILES(LAB)                          !WHILE STATEMENT
	RETURN
50	CALL RPEAT(LAB)                           !REPEAT STATEMENT
	RETURN
60	IF(LEXTYP .EQ. 10)GO TO 65
	   CALL ERROR('NO REPEAT FOR THIS UNTIL%')
	   ERR=.TRUE.
	RETURN
65	   CALL UNTILS(LABVAL)
	RETURN
70	CALL FORCOD(LAB)                          !FOR STATEMENT
	RETURN
80	CALL DOCODE(LAB)                          !DO STATEMENT
85	RETURN
90	CALL DFINE
	RETURN
100	CALL INCLUD
	RETURN
110	CALL DEFLST
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE UNSTAK(SP,LEXTYP,LABVAL,TOKEN)
	SUBROUTINE UNSTAK(SP,LEXTYP,LABVAL,TOKEN)
	INTEGER SP,TOKEN,LABVAL(50),LEXTYP(50)
C
C END OF STATEMENT; GO DOWN STACK REMOVING AS MUCH AS POSSIBLE
C
5	IF(SP .LE. 1)RETURN
	   IF(LEXTYP(SP) .EQ. 3
	1     .OR. (LEXTYPE(SP) .EQ. 7  .AND.  TOKEN .EQ. 8)
	2     .OR. (LEXTYPE(SP) .EQ. 10  .AND.  TOKEN .EQ. 11))RETURN
	   IX =LEXTYP(SP)-6
	   IF(IX .GT. 0 .AND. IX .LT. 8)GO TO (10,20,30,30,20,30,40),IX
	   CALL ERROR('INTERNAL ERROR IN UNSTAK-ABORT#')
C
10	   CALL OUTCON(LABVAL(SP))               !IF
	   GO TO 90
C
20	   IF(SP .GT. 2)SP=SP-1
	   CALL OUTCON(LABVAL(SP)+1)             !ELSE, UNTIL
	   GO TO 90
C
30	   IF(IX .EQ. 4)CALL OUTNUM(LABVAL(SP)+2)
	   CALL OUTGO(LABVAL(SP))                !WHILE, REPEAT WITHOUT
	   CALL OUTCON(LABVAL(SP)+1)             !UNTIL, FOR
	   GO TO 90
C
40	   CALL OUTCON(LABVAL(SP))               !DO
	   CALL OUTCON(LABVAL(SP)+1)
	   GO TO 90
C
90	   SP=SP-1
	GO TO 5
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE LABELC(LEXSTR)
	SUBROUTINE LABELC(LEXSTR)
	LOGICAL*1 LEXSTR(1000),C,NXTOK
	INTEGER LENGTH
C
C PUT OUT FORTRAN LABEL AND WARN ABOUT 23000 RANGE
C
	IF(LENGTH(LEXSTR) .NE. 5)GO TO 10
	IF(LEXSTR(1) .EQ. '2'  .AND.  LEXSTR(2) .EQ. '3')
	1    CALL ERROR('LABEL IN 23000 RANGE-POSSIBLE CONFLICT@')
10	CALL OUTSTR(LEXSTR)
	CALL OUTTAB
	C=NXTOK(LEXSTR,101)
	IF(C .EQ. "012 .OR. C .EQ. "004 .OR. C .EQ. ']'
	1 .OR. C .EQ. '[' .OR. C .EQ. ';')CALL OUTCON(0)
	CALL PBSTR(LEXSTR)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE IFCODE(LAB)
	SUBROUTINE IFCODE(LAB)
	INTEGER LAB,LABGEN
C
C	IF STATEMENT
C
	LAB=LABGEN(3)
	CALL IFGO(LAB)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE ELSEIF(LAB)
	SUBROUTINE ELSEIF(LAB)
	INTEGER LAB
C
C ELSE STATEMENT
C
	CALL OUTNUM(LAB+2)   !IF STATEMENT BEFORE ELSE IS RETURN, STOP, 
 			     !ETC., THIS FOOLS F4P INTO THINKING THERE IS
		             !A PATH TO THE ELSE PART
	CALL OUTGO(LAB+1)
	CALL OUTCON(LAB)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE WHILES(LAB)
	SUBROUTINE WHILES(LAB)
	INTEGER LABGEN,LAB
C
C WHILE STATEMENT
C
	CALL OUTCON(0)              !HOLDS LABEL OF WHILE STATEMENT
	LAB=LABGEN(2)
	CALL OUTNUM(LAB)
	CALL IFGO(LAB+1)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE RPEAT(LAB)
	SUBROUTINE RPEAT(LAB)
	INTEGER LAB,LABGEN
C
C REPEAT STATEMENT
C
	CALL OUTCON(0)                !IN CASE REPEAT IS LABELLED
	LAB=LABGEN(3)
	CALL OUTCON(LAB)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE UNTILS(LAB)
	SUBROUTINE UNTILS(LAB)
	INTEGER LAB
C
C UNTIL STATEMENT
C
	CALL OUTNUM(LAB+2)
	CALL IFGO(LAB)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE DOCODE(LAB)
	SUBROUTINE DOCODE(LAB)
	LOGICAL*1 ST(3)
	INTEGER LABGEN,LAB
	DATA ST/'D', 'O', "000/
C
C DO STATEMENT
C
	CALL OUTTAB
	CALL OUTSTR(ST)
	LAB=LABGEN(2)
	CALL OUTNUM(LAB)
	CALL EATUP
	CALL OUTDON
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE OTHERC(LEXSTR,SP)
	SUBROUTINE OTHERC(LEXSTR,SP)
	LOGICAL*1 LEXSTR(101),TOK,NXTOK,RET(7),FUNAME(7),FIN(4)
	INTEGER SP
	LOGICAL EQUAL,LSTEND
	COMMON /LASTAT/ LSTEND
	COMMON /CLINE/ LINECT, NUMERR, LINF4P, LINES
	DATA RET/'R','E','T','U','R','N',"000/, FUNAME(1)/"000/
	DATA FIN/'E','N','D',"000/
C
C NON-RATFOR; IF FIRST SUBPROGRAM STATEMENT, CHECK FOR AND SAVE FUNCTION
C NAME; IF RETURN() LET DORET HANDLE; IF END RESET COUNTERS; AND
C IN ALL CASES, EVENTUALLY SEND STATEMENT TO OUTSTR.
C
	CALL OUTTAB
	IF(.NOT. EQUAL(LEXSTR,RET))GO TO 10
	   CALL DORET(LEXSTR,FUNAME,RET)
	   LSTEND=.FALSE.
	   RETURN
10	IF(.NOT. LSTEND)GO TO 20	!LSTEND=TRUE=>LAST STATEMENT END
	   CALL LOOKFN(LEXSTR,FUNAME)
	   LSTEND=.FALSE.
	   RETURN
20	CALL OUTSTR(LEXSTR)
	IF(.NOT. EQUAL(FIN,LEXSTR))GO TO 30
	     TOK=NXTOK(LEXSTR,101)      !PEEK AT TOKEN AFTER END
	     IF(TOK.EQ."012 .OR. TOK.EQ.';' .OR. TOK.EQ.']'
	1    .OR. TOK.EQ.'[' .OR. TOK .EQ."004) LSTEND=.TRUE.
	     CALL PBSTR(LEXSTR)
30	CALL EATUP
	CALL OUTDON
	IF(.NOT.LSTEND)RETURN
	FUNAME(1)="000
	LINF4P=1
	IF(SP .GT. 1)CALL ERROR('UNFINISHED RATFOR STATEMENTS IN THIS
	1 SUBPROGRAM%')
	LINES=999
	SP =1
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE DORET(LEXSTR,FUNAME,RET)
	SUBROUTINE DORET(LEXSTR,FUNAME,RET)
	LOGICAL*1 LEXSTR(101), FUNAME(7), NXTOK,TOK,RET(7)
C
C HANDLE RETURN(); IF JUST RETURN OR RETURN() NOT IN FUNCTION,
C JUST DUMP STATEMENT.
C
	TOK=NXTOK(LEXSTR,101)
	IF(TOK .NE. '(' .OR. FUNAME(1) .EQ. "000)GO TO 10
	   CALL OUTSTR(FUNAME)
	   CALL OUTCH('=')
	   CALL OUTCH('(')
	   CALL EATUP
	   CALL OUTDON
	   CALL OUTTAB
	   CALL OUTSTR(RET)
	   CALL OUTDON
	   RETURN
C
10	CALL OUTSTR(RET)             !NOT RETURN() OR NO FUNCTION NAME
	CALL PBSTR(LEXSTR)
	CALL EATUP
	CALL OUTDON
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE LOOKFN(LEXSTR,FUNAME)
	SUBROUTINE LOOKFN(LEXSTR,FUNAME)
	LOGICAL*1 LEXSTR(101), FUNAME(7), NXTOK, TOK, FUNC(9)
	LOGICAL GOTFUN,EQUAL
	DATA FUNC/'F','U','N','C','T','I','O','N',"000/
C
C TRY TO FIND KEYWORD FUNCTION, IF CAN SAVE FUNCTION NAME
C
	FUNAME(1) = "000             !ASSUME NO FUNCTION NAME
10	GOTFUN=EQUAL(LEXSTR,FUNC)
	   CALL OUTSTR(LEXSTR)
	   TOK=NXTOK(LEXSTR,101)
	   IF(TOK.EQ.';' .OR. TOK.EQ.']' .OR. TOK.EQ.'['
	1  .OR. TOK.EQ."012 .OR. TOK.EQ."004)GO TO 30
	IF(.NOT. GOTFUN)GO TO 10
	IF(TOK .NE. 'A')GO TO 30
	DO 15 I=1,6
	   IF(LEXSTR(I) .EQ. "000)GO TO 25
	   FUNAME(I) = LEXSTR(I)
15	CONTINUE
	I=7
25	FUNAME(I)="000
30	CALL PBSTR(LEXSTR)
	CALL EATUP
	CALL OUTDON
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE BRKNXT(SP,LEXTYP,LABVAL,TOKEN,LEXSTR)
	SUBROUTINE BRKNXT(SP,LEXTYP,LABVAL,TOKEN,LEXSTR)
	INTEGER LABVAL(50),SP,TOKEN,LEXTYP(50)
	LOGICAL*1 LEXSTR(101),C,GROUP(6),NXTOK
	LOGICAL EQUAL
	DATA GROUP/'G','R','O','U','P',"000/
C
C BREAK AND NEXT STATEMENT
C
	I = SP+1
	C=NXTOK(LEXSTR,101)
	IF(C .EQ. "012 .OR. C .EQ. ';'
	1  .OR. C .EQ. ']'  .OR. C .EQ. '[' .OR. C .EQ. "004)GO TO 13
	IF(TOKEN .EQ. 15) GO TO 30
	IF(C .NE. 'A' .OR. .NOT. EQUAL(LEXSTR,GROUP))GO TO 30
	C = NXTOK(LEXSTR,101)
	IF(C .NE. "012 .AND. C .NE. ';' .AND. C .NE. ']'
	1  .AND. C .NE. '[' .AND. C .NE. "004)GO TO 30
	IF(C .EQ. ']' .OR. C .EQ. '[' .OR. C .EQ. "004)CALL PUTBAK(C)
10	I=I-1
	   IF(I .LE. 1)GO TO 40
	   IF(LEXTYP(I) .NE. 3)GO TO 10
	CALL OUTGO(LABVAL(I))
	RETURN
C
13	IF(C .EQ. ']' .OR. C .EQ. '[' .OR. C .EQ. "004)CALL PUTBAK(C)
15	I=I-1
	   IF(I .LE. 1) GO TO 20
	   IF(LEXTYP(I) .NE. 9  .AND. LEXTYP(I) .NE. 10 
	1  .AND. LEXTYP(I) .NE. 12  .AND. LEXTYP(I) .NE. 13)GO TO 15
	IF(TOKEN .EQ. 14)CALL OUTGO(LABVAL(I)+1)
	IF(TOKEN .EQ. 15 .AND. LEXTYP(I) .EQ. 10) CALL OUTGO(LABVAL(I)+2)
	IF(TOKEN .EQ. 15 .AND. LEXTYP(I) .NE. 10) CALL OUTGO(LABVAL(I))
	RETURN
C
20	CALL ERROR('BREAK OR NEXT NOT IN RATFOR LOOP%')
	RETURN
30	CALL PBSTR(LEXSTR)
	CALL SKIPLF
	CALL ERROR('BAD FORM FOR BREAK/NEXT%')
	RETURN
40	CALL ERROR('BREAK GROUP NOT IN BRACKETED STATEMENT GROUP%')
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE FORCOD(LAB)
	SUBROUTINE FORCOD(LAB)
	LOGICAL*1 COND(301),LEXSTR(101),TOK,NXTOK
	INTEGER NPAR,NCHAR1,NCHAR2,NCHAR3
	LOGICAL ERR
C
C FOR STATEMENT.  COLLECT THE 3 PARTS WITH COLECT; SINCE RE-INITIALIZE
C OUTPUT BEFORE CONDITION, SAVE CONDITION IN COND
C
	LAB=LABGEN(3)
	NPAR=1
	IF(NXTOK(LEXSTR,101) .NE. '(')GO TO 1000
C
	CALL COLECT(0,NCHAR1,NPAR,COND,ERR)
	IF(ERR)GO TO 1000
	IF(NCHAR1 .LE. 0)CALL OUTCON(0)          !NO INIT-CONT. HOLDS FOR'S LAB
5	IF(NPAR .LE. 0) CALL OUTCON(LAB)	 !END OF FOR, TOP OF LOOP CONT
	IF(NPAR .LE. 0)RETURN
C
	CALL COLECT(301,NCHAR2,NPAR,COND,ERR)    !COLLECT & SAVE CONDITION
	IF(ERR)GO TO 1000
	IF(NCHAR2 .LE. 0 .AND. NPAR .LE. 0) GO TO 5
C
	CALL OUTGO(LAB+2)                       !SKIP RE-INIT ON 1ST LOOP
	CALL OUTNUM(LAB)
	NCHAR3=0
	IF(NPAR .GT. 0) CALL COLECT(0,NCHAR3,NPAR,COND,ERR)
	IF(ERR  .OR.  NPAR .GT. 0)GO TO 1000
	IF(NCHAR3 .LE. 0)CALL OUTCON(0)        !NO RE-INIT=>TOP OF LOOP CONT
	IF(NCHAR2 .LE. 0)CALL OUTCON(LAB+2)      !NO TEST-LAB FOR INIT TO GOTO
	IF(NCHAR2 .LE. 0)RETURN
	CALL PUTBAK(')')                         !PUT COND BACK INTO INPUT
	CALL PBSTR(COND)                         !FOR IFGO TO HANDLE
	CALL PUTBAK('(')
	CALL OUTNUM(LAB+2)
	CALL IFGO(LAB+1)
	RETURN
C
1000	CALL SKIPLF
	CALL ERROR('BAD FOR - CHECK FOR UNBALANCED PARENTHESES%')
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE COLECT(L,NUM,NPAR,HOLD,ERR)
	SUBROUTINE COLECT(L,NUM,NPAR,HOLD,ERR)
	INTEGER L,NUM,NPAR
	LOGICAL*1 HOLD(301),LEXSTR(101),NXTOK,TOK
	LOGICAL ERR
C
C GET NEXT PART OF FOR; PUT IN HOLD IF L >= 0 (L IS SIZE HOLD), ELSE OUTSTR IT
C
	NUM=0                                    !COUNTS LOGICAL*1S IN HOLD
	ERR=.FALSE.
	IF(L .LE. 0)CALL OUTTAB
C
10	TOK = NXTOK(LEXSTR,101)
	   IF(TOK .EQ. "012  .OR.  TOK .EQ. "004)GO TO 990
	   IF(TOK .EQ. ')')NPAR=NPAR-1
	   IF(TOK .EQ. '(')NPAR=NPAR+1
	   IF(TOK .EQ. ';'  .OR.  NPAR .LE. 0)GO TO 50
	   IF(L .GT. 0)GO TO 20
	       NUM = 1                          !JUST SHOW >= 1 CHAR FOUND
	       CALL OUTSTR(LEXSTR)
	GO TO 10
20	      DO 30 I=1,L
	         IF(LEXSTR(I) .EQ. "000)GO TO 10
	         NUM=NUM+1
	         IF(NUM .GT. L-1)GO TO 1000
	         HOLD(NUM) = LEXSTR(I)
30	      CONTINUE
	      GO TO 1000
C
50	IF(NPAR .GT. 1)GO TO 1000
	IF(L .LE. 0  .AND.  NUM .GT. 0)CALL OUTDON
	IF(L .GT. 0)HOLD(NUM+1)="000
	IF(NPAR .LE. 0)RETURN
	TOK=NXTOK(LEXSTR,101)                   !PEEK AT TOKEN AFTER ;
	IF(TOK .EQ. ')')NPAR = 0                 !REPLACE ;) BY )
	IF(TOK .NE. ')')CALL PBSTR(LEXSTR)
	RETURN
C
990	CALL PUTBAK(TOK)
1000	ERR=.TRUE.
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE DEFLST
	SUBROUTINE DEFLST
	LOGICAL*1 HOLD(8),LEXSTR(101),NXTOK
	LOGICAL ALLDIG
	DATA HOLD/6*' ',"012,"000/
C
C DEFINELIST STATEMENT
C
	IF(NXTOK(LEXSTR,101) .NE. 'A')GO TO 50
	IF(.NOT. ALLDIG(LEXSTR))GO TO 50
	L=LENGTH(LEXSTR)
	IF(L .GT. 5  .OR. 
	1   (L .EQ. 5  .AND. LEXSTR(1) .GT. '2'))GO TO 50
	NUM=0
	DO 10 I=1,6
	   HOLD(I)=' '
	   IF(I .LE. L)NUM = NUM*10 + (LEXSTR(I)-"060)
10	CONTINUE
	IF(NUM .EQ. 0)GO TO 50
20	L=ITOC(NUM,HOLD(2),5)
	   IF(NXTOK(LEXSTR,101) .NE. 'A')GO TO 40
	   CALL PBSTR(HOLD)
	   CALL PBSTR(LEXSTR)
	   CALL DFINE
	   NUM=NUM+1
	GO TO 20
C
40	IF(LEXSTR(1) .EQ. "012)RETURN
	CALL PBSTR(LEXSTR)
	CALL SKIPLF
	CALL ERROR('BAD NAMES LIST%')
	RETURN
50	CALL ERROR('BAD INTEGER%')
	CALL SKIPLF
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE DFINE
	SUBROUTINE DFINE
	INTEGER FREE, NAMES(257), LONG(257)
	LOGICAL*1 LEXSTR(101),GETCHR,C,TABLE(2048),GETTOK
	COMMON /DEFN/ NAMES, LONG, TABLE,FREE
C
C DEFINE STATEMENT
C
	C = GETTOK(LEXSTR,101)
	IF(C .NE. 'A')GO TO 100                            !NO NAME
	IF(LOOKUP(LEXSTR,INDEX) .EQ. -1)GO TO 200          !NO ROOM IN TABLES
	NAMES(INDEX) = FREE
	LONG(INDEX) = LENGTH(LEXSTR)+1                     !+1 FOR ENDING "000
	I=FREE-1
C
10	I=I+1
	   IF(I .GT. 2048)GO TO 200
	   TABLE(I) = LEXSTR(I-FREE+1)
	IF(TABLE(I) .NE. "000)GO TO 10
C
20	IF(GETCHR(C) .EQ. ' ')GO TO 20
	IF(C .EQ. "011)GO TO 20                            !TABS
	IF(C .EQ. "004  .OR.  C .EQ. "012)GO TO 100        !NO REPLACEMENT TEXT
	CALL PUTBAK(C)
	IF(C .EQ. '''')C=GETTOK(LEXSTR,101)                !GETTOK GATHERS HOLL
	IF(C .EQ. '''')GO TO 40
	   DO 30 J=1,100
	      IF(GETCHR(C) .EQ. "004)GO TO 100
	      IF(C.EQ."011 .OR. C.EQ.' ' .OR. C.EQ."012)GO TO 35
	      LEXSTR(J) = C
30	   CONTINUE
	   GO TO 100
35	   LEXSTR(J) = "000
40	DO 50 J=1,101
	   I=I+1
	   IF(I .GT. 2048)GO TO 200
	   TABLE(I)=LEXSTR(J)
	   IF(TABLE(I) .EQ. "000)GO TO 60
50	CONTINUE
C
60	FREE=I+1
	IF(C .NE. "012)CALL SKIPLF
	RETURN
100	CALL PUTBAK(C)
	CALL ERROR('BAD DEFINE%')
	CALL SKIPLF
	RETURN
200	CALL ERROR('DEFINE TABLES OVERFLOWN-ABORT#')
	END
C%%A-RCB-0047-SL-18-1   RAT -- INTEGER FUNCTION LOOKUP(STR,INDEX)
	INTEGER FUNCTION LOOKUP(STR,INDEX)
	LOGICAL*1 TABLE(2048),STR(1000)
	INTEGER LONG(257),NAMES(257),HASH,HASH1,REHASH,INDEX
	LOGICAL EQUAL
	COMMON /DEFN/ NAMES, LONG, TABLE
C
C RETURN INDEX OF STR IN NAMES TABLE IN LOOKUP AND INDEX
C
	INDEX=HASH(STR)
	HASH1=INDEX
	DO 10 I=1,257
	   IF(NAMES(INDEX) .EQ. 0)GO TO 20
	   IF( EQUAL(TABLE(NAMES(INDEX)), STR) )GO TO 30
	   INDEX = REHASH(INDEX,HASH1)
10	CONTINUE
C
	LOOKUP=-1
	INDEX=-1                                      !TABLE IS FULL&NOT THERE
	RETURN
C
20	LOOKUP=0                                      !NOT IN TABLE, BUT INDEX
	RETURN                                        !SHOWS WHERE IT SHOULD GO
C
30	LOOKUP=INDEX                                  !GOT IT!!
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- LOGICAL FUNCTION REPLAC(STR)
	LOGICAL FUNCTION REPLAC(STR)
	LOGICAL*1 TABLE(2048),STR(1000)
	INTEGER LONG(257),NAMES(257),INDEX
	COMMON /DEFN/ NAMES, LONG, TABLE
C
C TRY TO REPLACE STR BY ITS DEFINE D VALUE; IF CAN'T, RETURN FALSE
C
	REPLAC=.FALSE.
	IF(LOOKUP(STR,INDEX) .LE. 0)RETURN
	CALL PBSTR(TABLE(NAMES(INDEX)+LONG(INDEX)))
	REPLAC=.TRUE.
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- INTEGER FUNCTION HASH(STR)
	INTEGER FUNCTION HASH(STR)
	LOGICAL*1 STR(1000)
C
C COMPUTE HASH INDEX AS SUM CHARS MOD 257 + 1 (NOTE: 257 IS PRIME)
C
	HASH=0
	DO 10 I=1,1000
	   IF(STR(I) .EQ. "000)GO TO 20
	   HASH = HASH+STR(I)
10	CONTINUE
20	HASH=MOD(HASH,257)+1
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT --         INTEGER FUNCTION REHASH(OLDHSH,HASH1)
        INTEGER FUNCTION REHASH(OLDHSH,HASH1)
	INTEGER HASH1,OLDHSH
C
C ADD THE HASH REHASH; SINCE TABLE SIZE PRIME, WILL VISIT EVERY ENTRY IN NAMES
C
	REHASH=MOD(OLDHSH+HASH1,257)+1
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- INTEGER FUNCTION LEX(LEXSTR)
	INTEGER FUNCTION LEX(LEXSTR)
	LOGICAL*1 NXTOK,LEXSTR(101),CHARS(4)
	LOGICAL LOOK,ALLDIG
	DATA CHARS/']', ';', '[', "004/
C
C RETURN INTEGER REPRESENTING NEXT TOKEN-RATFOR KEYWORDS HAVE OWN INTEGER
C
10	IF(NXTOK(LEXSTR,101) .EQ. "012) GO TO 10        !JUNK EMPTY/BLANK LINE
	DO 20 LEX=1,4
	   IF(CHARS(LEX) .EQ. LEXSTR(1))RETURN           !CHECK FOR [ ] ; EOF
20	CONTINUE
	LEX=6
	IF(ALLDIG(LEXSTR))RETURN                         !LABEL
	LEX=5
	IF(.NOT. LOOK(LEXSTR,I)) RETURN                  !EXIT-NOTHING SPECIAL
	LEX=I+6
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- LOGICAL FUNCTION LOOK(LEXSTR,IX)
	LOGICAL FUNCTION LOOK(LEXSTR,IX)
	LOGICAL*1 LEXSTR(101),TAB(71)
	INTEGER PNT(12)
	LOGICAL EQUAL
	DATA TAB/ 'I','F',"000,'E','L','S','E',"000
	1 ,'W','H','I','L','E',"000,'R','E','P','E','A','T',"000
	2 ,'U','N','T','I','L',"000,'F','O','R',"000
	3 ,'D','O',"000,'B','R','E','A','K',"000
	4 ,'N','E','X','T',"000,'D','E','F','I','N','E',"000
	5,'I','N','C','L','U','D','E',"000
	6,'D','E','F','I','N','E','L','I','S','T',"000/
	DATA PNT/1,4,9,15,22,28,32,35,41,46,53,61/
C
C SEE IF LEXSTR IS RATFOR KEYWORD
C
	LOOK=.TRUE.
	DO 10 IX=1,12
	   IF(EQUAL(LEXSTR,TAB(PNT(IX))))RETURN
10	CONTINUE
	LOOK=.FALSE.
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE INCLUD
	SUBROUTINE INCLUD
	LOGICAL*1 GETCHR,C,FN(46),MCR(82),SW(2),MCRSAV(82)
	LOGICAL LISTSW(3)
	INTEGER POS,POSAVE
	COMMON /LUNS/ LUNIN,LUNOUT,LUNLST,LUNTTY
	COMMON /SWLIST/ LISTSW
	COMMON /MCRNFO/ MCR,POS
	DATA FN(1),FN(2),FN(3),FN(4),FN(5)/'[','1',',','1',']'/
C
C INCLUDE STATEMENT
C
	DO 5 I=1,82
	   MCRSAV(I)=MCR(I)
5	CONTINUE
	POSAVE=POS
	IF(LUNIN .GE. 3)GO TO 120
	I=1
20	IF(GETCHR(C) .EQ. "004)GO TO 100
	   IF (C .EQ. "012  .OR.  C .EQ. '#')GO TO 30
	   IF(C .EQ. ' '  .OR.  C .EQ. "011)GO TO 20
	   IF(I .GT. 49)GO TO 100
	   MCR(I)=C
	   I=I+1
	GO TO 20
30	POS = 1
	MCR(I) = "000
	JUNK = NXTFIL('.RAT',FN(6),41,SW,2)
	LUNIN = LUNIN+1
	LISTSW(LUNIN) = SW(1) .EQ. 'L'
	OPEN(UNIT=LUNIN,NAME=FN(6),TYPE='OLD',READONLY,ERR=40)
	GO TO 50
40	OPEN(UNIT=LUNIN,NAME=FN,TYPE='OLD',READONLY,ERR=110)
50	DO 60 I=1,82
	   MCR(I) = MCRSAV(I)
60	CONTINUE
	POS=POSAVE
	RETURN
C
100	CALL PUTBAK(C)
	CALL ERROR('BAD INCLUDE%')
	CALL SKIPLF
	GO TO 50
110	CALL ERROR('CAN''T OPEN INCLUDE FILE%')
	LUNIN=LUNIN-1
	GO TO 50
120	CALL ERROR('INCLUDES NESTED TOO DEEPLY%')
	CALL SKIPLF
	GO TO 50
	END
C%%A-RCB-0047-SL-18-1   RAT -- LOGICAL*1 FUNCTION NXTOK(T,N)
	LOGICAL*1 FUNCTION NXTOK(T,N)
	LOGICAL*1 T(N),GETTOK,C
	LOGICAL REPLAC
C
C GET NEXT TOKEN AND HANDLE RATFOR CONTINUATION.  GETTOK DOES
C MOST OF THE WORK.
C
	KOUNT=0              !COUNTS # OF DEFINE REPLACEMENTS
5	NXTOK=GETTOK(T,N)
	IF(NXTOK .NE. 'A')GO TO 8
	IF(.NOT. REPLAC(T)) GO TO 8
	   KOUNT=KOUNT+1
	   IF(KOUNT .LE. 100)GO TO 5
	   CALL ERROR('PROBABLE RECURSIVE DEFINE%')
	   CALL SKIPLF
	   GO TO 5
8	IF(NXTOK .NE. '_'  .AND.  NXTOK .NE. ','
	1 .AND. NXTOK .NE. '&'  .AND. NXTOK .NE. "41)RETURN
	C = GETTOK(T,N)
	IF( C .NE. "012)GO TO 10
	   IF(NXTOK .EQ. '_')GO TO 5
	   T(1) = NXTOK
	   RETURN
10	CALL PBSTR(T)
	T(1) = NXTOK
	T(2) ="000
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- LOGICAL*1 FUNCTION GETTOK(LEXSTR,TOKSIZ)
	LOGICAL*1 FUNCTION GETTOK(LEXSTR,TOKSIZ)
	INTEGER TOKSIZ
	LOGICAL LOGOP,SWITCH
	LOGICAL*1 GETCHR,TYPE,C,LEXSTR(TOKSIZ)
C
5	IF(GETCHR(C) .EQ. ' ')GO TO 5
	   IF(C .EQ. "011)GO TO 5
	CALL PUTBAK(C)
	DO 20 I=1,TOKSIZ-1
	   GETTOK=TYPE(GETCHR(LEXSTR(I)))
	   IF(GETTOK .NE. 'A'  .AND.  GETTOK .NE. '0')GO TO 30
	    IF(LEXSTR(I) .GE. "141 .AND. LEXSTR(I) .LE. "172)
	1                   LEXSTR(I)=LEXSTR(I)-"040
20	CONTINUE
25	CALL ERROR('TOKEN TOO LONG%')
	CALL SKIPLF
	LEXSTR(TOKSIZ)="000
	RETURN
30	IF(I .LE. 1)GO TO 40                              !JUMP IF SPECIAL CHAR
	   CALL PUTBAK(LEXSTR(I))                         !1 TOO FAR FOR NAMES
	   LEXSTR(I)="000
	   GETTOK='A'
	   RETURN
40	IF(LEXSTR(1) .NE. '''')GO TO 70
	   SWITCH=.FALSE.          !TOGGLE SWITCH FOR EACH '
	   DO 45 I=2,TOKSIZ
	      IF(GETCHR(LEXSTR(I)) .EQ. '''')GO TO 42
	      IF(SWITCH)GO TO 50
42	      IF(LEXSTR(I) .EQ. '''')SWITCH = .NOT. SWITCH
	      IF(LEXSTR(I) .EQ. "012  .OR. LEXSTR(I) .EQ. "004)GO TO 55
45	   CONTINUE
	   I=1
	   CALL SKIPLF
	   GO TO 55
50	   CALL PUTBAK(LEXSTR(I))
	   LEXSTR(I) = "000
	   RETURN
55	   IF(LEXSTR(I) .EQ. "004)CALL PUTBAK("004)
	   CALL ERROR('MISSING QUOTE FOR HOLLERITH%')
	   GO TO 5
C
70	IF(LEXSTR(1) .NE. '#')GO TO 80
	   CALL SKIPLF
	   LEXSTR(1) = "012
80	LEXSTR(2)="000
	IF(LOGOP(LEXSTR(1)))GO TO 5
	GETTOK=LEXSTR(1)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- LOGICAL FUNCTION LOGOP(C1)
	LOGICAL FUNCTION LOGOP(C1)
	LOGICAL*1 C1,C2,GETCHR,SPEC(20),OSPEC(20)
	DATA SPEC/'=','=','^','=','<','>','>','<','>','=','=','>'
	1 ,'=','<','<','=','<','<','>','>'/,
	2 OSPEC/'E','Q','N','E','N','E','N','E','G','E','G','E','L','E',
	3      'L','E','L','T','G','T'/
C
C TRANSLATE RELATIONAL OPERATOR SHORTFORMS BUT LEAVE & , ! AND ^ FOR
C OUTSTR SO THAT IFGO CAN LOOK FOR && AND !!.  ALSO TRANSLATES THE 
C CURLY BRACKETS TO [ AND ], THE VERTICAL BAR TO !, AND THE TILDE TO ^.
C
	LOGOP=.FALSE.
	IF(C1 .EQ. "173) C1= '['
	IF(C1 .EQ. "174) C1 = '!'
        IF(C1 .EQ. "175) C1 = ']'
        IF(C1 .EQ. "176) C1 = '^'
	IF(C1 .NE. '>'  .AND.  C1 .NE. '<'  .AND. C1 .NE. '='
	1  .AND. C1 .NE. '^')RETURN
	C2=GETCHR(C2)
	DO 10 I=1,20,2
	   IF(C1 .NE. SPEC(I)  .OR.  C2 .NE. SPEC(I+1))GO TO 10
	      CALL PUTBAK('.')
	      CALL PUTBAK(OSPEC(I+1))
	      CALL PUTBAK(OSPEC(I))
	      CALL PUTBAK('.')
	      LOGOP=.TRUE.
	      RETURN
10	CONTINUE
	CALL PUTBAK(C2)
	RETURN
	END
C%%A-RCB-0047-SL-18-1   RAT -- SUBROUTINE ERROR(MESS)
	SUBROUTINE ERROR(MESS)
	LOGICAL*1 MESS(100),BUF(101),BAKBUF(501)
	COMMON /LUNS/ LUNIN,LUNOUT,LUNLST,LUNTTY
	COMMON /INPUT/ BUF,BAKBUF,NOWBUF,NOWBAK,LNGTH
	COMMON /CLINE/ LINECT, NUMERR,LINF4P,LINES
C
C ERROR MESSAGE PRINTER
C
	IF(LUNLST .LE. 0)WRITE(LUNTTY,10) LINECT,(BUF(I),I=1,LNGTH)
10	FORMAT(1X,I4,2X,100A1)
	LUN=LUNLST
	IF(LUNLST .LE. 0)LUN=LUNTTY
	DO 20 I=1,100
	   IF(MESS(I) .EQ. '%'  .OR.  MESS(I) .EQ. '@'
	1  .OR. MESS(I) .EQ. '#')GO TO 30
20	CONTINUE
	MESS(2)='%'
	I=2
30	N=I-1
	IF(MESS(I) .EQ. '@')WRITE(LUN,35)(MESS(K),K=1,N)
	IF(MESS(I) .NE. '@')WRITE(LUN,40)(MESS(K),K=1,N)
	WRITE(LUN,45)
	IF(MESS(I) .NE. '@')NUMERR=NUMERR+1
	LINES=LINES+2
	IF(MESS(I) .NE. '#')RETURN
	WRITE(LUNTTY,50)
	CALL EXIT
35	FORMAT(10X,'**WARNING:  ',100A1)
40	FORMAT(10X,'****ERROR:  ',100A1)
45	FORMAT(1X)
50	FORMAT('0RAT -- RUN ABORTED'/)
	END
C%%A-RCB-0047-SL-18-1   RAT -- 
