/[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.21 - (hide annotations) (download)
Tue Aug 7 13:56:29 2007 UTC (17 years, 4 months ago) by pam-fi
Branch: MAIN
Changes since 1.20: +18 -2 lines
cog modified

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

  ViewVC Help
Powered by ViewVC 1.1.23