/[PAMELA software]/yoda/techmodel/forroutines/trigger/triggerunpack.for
ViewVC logotype

Contents of /yoda/techmodel/forroutines/trigger/triggerunpack.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5.0 - (show annotations) (download)
Mon Aug 29 09:46:13 2005 UTC (19 years, 4 months ago) by kusanagi
Branch: MAIN
CVS Tags: YODA5_0/00, YODA5_0/01, YODA5_0/02
Changes since 4.4: +0 -0 lines
Starting form this version:
1) includes are defined with relative (not absolute) path respect to the YODA aplication
2) RegistryEvent class is foreseen to contain post-unpack data.

1 C--------------------------------------------------------------------
2 SUBROUTINE TRIGGERUNPACK(vecta,lung,me)
3
4 C D.Campana, Dec. 04
5 C---------------------------------------------------------------------
6
7 IMPLICIT NONE
8 C
9 integer lung
10 integer*1 vecta(lung)
11 integer*2 ibuf
12 integer me
13 integer*2 check, crctrig
14 integer ic0,sup,inf
15 integer i, ic, bit, bi
16 integer pmtpl(3), trigrate(6), dltime(2), s4calcount(2)
17 integer pmtcount1(24), pmtcount2(24)
18 integer*4 patternbusy(3)
19 integer patterntrig(6), trigconf
20 integer*4 evcount
21 real ratepmt(3),ratetrig(6),dltimems(2)
22 C
23 C
24 COMMON / trig / evcount, pmtpl, trigrate, dltime,
25 & s4calcount, pmtcount1, pmtcount2,
26 & patternbusy, patterntrig, trigconf
27 save / trig /
28 C
29 C Begin !
30 C
31
32 ic = 1
33 c print *,'************* Trigger Unpack ******************'
34 ic0 = ic
35 do i = 1, 3
36 pmtpl(i) = 0
37 do bit = 0, 7
38 bi = ibits(vecta(ic),bit,1)
39 if (bi.eq.1) pmtpl(i) = ibset(pmtpl(i),7-bit)
40
41 if (bit.ge.4) then
42 bi = ibits(vecta(ic+1),bit,1)
43 if (bi.eq.1) pmtpl(i) = ibset(pmtpl(i),15-bit)
44 endif
45 enddo
46 ratepmt(i) = pmtpl(i)/0.06 ! rate di piano in Hz
47 ic = ic + 2
48 enddo
49 c print *,'----------> 1crc: ',ic
50 c print *,'pmtpl(i,(i=1,3))'
51 c print *,pmtpl(1),pmtpl(2),pmtpl(3)
52 c print *,'ratepmt(i,(i=1,3))'
53 c print *,ratepmt(1),ratepmt(2),ratepmt(3)
54 c
55 c vecta(ic) is the CRC
56 c Check consistency of CRC.
57 c
58 ibuf=0
59 do bit = 0, 7
60 bi = ibits(vecta(ic),bit,1)
61 if (bi.eq.1) ibuf = ibset(ibuf,bit)
62 enddo
63 c
64 check = 0
65 inf = ic0
66 sup = ic - 1
67 do i = inf,sup
68 check=crctrig(check,vecta(i))
69 enddo
70 if (check.ne.ibuf) then
71 c print *,'crc wrong ',ibuf, check
72 me = 1
73 endif
74 c
75 ic = ic + 1
76 ic0 = ic
77 evcount = 0
78 do bit=0, 7
79 bi = ibits(vecta(ic),bit,1)
80 if (bi.eq.1) evcount = ibset(evcount,7-bit)
81 bi = ibits(vecta(ic+1),bit,1)
82 if (bi.eq.1) evcount = ibset(evcount,15-bit)
83 bi = ibits(vecta(ic+2),bit,1)
84 if (bi.eq.1) evcount = ibset(evcount,23-bit)
85 enddo
86 ic = ic + 3
87
88 c print *,'----------> 2crc: ',ic
89 c print *,'evcount',evcount
90 c
91 c vecta(ic) is the CRC
92 c Check consistency of CRC.
93 c
94 ibuf=0
95 do bit = 0, 7
96 bi = ibits(vecta(ic),bit,1)
97 if (bi.eq.1) ibuf = ibset(ibuf,bit)
98 enddo
99 c
100 check = 0
101 inf = ic0
102 sup = ic - 1
103 do i = inf,sup
104 check=crctrig(check,vecta(i))
105 enddo
106 if (check.ne.ibuf) then
107 c print *,'crc wrong ',ibuf, check
108 me = 1
109 endif
110 c
111 c
112 ic = ic + 1
113 ic0 = ic
114 do i = 1, 6
115 trigrate(i) = 0
116 do bit = 0, 7
117 bi = ibits(vecta(ic),bit,1)
118 if (bi.eq.1) trigrate(i) = ibset(trigrate(i),7-bit)
119
120 if (bit.ge.4) then
121 bi = ibits(vecta(ic+1),bit,1)
122 if (bi.eq.1) trigrate(i) = ibset(trigrate(i),15-bit)
123 endif
124 enddo
125 ratetrig(i) = trigrate(i)/0.06 ! rate di trigger in Hz
126 ic = ic + 2
127 enddo
128
129 c print *,'----------> 3crc: ',ic
130 c print *,'trigrate(i,(i=1,6))'
131 c print *,trigrate(1),trigrate(2),trigrate(3)
132 c print *,trigrate(4),trigrate(5),trigrate(6)
133 c print *,'ratetrig(i,(i=1,6))'
134 c print *,ratetrig(1),ratetrig(2),ratetrig(3)
135 c print *,ratetrig(4),ratetrig(5),ratetrig(6)
136 c
137 c vecta(ic) is the CRC
138 c Check consistency of CRC.
139 c
140 ibuf=0
141 do bit = 0, 7
142 bi = ibits(vecta(ic),bit,1)
143 if (bi.eq.1) ibuf = ibset(ibuf,bit)
144 enddo
145 c
146 check = 0
147 inf = ic0
148 sup = ic - 1
149 do i = inf,sup
150 check=crctrig(check,vecta(i))
151 enddo
152 if (check.ne.ibuf) then
153 c print *,'crc wrong ',ibuf, check
154 me = 1
155 endif
156 c
157 c
158 ic = ic + 1
159 ic0 = ic
160 do i = 1, 2
161 dltime(i) = 0
162 do bit = 0, 7
163 bi = ibits(vecta(ic),bit,1)
164 if (bi.eq.1) dltime(i) = ibset(dltime(i),7-bit)
165 bi = ibits(vecta(ic+1),bit,1)
166 if (bi.eq.1) dltime(i) = ibset(dltime(i),15-bit)
167 enddo
168 ic = ic + 2
169 enddo
170 dltimems(1) = dltime(1) * 0.16 ! dltime in msec
171 dltimems(2) = dltime(2) * 0.01 ! dltime in msec
172
173 c print *,'----------> 4crc: ',ic
174 c print *,'dltime(i,(i=1,2))'
175 c print *,dltime(1),dltime(2)
176 c print *,'dltimems(i,(i=1,2))'
177 c print *,dltimems(1),dltimems(2)
178 c
179 c vecta(ic) is the CRC
180 c Check consistency of CRC.
181 c
182 ibuf=0
183 do bit = 0, 7
184 bi = ibits(vecta(ic),bit,1)
185 if (bi.eq.1) ibuf = ibset(ibuf,bit)
186 enddo
187 c
188 check = 0
189 inf = ic0
190 sup = ic - 1
191 do i = inf,sup
192 check=crctrig(check,vecta(i))
193 enddo
194 if (check.ne.ibuf) then
195 c print *,'crc wrong ',ibuf, check
196 me = 1
197 endif
198 c
199 c
200 ic = ic + 1
201 ic0 = ic
202 do i = 1, 2
203 s4calcount(i) = 0
204 do bit = 0, 7
205 bi = ibits(vecta(ic),bit,1)
206 if (bi.eq.1) s4calcount(i) = ibset(s4calcount(i),7-bit)
207
208 if (bit.ge.4) then
209 bi = ibits(vecta(ic+1),bit,1)
210 if (bi.eq.1) s4calcount(i) = ibset(s4calcount(i),15-bit)
211 endif
212 enddo
213 ic = ic + 2
214 enddo
215
216 c print *,'----------> 5crc: ',ic
217 c print *,'s4calcount(i,(i=1,2))'
218 c print *,s4calcount(1),s4calcount(2)
219 c
220 c
221 c vecta(ic) is the CRC
222 c Check consistency of CRC.
223 c
224 ibuf=0
225 do bit = 0, 7
226 bi = ibits(vecta(ic),bit,1)
227 if (bi.eq.1) ibuf = ibset(ibuf,bit)
228 enddo
229 c
230 check = 0
231 inf = ic0
232 sup = ic - 1
233 do i = inf,sup
234 check=crctrig(check,vecta(i))
235 enddo
236 if (check.ne.ibuf) then
237 c print *,'crc wrong ',ibuf, check
238 me = 1
239 endif
240 C
241 ic = ic + 1
242 ic0 = ic
243 do i = 1, 24
244 pmtcount1(i) = 0
245 do bit = 0, 7
246 bi = ibits(vecta(ic),bit,1)
247 if (bi.eq.1) pmtcount1(i) = ibset(pmtcount1(i),7-bit)
248
249 if (bit.ge.4) then
250 bi = ibits(vecta(ic+1),bit,1)
251 if (bi.eq.1) pmtcount1(i) = ibset(pmtcount1(i),15-bit)
252 endif
253 enddo
254 ic = ic + 2
255 enddo
256
257 c print *,'----------> 6crc: ',ic
258 c print *,'pmtcount1(i,(i=1,24))'
259 c print *,pmtcount1(1) ,pmtcount1(2) ,pmtcount1(3) ,pmtcount1(4)
260 c print *,pmtcount1(5) ,pmtcount1(6) ,pmtcount1(7) ,pmtcount1(8)
261 c print *,pmtcount1(9) ,pmtcount1(10),pmtcount1(11),pmtcount1(12)
262 c print *,pmtcount1(13),pmtcount1(14),pmtcount1(15),pmtcount1(16)
263 c print *,pmtcount1(17),pmtcount1(18),pmtcount1(19),pmtcount1(20)
264 c print *,pmtcount1(21),pmtcount1(22),pmtcount1(23),pmtcount1(24)
265 c
266 c
267 c vecta(ic) is the CRC
268 c Check consistency of CRC.
269 c
270 ibuf=0
271 do bit = 0, 7
272 bi = ibits(vecta(ic),bit,1)
273 if (bi.eq.1) ibuf = ibset(ibuf,bit)
274 enddo
275 c
276 check = 0
277 inf = ic0
278 sup = ic - 1
279 do i = inf,sup
280 check=crctrig(check,vecta(i))
281 enddo
282 if (check.ne.ibuf) then
283 c print *,'crc wrong ',ibuf, check
284 me = 1
285 endif
286 c
287 c
288 ic = ic + 1
289 ic0 = ic
290 do i = 1, 24
291 pmtcount2(i) = 0
292 do bit = 0, 7
293 bi = ibits(vecta(ic),bit,1)
294 if (bi.eq.1) pmtcount2(i) = ibset(pmtcount2(i),7-bit)
295 if (bit.ge.4) then
296 bi = ibits(vecta(ic+1),bit,1)
297 if (bi.eq.1) pmtcount2(i) = ibset(pmtcount2(i),15-bit)
298 endif
299 enddo
300 ic = ic + 2
301 enddo
302 c print *,'----------> 7crc: ',ic
303 c print *,'pmtcount2(i,(i=1,24))'
304 c print *,pmtcount2(1) ,pmtcount2(2) ,pmtcount2(3) ,pmtcount2(4)
305 c print *,pmtcount2(5) ,pmtcount2(6) ,pmtcount2(7) ,pmtcount2(8)
306 c print *,pmtcount2(9) ,pmtcount2(10),pmtcount2(11),pmtcount2(12)
307 c print *,pmtcount2(13),pmtcount2(14),pmtcount2(15),pmtcount2(16)
308 c print *,pmtcount2(17),pmtcount2(18),pmtcount2(19),pmtcount2(20)
309 c print *,pmtcount2(21),pmtcount2(22),pmtcount2(23),pmtcount2(24)
310
311 c
312 c vecta(ic) is the CRC
313 c Check consistency of CRC.
314 c
315 ibuf=0
316 do bit = 0, 7
317 bi = ibits(vecta(ic),bit,1)
318 if (bi.eq.1) ibuf = ibset(ibuf,bit)
319 enddo
320 c
321 check = 0
322 inf = ic0
323 sup = ic - 1
324 do i = inf,sup
325 check=crctrig(check,vecta(i))
326 enddo
327 if (check.ne.ibuf) then
328 c print *,'crc wrong ',ibuf, check
329 me = 1
330 endif
331 c
332
333 ic = ic + 1
334 ic0 = ic
335 do i = 1, 3
336 patternbusy(i) = 0
337 if(i.eq.1)then
338 do bit = 0, 7
339 bi = ibits(vecta(ic),bit,1)
340 if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),11+bit)
341 bi = ibits(vecta(ic+1),bit,1)
342 if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),3+bit)
343
344 if (bit.ge.5) then
345 bi = ibits(vecta(ic+2),bit,1)
346 if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),bit-5)
347 endif
348 enddo
349 endif
350 if(i.eq.2)then
351 do bit = 0, 7
352 if (bit.lt.5) then
353 bi = ibits(vecta(ic),bit,1)
354 if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),14+bit)
355 endif
356 bi = ibits(vecta(ic+1),bit,1)
357 if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),6+bit)
358
359 if (bit.ge.2) then
360 bi = ibits(vecta(ic+2),bit,1)
361 if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),bit-2)
362 endif
363 enddo
364 endif
365
366 if(i.eq.3)then
367 do bit = 0, 7
368 if (bit.lt.2) then
369 bi = ibits(vecta(ic),bit,1)
370 if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),17+bit)
371 endif
372 bi = ibits(vecta(ic+1),bit,1)
373 if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),9+bit)
374 bi = ibits(vecta(ic+2),bit,1)
375 if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),bit+1)
376
377 if (bit.eq.7) then
378 bi = ibits(vecta(ic+3),bit,1)
379 if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),0)
380 endif
381 enddo
382 endif
383
384 ic = ic + 2
385 enddo
386 ic = ic + 2
387
388 c print *,'----------> 8crc: ',ic
389 c print *,'patternbusy(i,(i=1,3))'
390 c print *, patternbusy(1) ,patternbusy(2) ,patternbusy(3)
391 c
392 c vecta(ic) is the CRC
393 c Check consistency of CRC.
394 c
395 ibuf=0
396 do bit = 0, 7
397 bi = ibits(vecta(ic),bit,1)
398 if (bi.eq.1) ibuf = ibset(ibuf,bit)
399 enddo
400 c
401 check = 0
402 inf = ic0
403 sup = ic - 1
404 do i = inf,sup
405 check=crctrig(check,vecta(i))
406 enddo
407 if (check.ne.ibuf) then
408 c print *,'crc wrong ',ibuf, check
409 me = 1
410 endif
411 c
412 c
413 ic = ic + 1
414 ic0 = ic
415 do i = 1, 6
416 patterntrig(i) = 0
417 enddo
418 do i = 1, 7
419 if(i.eq.1)then
420 do bit = 0, 7
421 bi = ibits(vecta(ic),bit,1)
422 if (bi.eq.1)then
423 if(bit.ge.4)patterntrig(i) = ibset(patterntrig(i),bit-4)
424 if(bit.lt.4.and.bit.gt.0)
425 + patterntrig(i+1) = ibset(patterntrig(i+1),bit-1)
426
427 if(bit.eq.0)patterntrig(i+2)=ibset(patterntrig(i+2),11)
428 endif
429 enddo
430 endif
431
432 if(i.eq.2)then
433 do bit = 0, 7
434 bi = ibits(vecta(ic),bit,1)
435 if (bi.eq.1)
436 + patterntrig(i+1) = ibset(patterntrig(i+1),bit+3)
437 enddo
438 endif
439
440 if(i.eq.3)then
441 do bit = 0, 7
442 bi = ibits(vecta(ic),bit,1)
443 if (bi.eq.1)then
444 if(bit.ge.5)then
445 patterntrig(i)=ibset(patterntrig(i),bit-5)
446 else
447 patterntrig(i+1)=ibset(patterntrig(i+1),bit+3)
448 endif
449 endif
450 enddo
451 endif
452
453 if(i.eq.4)then
454 do bit = 0, 7
455 bi = ibits(vecta(ic),bit,1)
456 if (bi.eq.1)then
457 if(bit.ge.5)then
458 patterntrig(i)=ibset(patterntrig(i),bit-5)
459 else
460 patterntrig(i+1)=ibset(patterntrig(i+1),bit+7)
461 endif
462 endif
463 enddo
464 endif
465
466 if(i.eq.5)then
467 do bit = 0, 7
468 bi = ibits(vecta(ic),bit,1)
469 if (bi.eq.1)then
470 if(bit.gt.0)then
471 patterntrig(i)=ibset(patterntrig(i),bit-1)
472 else
473 patterntrig(i+1)=ibset(patterntrig(i+1),bit+15)
474 endif
475 endif
476 enddo
477 endif
478
479 if(i.eq.6)then
480 do bit = 0, 7
481 bi = ibits(vecta(ic),bit,1)
482 if (bi.eq.1)patterntrig(i)=ibset(patterntrig(i),bit+7)
483 enddo
484 endif
485
486 if(i.eq.7)then
487 do bit = 0, 7
488 bi = ibits(vecta(ic),bit,1)
489 if (bi.eq.1)then
490 if(bit.gt.0)patterntrig(i-1)=ibset(patterntrig(i-1),bit-1)
491 endif
492 enddo
493 endif
494 ic = ic + 1
495 enddo
496
497 c print *,'----------> 9crc: ',ic
498 c print *,'patterntrig(i,(i=1,6))'
499 c print *, patterntrig(1) ,patterntrig(2) ,patterntrig(3)
500 c print *, patterntrig(4) ,patterntrig(5) ,patterntrig(6)
501 c
502 c
503 c vecta(ic) is the CRC
504 c Check consistency of CRC.
505 c
506 ibuf=0
507 do bit = 0, 7
508 bi = ibits(vecta(ic),bit,1)
509 if (bi.eq.1) ibuf = ibset(ibuf,bit)
510 enddo
511 c
512 check = 0
513 inf = ic0
514 sup = ic - 1
515 do i = inf,sup
516 check=crctrig(check,vecta(i))
517 enddo
518 if (check.ne.ibuf) then
519 c print *,'crc wrong ',ibuf, check
520 me = 1
521 endif
522 c
523 c
524 ic = ic + 1
525 ic0 = ic
526 trigconf = 0
527 do i = 1, 2
528 do bit = 0, 7
529 bi = ibits(vecta(ic),bit,1)
530 if (bi.eq.1) then
531 if(i.eq.1) trigconf = ibset(trigconf,bit+2)
532 if(i.eq.2) then
533 if(bit.ge.6)trigconf = ibset(trigconf,bit-6)
534 endif
535 endif
536 enddo
537 ic = ic + 1
538 enddo
539 c print *,'----------> 10crc: ',ic
540 c print *,'ic here is ',ic
541 c print *,'trigconf'
542 c print *, trigconf
543 c
544 c vecta(ic) is the CRC
545 c Check consistency of CRC.
546 c
547 ibuf=0
548 do bit = 0, 7
549 bi = ibits(vecta(ic),bit,1)
550 if (bi.eq.1) ibuf = ibset(ibuf,bit)
551 enddo
552 c
553 check = 0
554 inf = ic0
555 sup = ic - 1
556 do i = inf,sup
557 check=crctrig(check,vecta(i))
558 enddo
559 if (check.ne.ibuf) then
560 c print *,'crc wrong ',ibuf, check
561 me = 1
562 endif
563 c
564 RETURN
565 END

  ViewVC Help
Powered by ViewVC 1.1.23