CDECK  ID>, YFRCEX.
      SUBROUTINE YFRCEX

C-    CONVERT CETA FILE TO COMPACT BINARY

      COMMON /QBCD/  IQNUM2(11),IQLETT(26),IQNUM(10),IQPLUS
     +,              IQMINS,IQSTAR,IQSLAS,IQOPEN,IQCLOS,IQDOLL,IQEQU
     +,              IQBLAN,IQCOMA,IQDOT,IQAPO,  IQCROS
      COMMON /QUNIT/ IQREAD,IQPRNT,IQPR2,IQLOG,IQPNCH,IQTTIN,IQTYPE
     +,              IQDLUN,IQFLUN,IQHLUN,IQCLUN,  NQUSED
      COMMON /ARRCOM/LUNPAM,NCHKD,NWKD,NCARDP,NAREOF,NSKIPR,KDHOLD(20)
     +,              NTRUNC,IPROMU,IPROMI
      COMMON /CCPARA/NCHCCD,NCHCCT,KARDCC(84),   JCCTYP,JCCPRE,JCCEND
     +,              MCCPAR(120),NCCPAR,MXCCIF,JCCIFV,JCCBAD,JCCWK(4)
     +,              JCCPP,JCCPD,JCCPZ,JCCPT,JCCPIF,JCCPC,JCCPN
     +,              NCCPP,NCCPD,NCCPZ,NCCPT,NCCPIF,NCCPC,NCCPN
      COMMON /CCPARU/MCCTOU,JCCLOW,JCCTPX
      COMMON /CCTYPE/MCCQUI,MCCPAM,MCCTIT,MCCPAT,MCCDEC,MCCDEF,MCCEOD
     +,              MCCASM,MCCOPT,MCCUSE
      COMMON /COMCET/INILEV,NWCEIN,NCHCEU,NWCEU
     +,              NWCEBA,IPAKCE(5),IPAKKD(5),JPOSA1,MXINHO
     +,              LCESAV(4)
      COMMON /IOFCOM/IOTALL,IOTOFF,IOTON,IOSPEC,IOPARF(5),IOMODE(12)
      PARAMETER      (IQBDRO=25, IQBMAR=26, IQBCRI=27, IQBSYS=31)
      COMMON /QBITS/ IQDROP,IQMARK,IQCRIT,IQZIM,IQZIP,IQSYS
                         DIMENSION    IQUEST(30)
                         DIMENSION                 LQ(99), IQ(99), Q(99)
                         EQUIVALENCE (QUEST,IQUEST),    (LQUSER,LQ,IQ,Q)
      COMMON //      QUEST(30),LQUSER(7),LQMAIN,LQSYS(24),LQPRIV(7)
     +,              LQ1,LQ2,LQ3,LQ4,LQ5,LQ6,LQ7,LQSV,LQAN,LQDW,LQUP
     +, KADRV(14),LADRV(11),LCCIX,LBUF,LLAST
     +, NVOPER(6),MOPTIO(31),JANSW,JCARD,NDECKR,NVUSEX(20)
     +, NVINC(6),NVUTY(17),IDEOF(9),NVPROX(6),LOGLVG,LOGLEV,NVWARX(6)
     +, NVOLDQ(4),MVOLD1,MVOLDN,  NVOLD(7),NRTOLD,NROLD,MAXEOF
     +, IDOLDV(8),JPDOLD,JOLD, NVARRI(9),LARX,LARXE,LINBIN, NVCCP(10)
     +, NVNEW(7),NRTNEW,NRNEW,LLASTN, IDNEWV(8),JPDNEW,NDKNEW
     +, NVNEWL(3),NCDECK,JNEW,MODEPR,  MWK(80),MWKX(80)
      DIMENSION      IDD(2),             IDP(2),             IDF(2)
      EQUIVALENCE
     +       (IDD(1),IDNEWV(1)), (IDP(1),IDNEWV(3)), (IDF(1),IDNEWV(5))
C--------------    END CDE                             -----------------
      EQUIVALENCE (JCCF,JCCPC)
      DIMENSION    JOPINH(13), NOPINH(3)


C                   1---------------  2----------------  3---
C-                   A B  S  U  X  Y   F  I  M  T  1  2   C
      DATA  JOPINH / 1,2,19,21,24,25,  6, 9,13,20,28,29,  3   /
      DATA  NOPINH /               6,                12,  13  /

      DATA  MMPAM  / 4HPAM  /


      CALL CETUP
      IOTON = 256
C-                                 256 INIT

      CALL SBIT0 (MOPTIO(31),3)
      CALL SBIT0 (MOPTIO(31),6)
      CALL SBIT0 (MOPTIO(31),26)
      CALL SBIT0 (MOPTIO(31),21)
      CALL SBIT0 (MOPTIO(31),19)
      CALL SBIT0 (MOPTIO(31),25)

      JCCPT  = 0
      CALL SETOPT

      INILEV = 1

      NVNEW(6)= MMPAM
      MODEPR = IQPLUS
      NDISCD = 0
      JPAMCA = 0
      NSECT  = 0
      NSKIP  = 0
      NTAKE  = 9999

      IF (IQREAD.EQ.0)       GO TO 90

C-----             READ DATA CARDS

      LUNPAM = IQREAD
      NCHKD  = -1
      CALL KDNGO

   11 CONTINUE
      WRITE (IQPRNT,9011)
      MCCTOU = 7

   12 MOPTSV = MOPTIO(31)
      NCHKD  = -2
      CALL KDNEXT (KDHOLD(1))
      IF (NCHKD.LT.0)        GO TO 90
      CALL UBLOW  (KDHOLD(1),KARDCC(1),NCHKD)
      WRITE (IQPRNT,9012) INILEV,(KARDCC(J),J=1,NCHKD)
      WRITE (IQPRNT,9011)

      JCCTYP = JARTYP (KDHOLD(1))
      IF (JCCTYP.NE.0)       GO TO 14
   13 WRITE (IQPRNT,9013)
      GO TO 12

   14 CALL CCKRAK (KDHOLD(1))

      IF (JCCTYP.EQ.MCCQUI)  GO TO 91
      IF (JCCTYP.EQ.MCCPAM)  GO TO 31
      IF (JCCTYP.NE.MCCOPT)  GO TO 13

C----              HANDLE  +OPTION

   19 CALL SETOPT
      IF (INILEV.EQ.0)       GO TO 25
      JFL = 0
      N   = NOPINH(INILEV)

      DO 23  J=1,N
      JB   = JOPINH(J)
      JOLD = JBIT (MOPTSV,    JB)
      JNEW = JBIT (MOPTIO(31),JB)
      IF (JNEW.EQ.JOLD)      GO TO 23
      JFL = 7
      CALL SBIT (JOLD,MOPTIO(31),JB)
   23 CONTINUE
      IF (JFL.EQ.0)          GO TO 25

      WRITE (IQPRNT,9023) INILEV
 9023 FORMAT (1X/4H ***,16X,'INIT-LEVEL',I2,' IS TOO LATE',
     F' FOR CHANGING THIS OPTION   *****')
      JCCPT = 0
      GO TO 19

   25 IF (MOPTIO(3).EQ.0)    GO TO 27
      CALL SBIT0 (MOPTIO(31),3)
      CALL FRSETU

   27 IF (MOPTIO(6).EQ.0)    GO TO 12
      CALL SBIT0 (MOPTIO(31),6)

      IOSPEC = MOPTIO(1)
      CALL AUXFIL (128,NVOLD(1),4HCETA)
      NCHKD = -4
      CALL FRCETA (IQUEST)
      GO TO 11

C--              +PAM, F=FNAME, T=ATT,RESUME,EOF,HOLD, N=NSKIP,NDO

   31 CALL FRSETU
      NSKIP = 0
      NTAKE = 9999
      IF (NCCPN.EQ.0)        GO TO 33
      IF (NCCPN.EQ.1)        GO TO 32
      NSKIP = MCCPAR(JCCPN+1)
      JCCPN = JCCPN + 3
   32 NTAKE = MCCPAR(JCCPN+1)
   33 J     = IOTYPE(MCCPAR(JCCPT+1),4)
      IF (JCCF.EQ.0)         GO TO 38
      IF (JPAMCA.EQ.0)       GO TO 36
      CALL POPREW
      NRTNEW = -1

   36 NVNEW(3) = MCCPAR(JCCF+1)
      NVNEW(5) = J
      CALL AUXFIL (64+256+2048,NVNEW(1),0)
      JCCPT = 0

   38 IF (JCCPT.NE.0)  NVNEW(5)=J
      JPAMCA = JPAMCA + 1

C------------      START NEW BIG-FILE OUTPUT

   41 CONTINUE
   42 CONTINUE
      INILEV = 3
      MCCTOU = 0

C----              START NEW PAM-FILE = CETA-SECTION

   47 NCARDP = 0
      JPDNEW = 3
      NSECT = NSECT + 1
      WRITE (IQPRNT,9047) NSECT

      NCHKD = 0
      CALL FRCETA (KDHOLD(1))
      IF (NCHKD.LT.0)        GO TO 91
      IF (NSKIP.EQ.0)        GO TO 71
      NSKIP = NSKIP - 1
      WRITE (IQPRNT,9049) (MWK(J),J=1,NCHKD)
      NCHKD = -3
      CALL FRCETA (IQUEST)
      GO TO 47

C----              HUNTING FOR START OF NEW DECK

   61 NDISCD = NDISCD + 1
   62 CALL FRCETA (KDHOLD(1))
      IF (NCHKD.LT.0)        GO TO 78

      JCCTYP = JARTYP (KDHOLD(1))
      IF (JCCTYP - MCCTIT)   61,78,64
   64 IF (JCCTYP.GE.MCCEOD)  GO TO 61

      CALL CCKRAK (KDHOLD(1))
      IF (JCCBAD.NE.0)       GO TO 67
      IF (JCCTYP.GE.MCCEOD)  GO TO 61
      GO TO 74

C--                BAD C/C, SKIP THIS CARD

   67 JC = NCARDP - NCDECK
      WRITE (IQPRNT,9067) IDP,IDD,JC,(KARDCC(J),J=1,NCHCCT)
      NVWARX(1) = NVWARX(1) + 1
      GO TO 61

C----              NORMAL LOOP FOR DECKS

   71 CALL PILECT
      IF (NCHKD)             78,62,74

   74 JPDNEW = MCCDEF - JCCTYP
      GO TO 71

C--                END OF CETA-SECTION

   78 WRITE (IQPRNT,9078) NCARDP
      NTAKE = NTAKE - 1
      IF (NTAKE.GT.0)        GO TO 47
      GO TO 11

C--                EOI

   90 IF (INILEV.GE.3)       GO TO 91
      NCCPN = -7
      CALL FRSETU
      GO TO 41

   91 CONTINUE
      IOSPEC = MOPTIO(1)
      CALL AUXFIL (512,NVOLD(1),0)
      CALL POPREW
      IF (NDISCD+NVWARX(1).NE.0)  WRITE (IQPRNT,9098) NDISCD,NVWARX(1)
      RETURN

 9011 FORMAT (1X)
 9012 FORMAT (10X,'LEV=',I1,3H - ,80A1)
 9013 FORMAT (4H ***,40X,'*** ILLEGAL C/C. IGNORED ***'/1X)
 9047 FORMAT (1X/14H START SECTION,I4,/1X)
 9049 FORMAT (14H SKIP  SECTION,9X,4H--- ,80A1)
C9067 FORMAT (3H0P=,A8,   3H D=,A8,   3H C=,I6,16H *** FAULTY C/C ,72A1) A8M
C9067 FORMAT (3H0P=,A6,A2,3H D=,A6,A2,3H C=,I6,16H *** FAULTY C/C ,72A1) A6
C9067 FORMAT (3H0P=,A5,A3,3H D=,A5,A3,3H C=,I6,16H *** FAULTY C/C ,72A1) A5
 9067 FORMAT (3H0P=,2A4,  3H D=,2A4,  3H C=,I6,16H *** FAULTY C/C ,72A1) A4
 9078 FORMAT (35X,I7,12H CARDS READ./1X/1X,53(1H-))
 9098 FORMAT (1X,3(/1X,20(1H*)),I5,' CARDS BETWEEN DECKS HAVE BEEN IGNOR
     FED,'/21X,I5,' BAD CONTROL CARDS HAVE BEEN SEEN.')
      END
