/[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.2 - (show annotations) (download)
Tue May 30 16:30:37 2006 UTC (18 years, 6 months ago) by pam-fi
Branch: MAIN
CVS Tags: v0r02, v1r01beta, v1r00, v1r01
Changes since 1.1: +43 -79 lines
Error handling from F77 routine / Fixed some bugs with default calibration

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

  ViewVC Help
Powered by ViewVC 1.1.23