[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / mq / mzdiv.F

*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/18 16:11:22  mclareni
* Incorporate changes from J.Zoll for version 3.77
*
* Revision 1.1.1.1  1996/03/06 10:47:18  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE MZDIV (IXSTOR,IXDIV,CHNAME,NWAP,NWMP,CHOPT)

C-    Create new division, user called

#include "zebra/zbcd.inc"
#include "zebra/zstate.inc"
#include "zebra/zunit.inc"
#include "zebra/zvfaut.inc"
#include "zebra/mqsys.inc"
#include "zebra/mzct.inc"
C--------------    End CDE                             --------------
      DIMENSION    IXDIV(9),NWAP(9),NWMP(9)
      CHARACTER    *(*) CHNAME, CHOPT
      DIMENSION    NAME(2)
#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HMZDI, 4HV    /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HMZDIV  /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      PARAMETER   (NAMESR = 'MZDIV   ')
#endif

#include "zebra/q_jbit.inc"
#include "zebra/q_jbyt.inc"
#include "zebra/q_sbit1.inc"
#include "zebra/q_sbyt.inc"
#include "zebra/q_shiftl.inc"


#include "zebra/qtrace.inc"

      NWALLO = NWAP(1)
      NWMAX  = NWMP(1)
      CALL UOPTC (CHOPT,'RMLPC',IQUEST)
      MODE   = IQUEST(1) + 2*IQUEST(2)
      KIND   = MIN (2, IQUEST(3)+2*IQUEST(4)) + 1
      IOPTC  = IQUEST(5)

C--                Printing name of division

      NAME(1) = IQBLAN
      NAME(2) = IQBLAN
      N = MIN (8, LEN(CHNAME))
      IF (N.NE.0)  CALL UCTOH (CHNAME,NAME,4,N)

#include "zebra/qstore.inc"

C--       option M, match mode of new division to neighbour

      IF (MODE.LT.2)               GO TO 29
      MODE = 0
      IF (KIND.GE.2)               GO TO 24
      IF (JQDVLL.EQ.2)             GO TO 29
      IF (IQMODE(KQT+JQDVLL).NE.0)    GO TO 29
      GO TO 28

   24 IF (JQDVSY.EQ.20)            GO TO 28
      IF (IQMODE(KQT+JQDVSY+1).NE.0)  GO TO 29
   28 MODE = 1
   29 CONTINUE

#if defined(CERNLIB_QPRINT)
      IF (NQLOGL.GE.0)
     +WRITE (IQLOG,9029) NAME,JQSTOR,NWALLO,NWMAX,MODE,KIND
 9029 FORMAT (1X/' MZDIV.   Initialize Division  ',2A4,'  in Store',I3
     F/10X,'NW/NWMAX=',2I7,',  MODE/KIND=',2I3)
#endif
#if defined(CERNLIB_QDEBUG)
      IF (IQVSTA.NE.0)       CALL ZVAUTX
#endif

C--                Check parameters

      IF (NWALLO.LT.100)           GO TO 91
      IF (NWMAX .LT.NWALLO)        GO TO 91
      IF (MODE  .LT.0)             GO TO 91
      IF (MODE  .GE.2)             GO TO 91
      IF (KIND  .LT.0)             GO TO 91
      IF (KIND  .GE.4)             GO TO 91
      IF (JQDVLL+1.EQ.JQDVSY)      GO TO 92

C----              Push down low divisions, and maybe system division

      MQDVGA = 0
      MQDVWI = 0
      NQDVMV = -NWALLO
      IQTNMV = 0
      JQSTMV = JQSTOR
      JQDVM1 = 2
      IF (KIND.LT.2)  THEN
          KIND   = 1
          JQDVM2 = JQDVLL
        ELSE
          JQDVM2 = JQDVSY
          MQDVGA = MSBIT1 (MQDVGA,JQDVSY)
        ENDIF
      JQDIVI = JQDVM2
      NRESV1 = LQSTA(KQT+2) - LQEND(KQT+1) - NQMINR
      NRESV2 = LQEND(KQT+2) - LQ2END
      NQRESV = MIN (NRESV1,NRESV2) + NQDVMV
      IF (NQRESV.LT.0)             GO TO 93

      CALL MZTABM
      CALL MZTABS
      CALL MZTABR
      CALL MZTABX
      CALL MZTABF
      CALL MZRELX
      CALL MZMOVE

C--                Create high division, re-number system division

      IF (JQDIVI.NE.JQDVSY)        GO TO 61
      JQDVSY = JQDVSY - 1

       LQSTA(KQT+JQDVSY) =  LQSTA(KQT+JQDVSY+1)
       LQEND(KQT+JQDVSY) =  LQEND(KQT+JQDVSY+1)
      NQDMAX(KQT+JQDVSY) = NQDMAX(KQT+JQDVSY+1)
      IQMODE(KQT+JQDVSY) = IQMODE(KQT+JQDVSY+1)
      IQKIND(KQT+JQDVSY) = IQKIND(KQT+JQDVSY+1)
       IQRTO(KQT+JQDVSY) =  IQRTO(KQT+JQDVSY+1)
       IQRNO(KQT+JQDVSY) =  IQRNO(KQT+JQDVSY+1)
      NQDINI(KQT+JQDVSY) = NQDINI(KQT+JQDVSY+1)
      NQDWIP(KQT+JQDVSY) = NQDWIP(KQT+JQDVSY+1)
      NQDGAU(KQT+JQDVSY) = NQDGAU(KQT+JQDVSY+1)
      NQDGAF(KQT+JQDVSY) = NQDGAF(KQT+JQDVSY+1)
      NQDPSH(KQT+JQDVSY) = NQDPSH(KQT+JQDVSY+1)
      NQDRED(KQT+JQDVSY) = NQDRED(KQT+JQDVSY+1)
      NQDSIZ(KQT+JQDVSY) = NQDSIZ(KQT+JQDVSY+1)
       IQDN1(KQT+JQDVSY) =  IQDN1(KQT+JQDVSY+1)
       IQDN2(KQT+JQDVSY) =  IQDN2(KQT+JQDVSY+1)

      NQDWIP(KQT+JQDIVI) = 0
      NQDGAU(KQT+JQDIVI) = 0
      NQDGAF(KQT+JQDIVI) = 0
      NQDPSH(KQT+JQDIVI) = 0
      NQDRED(KQT+JQDIVI) = 0
      NQDSIZ(KQT+JQDIVI) = 0

      LSTA   = LQEND(KQT+JQDVSY)
      GO TO 64

C--                Create low division JQDVLL

   61 LSTA = LQEND(KQT+JQDVLL)
      MOLL = JBIT (IQMODE(KQT+JQDVLL),1)

      JQDVLL = JQDVLL + 1
      JQDIVI = JQDVLL
      IF (MOLL.EQ.0)  THEN
          LSTA = MAX (LSTA, LQSTA(KQT+JQDVLL-1)+IQTABV(KQT+15))
          LSTA = MIN (LSTA, LQSTA(KQT+JQDVSY)-NWALLO)
        ENDIF
      IQTABV(KQT+15) = NWALLO

C--                Update store tables

   64 IF (MODE.NE.0) LSTA=LSTA+NWALLO

      MKIND = MSBIT1 (0,JQDIVI)
      MKIND = MSBIT1 (MKIND,20+KIND)

      MREF  = 0
      IF (KIND.GE.3)               GO TO 65
      IF (IOPTC.NE.0)              GO TO 65
      MREF = ISHFTL (3, 20)

   65 LQSTA(KQT+JQDIVI)  = LSTA
      LQEND(KQT+JQDIVI)  = LSTA
      NQDMAX(KQT+JQDIVI) = NWMAX
      IQMODE(KQT+JQDIVI) = MODE
      IQKIND(KQT+JQDIVI) = MKIND
      IQRTO(KQT+JQDIVI)  = MREF
      IQRNO(KQT+JQDIVI)  = 9437183
      NQDINI(KQT+JQDIVI) = NWALLO
      IQDN1(KQT+JQDIVI)  = NAME(1)
      IQDN2(KQT+JQDIVI)  = NAME(2)

      IQTABV(KQT+8) = JQDVLL
      IQTABV(KQT+9) = JQDVSY
      CALL MZXRUP


C--                Return IXDIV

#if defined(CERNLIB_QPRINT)
      IF (NQLOGL.GE.0)
     +WRITE (IQLOG,9079) JQDIVI
 9079 FORMAT (10X,'Division',I3,' initialized.')
#endif

      IXDIV(1) = MSBYT (JQSTOR,JQDIVI,27,4)
#include "zebra/qtrace99.inc"
      RETURN

C------            Error conditions

   93 NQCASE = 1
      NQFATA = 4
      IQUEST(18) = NQRESV
      IQUEST(19) = -NQDVMV
      IQUEST(20) = NRESV1
      IQUEST(21) = NRESV2

   92 NQCASE = NQCASE + 1
   91 NQCASE = NQCASE + 1
      NQFATA = NQFATA + 7
      IQUEST(11) = NAME(1)
      IQUEST(12) = NAME(2)
      IQUEST(13) = NWALLO
      IQUEST(14) = NWMAX
      IQUEST(15) = MODE
      IQUEST(16) = KIND
      IQUEST(17) = IOPTC
#include "zebra/qtofatal.inc"
      END
*      ==================================================
#include "zebra/qcardl.inc"
Commit	Line	Data
fe4da5cc	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"