      PROGRAM IFTRAN
C
C $Id: Iftran.f,v 1.7 2008-04-11 20:11:24 kennison Exp $
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C                       Copyright (C) 1989 by UCAR                     C
C            University Corporation for Atmospheric Research           C
C                          All Rights Reserved                         C
C                                                                      C
C                          IFTRAN Version 1.00                         C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      COMMON /IFTCM3/ IU1B(512),IU2B(512),CRC1,CRC2,SFUN,TBCH
      CHARACTER*1     IU1B,IU2B,CRC1,CRC2,TBCH
      CHARACTER*17    SFUN
      COMMON /IFTCM4/ IU1P,IU1Q,IU2P,IU2Q
      CHARACTER*80 ARGU
      CALL IFTRBD
      CRC1=CHAR(10)
      CRC2=CHAR(13)
      TBCH=CHAR(9)
      CALL NGCPID (IPID)
      IPID=10000+MOD(ABS(IPID),10000)
      WRITE (SFUN(12:16),'(I5)') IPID
      SFUN( 1:12)='/tmp/iftran.'
      SFUN(17:17)=CHAR(0)
      IU1P=0
      IU1Q=0
      IU2P=0
      IU2Q=0
      NPAR=IARGC()
      IF (.NOT.(NPAR.GT.0)) GO TO 10001
      DO 10002 IPAR=1,NPAR
      CALL GETARG(IPAR,ARGU)
      IF (.NOT.(ARGU(1:1).EQ.'-')) GO TO 10003
      IF (.NOT.(ARGU(2:2).EQ.'l'.OR.ARGU(2:2).EQ.'L')) GO TO 10004
      ITMP=IOUT
      IOUT=IOTC
      IOTC=ITMP
      GO TO 10005
10004 CONTINUE
      IF (.NOT.(ARGU(2:2).EQ.'6')) GO TO 10006
      IBIT=0
      GO TO 10005
10006 CONTINUE
      IF (.NOT.(ARGU(2:2).EQ.'7')) GO TO 10007
      IBIT=1
10005 CONTINUE
10007 CONTINUE
      GO TO 10008
10003 CONTINUE
      DO 10009 I=1,80
      IF (.NOT.(ARGU(I:I).EQ.' ')) GO TO 10010
      ITMP=I
      GO TO 101
10010 CONTINUE
10009 CONTINUE
      ITMP=80
  101 ARGU(I:I)=CHAR(0)
      IF (.NOT.(IOUT.EQ.0)) GO TO 10011
      CALL NGOFWO (ARGU,IOUT,ITMP)
      GO TO 10012
10011 CONTINUE
      IF (.NOT.(IOTC.EQ.0)) GO TO 10013
      CALL NGOFWO (ARGU,IOTC,ITMP)
10012 CONTINUE
10013 CONTINUE
10008 CONTINUE
10002 CONTINUE
10001 CONTINUE
      CALL NGOFRW (SFUN,ISAV,ITMP)
      IF (ITMP.NE.0) ISAV=0
      CALL IFTRAX
      IF (IINP.GT.2) CALL NGCLFI (IINP)
      IF (IOUT.GT.2) CALL NGCLFI (IOUT)
      IF (IOTC.GT.2) CALL NGCLFI (IOTC)
      IF (ISAV.GT.2) CALL NGCLFI (ISAV)
      IF (ISAV.GT.2) CALL NGRMFI (SFUN)
      WRITE (0,1001) NCTO,NERR
      CALL NGEXIT(NERR)
      STOP
 1001 FORMAT ('*** IFTRAN SUMMARY - ',I5,' CARDS, ',I3,' ERRORS ***')
      END
      SUBROUTINE IFTRBD
      RETURN
      END
CNOSPLIT - makes Fsplit put next routine in same file as last routine.
      BLOCKDATA IFTRBDX
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      DATA DBLS / .FALSE. /
      DATA DSOK / .TRUE. /
      DATA IADE / 26*'D' /
      DATA IBIT / 0 /
      DATA ICHS / '$' , 'A' , 'B' , 'C' , 'D' , 'E' , 'F' , 'G' , 'H' ,
     +            'I' , 'J' , 'K' , 'L' , 'M' , 'N' , 'O' , 'P' , 'Q' ,
     +            'R' , 'S' , 'T' , 'U' , 'V' , 'W' , 'X' , 'Y' , 'Z' ,
     +            '0' , '1' , '2' , '3' , '4' , '5' , '6' , '7' , '8' ,
     +            '9' , ',' , ' ' , '+' , '-' , '*' , '/' , '(' , ')' ,
     +            '=' , '.' , '''' , '"' ,
     +            ' ' /
      DATA ICRB / 0 /
      DATA ICRI / 0 / , ICRJ / 0 / , ICRK / 0 / , ICRL / 0 /
      DATA ICUB / 0 /
      DATA IFIN / 0 /
      DATA IFOC,IFOF,IFOI,IFON,IFOS / 0 , 1 , 0 , 0 , 0 /
      DATA IFVA(1) / 1 / , IFVI / 1 /
      DATA IGND / -1 /
      DATA IGNI / 19999 /
      DATA IGNN / 19999 /
      DATA IHDR / '1' , ' ' , ' ' , 'S' , 'E' , 'Q' , ' ' , 'N' , 'E' ,
     +            'S' , 'T' , ' ' , 'S' , 'O' , 'U' , 'R' , 'C' , 'E' ,
     +            10*' ' , 72*'-' , 5*' '     , 'P' , 'A' , 'G' , 'E' ,
     +                                                          6*' ' /
      DATA IINP / 0 /
      DATA ILCA / 'a' , 'b' , 'c' , 'd' , 'e' , 'f' , 'g' , 'h' , 'i' ,
     +            'j' , 'k' , 'l' , 'm' , 'n' , 'o' , 'p' , 'q' , 'r' ,
     +            's' , 't' , 'u' , 'v' , 'w' , 'x' , 'y' , 'z' /
      DATA INCP / 0 /
      DATA INCU / 0 /
      DATA IOCC / .FALSE. /
      DATA IOCP / 0 /
      DATA IOTC / 1 /
      DATA IOUT / 0 /
      DATA IPOC,IPOF,IPOI,IPON,IPOS / 1 , 1 , 1 , 0 , 1 /
      DATA ISAV / 0 /
      DATA ISGT / 0 /
      DATA ISRA / .FALSE. /
      DATA ISRL / 0 /
      DATA ISRM / 1327 /
      DATA ISRS / 0 /
      DATA ISRT / 0 /
      DATA ISRX / .FALSE. /
      DATA ISTL / 0 /
      DATA ISTS / 0 /
      DATA ISUM / 2 /
      DATA ISVI / 0 /
      DATA ISVN / 0 /
      DATA IUAF / 0 /
      DATA IUCF / 1 /
      DATA KWOK / .FALSE. /
      DATA LNCD / 80 /
      DATA NABT / 0 /
      DATA NAMP / 0 / , NAMQ / 500 /
      DATA NAMR / 0 /
      DATA NCLI / 0 /
      DATA NCTO / 0 /
      DATA NDNT / -4 /
      DATA NERR / 0 /
      DATA NEST / 0 /
      DATA NLNE / 55 /
      DATA NLNX / 0 /
      DATA NPGE / 0 /
      END
      SUBROUTINE IFTRAX
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      IOTX=IOUT
      ICHS(50)=CHAR(0)
      ICNC=ICHS(50)
      ITBC=ICHS(50)
      IXCC=ICHS(50)
      IEVS=ICHS(50)
      IEVT=ICHS(50)
      DO 10001 I=1,1023
      ISRP(I)=0
10001 CONTINUE
10002 CONTINUE
      IF (.NOT.(ISTS.GE.0)) GO TO 10003
      IF (.NOT.(ISTS.EQ.0)) GO TO 10004
      IGNN=IGNI
      ISGT=0
      ISTL=0
      ISTS=1
      NAMP=0
      NAMQ=500
      NAMR=0
      NCLO=0
      NEST=0
      NLNX=0
      PTYP=ICHS(50)
10004 CONTINUE
      CALL GETSTA
      IF (.NOT.(ICRI.EQ.(-1))) GO TO 10005
      ISTS=-1
      IF (NEST.NE.0) CALL ERRM(1)
      GO TO 10006
10005 CONTINUE
      IF (.NOT.(ITYP.EQ.ICHS(4))) GO TO 10007
      CALL CRDOUT
      GO TO 10006
10007 CONTINUE
      IF (.NOT.(ITYP.EQ.ICHS(10))) GO TO 10008
      GO TO (101,102,103,104,105,106,107,107,115,126,
     +       108,108,117,124,109,110,111,112,113,114,
     +       116,125,126,115,118,119,120,127,121,123) , ITYQ
  101 CALL CCSET(ISTA(ISTC),ICHS( 2))
      GO TO 199
  102 ISRX=ISRA
      ISRA=.TRUE.
      I1=INDEX1(ICHS(38),ISTA,ISTC,ISTB-1)
      IF (.NOT.(I1.GT.0)) GO TO 10009
      CALL MULREP(I1+1)
      GO TO 10010
10009 CONTINUE
      I1=ISTB-1
10010 CONTINUE
      GO TO 122
  103 ICNC=ISTA(ISTC)
      GO TO 199
  104 CALL CCSET(ISTA(ISTC),ICHS( 5))
      GO TO 199
  105 DSOK=.TRUE.
      GO TO 199
  106 NLNX=0
      GO TO 199
  107 CALL CCSET(ISTA(ISTC),ICHS( 6))
      GO TO 199
  115 CONTINUE
      IF (.NOT.(ABS(IFVA(IFVI)).EQ.1)) GO TO 10011
      IFVA(IFVI)=-2*IFVA(IFVI)
      GO TO 10012
10011 CONTINUE
      IF (.NOT.(ABS(IFVA(IFVI)).EQ.2)) GO TO 10013
      CALL ERRM(8)
      GO TO 10012
10013 CONTINUE
      IF (.NOT.(IFVA(IFVI).EQ.(-3))) GO TO 10014
      IFVA(IFVI)=-2
10012 CONTINUE
10014 CONTINUE
      GO TO 199
  108 ISRA=ISRX
      GO TO 199
  117 CONTINUE
      IF (.NOT.(IFVI.GT.1)) GO TO 10015
      IFVI=IFVI-1
      GO TO 10016
10015 CONTINUE
      CALL ERRM(8)
10016 CONTINUE
      GO TO 199
  124 CONTINUE
      IF (.NOT.(IFVI.LT.16)) GO TO 10017
      IFVI=IFVI+1
      IF (.NOT.(IFVA(IFVI-1).LE.0)) GO TO 10018
      IFVA(IFVI)=0
      GO TO 10019
10018 CONTINUE
      IFVA(IFVI)=-1
      IF (.NOT.(ISRA)) GO TO 10020
      ITMP=ISTB-1
      CALL REPL2(ISTA,1327,ISTB,ISTC,ITMP,ISTF)
10020 CONTINUE
      IF (ISTA(ISTC).NE.ICHS(28)) IFVA(IFVI)=+1
10019 CONTINUE
      GO TO 10021
10017 CONTINUE
      CALL ERRM(8)
      CALL NGEXIT(NERR)
      STOP
10021 CONTINUE
      GO TO 199
  109 CONTINUE
      IF (.NOT.(ISRA)) GO TO 10022
      ITMP=ISTB-1
      CALL REPL2(ISTA,1327,ISTB,ISTC,ITMP,ISTF)
10022 CONTINUE
      IF (.NOT.(INCP.LE.0.AND.IUAF.EQ.0)) GO TO 10023
      CALL INCLPM(INCU,INCL,IREW)
      IF (.NOT.(INCU.GT.0)) GO TO 10024
      INCP=-1
      IF (.NOT.(ICRK.GT.0)) GO TO 10025
      INCP=1
      CALL XMIT(ICRL-ICRK+1,ICRD(ICRK),INSB)
      NCLI=NCLI-1
10025 CONTINUE
      ICRK=0
      ICRL=ICRJ
      IF (IREW.NE.0) CALL IFTRIO(3,INCU,ICRD,0,0)
      GO TO 10026
10024 CONTINUE
      CALL ERRM(18)
10026 CONTINUE
      GO TO 10027
10023 CONTINUE
      CALL ERRM(18)
10027 CONTINUE
      GO TO 199
  110 KWOK=.TRUE.
      GO TO 199
  111 IOUT=IOTX
      GO TO 199
  112 DSOK=.FALSE.
      GO TO 199
  113 KWOK=.FALSE.
      GO TO 199
  114 IOUT=0
      GO TO 199
  116 ISRA=.FALSE.
      ISRX=.FALSE.
      GO TO 199
  125 CONTINUE
      IF (.NOT.(ISRA)) GO TO 10028
      ITMP=ISTB-1
      CALL REPL2(ISTA,1327,ISTB,ISTC,ITMP,ISTF)
10028 CONTINUE
      CALL SETOPT
      GO TO 199
  126 CONTINUE
      IF (.NOT.(IFVA(IFVI).EQ.1)) GO TO 10029
      IFVA(IFVI)=-3
      GO TO 10030
10029 CONTINUE
      IF (.NOT.(IFVA(IFVI).EQ.(-1))) GO TO 10031
      IF (.NOT.(ISRA)) GO TO 10032
      ITMP=ISTB-1
      CALL REPL2(ISTA,1327,ISTB,ISTC,ITMP,ISTF)
10032 CONTINUE
      IF (ISTA(ISTC).NE.ICHS(28)) IFVA(IFVI)=+1
      GO TO 10030
10031 CONTINUE
      IF (.NOT.(ABS(IFVA(IFVI)).EQ.2)) GO TO 10033
      CALL ERRM(8)
10030 CONTINUE
10033 CONTINUE
      GO TO 199
  118 CONTINUE
      IF (.NOT.(ISTA(ISTC).NE.ICHS(50))) GO TO 10034
      CALL MULREP(ISTC)
10034 CONTINUE
      ISRA=.TRUE.
      ISRX=.TRUE.
      GO TO 199
  119 CONTINUE
      IF (.NOT.(IUAF.NE.0)) GO TO 10035
      CALL ERRM(16)
      GO TO 10036
10035 CONTINUE
      IF (.NOT.(ISAV.EQ.0)) GO TO 10037
      CALL ERRM(15)
      GO TO 10038
10037 CONTINUE
      IF (.NOT.(ISRA)) GO TO 10039
      ITMP=ISTB-1
      CALL REPL2(ISTA,1327,ISTB,ISTC,ITMP,ISTF)
10039 CONTINUE
      CALL SAVUSE(1,KSAV)
      IF (.NOT.(KSAV.EQ.(-1))) GO TO 10040
      ISTS=-1
      GO TO 999
10040 CONTINUE
10038 CONTINUE
10036 CONTINUE
      GO TO 199
  120 ITBC=ISTA(ISTC)
      GO TO 199
  127 ITMP=MIN(ISTB-ISTC,72)
      CALL XMIT(ITMP,ISTA(ISTC),IHDR(29))
      IF (ITMP.LT.72) CALL XMIT(ITMP-72,ICHS(39),IHDR(ITMP+29))
      GO TO 199
  121 I1=ISTB-1
  122 CONTINUE
      IF (.NOT.(ISAV.EQ.0)) GO TO 10041
      CALL ERRM(15)
      GO TO 10042
10041 CONTINUE
      IF (.NOT.(IUAF.NE.0)) GO TO 10043
      CALL ERRM(14)
      GO TO 10044
10043 CONTINUE
      IF (ISRA) CALL REPL2(ISTA,1327,ISTB,ISTC,I1,ISTF)
      CALL SAVUSE(2,KUSE)
      IF (.NOT.(KUSE.EQ.(-1))) GO TO 10045
      CALL ERRM(17)
      GO TO 10046
10045 CONTINUE
      IUAF=-1
      IF (.NOT.(ICRK.GT.0)) GO TO 10047
      IUAF=1
      CALL XMIT(ICRL-ICRK+1,ICRD(ICRK),IUSB)
      NCLI=NCLI-1
10047 CONTINUE
      ICRK=0
      ICRL=ICRJ
10046 CONTINUE
10044 CONTINUE
10042 CONTINUE
      GO TO 199
  123 IXCC=ISTA(ISTC)
      GO TO 199
  199 CALL CRDOUT
      GO TO 10006
10008 CONTINUE
      IF (.NOT.(ISRA)) GO TO 10048
      ITMP=ISTB-1
      CALL REPL2(ISTA,1327,ISTB,1,ITMP,ISTF)
10048 CONTINUE
      CALL PAQQ(KEY)
      IF (.NOT.(KEY.EQ.0)) GO TO 10049
      IF (IHDR(29).EQ.ICHS(41)) CALL XMIT(72,ICRD(ICRI),IHDR(29))
      CALL CRDOUT
      ISGT=0
      GO TO 10050
10049 CONTINUE
      ITYP=ICHS(20)
      GO TO (201,202,203,217,204,205,206,207,208,209,
     +       210,211,212,213,298,214,215,216,217,218,
     +       298,298,219,220,221,298                ) , KEY
  201 CALL BLOCKS
      GO TO 299
  202 CALL DOSTAT
      GO TO 299
  203 CALL ELSORF
      GO TO 299
  204 ITYP=ICHS( 7)
      CALL CRDOUT
      IF (.NOT.(NEST.NE.0)) GO TO 10051
      CALL ERRM(1)
10051 CONTINUE
      IF (.NOT.(NAMP.NE.0)) GO TO 10052
      I=0
      DO 10053 J=1,NAMP,4
      IF (.NOT.(NAMI(J).GT.0)) GO TO 10054
      IF (.NOT.(I.EQ.0)) GO TO 10055
      I=1
      CALL ERRM(35)
      CALL XMIT(-6,ICHS(39),IHDR(29))
10055 CONTINUE
      CALL SPCOUT(1)
      K=NAMI(J+1)
      CALL XMIT(NAMI(J+2),NAMC(K),IHDR(35))
      CALL IFTRIO(2,IOUT,IHDR(29),NAMI(J+2)+6,0)
10054 CONTINUE
10053 CONTINUE
10052 CONTINUE
      ISTS=0
      CALL XMIT(-72,ICHS(41),IHDR(29))
      GO TO 299
  205 CALL ENDBLO
      GO TO 299
  206 CALL ENDDO
      GO TO 299
  207 CALL ENDFOR
      GO TO 299
  208 CALL ENDIF
      GO TO 299
  209 CALL ENDLOO
      GO TO 299
  210 CALL ENDWHI
      GO TO 299
  211 CALL EXITST
      GO TO 299
  212 CALL EXITIF
      GO TO 299
  213 CALL FORSTA
      GO TO 299
  214 CALL IFSTAT
      GO TO 299
  215 CALL INVOKE
      GO TO 299
  216 CALL LOOPST
      GO TO 299
  217 CALL ELSORF
      GO TO 299
  218 CALL REPETE
      GO TO 299
  219 CALL UNTIL
      GO TO 299
  220 CALL WHILE
      GO TO 299
  221 CONTINUE
      IF (.NOT.(IBIT.EQ.0)) GO TO 10056
      CALL IFSTAT
      GO TO 10057
10056 CONTINUE
      CALL STAK(2,0,0)
      ITYP=ICHS( 7)
      CALL CRDOUT
      NEST=NEST+1
10057 CONTINUE
      GO TO 299
  298 ISGT=1
      ITYP=ICHS( 7)
      CALL CRDOUT
  299 CONTINUE
10050 CONTINUE
10006 CONTINUE
      GO TO 10002
10003 CONTINUE
  999 RETURN
      END
      SUBROUTINE BLOCKS
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CALL NAMBLO(N1,0)
      CALL CRDOUT
      CALL LABOUT
      IF (.NOT.(N1.GT.0)) GO TO 10001
      NAMI(N1)=-ABS(NAMI(N1))
      N2=0
      IF (.NOT.(ISGT.EQ.0)) GO TO 10002
      CALL NEWNUM(N2)
      CALL GOTOCD(N2)
10002 CONTINUE
      ITMP=ABS(NAMI(N1))
      CALL CONTCD(ITMP)
      CALL STAK(9,N1,N2)
      NEST=NEST+1
10001 CONTINUE
      RETURN
      END
      SUBROUTINE CCSET(ICHR,JADE)
      CHARACTER*1 ICHR,JADE
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      I=INDEX1(ICHR,ICHS(2),1,26)
      IF (.NOT.(I.LT.1.OR.I.GT.26)) GO TO 10001
      I=INDEX1(ICHR,ILCA,1,26)
10001 CONTINUE
      IF (.NOT.(I.GE.1.AND.I.LE.26)) GO TO 10002
      IADE(I)=JADE
      IF (.NOT.(ICRK.GT.0.AND.ICRD(ICRL).EQ.ICHR)) GO TO 10003
      IF (.NOT.(JADE.EQ.ICHS(2))) GO TO 10004
      ICRD(ICRK)=ICHS(39)
      GO TO 10005
10004 CONTINUE
      IF (.NOT.(JADE.EQ.ICHS(5))) GO TO 10006
      ICRD(ICRK)=ICHS( 4)
      GO TO 10005
10006 CONTINUE
      ICRD(ICRK)=ICHS(50)
10005 CONTINUE
10003 CONTINUE
      GO TO 10007
10002 CONTINUE
      CALL ERRM(27)
10007 CONTINUE
      RETURN
      END
      SUBROUTINE CONTCD(N)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ICNT(9)
      DATA ICNT / ' ','C','O','N','T','I','N','U','E' /
      CALL CVD(N,IBUF,5)
      CALL XMIT(9,ICNT,IBUF(6))
      CALL XMIT(-58,ICHS(39),IBUF(15))
      CALL OUTBUF
      ISGT=0
      RETURN
      END
      SUBROUTINE CRDOUT
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 LINE(128),IDOT
      IF (.NOT.(IOUT.NE.0)) GO TO 10001
      IF (.NOT.((ITYP.EQ.ICHS(4).AND.IPOC.NE.0).OR.(ITYP.EQ.ICHS(7).AND.
     +IPOF.NE.0).OR.(ITYP.EQ.ICHS(10).AND.IPOI.NE.0).OR.(ITYP.EQ.ICHS(20
     +).AND.IPOS.NE.0))) GO TO 10002
      NIST=MAX(NEST,0)
      JDNT=ABS(NDNT)
      NIND=MIN(NIST*JDNT,116-LNCD)
      KSEQ=201-LNCD
      LSEQ=LNCD-72
      IF (.NOT.(ITYP.EQ.ICHS(4).AND.NIST.NE.0)) GO TO 10003
      NIND=MIN(NIND,112-LNCD)
      ISPL=1
      KSPL=18+NIND
      IDOT=ICHS(42)
      GO TO 10004
10003 CONTINUE
      ISPL=6
      KSPL=19+NIND
      IDOT=ICHS(47)
10004 CONTINUE
      IF (.NOT.(DSOK)) GO TO 10005
      DBLS=ITYP.NE.PTYP
      IF (.NOT.(DBLS)) GO TO 10006
      CALL SPCOUT(1)
10006 CONTINUE
      GO TO 10007
10005 CONTINUE
      DBLS=.FALSE.
10007 CONTINUE
      IF (.NOT.(ISTF.NE.0.AND.ICRB.NE.0)) GO TO 10008
      I=1
      J=72
      K=ICRL+1
      L=0
10009 CONTINUE
      IF (K+LNCD.GT.1701) K=1
      IF (.NOT.(K.LE.ICRI.AND.K+LNCD.GE.ICRI)) GO TO 10010
      CALL ERRM(7)
      GO TO 101
10010 CONTINUE
      IF (.NOT.(L.NE.0)) GO TO 10011
      IF (.NOT.(ITYP.EQ.ICHS(4))) GO TO 10012
      ICRD(K)=ISTA(1)
      ICRD(K+1)=ICHS(39)
      GO TO 10013
10012 CONTINUE
      IF (.NOT.(ITYP.EQ.ICHS(10))) GO TO 10014
      ICRD(K)=ICHS(38)
      GO TO 10013
10014 CONTINUE
      CALL XMIT(-5,ICHS(39),ICRD(K))
      ICRD(K+5)=ICHS(40)
10013 CONTINUE
10011 CONTINUE
      M=MIN(J,ISTB-I)
      N=K+L
      CALL XMIT(M,ISTA(I),ICRD(N))
      M=M+N
      IF (M.LT.K+72) CALL XMIT(M-K-72,ICHS(39),ICRD(M))
      CALL XMIT(8,ICRD(ICRI+72),ICRD(K+72))
      I=I+J
      IF (I.GE.ISTB) GO TO 10015
      K=K+LNCD+1
      IF (.NOT.(L.EQ.0)) GO TO 10016
      IF (.NOT.(ITYP.EQ.ICHS(4))) GO TO 10017
      J=70
      L=2
      GO TO 10018
10017 CONTINUE
      IF (.NOT.(ITYP.EQ.ICHS(10))) GO TO 10019
      J=71
      L=1
      GO TO 10018
10019 CONTINUE
      J=66
      L=6
10018 CONTINUE
10016 CONTINUE
      IF (.NOT.(ICRI+LNCD.NE.ICRJ)) GO TO 10020
      ICRI=ICRI+LNCD+1
      IF (ICRI+LNCD.GT.1701) ICRI=1
10020 CONTINUE
      GO TO 10009
10015 CONTINUE
      ICRI=ICRL+1
      IF (ICRI+LNCD.GT.1701) ICRI=1
      ICRJ=K+LNCD
      ICRL=ICRJ
      IF (.NOT.(ICRK.GT.0)) GO TO 10021
      K=ICRJ+1
      IF (K+LNCD.GT.1701) K=1
      CALL XMIT(LNCD+1,ICRD(ICRK),ICRD(K))
      ICRK=K
      ICRL=ICRK+LNCD
10021 CONTINUE
10008 CONTINUE
  101 I=ICRI
10022 CONTINUE
      CALL XMIT(-128,ICHS(39),LINE)
      IF (.NOT.(I.EQ.ICRI)) GO TO 10023
      IF (DBLS) LINE(1)=ICHS(28)
      CALL CVD(NCLO,LINE(2),5)
      CALL CVD(NIST,LINE(8),2)
10023 CONTINUE
      IF (.NOT.(NIST.GT.0.AND.NDNT.LT.0)) GO TO 10024
      DO 10025 J=1,NIND,JDNT
      LINE(J+18)=IDOT
10025 CONTINUE
10024 CONTINUE
      CALL XMIT(ISPL,ICRD(I),LINE(13))
      JSPL=I+ISPL
      CALL XMIT(72-ISPL,ICRD(JSPL),LINE(KSPL))
      IF (.NOT.(IPON.EQ.1)) GO TO 10026
      CALL CVD(NIST,LINE(KSEQ),3)
      CALL CVD(NCLO,LINE(KSEQ+3),5)
      GO TO 10027
10026 CONTINUE
      IF (.NOT.(IPON.EQ.2)) GO TO 10028
      CALL XMIT(LSEQ,ICRD(I+72),LINE(KSEQ))
10027 CONTINUE
10028 CONTINUE
      CALL SPCOUT(1)
      CALL IFTRIO(2,IOUT,LINE,LSTNB(LINE,1,128),1)
      IF (I+LNCD.EQ.ICRJ) GO TO 10029
      I=I+LNCD+1
      IF (I+LNCD.GT.1701) I=1
      GO TO 10022
10029 CONTINUE
      PTYP=ITYP
10002 CONTINUE
10001 CONTINUE
      IF (.NOT.(IOTC.NE.0.AND.ISTB.GT.1)) GO TO 10030
      IF (.NOT.(ITYP.EQ.ICHS(4))) GO TO 10031
      IF (IFOC.EQ.0) GO TO 102
      IBUF(1)=ICHS( 4)
      I=2
      J=71
      GO TO 10032
10031 CONTINUE
      IF (.NOT.(ITYP.EQ.ICHS(7))) GO TO 10033
      IF (IFOF.EQ.0) GO TO 102
      CALL XMIT(6,ISTA,IBUF)
      I=7
      J=66
      GO TO 10032
10033 CONTINUE
      IF (.NOT.(ITYP.EQ.ICHS(10))) GO TO 10034
      IF (IFOI.EQ.0) GO TO 102
      IBUF(1)=ICHS( 4)
      I=2
      J=71
      GO TO 10032
10034 CONTINUE
      IF (.NOT.(ITYP.EQ.ICHS(20))) GO TO 10035
      IF (IFOS.EQ.0) GO TO 102
      IBUF(1)=ICHS( 4)
      CALL XMIT(5,ISTA(2),IBUF(2))
      I=7
      J=66
10032 CONTINUE
10035 CONTINUE
      K=I
10036 CONTINUE
      L=MIN(J,ISTB-I)
      CALL XMIT(L,ISTA(I),IBUF(K))
      M=K+L
      IF (M.LT.73) CALL XMIT(M-73,ICHS(39),IBUF(M))
      CALL OUTBUF
      I=I+L
      IF (I.GE.ISTB) GO TO 10037
      IF (.NOT.(I.EQ.73)) GO TO 10038
      IF (.NOT.(ITYP.EQ.ICHS(7))) GO TO 10039
      CALL XMIT(-5,ICHS(39),IBUF)
      IBUF(6)=ICHS(40)
      GO TO 10040
10039 CONTINUE
      IF (.NOT.(ITYP.EQ.ICHS(20))) GO TO 10041
      CALL XMIT(-4,ICHS(39),IBUF(2))
      IBUF(6)=ICHS(40)
10040 CONTINUE
10041 CONTINUE
10038 CONTINUE
      GO TO 10036
10037 CONTINUE
10030 CONTINUE
  102 RETURN
      END
      SUBROUTINE CVD(NUMB,ISTR,LSTR)
      CHARACTER*1 ISTR(LSTR)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CALL XMIT(-LSTR,ICHS(39),ISTR)
      I=LSTR
      N=NUMB
10001 CONTINUE
      J=28+MOD(N,10)
      ISTR(I)=ICHS(J)
      I=I-1
      N=N/10
      IF (.NOT.(I.EQ.0.OR.N.EQ.0)) GO TO 10001
      RETURN
      END
      SUBROUTINE CVINT(N,K,ISTR,I,LSTR)
      CHARACTER*1 ISTR(1)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      N=0
10001 CONTINUE
      IF (.NOT.(I.LE.LSTR)) GO TO 10002
      IF (.NOT.(ISTR(I).GE.ICHS(28).AND.ISTR(I).LE.ICHS(37)))
     +GO TO 10003
      N=10*N+INDEX1(ISTR(I),ICHS(28),1,12)-1
      GO TO 10004
10003 CONTINUE
      IF (.NOT.(ISTR(I).EQ.ICHS(38))) GO TO 10005
      K=11
      RETURN
10005 CONTINUE
      IF (.NOT.(ISTR(I).EQ.ICHS(39))) GO TO 10006
      K=12
      RETURN
10006 CONTINUE
      K=0
      RETURN
10004 CONTINUE
      I=I+1
      GO TO 10001
10002 CONTINUE
      K=12
      RETURN
      END
      SUBROUTINE DOSTAT
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 KDO(2)
      DATA KDO / 'D', 'O' /
      CALL NEWNUM(N1)
      CALL STAK(5,N1,0)
      CALL CRDOUT
      CALL LABOUT
      CALL OUTSTR(KDO,1,2)
      CALL OUTSTR(ICHS(39),1,1)
      CALL OUTNUM(N1)
      CALL OUTSTR(ICHS(39),1,1)
      IF (.NOT.(ISTA(ISTD+1).NE.ICHS(44))) GO TO 10001
      CALL OUTSTR(ISTA,ISTD+1,ISTE-1)
      GO TO 10002
10001 CONTINUE
      CALL OUTSTR(ISTA,ISTD+2,ISTE-2)
10002 CONTINUE
      CALL OUTLIN(0)
      NEST=NEST+1
      RETURN
      END
      SUBROUTINE ELSORF
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 IELI(8),ITHN(5)
      DATA IELI / 'E','L','S','E',' ','I','F',' ' /
      DATA ITHN / ' ','T','H','E','N' /
      CALL UNSTAK(N0,N1,N2)
      NEST=NEST-1
      IF (.NOT.(IBIT.EQ.0)) GO TO 10001
      IF (.NOT.(N0.EQ.1.AND.N2.NE.0)) GO TO 10002
      CALL CRDOUT
      IF (N1.EQ.0.AND.ISGT.EQ.0) CALL NEWNUM(N1)
      CALL GOTOCD(N1)
      CALL LABOUT
      CALL CONTCD(N2)
      N2=0
      IF (.NOT.(ISTD.LE.ISTE)) GO TO 10003
      CALL NEWNUM(N2)
      CALL IFNOT(ISTA,ISTD,ISTE,N2)
10003 CONTINUE
      GO TO 10004
10002 CONTINUE
      CALL ERRM(5)
      CALL CRDOUT
10004 CONTINUE
      GO TO 10005
10001 CONTINUE
      IF (.NOT.(N0.EQ.1)) GO TO 10006
      IF (.NOT.(ISTD.LE.ISTE)) GO TO 10007
      ISTB=ISTE-ISTD+21
      IF (.NOT.(ISTB.LE.1327)) GO TO 10008
      CALL XMIT(8,IELI,ISTA(7))
      CALL XMIT(ISTE-ISTD+1,ISTA(ISTD),ISTA(15))
      CALL XMIT(5,ITHN,ISTA(ISTB-5))
      ISTA(ISTB)=ICHS(50)
      GO TO 10009
10008 CONTINUE
      CALL ERRM(32)
      CALL NGEXIT(NERR)
      STOP
10009 CONTINUE
10007 CONTINUE
      ITYP=ICHS( 7)
      CALL CRDOUT
      ISGT=0
      GO TO 10010
10006 CONTINUE
      IF (.NOT.(N0.EQ.2)) GO TO 10011
      ITYP=ICHS( 7)
      CALL CRDOUT
      ISGT=0
      GO TO 10010
10011 CONTINUE
      CALL ERRM(5)
      CALL CRDOUT
10010 CONTINUE
10005 CONTINUE
      CALL STAK(N0,N1,N2)
      NEST=NEST+1
      RETURN
      END
      SUBROUTINE ENDBLO
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ITX1(7),ITX2(5)
      DATA ITX1 / 'G', 'O', ' ', 'T', 'O', ' ', '(' /
      DATA ITX2 / ')' , ' ' , ',' , ' ' , 'L' /
      NEST=NEST-1
      CALL CRDOUT
      CALL LABOUT
      CALL UNSTAK(N0,N1,N2)
      IF (.NOT.(N0.EQ.9)) GO TO 10001
      IF (.NOT.(ISGT.EQ.0.AND.NAMI(N1+3).GT.0)) GO TO 10002
      CALL OUTSTR(ITX1,1,7)
      I=NAMI(N1+3)
10003 CONTINUE
      IF (.NOT.(I.NE.0)) GO TO 10004
      CALL OUTNUM(NAMI(I))
      I=NAMI(I+1)
      IF (I.NE.0) CALL OUTCHR(ICHS(38))
      GO TO 10003
10004 CONTINUE
      CALL OUTSTR(ITX2,1,5)
      N3=ABS(NAMI(N1))
      CALL OUTNUM(N3)
      CALL OUTLIN(1)
10002 CONTINUE
      IF (N2.NE.0) CALL CONTCD(N2)
      GO TO 10005
10001 CONTINUE
      CALL ERRM(24)
      NEST=NEST+1
      CALL STAK(N0,N1,N2)
10005 CONTINUE
      RETURN
      END
      SUBROUTINE ENDDO
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      NEST=NEST-1
      CALL CRDOUT
      CALL LABOUT
      CALL UNSTAK(N0,N1,N2)
      IF (.NOT.(N0.EQ.5)) GO TO 10001
      CALL CONTCD(N1)
      GO TO 10002
10001 CONTINUE
      CALL ERRM(3)
      CALL STAK(N0,N1,N2)
      NEST=NEST+1
10002 CONTINUE
      RETURN
      END
      SUBROUTINE ENDFOR
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      NEST=NEST-1
      CALL CRDOUT
      CALL LABOUT
      CALL UNSTAK(N0,N1,N2)
      IF (.NOT.(N0.EQ.7)) GO TO 10001
      CALL GOTOCD(N1)
      CALL CONTCD(N2)
      GO TO 10002
10001 CONTINUE
      CALL ERRM(23)
      CALL STAK(N0,N1,N2)
      NEST=NEST+1
10002 CONTINUE
      RETURN
      END
      SUBROUTINE ENDIF
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      NEST=NEST-1
      CALL UNSTAK(N0,N1,N2)
      IF (.NOT.(IBIT.EQ.0)) GO TO 10001
      IF (.NOT.(N0.EQ.1)) GO TO 10002
      CALL CRDOUT
      CALL LABOUT
      IF (.NOT.(N1.NE.0)) GO TO 10003
      CALL CONTCD(N1)
10003 CONTINUE
      IF (.NOT.(N2.NE.0)) GO TO 10004
      CALL CONTCD(N2)
10004 CONTINUE
      GO TO 10005
10002 CONTINUE
      CALL ERRM(2)
      CALL CRDOUT
      CALL STAK(N0,N1,N2)
      NEST=NEST+1
10005 CONTINUE
      GO TO 10006
10001 CONTINUE
      IF (.NOT.(N0.EQ.1.OR.N0.EQ.2)) GO TO 10007
      ITYP=ICHS( 7)
      CALL CRDOUT
      ISGT=0
      GO TO 10008
10007 CONTINUE
      CALL ERRM(2)
      CALL CRDOUT
      CALL STAK(N0,N1,N2)
      NEST=NEST+1
10008 CONTINUE
10006 CONTINUE
      RETURN
      END
      SUBROUTINE ENDLOO
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      NEST=NEST-1
      CALL CRDOUT
      CALL LABOUT
      CALL UNSTAK(N0,N1,N2)
      IF (.NOT.(N0.EQ.6)) GO TO 10001
      CALL GOTOCD(N1)
      IF (N2.NE.0) CALL CONTCD(N2)
      GO TO 10002
10001 CONTINUE
      CALL ERRM(20)
      CALL STAK(N0,N1,N2)
      NEST=NEST+1
10002 CONTINUE
      RETURN
      END
      SUBROUTINE ENDWHI
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      NEST=NEST-1
      CALL CRDOUT
      CALL LABOUT
      CALL UNSTAK(N0,N1,N2)
      IF (.NOT.(N0.EQ.4)) GO TO 10001
      CALL GOTOCD(N1)
      CALL CONTCD(N2)
      GO TO 10002
10001 CONTINUE
      CALL ERRM(4)
      CALL STAK(N0,N1,N2)
      NEST=NEST+1
10002 CONTINUE
      RETURN
      END
      SUBROUTINE ERRM(N)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      DIMENSION IPTR(37)
      CHARACTER*1 IERR(28),IMSG(818),
     +            IM01(16),IM02(15),IM03(15),IM04(18),IM05(22),IM06(18),
     +            IM07(28),IM08(22),IM09(27),IM10(31),IM11(26),IM12(32),
     +            IM13(13),IM14(23),IM15(34),IM16(28),IM17(21),IM18(31),
     +            IM19(14),IM20(17),IM21(28),IM22(22),IM23(16),IM24(18),
     +            IM25(26),IM26(19),IM27(30),IM28(19),IM29(33),IM30(31),
     +            IM31(26),IM32(19),IM33(24),IM34(21),IM35(19),IM36(16)
      EQUIVALENCE (IMSG(  1),IM01(1)) , (IMSG( 17),IM02(1)) ,
     +            (IMSG( 32),IM03(1)) , (IMSG( 47),IM04(1)) ,
     +            (IMSG( 65),IM05(1)) , (IMSG( 87),IM06(1)) ,
     +            (IMSG(105),IM07(1)) , (IMSG(133),IM08(1)) ,
     +            (IMSG(155),IM09(1)) , (IMSG(182),IM10(1)) ,
     +            (IMSG(213),IM11(1)) , (IMSG(239),IM12(1)) ,
     +            (IMSG(271),IM13(1)) , (IMSG(284),IM14(1)) ,
     +            (IMSG(307),IM15(1)) , (IMSG(341),IM16(1)) ,
     +            (IMSG(369),IM17(1)) , (IMSG(390),IM18(1)) ,
     +            (IMSG(421),IM19(1)) , (IMSG(435),IM20(1)) ,
     +            (IMSG(452),IM21(1)) , (IMSG(480),IM22(1)) ,
     +            (IMSG(502),IM23(1)) , (IMSG(518),IM24(1)) ,
     +            (IMSG(536),IM25(1)) , (IMSG(562),IM26(1)) ,
     +            (IMSG(581),IM27(1)) , (IMSG(611),IM28(1)) ,
     +            (IMSG(630),IM29(1)) , (IMSG(663),IM30(1)) ,
     +            (IMSG(694),IM31(1)) , (IMSG(720),IM32(1)) ,
     +            (IMSG(739),IM33(1)) , (IMSG(763),IM34(1)) ,
     +            (IMSG(784),IM35(1)) , (IMSG(803),IM36(1))
      DATA IPTR / 1,17,32,47,65,87,105,133,155,182,213,239,271,284,307,
     +            341,369,390,421,435,452,480,502,518,536,562,581,611,
     +            630,663,694,720,739,763,784,803,819 /
      DATA IERR / ' ',10*'*',' ','E','R','R','O','R',' ',10*'*' /
      DATA IM01 / ' ','M','I','S','S','I','N','G',' ','E','N','D',' ',
     +            '.','.','.'/
      DATA IM02 / ' ','I','N','V','A','L','I','D',' ','E','N','D',' ',
     +            'I','F'/
      DATA IM03 / ' ','I','N','V','A','L','I','D',' ','E','N','D',' ',
     +            'D','O'/
      DATA IM04 / ' ','I','N','V','A','L','I','D',' ','E','N','D',' ',
     +            'W','H','I','L','E'/
      DATA IM05 / ' ','I','N','V','A','L','I','D',' ','E','L','S','E',
     +            ' ','O','R',' ','O','R',' ','I','F'/
      DATA IM06 / ' ','C','O','M','M','A','N','D',' ','N','O','T',' ',
     +            'K','N','O','W','N'/
      DATA IM07 / ' ','I','N','P','U','T',' ','C','A','R','D',' ','B',
     +            'U','F','F','E','R',' ','T','O','O',' ','S','H','O',
     +            'R','T'/
      DATA IM08 / ' ','.','I','F',' ','U','S','E','D',' ','I','N','C',
     +            'O','R','R','E','C','T','L','Y',' '/
      DATA IM09 / ' ','R','E','P','L','A','C','E','M','E','N','T',' ',
     +            'T','A','B','L','E',' ','O','V','E','R','F','L','O',
     +            'W'/
      DATA IM10 / ' ','C','H','A','R','A','C','T','E','R',' ','S','T',
     +            'O','R','A','G','E',' ','I','N','S','U','F','F','I',
     +            'C','I','E','N','T'/
      DATA IM11 / ' ','S','T','R','I','N','G','-','R','E','P','L','A',
     +            'C','E','M','E','N','T',' ','E','R','R','O','R',' '/
      DATA IM12 / ' ','I','N','T','E','R','N','A','L',' ','I','F','T',
     +            'R','A','N',' ','E','R','R','O','R',' ','I','N',' ',
     +            'S','A','V','U','S','E'/
      DATA IM13 / ' ','M','I','S','S','I','N','G',' ','.','E','N','D'/
      DATA IM14 / ' ','N','E','S','T','E','D',' ','U','S','E',' ','N',
     +            'O','T',' ','A','L','L','O','W','E','D'/
      DATA IM15 / ' ','N','O',' ','F','I','L','E',' ','A','V','A','I',
     +            'L','A','B','L','E',' ','F','O','R',' ','S','A','V',
     +            'E',' ','O','R',' ','U','S','E'/
      DATA IM16 / ' ','S','A','V','E',' ','W','I','T','H','I','N',' ',
     +            'U','S','E',' ','N','O','T',' ','A','L','L','O','W',
     +            'E','D'/
      DATA IM17 / ' ','S','A','V','E',' ','G','R','O','U','P',' ','N',
     +            'O','T',' ','F','O','U','N','D'/
      DATA IM18 / ' ','I','N','V','A','L','I','D',' ','I','N','C','L',
     +            'U','D','E',' ','C','A','R','D',' ','-',' ','I','G',
     +            'N','O','R','E','D'/
      DATA IM19 / ' ','I','N','V','A','L','I','D',' ','U','N','T','I',
     +            'L'/
      DATA IM20 / ' ','I','N','V','A','L','I','D',' ','E','N','D',' ',
     +            'L','O','O','P'/
      DATA IM21 / ' ','N','O',' ','L','O','O','P',' ','F','O','R',' ',
     +            'E','X','I','T',' ','O','R',' ','E','X','I','T',' ',
     +            'I','F'/
      DATA IM22 / ' ','I','N','V','A','L','I','D',' ','F','O','R',' ',
     +            'S','T','A','T','E','M','E','N','T'/
      DATA IM23 / ' ','I','N','V','A','L','I','D',' ','E','N','D',' ',
     +            'F','O','R'/
      DATA IM24 / ' ','I','N','V','A','L','I','D',' ','E','N','D',' ',
     +            'B','L','O','C','K'/
      DATA IM25 / ' ','B','L','O','C','K',' ','I','N','F','O',' ','T',
     +            'A','B','L','E',' ','O','V','E','R','F','L','O','W'/
      DATA IM26 / ' ','I','N','V','A','L','I','D',' ','B','L','O','C',
     +            'K',' ','N','A','M','E'/
      DATA IM27 / ' ','I','F','T','R','A','N',' ','C','O','M','M','A',
     +            'N','D',' ','-',' ','S','Y','N','T','A','X',' ','E',
     +            'R','R','O','R'/
      DATA IM28 / ' ','I','F','T','R','A','N',' ','L','O','G','I','C',
     +            ' ','E','R','R','O','R'/
      DATA IM29 / ' ','S','Y','N','T','A','X',' ','E','R','R','O','R',
     +            ' ','I','N',' ','I','F','T','R','A','N',' ','C','O',
     +            'N','S','T','R','U','C','T'/
      DATA IM30 / ' ','S','T','A','T','E','M','E','N','T','-','L','A',
     +            'B','E','L','-','S','T','A','C','K',' ','O','V','E',
     +            'R','F','L','O','W'/
      DATA IM31 / ' ','B','L','O','C','K',' ','N','A','M','E',' ','T',
     +            'A','B','L','E',' ','O','V','E','R','F','L','O','W'/
      DATA IM32 / ' ','S','T','A','T','E','M','E','N','T',' ','T','O',
     +            'O',' ','L','O','N','G'/
      DATA IM33 / ' ','S','T','R','I','N','G','-','E','V','A','L','U',
     +            'A','T','I','O','N',' ','E','R','R','O','R'/
      DATA IM34 / ' ','I','N','V','O','K','E',' ','F','O','L','L','O',
     +            'W','S',' ','B','L','O','C','K'/
      DATA IM35 / ' ','B','L','O','C','K','S',' ','U','N','D','E','F',
     +            'I','N','E','D',' ','-'/
      DATA IM36 / ' ','B','L','O','C','K',' ','R','E','D','E','F','I',
     +            'N','E','D'/
      NERR=NERR+1
      NMSG=N
      IF (NMSG.LT.1.OR.NMSG.GT.36) NMSG=28
      INDM=IPTR(NMSG)
      LENM=IPTR(NMSG+1)-IPTR(NMSG)
      IF (.NOT.(IOUT.NE.0)) GO TO 10001
      CALL SPCOUT(1)
      CALL IFTRIO(2,IOUT,IERR,28,0)
      CALL SPCOUT(1)
      CALL IFTRIO(2,IOUT,IMSG(INDM),LENM,0)
10001 CONTINUE
      CALL TYPERR(N,IMSG(INDM),LENM)
      RETURN
      END
      SUBROUTINE EXITIF
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CALL EXITXX(N2)
      IF (N2.GT.0) CALL IFTRUE(ISTA,ISTD+1,ISTE-1,N2)
      RETURN
      END
      SUBROUTINE EXITST
      CALL EXITXX(N2)
      IF (N2.GT.0) CALL GOTOCD(N2)
      RETURN
      END
      SUBROUTINE EXITXX(N2)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CALL STAKFI(6,N1,N2,NDEE)
      NEST=NEST-NDEE
      CALL CRDOUT
      CALL LABOUT
      NEST=NEST+NDEE
      IF (.NOT.(N1.LE.0)) GO TO 10001
      CALL ERRM(21)
      GO TO 10002
10001 CONTINUE
      IF (.NOT.(N2.LE.0)) GO TO 10003
      CALL NEWNUM(N2)
      I=ISTL-3*(NDEE-1)
      ISTK(I)=N2
10003 CONTINUE
10002 CONTINUE
      RETURN
      END
      SUBROUTINE FORSTA
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ITCH
      DIMENSION IBEG(8),IEND(8),LKWD(6),KWPT(6)
      CHARACTER*1 KYWD(6,6),IFST(4),IGST(7),ILTS(4),IGTS(4)
      DATA LKWD / 3 , 3 , 5 , 6 , 6 , 5 /
      DATA KWPT / 4 , 5 , 5 , 6 , 7 , 8 /
      DATA KYWD / 'T' , 'O' , ' ' , ' ' , ' ' , ' ' ,
     +            'B' , 'Y' , ' ' , ' ' , ' ' , ' ' ,
     +            'S' , 'T' , 'E' , 'P' , ' ' , ' ' ,
     +            'W' , 'H' , 'I' , 'L' , 'E' , ' ' ,
     +            'U' , 'N' , 'T' , 'I' , 'L' , ' ' ,
     +            'N' , 'E' , 'X' , 'T' , ' ' , ' ' /
      DATA IFST / 'I' , 'F' , ' ' , '(' /
      DATA IGST / ' ' , 'G' , 'O' , ' ' , 'T' , 'O' , ' ' /
      DATA ILTS / '.' , 'L' , 'T' , '.' /
      DATA IGTS / '.' , 'G' , 'T' , '.' /
      CALL CRDOUT
      CALL LABOUT
      CALL NEWNUM(N1)
      CALL NEWNUM(N2)
      CALL NEWNUM(N3)
      CALL STAK(7,N1,N2)
      NEST=NEST+1
      DO 10001 I=1,8
      IBEG(I)=0
10001 CONTINUE
      IEQ=INDEX1(ICHS(46),ISTA,ISTD,ISTE)
      IF (IEQ.EQ.0) GO TO 101
      IBEG(1)=ISTD+1
      IF (ISTA(ISTD+1).EQ.ICHS(44)) IBEG(1)=ISTD+2
      IEND(1)=IEQ-1
      IBEG(2)=IEQ
      IEND(2)=IEQ
      IBEG(3)=IEQ+1
      LPRE=3
      ISCN=IEQ+2
10002 CONTINUE
      IF (.NOT.(ISCN.LT.ISTE)) GO TO 10003
      IF (.NOT.(ISTA(ISCN).EQ.ICHS(39))) GO TO 10004
      DO 10005 IKWD=1,6
      MTCH=0
      DO 10006 I=1,LKWD(IKWD)
      ITCH=ISTA(ISCN+I)
      IF (.NOT.(ITCH.GE.ILCA(1).AND.ITCH.LE.ILCA(26))) GO TO 10007
      ITCH=CHAR(ICHAR(ICHS( 2))+ICHAR(ITCH)-ICHAR(ILCA( 1)))
10007 CONTINUE
      IF (ITCH.NE.KYWD(I,IKWD)) GO TO 102
10006 CONTINUE
      MTCH=1
  102 CONTINUE
      IF (.NOT.(MTCH.NE.0)) GO TO 10008
      LCUR=KWPT(IKWD)
      IF (IBEG(LCUR).NE.0) GO TO 101
      IEND(LPRE)=ISCN-1
      LPRE=LCUR
      IBEG(LCUR)=ISCN+1+LKWD(IKWD)
      ISCN=ISCN+LKWD(IKWD)
10008 CONTINUE
10005 CONTINUE
10004 CONTINUE
      ISCN=ISCN+1
      GO TO 10002
10003 CONTINUE
      IEND(LPRE)=ISTE-1
      IF (ISTA(ISTD+1).EQ.ICHS(44)) IEND(LPRE)=ISTE-2
      IF (.NOT.(IBEG(8).NE.0)) GO TO 10009
      IF (IBEG(4).NE.0.OR.IBEG(5).NE.0) GO TO 101
      GO TO 10010
10009 CONTINUE
      IF (.NOT.(IBEG(5).EQ.0)) GO TO 10011
      INCK=1
      ISGN=0
      GO TO 10012
10011 CONTINUE
      I=IBEG(5)
      INCK=0
      ISGN=0
      IF (.NOT.(ISTA(I).EQ.ICHS(40))) GO TO 10013
      INCK=1
      ISGN=1
      GO TO 10014
10013 CONTINUE
      IF (.NOT.(ISTA(I).EQ.ICHS(41))) GO TO 10015
      INCK=-1
      ISGN=-1
      GO TO 10014
10015 CONTINUE
      IF (.NOT.(ISTA(I).EQ.ICHS(47).OR.(ISTA(I).GE.ICHS(28).AND.ISTA(I).
     +LE.ICHS(37)))) GO TO 10016
      INCK=1
10014 CONTINUE
10016 CONTINUE
10017 CONTINUE
      IF (.NOT.(INCK.NE.0.AND.I.LT.IEND(5))) GO TO 10018
      I=I+1
      IF (ISTA(I).NE.ICHS(47).AND.ISTA(I).NE.ICHS(39).AND.
     +                            (ISTA(I).LT.ICHS(28).OR.ISTA(I).GT.ICH
     +S(37))) INCK=0
      GO TO 10017
10018 CONTINUE
10012 CONTINUE
      IF (.NOT.(INCK.EQ.0)) GO TO 10019
      CALL NEWNUM(N4)
      CALL NEWNUM(N5)
      CALL NEWNUM(N6)
10019 CONTINUE
10010 CONTINUE
      CALL OUTSTR(ISTA,IBEG(1),IEND(3))
      CALL OUTLIN(0)
      CALL GOTOCD(N3)
      CALL CONTCD(N1)
      IF (.NOT.(IBEG(7).NE.0)) GO TO 10020
      CALL IFTRUE(ISTA,IBEG(7),IEND(7),N2)
10020 CONTINUE
      CALL OUTSTR(ISTA,IBEG(1),IEND(2))
      IF (.NOT.(IBEG(8).NE.0)) GO TO 10021
      CALL OUTSTR(ISTA,IBEG(8),IEND(8))
      GO TO 10022
10021 CONTINUE
      CALL OUTSTR(ISTA,IBEG(1),IEND(1))
      IF (ISGN.EQ.0) CALL OUTCHR(ICHS(40))
      IF (.NOT.(IBEG(5).EQ.0)) GO TO 10023
      CALL OUTCHR(ICHS(29))
      GO TO 10024
10023 CONTINUE
      CALL OUTSTR(ISTA,IBEG(5),IEND(5))
10024 CONTINUE
10022 CONTINUE
      CALL OUTLIN(0)
      CALL CONTCD(N3)
      IF (.NOT.(IBEG(4).NE.0)) GO TO 10025
      IF (.NOT.(INCK.EQ.0)) GO TO 10026
      CALL OUTSTR(IFST,1,4)
      CALL OUTSTR(ISTA,IBEG(5),IEND(5))
      CALL OUTCHR(ICHS(45))
      CALL OUTCHR(ICHS(39))
      CALL OUTNUM(N4)
      CALL OUTCHR(ICHS(38))
      CALL OUTNUM(N5)
      CALL OUTCHR(ICHS(38))
      CALL OUTNUM(N6)
      CALL OUTLIN(0)
      CALL CONTCD(N4)
10026 CONTINUE
      IF (.NOT.(INCK.LE.0)) GO TO 10027
      CALL OUTSTR(IFST,1,4)
      CALL OUTSTR(ISTA,IBEG(1),IEND(1))
      CALL OUTSTR(ILTS,1,4)
      CALL OUTCHR(ICHS(44))
      CALL OUTSTR(ISTA,IBEG(4),IEND(4))
      CALL OUTCHR(ICHS(45))
      CALL OUTCHR(ICHS(45))
      CALL OUTSTR(IGST,1,7)
      CALL OUTNUM(N2)
      CALL OUTLIN(0)
10027 CONTINUE
      IF (.NOT.(INCK.EQ.0)) GO TO 10028
      CALL GOTOCD(N5)
      CALL CONTCD(N6)
10028 CONTINUE
      IF (.NOT.(INCK.GE.0)) GO TO 10029
      CALL OUTSTR(IFST,1,4)
      CALL OUTSTR(ISTA,IBEG(1),IEND(1))
      CALL OUTSTR(IGTS,1,4)
      CALL OUTCHR(ICHS(44))
      CALL OUTSTR(ISTA,IBEG(4),IEND(4))
      CALL OUTCHR(ICHS(45))
      CALL OUTCHR(ICHS(45))
      CALL OUTSTR(IGST,1,7)
      CALL OUTNUM(N2)
      CALL OUTLIN(0)
10029 CONTINUE
      IF (.NOT.(INCK.EQ.0)) GO TO 10030
      CALL CONTCD(N5)
10030 CONTINUE
10025 CONTINUE
      IF (.NOT.(IBEG(6).NE.0)) GO TO 10031
      I=IBEG(6)-1
      ISTA(I)=ICHS(44)
      I=IEND(6)+1
      ISTA(I)=ICHS(45)
      CALL IFNOT(ISTA,IBEG(6)-1,IEND(6)+1,N2)
10031 CONTINUE
      RETURN
  101 CALL ERRM(22)
      RETURN
      END
      SUBROUTINE GETSTA
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ICMP(30,5),JXCC,ITCH
      DATA (ICMP( 1,J),J=1,5) / 'A' , 'C' , 'T' , 'I' , 'V' /
      DATA (ICMP( 2,J),J=1,5) / 'C' , 'A' , 'L' , 'L' , ' ' /
      DATA (ICMP( 3,J),J=1,5) / 'C' , 'O' , 'N' , 'T' , 'I' /
      DATA (ICMP( 4,J),J=1,5) / 'D' , 'E' , 'A' , 'C' , 'T' /
      DATA (ICMP( 5,J),J=1,5) / 'D' , 'S' , 'O' , 'K' , ' ' /
      DATA (ICMP( 6,J),J=1,5) / 'E' , 'J' , 'E' , 'C' , 'T' /
      DATA (ICMP( 7,J),J=1,5) / 'E' , 'L' , ' ' , ' ' , ' ' /
      DATA (ICMP( 8,J),J=1,5) / 'E' , 'L' , 'I' , 'M' , 'I' /
      DATA (ICMP( 9,J),J=1,5) / 'E' , 'L' , 'S' , 'E' , ' ' /
      DATA (ICMP(10,J),J=1,5) / 'E' , 'L' , 'S' , 'E' , 'I' /
      DATA (ICMP(11,J),J=1,5) / 'E' , 'N' , ' ' , ' ' , ' ' /
      DATA (ICMP(12,J),J=1,5) / 'E' , 'N' , 'D' , ' ' , ' ' /
      DATA (ICMP(13,J),J=1,5) / 'E' , 'N' , 'D' , 'I' , 'F' /
      DATA (ICMP(14,J),J=1,5) / 'I' , 'F' , ' ' , ' ' , ' ' /
      DATA (ICMP(15,J),J=1,5) / 'I' , 'N' , 'C' , 'L' , 'U' /
      DATA (ICMP(16,J),J=1,5) / 'K' , 'W' , 'O' , 'K' , ' ' /
      DATA (ICMP(17,J),J=1,5) / 'L' , 'I' , 'S' , 'T' , ' ' /
      DATA (ICMP(18,J),J=1,5) / 'N' , 'O' , 'D' , 'S' , 'O' /
      DATA (ICMP(19,J),J=1,5) / 'N' , 'O' , 'K' , 'W' , 'O' /
      DATA (ICMP(20,J),J=1,5) / 'N' , 'O' , 'L' , 'I' , 'S' /
      DATA (ICMP(21,J),J=1,5) / 'N' , 'O' , 'R' , 'E' , 'P' /
      DATA (ICMP(22,J),J=1,5) / 'O' , 'P' , 'T' , 'I' , 'O' /
      DATA (ICMP(23,J),J=1,5) / 'O' , 'R' , 'I' , 'F' , ' ' /
      DATA (ICMP(24,J),J=1,5) / 'O' , 'T' , 'H' , 'E' , 'R' /
      DATA (ICMP(25,J),J=1,5) / 'R' , 'E' , 'P' , 'L' , 'A' /
      DATA (ICMP(26,J),J=1,5) / 'S' , 'A' , 'V' , 'E' , ' ' /
      DATA (ICMP(27,J),J=1,5) / 'T' , 'A' , 'B' , ' ' , ' ' /
      DATA (ICMP(28,J),J=1,5) / 'T' , 'I' , 'T' , 'L' , 'E' /
      DATA (ICMP(29,J),J=1,5) / 'U' , 'S' , 'E' , ' ' , ' ' /
      DATA (ICMP(30,J),J=1,5) / 'X' , 'C' , 'O' , 'M' , ' ' /
  101 CONTINUE
      IF (.NOT.(ICRK.EQ.(-1))) GO TO 10001
      ICRI=-1
      ICRJ=0
      ICRK=0
      ICRL=0
      RETURN
10001 CONTINUE
      ISTF=0
      ITMP=MAX(ICRK,1)
      IF (.NOT.(ICRK.EQ.0.OR.ICRD(ITMP).EQ.ICHS(50))) GO TO 10002
10003 CONTINUE
      CALL RDCRD(ICRD,IEOF,1)
      IF (.NOT.(IEOF.NE.0)) GO TO 10004
      ICRI=-1
      ICRJ=0
      ICRK=0
      ICRL=0
      RETURN
10004 CONTINUE
      IF (.NOT.(ICRD(1).NE.ICHS(50))) GO TO 10003
      ICRK=1
      ICRL=LNCD+1
10002 CONTINUE
      ICRI=ICRK
      ICRJ=ICRL
      ICRK=0
      NCLO=NCLO+NCLI
      NCLI=0
      IF (.NOT.(ICRD(ICRI).EQ.ICHS(4).OR.ICRD(ICRI).EQ.ILCA(3).OR.ICRD(I
     +CRI).EQ.ICHS(47).OR.ICRD(ICRI).EQ.ICHS(42))) GO TO 10005
      IF (.NOT.((ICRD(ICRI+1).LT.ICHS(2).OR.ICRD(ICRI+1).GT.ICHS(27)).AN
     +D.(ICRD(ICRI+1).LT.ILCA(1).OR.ICRD(ICRI+1).GT.ILCA(26))))
     +GO TO 10006
      IF (IFVA(IFVI).LE.0) GO TO 101
      ICRD(ICRI)=ICHS( 4)
      ITYP=ICHS( 4)
      IF (.NOT.(IFOC.NE.0)) GO TO 10007
      CALL XMIT(72,ICRD(ICRI),ISTA)
      ISTB=73
      GO TO 10008
10007 CONTINUE
      ISTB=1
10008 CONTINUE
      ISTA(ISTB)=ICHS(50)
      RETURN
10006 CONTINUE
      IF (.NOT.((ICRD(ICRI).EQ.ICHS(4).OR.ICRD(ICRI).EQ.ILCA(3)).AND.(IC
     +RD(ICRI+1).EQ.ICHS(5).OR.ICRD(ICRI+1).EQ.ILCA(4)).AND.(ICRD(ICRI+2
     +).EQ.ICHS(10).OR.ICRD(ICRI+2).EQ.ILCA(9)).AND.(ICRD(ICRI+3).EQ.ICH
     +S(19).OR.ICRD(ICRI+3).EQ.ILCA(18)).AND.ICRD(ICRI+4).EQ.ICHS(1).AND
     +.ICRD(ICRI+5).EQ.ICHS(39))) GO TO 10009
      IF (IFVA(IFVI).LE.0) GO TO 101
      ITYP=ICHS( 7)
      GO TO 10010
10009 CONTINUE
      ICRD(ICRI)=ICHS(47)
      ITYP=ICHS(10)
10010 CONTINUE
      GO TO 10011
10005 CONTINUE
      IF (IFVA(IFVI).LE.0) GO TO 101
      ITYP=ICHS( 7)
10011 CONTINUE
10012 CONTINUE
      ICRK=ICRJ+1
      IF (ICRK+LNCD.GT.1701) ICRK=1
      ICRL=ICRK+LNCD
      IF (.NOT.(ICRK.LE.ICRI.AND.ICRL.GE.ICRI)) GO TO 10013
      CALL ERRM(7)
      ICRK=0
      ICRL=ICRJ
      GO TO 10014
10013 CONTINUE
10015 CONTINUE
      CALL RDCRD(ICRD(ICRK),IEOF,1)
      IF (.NOT.(IEOF.NE.0)) GO TO 10016
      ICRK=-1
      ICRL=ICRJ
      GO TO 10014
10016 CONTINUE
      IF (.NOT.(ITYP.EQ.ICHS(10).OR.ICRD(ICRK).NE.ICHS(50))) GO TO 10015
      IF (ICRD(ICRK).EQ.ICHS(4).OR.ICRD(ICRK).EQ.ILCA(3).OR.ICRD(ICRK).E
     +Q.ICHS(47).OR.ICRD(ICRK).EQ.ICHS(42)) GO TO 10014
      IF (ITYP.EQ.ICHS(7).AND.(ICRD(ICRK+5).EQ.ICHS(39).OR.ICRD(ICRK+5).
     +EQ.ICHS(28))) GO TO 10014
      IF (ITYP.EQ.ICHS(10).AND.ICRD(ICRK).NE.ICHS(38)) GO TO 10014
      ICRJ=ICRL
      GO TO 10012
10014 CONTINUE
      I=ICRI
      IF (.NOT.(ITYP.EQ.ICHS(7))) GO TO 10017
      CALL XMIT(6,ICRD(ICRI),ISTA)
      ISTB=6
      J=ICRI+6
      K=66
      GO TO 10018
10017 CONTINUE
      CALL XMIT(1,ICRD(ICRI),ISTA)
      ISTB=1
      J=ICRI+1
      K=71
10018 CONTINUE
      JXCC=IXCC
      IF (.NOT.(ITYP.EQ.ICHS(10))) GO TO 10019
      IF ((ICRD(ICRI+1).EQ.ICHS(25).OR.ICRD(ICRI+1).EQ.ILCA(24)).AND.
     +              (ICRD(ICRI+2).EQ.ICHS( 4).OR.ICRD(ICRI+2).EQ.ILCA( 3
     +))) JXCC=ICHS(50)
10019 CONTINUE
10020 CONTINUE
      IF (.NOT.(JXCC.EQ.ICHS(50))) GO TO 10021
      L=K
      GO TO 10022
10021 CONTINUE
      L=INDEX1(JXCC,ICRD(J),1,K)-1
      IF (L.LT.0) L=K
10022 CONTINUE
      CALL XMIT (L,ICRD(J),ISTA(ISTB+1))
      ISTB=ISTB+L
      IF (.NOT.(I+LNCD.EQ.ICRJ)) GO TO 10023
      ISTB=LSTNB(ISTA,1,ISTB)
      IF (.NOT.(ISTB.LT.7)) GO TO 10024
      CALL XMIT(ISTB-7,ICHS(39),ISTA(ISTB+1))
      ISTB=7
10024 CONTINUE
      GO TO 10025
10023 CONTINUE
      I=I+LNCD+1
      J=J+LNCD+1
      IF (.NOT.(I+LNCD.GT.1701)) GO TO 10026
      J=1+J-I
      I=1
10026 CONTINUE
      GO TO 10020
10025 CONTINUE
      ISTB=ISTB+1
      ISTA(ISTB)=ICHS(50)
      IF (.NOT.(ITYP.EQ.ICHS(10))) GO TO 10027
      ITYQ=1
      ITYR=30
      ISTC = 2
      GO TO 10030
10028 CONTINUE
      IF (ITYQ.EQ.0.OR.ISTA(ISTC).EQ.ICHS(39)) GO TO 10029
      ISTC =ISTC +1
10030 CONTINUE
      IF (ISTC .GT.(6)) GO TO 10029
      IF (.NOT.(ITYQ.NE.ITYR.OR.ISTA(ISTC).NE.ICHS(39))) GO TO 10031
      ITCH=ISTA(ISTC)
      IF (.NOT.(ITCH.GE.ILCA(1).AND.ITCH.LE.ILCA(26))) GO TO 10032
      ITCH=CHAR(ICHAR(ICHS( 2))+ICHAR(ITCH)-ICHAR(ILCA( 1)))
10032 CONTINUE
      ITYQ=INDEX1(ITCH,ICMP(1,ISTC-1),ITYQ,ITYR)
10033 CONTINUE
      IF (.NOT.(ITYQ.NE.0.AND.ITCH.NE.ICMP(ITYR,ISTC-1))) GO TO 10034
      ITYR=ITYR-1
      GO TO 10033
10034 CONTINUE
10031 CONTINUE
      GO TO 10028
10029 CONTINUE
      IF (.NOT.(ITYQ.NE.ITYR)) GO TO 10035
      IF (IFVA(IFVI).LE.0) GO TO 101
      IF (.NOT.(IUCF.NE.0)) GO TO 10036
      CALL ERRM(6)
10036 CONTINUE
      ICRD(ICRI)=ICHS( 4)
      ITYP=ICHS( 4)
      RETURN
10035 CONTINUE
      IF (.NOT.(IFVA(IFVI).LE.0)) GO TO 10037
      IF (ITYQ.NE.9.AND.ITYQ.NE.10.AND.ITYQ.NE.13.AND.
     +           ITYQ.NE.14.AND.ITYQ.NE.23.AND.ITYQ.NE.24) GO TO 101
10037 CONTINUE
      IF (ISTA(ISTC).NE.ICHS(39)) ISTC=INDEX1(ICHS(39),ISTA,ISTC+1,ISTB)
      IF (.NOT.(ISTC.NE.0)) GO TO 10038
      ISTC=NINDX1(ICHS(39),ISTA,ISTC+1,ISTB)
      GO TO 10039
10038 CONTINUE
      ISTC=ISTB
10039 CONTINUE
      RETURN
10027 CONTINUE
      IF (.NOT.(ICUB.NE.0.AND.ITYP.EQ.ICHS(7).AND.(ISTA(6).EQ.ICHS(39).O
     +R.ISTA(6).EQ.ICHS(28)).AND.ISTA(7).EQ.ICHS(39))) GO TO 10040
      I=NINDX1(ICHS(39),ISTA,7,ISTB)
      CALL XMIT(ISTB-I+1,ISTA(I),ISTA(7))
      ISTB=ISTB-I+7
      ISTF=1
10040 CONTINUE
      RETURN
      END
      SUBROUTINE GOTOCD(N)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 IGOT(12)
      DATA IGOT / 6*' ','G','O',' ','T','O',' ' /
      IF (.NOT.(ISGT.EQ.0)) GO TO 10001
      CALL XMIT(12,IGOT,IBUF)
      CALL CVD(N,IBUF(13),5)
      CALL XMIT(-55,ICHS(39),IBUF(18))
      CALL OUTBUF
      ISGT=1
10001 CONTINUE
      RETURN
      END
      SUBROUTINE IFNOT(ISTR,I0,I1,N)
      CHARACTER*1 ISTR(1)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ISIF(15),ISGO(6)
      DATA ISIF / 6*' ' , 'I' , 'F' , ' ' , '(' , '.' , 'N' , 'O' ,
     +            'T' , '.' /
      DATA ISGO / 'G' , 'O' , ' ' , 'T' , 'O' , ' ' /
      CALL XMIT(15,ISIF,IBUF)
      J=15
      I=I0
10001 CONTINUE
      IF (.NOT.(I.LE.I1)) GO TO 10002
      IF (.NOT.(J.EQ.72)) GO TO 10003
      L10005=    1
      GO TO 10005
10004 CONTINUE
10003 CONTINUE
      K=MIN(I1-I+1,72-J)
      CALL XMIT(K,ISTR(I),IBUF(J+1))
      I=I+K
      J=J+K
      GO TO 10001
10002 CONTINUE
      IF (.NOT.(J.EQ.72)) GO TO 10006
      L10005=    2
      GO TO 10005
10007 CONTINUE
10006 CONTINUE
      J=J+1
      IBUF(J)=ICHS(45)
      IF (.NOT.(J.NE.72)) GO TO 10008
      J=J+1
      IBUF(J)=ICHS(39)
10008 CONTINUE
      IF (.NOT.(J.GT.61)) GO TO 10009
      L10005=    3
      GO TO 10005
10010 CONTINUE
10009 CONTINUE
      CALL XMIT(6,ISGO,IBUF(J+1))
      CALL CVD(N,IBUF(J+7),5)
      J=J+11
      L10005=    4
      GO TO 10005
10011 CONTINUE
      RETURN
10005 CONTINUE
      CALL XMIT(J-72,ICHS(39),IBUF(J+1))
      CALL OUTBUF
      IBUF(6)=ICHS(40)
      J=6
      GO TO (10004,10007,10010,10011) , L10005
      END
      SUBROUTINE IFSTAT
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 IIFS(3),ITHN(5)
      DATA IIFS / 'I','F',' ' /
      DATA ITHN / ' ','T','H','E','N' /
      IF (.NOT.(IBIT.EQ.0)) GO TO 10001
      CALL CRDOUT
      CALL LABOUT
      CALL NEWNUM(N2)
      CALL STAK(1,0,N2)
      CALL IFNOT(ISTA,ISTD,ISTE,N2)
      NEST=NEST+1
      GO TO 10002
10001 CONTINUE
      ISTB=ISTE-ISTD+16
      IF (.NOT.(ISTB.LE.1327)) GO TO 10003
      CALL XMIT(3,IIFS,ISTA(7))
      CALL XMIT(ISTE-ISTD+1,ISTA(ISTD),ISTA(10))
      CALL XMIT(5,ITHN,ISTA(ISTB-5))
      ISTA(ISTB)=ICHS(50)
      GO TO 10004
10003 CONTINUE
      CALL ERRM(32)
      CALL NGEXIT(NERR)
      STOP
10004 CONTINUE
      CALL STAK(1,0,0)
      ITYP=ICHS( 7)
      CALL CRDOUT
      NEST=NEST+1
      ISGT=0
10002 CONTINUE
      RETURN
      END
      SUBROUTINE IFTRIO (IKEY,IUNT,ITXT,LNTH,IEOF)
      CHARACTER*1 ITXT(*)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      COMMON /IFTCM3/ IU1B(512),IU2B(512),CRC1,CRC2,SFUN,TBCH
      CHARACTER*1     IU1B,IU2B,CRC1,CRC2,TBCH
      CHARACTER*17    SFUN
      COMMON /IFTCM4/ IU1P,IU1Q,IU2P,IU2Q
      IF (.NOT.(IKEY.EQ.1)) GO TO 10001
      IF (.NOT.(IUNT.EQ.IINP)) GO TO 10002
      ITBF=0
      DO 10003 I=1,32767
      IF (.NOT.(ITBF.LE.0)) GO TO 10004
      IF (.NOT.(IU1P.GE.IU1Q)) GO TO 10005
      CALL NGRDCH (IUNT,IU1B,512,IU1R)
      IF (.NOT.(IU1R.LE.0)) GO TO 10006
      IEOF=1
      RETURN
10006 CONTINUE
      IU1P=0
      IU1Q=IU1R
10005 CONTINUE
      IU1P=IU1P+1
      IF (.NOT.(IU1B(IU1P).EQ.CRC1.OR.IU1B(IU1P).EQ.CRC2)) GO TO 10007
      IF (I.LE.LNTH) CALL XMIT(I-LNTH-1,ICHS(39),ITXT(I))
      IEOF=0
      IF ( ITXT(1).EQ.'.'.AND.
     +    (ITXT(2).EQ.'F'.OR.ITXT(2).EQ.'f').AND.
     +    (ITXT(3).EQ.'I'.OR.ITXT(3).EQ.'i')) IEOF=1
      RETURN
10007 CONTINUE
      IF (.NOT.(IU1B(IU1P).EQ.TBCH)) GO TO 10008
      IF (I.LE.LNTH) ITXT(I)=' '
      ITBF=8*((I-1)/8+1)-I
      GO TO 10009
10008 CONTINUE
      IF (I.LE.LNTH) ITXT(I)=IU1B(IU1P)
10009 CONTINUE
      GO TO 10010
10004 CONTINUE
      IF (I.LE.LNTH) ITXT(I)=' '
      ITBF=ITBF-1
10010 CONTINUE
10003 CONTINUE
      GO TO 10011
10002 CONTINUE
      IF (.NOT.(IUNT.EQ.INCU)) GO TO 10012
      ITBF=0
      DO 10013 I=1,32767
      IF (.NOT.(ITBF.LE.0)) GO TO 10014
      IF (.NOT.(IU2P.GE.IU2Q)) GO TO 10015
      CALL NGRDCH (IUNT,IU2B,512,IU2R)
      IF (.NOT.(IU2R.LE.0)) GO TO 10016
      IEOF=1
      RETURN
10016 CONTINUE
      IU2P=0
      IU2Q=IU2R
10015 CONTINUE
      IU2P=IU2P+1
      IF (.NOT.(IU2B(IU2P).EQ.CRC1.OR.IU2B(IU2P).EQ.CRC2)) GO TO 10017
      IF (I.LE.LNTH) CALL XMIT(I-LNTH-1,ICHS(39),ITXT(I))
      IEOF=0
      IF (ITXT(1).EQ.'.'.AND.
     +    (ITXT(2).EQ.'F'.OR.ITXT(2).EQ.'f').AND.
     +    (ITXT(3).EQ.'I'.OR.ITXT(3).EQ.'i')) IEOF=1
      RETURN
10017 CONTINUE
      IF (.NOT.(IU2B(IU2P).EQ.TBCH)) GO TO 10018
      IF (I.LE.LNTH) ITXT(I)=' '
      ITBF=8*((I-1)/8+1)-I
      GO TO 10019
10018 CONTINUE
      IF (I.LE.LNTH) ITXT(I)=IU2B(IU2P)
10019 CONTINUE
      GO TO 10020
10014 CONTINUE
      IF (I.LE.LNTH) ITXT(I)=' '
      ITBF=ITBF-1
10020 CONTINUE
10013 CONTINUE
      GO TO 10011
10012 CONTINUE
      CALL NGRDCH (IUNT,ITXT,LNTH,LNRD)
      IF (.NOT.(LNRD.EQ.LNTH)) GO TO 10021
      IEOF=0
      GO TO 10022
10021 CONTINUE
      IEOF=1
10022 CONTINUE
10011 CONTINUE
      GO TO 10023
10001 CONTINUE
      IF (.NOT.(IKEY.EQ.2)) GO TO 10024
      IF (.NOT.(IUNT.EQ.ISAV)) GO TO 10025
      CALL NGWRCH (IUNT,ITXT,LNTH,LNWR)
      GO TO 10026
10025 CONTINUE
      ITMP=LSTNB(ITXT,1,LNTH)
      CALL NGWRCH (IUNT,ITXT,ITMP,LNWR)
      CALL NGWRCH (IUNT,CRC1,   1,LNWR)
10026 CONTINUE
      GO TO 10023
10024 CONTINUE
      IF (.NOT.(IKEY.EQ.3)) GO TO 10027
      IF (.NOT.(IUNT.EQ.ISAV)) GO TO 10028
      CALL NGCLFI (ISAV)
      CALL NGOFRW (SFUN,ISAV,ITMP)
      IF (ITMP.NE.0) ISAV=0
10028 CONTINUE
10023 CONTINUE
10027 CONTINUE
      RETURN
      END
      SUBROUTINE IFTRUE(ISTR,I0,I1,N)
      CHARACTER*1 ISTR(1)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ISIF(10),ISGO(6)
      DATA ISIF / 6*' ' , 'I' , 'F' , ' ' , '(' /
      DATA ISGO / 'G' , 'O' , ' ' , 'T' , 'O' , ' ' /
      CALL XMIT(10,ISIF,IBUF)
      J=10
      I=I0
10001 CONTINUE
      IF (.NOT.(I.LE.I1)) GO TO 10002
      IF (.NOT.(J.EQ.72)) GO TO 10003
      L10005=    1
      GO TO 10005
10004 CONTINUE
10003 CONTINUE
      K=MIN(I1-I+1,72-J)
      CALL XMIT(K,ISTR(I),IBUF(J+1))
      I=I+K
      J=J+K
      GO TO 10001
10002 CONTINUE
      IF (.NOT.(J.EQ.72)) GO TO 10006
      L10005=    2
      GO TO 10005
10007 CONTINUE
10006 CONTINUE
      J=J+1
      IBUF(J)=ICHS(45)
      IF (.NOT.(J.NE.72)) GO TO 10008
      J=J+1
      IBUF(J)=ICHS(39)
10008 CONTINUE
      IF (.NOT.(J.GT.61)) GO TO 10009
      L10005=    3
      GO TO 10005
10010 CONTINUE
10009 CONTINUE
      CALL XMIT(6,ISGO,IBUF(J+1))
      CALL CVD(N,IBUF(J+7),5)
      J=J+11
      L10005=    4
      GO TO 10005
10011 CONTINUE
      RETURN
10005 CONTINUE
      CALL XMIT(J-72,ICHS(39),IBUF(J+1))
      CALL OUTBUF
      IBUF(6)=ICHS(40)
      J=6
      GO TO (10004,10007,10010,10011) , L10005
      END
      SUBROUTINE INCLPM(NUNT,LENC,IREW)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*80 CFNM
      IF (.NOT.(ISTC.LT.ISTB)) GO TO 10001
      J=0
      DO 10002 I=ISTC,ISTB-1
      J=J+1
      IF (J.LT.80) CFNM(J:J)=ISTA(I)
10002 CONTINUE
      CFNM(J+1:J+1)=ICHS(50)
      CALL NGOFRO (CFNM,NUNT,ITMP)
      IU2P=0
      IU2Q=0
      LENC=80
      IREW=0
      GO TO 10003
10001 CONTINUE
      NUNT=0
10003 CONTINUE
      RETURN
      END
      FUNCTION INDEX1(ICHR,ISTR,L0,L1)
      CHARACTER*1 ICHR,ISTR(1)
      IF (.NOT.(L0.LE.L1)) GO TO 10001
      DO 10002 L=L0,L1
      IF (ICHR.EQ.ISTR(L)) GO TO 101
10002 CONTINUE
10001 CONTINUE
      L=0
  101 INDEX1=L
      RETURN
      END
      SUBROUTINE INVOKE
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CALL NEWNUM(IR)
      NR=IR
      CALL NAMBLO(N1,NR)
      CALL CRDOUT
      CALL LABOUT
      IF (.NOT.(N1.GT.0)) GO TO 10001
      N3=ABS(NAMI(N1))
      IF (.NOT.(NAMI(N1+3).GE.0)) GO TO 10002
      CALL OUTCHR(ICHS(13))
      CALL OUTNUM(N3)
      CALL OUTCHR(ICHS(46))
      CALL OUTNUM(NR)
      CALL OUTLIN(0)
      CALL GOTOCD(N3)
      CALL CONTCD(IR)
      GO TO 10003
10002 CONTINUE
      CALL GOTOCD(N3)
10003 CONTINUE
10001 CONTINUE
      RETURN
      END
      SUBROUTINE LABOUT
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ICNT(9)
      DATA ICNT / ' ' , 'C' , 'O' , 'N' , 'T' , 'I' , 'N' , 'U' , 'E' /
      DO 10001 I=1,5
      IF (ISTA(I).NE.ICHS(39)) GO TO 101
10001 CONTINUE
      RETURN
  101 CALL XMIT(5,ISTA,IBUF)
      CALL XMIT(9,ICNT,IBUF(6))
      CALL XMIT(-66,ICHS(39),IBUF(15))
      CALL OUTBUF
      ISGT=0
      RETURN
      END
      SUBROUTINE LOOPST
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CALL CRDOUT
      CALL LABOUT
      CALL NEWNUM(N1)
      CALL STAK(6,N1,0)
      CALL CONTCD(N1)
      NEST=NEST+1
      RETURN
      END
      FUNCTION LSTNB(ISTR,L0,L1)
      CHARACTER*1 ISTR(1)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      LSTNB=L1
10001 CONTINUE
      IF (.NOT.(LSTNB.GT.L0)) GO TO 10002
      IF (ISTR(LSTNB).NE.ICHS(39)) RETURN
      LSTNB=LSTNB-1
      GO TO 10001
10002 CONTINUE
      RETURN
      END
      SUBROUTINE MULREP(ISTX)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ICH
      I1=NINDX1(ICHS(39),ISTA,ISTX,ISTB-1)
      IF (I1.EQ.0) RETURN
10001 CONTINUE
      ICH=ISTA(I1)
      I2=INDEX1(ICH,ISTA,I1+1,ISTB-1)
      IF (.NOT.(I2.LE.I1+1)) GO TO 10002
      CALL ERRM(11)
      RETURN
10002 CONTINUE
      I3=INDEX1(ICH,ISTA,I2+1,ISTB-1)
      IF (.NOT.(I3.EQ.0)) GO TO 10003
      CALL ERRM(11)
      RETURN
10003 CONTINUE
      IF (.NOT.(ISRA)) GO TO 10004
      J3=I3-1
      IF (I2.LT.J3) CALL REPL2(ISTA,1327,ISTB,I2+1,J3,ISTF)
      I3=J3+1
10004 CONTINUE
      CALL REPL1(ISTA(I1+1),I2-I1-1,ISTA(I2+1),I3-I2-1)
      I=NINDX1(ICHS(39),ISTA,I3+1,ISTB-1)
      IF (I.LE.0) RETURN
      IF (.NOT.(ISTA(I).NE.ICHS(38))) GO TO 10005
      CALL ERRM(11)
      RETURN
10005 CONTINUE
      I1=NINDX1(ICHS(39),ISTA,I+1,ISTB-1)
      IF (.NOT.(I1.EQ.0)) GO TO 10006
      CALL ERRM(11)
      RETURN
10006 CONTINUE
      GO TO 10001
      END
      SUBROUTINE NAMBLO(NUMB,IREF)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      J=ISTD-1
      DO 10001 I=ISTD,ISTE
      IF (.NOT.(ISTA(I).NE.ICHS(44).AND.ISTA(I).NE.ICHS(39).AND.ISTA(I).
     +NE.ICHS(45))) GO TO 10002
      J=J+1
      ISTA(J)=ISTA(I)
10002 CONTINUE
10001 CONTINUE
      ISTE=J
      IF (.NOT.(ISTE.LT.ISTD)) GO TO 10003
      CALL ERRM(26)
      NUMB=0
      RETURN
10003 CONTINUE
      NUMB=1
10004 CONTINUE
      IF (.NOT.(NUMB.LT.NAMP)) GO TO 10005
      IF (.NOT.(NAMI(NUMB+2).EQ.ISTE-ISTD+1)) GO TO 10006
      I=NAMI(NUMB+1)
      IF (.NOT.(NOTEQ(NAMC(I),ISTA(ISTD),NAMI(NUMB+2)).EQ.0))
     +GO TO 10007
      IF (.NOT.(NAMI(NUMB).LT.0)) GO TO 10008
      IF (.NOT.(IREF.NE.0)) GO TO 10009
      CALL ERRM(34)
      GO TO 10010
10009 CONTINUE
      CALL ERRM(36)
10010 CONTINUE
10008 CONTINUE
      GO TO 101
10007 CONTINUE
10006 CONTINUE
      NUMB=NUMB+4
      GO TO 10004
10005 CONTINUE
      IF (.NOT.(NUMB+4.GT.NAMQ)) GO TO 10011
      CALL ERRM(25)
      NUMB=0
      RETURN
10011 CONTINUE
      IF (.NOT.(NAMR+ISTE-ISTD+1.GT.1000)) GO TO 10012
      CALL ERRM(31)
      NUMB=0
      RETURN
10012 CONTINUE
      CALL NEWNUM(NAMI(NUMB))
      NAMI(NUMB+1)=NAMR+1
      NAMI(NUMB+2)=ISTE-ISTD+1
      NAMI(NUMB+3)=0
      IF ( ISTA(ISTE-2).EQ.ICHS(38).AND.
     +         (ISTA(ISTE-1).EQ.ICHS(15).OR.ISTA(ISTE-1).EQ.ILCA(14)).AN
     +D.                 (ISTA(ISTE  ).EQ.ICHS(19).OR.ISTA(ISTE  ).EQ.IL
     +CA(18)) )
     +        NAMI(NUMB+3)=-1
      NAMP=NAMP+4
      CALL XMIT (ISTE-ISTD+1,ISTA(ISTD),NAMC(NAMR+1))
      NAMR=NAMR+ISTE-ISTD+1
  101 CONTINUE
      IF (.NOT.(IREF.NE.0)) GO TO 10013
      IF (.NOT.(NAMQ-2.LT.NAMP)) GO TO 10014
      CALL ERRM(25)
      RETURN
10014 CONTINUE
      IF (.NOT.(NAMI(NUMB+3).GE.0)) GO TO 10015
      ITMP=NUMB+2
      JTMP=1
10016 CONTINUE
      IF (.NOT.(NAMI(ITMP+1).NE.0)) GO TO 10017
      ITMP=NAMI(ITMP+1)
      JTMP=JTMP+1
      GO TO 10016
10017 CONTINUE
      NAMQ=NAMQ-2
      NAMI(NAMQ+1)=IREF
      NAMI(NAMQ+2)=0
      NAMI(ITMP+1)=NAMQ+1
      IREF=JTMP
10015 CONTINUE
10013 CONTINUE
      RETURN
      END
      SUBROUTINE NEWNUM(NUMB)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      NUMB=IGNN
      IGNN=IGNN+IGND
      RETURN
      END
      FUNCTION NINDX1(ICHR,ISTR,L0,L1)
      CHARACTER*1 ICHR,ISTR(1)
      IF (.NOT.(L0.LE.L1)) GO TO 10001
      DO 10002 L=L0,L1
      IF (ICHR.NE.ISTR(L)) GO TO 101
10002 CONTINUE
10001 CONTINUE
      L=0
  101 NINDX1=L
      RETURN
      END
      FUNCTION NOTEQ(IST1,IST2,N)
      CHARACTER*1 IST1(1),IST2(1)
      IF (.NOT.(N.GT.0)) GO TO 10001
      DO 10002 I=1,N
      IF (IST1(I).NE.IST2(I)) GO TO 101
10002 CONTINUE
10001 CONTINUE
      I=0
  101 NOTEQ=I
      RETURN
      END
      SUBROUTINE OUTBUF
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 JBUF(80)
      SAVE NCJB
      DATA JBUF(1),JBUF(2),JBUF(3),JBUF(4),JBUF(5),JBUF(6) / 5*' ','+' /
      DATA NCJB / 0 /
      IF (IOTC.EQ.0) RETURN
      IF (.NOT.(IFON.EQ.1)) GO TO 10001
      CALL CVD(MAX(NEST,0),IBUF(73),3)
      CALL CVD(NCLO,IBUF(76),5)
      GO TO 10002
10001 CONTINUE
      IF (.NOT.(IFON.EQ.2)) GO TO 10003
      CALL XMIT(8,ICRD(ICRI+72),IBUF(73))
      GO TO 10002
10003 CONTINUE
      CALL XMIT(-8,ICHS(39),IBUF(73))
10002 CONTINUE
      MEST=MAX(0,MIN(66,NEST*IFIN))
      IF (.NOT.(IBUF(1).EQ.ICHS(4).OR.IBUF(1).EQ.ILCA(3))) GO TO 10004
      IF (.NOT.(NCJB.NE.0)) GO TO 10005
      DO 10006 I=7,6+NCJB
      IF (JBUF(I).NE.ICHS(39)) GO TO 101
10006 CONTINUE
      GO TO 102
  101 CALL IFTRIO (2,IOTC,JBUF,80,0)
  102 NCJB=0
10005 CONTINUE
      CALL IFTRIO (2,IOTC,IBUF,80,0)
      GO TO 10007
10004 CONTINUE
      IF (.NOT.(IBUF(6).NE.ICHS(40))) GO TO 10008
      IF (.NOT.(NCJB.NE.0)) GO TO 10009
      DO 10010 I=7,6+NCJB
      IF (JBUF(I).NE.ICHS(39)) GO TO 103
10010 CONTINUE
      GO TO 104
  103 CALL IFTRIO (2,IOTC,JBUF,80,0)
  104 NCJB=0
10009 CONTINUE
      IF (.NOT.(MEST.NE.0)) GO TO 10011
      CALL XMIT (MEST,IBUF(73-MEST),JBUF(7))
      CALL XMIT (MEST-66,ICHS(39),JBUF(7+MEST))
      CALL XMIT (8,IBUF(73),JBUF(73))
      NCJB=MEST
      I=72
10012 CONTINUE
      IF (.NOT.(I.GE.7+MEST)) GO TO 10013
      IBUF(I)=IBUF(I-MEST)
      I=I-1
      GO TO 10012
10013 CONTINUE
      CALL XMIT (-MEST,ICHS(39),IBUF(7))
10011 CONTINUE
      CALL IFTRIO (2,IOTC,IBUF,80,0)
      GO TO 10007
10008 CONTINUE
      IF (.NOT.(MEST.EQ.0)) GO TO 10014
      CALL IFTRIO (2,IOTC,IBUF,80,0)
      GO TO 10015
10014 CONTINUE
      CALL XMIT (66-NCJB,IBUF(7),JBUF(7+NCJB))
      CALL XMIT (8,IBUF(73),JBUF(73))
      CALL IFTRIO (2,IOTC,JBUF,80,0)
      CALL XMIT (NCJB,IBUF(73-NCJB),JBUF(7))
      CALL XMIT (NCJB-66,ICHS(39),JBUF(7+NCJB))
10015 CONTINUE
10007 CONTINUE
      RETURN
      END
      SUBROUTINE OUTCHR(ICHR)
      CHARACTER*1 ICHR
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      IF (.NOT.(IOCP.EQ.0)) GO TO 10001
      CALL XMIT(-80,ICHS(39),IBUF)
      IF (IOCC) IBUF(6)=ICHS(40)
      IOCP=6
10001 CONTINUE
      IOCP=IOCP+1
      IBUF(IOCP)=ICHR
      IF (.NOT.(IOCP.GE.72)) GO TO 10002
      CALL OUTBUF
      IOCP=0
      IOCC=.TRUE.
10002 CONTINUE
      RETURN
      END
      SUBROUTINE OUTLIN(JSGT)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      IF (.NOT.(IOCP.GT.0)) GO TO 10001
      CALL OUTBUF
      IOCP=0
10001 CONTINUE
      IOCC=.FALSE.
      ISGT=JSGT
      RETURN
      END
      SUBROUTINE OUTNUM(NUMB)
      CHARACTER*1 ISTR(5)
      CALL CVD(NUMB,ISTR,5)
      CALL OUTSTR(ISTR,1,5)
      RETURN
      END
      SUBROUTINE OUTSTR(ISTR,I0,I1)
      CHARACTER*1 ISTR(1)
      DO 10001 I=I0,I1
      CALL OUTCHR(ISTR(I))
10001 CONTINUE
      RETURN
      END
      SUBROUTINE PAQQ(KEY)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ITCH
      CHARACTER*1 LTPS(24,9),ITHN(4),ICPI
      DIMENSION LTPE(24)
      DATA (LTPS( 1,J),J=1,9) / 'B','L','O','C','K',' ',' ',' ',' ' / ,
     +      LTPE( 1  )        / 1 /
      DATA (LTPS( 2,J),J=1,9) / 'D','O',' ',' ',' ',' ',' ',' ',' ' / ,
     +      LTPE( 2  )        / 1 /
      DATA (LTPS( 3,J),J=1,9) / 'E','L','S','E',' ',' ',' ',' ',' ' / ,
     +      LTPE( 3  )        / 0 /
      DATA (LTPS( 4,J),J=1,9) / 'E','L','S','E','I','F',' ',' ',' ' / ,
     +      LTPE( 4  )        / 1 /
      DATA (LTPS( 5,J),J=1,9) / 'E','N','D',' ',' ',' ',' ',' ',' ' / ,
     +      LTPE( 5  )        / 0 /
      DATA (LTPS( 6,J),J=1,9) / 'E','N','D','B','L','O','C','K',' ' / ,
     +      LTPE( 6  )        / 0 /
      DATA (LTPS( 7,J),J=1,9) / 'E','N','D','D','O',' ',' ',' ',' ' / ,
     +      LTPE( 7  )        / 0 /
      DATA (LTPS( 8,J),J=1,9) / 'E','N','D','F','O','R',' ',' ',' ' / ,
     +      LTPE( 8  )        / 0 /
      DATA (LTPS( 9,J),J=1,9) / 'E','N','D','I','F',' ',' ',' ',' ' / ,
     +      LTPE( 9  )        / 0 /
      DATA (LTPS(10,J),J=1,9) / 'E','N','D','L','O','O','P',' ',' ' / ,
     +      LTPE(10  )        / 0 /
      DATA (LTPS(11,J),J=1,9) / 'E','N','D','W','H','I','L','E',' ' / ,
     +      LTPE(11  )        / 0 /
      DATA (LTPS(12,J),J=1,9) / 'E','X','I','T',' ',' ',' ',' ',' ' / ,
     +      LTPE(12  )        / 0 /
      DATA (LTPS(13,J),J=1,9) / 'E','X','I','T','I','F',' ',' ',' ' / ,
     +      LTPE(13  )        / 1 /
      DATA (LTPS(14,J),J=1,9) / 'F','O','R',' ',' ',' ',' ',' ',' ' / ,
     +      LTPE(14  )        / 1 /
      DATA (LTPS(15,J),J=1,9) / 'G','O','T','O',' ',' ',' ',' ',' ' / ,
     +      LTPE(15  )        / 2 /
      DATA (LTPS(16,J),J=1,9) / 'I','F',' ',' ',' ',' ',' ',' ',' ' / ,
     +      LTPE(16  )        / 1 /
      DATA (LTPS(17,J),J=1,9) / 'I','N','V','O','K','E',' ',' ',' ' / ,
     +      LTPE(17  )        / 1 /
      DATA (LTPS(18,J),J=1,9) / 'L','O','O','P',' ',' ',' ',' ',' ' / ,
     +      LTPE(18  )        / 0 /
      DATA (LTPS(19,J),J=1,9) / 'O','R','I','F',' ',' ',' ',' ',' ' / ,
     +      LTPE(19  )        / 1 /
      DATA (LTPS(20,J),J=1,9) / 'R','E','P','E','A','T',' ',' ',' ' / ,
     +      LTPE(20  )        / 0 /
      DATA (LTPS(21,J),J=1,9) / 'R','E','T','U','R','N',' ',' ',' ' / ,
     +      LTPE(21  )        / 3 /
      DATA (LTPS(22,J),J=1,9) / 'S','T','O','P',' ',' ',' ',' ',' ' / ,
     +      LTPE(22  )        / 4 /
      DATA (LTPS(23,J),J=1,9) / 'U','N','T','I','L',' ',' ',' ',' ' / ,
     +      LTPE(23  )        / 1 /
      DATA (LTPS(24,J),J=1,9) / 'W','H','I','L','E',' ',' ',' ',' ' / ,
     +      LTPE(24  )        / 1 /
      DATA ITHN / 'T' , 'H' , 'E' , 'N' /
      KEY=0
      ISTD=ISTB+1
      ISTE=ISTB
      ITPL=1
      ITPH=24
      MTCH=0
      NCBS=0
      I0=7
      I1=ISTB-1
      DO 10001 I=I0,I1
      ITCH=ISTA(I)
      IF (.NOT.(ITCH.GE.ILCA(1).AND.ITCH.LE.ILCA(26))) GO TO 10002
      ITCH=CHAR(ICHAR(ICHS( 2))+ICHAR(ITCH)-ICHAR(ILCA( 1)))
10002 CONTINUE
      IF (.NOT.(ITCH.NE.ICHS(39))) GO TO 10003
      IF (.NOT.(ITPL.LT.ITPH)) GO TO 10004
      MTCH=MTCH+1
      ITPL=INDEX1(ITCH,LTPS(1,MTCH),ITPL,ITPH)
      IF (ITPL.EQ.0) RETURN
10005 CONTINUE
      IF (.NOT.(ITCH.NE.LTPS(ITPH,MTCH))) GO TO 10006
      ITPH=ITPH-1
      GO TO 10005
10006 CONTINUE
      GO TO 10007
10004 CONTINUE
      IF (.NOT.(LTPS(ITPL,MTCH+1).NE.ICHS(39))) GO TO 10008
      MTCH=MTCH+1
      IF (ITCH.NE.LTPS(ITPL,MTCH)) RETURN
      GO TO 10007
10008 CONTINUE
      IF (.NOT.(LTPE(ITPL).EQ.0)) GO TO 10009
      RETURN
10009 CONTINUE
      IF (.NOT.(LTPE(ITPL).EQ.1)) GO TO 10010
      IF (.NOT.(KWOK)) GO TO 10011
      IF (NCBS.EQ.0) RETURN
      ISTE=ISTE+1
      IF (ISTE.GT.1327) GO TO 106
      ISTA(ISTE)=ICHS(44)
      GO TO 10012
10011 CONTINUE
      IF (ITCH.NE.ICHS(44)) RETURN
10012 CONTINUE
      GO TO 101
10010 CONTINUE
      GO TO 105
10007 CONTINUE
      NCBS=0
      GO TO 10013
10003 CONTINUE
      NCBS=NCBS+1
10013 CONTINUE
10001 CONTINUE
      IF (LTPS(ITPL,MTCH+1).EQ.ICHS(39).AND.LTPE(ITPL).NE.1) KEY=ITPL
      RETURN
  101 LEVP=0
      IPAS=0
      NCBS=0
      IZRP=0
      INTV=0
      ICPI=ICHS(39)
      I0=I
      DO 10014 I=I0,I1
      IF (.NOT.(IPAS.LT.0)) GO TO 10015
      IF (IPAS.EQ.(-1).AND.ISTA(I).EQ.ICHS(48)) IPAS=0
      IF (IPAS.EQ.(-2).AND.ISTA(I).EQ.ICHS(49)) IPAS=0
      GO TO 10016
10015 CONTINUE
      IF (.NOT.(IPAS.GT.0)) GO TO 10017
      IPAS=IPAS-1
      GO TO 10016
10017 CONTINUE
      IF (.NOT.(ISTA(I).EQ.ICHS(39))) GO TO 10018
      NCBS=NCBS+1
      IF (.NOT.(NCBS.EQ.1.AND.ITPL.EQ.14)) GO TO 10019
      ISTE=ISTE+1
      IF (ISTE.GT.1327) GO TO 106
      ISTA(ISTE)=ICHS(39)
10019 CONTINUE
      GO TO 103
10018 CONTINUE
      IF (.NOT.(IZRP.NE.0)) GO TO 10020
      IF (.NOT.(KWOK)) GO TO 10021
      IF (ISTA(I).NE.ICHS(40).AND.ISTA(I).NE.ICHS(41).AND.
     +              ISTA(I).NE.ICHS(42).AND.ISTA(I).NE.ICHS(43).AND.
     +                        ISTA(I).NE.ICHS(47)
     + ) GO TO 104
      IZRP=0
      GO TO 10022
10021 CONTINUE
      GO TO 104
10022 CONTINUE
      GO TO 10016
10020 CONTINUE
      IF (.NOT.(ISTA(I).EQ.ICHS(48))) GO TO 10023
      IPAS=-1
      GO TO 10016
10023 CONTINUE
      IF (.NOT.(ISTA(I).EQ.ICHS(49))) GO TO 10024
      IPAS=-2
      GO TO 10016
10024 CONTINUE
      IF (.NOT.(ISTA(I).EQ.ICHS(44))) GO TO 10025
      LEVP=LEVP+1
      GO TO 10016
10025 CONTINUE
      IF (.NOT.(ISTA(I).EQ.ICHS(45))) GO TO 10026
      LEVP=LEVP-1
      IF (.NOT.(LEVP.LT.0)) GO TO 10027
      CALL ERRM(29)
      RETURN
10027 CONTINUE
      IF (.NOT.(LEVP.EQ.0)) GO TO 10028
      IZRP=1
10028 CONTINUE
      GO TO 10016
10026 CONTINUE
      IF (.NOT.(INTV.NE.0.AND.(ISTA(I).EQ.ICHS(9).OR.ISTA(I).EQ.ILCA(8).
     +OR.ISTA(I).EQ.ICHS(13).OR.ISTA(I).EQ.ILCA(12).OR.ISTA(I).EQ.ICHS(1
     +9).OR.ISTA(I).EQ.ILCA(18)))) GO TO 10029
      IF (.NOT.(ICPI.GE.ILCA(1).AND.ICPI.LE.ILCA(26))) GO TO 10030
      ICPI=CHAR(ICHAR(ICHS( 2))+ICHAR(ICPI)-ICHAR(ILCA( 1)))
10030 CONTINUE
      IF (.NOT.(ICPI.LT.ICHS(2).OR.ICPI.GT.ICHS(27))) GO TO 10031
      IPAS=INTV
10031 CONTINUE
      GO TO 10016
10029 CONTINUE
      J=INDEX1(ISTA(I),ICHS(28),1,10)-1
      IF (.NOT.(J.GE.0)) GO TO 10032
      IF (INTV.LT.3276) INTV=10*INTV+J
      GO TO 102
10032 CONTINUE
10016 CONTINUE
      INTV=0
      ICPI=ISTA(I)
  102 NCBS=0
      ISTE=ISTE+1
      IF (ISTE.GT.1327) GO TO 106
      ISTA(ISTE)=ISTA(I)
  103 CONTINUE
10014 CONTINUE
      IF (.NOT.(KWOK)) GO TO 10033
      IF (.NOT.(LEVP.EQ.0.AND.IPAS.GE.0)) GO TO 10034
      KEY=ITPL
      IF (.NOT.(IPAS.GT.0)) GO TO 10035
      ITMP=ISTE+1
      ISTE=ISTE+IPAS
      IF (ISTE.GT.1327) GO TO 106
      DO 10036 I=ITMP,ISTE
      ISTA(I)=ICHS(39)
10036 CONTINUE
10035 CONTINUE
      ISTE=ISTE+1
      IF (ISTE.GT.1327) GO TO 106
      ISTA(ISTE)=ICHS(45)
      GO TO 10037
10034 CONTINUE
      CALL ERRM(29)
10037 CONTINUE
      GO TO 10038
10033 CONTINUE
      IF (IZRP.NE.0) KEY=ITPL
10038 CONTINUE
      RETURN
  104 CONTINUE
      IF (.NOT.(ITPL.EQ.16.AND.(ISTA(I).GE.ICHS(28).AND.ISTA(I).LE.ICHS(
     +37)))) GO TO 10039
      KEY=26
      RETURN
10039 CONTINUE
      IF (.NOT.(ITPL.EQ.4.OR.ITPL.EQ.16.OR.ITPL.EQ.19)) GO TO 10040
      MTCH=0
      I0=I
      DO 10041 I=I0,I1
      ITCH=ISTA(I)
      IF (.NOT.(ITCH.GE.ILCA(1).AND.ITCH.LE.ILCA(26))) GO TO 10042
      ITCH=CHAR(ICHAR(ICHS( 2))+ICHAR(ITCH)-ICHAR(ILCA( 1)))
10042 CONTINUE
      IF (.NOT.(ITCH.NE.ICHS(39))) GO TO 10043
      MTCH=MTCH+1
      IF (ITCH.NE.ITHN(MTCH)) RETURN
10043 CONTINUE
10041 CONTINUE
      IF (.NOT.(MTCH.EQ.4)) GO TO 10044
      IF (ITPL.EQ.4.OR.ITPL.EQ.19) KEY=ITPL
      IF (ITPL.EQ.16) KEY=25
      RETURN
10044 CONTINUE
10040 CONTINUE
      RETURN
  105 I0=I
      DO 10045 I=I0,I1
      IF (ISTA(I).EQ.ICHS(46)) RETURN
10045 CONTINUE
      KEY=ITPL
      RETURN
  106 CALL ERRM(32)
      CALL NGEXIT(NERR)
      STOP
      END
      SUBROUTINE RDCRD(JCRD,IEOF,IPCC)
      CHARACTER*1 JCRD(1)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ITCH
  101 IEOF=0
      IF (.NOT.(ABS(IUAF).EQ.1)) GO TO 10001
      CALL IFTRIO(1,ISAV,JCRD,LNCD+1,IEOF)
      IF (.NOT.(JCRD(LNCD+1).EQ.ICHS(6))) GO TO 10002
      IUAF=IUAF+1
10002 CONTINUE
      GO TO 10003
10001 CONTINUE
      IF (.NOT.(IUAF.EQ.2)) GO TO 10004
      CALL XMIT(LNCD+1,IUSB,JCRD)
      IUAF=0
      GO TO 10003
10004 CONTINUE
      IF (.NOT.(ABS(INCP).EQ.1)) GO TO 10005
      LNRD=MIN(LNCD,INCL)
      CALL IFTRIO(1,INCU,JCRD,LNRD,IEOF)
      IF (.NOT.(IEOF.NE.0)) GO TO 10006
      INCP=INCP+1
      GO TO 101
10006 CONTINUE
      IF (LNRD.LT.LNCD) CALL XMIT(LNRD-LNCD,ICHS(39),JCRD(LNRD+1))
      GO TO 10003
10005 CONTINUE
      IF (.NOT.(INCP.EQ.2)) GO TO 10007
      CALL XMIT(LNCD+1,INSB,JCRD)
      INCP=0
      GO TO 10003
10007 CONTINUE
      CALL IFTRIO(1,IINP,JCRD,LNCD,IEOF)
      IF (IEOF.NE.0) RETURN
10003 CONTINUE
      NCLI=NCLI+1
      NCTO=NCTO+1
      IF (IPCC.EQ.0) RETURN
      JCRD(LNCD+1)=JCRD(1)
      IF (.NOT.(JCRD(1).NE.ICHS(39))) GO TO 10008
      ITCH=JCRD(1)
      IF (.NOT.((ITCH.GE.ICHS(2).AND.ITCH.LE.ICHS(27)).OR.(ITCH.GE.ILCA(
     +1).AND.ITCH.LE.ILCA(26)))) GO TO 10009
      I=INDEX1(ITCH,ICHS(2),1,26)
      IF (I.EQ.0) I=INDEX1(ITCH,ILCA,1,26)
      IF (.NOT.(IADE(I).EQ.ICHS(2))) GO TO 10010
      JCRD(1)=ICHS(39)
      GO TO 10011
10010 CONTINUE
      IF (.NOT.(IADE(I).EQ.ICHS(5))) GO TO 10012
      JCRD(1)=ICHS( 4)
      GO TO 10011
10012 CONTINUE
      JCRD(1)=ICHS(50)
10011 CONTINUE
10009 CONTINUE
10008 CONTINUE
      IF (.NOT.(JCRD(1).NE.ICHS(4).AND.JCRD(1).NE.ILCA(3).AND.JCRD(1).NE
     +.ICHS(47).AND.JCRD(1).NE.ICHS(42))) GO TO 10013
      IF (.NOT.(ITBC.NE.ICHS(50))) GO TO 10014
      I=INDEX1(ITBC,JCRD,1,6)
      IF (.NOT.(I.GT.0)) GO TO 10015
      IF (.NOT.(I.LE.5)) GO TO 10016
      DO 10017 J=1,66
      K=73-J
      L=I+67-J
      JCRD(K)=JCRD(L)
10017 CONTINUE
10016 CONTINUE
      CALL XMIT(I-7,ICHS(39),JCRD(I))
10015 CONTINUE
10014 CONTINUE
      IF (.NOT.(ICNC.NE.ICHS(50).AND.JCRD(1).EQ.ICNC)) GO TO 10018
      DO 10019 I=1,67
      J=73-I
      K=68-I
      JCRD(J)=JCRD(K)
10019 CONTINUE
      CALL XMIT(-5,ICHS(39),JCRD(1))
10018 CONTINUE
10013 CONTINUE
      RETURN
      END
      SUBROUTINE REPETE
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CALL CRDOUT
      CALL LABOUT
      CALL NEWNUM(N1)
      CALL STAK(8,N1,0)
      CALL CONTCD(N1)
      NEST=NEST+1
      RETURN
      END
      SUBROUTINE REPL1(IOST,LOST,IRST,LRST)
      CHARACTER*1 IOST(LOST),IRST(LRST)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      IF (ISRS.NE.0) RETURN
      ISRM=MIN(ISRM,LOST)
      IF (.NOT.(ISRL+LOST+LRST+2.GT.6000)) GO TO 10001
      I=1
10002 CONTINUE
      IF (.NOT.(I.LT.ISRL)) GO TO 10003
      J=I+1
      DO 10004 K=1,2
10005 CONTINUE
      IF (.NOT.(ISRC(J).NE.ICHS(50))) GO TO 10006
      J=J+1
      GO TO 10005
10006 CONTINUE
      J=J+1
10004 CONTINUE
      DO 10007 K=1,1023
      IF (ISRP(K).EQ.I) GO TO 101
10007 CONTINUE
      CALL XMIT(ISRL-J+1,ISRC(J),ISRC(I))
      ISRL=ISRL+I-J
      DO 10008 K=1,1023
      IF (ISRP(K).GT.I) ISRP(K)=ISRP(K)+I-J
10008 CONTINUE
      J=I
  101 I=J
      GO TO 10002
10003 CONTINUE
      IF (.NOT.(ISRL+LOST+LRST+2.GT.6000)) GO TO 10009
      CALL ERRM(10)
      ISRS=1
      RETURN
10009 CONTINUE
10001 CONTINUE
      I=ISRL+1
      CALL XMIT(LOST,IOST,ISRC(ISRL+1))
      ISRL=ISRL+LOST+1
      ISRC(ISRL)=ICHS(50)
      CALL XMIT(LRST,IRST,ISRC(ISRL+1))
      ISRL=ISRL+LRST+1
      ISRC(ISRL)=ICHS(50)
      J=0
      DO 10010 K=1,MIN(LOST,4)
      J=100*J+ICHAR(IOST(K))
10010 CONTINUE
      J=1+MOD(J,1023)
      DO 10011 K=1,1023
      IF (.NOT.(ISRP(J).EQ.0)) GO TO 10012
      ISRP(J)=I
      RETURN
10012 CONTINUE
      L=ISRP(J)
      IF (.NOT.(NOTEQ(ISRC(I),ISRC(L),LOST+1).EQ.0)) GO TO 10013
      ISRP(J)=I
      RETURN
10013 CONTINUE
      J=MOD(J,1023)+1
10011 CONTINUE
      CALL ERRM(9)
      ISRS=1
      RETURN
      END
      SUBROUTINE REPL2(ISTR,MSTR,LSTR,IBSS,IESS,NSRD)
      CHARACTER*1 ISTR(MSTR)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      ILST=IESS-ISRM+1
      ISRN=MIN(ISRM,4)
      JEVS=0
      I=IBSS
      IF (.NOT.(ISRT.EQ.0)) GO TO 10001
  101 CONTINUE
10002 CONTINUE
      IF (.NOT.(I.LE.LSTR)) GO TO 10003
      IF (.NOT.(ISTR(I).EQ.IEVS)) GO TO 10004
      IF (.NOT.(JEVS.EQ.0)) GO TO 10005
      JEVS=I
      I=I+1
      GO TO 101
10005 CONTINUE
10004 CONTINUE
      IF (.NOT.(ISTR(I).EQ.IEVT)) GO TO 10006
      IF (.NOT.(JEVS.NE.0)) GO TO 10007
      JEVT=I
      CALL REPL3(ISTR,MSTR,LSTR,JEVS,JEVT,NSRD)
      IESS=IESS+JEVT-I
      ILST=ILST+JEVT-I
      I=JEVT+1
      JEVS=0
      GO TO 101
10007 CONTINUE
10006 CONTINUE
      IF (.NOT.(I.LE.ILST)) GO TO 10008
      LSRN=MIN(IESS-I+1,4)
      DO 10009 JSRN=ISRN,LSRN
      KSRN=ISRN+LSRN-JSRN
      J=0
      DO 10010 K=I,I+KSRN-1
      J=100*J+ICHAR(ISTR(K))
10010 CONTINUE
      J=1+MOD(J,1023)
      LMAX=0
      MMAX=0
      IF (.NOT.(ISRP(J).NE.0)) GO TO 10011
      K=J
10012 CONTINUE
      L=ISRP(K)
      M=I
10013 CONTINUE
      IF (ISRC(L).NE.ISTR(M)) GO TO 10014
      IF (.NOT.(ISRC(L+1).EQ.ICHS(50))) GO TO 10015
      IF (.NOT.(M.GT.MMAX.AND.M-I+1.GE.KSRN)) GO TO 10016
      LMAX=L
      MMAX=M
      GO TO 10014
10016 CONTINUE
10015 CONTINUE
      IF (M.EQ.IESS) GO TO 10014
      L=L+1
      M=M+1
      GO TO 10013
10014 CONTINUE
      K=MOD(K,1023)+1
      IF (.NOT.(K.EQ.J.OR.ISRP(K).EQ.0)) GO TO 10012
      IF (.NOT.(MMAX.NE.0)) GO TO 10017
      L=LMAX
      M=MMAX
      J=L+2
10018 CONTINUE
      IF (ISRC(J).EQ.ICHS(50)) GO TO 10019
      IF (I.LE.M) ISTR(I)=ISRC(J)
      I=I+1
      J=J+1
      GO TO 10018
10019 CONTINUE
      K=I-M-1
      IF (.NOT.(K.LT.0)) GO TO 10020
      CALL XMIT(LSTR-M,ISTR(M+1),ISTR(I))
      LSTR=LSTR+K
      IESS=IESS+K
      ILST=ILST+K
      GO TO 10021
10020 CONTINUE
      IF (.NOT.(K.GT.0)) GO TO 10022
      L=J-K
      IF (.NOT.(LSTR+K.GT.MSTR)) GO TO 10023
      CALL ERRM(32)
      K=MSTR-LSTR
10023 CONTINUE
      J=LSTR
      N=LSTR+K
10024 CONTINUE
      IF (.NOT.(J.GT.M)) GO TO 10025
      ISTR(N)=ISTR(J)
      J=J-1
      N=N-1
      GO TO 10024
10025 CONTINUE
      CALL XMIT(K,ISRC(L),ISTR(M+1))
      LSTR=LSTR+K
      IESS=IESS+K
      ILST=ILST+K
10021 CONTINUE
10022 CONTINUE
      NSRD=NSRD+1
      GO TO 101
10017 CONTINUE
10011 CONTINUE
10009 CONTINUE
10008 CONTINUE
      I=I+1
      GO TO 10002
10003 CONTINUE
      GO TO 10026
10001 CONTINUE
  102 ITKO=0
10027 CONTINUE
      IF (.NOT.(I.LE.LSTR)) GO TO 10028
      IF (.NOT.(ISTR(I).EQ.IEVS)) GO TO 10029
      IF (.NOT.(JEVS.EQ.0)) GO TO 10030
      JEVS=I
      I=I+1
      GO TO 102
10030 CONTINUE
10029 CONTINUE
      IF (.NOT.(ISTR(I).EQ.IEVT)) GO TO 10031
      IF (.NOT.(JEVS.NE.0)) GO TO 10032
      JEVT=I
      CALL REPL3(ISTR,MSTR,LSTR,JEVS,JEVT,NSRD)
      IESS=IESS+JEVT-I
      ILST=ILST+JEVT-I
      I=JEVT+1
      JEVS=0
      GO TO 102
10032 CONTINUE
10031 CONTINUE
      IF (.NOT.(I.LE.ILST)) GO TO 10033
      ITKN=0
      IF ((ISTR(I).GE.ICHS( 2).AND.ISTR(I).LE.ICHS(27)).OR.
     +              (ISTR(I).GE.ILCA( 1).AND.ISTR(I).LE.ILCA(26)).OR.IST
     +R(I).EQ.ICHS( 1))
     +             ITKN=1
      IF (.NOT.(ITKO.EQ.0.AND.ITKN.NE.0)) GO TO 10034
      LSRN=MIN(IESS-I+1,4)
      DO 10035 JSRN=ISRN,LSRN
      KSRN=ISRN+LSRN-JSRN
      J=0
      DO 10036 K=I,I+KSRN-1
      J=100*J+ICHAR(ISTR(K))
10036 CONTINUE
      J=1+MOD(J,1023)
      LMAX=0
      MMAX=0
      IF (.NOT.(ISRP(J).NE.0)) GO TO 10037
      K=J
10038 CONTINUE
      L=ISRP(K)
      M=I
10039 CONTINUE
      IF (ISRC(L).NE.ISTR(M)) GO TO 10040
      IF (.NOT.(ISRC(L+1).EQ.ICHS(50))) GO TO 10041
      IF (.NOT.(M.GT.MMAX.AND.M-I+1.GE.KSRN)) GO TO 10042
      LMAX=L
      MMAX=M
      GO TO 10040
10042 CONTINUE
10041 CONTINUE
      IF (M.EQ.IESS) GO TO 10040
      L=L+1
      M=M+1
      GO TO 10039
10040 CONTINUE
      K=MOD(K,1023)+1
      IF (.NOT.(K.EQ.J.OR.ISRP(K).EQ.0)) GO TO 10038
      IF (.NOT.(MMAX.NE.0)) GO TO 10043
      L=LMAX
      M=MMAX
      J=L+2
10044 CONTINUE
      IF (ISRC(J).EQ.ICHS(50)) GO TO 10045
      IF (I.LE.M) ISTR(I)=ISRC(J)
      I=I+1
      J=J+1
      GO TO 10044
10045 CONTINUE
      K=I-M-1
      IF (.NOT.(K.LT.0)) GO TO 10046
      CALL XMIT(LSTR-M,ISTR(M+1),ISTR(I))
      LSTR=LSTR+K
      IESS=IESS+K
      ILST=ILST+K
      GO TO 10047
10046 CONTINUE
      IF (.NOT.(K.GT.0)) GO TO 10048
      L=J-K
      IF (.NOT.(LSTR+K.GT.MSTR)) GO TO 10049
      CALL ERRM(32)
      K=MSTR-LSTR
10049 CONTINUE
      J=LSTR
      N=LSTR+K
10050 CONTINUE
      IF (.NOT.(J.GT.M)) GO TO 10051
      ISTR(N)=ISTR(J)
      J=J-1
      N=N-1
      GO TO 10050
10051 CONTINUE
      CALL XMIT(K,ISRC(L),ISTR(M+1))
      LSTR=LSTR+K
      IESS=IESS+K
      ILST=ILST+K
10047 CONTINUE
10048 CONTINUE
      NSRD=NSRD+1
      GO TO 102
10043 CONTINUE
10037 CONTINUE
10035 CONTINUE
10034 CONTINUE
10033 CONTINUE
      I=I+1
      ITKO=ITKN
      GO TO 10027
10028 CONTINUE
10026 CONTINUE
      RETURN
      END
      SUBROUTINE REPL3(ISTR,MSTR,LSTR,IBSS,IESS,NSRD)
      CHARACTER*1 ISTR(MSTR)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ITCH
      DIMENSION IOPR(32),IOPS(64),IGTS(16),IOPL(20),            KOPR(9)
      CHARACTER*1 LOPR(9,5),LOPS(16,7),INCH(12)
      DATA IOPL / 0,1,2*2,2*3,6*5,6,7,8,9,10,11,12,13 /
      DATA (LOPR(1,J),J=1,5),KOPR(1) / '.' , 'A' , 'N' , 'D' , '.', 14 /
      DATA (LOPR(2,J),J=1,5),KOPR(2) / '.' , 'E' , 'Q' , '.' , ' ', 11 /
      DATA (LOPR(3,J),J=1,5),KOPR(3) / '.' , 'G' , 'E' , '.' , ' ', 10 /
      DATA (LOPR(4,J),J=1,5),KOPR(4) / '.' , 'G' , 'T' , '.' , ' ',  9 /
      DATA (LOPR(5,J),J=1,5),KOPR(5) / '.' , 'L' , 'E' , '.' , ' ',  8 /
      DATA (LOPR(6,J),J=1,5),KOPR(6) / '.' , 'L' , 'T' , '.' , ' ',  7 /
      DATA (LOPR(7,J),J=1,5),KOPR(7) / '.' , 'N' , 'E' , '.' , ' ', 12 /
      DATA (LOPR(8,J),J=1,5),KOPR(8) / '.' , 'O' , 'R' , '.' , ' ', 16 /
      DATA (LOPR(9,J),J=1,5),KOPR(9) / '.' , 'X' , 'O' , 'R' , '.', 15 /
      DATA (LOPS( 1,J),J=1,7) / 'A' , 'B' , 'S' , '(' , ' ' , ' ' , ' '/
      DATA (LOPS( 2,J),J=1,7) / 'A' , 'N' , 'D' , '(' , ' ' , ' ' , ' '/
      DATA (LOPS( 3,J),J=1,7) / 'M' , 'A' , 'S' , 'K' , '(' , ' ' , ' '/
      DATA (LOPS( 4,J),J=1,7) / 'M' , 'A' , 'X' , '(' , ' ' , ' ' , ' '/
      DATA (LOPS( 5,J),J=1,7) / 'M' , 'I' , 'N' , '(' , ' ' , ' ' , ' '/
      DATA (LOPS( 6,J),J=1,7) / 'M' , 'O' , 'D' , '(' , ' ' , ' ' , ' '/
      DATA (LOPS( 7,J),J=1,7) / 'N' , 'O' , 'T' , '(' , ' ' , ' ' , ' '/
      DATA (LOPS( 8,J),J=1,7) / 'O' , 'R' , '(' , ' ' , ' ' , ' ' , ' '/
      DATA (LOPS( 9,J),J=1,7) / 'S' , 'H' , 'I' , 'F' , 'T' , '(' , ' '/
      DATA (LOPS(10,J),J=1,7) / 'S' , 'I' , 'G' , 'N' , '(' , ' ' , ' '/
      DATA (LOPS(11,J),J=1,7) / 'X' , 'O' , 'R' , '(' , ' ' , ' ' , ' '/
      DATA (LOPS(12,J),J=1,7) / '.' , 'F' , 'A' , 'L' , 'S' , 'E' , '.'/
      DATA (LOPS(13,J),J=1,7) / '.' , 'F' , '.' , ' ' , ' ' , ' ' , ' '/
      DATA (LOPS(14,J),J=1,7) / '.' , 'N' , 'O' , 'T' , '.' , ' ' , ' '/
      DATA (LOPS(15,J),J=1,7) / '.' , 'T' , 'R' , 'U' , 'E' , '.' , ' '/
      DATA (LOPS(16,J),J=1,7) / '.' , 'T' , '.' , ' ' , ' ' , ' ' , ' '/
      NOPR=0
      NOPS=0
      NGTS=0
      I=IBSS
      IOOO=0
10001 CONTINUE
      IF (.NOT.(I.LE.IESS)) GO TO 10002
      IF (.NOT.(ISTR(I).NE.ICHS(39))) GO TO 10003
      IF (.NOT.(IOOO.EQ.0)) GO TO 10004
      IF (.NOT.(ISTR(I).NE.ICHS(40))) GO TO 10005
      IF (.NOT.(ISTR(I).EQ.ICHS(41))) GO TO 10006
      JOPR=2
      L10008=    1
      GO TO 10008
10007 CONTINUE
      GO TO 10009
10006 CONTINUE
      IF (.NOT.(ISTR(I).EQ.ICHS(44).OR.ISTR(I).EQ.IEVS)) GO TO 10010
      JGTS=0
      L10012=    1
      GO TO 10012
10011 CONTINUE
      JOPR=19
      L10008=    2
      GO TO 10008
10013 CONTINUE
      GO TO 10009
10010 CONTINUE
      IF (.NOT.(ISTR(I).GE.ICHS(28).AND.ISTR(I).LE.ICHS(37)))
     +GO TO 10014
      CALL CVINT(JOPS,KSTP,ISTR,I,IESS)
      L10016=    1
      GO TO 10016
10015 CONTINUE
      I=I-1
      GO TO 10009
10014 CONTINUE
      INDL=1
      INDH=16
      MTCH=1
10017 CONTINUE
      ITCH=ISTR(I)
      IF (.NOT.(ITCH.GE.ILCA(1).AND.ITCH.LE.ILCA(26))) GO TO 10018
      ITCH=CHAR(ICHAR(ICHS( 2))+ICHAR(ITCH)-ICHAR(ILCA( 1)))
10018 CONTINUE
      INDL=INDEX1(ITCH,LOPS(1,MTCH),INDL,INDH)
      IF (.NOT.(INDL.EQ.0)) GO TO 10019
      GO TO 10021
10019 CONTINUE
10022 CONTINUE
      IF (.NOT.(ITCH.NE.LOPS(INDH,MTCH))) GO TO 10023
      INDH=INDH-1
      GO TO 10022
10023 CONTINUE
      MTCH=MTCH+1
      IF (MTCH.EQ.8.OR.LOPS(INDL,MTCH).EQ.ICHS(39)) GO TO 10024
      I=NINDX1(ICHS(39),ISTR,I+1,IESS)
      IF (.NOT.(I.EQ.0)) GO TO 10025
      GO TO 10021
10025 CONTINUE
      GO TO 10017
10024 CONTINUE
      IF (.NOT.(INDL.LE.11)) GO TO 10027
      JGTS=INDL*1000
      L10012=    2
      GO TO 10012
10028 CONTINUE
      JOPR=19
      L10008=    3
      GO TO 10008
10029 CONTINUE
      GO TO 10030
10027 CONTINUE
      IF (.NOT.(INDL.EQ.12.OR.INDL.EQ.13)) GO TO 10031
      JOPS=0
      L10016=    2
      GO TO 10016
10032 CONTINUE
      GO TO 10030
10031 CONTINUE
      IF (.NOT.(INDL.EQ.14)) GO TO 10033
      JOPR=13
      L10008=    4
      GO TO 10008
10034 CONTINUE
      GO TO 10030
10033 CONTINUE
      JOPS=1
      L10016=    3
      GO TO 10016
10035 CONTINUE
10030 CONTINUE
10009 CONTINUE
10005 CONTINUE
      GO TO 10036
10004 CONTINUE
      IF (.NOT.(ISTR(I).EQ.ICHS(42))) GO TO 10037
      J=NINDX1(ICHS(39),ISTR,I+1,IESS)
      IF (.NOT.(J.NE.0.AND.ISTR(J).EQ.ICHS(42))) GO TO 10038
      I=J
      JOPR=1
      GO TO 10039
10038 CONTINUE
      JOPR=3
10039 CONTINUE
      GO TO 10040
10037 CONTINUE
      IF (.NOT.(ISTR(I).EQ.ICHS(43))) GO TO 10041
      JOPR=4
      GO TO 10040
10041 CONTINUE
      IF (.NOT.(ISTR(I).EQ.ICHS(40))) GO TO 10042
      JOPR=5
      GO TO 10040
10042 CONTINUE
      IF (.NOT.(ISTR(I).EQ.ICHS(41))) GO TO 10043
      JOPR=6
      GO TO 10040
10043 CONTINUE
      IF (.NOT.(ISTR(I).EQ.ICHS(38))) GO TO 10044
      IF (.NOT.(NGTS.EQ.0.OR.IGTS(NGTS).EQ.0)) GO TO 10045
      GO TO 10021
10045 CONTINUE
      JOPR=17
      GO TO 10040
10044 CONTINUE
      IF (.NOT.(ISTR(I).EQ.ICHS(45).OR.ISTR(I).EQ.IEVT)) GO TO 10047
      IF (.NOT.(NGTS.EQ.0)) GO TO 10048
      GO TO 10021
10048 CONTINUE
      JOPR=20
      GO TO 10040
10047 CONTINUE
      INDL=1
      INDH=9
      MTCH=1
10050 CONTINUE
      ITCH=ISTR(I)
      IF (.NOT.(ITCH.GE.ILCA(1).AND.ITCH.LE.ILCA(26))) GO TO 10051
      ITCH=CHAR(ICHAR(ICHS( 2))+ICHAR(ITCH)-ICHAR(ILCA( 1)))
10051 CONTINUE
      INDL=INDEX1(ITCH,LOPR(1,MTCH),INDL,INDH)
      IF (.NOT.(INDL.EQ.0)) GO TO 10052
      GO TO 10021
10052 CONTINUE
10054 CONTINUE
      IF (.NOT.(ITCH.NE.LOPR(INDH,MTCH))) GO TO 10055
      INDH=INDH-1
      GO TO 10054
10055 CONTINUE
      MTCH=MTCH+1
      IF (MTCH.EQ.6.OR.LOPR(INDL,MTCH).EQ.ICHS(39)) GO TO 10056
      I=NINDX1(ICHS(39),ISTR,I+1,IESS)
      IF (.NOT.(I.EQ.0)) GO TO 10057
      GO TO 10021
10057 CONTINUE
      GO TO 10050
10056 CONTINUE
      JOPR=KOPR(INDL)
10040 CONTINUE
      L10060=    1
      GO TO 10060
10059 CONTINUE
      IF (.NOT.(JOPR.NE.20)) GO TO 10061
      L10008=    5
      GO TO 10008
10062 CONTINUE
10061 CONTINUE
10036 CONTINUE
10003 CONTINUE
      I=I+1
      GO TO 10001
10002 CONTINUE
      JOPR=18
      L10060=    2
      GO TO 10060
10063 CONTINUE
      IF (.NOT.(NOPR.NE.0.OR.NOPS.NE.1.OR.NGTS.NE.0)) GO TO 10064
      GO TO 10021
10064 CONTINUE
      CALL CVD(ABS(IOPS(1)),INCH,12)
      I=NINDX1(ICHS(39),INCH,1,12)
      J=IBSS
      IF (.NOT.(IOPS(1).LT.0)) GO TO 10066
      ISTR(J)=ICHS(41)
      J=J+1
10066 CONTINUE
      IF (.NOT.(J+13-I+LSTR-IESS.GT.MSTR)) GO TO 10067
      GO TO 10021
10067 CONTINUE
      K=MIN(13-I,IESS+1-J)
      CALL XMIT(K,INCH(I),ISTR(J))
      I=I+K
      J=J+K
      K=IESS+1-J
      IF (.NOT.(K.EQ.0)) GO TO 10069
      K=13-I
      IF (.NOT.(K.NE.0)) GO TO 10070
      L=LSTR+K
      M=LSTR
10071 CONTINUE
      IF (.NOT.(M.GE.IESS+1)) GO TO 10072
      ISTR(L)=ISTR(M)
      L=L-1
      M=M-1
      GO TO 10071
10072 CONTINUE
      LSTR=LSTR+K
      IESS=IESS+K
      CALL XMIT(K,INCH(I),ISTR(J))
10070 CONTINUE
      GO TO 10073
10069 CONTINUE
      CALL XMIT(LSTR-IESS,ISTR(IESS+1),ISTR(J))
      LSTR=LSTR-K
      IESS=IESS-K
10073 CONTINUE
      NSRD=NSRD+1
      RETURN
10008 CONTINUE
      NOPR=NOPR+1
      IF (.NOT.(NOPR.GT.32)) GO TO 10074
      GO TO 10021
10074 CONTINUE
      IOPR(NOPR)=JOPR
      IOOO=0
      GO TO (10007,10013,10029,10034,10062) , L10008
10016 CONTINUE
      NOPS=NOPS+1
      IF (.NOT.(NOPS.GT.64)) GO TO 10076
      GO TO 10021
10076 CONTINUE
      IOPS(NOPS)=JOPS
      IOOO=1
      GO TO (10015,10032,10035) , L10016
10012 CONTINUE
      NGTS=NGTS+1
      IF (.NOT.(NGTS.GT.16)) GO TO 10078
      GO TO 10021
10078 CONTINUE
      IGTS(NGTS)=JGTS
      GO TO (10011,10028) , L10012
10060 CONTINUE
      JOPL=IOPL(JOPR)
10080 CONTINUE
      IF (NOPR.EQ.0) GO TO 10081
      MOPR=IOPR(NOPR)
      IF (IOPL(MOPR).GT.JOPL) GO TO 10081
      GO TO (101,102,103,104,105,106,107,108,109,110,
     +       111,112,113,114,115,116,117,118,119,120) , MOPR
  101 CONTINUE
      IF (.NOT.(IOPS(NOPS).LT.0.OR.(IOPS(NOPS-1).EQ.0.AND.IOPS(NOPS).EQ.
     +0))) GO TO 10082
      GO TO 10021
10082 CONTINUE
      IOPS(NOPS-1)=IOPS(NOPS-1)**IOPS(NOPS)
      GO TO 198
  102 IOPS(NOPS)=-IOPS(NOPS)
      GO TO 199
  103 IOPS(NOPS-1)=IOPS(NOPS-1)*IOPS(NOPS)
      GO TO 198
  104 IOPS(NOPS-1)=IOPS(NOPS-1)/IOPS(NOPS)
      GO TO 198
  105 IOPS(NOPS-1)=IOPS(NOPS-1)+IOPS(NOPS)
      GO TO 198
  106 IOPS(NOPS-1)=IOPS(NOPS-1)-IOPS(NOPS)
      GO TO 198
  107 CONTINUE
      IF (.NOT.(IOPS(NOPS-1).LT.IOPS(NOPS))) GO TO 10084
      IOPS(NOPS-1)=1
      GO TO 10085
10084 CONTINUE
      IOPS(NOPS-1)=0
10085 CONTINUE
      GO TO 198
  108 CONTINUE
      IF (.NOT.(IOPS(NOPS-1).LE.IOPS(NOPS))) GO TO 10086
      IOPS(NOPS-1)=1
      GO TO 10087
10086 CONTINUE
      IOPS(NOPS-1)=0
10087 CONTINUE
      GO TO 198
  109 CONTINUE
      IF (.NOT.(IOPS(NOPS-1).GT.IOPS(NOPS))) GO TO 10088
      IOPS(NOPS-1)=1
      GO TO 10089
10088 CONTINUE
      IOPS(NOPS-1)=0
10089 CONTINUE
      GO TO 198
  110 CONTINUE
      IF (.NOT.(IOPS(NOPS-1).GE.IOPS(NOPS))) GO TO 10090
      IOPS(NOPS-1)=1
      GO TO 10091
10090 CONTINUE
      IOPS(NOPS-1)=0
10091 CONTINUE
      GO TO 198
  111 CONTINUE
      IF (.NOT.(IOPS(NOPS-1).EQ.IOPS(NOPS))) GO TO 10092
      IOPS(NOPS-1)=1
      GO TO 10093
10092 CONTINUE
      IOPS(NOPS-1)=0
10093 CONTINUE
      GO TO 198
  112 CONTINUE
      IF (.NOT.(IOPS(NOPS-1).NE.IOPS(NOPS))) GO TO 10094
      IOPS(NOPS-1)=1
      GO TO 10095
10094 CONTINUE
      IOPS(NOPS-1)=0
10095 CONTINUE
      GO TO 198
  113 IOPS(NOPS)=1-IOPS(NOPS)
      GO TO 199
  114 IOPS(NOPS-1)=IOPS(NOPS-1)*IOPS(NOPS)
      GO TO 198
  115 IOPS(NOPS-1)=MOD(IOPS(NOPS-1)+IOPS(NOPS),2)
      GO TO 198
  116 IOPS(NOPS-1)=IOPS(NOPS-1)+IOPS(NOPS)-IOPS(NOPS-1)*IOPS(NOPS)
      GO TO 198
  117 IGTS(NGTS)=IGTS(NGTS)+1
      GO TO 199
  118 CONTINUE
      GO TO 10021
  119 CONTINUE
      IF (.NOT.(NGTS.LE.0)) GO TO 10097
      GO TO 10021
10097 CONTINUE
      IF (.NOT.(IGTS(NGTS).NE.0)) GO TO 10099
      NFUN=IGTS(NGTS)/1000
      NAM1=MOD(IGTS(NGTS),1000)
      GO TO (201,202,203,204,205,206,207,208,209,210,211) , NFUN
  201 CONTINUE
      IF (.NOT.(NAM1.NE.0)) GO TO 10100
      GO TO 10021
10100 CONTINUE
      IOPS(NOPS)=ABS(IOPS(NOPS))
      GO TO 299
  202 CONTINUE
      GO TO 10021
  203 CONTINUE
      IF (.NOT.(NAM1.NE.0)) GO TO 10103
      GO TO 10021
10103 CONTINUE
      GO TO 10021
  204 CONTINUE
      IF (.NOT.(NAM1.NE.0)) GO TO 10106
      DO 10107 IARG=1,NAM1
      IOPS(NOPS-1)=MAX(IOPS(NOPS-1),IOPS(NOPS))
      NOPS=NOPS-1
10107 CONTINUE
10106 CONTINUE
      GO TO 299
  205 CONTINUE
      IF (.NOT.(NAM1.NE.0)) GO TO 10108
      DO 10109 IARG=1,NAM1
      IOPS(NOPS-1)=MIN(IOPS(NOPS-1),IOPS(NOPS))
      NOPS=NOPS-1
10109 CONTINUE
10108 CONTINUE
      GO TO 299
  206 CONTINUE
      IF (.NOT.(NAM1.NE.1)) GO TO 10110
      GO TO 10021
10110 CONTINUE
      IOPS(NOPS-1)=MOD(IOPS(NOPS-1),IOPS(NOPS))
      GO TO 298
  207 CONTINUE
      IF (.NOT.(NAM1.NE.0)) GO TO 10112
      GO TO 10021
10112 CONTINUE
      GO TO 10021
  208 CONTINUE
      GO TO 10021
  209 CONTINUE
      IF (.NOT.(NAM1.NE.1)) GO TO 10116
      GO TO 10021
10116 CONTINUE
      GO TO 10021
  210 CONTINUE
      IF (.NOT.(NAM1.NE.1)) GO TO 10119
      GO TO 10021
10119 CONTINUE
      IOPS(NOPS-1)=SIGN(IOPS(NOPS-1),IOPS(NOPS))
      GO TO 298
  211 CONTINUE
      GO TO 10021
  298 NOPS=NOPS-NAM1
10099 CONTINUE
  299 NGTS=NGTS-1
      JOPL=0
      GO TO 199
  120 CONTINUE
      GO TO 10021
  198 NOPS=NOPS-1
  199 NOPR=NOPR-1
      GO TO 10080
10081 CONTINUE
      GO TO (10059,10063) , L10060
10021 CONTINUE
      CALL ERRM(33)
      RETURN
      END
      SUBROUTINE SAVUSE(ISUB,KSVE)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      ICR1=ICRL+1
      IF (ICR1+LNCD.GT.1701) ICR1=1
      ICR2=ICR1+LNCD
      IF (.NOT.(ICR1.LE.ICRI.AND.ICR2.GE.ICRI)) GO TO 10001
      CALL ERRM(7)
      KSVE=-1
      RETURN
10001 CONTINUE
      GO TO (101,102) , ISUB
  101 IF (ISVN.LE.0) CALL IFTRIO(3,ISAV,ICRD,0,0)
10002 CONTINUE
      IF (.NOT.(ISVI.LT.ISVN)) GO TO 10003
      CALL IFTRIO(1,ISAV,ICRD(ICR1),LNCD+1,IEOF)
      IF (.NOT.(IEOF.NE.0)) GO TO 10004
      CALL ERRM(12)
      KSVE=-1
      RETURN
10004 CONTINUE
      IF (ICRD(ICR2).EQ.ICHS( 6)) ISVI=ISVI+1
      GO TO 10002
10003 CONTINUE
      I=MIN(ISTB-ISTC+1,LNCD)
      CALL XMIT(I,ISTA(ISTC),ICRD(ICR1))
      I=ICR1+I
      CALL XMIT(I-ICR2,ICHS(39),ICRD(I))
      ICRD(ICR2)=ICHS(20)
      CALL IFTRIO(2,ISAV,ICRD(ICR1),LNCD+1,0)
      IF (ICRK.NE.(-1)) ICRD(ICRK)=ICRD(ICRL)
      ICRD(ICRL)=ICHS(39)
10005 CONTINUE
      IF (.NOT.(ICRK.EQ.(-1))) GO TO 10006
      KSVE=-1
      CALL ERRM(13)
      RETURN
10006 CONTINUE
      IF (.NOT.(ICRD(ICRK).EQ.ICHS(4).OR.ICRD(ICRK).EQ.ILCA(3).OR.ICRD(I
     +CRK).EQ.ICHS(47).OR.ICRD(ICRK).EQ.ICHS(42))) GO TO 10007
      IF (.NOT.((ICRD(ICRK+1).EQ.ICHS(6).OR.ICRD(ICRK+1).EQ.ILCA(5)).AND
     +.(ICRD(ICRK+2).EQ.ICHS(15).OR.ICRD(ICRK+2).EQ.ILCA(14)).AND.ICRD(I
     +CRK+4).NE.ICHS(10).AND.ICRD(ICRK+4).NE.ILCA(9))) GO TO 10008
      ICRD(ICRL)=ICHS( 6)
10008 CONTINUE
10007 CONTINUE
      CALL IFTRIO(2,ISAV,ICRD(ICRK),LNCD+1,0)
      IF (ICRD(ICRL).EQ.ICHS(6)) GO TO 10009
      CALL RDCRD(ICRD(ICRK),IEOF,0)
      IF (.NOT.(IEOF.NE.0)) GO TO 10010
      ICRK=-1
      ICRL=ICRJ
10010 CONTINUE
      GO TO 10005
10009 CONTINUE
      ICRK=0
      ICRL=ICRJ
      ISVN=ISVN+1
      ISVI=ISVN
      KSVE=0
      RETURN
  102 LENC=INDEX1(ICHS(38),ISTA(ISTC),1,ISTB-ISTC)-1
      IF (.NOT.(LENC.GT.0)) GO TO 10011
      LENC=LSTNB(ISTA(ISTC),1,LENC)
      GO TO 10012
10011 CONTINUE
      LENC=ISTB-ISTC
10012 CONTINUE
      LENC=MIN(LENC,LNCD)
      INUL=ICR1+LENC
      IF (.NOT.(LENC.EQ.0)) GO TO 10013
      CALL ERRM(17)
      KSVE=-1
      RETURN
10013 CONTINUE
      I = 1
      GO TO 10016
10014 CONTINUE
      I =I +1
10016 CONTINUE
      IF (I .GT.(ISVN)) GO TO 10015
      IF (.NOT.(ISVI.GE.ISVN)) GO TO 10017
      CALL IFTRIO(3,ISAV,ICRD,0,0)
      ISVI=0
10017 CONTINUE
10018 CONTINUE
      CALL IFTRIO(1,ISAV,ICRD(ICR1),LNCD+1,IEOF)
      IF (.NOT.(IEOF.NE.0)) GO TO 10019
      CALL ERRM(12)
      KSVE=-1
      RETURN
10019 CONTINUE
      IF (.NOT.(ICRD(ICR2).EQ.ICHS(20))) GO TO 10018
      ISVI=ISVI+1
      IF (.NOT.(NOTEQ(ISTA(ISTC),ICRD(ICR1),LENC).EQ.0)) GO TO 10020
      IF (.NOT.(LENC.EQ.LNCD.OR.ICRD(INUL).EQ.ICHS(50))) GO TO 10021
      KSVE=0
      RETURN
10021 CONTINUE
10020 CONTINUE
      GO TO 10014
10015 CONTINUE
      KSVE=-1
      CALL IFTRIO(3,ISAV,ICRD,0,0)
      ISVI=0
      RETURN
      END
      SUBROUTINE SETOPT
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ITC1,ITC2
      CHARACTER*1 ICHV
      INTEGER IINV
      LOGICAL ILOV
      CHARACTER*1 IKWD(2,28)
      DATA (IKWD(I, 1),I=1,2) / 'B' , 'I' /
      DATA (IKWD(I, 2),I=1,2) / 'C' , 'B' /
      DATA (IKWD(I, 3),I=1,2) / 'C' , 'C' /
      DATA (IKWD(I, 4),I=1,2) / 'D' , 'S' /
      DATA (IKWD(I, 5),I=1,2) / 'E' , 'S' /
      DATA (IKWD(I, 6),I=1,2) / 'E' , 'T' /
      DATA (IKWD(I, 7),I=1,2) / 'I' , 'F' /
      DATA (IKWD(I, 8),I=1,2) / 'I' , 'L' /
      DATA (IKWD(I, 9),I=1,2) / 'K' , 'W' /
      DATA (IKWD(I,10),I=1,2) / 'L' , 'I' /
      DATA (IKWD(I,11),I=1,2) / 'L' , 'R' /
      DATA (IKWD(I,12),I=1,2) / 'L' , 'S' /
      DATA (IKWD(I,13),I=1,2) / 'O' , 'C' /
      DATA (IKWD(I,14),I=1,2) / 'O' , 'F' /
      DATA (IKWD(I,15),I=1,2) / 'O' , 'I' /
      DATA (IKWD(I,16),I=1,2) / 'O' , 'N' /
      DATA (IKWD(I,17),I=1,2) / 'O' , 'S' /
      DATA (IKWD(I,18),I=1,2) / 'P' , 'C' /
      DATA (IKWD(I,19),I=1,2) / 'P' , 'F' /
      DATA (IKWD(I,20),I=1,2) / 'P' , 'I' /
      DATA (IKWD(I,21),I=1,2) / 'P' , 'N' /
      DATA (IKWD(I,22),I=1,2) / 'P' , 'R' /
      DATA (IKWD(I,23),I=1,2) / 'P' , 'S' /
      DATA (IKWD(I,24),I=1,2) / 'R' , 'S' /
      DATA (IKWD(I,25),I=1,2) / 'R' , 'T' /
      DATA (IKWD(I,26),I=1,2) / 'T' , 'C' /
      DATA (IKWD(I,27),I=1,2) / 'U' , 'C' /
      DATA (IKWD(I,28),I=1,2) / 'X' , 'C' /
10001 CONTINUE
      DO 10002 J=1,28
      ITC1=ISTA(ISTC)
      IF (.NOT.(ITC1.GE.ILCA(1).AND.ITC1.LE.ILCA(26))) GO TO 10003
      ITC1=CHAR(ICHAR(ICHS( 2))+ICHAR(ITC1)-ICHAR(ILCA( 1)))
10003 CONTINUE
      ITC2=ISTA(ISTC+1)
      IF (.NOT.(ITC2.GE.ILCA(1).AND.ITC2.LE.ILCA(26))) GO TO 10004
      ITC2=CHAR(ICHAR(ICHS( 2))+ICHAR(ITC2)-ICHAR(ILCA( 1)))
10004 CONTINUE
      IF (.NOT.(ITC1.EQ.IKWD(1,J).AND.ITC2.EQ.IKWD(2,J))) GO TO 10005
      NKWD=J
      ISTC=NINDX1(ICHS(39),ISTA,ISTC+2,ISTB)
      IF (.NOT.(ISTA(ISTC).NE.ICHS(46))) GO TO 10006
      ICHV=ICHS(50)
      IINV=1
      ILOV=.TRUE.
      GO TO 10007
10006 CONTINUE
      ISTC=NINDX1(ICHS(39),ISTA,ISTC+1,ISTB)
      IF (ISTA(ISTC).EQ.ICHS(50)) GO TO 198
      ICHV=ISTA(ISTC)
      IINV=0
      ILOV=.FALSE.
      IF (.NOT.(ISTA(ISTC).EQ.ICHS(41))) GO TO 10008
      ISTC=ISTC+1
      CALL CVINT(IINV,KSTP,ISTA,ISTC,ISTB)
      IINV=-IINV
      IF (IINV.NE.0) ILOV=.TRUE.
      GO TO 10009
10008 CONTINUE
      IF (.NOT.(ISTA(ISTC).GE.ICHS(28).AND.ISTA(ISTC).LE.ICHS(37)))
     +GO TO 10010
      CALL CVINT(IINV,KSTP,ISTA,ISTC,ISTB)
      IF (IINV.NE.0) ILOV=.TRUE.
      GO TO 10009
10010 CONTINUE
      IF (.NOT.(ISTA(ISTC).EQ.ICHS(21).OR.ISTA(ISTC).EQ.ILCA(20)))
     +GO TO 10011
      ISTC=NINDX1(ICHS(39),ISTA,ISTC+1,ISTB)
      IINV=1
      ILOV=.TRUE.
      GO TO 10009
10011 CONTINUE
      ISTC=NINDX1(ICHS(39),ISTA,ISTC+1,ISTB)
10009 CONTINUE
10007 CONTINUE
      GO TO (101,102,103,104,105,106,107,108,109,110,
     +       111,112,113,114,115,116,117,118,119,120,
     +       121,122,123,124,125,126,127,128        ) , NKWD
  101 CONTINUE
      IF (.NOT.(NEST.EQ.0)) GO TO 10012
      IBIT=IINV
      IF (IBIT.EQ.6.OR.IBIT.EQ.66) IBIT=0
10012 CONTINUE
  102 ICUB=IINV
      GO TO 199
  103 ICNC=ICHV
      GO TO 199
  104 DSOK=ILOV
      GO TO 199
  105 IEVS=ICHV
      IF (IEVT.EQ.ICHS(50)) IEVT=IEVS
      GO TO 199
  106 IEVT=ICHV
      GO TO 199
  107 IFIN=IINV
      GO TO 199
  108 NDNT=IINV
      GO TO 199
  109 KWOK=ILOV
      GO TO 199
  110 IGND=IINV
      GO TO 199
  111 ICRB=IINV
      GO TO 199
  112 IGNI=IINV
      IGNN=IINV
      GO TO 199
  113 IFOC=IINV
      GO TO 199
  114 IFOF=IINV
      GO TO 199
  115 IFOI=IINV
      GO TO 199
  116 IFON=IINV
      GO TO 199
  117 IFOS=IINV
      GO TO 199
  118 IPOC=IINV
      GO TO 199
  119 IPOF=IINV
      GO TO 199
  120 IPOI=IINV
      GO TO 199
  121 IPON=IINV
      GO TO 199
  122 CONTINUE
      IF (.NOT.(ILOV)) GO TO 10013
      IOUT=IOTX
      GO TO 10014
10013 CONTINUE
      IOUT=0
10014 CONTINUE
      GO TO 199
  123 IPOS=IINV
      GO TO 199
  124 ISRA=ILOV
      ISRX=ILOV
      GO TO 199
  125 ISRT=IINV
      GO TO 199
  126 ITBC=ICHV
      GO TO 199
  127 IUCF=IINV
      GO TO 199
  128 IXCC=ICHV
      GO TO 199
10005 CONTINUE
10002 CONTINUE
  198 CALL ERRM(27)
      ISTC=ISTC+1
      IF (ISTC.GE.ISTB) GO TO 10015
  199 ISTC=NINDX1(ICHS(39),ISTA,ISTC,ISTB)
      IF (ISTC.GE.ISTB) GO TO 10015
      IF (ISTA(ISTC).EQ.ICHS(38)) ISTC=NINDX1(ICHS(39),ISTA,ISTC+1,ISTB)
      GO TO 10001
10015 CONTINUE
      RETURN
      END
      SUBROUTINE SPCOUT(NLNS)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CHARACTER*1 ISKP(2)
      DATA ISKP / ' ' , ' ' /
      IF (.NOT.(IOUT.NE.0)) GO TO 10001
      NLNX=NLNX-NLNS
      IF (.NOT.(NLNX.LT.0)) GO TO 10002
      IF (.NOT.(NCLO.LE.1)) GO TO 10003
      CALL TYPHED(IHDR(2),NERR)
      NPGE=0
      DBLS=.FALSE.
      PTYP=ITYP
10003 CONTINUE
      NPGE=NPGE+1
      CALL CVD(NPGE,IHDR(111),5)
      CALL IFTRIO(2,IOUT,IHDR,115,0)
      CALL IFTRIO(2,IOUT,ISKP,2,0)
      NLNX=NLNE-NLNS
10002 CONTINUE
10001 CONTINUE
      END
      SUBROUTINE STAK(N0,N1,N2)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      IF (N0.LT.0) RETURN
      ISTL=ISTL+3
      IF (.NOT.(ISTL.GT.96)) GO TO 10001
      CALL ERRM(30)
      CALL NGEXIT(NERR)
      STOP
10001 CONTINUE
      ISTK(ISTL-2)=N0
      ISTK(ISTL-1)=N1
      ISTK(ISTL  )=N2
      RETURN
      END
      SUBROUTINE STAKFI(N0,N1,N2,N3)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      ISTP=ISTL-2
      N3=1
10001 CONTINUE
      IF (.NOT.(ISTP.GT.0)) GO TO 10002
      IF (.NOT.(N0.EQ.ISTK(ISTP))) GO TO 10003
      N1=ISTK(ISTP+1)
      N2=ISTK(ISTP+2)
      RETURN
10003 CONTINUE
      ISTP=ISTP-3
      N3=N3+1
      GO TO 10001
10002 CONTINUE
      N1=0
      N2=0
      N3=0
      RETURN
      END
      SUBROUTINE TYPERR(NMSG,IMSG,LMSG)
      CHARACTER*1 IMSG(LMSG)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      IF (.NOT.(ISUM.NE.0)) GO TO 10001
      WRITE(0,1001) NMSG,(IMSG(I),I=2,LMSG)
      WRITE(0,1002) (IHDR(I),I=29,81)
      ITMP=ICRI+52
      WRITE(0,1003) NCTO,NCLO,(ICRD(I),I=ICRI,ITMP)
10001 CONTINUE
      RETURN
 1001 FORMAT ('ERROR MESSAGE NUMBER',I3,' - ',53A1)
 1002 FORMAT ('FIRST CARD OF ROUTINE   - '   ,53A1)
 1003 FORMAT ('CARD',I5,' - ',I5,' LOCAL - ' ,53A1)
      END
      SUBROUTINE TYPHED(HEAD,NERR)
      CHARACTER*1 HEAD(1)
      RETURN
      END
      SUBROUTINE UNSTAK(N0,N1,N2)
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      IF (.NOT.(ISTL.LE.0)) GO TO 10001
      N0=-1
      GO TO 10002
10001 CONTINUE
      N0=ISTK(ISTL-2)
      N1=ISTK(ISTL-1)
      N2=ISTK(ISTL  )
      ISTL=ISTL-3
10002 CONTINUE
      RETURN
      END
      SUBROUTINE UNTIL
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      NEST=NEST-1
      CALL CRDOUT
      CALL LABOUT
      CALL UNSTAK(N0,N1,N2)
      IF (.NOT.(N0.EQ.8)) GO TO 10001
      CALL IFNOT(ISTA,ISTD,ISTE,N1)
      GO TO 10002
10001 CONTINUE
      CALL ERRM(19)
      CALL STAK(N0,N1,N2)
      NEST=NEST+1
10002 CONTINUE
      RETURN
      END
      SUBROUTINE WHILE
      COMMON /IFTCM1/ DBLS,DSOK,IBIT,ICRB,ICRI,ICRJ,ICRK,ICRL,ICUB,IFIN,
     +                IFOC,IFOF,IFOI,IFON,IFOS,IFVA(16),IFVI,IGND,
     +          IGNI,IGNN,IINP,INCL,INCP,INCU,IOCC,IOCP,IOTC,IOTX,
     +          IOUT,IPOC,IPOF,IPOI,IPON,IPOS,ISAV,ISGT,ISRA,ISRL,
     +          ISRM,ISRP(1023),ISRS,ISRT,ISRX,ISTB,ISTC,ISTD,
     +      ISTE,ISTF,ISTK(96),ISTL,ISTS,ISUM,ISVI,ISVN,
     +ITYQ,IUAF,IUCF,KWOK,LNCD,NABT,NAMI(500),NAMP,                NAMQ,
     +NAMR,NCLI,NCLO,NCTO,NDNT,NERR,NEST,NLNE,NLNX,                NPGE
      COMMON /IFTCM2/ IADE(26),IBUF(80),ICHS(50),ICNC,ICRD(1701),
     +            IEVS,IEVT,IHDR(115),ILCA(26),INSB(81),
     +            ISRC(6000),ISTA(1327),ITBC,ITYP,IUSB(81),
     +    IXCC,NAMC(1000),PTYP
      CHARACTER*1     IADE,IBUF,ICHS,ICNC,ICRD,IEVS,IEVT,IHDR,ILCA,INSB,
     +                ISRC,ISTA,ITBC,ITYP,IUSB,IXCC,NAMC,PTYP
      LOGICAL         DBLS,DSOK,IOCC,ISRA,ISRX,KWOK
      CALL CRDOUT
      CALL LABOUT
      CALL NEWNUM(N1)
      CALL NEWNUM(N2)
      CALL STAK(4,N1,N2)
      CALL CONTCD(N1)
      CALL IFNOT(ISTA,ISTD,ISTE,N2)
      NEST=NEST+1
      RETURN
      END
      SUBROUTINE XMIT(N,IS,ID)
      CHARACTER*1 IS(1),ID(1)
      IF (N.EQ.0) RETURN
      IF (N.GT.0) GO TO 101
      M=-N
      DO 10001 I=1,M
      ID(I)=IS(1)
10001 CONTINUE
      RETURN
  101 CONTINUE
      DO 10002 I=1,N
      ID(I)=IS(I)
10002 CONTINUE
      RETURN
      END
