/[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.22 - (hide annotations) (download)
Mon Aug 20 16:07:16 2007 UTC (17 years, 3 months ago) by pam-fi
Branch: MAIN
Changes since 1.21: +18 -12 lines
missing-image bug fixed + other changes

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 pam-fi 1.17 c$$$ debug = .true.
27     c$$$ verbose = .true.
28     c$$$ warning = .true.
29    
30 pam-fi 1.22 c$$$ print*,debug,verbose,warning
31     c$$$ debug=1
32     c$$$ verbose=1
33     c$$$ warning=1
34    
35 pam-fi 1.19 * //////////////////////////
36     * initialize some parameters
37     * //////////////////////////
38    
39 mocchiut 1.1 call init_level1
40    
41 pam-fi 1.20 c debug=.true.
42    
43 pam-fi 1.22 if(debug.eq.1)print*,'-- check LEVEL0 status'
44 pam-fi 1.17
45 pam-fi 1.20 ievco=-1
46     mismatch=0
47 pam-fi 1.6 c good1 = good0
48     c--------------------------------------------------
49     c check the LEVEL0 event status for missing
50     c sections or DSP alarms
51     c ==> set the variable GOOD1(12)
52     c--------------------------------------------------
53     do iv=1,nviews
54     if(DSPnumber(iv).gt.0.and.DSPnumber(iv).le.12)then
55     c ------------------------
56     c GOOD
57     c ------------------------
58 pam-fi 1.9 GOOD1(DSPnumber(iv))=0 !OK
59 pam-fi 1.6 c ------------------------
60     c CRC error
61     c ------------------------
62     if(crc(iv).eq.1) then
63 pam-fi 1.20 c GOOD1(DSPnumber(iv)) = 2
64     c GOOD1(DSPnumber(iv)) = GOOD1(DSPnumber(iv)) + 2**1
65     GOOD1(DSPnumber(iv)) = ior(GOOD1(DSPnumber(iv)),2**1)
66     102 format(' * WARNING * Event ',i7,' view',i3
67     $ ,' CRC error')
68 pam-fi 1.22 if(debug.eq.1)write(*,102)eventn(1),DSPnumber(iv)
69 pam-fi 1.20 c goto 18 !next view
70 pam-fi 1.6 endif
71     c ------------------------
72     c online-software alarm
73     c ------------------------
74     if(
75     $ fl1(iv).ne.0.or.
76     $ fl2(iv).ne.0.or.
77     $ fl3(iv).ne.0.or.
78     $ fl4(iv).ne.0.or.
79     $ fl5(iv).ne.0.or.
80     $ fl6(iv).ne.0.or.
81     $ fc(iv).ne.0.or.
82     $ DATAlength(iv).eq.0.or.
83     $ .false.)then
84 pam-fi 1.20 c GOOD1(DSPnumber(iv))=3
85     c GOOD1(DSPnumber(iv)) = GOOD1(DSPnumber(iv)) + 2**2
86     GOOD1(DSPnumber(iv)) = ior(GOOD1(DSPnumber(iv)),2**2)
87     103 format(' * WARNING * Event ',i7,' view',i3
88     $ ,' software alarm')
89 pam-fi 1.22 if(debug.eq.1)write(*,103)eventn(1),DSPnumber(iv)
90 pam-fi 1.20 c goto 18
91 pam-fi 1.6 endif
92     c ------------------------
93     c DSP-counter jump
94     c ------------------------
95 pam-fi 1.20 c commentato perche` non e` un controllo significativo nel caso in cui
96     c la subroutine venga chiamata per riprocessare l'evento
97     c sostituito con un check dei contatori dei vari dsp
98     c$$$ if(
99     c$$$ $ eventn_old(iv).ne.0.and. !first event in this file
100     c$$$ $ eventn(iv).ne.1.and. !first event in run
101     c$$$ $ good_old(DSPnumber(iv)).ne.0.and. !previous event corrupted
102     c$$$ $ .true.)then
103     c$$$
104     c$$$ if(eventn(iv).ne.(eventn_old(iv)+1))then
105     c$$$c GOOD1(DSPnumber(iv))=4
106     c$$$c GOOD1(DSPnumber(iv)) = GOOD1(DSPnumber(iv)) + 2**3
107     c$$$ GOOD1(DSPnumber(iv)) = ior(GOOD1(DSPnumber(iv)),2**3)
108     c$$$ 104 format(' * WARNING * Event ',i7,' view',i3
109     c$$$ $ ,' counter jump ',i10,i10)
110 pam-fi 1.22 c$$$ if(debug.eq.1)write(*,104)eventn(1),DSPnumber(iv)
111 pam-fi 1.20 c$$$ $ ,eventn_old(iv),eventn(iv))
112     c$$$ goto 18
113     c$$$ endif
114     c$$$
115     c$$$ endif
116     c ------------------------
117     c 18 continue
118     c ------------------------
119     c DSP-counter
120     c ------------------------
121     if( DSPnumber(iv).ne.0.and.GOOD1(DSPnumber(iv)).ne.1)then
122     if(iv.ne.1.and.ievco.ne.-1)then
123     if( eventn(iv).ne.ievco )then
124     mismatch=1
125     endif
126 pam-fi 1.6 endif
127 pam-fi 1.20 ievco = eventn(iv)
128 pam-fi 1.6 endif
129     endif
130     enddo
131    
132 pam-fi 1.20 c print*,'*** ',(eventn(iv),iv=1,12)
133    
134 pam-fi 1.22 if(mismatch.eq.1.and.debug.eq.1)
135 pam-fi 1.20 $ print*,' * WARNING * DSP counter mismatch: '
136     $ ,(eventn(iv),iv=1,12)
137    
138 pam-fi 1.6 ngood = 0
139     do iv = 1,nviews
140 pam-fi 1.20
141     if(mismatch.eq.1.and.GOOD1(iv).ne.1)
142     $ GOOD1(iv)=ior(GOOD1(iv),2**3)
143    
144 pam-fi 1.6 eventn_old(iv) = eventn(iv)
145     good_old(iv) = good1(iv)
146     ngood = ngood + good1(iv)
147 pam-fi 1.20
148 pam-fi 1.6 enddo
149 pam-fi 1.20 c$$$ if(verbose.and.ngood.ne.0)print*,'* WARNING * Event ',eventn(1)
150     c$$$ $ ,':LEVEL0 event status: '
151     c$$$ $ ,(good1(i),i=1,nviews)
152 mocchiut 1.1 c--------------------------------------------------
153     c read the variable DATATRACKER from LEVEL0
154 pam-fi 1.6 c and fill the variable ADC (invertin view 11)
155 mocchiut 1.1 c--------------------------------------------------
156 pam-fi 1.17
157 pam-fi 1.22 if(debug.eq.1)print*,'-- fill ADC vectors'
158 pam-fi 1.17
159 mocchiut 1.1 call filladc(iflag)
160     if(iflag.ne.0)then
161 pam-fi 1.6 ierror = 220
162 mocchiut 1.1 endif
163    
164     c--------------------------------------------------
165     c computes common noise for each VA1
166 pam-fi 1.10 c (excluding strips with signal,
167 mocchiut 1.1 c tagged with the flag CLSTR)
168     c--------------------------------------------------
169 pam-fi 1.22 if(debug.eq.1)print*,'-- compute CN'
170 pam-fi 1.17
171 mocchiut 1.1 do iv=1,nviews
172 pam-fi 1.8 ima=0
173     do ik=1,nva1_view
174 pam-fi 1.18 cn(iv,ik) = 0
175     cnrms(iv,ik) = 0
176     cnn(iv,ik) = -1
177     iflag = 0
178     mask_vk_ev(iv,ik) = 1
179 pam-fi 1.13 call stripmask(iv,ik) !compute mask(i,j,k), combining VA1-masks
180 pam-fi 1.18 * --------------------------------------
181     * if chip is not masked ---> evaluate CN
182     * --------------------------------------
183     if( mask(iv,ik,1).eq.1 ) then !!!NBNB mask per la striscia 1 !!!!!!!!
184     call cncomp(iv,ik,iflag)
185     if(iflag.ne.0)then
186     ima=ima+1
187     mask_vk_ev(iv,ik)=0
188     ierror = 220
189     endif
190     call stripmask(iv,ik) !compute mask(i,j,k), combining VA1-masks
191 pam-fi 1.8 endif
192     enddo
193 pam-fi 1.9 100 format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
194 pam-fi 1.22 if(ima.ne.0.and.verbose.eq.1)write(*,100)eventn(1),iv
195 pam-fi 1.8 $ ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
196 pam-fi 1.18 c if(ima.ne.0)write(*,100)eventn(1),iv
197     c $ ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
198 mocchiut 1.1 enddo
199    
200 pam-fi 1.13 cc call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
201 pam-fi 1.10
202 mocchiut 1.1 c---------------------------------------------
203     c loops on views, VA1 and strips,
204     c and computes strips signals using
205     c badstrip, pedestals, and
206     c sigma informations from histograms
207     c---------------------------------------------
208     ind=1 !clsignal array index
209 pam-fi 1.5
210 pam-fi 1.22 if(debug.eq.1)print*,'-- search clusters'
211 mocchiut 1.1 do iv=1,nviews !loop on views
212     do is=1,nstrips_view !loop on strips (1)
213     if(mod(iv,2).eq.1) then
214     C=== > Y view
215 pam-fi 1.20 c print*,iv,nvk(is),nst(is),adc(iv,nvk(is),nst(is))
216     c $ ,cn(iv,nvk(is))
217     c $ ,pedestal(iv,nvk(is),nst(is))
218 mocchiut 1.1 value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))
219     $ -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
220     $ *mask(iv,nvk(is),nst(is))
221     clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is))
222     $ *mask(iv,nvk(is),nst(is))
223     clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
224     $ *mask(iv,nvk(is),nst(is))
225 pam-fi 1.10 sat(is)=0
226     if( adc(iv,nvk(is),nst(is)).lt.adc_saty )sat(is)=1
227 mocchiut 1.1 else
228     C=== > X view
229     value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
230     $ -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
231     $ *mask(iv,nvk(is),nst(is))
232     clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is))
233     $ *mask(iv,nvk(is),nst(is))
234     clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
235     $ *mask(iv,nvk(is),nst(is))
236 pam-fi 1.10 sat(is)=0
237     if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1
238 mocchiut 1.1 endif
239     enddo !end loop on strips (1)
240     call search_cluster(iv)
241 pam-fi 1.10
242 pam-fi 1.5 if(.not.flag_shower)then
243     call save_cluster(iv)
244 pam-fi 1.22 if(debug.eq.1)print*,'view ',iv,' #clusters ', nclstr_view
245 pam-fi 1.5 else
246     fshower(iv) = 1
247 pam-fi 1.14 c GOOD1(DSPnumber(iv)) = 11 !AHAHAHAHA ORRORE!!
248 pam-fi 1.20 c GOOD1(iv) = 11
249     c GOOD1(iv) = GOOD1(iv) + 2**5
250     GOOD1(iv) = ior(GOOD1(iv),2**5)
251 pam-fi 1.17 101 format(' * WARNING * Event ',i7,' view',i3
252     $ ,' #clusters > ',i5,' --> MASKED')
253 pam-fi 1.22 if(verbose.eq.1)write(*,101)eventn(1),iv,nclstrmax_view
254 mocchiut 1.1 endif
255     enddo ! end loop on views
256     do iv=1,nviews
257     do ik=1,nva1_view
258 pam-fi 1.10 cnev(iv,ik) = cn(iv,ik) !assigns computed CN to ntuple variables
259     cnrmsev(iv,ik) = cnrms(iv,ik) !assigns computed CN to ntuple variables
260     cnnev(iv,ik) = cnn(iv,ik) !assigns computed CN to ntuple variables
261 mocchiut 1.1 enddo
262     enddo
263     C---------------------------------------------
264     C come here if GOOD1=0
265     C or the event has too many clusters
266     C---------------------------------------------
267     200 continue
268 pam-fi 1.6
269     ngood = 0
270     do iv = 1,nviews
271     ngood = ngood + good1(iv)
272     enddo
273 pam-fi 1.22 if(verbose.eq.1.and.ngood.ne.0)
274     $ print*,'* WARNING * Event ',eventn(1)
275 pam-fi 1.17 $ ,':LEVEL1 event status: '
276     $ ,(good1(i),i=1,nviews)
277 mocchiut 1.1 c------------------------------------------------------------------------
278 pam-fi 1.2 c
279 mocchiut 1.1 c closes files and exits
280 pam-fi 1.2 c
281 mocchiut 1.1 c------------------------------------------------------------------------
282 pam-fi 1.2 RETURN
283     END
284 mocchiut 1.1
285     ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
286     *
287     *
288     *
289     *
290     *
291     *
292     *
293     *
294     *
295     ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
296    
297    
298     subroutine init_level1
299    
300     include 'commontracker.f'
301     include 'level1.f'
302     include 'level0.f'
303    
304 pam-fi 1.6 c good1 = 0
305     do iv=1,12
306     good1(iv) = 1 !missing packet
307     enddo
308 pam-fi 1.5 nclstr1 = 0
309     totCLlength = 0
310 mocchiut 1.1 do ic=1,nclstrmax
311 pam-fi 1.5 view(ic) = 0
312     ladder(ic) = 0
313     indstart(ic) = 0
314     indmax(ic) = 0
315     maxs(ic) = 0
316     mult(ic) = 0
317 pam-fi 1.16 sgnl(ic) = 0
318 pam-fi 1.15 whichtrack(ic) = 0 !assigned @ level2
319 pam-fi 1.5
320 mocchiut 1.1 enddo
321     do id=1,maxlength !???
322 pam-fi 1.5 clsignal(id) = 0.
323     clsigma(id) = 0.
324     cladc(id) = 0.
325     clbad(id) = 0.
326 mocchiut 1.1 enddo
327     do iv=1,nviews
328     c crc1(iv)=0
329     do ik=1,nva1_view
330 pam-fi 1.5 cnev(iv,ik) = 0
331     cnnev(iv,ik) = 0
332 mocchiut 1.1 enddo
333 pam-fi 1.5 fshower(iv) = 0
334 mocchiut 1.1 enddo
335    
336     return
337     end
338 pam-fi 1.10
339 mocchiut 1.1 *---***---***---***---***---***---***---***---***
340     *
341     *
342     *
343     *
344     *
345     *---***---***---***---***---***---***---***---***
346    
347     subroutine search_cluster(iv)
348    
349     include 'commontracker.f'
350     include 'level0.f'
351     include 'level1.f'
352     include 'calib.f'
353    
354 pam-fi 1.5 include 'common_reduction.f'
355 mocchiut 1.1
356    
357     c local variables
358     integer rmax,lmax !estremi del cluster
359 pam-fi 1.10 integer rstop,lstop
360     integer first,last
361     integer fsat,lsat
362 mocchiut 1.1
363     external nst
364    
365 pam-fi 1.10 iseed=-999 !cluster seed index initialization
366 mocchiut 1.1
367 pam-fi 1.10 inext=-999 !index where to start new cluster search
368 mocchiut 1.1
369 pam-fi 1.10 flag_shower = .false.
370 pam-fi 1.5 nclstr_view=0
371    
372 pam-fi 1.10 do jl=1,nladders_view !1..3 !loops on ladders
373    
374     first = 1+nstrips_ladder*(jl-1) !1,1025,2049
375     last = nstrips_ladder*jl !1024,2048,3072
376    
377     * X views have 1018 strips instead of 1024
378 mocchiut 1.1 if(mod(iv,2).eq.0) then
379     first=first+3
380     last=last-3
381     endif
382 pam-fi 1.6
383 mocchiut 1.1 do is=first,last !loop on strips in each ladder
384 pam-fi 1.6
385 pam-fi 1.10 c---------------------------------------------
386     c new-cluster search starts at index inext
387     c---------------------------------------------
388     if(is.lt.inext) goto 220 ! next strip
389 pam-fi 1.5
390 mocchiut 1.1 if(value(is).gt.clseedcut(is)) then
391     c-----------------------------------------
392     c possible SEED...
393     c-----------------------------------------
394 pam-fi 1.10 itemp = is
395     fsat = 0 ! first saturated strip
396     lsat = 0 ! last saturated strip
397 mocchiut 1.1 if(itemp.eq.last) goto 230 !estremo...
398 pam-fi 1.10 c ------------------------
399     c search for first maximum
400     c ------------------------
401 pam-fi 1.6 do while(
402     $ value(itemp).le.value(itemp+1)
403     $ .and.value(itemp+1).gt.clseedcut(itemp+1))
404 pam-fi 1.10 itemp = itemp+1
405     if(itemp.eq.last) goto 230 !stops if reaches last strip
406     if(sat(itemp).eq.1) goto 230 !stop if reaches a saturated strip
407 mocchiut 1.1 enddo ! of the ladder
408     230 continue
409 pam-fi 1.10 c -----------------------------
410     c check if strips are saturated
411     c -----------------------------
412     if( sat(itemp).eq.1 )then
413     fsat = itemp
414     lsat = itemp
415     if(itemp.eq.last) goto 231 !estremo...
416     do while( sat(itemp+1).eq.1 )
417     itemp = itemp+1
418     lsat = itemp
419     if(itemp.eq.last) goto 231 !stops if reaches last strip
420     enddo
421     endif
422     231 continue
423     c---------------------------------------------------------------------------
424 mocchiut 1.1 c fownd SEED!!!
425 pam-fi 1.10 c (if there are saturated strips, the cluster is centered in the middle)
426     c---------------------------------------------------------------------------
427     if(fsat.eq.0.and.lsat.eq.0)then
428     iseed = itemp ! <<< SEED
429     else
430     iseed = int((lsat+fsat)/2) ! <<< SEED
431     c$$$ print*,'saturated strips ',fsat,lsat,iseed
432     c$$$ print*,'--> ',(value(ii),ii=fsat,lsat)
433     endif
434     c---------------------------------------------------------------
435 mocchiut 1.1 c after finding a cluster seed, checks also adjacent strips,
436 pam-fi 1.10 C and tags the ones exceeding clinclcut
437     c---------------------------------------------------------------
438 mocchiut 1.1 ir=iseed !indici destro
439     il=iseed ! e sinistro
440    
441     rmax=ir !estremo destro del cluster
442     lmax=il ! e sinistro
443    
444     rstop=0 !initialize flags used to exit from
445     lstop=0 ! inclusion loop
446    
447     do while(lstop.eq.0.or.rstop.eq.0) !shifts left and right from
448 pam-fi 1.10
449    
450     ir=ir+1 !index for right side
451     il=il-1 !index for left side
452 mocchiut 1.1 c------------------------------------------------------------------------
453     c checks for last or first strip of the ladder
454     c------------------------------------------------------------------------
455 pam-fi 1.10 if( ir.gt.last ) rstop = 1
456     if( il.lt.first ) lstop = 1
457 mocchiut 1.1
458     c------------------------------------------------------------------------
459 pam-fi 1.10 c add strips exceeding inclusion cut
460 mocchiut 1.1 c------------------------------------------------------------------------
461 pam-fi 1.10 if( (rmax-lmax+1).ge.nclstrp )goto 210 !exits inclusion loop
462    
463 pam-fi 1.21 if(rstop.eq.0) then !if right cluster border has not been reached
464 pam-fi 1.10 if(value(ir).gt.clinclcut(ir)) then
465     rmax=ir !include a strip on the right
466 mocchiut 1.1 else
467 pam-fi 1.10 rstop=1 !cluster right end
468     endif
469 mocchiut 1.1 endif
470 pam-fi 1.10
471     if( (rmax-lmax+1).ge.nclstrp )goto 210 !exits inclusion loop
472    
473 pam-fi 1.21 if(lstop.eq.0) then !if left cluster border has not been reached
474 mocchiut 1.1 if(value(il).gt.clinclcut(il)) then
475 pam-fi 1.10 lmax=il !include a strip on the left
476 mocchiut 1.1 else
477 pam-fi 1.10 lstop=1 !cluster left end
478 mocchiut 1.1 endif
479     endif
480    
481 pam-fi 1.21 c if( (rmax-lmax+1).ge.nclstrp )goto 210 !exits inclusion loop
482    
483 mocchiut 1.1 enddo !ends strip inclusion loop
484 pam-fi 1.10 goto 211
485 mocchiut 1.1 210 continue !jumps here if more than nclstrp have been included
486 pam-fi 1.10 c print*,'>>> nclstrp! '
487     211 continue
488     c-----------------------------------------
489     c end of inclusion loop!
490     c-----------------------------------------
491    
492     c------------------------------------------------------------------------
493     c adjust the cluster in order to have at least a strip around the seed
494     c------------------------------------------------------------------------
495     if(iseed.eq.lmax.and.lmax.ne.first)then
496     lmax = lmax-1
497     if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
498     endif
499     if(iseed.eq.rmax.and.rmax.ne.last )then
500     rmax = rmax+1
501     if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
502 mocchiut 1.1 endif
503 pam-fi 1.21 c-------------------------------------------------------------------------------
504     c adjust the cluster in order to have at least ANOTHER strip around the seed
505     c-------------------------------------------------------------------------------
506     c$$$ if(iseed-1.eq.lmax.and.lmax.ne.first)then
507     c$$$ lmax = lmax-1
508     c$$$ if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
509     c$$$ endif
510     c$$$ if(iseed+1.eq.rmax.and.rmax.ne.last )then
511     c$$$ rmax = rmax+1
512     c$$$ if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
513     c$$$ endif
514     c---------------------------------------------------
515     c now we have 5 stored-strips around the maximum
516     c---------------------------------------------------
517 pam-fi 1.10
518 mocchiut 1.1 c------------------------------------------------------------------------
519 pam-fi 1.10 c adjust the cluster in order to store a minimum number of strips
520     c------------------------------------------------------------------------
521     do while( (rmax-lmax+1).lt.nclstrpmin )
522    
523     vl = -99999
524     vr = -99999
525     if(lmax-1.ge.first) vl = value(lmax-1)
526     if(rmax+1.le.last ) vr = value(rmax+1)
527     if(vr.ge.vl) then
528     rmax = rmax+1
529     else
530     lmax = lmax-1
531 mocchiut 1.1 endif
532 pam-fi 1.10
533     enddo
534 mocchiut 1.1
535     c--------------------------------------------------------
536 pam-fi 1.10 c store cluster info
537 mocchiut 1.1 c--------------------------------------------------------
538 pam-fi 1.5 nclstr_view = nclstr_view + 1 !cluster number
539 pam-fi 1.10
540 pam-fi 1.5 if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view:
541 pam-fi 1.10 c$$$ if(verbose) print*,'Event ',eventn(1),
542     c$$$ $ ': more than ',nclstrmax_view
543     c$$$ $ ,' clusters on view ',iv
544 mocchiut 1.1 flag_shower = .true.
545     goto 2000
546     endif
547 pam-fi 1.5
548 pam-fi 1.10 ladder_view(nclstr_view) = nld(iseed,iv)
549     maxs_view(nclstr_view) = iseed
550     mult_view(nclstr_view) = rmax-lmax+1
551 pam-fi 1.5 rmax_view(nclstr_view) = rmax
552     lmax_view(nclstr_view) = lmax
553    
554 pam-fi 1.10 c$$$ if(rmax-lmax+1.gt.25)
555     c$$$ $ print*,'view ',iv
556     c$$$ $ ,' cl ',nclstr_view,' mult ',rmax-lmax+1
557     c------------------------------------------------------------------------
558 pam-fi 1.11 c search for a double peak inside the cluster
559 pam-fi 1.10 c------------------------------------------------------------------------
560     inext = rmax+1 !<< index where to start new-cluster search
561    
562     vmax = 0
563     vmin = value(iseed)
564     imax = iseed
565     imin = iseed
566     do iss = max(iseed+1,lsat+1),rmax
567     if( value(iss).lt.vmin )then
568     if( imax.ne.iseed )goto 221 !found dowble peek
569     imin = iss
570     vmin = value(iss)
571     else
572     delta = value(iss) - value(imin)
573     cut = sqrt(clinclcut(iss)**2 + clinclcut(imin)**2)
574     if(
575     $ delta.gt.cut .and.
576     $ value(iss).gt.clseedcut(iss).and.
577     $ .true.)then
578     if( value(iss).gt.vmax )then
579     imax = iss
580     vmax = value(iss)
581     else
582     goto 221 !found dowble peek
583     endif
584     endif
585     endif
586     enddo
587     221 continue
588    
589     if(imax.gt.iseed)then
590     inext = imax !<< index where to start new-cluster search
591     c$$$ print*,'--- double peek ---'
592     c$$$ print*,(value(ii),ii=lmax,rmax)
593     c$$$ print*,'seed ',iseed,' imin ',imin,' imax ',imax
594     endif
595 mocchiut 1.1 c--------------------------------------------------------
596 pam-fi 1.2 c
597 mocchiut 1.1 c--------------------------------------------------------
598     endif !end possible seed conditio
599     220 continue !jumps here to skip strips left of last seed
600    
601     enddo ! end loop on strips
602     enddo !end loop on ladders
603     2000 continue
604     return
605     end
606    
607    
608     *---***---***---***---***---***---***---***---***
609     *
610     *
611     *
612     *
613     *
614     *---***---***---***---***---***---***---***---***
615    
616 pam-fi 1.5 subroutine save_cluster(iv)
617     *
618     * (080/2006 Elena Vannuccini)
619     * Save the clusters view by view
620    
621     include 'commontracker.f'
622     include 'level1.f'
623     include 'calib.f'
624     include 'common_reduction.f'
625    
626     integer CLlength !lunghezza in strip del cluster
627    
628     do ic=1,nclstr_view
629    
630     nclstr1 = nclstr1+1
631     view(nclstr1) = iv
632     ladder(nclstr1) = ladder_view(ic)
633     maxs(nclstr1) = maxs_view(ic)
634     mult(nclstr1) = mult_view(ic)
635    
636     c posizione dell'inizio del cluster nell' array clsignal
637     indstart(nclstr1) = ind
638     c posizione del cluster seed nell'array clsignal
639     indmax(nclstr1) = indstart(nclstr1)
640     $ +( maxs_view(ic) - lmax_view(ic) )
641    
642     CLlength = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate
643     totCLlength = totCLlength + CLlength
644 pam-fi 1.16 sgnl(nclstr1) = 0
645 pam-fi 1.5 do j=lmax_view(ic),rmax_view(ic) !stores sequentially cluter strip values in
646    
647     clsignal(ind) = value(j) ! clsignal array
648 pam-fi 1.20 c$$$ print*,ind,clsignal(ind)
649 pam-fi 1.5 ivk=nvk(j)
650     ist=nst(j)
651    
652     clsigma(ind) = sigma(iv,ivk,ist)
653     cladc(ind) = adc(iv,ivk,ist)
654     clbad(ind) = bad(iv,ivk,ist)
655     c clped(ind) = pedestal(iv,ivk,ist)
656    
657     ind=ind+1
658     c if(value(j).gt.0)
659     if(value(j).gt.clinclcut(j))
660 pam-fi 1.16 $ sgnl(nclstr1) = sgnl(nclstr1) + value(j) !cluster charge
661 pam-fi 1.5 enddo
662    
663 pam-fi 1.20 c$$$ print*,'view ',iv,' -- save_cluster -- nclstr1: '
664     c$$$ $ ,nclstr1,maxs(nclstr1),mult(nclstr1),sgnl(nclstr1)
665     c$$$ print*,'----------------------'
666    
667 pam-fi 1.5 enddo
668    
669     return
670     end
671     *---***---***---***---***---***---***---***---***
672     *
673     *
674     *
675     *
676     *
677     *---***---***---***---***---***---***---***---***
678    
679 mocchiut 1.1
680 pam-fi 1.13 c$$$ subroutine stripmask
681     c$$$
682     c$$$* this routine set va1 and single-strip masks,
683     c$$$* on the basis of the VA1 mask saved in the DB
684     c$$$*
685     c$$$* mask(nviews,nva1_view,nstrips_va1) !strip mask
686     c$$$* mask_vk(nviews,nva1_view) !VA1 mask
687     c$$$*
688     c$$$ include 'commontracker.f'
689     c$$$ include 'level1.f'
690     c$$$ include 'common_reduction.f'
691     c$$$ include 'calib.f'
692     c$$$
693     c$$$* init mask
694     c$$$ do iv=1,nviews
695     c$$$ do ivk=1,nva1_view
696     c$$$ do is=1,nstrips_va1
697     c$$$c mask(iv,ivk,is) = mask_vk(iv,ivk)
698     c$$$ if( mask_vk(iv,ivk) .ne. -1)then
699     c$$$ mask(iv,ivk,is) = 1
700     c$$$ $ * mask_vk(iv,ivk) !from DB
701     c$$$ $ * mask_vk_ev(iv,ivk) !from <SIG>
702     c$$$ $ * mask_vk_run(iv,ivk) !from CN
703     c$$$ else
704     c$$$ mask(iv,ivk,is) = -1
705     c$$$ $ * mask_vk(iv,ivk) !from DB
706     c$$$ $ * mask_vk_ev(iv,ivk) !from CN
707     c$$$ endif
708     c$$$ enddo
709     c$$$ enddo
710     c$$$ enddo
711     c$$$
712     c$$$
713     c$$$ return
714     c$$$ end
715    
716     subroutine stripmask(iv,ivk)
717 mocchiut 1.1
718 pam-fi 1.18 * -----------------------------------------------
719 mocchiut 1.1 * this routine set va1 and single-strip masks,
720     * on the basis of the VA1 mask saved in the DB
721     *
722     * mask(nviews,nva1_view,nstrips_va1) !strip mask
723     * mask_vk(nviews,nva1_view) !VA1 mask
724 pam-fi 1.18 * -----------------------------------------------
725 mocchiut 1.1 include 'commontracker.f'
726 pam-fi 1.5 include 'level1.f'
727 pam-fi 1.4 include 'common_reduction.f'
728 mocchiut 1.1 include 'calib.f'
729    
730     * init mask
731 pam-fi 1.13 do is=1,nstrips_va1
732 pam-fi 1.18 * --------------------------------------------------------
733     * if VA1-mask from DB is 0 or 1, three masks are combined:
734     * - from DB (a-priori mask)
735     * - run-based (chip declared bad on the basis of <SIG>)
736     * - event-based (failure in CN computation)
737     * --------------------------------------------------------
738 pam-fi 1.20 c print*,iv,ivk
739     c $ ,mask_vk(iv,ivk),mask_vk_ev(iv,ivk),mask_vk_run(iv,ivk)
740 pam-fi 1.13 if( mask_vk(iv,ivk) .ne. -1)then
741     mask(iv,ivk,is) = 1
742 pam-fi 1.18 $ * mask_vk(iv,ivk) !from DB
743     $ * mask_vk_ev(iv,ivk) !from <SIG>
744 pam-fi 1.13 $ * mask_vk_run(iv,ivk) !from CN
745 pam-fi 1.18 * -----------------------------------------------------------
746     * if VA1-mask from DB is -1 only event-based mask is applied
747     * -----------------------------------------------------------
748 pam-fi 1.13 else
749     mask(iv,ivk,is) = -1
750 pam-fi 1.18 $ * mask_vk(iv,ivk) !from DB
751     $ * mask_vk_ev(iv,ivk) !from CN
752 pam-fi 1.13 endif
753 mocchiut 1.1 enddo
754 pam-fi 1.13
755    
756 mocchiut 1.1 return
757     end

  ViewVC Help
Powered by ViewVC 1.1.23