MINICERN/packlib/zebra/jz91/jzinit.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:11:06  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:16  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE JZINIT (IXPARA,CHPA1,CHPA2,IPA3,IPA4,IPA5,IPA6)
  14
  15 C-    Initialize JZ91 package
  16
  17
  18 #include "zebra/zstate.inc"
  19 #include "zebra/zunit.inc"
  20 #include "zebra/mqsys.inc"
  21 #include "zebra/eqlqt.inc"
  22 #include "zebra/jzuc.inc"
  23 #include "zebra/jzc.inc"
  24 C--------------    END CDE                             -----------------  ------
  25       DIMENSION    IPA3(7),IPA4(7),IPA5(7),IPA6(7)
  26       CHARACTER    CHPA1*(*), CHPA2*(*)
  27 #if defined(CERNLIB_A4)
  28       CHARACTER    CHIAM*4
  29 #endif
  30 #if defined(CERNLIB_A8)
  31       CHARACTER    CHIAM*8
  32 #endif
  33 #if defined(CERNLIB_EQUHOLCH)
  34       EQUIVALENCE (CHIAM, NQME(1))
  35 #endif
  36
  37       DIMENSION    INIT(4),          MEXTR(4)
  38       EQUIVALENCE (INIT(1),JQTIME), (NACCE,NQME(6))
  39       DIMENSION    MMJZ91(5), MMCALL(5)
  40 #if defined(CERNLIB_QDEBUG)
  41       DIMENSION    MMFL(5)
  42 #endif
  43 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  44       DIMENSION    NAMESR(2)
  45       DATA  NAMESR / 4HJZIN, 4HIT   /
  46 #endif
  47 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  48       DATA  NAMESR / 6HJZINIT /
  49 #endif
  50 #if !defined(CERNLIB_QTRHOLL)
  51       CHARACTER    NAMESR*8
  52       PARAMETER   (NAMESR = 'JZINIT  ')
  53 #endif
  54 #if defined(CERNLIB_QDEBUG)
  55
  56       DATA  MEND   /4HEND /
  57       DATA  MMFL   /4HJZFL,  0,  0, -7, 2 /
  58 #endif
  59       DATA  MMJZ91 /4HJZ91, -7, -7, -7, 2 /
  60       DATA  MMCALL /4HJZCA, -7,  0, -7, 0 /
  61
  62       DATA    MJQAN/4HJZAN/, MJQFL/4HJZFL/
  63
  64 #include "zebra/q_shiftl.inc"
  65
  66 #include "zebra/qtraceq.inc"
  67
  68       IF (JQLEV.NE.-1)       CALL ZFATAM ('re-init of JZ91.')
  69       CALL VZERO (JQTIME,16)
  70
  71       CALL MZSDIV (IXPARA,-7)
  72       JQSTJZ = JQSTOR
  73       IXSTJZ = ISHFTL(JQSTJZ,26)
  74
  75       JQMLEV = IPA3(1)
  76       JQCBNL = IPA4(1)
  77       JQCBND = IPA5(1)
  78
  79       CALL UOPTC (CHPA2,'TQE',IQUEST)
  80       JQTIME = IQUEST(1)
  81       JQLLEV = 2
  82       IF (IQUEST(2).NE.0)  JQLLEV = 0
  83       IF (IQUEST(3).NE.0)  JQLLEV = 1
  84
  85       CHIAM = CHPA1
  86 #if !defined(CERNLIB_EQUHOLCH)
  87       CALL UCTOH (CHIAM, NQME(1),4,4)
  88 #endif
  89       NQME(2) = 10
  90       NQME(3) = 10
  91
  92       N = IPA6(1)
  93       IF (N.GE.0)  THEN
  94           N =  MIN (N,5)
  95           CALL UCOPY (IPA6(2),NQME(2),N)
  96         ENDIF
  97
  98       IF (JQLLEV.GE.2)  WRITE (IQLOG,9001) JQSTJZ,INIT
  99  9001 FORMAT (/' JZINIT.  JZ91 in store',I2,
 100      F', IFTIME,MAXLEV,NL,ND =',7I6)
 101
 102       MMCALL(2) = JQCBNL
 103       MMCALL(4) = JQCBND
 104       JQNACC   = 9 + NACCE
 105       MEXTR(1) = 3
 106       MEXTR(2) = NQME(3)
 107       MEXTR(3) = NQME(4)
 108       MEXTR(4) = NQME(5)
 109
 110 C--                Lift division JZ91
 111
 112       NWINT = 1000
 113       NWMAX = LQSTA(KQT+21) / 2
 114       CALL MZDIV  (IXSTJZ,IXDVJZ,'JZ91',NWINT,NWMAX,'ML')
 115       CALL MZLINK (IXSTJZ,'JZ91',LQJZ,LQUP,LQAN)
 116
 117 C----              Lift main bank
 118
 119       MMJZ91(2) = 2*JQMLEV + 6
 120       MMJZ91(3) =   JQMLEV + 5
 121       MMJZ91(4) = 2*JQMLEV + 2
 122       CALL MZLIFT (IXDVJZ,L,LQJZ,1,MMJZ91,0)
 123       IQ(KQS+LQJZ+1) = NACCE
 124
 125 C----              Lift the call banks
 126
 127       DO 24 J=1,JQMLEV
 128       CALL MZLIFT (IXDVJZ,L,LQJZ,-J-5,MMCALL,0)
 129    24 CONTINUE
 130
 131 C----              Collect all JQAN titles
 132
 133       CALL TZINQ (IXSTJZ,IXDVTT,LQAN,1)
 134       IF (LQAN.EQ.0)               GO TO 49
 135       CALL MZXREF (IXDVJZ,IXDVTT,'A')
 136       GO TO 33
 137
 138    32 LQAN = LQ(KQS+LQAN)
 139    33 IF (LQAN.EQ.0)               GO TO 39
 140       IF (IQ(KQS+LQAN-4).NE.MJQAN)    GO TO 32
 141
 142       L = LZFIND (IXSTJZ,LQ(KQS+LQJZ-1), IQ(KQS+LQAN+1),1)
 143       IF (L.NE.0)                  GO TO 34
 144       L    = LQAN
 145       LQAN = LQ(KQS+LQAN)
 146       CALL ZSHUNT (IXSTJZ,L,LQJZ,-1,0)
 147       GO TO 33
 148
 149    34 CALL MZDROP (IXSTJZ,LQAN, '.')
 150       GO TO 32
 151
 152    39 CALL ZTOPSY (IXSTJZ,LQ(KQS+LQJZ-1))
 153
 154 C----              Digest all JQFL titles
 155
 156       LQAN = LQT(KQT+1)
 157       GO TO 43
 158
 159    42 LQAN = LQ(KQS+LQAN)
 160    43 IF (LQAN.EQ.0)               GO TO 49
 161       IF (IQ(KQS+LQAN-4).NE.MJQFL)    GO TO 42
 162
 163 #if defined(CERNLIB_QDEBUG)
 164       JNEXT = 1
 165       JMAX  = IQ(KQS+LQAN-1)
 166
 167    44 IF (JNEXT.GT.JMAX)           GO TO 47
 168       JID   = JNEXT
 169       JEND  = IUFIND (MEND,IQ(KQS+LQAN+1),JID+1,JMAX)
 170       JNEXT = JEND + 1
 171       ID = IQ(KQS+LQAN+JID)
 172       IF (LZFIND(IXSTJZ,LQ(KQS+LQJZ-2),ID,1).NE.0)   GO TO 44
 173
 174       IF (JID .NE.1)               GO TO 45
 175       IF (JEND.LE.JMAX)            GO TO 45
 176       L    = LQAN
 177       LQAN = LQ(KQS+LQAN)
 178       CALL ZSHUNT (IXSTJZ,L, LQJZ,-2,0)
 179       GO TO 33
 180
 181    45 MMFL(4) = MIN (JEND-JID,JQMFLW+1)
 182       CALL MZLIFT (IXDVTT,L,LQJZ,-2,MMFL,-1)
 183       CALL UCOPY (IQ(KQS+LQAN+JID),IQ(KQS+L+1),MMFL(4))
 184       GO TO 44
 185
 186 #endif
 187    47 CALL MZDROP (IXSTJZ,LQAN, '.')
 188       GO TO 42
 189
 190    49 CONTINUE
 191
 192 C----              Lift the root level
 193
 194 #if defined(CERNLIB_JZTIME)
 195 #include "zebra/jztimed.inc"
 196 #endif
 197
 198       JQREOD = 512
 199       JQEALL = -JQREOD
 200
 201       CALL JZIN (CHIAM,1,NQME(2),MEXTR)
 202
 203 #include "zebra/qtrace99.inc"
 204       RETURN
 205       END
 206 *      ==================================================
 207 #include "zebra/qcardl.inc"