C-------RFP
C-------RFPP
      PROGRAMRFPP
      INTEGERARGSTK(100)
      INTEGERMACADR(500)
      INTEGERMACDEF(500)
      INTEGERMACIND(64)
      INTEGERMACNAM(500)
      INTEGERMACNEX(500)
      INTEGERITAB
      INTEGERMACM
      INTEGERMTAB
      INTEGERNARG
      INTEGERNBUF
      INTEGERNDEV
      INTEGERNOUT
      INTEGERNMAC
      INTEGERNDAT
      COMMON/INT1/ARGSTK,MACADR,MACDEF,MACIND,MACNAM,MACNEX,MACM,NARG,NM
     &AC,ITAB,MTAB,NBUF,NDAT,NDEV,NOUT
      INTEGERACCF
      INTEGERCODF
      INTEGEREXTF
      INTEGERFLAGS,FLAGR,FLAGD
      INTEGERFORSTK(100)
      INTEGERNERR
      INTEGERNLAB
      INTEGERNERT
      INTEGERNBRC
      INTEGERNSQB
      INTEGERNFIL
      INTEGERNFOR
      INTEGERIFOR
      INTEGERILIN
      INTEGERLLIN
      INTEGEROLIN
      INTEGERXFLG
      COMMON/INT2/ACCF,CODF,EXTF,FLAGS,FLAGR,FLAGD,FORSTK,NERR,NLAB,NERT
     &,NBRC,NSQB,NFIL,NFOR,IFOR,ILIN,LLIN,OLIN,XFLG
      CHARACTER*4000IBUF
      CHARACTER*72OBUF
      CHARACTER*120LBUF
      CHARACTER*12PROG
      CHARACTER*20000MACTAB
      CHARACTER*4000MACSTR
      CHARACTER*4000FORSTR
      CHARACTER*1BSL
      COMMON/CHRX/IBUF,OBUF,LBUF,PROG,MACTAB,MACSTR,FORSTR,BSL
      CHARACTER*1C
      CHARACTER*100STRING
      CHARACTER*20LINE
      INTEGERFLAG
      INTEGERFILSTK(5)
      INTEGERFUNSTK(100)
      INTEGERLABSTK(100)
      INTEGERILAB
      INTEGERINCL
      INTEGERNFUN
      INTEGERNSTR
      INTEGERNTOK
      INTEGERTYPE
      DATAFLAG/-1/
      DATALINE/' Total Errors:      '/
      CALLINITL
      I=0
27000 IF(I.LT.5)THEN
      FILSTK(I+1)=I+1
      I=I+1
      GOTO27000
      END IF
      STRING(1:)=' '
      NFIL=1
27003 IF(NFIL.GT.0)THEN
      NDEV=FILSTK(NFIL)
      NFUN=0
27006 CONTINUE
      INCL=0
      NSTR=1
27008 CONTINUE
      CALLMACEXP(STRING(NSTR:),TYPE,NTOK)
      NSTR=NSTR+NTOK
      IF(TYPE.EQ.4)THEN
      GOTO27009
      END IF
      IF(INCL.EQ.0)THEN
      IF(STRING(1:7).NE.'INCLUDE')THEN
      GOTO27009
      END IF
      INCL=1
      END IF
      IF(TYPE.EQ.8)THEN
      NSTR=NSTR-NTOK
      END IF
      IF(TYPE.NE.3)THEN
      GOTO27008
      END IF
      NFIL=NFIL+1
      IF(NFIL.GT.5)THEN
      CALLERROR(01,' ',0)
      END IF
      NDEV=FILSTK(NFIL)
      OPEN(NDEV,FILE=STRING(8:NSTR-2),STATUS='OLD')
      REWIND(NDEV)
      GOTO27009
27009 CONTINUE
      IF(TYPE.EQ.3.OR.TYPE.EQ.8)THEN
      GOTO27006
      END IF
      IF(TYPE.EQ.4.OR.INCL.EQ.1)THEN
      GOTO27007
      END IF
      NSTR=NSTR-1
      C=STRING(1:1)
      IF(C.EQ.'{'.OR.(TYPE.EQ.7.AND.C.EQ.'('))THEN
      NBRC=NBRC+1
      IFUN=7
      ILAB=0
      ELSE IF(C.EQ.'}'.OR.(TYPE.EQ.7.AND.C.EQ.')'))THEN
      NBRC=NBRC-1
      IFUN=0
      IF(FUNSTK(NFUN).EQ.7)THEN
      NFUN=NFUN-1
      ELSE 
      CALLERROR(04,' ',0)
      END IF
      ELSE IF(TYPE.EQ.7.AND.C.EQ.'P')THEN
      FLAG=-2
      IFUN=0
      ELSE IF(NSTR.EQ.2.AND.STRING(1:2).EQ.'IF')THEN
      IF(IFUN.EQ.6)THEN
      ILAB=0
      ELSE 
      ILAB=-1
      END IF
      CALLOUTSTR(ILAB,'IF',2,0)
      CALLEATUP(2,0)
      CALLOUTSTR(0,'THEN',4,0)
      IFUN=2
      ELSE IF(NSTR.EQ.4.AND.STRING(1:4).EQ.'ELSE')THEN
      N=FUNSTK(NFUN)
      IF(N.NE.2)THEN
      CALLERROR(17,' ',0)
      END IF
      CALLOUTSTR(-1,'ELSE ',5,0)
      IFUN=6
      ILAB=0
      ELSE IF(NSTR.EQ.6.AND.STRING(1:6).EQ.'ELSEIF')THEN
      N=FUNSTK(NFUN)
      IF(N.NE.2)THEN
      CALLERROR(17,' ',0)
      END IF
      NFUN=NFUN+1
      IF(NFUN.GT.100)THEN
      CALLERROR(05,' ',0)
      END IF
      FUNSTK(NFUN)=6
      LABSTK(NFUN)=NLAB
      CALLOUTSTR(-1,'ELSE IF',7,0)
      CALLEATUP(2,0)
      CALLOUTSTR(0,'THEN',4,0)
      IFUN=2
      ILAB=0
      ELSE IF(NSTR.EQ.2.AND.STRING(1:2).EQ.'DO')THEN
      CALLOUTSTR(-1,'DO',2,NLAB)
      CALLEATUP(1,0)
      IFUN=1
      ILAB=2
      ELSE IF(NSTR.EQ.5.AND.STRING(1:5).EQ.'WHILE')THEN
      CALLOUTSTR(NLAB,'IF',2,0)
      CALLEATUP(4,0)
      CALLOUTSTR(0,'THEN',4,0)
      IFUN=4
      ILAB=2
      ELSE IF(NSTR.EQ.6.AND.STRING(1:6).EQ.'REPEAT')THEN
      CALLOUTSTR(NLAB,'CONTINUE',8,0)
      IFUN=5
      ILAB=2
      ELSE IF(NSTR.EQ.3.AND.STRING(1:3).EQ.'FOR')THEN
      CALLEATUP(3,-1)
      NBUF=NBUF+1
      IF(IBUF(NBUF:NBUF).NE.';')THEN
      NBUF=NBUF-1
      CALLOUTSTR(NLAB,'IF(',3,0)
      CALLEATUP(3,0)
      CALLOUTSTR(0,')THEN',5,0)
      IFUN=3
      ELSE 
      CALLOUTSTR(NLAB,'CONTINUE',8,0)
      IFUN=-3
      END IF
      CALLEATUP(3,-3)
      ILAB=2
      NLAB=NLAB+1
      ELSE IF((NSTR.EQ.4.AND.STRING(1:4).EQ.'NEXT').OR.(NSTR.EQ.5.AND.ST
     &RING(1:5).EQ.'BREAK'))THEN
      I=NFUN
27010 IF(I.GT.0)THEN
      N=IABS(FUNSTK(I))
      L=IABS(LABSTK(I))
      IF(N.NE.4.AND.N.NE.1.AND.N.NE.3.AND.N.NE.5)THEN
      GOTO27011
      END IF
      IF(NSTR.EQ.4)THEN
      CALLOUTSTR(-1,'GOTO',4,L)
      IF(N.EQ.3)THEN
      FORSTK(NFOR)=-IABS(FORSTK(NFOR))
      END IF
      ELSE 
      CALLOUTSTR(-1,'GOTO',4,L+1)
      LABSTK(I)=-L
      END IF
      IFUN=0
      GOTO27012
27011 CONTINUE
      I=I-1
      GOTO27010
27012 CONTINUE
      END IF
      IF(I.EQ.0)THEN
      CALLERROR(03,' ',0)
      END IF
      ELSE IF(C.EQ.';')THEN
      IFUN=0
      ELSE IF(TYPE.EQ.6)THEN
      CALLOUTSTR(-4,STRING(1:),NSTR,0)
      CALLEATUP(0,0)
      IFUN=0
      ELSE 
      CALLOUTSTR(FLAG,STRING(1:),NSTR,0)
      CALLEATUP(0,0)
      FLAG=-1
      IFUN=0
      END IF
      IF(IFUN.NE.0)THEN
      NFUN=NFUN+1
      IF(NFUN.GT.100)THEN
      CALLERROR(05,' ',0)
      END IF
      FUNSTK(NFUN)=IFUN
      IF(ILAB.LT.0)THEN
      LABSTK(NFUN)=0
      ELSE 
      LABSTK(NFUN)=NLAB
      NLAB=NLAB+ILAB
      END IF
      GOTO27006
      END IF
27013 IF(NFUN.GT.0)THEN
      N=FUNSTK(NFUN)
      M=LABSTK(NFUN)
      L=IABS(M)
      IF(N.EQ.7)THEN
      GOTO27015
      END IF
      IF(N.EQ.2)THEN
      TYPE=3
27016 IF(TYPE.EQ.3.OR.TYPE.EQ.8.OR.STRING(1:1).EQ.';')THEN
      CALLMACEXP(STRING(1:),TYPE,NTOK)
      GOTO27016
      END IF
      IF(TYPE.NE.7)THEN
      NBUF=NBUF-NTOK
      ELSE 
      NBUF=NBUF-2
      END IF
      IF(STRING(1:4).EQ.'ELSE')THEN
      GOTO27015
      END IF
      IF(L.EQ.0)THEN
      CALLOUTSTR(-1,'END IF',6,0)
      END IF
      ELSE IF(N.EQ.6)THEN
      IF(NFUN.GT.1)THEN
      NFUN=NFUN-1
      END IF
      IF(LABSTK(NFUN).EQ.0)THEN
      CALLOUTSTR(-1,'END IF',6,0)
      END IF
      ELSE IF(N.EQ.1)THEN
      CALLOUTSTR(L,'CONTINUE',8,0)
      IF(M.LT.0)THEN
      CALLOUTSTR(L+1,'CONTINUE',8,0)
      END IF
      ELSE IF(N.EQ.4.OR.N.EQ.5)THEN
      CALLOUTSTR(-1,'GOTO',4,L)
      IF(M.LT.0)THEN
      CALLOUTSTR(L+1,'CONTINUE',8,0)
      END IF
      IF(N.EQ.4)THEN
      CALLOUTSTR(-1,'END IF',6,0)
      END IF
      ELSE IF(IABS(N).EQ.3)THEN
      I=FORSTK(NFOR)
      J=IABS(I)
      NFOR=NFOR-1
      K=IFOR-J
      IFOR=J
      IF(I.LT.0)THEN
      CALLOUTSTR(L,'CONTINUE',8,0)
      END IF
      IF(K.GT.0)THEN
      CALLOUTSTR(-1,FORSTR(J:),K,0)
      END IF
      CALLOUTSTR(-1,'GOTO',4,L-1)
      IF(M.LT.0)THEN
      CALLOUTSTR(L+1,'CONTINUE',8,0)
      END IF
      IF(N.GT.0)THEN
      CALLOUTSTR(-1,'END IF',6,0)
      END IF
      END IF
      NFUN=NFUN-1
      GOTO27013
27015 CONTINUE
      END IF
      GOTO27006
27007 CONTINUE
      CLOSE(UNIT=NDEV)
      NFIL=NFIL-1
      GOTO27003
      END IF
      IF(NERT.NE.0)THEN
      CALLCHRINT(NERT,LINE,16,20,II,1)
      WRITE(8,'(A)')LINE(1:20)
      WRITE(6,'(A)')LINE(1:20)
      END IF
      CLOSE(UNIT=7)
      CLOSE(UNIT=8)
      IF(NERT.NE.0)THEN
      STOP8
      END IF
      STOP
      END
C-------INITL
      SUBROUTINEINITL
      INTEGERARGSTK(100)
      INTEGERMACADR(500)
      INTEGERMACDEF(500)
      INTEGERMACIND(64)
      INTEGERMACNAM(500)
      INTEGERMACNEX(500)
      INTEGERITAB
      INTEGERMACM
      INTEGERMTAB
      INTEGERNARG
      INTEGERNBUF
      INTEGERNDEV
      INTEGERNOUT
      INTEGERNMAC
      INTEGERNDAT
      COMMON/INT1/ARGSTK,MACADR,MACDEF,MACIND,MACNAM,MACNEX,MACM,NARG,NM
     &AC,ITAB,MTAB,NBUF,NDAT,NDEV,NOUT
      INTEGERACCF
      INTEGERCODF
      INTEGEREXTF
      INTEGERFLAGS,FLAGR,FLAGD
      INTEGERFORSTK(100)
      INTEGERNERR
      INTEGERNLAB
      INTEGERNERT
      INTEGERNBRC
      INTEGERNSQB
      INTEGERNFIL
      INTEGERNFOR
      INTEGERIFOR
      INTEGERILIN
      INTEGERLLIN
      INTEGEROLIN
      INTEGERXFLG
      COMMON/INT2/ACCF,CODF,EXTF,FLAGS,FLAGR,FLAGD,FORSTK,NERR,NLAB,NERT
     &,NBRC,NSQB,NFIL,NFOR,IFOR,ILIN,LLIN,OLIN,XFLG
      CHARACTER*4000IBUF
      CHARACTER*72OBUF
      CHARACTER*120LBUF
      CHARACTER*12PROG
      CHARACTER*20000MACTAB
      CHARACTER*4000MACSTR
      CHARACTER*4000FORSTR
      CHARACTER*1BSL
      COMMON/CHRX/IBUF,OBUF,LBUF,PROG,MACTAB,MACSTR,FORSTR,BSL
      CHARACTERHEAD1*50,HEAD2*20
      DATAHEAD1/' RFPP --- Ratmac-Ftn77 PreProcessor  (3.2/Oct92)'/
      DATAHEAD2/' R:     F:          '/
      OPEN(1,FILE='RFPRAT',STATUS='OLD')
      REWIND(1)
      OPEN(7,FILE='RFPFTN',STATUS='UNKNOWN')
      REWIND(7)
      OPEN(8,FILE='RFPLST',STATUS='UNKNOWN')
      REWIND(8)
      WRITE(8,'(1H1)')
      LLIN=3
      WRITE(8,'(A)')HEAD1(1:50)
      WRITE(6,'(A)')HEAD1(1:50)
      WRITE(8,'(A)')HEAD1(1:1)
      WRITE(6,'(A)')HEAD1(1:1)
      LBUF(1:20)=HEAD2
      PROG='            '
      IBUF(4000:4000)='#'
      NBUF=4000
      NOUT=1
      ILIN=0
      OLIN=1
      NERR=0
      NERT=0
      NMAC=0
      MACM=0
      NDAT=1000
      NARG=0
      ITAB=1
      MTAB=1
      NLAB=27000
      NBRC=0
      NSQB=0
      NFOR=0
      IFOR=1
      XFLG=-1
      FLAGS=0
      FLAGR=0
      FLAGD=0
      ACCF=1
      CODF=0
      EXTF=0
      BSL='\\\\'
      DO27000I=1,64
      MACIND(I)=0
27000 CONTINUE
      DO27002I=1,500
      MACNEX(I)=0
27002 CONTINUE
      CALLPUTMAC('ARITH:]A',6,2,I)
      CALLPUTMAC('MACRO:]M',6,2,I)
      CALLPUTMAC('XMACRO:]X',7,2,I)
      CALLPUTMAC('IFELSE:]I',7,2,I)
      CALLPUTMAC('INCR:]+',5,2,I)
      CALLPUTMAC('DECR:]-',5,2,I)
      CALLPUTMAC('CHR:]C',4,2,I)
      CALLPUTMAC('ORD:]O',4,2,I)
      CALLPUTMAC('LENSTR:]L',7,2,I)
      CALLPUTMAC('SUBSTR:]S',7,2,I)
      CALLPUTMAC('FLAGON:]Y',7,2,I)
      CALLPUTMAC('FLAGOFF:]N',8,2,I)
      CALLPUTMAC('PMACRO:]P',7,2,I)
      CALLPUTMAC('DMACRO:]D',7,2,I)
      CALLPUTMAC('CHARDATA:]E',9,2,I)
      CALLPUTMAC('REALDATA:]G',9,2,I)
      CALLPUTMAC('DBLEDATA:]J',9,2,I)
      CALLPUTMAC('INTDATA:]H',8,2,I)
      CALLPUTMAC('DATASTUFF:]F',10,2,I)
      CALLPUTMAC('STRING:]R',7,2,I)
      CALLPUTMAC('SELECT:]Q',7,2,I)
      CALLPUTMAC('IFSEL:]Z',6,2,I)
      CALLPUTMAC('ENDSEL:]W',7,2,I)
      CALLPUTMAC('EXTRUDE:]U',8,2,I)
      CALLPUTMAC('ENDEXT:]V',7,2,I)
      CALLPUTMAC('INCLUDE:INCLUDE $1            ',8,22,I)
      CALLPUTMAC('SYSTEMHEADER:IFELSE:($2,,$PC-------$1,)    ',13,30,I)
      CALLPUTMAC('YES:1',4,1,I)
      CALLPUTMAC('NO:0',3,1,I)
      RETURN
      END
C-------CHRINT
      SUBROUTINECHRINT(INT,STRING,TOP,BOT,LEN,KEY)
      CHARACTER*1C
      CHARACTER*(*)STRING
      CHARACTER*13DIGIT
      CHARACTER*10BLANK
      INTEGERPOWER(9)
      INTEGERINT
      INTEGERTOP,BOT
      INTEGERLEN
      INTEGERKEY
      INTEGERI,J,K,L,M,N
      DATABLANK/'          '/,DIGIT/'0123456789+-*'/
      DATAPOWER/1,10,100,1000,10000,100000,1000000,10000000,100000000/
      IF(KEY.EQ.0)THEN
      LEN=0
      INT=0
      DO27000I=BOT,TOP,-1
      C=STRING(I:I)
      J=1
27002 IF(J.LE.12)THEN
      IF(C.EQ.DIGIT(J:J))THEN
      GOTO27004
      END IF
      J=J+1
      GOTO27002
27004 CONTINUE
      END IF
      IF(J.EQ.12)THEN
      INT=-INT
      END IF
      IF(J.GT.10)THEN
      GOTO27000
      END IF
      LEN=LEN+1
      INT=INT+POWER(LEN)*(J-1)
27000 CONTINUE
      ELSE 
      STRING(TOP:BOT)=BLANK
      IF(INT.EQ.0)THEN
      STRING(TOP:TOP)=DIGIT(1:)
      LEN=1
      ELSE 
      LEN=TOP
      N=IABS(INT)
      M=N
      L=MIN0(BOT-TOP+1,9)
      IF(INT.LT.0)THEN
      STRING(TOP:TOP)=DIGIT(12:)
      LEN=LEN+1
      END IF
      DO27005I=L,1,-1
      IF(M.LT.POWER(I))THEN
      GOTO27005
      END IF
      K=N/POWER(I)
      N=N-K*POWER(I)
      IF(K.GT.9)THEN
      K=12
      END IF
      STRING(LEN:LEN)=DIGIT(K+1:)
      LEN=LEN+1
27005 CONTINUE
      LEN=LEN-TOP
      END IF
      END IF
      RETURN
      END
C-------MACEXP
      SUBROUTINEMACEXP(TOKEN,TYPE,NTOK)
      INTEGERARGSTK(100)
      INTEGERMACADR(500)
      INTEGERMACDEF(500)
      INTEGERMACIND(64)
      INTEGERMACNAM(500)
      INTEGERMACNEX(500)
      INTEGERITAB
      INTEGERMACM
      INTEGERMTAB
      INTEGERNARG
      INTEGERNBUF
      INTEGERNDEV
      INTEGERNOUT
      INTEGERNMAC
      INTEGERNDAT
      COMMON/INT1/ARGSTK,MACADR,MACDEF,MACIND,MACNAM,MACNEX,MACM,NARG,NM
     &AC,ITAB,MTAB,NBUF,NDAT,NDEV,NOUT
      INTEGERACCF
      INTEGERCODF
      INTEGEREXTF
      INTEGERFLAGS,FLAGR,FLAGD
      INTEGERFORSTK(100)
      INTEGERNERR
      INTEGERNLAB
      INTEGERNERT
      INTEGERNBRC
      INTEGERNSQB
      INTEGERNFIL
      INTEGERNFOR
      INTEGERIFOR
      INTEGERILIN
      INTEGERLLIN
      INTEGEROLIN
      INTEGERXFLG
      COMMON/INT2/ACCF,CODF,EXTF,FLAGS,FLAGR,FLAGD,FORSTK,NERR,NLAB,NERT
     &,NBRC,NSQB,NFIL,NFOR,IFOR,ILIN,LLIN,OLIN,XFLG
      CHARACTER*4000IBUF
      CHARACTER*72OBUF
      CHARACTER*120LBUF
      CHARACTER*12PROG
      CHARACTER*20000MACTAB
      CHARACTER*4000MACSTR
      CHARACTER*4000FORSTR
      CHARACTER*1BSL
      COMMON/CHRX/IBUF,OBUF,LBUF,PROG,MACTAB,MACSTR,FORSTR,BSL
      CHARACTER*1C
      CHARACTER*132TEMP
      CHARACTER*(*)TOKEN
      CHARACTER*14HEAD
      INTEGERI,J,K,L,M,N
      INTEGERIMAC
      INTEGERMMAC
      INTEGERMACSTK(100)
      INTEGERNTOK
      INTEGERPARLEV(100)
      INTEGERQFLG
      INTEGERTYPE
      INTEGERNPNT
      DATAPARLEV/100*0/
      DATAIMAC,MMAC/2,0/
      DATAHEAD/' >>>>>>>>>>>> '/
      NPNT=0
27000 CONTINUE
      CALLGETTOK(TOKEN,TYPE,NTOK)
      IF(TYPE.EQ.4)THEN
      GOTO27001
      END IF
      C=TOKEN(1:1)
      IF(NSQB.GT.0)THEN
      IF(C.EQ.'[')THEN
      NSQB=NSQB+1
      ELSE IF(C.EQ.']')THEN
      NSQB=NSQB-1
      END IF
      IF(NSQB.EQ.0)THEN
      GOTO27000
      END IF
      IF(MMAC.EQ.0)THEN
      GOTO27001
      END IF
      IF(NTOK.GT.0)THEN
      KJK=IMAC+NTOK-1
      IF(KJK.GE.4000)THEN
      CALLERROR(18,TOKEN,NTOK)
      END IF
      MACSTR(IMAC:KJK)=TOKEN
      IMAC=KJK+1
      END IF
      ELSE IF(TYPE.EQ.2)THEN
      CALLPUTMAC(TOKEN(1:),NTOK,-1,NPNT)
      IF(NPNT.EQ.0)THEN
      IF(MMAC.EQ.0)THEN
      CALLERROR(11,TOKEN(1:),NTOK)
      GOTO27001
      ELSE 
      IF(NTOK.GT.0)THEN
      KJK=IMAC+NTOK-1
      IF(KJK.GE.4000)THEN
      CALLERROR(18,TOKEN,NTOK)
      END IF
      MACSTR(IMAC:KJK)=TOKEN
      IMAC=KJK+1
      END IF
      END IF
      ELSE 
      MMAC=MMAC+1
      NARG=NARG+1
      IF(MMAC.GT.100.OR.NARG.GT.100)THEN
      CALLERROR(05,' ',0)
      END IF
      MACSTK(MMAC)=NARG
      ARGSTK(NARG)=IMAC
      PARLEV(MMAC)=0
      N=MACNAM(NPNT)
      L=MACDEF(NPNT)
      I=MACADR(NPNT)+N
      IF(L.GT.0)THEN
      IF(IMAC+L-1.GE.4000)THEN
      CALLERROR(18,' ',0)
      END IF
      MACSTR(IMAC:IMAC+L-1)=MACTAB(I:)
      IMAC=IMAC+L
      ELSE 
      MACSTR(IMAC:IMAC)=' '
      END IF
      IF(IBUF(NBUF+1:NBUF+1).NE.'(')THEN
      NBUF=NBUF-2
      IBUF(NBUF+1:NBUF+2)='()'
      END IF
      IF(FLAGD.EQ.1)THEN
      TEMP(1:14)=HEAD
      CALLCHRINT(MMAC,TEMP,15,17,II,1)
      TEMP(18:35)=TOKEN(1:NTOK)
      L=MIN0(L,95)
      IF(L.GT.0)THEN
      TEMP(36:L+35)=MACTAB(I:)
      END IF
      IF(MMAC.EQ.1)THEN
      WRITE(8,'(A)')HEAD(1:14)
      END IF
      WRITE(8,'(A)')TEMP(1:L+35)
      END IF
      END IF
      ELSE IF(C.EQ.'[')THEN
      NSQB=1
      GOTO27000
      ELSE IF(MMAC.EQ.0)THEN
      IF(NTOK.EQ.2.AND.C.EQ.'$')THEN
      TOKEN(1:1)=TOKEN(2:2)
      TYPE=7
      NTOK=1
      ELSE IF(C.EQ.'^')THEN
      TOKEN(1:1)=':'
      END IF
      GOTO27001
      ELSE IF(TYPE.NE.5)THEN
      IF(NTOK.GT.0)THEN
      KJK=IMAC+NTOK-1
      IF(KJK.GE.4000)THEN
      CALLERROR(18,TOKEN,NTOK)
      END IF
      MACSTR(IMAC:KJK)=TOKEN
      IMAC=KJK+1
      END IF
      ELSE IF(C.EQ.'(')THEN
      IF(PARLEV(MMAC).GT.0)THEN
      IF(NTOK.GT.0)THEN
      KJK=IMAC+NTOK-1
      IF(KJK.GE.4000)THEN
      CALLERROR(18,TOKEN,NTOK)
      END IF
      MACSTR(IMAC:KJK)=TOKEN
      IMAC=KJK+1
      END IF
      ELSE 
      NARG=NARG+1
      ARGSTK(NARG)=IMAC
      END IF
      PARLEV(MMAC)=PARLEV(MMAC)+1
      ELSE IF(C.EQ.')')THEN
      PARLEV(MMAC)=PARLEV(MMAC)-1
      IF(PARLEV(MMAC).GT.0)THEN
      IF(NTOK.GT.0)THEN
      KJK=IMAC+NTOK-1
      IF(KJK.GE.4000)THEN
      CALLERROR(18,TOKEN,NTOK)
      END IF
      MACSTR(IMAC:KJK)=TOKEN
      IMAC=KJK+1
      END IF
      ELSE 
      NARG=NARG+1
      ARGSTK(NARG)=IMAC
      I=MACSTK(MMAC)
      J=ARGSTK(I)
      IF(FLAGD.EQ.1)THEN
      CALLCHRINT(MMAC,TEMP,15,35,II,1)
      II=36
      K=I+1
27002 IF(K.LT.NARG)THEN
      N=ARGSTK(K)
      L=II+ARGSTK(K+1)-N
      L=MIN0(L,130)
      TEMP(II:II)='<'
      IF(L.GT.II)THEN
      TEMP(II+1:L)=MACSTR(N:)
      END IF
      TEMP(L+1:L+1)='>'
      II=L+2
      K=K+1
      GOTO27002
      END IF
      WRITE(8,'(A)')TEMP(1:II-1)
      IF(MMAC.EQ.1)THEN
      WRITE(8,'(A)')HEAD(1:14)
      END IF
      END IF
      IF(MACSTR(J:J).EQ.']')THEN
      CALLSYSMAC(I,J+1)
      ELSE 
      QFLG=-1
      N=ARGSTK(I+1)-1
27005 IF(N.GE.J)THEN
      C=MACSTR(N:N)
      IF(C.EQ.'''')THEN
      QFLG=-QFLG
      END IF
      IF(N.GT.J.AND.MACSTR(N-1:N-1).EQ.'$'.AND.QFLG.NE.1.AND.C.GE.'1'.AN
     &D.C.LE.'9')THEN
      CALLCHRINT(M,C,1,1,LX,0)
      M=M+I
      N=N-1
      IF(M.GE.NARG)THEN
      GOTO27006
      END IF
      K=ARGSTK(M)
      L=ARGSTK(M+1)-K
      IF(L.GT.0)THEN
      JKJ=NBUF
      NBUF=NBUF-(L)
      IF(NBUF.LE.0)THEN
      CALLERROR(18,MACSTR(K:),L)
      END IF
      IBUF((NBUF+1):JKJ)=MACSTR(K:)
      END IF
      ELSE 
      IF(1.GT.0)THEN
      JKJ=NBUF
      NBUF=NBUF-(1)
      IF(NBUF.LE.0)THEN
      CALLERROR(18,C,1)
      END IF
      IBUF((NBUF+1):JKJ)=C
      END IF
      END IF
27006 CONTINUE
      N=N-1
      GOTO27005
      END IF
      END IF
      NARG=I-1
      IMAC=J
      MMAC=MMAC-1
      END IF
      ELSE IF(C.EQ.','.AND.PARLEV(MMAC).EQ.1)THEN
      NARG=NARG+1
      ARGSTK(NARG)=IMAC
      ELSE 
      IF(NTOK.GT.0)THEN
      KJK=IMAC+NTOK-1
      IF(KJK.GE.4000)THEN
      CALLERROR(18,TOKEN,NTOK)
      END IF
      MACSTR(IMAC:KJK)=TOKEN
      IMAC=KJK+1
      END IF
      END IF
      GOTO27000
27001 CONTINUE
      IF(MMAC.NE.0.AND.TYPE.EQ.4)THEN
      CALLERROR(12,' ',0)
      END IF
      RETURN
      END
C-------GETTOK
      SUBROUTINEGETTOK(TOKEN,TYPE,NTOK)
      INTEGERARGSTK(100)
      INTEGERMACADR(500)
      INTEGERMACDEF(500)
      INTEGERMACIND(64)
      INTEGERMACNAM(500)
      INTEGERMACNEX(500)
      INTEGERITAB
      INTEGERMACM
      INTEGERMTAB
      INTEGERNARG
      INTEGERNBUF
      INTEGERNDEV
      INTEGERNOUT
      INTEGERNMAC
      INTEGERNDAT
      COMMON/INT1/ARGSTK,MACADR,MACDEF,MACIND,MACNAM,MACNEX,MACM,NARG,NM
     &AC,ITAB,MTAB,NBUF,NDAT,NDEV,NOUT
      INTEGERACCF
      INTEGERCODF
      INTEGEREXTF
      INTEGERFLAGS,FLAGR,FLAGD
      INTEGERFORSTK(100)
      INTEGERNERR
      INTEGERNLAB
      INTEGERNERT
      INTEGERNBRC
      INTEGERNSQB
      INTEGERNFIL
      INTEGERNFOR
      INTEGERIFOR
      INTEGERILIN
      INTEGERLLIN
      INTEGEROLIN
      INTEGERXFLG
      COMMON/INT2/ACCF,CODF,EXTF,FLAGS,FLAGR,FLAGD,FORSTK,NERR,NLAB,NERT
     &,NBRC,NSQB,NFIL,NFOR,IFOR,ILIN,LLIN,OLIN,XFLG
      CHARACTER*4000IBUF
      CHARACTER*72OBUF
      CHARACTER*120LBUF
      CHARACTER*12PROG
      CHARACTER*20000MACTAB
      CHARACTER*4000MACSTR
      CHARACTER*4000FORSTR
      CHARACTER*1BSL
      COMMON/CHRX/IBUF,OBUF,LBUF,PROG,MACTAB,MACSTR,FORSTR,BSL
      CHARACTER*1C,D
      CHARACTERHEAD1*50
      CHARACTER*(*)TOKEN
      INTEGERAFLG
      INTEGERNINP
      INTEGERNTOK
      INTEGERTYPE
      INTEGERQFLG
      SAVENINP
      DATAHEAD1/' RFPP --- Ratmac-Ftn77 PreProcessor  (3.2/Oct92)'/
      TYPE=6
      AFLG=0
      NTOK=1
27000 IF(NTOK.LT.100)THEN
      NBUF=NBUF+1
      IF(NBUF.GT.4000.OR.ACCF.EQ.0)THEN
27003 CONTINUE
      READ(NDEV,'(A)',END=112)IBUF(1:80)
      NINP=80
      GOTO113
112   NINP=-1
113   CONTINUE
      IF(NINP.LT.0)THEN
      GOTO27004
      END IF
      IF(NINP.EQ.0)THEN
      GOTO27003
      END IF
      IF(NFIL.EQ.1)THEN
      ILIN=ILIN+1
      END IF
      IF(FLAGS.EQ.1)THEN
      LLIN=LLIN+1
      IF(LLIN.GT.80)THEN
      WRITE(8,'(1H1)')
      LLIN=3
      WRITE(8,'(A)')HEAD1(1:50)
      WRITE(8,'(A)')HEAD1(1:1)
      END IF
      I=NINP+17
      CALLCHRINT(ILIN,LBUF,4,7,II,1)
      IF(NOUT.GT.1)THEN
      CALLCHRINT(OLIN+1,LBUF,11,14,II,1)
      ELSE 
      CALLCHRINT(OLIN,LBUF,11,14,II,1)
      END IF
      LBUF(18:I)=IBUF(1:NINP)
      WRITE(8,'(A)')LBUF(1:I)
      END IF
      IF(EXTF.EQ.1)THEN
      IF(IBUF(1:7).NE.'ENDEXT:'.AND.IBUF(1:7).NE.'endext:'.AND.IBUF(4:10
     &).NE.'ENDEXT:')THEN
      WRITE(10,'(A)')IBUF(1:80)
      GOTO27003
      END IF
      END IF
      IF(FLAGR.EQ.1)THEN
      IF(IBUF(8:11).EQ.':(R)')THEN
      FLAGR=0
      ELSE 
      OLIN=OLIN+1
      WRITE(7,'(A)')IBUF(1:80)
      GOTO27003
      END IF
      END IF
      IF(IBUF(1:1).EQ.'#')THEN
      GOTO27003
      END IF
      QFLG=-1
      D=' '
      I=1
27005 IF(I.LE.NINP)THEN
      C=IBUF(I:)
      IF(C.EQ.''''.AND.(D.NE.'$'.OR.QFLG.EQ.1))THEN
      QFLG=-QFLG
      ELSE IF(QFLG.EQ.1)THEN
      GOTO27006
      ELSE IF(C.EQ.'#')THEN
      GOTO27007
      END IF
      IF(C.EQ.'"')THEN
      XFLG=-XFLG
      ELSE IF(XFLG.EQ.1)THEN
      GOTO27006
      END IF
      D=C
      N=ICHAR(C)
      N=N-96
      IF(N.GE.1.AND.N.LE.26)THEN
      IBUF(I:I)=CHAR(N+64)
      END IF
27006 CONTINUE
      I=I+1
      GOTO27005
27007 CONTINUE
      END IF
      NBUF=4000-I+1
      IBUF(NBUF:3999)=IBUF(1:I-1)
      IF(ACCF.EQ.1)THEN
      GOTO27004
      END IF
      IF(NBUF.GT.3994)THEN
      GOTO27003
      END IF
      IF(IBUF(NBUF:NBUF+5).EQ.'IFSEL:')THEN
      GOTO27004
      END IF
      IF(IBUF(NBUF:NBUF+6).EQ.'ENDSEL:')THEN
      GOTO27004
      END IF
      GOTO27003
27004 CONTINUE
      END IF
      IF(NINP.LT.0)THEN
      GOTO27002
      END IF
      C=IBUF(NBUF:)
      ACCF=1
      TOKEN(NTOK:NTOK)=C
      IF(NBUF.EQ.3999)THEN
      IF(C.EQ.'$')THEN
      NTOK=NTOK-1
      NBUF=4000
      GOTO27001
      END IF
      IF(C.EQ.','.AND.NTOK.EQ.1)THEN
      NBUF=4000
      END IF
      END IF
      IF(C.EQ.'''')THEN
      IF(AFLG.EQ.0.AND.NTOK.GT.1)THEN
      GOTO27002
      END IF
      IF(AFLG.EQ.0)THEN
      AFLG=1
      ELSE 
      AFLG=0
      END IF
      END IF
      IF(AFLG.EQ.1.AND.NBUF.LT.4000)THEN
      GOTO27001
      END IF
      IF(C.GE.'A'.AND.C.LE.'Z')THEN
      IF(TYPE.EQ.1)THEN
      GOTO27001
      END IF
      IF(NTOK.GT.1)THEN
      GOTO27002
      END IF
      TYPE=1
      GOTO27001
      ELSE IF(C.GE.'0'.AND.C.LE.'9')THEN
      GOTO27001
      END IF
      GOTO27002
27001 CONTINUE
      NTOK=NTOK+1
      GOTO27000
27002 CONTINUE
      END IF
      IF(NTOK.EQ.100)THEN
      CALLERROR(10,' ',0)
      END IF
      IF(AFLG.EQ.1)THEN
      CALLERROR(15,' ',0)
      END IF
      IF(NINP.LT.0)THEN
      TYPE=4
      ELSE IF(NTOK.EQ.1)THEN
      TYPE=5
      IF(C.EQ.'#')THEN
      TYPE=3
      ELSE IF(C.EQ.',')THEN
      ELSE IF(C.EQ.'$')THEN
      TOKEN(2:2)=IBUF(NBUF+1:)
      NBUF=NBUF+1
      NTOK=2
      ELSE IF(C.EQ.' ')THEN
      NBUF=NBUF+1
27008 IF(NBUF.LT.4000)THEN
      IF(IBUF(NBUF:NBUF).NE.' ')THEN
      GOTO27010
      END IF
      NTOK=NTOK+1
      TOKEN(NTOK:NTOK)=' '
      NBUF=NBUF+1
      GOTO27008
27010 CONTINUE
      END IF
      NBUF=NBUF-1
      TYPE=8
      ELSE IF(NSQB.GT.0)THEN
      ELSE IF(IBUF(NBUF+1:NBUF+1).EQ.'=')THEN
      NBUF=NBUF+1
      IF(C.EQ.'=')THEN
      TOKEN(1:4)='.EQ.'
      NTOK=4
      ELSE IF(C.EQ.'!')THEN
      TOKEN(1:4)='.NE.'
      NTOK=4
      ELSE IF(C.EQ.'<')THEN
      TOKEN(1:4)='.LE.'
      NTOK=4
      ELSE IF(C.EQ.'>')THEN
      TOKEN(1:4)='.GE.'
      NTOK=4
      ELSE 
      NBUF=NBUF-1
      END IF
      ELSE IF(C.EQ.'<')THEN
      TOKEN(1:4)='.LT.'
      NTOK=4
      ELSE IF(C.EQ.'>')THEN
      TOKEN(1:4)='.GT.'
      NTOK=4
      ELSE IF(C.EQ.'&')THEN
      TOKEN(1:5)='.AND.'
      NTOK=5
      ELSE IF(C.EQ.BSL)THEN
      TOKEN(1:4)='.OR.'
      NTOK=4
      ELSE IF(C.EQ.'!')THEN
      TOKEN(1:5)='.NOT.'
      NTOK=5
      END IF
      ELSE 
      IF(C.EQ.':')THEN
      TYPE=2
      IF(TOKEN(1:NTOK).EQ.'SYSTEMHEADER:')THEN
      DO27011I=NBUF,4000
      IF(IBUF(I:I).EQ.','.OR.IBUF(I:I).EQ.')')THEN
      GOTO27012
      END IF
27011 CONTINUE
27012 CONTINUE
      IF(IBUF(I:I).EQ.')')THEN
      PROG=IBUF(NBUF+2:I-1)
      END IF
      END IF
      ELSE IF(TOKEN(1:1).NE.'''')THEN
      NBUF=NBUF-1
      NTOK=NTOK-1
      ELSE 
      TYPE=1
      END IF
      END IF
      RETURN
      END
C-------OUTSTR
      SUBROUTINEOUTSTR(L1,STRING,NSTR,L2)
      INTEGERARGSTK(100)
      INTEGERMACADR(500)
      INTEGERMACDEF(500)
      INTEGERMACIND(64)
      INTEGERMACNAM(500)
      INTEGERMACNEX(500)
      INTEGERITAB
      INTEGERMACM
      INTEGERMTAB
      INTEGERNARG
      INTEGERNBUF
      INTEGERNDEV
      INTEGERNOUT
      INTEGERNMAC
      INTEGERNDAT
      COMMON/INT1/ARGSTK,MACADR,MACDEF,MACIND,MACNAM,MACNEX,MACM,NARG,NM
     &AC,ITAB,MTAB,NBUF,NDAT,NDEV,NOUT
      INTEGERACCF
      INTEGERCODF
      INTEGEREXTF
      INTEGERFLAGS,FLAGR,FLAGD
      INTEGERFORSTK(100)
      INTEGERNERR
      INTEGERNLAB
      INTEGERNERT
      INTEGERNBRC
      INTEGERNSQB
      INTEGERNFIL
      INTEGERNFOR
      INTEGERIFOR
      INTEGERILIN
      INTEGERLLIN
      INTEGEROLIN
      INTEGERXFLG
      COMMON/INT2/ACCF,CODF,EXTF,FLAGS,FLAGR,FLAGD,FORSTK,NERR,NLAB,NERT
     &,NBRC,NSQB,NFIL,NFOR,IFOR,ILIN,LLIN,OLIN,XFLG
      CHARACTER*4000IBUF
      CHARACTER*72OBUF
      CHARACTER*120LBUF
      CHARACTER*12PROG
      CHARACTER*20000MACTAB
      CHARACTER*4000MACSTR
      CHARACTER*4000FORSTR
      CHARACTER*1BSL
      COMMON/CHRX/IBUF,OBUF,LBUF,PROG,MACTAB,MACSTR,FORSTR,BSL
      CHARACTER*56LINE
      CHARACTER*(*)STRING
      INTEGERICNT
      INTEGERL1,LAB1
      INTEGERL2,LAB2
      INTEGERNSTR
      INTEGEROCNT
      INTEGEROUTF
      DATALINE/'NERR:      NRAT:      NFTN:      NMAC:      MACT:    %  
     &'/
      DATAICNT,OCNT/0,1/
      LAB1=L1
      LAB2=L2
      N=1
      IF(STRING(1:4).NE.'GOTO'.OR.OBUF(7:10).NE.'GOTO')THEN
27000 CONTINUE
      OUTF=0
      IF(NOUT.EQ.7.AND.LAB1.NE.0)THEN
      NOUT=1
      END IF
      IF(LAB1.NE.0.AND.NOUT.EQ.1)THEN
      NOUT=7
      OBUF(1:6)='      '
      IF(LAB1.GT.0)THEN
      CALLCHRINT(LAB1,OBUF,1,6,II,1)
      ELSE IF(LAB1.EQ.-5)THEN
      OBUF(6:6)='&'
      ELSE IF(LAB1.EQ.-2.OR.LAB1.EQ.-4)THEN
      OBUF(1:NSTR)=STRING(1:NSTR)
      N=NSTR+1
      IF(LAB1.EQ.-2)THEN
      NOUT=N
      END IF
      END IF
      LAB1=0
      ELSE IF(LAB1.NE.0)THEN
      OUTF=1
      END IF
      IF(OUTF.EQ.0.AND.NSTR.GE.N)THEN
      L=MIN0(NSTR-N,72-NOUT)
      OBUF(NOUT:NOUT+L)=STRING(N:)
      N=N+L+1
      NOUT=NOUT+L+1
      IF(NOUT.GT.72)THEN
      OUTF=1
      LAB1=-5
      END IF
      END IF
      IF(OUTF.EQ.0.AND.LAB2.NE.0)THEN
      IF(LAB2.GT.0.AND.(NOUT+4.LE.72))THEN
      CALLCHRINT(LAB2,OBUF,NOUT,NOUT+4,II,1)
      NOUT=NOUT+5
      LAB2=0
      GOTO27000
      ELSE IF(LAB2.GT.0)THEN
      LAB1=-5
      ELSE IF(LAB2.LT.0)THEN
      LAB2=0
      END IF
      OUTF=1
      END IF
      IF(NOUT.EQ.10.AND.OBUF(7:9).EQ.'END')THEN
      OUTF=1
      END IF
      IF(OUTF.EQ.0.OR.NOUT.EQ.1)THEN
      GOTO27001
      END IF
      OLIN=OLIN+1
      NOUT=NOUT-1
      WRITE(7,'(A)')OBUF(1:NOUT)
      IF(NOUT.EQ.9.AND.OBUF(7:9).EQ.'END')THEN
      IF(NBRC.NE.0)THEN
      CALLERROR(16,' ',0)
      END IF
      IF(NDAT.NE.1000)THEN
      CALLERROR(19,' ',0)
      END IF
      OBUF(1:70)=' '
      OBUF(2:13)=PROG
      OBUF(15:70)=LINE
      CALLCHRINT(NERR,OBUF,21,24,II,1)
      CALLCHRINT(ILIN-ICNT,OBUF,32,35,II,1)
      CALLCHRINT(OLIN-OCNT,OBUF,43,46,II,1)
      CALLCHRINT(MACM,OBUF,54,56,II,1)
      I=MTAB*100/20000
      CALLCHRINT(I,OBUF,65,66,II,1)
      LLIN=LLIN+1
      NERT=NERT+NERR
      WRITE(8,'(A)')OBUF(1:70)
      WRITE(6,'(A)')OBUF(1:70)
      ICNT=ILIN
      OCNT=OLIN
      NERR=0
      MTAB=ITAB
      NDAT=1000
      NBRC=0
      MACM=NMAC
      NLAB=27000
      END IF
      NOUT=1
      GOTO27000
27001 CONTINUE
      END IF
      RETURN
      END
C-------EATUP
      SUBROUTINEEATUP(N,IFLG)
      INTEGERARGSTK(100)
      INTEGERMACADR(500)
      INTEGERMACDEF(500)
      INTEGERMACIND(64)
      INTEGERMACNAM(500)
      INTEGERMACNEX(500)
      INTEGERITAB
      INTEGERMACM
      INTEGERMTAB
      INTEGERNARG
      INTEGERNBUF
      INTEGERNDEV
      INTEGERNOUT
      INTEGERNMAC
      INTEGERNDAT
      COMMON/INT1/ARGSTK,MACADR,MACDEF,MACIND,MACNAM,MACNEX,MACM,NARG,NM
     &AC,ITAB,MTAB,NBUF,NDAT,NDEV,NOUT
      INTEGERACCF
      INTEGERCODF
      INTEGEREXTF
      INTEGERFLAGS,FLAGR,FLAGD
      INTEGERFORSTK(100)
      INTEGERNERR
      INTEGERNLAB
      INTEGERNERT
      INTEGERNBRC
      INTEGERNSQB
      INTEGERNFIL
      INTEGERNFOR
      INTEGERIFOR
      INTEGERILIN
      INTEGERLLIN
      INTEGEROLIN
      INTEGERXFLG
      COMMON/INT2/ACCF,CODF,EXTF,FLAGS,FLAGR,FLAGD,FORSTK,NERR,NLAB,NERT
     &,NBRC,NSQB,NFIL,NFOR,IFOR,ILIN,LLIN,OLIN,XFLG
      CHARACTER*4000IBUF
      CHARACTER*72OBUF
      CHARACTER*120LBUF
      CHARACTER*12PROG
      CHARACTER*20000MACTAB
      CHARACTER*4000MACSTR
      CHARACTER*4000FORSTR
      CHARACTER*1BSL
      COMMON/CHRX/IBUF,OBUF,LBUF,PROG,MACTAB,MACSTR,FORSTR,BSL
      CHARACTER*1C
      CHARACTER*4050STRING
      INTEGERIFLG
      INTEGERN
      INTEGERLPAR
      INTEGERNPAR
      INTEGERNSTR
      INTEGERNTOK
      INTEGERTYPE
      INTEGERQFLG
      IF(IFLG.EQ.-3)THEN
      NFOR=NFOR+1
      FORSTK(NFOR)=IFOR
      END IF
      NPAR=0
      LPAR=0
      NSTR=1
      QFLG=0
27000 CONTINUE
      CALLMACEXP(STRING(NSTR:),TYPE,NTOK)
      IF(TYPE.EQ.4)THEN
      GOTO27001
      END IF
      IF(TYPE.EQ.3.AND.QFLG.EQ.1)THEN
      GOTO27000
      END IF
      IF(TYPE.EQ.8.AND.QFLG.EQ.0)THEN
      GOTO27000
      END IF
      IF(TYPE.EQ.3.AND.(N.EQ.1.OR.N.EQ.0))THEN
      GOTO27001
      END IF
      IF(TYPE.EQ.3)THEN
      GOTO27000
      END IF
      C=STRING(NSTR:)
      IF(C.EQ.'{'.OR.C.EQ.'}')THEN
      NBUF=NBUF-1
      GOTO27001
      END IF
      IF(TYPE.EQ.7.AND.(C.EQ.'('.OR.C.EQ.')'))THEN
      NBUF=NBUF-2
      GOTO27001
      END IF
      IF(N.EQ.3.AND.LPAR.EQ.0.AND.IFLG.EQ.-1)THEN
      IF(C.NE.'(')THEN
      CALLERROR(02,' ',0)
      END IF
      LPAR=1
      GOTO27000
      END IF
      IF(C.EQ.'"')THEN
      IF(QFLG.EQ.0)THEN
      QFLG=1
      ELSE 
      QFLG=0
      END IF
      STRING(NSTR:NSTR)=''''
      ELSE IF(TYPE.EQ.7)THEN
      IF(C.EQ.'B')THEN
      STRING(NSTR:NSTR)=' '
      ELSE IF(C.EQ.'L')THEN
      STRING(NSTR:NSTR)='('
      ELSE IF(C.EQ.'R')THEN
      STRING(NSTR:NSTR)=')'
      END IF
      END IF
      IF(C.EQ.';')THEN
      GOTO27001
      ELSE IF(C.EQ.'(')THEN
      NPAR=NPAR+1
      ELSE IF(C.EQ.')')THEN
      NPAR=NPAR-1
      END IF
      NSTR=NSTR+NTOK
      IF(NSTR.GT.4000)THEN
      CALLERROR(18,' ',0)
      END IF
      IF(NPAR.LT.0)THEN
      GOTO27001
      END IF
      IF(NPAR.EQ.0.AND.(N.EQ.2.OR.N.EQ.4))THEN
      GOTO27001
      END IF
      GOTO27000
27001 CONTINUE
      IF(NPAR.GT.0)THEN
      CALLERROR(06,' ',0)
      END IF
      IF(NPAR.LT.0.AND.N.NE.3)THEN
      CALLERROR(07,' ',0)
      END IF
      IF(QFLG.EQ.1)THEN
      CALLERROR(15,' ',0)
      END IF
      IF(IFLG.EQ.-3)THEN
      IF(NSTR-2.GT.0)THEN
      KJK=IFOR+NSTR-2-1
      IF(KJK.GE.4000)THEN
      CALLERROR(18,STRING,NSTR-2)
      END IF
      FORSTR(IFOR:KJK)=STRING
      IFOR=KJK+1
      END IF
      ELSE IF(NSTR.GT.1)THEN
      CALLOUTSTR(IFLG,STRING,NSTR-1,0)
      END IF
      RETURN
      END
C-------PUTMAC
      SUBROUTINEPUTMAC(MACS,LNAM,LDEF,NPNT)
      INTEGERARGSTK(100)
      INTEGERMACADR(500)
      INTEGERMACDEF(500)
      INTEGERMACIND(64)
      INTEGERMACNAM(500)
      INTEGERMACNEX(500)
      INTEGERITAB
      INTEGERMACM
      INTEGERMTAB
      INTEGERNARG
      INTEGERNBUF
      INTEGERNDEV
      INTEGERNOUT
      INTEGERNMAC
      INTEGERNDAT
      COMMON/INT1/ARGSTK,MACADR,MACDEF,MACIND,MACNAM,MACNEX,MACM,NARG,NM
     &AC,ITAB,MTAB,NBUF,NDAT,NDEV,NOUT
      INTEGERACCF
      INTEGERCODF
      INTEGEREXTF
      INTEGERFLAGS,FLAGR,FLAGD
      INTEGERFORSTK(100)
      INTEGERNERR
      INTEGERNLAB
      INTEGERNERT
      INTEGERNBRC
      INTEGERNSQB
      INTEGERNFIL
      INTEGERNFOR
      INTEGERIFOR
      INTEGERILIN
      INTEGERLLIN
      INTEGEROLIN
      INTEGERXFLG
      COMMON/INT2/ACCF,CODF,EXTF,FLAGS,FLAGR,FLAGD,FORSTK,NERR,NLAB,NERT
     &,NBRC,NSQB,NFIL,NFOR,IFOR,ILIN,LLIN,OLIN,XFLG
      CHARACTER*4000IBUF
      CHARACTER*72OBUF
      CHARACTER*120LBUF
      CHARACTER*12PROG
      CHARACTER*20000MACTAB
      CHARACTER*4000MACSTR
      CHARACTER*4000FORSTR
      CHARACTER*1BSL
      COMMON/CHRX/IBUF,OBUF,LBUF,PROG,MACTAB,MACSTR,FORSTR,BSL
      CHARACTER*1C
      CHARACTER*(*)MACS
      CHARACTER*100MACTEM
      INTEGERI,J,K,L,M,N
      INTEGERLNAM
      INTEGERLDEF
      INTEGERNPNT
      IF(LNAM.GT.0)THEN
27000 IF(MACS(LNAM:LNAM).EQ.' ')THEN
      I=LNAM
      LNAM=LNAM-1
      DO27002J=1,LDEF
      C=MACS(I+1:)
      MACS(I:)=C
      I=I+1
27002 CONTINUE
      GOTO27000
      END IF
      IF(NPNT.GE.0.AND.MACS(LNAM:LNAM).NE.':')THEN
      CALLERROR(08,' ',0)
      END IF
      I=LNAM-1
      M=ICHAR(MACS(I:I))
      M=M-47
      NPNT=MACIND(M)
      IF(LDEF.GE.0.OR.NPNT.GT.0)THEN
      N=0
27004 IF(NPNT.NE.0)THEN
      N=NPNT
      IF(LNAM.NE.MACNAM(NPNT))THEN
      GOTO27005
      END IF
      J=MACADR(NPNT)
      K=I+J
      MACTEM(1:LNAM)=MACTAB(J:)
      IF(MACS(1:LNAM).EQ.MACTEM(1:LNAM))THEN
      GOTO27006
      END IF
27005 CONTINUE
      NPNT=MACNEX(NPNT)
      GOTO27004
27006 CONTINUE
      END IF
      END IF
      IF(LDEF.GE.0)THEN
      IF(NPNT.GT.0)THEN
      IF(LDEF.LE.MACDEF(NPNT))THEN
      MACDEF(NPNT)=LDEF
      MACTAB(J:K+LDEF)=MACS(1:)
      ELSE 
      MACNAM(NPNT)=0
      N=0
27007 IF(NPNT.NE.0)THEN
      N=NPNT
      NPNT=MACNEX(NPNT)
      GOTO27007
      END IF
      END IF
      END IF
      IF(NPNT.EQ.0)THEN
      NMAC=NMAC+1
      IF(NMAC.GT.500)THEN
      CALLERROR(20,' ',0)
      END IF
      IF(N.GT.0)THEN
      MACNEX(N)=NMAC
      END IF
      IF(MACIND(M).EQ.0)THEN
      MACIND(M)=NMAC
      END IF
      L=ITAB+LNAM+LDEF
      IF(L.GT.20000)THEN
      CALLERROR(09,' ',0)
      END IF
      MACADR(NMAC)=ITAB
      MACNAM(NMAC)=LNAM
      MACDEF(NMAC)=LDEF
      MACTAB(ITAB:L-1)=MACS(1:)
      ITAB=L
      IF(ITAB.GT.MTAB)THEN
      MTAB=ITAB
      END IF
      IF(NMAC.GT.MACM)THEN
      MACM=NMAC
      END IF
      END IF
      END IF
      ELSE 
      NPNT=0
      END IF
      RETURN
      END
C-------SYSMAC
      SUBROUTINESYSMAC(IARG,ISTR)
      INTEGERARGSTK(100)
      INTEGERMACADR(500)
      INTEGERMACDEF(500)
      INTEGERMACIND(64)
      INTEGERMACNAM(500)
      INTEGERMACNEX(500)
      INTEGERITAB
      INTEGERMACM
      INTEGERMTAB
      INTEGERNARG
      INTEGERNBUF
      INTEGERNDEV
      INTEGERNOUT
      INTEGERNMAC
      INTEGERNDAT
      COMMON/INT1/ARGSTK,MACADR,MACDEF,MACIND,MACNAM,MACNEX,MACM,NARG,NM
     &AC,ITAB,MTAB,NBUF,NDAT,NDEV,NOUT
      INTEGERACCF
      INTEGERCODF
      INTEGEREXTF
      INTEGERFLAGS,FLAGR,FLAGD
      INTEGERFORSTK(100)
      INTEGERNERR
      INTEGERNLAB
      INTEGERNERT
      INTEGERNBRC
      INTEGERNSQB
      INTEGERNFIL
      INTEGERNFOR
      INTEGERIFOR
      INTEGERILIN
      INTEGERLLIN
      INTEGEROLIN
      INTEGERXFLG
      COMMON/INT2/ACCF,CODF,EXTF,FLAGS,FLAGR,FLAGD,FORSTK,NERR,NLAB,NERT
     &,NBRC,NSQB,NFIL,NFOR,IFOR,ILIN,LLIN,OLIN,XFLG
      CHARACTER*4000IBUF
      CHARACTER*72OBUF
      CHARACTER*120LBUF
      CHARACTER*12PROG
      CHARACTER*20000MACTAB
      CHARACTER*4000MACSTR
      CHARACTER*4000FORSTR
      CHARACTER*1BSL
      COMMON/CHRX/IBUF,OBUF,LBUF,PROG,MACTAB,MACSTR,FORSTR,BSL
      CHARACTER*1C,D
      CHARACTER*10CODE
      CHARACTER*40HEAD
      CHARACTER*4000TEMP
      INTEGERI,J,K,L,M,N
      INTEGERIARG
      INTEGERISTR
      INTEGERN1,N2,N3,N4,N5,N6
      INTEGERNA,NN(10)
      EQUIVALENCE(N1,NN(1)),(N2,NN(2)),(N3,NN(3))
      EQUIVALENCE(N4,NN(4)),(N5,NN(5)),(N6,NN(6))
      DATAHEAD/' NMAC  IMAC          NAME  DEFINITION   '/
      DATACODE/'    '/
      DO27000I=1,10
      NN(I)=0
27000 CONTINUE
      NA=0
      I=IARG+1
27002 IF(I.LE.NARG)THEN
      NA=NA+1
      NN(NA)=ARGSTK(I)
      IF(NA.EQ.10)THEN
      GOTO27004
      END IF
      I=I+1
      GOTO27002
27004 CONTINUE
      END IF
      C=MACSTR(ISTR:ISTR)
      IF(C.EQ.'A')THEN
      DO27005KJ=N1,N2-1
      IF(INDEX('0123456789 -+',MACSTR(KJ:KJ)).EQ.0)THEN
      CALLERROR(21,MACSTR(N1:),N2-1-N1+1)
      END IF
27005 CONTINUE
      DO27007KJ=N3,N4-1
      IF(INDEX('0123456789 -+',MACSTR(KJ:KJ)).EQ.0)THEN
      CALLERROR(21,MACSTR(N3:),N4-1-N3+1)
      END IF
27007 CONTINUE
      CALLCHRINT(I,MACSTR,N1,N2-1,LX,0)
      CALLCHRINT(J,MACSTR,N3,N4-1,LX,0)
      D=MACSTR(N2:N2)
      K=N2+1
      IF(D.EQ.'+')THEN
      N=I+J
      ELSE IF(D.EQ.'-')THEN
      N=I-J
      ELSE IF(D.EQ.'/'.AND.J.NE.0)THEN
      N=I/J
      ELSE IF(D.EQ.'*')THEN
      IF(MACSTR(K:K).NE.'*')THEN
      N=I*J
      ELSE 
      N=I**J
      END IF
      ELSE 
      CALLERROR(13,' ',0)
      END IF
      CALLCHRINT(N,TEMP,1,10,L,1)
      IF(L.GT.0)THEN
      JKJ=NBUF
      NBUF=NBUF-(L)
      IF(NBUF.LE.0)THEN
      CALLERROR(18,TEMP(1:),L)
      END IF
      IBUF((NBUF+1):JKJ)=TEMP(1:)
      END IF
      ELSE IF(C.EQ.'M')THEN
      CALLPUTMAC(MACSTR(N1:),N2-N1,N3-N2,N)
      ELSE IF(C.EQ.'X')THEN
      CALLPUTMAC(MACSTR(N1:),N2-N1,-1,N)
      IF(N.GT.0)THEN
      MACNAM(N)=0
      ELSE 
      CALLERROR(11,MACSTR(N1:),N2-N1)
      END IF
      IF(N.EQ.NMAC)THEN
      I=N
27009 IF(I.GT.0)THEN
      IF(MACNAM(I).GT.0)THEN
      GOTO27011
      END IF
      I=I-1
      GOTO27009
27011 CONTINUE
      END IF
      DO27012J=1,NMAC
      IF(MACNEX(J).GT.I)THEN
      MACNEX(J)=0
      END IF
27012 CONTINUE
      DO27014J=1,64
      IF(MACIND(J).GT.I)THEN
      MACIND(J)=0
      END IF
27014 CONTINUE
      NMAC=I
      ITAB=MACADR(I+1)
      END IF
      ELSE IF(C.EQ.'I')THEN
      M=0
      IF(N2-N1.EQ.N3-N2)THEN
      IF(N1.EQ.N3)THEN
      M=1
      ELSE IF(MACSTR(N1:N2-1).EQ.MACSTR(N2:N3-1))THEN
      M=1
      END IF
      END IF
      IF(M.GT.0)THEN
      IF(N4-N3.GT.0)THEN
      JKJ=NBUF
      NBUF=NBUF-(N4-N3)
      IF(NBUF.LE.0)THEN
      CALLERROR(18,MACSTR(N3:),N4-N3)
      END IF
      IBUF((NBUF+1):JKJ)=MACSTR(N3:)
      END IF
      ELSE 
      IF(N5-N4.GT.0)THEN
      JKJ=NBUF
      NBUF=NBUF-(N5-N4)
      IF(NBUF.LE.0)THEN
      CALLERROR(18,MACSTR(N4:),N5-N4)
      END IF
      IBUF((NBUF+1):JKJ)=MACSTR(N4:)
      END IF
      END IF
      ELSE IF(C.EQ.'+')THEN
      DO27016KJ=N1,N2-1
      IF(INDEX('0123456789 -+',MACSTR(KJ:KJ)).EQ.0)THEN
      CALLERROR(21,MACSTR(N1:),N2-1-N1+1)
      END IF
27016 CONTINUE
      CALLCHRINT(I,MACSTR,N1,N2-1,LX,0)
      CALLCHRINT(I+1,TEMP,1,10,N,1)
      IF(N.GT.0)THEN
      JKJ=NBUF
      NBUF=NBUF-(N)
      IF(NBUF.LE.0)THEN
      CALLERROR(18,TEMP(1:),N)
      END IF
      IBUF((NBUF+1):JKJ)=TEMP(1:)
      END IF
      ELSE IF(C.EQ.'-')THEN
      DO27018KJ=N1,N2-1
      IF(INDEX('0123456789 -+',MACSTR(KJ:KJ)).EQ.0)THEN
      CALLERROR(21,MACSTR(N1:),N2-1-N1+1)
      END IF
27018 CONTINUE
      CALLCHRINT(I,MACSTR,N1,N2-1,LX,0)
      CALLCHRINT(I-1,TEMP,1,10,N,1)
      IF(N.GT.0)THEN
      JKJ=NBUF
      NBUF=NBUF-(N)
      IF(NBUF.LE.0)THEN
      CALLERROR(18,TEMP(1:),N)
      END IF
      IBUF((NBUF+1):JKJ)=TEMP(1:)
      END IF
      ELSE IF(C.EQ.'C')THEN
      DO27020KJ=N1,N2-1
      IF(INDEX('0123456789 -+',MACSTR(KJ:KJ)).EQ.0)THEN
      CALLERROR(21,MACSTR(N1:),N2-1-N1+1)
      END IF
27020 CONTINUE
      CALLCHRINT(I,MACSTR,N1,N2-1,LX,0)
      TEMP(1:1)=CHAR(I)
      IF(1.GT.0)THEN
      JKJ=NBUF
      NBUF=NBUF-(1)
      IF(NBUF.LE.0)THEN
      CALLERROR(18,TEMP(1:),1)
      END IF
      IBUF((NBUF+1):JKJ)=TEMP(1:)
      END IF
      ELSE IF(C.EQ.'O')THEN
      I=ICHAR(MACSTR(N1:N1))
      CALLCHRINT(I,TEMP,1,10,N,1)
      IF(N.GT.0)THEN
      JKJ=NBUF
      NBUF=NBUF-(N)
      IF(NBUF.LE.0)THEN
      CALLERROR(18,TEMP(1:),N)
      END IF
      IBUF((NBUF+1):JKJ)=TEMP(1:)
      END IF
      ELSE IF(C.EQ.'L')THEN
      CALLCHRINT(N2-N1,TEMP,1,10,N,1)
      IF(N.GT.0)THEN
      JKJ=NBUF
      NBUF=NBUF-(N)
      IF(NBUF.LE.0)THEN
      CALLERROR(18,TEMP(1:),N)
      END IF
      IBUF((NBUF+1):JKJ)=TEMP(1:)
      END IF
      ELSE IF(C.EQ.'S')THEN
      N=N2-N1
      DO27022KJ=N2,N3-1
      IF(INDEX('0123456789 -+',MACSTR(KJ:KJ)).EQ.0)THEN
      CALLERROR(21,MACSTR(N2:),N3-1-N2+1)
      END IF
27022 CONTINUE
      CALLCHRINT(I,MACSTR,N2,N3-1,LX,0)
      IF(I.LT.1.OR.I.GT.N)THEN
      J=0
      ELSE IF(N4.GT.0)THEN
      DO27024KJ=N3,N4-1
      IF(INDEX('0123456789 -+',MACSTR(KJ:KJ)).EQ.0)THEN
      CALLERROR(21,MACSTR(N3:),N4-1-N3+1)
      END IF
27024 CONTINUE
      CALLCHRINT(J,MACSTR,N3,N4-1,LX,0)
      ELSE 
      J=N-I+1
      END IF
      I=N1+I-1
      IF(J.GT.0)THEN
      JKJ=NBUF
      NBUF=NBUF-(J)
      IF(NBUF.LE.0)THEN
      CALLERROR(18,MACSTR(I:),J)
      END IF
      IBUF((NBUF+1):JKJ)=MACSTR(I:)
      END IF
      ELSE IF(C.EQ.'Y'.OR.C.EQ.'N')THEN
      IF(C.EQ.'Y')THEN
      N=1
      ELSE 
      N=0
      END IF
      D=MACSTR(N1:N1)
      IF(D.EQ.'S')THEN
      FLAGS=N
      ELSE IF(D.EQ.'R')THEN
      FLAGR=N
      ELSE IF(D.EQ.'D')THEN
      FLAGD=N
      ELSE 
      CALLERROR(14,' ',0)
      END IF
      CALLOUTSTR(0,' ',0,-1)
      ELSE IF(C.EQ.'P')THEN
      CALLPUTMAC(MACSTR(N1:),N2-N1,-1,N)
      IF(N.EQ.0)THEN
      CALLERROR(11,MACSTR(N1:),N2-N1)
      END IF
      DO27026J=1,NMAC
      IF(MACNEX(J).GT.N)THEN
      MACNEX(J)=0
      END IF
27026 CONTINUE
      DO27028J=1,64
      IF(MACIND(J).GT.N)THEN
      MACIND(J)=0
      END IF
27028 CONTINUE
      NMAC=N
      ITAB=MACADR(N+1)
      ELSE IF(C.EQ.'D')THEN
      CALLPUTMAC(MACSTR(N1:),N2-N1,-1,N)
      IF(N.EQ.0)THEN
      N=1
      END IF
      CALLPUTMAC(MACSTR(N2:),N3-N2,-1,L)
      IF(L.EQ.0)THEN
      L=NMAC
      END IF
      WRITE(8,'(A)')HEAD(1:40)
27030 IF(N.LE.L)THEN
      I=MACNAM(N)
      J=MACADR(N)
      TEMP(1:27)='                           '
      CALLCHRINT(N,TEMP,2,5,K,1)
      CALLCHRINT(J,TEMP,8,11,K,1)
      TEMP(27-I:26)=MACTAB(J:)
      J=J+I
      I=MACDEF(N)
27033 IF(I.GE.0)THEN
      K=MIN0(I,70)+27
      TEMP(28:K)=MACTAB(J:)
      LLIN=LLIN+1
      IF(LLIN.GT.80)THEN
      WRITE(8,'(1H1)')
      LLIN=3
      WRITE(8,'(A)')HEAD(1:40)
      END IF
      WRITE(8,'(A)')TEMP(1:K)
      TEMP(1:27)=' '
      J=J+70
      I=I-70
      GOTO27033
      END IF
      N=N+1
      GOTO27030
      END IF
      ELSE IF(C.EQ.'E')THEN
      I=N2-N1
      J=N3-N2
      N=-1
      IF(MACSTR(N2:N2).EQ.''''.OR.MACSTR(N2:N2).EQ.'"')THEN
      TEMP(1:J)=MACSTR(N2+1:)
      MACSTR(N2:N3)=TEMP(1:)
      J=J-2
      END IF
      CALLPUTMAC(MACSTR(N1:),I,J,N)
      NDAT=MIN0(NDAT,NMAC)
      TEMP(1:8)='INTEGERN'
      TEMP(9:I+8)=MACSTR(N1:)
      CALLOUTSTR(-1,TEMP(1:),I+8,0)
      TEMP(1:10)='CHARACTER*'
      CALLCHRINT(J,TEMP,11,16,K,1)
      TEMP(17:I+16)=MACSTR(N1:)
      CALLOUTSTR(-1,TEMP(1:),I+16,0)
      ELSE IF(C.EQ.'G'.OR.C.EQ.'H'.OR.C.EQ.'J')THEN
      I=N2-N1+1
      J=N3-N2
      N=-1
      TEMP(1:I)=MACSTR(N1:)
      TEMP(I:I)='/'
      TEMP(I+1:I+J)=MACSTR(N2:)
      CALLPUTMAC(TEMP(1:),I,J,N)
      NDAT=MIN0(NDAT,NMAC)
      N=1
      J=J+N2
27036 IF(N2.LT.J)THEN
      IF(MACSTR(N2:N2).EQ.',')THEN
      N=N+1
      END IF
      N2=N2+1
      GOTO27036
      END IF
      IF(C.EQ.'G')THEN
      TEMP(1:16)='REAL'
      ELSE IF(C.EQ.'H')THEN
      TEMP(1:16)='INTEGER'
      ELSE 
      TEMP(1:16)='DOUBLE PRECISION'
      END IF
      TEMP(17:I+16)=MACSTR(N1:)
      IF(N.GT.1)THEN
      TEMP(I+16:I+20)='(   )'
      CALLCHRINT(N,TEMP,I+17,I+19,K,1)
      CALLOUTSTR(-1,TEMP(1:),I+20,0)
      ELSE 
      CALLOUTSTR(-1,TEMP(1:),I+15,0)
      END IF
      ELSE IF(C.EQ.'F'.AND.NDAT.LT.1000)THEN
      DO27039N=NDAT,NMAC
      I=MACNAM(N)
      J=MACADR(N)
      L=MACDEF(N)
      K=I+J-1
      IF(MACTAB(K:K).EQ.'/')THEN
      TEMP(1:4)='DATA'
      K=I+L+4
      TEMP(5:K)=MACTAB(J:)
      TEMP(K+1:K+1)='/'
      CALLOUTSTR(-1,TEMP(1:),K+1,0)
      GOTO27039
      END IF
      TEMP(1:5)='DATAN'
      TEMP(6:I+5)=MACTAB(J:)
      TEMP(I+6:I+12)='/   /, '
      CALLCHRINT(L,TEMP,I+7,I+9,K,1)
      K=I+I+12
      TEMP(I+13:K)=MACTAB(J:)
      TEMP(K+1:K+2)='/'''
      L=K+L+2
      TEMP(K+3:L)=MACTAB(I+J:)
      TEMP(L+1:L+2)='''/'
      CALLOUTSTR(-1,TEMP(1:),L+2,0)
27039 CONTINUE
      DO27041J=1,NMAC
      IF(MACNEX(J).GE.NDAT)THEN
      MACNEX(J)=0
      END IF
27041 CONTINUE
      DO27043J=1,64
      IF(MACIND(J).GE.NDAT)THEN
      MACIND(J)=0
      END IF
27043 CONTINUE
      NMAC=NDAT-1
      ITAB=MACADR(NDAT)
      NDAT=1000
      ELSE IF(C.EQ.'R')THEN
      I=N2-N1
      TEMP(1:11)='CHARACTER*('
      TEMP(12:17)=MACSTR(N2:N3-1)
      TEMP(18:18)=')'
      TEMP(19:I+18)=MACSTR(N1:)
      CALLOUTSTR(-1,TEMP(1:),I+18,0)
      ELSE IF(C.EQ.'U')THEN
      IF(MACSTR(N1:N1).EQ.'''')THEN
      OPEN(10,FILE=MACSTR(N1+1:N2-2),STATUS='UNKNOWN')
      REWIND(10)
      ELSE 
      OPEN(10,FILE=MACSTR(N1:N2-1),STATUS='UNKNOWN')
      REWIND(10)
      END IF
      EXTF=1
      ELSE IF(C.EQ.'V')THEN
      CLOSE(UNIT=10)
      EXTF=0
      ELSE IF(C.EQ.'Q')THEN
      I=N2-N1
      CODE(1:10)='          '
      CODE(1:I)=MACSTR(N1:)
      ELSE IF(C.EQ.'Z')THEN
      IF(CODF.EQ.0)THEN
      I=1
27045 IF(I.LT.NA)THEN
      N=NN(I)
      M=NN(I+1)
      J=M-N
      IF(J.LE.0)THEN
      GOTO27047
      END IF
      IF(CODE(1:J).EQ.MACSTR(N:M-1))THEN
      GOTO27047
      END IF
      I=I+1
      GOTO27045
27047 CONTINUE
      END IF
      IF(I.LT.NA)THEN
      CODF=1
      ELSE 
      ACCF=0
      END IF
      ELSE 
      ACCF=0
      END IF
      ELSE IF(C.EQ.'W')THEN
      CODF=0
      END IF
      RETURN
      END
C-------ERROR
      SUBROUTINEERROR(IERR,NAME,M)
      INTEGERARGSTK(100)
      INTEGERMACADR(500)
      INTEGERMACDEF(500)
      INTEGERMACIND(64)
      INTEGERMACNAM(500)
      INTEGERMACNEX(500)
      INTEGERITAB
      INTEGERMACM
      INTEGERMTAB
      INTEGERNARG
      INTEGERNBUF
      INTEGERNDEV
      INTEGERNOUT
      INTEGERNMAC
      INTEGERNDAT
      COMMON/INT1/ARGSTK,MACADR,MACDEF,MACIND,MACNAM,MACNEX,MACM,NARG,NM
     &AC,ITAB,MTAB,NBUF,NDAT,NDEV,NOUT
      INTEGERACCF
      INTEGERCODF
      INTEGEREXTF
      INTEGERFLAGS,FLAGR,FLAGD
      INTEGERFORSTK(100)
      INTEGERNERR
      INTEGERNLAB
      INTEGERNERT
      INTEGERNBRC
      INTEGERNSQB
      INTEGERNFIL
      INTEGERNFOR
      INTEGERIFOR
      INTEGERILIN
      INTEGERLLIN
      INTEGEROLIN
      INTEGERXFLG
      COMMON/INT2/ACCF,CODF,EXTF,FLAGS,FLAGR,FLAGD,FORSTK,NERR,NLAB,NERT
     &,NBRC,NSQB,NFIL,NFOR,IFOR,ILIN,LLIN,OLIN,XFLG
      CHARACTER*4000IBUF
      CHARACTER*72OBUF
      CHARACTER*120LBUF
      CHARACTER*12PROG
      CHARACTER*20000MACTAB
      CHARACTER*4000MACSTR
      CHARACTER*4000FORSTR
      CHARACTER*1BSL
      COMMON/CHRX/IBUF,OBUF,LBUF,PROG,MACTAB,MACSTR,FORSTR,BSL
      CHARACTER*(*)NAME
      CHARACTER*30MESS(21)
      CHARACTER*70EBUF
      INTEGERN,M
      INTEGERIERR
      DATAEBUF(1:19)/' ERROR in line     '/
      DATAMESS(1)/'max <INCLUDE> files exceeded  '/
      DATAMESS(2)/'<FOR> MUST be followed by <(> '/
      DATAMESS(3)/'<NEXT>,<BREAK> not in a loop  '/
      DATAMESS(4)/'BRACES are not balanced       '/
      DATAMESS(5)/'stack overflow - incr. maxstk:'/
      DATAMESS(6)/'too many LEFT parentheses     '/
      DATAMESS(7)/'too many RIGHT parentheses    '/
      DATAMESS(8)/'macro NAME is now redefined   '/
      DATAMESS(9)/'macro TABLE has been exceeded '/
      DATAMESS(10)/'max size of TOKEN exceeded    '/
      DATAMESS(11)/'invoked macro not defined     '/
      DATAMESS(12)/'macro definition incomplete   '/
      DATAMESS(13)/'illegal arith: operator       '/
      DATAMESS(14)/'unrecognized flagon/off: code '/
      DATAMESS(15)/'quoted string is incomplete   '/
      DATAMESS(16)/'braces imbalanced at END line '/
      DATAMESS(17)/'illegal <ELSE-IF> construction'/
      DATAMESS(18)/'line expansion exceeds maxbuf:'/
      DATAMESS(19)/'datastuff: missing in program '/
      DATAMESS(20)/'macro overflow - incr. maxmac:'/
      DATAMESS(21)/'macro arg. must be numeric    '/
      N=MIN0(M,14)
      CALLCHRINT(ILIN,EBUF,16,21,II,1)
      EBUF(22:51)=MESS(IERR)
      N=N+51
      IF(N.GT.51)THEN
      EBUF(52:N)=NAME(1:)
      END IF
      LLIN=LLIN+1
      WRITE(8,'(A)')EBUF(1:N)
      WRITE(6,'(A)')EBUF(1:N)
      NERR=NERR+1
      IF(IERR.EQ.1.OR.IERR.EQ.5.OR.IERR.EQ.9.OR.IERR.EQ.10.OR.IERR.EQ.18
     &.OR.IERR.EQ.20.OR.IERR.EQ.12.OR.IERR.EQ.21)THEN
      CALLOUTSTR(0,' ',0,-1)
      STOP15
      END IF
      RETURN
      END
