/[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.8 - (hide annotations) (download)
Fri Sep 29 08:45:16 2006 UTC (18 years, 2 months ago) by pam-fi
Branch: MAIN
Changes since 1.7: +20 -15 lines
*** empty log message ***

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

  ViewVC Help
Powered by ViewVC 1.1.23