/[PAMELA software]/chewbacca/PamOffLineSW/forroutines/trigger/triggerunpack.for
ViewVC logotype

Contents of /chewbacca/PamOffLineSW/forroutines/trigger/triggerunpack.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (download) (vendor branch)
Tue Sep 23 07:20:19 2008 UTC (16 years, 2 months ago) by mocchiut
Branch: v0r00, MAIN
CVS Tags: v1r02, v1r00, v1r01, start, v10RED, v9r00, v9r01, HEAD
Changes since 1.1: +0 -0 lines
Imported sources, 23/09/2008

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

  ViewVC Help
Powered by ViewVC 1.1.23