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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.22 - (hide annotations) (download)
Mon Feb 15 20:47:11 2010 UTC (14 years, 9 months ago) by mocchiut
Branch: MAIN
CVS Tags: v9r00, v9r01
Changes since 1.21: +1 -1 lines
F77 compilation warning on gcc4.x fixed

1 mocchiut 1.1 *************************************************************************
2     * Program analysis.f
3     *
4     * - reads cluster information (LEVEL1, reduction.f output ntuple)
5     * - perform track identification and fit
6     * - create LEVEL2 ntuple
7     *
8     *************************************************************************
9 pam-fi 1.15 subroutine analysisflight
10 mocchiut 1.1
11     include 'commontracker.f'
12 pam-fi 1.4 include 'level1.f'
13 mocchiut 1.1 include 'common_momanhough.f'
14     include 'common_mech.f'
15     include 'common_xyzPAM.f'
16     include 'common_mini_2.f'
17     include 'calib.f'
18     include 'level2.f'
19    
20 pam-fi 1.10 * input flag
21     *
22 pam-fi 1.15 c integer fin
23 pam-fi 1.10
24 mocchiut 1.1 * flag to chose PFA
25     character*10 PFA
26     common/FINALPFA/PFA
27    
28     c parameter (inf=1.e8) !just a huge number...
29    
30     * external functions
31     external npl
32     external acoordsi,coordsi,nld,coord,dcoord
33    
34 pam-fi 1.17 integer hitplanex(6)
35     integer hitplaney(6)
36    
37     logical BAD_NUCLEUS
38    
39 mocchiut 1.1 ************************************************************
40     ************************************************************
41     ************************************************************
42     *
43     * track analysis
44     *
45     ************************************************************
46     ************************************************************
47     ************************************************************
48 pam-fi 1.15
49     call idtoc(pfaid,PFA)
50    
51 mocchiut 1.1
52 pam-fi 1.16 if(DEBUG.EQ.1)then
53 mocchiut 1.1 print*,'----------------------------------'
54 pam-fi 1.15 print*,'Settings: '
55 pam-fi 1.16 print*,'PFA ',pfaid,' ---> ',PFA
56 pam-fi 1.15 print*,'tracking mode ',trackmode
57     print*,'fit-tolerance factor ',fact
58     print*,'minimum n.step ',istepmin
59 pam-fi 1.16
60 mocchiut 1.1 endif
61    
62 pam-fi 1.17 RECOVER_SINGLETS = .false.
63     RECOVER_NUCLEI = .false.
64     SECOND_SEARCH = .false.
65 mocchiut 1.1
66 pam-fi 1.17 ntrk_old = 0
67    
68 pamelats 1.21 dedx_x_min = dedx_x_min_mip !mip search
69     dedx_y_min = dedx_y_min_mip !
70    
71 mocchiut 1.22 c 887 continue ! Emiliano, fix compilation warning (gcc 4.1), Label 887 defined but not used
72 pamelats 1.21
73     *------------------------------------------------------
74 mocchiut 1.1 do i=1,nclstr1
75     cl_used(i)=0 !init mask of clusters associated to a track
76     enddo
77 pamelats 1.21
78 pam-fi 1.17 call init_level2
79     call init_hough
80     *------------------------------------------------------
81    
82     888 continue
83 mocchiut 1.1
84 pam-fi 1.17
85 mocchiut 1.1 * ///////////////////////////////////////////////
86     * \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
87    
88     iflag=0
89     call track_finding(iflag)
90     if(iflag.eq.1)then !bad event
91     goto 880 !fill ntp and go to next event
92     endif
93    
94 pam-fi 1.19 * ----------------------------------------------------
95 pam-fi 1.17 * fill hough output variables only for the first searc
96 pam-fi 1.19 * ----------------------------------------------------
97 pam-fi 1.17 if(.not.SECOND_SEARCH)call fill_hough
98 pam-fi 1.7
99 mocchiut 1.1 iflag=0
100     call track_fitting(iflag)
101    
102 pam-fi 1.17
103     * ////////////////////////////////////////////////
104     * PATCH to recover events with less than 3 couples
105     * ////////////////////////////////////////////////
106     * if no tracks have been found
107     * and n.planes with at least one couple (planehit)
108     * is less than 3 try to recover applying the hough
109     * transform to singlet
110     nplanehit=0
111     do ip=1,NPLANES
112     if(ncp_plane(ip).gt.0)nplanehit=nplanehit+1
113     enddo
114     if(DEBUG.eq.1)then
115     cc if(.true.)then
116     print*,''
117     print*,'-----------------------------------'
118     print*,'n.tracks ',ntrk
119     print*,'n.hit-planes ',nplanehit
120     endif
121     if(
122     $ .not.RECOVER_SINGLETS.and. !recover only once
123     $ ntrk.eq.0 .and. !no tracks has been found
124     $ nplanehit.le.3 .and. !if less than 3 hit planes (n.real couples)
125     $ .true.)then
126     RECOVER_SINGLETS=.true.
127     cc if(.true.)
128     if(DEBUG.EQ.1)
129     $ print*,' -----> ((( TRY TO RECOVER SINGLETS )))'
130     goto 888 !back to track finding
131     endif
132    
133    
134     * ////////////////////////////////////////////////
135     * PATCH to recover nuclei
136     * ////////////////////////////////////////////////
137     itrk = ntrk !check the last track first
138     isimage = 0
139     BAD_NUCLEUS=.false.
140     150 continue
141    
142     dedxav = 0.
143     npt = 0
144     dedxmin = 1000000
145     if(itrk.gt.0)then
146     do ip=1,NPLANES
147     cc print*,ip,' ** ',dedx_x(ip,itrk),dedx_y(ip,itrk)
148     if(xgood_nt(ip,itrk).eq.1)then
149     dedxav = dedxav + abs(dedx_x(ip,itrk))
150     if(abs(dedx_x(ip,itrk)).lt.dedxmin)
151     $ dedxmin=abs(dedx_x(ip,itrk))
152     npt = npt + 1
153     endif
154     if(ygood_nt(ip,itrk).eq.1)then
155     dedxav = dedxav + abs(dedx_y(ip,itrk))
156     if(abs(dedx_y(ip,itrk)).lt.dedxmin)
157     $ dedxmin=abs(dedx_y(ip,itrk))
158     npt = npt + 1
159     endif
160     enddo
161     if(npt.gt.0)dedxav = dedxav/npt
162     if( dedxav.gt.dedx_min_nuclei )then
163     if( (dedxav-dedxmin)/dedxav.gt.ddedx_min_nuclei )
164     $ BAD_NUCLEUS=.true.
165     endif
166     endif
167     if(DEBUG.eq.1)then
168     cc if(.true.)then
169     print*,''
170     print*,'-----------------------------------'
171     print*,'itrk ',itrk
172     print*,'dedx(average) ',dedxav,' cut ',dedx_min_nuclei
173     print*,'dedx(minimum) ',dedxmin
174     if(dedxav.gt.0)print*,'(av-min)/av',(dedxav-dedxmin)/dedxav
175     $ ,' cut ',ddedx_min_nuclei
176     print*,'BAD_NUCLEUS ? ',BAD_NUCLEUS
177     endif
178    
179     itrk=0
180     if(ntrk.gt.0)itrk = image(ntrk)
181     if(itrk.gt.0.and.isimage.eq.0)then !hence check the image
182     isimage=1
183     goto 150
184     endif
185    
186    
187     if(
188     $ .not.RECOVER_NUCLEI.and. !recover only once
189     $ (ntrk.eq.0.or.BAD_NUCLEUS).and. !no tracks found or bad nucleus
190     $ .true.)then
191    
192     RECOVER_NUCLEI = .true.
193     dedx_x_min = dedx_x_min_nuclei
194     dedx_y_min = dedx_y_min_nuclei
195     cc if(.true.)
196     if(DEBUG.EQ.1)
197     $ print*,' -----> ((( TRY TO RECOVER NUCLEI )))'
198     * ----------------------------------------------
199     * in case of re-tracking, un-tag used clusters
200     * ----------------------------------------------
201     if(ntrk.ne.0)then
202     do ip=1,NPLANES
203     if(cltrx(ip,ntrk).ne.0)cl_used(cltrx(ip,ntrk)) = 0 !un-tag used clusters
204     if(cltry(ip,ntrk).ne.0)cl_used(cltry(ip,ntrk)) = 0 !un-tag used clusters
205     enddo
206     ntrk = ntrk-1 !decrement track
207     if(isimage.eq.1)then
208     do ip=1,NPLANES
209     if(cltrx(ip,ntrk).ne.0)cl_used(cltrx(ip,ntrk)) = 0 !un-tag used clusters
210     if(cltry(ip,ntrk).ne.0)cl_used(cltry(ip,ntrk)) = 0 !un-tag used clusters
211     enddo
212     ntrk = ntrk-1 !decrement track image
213     endif
214     endif
215     goto 888 !back to track finding
216    
217     endif
218     * ----------------------------------------------
219     * back to default parameters for the second-track search
220     * ----------------------------------------------
221     if(RECOVER_NUCLEI)then
222     dedx_x_min = dedx_x_min_mip
223     dedx_y_min = dedx_y_min_mip
224     RECOVER_NUCLEI = .false.
225     endif
226    
227     if(ntrk.eq.0)goto 880
228    
229     * /////////////////////////////////////////////////////
230     * PATCH to perform a more efficient second-track search
231     * /////////////////////////////////////////////////////
232     * -------------------------------------------------
233     * n. hit planes and number of clusters
234     * -------------------------------------------------
235     do ip=1,NPLANES
236     hitplanex(ip)=0
237     hitplaney(ip)=0
238     nclusters=0
239     enddo
240     do icl=1,nclstr1
241     ip = npl(VIEW(icl))
242     if(cl_good(icl).eq.0.or.cl_used(icl).eq.1)goto 9
243     if(mod(VIEW(icl),2).eq.1)hitplaney(ip)=hitplaney(ip)+1 !YY
244     if(mod(VIEW(icl),2).eq.0)hitplanex(ip)=hitplanex(ip)+1 !XX
245     nclusters=nclusters+1
246     9 continue
247     enddo
248     nhitplaney=0
249     nhitplanex=0
250     do ip=1,NPLANES
251     if(hitplaney(ip).gt.0)nhitplaney=nhitplaney+1
252     if(hitplanex(ip).gt.0)nhitplanex=nhitplanex+1
253     enddo
254     * -------------------------------------------------
255     * chi2 cut
256     * -------------------------------------------------
257     p0 = 1.111588e+00
258     p1 = 1.707656e+00
259     p2 = 1.489693e-01
260     chi2m025 = p0
261     $ + abs(al_nt(5,ntrk))*p1
262     $ + al_nt(5,ntrk)*al_nt(5,ntrk)*p2
263     chi2m025_0 = p0 + 0.07*p1 + 0.07*0.07*p2
264     cc chi2m = (chi2m025-chi2m025_0+12**0.25)**4. !95%
265     chi2m = (chi2m025-chi2m025_0+20.**0.25)**4. !???
266     * -------------------------------------------------
267     * image track
268     * -------------------------------------------------
269     ntrk_best = ntrk
270     chi2_best = chi2_nt(ntrk)
271     if(image(ntrk).ne.0)
272     $ chi2_best = min(chi2_nt(ntrk),chi2_nt(image(ntrk)))
273     if(DEBUG.eq.1)then
274     cc if(.true.)then
275     print*,''
276     print*,'-----------------------------------'
277     print*,'chi2_nt(',ntrk_best,') = ',chi2_best,' < ',chi2m,' ?'
278     print*,'nhitplanex',nhitplanex
279     print*,'nhitplaney',nhitplaney
280     print*,'nclusters',nclusters
281     endif
282     if(
283     $ ntrk.gt.ntrk_old.and. !one track must have been already found
284     $ chi2_best.gt.0 .and. !this track must not be garbage
285     $ chi2_best.lt.chi2m .and. !"
286     $ nhitplaney.ge.3.and. !a minimum number of hit planes is required
287     $ nhitplanex.ge.3.and. !"
288     $ nclusters.le.20.and. !limit on number of clusters to save time
289     $ .true.)then
290    
291     SECOND_SEARCH=.true.
292 pam-fi 1.18 c RECOVER_SINGLETS=.true. !OPTIMIZATION
293 pam-fi 1.17 ntrk_old=ntrk
294    
295     if(DEBUG.EQ.1)
296     cc if(.true.)
297     $ print*,'***** NEW SEARCH ****'
298     goto 888 !back to track finding
299 mocchiut 1.1
300 pam-fi 1.17 endif
301 mocchiut 1.1
302     880 continue
303    
304     * **********************************************************
305     * stores info about clusters not associated with any track
306     * **********************************************************
307    
308     call fill_level2_siglets
309    
310 pam-fi 1.16 if(DEBUG.EQ.1)then
311 mocchiut 1.1 print*,''
312     print*,'DONE!'
313     print*,''
314     print*,'* summary *'
315     print*,'tracks ',ntrk
316     print*,'cl used ',(cl_used(i),i=1,nclstr1)
317     print*,''
318     print*,''
319     endif
320 pam-fi 1.5
321     ngood = 0
322     do iv = 1,nviews
323     ngood = ngood + good1(iv)
324     enddo
325 mocchiut 1.1
326 mocchiut 1.20 c 8800 continue
327     continue
328 mocchiut 1.1
329    
330     * ///////////////////////////////////////////////
331     * \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
332    
333 mocchiut 1.20 c 100 continue
334     continue
335 mocchiut 1.1
336     return
337     end
338    
339    
340     ************************************************************
341    
342    

  ViewVC Help
Powered by ViewVC 1.1.23