/[PAMELA software]/calo/unpacking/calunpack3.for
ViewVC logotype

Annotation of /calo/unpacking/calunpack3.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide annotations) (download) (vendor branch)
Mon Dec 5 16:23:20 2005 UTC (18 years, 11 months ago) by mocchiut
Branch: MAIN, unpacking
CVS Tags: start, v1r00, HEAD
Changes since 1.1: +0 -0 lines
Imported sources

1 mocchiut 1.1 C
2     C Written by Mirko Boezio and Emiliano Mocchiutti
3     C
4     C * Version: 2.18.4 *
5     C
6     C Changelog:
7     C
8     C 2.18.3 - 2.18.4: consider a bad thing if you find a section in the wrong
9     C position of the vector and try again to
10     C find the real data (if they exist).
11     C
12     C 2.18.2 - 2.18.3: vectors belonging to common must be cleared if the calo
13     C isn't found. Fixed.
14     C
15     C 2.18.1 - 2.18.2: fixed unclearing error codes if the program doesn't find
16     C the calorimeter where it should be but shifted somewhere
17     C else
18     C forgotten to clear st2c variable: fixed
19     C exit error code wrong in some cases: fixed
20     C self trigger data not saved: fixed
21     C
22     C 2.18.0 - 2.18.1: small changes in the common varie to fix a memory leak;
23     C fixed an error in reporting error codes (stwerr,pwerror)
24     C
25     C 2.17 - 2.18.0: corrected bug which made unable the program to find CRC
26     C errors in the last section of the calorimeter;
27     C added a "debugging" option to dump to standard output
28     C the whole packet in hexadecimal format and other
29     C useful informations. To activate it the dump variable
30     C in the common varie must be passed with the value
31     C of iev you want to check. Do nothing if you don't want
32     C any output.
33     C
34     C------------------------------------------------
35     SUBROUTINE CALUNPACK(vecta,lung,me)
36     C------------------------------------------------
37    
38     IMPLICIT NONE
39     C
40     C Normal variables definition
41     C
42     INTEGER SOGLIA, SOGLIA0, START
43     PARAMETER (SOGLIA0=7)
44     PARAMETER (SOGLIA=27)
45     c PARAMETER (START=274)
46     PARAMETER (START=80)
47     integer lung, me, pro, m, dumpo
48     c
49     INTEGER NPLA, NCHA, LENSEV
50     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
51    
52     INTEGER merror(4),mi
53     C
54     INTEGER i, j, iev, min, st2c, bit, bi, lleng, salta
55     C
56     INTEGER*1 VECTA(lung)
57     INTEGER*2 vect(60000), test
58     C
59     integer*2 check, crc, e2(4)
60     C
61     INTEGER ic, k,l, ke, ic0, icsave(1000), chi(1000)
62     INTEGER status, contr, cstatus, co, nta, conte
63     INTEGER inf, sup, em, esci, icb
64     INTEGER XO, YO, XE, YE,iev2, icold
65    
66     INTEGER*2 length, length2
67    
68     INTEGER*2 st1, st2, cst1, st4
69    
70     integer st1b, st2b,p, lunga, pari
71    
72     integer icsez(4), mioic
73    
74     INTEGER*2 ival
75     PARAMETER (ival='FFFF'x)
76    
77     real dedx1(11,96),dedx2(11,96),dedx3(11,96),dedx4(11,96)
78     real dedx1c(11,96),dedx2c(11,96),dedx3c(11,96),dedx4c(11,96)
79     real base1(11,6),base2(11,6),base3(11,6),base4(11,6)
80     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
81    
82    
83     real auto(7)
84     real calselftrig(4,7), calIItrig(4), calstripshit(4),
85     & calDSPtaberr(4), calevnum(4)
86    
87     DATA XO/241/ ! CODE_EV_R XO = 111 10001
88     DATA YO/237/ ! CODE_EV_R YO = 111 01101
89     DATA XE/234/ ! CODE_EV_R XE = 111 01010
90     DATA YE/246/ ! CODE_EV_R YE = 111 10110
91    
92     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
93     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
94     REAL calpuls(4,11,96)
95     real perror(4)
96     integer stwerr(4)
97    
98     COMMON / evento / IEV, stwerr, perror,
99     & dexy,dexyc,base,
100     & calselftrig,calIItrig,
101     & calstripshit,calDSPtaberr,calevnum
102    
103     save / evento /
104    
105     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
106     & calbase,
107     & calvar,
108     & calpuls
109    
110     save / calib /
111    
112     c
113     COMMON / VARIE / dumpo, CONTR
114     SAVE / VARIE /
115    
116     C
117     C Begin !
118     C
119     if (dumpo.eq.0) dumpo=-1
120     if (iev.eq.dumpo) then
121     c do l=1,lung,2
122     c write(*,18)l,vecta(l),vecta(l+1)
123     c enddo
124     do l=1,lung
125     write(*,17)l,vecta(l)
126     enddo
127     endif
128     c
129     if (iev.lt.0.or.iev.gt.9000000) iev = 0
130     min = 0
131     lleng = 0
132     salta = 0
133     m = 0
134     pari = 0
135     IF (MOD(LUNG,2).EQ.0) THEN
136     lunga = lung / 2
137     pari = 1
138     else
139     lunga = int(lung/2) + 1
140     endif
141     c
142     if (lunga.gt.60000.and.dumpo.gt.0) then
143     print *,'Calorimeter WARNING: more than 60000 words!'
144     lunga = 60000
145     endif
146     c
147     call canctutto
148     call azero(dedx1,11*96)
149     call azero(dedx2,11*96)
150     call azero(dedx3,11*96)
151     call azero(dedx4,11*96)
152     call azero(dedx1c,11*96)
153     call azero(dedx2c,11*96)
154     call azero(dedx3c,11*96)
155     call azero(dedx4c,11*96)
156     call azero(base1,11*6)
157     call azero(base2,11*6)
158     call azero(base3,11*6)
159     call azero(base4,11*6)
160     C
161     do l = 1,4
162     e2(l) = 0
163     perror(l) = 0.
164     stwerr(l) = 0
165     merror(l) = 0
166     enddo
167     c
168     do l = 1,1000
169     icsave(l) = 0
170     chi(l) = 0
171     enddo
172     em = 0
173     co = 0
174     esci = 0
175     me = 1
176     c
177     contr = 1
178     c
179     ic = 1
180     icb = 0
181     nta = 0
182     c
183     CX length2 = ic - 2
184     length2 = start
185     c
186     if (length2.ge.-2) then
187     ic = ic + (2 * (length2 + 2))
188     else
189     if (dumpo.gt.0)
190     & print *,'Calorimeter WARNING: length errors ',ic,length2,nta
191     endif
192     c
193     contr=1
194     10 continue
195     C
196     if (ic.gt.(lung-1)) then
197     goto 105
198     endif
199     C
200     st1b = 0
201     st2b = 0
202     if ((ic+3).gt.lung) then
203     c if (co.eq.0) co = 1
204     c chi(co) = chi(co) + 8 * (5 - contr)
205     c merror(contr) = 130
206     c if (contr.ne.1) contr=5
207     goto 105
208     endif
209     do bit = 0, 7
210     bi = ibits(vecta(ic),bit,1)
211     if (bi.eq.1) st1b = ibset(st1b,bit)
212     bi = ibits(vecta(ic+1),bit,1)
213     if (bi.eq.1) st2b = ibset(st2b,bit)
214     enddo
215     c
216     C ST2 is the STATUS WORD
217     c
218     length2 = 0
219     do bit=0, 7
220     bi = ibits(vecta(ic+3),bit,1)
221     if (bi.eq.1) length2 = ibset(length2,bit)
222     bi = ibits(vecta(ic+2),bit,1)
223     if (bi.eq.1) length2 = ibset(length2,bit+8)
224     enddo
225     c the crc should be at vect(length) with
226     length = length2 + 1
227     C
228     c some checks to be sure we have found the calorimeter data:
229     c
230     c status word is always less then 129
231     c
232     if (st2b.gt.128) then
233     length = 0
234     goto 100
235     endif
236     c
237     c length of the packet must be less then 20000 if no errors
238     c are found
239     c
240     if (st2b.eq.0.and.length2.gt.lunga) then
241     length = 0
242     goto 100
243     endif
244     c
245     if (length2.le.0) then
246     length = 0
247     goto 100
248     endif
249     c
250     e2(contr) = 0
251     C
252     if (contr.eq.1) then
253     if (st1b.eq.YE) then
254     call riempi(ic,lunga,lleng,lung,pari,vect,vecta)
255     if (st2b.ne.0) then
256     E2(contr) = vect(icb)
257     else
258     e2(contr) = 0
259     endif
260     goto 20
261     else
262     ic = ic + 1
263     goto 10
264     endif
265     ENDIF
266     if (contr.eq.2) then
267     if (st1b.eq.YO) then
268     call riempi(ic,lunga,lleng,lung,pari,vect,vecta)
269     if (st2b.ne.0) then
270     E2(contr) = vect(icb)
271     else
272     e2(contr) = 0
273     endif
274     goto 20
275     else
276     ic = ic + 1
277     goto 10
278     endif
279     ENDIF
280     if (contr.eq.3) then
281     if (st1b.eq.XE) then
282     call riempi(ic,lunga,lleng,lung,pari,vect,vecta)
283     if (st2b.ne.0) then
284     E2(contr) = vect(icb)
285     else
286     e2(contr) = 0
287     endif
288     goto 20
289     else
290     ic = ic + 1
291     goto 10
292     endif
293     ENDIF
294     if (contr.eq.4) then
295     if (st1b.eq.XO) then
296     call riempi(ic,lunga,lleng,lung,pari,vect,vecta)
297     if (st2b.ne.0) then
298     E2(contr) = vect(icb)
299     else
300     e2(contr) = 0
301     endif
302     goto 20
303     else
304     ic = ic + 1
305     goto 10
306     endif
307     ENDIF
308     100 continue
309     ic = ic + 1
310     goto 10
311     20 continue
312     C
313     c format not used
314     c
315     c 10 FORMAT(2X,'Error for view:',2X,I1,2X,'Status word:',2X,Z4)
316     11 FORMAT(2X,'View or command not recognized for view:',2X,I1,2X,
317     & 'Status word:',2X,Z4)
318     12 FORMAT(2X,'Error - did NOT find view:',2X,I1)
319     13 FORMAT(2X,'Error - eof reached, exiting')
320     14 FORMAT(2X,I8,2X,I10)
321     15 FORMAT(2X,I8,2X,Z8)
322     17 FORMAT(2X,'Elemento:',2X,I6,2X,' word:',2X,Z8)
323     18 FORMAT(2X,'Elemento:',2X,I6,2X,' word:',2X,Z2,Z2)
324     21 FORMAT(2X,'CRC: ',2X,Z8)
325     C
326     c go on recording data
327     mioic = ic
328     ic = ic - 1
329     c
330     K = CONTR
331     ic0 = icb
332     icb = icb + 1
333     length = vect(icb) + 2
334     length2 = vect(icb)
335     lleng = (length*2) - 1
336     C
337     C Check consistency of CRC.
338     C
339     check = 0
340     inf = ic0
341     sup = length - 1
342     do i = inf,sup
343     check=crc(check,vect(i))
344     enddo
345    
346     if (iev.eq.dumpo) write(*,21)vect(length)
347     if (iev.eq.dumpo) write(*,21)check
348     c
349     if (check.eq.vect(length).and.ibits(e2(contr),0,1).eq.0) then
350     icsez(contr)=mioic
351     contr = contr + 1
352     else
353     ic = ic + 1
354     endif
355     if (contr.lt.5) goto 10
356     105 continue
357     if (contr.eq.4) then
358     lleng = 0
359     do mi=1, 4
360     ic = icsez(mi)
361     call riempi(ic,lunga,lleng,lung,pari,vect,vecta)
362     ic = ic - 1
363     c
364     K = CONTR
365     ic0 = icb
366     icb = icb + 1
367     length = vect(icb) + 2
368     length2 = vect(icb)
369     lleng = (length*2) - 1
370     C
371     C Check consistency of CRC.
372     C
373     check = 0
374     inf = ic0
375     sup = length - 1
376     do i = 1, 7
377     icb = icb + 1
378     auto(i) = vect(icb)
379     enddo
380     C
381     st2c = 0
382     if (st2b.ne.0) then
383     do bit=0, 6
384     bi = ibits(st2b,bit,1)
385     if (bit.eq.3.and.bi.ne.0) st2c = 8
386     enddo
387     endif
388     C
389     if (st2c.eq.8) then
390     if (length2.ne.1064) then
391     merror(contr) = 133
392     chi(co) = chi(co) + 4
393     lleng = 0
394     goto 150
395     else
396     if (k.eq.1) then
397     call azero(dedx1,11*96)
398     call azero(dedx2,11*96)
399     call azero(dedx3,11*96)
400     call azero(dedx4,11*96)
401     call azero(dedx1c,11*96)
402     call azero(dedx2c,11*96)
403     call azero(dedx3c,11*96)
404     call azero(dedx4c,11*96)
405     call azero(base1,11*6)
406     call azero(base2,11*6)
407     call azero(base3,11*6)
408     call azero(base4,11*6)
409     call CALRAW(vect,icb+1,length-1,dedx1)
410     endif
411     if (k.eq.2) call CALRAW(vect,icb+1,length-1,dedx2)
412     if (k.eq.3) call CALRAW(vect,icb+1,length-1,dedx3)
413     if (k.eq.4) call CALRAW(vect,icb+1,length-1,dedx4)
414     endif
415     goto 50
416     endif
417     C
418     41 FORMAT(2X,I2,2X,'word :',1x,z4)
419     test = vect(icb+3)
420     c
421     if (test.eq.ival) then
422     if (length2.gt.1201) then
423     merror(contr) = 134
424     chi(co) = chi(co) + 4
425     lleng = 0
426     goto 150
427     else
428     icb = icb + 1
429     calIItrig(k) = vect(icb)
430     icb = icb + 1
431     calstripshit(k) = vect(icb)
432     icb = icb + 1
433     C qui c'e` test!
434     icb = icb + 1
435     calDSPtaberr(k) = vect(icb)
436     icb = icb + 1
437     calevnum(k) = vect(icb)
438     merror(contr) = 137
439     if (k.eq.1) then
440     call azero(dedx1,11*96)
441     call azero(dedx2,11*96)
442     call azero(dedx3,11*96)
443     call azero(dedx4,11*96)
444     call azero(dedx1c,11*96)
445     call azero(dedx2c,11*96)
446     call azero(dedx3c,11*96)
447     call azero(dedx4c,11*96)
448     call azero(base1,11*6)
449     call azero(base2,11*6)
450     call azero(base3,11*6)
451     call azero(base4,11*6)
452     call CALCOMPRESS(vect,icb+1,length-1,dedx1c,
453     & base1)
454     endif
455     if (k.eq.2) call CALCOMPRESS(vect,icb+1,length-1,dedx2c,
456     & base2)
457     if (k.eq.3) call CALCOMPRESS(vect,icb+1,length-1,dedx3c,
458     & base3)
459     if (k.eq.4) call CALCOMPRESS(vect,icb+1,length-1,dedx4c,
460     & base4)
461     goto 50
462     endif
463     else if (test.eq.0) then
464     if (length2.gt.2257) then
465     merror(contr) = 135
466     chi(co) = chi(co) + 4
467     lleng = 0
468     goto 150
469     else
470     icb = icb + 1
471     calIItrig(k) = vect(icb)
472     icb = icb + 1
473     calstripshit(k) = vect(icb)
474     icb = icb + 1
475     C qui c'e` test
476     icb = icb + 1
477     calDSPtaberr(k) = vect(icb)
478     icb = icb + 1
479     calevnum(k) = vect(icb)
480     merror(contr) = 138
481     if (k.eq.1) then
482     call azero(dedx1,11*96)
483     call azero(dedx2,11*96)
484     call azero(dedx3,11*96)
485     call azero(dedx4,11*96)
486     call azero(dedx1c,11*96)
487     call azero(dedx2c,11*96)
488     call azero(dedx3c,11*96)
489     call azero(dedx4c,11*96)
490     call azero(base1,11*6)
491     call azero(base2,11*6)
492     call azero(base3,11*6)
493     call azero(base4,11*6)
494     call CALFULL(vect,icb+1,length-1,dedx1,
495     & dedx1c,base1)
496     endif
497     if (k.eq.2) call CALFULL(vect,icb+1,length-1,dedx2,
498     & dedx2c,base2)
499     if (k.eq.3) call CALFULL(vect,icb+1,length-1,dedx3,
500     & dedx3c,base3)
501     if (k.eq.4) call CALFULL(vect,icb+1,length-1,dedx4,
502     & dedx4c,base4)
503     goto 50
504     endif
505     else
506     merror(contr) = 136
507     chi(co) = chi(co) + 4
508     lleng = 0
509     goto 150
510     endif
511     c
512     50 continue
513     c
514     C
515     do i = 1,7
516     calselftrig(k,i) = auto(i)
517     enddo
518     C
519     DO I = 1,11
520     DO J = 1,96
521     DEXY(2,2*I-1,97-J) = DEDX3(I,J)
522     DEXY(1,2*I-1,J) = DEDX2(I,J)
523     DEXY(2,2*I,J) = DEDX4(I,J)
524     DEXY(1,2*I,J) = DEDX1(I,J)
525     DEXYC(2,2*I-1,97-J) = DEDX3C(I,J)
526     DEXYC(1,2*I-1,J) = DEDX2C(I,J)
527     DEXYC(2,2*I,J) = DEDX4C(I,J)
528     DEXYC(1,2*I,J) = DEDX1C(I,J)
529     enddo
530     do j = 1,6
531     base(2,2*i-1,7-j) = base3(i,j)
532     base(1,2*i-1,j) = base2(i,j)
533     base(2,2*i,j) = base4(i,j)
534     base(1,2*i,j) = base1(i,j)
535     enddo
536     enddo
537     C
538     enddo
539     else
540     c soncazzi
541     endif
542     C
543     150 continue
544     C
545     c
546     do l = 1, 4
547     do bit=0, 31
548     if (bit.lt.16) then
549     bi = ibits(E2(L),bit,1)
550     else
551     bi = 0
552     endif
553     if (bi.eq.1) then
554     stwerr(l) = ibset(stwerr(l),bit)
555     else
556     stwerr(l) = ibclr(stwerr(l),bit)
557     endif
558     enddo
559     perror(l) = float(merror(l))
560     enddo
561     c
562     iev = iev + 1
563     RETURN
564     END
565    
566    
567     C------------------------------------------------
568     SUBROUTINE CALRAW(vect,inf,sup,dedx)
569     C------------------------------------------------
570    
571     IMPLICIT NONE
572    
573     INTEGER*2 VECT(30000)
574     INTEGER inf, sup
575     INTEGER i,j,k, iev,iev2
576    
577     C
578     INTEGER NPLA, NCHA, LENSEV
579     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
580     INTEGER merror(4)
581     integer*2 e2(4)
582     INTEGER contr
583     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
584    
585    
586     real calselftrig(4,7), calIItrig(4), calstripshit(4),
587     & calDSPtaberr(4), calevnum(4)
588    
589    
590     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
591     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
592     REAL calpuls(4,11,96)
593     REAL dedx(11,96)
594     real perror(4)
595     integer stwerr(4), dumpo
596    
597     COMMON / evento / IEV, stwerr, perror,
598     & dexy,dexyc,base,
599     & calselftrig,calIItrig,
600     & calstripshit,calDSPtaberr,calevnum
601    
602     save / evento /
603    
604     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
605     & calbase,
606     & calvar,
607     & calpuls
608    
609     save / calib /
610     c
611     COMMON / VARIE / dumpo, CONTR
612     SAVE / VARIE /
613    
614     C
615     DO I = 1,11
616     DO J = 1,96
617     DEDX(I,J) = 0.
618     ENDDO
619     ENDDO
620     C
621     k = inf
622     do j = 1,96
623     do i = 1,11
624     dedx(i,j) = vect(k)
625     k = k + 1
626     enddo
627     enddo
628     c
629     RETURN
630     END
631    
632     C------------------------------------------------
633     SUBROUTINE CALCOMPRESS(vect,inf,sup,dedx,basse)
634     C------------------------------------------------
635    
636     IMPLICIT NONE
637    
638     INTEGER*2 VECT(30000) , st3
639     C
640     INTEGER inf, sup
641     INTEGER i,j, iev,iev2,h
642     INTEGER*2 st, st1, st2
643     C
644     INTEGER ib
645     INTEGER ipl, ipr, ist
646     C
647     C
648     INTEGER NPLA, NCHA, LENSEV
649     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
650     INTEGER merror(4)
651     integer*2 e2(4)
652     INTEGER contr
653     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
654    
655    
656     real calselftrig(4,7), calIItrig(4), calstripshit(4),
657     & calDSPtaberr(4), calevnum(4)
658    
659    
660     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
661     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
662     REAL calpuls(4,11,96)
663     REAL dedx(11,96), basse(11,6)
664     real perror(4)
665     integer stwerr(4),dumpo
666     C
667     COMMON / evento / IEV, stwerr,perror,
668     & dexy,dexyc,base,
669     & calselftrig,calIItrig,
670     & calstripshit,calDSPtaberr,calevnum
671    
672     save / evento /
673    
674     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
675     & calbase,
676     & calvar,
677     & calpuls
678    
679     save / calib /
680     c
681     COMMON / VARIE / dumpo, CONTR
682     SAVE / VARIE /
683    
684     C
685     DO I = 1,11
686     DO J = 1,96
687     DEDX(I,J) = 0.
688     ENDDO
689     do j = 1,6
690     basse(i,j) = 0.
691     enddo
692     ENDDO
693     C
694     i = inf
695     c
696     10 continue
697     if (i.gt.sup) then
698     RETURN
699     endif
700     C
701     40 format(2x,i5,2x,'status :',1x,Z4)
702     C
703     c
704     st1 = 0
705     st1 = IAND(vect(i),'0800'x)
706     st1 = ISHFT(st1,-11)
707     cc 41 format(2x,'st1 = ',Z8)
708     cc 42 format(2x,'st2 = ',Z8)
709     43 format(2x,'vect(i) = ',Z8)
710     cc 44 format(2x,'vect(i) dopo = ',Z8)
711     cc 45 format(2x,'vect(i) ib = 1 : ',Z8)
712     cc 46 format(2x,'vect(i) < 0 : ',Z8)
713     if (st1.eq.1) then
714     ib = 1
715     else
716     st2 = IAND(vect(i),'1000'x)
717     st2 = ISHFT(st2,-12)
718     if (st2.eq.1) then
719     ib = 0
720     else
721     if (iev.eq.dumpo) then
722     print *,'i ',i
723     write(*,43)vect(i)
724     endif
725     merror(contr) = 139
726     RETURN
727     endif
728     endif
729     C
730     if (ib.eq.1) then
731     C
732     st = IAND(vect(i),'00FF'x)
733     c
734     ipl = int(st/6) + 1
735     ipr = st - (ipl - 1) * 6 + 1
736     i = i + 1
737     if (i.gt.sup) RETURN
738     basse(ipl,ipr) = vect(i)
739     c
740     20 continue
741     if (i.gt.sup) RETURN
742     C
743     i = i + 1
744     if (i.gt.sup) RETURN
745     if ((vect(i)+1).gt.16.or.(vect(i)+1).lt.1) then
746     goto 10
747     endif
748     ist = vect(i) + 1 + 16 * (ipr - 1)
749     i = i + 1
750     if (i.gt.sup) RETURN
751     dedx(ipl,ist) = vect(i)
752     goto 20
753     else
754     C
755     st = IAND(vect(i),'00FF'x)
756     ipl = int(st/6) + 1
757     ipr = st - (ipl - 1) * 6 + 1
758     do j = 1,16
759     i = i + 1
760     if (i.gt.sup) RETURN
761     ist = j + 16 * (ipr - 1)
762     dedx(ipl,ist) = vect(i)
763     enddo
764     i = i + 1
765     if (i.gt.sup) RETURN
766     goto 10
767     C
768     endif
769    
770    
771     RETURN
772     END
773    
774    
775     C----------------------------------------------------------
776     SUBROUTINE CALFULL(vect,inf,sup,dedx,dedxc,basse)
777     C--------------------------------------------------------------
778    
779     IMPLICIT NONE
780    
781     INTEGER*2 VECT(30000)
782     C
783     INTEGER inf, sup
784     INTEGER i,j,k, iev,iev2
785     C
786     INTEGER NPLA, NCHA, LENSEV
787     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
788     INTEGER merror(4)
789     integer*2 e2(4)
790     INTEGER contr
791     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
792    
793    
794     real calselftrig(4,7), calIItrig(4), calstripshit(4),
795     & calDSPtaberr(4), calevnum(4)
796    
797    
798     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
799     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
800     REAL calpuls(4,11,96)
801     REAL dedx(11,96), basse(11,6), dedxc(11,96)
802     real perror(4)
803     integer stwerr(4),dumpo
804    
805     COMMON / evento / IEV, stwerr,perror,
806     & dexy,dexyc,base,
807     & calselftrig,calIItrig,
808     & calstripshit,calDSPtaberr,calevnum
809    
810     save / evento /
811    
812     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
813     & calbase,
814     & calvar,
815     & calpuls
816    
817     save / calib /
818    
819     c
820     COMMON / VARIE / dumpo, CONTR
821     SAVE / VARIE /
822    
823     C
824     C
825     C
826     DO I = 1,11
827     DO J = 1,96
828     DEDX(I,J) = 0.
829     ENDDO
830     ENDDO
831     C
832     k = inf
833     do i = 1,11
834     do j = 1,96
835     dedx(i,j) = vect(k)
836     k = k + 1
837     enddo
838     enddo
839     C
840     call CALCOMPRESS(vect,k,sup,dedxc,basse)
841     C
842     10 FORMAT(2X,'Status word:',2X,Z8)
843    
844     RETURN
845     END
846    
847    
848     C------------------------------------------------
849     SUBROUTINE CONTAER(ve,er)
850     C------------------------------------------------
851    
852     IMPLICIT NONE
853    
854     INTEGER*2 VE, st4
855     C
856     INTEGER*2 VECT(30000)
857     C
858     INTEGER er, l, bit, bi, iev,iev2
859     C
860     INTEGER NPLA, NCHA, LENSEV
861     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
862     INTEGER merror(4)
863     integer*2 e2(4)
864     INTEGER contr
865     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
866    
867    
868     real calselftrig(4,7), calIItrig(4), calstripshit(4),
869     & calDSPtaberr(4), calevnum(4)
870    
871    
872     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
873     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
874     REAL calpuls(4,11,96)
875     real perror(4)
876     integer stwerr(4),dumpo
877    
878     COMMON / evento / IEV, stwerr,perror,
879     & dexy,dexyc,base,
880     & calselftrig,calIItrig,
881     & calstripshit,calDSPtaberr,calevnum
882    
883     save / evento /
884    
885     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
886     & calbase,
887     & calvar,
888     & calpuls
889    
890     save / calib /
891    
892     COMMON / VARIE / dumpo, CONTR
893     SAVE / VARIE /
894    
895    
896     st4 = 0
897     st4 = IAND(ve,'00FF'x)
898     if (st4.ne.0) then
899     do bit=0, 6
900     bi = ibits(st4,bit,1)
901     if (bi.ne.0) then
902     er = er + 1
903     endif
904     enddo
905     endif
906    
907     10 FORMAT(2X,'Status word:',2X,Z4)
908     return
909     end
910    
911    
912     C------------------------------------------------
913     SUBROUTINE MINERR(ic,icsave,chi,min,co)
914     C------------------------------------------------
915    
916     IMPLICIT NONE
917     C
918     INTEGER ic, icsave(1000), chi(1000)
919     integer l, st, min,co
920     INTEGER*2 VECT(30000)
921     C
922     INTEGER iev,iev2
923     C
924     INTEGER NPLA, NCHA, LENSEV
925     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
926     INTEGER merror(4)
927     integer*2 e2(4)
928     INTEGER contr
929     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
930    
931    
932     real calselftrig(4,7), calIItrig(4), calstripshit(4),
933     & calDSPtaberr(4), calevnum(4)
934    
935    
936     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
937     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
938     REAL calpuls(4,11,96)
939     real perror(4)
940     integer stwerr(4),dumpo
941    
942     COMMON / evento / IEV, stwerr,perror,
943     & dexy,dexyc,base,
944     & calselftrig,calIItrig,
945     & calstripshit,calDSPtaberr,calevnum
946    
947     save / evento /
948    
949     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
950     & calbase,
951     & calvar,
952     & calpuls
953    
954     save / calib /
955     c
956     COMMON / VARIE / dumpo, CONTR
957     SAVE / VARIE /
958    
959     st = chi(1)
960     min = 1
961     if (co.gt.1) then
962     do l = 2, co
963     if (chi(l).lt.st) then
964     st = chi(l)
965     min = l
966     endif
967     enddo
968     endif
969     ic = icsave(min)
970    
971     return
972     end
973    
974     C-----------------------------------------------------
975     SUBROUTINE CANCTUTTO
976     C-----------------------------------------------------
977    
978     IMPLICIT NONE
979     C
980     INTEGER iev,iev2
981     C
982     INTEGER NPLA, NCHA, LENSEV
983     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
984     INTEGER merror(4)
985     integer*2 e2(4)
986     INTEGER contr
987     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
988    
989    
990     real calselftrig(4,7), calIItrig(4), calstripshit(4),
991     & calDSPtaberr(4), calevnum(4)
992    
993    
994     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
995     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
996     REAL calpuls(4,11,96)
997     real perror(4)
998     integer stwerr(4),dumpo
999    
1000     COMMON / evento / IEV, stwerr,perror,
1001     & dexy,dexyc,base,
1002     & calselftrig,calIItrig,
1003     & calstripshit,calDSPtaberr,calevnum
1004    
1005     save / evento /
1006    
1007     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
1008     & calbase,
1009     & calvar,
1010     & calpuls
1011    
1012     save / calib /
1013     c
1014     COMMON / VARIE / dumpo, CONTR
1015     SAVE / VARIE /
1016     C
1017     call azero(calped,4*11*96)
1018     call azero(calgood,4*11*96)
1019     call azero(calthr,4*11*96)
1020     call azero(calrms,4*11*96)
1021     call azero(calbase,4*11*6)
1022     call azero(calvar,4*11*6)
1023     call azero(calpuls,4*11*96)
1024     call azero(dexy,4*11*96)
1025     call azero(dexyc,4*11*96)
1026     call azero(base,4*11*6)
1027     call azero(calselftrig,4*7)
1028     call azero(calIItrig,4)
1029     call azero(calstripshit,4)
1030     call azero(calDSPtaberr,4)
1031     call azero(calevnum,4)
1032     c
1033     return
1034     end

  ViewVC Help
Powered by ViewVC 1.1.23