C======== FILE=RAT1.RAT ======================= RATFOR IN RATFOR =======
C$ ***** FIRST PART OF THE NON-SYSTEM SPECIFIC PARTS OF RATFOR
CNOTE:THE COMPILER MUST CORRECTLY HANDLE NUMBERIC COMPARES OF BYTES AND 
CFILE=DEFIN.RAT  ===== GENERAL CHARACTER SET DEFINITIONS ===============
C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT.
C
C				FILE=RATDEF.RAT
CDEFINE (DECWRITER,)		#DEFINED FOR DECWRITER OUTPUT 
C
C
C$ ADDDEF	- GET DEFINITION, INSTALL SYMBOLIC CONSTANT AND SORT THE TABLE
C SYKES, 18FEB77
C PCN # 62, 3 SEP 79, FIX BUG ON STORAGE OF STRING DEFINITIONS
C PCN # 68, 10 OCT 79, FIX BUG IF LASTP=1,TESTING NAMPTR(0).
C PCN # 84, 18 JAN 80, FIX BUG IN PCN # 68, CHANGE > TO >= SO 2ND SYMBOL
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C
      SUBROUTINE ADDDEF ( TOKEN, TOKSIZ ) 
C
      INTEGER TOKSIZ, LOOKFR, INSTAL, SCOMPR, I, J
      LOGICAL * 1 TOKEN ( TOKSIZ ), DEFN ( 96 ) 
C
C					FILE = CLOOK.RAT  FOR RATFOR.RAT
      COMMON / CLOOK / LASTP, TWOS, LASTT, NAMPTR ( 250 ), TABLE ( 3000 
     $) 
      INTEGER LASTP 
      INTEGER TWOS
      INTEGER LASTT 
      INTEGER NAMPTR
      LOGICAL * 1 TABLE 
C
      CALL GETDEF ( TOKEN, TOKSIZ, DEFN, 96 ) 
      CALL UNFOLD ( TOKEN ) 
      IF (.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 1 )) GOTO 20000
      CALL SYNERR ( 44HATTEMPTED REDEFINITION OF SYMBOLIC CONSTANT. ) 
      GOTO 20001
20000 CONTINUE
      IF (.NOT.( INSTAL ( TOKEN, DEFN, LASTP, LASTT, NAMPTR, 3000, 250, 
     $TABLE ) .EQ. - 1 )) GOTO 20002
      CALL SYNERR ( 39HTOO MANY SYMBOLIC CONSTANT DEFINITIONS. )
      GOTO 20003
20002 CONTINUE
      IF (.NOT.( LASTP .GE. 2 )) GOTO 20004 
      IF (.NOT.( TWOS * 2 .LE. LASTP )) GOTO 20006
      TWOS = TWOS * 2 
20006 CONTINUE
      I = NAMPTR ( LASTP - 1 )
      J = NAMPTR ( LASTP )
      IF (.NOT.( SCOMPR ( TABLE ( I ), TABLE ( J ) ) .GT. 0 )) GOTO 
     $20008 
      CALL SHELL ( LASTP, NAMPTR, TABLE ) 
20008 CONTINUE
C
20004 CONTINUE
20003 CONTINUE
20001 CONTINUE
      RETURN
      END 

C
C$ BALPAR	- COPY BALANCED PARTHENTHESES STRING INTO FORTRAN CODE
C PCN # 21
C
      SUBROUTINE BALPAR 
C
      LOGICAL * 1 T, TOKEN ( 80 ), DEFTOK 
      INTEGER NLPAR 
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS 
      INTEGER LC
      INTEGER COMPRS
C
      IF (.NOT.( DEFTOK ( TOKEN, 80 ) .NE. 40 )) GOTO 20010 
      CALL SYNERR ( 10HMISSING (. ) 
      RETURN
20010 CONTINUE
      CALL OUTSTR ( TOKEN ) 
      NLPAR = 1 
20012 CONTINUE
      T = DEFTOK ( TOKEN, 80 )
      IF (.NOT.( T .EQ. 59 .OR. T .EQ. 123 .OR. T .EQ. 125 .OR. T .EQ.  
     $- 3 )) GOTO 20015 
      CALL PBSTR ( TOKEN )
      GOTO 20014
20015 CONTINUE
      IF (.NOT.( T .EQ. 10 )) GOTO 20017
      TOKEN ( 1 ) = 0 
      GOTO 20018
20017 CONTINUE
      CALL LRPAR ( T, NLPAR ) 
20018 CONTINUE
      IF (.NOT.( T .NE. 44 .AND. COMPRS .EQ. 0 )) GOTO 20019
      CALL OUTCH ( 32 ) 
20019 CONTINUE
      CALL OUTSTR ( TOKEN ) 
20013 IF (.NOT.( NLPAR .LE. 0 )) GOTO 20012 
20014 CONTINUE
      IF (.NOT.( NLPAR .NE. 0 )) GOTO 20021 
      CALL SYNERR ( 28HMISSING ( OR ) IN CONDITION. ) 
C
20021 CONTINUE
      RETURN
      END 

C
C$ BRKNXT	- GENERATE FORTRAN CODE FOR 'BREAK' AND 'NEXT' STATEMENTS 
C PCN 107, 29 SEP 80, ALLOW MULTI LEVEL BREAK AND NEXT. 
C
      SUBROUTINE BRKNXT ( SP, LEXTYP, LABVAL, TOKEN ) 
C
      INTEGER I, LABVAL ( 120 ), LEXTYP ( 120 ), SP, TOKEN
      INTEGER ALLDIG, SCTOI, N
      LOGICAL * 1 T, NUMB ( 80 ), GTOK
C
      N = 0 
      T = GTOK ( NUMB, 80 ) 
      IF (.NOT.( ALLDIG ( NUMB ) .EQ. 1 )) GOTO 20023 
      I = 1 
      N = SCTOI ( NUMB, I ) - 1 
      GOTO 20024
20023 CONTINUE
      IF (.NOT.( T .NE. 59 )) GOTO 20025
      CALL PBSTR ( NUMB ) 
20025 CONTINUE
20024 CONTINUE
       I = SP 
20027 IF (.NOT.( I .GT. 0)) GOTO 20029
      IF (.NOT.( LEXTYP ( I ) .EQ. - 121 .OR. LEXTYP ( I ) .EQ. - 112   
     $.OR. LEXTYP ( I ) .EQ. - 115 .OR. LEXTYP ( I ) .EQ. - 119 )) GOTO 
     $20030 
      IF (.NOT.( N .GT. 0 )) GOTO 20032 
      N = N - 1 
      GOTO 20028
20032 CONTINUE
      IF (.NOT.( TOKEN .EQ. - 110 )) GOTO 20034 
      CALL OUTGO ( LABVAL ( I ) + 1 ) 
      GOTO 20035
20034 CONTINUE
      CALL OUTGO ( LABVAL ( I ) ) 
20035 CONTINUE
      RETURN
20030 CONTINUE
20028 I = I - 1 
      GOTO 20027
20029 CONTINUE
      IF (.NOT.( TOKEN .EQ. - 110 )) GOTO 20036 
      CALL SYNERR ( 14HILLEGAL BREAK. ) 
      GOTO 20037
20036 CONTINUE
      CALL SYNERR ( 13HILLEGAL NEXT. )
C
20037 CONTINUE
      RETURN
      END 

C
C$ DEFLST	- LIST CURRENT DEFINE TABLE CONTENTS
C SYKES,OCT76 
C PCN # 61, 3 SEP 79, ADD SYMBOLIC CONSTANT USAGE DATA AT END OF LISTING
C PCN # 66, 6 OCT 79, DELETE LASTP<2 TEST, NOLONGER VALID 
C PCN # 75, DEC 79, ADD FTN LINE NUMBERS TO LISTING 
C PCN # 77, 5 JAN 80, INCLUDE CPRTLN AND USE 'PRTBUF' JUST TO SAVE SPACE
C PCN # 96, 20 MAR 80, ADD PAGE INDEX AT END OF LISTING.
C PCN #116, 21 JUN 81, REMOVE CPRTLN AND USE INTERNAL BUFFER. 
C
      SUBROUTINE DEFLST 
C
      LOGICAL * 1 FF ( 2 ), BUFR ( 97 ) 
      INTEGER I, J, K, LEN1, LEN2, CENTER, LINE, JUNK 
      INTEGER SJOIN, SITOC, SLEN, SCOPY 
C
C					FILE = CLOOK.RAT  FOR RATFOR.RAT
      COMMON / CLOOK / LASTP, TWOS, LASTT, NAMPTR ( 250 ), TABLE ( 3000 
     $) 
      INTEGER LASTP 
      INTEGER TWOS
      INTEGER LASTT 
      INTEGER NAMPTR
      LOGICAL * 1 TABLE 
C
      LOGICAL * 1 TITLE (37)
      LOGICAL * 1 BL (2)
      LOGICAL * 1 HOW (7) 
      LOGICAL * 1 MUCH (14) 
      LOGICAL * 1 CHARS (12)
      LOGICAL * 1 ANDIT (5) 
      LOGICAL * 1 SYMB (9)
C
      DATA TITLE/1H*,1H*,1H*,1HS,1HY,1HM,1HB,1HO,1HL,1HI,1HC,1H ,1HC, 
     $1HO,1HN,1HS,1HT,1HA,1HN,1HT,1H ,1H=,1H ,1HD,1HE,1HF,1HI,1HN,1HI,
     $1HT,1HI,1HO,1HN,1H*,1H*,1H*,0/
      DATA BL/1H ,0/
      DATA HOW/1H ,1HU,1HS,1HE,1HD,1H ,0/ 
      DATA MUCH/1H ,1HO,1HF,1H ,1HP,1HO,1HS,1HS,1HI,1HB,1HL,1HE,1H ,0/
      DATA CHARS/1H ,1HC,1HH,1HA,1HR,1HA,1HC,1HT,1HE,1HR,1HS,0/ 
      DATA ANDIT/1H ,1H ,1H&,1H ,0/ 
      DATA SYMB/1H ,1HS,1HY,1HM,1HB,1HO,1HL,1HS,0/
      DATA FF / 12, 0 / 
C
      IF (.NOT.( LASTP .GT. 0 )) GOTO 20038 
      CALL RATLST ( FF, 0, 0 )
      CALL DOINDX ( 4, TITLE )
      CENTER = ( 96 / 2 ) - 16
      IF (.NOT.( CENTER .GT. 30 )) GOTO 20040 
      CENTER = 30 
20040 CONTINUE
      BUFR ( 1 ) = 0
      CALL SPAD ( BUFR, 60 )
      JUNK = SCOPY ( TITLE, BUFR ( CENTER - 21 ), 40, JUNK )
      CALL RATLST ( BUFR, 0, 0 )
      CALL RATLST ( BL, 0, 0 )
       I = 1
20042 IF (.NOT.( I .LE. LASTP)) GOTO 20044
      J = NAMPTR ( I )
      LINE = I
      LEN1 = SLEN ( TABLE ( J ) ) 
      LEN2 = SLEN ( TABLE ( J + 1 + LEN1 ) )
      K = ( CENTER - 1 ) - LEN1 
      IF (.NOT.( LEN1 .GT. ( CENTER - 2 ) .OR. LEN2 .GT. ( CENTER - 2 ) 
     $)) GOTO 20045 
      K = 1 
20045 CONTINUE
      IF (.NOT.( ( LEN1 + LEN2 ) .GT. ( 96 - 3 ) )) GOTO 20047
      LINE = 32767
20047 CONTINUE
       L = 1
20049 IF (.NOT.( L .LT. K)) GOTO 20051
      BUFR ( L ) = 32 
20050 L = L + 1 
      GOTO 20049
20051 CONTINUE
      JUNK = SCOPY ( TABLE ( J ), BUFR ( K ), 80, JUNK )
      IF (.NOT.( LINE .EQ. I )) GOTO 20052
      L = K + LEN1 + 3
      GOTO 20053
20052 CONTINUE
      L = 96 - LEN2 
20053 CONTINUE
      IF (.NOT.( TABLE ( J + 1 + LEN1 ) .EQ. - 9 )) GOTO 20054
      J = J + 1 
20054 CONTINUE
      JUNK = SCOPY ( TABLE ( J + 1 + LEN1 ), BUFR ( L ), 96, JUNK ) 
      BUFR ( K + LEN1 ) = 32
      BUFR ( K + LEN1 + 1 ) = 61
      BUFR ( K + LEN1 + 2 ) = 32
      CALL RATLST ( BUFR, LINE, 0 ) 
20043 I = I + 1 
      GOTO 20042
20044 CONTINUE
      LEN1 = SCOPY ( HOW, BUFR, 30, JUNK )
      JUNK = SITOC ( LASTP, BUFR ( LEN1 + 1 ), 5 )
      LEN1 = SJOIN ( BUFR, SYMB, 96, JUNK ) 
      LEN1 = SJOIN ( BUFR, MUCH, 96, JUNK ) 
      JUNK = SITOC ( 250, BUFR ( LEN1 + 1 ), 6 )
      LEN1 = SJOIN ( BUFR, ANDIT, 96, JUNK )
      JUNK = SITOC ( LASTT, BUFR ( LEN1 + 1 ), 6 )
      LEN1 = SJOIN ( BUFR, CHARS, 96, JUNK )
      LEN1 = SJOIN ( BUFR, MUCH, 96, JUNK ) 
      JUNK = SITOC ( 3000, BUFR ( LEN1 + 1 ), 6 ) 
      CALL RATLST ( BUFR, 0, 0 )
C
20038 CONTINUE
      RETURN
      END 

C
C$ DEFMAC	- PROCESS MACRO INVOCATIONS (WITH ARGUMENT) 
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
CTHE 'MACRO' AND 'DEFINE' KEYWORDS ARE SYNOMIMUS. 
CA MACRO CAN BE DEFINED WITH A DEFINITION CONTAINING ONE OR 
C  MORE 'PASSCHARACTERS' IN IT. WHEN THE MACRO IS INVOKED, EACH 
C  OCCURANCE OF THE PASSCHARACTER IN THE DEFINITION IS REPLACED 
C  WITH THE CURRENT ARGUMENT OF THE MACRO, WHICH IS CONTAINED IN PAREN
C  FOLLOWING THE MACRO NAME.
CDEFINE(FOO,($=$+1)) OR MACRO(FOO,($=$+1))	THEN 
C  UNTIL (I)		IS PROCESSED INTO	UNTIL (I=I+1) 
C NO PROCESSING OF THE MACRO DEFINITION IS DONE UNTIL THE MACRO 
C   IS RESOLVED. SPECIAL CHAR. AND BLANKS IN DEFINITION ARE PRESERVED.
C
      SUBROUTINE DEFMAC ( DEFN )
C
      INTEGER I, NLPAR, SLEN
      LOGICAL * 1 DEFN ( 96 ), TOKEN ( 80 ), GTOK 
C
      IF (.NOT.( DEFN ( 1 ) .EQ. - 9 )) GOTO 20056
      IF (.NOT.( GTOK ( TOKEN, 80 ) .NE. 40 )) GOTO 20058 
      CALL SYNERR ( 14HNO ( IN MACRO. ) 
      CALL PBSTR ( TOKEN )
      RETURN
20058 CONTINUE
      NLPAR = 1 
       I = 1
20060 IF (.NOT.( NLPAR .GT. 0)) GOTO 20062
      IF (.NOT.( I .GT. 80 )) GOTO 20063
      CALL SYNERR ( 24HMACRO ARGUMENT TOO LONG. ) 
      RETURN
20063 CONTINUE
      IF (.NOT.( NGETCH ( TOKEN ( I ) ) .EQ. - 3 .OR. TOKEN ( I ) .EQ.  
     $10 )) GOTO 20065
      CALL SYNERR ( 27HMACRO > 1 LINE NOT ALLOWED. )
      CALL PUTBAK ( TOKEN ( I ) ) 
      RETURN
20065 CONTINUE
      CALL LRPAR ( TOKEN ( I ), NLPAR ) 
20061 I = I + 1 
      GOTO 20060
20062 CONTINUE
      TOKEN ( I - 1 ) = 0 
C PUSH BACK 'DEFINITION' WITH 'TOKEN' IN PLACE OF 'PASSCHAR'
C	BUT NOT THE FIRST CHAR--MACTYPE 
       I = SLEN ( DEFN )
20067 IF (.NOT.( I .GT. 1)) GOTO 20069
      IF (.NOT.( DEFN ( I ) .EQ. 36 )) GOTO 20070 
      CALL PBSTR ( TOKEN )
      GOTO 20071
20070 CONTINUE
      CALL PUTBAK ( DEFN ( I ) )
20071 CONTINUE
20068 I = I - 1 
      GOTO 20067
20069 CONTINUE
      GOTO 20057
20056 CONTINUE
      CALL PBSTR ( DEFN ) 
20057 CONTINUE
      RETURN
      END 

C
C$ DEFTOK	- GET TOKEN; CONVERT SYMBOLIC CONSTANTS, DO INCLUDES
C PCN 93, 18 FEB 80, HANDLE EOF OF INCLUDE FILES
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C PCN 92, 20 FEB 80, ADD GTFUNC TO SET UP FOR RETURN(EXPRESSION)
C IMPOSSES THE RESTRICTION THAT SYMBOLIC CONSTANTS
C MUST START WITH A LETTER.  ALSO THAT SYMBOLIC CONSTANTS ARE 
C ALWAYS CONVERTED TO UPPER CASE BEFORE LOOKUP, THEREFOR CASE 
C IS NOT SIGNIFICANT TO SYMBOLIC CONSTANTS. 
C SYKES, DEC76, ADD MACRO (WITH ARGUMENTS) CAPABILITY 
C
      LOGICAL FUNCTION DEFTOK * 1 ( TOKEN, TOKSIZ ) 
C
      INTEGER TOKSIZ, LOOKFR, SEQL
      LOGICAL * 1 DEFN ( 96 ), T, TOKEN ( TOKSIZ ), GTOK, TYPE
C
C				FILE = CLINE.RAT  FOR RATFOR.RAT 
C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING 
      COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF, FTNLN 
      INTEGER LEVEL 
      INTEGER INFILE
      INTEGER LINECT
      INTEGER INIF
      INTEGER FTNLN 
C
      LOGICAL * 1 FUNC (9)
C
      DATA FUNC/1HF,1HU,1HN,1HC,1HT,1HI,1HO,1HN,0/
20072 IF (.NOT.( LEVEL .GT. 0 )) GOTO 20073 
       DEFTOK = GTOK ( TOKEN, TOKSIZ )
20074 IF (.NOT.( DEFTOK .NE. - 3)) GOTO 20076 
      IF (.NOT.( DEFTOK .NE. - 100 .OR. TYPE ( TOKEN ( 1 ) ) .NE. - 30  
     $)) GOTO 20077 
      RETURN
20077 CONTINUE
      CALL UNFOLD ( TOKEN ) 
      IF (.NOT.( LOOKFR ( TOKEN, DEFN ) .EQ. 0 )) GOTO 20079
      IF (.NOT.( SEQL ( FUNC, TOKEN ) .EQ. 1 )) GOTO 20081
      CALL GTFUNC 
20081 CONTINUE
      RETURN
20079 CONTINUE
      CALL DEFMAC ( DEFN )
20080 CONTINUE
20075 DEFTOK = GTOK ( TOKEN , TOKSIZ )  
      GOTO 20074
20076 CONTINUE
      IF (.NOT.( LEVEL .EQ. 1 )) GOTO 20083 
      RETURN
20083 CONTINUE
      CLOSE ( UNIT = INFILE ( LEVEL ) ) 
      LEVEL = LEVEL - 1 
20084 CONTINUE
C
      GOTO 20072
20073 CONTINUE
      END 

C
C$ DOCODE	- GENERATE CODE FOR BEGINNING OF 'DO' STATEMENT 
C
      SUBROUTINE DOCODE ( LAB ) 
C
      INTEGER LABGEN, LAB 
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS 
      INTEGER LC
      INTEGER COMPRS
C
      LOGICAL * 1 DOSTRU (4)
      LOGICAL * 1 DOSTRL (4)
C
      DATA DOSTRU/1HD,1HO,1H ,0/
      DATA DOSTRL/1Hd,1Ho,1H ,0/
      CALL OUTTAB 
      IF (.NOT.( LC .EQ. 1 )) GOTO 20085
      CALL OUTSTR ( DOSTRL )
      GOTO 20086
20085 CONTINUE
      CALL OUTSTR ( DOSTRU )
20086 CONTINUE
      LAB = LABGEN ( 2 )
      CALL OUTNUM ( LAB ) 
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20087
      CALL OUTCH ( 32 ) 
20087 CONTINUE
      CALL EATUP
      CALL OUTDON 
C
      RETURN
      END 

C
C$ DOINDX	- COLLECT, FORMAT, AND SAVE LINES FOR THE INDEX 
C PCN # 96, 20 MAR 80 
C
      SUBROUTINE DOINDX ( MODE, TITLE ) 
C
      INTEGER MODE, I, JUNK, PAG
      INTEGER STRPUT, SITOC, SJOIN
      LOGICAL * 1 BUFR ( 97 ), TITLE ( 1 )
C
C				FILE = CLIST. RAT   FOR RATFOR.RAT ; SYKES,26SEP76 
      COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, 
     $DEBUG, INDXIT 
      INTEGER LST 
      INTEGER PLINE 
      INTEGER PAGE
      INTEGER ERRORS
      INTEGER OUTPUT
      INTEGER IFPNT 
      INTEGER DEBUG 
      INTEGER INDXIT
C
      LOGICAL * 1 FIL (7) 
      LOGICAL * 1 INCL (14) 
C
      DATA FIL/1HF,1HI,1HL,1HE,1H:,1H ,0/ 
      DATA INCL/1H ,1H ,1H ,1H ,1HI,1HN,1HC,1HL,1HU,1HD,1HE,1H:,1H ,0/
      IF (.NOT.( INDXIT .EQ. 1 )) GOTO 20089
      PAG = PAGE
      IF (.NOT.( MODE .EQ. 1 )) GOTO 20091
      PAG = PAG + 1 
20091 CONTINUE
      JUNK = SITOC ( PAG, BUFR ( 1 ), 4 ) 
      I = 5 
      IF (.NOT.( MODE .EQ. 2 )) GOTO 20093
      I = 7 
20093 CONTINUE
      CALL SPAD ( BUFR, I ) 
      IF (.NOT.( MODE .EQ. 1 )) GOTO 20095
      JUNK = SJOIN ( BUFR, FIL, 96, JUNK )
20095 CONTINUE
      IF (.NOT.( MODE .EQ. 3 )) GOTO 20097
      JUNK = SJOIN ( BUFR, INCL, 96, JUNK ) 
20097 CONTINUE
      JUNK = SJOIN ( BUFR, TITLE, 96, JUNK )
      IF (.NOT.( STRPUT ( 9, BUFR, 0 ) .NE. 1 )) GOTO 20099 
      CALL ERROR ( 36HDOINDX I/O ERROR WRITING INDEX FILE. )
20099 CONTINUE
20089 CONTINUE
      RETURN
      END 

C
C$ DMPIDX	- PRINT THE INDEX PAGES 
C PCN #96, 20 MAR 80
C PCN #115 21 JUN 81, SPEED UP BY USING GETIN INSTEAD OF STRGET 
C
      SUBROUTINE DMPIDX 
C
      INTEGER GETIN 
      LOGICAL * 1 BUFR ( 97 ) 
C
      REWIND 9
      BUFR ( 1 ) = 12 
      BUFR ( 2 ) = 0
      CALL RATLST ( BUFR, 0, 0 )
      CALL RATLST ( 4HPAGE, 0, 0 )
      CALL RATLST ( 1H , 0, 0 ) 
20101 IF (.NOT.( GETIN ( 9, BUFR, BUFR ) .NE. - 3 )) GOTO 20102 
      CALL RATLST ( BUFR, 0, 0 )
C
      GOTO 20101
20102 CONTINUE
      RETURN
      END 

C
C$ EATUP	- PROCESS REST OF A STATEMENT; INTERPRET CONTINUATIONS 
C PCN 102, 29 MAR 80, ALLOW UNDERLINE EMBEDDED IN TOKENS
C
      SUBROUTINE EATUP
C
      LOGICAL * 1 PTOKEN ( 80 ), T, TOKEN ( 80 ), DEFTOK
      INTEGER NLPAR, SLEN 
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS 
      INTEGER LC
      INTEGER COMPRS
C
      NLPAR = 0 
20103 CONTINUE
      T = DEFTOK ( TOKEN, 80 )
      IF (.NOT.( T .EQ. 59 .OR. T .EQ. 10 )) GOTO 20106 
      GOTO 20105
20106 CONTINUE
      IF (.NOT.( T .EQ. 125 )) GOTO 20108 
      CALL PBSTR ( TOKEN )
      GOTO 20105
20108 CONTINUE
      IF (.NOT.( T .EQ. 123 .OR. T .EQ. - 3 )) GOTO 20110 
      IF (.NOT.( NLPAR .GT. 0 )) GOTO 20112 
      CALL SYNERR ( 24HUNEXPECTED BRACE OR EOF. ) 
20112 CONTINUE
      CALL PBSTR ( TOKEN )
      GOTO 20105
20110 CONTINUE
      IF (.NOT.( T .EQ. 44 .OR. TOKEN ( SLEN ( TOKEN ) ) .EQ. 95 )) 
     $GOTO 20114
      IF (.NOT.( DEFTOK ( PTOKEN, 80 ) .NE. 10 )) GOTO 20116
      CALL PBSTR ( PTOKEN ) 
      GOTO 20117
20116 CONTINUE
      IF (.NOT.( T .NE. 44 )) GOTO 20118
      TOKEN ( SLEN ( TOKEN ) ) = 0
20118 CONTINUE
20117 CONTINUE
      GOTO 20115
20114 CONTINUE
      CALL LRPAR ( T, NLPAR ) 
20115 CONTINUE
      IF (.NOT.( T .NE. 44 .AND. COMPRS .EQ. 0 )) GOTO 20120
      CALL OUTCH ( 32 ) 
20120 CONTINUE
      CALL OUTSTR ( TOKEN ) 
20104 IF (.NOT.( NLPAR .LT. 0 )) GOTO 20103 
20105 CONTINUE
      IF (.NOT.( NLPAR .NE. 0 )) GOTO 20122 
      CALL SYNERR ( 15HUNBALANCED ( ). )
C
20122 CONTINUE
      RETURN
      END 

C
C$ ELSEIF	- GENERATE CODE FOR END OF 'IF' BEFORE ELSE 
C PCN#10, 21 OCT 77 DON'T GENERATE THE 'GOTO' IF THE PRECEEDING LINE GEN
C  A 'GOTO', MAKING THIS ONE UNREACHABLE, WHICH SOME COMPILERS DON'T LIK
C PCN 109, 1 OCT 80, CHANGE DATA TYPE OF 'LAST' TO INTEGER. 
C
      SUBROUTINE ELSE IF ( LAB, LAST )
C
      INTEGER LAB, LAST 
C
      IF (.NOT.( LAST .NE. - 110 .AND. LAST .NE. - 117  .AND. LAST .NE. 
     $- 123 .AND. LAST .NE. - 122 )) GOTO 20124 
      CALL OUTGO ( LAB + 1 )
20124 CONTINUE
      CALL OUTCON ( LAB ) 
C
      RETURN
      END 

C
C$ ENDCOD	- PROCESS 'END' STATEMENT 
C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING 
C PCN #92, 20 FEB 80, RESET IN-FUNCTION STATUS FLAG.
C
      SUBROUTINE ENDCOD ( LEXSTR, SP )
C
      INTEGER SLEN, SP
      LOGICAL * 1 LEXSTR ( 1 ), PTOK ( 80 ), DEFTOK 
C
C				FILE=CFUNC.RAT  FOR RATFOR 
      COMMON / CFUNC / INFUNC, FNAM ( 80 )
      INTEGER INFUNC
      LOGICAL * 1 FNAM
C
C				FILE = CLIST. RAT   FOR RATFOR.RAT ; SYKES,26SEP76 
      COMMON / CLIST / LST ( 4 ), PLINE, PAGE, OUTPUT, ERRORS, IFPNT, 
     $DEBUG, INDXIT 
      INTEGER LST 
      INTEGER PLINE 
      INTEGER PAGE
      INTEGER ERRORS
      INTEGER OUTPUT
      INTEGER IFPNT 
      INTEGER DEBUG 
      INTEGER INDXIT
C
C				FILE=CPRTLN.RAT FOR RATFOR 
      COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 97 ) 
      INTEGER FORTYP
      INTEGER IFTYP 
      INTEGER READY 
      LOGICAL * 1 PRTBUF
C
C				FILE = CLINE.RAT  FOR RATFOR.RAT 
C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING 
      COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF, FTNLN 
      INTEGER LEVEL 
      INTEGER INFILE
      INTEGER LINECT
      INTEGER INIF
      INTEGER FTNLN 
C
      IF (.NOT.( 3 .EQ. SLEN ( LEXSTR ) .AND. DEFTOK ( PTOK, 80 ) .EQ.  
     $10 )) GOTO 20126
      CALL OUTTAB 
      CALL OUTSTR ( LEXSTR )
      CALL OUTDON 
      CALL PRTLIN 
      IF (.NOT.( SP .NE. 1 )) GOTO 20128
      CALL SYNERR ( 40HMISSING CLAUSE OR BRACE IN ABOVE MODULE. ) 
      SP = 1
20128 CONTINUE
      PLINE = 9999
      CALL OUTCH ( 12 ) 
      CALL OUTDON 
      FTNLN = 0 
      INFUNC = 0
      GOTO 20127
20126 CONTINUE
      CALL OTHERC ( LEXSTR )
20127 CONTINUE
      CALL PBSTR ( PTOK ) 
      RETURN
      END 

C
C$ ENDSTR	- DUMP PENDING STRING DEFINITIONS 
C
      SUBROUTINE ENDSTR 
C
      INTEGER J, K, SLEN
C
C					FILE= CSTR.RAT  FOR RATFOR
      COMMON / CSTR / LASTS, LASTR, STRPTR ( 35 ), TABLES ( 400 ) 
      INTEGER LASTS 
      INTEGER LASTR 
      INTEGER STRPTR
      LOGICAL * 1 TABLES
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS 
      INTEGER LC
      INTEGER COMPRS
C
C				FILE= COUTLN.RAT  FOR RATFOR.RAT 
      COMMON / COUTLN / OUTP, OUTBUF ( 97 ) 
      INTEGER OUTP
      LOGICAL * 1 OUTBUF
C
      LOGICAL * 1 DATAU (6) 
      LOGICAL * 1 DATAL (6) 
C
      DATA DATAU/1HD,1HA,1HT,1HA,1H ,0/ 
      DATA DATAL/1Hd,1Ha,1Ht,1Ha,1H ,0/ 
       K = 1
20130 IF (.NOT.( K .LE. LASTS)) GOTO 20132
      CALL OUTTAB 
      IF (.NOT.( LC .EQ. 1 )) GOTO 20133
      CALL OUTSTR ( DATAL ) 
      GOTO 20134
20133 CONTINUE
      CALL OUTSTR ( DATAU ) 
20134 CONTINUE
      J = STRPTR ( K )
      CALL OUTSTR ( TABLES ( J ) )
      CALL OUTCH ( 47 ) 
       J = J + SLEN ( TABLES ( J ) ) + 1
20135 IF (.NOT.( TABLES ( J ) .NE. 0)) GOTO 20137 
      CALL OUTCH ( 49 ) 
      IF (.NOT.( LC .EQ. 1 )) GOTO 20138
      CALL OUTCH ( 104 )
      GOTO 20139
20138 CONTINUE
      CALL OUTCH ( 72 ) 
20139 CONTINUE
      CALL OUTCH ( TABLES ( J ) ) 
      CALL OUTCH ( 44 ) 
      IF (.NOT.( OUTP .GE. 69 )) GOTO 20140 
      OUTP = - OUTP 
20140 CONTINUE
20136 J = J + 1 
      GOTO 20135
20137 CONTINUE
      CALL OUTNUM ( 0 ) 
      CALL OUTCH ( 47 ) 
      CALL OUTDON 
20131 K = K + 1 
      GOTO 20130
20132 CONTINUE
      LASTS = 0 
      LASTR = 0 
      RETURN
      END 

C
C$ ERROR	- PRINT FATAL ERROR MESSAGE, THEN DIE
CSYKES 28 SEP 76
C
      SUBROUTINE ERROR ( BUF )
C
      LOGICAL * 1 BUF ( 1 ) 
C
      CALL SYNERR ( BUF ) 
      CALL SYNERR ( 10H**ABORT**. ) 
      CALL EXIT 
      END 

C
C$ FORCOD	- GENERATE CODE FOR THE BEGINNING OF 'FOR' STATEMENT
C ***PCN # 21 
C PCN #75, DEC 79, ADD FTN LINE NUMBERS TO LISTING
C
      SUBROUTINE FORCOD ( LAB, SP ) 
C
      LOGICAL * 1 T, TOKEN ( 80 ), DEFTOK 
      INTEGER SLEN, LABGEN
      INTEGER I, J, LAB, NLPAR, SP, JUNK, SCOPY 
C
C					FILE = CFOR.RAT FOR RATFOR.RAT
      COMMON / CFOR / FORDEP, FORSTK ( 150 ), FORLEN
      INTEGER FORDEP
      LOGICAL * 1 FORSTK
      INTEGER FORLEN
C
C				FILE=CPRTLN.RAT FOR RATFOR 
      COMMON / CPRTLN / FORTYP, IFTYP, READY, PRTBUF ( 97 ) 
      INTEGER FORTYP
      INTEGER IFTYP 
      INTEGER READY 
      LOGICAL * 1 PRTBUF
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS 
      INTEGER LC
      INTEGER COMPRS
C
      LAB = LABGEN ( 3 )
      IF (.NOT.( SP .GT. 1 )) GOTO 20142
      CALL OUTCON ( 0 ) 
C
20142 CONTINUE
      IF (.NOT.( DEFTOK ( TOKEN, 80 ) .NE. 40 )) GOTO 20144 
      CALL SYNERR ( 18HMISSING  ( IN FOR. ) 
      RETURN
20144 CONTINUE
      IF (.NOT.( DEFTOK ( TOKEN, 80 ) .NE. 59 )) GOTO 20146 
      CALL PBSTR ( TOKEN )
      CALL OUTTAB 
      CALL EATUP
      CALL OUTDON 
      FORTYP = 1
20146 CONTINUE
      IF (.NOT.( DEFTOK ( TOKEN, 80 ) .EQ. 59 )) GOTO 20148 
      CALL OUTCON ( LAB ) 
      GOTO 20149
20148 CONTINUE
      CALL PBSTR ( TOKEN )
      CALL OUTNUM ( LAB ) 
      CALL OUTIF
      CALL OUTCH ( 40 ) 
      NLPAR = 0 
20150 IF (.NOT.( NLPAR .GE. 0 )) GOTO 20151 
      T = DEFTOK ( TOKEN, 80 )
      IF (.NOT.( T .EQ. 59 )) GOTO 20152
      GOTO 20151
20152 CONTINUE
      CALL LRPAR ( T, NLPAR ) 
20153 CONTINUE
      IF (.NOT.( T .NE. 10 .AND. T .NE. 95 )) GOTO 20154
      IF (.NOT.( T .NE. 44 .AND. COMPRS .EQ. 0 )) GOTO 20156
      CALL OUTCH ( 32 ) 
20156 CONTINUE
      CALL OUTSTR ( TOKEN ) 
20154 CONTINUE
      GOTO 20150
20151 CONTINUE
      CALL OUTCH ( 41 ) 
      CALL OUTCH ( 41 ) 
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20158
      CALL OUTCH ( 32 ) 
20158 CONTINUE
      CALL OUTGO ( LAB + 2 )
      IF (.NOT.( NLPAR .LT. 0 )) GOTO 20160 
      CALL SYNERR ( 26HINVALID FOR CLAUSE SYNTAX. ) 
20160 CONTINUE
20149 CONTINUE
      FORDEP = FORDEP + 1 
      J = FORLEN
      FORSTK ( J ) = 0
      NLPAR = 0 
20162 IF (.NOT.( NLPAR .GE. 0 )) GOTO 20163 
      T = DEFTOK ( TOKEN, 80 )
      CALL LRPAR ( T, NLPAR ) 
      IF (.NOT.( NLPAR .GE. 0 .AND. T .NE. 10 .AND. T .NE. 95 )) GOTO 
     $20164 
      J = J + SLEN ( TOKEN )
      IF (.NOT.( J + 2 .GT. 150 )) GOTO 20166 
      CALL ERROR (  
     $51HFOR REINIT CLAUSE(S) TOO LONG (INCREASE MAXFORSTK). )
      GOTO 20167
20166 CONTINUE
      JUNK = SCOPY ( TOKEN, FORSTK ( FORLEN ), 32767, JUNK )
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20168
      FORSTK ( J ) = 32 
      J = J + 1 
20168 CONTINUE
      FORSTK ( J ) = 0
      FORLEN = J
20167 CONTINUE
20164 CONTINUE
      GOTO 20162
20163 CONTINUE
      FORLEN = FORLEN + 1 
      LAB = LAB + 1 
C
      RETURN
      END 

C
C$ FORS	- GENERATE CODE FOR END OF 'FOR' STATEMENT
C
      SUBROUTINE FORS ( LAB ) 
C
      INTEGER I, J, LAB, SLEN 
C
C					FILE = CFOR.RAT FOR RATFOR.RAT
      COMMON / CFOR / FORDEP, FORSTK ( 150 ), FORLEN
      INTEGER FORDEP
      LOGICAL * 1 FORSTK
      INTEGER FORLEN
C
      CALL OUTNUM ( LAB ) 
      J = 1 
       I = 1
20170 IF (.NOT.( I .LT. FORDEP)) GOTO 20172 
      J = J + SLEN ( FORSTK ( J ) ) + 1 
20171 I = I + 1 
      GOTO 20170
20172 CONTINUE
      IF (.NOT.( SLEN ( FORSTK ( J ) ) .GT. 0 )) GOTO 20173 
      CALL OUTTAB 
      CALL OUTSTR ( FORSTK ( J ) )
      CALL OUTDON 
20173 CONTINUE
      CALL OUTGO ( LAB - 1 )
      CALL OUTCON ( LAB + 1 ) 
      FORDEP = FORDEP - 1 
      FORLEN = J
C
      RETURN
      END 

C
C$ GETDEF 	- GET SYMBOLIC CONSTANTS AND DEFINITIONS 
C SYKES, DEC76, ALLOW SINGLE ARGUMENT MACRO DEFINITIONS.  STORE "MAXTYPE
C  FIRST CHAR OF MACRO DEFINITIONS, SO 'DEFMAC' CAN TELL MACROS FROM SYM
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C   BLANKS ARE PRESERVED IN A DEFINITION
C
      SUBROUTINE GETDEF ( TOKEN, TOKSIZ, DEFN, DEFSIZ ) 
C
      LOGICAL * 1 GTOK, NGETCH, TEMP ( 5 )
      INTEGER DEFSIZ, I, NLPAR, TOKSIZ, INDEX, JUNK, SCOPY
      LOGICAL * 1 C, DEFN ( DEFSIZ ), TOKEN ( TOKSIZ )
C
      DEFN ( 1 ) = 0
      IF (.NOT.( GTOK ( TOKEN, TOKSIZ ) .NE. 40 )) GOTO 20175 
      CALL SYNERR ( 15HNO ( IN DEFINE. )
      RETURN
20175 CONTINUE
      IF (.NOT.( GTOK ( TOKEN, TOKSIZ ) .NE. - 100 )) GOTO 20177
      CALL SYNERR ( 47HSYMBOLIC CONSTANT NAMES MUST START WITH LETTER.  
     $) 
      RETURN
20177 CONTINUE
      IF (.NOT.( GTOK ( TEMP, 5 ) .NE. 44 .AND. TEMP ( 1 ) .NE. 61 )) 
     $GOTO 20179
      CALL SYNERR ( 20HNO , OR = IN DEFINE. ) 
      RETURN
C ELSE GOT '(NAME,'	NOW GET THE DEFINITION... 
20179 CONTINUE
20178 CONTINUE
      NLPAR = 1 
       I = 2
20181 IF (.NOT.( NLPAR .GT. 0)) GOTO 20183
      IF (.NOT.( I .GT. DEFSIZ )) GOTO 20184
      CALL SYNERR ( 47HSYMBOLIC DEFINITION TOO LONG (INCREASE MAXDEF).  
     $) 
      RETURN
20184 CONTINUE
      IF (.NOT.( NGETCH ( DEFN ( I ) ) .EQ. - 3 )) GOTO 20186 
      CALL SYNERR ( 15HNO ) IN DEFINE. )
      RETURN
20186 CONTINUE
      IF (.NOT.( DEFN ( I ) .EQ. 60 )) GOTO 20188 
      CALL MATH 
      I = I - 1 
      GOTO 20189
20188 CONTINUE
      CALL LRPAR ( DEFN ( I ), NLPAR )
20189 CONTINUE
20187 CONTINUE
20182 I = I + 1 
      GOTO 20181
20183 CONTINUE
      DEFN ( I - 1 ) = 0
      DEFN ( 1 ) = - 9
      IF (.NOT.( INDEX ( DEFN, 36 ) .EQ. 0 )) GOTO 20190
      JUNK = SCOPY ( DEFN ( 2 ), DEFN ( 1 ), 96, JUNK ) 
C
20190 CONTINUE
      RETURN
      END 

C
C$ GTFUNC	- GET AND SAVE THE FUNCTION NAME FOR RETURN(EXPRESSION) 
CPCN #92, 20 FEB 80 
C PCN #103, LOOKUP ANY DEFINITION OF FUNCTION NAME BEFORE SAVEING 
C# DEPENDS ON THE WAY LOOKFR DOES NOT CHANGE 2ND STRING UNLES DEFIN. IS 
C
      SUBROUTINE GTFUNC 
C
      INTEGER LOOKFR, JUNK
      LOGICAL * 1 GTOK, T, TYPE 
C
C				FILE=CFUNC.RAT  FOR RATFOR 
      COMMON / CFUNC / INFUNC, FNAM ( 80 )
      INTEGER INFUNC
      LOGICAL * 1 FNAM
C
      T = GTOK ( FNAM, 80 ) 
      CALL UNFOLD ( FNAM )
      JUNK = LOOKFR ( FNAM, FNAM )
      CALL PBSTR ( FNAM ) 
      IF (.NOT.( INFUNC .EQ. 1 .OR. T .NE. - 100 .OR. TYPE ( FNAM ( 1 ) 
     $) .NE. - 30 )) GOTO 20192 
      CALL SYNERR ( 22HILLEGAL FUNCTION NAME. ) 
      GOTO 20193
20192 CONTINUE
      INFUNC = 1
C
20193 CONTINUE
      RETURN
      END 

C
C$ GTOK	- GET TOKEN; INTERPRET SPECIAL CHAR, DELETE BLANKS,TABS 
C PCN #73, DEC 79, ADD TILDE,CARET FOR .NOT.
C PCN #87, 12 FEB 80, PASS '...' STRINGS WITHOUT PROCESSING.
C PCN 94, 17 FEB 80, STOP PASSING CURRENT INPUT FILE LUN ALL OVER.
C PCN 102, 29 MAR 80, ALLOW UNDERLINE EMBEDDED IN TOKENS
C PCN #120, 12 JUL 81, ALLOW PERIODS (DECIMAL POINT) TO BE PART OF TOKES
C
      LOGICAL FUNCTION GTOK * 1 ( TOKEN, TOKSIZ ) 
C
      INTEGER I, TOKSIZ 
      LOGICAL * 1 C, TOKEN ( TOKSIZ ), NGETCH, TYPE 
C
20194 IF (.NOT.( NGETCH ( C ) .NE. - 3 )) GOTO 20195
      IF (.NOT.( C .NE. 32 .AND. C .NE. 9 )) GOTO 20196 
      GOTO 20195
20196 CONTINUE
      GOTO 20194
20195 CONTINUE
      CALL PUTBAK ( C ) 
C
       I = 1
20198 IF (.NOT.( I .LT. TOKSIZ - 1)) GOTO 20200 
      GTOK = TYPE ( NGETCH ( TOKEN ( I ) ) )
      IF (.NOT.( GTOK .NE. - 30 .AND. GTOK .NE. - 20 .AND. GTOK .NE. 95 
     $.AND.  GTOK .NE. 46 )) GOTO 20201 
      GOTO 20200
20201 CONTINUE
C
20199 I = I + 1 
      GOTO 20198
20200 CONTINUE
      IF (.NOT.( I .GE. TOKSIZ - 1 )) GOTO 20203
      CALL SYNERR ( 33HTOKEN TOO LONG (INCREASE MAXTOK). )
20203 CONTINUE
      IF (.NOT.( I .GT. 1 )) GOTO 20205 
      CALL PUTBAK ( TOKEN ( I ) ) 
      TOKEN ( I ) = 0 
      GTOK = - 100
C
C DO SOME CHARACTER CONVERSIONS TO MAKE THINGS EASIER LATER 
      GOTO 20206
20205 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 92 )) GOTO 20207
      TOKEN ( 1 ) = 124 
      GTOK = 124
      GOTO 20208
20207 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 91 )) GOTO 20209
      TOKEN ( 1 ) = 123 
      GTOK = 123
      GOTO 20210
20209 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 93 )) GOTO 20211
      TOKEN ( 1 ) = 125 
      GTOK = 125
      GOTO 20212
20211 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 126 .OR. TOKEN ( 1 ) .EQ. 94 )) GOTO  
     $20213 
      TOKEN ( 1 ) = 33
      GTOK = 33 
C# ELSE IF (TOKEN(1) == DOLLAR) [  		# ALLOW $( AND $) FOR BRACES 
C#    IF (NGETCH(TOKEN(2)) == LPAREN) [ 
C#       TOKEN(1) = LBRACE
C#       GTOK = LBRACE
C#       ]
C#    ELSE IF (TOKEN(2) == RPAREN) [
C#       TOKEN(1) = RBRACE
C#       GTOK = RBRACE		##SYKES, 22NOV76
C#       ]
C#    ELSE
C#       CALL PUTBAK(TOKEN(2))
C#    ] 
      GOTO 20214
20213 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 34 .OR. TOKEN ( 1 ) .EQ. 39 )) GOTO 
     $20215 
C COLLECT QUOTED STRINGS AS SINGLE TOKENS WITHOUT PROCESSING. 
       I = 2
20217 IF (.NOT.( NGETCH ( TOKEN ( I ) ) .NE. TOKEN ( 1 ))) GOTO 20219 
      IF (.NOT.( TOKEN ( I ) .EQ. 10 .OR. I .GE. TOKSIZ - 1 )) GOTO 
     $20220 
      CALL SYNERR ( 14HMISSING QUOTE. ) 
      TOKEN ( I ) = TOKEN ( 1 ) 
      CALL PUTBAK ( 10 )
      GOTO 20219
20220 CONTINUE
20218 I = I + 1 
      GOTO 20217
20219 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 39 .AND. I .EQ. 2 )) GOTO 20222 
      I = 1 
20222 CONTINUE
      GOTO 20216
20215 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 35 )) GOTO 20224
20226 IF (.NOT.( NGETCH ( TOKEN ( 1 ) ) .NE. 10 )) GOTO 20227 
      GOTO 20226
20227 CONTINUE
      GTOK = 10 
20224 CONTINUE
20216 CONTINUE
20214 CONTINUE
20212 CONTINUE
20210 CONTINUE
20208 CONTINUE
20206 CONTINUE
      IF (.NOT.( TOKEN ( 1 ) .EQ. 62 .OR. TOKEN ( 1 ) .EQ. 60 .OR.  
     $TOKEN ( 1 ) .EQ. 33  .OR. TOKEN ( 1 ) .EQ. 61 .OR. TOKEN ( 1 )  
     $.EQ. 38 .OR. TOKEN ( 1 ) .EQ. 124 )) GOTO 20228 
      CALL RELATE ( TOKEN, I )
20228 CONTINUE
      TOKEN ( I + 1 ) = 0 
C
      RETURN
      END 

C
C$ IFCODE 	- GENERATE INITIAL CODE FOR 'IF' STATEMENTS
C
      SUBROUTINE IFCODE ( LAB ) 
C
      INTEGER LAB, LABGEN 
C
      LAB = LABGEN ( 2 )
      CALL IFGO ( LAB ) 
C
      RETURN
      END 

C
C$ IFDEFC	- PROCESS 'IFDEF' AND 'IFNOTDEF' CONDITIONALS 
CSYKES, FEB77,APR77,
C PCN 77, 5 JAN 80, ADD UNFOLD, SO 'IFDEF' ETC CAN BE LOWER CASE. 
CCTRL='YES' FOR IFDEF; 'NO' FOR IFNOTDEF
CIFDEF (SYMBOL)		OR IFNOTDEF (SYMBOL) 
C   <STATEMENT> 
CENDIFDEF 
C
      SUBROUTINE IFDEFC ( CTRL )
C
      INTEGER LOOKFR, SEQL, LAYER, CTRL 
      LOGICAL * 1 TOKEN ( 80 ), JUNK ( 96 ), GTOK, TYPE 
C
C				FILE = CLINE.RAT  FOR RATFOR.RAT 
C PCN #75, DEC 79, ADD FORTRAN LINE NUMBERS TO RATFOR LISTING 
      COMMON / CLINE / LEVEL, INFILE ( 4 ), LINECT, INIF, FTNLN 
      INTEGER LEVEL 
      INTEGER INFILE
      INTEGER LINECT
      INTEGER INIF
      INTEGER FTNLN 
C
      LOGICAL * 1 ENDIF (9) 
      LOGICAL * 1 IFDEFS (6)
      LOGICAL * 1 IFNOT (9) 
C
      DATA ENDIF/1HE,1HN,1HD,1HI,1HF,1HD,1HE,1HF,0/ 
      DATA IFDEFS/1HI,1HF,1HD,1HE,1HF,0/
      DATA IFNOT/1HI,1HF,1HN,1HO,1HT,1HD,1HE,1HF,0/ 
      IF (.NOT.( GTOK ( TOKEN, 80 ) .NE. 40 )) GOTO 20230 
      CALL SYNERR ( 19HMISSING ( IN IFDEF. )
      CALL PBSTR ( TOKEN )
      RETURN
20230 CONTINUE
      IF (.NOT.( GTOK ( TOKEN, 80 ) .NE. - 100 .OR.  TYPE ( TOKEN ( 1 ) 
     $) .NE. - 30 )) GOTO 20232 
      CALL SYNERR ( 40HILLEGAL SYMBOLIC CONSTANT USED IN IFDEF. ) 
      CALL PBSTR ( TOKEN )
      RETURN
C
20232 CONTINUE
      IF (.NOT.( LOOKFR ( TOKEN, JUNK ) .EQ. CTRL )) GOTO 20234 
      IF (.NOT.( GTOK ( TOKEN, 80 ) .NE. 41 )) GOTO 20236 
      CALL SYNERR ( 19HMISSING ) IN IFDEF. )
      CALL PBSTR ( TOKEN )
      RETURN
20236 CONTINUE
      RETURN
C
20234 CONTINUE
      INIF = 1
      LAYER = 1 
20238 CONTINUE
      IF (.NOT.( GTOK ( TOKEN, 80 ) .NE. - 3 )) GOTO 20241
      CALL UNFOLD ( TOKEN ) 
      IF (.NOT.( SEQL ( TOKEN, ENDIF ) .EQ. 1 )) GOTO 20243 
      IF (.NOT.( LAYER .EQ. 1 )) GOTO 20245 
      GOTO 20240
20245 CONTINUE
      LAYER = LAYER - 1 
20246 CONTINUE
      GOTO 20244
20243 CONTINUE
      IF (.NOT.( SEQL ( TOKEN, IFDEFS ) .EQ. 1 .OR. SEQL ( TOKEN, IFNOT 
     $) .EQ. 1 )) GOTO 20247
      LAYER = LAYER + 1 
20247 CONTINUE
20244 CONTINUE
      GOTO 20242
20241 CONTINUE
      CALL SYNERR ( 33HUNTERMINATED IFDEF (NO ENDIFDEF). )
      CALL PUTBAK ( TOKEN ) 
      GOTO 20240
20242 CONTINUE
20239 GOTO 20238
20240 CONTINUE
      INIF = 0
      RETURN
C
20235 CONTINUE
      END 

C
C$ IFGO	- GENERATE CODE:  "IF(NOT.(...))GOTO LAB" 
C ***PCN # 21 
C
      SUBROUTINE IFGO ( LAB ) 
C
      INTEGER LAB 
C
C				FILE= CUCLC.RAT  FOR RATFOR
      COMMON / CUCLC / LC, COMPRS 
      INTEGER LC
      INTEGER COMPRS
C
      CALL OUTIF
      CALL BALPAR 
      CALL OUTCH ( 41 ) 
      IF (.NOT.( COMPRS .EQ. 0 )) GOTO 20249
      CALL OUTCH ( 32 ) 
20249 CONTINUE
      CALL OUTGO ( LAB )
C
      RETURN
      END