CDECK  ID>, TOSETU.
      SUBROUTINE TOSETU

C-    DECIDE CETA FORMAT, READY CONVERSION TABLES FOR YTOCETA

      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 /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(6), NVOLD(10), IDOLDV(10), NVARRI(12), NVCCP(10)
     +, NVNEW(10), IDNEWV(10), NVNEWL(6),  MWK(80),MWKX(80)
      EQUIVALENCE (LORGH,LQPRIV(1)), (LORGI,LQPRIV(2))
     +,           (LXREF,LQPRIV(3)), (LTOCE,LQPRIV(4))
     +,           (LCETA,LQPRIV(7))
C--------------    END CDE                             --------------


      IF (INILEV.GE.2)       GO TO 31
      INILEV = 2

      IOSPEC = MOPTIO(1)
      CALL AUXFIL (64+128+256,NVNEW(1),4HCETA)

C--------          CHOOSE CETA FORMAT

      WRITE (IQPRNT,9010)
 9010 FORMAT (1X/20X,'Ready CETA conversion, set Init-level to 2')

      NCHCEU = 3600
      NWCEU  = 5*NWCEBA
      IFLAGX = 0
      IF (MOPTIO(2)+MOPTIO(25).NE.0)  WRITE (IQPRNT,9014)
 9014 FORMAT (20X,'!!!  Obsolete options BACK / Y ignored  !!!!')

C--                INIT OF TOCETA

      NCHKD = -5
      CALL TOCETA (IQUEST)

C----              INITIAL SETUP OF CONVERSION TABLES


C--                CONVERT TO UPPER CASE IF OPTIONS BACK OR 1

      IF (IFLAGX+MOPTIO(28).EQ.0)   GO TO 24
      DO 22  JJ=65,90
   22 IQ(LXREF+JJ) = JJ - 64
      WRITE (IQPRNT,9022)
 9022 FORMAT (1X/20X,'CONVERT LOWER CASE LETTERS TO UPPER.')

C--                CONVERT TO LOWER CASE IF OPTION 2

   24 IF (MOPTIO(29).EQ.0)          GO TO 26
      DO 25  JJ=1,26
   25 IQ(LXREF+JJ) = JJ + 64
      WRITE (IQPRNT,9025)
 9025 FORMAT (1X/20X,'CONVERT UPPER CASE LETTERS TO LOWER.')

C--                SELECT ESCAPE REPRESENTATION IF OPTION BACK

   26 DO 28  JJ=64,255
      J = IQ(LXREF+JJ+256)
      IF (J.EQ.0)              GO TO 28
      IF (IFLAGX.NE.0)         GO TO 27
      IQ(LXREF+JJ) = JJ
      GO TO 28

   27 IQ(LXREF+JJ) = J + 1000
   28 CONTINUE

      IQ(LXREF) = 57

      IQ(LXREF+201) = 1201

C--------      HANDLE  +OPTION, CONVERT  /,N=I1-C1,... /OR/ .I1C1...

   31 IF (NCCPN.LT.0)        GO TO 81
      IF (JCCTYP.NE.MCCOPT)  GO TO 81
      NG = 0
      IF (NCCPN.EQ.0)        GO TO 34
      JT = JCCPN

      DO 33  J=1,NCCPN
      MWK(NG+1) = MCCPAR(JT+1)
      MWK(NG+2) = MCCPAR(JT+2)
      JT = JT + 3
   33 NG = NG + 2
      GO TO 40

   34 N = NCHCCT+1 - NCHCCD
      IF (N.LT.3)            GO TO 81
      CALL UCOPY  (KARDCC(NCHCCD+1),MWKX(1),N)
      MWKX(N) = IQBLAN
      CALL ULEFT  (MWKX,1,N)
      CALL HOLLCV (MWKX(1),MWK(1),N,1)
      N = N - 1

      DO 35  J=1,N,2
      JJ = MWK(J)
      JJ = IQ(LTOCE+JJ)
      IF (JJ.EQ.45)          GO TO 39
      JJ = MWK(J+1)
      MWK(J+1) = IQ(LTOCE+JJ)
      IF (MWK(J+1).EQ.45)    GO TO 39
   35 NG = NG + 2
   39 IF (NG.EQ.0)           GO TO 81

C----              UP-DATE  XREF  TABLE

   40 DO 49  J=1,NG,2
      NADDC = 0
      NADDH = 0
      JINHO = MWK(J)
      JCETU = MWK(J+1)

      IF (JCETU.LT.1000)     GO TO 42
      NADDC = 1000
      JCETU = JCETU - 1000

   42 IF (JCETU.LE.0)        GO TO 48
      IF (JCETU.GE.256)      GO TO 48
      IF (NADDC.EQ.0)        GO TO 43
      IF (IQ(LXREF+JCETU+512).EQ.0)  GO TO 48

   43 IF (JINHO.LT.1000)     GO TO 44
      NADDH = 1000
      JINHO = JINHO - 1000

   44 IF (JINHO.LT.0)        GO TO 48
      IF (JINHO.GT.MXINHO)   GO TO 48
      JCETA = IQ(LTOCE+JINHO)
      IF (NADDH.NE.0)  JCETA=IQ(LXREF+JCETA+512)
      IF (JCETA.NE.0)        GO TO 46

C--                CREATE NEW CHARACTER

      IF (NADDH.NE.0)        GO TO 48
      JCETA = JCETU
      IF (IQ(LORGI+JCETA).EQ.-1)  GO TO 45
      JCETA = IUCOMP (-1,IQ(LORGI+96),100)
      IF (JCETA.EQ.0)        GO TO 48
      JCETA = JCETA + 95

   45 IQ(LORGI+JCETA) = JINHO
      IQ(LTOCE+JINHO) = JCETA

C--                SET  XREF  ENTRY

   46 IQ(LXREF+JCETA) = JCETU + NADDC

      JINHO = JINHO + NADDH
      JCETU = JCETU + NADDC
      WRITE (IQPRNT,9046)  JINHO,JCETU
      GO TO 49

   48 JINHO = JINHO + NADDH
      JCETU = JCETU + NADDC
      WRITE (IQPRNT,9048)  JINHO,JCETU
   49 CONTINUE
      WRITE (IQPRNT,9049)

   81 CALL LOGLV  (MOPTIO(31),0,0)
      RETURN

 9046 FORMAT (24X,'INTERNAL',I5,'  GIVES CETA',I5)
 9048 FORMAT (4H ***/4H ***,20X,'INTERNAL',I5,'     TO CETA',I5,
     F'  IS IMPOSSIBLE.',24X,'*******')
 9049 FORMAT (1X)
      END
