/[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.6 - (hide annotations) (download)
Thu Sep 28 14:04:40 2006 UTC (18 years, 2 months ago) by pam-fi
Branch: MAIN
Changes since 1.5: +88 -8 lines
some bugs fixed, some changings in the classes:

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

  ViewVC Help
Powered by ViewVC 1.1.23