zebra.f

Go to the documentation of this file.

*-------------------------------------------------------------------------------
*
* This file contains the zebra's package subset needed to build h2root.
* It cannot be used by any zebra application because many zebra functionalities
* are missing.
*
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzebra (LIST)
      COMMON /zbcd/  iqnum2(11),iqlett(26),iqnum(10),   iqplus,iqmins
     +,              iqstar,iqslas,iqopen,iqclos,iqdoll,iqequ, iqblan
     +,              iqcoma,iqdot, iqnumb,iqapo, iqexcl,iqcolo,iqquot
     +,              iqunde,iqclsq,iqand, iqat,  iqques,iqopsq,iqgrea
     +,              iqless,iqreve,iqcirc,iqsemi,iqperc,  iqlowl(26)
     +,              iqcrop,iqvert,iqcrcl,iqnot, iqgrav,  iqileg
     +,              nqhol0,nqholl(95)
      CHARACTER  CQALLC*96
      COMMON /zbcdch/ cqallc
                      CHARACTER*1  CQLETT(96), CQNUM(10)
                      equivalence(cqlett(1),cqallc(1:1))
                      equivalence(cqnum(1), cqallc(27:27))
      parameter(nqtcet=256)
      COMMON /zceta/ iqceta(256),iqtcet(256)
      COMMON /zheadp/iqhead(20),iqdate,iqtime,iqpage,nqpage(4)
      parameter(iqbitw=32, iqbitc=8, iqchaw=4)
      COMMON /zmach/ nqbitw,nqbitc,nqchaw
     +,              nqlnor,nqlmax,nqlpth,nqrmax,iqlpct,iqnil
      COMMON /znatur/qpi2,qpi,qpiby2,qpbyhr
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +,              nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun,  nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence (iqcur(1),lqstor)
      COMMON /mzcl/  nqln,nqls,nqnio,nqid,nqnl,nqns,nqnd,nqioch(16)
     +,              lqsup,nqbia, nqiosv(3)
      COMMON /jzuc/  lqjz,lqup,lqdw,lqsv,lqan, jqlev,jqflag(10)
      common/rzcount/rzxio(2)
      COMMON /rzclun/lun,lrec,isave,imodex,irelat,nhpwd,ihpwd(2)
     +,              izrecl,imodec,imodeh
      parameter(maxfiles=128, maxstrip=21)
      CHARACTER*128  RZNAMES(MAXFILES),RZSFILE(MAXSTRIP)
      common/rzcstrc/rznames,rzsfile
      common/rzcstri/islast,istrip(maxfiles),nstrip(maxfiles),
     +                      nrstrip(maxfiles)
      CHARACTER*4 CVERSN
      dimension    list(9), inkeys(3)
      DATA  inkeys / 4hebra, 4hinit, 4hdone /
   12 nqstor = -1
      jqstor = -99
      CALL vzeroi (nqofft,66)
      CALL mzinco (list)
      nqdcut = 201
      nqwcut = 500
      CALL ucopyi (inkeys,mqkeys,3)
      CALL vzeroi (nqln, 28)
      CALL vzeroi (lqjz, 16)
      CALL vzeroi (nstrip, maxfiles)
      jqlev = -1
      rzxio(1) = 0.
      rzxio(2) = 0.
      imodeh   = 0
      CALL vfill (iqfenc,4,iqnil)
      nqinit = -1
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzinco (LIST)
      COMMON /zbcd/  iqnum2(11),iqlett(26),iqnum(10),   iqplus,iqmins
     +,              iqstar,iqslas,iqopen,iqclos,iqdoll,iqequ, iqblan
     +,              iqcoma,iqdot, iqnumb,iqapo, iqexcl,iqcolo,iqquot
     +,              iqunde,iqclsq,iqand, iqat,  iqques,iqopsq,iqgrea
     +,              iqless,iqreve,iqcirc,iqsemi,iqperc,  iqlowl(26)
     +,              iqcrop,iqvert,iqcrcl,iqnot, iqgrav,  iqileg
     +,              nqhol0,nqholl(95)
      CHARACTER  CQALLC*96
      COMMON /zbcdch/ cqallc
                      CHARACTER*1  CQLETT(96), CQNUM(10)
                      equivalence(cqlett(1),cqallc(1:1))
                      equivalence(cqnum(1), cqallc(27:27))
      parameter(nqtcet=256)
      COMMON /zceta/ iqceta(256),iqtcet(256)
      COMMON /zheadp/iqhead(20),iqdate,iqtime,iqpage,nqpage(4)
      parameter(iqbitw=32, iqbitc=8, iqchaw=4)
      COMMON /zmach/ nqbitw,nqbitc,nqchaw
     +,              nqlnor,nqlmax,nqlpth,nqrmax,iqlpct,iqnil
      COMMON /znatur/qpi2,qpi,qpiby2,qpbyhr
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +,              nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun,  nqused
      COMMON /zvfaut/iqvid(2),iqvsta,iqvlog,iqvthr(2),iqvrem(2,6)
      COMMON /quest/ iquest(100)
      dimension list(9)
      jbit(izw,izp)     = iand(ishft(izw,-(izp-1)),1)
      CALL vzeroi (iquest,100)
      CALL vzeroi (iqvid,18)
      CALL vzeroi (nqphas,15)
      nqbitw = iqbitw
      nqbitc = iqbitc
      nqchaw = iqchaw
      nqlnor = 58
      nqlmax = 58
      nqlpth =  0
      nqrmax = 132
      iqlpct = iqblan
      iqnil  = 16744448
      cqallc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-*/()$= ,.'
      cqallc(65:90) = 'abcdefghijklmnopqrstuvwxyz'
      cqallc(48:64) = '#''!:"_]&@?[>< ^;%'
      cqallc(91:96) = '{|}~`?'
      cqallc(61:61) = char(92)
      CALL uctoh1 (cqallc, iqlett, 96)
      CALL uctoh1 (' 1234567890', iqnum2, 11)
      CALL izhnum (iqlett,nqholl,95)
      nqhol0 = nqholl(45)
      CALL vfill (iqceta,nqtcet,96)
      DO 24  jc=95,1,-1
      jh = nqholl(jc)
   24 iqceta(jh+1) = jc
      DO 26  jl=1,nqtcet
      j = iqceta(jl)
      IF (j.GE.64)  THEN
        IF (j.GE.94)  THEN
          j = 57
        ELSEIF (j.EQ.93)  THEN
          j = 42
        ELSEIF (j.EQ.92)  THEN
          j = 40
        ELSEIF (j.EQ.91)  THEN
          j = 41
        ELSEIF (j.EQ.64)  THEN
          j = 51
        ELSE
          j = j - 64
        ENDIF
       ENDIF
   26 iqtcet(jl) = j
      qpi    = 4.*atan(1.)
      qpi2   = 2.*qpi
      qpiby2 = qpi/2.
      qpbyhr = .0002998
      iqread = 2
      iqprnt = 3
      iqpnch = 4
      iqlog  = iqprnt
      iqttin = 5
      iqtype = 6
      itype = iqtype
      IF (itype.EQ.0) itype = iqlog
      nlist = list(1)
      IF (nlist) 32, 38, 33
   32 nlist = -nlist
      IF (jbit(nlist,2).NE.0)  nqlogd = -2
      IF (jbit(nlist,1).NE.0)  iqlog = itype
      iqprnt = iqlog
      GO TO 38
   33 nqlogd = list(2)
      IF (nlist.EQ.1)              GO TO 38
      IF (list(3).NE.0) THEN
          IF (list(3).LT.0) THEN
              iqlog = itype
            ELSE
              iqlog = list(3)
            ENDIF
        ENDIF
      iqprnt = iqlog
      IF (nlist.EQ.2)              GO TO 38
      IF (list(4).NE.0) THEN
          IF (list(4).LT.0) THEN
              iqprnt = itype
            ELSE
              iqprnt = list(4)
            ENDIF
        ENDIF
   38 iqpr2  = iqprnt
      nqlogm = nqlogd
      iqdlun = iqprnt
      iqflun = iqprnt
      iqhlun = iqprnt
      nqused = 0
      CALL vblank (iqhead,20)
      CALL vzeroi (iqdate,7)
******CALL DATIME (IQDATE,IQTIME)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzpaw (NWORDS,CHOPT)
      COMMON /pawc/  nwpaw,ixpawc,ihbook,ixhigz,ixku,ifence(5)
     +,              lmain, ipaw(4000000-11)
      CHARACTER    *(*) CHOPT
      CALL uoptc (chopt,'M',ipaw)
      IF (ipaw(1).NE.0)   CALL mzebra(-1)
      nw = max(nwords,10000)
      CALL mzstor (ixpawc,'/PAWC/',' ',ifence,lmain,ipaw(1),ipaw(1),
     +            ipaw(5000),ipaw(nw-11))
      nwpaw  = nw
      ihbook = 0
      ixhigz = 0
      ixku   = 0
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzstor (IXSTOR,CHNAME,CHOPT
     +,                  IFENCE,LV,LLR,LLD,LIMIT,LAST)
      COMMON /zbcd/  iqnum2(11),iqlett(26),iqnum(10),   iqplus,iqmins
     +,              iqstar,iqslas,iqopen,iqclos,iqdoll,iqequ, iqblan
     +,              iqcoma,iqdot, iqnumb,iqapo, iqexcl,iqcolo,iqquot
     +,              iqunde,iqclsq,iqand, iqat,  iqques,iqopsq,iqgrea
     +,              iqless,iqreve,iqcirc,iqsemi,iqperc,  iqlowl(26)
     +,              iqcrop,iqvert,iqcrcl,iqnot, iqgrav,  iqileg
     +,              nqhol0,nqholl(95)
      parameter(iqbitw=32, iqbitc=8, iqchaw=4)
      COMMON /zmach/ nqbitw,nqbitc,nqchaw
     +,              nqlnor,nqlmax,nqlpth,nqrmax,iqlpct,iqnil
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +,              nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun,  nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      parameter(nqwktt=2560)
      COMMON /mzcwk/ iqwktb(nqwktt), iqwkfz(nqwktt)
*
      dimension    ixstor(9),ifence(9)
      dimension    lv(9),llr(9),lld(9),limit(9),last(9)
      dimension    mmsysl(5), namela(2), namesy(2)
      CHARACTER    *(*) CHNAME,CHOPT
      dimension    namesr(2)
      DATA  namesr / 4hmzst, 4hor   /
      DATA  mmsysl / 4hsysl,0,0,101,2/
      DATA  namela / 4hsyst, 4hem   /
      DATA  namesy / 4hsyst, 4hem   /
      DATA  namwsp / 4hqwsp /
      DATA  namedv / 4hqdiv /
      msbit1(izw,izp)   = ior(izw,     ishft(1,izp-1))
      IF (nqstor.NE.-1)            GO TO 13
      CALL vzeroi (nqofft,32)
      lqatab = locf(iqtabv(1)) - 1
      lqasto = locf(lq(1)) - 1
      lqbtis = lqatab - lqasto
      lqwktb = locf(iqwktb(1)) - lqasto
      lqwkfz = locf(iqwkfz(1)) - lqasto
      nqtsys = locf(iqdn2(20)) - lqatab
      nqwktb = nqwktt
      kqft = 342
      IF (nqlogd.GE.-1)
     +WRITE (iqlog,9011) lqatab,lqatab
 9011 FORMAT (1x/' MZSTOR.  ZEBRA table base TAB(0) in /MZCC/ at adr'
     f,i12,1x,z11,' HEX')
   13 CONTINUE
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      CALL uoptc (chopt,'Q:',iquest)
      logq   = iquest(1)
      iflspl = iquest(2)
      jqstor = nqstor + 1
      CALL vzeroi (kqt,27)
      lqstor = locf(lv(1)) - 1
      kqs    = lqstor - lqasto
      nfend  = (lqstor+1) - locf(ifence(1))
      nqfend = nfend
      nqsnam(1) = iqblan
      nqsnam(2) = iqblan
      n = min(8, len(chname))
      IF (n.NE.0)  CALL uctoh (chname,nqsnam,4,n)
      nqlogl = nqlogd
      IF (logq.NE.0)  nqlogl=-2
      nqstru = locf(llr(1)) - (lqstor+1)
      nqref  = locf(lld(1)) - (lqstor+1)
      nqlink = nqref
      lq2end = locf(limit(1)) - lqstor
      ndatat = locf(last(1))  - lqstor
      ndata = ndatat
      loct  = lqatab
      IF (jqstor.NE.0)  THEN
          ndata = ndata  - nqtsys
          nqsnam(6) = ndata
          loct  = lqstor + ndata
          kqt   = loct   - lqatab
          ndata = ndata - 4
          CALL vfill (lq(kqs+ndata),10,iqnil)
        ENDIF
      IF (nqlogl.GE.-1)
     +WRITE (iqlog,9021) jqstor,nqsnam(1),nqsnam(2)
     +,                  lqstor,loct,lqstor,loct,kqs,kqt,kqs,kqt
     +,                  nqstru,nqref,lq2end,ndatat,nfend
 9021 FORMAT (1x/' MZSTOR.  Initialize Store',i3,'  in ',2a4,
     f/10x,'with Store/Table at absolute adrs',2i12
     f/40x,'HEX',2(1x,z11)/40x,'HEX',2(1x,z11)
     f/30x,'relative adrs',2i12
     f/10x,'with',i6,' Str. in',i6,' Links in',i7,' Low words in'
     f,i8,' words.'
     f/10x,'This store has a fence of',i5,' words.')
      nsys   =  400
      nqminr =   40
      nwf    = 2000
      IF (jqstor.EQ.0)  nqminr=164
      IF (nqstru.LT.0)               GO TO 91
      IF (nqref .LT.nqstru)          GO TO 91
      IF (ndatat.LT.nqlink+nwf)      GO TO 91
      IF (lq2end.LT.nqlink+nqminr)   GO TO 91
      IF (nfend .LT.1)               GO TO 92
      IF (nfend .GE.1001)            GO TO 92
      IF (iflspl.EQ.1)  THEN
          IF (jqstor.EQ.0)           GO TO 96
          GO TO 39
        ENDIF
      IF (jqstor.EQ.0)             GO TO 41
      ksa = kqs - nqfend
      kse = kqs + ndatat
      DO 36  jsto=1,jqstor
      jt  = nqofft(jsto)
      js  = nqoffs(jsto)
      jsa = js  - iqtabv(jt+2)
      jse = js  + lqsta(jt+21)
      jta = jt  + lqbtis
      jte = jta + nqtsys
      IF (kse.GT.jta .AND. ksa.LT.jte)    GO TO 94
      IF (kse.GT.jsa .AND. ksa.LT.jse)    GO TO 95
   36 CONTINUE
   39 IF (jqstor.GE.16)            GO TO 93
   41 nqofft(jqstor+1) = kqt
      nqoffs(jqstor+1) = kqs
      nqallo(jqstor+1) = iflspl
      CALL vzeroi (iqtabv(kqt+1),nqtsys)
      CALL vblank (iqdn1(kqt+1), 40)
      nqstor = nqstor + 1
      lq(kqs+ndata-1) = iqnil
      lq(kqs+ndata)   = iqnil
      ndata = ndata - 2
      lqsta(kqt+21) = ndata
      jqdvll = 2
      jqdvsy = 20
      lqsta(kqt+20)  = ndata
      lqend(kqt+20)  = ndata
      nqdmax(kqt+20) = ndata
      iqmode(kqt+20) = 1
      iqkind(kqt+20) = ishft(1, 23)
      iqrno(kqt+20)  = 9437183
      iqdn1(kqt+20)  = namesy(1)
      iqdn2(kqt+20)  = namesy(2)
      lqsta(kqt+2)  = ndata - nsys
      lqend(kqt+2)  = lqsta(kqt+2)
      nqdmax(kqt+2) = ndata
      iqmode(kqt+2) = 1
      iqkind(kqt+2) = msbit1(2, 21)
      iqrcu(kqt+2)  = 3
      iqrto(kqt+2)  = ishft(3,20)
      iqrno(kqt+2)  = 9437183
      iqdn1(kqt+2)  = namedv
      iqdn2(kqt+2)  = iqnum(3)
      lqsta(kqt+1)  = nqlink + 1
      lqend(kqt+1)  = lqsta(kqt+1)
      nqdmax(kqt+1) = ndata
      iqkind(kqt+1) = msbit1(1, 21)
      iqrcu(kqt+1)  = 3
      iqrto(kqt+1)  = ishft(3,20)
      iqrno(kqt+1)  = 9437183
      iqdn1(kqt+1)  = namedv
      iqdn2(kqt+1)  = iqnum(2)
      CALL ucopyi (iqcur,iqtabv(kqt+1),16)
      CALL vfill (ifence,nfend,iqnil)
      IF (nqlink.NE.0)  CALL vzeroi (lv,nqlink)
      IF (jqstor.EQ.0)  THEN
          IF (ixstor(1).EQ.0)      GO TO 71
        ENDIF
      idn = ishft(jqstor,26)
      ixstor(1) = idn
   71 jqdivi = jqdvsy
      CALL mzlift (-7,lsys,0,2,mmsysl,0)
      lqsyss(kqt+1) = lsys
      nall   = locf(iqtdum(1)) - locf(lqsyss(1))
      nstr   = locf(lqsysr(1)) - locf(lqsyss(1))
      locar  = locf(lqsyss(kqt+1)) - lqstor
      locare = locar + nall
      iq(kqs+lsys+1) = 11
      iq(kqs+lsys+2) = 1
      iq(kqs+lsys+3) = 1 + nqlink
      iq(kqs+lsys+4) = nqstru
      iq(kqs+lsys+5) = namwsp
      iq(kqs+lsys+6) = iqblan
      iq(kqs+lsys+7) = locar
      iq(kqs+lsys+8) = locare
      iq(kqs+lsys+9) = nstr
      iq(kqs+lsys+10)= namela(1)
      iq(kqs+lsys+11)= namela(2)
      iqtabv(kqt+13) = min(1, locar)
      iqtabv(kqt+14) = max(lqsta(kqt+21), locare)
  999 nqtrac = nqtrac - 2
      RETURN
   95 nqcase = 1
   94 nqcase = nqcase - 2
      nqfata = 3
      iquest(20) = jsto - 1
      iquest(21) = nqpnam(jt+1)
      iquest(22) = nqpnam(jt+2)
   96 nqcase = nqcase + 3
   93 nqcase = nqcase + 1
   92 nqcase = nqcase + 1
   91 nqcase = nqcase + 1
      nqfata = nqfata + 9
      iquest(11) = nqsnam(1)
      iquest(12) = nqsnam(2)
      iquest(13) = nfend
      iquest(14) = nqstru
      iquest(15) = nqlink
      iquest(16) = lq2end
      iquest(17) = ndatat
      iquest(18) = nqminr
      iquest(19) = nwf
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzopen(LUNIN,CHDIR,CFNAME,CHOPTT,LRECL,ISTAT)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun,  nqused
      common/rzckey/ihead(3),key(100),key2(100),keydum(50)
      COMMON /rzclun/lun,lrec,isave,imodex,irelat,nhpwd,ihpwd(2)
     +,              izrecl,imodec,imodeh
      COMMON /quest/ iquest(100)
      COMMON /rzbuff/ itest(8704)
      parameter(maxfiles=128, maxstrip=21)
      CHARACTER*128  RZNAMES(MAXFILES),RZSFILE(MAXSTRIP)
      common/rzcstrc/rznames,rzsfile
      common/rzcstri/islast,istrip(maxfiles),nstrip(maxfiles),
     +                      nrstrip(maxfiles)
      integer cfstat,statf,info(12)
      CHARACTER*(*) CFNAME,CHDIR,CHOPTT
      CHARACTER*9   SPACES
      CHARACTER*8   STAT
      CHARACTER*36  CHOPT
      CHARACTER*255 CHFILE
      LOGICAL       IEXIST
      CHARACTER*4   CHOPE
      parameter(nword = 8704)
      parameter(ibytes=4)
      chopt=choptt
      CALL cltou(chopt)
      iopt1=index(chopt,'1')
      ioptc=index(chopt,'C')
      ioptl=index(chopt,'L')
      ioptn=index(chopt,'N')
      iopts=index(chopt,'S')
      ioptp=index(chopt,'P')
      ioptu=index(chopt,'U')
      ioptv=index(chopt,'V')
      ioptw=index(chopt,'W')
      ioptx=index(chopt,'X')
      iopty=index(chopt,'Y')
      lunit=lunin
      iquest(10) = 0
      iquest(11) = 0
      iquest(12) = 0
      imodec = ioptc
      imodex = ioptx
      lreci = lrecl
      lrecl2 = 0
      imodeh = 0
      chfile=cfname
      IF(ioptp.EQ.0)CALL cutol(chfile)
      ipass=0
   10 CONTINUE
      IF(ioptn.NE.0)THEN
         stat='UNKNOWN'
         IF(lreci.LE.0) THEN
            WRITE(iqprnt,10000) lreci
10000 FORMAT(' RZOPEN. - invalid record length: ',i6)
            istat = 1
            GOTO 70
         ELSEIF(lreci.GE.8191) THEN
            WRITE(iqprnt,10100) lreci
10100 FORMAT(' RZOPEN. record length:',i6,
     + ' > maximum safe value (8191 words).')
            IF(lreci.GT.8192) WRITE(iqprnt,10200)
10200 FORMAT(' RZOPEN. Automatic record length determination will not',
     + ' work with this file.')
            WRITE(iqprnt,10300)
10300 FORMAT(' RZOPEN. You may have problems transferring your',
     + ' file to other systems ',/,
     + '         or writing it to tape.')
         ENDIF
      ELSE
         stat='OLD'
         lenf = lenocc(chfile)
         IF(ioptc.EQ.0) THEN
            INQUIRE(file=chfile,exist=iexist)
            istatf = 0
         ELSE
            iexist = cfstat(chfile(1:lenf),info).EQ.0
            istatf = 1
         ENDIF
         IF(.NOT.iexist) THEN
            WRITE(iqprnt,*) 'RZOPEN. Error - input file ',
     + chfile(1:lenf),' does not exist'
            istat = 2
            GOTO 70
         ENDIF
         IF(lrecl.EQ.0) THEN
            icount = nword
            IF(ioptc.EQ.0) THEN
            ENDIF
   20 nread = icount
            IF(ioptc.EQ.0) THEN
               OPEN(lunit,file=chfile,form='UNFORMATTED',status='OLD',
     +         recl=ibytes*nread,access='DIRECT',iostat=istat)
               IF(istat.NE.0)GOTO 60
               READ(lunit,rec=1,iostat=ios) (itest(jw),jw=1,nread)
               IF(ios.NE.0) THEN
                  CLOSE(lunit)
                  icount = icount * .75
                  GOTO 20
               ENDIF
            ELSE
               CALL cfopen(lunptr,0,nread,'r',0,chfile,ios)
               IF (ios .NE. 0) THEN
                  istat = -1
                  GOTO 70
               ENDIF
               nwtak = nread
               CALL cfget(lunptr,0,nread,nwtak,itest,ios)
               IF(ios.NE.0) THEN
                  CALL cfclos(lunptr,0)
                  icount = icount * .75
                  GOTO 20
               ENDIF
            ENDIF
            IF(ioptx.NE.0) CALL vxinvb(itest(1),nread)
            DO 30 j=1, nword
               IF(itest(j+25).GT.0.AND.itest(j+25).LE.j) THEN
                  IF((j+itest(j+25)).GT.8703) GOTO 30
                  lrc = itest(j+itest(j+25)+1)
                  IF(lrc.EQ.j) THEN
                     le = itest(j+30)
                     ld = itest(j+24)
                     nrd = itest(j+ld)
                     IF(nrd*lrc.NE.le) GOTO 30
                     lrecl = j
                     IF(ioptc.EQ.0) THEN
                        CLOSE(lunit)
                     ELSE
                        CALL cfclos(lunptr,0)
                     ENDIF
                     GOTO 40
                  ENDIF
               ENDIF
   30 CONTINUE
            IF(ioptc.EQ.0) THEN
               CLOSE(lunit)
            ELSE
               CALL cfclos(lunptr,0)
            ENDIF
            IF(ioptx.EQ.0.AND.ipass.EQ.0) THEN
               WRITE(iqprnt,10400)
10400 FORMAT(' RZOPEN. Cannot determine record length - ',
     + ' EXCHANGE mode is used.')
               ioptx = 1
               imodex = 1
               ipass = 1
               GOTO 10
            ENDIF
            WRITE(iqprnt,*) ' RZOPEN. Error in the input file'
            istat = 3
            GOTO 70
         ENDIF
      ENDIF
   40 CONTINUE
      IF(ioptc.EQ.0) THEN
      nbytes = ibytes
      OPEN(unit=lunit,file=chfile,form='UNFORMATTED',
     + recl=nbytes*lrecl,access='DIRECT',status=stat,iostat=istat)
      ELSE
         chope = 'r'
         IF(ioptu.NE.0.OR.iopt1.NE.0) chope = 'r+'
         IF(ioptn.NE.0) chope = 'w+'
         jrecl = lrecl
         CALL cfopen(lunptr,0,jrecl,chope,0,chfile,istat)
         lunit = 1000 + lunptr
      ENDIF
      IF(istat.NE.0)GOTO 60
      IF(iopty.NE.0)GOTO 50
      IF(ioptn.EQ.0.AND.ipass.EQ.0.AND.istat.EQ.0)THEN
         imodex=ioptx
         izrecl=lrecl
         CALL rziodo(lunit,50,2,itest,1)
         CALL vxinvb(itest(9),1)
         IF(jbit(itest(9),12).NE.0)THEN
            imodex=1
            CALL rziodo(lunit,50,2,itest,1)
         ELSE
            CALL vxinvb(itest(9),1)
         ENDIF
         lb=itest(25)
         IF(lb.GT.8187) THEN
            WRITE(iqprnt,10500) chfile(1:lenocc(chfile))
10500 FORMAT(' RZOPEN: cannot determine record length.',
     + ' File ',a,' probably not in RZ format')
            lrecp=-1
            istat=2
            IF(ioptc.EQ.0) THEN
               CLOSE(lunit)
            ELSE
               CALL cfclos(lunit-1000,0)
            ENDIF
            GOTO 70
         ENDIF
         IF(lb.GT.48) CALL rziodo(lunit,lb+6,2,itest,1)
         lrecp=itest(lb+1)
         iquest(1)=0
         IF(lrecp.NE.lrecl)THEN
            lrecl2=lrecl
            lrecl=0
            IF(ioptc.EQ.0) THEN
               CLOSE(lunit)
            ELSE
               CALL cfclos(lunit-1000,0)
            ENDIF
            IF(ipass.EQ.0) THEN
               ipass=1
               GOTO 10
            ELSE
               WRITE(iqprnt,*) 'Cannot determine record length'
               istat = 1
               GOTO 70
            ENDIF
         ENDIF
      ENDIF
      IF (ipass.NE.0 .AND. lrecl2.NE.0) THEN
         WRITE(iqprnt,10600) lrecl2,lrecl
10600 FORMAT(' RZOPEN:  LRECL inconsistent - ',
     + ' file was opened with LRECL = ',i6,
     + ' should be LRECL = ',i6)
      ENDIF
   50 IF(ioptw.NE.0)THEN
         IF (ioptc .EQ. 0) THEN
            lun = lunit
         ELSE
            lun = lunit - 1000
         ENDIF
         IF(lun.LT.10)WRITE(chdir,10700)lun
         IF(lun.GE.10)WRITE(chdir,10800)lun
10700 FORMAT('LUN',i1,'    ')
10800 FORMAT('LUN',i2,'   ')
      ENDIF
   60 CONTINUE
      iquest(10) = lrecl
      iquest(11) = lunit
      iquest(12) = imodex
   70 CONTINUE
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rziodo(LUNRZ,JREC,IREC1,IBUF,IRW)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /rzcl/ ltop,lrz0,lcdir,lrin,lrout,lfree,lused,lpurg
     +, ltemp,lcord,lfrom
      equivalence(lqrs,lqsyss(7))
      COMMON /rzclun/lun,lrec,isave,imodex,irelat,nhpwd,ihpwd(2)
     +, izrecl,imodec,imodeh
      COMMON /rzbuff/ itest(8704)
      common/rzcount/rzxio(2)
      parameter(maxfiles=128, maxstrip=21)
      CHARACTER*128 RZNAMES(MAXFILES),RZSFILE(MAXSTRIP)
      common/rzcstrc/rznames,rzsfile
      common/rzcstri/islast,istrip(maxfiles),nstrip(maxfiles),
     + nrstrip(maxfiles)
      dimension ibuf(jrec)
      parameter(medium=0)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      rzxio(irw) = rzxio(irw) + jrec
      irec=irec1
      IF(lunrz.GT.0)THEN
         nerr=0
         IF(imodeh.NE.0) THEN
            iquest(1) = jbyt(iq(kqsp+ltop),7,7)
            iquest(2) = jrec
            iquest(4) = irec
            ioway = irw - 1
            IF(irw.EQ.2.AND.imodex.NE.0) CALL vxinvb(ibuf,jrec)
            print*,'>>>>>> CALL JUMPST(LUNRZ)'
******      CALL JUMPST(LUNRZ)
            print*,'>>>>>> CALL JUMPX2(IBUF,IOWAY)'
******      CALL JUMPX2(IBUF,IOWAY)
            IF(iquest(1).NE.0) iquest(1) = 100 + irw
            IF(imodex.NE.0) CALL vxinvb(ibuf,jrec)
         ELSE
   10 IF (irw.EQ.1)THEN
               IF(imodec.EQ.0) THEN
                  READ (unit=lunrz,rec=irec,err=20,iostat=istat)ibuf
               ELSE
                     CALL cfseek(lunrz-1000,medium,izrecl,irec-1,istat)
                     nwtak = jrec
                     CALL cfget(lunrz-1000,medium,jrec,nwtak,ibuf,
     + istat)
                     IF(istat.NE.0) GOTO 20
               ENDIF
               IF(imodex.NE.0) CALL vxinvb(ibuf,jrec)
            ELSE
               IF(imodex.NE.0) CALL vxinvb(ibuf,jrec)
               IF(imodec.EQ.0) THEN
                  WRITE(unit=lunrz,rec=irec,err=20,iostat=istat)ibuf
               ELSE
                  CALL cfseek(lunrz-1000,medium,izrecl,irec-1,istat)
                  IF(istat.NE.0) GOTO 20
                  print*,'>>>>>> CALL CFPUT()'
******            CALL CFPUT(LUNRZ-1000,MEDIUM,JREC,IBUF,ISTAT)
                  IF(istat.NE.0) GOTO 20
               ENDIF
               IF(imodex.NE.0) CALL vxinvb(ibuf,jrec)
            ENDIF
            RETURN
   20 nerr=nerr+1
            IF(nerr.LT.100)GO TO 10
            iquest(1)=100+irw
            WRITE(iqlog,1000)irec,lunrz,istat
 1000 FORMAT(' RZIODO. Error at record =',i5,' LUN =',i6,
     + ' IOSTAT =',i6)
         ENDIF
      ELSE
         kof=iq(kqsp+lrz0-2*lunrz-1)+iq(kqsp+lrz0-2*lunrz)*(irec-1)
         IF (irw.EQ.1)THEN
            CALL ucopyi(iq(kof),ibuf,jrec)
         ELSE
            CALL ucopyi(ibuf,iq(kof),jrec)
         ENDIF
      ENDIF
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzvcyc(LTAD)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /rzcl/  ltop,lrz0,lcdir,lrin,lrout,lfree,lused,lpurg
     +,              ltemp,lcord,lfrom
      equivalence(lqrs,lqsyss(7))
      parameter(kup=5,kpw1=7,knch=9,kdatec=10,kdatem=11,kquota=12,
     +           krused=13,kwused=14,kmega=15,krzver=16,kirin=17,
     +           kirout=18,krlout=19,kip1=20,knfree=22,knsd=23,kld=24,
     +           klb=25,kls=26,klk=27,klf=28,klc=29,kle=30,knkeys=31,
     +           knwkey=32,kkdes=33,knsize=253,kex=6,knmax=100)
      INTEGER        KLCYCL, KPPCYC, KFRCYC, KSRCYC, KFLCYC, KORCYC,
     +               kcncyc, knwcyc, kkycyc, kvscyc
      common/rzcycle/klcycl, kppcyc, kfrcyc, ksrcyc, kflcyc, korcyc,
     +               kcncyc, knwcyc, kkycyc, kvscyc
      IF (ltad.EQ.0) GO TO 99
      IF (iq(kqsp+ltad+krzver).EQ.0) THEN
         klcycl = 4
         kppcyc = 0
         kfrcyc = 2
         ksrcyc = 0
         kflcyc = 1
         korcyc = 2
         kcncyc = 3
         knwcyc = 3
         kkycyc =-1
         kvscyc = 0
      ELSE
         klcycl = 7
         kppcyc = 0
         kfrcyc = 2
         ksrcyc = 5
         kflcyc = 1
         korcyc = 3
         kcncyc = 3
         knwcyc = 4
         kkycyc = 6
         kvscyc = 1
      ENDIF
  99  RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzin(IXDIV,LSUP,JBIAS,KEYU,ICYCLE,CHOPT)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /rzcl/  ltop,lrz0,lcdir,lrin,lrout,lfree,lused,lpurg
     +,              ltemp,lcord,lfrom
      equivalence(lqrs,lqsyss(7))
      COMMON /rzclun/lun,lrec,isave,imodex,irelat,nhpwd,ihpwd(2)
     +,              izrecl,imodec,imodeh
      parameter(kup=5,kpw1=7,knch=9,kdatec=10,kdatem=11,kquota=12,
     +           krused=13,kwused=14,kmega=15,krzver=16,kirin=17,
     +           kirout=18,krlout=19,kip1=20,knfree=22,knsd=23,kld=24,
     +           klb=25,kls=26,klk=27,klf=28,klc=29,kle=30,knkeys=31,
     +           knwkey=32,kkdes=33,knsize=253,kex=6,knmax=100)
      CHARACTER*(*) CHOPT
      dimension keyu(*)
      dimension lsup(1),jbias(1),iqk(10),iqks(10)
      equivalence(iopta,iquest(91)), (ioptc,iquest(92))
     +,      (ioptd,iquest(93)), (ioptn,iquest(94)), (ioptr,iquest(95))
     +,      (iopts,iquest(96))
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      lrin=lq(kqsp+ltop-7)
      IF(lrin.EQ.0)THEN
         CALL mzbook(jqpdvs,lrin,ltop,-7,'RZIN',0,0,lrec+1,2,-1)
         iq(kqsp+lrin-5)=iq(kqsp+ltop-5)
         iq(kqsp+ltop+kirin)=0
      ENDIF
      CALL rzink(keyu,icycle,chopt)
      IF(iquest(1).NE.0)GO TO 99
      IF(ioptc.NE.0.AND.ioptd.EQ.0)GO TO 99
      idtime=iquest(14)
      idnw  =iquest(12)
      IF(iopts.NE.0)CALL ucopyi(iquest(20),iqks,10)
      IF(ioptn.NE.0)THEN
         IF(ioptd.EQ.0)GO TO 99
         CALL ucopyi(iquest(41),iqk,10)
      ENDIF
      lbank=0
      IF(lsup(1).NE.0)THEN
         CALL mzsdiv(ixdiv,1)
         IF(jbias(1).LE.0)lbank=lq(kqs+lsup(1)+jbias(1))
         IF(jbias(1).GT.0)lbank=lsup(1)
      ENDIF
      iform=jbyt(iquest(14),1,3)
      IF(iform.EQ.0)THEN
         CALL rzins(ixdiv,lsup,jbias,lbank)
      ELSE
         ndata=iquest(12)
         IF(lbank.NE.0)THEN
            IF(ndata.LE.iq(kqs+lbank-1))THEN
               CALL rzread(iq(kqs+lbank+1),ndata,1,iform)
               iquest(11) = lbank
            ELSE
               iquest(1)=3
            ENDIF
         ELSE
            CALL mzbook(ixdiv,lfrom,lsup,jbias,'RZIN',0,0,ndata,
     +                  iform,-1)
            CALL rzread(iq(kqs+lfrom+1),ndata,1,iform)
            iquest(11) = lfrom
         ENDIF
      ENDIF
      iquest(14)=idtime
      iquest(12)=idnw
      IF(ioptn.NE.0)CALL ucopyi(iqk ,iquest(41),10)
      IF(iopts.NE.0)CALL ucopyi(iqks,iquest(20),10)
  99  RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzins(IXDIVP,LSUPP,JBIASP,LBANK)
      parameter(iqbitw=32, iqbitc=8, iqchaw=4)
      COMMON /zmach/ nqbitw,nqbitc,nqchaw
     +,              nqlnor,nqlmax,nqlpth,nqrmax,iqlpct,iqnil
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/  mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +,              mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +,              iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +,              lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +,                         lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +,              lqmtc1,lqmtc2, nqfrtc,nqlive
      COMMON /mzioc/ nwfoav,nwfott,nwfodn,nwfore,ifocon(3)
     +,              mfosav(2),  jfoend,jforep,jfocur,mfo(200)
      COMMON /mzcn/  iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      COMMON /fzci/  luni,lunni,ixdivi,ltempi,ievfli
     +,              mstati,mediui,ififoi,idafoi,iacmoi,iupaki
     +,              iadopi,iactvi,incbpi,loglvi,maxrei,  isteni
     +,              lbpari, l4stoi,l4stai,l4curi,l4endi
     +,              iflagi,nfasti,n4skii,n4resi,n4doni,n4endi
     +,              ioptie,ioptir,ioptis,ioptia,ioptit,ioptid
     +,                     ioptif,ioptig,ioptih,iopti2(4)
     +,              idi(2),ipili(4),nwtxi,nwsegi,nwtabi,nwbki,lentri
     +,              nwuhci,iochi(16),nwumxi,nwuhi,nwioi
     +,              nwrdai,nrecai,luheai,jretcd,jerror,nwerr
      parameter(jauioc=50, jauseg=68, jauear=130)
      COMMON /fzcseg/nqseg,iqsegh(2,20),iqsegd(20),iqsglu,iqsgwk
      COMMON /fzcocc/nqocc,iqocdv(20),iqocsp(20)
      COMMON /rzclun/lun,lrec,isave,imodex,irelat,nhpwd,ihpwd(2)
     +,              izrecl,imodec,imodeh
      dimension    ixdivp(9),lsupp(9),jbiasp(9),idum(3)
      equivalence(ioptr,iquest(95))
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      ixdivi = ixdivp(1)
      jretcd = 0
      jerror = 0
      nqocc  = 0
      nqseg  = 0
      CALL rzread(nwtabi,3,1,1)
      IF(iquest(1).NE.0) GO TO 99
      nwioi  = 0
      nwuhi  = 0
      nwuhci = 0
      nwumxi = 0
      nwtxi  = 0
      nwsegi = 0
      CALL mzsdiv(ixdivi,7)
      IF(jqdivi.EQ.0) jqdivi=2
      IF(lbank.NE.0.AND.ioptr.NE.0)THEN
         nlink=iq(kqs+lbank-3)
         nwk  =nwbki-10-nlink
         IF(iq(kqs+lbank-1).LT.nwk)GO TO 91
         IF(imodex.GT.0)THEN
            CALL mziocr(lq(kqs+lbank-nlink-1))
            IF(iquest(1).LT.0)GO TO 99
            iquest(1)=0
         ENDIF
         CALL rzread(iq(kqs+lbank+1),nwk,nwtabi+14+nlink,0)
         GO TO 99
      ENDIF
      lqsysr(kqt+1)=lsupp(1)
      CALL fzimtb
      IF(jretcd.EQ.3)GO TO 91
      CALL rzread(lq(lqta+nwtabi),nwtabi,4,1)
      IF(iquest(1).NE.0) GO TO 99
      lsta = lq(lqmta+3)
      lend = lq(lqmta+4)
      IF(imodex.LE.0)GO TO 30
      lin = lsta
      nwr = nwtabi+4
   10 CONTINUE
      CALL rzread(lq(kqs+lin),1,nwr,1)
      IF(iquest(1).NE.0)GO TO 99
      nwr   = nwr+1
      iwd   = lq(kqs+lin)
      nst   = jbyt(iwd,1,16)-12
      IF(nst.LT.0)GO TO 20
      iqln = lin
      iqls = lin + nst + 1
      IF(iqls+8.GE.lend)GO TO 92
      mfo(1) =  1
      mfo(2) =  nst + 2
      mfo(3) =  2
      mfo(4) =  2
      mfo(5) =  5
      mfo(6) =  1
      mfo(7) =  1
      mfo(8) = -1
      jfoend =  8
      nwfott = nst+9
      nwfodn = 0
      CALL rzread(lq(kqs+lin+1),nst+9,nwr,0)
      IF(iquest(1).NE.0)GO TO 99
      nwr    = nwr+nst+9
      iqnio  = jbyt(iq(kqs+iqls),19,4)
      iqnl   = iq(kqs+iqls-3)
      iqnd   = iq(kqs+iqls-1)
      IF(iqnio+iqnl.NE.nst)GO TO 92
      lin    = iqls + iqnd + 9
      IF(iqnd.GT.0)THEN
         IF(lin.GT.lend)GO TO 92
         CALL mziocr(lq(kqs+iqln))
         IF(iquest(1).LT.0)GO TO 99
         iquest(1)=0
         CALL rzread(iq(kqs+iqls+1),iqnd,nwr,0)
         IF(iquest(1).NE.0)GO TO 99
         nwr = nwr+iqnd
      ENDIF
      IF(lin.LT.lend)GO TO 10
      GO TO 40
   20 nwd = jbyt(iwd,17,iqdrop-17)
      IF(nwd.EQ.0.OR.nwd.NE.nst+12)GO TO 92
      IF(jbyt(iwd,iqdrop,iqbitw-iqdrop).NE.1)GO TO 92
      lin = lin + nwd
      IF(lin.LT.lend)GO TO 10
      GO TO 40
   30 nwr = lend - lsta
      CALL rzread(lq(kqs+lsta),nwr,nwtabi+4,0)
      IF(iquest(1).NE.0) GO TO 99
   40 CONTINUE
      CALL fzirel
      IF(jretcd.NE.0)GO TO 93
      jb=jbiasp(1)
      IF(jb.GE.2)THEN
         lsupp(1)=lentri
      ELSE
         lsupp(1)=lqsysr(kqt+1)
         CALL zshunt(ixdivi,lentri,lsupp,jb,1)
      ENDIF
      iquest(1)  = 0
      iquest(11) = ievfli
      iquest(12) = 0
      iquest(13) = lentri
      iquest(14) = nwbki
      GO TO 99
   91 iquest(11)= -2
      iquest(1) =  1
      GO TO 99
   92 iquest(11)= -3
      iquest(1) =  1
      GO TO 99
   93 iquest(11)= -3
      iquest(1) =  1
   99 RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE zitoh (INTV,IHOLL,NP)
      COMMON /zbcd/  iqnum2(11),iqlett(26),iqnum(10),   iqplus,iqmins
     +,              iqstar,iqslas,iqopen,iqclos,iqdoll,iqequ, iqblan
     +,              iqcoma,iqdot, iqnumb,iqapo, iqexcl,iqcolo,iqquot
     +,              iqunde,iqclsq,iqand, iqat,  iqques,iqopsq,iqgrea
     +,              iqless,iqreve,iqcirc,iqsemi,iqperc,  iqlowl(26)
     +,              iqcrop,iqvert,iqcrcl,iqnot, iqgrav,  iqileg
     +,              nqhol0,nqholl(95)
      COMMON /slate/ dummy(8), mm(4), dumb(28)
      dimension    intv(99), iholl(99), np(9)
      dimension    mpak(2)
      DATA  mpak   /6,4/
      n = np(1)
      DO 39  jw=1,n
      CALL upkbyt (intv(jw),1,mm(1),4,mpak(1))
      DO 16  j=1,4
      jv = mm(j)
      IF (jv.EQ.0)  jv=45
   16 mm(j) = iqlett(jv)
      CALL ubunch (mm(1),iholl(jw),4)
   39 CONTINUE
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzresv
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      jbit(izw,izp)     = iand(ishft(izw,-(izp-1)),1)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      jqdivr = jqdivi
      IF (jqdivr.LT.3)             GO TO 41
      jqmode = jbit(iqmode(kqt+jqdivr), 1)
      jqkind = jbyt(iqkind(kqt+jqdivr),21,4)
      IF (jqmode.NE.0)             GO TO 31
      jqdivn = jqdivr + 1
      IF (jqdivr.EQ.jqdvll)        GO TO 24
      IF (jqdivr.EQ.20)            GO TO 25
      IF (jbyt(iqkind(kqt+jqdivn),21,4).NE.jqkind)  GO TO 25
      IF (jbit(iqmode(kqt+jqdivn),1)   .EQ.jqmode)  GO TO 25
      jqshar = jqdivn
      jqshr1 = jqdivr
      jqshr2 = jqdivn
      nqresv = lqsta(kqt+jqdivn) - lqend(kqt+jqdivr)
      RETURN
   24 jqdivn = jqdvsy
   25 l      = min(lqsta(kqt+jqdivr)+nqdmax(kqt+jqdivr),
     +               lqsta(kqt+jqdivn) )
      nqresv = l - lqend(kqt+jqdivr)
      jqshar = 0
      RETURN
   31 jqdivn = jqdivr - 1
      IF (jqdivr.EQ.jqdvsy)        GO TO 34
      IF (jbyt(iqkind(kqt+jqdivn),21,4).NE.jqkind)  GO TO 35
      IF (jbit(iqmode(kqt+jqdivn),1)   .EQ.jqmode)  GO TO 35
      jqshar = jqdivn
      jqshr1 = jqdivn
      jqshr2 = jqdivr
      nqresv = lqsta(kqt+jqdivr) - lqend(kqt+jqdivn)
      RETURN
   34 jqdivn = jqdvll
   35 l      = max(lqend(kqt+jqdivr)-nqdmax(kqt+jqdivr),
     +               lqend(kqt+jqdivn) )
      nqresv = lqsta(kqt+jqdivr) - l
      jqshar = 0
      RETURN
   41 jqkind = 1
      jqshr1 = 1
      jqshr2 = 2
      nqresv = lqsta(kqt+2) - lqend(kqt+1) - nqminr
      IF (jqdivr.EQ.1)             GO TO 44
      jqmode = 1
      jqdivn = 1
      jqshar = 1
      RETURN
   44 jqmode = 0
      jqdivn = 2
      jqshar = 2
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzsave
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /rzcl/  ltop,lrz0,lcdir,lrin,lrout,lfree,lused,lpurg
     +,              ltemp,lcord,lfrom
      equivalence(lqrs,lqsyss(7))
      COMMON /rzclun/lun,lrec,isave,imodex,irelat,nhpwd,ihpwd(2)
     +,              izrecl,imodec,imodeh
      parameter(kup=5,kpw1=7,knch=9,kdatec=10,kdatem=11,kquota=12,
     +           krused=13,kwused=14,kmega=15,krzver=16,kirin=17,
     +           kirout=18,krlout=19,kip1=20,knfree=22,knsd=23,kld=24,
     +           klb=25,kls=26,klk=27,klf=28,klc=29,kle=30,knkeys=31,
     +           knwkey=32,kkdes=33,knsize=253,kex=6,knmax=100)
      jbit(izw,izp)     = iand(ishft(izw,-(izp-1)),1)
      IF(lqrs.EQ.0)GO TO 99
      IF(ltop.EQ.0)GO TO 99
      IF(jbit(iq(kqsp+ltop),2).NE.0)THEN
         IF(isave.NE.2)THEN
            idtime=0
            CALL rzdate(idtime,idate,itime,2)
            iq(kqsp+ltop+kdatem)=idtime
         ENDIF
         lunc= iq(kqsp+ltop-5)
         lb  = iq(kqsp+ltop+klb)
         lrek= iq(kqsp+ltop+lb+1)
         lus = lq(kqsp+ltop-3)
         IF(lus.NE.0)THEN
            nused=iq(kqsp+lus+1)
            IF(nused.GT.0)THEN
               DO 40 i=1,nused
                  ir1=iq(kqsp+lus+2*(i-1)+2)
                  irl=iq(kqsp+lus+2*(i-1)+3)
                  DO 30 j=ir1,irl
                     iword = (j-1)/32 + 1
                     ibit  = j-32*(iword-1)
                     CALL sbit1(iq(kqsp+ltop+lb+2+iword),ibit)
  30              CONTINUE
  40           CONTINUE
               iq(kqsp+lus+1)=0
            ENDIF
         ENDIF
         lpu = lq(kqsp+ltop-5)
         IF(lpu.NE.0)THEN
            npurg=iq(kqsp+lpu+1)
            IF(npurg.GT.0)THEN
               DO 60 i=1,npurg
                  ir1=iq(kqsp+lpu+2*(i-1)+2)
                  irl=iq(kqsp+lpu+2*(i-1)+3)
                  DO 50 j=ir1,irl
                     iword = (j-1)/32 + 1
                     ibit  = j-32*(iword-1)
                     CALL sbit0(iq(kqsp+ltop+lb+2+iword),ibit)
  50              CONTINUE
  60           CONTINUE
               iq(kqsp+lpu+1)=0
            ENDIF
         ENDIF
         lrout=lq(kqsp+ltop-6)
         IF(lrout.NE.0)THEN
            irout=iq(kqsp+ltop+kirout)
            IF(irout.NE.0)THEN
               CALL rziodo(lunc,lrek,irout,iq(kqsp+lrout+1),2)
               IF(iquest(1).NE.0)GO TO 99
            ENDIF
         ENDIF
         lds =iq(kqsp+ltop+kld)
         nrd =iq(kqsp+ltop+lds)
         IF(isave.NE.2)THEN
            IF(ltop.EQ.lcdir)iq(kqsp+ltop+kdatem)=idtime
         ENDIF
         CALL sbit0(iq(kqsp+ltop),2)
         DO 70 j=nrd,1,-1
            irec=iq(kqsp+ltop+lds+j)
            l=(j-1)*lrek+1
            CALL rziodo(lunc,lrek,irec,iq(kqsp+ltop+l),2)
            IF(iquest(1).NE.0)THEN
               CALL sbit1(iq(kqsp+ltop),2)
               GO TO 99
            ENDIF
  70     CONTINUE
         IF(lcdir.EQ.0.OR.ltop.EQ.lcdir)GO TO 99
         IF(jbit(iq(kqsp+lcdir),2).NE.0)THEN
            lds =iq(kqsp+lcdir+kld)
            nrd =iq(kqsp+lcdir+lds)
            IF(isave.NE.2)THEN
               iq(kqsp+lcdir+kdatem)=idtime
            ENDIF
            CALL sbit0(iq(kqsp+lcdir),2)
            DO 80 j=nrd,1,-1
               irec=iq(kqsp+lcdir+lds+j)
               l=(j-1)*lrek+1
               CALL rziodo(lunc,lrek,irec,iq(kqsp+lcdir+l),2)
               IF(iquest(1).NE.0)THEN
                  CALL sbit1(iq(kqsp+lcdir),2)
                  GO TO 99
               ENDIF
  80        CONTINUE
         ENDIF
      ENDIF
  99  RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE fzicv (MS,IRMT)
      COMMON /quest/ iquest(100)
      COMMON /mzioc/ nwfoav,nwfott,nwfodn,nwfore,ifocon(3)
     +,              mfosav(2),  jfoend,jforep,jfocur,mfo(200)
      dimension    ms(99), irmt(99)
      DOUBLE PRECISION   THDB
      dimension    this(2)
      equivalence(thdb,this)
      equivalence(itha,tha,this(1)), (ithb,thb,this(2))
 
      jms = 0
      IF (nwfodn.NE.0) GO TO 30
      nwfore = nwfott
      jmsex = min(nwfore,nwfoav)
      jmt = 0
      jfocur = 0
      ifocon(1) = 0
   21 itype = mfo(jfocur+1)
      IF (itype.EQ.7) GO TO 24
      nwsec = mfo(jfocur+2)
      IF (nwsec) 22, 23, 31
   22 nwsec = nwfore
      GO TO 31
   23 iword = ms(jms+1)
      nwsec = iword
      GO TO 25
   24 iword = ms(jms+1)
      itype = mod(iword,16)
      nwsec = iword/16
   25 irmt(jmt+1) = iword
      jms = jms + 1
      jmt = jmt + 1
      nwfore = nwfore - 1
      IF (itype.GE.8) GO TO 27
      IF (nwsec.EQ.0) GO TO 29
      IF (nwsec.GT.0) GO TO 31
   27 ifocon(1) = -1
      ifocon(2) = jmt
      ifocon(3) = iword
   29 itype = 0
      nwsec = nwfore
      GO TO 31
   30 jmsex = min(nwfore,nwfoav)
      jmt = nwfodn
      itype = mfosav(1)
      nwsec = mfosav(2)
   31 nwdo = min(nwsec,jmsex-jms)
      IF (nwdo.EQ.0) GO TO 801
      IF (itype.LE.0) GO TO 91
      GO TO (101,201,301,401,501,101,101), itype
   91 CALL vzeroi (irmt(jmt+1),nwdo)
      jmt = jmt + nwdo
      jms = jms + nwdo
      GO TO 801
  401 ndpn = nwdo / 2
      nwdodb = ndpn * 2
      IF (nwdodb.EQ.0) GO TO 451
      DO 449 jl=1,ndpn
      irmt(jmt+1) = ms(jms+2)
      irmt(jmt+2) = ms(jms+1)
      jmt = jmt + 2
  449 jms = jms + 2
  451 IF (nwdodb .EQ.nwdo) GO TO 801
      IF (nwdodb+1.EQ.nwsec) GO TO 471
      IF (nwdodb+1.EQ.nwfore) GO TO 471
      nwdo = nwdodb
      jms = jms + 2
      GO TO 801
  471 jmt = jmt + 1
      jms = jms + 1
      ifocon(1) = -2
      ifocon(2) = jmt
      ifocon(3) = nwdo
      irmt(jmt) = 0
      GO TO 801
  501 CONTINUE
      CALL vxinvc (ms(jms+1),irmt(jmt+1),nwdo)
      jmt = jmt + nwdo
      jms = jms + nwdo
      GO TO 801
  301 CONTINUE
  201 CONTINUE
  101 CONTINUE
      CALL ucopyi (ms(jms+1),irmt(jmt+1),nwdo)
      jmt = jmt + nwdo
      jms = jms + nwdo
  801 nwfore = nwfott - jmt
      IF (jms.GE.jmsex) GO TO 804
      jfocur = jfocur + 2
      IF (jfocur.LT.jfoend) GO TO 21
      jfocur = jforep
      GO TO 21
  804 iquest(1) = jms
      nwfoav = nwfoav - jms
      IF (nwfore.EQ.0) RETURN
      nwfodn = jmt
      mfosav(1) = itype
      mfosav(2) = nwsec - nwdo
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE fzirel
      COMMON /zbcd/  iqnum2(11),iqlett(26),iqnum(10),   iqplus,iqmins
     +,              iqstar,iqslas,iqopen,iqclos,iqdoll,iqequ, iqblan
     +,              iqcoma,iqdot, iqnumb,iqapo, iqexcl,iqcolo,iqquot
     +,              iqunde,iqclsq,iqand, iqat,  iqques,iqopsq,iqgrea
     +,              iqless,iqreve,iqcirc,iqsemi,iqperc,  iqlowl(26)
     +,              iqcrop,iqvert,iqcrcl,iqnot, iqgrav,  iqileg
     +,              nqhol0,nqholl(95)
      parameter(iqbitw=32, iqbitc=8, iqchaw=4)
      COMMON /zmach/ nqbitw,nqbitc,nqchaw
     +,              nqlnor,nqlmax,nqlpth,nqrmax,iqlpct,iqnil
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun,  nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
                   equivalence(lqfs,lqsyss(4)), (lqff,lqsysr(4))
     +,                        (lqfi,lqsysr(5)), (lqfx,lqsysr(6))
      COMMON /mzcn/  iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      COMMON /mzct/  mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +,              mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +,              iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +,              lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +,                         lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +,              lqmtc1,lqmtc2, nqfrtc,nqlive
      COMMON /fzci/  luni,lunni,ixdivi,ltempi,ievfli
     +,              mstati,mediui,ififoi,idafoi,iacmoi,iupaki
     +,              iadopi,iactvi,incbpi,loglvi,maxrei,  isteni
     +,              lbpari, l4stoi,l4stai,l4curi,l4endi
     +,              iflagi,nfasti,n4skii,n4resi,n4doni,n4endi
     +,              ioptie,ioptir,ioptis,ioptia,ioptit,ioptid
     +,                     ioptif,ioptig,ioptih,iopti2(4)
     +,              idi(2),ipili(4),nwtxi,nwsegi,nwtabi,nwbki,lentri
     +,              nwuhci,iochi(16),nwumxi,nwuhi,nwioi
     +,              nwrdai,nrecai,luheai,jretcd,jerror,nwerr
      parameter(jauioc=50, jauseg=68, jauear=130)
      dimension    ladesv(6)
      dimension    namesr(2)
      DATA  namesr / 4hfzir, 4hel   /
      DATA  ladesv / 6, 5*0 /
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      IF (nwtabi.EQ.0)             GO TO 61
      lput  = lqta
      ltake = lqta + nwtabi
      lmt = lqmta
   22 IF (lq(lmt+1).NE.0)          GO TO 24
      nwsg  = lq(lmt+3)
   23 IF (nwsg.GE.0)               GO TO 29
      IF (ltake.GE.lqte)           GO TO 731
      nwsg  = nwsg + (lq(ltake+1)-lq(ltake))
      ltake = ltake + 2
      GO TO 23
   24 lsta  = lq(lmt+3)
      lend  = lq(lmt+4)
      nwsg  = lsta - lend
      nrel  = 0
      le    = lsta
   25 IF (ltake.GE.lqte)           GO TO 731
      la    = lq(ltake)
      nrel  = nrel - (la-le)
      le    = lq(ltake+1)
      lq(lput)   = la
      lq(lput+1) = le
      lq(lput+2) = nrel
      lq(lput+3) = 0
      ltake = ltake + 2
      lput  = lput  + 4
      nwsg  = nwsg + (le-la)
      IF (nwsg.LT.0)               GO TO 25
   29 IF (nwsg.NE.0)               GO TO 732
      lmt = lmt + 8
      IF (lmt.LT.lqmte)            GO TO 22
      IF (ltake.NE.lqte)           GO TO 733
      lqte = lput
      lq(lqte)   =  lq(lqte-3)
      lq(lqta-1) =  lq(lqta)
      IF (loglvi.GE.4)
     +  WRITE (iqlog,9167) lentri,(lq(j),j=lqta,lqte-1)
 9167 FORMAT (' FZIREL-  Relocation Table, LENTRY before=',i10/
     f (15x,3i9,i4))
      iqflio = 7
      CALL mzrelb
      IF (iqflio.LT.0)             GO TO 734
      ladesv(2) = locf(lentri) - lqstor
      ladesv(3) = ladesv(2) + 1
      ladesv(5) = iqlett(9)
      ladesv(6) = iqlett(15)
      CALL mzrell (ladesv)
      IF (loglvi.GE.4)  WRITE (iqlog,9037) lentri
 9037 FORMAT (10x,'LENTRY after=',i10)
      lq(kqs+lentri+1) = 0
      lq(kqs+lentri+2) = 0
      GO TO 999
   61 CALL fzilin
      IF (iqfoul.NE.0)             GO TO 734
      lentri = iquest(1)
  999 nqtrac = nqtrac - 2
      RETURN
  734 jerror = 34
      iquest(14)= iqln
      nwerr  = 1
      GO TO 739
  733 jerror = 33
      iquest(14)= ltake
      iquest(15)= lqte
      nwerr  = 2
      GO TO 739
  732 jerror = 32
      iquest(14)= nwsg
      nwerr  = 1
      GO TO 739
  731 jerror = 31
      iquest(14)= nwsg
      nwerr  = 1
  739 jretcd = 5
      GO TO 999
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE fzilin
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzcn/  iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      COMMON /mzct/  mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +,              mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +,              iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +,              lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +,                         lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +,              lqmtc1,lqmtc2, nqfrtc,nqlive
      iqfoul = 0
      lentri = 0
      k   = 0
      lmt = lqmta
   22 IF (lq(lmt+1).LE.0)          GO TO 29
      iqnx  = lq(lmt+3)
      lend  = lq(lmt+4)
   24 CALL mzchln (-7,iqnx)
      IF (iqfoul.NE.0)             GO TO 91
      IF (iqnd.LT.0)               GO TO 27
      IF (k.EQ.0)  THEN
          lentri = iqls
        ELSE
          lq(kqs+k) = iqls
        ENDIF
      l = iqls - iqnl - 1
      DO 26  j=1, iqnl+2
   26 lq(kqs+l+j) = 0
      lq(kqs+iqls+2) = k
      k = iqls
   27 IF (iqnx.LT.lend)            GO TO 24
      IF (iqnx.NE.lend)            GO TO 91
   29 lmt = lmt + 8
      IF (lmt.LT.lqmte)            GO TO 22
      iquest(1) = lentri
      RETURN
   91 iqfoul = 7
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzchls (IXST,LP)
      parameter(iqbitw=32, iqbitc=8, iqchaw=4)
      COMMON /zmach/ nqbitw,nqbitc,nqchaw
     +,              nqlnor,nqlmax,nqlpth,nqrmax,iqlpct,iqnil
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzcn/  iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      dimension    ixst(9), lp(9)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      ixstor = ixst(1)
      iqls   = lp(1)
      IF (ixstor.EQ.-7)                 GO TO 21
      IF (jbyt(ixstor,27,6).NE.jqstor)  CALL mzsdiv (ixstor,-7)
   21 IF (iqls.LT.lqsta(kqt+1))       GO TO 98
      IF (iqls.GE.lqsta(kqt+21))      GO TO 98
      iqnio = jbyt(iq(kqs+iqls),19,4)
      iqid  = iq(kqs+iqls-4)
      iqnl  = iq(kqs+iqls-3)
      iqns  = iq(kqs+iqls-2)
      iqnd  = iq(kqs+iqls-1)
      IF (  jbyt(iqnl,iqbitw-3,4)
     +    + jbyt(iqns,iqbitw-3,4)
     +    + jbyt(iqnd,iqbitw-3,4) .NE.0)    GO TO 91
      iqnx  = iqls + iqnd + 9
      IF (iqnx.GT.lqsta(kqt+21))      GO TO 91
      iqln  = iqls - iqnl - iqnio - 1
      IF (iqln.LT.lqsta(kqt+1))       GO TO 91
      nst = jbyt(lq(kqs+iqln),1,16) - 12
      IF (nst.NE.iqnio+iqnl)       GO TO 91
      IF (iqns.GT.iqnl)            GO TO 91
      iqfoul = 0
      RETURN
   91 iqfoul = 7
      RETURN
   98 iqfoul = -7
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzbook (IXP,LP,LSUPP,JBP, CHIDH,NL,NS,ND,NIOP,NZP)
      COMMON /zbcd/  iqnum2(11),iqlett(26),iqnum(10),   iqplus,iqmins
     +,              iqstar,iqslas,iqopen,iqclos,iqdoll,iqequ, iqblan
     +,              iqcoma,iqdot, iqnumb,iqapo, iqexcl,iqcolo,iqquot
     +,              iqunde,iqclsq,iqand, iqat,  iqques,iqopsq,iqgrea
     +,              iqless,iqreve,iqcirc,iqsemi,iqperc,  iqlowl(26)
     +,              iqcrop,iqvert,iqcrcl,iqnot, iqgrav,  iqileg
     +,              nqhol0,nqholl(95)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzcl/  nqln,nqls,nqnio,nqid,nqnl,nqns,nqnd,nqioch(16)
     +,              lqsup,nqbia, nqiosv(3)
      dimension    ixp(9),lp(9),lsupp(9),jbp(9),niop(9),nzp(9)
      CHARACTER    CHIDH*(*)
      dimension    namesr(2)
      DATA  namesr / 4hmzbo, 4hok   /
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      nqid = iqques
      nio  = min(4, len(chidh))
      IF  (nio.NE.0)  CALL uctoh (chidh,nqid,4,nio)
      nqnl  = nl
      nqns  = ns
      nqnd  = nd
      nqbia = jbp(1)
      iodorg = niop(1)
      nio = jbyt(iodorg,12,4)
      IF (nio.EQ.0)  THEN
          nqioch(1) = iodorg
        ELSE
          CALL ucopyi (niop,nqioch,nio+1)
          nqiosv(1) = 0
        ENDIF
        CALL mzlift (ixp,lp,lsupp,63, nqid, nzp)
  999 nqtrac = nqtrac - 2
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzlift (IXDIV,LP,LSUPP,JBIAS,NAME,NZERO)
      parameter(iqbitw=32, iqbitc=8, iqchaw=4)
      COMMON /zmach/ nqbitw,nqbitc,nqchaw
     +,              nqlnor,nqlmax,nqlpth,nqrmax,iqlpct,iqnil
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +,              nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun,  nqused
      COMMON /zvfaut/iqvid(2),iqvsta,iqvlog,iqvthr(2),iqvrem(2,6)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      dimension    lqmst(9)
      equivalence(lqmst(1),lqsyss(2))
      equivalence(lqform,lqsyss(5))
      COMMON /mzcl/  nqln,nqls,nqnio,nqid,nqnl,nqns,nqnd,nqioch(16)
     +,              lqsup,nqbia, nqiosv(3)
      COMMON /mzcn/  iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      COMMON /mzct/  mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +,              mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +,              iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +,              lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +,                         lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +,              lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension    ixdiv(9), lp(9), lsupp(9), name(9)
      dimension    namesr(2)
      DATA  namesr / 4hmzli, 4hft   /
      jbit(izw,izp)     = iand(ishft(izw,-(izp-1)),1)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      msbyt(mz,izw,izp,nzb) = ior(
     +       iand(izw, not(ishft(ishft(not(0),-(32-nzb)),izp-1)))
     +      ,ishft(ishft(mz,32-nzb), -(33-izp-nzb)) )
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
******IF (IQVSTA.NE.0)       CALL ZVAUTX
      IF (jbias.NE.63)  THEN
          nqbia = jbias
          nio   = jbyt(name(5),12,4)
          CALL ucopyi (name,nqid,nio+5)
          IF (nio.NE.0)  nqiosv(1)=0
        ENDIF
      jdv   = ixdiv(1)
      lqsup = lsupp(1)
      IF (nqbia.GE.2)  lqsup = 0
      ichorg = nqioch(1)
      ntot   = nqnl + nqnd + 10
      IF (jdv.EQ.-7)                 GO TO 24
      IF (jbyt(jdv,27,6).NE.jqstor)  GO TO 22
      jqdivi = jbyt(jdv,1,26)
      IF (jqdivi.LT.21)              GO TO 23
   22 CALL mzsdiv (jdv,0)
   23 CALL mzchnb (lp)
   24 CONTINUE
      j = jbyt(nqid,iqbitw-7,8)
      IF (j.EQ.0)                  GO TO 91
      IF (j.EQ.255)                GO TO 91
      IF (ntot.GE.lqsta(kqt+21))      GO TO 91
      IF (nqns.GT.nqnl)            GO TO 91
      IF (nqns.LT.0)               GO TO 91
      IF (nqnl.GT.64000)           GO TO 91
      IF (nqnd.LT.0)               GO TO 91
      IF (nqbia.GE.3)              GO TO 91
      IF (lqsup.EQ.0)              GO TO 25
      CALL mzchls (-7,lqsup)
      IF (iqfoul.NE.0)             GO TO 92
      IF (nqbia.EQ.1)              GO TO 26
      IF (jbit(iq(kqs+lqsup),iqdrop).NE.0)  GO TO 92
      IF (iqns+nqbia.LT.0)         GO TO 93
      GO TO 26
   25 IF (nqbia.LE.0)              GO TO 92
   26 CONTINUE
      idn   = 1
      ls    = lqsup
      lsame = lqsup
      lnext = lqsup
      IF (nqbia.GT.0)              GO TO 38
      lnext = lq(kqs+lnext+nqbia)
      IF (lnext.EQ.0)              GO TO 36
      lsame = lnext
      ls    = lnext
      CALL mzchls (-7,lnext)
      IF (iqfoul.NE.0)             GO TO 94
      idn = iq(kqs+lnext-5) + 1
      GO TO 39
   36 IF (nqbia.EQ.0)              GO TO 37
      lsame = 0
      idn   = -nqbia
      GO TO 39
   37 idn = iq(kqs+lsame-5) + 1
      GO TO 39
   38 IF (lnext.NE.0)  idn=iq(kqs+lnext-5)+1
   39 CONTINUE
      IF (ichorg.LT.0)             GO TO 47
      IF (ichorg.LT.8)  THEN
          nqnio = 0
          nqioch(1) = ishft(ichorg, 16)
          GO TO 49
        ENDIF
      IF (ichorg-11)         45, 43, 47
   43 IF (lsame.EQ.0)              GO TO 45
      nqnio = iqnio
      IF (nqnio.EQ.0)  THEN
          nqioch(1) = lq(kqs+iqln)
          GO TO 49
        ELSE
          CALL ucopyi (lq(kqs+iqln),nqioch,nqnio+1)
          nqiosv(1) = 0
          GO TO 49
        ENDIF
   45 lid  = lqform
      IF (lid.EQ.0)                GO TO 95
      liod = lq(kqsp+lid-2)
      IF (nqid.LT.0)  lid=lq(kqsp+lid)
      IF (nqid.EQ.iq(kqsp+lid+3))  THEN
          ixio = iq(kqsp+lid+2)
        ELSE
          n = iq(kqsp+lid+1)
          IF (n.EQ.0)              GO TO 95
          j = iucomp(nqid,iq(kqsp+lid+4),n)
          IF (j.EQ.0)              GO TO 95
          lix  = lq(kqsp+lid-1)
          ixio = iq(kqsp+lix+j)
          iq(kqsp+lid+2) = ixio
          iq(kqsp+lid+3) = nqid
        ENDIF
      nqnio = jbyt(iq(kqsp+liod+ixio+1),7,5) - 1
      GO TO 48
   47 j     = jbyt(ichorg,1,6)
      nqnio = jbyt(ichorg,7,5) - 1
      ioth  = jbyt(ichorg,12,5)
      IF (j.EQ.1)  THEN
          IF (nqnio.NE.ioth)       GO TO 96
          GO TO 49
        ENDIF
      IF (j.NE.2)                  GO TO 96
      IF (ioth.NE.0)               GO TO 96
      ixio = jbyt(ichorg,17,16)
      IF (ixio.EQ.0)               GO TO 96
      liod = lq(kqsp+lqform-2)
      IF (ixio.GE.iq(kqsp+liod+1))    GO TO 96
   48 IF (ixio.EQ.nqiosv(1))  THEN
          nqioch(1) = nqiosv(2)
          GO TO 49
        ENDIF
      nqiosv(1) = 0
      IF (nqnio.GE.16)             GO TO 96
      CALL ucopyi (iq(kqsp+liod+ixio+1),nqioch,nqnio+1)
      ioth = jbyt(nqioch(1),12,5)
      IF (nqnio.NE.ioth)           GO TO 96
      nqiosv(1) = ixio
      nqiosv(2) = nqioch(1)
   49 ntot = ntot + nqnio
      IF (jqdivi.NE.0)             GO TO 59
      IF (ls.LT.lqsta(kqt+1))         GO TO 58
      IF (ls.GE.lqend(kqt+20))        GO TO 58
      IF (ls.GE.lqend(kqt+jqdvll))    GO TO 54
      IF (ls.LT.lqend(kqt+2))         GO TO 57
      jqdivi = 3
      GO TO 55
   54 jqdivi = jqdvsy
   55 IF (ls.LT.lqend(kqt+jqdivi))    GO TO 61
      jqdivi = jqdivi + 1
      GO TO 55
   57 jqdivi = 1
      IF (ls.LT.lqsta(kqt+2))         GO TO 61
   58 jqdivi = 2
      GO TO 61
   59 IF (lsame.EQ.0)               GO TO 61
      IF (lsame.LT.lqsta(kqt+jqdivi))  GO TO 97
      IF (lsame.GE.lqend(kqt+jqdivi))  GO TO 97
   61 CALL mzresv
      nqresv = nqresv - ntot
      IF (nqresv.LT.0)             GO TO 81
      IF (jqmode.NE.0)             GO TO 63
      nqln  = lqend(kqt+jqdivi)
      le    = nqln + ntot
      lqend(kqt+jqdivi) = le
      GO TO 65
   63 le    = lqsta(kqt+jqdivi)
      nqln  = le - ntot
      lqsta(kqt+jqdivi) = nqln
   65 nz = min(nzero,nqnd)
      IF (nz.EQ.0)  nz=nqnd
      IF (nz.LT.0)  nz=0
      nst  = nqnio + nqnl
      nqls = nqln + nst + 1
      CALL vzeroi (lq(kqs+nqln+nqnio+1),nqnl+nz+9)
      nqioch(1) = msbyt(nst+12,nqioch(1),1,16)
      DO 67  j=0,nqnio
   67 lq(kqs+nqln+j) = nqioch(j+1)
      iq(kqs+nqls-5) = idn
      iq(kqs+nqls-4) = nqid
      iq(kqs+nqls-3) = nqnl
      iq(kqs+nqls-2) = nqns
      iq(kqs+nqls-1) = nqnd
      iq(kqs+nqls)   = ishft(nqnio,18)
      IF   (nqbia-1)         72, 73, 79
   72 lup   = lqsup
      kadr  = lqsup + nqbia
      lnext = lq(kqs+kadr)
      IF (nqbia.NE.0)              GO TO 77
      lup   = lq(kqs+lup+1)
      GO TO 77
   73 lnext = lqsup
      IF (lnext.NE.0)              GO TO 74
      lup  = 0
      kadr = locf(lsupp(1)) - lqstor
      IF (kadr.LT.lqsta(kqt+1))       GO TO 78
      IF (kadr.LT.lqsta(kqt+21))      GO TO 98
      GO TO 78
   74 lup  = lq(kqs+lnext+1)
      kadr = lq(kqs+lnext+2)
   77 IF (lnext.EQ.0)              GO TO 78
      lq(kqs+nqls)    = lnext
      lq(kqs+lnext+2) = nqls
   78 lq(kqs+nqls+1) = lup
      lq(kqs+nqls+2) = kadr
      lq(kqs+kadr)   = nqls
   79 lp(1) = nqls
      IF (nqlogl.GE.2)
     + WRITE (iqlog,9079) jqstor,jqdivi,nqls,lqsup,nqbia,
     +                                  nqid,nqnl,nqns,nqnd
 9079 FORMAT (' MZLIFT-  Store/Div',2i3,' L/LSUP/JBIAS=',2i9,i6,
     f' ID,NL,NS,ND= ',a4,2i6,i9)
  999 nqtrac = nqtrac - 2
      RETURN
   81 lqmst(kqt+1) = lqsup
      CALL mzgar1
      lqsup = lqmst(kqt+1)
      IF (nqbia.GE.1)              GO TO 61
      kadr = locf (lsupp(1)) - lqstor
      IF (kadr.LT.lqsta(kqt+1))       GO TO 83
      IF (kadr.LT.lqsta(kqt+21))      GO TO 61
   83 lsupp(1) = lqsup
      GO TO 61
   98 nqcase = 8
      nqfata = 1
      iquest(18) = kadr
      GO TO 90
   97 nqcase = 7
      nqfata = 1
      iquest(18) = lsame
      GO TO 90
   94 nqcase = 4
      nqfata = 1
      iquest(18) = lnext
      GO TO 90
   96 nqcase = 1
   95 nqcase = nqcase + 2
   93 nqcase = nqcase + 1
   92 nqcase = nqcase + 1
   91 nqcase = nqcase + 1
   90 nqfata = nqfata + 7
      iquest(11) = lqsup
      iquest(12) = nqbia
      iquest(13) = nqid
      iquest(14) = nqnl
      iquest(15) = nqns
      iquest(16) = nqnd
      iquest(17) = ichorg
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzlink (IXSTOR,CHNAME,LAREA,LREF,LREFL)
      COMMON /zbcd/  iqnum2(11),iqlett(26),iqnum(10),   iqplus,iqmins
     +,              iqstar,iqslas,iqopen,iqclos,iqdoll,iqequ, iqblan
     +,              iqcoma,iqdot, iqnumb,iqapo, iqexcl,iqcolo,iqquot
     +,              iqunde,iqclsq,iqand, iqat,  iqques,iqopsq,iqgrea
     +,              iqless,iqreve,iqcirc,iqsemi,iqperc,  iqlowl(26)
     +,              iqcrop,iqvert,iqcrcl,iqnot, iqgrav,  iqileg
     +,              nqhol0,nqholl(95)
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +,              nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun,  nqused
      COMMON /zvfaut/iqvid(2),iqvsta,iqvlog,iqvthr(2),iqvrem(2,6)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      dimension    larea(9),lref(9),lrefl(9),name(2)
      CHARACTER    *(*) CHNAME
      dimension    namesr(2)
      DATA  namesr / 4hmzli, 4hnk   /
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      IF (jbyt(ixstor,27,6).NE.jqstor)  CALL mzsdiv (ixstor,-7)
******IF (IQVSTA.NE.0)       CALL ZVAUTX
      lsys  = lqsyss(kqt+1)
      nwtab = iq(kqs+lsys+1)
      IF (nwtab+5.GT.iq(kqs+lsys-1))  THEN
          jqdivi = jqdvsy
          CALL mzpush (-7,lsys,0,100,'I')
          lqsyss(kqt+1) = lsys
        ENDIF
      lsto = lsys + nwtab
      locar = locf(larea(1)) - lqstor
      locr  = locf(lref(1))  - lqstor
      locrl = locf(lrefl(1)) - lqstor
      ns = locr    - locar
      nl = locrl+1 - locar
      IF (nl.EQ.1)  THEN
          ns = ns + 1
          nl = ns
        ENDIF
      locare = locar + nl
      modar  = ns
      name(1) = iqblan
      name(2) = iqblan
      n = min(8, len(chname))
      IF (n.NE.0)  CALL uctoh (chname,name,4,n)
      iq(kqs+lsto+1) = locar
      iq(kqs+lsto+2) = locare
      iq(kqs+lsto+3) = modar
      iq(kqs+lsto+4) = name(1)
      iq(kqs+lsto+5) = name(2)
      iqtabv(kqt+13) = min(iqtabv(kqt+13), locar)
      iqtabv(kqt+14) = max(iqtabv(kqt+14), locare)
      IF (nqlogl.GE.0)
     +WRITE (iqlog,9039) name,jqstor,nl,ns
 9039 FORMAT (1x/' MZLINK.  Initialize Link Area  ',2a4,'  for Store'
     f,i3,' NL/NS=',2i6)
      IF (locr .LT.locar)          GO TO 91
      IF (locrl.LT.locar)          GO TO 91
      IF (nl.LT.ns)                GO TO 91
      kla = kqs + locar
      kle = kqs + locare
      DO 47  jsto=1,nqstor+1
      IF (nqallo(jsto).NE.0)       GO TO 47
      jt  = nqofft(jsto)
      js  = nqoffs(jsto)
      jsa = js  - iqtabv(jt+2) + 1
      jse = js  + lqsta(jt+21) + 1
      jta = jt  + lqbtis       + 1
      jte = jta + nqtsys
      IF (kle.GT.jta .AND. kla.LT.jte)    GO TO 92
      IF (kle.GT.jsa .AND. kla.LT.jse)    GO TO 93
      l = js+ lqsyss(jt+1)
      n = iq(l+1)
      IF (n.LT.12)                 GO TO 47
      DO 44  j=12,n,5
      jla = js + iq(l+j)
      jle = js + iq(l+j+1)
      IF (kle.GT.jla .AND. kla.LT.jle)    GO TO 94
   44 CONTINUE
   47 CONTINUE
   61 iq(kqs+lsys+1) = nwtab + 5
      CALL vzeroi (larea,nl)
  999 nqtrac = nqtrac - 2
      RETURN
   94 nqcase = 1
      nqfata = 3
      iquest(21) = iq(l+j+3)
      iquest(22) = iq(l+j+4)
      iquest(23) = jla + lqstor
   93 nqcase = nqcase + 1
   92 nqcase = nqcase + 1
      nqfata = nqfata + 3
      iquest(18) = jsto - 1
      iquest(19) = nqpnam(jt+1)
      iquest(20) = nqpnam(jt+2)
   91 nqcase = nqcase + 1
      nqfata = nqfata + 7
      iquest(11) = name(1)
      iquest(12) = name(2)
      iquest(13) = locar + lqstor
      iquest(14) = locr  + lqstor
      iquest(15) = locrl + lqstor
      iquest(16) = ns
      iquest(17) = nl
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzpush (IXDIV,LORGP,INCNLP,INCNDP,CHOPT)
      COMMON /zbcd/ iqnum2(11),iqlett(26),iqnum(10), iqplus,iqmins
     +, iqstar,iqslas,iqopen,iqclos,iqdoll,iqequ, iqblan
     +, iqcoma,iqdot, iqnumb,iqapo, iqexcl,iqcolo,iqquot
     +, iqunde,iqclsq,iqand, iqat, iqques,iqopsq,iqgrea
     +, iqless,iqreve,iqcirc,iqsemi,iqperc, iqlowl(26)
     +, iqcrop,iqvert,iqcrcl,iqnot, iqgrav, iqileg
     +, nqhol0,nqholl(95)
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      COMMON /zvfaut/iqvid(2),iqvsta,iqvlog,iqvthr(2),iqvrem(2,6)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzcl/ nqln,nqls,nqnio,nqid,nqnl,nqns,nqnd,nqioch(16)
     +, lqsup,nqbia, nqiosv(3)
      COMMON /mzcn/ iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension ixdiv(9),lorgp(9),incnlp(9),incndp(9)
      CHARACTER *(*) CHOPT
      dimension namesr(2)
      DATA namesr / 4hmzpu, 4hsh  /
      jbit(izw,izp) = iand(ishft(izw,-(izp-1)),1)
      msbit1(izw,izp) = ior(izw, ishft(1,izp-1))
      msbyt(mz,izw,izp,nzb) = ior(
     + iand(izw, not(ishft(ishft(not(0),-(32-nzb)),izp-1)))
     + ,ishft(ishft(mz,32-nzb), -(33-izp-nzb)) )
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      IF (ixdiv(1).EQ.-7) GO TO 12
      CALL mzsdiv (ixdiv,0)
   12 CALL mzchnb (lorgp)
      lorg = lorgp(1)
      incnl = incnlp(1)
      incnd = incndp(1)
      CALL uoptc (chopt,'RI',iquest)
      iflag = min(2, iquest(1)+2*iquest(2))
      IF ((incnl.EQ.0) .AND. (incnd.EQ.0)) GO TO 999
      lqsysr(kqt+1) = lorg
      jqdivi = mzfdiv(-7, lorg)
      IF (jqdivi.EQ.0) GO TO 91
      CALL mzchls (-7,lorg)
      IF (iqfoul.NE.0) GO TO 91
      nl = iqnl
      ns = iqns
      nd = iqnd
      nqnio = iqnio
      nqid = iqid
      nqnl = nl + incnl
      nqns = min(ns,nqnl)
      nqnd = nd + incnd
      IF (ns.EQ.nl) nqns = nqnl
      IF (nqlogl.GE.2)
     + WRITE (iqlog,9032) jqstor,jqdivi,lorg,nqid,incnl,incnd,chopt
 9032 FORMAT (' MZPUSH-  Store/Div',2i3,' L/ID/INCNL/INCND/OPT=',
     fi9,1x,a4,2i7,1x,a)
      IF (jbit(iq(kqs+lorg),iqdrop).NE.0) GO TO 92
      IF (nqnd+nqnl.GE.lqsta(kqt+21)) GO TO 93
      IF (nqnd.LT.0) GO TO 93
      IF (nqnl.GT.64000) GO TO 93
      IF (nqns.LT.0) GO TO 93
      nlc = min(nl,nqnl)
      nsc = min(ns,nqns)
      ndc = min(nd,nqnd)
      IF (nqns.GE.ns) GO TO 36
      l = lorg - ns - 1
      ld = lorg - nqns
   34 l = l + 1
      IF (l.GE.ld) GO TO 36
      lnz = lq(kqs+l)
   35 IF (lnz.EQ.0) GO TO 34
      IF (lq(kqs+lnz+2).NE.l) GO TO 34
      IF (jbit(iq(kqs+lnz),iqdrop).EQ.0) GO TO 94
      lnz = lq(kqs+lnz)
      GO TO 35
   36 ln = lorg - nl - nqnio - 1
      CALL ucopyi (lq(kqs+ln),nqioch,nqnio+1)
      IF (nqnio.NE.0) nqiosv(1)=0
      nqioch(1) = msbyt(nqnl+nqnio+12,nqioch(1),1,16)
   41 le = lorg + nd + 9
      inctt = incnl + incnd
      incmx = max(incnl,incnd)
      incmi = min(incnl,incnd)
      CALL mzresv
      IF (jqmode.NE.0) GO TO 45
      IF (le.NE.lqend(kqt+jqdivi)) GO TO 51
      IF (incnl.GE.0) GO TO 42
      IF (iflag.NE.1) GO TO 42
      IF ((nqresv.GE.inctt).AND.(nqresv.LT.incnd)) GO TO 42
      lnn = ln - incnl
      CALL ucopyi (nqioch,lq(kqs+lnn),nqnio+1)
      iq(kqs+lorg-3) = nqnl
      iq(kqs+lorg-2) = nqns
      nwd = -incnl
      CALL mzpudx (ln,nwd)
      incnl = 0
      inctt = incnd
      ln = lnn
      nl = nqnl
   42 nqresv = nqresv - inctt
      IF (nqresv.LT.0) GO TO 49
      ndelta = incnl
      lnew = lorg + ndelta
      lqend(kqt+jqdivi) = lqend(kqt+jqdivi) + inctt
      IF (ndelta.EQ.0) THEN
          iq(kqs+lnew-1) = nqnd
          IF (iflag.NE.0) GO TO 81
          IF (incmi.GE.0) GO TO 81
          GO TO 71
        ELSE
          CALL ucopy2 (lq(kqs+lorg-nlc),lq(kqs+lnew-nlc),nlc+ndc+9)
          IF (incnl.GT.0) CALL vzeroi (lq(kqs+lnew-nqnl),incnl)
          lq(kqs+ln) = nqioch(1)
          iq(kqs+lnew-3) = nqnl
          iq(kqs+lnew-2) = nqns
          iq(kqs+lnew-1) = nqnd
          GO TO 61
        ENDIF
   45 IF (ln.NE.lqsta(kqt+jqdivi)) GO TO 51
      IF (incnd.GE.0) GO TO 47
      IF (iflag.NE.1) GO TO 47
      IF ((nqresv.GE.inctt).AND.(nqresv.LT.incnl)) GO TO 47
      iq(kqs+lorg-1) = nqnd
      l = le + incnd
      nwd = -incnd
      CALL mzpudx (l,nwd)
      incnd = 0
      inctt = incnl
      nd = nqnd
   47 nqresv = nqresv - inctt
      IF (nqresv.LT.0) GO TO 49
      lnn = ln - inctt
      ndelta = -incnd
      lqsta(kqt+jqdivi) = lnn
      lnew = lorg + ndelta
      IF (ndelta.NE.0) CALL ucopy2 (lq(kqs+lorg-nlc)
     +, lq(kqs+lnew-nlc), nlc+ndc+9)
      IF (incnl.GT.0) CALL vzeroi (lq(kqs+lnew-nqnl),incnl)
      CALL ucopyi (nqioch,lq(kqs+lnn),nqnio+1)
      iq(kqs+lnew-3) = nqnl
      iq(kqs+lnew-2) = nqns
      iq(kqs+lnew-1) = nqnd
      IF (ndelta.NE.0) GO TO 61
      IF (iflag.NE.0) GO TO 81
      IF (incmi.GE.0) GO TO 81
      GO TO 71
   49 CALL mzgar1
      lorg = lqsysr(kqt+1)
      ln = lorg - nl - nqnio - 1
      GO TO 41
   51 IF (incmx.GT.0) GO TO 56
      IF (incnl.EQ.0) GO TO 52
      lnn = ln - incnl
      CALL ucopyi (nqioch,lq(kqs+lnn),nqnio+1)
      iq(kqs+lorg-3)= nqnl
      iq(kqs+lorg-2)= nqns
      CALL mzpudx (ln,-incnl)
      IF (incnd.EQ.0) GO TO 54
   52 iq(kqs+lorg-1) = nqnd
      ld = le + incnd
      nwd = -incnd
      CALL mzpudx (ld,nwd)
   54 lnew = lorg
      ndelta = 0
      IF (iflag.NE.0) GO TO 999
      GO TO 71
   56 j = 64*(32*nqnio + nqnio + 1) + 1
      nqioch(1) = msbyt(j,nqioch(1),1,16)
      nqbia = 2
      CALL mzlift (-7,lnew,0,63,nqid,-1)
      lorg = lqsysr(kqt+1)
      ndelta = lnew - lorg
      CALL ucopyi (lq(kqs+lorg-nlc),lq(kqs+lnew-nlc),nlc+4)
      CALL ucopyi (iq(kqs+lorg), iq(kqs+lnew), ndc+1)
      iq(kqs+lorg) = msbit1(iq(kqs+lorg),iqdrop)
   61 IF (iflag.LT.2) GO TO 71
      k = lq(kqs+lnew+2)
      IF (k.EQ.0) GO TO 62
      IF (lq(kqs+k).NE.lorg) GO TO 95
      lq(kqs+k) = lnew
   62 k = lnew
      l = lq(kqs+k)
      IF (l.EQ.0) GO TO 65
      IF (l.EQ.lorg) GO TO 64
      lq(kqs+l+2) = k
   63 k = l
      l = lq(kqs+k)
      IF (l.EQ.0) GO TO 65
      IF (l.NE.lorg) GO TO 63
   64 lq(kqs+k) = lnew
   65 k = lnew - nsc - 1
   66 k = k + 1
      IF (k.GE.lnew) GO TO 81
      l = lq(kqs+k)
      IF (l.EQ.0) GO TO 66
      IF (lq(kqs+l+2).NE.k-ndelta) GO TO 66
      lq(kqs+l+2) = k
      lf = l
   68 lq(kqs+l+1) = lnew
      l = lq(kqs+l)
      IF (l.EQ.lf) GO TO 66
      IF (l.NE.0) GO TO 68
      GO TO 66
   71 mqdvga = 0
      mqdvwi = 0
      jqstmv = -1
      IF (nqlogl.GE.1)
     + WRITE (iqlog,9071) jqstor,jqdivi,lorg,nqid
 9071 FORMAT (' MZPUSH-  Store/Div',2i3,' Relocation pass for L/ID ='
     f,i9,1x,a4)
      CALL mztabm
      lmt = lqmta - 8
   74 lmt = lmt + 8
      IF (lq(lmt).NE.jqdivi) GO TO 74
      lq(lmt+1) = 2
      CALL mztabx
      lqmte = lqmtlu
      lq(lqta-1) = lorg - nl - nqnio - 1
      lq(lqta) = lorg - nlc
      lq(lqta+1) = lorg + ndc + 9
      lq(lqta+2) = ndelta
      lq(lqta+3) = 0
      lq(lqta+4) = lorg + nd + 9
      lqte = lqta + 4
      CALL mzrelx
      nqdpsh(kqt+jqdivi) = nqdpsh(kqt+jqdivi) + 1
   81 lorgp(1) = lnew
      IF (incnd.GT.0) CALL vzeroi (iq(kqs+lnew+nd+1),incnd)
  999 nqtrac = nqtrac - 2
      RETURN
   95 nqcase = 3
      nqfata = 1
      iquest(19) = k
      GO TO 92
   94 nqcase = 1
      nqfata = 2
      iquest(19) = l - lorg
      iquest(20) = lq(kqs+l)
   93 nqcase = nqcase + 1
   92 nqcase = nqcase + 1
      nqfata = nqfata + 7
      iquest(12) = nqid
      iquest(13) = ns
      iquest(14) = nl
      iquest(15) = nd
      iquest(16) = nqnio
      iquest(17) = incnl
      iquest(18) = incnd
   91 nqcase = nqcase + 1
      nqfata = nqfata + 1
      iquest(11) = lorg
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzneed (IXDIV,NEEDP,CHOPT)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      COMMON /zvfaut/iqvid(2),iqvsta,iqvlog,iqvthr(2),iqvrem(2,6)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension ixdiv(9),needp(9)
      CHARACTER *(*) CHOPT
      dimension namesr(2)
      DATA namesr / 4hmzne, 4hed  /
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      jdv = ixdiv(1)
      need = needp(1)
      IF (jbyt(jdv,27,6).NE.jqstor) GO TO 22
      jqdivi = jbyt(jdv,1,26)
      IF (jqdivi.EQ.0) GO TO 22
      IF (jqdivi.LT.21) GO TO 23
   22 CALL mzsdiv (jdv,4)
   23 CONTINUE
      CALL mzresv
      nqresv = nqresv - need
      IF (nqresv.LT.0) GO TO 41
   28 iquest(11) = nqresv
      iquest(12) = lqend(kqt+jqdivi) - lqsta(kqt+jqdivi)
      iquest(13) = nqdmax(kqt+jqdivi)
      IF (nqlogl.GE.2)
     + WRITE (iqlog,9029) jqstor,jqdivi,need,nqresv,chopt
 9029 FORMAT (' MZNEED-  Store/Div',2i3,' NEED/Excess=',2i8
     f,' Opt=',a)
  999 nqtrac = nqtrac - 2
      RETURN
   41 CALL uoptc (chopt,'G',iquest)
      IF (iquest(1).EQ.0) GO TO 28
      nqperm = 1
      CALL mzgar1
      nqperm = 0
      GO TO 28
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzdate(IWORD,IDATE,ITIME,ICASE)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      IF(icase.EQ.1)THEN
         icont = jbyt(iword,9,24)
         iminut= mod(icont,60)
         im1 = icont-iminut
         ihour = mod(im1/60,24)
         itime = 100*ihour+iminut
         im2 = im1-60*ihour
         iday = mod(im2/1440,31)
         IF(iday.EQ.0)iday=31
         im3 = im2-1440*iday
         imonth= mod(im3/44640,12)
         IF(imonth.EQ.0)imonth=12
         iyear = (im3-44640*imonth)/535680
         IF(iyear.GE.14) THEN
            idate = 10000*(iyear-14)+100*imonth+iday
         ELSE
            idate = 860000+10000*iyear+100*imonth+iday
         ENDIF
      ELSE
******   IF(ICASE.NE.3)CALL DATIME(IDATE,ITIME)
         IF(idate.GE.860000) THEN
            idat2 = idate - 860000
         ELSE
            idat2 = idate + 140000
         ENDIF
         iyear = idat2/10000
         imonth= (idat2-10000*iyear)/100
         iday = mod(idat2,100)
         ihour = itime/100
         iminut= mod(itime,100)
         icont2= iday+31*(imonth+12*iyear)
         icont = iminut+60*(ihour+24*icont2)
         CALL sbyt(icont,iword,9,24)
      ENDIF
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzcdir(CHPATH,CHOPT)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /rzcl/ ltop,lrz0,lcdir,lrin,lrout,lfree,lused,lpurg
     +, ltemp,lcord,lfrom
      equivalence(lqrs,lqsyss(7))
      parameter(nlpatm=100)
      COMMON /rzdirn/nlcdir,nlndir,nlpat
      COMMON /rzdirc/chcdir(nlpatm),chndir(nlpatm),chpat(nlpatm)
      CHARACTER*16 CHNDIR, CHCDIR, CHPAT
      COMMON /rzch/ chwold,chl
      CHARACTER*255 CHWOLD,CHL
      COMMON /rzclun/lun,lrec,isave,imodex,irelat,nhpwd,ihpwd(2)
     +, izrecl,imodec,imodeh
      parameter(kup=5,kpw1=7,knch=9,kdatec=10,kdatem=11,kquota=12,
     + krused=13,kwused=14,kmega=15,krzver=16,kirin=17,
     + kirout=18,krlout=19,kip1=20,knfree=22,knsd=23,kld=24,
     + klb=25,kls=26,klk=27,klf=28,klc=29,kle=30,knkeys=31,
     + knwkey=32,kkdes=33,knsize=253,kex=6,knmax=100)
      dimension ioptv(5)
      equivalence(ioptr,ioptv(1)), (ioptp,ioptv(2)), (ioptu,ioptv(3))
      equivalence(ioptk,ioptv(4)), (ioptq,ioptv(5))
      CHARACTER*(*) CHPATH,CHOPT
      CHARACTER*1 COPTQ
      jbit(izw,izp) = iand(ishft(izw,-(izp-1)),1)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      iquest(1)=0
      CALL uoptc (chopt,'RPUKQ',ioptv)
      IF(ioptk.NE.0) ioptu=0
      IF(ioptr.NE.0) chpath = ' '
      IF(lqrs.EQ.0) THEN
         iquest(1) = 4
         GOTO 999
      ENDIF
      lrz=lqrs
   10 IF(lrz.EQ.0) GOTO 20
      IF(iq(kqsp+lrz-5).NE.0) GOTO 30
      lrz=lq(kqsp+lrz)
      GO TO 10
   20 CONTINUE
      iquest(1) = 5
      GOTO 999
   30 CONTINUE
      IF(ioptr.NE.0)THEN
         CALL rzpaff(chcdir,nlcdir,chpath)
         GO TO 999
      ENDIF
      IF(ioptp.NE.0)THEN
         CALL rzpaff(chcdir,nlcdir,chl)
         WRITE(iqprnt,10000)chl(1:lenocc(chl))
10000 FORMAT(' Current Working Directory = ',a)
         GO TO 999
      ENDIF
      coptq = ' '
      IF(ioptq.NE.0) coptq = 'Q'
      IF(lcdir.NE.0.AND.isave.NE.0.AND.ioptk.EQ.0)THEN
         lbank=lcdir
   40 IF(lbank.NE.ltop)THEN
            lup=lq(kqsp+lbank+1)
            IF(ioptu.EQ.0)THEN
               CALL sbit1(iq(kqsp+lbank),iqdrop)
            ELSE
               CALL mzdrop(jqpdvs,lbank,' ')
               iq(kqsp+ltop+kirin)=0
            ENDIF
            lbank=lup
            IF(lbank.NE.0)GO TO 40
         ENDIF
      ENDIF
      IF(ioptu.NE.0)THEN
         print*,'>>>>>> CALL RZRTOP'
******   CALL RZRTOP
      ENDIF
      IF(isave.NE.0)THEN
         CALL rzsave
      ENDIF
      CALL rzpath(chpath)
      CALL rzfdir('RZCDIR',lt,ldir,coptq)
      IF(ldir.NE.0)THEN
         nlcdir= nlpat
         lcdir = ldir
         ltop = lt
         DO 50 i=1,nlpat
            chcdir(i)=chpat(i)
   50 CONTINUE
      ELSE
         IF(lcdir.NE.0)CALL sbit0(iq(kqsp+lcdir),iqdrop)
         GO TO 999
      ENDIF
      lfree = lq(kqsp+ltop-2)
      lused = lq(kqsp+ltop-3)
      lpurg = lq(kqsp+ltop-5)
      lrout = lq(kqsp+ltop-6)
      lrin = lq(kqsp+ltop-7)
      lb = iq(kqsp+ltop+klb)
      lrec = iq(kqsp+ltop+lb+1)
      lun = iq(kqsp+ltop-5)
      izrecl = iq(kqsp+ltop+lb+1)
      imodec = jbit(iq(kqsp+ltop),5)
      imodeh = jbit(iq(kqsp+ltop),6)
      imodex = jbit(iq(kqsp+ltop+kpw1+2),12)
      iquest(7)=iq(kqsp+lcdir+knkeys)
      iquest(8)=iq(kqsp+lcdir+knwkey)
      iquest(9)=iq(kqsp+lcdir+knsd)
      iquest(10)=iq(kqsp+lcdir+kquota)
      iquest(11)=lcdir
      iquest(12)=ltop
      iquest(13)=iq(kqsp+lcdir+klk)
      CALL rzdate(iq(kqsp+lcdir+kdatec),idatec,itimec,1)
      CALL rzdate(iq(kqsp+lcdir+kdatem),idatem,itimem,1)
      iquest(14)=idatec
      iquest(15)=itimec
      iquest(16)=idatem
      iquest(17)=itimem
      iquest(18)=iq(kqsp+lcdir+krused)
      iquest(19)=iq(kqsp+lcdir+kmega)
      iquest(20)=iq(kqsp+lcdir+kwused)
      iquest(21)=iq(kqsp+lcdir+iq(kqsp+lcdir+kld))
      IF(jbyt(iq(kqsp+lcdir+kpw1+2),6,5).NE.0)THEN
         IF(iq(kqsp+lcdir+kpw1).NE.ihpwd(1).OR.
     + iq(kqsp+lcdir+kpw1+1).NE.ihpwd(2))THEN
            CALL sbit1(iq(kqsp+lcdir),1)
         ELSE
            CALL sbit0(iq(kqsp+lcdir),1)
         ENDIF
      ENDIF
      IF(jbit(iq(kqsp+ltop),1).NE.0)CALL sbit1(iq(kqsp+lcdir),1)
  999 END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzfile(LUNIN,CHDIR,CHOPT)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /rzcl/ ltop,lrz0,lcdir,lrin,lrout,lfree,lused,lpurg
     +, ltemp,lcord,lfrom
      equivalence(lqrs,lqsyss(7))
      parameter(nlpatm=100)
      COMMON /rzdirn/nlcdir,nlndir,nlpat
      COMMON /rzdirc/chcdir(nlpatm),chndir(nlpatm),chpat(nlpatm)
      CHARACTER*16 CHNDIR, CHCDIR, CHPAT
      COMMON /rzclun/lun,lrec,isave,imodex,irelat,nhpwd,ihpwd(2)
     +, izrecl,imodec,imodeh
      parameter(kup=5,kpw1=7,knch=9,kdatec=10,kdatem=11,kquota=12,
     + krused=13,kwused=14,kmega=15,krzver=16,kirin=17,
     + kirout=18,krlout=19,kip1=20,knfree=22,knsd=23,kld=24,
     + klb=25,kls=26,klk=27,klf=28,klc=29,kle=30,knkeys=31,
     + knwkey=32,kkdes=33,knsize=253,kex=6,knmax=100)
      common/rzckey/ihead(3),key(100),key2(100),keydum(50)
      INTEGER KLCYCL, KPPCYC, KFRCYC, KSRCYC, KFLCYC, KORCYC,
     + kcncyc, knwcyc, kkycyc, kvscyc
      common/rzcycle/klcycl, kppcyc, kfrcyc, ksrcyc, kflcyc, korcyc,
     + kcncyc, knwcyc, kkycyc, kvscyc
      COMMON /rzbuff/ itest(8704)
      CHARACTER CHOPT*(*),CHDIR*(*)
      CHARACTER*16 CHTOP
      dimension ioptv(10)
      equivalence(ioptm,ioptv(1)), (ioptu,ioptv(2))
      equivalence(iopts,ioptv(3)), (ioptl,ioptv(4))
      equivalence(iopt1,ioptv(5)), (ioptd,ioptv(6))
      equivalence(ioptc,ioptv(7)), (ioptx,ioptv(8))
      equivalence(ioptb,ioptv(9)), (iopth,ioptv(10))
      jbit(izw,izp) = iand(ishft(izw,-(izp-1)),1)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      iquest(1)=0
      loglv = min(nqlogd,4)
      loglv = max(loglv,-3)
      lunsa = lun
      lunp = lunin
      CALL rzsave
      CALL uoptc (chopt,'MUSL1DCXBH',ioptv)
      irelat=0
      imodec=ioptc
      imodeh=iopth
      imodex=ioptx
      IF(ioptc.NE.0) THEN
         lrecp = iquest(10)
         lunp = iquest(11)
      ENDIF
      IF(iopth.NE.0) THEN
         lrecp = iquest(10)
         lun = iquest(11)
         luser = lunin
      ENDIF
      IF(ioptm.NE.0)THEN
         lrecp=1024
         lun=-99
      ELSEIF(iopth.EQ.0) THEN
         izrecl=lrecp
         CALL rziodo(lunp,50,2,itest,1)
         IF(ioptx.EQ.0) THEN
            CALL vxinvb(itest(9),1)
            IF(jbit(itest(9),12).NE.0)THEN
               imodex=1
               CALL rziodo(lunp,50,2,itest,1)
            ELSE
               CALL vxinvb(itest(9),1)
            ENDIF
         ENDIF
         IF(iquest(1).NE.0)GO TO 30
         lb=itest(klb)
         IF(lb.GT.48)CALL rziodo(lunp,lb+6,2,itest,1)
         IF(lb.GT.100)THEN
            IF(loglv.GE.-1) WRITE(iqlog,10000)
10000 FORMAT(' RZFILE. WARNING!! Top directory is big')
         ENDIF
         lrecp=itest(lb+1)
         lun=lunp
         iquest(1)=0
      ENDIF
      IF(loglv.GE.0) WRITE(iqlog,10200) lun,lrecp,chopt
10200 FORMAT(' RZFILE. UNIT ',i6,' Initializing with LREC=',i6,
     +', OPT= ',a)
      CALL mzsdiv (0,-7)
      lrz=lqrs
   10 IF(lrz.NE.0)THEN
         IF(iq(kqsp+lrz-5).EQ.lun)THEN
            iquest(1)=1
            IF(loglv.GE.-2) WRITE(iqlog,10300)
10300 FORMAT(' RZFILE. Unit is already in use')
            lun=lunsa
            GO TO 30
         ELSE
            lrz=lq(kqsp+lrz)
            GO TO 10
         ENDIF
      ENDIF
      IF(lqrs.EQ.0)THEN
         CALL mzlink(jqpdvs,'RZCL',ltop,ltop,lfrom)
         CALL mzbook (jqpdvs,lrz0,lqrs,1,'RZ0 ',2,2,36,2,0)
         iq(kqsp+lrz0-5)=0
         isave = 1
         nhpwd = 0
         CALL vblank(ihpwd,2)
      ENDIF
      nchd = len(chdir)
      IF(nchd.GT.16)nchd=16
      chtop = chdir(1:nchd)
      CALL mzbook(jqpdvs,ltop,lqrs,1,'RZ  ',10,9,lrecp,2,0)
      IF(ioptm.EQ.0)THEN
         iq(kqsp+ltop-5) = lun
         IF(ioptc.NE.0) CALL sbit1(iq(kqsp+ltop),5)
         IF(iopth.NE.0) THEN
            CALL sbit1(iq(kqsp+ltop),6)
            CALL sbyt(luser,iq(kqsp+ltop),7,7)
         ENDIF
      ELSE
         nmem=iq(kqsp+lrz0)+1
         iq(kqsp+lrz0)=nmem
         iq(kqsp+ltop-5)=-nmem
         IF(2*nmem.GT.iq(kqsp+lrz0-1))THEN
            CALL mzpush(jqpdvs,lrz0,0,10,' ')
         ENDIF
         iq(kqsp+lrz0+2*nmem-1)=locf(lunp)-locf(iq(1))+1
         iq(kqsp+lrz0+2*nmem )=lrecp
         lun=-nmem
      ENDIF
      CALL rziodo(lun,lrecp,2,iq(kqsp+ltop+1),1)
      IF(iquest(1).NE.0)GO TO 30
      ld = iq(kqsp+ltop+kld)
      lb = iq(kqsp+ltop+klb)
      lrec = iq(kqsp+ltop+lb+1)
      nrd = iq(kqsp+ltop+ld)
      imodex=jbit(iq(kqsp+ltop+kpw1+2),12)
      npush=nrd*lrec-lrecp
      IF(npush.NE.0)CALL mzpush(jqpdvs,ltop,0,npush,'I')
      DO 20 i=2,nrd
         CALL rziodo(lun,lrec,iq(kqsp+ltop+ld+i),
     + iq(kqsp+ltop+(i-1)*lrec+1),1)
         IF(iquest(1).NE.0)GO TO 30
   20 CONTINUE
      CALL vblank(iq(kqsp+ltop+1),4)
      CALL uctoh(chdir,iq(kqsp+ltop+1),4,nchd)
      CALL zhtoi(iq(kqsp+ltop+1),iq(kqsp+ltop+1),4)
      CALL sbyt(nchd,iq(kqsp+ltop+kpw1+2),1,5)
      CALL ucopyi(iq(kqsp+ltop+kpw1),ihpwd,2)
      nhpwd=jbyt(iq(kqsp+ltop+kpw1+2),6,5)
      iq(kqsp+ltop+kirin)=0
      iq(kqsp+ltop+kirout)=0
      lfree = 0
      lused = 0
      lrin = 0
      lpurg = 0
      lrout = 0
      lcdir = ltop
      nlcdir= 1
      nlndir= 1
      nlpat = 1
      chcdir(1)=chtop
      chndir(1)=chtop
      IF(ioptd.NE.0)THEN
         print*,'>>>>>> CALL RZDLOK'
******   CALL RZDLOK
      ENDIF
      IF(ioptl.NE.0)THEN
         print*,'>>>>>> CALL RZLLOK'
******   CALL RZLLOK
      ENDIF
      logl = loglv + 3
      CALL sbyt(logl,iq(kqsp+ltop),15,3)
      CALL rzvcyc(ltop)
      iquest(13) = iq(kqsp+ltop+krzver)
      IF(ioptb.NE.0) THEN
         print*,'>>>>>> CALL RZVERI(...)'
      ENDIF
      CALL sbit1(iq(kqsp+ltop),1)
      IF(ioptu.NE.0.OR.iopt1.NE.0)THEN
         CALL sbit0(iq(kqsp+ltop),1)
         CALL mzbook(jqpdvs,lfree,ltop,-2,'RZFR',0,0,21,2,0)
         iq(kqsp+lfree-5)=lun
         IF(iopts.EQ.0)THEN
            CALL sbit1(iq(kqsp+ltop),3)
            print*,'>>>>>> CALL RZLLOK'
******      CALL RZLOCK('RZFILE')
            IF(iquest(1).NE.0)THEN
               CALL sbit1(iq(kqsp+ltop),1)
               iq1=iquest(1)
               CALL mzdrop(jqpdvs,lfree,' ')
               lfree=0
               iquest(1)=2+iq1
               GO TO 30
            ENDIF
         ELSE
            CALL sbit0(iq(kqsp+ltop),3)
         ENDIF
         CALL mzbook(jqpdvs,lused,ltop,-3,'RZUS',0,0,21,2,0)
         iq(kqsp+lused-5)=lun
      ENDIF
      iquest(7)=iq(kqsp+lcdir+knkeys)
      iquest(8)=iq(kqsp+lcdir+knwkey)
   30 RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzfdir(CHROUT,LT,LDIR,CHOPT)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /rzcl/ ltop,lrz0,lcdir,lrin,lrout,lfree,lused,lpurg
     +, ltemp,lcord,lfrom
      equivalence(lqrs,lqsyss(7))
      parameter(nlpatm=100)
      COMMON /rzdirn/nlcdir,nlndir,nlpat
      COMMON /rzdirc/chcdir(nlpatm),chndir(nlpatm),chpat(nlpatm)
      CHARACTER*16 CHNDIR, CHCDIR, CHPAT
      COMMON /rzch/ chwold,chl
      CHARACTER*255 CHWOLD,CHL
      parameter(kup=5,kpw1=7,knch=9,kdatec=10,kdatem=11,kquota=12,
     + krused=13,kwused=14,kmega=15,krzver=16,kirin=17,
     + kirout=18,krlout=19,kip1=20,knfree=22,knsd=23,kld=24,
     + klb=25,kls=26,klk=27,klf=28,klc=29,kle=30,knkeys=31,
     + knwkey=32,kkdes=33,knsize=253,kex=6,knmax=100)
      INTEGER KLCYCL, KPPCYC, KFRCYC, KSRCYC, KFLCYC, KORCYC,
     + kcncyc, knwcyc, kkycyc, kvscyc
      common/rzcycle/klcycl, kppcyc, kfrcyc, ksrcyc, kflcyc, korcyc,
     + kcncyc, knwcyc, kkycyc, kvscyc
      COMMON /rzclun/lun,lrec,isave,imodex,irelat,nhpwd,ihpwd(2)
     +, izrecl,imodec,imodeh
      CHARACTER*(*) CHROUT
      CHARACTER*(*) CHOPT
      dimension ihdir(4)
      LOGICAL RZSAME
      INTEGER FQUOTA
      jbit(izw,izp) = iand(ishft(izw,-(izp-1)),1)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      ioptq = index(chopt,'Q')
      lt=0
      ldir=0
      IF(lqrs.EQ.0) GOTO 110
      IF(nlpat.LE.0)THEN
         chl='??? '
         GOTO 90
      ENDIF
      CALL vblank(ihdir,4)
      CALL uctoh(chpat(1),ihdir,4,16)
      CALL zhtoi(ihdir,ihdir,4)
      lrz=lqrs
   10 IF(.NOT.rzsame(ihdir,iq(kqsp+lrz+1),4))THEN
         lrz = lq(kqsp+lrz)
         IF(lrz.GT.0)GOTO 10
         GOTO 80
      ENDIF
      ltemp = lrz
      lt = lrz
      ldir = lrz
      CALL rzvcyc(lt)
      IF(nlpat.LT.2)GOTO 110
      lbt = iq(kqsp+lrz+klb)
      lref = iq(kqsp+lrz+lbt+1)
      lunf = iq(kqsp+lrz-5)
      fquota = iq(kqsp+lrz+kquota)
      loglv = jbyt(iq(kqsp+lt),15,3)-3
      izrecl = iq(kqsp+lt+lbt+1) ! SWON: Needed by CFSEEK in RZIODO
      imodex = jbit(iq(kqsp+lt+kpw1+2),12)
      imodec = jbit(iq(kqsp+lt),5)
      imodeh = jbit(iq(kqsp+lt),6)
      DO 60 il=2,nlpat
         CALL vblank(ihdir,4)
         CALL uctoh(chpat(il),ihdir,4,16)
         CALL zhtoi(ihdir,ihdir,4)
         CALL sbit0(iq(kqsp+lrz),iqdrop)
         nsdir=iq(kqsp+lrz+knsd)
         ls =iq(kqsp+lrz+kls)
         IF(nsdir.LE.0)GOTO 80
         DO 50 i=1,nsdir
            ih=ls+7*(i-1)
            IF(rzsame(ihdir,iq(kqsp+lrz+ih),4))THEN
               IF (kvscyc.EQ.0) THEN
                  irs = jbyt(iq(kqsp+lrz+ih+5),1,18)
               ELSE
                  irs = iq(kqsp+lrz+ih+5)
               ENDIF
               iquest(20) = 0
               IF(irs.LE.0.OR.irs.GT.fquota) GOTO 100
               lrn = lq(kqsp+lrz-1)
   20 IF(lrn.EQ.0)THEN
                  CALL mzbook(jqpdvs,ldir,lrz,-1,'RZ  ',6,6,lref,2,-1)
                  lrz=ldir
                  CALL rziodo(lunf,lref,irs,iq(kqsp+lrz+1),1)
                  IF(iquest(1).NE.0) GOTO 70
                  lds=iq(kqsp+lrz+kld)
                  IF(lds.GT.iq(kqsp+lrz-1)) GOTO 100
                  IF(lds.LE.0) GOTO 100
                  nrds=iq(kqsp+lrz+lds)
                  IF(nrds.GT.1)THEN
                     CALL mzpush(jqpdvs,lrz,0,lref*(nrds-1),' ')
                     ldir=lrz
                     iquest(20) = nrds
                     iquest(21) = irs
                     DO 30 ir=2,nrds
                        irs=iq(kqsp+lrz+lds+ir)
                        jr = 20 + ir
                        IF(jr.LE.100) iquest(jr) = irs
                        IF(irs.LE.0.OR.irs.GT.fquota) GOTO 100
                        CALL rziodo(lunf,lref,irs,
     + iq(kqsp+lrz+(ir-1)*lref+1),1)
                        IF(iquest(1).NE.0)GOTO 70
   30 CONTINUE
                  ENDIF
               ELSE
   40 IF(rzsame(ihdir,iq(kqsp+lrn+1),4))THEN
                     lrz = lrn
                     ldir= lrn
                     GOTO 60
                  ELSE
                     lrn=lq(kqsp+lrn)
                     GOTO 20
                  ENDIF
               ENDIF
               GOTO 60
            ENDIF
   50 CONTINUE
         GOTO 80
   60 CONTINUE
      CALL sbit0(iq(kqsp+ldir),iqdrop)
      lt=ltemp
      GOTO 110
   70 CONTINUE
      ldir = 0
      iquest(1) = 1
      GOTO 110
   80 CALL rzpaff(chpat,nlpat,chl)
   90 ldir=0
      iquest(1) = 2 ! SWON: Write a message if "Unknown directory"
      IF(loglv.GE.-2.AND.ioptq.EQ.0)THEN
         WRITE(iqlog,10000)chrout,chl(1:lenocc(chl))
10000 FORMAT(1x,a,'. Unknown directory ',a)
      ENDIF
      GOTO 110
  100 CALL rzpaff(chpat,nlpat,chl)
      iquest(1) = 3
      ldir=0
      IF(loglv.GE.-2)THEN ! SWON: Write a message if RZ is in trouble
         WRITE(iqlog,10100)chrout,chl(1:lenocc(chl))
10100 FORMAT(1x,a,'. Directory overwritten ',a)
      ENDIF
  110 RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE fzimtb
      COMMON /zbcd/ iqnum2(11),iqlett(26),iqnum(10), iqplus,iqmins
     +, iqstar,iqslas,iqopen,iqclos,iqdoll,iqequ, iqblan
     +, iqcoma,iqdot, iqnumb,iqapo, iqexcl,iqcolo,iqquot
     +, iqunde,iqclsq,iqand, iqat, iqques,iqopsq,iqgrea
     +, iqless,iqreve,iqcirc,iqsemi,iqperc, iqlowl(26)
     +, iqcrop,iqvert,iqcrcl,iqnot, iqgrav, iqileg
     +, nqhol0,nqholl(95)
      parameter(iqbitw=32, iqbitc=8, iqchaw=4)
      COMMON /zmach/ nqbitw,nqbitc,nqchaw
     +, nqlnor,nqlmax,nqlpth,nqrmax,iqlpct,iqnil
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
                   equivalence(lqfs,lqsyss(4)), (lqff,lqsysr(4))
     +, (lqfi,lqsysr(5)), (lqfx,lqsysr(6))
      COMMON /mzcn/ iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      COMMON /fzci/ luni,lunni,ixdivi,ltempi,ievfli
     +, mstati,mediui,ififoi,idafoi,iacmoi,iupaki
     +, iadopi,iactvi,incbpi,loglvi,maxrei, isteni
     +, lbpari, l4stoi,l4stai,l4curi,l4endi
     +, iflagi,nfasti,n4skii,n4resi,n4doni,n4endi
     +, ioptie,ioptir,ioptis,ioptia,ioptit,ioptid
     +, ioptif,ioptig,ioptih,iopti2(4)
     +, idi(2),ipili(4),nwtxi,nwsegi,nwtabi,nwbki,lentri
     +, nwuhci,iochi(16),nwumxi,nwuhi,nwioi
     +, nwrdai,nrecai,luheai,jretcd,jerror,nwerr
      parameter(jauioc=50, jauseg=68, jauear=130)
      COMMON /fzcseg/nqseg,iqsegh(2,20),iqsegd(20),iqsglu,iqsgwk
      COMMON /fzcocc/nqocc,iqocdv(20),iqocsp(20)
      dimension itosor(20), isordv(20), isorsp(20)
      dimension lstav(20), lendv(20)
      equivalence(lstav(1),iquest(60)), (lendv(1),iquest(80))
      dimension namesr(2)
      DATA namesr / 4hfzim, 4htb  /
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      iflgar = 0
      IF (nqseg.LE.0) THEN
          nqseg = 1
          nsor = 1
          nocc = 1
          itosor(1) = 1
          iqsegd(1) = jqdivi
          isordv(1) = jqdivi
          iqocdv(1) = jqdivi
          isorsp(1) = nwbki
          iqocsp(1) = nwbki
          GO TO 41
        ENDIF
      IF (loglvi.GE.3) WRITE (iqlog,9016) (j,
     + iqsegh(1,j),iqsegh(2,j),iqsegd(j),j=1,nqseg)
 9016 FORMAT (1x/' FZIMTB-  Segment Selection Table as set by the user'
     f/(10x,i2,1x,2a4,z17))
      lfiseg = lqfi + jauseg
      IF (3*nqseg.NE.iq(kqsp+lfiseg)) GO TO 715
      lspace = kqsp + lfiseg + 2*nqseg
      DO 27 js=1,nqseg
      ixdiv = iqsegd(js)
      IF (ixdiv) 22, 23, 24
   22 IF (ixdiv.LT.-7) GO TO 714
      itosor(js) = -iq(lspace+js)
      GO TO 27
   23 jdiv = jqdivi
      GO TO 25
   24 jdiv = jbyt(ixdiv,1,26)
      IF (jdiv.GT.20) GO TO 714
      jsto = jbyt(ixdiv,27,4)
      IF (jsto.NE.0) THEN
          IF (jsto.NE.jqstor) GO TO 714
        ENDIF
      IF (jdiv.EQ.0) GO TO 23
      IF (jdiv.GT.jqdvll) THEN
          IF (jdiv.LT.jqdvsy) GO TO 714
        ENDIF
   25 iqsegd(js) = jdiv
      itosor(js) = 0
   27 CONTINUE
      nsor = 0
      nocc = 0
      janx = 1
      jenx = nqseg
   31 jdvbig = 0
      ja = janx
      janx = 0
      je = jenx
      jenx = 0
      DO 35 js=ja,je
      IF (itosor(js).NE.0) GO TO 35
      jenx = js
      IF (janx.EQ.0) janx=js
      jdiv = iqsegd(js)
      IF (jdiv.LE.jdvbig) GO TO 35
      jdvbig = jdiv
      jsbig = js
   35 CONTINUE
      IF (jdvbig.EQ.0) GO TO 41
      nsor = nsor + 1
      itosor(jsbig) = nsor
      isordv(nsor) = jdvbig
      isorsp(nsor) = iq(lspace+jsbig)
      nocc = nocc + 1
      iqocdv(nocc) = jdvbig
      iqocsp(nocc) = iq(lspace+jsbig)
      IF (jsbig.EQ.jenx) GO TO 31
      DO 37 js=jsbig+1,jenx
      IF (itosor(js).NE.0) GO TO 37
      IF (iqsegd(js).NE.jdvbig) GO TO 37
      nsor = nsor + 1
      itosor(js) = nsor
      isordv(nsor) = jdvbig
      isorsp(nsor) = iq(lspace+js)
      iqocsp(nocc) = iqocsp(nocc) + iq(lspace+js)
   37 CONTINUE
      GO TO 31
   41 IF (nocc.EQ.0) GO TO 81
      jocc = 0
   42 jocc = jocc + 1
      jqdivi = iqocdv(jocc)
      nw = iqocsp(jocc)
      CALL mzresv
      nqresv = nqresv - nw
      IF (nqresv.LT.0) CALL mzgar1
      IF (jqmode.EQ.0) THEN
          iqln = lqend(kqt+jqdivi)
          iqnx = iqln + nw
          lqend(kqt+jqdivi) = iqnx
        ELSE
          iqnx = lqsta(kqt+jqdivi)
          iqln = iqnx - nw
          lqsta(kqt+jqdivi) = iqln
        ENDIF
      nqocc = jocc
      lq(kqs+iqln) = 12
      lq(kqs+iqln+1) = 0
      lq(kqs+iqln+2) = 0
      lq(kqs+iqln+3) = 0
      lq(kqs+iqln+5) = iqlett(1)
      lq(kqs+iqln+6) = 0
      lq(kqs+iqln+7) = 0
      lq(kqs+iqln+8) = nw - 10
      lq(kqs+iqln+9) = 0
      IF (jocc.NE.nocc) GO TO 42
   46 nwtr = 2*nwtabi + 2
      nwtm = 8*nqseg
      IF (nwtr+nwtm.LT.nqwktb) THEN
          lqmta = lqwktb
          lqrta = lqmta + nwtm
        ELSE
          jqstmv = -1
          CALL mzfgap
          IF (nqgapn.EQ.0) GO TO 61
          IF (iqgap(1,1).LT.nwtr) THEN
              IF (nqwktb.LT.nwtr) GO TO 61
              lqmta = iqgap(2,1)
              lqrta = lqwktb
            ELSE
              lqmta = lqwktb
              lqrta = iqgap(2,1)
            ENDIF
        ENDIF
      lqmte = lqmta + nwtm
      lqta = lqrta + 1
      lqte = lqta + 2*nwtabi
      lqrte = lqte
      jsor = 1
      jocc = 1
   52 jqdivi = isordv(jsor)
      IF (iqmode(kqt+jqdivi).EQ.0) THEN
          lsta = lqend(kqt+jqdivi) - iqocsp(jocc)
        ELSE
          lsta = lqsta(kqt+jqdivi)
        ENDIF
      lend = lsta + isorsp(jsor)
      lendv(jsor) = lend
      lstav(jsor) = lsta
      jocc = jocc + 1
   54 IF (jsor.EQ.nsor) GO TO 55
      jsor = jsor + 1
      IF (isordv(jsor).NE.jqdivi) GO TO 52
      lsta = lend
      lend = lsta + isorsp(jsor)
      lendv(jsor) = lend
      lstav(jsor) = lsta
      GO TO 54
   55 lmt = lqmta
      DO 59 js=1,nqseg
      jsor = itosor(js)
      IF (jsor.GE.0) GO TO 57
      lq(lmt) = 0
      lq(lmt+1) = 0
      lq(lmt+2) = 0
      lq(lmt+3) = jsor
      lq(lmt+4) = jsor
      lq(lmt+5) = 0
      lq(lmt+6) = 0
      lq(lmt+7) = 0
      IF (loglvi.GE.3) WRITE (iqlog,9055) js, -jsor
 9055 FORMAT (' FZIMTB-  skip segment',i3,i9,' WORDS')
      GO TO 59
   57 lq(lmt) = isordv(jsor)
      lq(lmt+1) = 1
      lq(lmt+2) = 0
      lq(lmt+3) = lstav(jsor)
      lq(lmt+4) = lendv(jsor)
      lq(lmt+5) = 0
      lq(lmt+6) = 0
      lq(lmt+7) = 0
      IF (loglvi.GE.3) THEN
          WRITE (iqlog,9058) js,lq(lmt),lq(lmt+3),lq(lmt+4)
        ENDIF
 9058 FORMAT (' FZIMTB-  read segment',i3,' into division/from/to'
     f,i3,2i9)
   59 lmt = lmt + 8
  999 nqtrac = nqtrac - 2
      RETURN
   61 IF (iflgar.GE.2) GO TO 721
      ixstor = ishft(jqstor,26)
      IF (iflgar.NE.0) GO TO 63
      ixstor = mzixco(ixstor+21,22,23,24)
      CALL mzgarb (ixstor, 0)
      iflgar = 1
      IF (jqstor.NE.0) GO TO 46
      iflgar = 2
      GO TO 46
   63 iflgar = 2
      j = mzixco(21,22,23,24)
      CALL mzgarb (j, 0)
      CALL mzsdiv (ixstor,-7)
      GO TO 46
   81 nwbki = 0
      jretcd = -4
      IF (loglvi.GE.3) WRITE (iqlog,9081)
 9081 FORMAT (' FZIMTB-  skip all segments')
      GO TO 999
  715 jerror = 15
      iquest(14)= nqseg
      iquest(15)= iq(kqsp+lfiseg)
      nwerr = 2
      GO TO 719
  714 jerror = 14
      iquest(14)= js
      iquest(15)= 0
      iquest(16)= ixdiv
      nwerr = 3
  719 jretcd = 4
      GO TO 999
  721 jerror = 21
      jretcd = 3
      GO TO 999
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE izhnum (HOLL,INTV,NP)
      INTEGER INTV(99), HOLL(99)
      DO 39 jwh=1,np
   39 intv(jwh) = iand(holl(jwh), 255)
      RETURN
      END
 
*-------------------------------------------------------------------------------
 
      FUNCTION iucomp (ITEXT,IVECT,N)
      dimension ivect(9)
      IF (n.EQ.0) GO TO 18
      DO 12 j=1,n
      IF (itext.EQ.ivect(j)) GO TO 24
   12 CONTINUE
   18 j=0
   24 iucomp=j
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE izbcdt (NP,ITABT)
      COMMON /quest/ iquest(100)
      parameter(nqtcet=256)
      COMMON /zceta/ iqceta(256),iqtcet(256)
      COMMON /zkrakc/iqholk(120), iqkrak(80), iqcetk(122)
      dimension np(9), itabt(99)
      n = np(1)
      lim = itabt(1)
      jgood = 0
      jbad = 0
      DO 29 jwh=1,n
      jv = iand(iqholk(jwh),255)
      jv = iqtcet(jv+1)
      IF (jv.GT.lim) GO TO 27
      jv = itabt(jv+1)
      IF (jv+1) 29, 27, 24
   24 jgood = jgood + 1
      iqcetk(jgood) = jv
      GO TO 29
   27 jbad = jbad + 1
   29 CONTINUE
      iquest(1) = jgood
      iquest(2) = jbad
      END
 
*-------------------------------------------------------------------------------
 
      LOGICAL FUNCTION rzsame(IH1,IH2,N)
      dimension ih1(n),ih2(n)
      IF(n.LE.0)GO TO 20
      DO 10 i=1,n
         IF(ih1(i).NE.ih2(i))GO TO 20
  10  CONTINUE
      rzsame=.true.
      GO TO 99
  20  rzsame=.false.
  99  RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzink(KEYU,ICYCLE,CHOPT)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /rzcl/ ltop,lrz0,lcdir,lrin,lrout,lfree,lused,lpurg
     +, ltemp,lcord,lfrom
      equivalence(lqrs,lqsyss(7))
      COMMON /rzclun/lun,lrec,isave,imodex,irelat,nhpwd,ihpwd(2)
     +, izrecl,imodec,imodeh
      COMMON /rzcout/ip1,ir1,ir2,irout,irlout,ioptrr
      parameter(kup=5,kpw1=7,knch=9,kdatec=10,kdatem=11,kquota=12,
     + krused=13,kwused=14,kmega=15,krzver=16,kirin=17,
     + kirout=18,krlout=19,kip1=20,knfree=22,knsd=23,kld=24,
     + klb=25,kls=26,klk=27,klf=28,klc=29,kle=30,knkeys=31,
     + knwkey=32,kkdes=33,knsize=253,kex=6,knmax=100)
      common/rzckey/ihead(3),key(100),key2(100),keydum(50)
      INTEGER KLCYCL, KPPCYC, KFRCYC, KSRCYC, KFLCYC, KORCYC,
     + kcncyc, knwcyc, kkycyc, kvscyc
      common/rzcycle/klcycl, kppcyc, kfrcyc, ksrcyc, kflcyc, korcyc,
     + kcncyc, knwcyc, kkycyc, kvscyc
      CHARACTER*(*) CHOPT
      dimension keyu(*)
      equivalence(iopta,iquest(91)), (ioptc,iquest(92))
     +, (ioptd,iquest(93)), (ioptn,iquest(94)), (ioptr,iquest(95))
     +, (iopts,iquest(96))
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      iquest(1)=0
      CALL uoptc(chopt,'ACDNRS',iquest(91))
      lk=iq(kqsp+lcdir+klk)
      nkeys=iq(kqsp+lcdir+knkeys)
      nwkey=iq(kqsp+lcdir+knwkey)
      iquest(7)=nkeys
      iquest(8)=nwkey
      IF(nkeys.EQ.0)GO TO 90
      IF(iopts.NE.0)THEN
         ik1=keyu(1)
         ik2=ik1
         IF(ik1.GT.nkeys.OR.ik1.LE.0)THEN
            iquest(1)=1
            iquest(2)=ik1
            RETURN
         ENDIF
      ELSE
         ik1=1
         ik2=nkeys
         DO 5 i=1,nwkey
            ikdes=(i-1)/10
            ikbit1=3*i-30*ikdes-2
            IF(jbyt(iq(kqsp+lcdir+kkdes+ikdes),ikbit1,3).LT.3)THEN
               key(i)=keyu(i)
            ELSE
               CALL zhtoi(keyu(i),key(i),1)
            ENDIF
   5  CONTINUE
      ENDIF
      DO 30 i=ik1,ik2
         lkc=lk+(nwkey+1)*(i-1)
         IF(iopts.EQ.0)THEN
            DO 10 k=1,nwkey
               IF(iq(kqsp+lcdir+lkc+k).NE.key(k))GO TO 30
  10  CONTINUE
         ELSE
            DO 15 k=1,nwkey
               IF(k.LT.10)THEN
                  ikdes=(k-1)/10
                  ikbit1=3*k-30*ikdes-2
                  IF(jbyt(iq(kqsp+lcdir+kkdes+ikdes),ikbit1,3).LT.3)THEN
                     iquest(20+k)=iq(kqsp+lcdir+lkc+k)
                  ELSE
                     CALL zitoh(iq(kqsp+lcdir+lkc+k),iquest(20+k),1)
                  ENDIF
               ENDIF
  15  CONTINUE
         ENDIF
         iquest(20)=i
         lcyc=iq(kqsp+lcdir+lkc)
*         IF (KVSCYC.NE.0) THEN
*            IF (IQ(KQSP+LCDIR+LCYC+KKYCYC).NE.IQ(KQSP+LCDIR+LKC+1)) THEN
*               IQUEST(1) = 11
*               GO TO 99
*            ENDIF
*         ENDIF
         nc=0
  20  nc=nc+1
         icy = jbyt(iq(kqsp+lcdir+lcyc+kcncyc),21,12)
         IF(icy.EQ.icycle)GO TO 50
         IF(nc.EQ.1.AND.icycle.GT.icy)GO TO 50
         IF (kvscyc.EQ.0) THEN
            lcold = jbyt(iq(kqsp+lcdir+lcyc+kppcyc),1,16)
         ELSE
            lcold = iq(kqsp+lcdir+lcyc+kppcyc)
         ENDIF
         IF(lcold.EQ.0.AND.lcold.NE.lcyc.AND.icycle.EQ.0)GO TO 50
         lcyc=lcold
         IF(lcyc.NE.0)GO TO 20
         GO TO 90
  30  CONTINUE
      GO TO 90
  50  IF (kvscyc.EQ.0) THEN
         ir1 = jbyt(iq(kqsp+lcdir+lcyc+kfrcyc),17,16)
         ir2 = jbyt(iq(kqsp+lcdir+lcyc+ksrcyc),17,16)
         ip1 = jbyt(iq(kqsp+lcdir+lcyc+korcyc), 1,16)
         nw = jbyt(iq(kqsp+lcdir+lcyc+knwcyc), 1,20)
      ELSE
         ir1 = iq(kqsp+lcdir+lcyc+kfrcyc)
         ir2 = iq(kqsp+lcdir+lcyc+ksrcyc)
         ip1 = jbyt(iq(kqsp+lcdir+lcyc+korcyc), 1,20)
         nw = iq(kqsp+lcdir+lcyc+knwcyc)
      ENDIF
      n1 = nw
      iquest(2)=1
      IF(ir2.NE.0)iquest(2)=(nw-n1-1)/lrec+2
      iquest(3)=ir1
      iquest(4)=ip1
      iquest(5)=ir2
      iquest(6)=icy
      iquest(12)=nw
      iquest(14)=iq(kqsp+lcdir+lcyc+1)
      iquest(15)=lcyc
      IF(ioptc.NE.0)THEN
         iquest(50)=0
         lc1=lcyc
  51  iquest(50)=iquest(50)+1
         IF (kvscyc.EQ.0) THEN
            lcold = jbyt(iq(kqsp+lcdir+lc1+kppcyc),1,16)
         ELSE
            lcold = iq(kqsp+lcdir+lc1+kppcyc)
         ENDIF
         IF(iquest(50).LE.19)THEN
            nc=iquest(50)
            iquest(50+nc)=jbyt(iq(kqsp+lcdir+lc1+kcncyc),21,12)
            iquest(70+nc)=iq(kqsp+lcdir+lc1+kflcyc)
         ENDIF
         IF(lcold.NE.0.AND.lcold.NE.lc1)THEN
            lc1=lcold
            GO TO 51
         ENDIF
      ENDIF
      IF(ioptn.NE.0)THEN
         IF(i.EQ.1)THEN
            iquest(30)=0
         ELSE
            iquest(30)=nwkey
            DO 52 j=1,nwkey
               IF(j.LT.10)THEN
                  lkcj=lk+(nwkey+1)*(i-2)
                  iquest(30+j)=iq(kqsp+lcdir+lkcj+j)
                  ikdes=(j-1)/10
                  ikbit1=3*j-30*ikdes-2
                  IF(jbyt(iq(kqsp+lcdir+kkdes+ikdes),ikbit1,3).GE.3)THEN
                     CALL zitoh(iquest(30+j),iquest(30+j),1)
                  ENDIF
               ENDIF
  52  CONTINUE
         ENDIF
         IF(i.EQ.nkeys)THEN
            iquest(40)=0
         ELSE
            iquest(40)=nwkey
            DO 53 j=1,nwkey
               IF(j.LT.10)THEN
                  lkcj=lk+(nwkey+1)*i
                  iquest(40+j)=iq(kqsp+lcdir+lkcj+j)
                  ikdes=(j-1)/10
                  ikbit1=3*j-30*ikdes-2
                  IF(jbyt(iq(kqsp+lcdir+kkdes+ikdes),ikbit1,3).GE.3)THEN
                     CALL zitoh(iquest(40+j),iquest(40+j),1)
                  ENDIF
               ENDIF
  53  CONTINUE
         ENDIF
      ENDIF
      GO TO 99
  90  iquest(1)=1
      IF(ioptn.NE.0)THEN
         IF(nkeys.GT.0)THEN
            iquest(30)=nwkey
            iquest(40)=nwkey
            DO 91 j=1,nwkey
               IF(j.GE.10)GO TO 91
               lkcj=lk+(nwkey+1)*(nkeys-1)
               iquest(30+j)=iq(kqsp+lcdir+lk+j)
               iquest(40+j)=iq(kqsp+lcdir+lkcj+j)
               ikdes=(j-1)/10
               ikbit1=3*j-30*ikdes-2
               IF(jbyt(iq(kqsp+lcdir+kkdes+ikdes),ikbit1,3).GE.3)THEN
                  CALL zitoh(iquest(30+j),iquest(30+j),1)
                  CALL zitoh(iquest(40+j),iquest(40+j),1)
               ENDIF
  91  CONTINUE
         ENDIF
      ENDIF
  99  RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzpaff(CH,NL,CHPATH)
      CHARACTER*(*) CHPATH,CH(*)
      CHARACTER*255 CHTEMP
      CHARACTER*16  CHL
      COMMON /quest/ iquest(100)
      maxlen=len(chpath)
      IF(maxlen.GT.255)maxlen=255
      iquest(1) = 0
      chpath='//'//ch(1)
      leng=lenocc(chpath)
      IF(leng.EQ.2) THEN
        chpath='//HOME'
        leng=6
      ENDIF
      IF(nl.EQ.1) GOTO 99
      DO 20 i=2,nl
         chl=ch(i)
         nmax=lenocc(chl)
         IF(nmax.EQ.0) THEN
            iquest(1) = 1
            GOTO 99
         ENDIF
         IF(leng+nmax.GT.maxlen)nmax=maxlen-leng
         chtemp=chpath(1:leng)//'/'//chl(1:nmax)
         chpath=chtemp
         leng=leng+nmax+1
         IF(leng.EQ.maxlen) THEN
            iquest(1) = 2
            GOTO 99
         ENDIF
  20  CONTINUE
  99  RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzpath(CHPATH)
      CHARACTER  CQALLC*96
      COMMON /zbcdch/ cqallc
                      CHARACTER*1  CQLETT(96), CQNUM(10)
                      equivalence(cqlett(1),cqallc(1:1))
                      equivalence(cqnum(1), cqallc(27:27))
      CHARACTER*1  BSLASH,KTILDE
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun,  nqused
      parameter(nlpatm=100)
      COMMON /rzdirn/nlcdir,nlndir,nlpat
      COMMON /rzdirc/chcdir(nlpatm),chndir(nlpatm),chpat(nlpatm)
      CHARACTER*16   CHNDIR,    CHCDIR,    CHPAT
      CHARACTER*(*) CHPATH
      CHARACTER*1 CH1
      CHARACTER*2 CH2
      bslash=cqallc(61:61)
      ktilde=cqallc(94:94)
      nchp=len(chpath)
      nlpat=0
  10  IF(chpath(nchp:nchp).EQ.' ')THEN
         nchp=nchp-1
         IF(nchp.GT.0)GO TO 10
         nlpat=nlcdir
         DO 20 i=1,nlcdir
            chpat(i)=chcdir(i)
  20     CONTINUE
         GO TO 99
      ENDIF
      is1=1
  30  IF(chpath(is1:is1).EQ.' ')THEN
         is1=is1+1
         GO TO 30
      ENDIF
      ch1=chpath(is1:is1)
      ch2=chpath(is1:is1+1)
      IF(ch1.EQ.'/')THEN
         IF(chpath(is1+1:is1+1).EQ.'/')THEN
            is=is1+2
            IF(is.GT.nchp)GO TO 99
  40        IF(chpath(is:is).EQ.'/')THEN
               IF(is.EQ.is1+2)GO TO 90
               nlpat=1
               chpat(1)=chpath(is1+2:is-1)
               is1=is+1
               is=is1
               GO TO 50
            ELSE
               is=is+1
               IF(is.LT.nchp)GO TO 40
               nlpat=1
               chpat(1)=chpath(is1+2:is)
               GO TO 99
            ENDIF
         ENDIF
         IF(chpath(is1+1:is1+1).EQ.bslash)GO TO 90
         IF(chpath(is1+1:is1+1).EQ.ktilde)GO TO 90
         nlpat=1
         chpat(1)=chcdir(1)
         is=is1+1
         is1=is
  50     IF(is.EQ.nchp)THEN
            IF(chpath(is1:is).NE.'..'.AND.
     +         chpath(is1:is).NE.bslash) THEN
               nlpat=nlpat+1
               IF(nlpat.GT.nlpatm)GO TO 90
               chpat(nlpat)=chpath(is1:is)
            ELSE
               nlpat = nlpat -1
            ENDIF
            GO TO 99
         ELSE
            IF(chpath(is:is).EQ.'/')THEN
               IF(nlpat.GT.nlpatm)GO TO 90
               IF(chpath(is1:is-1).NE.'..'.AND.
     +            chpath(is1:is-1).NE.bslash) THEN
                  nlpat=nlpat+1
                  chpat(nlpat)=chpath(is1:is-1)
               ELSE
                  nlpat = nlpat - 1
               ENDIF
               is1=is+1
            ENDIF
            is=is+1
            GO TO 50
         ENDIF
      ENDIF
      IF(ch1.EQ.ktilde)THEN
         nlpat=nlndir
         DO 60 i=1,nlndir
            chpat(i)=chndir(i)
  60     CONTINUE
         IF(is1.EQ.nchp)GO TO 99
         is1=is1+1
         ch1=chpath(is1:is1)
         GO TO 75
      ENDIF
      DO 70 i=1,nlcdir
         chpat(i)=chcdir(i)
  70  CONTINUE
      nlpat=nlcdir
  75  IF(ch1.EQ.bslash)THEN
         nlpat=nlpat-1
         IF(nlpat.EQ.0)nlpat=1
         IF(is1.EQ.nchp)GO TO 99
         is1=is1+1
         ch1=chpath(is1:is1)
         GO TO 75
      ENDIF
      is=is1
  76  IF(ch2.EQ.'..')THEN
         nlpat=nlpat-1
         IF(nlpat.EQ.0)nlpat=1
         IF(is1+1.EQ.nchp)GO TO 99
         IF(chpath(is1+2:is1+2).NE.'/') GOTO 90
         is =is1
         is1=is1+3
         ch2=chpath(is1:is1+1)
         GO TO 76
      ENDIF
  80  IF(is.EQ.nchp)THEN
         nlpat=nlpat+1
         IF(nlpat.GT.nlpatm)GO TO 90
         chpat(nlpat)=chpath(is1:is)
         GO TO 99
      ELSE
         IF(chpath(is:is).EQ.'/')THEN
            IF(is.GT.is1)THEN
               nlpat=nlpat+1
               IF(nlpat.GT.nlpatm)GO TO 90
               chpat(nlpat)=chpath(is1:is-1)
            ENDIF
            is1=is+1
         ENDIF
         is=is+1
         GO TO 80
      ENDIF
  90  nlpat=0
  99  RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzread(IV,N,IPC,IFORM)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /rzcl/ ltop,lrz0,lcdir,lrin,lrout,lfree,lused,lpurg
     +, ltemp,lcord,lfrom
      equivalence(lqrs,lqsyss(7))
      COMMON /rzclun/lun,lrec,isave,imodex,irelat,nhpwd,ihpwd(2)
     +, izrecl,imodec,imodeh
      COMMON /rzcout/ip1,ir1,ir2,irout,irlout,ioptrr
      parameter(kup=5,kpw1=7,knch=9,kdatec=10,kdatem=11,kquota=12,
     + krused=13,kwused=14,kmega=15,krzver=16,kirin=17,
     + kirout=18,krlout=19,kip1=20,knfree=22,knsd=23,kld=24,
     + klb=25,kls=26,klk=27,klf=28,klc=29,kle=30,knkeys=31,
     + knwkey=32,kkdes=33,knsize=253,kex=6,knmax=100)
      COMMON /mzioc/ nwfoav,nwfott,nwfodn,nwfore,ifocon(3)
     +, mfosav(2), jfoend,jforep,jfocur,mfo(200)
      dimension iv(*)
      nl1=lrec-ip1+1
      IF(ipc.LE.nl1)THEN
         irs=ir1
         is1=ip1+ipc-1
      ELSE
         nbef=(ipc-nl1-1)/lrec
         irs=ir2+nbef
         is1 =ipc-nl1-nbef*lrec
      ENDIF
      lrin=lq(kqsp+ltop-7)
      IF(lrin.EQ.0)THEN
         CALL mzbook(jqpdvs,lrin,ltop,-7,'RZIN',0,0,lrec+1,2,-1)
         iq(kqsp+lrin-5)=iq(kqsp+ltop-5)
         iq(kqsp+ltop+kirin)=0
         irin=0
      ELSE
         irin=iq(kqsp+ltop+kirin)
      ENDIF
      lrout=lq(kqsp+ltop-6)
      IF(lrout.EQ.0)THEN
         irout=0
      ELSE
         irout=iq(kqsp+ltop+kirout)
      ENDIF
      IF(irs.NE.irin)THEN
         IF(irs.NE.irout)THEN
            CALL rziodo(lun,lrec,irs,iq(kqsp+lrin+1),1)
            IF(iquest(1).NE.0)GO TO 90
            irin=irs
            iq(kqsp+ltop+kirin)=irin
         ENDIF
      ENDIF
      IF(imodex.GT.0.AND.iform.NE.1)THEN
         nwfott = n
         nwfodn = 0
         IF(iform.GT.0)THEN
            mfo(1) = iform
            mfo(2) = -1
            jfoend = 2
         ENDIF
      ENDIF
      nleft=lrec-is1+1
      IF(n.LE.nleft)THEN
         np1=n
      ELSE
         np1=nleft
      ENDIF
      IF(irs.NE.irout)THEN
         IF(imodex.GT.0.AND.iform.NE.1)THEN
            nwfoav=np1
            CALL fzicv(iq(kqsp+lrin+is1),iv)
            IF(nwfoav.GT.0.OR.ifocon(1).LT.0)GO TO 95
            IF(nwfoav.LT.0)idoub1=iq(kqsp+lrin+is1+np1-1)
            iquest(1)=0
         ELSE
            CALL ucopyi(iq(kqsp+lrin+is1),iv,np1)
         ENDIF
      ELSE
         IF(imodex.GT.0.AND.iform.NE.1)THEN
            nwfoav=np1
            CALL fzicv(iq(kqsp+lrout+is1),iv)
            IF(nwfoav.GT.0.OR.ifocon(1).LT.0)GO TO 95
            IF(nwfoav.LT.0)idoub1=iq(kqsp+lrout+is1+np1-1)
            iquest(1)=0
         ELSE
            CALL ucopyi(iq(kqsp+lrout+is1),iv,np1)
         ENDIF
      ENDIF
      IF(np1.LT.n)THEN
         nr=(n-np1-1)/lrec+1
         IF(irs.EQ.ir1)THEN
            irs=ir2
         ELSE
            irs=irs+1
         ENDIF
         DO 60 i=1,nr
            IF(i.NE.nr)THEN
               IF(imodex.GT.0.AND.iform.NE.1)THEN
                  CALL rziodo(lun,lrec,irs+i-1,iq(kqsp+lrin+1),1)
                  IF(iquest(1).NE.0)GO TO 90
                  IF(nwfoav.LT.0)THEN
                     CALL ucopy2(iq(kqsp+lrin+1),iq(kqsp+lrin+2),lrec)
                     iq(kqsp+lrin+1)=idoub1
                     nwfoav=lrec+1
                     CALL fzicv(iq(kqsp+lrin+1),iv)
                     CALL ucopy2(iq(kqsp+lrin+2),iq(kqsp+lrin+1),lrec)
                  ELSE
                     nwfoav=lrec
                     CALL fzicv(iq(kqsp+lrin+1),iv)
                  ENDIF
                  IF(nwfoav.GT.0.OR.ifocon(1).LT.0)GO TO 95
                  IF(nwfoav.LT.0)idoub1=iq(kqsp+lrin+lrec)
                  iquest(1)=0
               ELSE
                  print*,'>>>>>> RZIODO'
***               CALL RZIODO(LUN,LREC,IRS+I-1,V(NP1+1),1)
                  IF(iquest(1).NE.0)GO TO 90
               ENDIF
               np1=np1+lrec
            ELSE
               nl=n-np1
               irin=irs+i-1
               IF(irin.NE.irout)THEN
                  CALL rziodo(lun,lrec,irin,iq(kqsp+lrin+1),1)
                  IF(iquest(1).NE.0)GO TO 90
                  IF(imodex.GT.0.AND.iform.NE.1)THEN
                     IF(nwfoav.LT.0)THEN
                       CALL ucopy2(iq(kqsp+lrin+1),iq(kqsp+lrin+2),lrec)
                       iq(kqsp+lrin+1)=idoub1
                       nwfoav=nl+1
                       CALL fzicv(iq(kqsp+lrin+1),iv)
                       CALL ucopy2(iq(kqsp+lrin+2),iq(kqsp+lrin+1),lrec)
                     ELSE
                       nwfoav=nl
                       CALL fzicv(iq(kqsp+lrin+1),iv)
                     ENDIF
                     IF(nwfoav.GT.0.OR.ifocon(1).LT.0)GO TO 95
                     IF(nwfoav.LT.0)idoub1=iq(kqsp+lrin+nl)
                     iquest(1)=0
                  ELSE
                     CALL ucopyi(iq(kqsp+lrin+1),iv(np1+1),nl)
                  ENDIF
                  iq(kqsp+ltop+kirin)=irin
               ELSE
                 IF(imodex.GT.0.AND.iform.NE.1)THEN
                   IF(nwfoav.LT.0)THEN
                     CALL ucopy2(iq(kqsp+lrout+1),iq(kqsp+lrout+2),lrec)
                     iq(kqsp+lrout+1)=idoub1
                     nwfoav=nl+1
                     CALL fzicv(iq(kqsp+lrout+1),iv)
                     CALL ucopy2(iq(kqsp+lrout+2),iq(kqsp+lrout+1),lrec)
                   ELSE
                     nwfoav=nl
                     CALL fzicv(iq(kqsp+lrout+1),iv)
                   ENDIF
                   IF(nwfoav.GT.0.OR.ifocon(1).LT.0)GO TO 95
                   IF(nwfoav.LT.0)idoub1=iq(kqsp+lrout+nl)
                   iquest(1)=0
                 ELSE
                     CALL ucopyi(iq(kqsp+lrout+1),iv(np1+1),nl)
                  ENDIF
               ENDIF
            ENDIF
  60  CONTINUE
      ENDIF
  90  CONTINUE
      GO TO 99
  95  iquest(1) =4
      iquest(11)=nwfott
      iquest(12)=nwfore
      iquest(13)=nwfoav
      iquest(14)=nwfodn
      IF(jbyt(iq(kqsp+ltop),15,3)-3.GE.-2) WRITE(iqlog,1000)
 1000 FORMAT(' RZREAD. Error during conversion into native format')
  99  RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzchln (IXST,LP)
      parameter(iqbitw=32, iqbitc=8, iqchaw=4)
      COMMON /zmach/ nqbitw,nqbitc,nqchaw
     +, nqlnor,nqlmax,nqlpth,nqrmax,iqlpct,iqnil
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzcn/ iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      dimension ixst(9), lp(9)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      ixstor = ixst(1)
      iqln = lp(1)
      IF (ixstor.EQ.-7) GO TO 21
      IF (jbyt(ixstor,27,6).NE.jqstor) CALL mzsdiv (ixstor,-7)
   21 IF (iqln.LT.lqsta(kqt+1)) GO TO 98
      IF (iqln.GE.lqsta(kqt+21)) GO TO 98
      iwd = lq(kqs+iqln)
      nst = jbyt(iwd,1,16) - 12
      IF (nst.LT.0) GO TO 41
      iqls = iqln + nst + 1
      IF (iqls.GE.lqsta(kqt+21)) GO TO 91
      iqnio = jbyt(iq(kqs+iqls),19,4)
      iqid = iq(kqs+iqls-4)
      iqnl = iq(kqs+iqls-3)
      iqns = iq(kqs+iqls-2)
      iqnd = iq(kqs+iqls-1)
      IF ( jbyt(iqnl,iqbitw-3,4)
     + + jbyt(iqns,iqbitw-3,4)
     + + jbyt(iqnd,iqbitw-3,4) .NE.0) GO TO 91
      iqnx = iqls + iqnd + 9
      IF (iqnx.GT.lqsta(kqt+21)) GO TO 91
      IF (iqns.GT.iqnl) GO TO 91
      IF (nst.NE.iqnio+iqnl) GO TO 91
      iqfoul = 0
      RETURN
   41 nwd = jbyt(iwd,17,iqdrop-17)
      iqls = iqln - 8
      iqnx = iqln + nwd
      iqnd = -nwd
      IF (nwd.EQ.0) GO TO 91
      IF (nwd.NE.nst+12) GO TO 91
      nst = jbyt(iwd,iqdrop,iqbitw-iqdrop)
      IF (nst.NE.1) GO TO 91
      iqfoul= 0
      RETURN
   91 iqfoul = 7
      RETURN
   98 iqfoul = -7
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzchnb (LIX)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      dimension lix(9)
      dimension namesr(2)
      DATA namesr / 4hmzch, 4hnb  /
      k = locf(lix(1)) - lqstor
      IF (k.LT.lqsta(kqt+1)) RETURN
      IF (k.GE.lqend(kqt+20)) RETURN
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      nqcase = 1
      nqfata = 2
      iquest(11) = k
      iquest(12) = lix(1)
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzdrop (IXSTOR,LHEADP,CHOPT)
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      COMMON /zvfaut/iqvid(2),iqvsta,iqvlog,iqvthr(2),iqvrem(2,6)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzcn/ iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      dimension lheadp(9)
      CHARACTER *(*) CHOPT
      dimension namesr(2)
      DATA namesr / 4hmzdr, 4hop  /
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      lhead = lheadp(1)
      IF (lhead.EQ.0) RETURN
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      IF (jbyt(ixstor,27,6).NE.jqstor) CALL mzsdiv (ixstor,-7)
      CALL uoptc (chopt,'LV',iquest)
      iflag = iquest(1)
      IF (iquest(2).NE.0) iflag=-1
      CALL mzchls (-7,lhead)
      IF (iqfoul.NE.0) GO TO 91
      IF (nqlogl.LT.2) GO TO 19
      WRITE (iqlog,9018) jqstor,lhead,iqid,chopt
 9018 FORMAT (' MZDROP-  Store',i3,' L/ID=',i9,1x,a4,' Opt=',a)
   19 khead = lq(kqs+lhead+2)
   21 IF (iflag) 22, 31, 41
   22 ns = iqns
      CALL mzflag (ixstor,lhead,iqdrop,'V')
      CALL vzeroi (lq(kqs+lhead-ns),ns)
      GO TO 999
   31 CALL mzflag (ixstor,lhead,iqdrop,'.')
      ln = lq(kqs+lhead)
      IF (ln.EQ.0) GO TO 88
      IF (ln.EQ.lhead) GO TO 88
      CALL mzchls (-7,ln)
      IF (iqfoul.NE.0) GO TO 92
      IF (khead.NE.0) lq(kqs+khead)=ln
      lq(kqs+ln+2) = khead
      GO TO 999
   41 CALL mzflag (ixstor,lhead,iqdrop,'L')
   88 IF (khead.NE.0) lq(kqs+khead)=0
  999 nqtrac = nqtrac - 2
      RETURN
   92 nqcase = 1
      nqfata = 1
      iquest(12) = ln
   91 nqcase = nqcase + 1
      nqfata = nqfata + 1
      iquest(11) = lhead
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      FUNCTION mzdvac (IXDIVP)
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      dimension ixdivp(9)
      dimension namesr(2)
      DATA namesr / 4hmzdv, 4hac  /
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      msbit1(izw,izp) = ior(izw, ishft(1,izp-1))
      jbytet(mz,izw,izp,nzb) = iand(mz,
     + ishft(ishft(izw,33-izp-nzb),-(32-nzb)) )
      ixin = ixdivp(1)
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      jst = jbyt(ixin,27,6)
      IF (jst.EQ.jqstor) GO TO 31
      IF (jst-16.EQ.jqstor) GO TO 21
      CALL mzsdiv (ixin,-7)
      IF (jst.LT.16) GO TO 31
   21 ixac = jbyt(ixin,1,20)
      ixge = jbyt(ixin,21,6)
      IF (ixge.EQ.0) GO TO 59
      IF (ixge.LT.16) GO TO 41
   29 CALL mzsdiv (ixin,0)
   31 jdiv = jbyt(ixin,1,26)
      IF (jdiv.GE.25) GO TO 29
      ixac = 0
      IF (jdiv.GE.21) GO TO 33
      ixac = msbit1(ixac,jdiv)
      GO TO 59
   33 ixge = msbit1(0, jdiv-20)
   41 jdiv = 1
   42 IF (jdiv.EQ.jqdvll+1) jdiv=jqdvsy
      IF (jbytet(ixge,iqkind(kqt+jdiv),21,4).EQ.0) GO TO 47
      ixac = msbit1(ixac,jdiv)
   47 jdiv = jdiv + 1
      IF (jdiv.LT.21) GO TO 42
   59 mzdvac = ixac
  999 nqtrac = nqtrac - 2
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzgarb (IXGP,IXWP)
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      COMMON /zvfaut/iqvid(2),iqvsta,iqvlog,iqvthr(2),iqvrem(2,6)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension ixgp(1), ixwp(9)
      dimension namesr(2)
      DATA namesr / 4hmzga, 4hrb  /
      ixgarb = ixgp(1)
      ixwipe = ixwp(1)
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      jvlev = 2
      mqdvga = 0
      mqdvwi = 0
      IF (ixgarb.EQ.0) GO TO 16
      jvlev = 1
      mqdvga = mzdvac(ixgarb)
      IF (ixwipe.EQ.0) GO TO 19
      jsto = jqstor
      mqdvwi = mzdvac(ixwipe)
      IF (jsto.NE.jqstor) GO TO 91
      GO TO 19
   16 mqdvwi = mzdvac(ixwipe)
   19 IF (mqdvga+mqdvwi.EQ.0) GO TO 999
      nqresv = 0
      jqstmv = -1
      IF (nqlogl.LT.1) GO TO 24
      IF (mqdvga.NE.0) GO TO 22
      IF (nqlogl.LT.2) GO TO 24
   22 WRITE (iqlog,9022) jqstor,mqdvga,mqdvwi
 9022 FORMAT (' MZGARB-  User Garb.C./Wipe for store',i3,', Divs',
     f2(2x,z6))
      iqvrem(1,jvlev) = iqvid(1)
      iqvrem(2,jvlev) = iqvid(2)
   24 CALL mztabm
      CALL mztabr
      CALL mztabx
      CALL mztabf
      IF (nqnoop.NE.0) GO TO 999
      CALL mzgsta (nqdgau(kqt+1))
      CALL mzrelx
      CALL mzmove
      IF (iqpart.NE.0) GO TO 24
  999 nqtrac = nqtrac - 2
      RETURN
   91 nqcase = 1
      nqfata = 2
      iquest(11) = jsto
      iquest(12) = jqstor
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzgar1
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      COMMON /zvfaut/iqvid(2),iqvsta,iqvlog,iqvthr(2),iqvrem(2,6)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzcn/ iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension namesr(2)
      DATA namesr / 4hmzga, 4hr1  /
      msbit1(izw,izp) = ior(izw, ishft(1,izp-1))
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      iqvrem(1,1) = iqvid(1)
      iqvrem(2,1) = iqvid(2)
      mqdvga = 0
      mqdvwi = 0
      IF (jqdivi.LT.3) GO TO 24
      mqdvga = msbit1(0,jqdivi)
      jqdvm2 = jqdivi - jqmode
      IF (jqdvm2.EQ.jqdvsy-1) jqdvm2=jqdvll
      jqdvm1 = 2
      jqstmv = jqstor
      iqtnmv = 0
      IF (jqshar.EQ.0) GO TO 29
      mqdvga = msbit1(mqdvga,jqshar)
      GO TO 29
   24 mqdvga = 3
      jqstmv = -1
   29 nqdvmv = 0
      nresav = nqresv
      IF (nqlogl.GE.1) WRITE (iqlog,9028) mqtrac(nqtrac-3),
     + mqtrac(nqtrac-2),jqstor,jqdivi,nqresv
 9028 FORMAT (' MZGAR1-  Auto Garbage Collection called from ',2a4,
     f' for Store/Div',2i3,' Free',i7)
      CALL mztabm
      CALL mztabr
      nqresv = nqresv + nqfree
      IF (nqresv.GE.0) GO TO 51
      IF (iqpart.NE.0) GO TO 51
      IF (jqdivi.LT.3) GO TO 72
      nresv1 = lqsta(kqt+2) - lqend(kqt+1) - nqminr
      nresv1 = min(nresv1,lqend(kqt+2)-lq2end)
      IF (jqmode.NE.0) GO TO 34
      IF (jqshar.NE.0) THEN
          npossh = nqdmax(kqt+jqdivi) + nqdmax(kqt+jqdivn)
     + -(lqend(kqt+jqdivn) - lqsta(kqt+jqdivi))
          GO TO 36
        ELSE
          npossh = lqsta(kqt+jqdivi) + nqdmax(kqt+jqdivi)
     + - lqsta(kqt+jqdivn)
          GO TO 36
        ENDIF
   34 IF (jqshar.NE.0) THEN
          npossh = nqdmax(kqt+jqdivi) + nqdmax(kqt+jqdivn)
     + -(lqend(kqt+jqdivi) - lqsta(kqt+jqdivn))
        ELSE
          npossh = lqend(kqt+jqdivn)
     + - (lqend(kqt+jqdivi) - nqdmax(kqt+jqdivi))
        ENDIF
   36 nsh = (lqend(kqt+jqdivi)-lqsta(kqt+jqdivi)) / 8
      nsh = max(nsh,24) - nqresv
      nsh = min(nsh, npossh, nresv1)
      IF (nsh+nqresv.LT.0) GO TO 72
      nqresv = nqresv + nsh
      nqdvmv = - nsh
      CALL mztabs
   51 nwin = nqresv - nresav
      IF (nqlogl.GE.1) WRITE (iqlog,9051) nwin,nqdvmv
 9051 FORMAT (10x,'Wins',i7,' words, Shift by',i7)
      CALL mztabx
      CALL mztabf
      IF (nqnoop) 68, 53, 67
   53 CALL mzgsta (nqdgaf(kqt+1))
      CALL mzrelx
   67 CALL mzmove
   68 IF (nqresv.LT.0) GO TO 71
  999 nqtrac = nqtrac - 2
      RETURN
   71 IF (iqpart.NE.0) GO TO 29
   72 iquest(11) = nqresv
      iquest(12) = jqstor
      iquest(13) = jqdivi
      IF (nqlogl.GE.1) WRITE (iqlog,9072) nqresv
 9072 FORMAT (10x,'Not enough space, Free',i7)
      IF (nqperm.NE.0) GO TO 999
      IF (jqkind.NE.1) GO TO 91
      print*,'>>>>>> CALL ZTELL (99,1)'
   91 nqcase = 1
      nqfata = 1
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzform (CHID,CHFORM,IXIOP)
      COMMON /zvfaut/iqvid(2),iqvsta,iqvlog,iqvthr(2),iqvrem(2,6)
      COMMON /zkrakc/iqholk(120), iqkrak(80), iqcetk(122)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      equivalence(lqform,lqsyss(5))
      equivalence(nw,iquest(1))
      dimension ixiop(99)
      CHARACTER CHID*(*), CHFORM*(*)
      dimension mmid(5), mmix(5), mmio(5)
      dimension namesr(2)
      DATA namesr / 4hmzfo, 4hrm  /
      DATA mmid / 4hqid , 2, 2, 10, 5 /
      DATA mmix / 4hqiox, 0, 0, 7, 2 /
      DATA mmio / 4hqiod, 0, 0, 50, 1 /
      msbyt(mz,izw,izp,nzb) = ior(
     + iand(izw, not(ishft(ishft(not(0),-(32-nzb)),izp-1)))
     + ,ishft(ishft(mz,32-nzb), -(33-izp-nzb)) )
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      n = min(4, len(chid))
      CALL uctoh (chid,idh,4,n)
      IF (lqform.EQ.0) GO TO 75
   12 iqcetk(121) = idh
      liod = lq(kqsp+lqform-2)
      ixiod = iq(kqsp+liod+1)
      CALL mzioch (iq(kqsp+liod+ixiod+1),16,chform)
      nw = nw + 1
      nwio = ixiod + nw
      iq(kqsp+liod+1) = nwio
      nfrio = iq(kqsp+liod-1) - nwio
      lid = lqform
      IF (idh.LT.0) lid=lq(kqsp+lid)
      lix = lq(kqsp+lid-1)
      nwid = iq(kqsp+lid+1) + 1
      iq(kqsp+lid+1) = nwid
      iq(kqsp+lid+nwid+3) = idh
      iq(kqsp+lix+nwid) = ixiod
      nfrid = iq(kqsp+lid-1) - nwid - 3
      iquest(2) = 64*nw + 2
      iquest(2) = msbyt(ixiod,iquest(2),17,15)
      ixiop(1) = iquest(2)
      IF (nfrid.EQ.0) GO TO 71
   28 IF (nfrio.LT.16) GO TO 73
   29 CONTINUE
  999 nqtrac = nqtrac - 2
      RETURN
   71 CALL mzpush (jqpdvs,lid,0,20,'I')
      lix = lq(kqsp+lid-1)
      CALL mzpush (jqpdvs,lix,0,20,'I')
      GO TO 28
   73 liod = lq(kqsp+lqform-2)
      CALL mzpush (jqpdvs,liod,0,60,'I')
      GO TO 29
   75 CONTINUE
      DO 76 j=1,2
      CALL mzlift (jqpdvs,l,lqform,1,mmid,0)
      CALL mzlift (jqpdvs,lix,l,-1,mmix,0)
   76 CONTINUE
      CALL mzlift (jqpdvs,l,lqform,-2,mmio,0)
      iq(kqsp+l+1) = 1
      GO TO 12
      END
 
*-------------------------------------------------------------------------------
 
      FUNCTION mzfdiv (IXST,LIXP)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      dimension ixst(9), lixp(9)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      ixstor = ixst(1)
      lix = lixp(1)
      IF (ixstor.NE.-7) THEN
      IF (jbyt(ixstor,27,6).NE.jqstor) CALL mzsdiv (ixstor,-7)
          jdivi = 2
        ELSE
          jdivi = jqdivi
        ENDIF
      IF (jdivi.EQ.0) GO TO 21
      IF (lix.LT.lqsta(kqt+jdivi)) GO TO 21
      IF (lix.LT.lqend(kqt+jdivi)) GO TO 99
   21 jdivi = 1
      IF (lix.LT.lqend(kqt+jqdvll)) GO TO 24
      IF (lix.GE.lqend(kqt+20)) GO TO 91
      jdivi = jqdvsy
   24 IF (lix.LT.lqend(kqt+jdivi)) GO TO 26
      jdivi = jdivi + 1
      GO TO 24
   26 IF (lix.GE.lqsta(kqt+jdivi)) GO TO 99
   91 jdivi = 0
   99 mzfdiv = jdivi
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzfgap
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension ngapv(7), jdivv(7), jstov(7), jpv(7)
      equivalence(ngapv(1),iquest(11)), (jdivv(1),iquest(21))
      equivalence(jstov(1),iquest(31)), (jpv(1), iquest(41))
      dimension nqgapv(2)
      equivalence(nqgapv(1),nqgapn)
      CALL vzeroi (iqgap,20)
   15 DO 17 j=1,6
   17 ngapv(j) = 0
      IF (jqstmv.LT.0) GO TO 19
      kt = nqofft(jqstmv+1)
      jdvsh1 = jqdvm1
      jdvsh2 = jqdvm2
      IF (nqdvmv.GT.0) GO TO 19
      IF (jdvsh1.EQ.iqtabv(kt+9)) jdvsh1=iqtabv(kt+8)+1
      jdvsh1 = jdvsh1 - 1
      jdvsh2 = jdvsh2 - 1
   19 mingn = 0
      mingv = 0
      jmingn = 1
      jmingv = 5
      jsto = -1
   21 jsto = jsto + 1
      IF (jsto.GT.nqstor) GO TO 61
      IF (nqallo(jsto+1).LT.0) GO TO 21
      kt = nqofft(jsto+1)
      jdvn = 1
   31 jdiv = jdvn
      IF (jdiv.EQ.21) GO TO 21
      jdvn = jdiv + 1
      IF (jdiv.EQ.iqtabv(kt+8)) jdvn=iqtabv(kt+9)
      nwgap = lqsta(kt+jdvn) - lqend(kt+jdiv)
      IF (nwgap.LT.164) GO TO 31
      IF (jsto.NE.jqstmv) GO TO 41
      IF (jdiv.LT.jdvsh1) GO TO 41
      IF (jdiv.GT.jdvsh2) GO TO 41
      IF (nwgap.LE.mingv) GO TO 31
      ngapv(jmingv) = nwgap
      jdivv(jmingv) = jdiv
      jstov(jmingv) = jsto
      jmingv = 5
      mingv = ngapv(5)
      IF (mingv.LE.ngapv(6)) GO TO 31
      jmingv = 6
      mingv = ngapv(6)
      GO TO 31
   41 IF (nwgap.LE.mingn) GO TO 31
      ngapv(jmingn) = nwgap
      jdivv(jmingn) = jdiv
      jstov(jmingn) = jsto
      jmingn = 1
      mingn = ngapv(1)
      DO 44 j=2,4
      IF (mingn.LE.ngapv(j)) GO TO 44
      jmingn = j
      mingn = ngapv(j)
   44 CONTINUE
      GO TO 31
   61 DO 62 j=1,6
   62 jpv(j) = j
      jg = 1
   65 jf = jpv(jg)
      jn = jpv(jg+1)
      IF (ngapv(jf).LT.ngapv(jn)) GO TO 67
      IF (jg.EQ.3) GO TO 71
   66 jg = jg + 1
      GO TO 65
   67 jpv(jg) = jn
      jpv(jg+1) = jf
      IF (jg.EQ.1) GO TO 66
      jg = jg - 1
      GO TO 65
   71 jg = 4
   75 jf = jpv(jg)
      jn = jpv(jg+1)
      IF (ngapv(jf).LT.ngapv(jn)) GO TO 77
      IF (jg.EQ.5) GO TO 81
   76 jg = jg + 1
      GO TO 75
   77 jpv(jg) = jn
      jpv(jg+1) = jf
      IF (jg.EQ.3) GO TO 76
      jg = jg - 1
      GO TO 75
   81 nqgapn = 0
      nqgap = 0
      jsel = 1
      DO 87 jg=1,4
      ju = jpv(jg)
      nwgap= ngapv(ju)
      IF (nwgap.EQ.0) GO TO 87
      jdiv = jdivv(ju)
      jsto = jstov(ju)
      kt = nqofft(jsto+1)
      ks = nqoffs(jsto+1)
      iqgap(1,jg) = nwgap
      iqgap(2,jg) = ks+ lqend(kt+jdiv)
      iqgap(3,jg) = jdiv
      iqgap(4,jg) = jsto
      IF (ju.GE.5) jsel=2
      nqgapv(jsel) = jg
   87 CONTINUE
      nqgap = max(nqgapn,nqgap)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mztabc
      COMMON /mzcn/ iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      equivalence(ls,iqls), (lnx,iqnx)
      dimension namesr(2)
      DATA namesr / 4hmzta, 4hbc  /
      jbit(izw,izp) = iand(ishft(izw,-(izp-1)),1)
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      nqfrtc = 0
      nqlive = 0
      n = 0
      lnx = lqmtc1
      lqte = lqtc1
      new = iqtval
      lq(lqte) = lnx
      lq(lqte+2) = 0
   21 mode = new
   22 ln = lnx
      IF (ln.GE.lqmtc2) GO TO 41
      n = n + 1
      CALL mzchln (-7,ln)
      IF (iqfoul.NE.0) GO TO 91
      new = jbit(iq(kqs+ls),iqtbit)
      IF (new.EQ.mode) GO TO 22
      IF (new.EQ.iqtval) GO TO 36
      nqlive = nqlive + n - 1
      lq(lqte+1) = ln
      lq(lqte+3) = 1
      lqte = lqte + 4
      GO TO 21
   36 nqfrtc = nqfrtc + (ln - lq(lqte-3))
      lq(lqte) = ln
      lq(lqte+2) = 0
      n = 1
      IF (lqte.LT.lqtc2) GO TO 21
      CALL mztabh
      IF (iqpart.EQ.0) GO TO 21
      iqpart = 1
      ln = lqmtc2
   41 IF (new.NE.iqtval) GO TO 43
      nqlive = nqlive + n
      lq(lqte+1) = ln
      lq(lqte+3) = 0
      GO TO 45
   43 nqfrtc = nqfrtc + (ln-lq(lqte-3))
      lq(lqte) = ln
      lq(lqte+1) = ln
      lq(lqte+2) = 0
      lq(lqte+3) = 0
   45 lqte = lqte + 4
  999 nqtrac = nqtrac - 2
      RETURN
   91 nqcase = 1
      nqfata = 3
      iquest(11) = ln
      iquest(12) = lqmtc1
      iquest(13) = lqmtc2
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mztabf
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension namesr(2)
      DATA namesr / 4hmzta, 4hbf  /
      jbit(izw,izp) = iand(ishft(izw,-(izp-1)),1)
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      lmt = lqmta
      ncoll = 0
      ngarb = 0
      nqnoop = 0
      lfixlo = nqlink + 1
   21 jdiv = lq(lmt)
      iact = lq(lmt+1)
      IF (iact.EQ.4) GO TO 26
      IF (iact.GE.2) GO TO 28
      IF (iact.GE.0) lfixlo=lqend(kqt+jdiv)
      lmt = lmt + 8
      IF (lmt.LT.lqmte) GO TO 21
      nqnoop = -7
      IF (nqdvmv.EQ.0) GO TO 81
      nqnoop = 7
      GO TO 81
   26 IF (lq(lmt+9).NE.4) GO TO 28
      IF (lmt+8.GE.lqmte) GO TO 28
      lmt = lmt + 8
      GO TO 26
   28 lfir = lmt
      lqta = lqrta + lq(lmt+5)
   31 iact = lq(lmt+1)
      nshf = lq(lmt+2)
      ltu = lqrta + lq(lmt+5)
      IF (iact.EQ.4) GO TO 71
      IF (iact.EQ.3) GO TO 61
      IF (iact.EQ.2) GO TO 41
      IF (iact.LT.0) GO TO 79
      ncoll = ncoll + 1
      IF (ncoll.NE.1) GO TO 79
      lcoll = lmt
      GO TO 79
   41 IF (ncoll+ngarb.LT.2) GO TO 49
   43 lcole = lmt - 8
      lt = lq(lcole+5)
      ltf = lq(lcoll+5)
      n = lt - ltf
      nw = lqrta + ltf+1 - lqta
      CALL ucopy2 (lq(lqta),lq(lqta+n),nw)
      lqta = lqta + n
      ncoll = 0
      IF (iact.EQ.4) GO TO 71
      IF (iact.EQ.3) GO TO 61
   49 lq(ltu+2) = nshf
      GO TO 77
   61 IF (ncoll+ngarb.GE.2) GO TO 43
      jdiv = lq(lmt)
      lt = ltu
      lte = lqrta + lq(lmt+6)
      mode = jbit(iqmode(kqt+jdiv),1)
      IF (mode.NE.0) GO TO 65
      ncum = nshf
      GO TO 66
   65 ncum = lq(lmt+7) + nshf
   66 lq(lt+2) = ncum
      ncum = ncum - (lq(lt+4)-lq(lt+1))
      lt = lt + 4
      IF (lt.LT.lte) GO TO 66
      ngarb = -64
      GO TO 77
   71 IF (ncoll+ngarb.GE.2) GO TO 43
   77 ncoll = 0
   79 lmt = lmt + 8
      IF (lmt.LT.lqmte) GO TO 31
      lq(lqta-1) = lfixlo
      IF (ncoll.EQ.0) GO TO 81
      lqte = lqrta + lq(lcoll+5)
   81 CONTINUE
  999 nqtrac = nqtrac - 2
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mztabh
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension namesr(2)
      DATA namesr / 4hmzta, 4hbh  /
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      IF (jqgapm.NE.0) GO TO 41
      CALL mzfgap
      nw = lqmte+1 - lqmta
      jqgapm = nqgapn
      IF (jqgapm.LT.2) GO TO 26
   23 lnew = iqgap(2,jqgapm)
      nsh = lnew - lqmta
      CALL ucopyi (lq(lqmta),lq(lnew),nw)
      lqmta = lnew
      lqmtb = lqmtb + nsh
      lqmte = lqmte + nsh
      lqtc2 = lqtc2 + 161
      lqrte = lqrte + 161
      iqgap(1,jqgapm) = iqgap(1,jqgapm) - nw
      iqgap(2,jqgapm) = iqgap(2,jqgapm) + nw
  999 nqtrac = nqtrac - 2
      RETURN
   26 IF (iqtnmv.EQ.0) jqgapm=nqgap
      IF (jqgapm.NE.0) GO TO 23
      IF (iqtnmv.LT.0) GO TO 31
   29 iqpart = 7
      GO TO 999
   31 jqgapm = nqgap
      IF (jqgapm.EQ.0) GO TO 29
      iqpart = -7
      GO TO 23
   36 IF (iqtnmv.GE.0) GO TO 29
      IF (jqgapr.GT.nqgapn) GO TO 29
      jqgapr = nqgap
      IF (jqgapr.EQ.0) GO TO 29
      IF (iqgap(1,nqgap-1).GT.iqgap(1,nqgap)) jqgapr=nqgap-1
      nnew = iqgap(1,jqgapr) - (lqrte-lqrta) - 10
      IF (nnew.LT.16) GO TO 29
      iqpart = -7
      GO TO 44
   41 IF (jqgapr.NE.0) GO TO 36
      IF (nqgapn.EQ.0) GO TO 36
      nnew = iqgap(1,1) - nqwktb
      IF (nnew.LT.16) GO TO 36
      jqgapr = 1
   44 lnew = iqgap(2,jqgapr)
      nsh = lnew - lqrta
      nw = lqte+4 - lqrta
      CALL ucopyi (lq(lqrta),lq(lnew),nw)
      GO TO 999
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mztabm
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension namesr(2)
      DATA namesr / 4hmzta, 4hbm  /
      jbit(izw,izp) = iand(ishft(izw,-(izp-1)),1)
      msbit1(izw,izp) = ior(izw, ishft(1,izp-1))
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      lqmtbr = 0
      iqtbit = iqdrop
      iqtval = 0
      nqfree = 0
      iqpart = 0
      mqdvac = 0
      iqflio = 0
      IF (jqstmv.LT.0) THEN
          iqtnmv = 0
          jqdvm1 = 0
          jqdvm2 = 0
          nqdvmv = 0
        ENDIF
      jqgapm = 0
      jqgapr = 0
      lqmte = lqwktb + nqwktb - 1
      lqmta = lqmte - 160
      lqmtb = lqmta
      lqrte = lqmta - 10
      lqtc2 = lqrte
      lqrta = lqwktb
      lqta = lqrta + 1
      lqte = lqta
      lqtc1 = lqta
      lmt = lqmta
      jdiv = 1
   32 lq(lmt) = jdiv
      lq(lmt+1) = 0
      lq(lmt+2) = 0
      lq(lmt+3) = lqsta(kqt+jdiv)
      lq(lmt+4) = lqend(kqt+jdiv)
      lq(lmt+5) = 0
      lq(lmt+6) = 0
      lq(lmt+7) = 0
      nw = lq(lmt+4) - lq(lmt+3)
      IF (nw.EQ.0) GO TO 37
      nqdsiz(kqt+jdiv) = max(nqdsiz(kqt+jdiv),nw)
      IF (jbit(mqdvwi,jdiv).NE.0) GO TO 41
      IF (jbit(mqdvga,jdiv).NE.0) GO TO 44
      GO TO 48
   37 lq(lmt+1) = -1
      GO TO 48
   41 IF (jdiv.EQ.jqdvsy) GO TO 48
      lq(lmt+1) = 4
      GO TO 45
   44 lq(lmt+1) = 3
   45 mqdvac = msbit1(mqdvac,jdiv)
   48 lmt = lmt + 8
      jdiv = jdiv + 1
      IF (jdiv.EQ.jqdvll+1) jdiv=jqdvsy
      IF (jdiv.LT.21) GO TO 32
      lqmte = lmt
      lqmtlu = lmt
      lq(lqmte) = 21
  999 nqtrac = nqtrac - 2
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mztabr
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      equivalence(lmt,lqmtb)
      dimension namesr(2)
      DATA namesr / 4hmzta, 4hbr  /
      msbit0(izw,izp) = iand(izw, not(ishft(1,izp-1)))
      msbit1(izw,izp) = ior(izw, ishft(1,izp-1))
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      IF (lqmtbr.NE.0) GO TO 81
      lqta = lqrta + 2
      lqte = lqta
      lmt = lqmta
      lq(lqta-1) = nqlink + 1
   41 jdiv = lq(lmt)
      lq(lmt+5) = lqte - lqrta
   42 lq(lqte) = lq(lmt+3)
      lq(lqte+1) = lq(lmt+4)
      lq(lqte+2) = 0
      lq(lqte+3) = 0
      iact = lq(lmt+1)
      IF (iact.EQ.3) GO TO 61
      IF (iact.EQ.-1) GO TO 78
      IF (iact.EQ.4) GO TO 56
      IF (lq(lmt+6).EQ.-3) GO TO 45
      lqte = lqte + 4
      GO TO 78
   45 lq(lmt+6) = 0
      lq(lmt+1) = 3
      mqdvac = msbit1(mqdvac,jdiv)
      GO TO 42
   56 lq(lmt+7) = lq(lmt+4) - lq(lmt+3)
      GO TO 78
   61 IF (iqpart.NE.0) GO TO 66
      lqtc1 = lqte
      lqtc2 = lqrte - (lqmte-lmt)/2
      IF (lqtc1.GE.lqtc2) GO TO 65
      lqmtc1 = lq(lmt+3)
      lqmtc2 = lq(lmt+4)
      CALL mztabc
      nqfree = nqfree + nqfrtc
      IF (nqlive.EQ.0) GO TO 64
      IF (iqpart.NE.0) lqmtbr=lmt
      IF (nqfrtc.EQ.0) GO TO 67
      lq(lmt+6) = lqte - lqrta
      lq(lmt+7) = nqfrtc
      GO TO 78
   64 lqte = lqtc1
      lq(lmt+1) = 4
      GO TO 42
   65 lqmtbr = lmt
      iqpart = 7
   66 lq(lmt+6) = -3
      lqte = lqte + 4
   67 lq(lmt+1) = 2
      IF (lq(lmt+2).EQ.0) THEN
          lq(lmt+1) = 0
          mqdvac = msbit0(mqdvac,jdiv)
        ENDIF
   78 lmt = lmt + 8
      IF (lmt.LT.lqmte) GO TO 41
      jdiv = lq(lmt)
      lq(lqte) = lqsta(kqt+jdiv)
  999 nqtrac = nqtrac - 2
      RETURN
   81 lmt = lqmtbr
      lqmtbr = 0
      iqpart = 0
      jdiv = lq(lmt)
      mqdvac = msbit1(mqdvac,jdiv)
      WRITE (iqlog, 9882)
 9882 FORMAT (1x/' MZTABR!! !!!!****  re-entry with LQMTBR non-zero',
     f'****!!!!'/1x)
      jway = lq(lmt+6)
      IF (jway.EQ.-3) THEN
          lqte = lq(lmt+5)
          GO TO 45
        ENDIF
      lqte = jway - 4
      lqmtc1 = lq(lqte)
      lqmtc2 = lq(lqte+1)
      lqtc1 = lqte
      lqtc2 = lqrte - (lqmte-lmt)/2
      CALL mztabc
      lq(lmt+6) = lqte - lqrta
      lq(lmt+7) = lq(lmt+7) + nqfrtc
      GO TO 78
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mztabs
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      msbit1(izw,izp) = ior(izw, ishft(1,izp-1))
      lmt = lqmta
   21 lmt = lmt + 8
      jdiv = lq(lmt)
      IF (jdiv.LT.jqdvm1) GO TO 21
      IF (jdiv.GT.jqdvm2) RETURN
      lq(lmt+2) = lq(lmt+2) + nqdvmv
      IF (lq(lmt+1).LT.0) GO TO 21
      IF (lq(lmt+1).GE.2) GO TO 21
      lq(lmt+1) = 2
      mqdvac = msbit1(mqdvac,jdiv)
      GO TO 21
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mztabx
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      jbytet(mz,izw,izp,nzb) = iand(mz,
     + ishft(ishft(izw,33-izp-nzb),-(32-nzb)) )
      merge = 0
      lmt = lqmta
   22 IF (lq(lmt+1).LT.2) GO TO 27
      jdiv = lq(lmt)
      merge = ior(merge, iqkind(kqt+jdiv))
   27 lmt = lmt + 8
      IF (lmt.LT.lqmte) GO TO 22
      lmt = lqmta
   32 IF (lq(lmt+1)) 38, 33, 37
   33 jdiv = lq(lmt)
      IF (jbytet(iqrto(kqt+jdiv),merge,1,26).EQ.0) GO TO 38
      IF (jbytet(iqrno(kqt+jdiv),merge,1,26).EQ.0) GO TO 38
      lq(lmt+1) = 1
   37 lqmtlu = lmt + 8
   38 lmt = lmt + 8
      IF (lmt.LT.lqmte) GO TO 32
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzioch (IODVEC,NWIOMP,CHFORM)
      COMMON /zkrakc/iqholk(120), iqkrak(80), iqcetk(122)
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      COMMON /quest/ iquest(100)
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /zbcd/ iqnum2(11),iqlett(26),iqnum(10), iqplus,iqmins
     +, iqstar,iqslas,iqopen,iqclos,iqdoll,iqequ, iqblan
     +, iqcoma,iqdot, iqnumb,iqapo, iqexcl,iqcolo,iqquot
     +, iqunde,iqclsq,iqand, iqat, iqques,iqopsq,iqgrea
     +, iqless,iqreve,iqcirc,iqsemi,iqperc, iqlowl(26)
     +, iqcrop,iqvert,iqcrcl,iqnot, iqgrav, iqileg
     +, nqhol0,nqholl(95)
      dimension iodvec(99), nwiomp(9)
      CHARACTER CHFORM*(*)
      equivalence(ngr,iquest(1)), (ngru,iquest(2))
      dimension mu(99), mce(99)
      equivalence(mu(1),iqholk(1)), (mce(1),iqcetk(1))
      dimension nbitva(4), nbitvb(4), nbitvc(7)
      dimension mxvala(4), mxvalb(4), mxvalc(7)
      dimension itab(48), inv(10)
      dimension namesr(2)
      DATA namesr / 4hmzio, 4hch  /
      DATA itab / 47
     +, -1, 12, -1, 15, -1, 14, -1, 16, 13, -1, -1, -1, -1
     +, -1, -1, -1, -1, -1, 18, -1, -1, -1, -1, -1, -1, -1
     +, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, -1, 11, 10
     +, 19, -1, -1, -1, -1, -2, -2, -2 /
      DATA inv / 39, 38, 2, 9, 6, 4, 8, 24, 19, 40 /
      DATA nbitva / 32, 16, 10, 8 /
      DATA nbitvb / 29, 14, 9, 7 /
      DATA nbitvc / 26, 11, 6, 4, 2, 1, 1 /
      DATA mxvala / 0, 65536, 1024, 256 /
      DATA mxvalb / 0, 16384, 512, 128 /
      DATA mxvalc / 0, 2048, 64, 16, 4, 2, 2 /
      msbit1(izw,izp) = ior(izw, ishft(1,izp-1))
      msbyt(mz,izw,izp,nzb) = ior(
     + iand(izw, not(ishft(ishft(not(0),-(32-nzb)),izp-1)))
     + ,ishft(ishft(mz,32-nzb), -(33-izp-nzb)) )
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      nwiomx = nwiomp(1)
      nch = len(chform)
      IF (nch.GE.121) GO TO 90
      CALL uctoh1 (chform,iqholk,nch)
      CALL izbcdt (nch,itab)
      nch = iquest(1)
      IF (iquest(2).NE.0) GO TO 91
      IF (iquest(1).EQ.0) GO TO 91
      jposr = -1
      jposin = -1
      ival = 0
      jch = 0
      ju = 0
   21 nval = 0
   22 jch = jch + 1
      num = mce(jch)
      IF (num.GE.10) GO TO 24
      nval = 10*nval + num
      IF (jch.LT.nch) GO TO 22
      GO TO 92
   24 IF (num.GE.12) GO TO 26
      IF (nval.NE.0) GO TO 92
      IF (num.EQ.11) THEN
          nval = -1
          jposin = ju
          IF (jposr.GE.0) GO TO 93
        ENDIF
      IF (jch.EQ.nch) GO TO 92
      jch = jch + 1
      num = mce(jch)
      IF (num.LT.12) GO TO 92
      IF (num.GE.19) GO TO 92
      GO TO 27
   26 IF (num.EQ.19) GO TO 29
      IF (num.EQ.18) GO TO 92
      IF (nval.EQ.0) GO TO 92
      IF (num.EQ.15) THEN
          IF (nval.NE.2*(nval/2)) GO TO 92
        ENDIF
      ival = 7
   27 mu(ju+1) = num - 11
      mu(ju+2) = nval
      ju = ju + 2
      IF (jch.EQ.nch) GO TO 31
      IF (jposin.LT.0) GO TO 21
      GO TO 94
   29 IF (nval.NE.0) GO TO 92
      IF (jposr.GE.0) GO TO 95
      IF (jch.EQ.nch) GO TO 92
      jposr = ju
      GO TO 21
   31 nu = ju
      nseca = nu/2
      ju = 2
      iowd = 65
      nwio = 0
      jfl12 = 1
      IF (jposr.GE.0) THEN
          IF (jposr+2.NE.nu) GO TO 41
          IF (mu(nu-1).NE.7) GO TO 41
        ELSE
          IF (mu(nu).EQ.0) jfl12=2
        ENDIF
   32 nseca = nseca - 1
      iquest(12) = mu(nu-1)
      IF (nseca.EQ.0) THEN
          IF (jfl12.EQ.1) GO TO 82
          iquest(12) = msbit1(iquest(12),4)
          GO TO 82
        ENDIF
      IF (nseca.GE.2) GO TO 33
      IF (mu(2).GE.64) GO TO 34
      IF (jfl12.EQ.2) iquest(12)= msbit1(iquest(12),4)
      iquest(12) = msbyt(mu(1),iquest(12),5,3)
      iquest(12) = msbyt(mu(2),iquest(12),8,6)
      GO TO 82
   33 IF (ival+nseca.EQ.2) GO TO 38
   34 iquest(12) = msbyt(jfl12,iquest(12),14,2)
      iquest(12) = msbyt(mu(1),iquest(12),5,3)
      iquest(13) = mu(2)
      jbtf = 8
      IF (nseca.GE.4) GO TO 36
      iowd = 2177
      nwio = 1
      IF (nseca.EQ.1) GO TO 82
      ngr = nseca
      CALL mziocf (0,mxvala)
      IF (ngr.NE.ngru) GO TO 36
      nbt = nbitva(ngru)
      GO TO 71
   36 iquest(12) = msbit1(iquest(12),4)
      ngr = min(nseca,3)
      CALL mziocf (0,mxvalb)
      nbt = nbitvb(ngru)
      GO TO 70
   38 iquest(12) = 16*iquest(12)
      iquest(12) = msbyt(mu(1),iquest(12), 8,3)
      iquest(12) = msbyt(mu(3),iquest(12),11,3)
      iquest(12) = msbyt(jfl12,iquest(12),14,2)
      GO TO 82
   41 nsecl = jposr/2
      IF (nseca.GE.3) GO TO 44
      iquest(12) = mu(nu-1)
      iquest(12) = msbyt(3,iquest(12),14,2)
      IF (nseca.EQ.2) GO TO 42
      IF (mu(2).EQ.0) GO TO 82
      GO TO 32
   42 IF (mu(4).NE.0) GO TO 44
      IF (mu(2).GE.64) GO TO 44
      iquest(12) = msbyt(mu(1),iquest(12),5,3)
      iquest(12) = msbyt(mu(2),iquest(12),8,6)
      IF (nsecl.EQ.1) GO TO 82
      iquest(12) = msbit1(iquest(12),4)
      GO TO 82
   44 IF (nsecl.EQ.0) GO TO 51
      IF (nsecl.GE.3) GO TO 61
      IF (nseca.GE.5) GO TO 61
      IF (ival+nseca.EQ.3) GO TO 48
      ngr = nseca
      CALL mziocf (0,mxvala)
      IF (ngr.NE.ngru) GO TO 61
      iquest(12) = mu(1)
      iquest(13) = mu(2)
      IF (nsecl.EQ.2) iquest(12)=iquest(12)+8
      iquest(12) = msbit1(iquest(12),16)
      jbtf = 5
      nbt = nbitva(ngru)
      iowd = 2177
      nwio = 1
      GO TO 71
   48 iquest(12) = 8*(2*mu(1)+nsecl-1)
      iquest(12) = msbyt(mu(3),iquest(12), 8,3)
      iquest(12) = msbyt(mu(5),iquest(12),11,3)
      iquest(12) = msbit1(iquest(12),16)
      GO TO 82
   51 IF (ival+nseca.EQ.3) GO TO 58
      iquest(12) = mu(1)
      iquest(13) = mu(2)
      iquest(12) = msbyt(5,iquest(12),14,3)
      jbtf = 5
      IF (nseca.GE.5) GO TO 55
      ngr = nseca
      CALL mziocf (0,mxvala)
      IF (ngr.NE.ngru) GO TO 55
      nbt = nbitva(ngru)
      iowd = 2177
      nwio = 1
      GO TO 71
   55 iquest(12) = msbit1(iquest(12),4)
      ngr = min(nseca,4)
      CALL mziocf (0,mxvalb)
      nbt = nbitvb(ngru)
      GO TO 70
   58 iquest(12) = 16*mu(1)
      iquest(12) = msbyt(mu(3),iquest(12), 8,3)
      iquest(12) = msbyt(mu(5),iquest(12),11,3)
      iquest(12) = msbyt(5,iquest(12),14,3)
      GO TO 82
   61 iquest(12) = nsecl
      iquest(13) = mu(2)
      IF (nsecl.GE.16) GO TO 96
      iquest(12) = msbyt(mu(1),iquest(12),5,3)
      iquest(12) = msbyt(6,iquest(12),14,3)
      jbtf = 8
      ngr = 3
      CALL mziocf (0,mxvalb)
      nbt = nbitvb(ngru)
   70 IF (ngru.EQ.1) GO TO 73
   71 jbtc = 1
      DO 72 jl=2,ngru
      iquest(12) = msbyt(mu(ju+1),iquest(12),jbtf,3)
      jbtf = jbtf + 3
      jbtc = jbtc + nbt
      iquest(13) = msbyt(mu(ju+2),iquest(13),jbtc,nbt)
   72 ju = ju + 2
      IF (ngru.EQ.nseca) GO TO 82
   73 nsecd = ngru
      jwio = 13
   74 jwio = jwio + 1
      iquest(jwio) = mu(ju+1)
      jbt = 4
      ngru = 1
      ngr = min(7,nseca-nsecd)
      IF (ngr.EQ.1) GO TO 77
      CALL mziocf (ju,mxvalc)
      IF (ngru.EQ.1) GO TO 77
      just = ju
      DO 76 jl=2,ngru
      ju = ju + 2
      iquest(jwio) = msbyt(mu(ju+1),iquest(jwio),jbt,3)
   76 jbt = jbt + 3
      ju = just
   77 iquest(jwio-1) = msbyt(ngru,iquest(jwio-1),30,3)
      nbt = nbitvc(ngru)
      DO 79 jl=1,ngru
      iquest(jwio) = msbyt(mu(ju+2),iquest(jwio),jbt,nbt)
      jbt = jbt + nbt
   79 ju = ju + 2
      nsecd = nsecd + ngru
      IF (nsecd.LT.nseca) GO TO 74
      nwio = jwio - 12
      IF (nwio.GE.nwiomx) GO TO 97
      IF (nwio.GE.16) GO TO 97
      iowd = 64*(32*nwio+nwio+1) + 1
   82 iowd = msbyt(iquest(12),iowd,17,16)
      iquest(12) = iowd
      iquest(1) = nwio
      CALL ucopyi (iquest(12),iodvec,nwio+1)
      iqcetk(121) = iqblan
      IF (nqlogm.GE.1) WRITE (iqlog,9088) nwio,chform
 9088 FORMAT (' MZIOCH-',i5,' extra I/O words for Format ',a)
  999 nqtrac = nqtrac - 2
      RETURN
   90 nqfata = 2
      iquest(12) = nch
      GO TO 99
   91 nqcase = 1
      nqfata = 3
      iquest(12) = iquest(1)
      iquest(13) = iquest(2)
      IF (iquest(1).EQ.0) GO TO 99
      GO TO 98
   97 nqcase = 7
      iquest(12) = nwiomx
      iquest(13) = nwio + 1
      GO TO 98
   96 nqcase = 6
      iquest(12) = nseca
      iquest(13) = nsecl
      GO TO 98
   95 nqcase = 1
   94 nqcase = nqcase + 1
   93 nqcase = nqcase + 1
   92 nqcase = nqcase + 2
      print*, '>>>>>> MZIOCH: BAD SYNTAX'
      iquest(12) = jch
      iquest(13) = 0
   98 DO 88 jch=1,nch
      jcet = mce(jch)
      IF (jcet.LT.10) THEN
          mce(jch)=iqnum(jcet+1)
        ELSE
          jcet = inv(jcet-9)
          mce(jch) = iqlett(jcet)
        ENDIF
   88 CONTINUE
      nqfata = (nch-1)/4 + 4
   99 iquest(11) = iqcetk(121)
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzflag (IXSTOR,LHEADP,KBITP,CHOPT)
      COMMON /zlimit/lqliml,lqlimh
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      COMMON /zvfaut/iqvid(2),iqvsta,iqvlog,iqvthr(2),iqvrem(2,6)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzcn/ iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      parameter(nqwktt=2560)
      COMMON /mzcwk/ iqwktb(nqwktt), iqwkfz(nqwktt)
      dimension kbitp(9),lheadp(9)
      CHARACTER *(*) CHOPT
      dimension namesr(2)
      DATA namesr / 4hmzfl, 4hag  /
      jbit(izw,izp) = iand(ishft(izw,-(izp-1)),1)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      msbit0(izw,izp) = iand(izw, not(ishft(1,izp-1)))
      msbit1(izw,izp) = ior(izw, ishft(1,izp-1))
      msbit(mz,izw,izp) = ior(iand(izw, not(ishft(1,izp-1)))
     + ,ishft(iand(mz,1),izp-1))
      lhead = lheadp(1)
      IF (lhead.EQ.0) RETURN
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      IF (jbyt(ixstor,27,6).NE.jqstor) CALL mzsdiv (ixstor,-7)
      CALL mzchls (-7,lhead)
      IF (iqfoul.NE.0) GO TO 92
      lqliml = lqsta(kqt+21)
      lqlimh = 0
      iqtbit = kbitp(1)
      CALL uoptc (chopt,'ZLV',iquest)
      iqtval = 1 - iquest(1)
      iopts = 1 - iquest(3)
      iopth = iquest(2)
      lev = lqwktb + 3
      leve = lev + nqwktb - 10
      lq(lev-2) = 0
      lq(lev-1) = 0
      lq(lev) = lhead
      lcur = lhead
      lx = lhead - 1 + iopth
      last = lhead - iqns
      iq(kqs+lcur) = msbit1(iq(kqs+lcur),iqsysx)
      GO TO 24
   20 last = lcur - iq(kqs+lcur-2)
      iq(kqs+lnew) = msbit0(iq(kqs+lnew),iqsysx)
      iq(kqs+lnew) = msbit(iqtval,iq(kqs+lnew),iqtbit)
      lqliml = min(lqliml,lnew)
      lqlimh = max(lqlimh,lnew)
   24 IF (lx.LT.last) GO TO 41
      lnew = lq(kqs+lx)
      lx = lx - 1
      IF (lnew.EQ.0) GO TO 24
      CALL mzchls (-7,lnew)
      IF (iqfoul.NE.0) GO TO 94
      IF (jbit(iq(kqs+lnew),iqsysx).NE.0) GO TO 24
      lq(lev+1) = lx
      lq(lev+2) = lcur
      lev = lev + 3
      IF (lev.GE.leve) GO TO 91
      lq(lev) = lnew
   32 lcur = lnew
      iq(kqs+lcur) = msbit1(iq(kqs+lcur),iqsysx)
      lnew = lq(kqs+lcur)
      IF (lnew.EQ.0) GO TO 36
      CALL mzchls (-7,lnew)
      IF (iqfoul.NE.0) GO TO 93
      IF (jbit(iq(kqs+lnew),iqsysx).NE.0) GO TO 36
      IF (lq(kqs+lnew+2).NE.lcur) GO TO 95
      GO TO 32
   36 CONTINUE
      last = lcur - iqns
      lx = lcur - 1
      GO TO 24
   41 lnew = lcur
      IF (lcur.EQ.lq(lev)) GO TO 46
      lcur = lq(kqs+lcur+2)
      lx = lcur - 1
      GO TO 20
   46 lev = lev - 3
      lx = lq(lev+1)
      lcur = lq(lev+2)
      IF (lcur.NE.0) GO TO 20
   61 iq(kqs+lhead) = msbit0(iq(kqs+lhead),iqsysx)
      IF (iopts.EQ.0) GO TO 999
      iq(kqs+lhead) = msbit(iqtval,iq(kqs+lhead),iqtbit)
      lqliml = min(lqliml,lhead)
      lqlimh = max(lqlimh,lhead)
  999 nqtrac = nqtrac - 2
      RETURN
   95 nqcase = 2
      nqfata = 1
      iquest(14) = lq(kqs+lnew+2)
      GO TO 93
   94 nqcase = 1
      nqfata = 1
      iquest(14) = lx+1 - lcur
   93 nqcase = nqcase + 1
      nqfata = nqfata + 2
      iquest(12) = lnew
      iquest(13) = lcur
   92 nqcase = nqcase + 1
   91 nqcase = nqcase + 1
      nqfata = nqfata + 1
      iquest(11) = lhead
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzgsta (IGARB)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension igarb(20)
      lmt = lqmta
   22 iact = lq(lmt+1)
      IF (iact.LT.3) GO TO 28
      jdiv = lq(lmt)
      IF (iact.EQ.3) GO TO 26
      nqdwip(kqt+jdiv) = nqdwip(kqt+jdiv) + 1
      GO TO 28
   26 igarb(jdiv) = igarb(jdiv) + 1
   28 lmt = lmt + 8
      IF (lmt.LT.lqmte) GO TO 22
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mziocf (JUP,MXVAL)
      COMMON /zkrakc/iqholk(120), iqkrak(80), iqcetk(122)
      COMMON /quest/ iquest(100)
      dimension mu(99)
      equivalence(mu(1),iqholk(1))
      equivalence(ngr,iquest(1)), (ngru,iquest(2))
      dimension jup(9), mxval(9)
      ju = jup(1)
      mxc = mu(ju+2)
      DO 24 jl=2,ngr
      ju = ju + 2
      mxc = max(mu(ju+2),mxc)
      IF (mxc.GE.mxval(jl)) GO TO 29
   24 CONTINUE
      ngru = ngr
      RETURN
   29 ngru = jl - 1
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mziocr (IOW)
      COMMON /quest/ iquest(100)
      COMMON /mzioc/ nwfoav,nwfott,nwfodn,nwfore,ifocon(3)
     +, mfosav(2), jfoend,jforep,jfocur,mfo(200)
      equivalence(jio,iquest(1))
      dimension iow(9)
      dimension nbitva(4), nbitvb(4), nbitvc(7)
      DATA nbitva / 32, 16, 10, 8 /
      DATA nbitvb / 29, 14, 9, 7 /
      DATA nbitvc / 26, 11, 6, 4, 2, 1, 1 /
      jbit(izw,izp) = iand(ishft(izw,-(izp-1)),1)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      nwfodn = 0
      jfocur = 0
      jtypr = iow(1)
      iow1 = jbyt(jtypr,17,16)
      IF (iow1.NE.0) GO TO 21
      IF (jtypr.GE.8) GO TO 21
      mfo(1) = jtypr
      mfo(2) = -1
      jfoend = 2
      jforep = 2
      RETURN
   21 jfoend = 0
      jforep = 0
      jio = 1
      jtypr = jbyt(iow1,1,3)
      jflag = jbit(iow1,4)
      jclass = jbyt(iow1,14,3)
      jfl12 = 0
      GO TO ( 101, 201, 301, 401, 501, 601, 991), jclass
      jfl12 = jflag + 1
      jtyp = jbyt(iow1,5,3)
      IF (jtyp.NE.0) THEN
          mfo(1) = jtyp
          mfo(2) = jbyt(iow1,8,6)
          jfoend = 2
        ENDIF
   24 IF (jtypr.EQ.7) GO TO 28
      mfo(jfoend+1) = jtypr
      mfo(jfoend+2) = jfl12 - 2
      jfoend = jfoend + 2
      jforep = jfoend
      RETURN
   28 jforep = jfoend
      mfo(jfoend+1) = 7
      mfo(jfoend+2) = 0
      jfoend = jfoend + 2
      RETURN
  101 CONTINUE
  201 jfl12 = jclass
      IF (jtypr.NE.0) GO TO 821
      jtypr = jbyt(iow1,5,3)
      jbt = 8
      GO TO 831
  301 jtyp = jbyt(iow1,5,3)
      IF (jtyp.NE.0) THEN
          mfo(1) = jtyp
          mfo(2) = jbyt(iow1,8,6)
          jfoend = 2
          IF (jflag.EQ.0) jforep = 2
        ENDIF
      mfo(jfoend+1) = jtypr
      mfo(jfoend+2) = 0
      jfoend = jfoend + 2
      RETURN
  401 jforep = 2*(jflag+1)
      jflag = 0
  501 IF (jtypr.EQ.0) GO TO 830
      mfo(1) = jtypr
      jfoend = 2
      GO TO 821
  601 jforep = 2*jbyt(iow1,1,4)
      jflag = 1
  821 jio = 2
      DO 822 jbt=5,11,3
      jtyp = jbyt(iow1,jbt,3)
      IF (jtyp.EQ.0) GO TO 823
      mfo(jfoend+1) = jtyp
  822 jfoend = jfoend + 2
  823 ngru = jfoend/2
      IF (jflag.EQ.0) THEN
          nbt = nbitva(ngru)
        ELSE
          nbt = nbitvb(ngru)
        ENDIF
      jfoend = 0
      jbt = 1
      iown = iow(2)
      DO 824 jl=1,ngru
      mfo(jfoend+2) = jbyt(iown,jbt,nbt)
      jfoend = jfoend + 2
  824 jbt = jbt + nbt
      IF (jflag.EQ.0) GO TO 839
  825 ngru = jbyt(iown,30,3)
      IF (ngru.EQ.0) GO TO 839
      jio = jio + 1
      IF (jio.EQ.17) GO TO 991
      iown = iow(jio)
      jbtt = 1
      jbtc = 3*ngru + 1
      nbt = nbitvc(ngru)
      DO 826 jl=1,ngru
      mfo(jfoend+1) = jbyt(iown,jbtt,3)
      mfo(jfoend+2) = jbyt(iown,jbtc,nbt)
      jbtt = jbtt + 3
      jbtc = jbtc + nbt
  826 jfoend = jfoend + 2
      GO TO 825
  830 jbt = 5
  831 DO 834 jl=jbt,11,3
      jtyp = jbyt(iow1,jl,3)
      IF (jtyp.EQ.0) GO TO 839
      mfo(jfoend+1) = jtyp
      mfo(jfoend+2) = 0
  834 jfoend = jfoend + 2
  839 IF (jfl12.NE.0) GO TO 24
      RETURN
  991 iquest(1) = -1
      mfo(1) = 0
      mfo(2) = -1
      jfoend = 2
      END
 
*-------------------------------------------------------------------------------
 
      FUNCTION mzixco (IXAA,IXBB,IXCC,IXDD)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      dimension ixaa(9), ixbb(9), ixcc(9), ixdd(9), ixv(4)
      equivalence(ixv(1),iquest(11))
      dimension namesr(2)
      DATA namesr / 4hmzix, 4hco  /
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      msbit1(izw,izp) = ior(izw, ishft(1,izp-1))
      msbyt(mz,izw,izp,nzb) = ior(
     + iand(izw, not(ishft(ishft(not(0),-(32-nzb)),izp-1)))
     + ,ishft(ishft(mz,32-nzb), -(33-izp-nzb)) )
      mbytor(mz,izw,izp,nzb) = ior(izw,
     + ishft(ishft(mz,32-nzb),-(33-izp-nzb)))
      ixv(1) = ixaa(1)
      ixv(2) = ixbb(1)
      ixv(3) = ixcc(1)
      ixv(4) = ixdd(1)
      ixcomp = 0
      DO 49 jl=1,4
      ixin = ixv(jl)
      IF (ixin.EQ.0) GO TO 49
      jdv = jbyt(ixin,1,26)
      jst = jbyt(ixin,27,6)
      IF (jst.LT.16) GO TO 31
      jst = jst - 16
      IF (jst.GT.nqstor) GO TO 91
      IF (jdv.GE.16777216) GO TO 92
      IF (jl.NE.1) GO TO 24
      ixcomp = ixin
      jstoru = jst
      GO TO 49
   24 IF (jst.NE.jstoru) GO TO 93
      ixcomp = mbytor(jdv,ixcomp,1,26)
      GO TO 49
   31 IF (jst.GT.nqstor) GO TO 91
      IF (jdv.GE.25) GO TO 92
      IF (jdv.EQ.0) GO TO 92
      IF (jl.NE.1) GO TO 34
      ixcomp = msbyt(jst+16,ixcomp,27,5)
      jstoru = jst
      GO TO 47
   34 IF (jst.EQ.jstoru) GO TO 47
      IF (jst.NE.0) GO TO 93
      IF (jdv.LT.3) GO TO 47
      IF (jdv.LT.21) GO TO 93
   47 ixcomp = msbit1(ixcomp,jdv)
   49 CONTINUE
   59 mzixco = ixcomp
      RETURN
   93 nqcase = 1
   92 nqcase = nqcase + 1
   91 nqcase = nqcase + 1
      nqfata = 7
      iquest(15) = jl
      iquest(16) = jst
      iquest(17) = jdv
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      mzixco = 0
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzmove
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension namesr(2)
      DATA namesr / 4hmzmo, 4hve  /
      jbit(izw,izp) = iand(ishft(izw,-(izp-1)),1)
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      lmt = lqmta
   23 jdiv = lq(lmt)
      iact = lq(lmt+1)
      nshf = lq(lmt+2)
      IF (iact.EQ.4) GO TO 26
      IF (iact.NE.3) GO TO 31
      l = lq(lmt+3)
      lt = lq(lmt+5) + lqrta
      n = lq(lt+2)
      lqsta(kqt+jdiv) = l + n
      l = lq(lmt+4)
      lt = lq(lmt+6) + lqrta - 4
      n = lq(lt+2)
      lqend(kqt+jdiv) = l + n
      GO TO 36
   26 mode = jbit(iqmode(kqt+jdiv),1)
      IF (mode.NE.0) GO TO 28
      lqsta(kqt+jdiv) = lqsta(kqt+jdiv) + nshf
      GO TO 29
   28 lqsta(kqt+jdiv) = lqend(kqt+jdiv) + nshf
   29 lqend(kqt+jdiv) = lqsta(kqt+jdiv)
      GO TO 36
   31 IF (nshf.EQ.0) GO TO 37
      lqsta(kqt+jdiv) = lqsta(kqt+jdiv) + nshf
      lqend(kqt+jdiv) = lqend(kqt+jdiv) + nshf
   36 CONTINUE
   37 lmt = lmt + 8
      IF (lmt.LT.lqmte) GO TO 23
      IF (nqnoop.NE.0) GO TO 999
      IF (lqte.LE.lqta) GO TO 999
      ltf = lqta
   61 nrel = lq(ltf+2)
      IF (nrel) 64, 68, 71
   64 lold = lq(ltf)
      lnew = lold + nrel
      nw = lq(ltf+1) - lold
      IF (nw.EQ.0) GO TO 68
      CALL ucopyi (lq(kqs+lold),lq(kqs+lnew),nw)
   68 ltf = ltf + 4
      IF (ltf.NE.lqte) GO TO 61
      GO TO 999
   71 ltfn = ltf
   72 ltfn = ltfn + 4
      IF (ltfn.EQ.lqte) GO TO 76
      IF (lq(ltfn+2).GT.0) GO TO 72
   76 ltr = ltfn
   81 ltr = ltr - 4
      lold = lq(ltr)
      nw = lq(ltr+1) - lold
      IF (nw.EQ.0) GO TO 88
      lnew = lold + lq(ltr+2)
      CALL ucopy2 (lq(kqs+lold),lq(kqs+lnew),nw)
   88 IF (ltr.NE.ltf) GO TO 81
      ltf = ltfn
      IF (ltf.NE.lqte) GO TO 61
  999 nqtrac = nqtrac - 2
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzpudx (LP,NWP)
      COMMON /zbcd/ iqnum2(11),iqlett(26),iqnum(10), iqplus,iqmins
     +, iqstar,iqslas,iqopen,iqclos,iqdoll,iqequ, iqblan
     +, iqcoma,iqdot, iqnumb,iqapo, iqexcl,iqcolo,iqquot
     +, iqunde,iqclsq,iqand, iqat, iqques,iqopsq,iqgrea
     +, iqless,iqreve,iqcirc,iqsemi,iqperc, iqlowl(26)
     +, iqcrop,iqvert,iqcrcl,iqnot, iqgrav, iqileg
     +, nqhol0,nqholl(95)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      dimension lp(9),nwp(9)
      msbit1(izw,izp) = ior(izw, ishft(1,izp-1))
      msbyt(mz,izw,izp,nzb) = ior(
     + iand(izw, not(ishft(ishft(not(0),-(32-nzb)),izp-1)))
     + ,ishft(ishft(mz,32-nzb), -(33-izp-nzb)) )
      l = lp(1)
      nw = nwp(1)
      nd = nw - 10
      n = min(10,nw)
      DO 12 j=0,n-1
   12 lq(kqs+l+j) = 0
      IF (nd.GE.0) THEN
          lq(kqs+l) = 12
          l = l + 9
          lq(kqs+l-4) = iqlett(4)
          lq(kqs+l-1) = nd
        ELSE
          n = msbyt(nw,n,17,6)
          lq(kqs+l) = n
        ENDIF
      lq(kqs+l) = msbit1(lq(kqs+l),iqdrop)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzrelb
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzcn/ iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension namesr(2)
      DATA namesr / 4hmzre, 4hlb  /
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      lfixlo = lq(lqta-1)
      lfixre = lq(lqta)
      lfixhi = lq(lqte)
      jhigo = (lqte-lqta) / 4
      nentr = jhigo - 1
      IF (nentr.EQ.0) THEN
          ladtb1 = lq(lqta+1)
          nrltb2 = lq(lqta+2)
          ifltb3 = lq(lqta+3)
        ENDIF
      lmrnx = lqmta
   12 lmr = lmrnx
      IF (lmr.GE.lqmte) GO TO 999
      lmrnx = lmrnx + 8
      iact = lq(lmr+1)
      IF (iact.LE.0) GO TO 12
      IF (iact.EQ.4) GO TO 12
      lstop = lq(lmr+4)
      IF (iact.EQ.3) GO TO 14
      ln = lq(lmr+3)
      ldead = lstop
      GO TO 19
   14 lsec = lqrta + lq(lmr+5) - 4
   16 lsec = lsec + 4
      lnx = lq(lsec)
      ldead = lq(lsec+1)
   17 ln = lnx
      IF (ln.GE.lstop) GO TO 12
      IF (ln.EQ.ldead) GO TO 16
   19 CONTINUE
      CALL mzchln (-7,ln)
      IF (iqfoul.NE.0) GO TO 91
      lnx = iqnx
      IF (iqnd.LT.0) GO TO 17
      ls = iqls
      lx = ls + 3
      l2 = ls - iqns
      l1 = ls - iqnl
      nst = jbyt(lq(kqs+ln),1,16) - 11
      IF (nst.LT.0) THEN
          lnx = ln + nst + 11
          GO TO 17
        ELSE
          ls = ln + nst
          lx = ls + 3
          l2 = ls - iq(kqs+ls-2)
          l1 = ls - iq(kqs+ls-3)
          lnx = ls + iq(kqs+ls-1) + 9
        ENDIF
      IF (nentr) 66, 46, 26
   24 lq(kqs+l1)= 0
   25 l1 = l1 + 1
      IF (l1.EQ.lx) GO TO 17
   26 lfirst= lq(kqs+l1)
   27 link = lq(kqs+l1)
      IF (link.EQ.0) GO TO 25
      IF (iqflio.EQ.0) THEN
          IF (link.LT.lfixlo) GO TO 25
          IF (link.GE.lfixhi) GO TO 25
          IF (link.LT.lfixre) GO TO 24
        ELSE
          IF (link.LT.lfixre) GO TO 24
          IF (link.GE.lfixhi) GO TO 24
        ENDIF
      jlow = 0
      jhi = jhigo
   29 jex = (jhi+jlow) / 2
      IF (jex.EQ.jlow) GO TO 31
      IF (link.GE.lq(lqta+4*jex)) GO TO 30
      jhi = jex
      GO TO 29
   30 jlow = jex
      GO TO 29
   31 jtb = lqta + 4*jlow
      IF (link.GE.lq(jtb+1)) GO TO 33
      lq(kqs+l1) = link + lq(jtb+2)
      GO TO 25
   33 IF (lq(jtb+3)) 25, 24, 34
   34 IF (l1.LT.l2) GO TO 24
      IF (ls+1-l1) 36, 24, 35
   35 CONTINUE
      CALL mzchls (-7,link)
      IF (iqfoul.NE.0) GO TO 92
      link = lq(kqs+link)
      lq(kqs+l1) = link
      IF (link.NE.lfirst) GO TO 27
      GO TO 24
   36 link = lq(kqs+link+2)
      lq(kqs+l1) = link
      GO TO 27
   44 lq(kqs+l1)= 0
   45 l1 = l1 + 1
      IF (l1.EQ.lx) GO TO 17
   46 lfirst= lq(kqs+l1)
   47 link = lq(kqs+l1)
      IF (link.EQ.0) GO TO 45
      IF (iqflio.EQ.0) THEN
          IF (link.LT.lfixlo) GO TO 45
          IF (link.GE.lfixhi) GO TO 45
          IF (link.LT.lfixre) GO TO 44
          IF (link.GE.ladtb1) GO TO 53
        ELSE
          IF (link.LT.lfixre) GO TO 44
          IF (link.GE.ladtb1) GO TO 44
        ENDIF
      lq(kqs+l1) = link + nrltb2
      GO TO 45
   53 IF (ifltb3) 45, 44, 54
   54 IF (l1.LT.l2) GO TO 44
      IF (ls+1-l1) 56, 44, 55
   55 CONTINUE
      CALL mzchls (-7,link)
      IF (iqfoul.NE.0) GO TO 92
      link = lq(kqs+link)
      lq(kqs+l1) = link
      IF (link.NE.lfirst) GO TO 47
      GO TO 44
   56 link = lq(kqs+link+2)
      lq(kqs+l1) = link
      GO TO 47
   64 lq(kqs+l1)= 0
   65 l1 = l1 + 1
      IF (l1.EQ.lx) GO TO 17
   66 link = lq(kqs+l1)
      IF (link.EQ.0) GO TO 65
      IF (link.LT.lfixlo) GO TO 65
      IF (link.GE.lfixhi) GO TO 65
      GO TO 64
   92 nqcase = 1
      nqfata = 2
      ln = ls
      iquest(12) = l1
      iquest(13) = link
   91 nqcase = nqcase + 1
      nqfata = nqfata + 1
      iquest(11) = ln
      IF (iqflio.NE.0) GO TO 98
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
   98 iquest(9) = nqcase
      iquest(10)= nqfata
      nqcase = 0
      nqfata = 0
      iqflio = -7
  999 nqtrac = nqtrac - 2
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzrell (MDESV)
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzcn/ iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension mdesv(99)
      dimension namesr(2)
      DATA namesr / 4hmzre, 4hll  /
      jbit(izw,izp) = iand(ishft(izw,-(izp-1)),1)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      lfixlo = lq(lqta-1)
      lfixre = lq(lqta)
      lfixhi = lq(lqte)
      jhigo = (lqte-lqta) / 4
      nentr = jhigo - 1
      IF (nentr.EQ.0) THEN
          ladtb1 = lq(lqta+1)
          nrltb2 = lq(lqta+2)
          ifltb3 = lq(lqta+3)
        ENDIF
      jdesmx = mdesv(1) - 4
      jdes = -4
      IF (mdesv(2).GE.mdesv(3)) jdes =1
   17 jdes = jdes + 5
      IF (jdes.GE.jdesmx) GO TO 999
      locar = mdesv(jdes+1)
      lix = locar
      locare = mdesv(jdes+2)
      modar = mdesv(jdes+3)
      IF (jbit(modar,31).NE.0) THEN
          IF (lq(kqs+locar).EQ.0) GO TO 17
          lix = lix + 2
        ENDIF
      lir = locar + jbyt(modar,1,15)
      IF (nentr) 66, 46, 26
   24 lq(kqs+lix)= 0
   25 lix = lix + 1
      IF (lix.EQ.locare) GO TO 17
   26 lfirst= lq(kqs+lix)
   27 link = lq(kqs+lix)
      IF (link.EQ.0) GO TO 25
      IF (link.LT.lfixlo) GO TO 25
      IF (link.GE.lfixhi) GO TO 25
      IF (link.LT.lfixre) GO TO 24
      jlow = 0
      jhi = jhigo
   29 jex = (jhi+jlow) / 2
      IF (jex.EQ.jlow) GO TO 31
      IF (link.GE.lq(lqta+4*jex)) GO TO 30
      jhi = jex
      GO TO 29
   30 jlow = jex
      GO TO 29
   31 jtb = lqta + 4*jlow
      IF (link.GE.lq(jtb+1)) GO TO 33
      lq(kqs+lix) = link + lq(jtb+2)
      GO TO 25
   33 IF (lix.GE.lir) GO TO 24
      IF (lq(jtb+3).LE.0) GO TO 24
      CALL mzchls (-7,link)
      IF (iqfoul.NE.0) GO TO 91
      link = lq(kqs+link)
      lq(kqs+lix) = link
      IF (link.NE.lfirst) GO TO 27
      GO TO 24
   44 lq(kqs+lix)= 0
   45 lix = lix + 1
      IF (lix.EQ.locare) GO TO 17
   46 lfirst= lq(kqs+lix)
   47 link = lq(kqs+lix)
      IF (link.EQ.0) GO TO 45
      IF (link.LT.lfixlo) GO TO 45
      IF (link.GE.lfixhi) GO TO 45
      IF (link.LT.lfixre) GO TO 44
      IF (link.GE.ladtb1) GO TO 53
      lq(kqs+lix) = link + nrltb2
      GO TO 45
   53 IF (lix.GE.lir) GO TO 44
      IF (ifltb3.LE.0) GO TO 44
      CALL mzchls (-7,link)
      IF (iqfoul.NE.0) GO TO 91
      link = lq(kqs+link)
      lq(kqs+lix) = link
      IF (link.NE.lfirst) GO TO 47
      GO TO 44
   64 lq(kqs+lix)= 0
   65 lix = lix + 1
      IF (lix.EQ.locare) GO TO 17
   66 link = lq(kqs+lix)
      IF (link.EQ.0) GO TO 65
      IF (link.LT.lfixlo) GO TO 65
      IF (link.GE.lfixhi) GO TO 65
      GO TO 64
   91 nqcase = 1
      nqfata = 5
      iquest(11) = locar + lqstor
      iquest(12) = lix - locar + 1
      iquest(13) = link
      iquest(14) = mdesv(jdes+4)
      iquest(15) = mdesv(jdes+5)
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
  999 nqtrac = nqtrac - 2
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzrelx
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzct/ mqdvga,mqdvwi,jqstmv,jqdvm1,jqdvm2,nqdvmv,iqflio
     +, mqdvac,nqnoop,iqpart,nqfree, iqtbit,iqtval
     +, iqtnmv,jqgapm,jqgapr,nqgapn,nqgap,iqgap(5,4)
     +, lqta,lqte, lqrta,lqtc1,lqtc2,lqrte
     +, lqmta,lqmtb,lqmte,lqmtlu,lqmtbr
     +, lqmtc1,lqmtc2, nqfrtc,nqlive
      dimension namesr(2)
      DATA namesr / 4hmzre, 4hlx  /
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      l = lqsyss(kqt+1)
      IF (l.NE.0) THEN
          iq(kqs+l+3) = iq(kqs+l+2) + nqlink
          CALL mzrell (iq(kqs+l+1))
        ENDIF
      CALL mzrelb
  999 nqtrac = nqtrac - 2
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzsdiv (IXDIVP,IFLAGP)
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +, nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      dimension ixdivp(9), iflagp(9)
      dimension namesr(2)
      DATA namesr / 4hmzsd, 4hiv  /
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      ixin = ixdivp(1)
      iflag = iflagp(1)
      jsto = jbyt(ixin,27,4)
      IF (jsto.NE.jqstor) GO TO 41
      IF (iflag.LT.0) GO TO 48
   21 jdiv = jbyt(ixin,1,26)
      jcom = jbyt(ixin,31,2)
      IF (jcom-1) 22, 31, 91
   22 IF (jdiv.GE.25) GO TO 92
      IF (jdiv.GE.21) GO TO 24
      IF (jdiv.GT.jqdvll) THEN
          IF (jdiv.LT.jqdvsy) GO TO 92
        ENDIF
      IF (jdiv.EQ.0) THEN
          IF (iflag.EQ.4) GO TO 94
        ENDIF
      jqdivi = jdiv
      RETURN
   24 IF (jdiv.EQ.24) GO TO 26
      IF (iflag.GT.0) GO TO 93
      jqdivi = 0
      RETURN
   26 jqdivi = jqdvsy
      RETURN
   31 IF (iflag.GT.0) GO TO 93
      IF (jdiv.GE.16777216) GO TO 92
      jqdivi = 0
      RETURN
   41 IF (jsto.GT.nqstor) GO TO 91
      jqstor = jsto
      jqdivr = 0
      kqt = nqofft(jqstor+1)
      kqs = nqoffs(jqstor+1)
      DO 44 j=1,12
   44 iqcur(j) = iqtabv(kqt+j)
      nqlogm = nqlogl
      IF (iflag.GE.0) GO TO 21
   48 jqdivi = 0
      RETURN
   94 nqcase = 1
   93 nqcase = nqcase + 1
   92 nqcase = nqcase + 1
      nqfata = 1
      iquest(14) = jdiv
   91 nqcase = nqcase + 1
      nqfata = nqfata + 3
      iquest(11) = ixin
      iquest(12) = iflag
      iquest(13) = jsto
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE zshunt (IXSTOR,LSHP,LSUPP,JBIASP,IFLAGP)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun, nqused
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/ iqfenc(4), lq(100)
                              dimension iq(92), q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/ nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +, lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +, mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +, nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/ jqstor,kqt,kqs, jqdivi,jqdivr
     +, jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +, lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +, jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/ lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +, jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +, lqsyss(10), lqsysr(10), iqtdum(22)
     +, lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +, iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +, nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +, nqdpsh(20),nqdred(20),nqdsiz(20)
     +, iqdn1(20), iqdn2(20), kqft, lqfsta(21)
                                       dimension iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /mzcn/ iqln,iqls,iqnio,iqid,iqnl,iqns,iqnd, iqnx,iqfoul
      dimension lshp(9),lsupp(9),jbiasp(9),iflagp(9)
      dimension namesr(2)
      DATA namesr / 4hzshu, 4hnt  /
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      mqtrac(nqtrac+1) = namesr(1)
      mqtrac(nqtrac+2) = namesr(2)
      nqtrac = nqtrac + 2
      lsh = lshp(1)
      IF (lsh.EQ.0) GO TO 999
      lsup = lsupp(1)
      jbias = jbiasp(1)
      iflag = iflagp(1)
      IF (jbyt(ixstor,27,6).NE.jqstor) CALL mzsdiv (ixstor,-7)
      CALL mzchls (-7,lsh)
      IF (iqfoul.NE.0) GO TO 91
      IF (nqlogl.GE.2) THEN
          IF (jbias.GE.2) lsup=0
          WRITE (iqlog,9011) jqstor,lsh,lsup,jbias,iflag,iqid
        ENDIF
 9011 FORMAT (' ZSHUNT-  Store',i3,' LSH/LSUP/JBIAS/IFLAG='
     f,2i9,1x,i6,1x,i3,' IDH= ',a4)
      kex = lq(kqs+lsh+2)
      lnex = lq(kqs+lsh)
      lpre = 0
      IF (jbias-1) 21, 25, 28
   21 CONTINUE
      CALL mzchls (-7,lsup)
      IF (iqfoul.NE.0) GO TO 92
      IF (iqns+jbias.LT.0) GO TO 93
      kin = lsup + jbias
      lnin = lq(kqs+kin)
      lup = lsup
      IF (jbias.NE.0) GO TO 29
      lpre = lup
      lup = lq(kqs+lup+1)
      GO TO 29
   25 lnin = lsup
      IF (lnin.EQ.0) GO TO 26
      CALL mzchls (-7,lsup)
      IF (iqfoul.NE.0) GO TO 92
      kin = lq(kqs+lnin+2)
      lup = lq(kqs+lnin+1)
      GO TO 29
   26 kin = locf(lsupp(1)) - lqstor
      lup = 0
      GO TO 29
   28 kin = 0
      lnin = 0
      lup = 0
      IF (kex.EQ.0) GO TO 51
   29 IF (kin.EQ.kex) GO TO 999
      l = max(lnin,lpre)
      IF (l.EQ.0) GO TO 51
      IF (l.GE.lqend(kqt+20)) GO TO 94
      IF (l.GE.lqend(kqt+jqdvll)) GO TO 43
      jqdivi = 2
      IF (l.GE.lqend(kqt+2)) GO TO 44
      IF (l.GE.lqsta(kqt+2)) GO TO 45
      jqdivi = 1
      GO TO 45
   43 jqdivi = jqdvsy - 1
   44 jqdivi = jqdivi + 1
      IF (l.GE.lqend(kqt+jqdivi)) GO TO 44
   45 IF (lsh.LT.lqsta(kqt+jqdivi)) GO TO 94
      IF (lsh.GE.lqend(kqt+jqdivi)) GO TO 94
   51 IF (lnex.EQ.0) GO TO 58
      IF (iflag.EQ.0) GO TO 57
      l = lsh
   53 CALL mzchls (-7,lnex)
      IF (iqfoul.NE.0) GO TO 95
      l = lnex
      lnex = lq(kqs+lnex)
      IF (lnex.NE.0) GO TO 53
      lnex = lsh
   55 lend = lnex
      lq(kqs+lend+1) = lup
      lnex = lq(kqs+lend)
      IF (lnex.NE.0) GO TO 55
      GO TO 71
   57 CONTINUE
      l = lsh
      CALL mzchls (-7,lnex)
      IF (iqfoul.NE.0) GO TO 95
   58 lend = lsh
      lq(kqs+lsh+1) = lup
   71 IF (kex .NE.0) lq(kqs+kex) = lnex
      IF (lnex.NE.0) lq(kqs+lnex+2) = kex
      IF (kin.NE.0) THEN
          lq(kqs+kin) = lsh
        ELSE
          lsupp(1) = lsh
        ENDIF
      lq(kqs+lsh+2) = kin
      lq(kqs+lend) = lnin
      IF (lnin.NE.0) lq(kqs+lnin+2) = lend
  999 nqtrac = nqtrac - 2
      RETURN
   95 nqcase = 1
      nqfata = 1
      iquest(16) = lnex
   94 nqcase = nqcase + 1
      nqfata = nqfata + 1
      iquest(15) = l
   93 nqcase = nqcase + 1
   92 nqcase = nqcase + 1
   91 nqcase = nqcase + 1
      nqfata = nqfata + 4
      iquest(11) = lsh
      iquest(12) = lsup
      iquest(13) = jbias
      iquest(14) = iflag
      iquest(9) = namesr(1)
      iquest(10)= namesr(2)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE zhtoi (HOLL,INTV,NP)
      parameter(nqtcet=256)
      COMMON /zceta/ iqceta(256),iqtcet(256)
      INTEGER INTV(99), HOLL(99)
      DO 39 jwh=1,np
      mwh = holl(jwh)
      intw = 0
      DO 29 jl=1,4
      intw = ishft(intw,-6)
      jv = iand(mwh,255)
      IF (jv.EQ.32) THEN
      IF (jl.NE.1) GO TO 29
      ENDIF
      jv = iqtcet(jv+1)
      intw = ior(intw,ishft(jv,18))
   29 mwh = ishft(mwh,-8)
   39 intv(jwh) = intw
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzscan(CHPATH,UROUT)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /rzcl/  ltop,lrz0,lcdir,lrin,lrout,lfree,lused,lpurg
     +,              ltemp,lcord,lfrom
      equivalence(lqrs,lqsyss(7))
      parameter(nlpatm=100)
      COMMON /rzdirn/nlcdir,nlndir,nlpat
      COMMON /rzdirc/chcdir(nlpatm),chndir(nlpatm),chpat(nlpatm)
      CHARACTER*16   CHNDIR,    CHCDIR,    CHPAT
      COMMON /rzch/  chwold,chl
      CHARACTER*255  CHWOLD,CHL
      parameter(kup=5,kpw1=7,knch=9,kdatec=10,kdatem=11,kquota=12,
     +           krused=13,kwused=14,kmega=15,krzver=16,kirin=17,
     +           kirout=18,krlout=19,kip1=20,knfree=22,knsd=23,kld=24,
     +           klb=25,kls=26,klk=27,klf=28,klc=29,kle=30,knkeys=31,
     +           knwkey=32,kkdes=33,knsize=253,kex=6,knmax=100)
      CHARACTER *(*) CHPATH
      EXTERNAL urout
      dimension isd(nlpatm),nsd(nlpatm),ihdir(4)
      iquest(1)=0
      IF(lqrs.EQ.0)GO TO 99
      IF(lcdir.EQ.0)GO TO 99
      CALL rzcdir(chwold,'R')
      CALL rzcdir(chpath,' ')
      IF(iquest(1).NE.0) GOTO 99
      CALL rzpaff(chpat,nlpat,chl)
      nlpat0=nlpat
      itime=0
  10  CONTINUE
      IF(itime.NE.0)THEN
         CALL rzpaff(chpat,nlpat,chl)
      IF(iquest(1).NE.0)THEN
         nlpat=nlpat-1
         GO TO 20
      ENDIF
         CALL rzcdir(chl,' ')
      ENDIF
      IF(iquest(1).NE.0)THEN
         nlpat=nlpat-1
         GO TO 20
      ENDIF
      isd(nlpat)=0
      nsd(nlpat)=iq(kqsp+lcdir+knsd)
      CALL urout(chl)
  20  isd(nlpat)=isd(nlpat)+1
      IF(isd(nlpat).LE.nsd(nlpat))THEN
         nlpat=nlpat+1
         ls=iq(kqsp+lcdir+kls)
         ih=ls+7*(isd(nlpat-1)-1)
         CALL zitoh(iq(kqsp+lcdir+ih),ihdir,4)
         CALL uhtoc(ihdir,4,chpat(nlpat),16)
         itime=itime+1
         GO TO 10
      ELSE
         nlpat=nlpat-1
         IF(nlpat.GE.nlpat0)THEN
            lup=lq(kqsp+lcdir+1)
            CALL mzdrop(jqpdvs,lcdir,' ')
            lcdir=lup
            GO TO 20
         ENDIF
      ENDIF
  90  CALL rzcdir(chwold,' ')
  99  RETURN
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE mzwipe (IXWP)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /zvfaut/iqvid(2),iqvsta,iqvlog,iqvthr(2),iqvrem(2,6)
      dimension    ixwp(9)
      dimension    namesr(2)
      DATA  namesr / 4hmzwi, 4hpe   /
      ixwipe = ixwp(1)
      IF (ixwipe.EQ.0)  ixwipe=21
      CALL mzgarb (0,ixwipe)
      END
 
*-------------------------------------------------------------------------------
 
      SUBROUTINE rzend(CHDIR)
      COMMON /zunit/ iqread,iqprnt,iqpr2,iqlog,iqpnch,iqttin,iqtype
      COMMON /zunitz/iqdlun,iqflun,iqhlun,  nqused
      COMMON /zstate/qversn,nqphas,iqdbug,nqdcut,nqwcut,nqerr
     +,              nqlogd,nqlogm,nqlock,nqdevz,nqopts(6)
      parameter(iqdrop=25, iqmark=26, iqcrit=27, iqsysx=28)
      COMMON /quest/ iquest(100)
      COMMON /zebq/  iqfenc(4), lq(100)
                              dimension    iq(92),        q(92)
                              equivalence(iq(1),lq(9)), (q(1),iq(1))
      COMMON /mzca/  nqstor,nqofft(16),nqoffs(16),nqallo(16), nqiam
     +,              lqatab,lqasto,lqbtis, lqwktb,nqwktb,lqwkfz
     +,              mqkeys(3),nqinit,nqtsys,nqm99,nqperm,nqfata,nqcase
     +,              nqtrac,mqtrac(48)
                                       equivalence(kqsp,nqoffs(1))
      COMMON /mzcb/  jqstor,kqt,kqs,  jqdivi,jqdivr
     +,              jqkind,jqmode,jqdivn,jqshar,jqshr1,jqshr2,nqresv
     +,              lqstor,nqfend,nqstru,nqref,nqlink,nqminr,lq2end
     +,              jqdvll,jqdvsy,nqlogl,nqsnam(6)
                                       dimension    iqcur(16)
                                       equivalence(iqcur(1),lqstor)
      COMMON /mzcc/  lqpsto,nqpfen,nqpstr,nqpref,nqplk,nqpmin,lqp2e
     +,              jqpdvl,jqpdvs,nqplog,nqpnam(6)
     +,              lqsyss(10), lqsysr(10), iqtdum(22)
     +,              lqsta(21), lqend(20), nqdmax(20),iqmode(20)
     +,              iqkind(20),iqrcu(20), iqrto(20), iqrno(20)
     +,              nqdini(20),nqdwip(20),nqdgau(20),nqdgaf(20)
     +,              nqdpsh(20),nqdred(20),nqdsiz(20)
     +,              iqdn1(20), iqdn2(20),      kqft, lqfsta(21)
                                       dimension    iqtabv(16)
                                       equivalence(iqtabv(1),lqpsto)
      COMMON /rzcl/  ltop,lrz0,lcdir,lrin,lrout,lfree,lused,lpurg
     +,              ltemp,lcord,lfrom
      equivalence(lqrs,lqsyss(7))
      CHARACTER  CHDIR*(*)
      dimension ihdir(4)
      LOGICAL RZSAME
      jbit(izw,izp)     = iand(ishft(izw,-(izp-1)),1)
      jbyt(izw,izp,nzb) = ishft(ishft(izw,33-izp-nzb),-(32-nzb))
      iquest(1)=0
      IF(lqrs.EQ.0)GO TO 99
      CALL rzsave
      nchd=len(chdir)
      IF(nchd.GT.16)nchd=16
      CALL vblank(ihdir,4)
      CALL uctoh(chdir,ihdir,4,nchd)
      CALL zhtoi(ihdir,ihdir,4)
      lrz=lqrs
  10  IF(lrz.NE.0)THEN
         IF(.NOT.rzsame(ihdir,iq(kqsp+lrz+1),4))THEN
            lrz=lq(kqsp+lrz)
            GO TO 10
         ENDIF
      ltop=lrz
      loglv = jbyt(iq(kqsp+ltop),15,3)-3
      IF(loglv.GE.0) WRITE(iqlog,9019) chdir
 9019 FORMAT(' RZEND. called for ',a)
         IF(jbit(iq(kqsp+ltop),3).NE.0)THEN
            lcdir=ltop
         print*,'>>>>>> RZFREE'
*            CALL RZFREE('RZFILE')
         ENDIF
         CALL mzdrop(jqpdvs,ltop,' ')
         ltop = 0
         lcdir= 0
      ELSEIF(nqlogd.GE.-2)THEN
         WRITE(iqlog,1000) chdir
 1000    FORMAT(' RZEND. Unknown directory ',a)
      ENDIF
  99  RETURN
      END
 
*-------------------------------------------------------------------------------