MINICERN/packlib/zebra/mq/mzdiv.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:11:22  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:18  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE MZDIV (IXSTOR,IXDIV,CHNAME,NWAP,NWMP,CHOPT)
  14
  15 C-    Create new division, user called
  16
  17 #include "zebra/zbcd.inc"
  18 #include "zebra/zstate.inc"
  19 #include "zebra/zunit.inc"
  20 #include "zebra/zvfaut.inc"
  21 #include "zebra/mqsys.inc"
  22 #include "zebra/mzct.inc"
  23 C--------------    End CDE                             --------------
  24       DIMENSION    IXDIV(9),NWAP(9),NWMP(9)
  25       CHARACTER    *(*) CHNAME, CHOPT
  26       DIMENSION    NAME(2)
  27 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  28       DIMENSION    NAMESR(2)
  29       DATA  NAMESR / 4HMZDI, 4HV    /
  30 #endif
  31 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  32       DATA  NAMESR / 6HMZDIV  /
  33 #endif
  34 #if !defined(CERNLIB_QTRHOLL)
  35       CHARACTER    NAMESR*8
  36       PARAMETER   (NAMESR = 'MZDIV   ')
  37 #endif
  38
  39 #include "zebra/q_jbit.inc"
  40 #include "zebra/q_jbyt.inc"
  41 #include "zebra/q_sbit1.inc"
  42 #include "zebra/q_sbyt.inc"
  43 #include "zebra/q_shiftl.inc"
  44
  45
  46 #include "zebra/qtrace.inc"
  47
  48       NWALLO = NWAP(1)
  49       NWMAX  = NWMP(1)
  50       CALL UOPTC (CHOPT,'RMLPC',IQUEST)
  51       MODE   = IQUEST(1) + 2*IQUEST(2)
  52       KIND   = MIN (2, IQUEST(3)+2*IQUEST(4)) + 1
  53       IOPTC  = IQUEST(5)
  54
  55 C--                Printing name of division
  56
  57       NAME(1) = IQBLAN
  58       NAME(2) = IQBLAN
  59       N = MIN (8, LEN(CHNAME))
  60       IF (N.NE.0)  CALL UCTOH (CHNAME,NAME,4,N)
  61
  62 #include "zebra/qstore.inc"
  63
  64 C--       option M, match mode of new division to neighbour
  65
  66       IF (MODE.LT.2)               GO TO 29
  67       MODE = 0
  68       IF (KIND.GE.2)               GO TO 24
  69       IF (JQDVLL.EQ.2)             GO TO 29
  70       IF (IQMODE(KQT+JQDVLL).NE.0)    GO TO 29
  71       GO TO 28
  72
  73    24 IF (JQDVSY.EQ.20)            GO TO 28
  74       IF (IQMODE(KQT+JQDVSY+1).NE.0)  GO TO 29
  75    28 MODE = 1
  76    29 CONTINUE
  77
  78 #if defined(CERNLIB_QPRINT)
  79       IF (NQLOGL.GE.0)
  80      +WRITE (IQLOG,9029) NAME,JQSTOR,NWALLO,NWMAX,MODE,KIND
  81  9029 FORMAT (1X/' MZDIV.   Initialize Division  ',2A4,'  in Store',I3
  82      F/10X,'NW/NWMAX=',2I7,',  MODE/KIND=',2I3)
  83 #endif
  84 #if defined(CERNLIB_QDEBUG)
  85       IF (IQVSTA.NE.0)       CALL ZVAUTX
  86 #endif
  87
  88 C--                Check parameters
  89
  90       IF (NWALLO.LT.100)           GO TO 91
  91       IF (NWMAX .LT.NWALLO)        GO TO 91
  92       IF (MODE  .LT.0)             GO TO 91
  93       IF (MODE  .GE.2)             GO TO 91
  94       IF (KIND  .LT.0)             GO TO 91
  95       IF (KIND  .GE.4)             GO TO 91
  96       IF (JQDVLL+1.EQ.JQDVSY)      GO TO 92
  97
  98 C----              Push down low divisions, and maybe system division
  99
 100       MQDVGA = 0
 101       MQDVWI = 0
 102       NQDVMV = -NWALLO
 103       IQTNMV = 0
 104       JQSTMV = JQSTOR
 105       JQDVM1 = 2
 106       IF (KIND.LT.2)  THEN
 107           KIND   = 1
 108           JQDVM2 = JQDVLL
 109         ELSE
 110           JQDVM2 = JQDVSY
 111           MQDVGA = MSBIT1 (MQDVGA,JQDVSY)
 112         ENDIF
 113       JQDIVI = JQDVM2
 114       NRESV1 = LQSTA(KQT+2) - LQEND(KQT+1) - NQMINR
 115       NRESV2 = LQEND(KQT+2) - LQ2END
 116       NQRESV = MIN (NRESV1,NRESV2) + NQDVMV
 117       IF (NQRESV.LT.0)             GO TO 93
 118
 119       CALL MZTABM
 120       CALL MZTABS
 121       CALL MZTABR
 122       CALL MZTABX
 123       CALL MZTABF
 124       CALL MZRELX
 125       CALL MZMOVE
 126
 127 C--                Create high division, re-number system division
 128
 129       IF (JQDIVI.NE.JQDVSY)        GO TO 61
 130       JQDVSY = JQDVSY - 1
 131
 132        LQSTA(KQT+JQDVSY) =  LQSTA(KQT+JQDVSY+1)
 133        LQEND(KQT+JQDVSY) =  LQEND(KQT+JQDVSY+1)
 134       NQDMAX(KQT+JQDVSY) = NQDMAX(KQT+JQDVSY+1)
 135       IQMODE(KQT+JQDVSY) = IQMODE(KQT+JQDVSY+1)
 136       IQKIND(KQT+JQDVSY) = IQKIND(KQT+JQDVSY+1)
 137        IQRTO(KQT+JQDVSY) =  IQRTO(KQT+JQDVSY+1)
 138        IQRNO(KQT+JQDVSY) =  IQRNO(KQT+JQDVSY+1)
 139       NQDINI(KQT+JQDVSY) = NQDINI(KQT+JQDVSY+1)
 140       NQDWIP(KQT+JQDVSY) = NQDWIP(KQT+JQDVSY+1)
 141       NQDGAU(KQT+JQDVSY) = NQDGAU(KQT+JQDVSY+1)
 142       NQDGAF(KQT+JQDVSY) = NQDGAF(KQT+JQDVSY+1)
 143       NQDPSH(KQT+JQDVSY) = NQDPSH(KQT+JQDVSY+1)
 144       NQDRED(KQT+JQDVSY) = NQDRED(KQT+JQDVSY+1)
 145       NQDSIZ(KQT+JQDVSY) = NQDSIZ(KQT+JQDVSY+1)
 146        IQDN1(KQT+JQDVSY) =  IQDN1(KQT+JQDVSY+1)
 147        IQDN2(KQT+JQDVSY) =  IQDN2(KQT+JQDVSY+1)
 148
 149       NQDWIP(KQT+JQDIVI) = 0
 150       NQDGAU(KQT+JQDIVI) = 0
 151       NQDGAF(KQT+JQDIVI) = 0
 152       NQDPSH(KQT+JQDIVI) = 0
 153       NQDRED(KQT+JQDIVI) = 0
 154       NQDSIZ(KQT+JQDIVI) = 0
 155
 156       LSTA   = LQEND(KQT+JQDVSY)
 157       GO TO 64
 158
 159 C--                Create low division JQDVLL
 160
 161    61 LSTA = LQEND(KQT+JQDVLL)
 162       MOLL = JBIT (IQMODE(KQT+JQDVLL),1)
 163
 164       JQDVLL = JQDVLL + 1
 165       JQDIVI = JQDVLL
 166       IF (MOLL.EQ.0)  THEN
 167           LSTA = MAX (LSTA, LQSTA(KQT+JQDVLL-1)+IQTABV(KQT+15))
 168           LSTA = MIN (LSTA, LQSTA(KQT+JQDVSY)-NWALLO)
 169         ENDIF
 170       IQTABV(KQT+15) = NWALLO
 171
 172 C--                Update store tables
 173
 174    64 IF (MODE.NE.0) LSTA=LSTA+NWALLO
 175
 176       MKIND = MSBIT1 (0,JQDIVI)
 177       MKIND = MSBIT1 (MKIND,20+KIND)
 178
 179       MREF  = 0
 180       IF (KIND.GE.3)               GO TO 65
 181       IF (IOPTC.NE.0)              GO TO 65
 182       MREF = ISHFTL (3, 20)
 183
 184    65 LQSTA(KQT+JQDIVI)  = LSTA
 185       LQEND(KQT+JQDIVI)  = LSTA
 186       NQDMAX(KQT+JQDIVI) = NWMAX
 187       IQMODE(KQT+JQDIVI) = MODE
 188       IQKIND(KQT+JQDIVI) = MKIND
 189       IQRTO(KQT+JQDIVI)  = MREF
 190       IQRNO(KQT+JQDIVI)  = 9437183
 191       NQDINI(KQT+JQDIVI) = NWALLO
 192       IQDN1(KQT+JQDIVI)  = NAME(1)
 193       IQDN2(KQT+JQDIVI)  = NAME(2)
 194
 195       IQTABV(KQT+8) = JQDVLL
 196       IQTABV(KQT+9) = JQDVSY
 197       CALL MZXRUP
 198
 199
 200 C--                Return IXDIV
 201
 202 #if defined(CERNLIB_QPRINT)
 203       IF (NQLOGL.GE.0)
 204      +WRITE (IQLOG,9079) JQDIVI
 205  9079 FORMAT (10X,'Division',I3,' initialized.')
 206 #endif
 207
 208       IXDIV(1) = MSBYT (JQSTOR,JQDIVI,27,4)
 209 #include "zebra/qtrace99.inc"
 210       RETURN
 211
 212 C------            Error conditions
 213
 214    93 NQCASE = 1
 215       NQFATA = 4
 216       IQUEST(18) = NQRESV
 217       IQUEST(19) = -NQDVMV
 218       IQUEST(20) = NRESV1
 219       IQUEST(21) = NRESV2
 220
 221    92 NQCASE = NQCASE + 1
 222    91 NQCASE = NQCASE + 1
 223       NQFATA = NQFATA + 7
 224       IQUEST(11) = NAME(1)
 225       IQUEST(12) = NAME(2)
 226       IQUEST(13) = NWALLO
 227       IQUEST(14) = NWMAX
 228       IQUEST(15) = MODE
 229       IQUEST(16) = KIND
 230       IQUEST(17) = IOPTC
 231 #include "zebra/qtofatal.inc"
 232       END
 233 *      ==================================================
 234 #include "zebra/qcardl.inc"