]> git.uio.no Git - u/mrichter/AliRoot.git/blame - MINICERN/packlib/zebra/mq/mzstor.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / mq / mzstor.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.2 1996/04/18 16:12:06 mclareni
6* Incorporate changes from J.Zoll for version 3.77
7*
8* Revision 1.1.1.1 1996/03/06 10:47:17 mclareni
9* Zebra
10*
11*
12#include "zebra/pilot.h"
13 SUBROUTINE MZSTOR (IXSTOR,CHNAME,CHOPT
14 +, IFENCE,LV,LLR,LLD,LIMIT,LAST)
15
16C- Initialize new Zebra store region, user called
17
18#include "zebra/zbcd.inc"
19#include "zebra/zmach.inc"
20#include "zebra/zstate.inc"
21#include "zebra/zunit.inc"
22#include "zebra/mqsys.inc"
23#include "zebra/mzcwk.inc"
24C-------------- End CDE --------------
25 DIMENSION IXSTOR(9),IFENCE(9)
26 DIMENSION LV(9),LLR(9),LLD(9),LIMIT(9),LAST(9)
27 DIMENSION MMSYSL(5), NAMELA(2), NAMESY(2)
28 CHARACTER *(*) CHNAME,CHOPT
29#if defined(CERNLIB_QMVDS)
30 SAVE MMSYSL, NAMELA, NAMESY, NAMWSP, NAMEDV
31#endif
32#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
33 DIMENSION NAMESR(2)
34 DATA NAMESR / 4HMZST, 4HOR /
35#endif
36#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
37 DATA NAMESR / 6HMZSTOR /
38#endif
39#if !defined(CERNLIB_QTRHOLL)
40 CHARACTER NAMESR*8
41 PARAMETER (NAMESR = 'MZSTOR ')
42#endif
43#if defined(CERNLIB_QHOLL)
44 DATA MMSYSL / 4HSYSL,0,0,101,2/
45 DATA NAMELA / 4Hsyst, 4Hem /
46 DATA NAMESY / 4Hsyst, 4Hem /
47 DATA NAMWSP / 4Hqwsp /
48 DATA NAMEDV / 4HQDIV /
49#endif
50#if !defined(CERNLIB_QHOLL)
51 DATA MMSYSL / 0,0,0,101,2/
52#endif
53
54#include "zebra/q_sbit1.inc"
55#include "zebra/q_shiftl.inc"
56#include "zebra/q_locf.inc"
57
58
59C-- Clear Zebra tables on first entry
60
61 IF (NQSTOR.NE.-1) GO TO 13
62 CALL VZERO (NQOFFT,32)
63 LQATAB = LOCF (IQTABV(1)) - 1
64 LQASTO = LOCF (LQ(1)) - 1
65 LQBTIS = LQATAB - LQASTO
66 LQWKTB = LOCF(IQWKTB(1)) - LQASTO
67 LQWKFZ = LOCF(IQWKFZ(1)) - LQASTO
68 NQTSYS = LOCF(IQDN2(20)) - LQATAB
69 NQWKTB = NQWKTT
70
71C- KQFT=342 relies on LQFSTA(1) to be LQSTA(1+342) in /MZCC/
72 KQFT = 342
73#if defined(CERNLIB_QPRINT)
74 IF (NQLOGD.GE.-1)
75 +WRITE (IQLOG,9011) LQATAB,LQATAB
76 9011 FORMAT (1X/' MZSTOR. ZEBRA table base TAB(0) in /MZCC/ at adr'
77#endif
78#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
79 F,I12,1X,O11,' OCT')
80#endif
81#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(!defined(CERNLIB_B64))
82 F,I12,1X,Z11,' HEX')
83#endif
84#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(defined(CERNLIB_B64))
85 F,I12,1X,Z16,' HEX')
86#endif
87 13 CONTINUE
88#if !defined(CERNLIB_QHOLL)
89 CALL UCTOH ('SYSL', MMSYSL, 4,4)
90 CALL UCTOH ('system ',NAMELA, 4,8)
91 CALL UCTOH ('system ',NAMESY, 4,8)
92 CALL UCTOH ('qwsp' ,NAMWSP, 4,4)
93 CALL UCTOH ('QDIV' ,NAMEDV, 4,4)
94#endif
95
96#include "zebra/qtrace.inc"
97
98 CALL UOPTC (CHOPT,'Q:',IQUEST)
99 LOGQ = IQUEST(1)
100 IFLSPL = IQUEST(2)
101
102 JQSTOR = NQSTOR + 1
103 CALL VZERO (KQT,27)
104
105C-- Calculate store off-set
106
107 LQSTOR = LOCF(LV(1)) - 1
108 KQS = LQSTOR - LQASTO
109
110 NFEND = (LQSTOR+1) - LOCF(IFENCE(1))
111 NQFEND = NFEND
112
113C-- Printing name of store
114
115 NQSNAM(1) = IQBLAN
116 NQSNAM(2) = IQBLAN
117 N = MIN (8, LEN(CHNAME))
118 IF (N.NE.0) CALL UCTOH (CHNAME,NQSNAM,4,N)
119
120C-- Set log level
121
122 NQLOGL = NQLOGD
123 IF (LOGQ.NE.0) NQLOGL=-2
124
125C-- Permanent links et al.
126
127 NQSTRU = LOCF(LLR(1)) - (LQSTOR+1)
128 NQREF = LOCF(LLD(1)) - (LQSTOR+1)
129 NQLINK = NQREF
130 LQ2END = LOCF(LIMIT(1)) - LQSTOR
131 NDATAT = LOCF(LAST(1)) - LQSTOR
132
133C-- Calculate table off-set
134
135 NDATA = NDATAT
136 LOCT = LQATAB
137 IF (JQSTOR.NE.0) THEN
138 NDATA = NDATA - NQTSYS
139 NQSNAM(6) = NDATA
140 LOCT = LQSTOR + NDATA
141 KQT = LOCT - LQATAB
142 NDATA = NDATA - 4
143 CALL VFILL (LQ(KQS+NDATA),10,IQNIL)
144 ENDIF
145
146#if defined(CERNLIB_QPRINT)
147 IF (NQLOGL.GE.-1)
148 +WRITE (IQLOG,9021) JQSTOR,NQSNAM(1),NQSNAM(2)
149 +, LQSTOR,LOCT,LQSTOR,LOCT,KQS,KQT,KQS,KQT
150 +, NQSTRU,NQREF,LQ2END,NDATAT,NFEND
151 9021 FORMAT (1X/' MZSTOR. Initialize Store',I3,' in ',2A4,
152 F/10X,'with Store/Table at absolute adrs',2I12
153#endif
154#if (defined(CERNLIB_QPRINT))&&(!defined(CERNLIB_HEX))
155 F/40X,'OCT',2(1X,O11)/40X,'OCT',2(1X,O11)
156#endif
157#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(!defined(CERNLIB_B64))
158 F/40X,'HEX',2(1X,Z11)/40X,'HEX',2(1X,Z11)
159#endif
160#if (defined(CERNLIB_QPRINT))&&(defined(CERNLIB_HEX))&&(defined(CERNLIB_B64))
161 F/30X,'HEX',2(1X,Z16)/30X,'HEX',2(1X,Z16)
162#endif
163#if defined(CERNLIB_QPRINT)
164 F/30X,'relative adrs',2I12
165 F/10X,'with',I6,' Str. in',I6,' Links in',I7,' Low words in'
166 F,I8,' words.'
167 F/10X,'This store has a fence of',I5,' words.')
168#endif
169
170C-- Set minimum sizes
171
172 NSYS = 400
173 NQMINR = 40
174 NWF = 2000
175 IF (JQSTOR.EQ.0) NQMINR=164
176
177C-- Check parameters valid
178
179 IF (NQSTRU.LT.0) GO TO 91
180 IF (NQREF .LT.NQSTRU) GO TO 91
181 IF (NDATAT.LT.NQLINK+NWF) GO TO 91
182 IF (LQ2END.LT.NQLINK+NQMINR) GO TO 91
183 IF (NFEND .LT.1) GO TO 92
184 IF (NFEND .GE.1001) GO TO 92
185 IF (IFLSPL.EQ.1) THEN
186 IF (JQSTOR.EQ.0) GO TO 96
187 GO TO 39
188 ENDIF
189
190#if (!defined(CERNLIB_QSINGLST))&&(defined(CERNLIB_QDEBUG))
191C-- Check overlapping stores
192
193 IF (JQSTOR.EQ.0) GO TO 41
194 KSA = KQS - NQFEND
195 KSE = KQS + NDATAT
196
197 DO 36 JSTO=1,JQSTOR
198 JT = NQOFFT(JSTO)
199 JS = NQOFFS(JSTO)
200 JSA = JS - IQTABV(JT+2)
201 JSE = JS + LQSTA(JT+21)
202 JTA = JT + LQBTIS
203 JTE = JTA + NQTSYS
204
205 IF (KSE.GT.JTA .AND. KSA.LT.JTE) GO TO 94
206 IF (KSE.GT.JSA .AND. KSA.LT.JSE) GO TO 95
207 36 CONTINUE
208#endif
209 39 IF (JQSTOR.GE.16) GO TO 93
210
211C---- Initialize divisions 1 + 2 + system
212
213 41 NQOFFT(JQSTOR+1) = KQT
214 NQOFFS(JQSTOR+1) = KQS
215 NQALLO(JQSTOR+1) = IFLSPL
216 CALL VZERO (IQTABV(KQT+1),NQTSYS)
217 CALL VBLANK (IQDN1(KQT+1), 40)
218 NQSTOR = NQSTOR + 1
219
220 LQ(KQS+NDATA-1) = IQNIL
221 LQ(KQS+NDATA) = IQNIL
222
223 NDATA = NDATA - 2
224 LQSTA(KQT+21) = NDATA
225
226 JQDVLL = 2
227 JQDVSY = 20
228 LQSTA(KQT+20) = NDATA
229 LQEND(KQT+20) = NDATA
230 NQDMAX(KQT+20) = NDATA
231 IQMODE(KQT+20) = 1
232 IQKIND(KQT+20) = ISHFTL (1, 23)
233 IQRNO(KQT+20) = 9437183
234 IQDN1(KQT+20) = NAMESY(1)
235 IQDN2(KQT+20) = NAMESY(2)
236
237 LQSTA(KQT+2) = NDATA - NSYS
238 LQEND(KQT+2) = LQSTA(KQT+2)
239 NQDMAX(KQT+2) = NDATA
240 IQMODE(KQT+2) = 1
241 IQKIND(KQT+2) = MSBIT1 (2, 21)
242 IQRCU(KQT+2) = 3
243 IQRTO(KQT+2) = ISHFTL (3,20)
244 IQRNO(KQT+2) = 9437183
245 IQDN1(KQT+2) = NAMEDV
246 IQDN2(KQT+2) = IQNUM(3)
247
248 LQSTA(KQT+1) = NQLINK + 1
249 LQEND(KQT+1) = LQSTA(KQT+1)
250 NQDMAX(KQT+1) = NDATA
251 IQKIND(KQT+1) = MSBIT1 (1, 21)
252 IQRCU(KQT+1) = 3
253 IQRTO(KQT+1) = ISHFTL (3,20)
254 IQRNO(KQT+1) = 9437183
255 IQDN1(KQT+1) = NAMEDV
256 IQDN2(KQT+1) = IQNUM(2)
257
258 CALL UCOPY (IQCUR,IQTABV(KQT+1),16)
259 CALL VFILL (IFENCE,NFEND,IQNIL)
260 IF (NQLINK.NE.0) CALL VZERO (LV,NQLINK)
261
262C-- Return IXSTOR
263
264 IF (JQSTOR.EQ.0) THEN
265 IF (IXSTOR(1).EQ.0) GO TO 71
266 ENDIF
267 IDN = ISHFTL (JQSTOR,26)
268 IXSTOR(1) = IDN
269
270C---- Create system link table bank
271
272 71 JQDIVI = JQDVSY
273 CALL MZLIFT (-7,LSYS,0,2,MMSYSL,0)
274 LQSYSS(KQT+1) = LSYS
275
276 NALL = LOCF(IQTDUM(1)) - LOCF(LQSYSS(1))
277 NSTR = LOCF(LQSYSR(1)) - LOCF(LQSYSS(1))
278
279 LOCAR = LOCF (LQSYSS(KQT+1)) - LQSTOR
280 LOCARE = LOCAR + NALL
281
282C-- Working space
283
284 IQ(KQS+LSYS+1) = 11
285 IQ(KQS+LSYS+2) = 1
286 IQ(KQS+LSYS+3) = 1 + NQLINK
287 IQ(KQS+LSYS+4) = NQSTRU
288 IQ(KQS+LSYS+5) = NAMWSP
289 IQ(KQS+LSYS+6) = IQBLAN
290
291C-- System link area
292
293 IQ(KQS+LSYS+7) = LOCAR
294 IQ(KQS+LSYS+8) = LOCARE
295 IQ(KQS+LSYS+9) = NSTR
296 IQ(KQS+LSYS+10)= NAMELA(1)
297 IQ(KQS+LSYS+11)= NAMELA(2)
298
299C-- Range of possible values for an origin-link
300
301 IQTABV(KQT+13) = MIN (1, LOCAR)
302 IQTABV(KQT+14) = MAX (LQSTA(KQT+21), LOCARE)
303
304#include "zebra/qtrace99.inc"
305 RETURN
306
307C------ Error conditions
308
309#if (!defined(CERNLIB_QSINGLST))&&(defined(CERNLIB_QDEBUG))
310 95 NQCASE = 1
311 94 NQCASE = NQCASE - 2
312 NQFATA = 3
313 IQUEST(20) = JSTO - 1
314 IQUEST(21) = NQPNAM(JT+1)
315 IQUEST(22) = NQPNAM(JT+2)
316#endif
317
318 96 NQCASE = NQCASE + 3
319 93 NQCASE = NQCASE + 1
320 92 NQCASE = NQCASE + 1
321 91 NQCASE = NQCASE + 1
322 NQFATA = NQFATA + 9
323 IQUEST(11) = NQSNAM(1)
324 IQUEST(12) = NQSNAM(2)
325 IQUEST(13) = NFEND
326 IQUEST(14) = NQSTRU
327 IQUEST(15) = NQLINK
328 IQUEST(16) = LQ2END
329 IQUEST(17) = NDATAT
330 IQUEST(18) = NQMINR
331 IQUEST(19) = NWF
332#include "zebra/qtofatal.inc"
333 END
334* ==================================================
335#include "zebra/qcardl.inc"