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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Tue Sep 23 07:20:19 2008 UTC (16 years, 2 months ago) by mocchiut
Branch point for: v0r00, MAIN
Initial revision

1 mocchiut 1.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