/[PAMELA software]/yoda/techmodel/forroutines/calorimeter/calunpack.for
ViewVC logotype

Annotation of /yoda/techmodel/forroutines/calorimeter/calunpack.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations) (download)
Tue Jul 6 14:07:30 2004 UTC (20 years, 5 months ago) by kusanagi
Branch: MAIN
Changes since 1.2: +926 -381 lines
*** empty log message ***

1 kusanagi 1.3
2     C------------------------------------------------
3     SUBROUTINE CALUNPACK(vect,lung,me)
4     c SUBROUTINE CALUNPACK(vect,dexy,dexyc,base,
5     c & calselftrig,calIItrig,
6     c & calstripshit,calDSPtaberr,calevnum,
7     c & merror,contr,e2)
8     C------------------------------------------------
9    
10     IMPLICIT NONE
11     C
12     C Normal variables definition
13     C
14     INTEGER SOGLIA
15     PARAMETER (SOGLIA=27)
16     c PARAMETER (SOGLIA=30)
17     integer lung, me
18     c
19     INTEGER NPLA, NCHA, LENSEV
20     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
21    
22     INTEGER merror(4)
23     C
24     INTEGER i, j, iev, min
25     C
26     INTEGER*2 VECT(20000)
27     C
28     integer*2 check, crc, e2(4)
29     C
30     INTEGER ic, k,l, ke, ic0, icsave(1000), chi(1000)
31     INTEGER status, contr, cstatus, co, nta, conte
32     INTEGER inf, sup, em, esci
33     INTEGER XO, YO, XE, YE, iev2
34    
35     INTEGER*2 length, length2
36    
37     INTEGER*2 st1, st2, cst1
38    
39     INTEGER*2 ival
40     PARAMETER (ival='FFFF'x)
41    
42     real dedx1(11,96),dedx2(11,96),dedx3(11,96),dedx4(11,96)
43     real dedx1c(11,96),dedx2c(11,96),dedx3c(11,96),dedx4c(11,96)
44     real base1(11,6),base2(11,6),base3(11,6),base4(11,6)
45     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,ncha)
46    
47    
48     real auto(7)
49     real calselftrig(4,7), calIItrig(4), calstripshit(4),
50     & calDSPtaberr(4), calevnum(4)
51    
52     DATA XO/241/ ! CODE_EV_R XO = 111 10001
53     DATA YO/237/ ! CODE_EV_R YO = 111 01101
54     DATA XE/234/ ! CODE_EV_R XE = 111 01010
55     DATA YE/246/ ! CODE_EV_R YE = 111 10110
56    
57     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
58     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
59     REAL calpuls(4,11,96)
60    
61     COMMON / evento / IEV,
62     & dexy,dexyc,base,
63     & calselftrig,calIItrig,
64     & calstripshit,calDSPtaberr,calevnum
65    
66     save / evento /
67    
68     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
69     & calbase,
70     & calvar,
71     & calpuls
72    
73     save / calib /
74    
75     c
76     COMMON / VARIE / merror, CONTR, E2
77     SAVE / VARIE /
78    
79     C
80     C Begin !
81     C
82     do l = 1,1000
83     icsave(l) = 0
84     chi(l) = 0
85     enddo
86     em = 0
87     co = 0
88     esci = 0
89     me = 1
90     c
91     contr = 1
92     c
93     ic = 0
94     nta = 0
95     c
96     length = ic
97     c
98     20 continue
99     nta = nta + 1
100     ic = ic + length + 1
101     c
102     ke = 0
103     do while (ke.eq.0)
104     C
105     C Check consistency of header.
106     C it is composed by CODE+D# (8 bits) and by SATUS WORD (8 bits)
107     c so we must split vect into the two components:
108     C
109     C ST1 is CODE + D#
110     status = ISHFT(vect(ic),-8)
111     st1 = IAND(status,'00FF'x)
112     c st1 = IAND(status,'0800'x)
113     c print *,ic,st1
114     C ST2 is the STATUS WORD
115     st2 = IAND(vect(ic),'00FF'x)
116     length2 = vect(ic+1)
117     c the crc should be at vect(length) with
118     length = ic + vect(ic+1) + 13
119     C
120     c some checks to be sure we have found the calorimeter data:
121     c
122     c status word is always less then 129
123     c
124     if (st2.gt.128) goto 100
125     c
126     c length of the packet must be less then 20000 if no errors
127     c are found
128     c
129     if (st2.eq.0.and.length2.gt.20000) goto 100
130     c
131     e2(contr) = 0
132     C
133     if (contr.eq.1) then
134     c
135     c is it the first section?
136     c
137     if (st1.eq.YE) then
138     c if so go out of this loop and go on recording data
139     ke = 1
140     if (em.eq.0) then
141     em = 1
142     co = co + 1
143     icsave(co) = ic
144     endif
145     if (st2.ne.0) then
146     E2(contr) = vect(ic)
147     call contaer(e2(contr),chi(co))
148     endif
149     else
150     c if not, is it one of the next sections? did we miss a section?
151     if (st1.eq.YO.or.st1.eq.XE.or.st1.eq.XO) THEN
152     c if so, record an error and go back analizing this section
153     merror(contr) = 129
154     contr = 2
155     length = -1
156     if (em.eq.0) then
157     em = 1
158     co = co + 1
159     icsave(co) = ic
160     endif
161     chi(co) = chi(co) + 8
162     goto 20
163     ELSE
164     c if it is not the case, go on with the next value of vect
165     GOTO 100
166     endif
167     endif
168     ENDIF
169     C
170     c the same for the second section, ...
171     c
172     if (CONTR.eq.2) then
173     if (st1.eq.YO) then
174     ke = 1
175     if (em.eq.0) then
176     em = 1
177     co = co + 1
178     icsave(co) = ic
179     endif
180     if (st2.ne.0) then
181     E2(contr) = vect(ic)
182     call contaer(e2(contr),chi(co))
183     endif
184     else
185     if (st1.eq.XE.or.st1.eq.XO) then
186     merror(contr) = 129
187     contr = 3
188     length = -1
189     if (em.eq.0) then
190     em = 1
191     co = co + 1
192     icsave(co) = ic
193     endif
194     chi(co) = chi(co) + 8
195     goto 20
196     ELSE
197     GOTO 100
198     endif
199     endif
200     ENDIF
201     c
202     C ... for the third,...
203     c
204     if (CONTR.eq.3) then
205     if (st1.eq.XE) then
206     ke = 1
207     if (em.eq.0) then
208     em = 1
209     co = co + 1
210     icsave(co) = ic
211     endif
212     if (st2.ne.0) then
213     E2(contr) = vect(ic)
214     call contaer(e2(contr),chi(co))
215     endif
216     else
217     if (st1.eq.XO) then
218     merror(contr) = 129
219     contr = 4
220     length = -1
221     if (em.eq.0) then
222     em = 1
223     co = co + 1
224     icsave(co) = ic
225     endif
226     chi(co) = chi(co) + 8
227     goto 20
228     ELSE
229     GOTO 100
230     endif
231     endif
232     ENDIF
233     C
234     c ...and for the last section.
235     c
236     if (CONTR.eq.4) then
237     if (st1.eq.XO) then
238     ke = 1
239     if (em.eq.0) then
240     em = 1
241     co = co + 1
242     icsave(co) = ic
243     endif
244     if (st2.ne.0) then
245     E2(contr) = vect(ic)
246     call contaer(e2(contr),chi(co))
247     endif
248     else
249     c we should never arrive here (in case we run out of vector if section
250     c four is missing!)... however here it is in case of bugs!
251     merror(contr) = 129
252     contr = 5
253     if (em.eq.0) then
254     em = 1
255     co = co + 1
256     icsave(co) = ic
257     endif
258     chi(co) = chi(co) + 8
259     GOTO 200
260     endif
261     endif
262     C
263     100 CONTINUE
264     c
265     c increment vector of one searching for the next section
266     c
267     ic = ic + 1
268     c
269     c if we run out of vector give an error and exit the subroutine
270     c
271     if (ic.gt.19999) then
272     chi(co) = chi(co) + 8 * (5 - contr)
273     merror(contr) = 130
274     if (contr.ne.1) contr=5
275     if (em.eq.0) then
276     em = 1
277     co = co + 1
278     icsave(co) = ic
279     endif
280     goto 200
281     endif
282     enddo
283     C
284     c format not used
285     c
286     10 FORMAT(2X,'Error for view:',2X,I1,2X,'Status word:',2X,Z4)
287     11 FORMAT(2X,'View or command not recognized for view:',2X,I1,2X,
288     & 'Status word:',2X,Z4)
289     12 FORMAT(2X,'Error - did NOT find view:',2X,I1)
290     13 FORMAT(2X,'Error - eof reached, exiting')
291     14 FORMAT(2X,I8,2X,I10)
292     C
293     c go on recording data
294     c
295     K = CONTR
296     ic0 = ic - 1
297     length = ic0 + vect(ic) + 13
298     length2 = vect(ic)
299     C
300     C Check consistency of CRC.
301     C
302     check = 0.
303     inf = ic0
304     sup = length - 1
305     do i = inf,sup
306     check=crc(check,vect(i))
307     enddo
308     if (check.ne.vect(length)) then
309     merror(contr) = 132
310     chi(co) = chi(co) + 4
311     goto 150
312     endif
313     C
314     C Process data.
315     C
316     do i = 1,7
317     ic = ic + 1
318     auto(i) = vect(ic)
319     enddo
320     C
321     if (st2.eq.8) then
322     if (length2.ne.1064) then
323     c print *,'Problems with view:',k,' in Raw mode length:',
324     c & length2
325     merror(contr) = 133
326     chi(co) = chi(co) + 4
327     goto 150
328     else
329     if (k.eq.1) call CALRAW(vect,ic+1,length-1,dedx1)
330     if (k.eq.2) call CALRAW(vect,ic+1,length-1,dedx2)
331     if (k.eq.3) call CALRAW(vect,ic+1,length-1,dedx3)
332     if (k.eq.4) call CALRAW(vect,ic+1,length-1,dedx4)
333     endif
334     goto 150
335     endif
336     C
337     41 FORMAT(2X,I2,2X,'word :',1x,z4)
338     ic = ic + 1
339     if (vect(ic).eq.0) then
340     if (length2.gt.1201) then
341     c print *,'Problems with view:',k,
342     c & ' in Compress mode length:',length2
343     merror(contr) = 134
344     chi(co) = chi(co) + 4
345     goto 150
346     else
347     ic = ic + 1
348     calIItrig(k) = vect(ic)
349     ic = ic + 1
350     calstripshit(k) = vect(ic)
351     ic = ic + 1
352     ic = ic + 1
353     calDSPtaberr(k) = vect(ic)
354     ic = ic + 1
355     calevnum(k) = vect(ic)
356     if (k.eq.1) call CALCOMPRESS(vect,ic+1,length-1,dedx1,
357     & base1)
358     if (k.eq.2) call CALCOMPRESS(vect,ic+1,length-1,dedx2,
359     & base2)
360     if (k.eq.3) call CALCOMPRESS(vect,ic+1,length-1,dedx3,
361     & base3)
362     if (k.eq.4) call CALCOMPRESS(vect,ic+1,length-1,dedx4,
363     & base4)
364     endif
365     else if (vect(ic).eq.ival) then
366     if (length2.gt.2257) then
367     c print *,'Problems with view:',k,' in Full mode length:',
368     c & length2
369     merror(contr) = 135
370     chi(co) = chi(co) + 4
371     goto 150
372     else
373     c write(*,41) ic,vect(ic)
374     ic = ic + 1
375     calIItrig(k) = vect(ic)
376     ic = ic + 1
377     calstripshit(k) = vect(ic)
378     ic = ic + 1
379     ic = ic + 1
380     calDSPtaberr(k) = vect(ic)
381     ic = ic + 1
382     calevnum(k) = vect(ic)
383     c print *,'ic :',ic
384     if (k.eq.1) call CALFULL(vect,ic+1,length-1,dedx1,
385     & dedx1c,base1)
386     if (k.eq.2) call CALFULL(vect,ic+1,length-1,dedx2,
387     & dedx2c,base2)
388     if (k.eq.3) call CALFULL(vect,ic+1,length-1,dedx3,
389     & dedx3c,base3)
390     if (k.eq.4) call CALFULL(vect,ic+1,length-1,dedx4,
391     & dedx4c,base4)
392     endif
393     else
394     c print *,'Acq mode problems with view:',k
395     merror(contr) = 136
396     chi(co) = chi(co) + 4
397     goto 50
398     endif
399     C
400     do i = 1,7
401     calselftrig(k,i) = auto(i)
402     enddo
403     c
404     50 continue
405     c
406     C
407     DO I = 1,11
408     DO J = 1,96
409     DEXY(2,2*I-1,97-J) = DEDX1(I,J)
410     DEXY(1,2*I-1,J) = DEDX2(I,J)
411     DEXY(2,2*I,J) = DEDX3(I,J)
412     DEXY(1,2*I,J) = DEDX4(I,J)
413     DEXYC(2,2*I-1,97-J) = DEDX1C(I,J)
414     DEXYC(1,2*I-1,J) = DEDX2C(I,J)
415     DEXYC(2,2*I,J) = DEDX3C(I,J)
416     DEXYC(1,2*I,J) = DEDX4C(I,J)
417     enddo
418     do j = 1,6
419     base(2,2*i-1,7-j) = base1(i,j)
420     base(1,2*i-1,j) = base2(i,j)
421     base(2,2*i,j) = base3(i,j)
422     base(1,2*i,j) = base4(i,j)
423     enddo
424     enddo
425     C
426     150 continue
427     C
428     contr = contr + 1
429     C
430     c go on till we have found all the four sections
431     c
432     if (contr.ne.5) goto 20
433     c
434     c
435     c
436     200 continue
437     C
438     C if all section are missing clear vectors and go out
439     C
440     if (merror(1).eq.129.and.merror(2).eq.129
441     & .and.merror(3).eq.129.and.merror(4).eq.130) then
442     do l = 1,4
443     e2(l) = 0
444     enddo
445     do l = 1,4
446     merror(l) = 0
447     enddo
448     call vzero(calped,4*11*96)
449     call vzero(calgood,4*11*96)
450     call vzero(calthr,4*11*96)
451     call vzero(calrms,4*11*96)
452     call vzero(calbase,4*11*6)
453     call vzero(calvar,4*11*6)
454     call vzero(calpuls,4*11*96)
455     call vzero(dexy,4*11*96)
456     call vzero(dexyc,4*11*96)
457     call vzero(base,4*11*96)
458     call vzero(calselftrig,4*7)
459     call vzero(calIItrig,4)
460     call vzero(calstripshit,4)
461     call vzero(calDSPtaberr,4)
462     call vzero(calevnum,4)
463     contr=1
464     if (esci.eq.0) then
465     call minerr(ic,icsave,chi,min,co)
466     length = 0
467     goto 20
468     endif
469     endif
470     c
471    
472     if (esci.eq.0.and.((co.gt.1.and.icsave(co).eq.icsave(co-1)).or.
473     & co.eq.1000.or.icsave(co).gt.20000.or.nta.gt.1000)) then
474     esci = 1
475     min = 0
476     call minerr(ic,icsave,chi,min,co)
477     call vzero(calped,4*11*96)
478     call vzero(calgood,4*11*96)
479     call vzero(calthr,4*11*96)
480     call vzero(calrms,4*11*96)
481     call vzero(calbase,4*11*6)
482     call vzero(calvar,4*11*6)
483     call vzero(calpuls,4*11*96)
484     call vzero(dexy,4*11*96)
485     call vzero(dexyc,4*11*96)
486     call vzero(base,4*11*96)
487     call vzero(calselftrig,4*7)
488     call vzero(calIItrig,4)
489     call vzero(calstripshit,4)
490     call vzero(calDSPtaberr,4)
491     call vzero(calevnum,4)
492     contr = 1
493     if (chi(min).lt.SOGLIA) then
494     length = 0
495     me = 0
496     goto 20
497     else
498     do l = 1,4
499     e2(l) = 0
500     enddo
501     do l = 1,4
502     merror(l) = 0
503     enddo
504     me = 1
505     goto 999
506     endif
507     endif
508     c
509     if (esci.eq.0) then
510     call vzero(calped,4*11*96)
511     call vzero(calgood,4*11*96)
512     call vzero(calthr,4*11*96)
513     call vzero(calrms,4*11*96)
514     call vzero(calbase,4*11*6)
515     call vzero(calvar,4*11*6)
516     call vzero(calpuls,4*11*96)
517     call vzero(dexy,4*11*96)
518     call vzero(dexyc,4*11*96)
519     call vzero(base,4*11*96)
520     call vzero(calselftrig,4*7)
521     call vzero(calIItrig,4)
522     call vzero(calstripshit,4)
523     call vzero(calDSPtaberr,4)
524     call vzero(calevnum,4)
525     goto 20
526     endif
527     c
528     999 continue
529     c
530     RETURN
531     END
532    
533    
534     C------------------------------------------------
535     SUBROUTINE CALRAW(vect,inf,sup,dedx)
536     C------------------------------------------------
537    
538     IMPLICIT NONE
539    
540     INTEGER*2 VECT(20000)
541     INTEGER inf, sup
542     INTEGER i,j,k, iev,iev2
543    
544     C
545     INTEGER NPLA, NCHA, LENSEV
546     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
547     INTEGER merror(4)
548     integer*2 e2(4)
549     INTEGER contr
550     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,ncha)
551    
552    
553     real calselftrig(4,7), calIItrig(4), calstripshit(4),
554     & calDSPtaberr(4), calevnum(4)
555    
556    
557     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
558     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
559     REAL calpuls(4,11,96)
560     REAL dedx(11,96)
561    
562     COMMON / evento / IEV,
563     & dexy,dexyc,base,
564     & calselftrig,calIItrig,
565     & calstripshit,calDSPtaberr,calevnum
566    
567     save / evento /
568    
569     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
570     & calbase,
571     & calvar,
572     & calpuls
573    
574     save / calib /
575     c
576     COMMON / VARIE / merror, CONTR, E2
577     SAVE / VARIE /
578    
579     C
580     DO I = 1,11
581     DO J = 1,96
582     DEDX(I,J) = 0.
583     ENDDO
584     ENDDO
585     C
586     k = inf
587     do j = 1,96
588     do i = 1,11
589     dedx(i,j) = vect(k)
590     k = k + 1
591     enddo
592     enddo
593     c
594     RETURN
595     END
596    
597     C------------------------------------------------
598     SUBROUTINE CALCOMPRESS(vect,inf,sup,dedx,basse)
599     C------------------------------------------------
600    
601     IMPLICIT NONE
602    
603     INTEGER*2 VECT(20000) , st3
604     C
605     INTEGER inf, sup
606     INTEGER i,j, iev,iev2
607     INTEGER*2 st, st1, st2
608     C
609     INTEGER ib
610     INTEGER ipl, ipr, ist
611     C
612     C
613     INTEGER NPLA, NCHA, LENSEV
614     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
615     INTEGER merror(4)
616     integer*2 e2(4)
617     INTEGER contr
618     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,ncha)
619    
620    
621     real calselftrig(4,7), calIItrig(4), calstripshit(4),
622     & calDSPtaberr(4), calevnum(4)
623    
624    
625     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
626     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
627     REAL calpuls(4,11,96)
628     REAL dedx(11,96), basse(11,6)
629     C
630     COMMON / evento / IEV,
631     & dexy,dexyc,base,
632     & calselftrig,calIItrig,
633     & calstripshit,calDSPtaberr,calevnum
634    
635     save / evento /
636    
637     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
638     & calbase,
639     & calvar,
640     & calpuls
641    
642     save / calib /
643     c
644     COMMON / VARIE / merror, CONTR, E2
645     SAVE / VARIE /
646    
647     C
648     DO I = 1,11
649     DO J = 1,96
650     DEDX(I,J) = 0.
651     ENDDO
652     do j = 1,6
653     basse(i,j) = 0.
654     enddo
655     ENDDO
656     C
657     c do j = inf-1,inf
658     c write (*,40) j,vect(j)
659     c enddo
660     C
661     10 continue
662     if (i.gt.sup) RETURN
663     C
664     40 format(2x,i5,2x,'status :',1x,Z4)
665     C emi
666     cc vect(i) = 42775
667     cc write(*,43)vect(i)
668     c st3 = 0
669     cc st3 = ISHFTC(vect(i),4,8)
670     c st3 = ISHFTC(vect(i),8,16)
671     cc st3 = ISHFTC(st3,4,8)
672     cc vect(i) = st3
673     cc write(*,44)vect(i)
674     st1 = IAND(vect(i),'0800'x)
675     cc write(*,41)st1
676     st1 = ISHFT(st1,-11)
677     cc st2 = IAND(vect(i),'1000'x) !st2
678     cc write(*,42)st2
679     cc st2 = ISHFT(st1,-12) !st2
680     cc write(*,41)st1
681     cc write(*,42)st2
682     cc 41 format(2x,'st1 = ',Z8)
683     cc 42 format(2x,'st2 = ',Z8)
684     cc 43 format(2x,'vect(i) prima = ',Z8)
685     cc 44 format(2x,'vect(i) dopo = ',Z8)
686     C end emi
687     if (st1.eq.1) then
688     ib = 1
689     else
690     st2 = IAND(vect(i),'1000'x) !st2
691     st2 = ISHFT(st1,-12) !st2
692     if (st2.eq.1) then !st2
693     ib = 0
694     else
695     print *,'Calorimeter, problems with coding'
696     RETURN
697     endif
698     endif
699     C
700     if (ib.eq.1) then
701     C
702     st = IAND(vect(i),'00FF'x)
703     ipl = int(st/6) + 1
704     ipr = st - (ipl - 1) * 6
705     i = i + 1
706     basse(ipl,ipr) = vect(i)
707     C
708     20 continue
709     if (i.gt.sup) RETURN
710     C
711     i = i + 1
712     if (vect(i).gt.16) goto 10
713     ist = vect(i)
714     i = i + 1
715     dedx(ipl,i) = vect(i)
716     C
717     else
718     C
719     st = IAND(vect(i),'00FF'x)
720     ipl = int(st/6) + 1
721     ipr = st - (ipl - 1) * 6
722     do j = 1,16
723     i = i + 1
724     dedx(ipl,j) = vect(i)
725     enddo
726     goto 10
727     C
728     endif
729    
730    
731     RETURN
732     END
733    
734    
735     C------------------------------------------------
736     SUBROUTINE CALFULL(vect,inf,sup,dedx,dedxc,basse)
737     C------------------------------------------------
738    
739     IMPLICIT NONE
740    
741     INTEGER*2 VECT(20000)
742     C
743     INTEGER inf, sup
744     INTEGER i,j,k, iev,iev2
745     C
746     INTEGER NPLA, NCHA, LENSEV
747     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
748     INTEGER merror(4)
749     integer*2 e2(4)
750     INTEGER contr
751     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,ncha)
752    
753    
754     real calselftrig(4,7), calIItrig(4), calstripshit(4),
755     & calDSPtaberr(4), calevnum(4)
756    
757    
758     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
759     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
760     REAL calpuls(4,11,96)
761     REAL dedx(11,96), basse(11,6), dedxc(11,96)
762    
763     COMMON / evento / IEV,
764     & dexy,dexyc,base,
765     & calselftrig,calIItrig,
766     & calstripshit,calDSPtaberr,calevnum
767    
768     save / evento /
769    
770     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
771     & calbase,
772     & calvar,
773     & calpuls
774    
775     save / calib /
776    
777     c
778     COMMON / VARIE / merror, CONTR, E2
779     SAVE / VARIE /
780    
781     C
782     C
783     C
784     DO I = 1,11
785     DO J = 1,96
786     DEDX(I,J) = 0.
787     ENDDO
788     ENDDO
789     C
790     k = inf
791     do i = 1,11
792     do j = 1,96
793     dedx(i,j) = vect(k)
794     k = k + 1
795     enddo
796     enddo
797     C
798     c print *,'inf :',inf,' sup :',sup,' k :',k
799     call CALCOMPRESS(vect,k,sup,dedxc,basse)
800    
801    
802     RETURN
803     END
804    
805    
806     C------------------------------------------------
807     SUBROUTINE CONTAER(ve,er)
808     C------------------------------------------------
809    
810     IMPLICIT NONE
811    
812     INTEGER*2 VE, st4
813     C
814     INTEGER*2 VECT(20000)
815     C
816     INTEGER er, l, bit, bi, iev,iev2
817     C
818     INTEGER NPLA, NCHA, LENSEV
819     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
820     INTEGER merror(4)
821     integer*2 e2(4)
822     INTEGER contr
823     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,ncha)
824    
825    
826     real calselftrig(4,7), calIItrig(4), calstripshit(4),
827     & calDSPtaberr(4), calevnum(4)
828    
829    
830     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
831     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
832     REAL calpuls(4,11,96)
833    
834     COMMON / evento / IEV,
835     & dexy,dexyc,base,
836     & calselftrig,calIItrig,
837     & calstripshit,calDSPtaberr,calevnum
838    
839     save / evento /
840    
841     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
842     & calbase,
843     & calvar,
844     & calpuls
845    
846     save / calib /
847    
848     COMMON / VARIE / merror, CONTR, E2
849     SAVE / VARIE /
850    
851    
852     st4 = 0
853     st4 = IAND(ve,'00FF'x)
854     if (st4.ne.0) then
855     do bit=0, 6
856     bi = ibits(st4,bit,1)
857     if (bi.ne.0) then
858     er = er + 1
859     endif
860     enddo
861     endif
862    
863     10 FORMAT(2X,'Status word:',2X,Z4)
864     return
865     end
866    
867    
868     C------------------------------------------------
869     SUBROUTINE MINERR(ic,icsave,chi,min,co)
870     C------------------------------------------------
871    
872     IMPLICIT NONE
873     C
874     INTEGER ic, icsave(1000), chi(1000)
875     integer l, st, min,co
876     INTEGER*2 VECT(20000)
877     C
878     INTEGER iev,iev2
879     C
880     INTEGER NPLA, NCHA, LENSEV
881     PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
882     INTEGER merror(4)
883     integer*2 e2(4)
884     INTEGER contr
885     REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,ncha)
886    
887    
888     real calselftrig(4,7), calIItrig(4), calstripshit(4),
889     & calDSPtaberr(4), calevnum(4)
890    
891    
892     REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
893     REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
894     REAL calpuls(4,11,96)
895    
896     COMMON / evento / IEV,
897     & dexy,dexyc,base,
898     & calselftrig,calIItrig,
899     & calstripshit,calDSPtaberr,calevnum
900    
901     save / evento /
902    
903     COMMON / calib / IEV2, calped, calgood, calthr, calrms,
904     & calbase,
905     & calvar,
906     & calpuls
907    
908     save / calib /
909     c
910     COMMON / VARIE / merror, CONTR, E2
911     SAVE / VARIE /
912    
913     st = chi(1)
914     min = 1
915     if (co.gt.1) then
916     do l = 2, co
917     if (chi(l).lt.st) then
918     st = chi(l)
919     min = l
920     endif
921     enddo
922     endif
923     ic = icsave(min)
924    
925     return
926     end

  ViewVC Help
Powered by ViewVC 1.1.23