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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show 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 *************************************************************************
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 subroutine cncomp(i,j,errflag) !(view, VA1)
11
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 c ! excluded from common noise computation
23
24 c------------------------------------------------------------------------
25 c
26 c variables initialization
27 c
28 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 c ! affected strips
37 c------------------------------------------------------------------------
38 c
39 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 c
43 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 nstr = nstr + strange(i,j,k) !uses only
53 if(mod(i,2).eq.1) then !odd strip ---> Y view
54 signal(k) = - (DBLE(adc(i,j,k)) - pedestal(i,j,k)) !negative signal
55 else !even strip ---> X view
56 signal(k) = DBLE(adc(i,j,k)) - pedestal(i,j,k) !positive signal
57 endif
58 smean = smean + signal(k)*strange(i,j,k)
59 ssigma = ssigma + (signal(k)**2)*strange(i,j,k)
60 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 nco=0
69 nbo=0
70 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 c print*,i,j,k,signal(k),smean
74 endif
75 nco=nco+strange(i,j,k)
76 nbo=nbo+bad(i,j,k)
77 enddo ! in order not to use them in CN computation
78
79 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
88 countme = countme + 1 !???
89 if (countme.le.3) goto 666 !???
90
91 c------------------------------------------------------------------------
92 c
93 c common noise computation
94 c
95 c-----------------------------------------------------------------------
96 * loops on this VA1 till no new signal affected strips are found
97 do while(newclstr.eq.1)
98
99 newclstr=0 !to exit from loop if no new cluster is found
100
101 errflag=0
102 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
105 call cutcn(i,j) !(view, VA1) excludes clusters from cn computation
106
107 ncs=0 !initializes number of strips not excluded by cncut
108 do k=1,nstrips_va1 !loops on strips
109 * 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 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 enddo !ends do while
119
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 cnflag(i,j)=0 !initialize cn flag OK
158
159 do k=1,nstrips_va1 !loops on strips
160 * tags strange, bad or signal-affected strips
161 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 ncn = ncn + iok !counts number of strips in cn computation
164 enddo
165
166 if(ncn.lt.NSTRIPMIN) then !no signal free strips on this VA1...
167 if(ncn.eq.0)then
168 if(debug)print*,' WARNING - cnoise: ',
169 $ 'no strips for CN computation on VA1 ',j,
170 $ ', VIEW ',i,' >>> FAILED '
171 else
172 if(debug)print*,' WARNING - cnoise: ',
173 $ 'less than ',NSTRIPMIN
174 $ ,' strips for CN computation on VA1 ',j,
175 $ ', VIEW ',i,' >>> FAILED '
176 endif
177 gulp=1
178 cnflag(i,j) = -1
179 else
180 cn(i,j)=cn(i,j)/DBLE(ncn) !<<<< computes common noise
181 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 gulp=0
189 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