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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4.1 - (hide annotations) (download)
Wed Mar 16 20:32:11 2005 UTC (19 years, 9 months ago) by kusanagi
Branch: MAIN
CVS Tags: YODA4_1/00, YODA4_3/02, YODA4_3/00, YODA4_3/01, YODA4_2/01, YODA4_2/00, YODA4_2/03
Branch point for: PreThermistores2
Changes since 4.0: +82 -57 lines
New update from Donatella Campana 16 March 2005

1 kusanagi 1.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 kusanagi 4.1 integer*2 ibuf
12 kusanagi 1.1 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 kusanagi 4.1 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 kusanagi 1.1 check = 0
65     inf = ic0
66     sup = ic - 1
67     do i = inf,sup
68     check=crctrig(check,vecta(i))
69     enddo
70 kusanagi 4.1 if (check.ne.ibuf) then
71     c print *,'crc wrong ',ibuf, check
72 kusanagi 1.1 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 kusanagi 4.1 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 kusanagi 1.1 check = 0
101     inf = ic0
102     sup = ic - 1
103     do i = inf,sup
104     check=crctrig(check,vecta(i))
105     enddo
106 kusanagi 4.1 if (check.ne.ibuf) then
107     c print *,'crc wrong ',ibuf, check
108 kusanagi 1.1 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 kusanagi 4.1 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 kusanagi 1.1 check = 0
147     inf = ic0
148     sup = ic - 1
149     do i = inf,sup
150     check=crctrig(check,vecta(i))
151     enddo
152 kusanagi 4.1 if (check.ne.ibuf) then
153     c print *,'crc wrong ',ibuf, check
154 kusanagi 1.1 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 kusanagi 4.1 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 kusanagi 1.1 check = 0
189     inf = ic0
190     sup = ic - 1
191     do i = inf,sup
192     check=crctrig(check,vecta(i))
193     enddo
194 kusanagi 4.1 if (check.ne.ibuf) then
195     c print *,'crc wrong ',ibuf, check
196 kusanagi 1.1 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 kusanagi 4.1 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 kusanagi 1.1 check = 0
231     inf = ic0
232     sup = ic - 1
233     do i = inf,sup
234     check=crctrig(check,vecta(i))
235     enddo
236 kusanagi 4.1 if (check.ne.ibuf) then
237     c print *,'crc wrong ',ibuf, check
238 kusanagi 1.1 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 kusanagi 4.1 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 kusanagi 1.1 check = 0
277     inf = ic0
278     sup = ic - 1
279     do i = inf,sup
280     check=crctrig(check,vecta(i))
281     enddo
282 kusanagi 4.1 if (check.ne.ibuf) then
283     c print *,'crc wrong ',ibuf, check
284 kusanagi 1.1 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 kusanagi 4.1
311 kusanagi 1.1 c
312     c vecta(ic) is the CRC
313     c Check consistency of CRC.
314     c
315 kusanagi 4.1 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 kusanagi 1.1 check = 0
322     inf = ic0
323     sup = ic - 1
324     do i = inf,sup
325     check=crctrig(check,vecta(i))
326     enddo
327 kusanagi 4.1 if (check.ne.ibuf) then
328     c print *,'crc wrong ',ibuf, check
329 kusanagi 1.1 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 kusanagi 4.1 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 kusanagi 1.1 check = 0
402     inf = ic0
403     sup = ic - 1
404     do i = inf,sup
405     check=crctrig(check,vecta(i))
406     enddo
407 kusanagi 4.1 if (check.ne.ibuf) then
408     c print *,'crc wrong ',ibuf, check
409 kusanagi 1.1 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 kusanagi 4.1 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 kusanagi 1.1 check = 0
513     inf = ic0
514     sup = ic - 1
515     do i = inf,sup
516     check=crctrig(check,vecta(i))
517     enddo
518 kusanagi 4.1 if (check.ne.ibuf) then
519     c print *,'crc wrong ',ibuf, check
520 kusanagi 1.1 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 kusanagi 4.1 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 kusanagi 1.1 check = 0
554     inf = ic0
555     sup = ic - 1
556     do i = inf,sup
557     check=crctrig(check,vecta(i))
558     enddo
559 kusanagi 4.1 if (check.ne.ibuf) then
560     c print *,'crc wrong ',ibuf, check
561 kusanagi 1.1 me = 1
562     endif
563     c
564     RETURN
565     END

  ViewVC Help
Powered by ViewVC 1.1.23