/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/reductionflight.f
ViewVC logotype

Annotation of /DarthVader/TrackerLevel2/src/F77/reductionflight.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (hide annotations) (download)
Mon Oct 16 12:36:52 2006 UTC (18 years, 2 months ago) by pam-fi
Branch: MAIN
Changes since 1.8: +6 -3 lines
filladc bug fixed

1 mocchiut 1.1 *************************************************************************
2     *
3     * Program reductionflight.f
4     *
5     * - reads readraw.f output files: LEVEL0 ntuple, and ped, sig and bad histograms
6     * - decodes raw data (DATATRACKER) using DSP ped, sig and bad values
7     * - looks for clusters information using ped, sig and bad values from
8     * DSP histograms
9     * - fills LEVEL1 ntuple
10     *
11     *************************************************************************
12    
13 pam-fi 1.2 subroutine reductionflight(ierror)
14 mocchiut 1.1
15     include 'commontracker.f'
16     include 'level0.f'
17     include 'level1.f'
18     include 'common_reduction.f'
19     include 'calib.f'
20    
21 pam-fi 1.6 data eventn_old/nviews*0/
22    
23 pam-fi 1.2 integer ierror
24     ierror = 0
25 mocchiut 1.1
26     * -------------------------------------------------------
27     * STRIP MASK
28     * -------------------------------------------------------
29    
30 pam-fi 1.4 c call stripmask !called later, after CN computation
31 mocchiut 1.1 call init_level1
32    
33 pam-fi 1.6 c good1 = good0
34     c--------------------------------------------------
35     c check the LEVEL0 event status for missing
36     c sections or DSP alarms
37     c ==> set the variable GOOD1(12)
38     c--------------------------------------------------
39     do iv=1,nviews
40     if(DSPnumber(iv).gt.0.and.DSPnumber(iv).le.12)then
41     c ------------------------
42     c GOOD
43     c ------------------------
44 pam-fi 1.9 GOOD1(DSPnumber(iv))=0 !OK
45 pam-fi 1.6 c ------------------------
46     c CRC error
47     c ------------------------
48     if(crc(iv).eq.1) then
49     GOOD1(DSPnumber(iv)) = 2
50     goto 18 !next view
51     endif
52     c ------------------------
53     c online-software alarm
54     c ------------------------
55     if(
56     $ fl1(iv).ne.0.or.
57     $ fl2(iv).ne.0.or.
58     $ fl3(iv).ne.0.or.
59     $ fl4(iv).ne.0.or.
60     $ fl5(iv).ne.0.or.
61     $ fl6(iv).ne.0.or.
62     $ fc(iv).ne.0.or.
63     $ DATAlength(iv).eq.0.or.
64     $ .false.)then
65     GOOD1(DSPnumber(iv))=3
66     goto 18
67     endif
68     c ------------------------
69     c DSP-counter jump
70     c ------------------------
71     if(
72     $ eventn_old(iv).ne.0.and. !first event in this file
73     $ eventn(iv).ne.1.and. !first event in run
74     $ good_old(DSPnumber(iv)).ne.0.and. !previous event corrupted
75     $ .true.)then
76    
77     if(eventn(iv).ne.(eventn_old(iv)+1))then
78     GOOD1(DSPnumber(iv))=4
79     goto 18
80     endif
81    
82     endif
83     c ------------------------
84     18 continue
85     endif
86     enddo
87    
88     ngood = 0
89     do iv = 1,nviews
90     eventn_old(iv) = eventn(iv)
91     good_old(iv) = good1(iv)
92     ngood = ngood + good1(iv)
93     enddo
94     c if(ngood.ne.0)print*,'* WARNING * LEVEL0 event status: '
95     c $ ,(good1(i),i=1,nviews)
96 mocchiut 1.1 c--------------------------------------------------
97     c read the variable DATATRACKER from LEVEL0
98 pam-fi 1.6 c and fill the variable ADC (invertin view 11)
99 mocchiut 1.1 c--------------------------------------------------
100     call filladc(iflag)
101     if(iflag.ne.0)then
102 pam-fi 1.6 c good1=0!<<<<<<<<<<<<<<<
103 pam-fi 1.2 c if(DEBUG)print*,'event ',eventn(1),' >>>>> decode ERROR'
104 pam-fi 1.6 ierror = 220
105     c goto 200
106     c print*,'filladc error'
107 mocchiut 1.1 endif
108    
109     c--------------------------------------------------
110     c computes common noise for each VA1
111     c (excluding strips affected by signal,
112     c tagged with the flag CLSTR)
113     c--------------------------------------------------
114     do iv=1,nviews
115 pam-fi 1.8 ima=0
116     do ik=1,nva1_view
117     cn(iv,ik) = 0
118     cnn(iv,ik) = -1
119     mask_vk_ev(iv,ik)=1
120     iflag=0
121     if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik,iflag)
122     c if(iflag.ne.0)good1=0
123     if(iflag.ne.0)then
124     ima=ima+1
125     mask_vk_ev(iv,ik)=0
126     ierror = 220
127     c$$$ if(verbose)
128     c$$$ $ print*,' * WARNING * Event ',eventn(1)
129     c$$$ $ ,': masked vk ',ik,' on view',iv
130     endif
131     enddo
132 pam-fi 1.9 100 format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
133     c if(ima.ne.0.and.verbose)print*,' * WARNING * Event ',eventn(1)
134     c $ ,' view',iv,': VK MASK '
135     c $ ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
136     if(ima.ne.0.and.verbose)write(*,100)eventn(1),iv
137 pam-fi 1.8 $ ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
138 mocchiut 1.1 enddo
139 pam-fi 1.4 c if(good1.eq.0)then
140     c ierror = 220
141     c endif
142 mocchiut 1.1
143 pam-fi 1.5 call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
144 mocchiut 1.1 c---------------------------------------------
145     c loops on views, VA1 and strips,
146     c and computes strips signals using
147     c badstrip, pedestals, and
148     c sigma informations from histograms
149     c---------------------------------------------
150     flag_shower = .false.
151     ind=1 !clsignal array index
152 pam-fi 1.5
153 mocchiut 1.1 do iv=1,nviews !loop on views
154     do is=1,nstrips_view !loop on strips (1)
155     if(mod(iv,2).eq.1) then
156     C=== > Y view
157     value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))
158     $ -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
159     $ *mask(iv,nvk(is),nst(is))
160     clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is))
161     $ *mask(iv,nvk(is),nst(is))
162     clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
163     $ *mask(iv,nvk(is),nst(is))
164     ccc print*,"value(",is,")(reduction)= ",value(is)
165     else
166     C=== > X view
167     value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
168     $ -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
169     $ *mask(iv,nvk(is),nst(is))
170     clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is))
171     $ *mask(iv,nvk(is),nst(is))
172     clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
173     $ *mask(iv,nvk(is),nst(is))
174     endif
175 pam-fi 1.4 c$$$ print*,iv,is,' --- ',adc(iv,nvk(is),nst(is)),cn(iv,nvk(is))
176     c$$$ $ ,pedestal(iv,nvk(is),nst(is)),value(is)
177     c$$$ $ ,sigma(iv,nvk(is),nst(is))
178     c if(value(is).gt.clseedcut(is))
179     c $ print*,iv,is,' --- (ADC_PED_CN) ',value(is),clseedcut(is)
180 mocchiut 1.1 enddo !end loop on strips (1)
181     call search_cluster(iv)
182 pam-fi 1.5 c$$$ if(flag_shower.eqv..true.)then
183     c$$$ call init_level1
184     c$$$ good1=0
185     c$$$ goto 200 !jump to next event
186     c$$$ endif
187     ccc
188     ccc modified by Elena (08/2006)
189     ccc
190     if(.not.flag_shower)then
191     call save_cluster(iv)
192     else
193     fshower(iv) = 1
194 pam-fi 1.6 GOOD1(DSPn) = 11
195 mocchiut 1.1 endif
196     enddo ! end loop on views
197     do iv=1,nviews
198     do ik=1,nva1_view
199 pam-fi 1.5 cnev(iv,ik) = cn(iv,ik) !assigns computed CN to ntuple variables
200     cnnev(iv,ik) = cnn(iv,ik) !assigns computed CN to ntuple variables
201 mocchiut 1.1 ccc print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)
202     enddo
203     enddo
204     C---------------------------------------------
205     C come here if GOOD1=0
206     C or the event has too many clusters
207     C---------------------------------------------
208     200 continue
209 pam-fi 1.6
210     ngood = 0
211     do iv = 1,nviews
212     ngood = ngood + good1(iv)
213     enddo
214 pam-fi 1.7 if(ngood.ne.0)print*,'* WARNING * Event ',eventn(1)
215     $ ,':LEVEL1 event status: '
216 pam-fi 1.6 $ ,(good1(i),i=1,nviews)
217 mocchiut 1.1 c------------------------------------------------------------------------
218 pam-fi 1.2 c
219 mocchiut 1.1 c closes files and exits
220 pam-fi 1.2 c
221 mocchiut 1.1 c------------------------------------------------------------------------
222 pam-fi 1.2 RETURN
223     END
224 mocchiut 1.1
225     ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
226     *
227     *
228     *
229     *
230     *
231     *
232     *
233     *
234     *
235     ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
236    
237    
238     subroutine init_level1
239    
240     include 'commontracker.f'
241     include 'level1.f'
242     include 'level0.f'
243    
244 pam-fi 1.6 c good1 = 0
245     do iv=1,12
246     good1(iv) = 1 !missing packet
247     enddo
248 pam-fi 1.5 nclstr1 = 0
249     totCLlength = 0
250 mocchiut 1.1 do ic=1,nclstrmax
251 pam-fi 1.5 view(ic) = 0
252     ladder(ic) = 0
253     indstart(ic) = 0
254     indmax(ic) = 0
255     maxs(ic) = 0
256     mult(ic) = 0
257     dedx(ic) = 0
258     whichtrack(ic) = 0
259    
260 mocchiut 1.1 enddo
261     do id=1,maxlength !???
262 pam-fi 1.5 clsignal(id) = 0.
263     clsigma(id) = 0.
264     cladc(id) = 0.
265     clbad(id) = 0.
266 mocchiut 1.1 enddo
267     do iv=1,nviews
268     c crc1(iv)=0
269     do ik=1,nva1_view
270 pam-fi 1.5 cnev(iv,ik) = 0
271     cnnev(iv,ik) = 0
272 mocchiut 1.1 enddo
273 pam-fi 1.5 fshower(iv) = 0
274 mocchiut 1.1 enddo
275    
276     return
277     end
278     *---***---***---***---***---***---***---***---***
279     *
280     *
281     *
282     *
283     *
284     *---***---***---***---***---***---***---***---***
285    
286     subroutine search_cluster(iv)
287    
288     include 'commontracker.f'
289     include 'level0.f'
290     include 'level1.f'
291     include 'calib.f'
292    
293 pam-fi 1.5 include 'common_reduction.f'
294 mocchiut 1.1
295    
296     c local variables
297     integer rmax,lmax !estremi del cluster
298     integer rstop,lstop !per decidere quali strip includere nel cluster
299     ! oltre il seed
300     integer first,last,diff !per includere le strip giuste... !???
301    
302     integer multtemp !temporary multiplicity variable
303    
304     external nst
305    
306     c------------------------------------------------------------------------
307     c looks for clusters on each view
308     C : CERCO STRIP SOPRA CLSEEDCUT, POI SCORRO A DX FINCHE'
309     c NON TROVO
310     C STRIP PIU' BASSA (in segnale/rumore)
311     C => L'ULTIMA DELLA SERIE CRESCENTE
312     C (LA PIU' ALTA) E' IL
313     C CLUSTER SEED. POI SCORRO A SX E DX INCLUDENDO TUTTE
314     C LE STRIP (FINO A 17 AL
315     C MAX) CHE SUPERANO CLINCLCUT.
316     C QUANDO CERCO IL CLUSTER SEED SUCCESSIVO SALTO LA STRIP
317     C ADIACENTE A DESTRA
318     C DELL'ULTIMO CLUSTER SEED (CHE SARA' NECESSARIAMENTE
319     C PIU' BASSA) E PRENDO
320     C COME SEED UNA STRIP SOLO SE IL SUO SEGNALE E'
321     C MAGGIORE DI QUELLO DELLA STRIP
322     C PRECEDENTE (PRATICAMENTE PER EVITARE CHE L'ULTIMA
323     C STRIP DI UN GRUPPO DI STRIP
324     C TUTTE SOPRA IL CLSEEDCUT VENGA AUTOMATICAMENTE PRESA
325     C COME SEED... DEVE ESSERE
326     C PRESA SOLO SE IL CLUSTER E' DOUBLE PEAKED...)
327     c------------------------------------------------------------------------
328     c 6 ottobre 2003
329     c Elena: CLSEEDCUT = 7 (old value 10)
330     c Elena: CLINCLCUT = 4 (old value 5)
331    
332     iseed=-999 !cluster seed index initialization
333    
334 pam-fi 1.5 nclstr_view=0
335    
336 mocchiut 1.1 do jl=1,nladders_view !1..3 !loops on ladders
337     first=1+nstrips_ladder*(jl-1) !1,1025,2049
338     last=nstrips_ladder*jl !1024,2048,3072
339     c X views have 1018 strips instead of 1024
340     if(mod(iv,2).eq.0) then
341     first=first+3
342     last=last-3
343     endif
344 pam-fi 1.6
345 mocchiut 1.1 do is=first,last !loop on strips in each ladder
346 pam-fi 1.6
347 mocchiut 1.1 if(is.le.iseed+1) goto 220
348 pam-fi 1.5 *******************************************************
349     * Elena 08/2006
350     * QUESTA PARTE NON E` ADEGUATA per cluster con grossi rilasci di carica
351     * perche` salva molte volte lo stesso cluster
352 pam-fi 1.6 * (salvo il cluster rispetto al primo massimo e basta...)
353 pam-fi 1.5 *******************************************************
354     c$$$c-----------------------------------------
355     c$$$c after a cluster seed as been found,
356     c$$$c look for next one skipping one strip on the right
357     c$$$c (i.e. look for double peak cluster)
358     c$$$c-----------------------------------------
359     c$$$ if(is.ne.first) then
360     c$$$ if(value(is).le.value(is-1)) goto 220
361     c$$$ endif
362     c$$$c-----------------------------------------
363     c$$$c skips cluster seed
364     c$$$c finding if strips values are descreasing (a strip
365     c$$$c can be a cluster seed only if previous strip value
366     c$$$c is lower)
367     c$$$c-----------------------------------------
368     *******************************************************
369     * LA RICERCA PARTE DALL'ULTIMA STRIP SALVATA (***TEMPORANEO****)
370     *******************************************************
371     if(is.le.iseed+rmax+1) goto 220
372     *******************************************************
373    
374 mocchiut 1.1 if(value(is).gt.clseedcut(is)) then
375     ccc print*,"value(",is,")=",value(is),
376     ccc $ " .gt.clseedcut(",is,")=",clseedcut(is)
377     c-----------------------------------------
378     c possible SEED...
379     c-----------------------------------------
380     itemp=is
381     if(itemp.eq.last) goto 230 !estremo...
382 pam-fi 1.5 ****************************************************
383     * modificato da Elena (08/2006) per salvare
384     * il cluster intorno al massimo assoluto
385     ****************************************************
386     c$$$ do while(value(itemp)
387     c$$$ $ /sigma(iv,nvk(itemp),nst(itemp))
388     c$$$ $ .le.value(itemp+1)
389     c$$$ $ /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???
390     c$$$ itemp=itemp+1
391     c$$$ if(itemp.eq.last) goto 230 !stops if reaches last strip
392     c$$$ enddo ! of the ladder
393 pam-fi 1.6 do while(
394     $ value(itemp).le.value(itemp+1)
395     $ .and.value(itemp+1).gt.clseedcut(itemp+1))
396 mocchiut 1.1 itemp=itemp+1
397     if(itemp.eq.last) goto 230 !stops if reaches last strip
398     enddo ! of the ladder
399     230 continue
400     c-----------------------------------------
401     c fownd SEED!!!
402     c-----------------------------------------
403     iseed=itemp
404     c----------------------------------------------------------
405     c after finding a cluster seed, checks also adjacent strips,
406     C and marks the ones exceeding clinclcut
407     c----------------------------------------------------------
408     ir=iseed !indici destro
409     il=iseed ! e sinistro
410    
411     rmax=ir !estremo destro del cluster
412     lmax=il ! e sinistro
413    
414     rstop=0 !initialize flags used to exit from
415     lstop=0 ! inclusion loop
416    
417     do while(lstop.eq.0.or.rstop.eq.0) !shifts left and right from
418     ir=ir+1 !position index for strips on right side of
419     ! cluster seed
420     il=il-1 !and for left side
421     c------------------------------------------------------------------------
422     c checks for last or first strip of the ladder
423     c------------------------------------------------------------------------
424     if(ir.gt.last) then !when index goes beyond last strip
425     rstop=1 ! of the ladder, change rstop flag in order
426     ! to "help" exiting from loop
427     endif
428    
429     if(il.lt.first) then !idem when index goes beyond
430     lstop=1 ! first strip of the ladder
431     endif
432    
433     c------------------------------------------------------------------------
434     c check for clusters including more than nclstrp strips
435     c------------------------------------------------------------------------
436     if((rmax-lmax+1).ge.nclstrp) then
437     goto 210 !exits inclusion loop:
438     ! lmax and rmax maintain last value
439     ! NB .ge.!???
440     endif
441     c------------------------------------------------------------------------
442     c marks strips exceeding inclusion cut
443     c------------------------------------------------------------------------
444     if(rstop.eq.0) then !if last strip of the ladder or last
445     ! over-cut strip has not been reached
446     if(value(ir).gt.clinclcut(ir)) then !puts in rmax the
447     rmax=ir ! last right over-cut strip
448     else
449     rstop=1 !otherwise cluster ends on right and rstop
450     endif ! flag=1 signals it
451     endif
452     if(lstop.eq.0) then
453     if(value(il).gt.clinclcut(il)) then
454     lmax=il
455     else
456     lstop=1
457     endif
458     endif
459    
460     enddo !ends strip inclusion loop
461     210 continue !jumps here if more than nclstrp have been included
462    
463     multtemp=rmax-lmax+1 !stores multiplicity in temp
464     ! variable. NB rmax and lmax can change later in
465     ! order to include enough strips to calculate eta3
466     ! and eta4. so mult is not always equal to cllength
467     c------------------------------------------------------------------------
468     c NB per essere sicuro di poter calcolare eta3 e eta4 devo includere
469     c sempre e comunque le 2 strip adiacenti al cluster seed e quella
470     c adiacente ulteriore dalla parte della piu' alta fra queste due
471     c (vedi oltre...)!???
472     c------------------------------------------------------------------------
473    
474     c nel caso di estremi del ladder...!???
475    
476     c ho meno di 4 strip nel cluster --> se sono sui bordi o quasi del ladder
477     c costruisco il cluster ad hoc e poi esco, se non sono sui bordi o quasi
478     c vado oltre (aggiungero' quindi strip a sx e dx in modo da poter calcolare
479     c eta3e4)
480     if((rmax-lmax+1).lt.4) then
481    
482     if(iseed.eq.first) then !estremi...
483     rmax=iseed+2 !NB in questo modo puo' anche capitare di
484     lmax=iseed ! includere strip sotto taglio di inclusione
485     goto 250 ! che non serviranno per eta3e4!???
486     endif
487    
488     if(iseed.eq.last) then !estremi...
489     rmax=iseed
490     lmax=iseed-2 !NB 2 e non 3, perche' altrimenti sarei in
491     goto 250 ! ((rmax-lmax+1).lt.4).eq.false. !???
492     endif !NMB questo e' l'unico caso di cllength=3!???
493    
494     if(iseed.eq.first+1) then !quasi estremi...
495     rmax=iseed+2
496     lmax=iseed-1
497     goto 250
498     endif
499     if(iseed.eq.last-1) then
500     rmax=iseed+1
501     lmax=iseed-2
502     goto 250
503     endif
504     c se ho 4 o piu' strip --> se sono sui bordi esco, se sono sui quasi bordi
505     c includo la strip del bordo
506     else
507    
508     if(iseed.eq.first) goto 250 !estremi... non includo altro
509     if(iseed.eq.last) goto 250
510     if(iseed.eq.first+1) then !quasi estremi... mi assicuro di
511     lmax=first ! avere le strip adiacenti al seed
512     if((rmax-lmax+1).gt.nclstrp) rmax=rmax-1 !NB effetto
513     goto 250 ! coperta: se la lunghezza del cluster era gia'
514     endif ! al limite (nclstrp), per poter aggiungere questa
515     ! strip a sinistra devo toglierne una a destra...!???
516     if(iseed.eq.last-1) then
517     rmax=last
518     if((rmax-lmax+1).gt.nclstrp) lmax=lmax+1
519     goto 250
520     endif
521     endif
522     c------------------------------------------------------------------------
523     c be sure to include in the cluster the cluster seed with its 2 adjacent
524     c strips, and the one adjacent to the greatest between this two strip, as the
525     c fourth one. if the strips have the same value (!) the fourth one is chosen
526     c as the one having the greatest value between the second neighbors
527     c------------------------------------------------------------------------
528     if(value(iseed+1).eq.value(iseed-1)) then
529     if(value(iseed+2).ge.value(iseed-2)) then !??? qui cmq c'e'
530     diff=(iseed+2)-rmax
531     if(diff.gt.0) then
532     rmax=rmax+diff
533     if((rmax-lmax+1).gt.nclstrp) then
534     lmax=rmax-nclstrp+1
535     endif
536     endif
537     diff=(iseed-1)-lmax
538     if(diff.lt.0) then
539     lmax=lmax+diff
540     if((rmax-lmax+1).gt.nclstrp) then
541     rmax=lmax+nclstrp-1
542     endif
543     endif
544     else
545     diff=(iseed-2)-lmax
546     if(diff.lt.0) then
547     lmax=lmax+diff
548     if((rmax-lmax+1).gt.nclstrp) then
549     rmax=lmax+nclstrp-1
550     endif
551     endif
552     diff=(iseed+1)-rmax
553     if(diff.gt.0) then
554     rmax=rmax+diff
555     if((rmax-lmax+1).gt.nclstrp) then
556     lmax=rmax-nclstrp+1
557     endif
558     endif
559     endif
560     elseif(value(iseed+1).gt.value(iseed-1)) then
561     c !??? sposto il limite del cluster a destra per includere sempre le strip
562     c necessarie al calcolo di eta-i
563     c se il cluster diventa troppo lungo lo accorcio a sinistra per avere non piu'
564     c di nclstrp (in questo caso sono sicuro di aver gia' incluso le strip
565     c necessarie al calcolo di eta-i a sinistra, quindi se voglio posso uscire)
566     diff=(iseed+2)-rmax
567     if(diff.gt.0) then
568     rmax=rmax+diff
569     if((rmax-lmax+1).gt.nclstrp) then
570     lmax=rmax-nclstrp+1
571     c goto 250
572     endif
573     endif
574     diff=(iseed-1)-lmax
575     if(diff.lt.0) then
576     lmax=lmax+diff
577     if((rmax-lmax+1).gt.nclstrp) then
578     rmax=lmax+nclstrp-1
579     c goto 250 !inutile!???
580     endif
581     endif
582     else
583     diff=(iseed-2)-lmax
584     if(diff.lt.0) then
585     lmax=lmax+diff
586     if((rmax-lmax+1).gt.nclstrp) then
587     rmax=lmax+nclstrp-1
588     c goto 250
589     endif
590     endif
591     diff=(iseed+1)-rmax
592     if(diff.gt.0) then
593     rmax=rmax+diff
594     if((rmax-lmax+1).gt.nclstrp) then
595     lmax=rmax-nclstrp+1
596     c goto 250 !inutile!???
597     endif
598     endif
599     endif
600     250 continue
601    
602     c--------------------------------------------------------
603 pam-fi 1.4 c fills cluster variables
604 mocchiut 1.1 c--------------------------------------------------------
605 pam-fi 1.5 c$$$ nclstr1=nclstr1+1 !cluster number
606     c$$$ccc print*,nclstr1,multtemp
607     c$$$ if(nclstr1.gt.nclstrmax) then !too many clusters for the event:
608     c$$$ if(verbose)print*,'Event ',eventn(1),
609     c$$$ $ ': more than ',nclstrmax,' clusters'
610     c$$$ good1=0 ! event
611     c$$$ nclstr1=0
612     c$$$ totCLlength=0
613     c$$$ flag_shower = .true.
614     c$$$ goto 2000
615     c$$$ endif
616     c$$$ view(nclstr1) = iv !vista del cluster
617     c$$$ ladder(nclstr1) = nld(iseed,iv) !ladder a cui appartiene il cluster seed
618     c$$$ maxs(nclstr1) = iseed !strip del cluster seed
619     c$$$ mult(nclstr1) = multtemp !molteplicita'
620     c$$$
621     c$$$ indstart(nclstr1) = ind !posizione dell'inizio del cluster nell'
622     c$$$c ! array clsignal
623     c$$$ indmax(nclstr1) = indstart(nclstr1)+(iseed-lmax) !posizione del
624     c$$$c ! cluster seed nell'array clsignal
625     c$$$
626     c$$$ CLlength = rmax-lmax+1 !numero di strip del cluster
627     c$$$ totCLlength = totCLlength+CLlength
628     c$$$ dedx(nclstr1) = 0
629     c$$$ do j=lmax,rmax !stores sequentially cluter strip values in
630     c$$$ clsignal(ind) = value(j) ! clsignal array
631     c$$$ ind=ind+1
632     c$$$c if(value(j).gt.0)
633     c$$$ if(value(j).gt.clinclcut(j))
634     c$$$ $ dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge
635     c$$$ enddo
636     ccc
637     ccc *** Modified by Elena (08/2006) ***
638     ccc
639     nclstr_view = nclstr_view + 1 !cluster number
640     c print*,'view ',iv,' -- search_cluster -- nclstr_view: '
641     c $ ,nclstr_view
642     if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view:
643     if(verbose) print*,'Event ',eventn(1),
644     $ ': more than ',nclstrmax_view
645     $ ,' clusters on view ',iv
646     c good1=0 ! event
647     c nclstr1=0
648     c totCLlength=0
649 mocchiut 1.1 flag_shower = .true.
650     goto 2000
651     endif
652 pam-fi 1.5
653     c view(nclstr1) = iv !vista del cluster
654     ladder_view(nclstr_view) = nld(iseed,iv) !ladder a cui appartiene il cluster seed
655     maxs_view(nclstr_view) = iseed !strip del cluster seed
656     mult_view(nclstr_view) = multtemp !molteplicita'
657     rmax_view(nclstr_view) = rmax
658     lmax_view(nclstr_view) = lmax
659    
660 mocchiut 1.1 c--------------------------------------------------------
661 pam-fi 1.2 c
662 mocchiut 1.1 c--------------------------------------------------------
663     endif !end possible seed conditio
664     220 continue !jumps here to skip strips left of last seed
665    
666     enddo ! end loop on strips
667     enddo !end loop on ladders
668     2000 continue
669     return
670     end
671    
672    
673     *---***---***---***---***---***---***---***---***
674     *
675     *
676     *
677     *
678     *
679     *---***---***---***---***---***---***---***---***
680    
681 pam-fi 1.5 subroutine save_cluster(iv)
682     *
683     * (080/2006 Elena Vannuccini)
684     * Save the clusters view by view
685    
686     include 'commontracker.f'
687     include 'level1.f'
688     include 'calib.f'
689     include 'common_reduction.f'
690    
691     integer CLlength !lunghezza in strip del cluster
692    
693     do ic=1,nclstr_view
694    
695     nclstr1 = nclstr1+1
696     view(nclstr1) = iv
697     ladder(nclstr1) = ladder_view(ic)
698     maxs(nclstr1) = maxs_view(ic)
699     mult(nclstr1) = mult_view(ic)
700    
701     c posizione dell'inizio del cluster nell' array clsignal
702     indstart(nclstr1) = ind
703     c posizione del cluster seed nell'array clsignal
704     indmax(nclstr1) = indstart(nclstr1)
705     $ +( maxs_view(ic) - lmax_view(ic) )
706    
707     CLlength = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate
708     totCLlength = totCLlength + CLlength
709     dedx(nclstr1) = 0
710     do j=lmax_view(ic),rmax_view(ic) !stores sequentially cluter strip values in
711    
712     clsignal(ind) = value(j) ! clsignal array
713    
714     ivk=nvk(j)
715     ist=nst(j)
716    
717     clsigma(ind) = sigma(iv,ivk,ist)
718     cladc(ind) = adc(iv,ivk,ist)
719     clbad(ind) = bad(iv,ivk,ist)
720     c clped(ind) = pedestal(iv,ivk,ist)
721    
722     ind=ind+1
723     c if(value(j).gt.0)
724     if(value(j).gt.clinclcut(j))
725     $ dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge
726     enddo
727    
728     c print*,'view ',iv,' -- save_cluster -- nclstr1: '
729     c $ ,nclstr1,maxs(nclstr1),mult(nclstr1),dedx(nclstr1)
730    
731     enddo
732    
733     return
734     end
735     *---***---***---***---***---***---***---***---***
736     *
737     *
738     *
739     *
740     *
741     *---***---***---***---***---***---***---***---***
742    
743 mocchiut 1.1
744     subroutine stripmask
745    
746     * this routine set va1 and single-strip masks,
747     * on the basis of the VA1 mask saved in the DB
748     *
749     * mask(nviews,nva1_view,nstrips_va1) !strip mask
750     * mask_vk(nviews,nva1_view) !VA1 mask
751     *
752     include 'commontracker.f'
753 pam-fi 1.5 include 'level1.f'
754 pam-fi 1.4 include 'common_reduction.f'
755 mocchiut 1.1 include 'calib.f'
756    
757     * init mask
758     do iv=1,nviews
759     do ivk=1,nva1_view
760     do is=1,nstrips_va1
761 pam-fi 1.4 c mask(iv,ivk,is) = mask_vk(iv,ivk)
762     mask(iv,ivk,is) = mask_vk(iv,ivk) * mask_vk_ev(iv,ivk)
763 mocchiut 1.1 enddo
764     enddo
765     enddo
766    
767    
768     return
769     end
770    

  ViewVC Help
Powered by ViewVC 1.1.23