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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations) (download)
Fri Aug 4 08:18:06 2006 UTC (18 years, 4 months ago) by pam-fi
Branch: MAIN
Changes since 1.2: +29 -8 lines
some memory leak bugs fixed + CN computation modified

1 mocchiut 1.1 *************************************************************************
2     *
3     * Subroutine cncomp.f
4     *
5     * iterates common noise computation subroutine (./cnoise.f) and cluster
6     * cutting subroutine (./cutcn.f) till no more clusters are found
7     *
8     *************************************************************************
9    
10 pam-fi 1.2 subroutine cncomp(i,j,errflag) !(view, VA1)
11 mocchiut 1.1
12     include 'commontracker.f'
13     include 'common_reduction.f'
14     include 'calib.f'
15    
16     integer errflag !error flag to mark no signal free VA1
17     integer clstr_old(nstrips_va1) !flag storage vector
18     real signal(nstrips_va1) !"signal" (=adc-ped) value storage vector
19     real smean, ssigma !"signal" mean and sigma
20     real cut !"strange" strip exclusion cut
21     integer newclstr !flag to warn about new found clusters to be
22 pam-fi 1.2 c ! excluded from common noise computation
23 mocchiut 1.1
24     c------------------------------------------------------------------------
25 pam-fi 1.2 c
26 mocchiut 1.1 c variables initialization
27 pam-fi 1.2 c
28 mocchiut 1.1 c------------------------------------------------------------------------
29     do k=1,nstrips_va1 !loops on strips
30     clstr(i,j,k)=1 !initializes signal affected strips flag
31     clstr_old(k)=1 !initializes signal affected strips storage
32     strange(i,j,k)=1 !initializes unusually high or low signal
33     enddo ! affected strips flag
34    
35     newclstr=1 !flag to warn about new found signal
36 pam-fi 1.2 c ! affected strips
37 mocchiut 1.1 c------------------------------------------------------------------------
38 pam-fi 1.2 c
39 mocchiut 1.1 c high or low signal affected strips exclusion: computes "signal" (=adc-ped)
40     c mean value and sigma, and cuts from common noise computation strips
41     c whose ABS(signal) exceeds scut*sigma
42 pam-fi 1.2 c
43 mocchiut 1.1 c------------------------------------------------------------------------
44     countme=0 !???
45     666 continue !???
46    
47     smean=0. !initialization
48     ssigma=0.
49     nstr=0
50    
51     do k=1,nstrips_va1
52 pam-fi 1.2 nstr = nstr + strange(i,j,k) !uses only
53 mocchiut 1.1 if(mod(i,2).eq.1) then !odd strip ---> Y view
54 pam-fi 1.2 signal(k) = - (DBLE(adc(i,j,k)) - pedestal(i,j,k)) !negative signal
55 mocchiut 1.1 else !even strip ---> X view
56 pam-fi 1.2 signal(k) = DBLE(adc(i,j,k)) - pedestal(i,j,k) !positive signal
57 mocchiut 1.1 endif
58 pam-fi 1.2 smean = smean + signal(k)*strange(i,j,k)
59     ssigma = ssigma + (signal(k)**2)*strange(i,j,k)
60 mocchiut 1.1 enddo
61    
62     smean=smean/nstr !strips value distribution mean
63    
64     ssigma=SQRT((ssigma/nstr)-smean**2) !strips value distribution sigma
65    
66     cut=scut*ssigma !exclusion cut
67    
68 pam-fi 1.3 nco=0
69     nbo=0
70 mocchiut 1.1 do k=1,nstrips_va1
71     if(ABS(signal(k)-smean).gt.cut) then
72     strange(i,j,k)=0 !marks strips exceeding cut
73 pam-fi 1.3 c print*,i,j,k,signal(k),smean
74 mocchiut 1.1 endif
75 pam-fi 1.3 nco=nco+strange(i,j,k)
76     nbo=nbo+bad(i,j,k)
77 mocchiut 1.1 enddo ! in order not to use them in CN computation
78    
79 pam-fi 1.3 c$$$ if(i.eq.12.and.(j.eq.2.or.j.eq.3))then
80     c$$$ print*,'view ',i,' vk ',j
81     c$$$ print*,'ADC (1-51-128) = ',adc(i,j,1),adc(i,j,52),adc(i,j,128)
82     c$$$ print*,'<ADC-PED> = ',smean
83     c$$$ print*,'s = ',ssigma
84     c$$$ print*,'nstrange = ',128-nco
85     c$$$ print*,'nbad = ',128-nbo
86     c$$$ endif
87 mocchiut 1.1
88 pam-fi 1.2 countme = countme + 1 !???
89 mocchiut 1.1 if (countme.le.3) goto 666 !???
90    
91     c------------------------------------------------------------------------
92     c
93     c common noise computation
94     c
95 pam-fi 1.2 c-----------------------------------------------------------------------
96     * loops on this VA1 till no new signal affected strips are found
97     do while(newclstr.eq.1)
98 mocchiut 1.1
99 pam-fi 1.2 newclstr=0 !to exit from loop if no new cluster is found
100 mocchiut 1.1
101     errflag=0
102 pam-fi 1.2 call cnoise(i,j,errflag) !(view, VA1, error flag) computes cn
103     if(errflag.eq.1) goto 10 !goes to next VA1: this one has no signal-free strips...
104 mocchiut 1.1
105 pam-fi 1.2 call cutcn(i,j) !(view, VA1) excludes clusters from cn computation
106 mocchiut 1.1
107     ncs=0 !initializes number of strips not excluded by cncut
108     do k=1,nstrips_va1 !loops on strips
109 pam-fi 1.2 * checks if there are new found clusters, and if so sets
110     if(clstr(i,j,k).ne.clstr_old(k)) then
111     newclstr=1
112     clstr_old(k)=clstr(i,j,k)
113     endif
114 mocchiut 1.1 iok=strange(i,j,k)*bad(i,j,k)*clstr(i,j,k)
115     ncs=ncs+iok !counts number of good strips for cn computation
116     enddo
117    
118 pam-fi 1.2 enddo !ends do while
119 mocchiut 1.1
120     10 continue
121    
122     return
123     end
124    
125    
126    
127    
128     *************************************************************************
129     *
130     * Subroutine cnoise.f!DA COMMENTARE!???
131     *
132     * uses adc(nviews,nva1_view,nstrips_va1) and
133     * pedestal(nviews,nva1_view,nstrips_va1) variables to compute common noise,
134     * and fills cn(nviews,nva1_view) variable. in the computation only
135     * not-bad and not-signal-affected strips are used
136     * (bad(nviews,nva1_view,nstrips_va1) and
137     * clstr(nviews,nva1_view,nstrips_va1) flags)
138     *
139     * needs:
140     * - ./common_calib.f
141     *
142     * to be called inside ./cncomp.f
143     *
144     *************************************************************************
145    
146     subroutine cnoise(i,j,gulp) !(view, VA1)
147    
148     include 'commontracker.f'
149     include 'common_reduction.f'
150     include 'calib.f'
151    
152    
153     integer gulp !error flag
154    
155     ncn=0 !number of strips in cn computation
156     cn(i,j)=0 !initializes cn variable
157 pam-fi 1.3 cnflag(i,j)=0 !initialize cn flag OK
158 mocchiut 1.1
159     do k=1,nstrips_va1 !loops on strips
160 pam-fi 1.2 * tags strange, bad or signal-affected strips
161 pam-fi 1.3 iok = strange(i,j,k)*bad(i,j,k)*clstr(i,j,k)
162     cn(i,j) = cn(i,j) + (DBLE(adc(i,j,k)) - pedestal(i,j,k))*iok
163 mocchiut 1.1 ncn = ncn + iok !counts number of strips in cn computation
164     enddo
165 pam-fi 1.2
166 pam-fi 1.3 if(ncn.lt.NSTRIPMIN) then !no signal free strips on this VA1...
167 pam-fi 1.2 if(ncn.eq.0)then
168     if(debug)print*,' WARNING - cnoise: ',
169     $ 'no strips for CN computation on VA1 ',j,
170 pam-fi 1.3 $ ', VIEW ',i,' >>> FAILED '
171 pam-fi 1.2 else
172     if(debug)print*,' WARNING - cnoise: ',
173 pam-fi 1.3 $ 'less than ',NSTRIPMIN
174     $ ,' strips for CN computation on VA1 ',j,
175     $ ', VIEW ',i,' >>> FAILED '
176 pam-fi 1.2 endif
177 mocchiut 1.1 gulp=1
178 pam-fi 1.3 cnflag(i,j) = -1
179 mocchiut 1.1 else
180 pam-fi 1.2 cn(i,j)=cn(i,j)/DBLE(ncn) !<<<< computes common noise
181 pam-fi 1.3 if(ncn.lt.NSTRIPWARNING) then
182     if(debug)print*,' WARNING - cnoise: ',
183     $ 'less than ',NSTRIPWARNING
184     $ ,' strips for CN computation on VA1 ',j,
185     $ ', VIEW ',i
186     cnflag(i,j) = 1
187     endif
188 pam-fi 1.2 gulp=0
189 mocchiut 1.1 endif
190    
191     return
192     end
193    
194    
195     *************************************************************************
196     *
197     * Subroutine cutcn.f!DA COMMENTARE!???
198     *
199     * excludes strips with particle signals and/or noisy strips from common
200     * noise calculation, marking their clstr(nviews,nva1_view,nstrips_va1)
201     * flag:
202     * clstr=0 ---> not to be used in CN computation
203     * clstr=1 ---> to be used in CN computation
204     *
205     * needs:
206     * - ./common_calib.f
207     *
208     * to be called inside ./cncomp.f
209     *
210     *************************************************************************
211    
212     subroutine cutcn(i,j) !(view, VA1)
213    
214     include 'commontracker.f'
215     include 'common_reduction.f'
216     include 'calib.f'
217    
218    
219     integer skip !used to skip strips (see later...)
220    
221     integer kr, kl !position indexes to check signal affected
222     ! strips on right and left side of cluster
223     ! seed
224     integer ir, il !flags to exit loop on reaching VA1 extremes
225    
226     real valuec !cluster seed signal
227     real cut,stripcut !cluster seed cut
228    
229     real valuel, valuer !left and right strips signal
230     real stripcnincut !strip include cut
231    
232     skip = 0 !initializes skip
233    
234     do k=1,nstrips_va1 !loops on strips searching for cluster seeds
235    
236     if(k.le.skip) goto 20 !continues only if k strip has not been
237     ! checked yet
238    
239     clstr(i,j,k)=1 !reinitializes strip to be used in CN!???
240     ! computation, in order to be able to exclude
241     ! different strips at every CN computation loop
242    
243     c------------------------------------------------------------------------
244     c
245     c selects cut according to view
246     c
247     c------------------------------------------------------------------------
248     if(mod(i,2).eq.1) then !odd strip ---> Y view
249     valuec= - (DBLE(adc(i,j,k))-cn(i,j)-pedestal(i,j,k)) !negative signal
250     cut=clcuty !sets Y cut to find cluster seeds
251     else !even strip ---> X view
252     valuec= DBLE(adc(i,j,k))-cn(i,j)-pedestal(i,j,k) !positive signal
253     cut=clcutx !sets X cut to find cluster seeds
254     endif
255    
256    
257     c------------------------------------------------------------------------
258     c
259     c seeks clusters
260     c
261     c------------------------------------------------------------------------
262     stripcut=cut*sigma(i,j,k) !cluster seed cut
263    
264     c if(ABS(valuec).gt.stripcut) then !checks if signal exceeds threshold!???
265     if(valuec.gt.stripcut) then !checks if signal exceeds threshold
266    
267     c$$$ print*,'cut',i,j,k,valuec,stripcut,adc(i,j,k),cn(i,j)
268     c$$$ $ ,pedestal(i,j,k) !???
269    
270     clstr(i,j,k)=0 !if so, marks this strip as part of a
271     ! cluster
272    
273     c------------------------------------------------------------------------
274     c after finding a cluster seed, checks also adiacent strips, and marks
275     c the ones exceeding cnincut
276     c------------------------------------------------------------------------
277     kr=k !initializes position indexes to be equal to
278     kl=k ! cluster seed position
279    
280     ir=0 !initialize flags used to exit from
281     il=0 ! inclusion loop
282    
283     do while (il.eq.0.or.ir.eq.0) !shifts left and right from
284     ! cluster seed till it finds a strip below
285     ! the threshold, or till it reaches first or
286     ! last VA1 strip
287     kr=kr+1 !position index for strips on right side of
288     ! cluster seed
289     kl=kl-1 !and for left side
290    
291     c------------------------------------------------------------------------
292     c checks for last or first strip
293     c------------------------------------------------------------------------
294     if(kr.gt.nstrips_va1.and.ir.eq.0) then !when index goes
295     ir=1 ! beyond last VA1 strip, change ir flag in
296     ! order to "help" exiting from loop
297     skip=nstrips_va1+1 !sets skip beyond last strip: all
298     ! strips on the right have been included in
299     ! the cluster, so skips all next strips
300     ! (goto 20 condition is now always true)
301     endif
302    
303     if(kl.lt.1.and.il.eq.0) then !idem when index goes beyond
304     il=1 ! first strip
305     endif
306    
307     c P.S.: the "....and.i#.eq.0" term in above conditions is needed. In
308     c fact, even if I reach a under-cut strip on the right (so I get ir=1),
309     c the "do while loop" continues till such strip will be found on the
310     c left too.
311     c Thus kl and kr (! too) keep increasing, and it can happen kr gets
312     c greater than nstrips_va1 before kl reaches a under-cut strip. In this
313     c case it would pass this "if condition", so setting skip=nstrips_va1+1
314     c and skipping right strips never checked, if the "....and.i#.eq.0" term
315     c weren't the: instead, including this part it won't pass it
316     c because when I found reach the last VA1 strip on the right I set ir=1.
317     c (AAAAAAHHHHHHHHH!!!!!!!!!!!)
318    
319     c------------------------------------------------------------------------
320     c marks strips exceeding inclusion cut
321     c------------------------------------------------------------------------
322     c for right strips (kr index)
323     if(ir.eq.0) then !if last strip or last over-cut strip has
324     ! not been reached
325    
326     if(mod(i,2).eq.1) then !Y view
327     valuer= - (DBLE(adc(i,j,kr))-cn(i,j) !puts in valuer
328     $ -pedestal(i,j,kr)) ! right strip value
329     else !X view
330     valuer=DBLE(adc(i,j,kr))-cn(i,j)-pedestal(i,j,kr)
331     endif
332    
333     stripcnincut=cnincut*sigma(i,j,kr) !defines include cut
334     c if(ABS(valuer).gt.stripcnincut) then !marks right strip if it !???
335     if(valuer.gt.stripcnincut) then !marks right strip if it
336     clstr(i,j,kr)=0 !exceedes include cut
337     c$$$ print*,'inclcut_r',i,j,kr,valuer,stripcnincut
338     c$$$ $ ,adc(i,j,kr),cn(i,j),pedestal(i,j,kr) !???
339     else
340     ir=1 !otherwise cluster ends and ir flag =1
341     ! signals it
342     skip=kr !putting skip=kr, next k to be checked is
343     ! k=kr
344     endif
345    
346     endif
347    
348     c for left strips (kl index)
349     if(il.eq.0) then !if first strip or last over-cut strip has
350     ! not been reached
351    
352     if (mod(i,2).eq.1) then !Y view
353     valuel= - (DBLE(adc(i,j,kl))-cn(i,j) !puts in valuel
354     $ -pedestal(i,j,kl)) ! left strip value
355     else !X view
356     valuel=DBLE(adc(i,j,kl))-cn(i,j)-pedestal(i,j,kl)
357     endif
358    
359     stripcnincut=cnincut*sigma(i,j,kl) !defines include cut
360     c if(ABS(valuel).gt.stripcnincut) then !marks left strip if it!???
361     if(valuel.gt.stripcnincut) then !marks left strip if it
362     clstr(i,j,kl)=0 !exceedes include cut
363     c$$$ print*,'inclcut_l',i,j,kl,valuel,stripcnincut
364     c$$$ $ ,adc(i,j,kl),cn(i,j),pedestal(i,j,kl) !???
365     else
366     il=1 !otherwise cluster ends and il flag =1
367     ! signals it
368     endif
369    
370     endif
371    
372     enddo !ends lateral strips loop
373    
374     endif !ends cluster seed condition
375    
376     20 continue !comes here if next strip on the right has
377     ! already been included in a cluster
378    
379     enddo !ends principal strip loop
380    
381     return
382     end

  ViewVC Help
Powered by ViewVC 1.1.23