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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.19 - (hide annotations) (download)
Tue Feb 20 08:32:52 2007 UTC (17 years, 9 months ago) by pam-fi
Branch: MAIN
Changes since 1.18: +2 -2 lines
*** empty log message ***

1 mocchiut 1.1 ************************************************************
2     * The following subroutines
3     * - track_finding >> hough transform
4     * - track_fitting >> bob golden fitting
5     * all the procedures to create LEVEL2 data, starting from LEVEL1 data.
6     *
7     *
8     *
9     * (This subroutine and all the dependent subroutines
10     * will be included in the flight software)
11     ************************************************************
12     subroutine track_finding(iflag)
13    
14     include 'commontracker.f'
15 pam-fi 1.9 include 'level1.f'
16 mocchiut 1.1 include 'common_momanhough.f'
17     include 'common_mech.f'
18     include 'common_xyzPAM.f'
19     include 'common_mini_2.f'
20     include 'calib.f'
21     include 'level2.f'
22    
23 pam-fi 1.9 c include 'momanhough_init.f'
24 mocchiut 1.1
25     *-------------------------------------------------------------------------------
26     * STEP 1
27     *-------------------------------------------------------------------------------
28     * X-Y cluster association
29     *
30     * Clusters are associated to form COUPLES
31     * Clusters not associated in any couple are called SINGLETS
32     *
33     * Track identification (Hough transform) and fitting is first done on couples.
34     * Hence singlets are possibly added to the track.
35     *
36     * Variables assigned by the routine "cl_to_couples" are those in the
37     * common blocks:
38     * - common/clusters/cl_good
39     * - common/couples/clx,cly,ncp_plane,ncp_tot,cp_useds1,cp_useds2
40     * - common/singlets/ncls,cls,cl_single
41     *-------------------------------------------------------------------------------
42     *-------------------------------------------------------------------------------
43    
44     c iflag=0
45     call cl_to_couples(iflag)
46     if(iflag.eq.1)then !bad event
47 pam-fi 1.9 goto 880 !go to next event
48 mocchiut 1.1 endif
49    
50     *-----------------------------------------------------
51     *-----------------------------------------------------
52     * HOUGH TRASFORM
53     *-----------------------------------------------------
54     *-----------------------------------------------------
55    
56    
57     *-------------------------------------------------------------------------------
58     * STEP 2
59     *-------------------------------------------------------------------------------
60     *
61     * Association of couples to form
62     * - DOUBLETS in YZ view
63     * - TRIPLETS in XZ view
64     *
65     * Variables assigned by the routine "cp_to_doubtrip" are those in the
66     * common blocks:
67     * - common/hough_param/
68     * $ alfayz1, !Y0
69     * $ alfayz2, !tg theta-yz
70     * $ alfaxz1, !X0
71     * $ alfaxz2, !tg theta-xz
72     * $ alfaxz3 !1/r
73     * - common/doublets/ndblt,cpyz1,cpyz2
74     * - common/triplets/ntrpt,cpxz1,cpxz2,cpxz3
75     *-------------------------------------------------------------------------------
76     *-------------------------------------------------------------------------------
77    
78     c iflag=0
79     call cp_to_doubtrip(iflag)
80     if(iflag.eq.1)then !bad event
81 pam-fi 1.9 goto 880 !go to next event
82 mocchiut 1.1 endif
83    
84    
85     *-------------------------------------------------------------------------------
86     * STEP 3
87     *-------------------------------------------------------------------------------
88     *
89     * Classification of doublets and triplets to form CLOUDS,
90     * according to distance in parameter space.
91     *
92     * cloud = cluster of points (doublets/triplets) in parameter space
93     *
94     *
95     *
96     * Variables assigned by the routine "doub_to_YZcloud" are those in the
97     * common blocks:
98     * - common/clouds_yz/
99     * $ nclouds_yz
100     * $ ,alfayz1_av,alfayz2_av
101     * $ ,ptcloud_yz,db_cloud,cpcloud_yz
102     *
103     * Variables assigned by the routine "trip_to_XZcloud" are those in the
104     * common blocks:
105     * common/clouds_xz/
106     * $ nclouds_xz xz2_av,alfaxz3_av
107     * $ ,ptcloud_xz,tr_cloud,cpcloud_xz
108     *-------------------------------------------------------------------------------
109     *-------------------------------------------------------------------------------
110 pam-fi 1.9 * count number of hit planes
111     planehit=0
112     do np=1,nplanes
113     if(ncp_plane(np).ne.0)then
114     planehit=planehit+1
115     endif
116     enddo
117     if(planehit.lt.3) goto 880 ! exit
118    
119     nptxz_min=x_min_start
120     nplxz_min=x_min_start
121    
122     nptyz_min=y_min_start
123     nplyz_min=y_min_start
124    
125     cutdistyz=cutystart
126     cutdistxz=cutxstart
127 mocchiut 1.1
128 pam-fi 1.9 878 continue
129 mocchiut 1.1 call doub_to_YZcloud(iflag)
130     if(iflag.eq.1)then !bad event
131     goto 880 !fill ntp and go to next event
132 pam-fi 1.9 endif
133     if(nclouds_yz.eq.0.and.cutdistyz.lt.maxcuty)then
134     if(cutdistyz.lt.maxcuty/2)then
135     cutdistyz=cutdistyz+cutystep
136     else
137     cutdistyz=cutdistyz+(3*cutystep)
138     endif
139     goto 878
140     endif
141    
142     if(planehit.eq.3) goto 881
143    
144     879 continue
145 mocchiut 1.1 call trip_to_XZcloud(iflag)
146     if(iflag.eq.1)then !bad event
147     goto 880 !fill ntp and go to next event
148     endif
149 pam-fi 1.9
150     if(nclouds_xz.eq.0.and.cutdistxz.lt.maxcutx)then
151     cutdistxz=cutdistxz+cutxstep
152     goto 879
153     endif
154    
155    
156     881 continue
157     * if there is at least three planes on the Y view decreases cuts on X view
158     if(nclouds_xz.eq.0.and.nclouds_yz.gt.0.and.
159     $ nplxz_min.ne.y_min_start)then
160     nptxz_min=x_min_step
161     nplxz_min=x_min_start-x_min_step
162     goto 879
163     endif
164    
165 mocchiut 1.1 880 return
166     end
167    
168     ************************************************************
169    
170    
171     subroutine track_fitting(iflag)
172    
173     include 'commontracker.f'
174 pam-fi 1.9 include 'level1.f'
175 mocchiut 1.1 include 'common_momanhough.f'
176     include 'common_mech.f'
177     include 'common_xyzPAM.f'
178     include 'common_mini_2.f'
179     include 'calib.f'
180     include 'level2.f'
181    
182 pam-fi 1.9 c include 'momanhough_init.f'
183 mocchiut 1.1
184     logical FIMAGE !
185 pam-fi 1.11 real*8 AL_GUESS(5)
186 mocchiut 1.1
187     *-------------------------------------------------------------------------------
188     * STEP 4 (ITERATED until any other physical track isn't found)
189     *-------------------------------------------------------------------------------
190     *
191     * YZ and XZ clouds are combined in order to obtain the initial guess
192     * of the candidate-track parameters.
193     * A minimum number of matching couples between YZ and XZ clouds is required.
194     *
195     * A TRACK CANDIDATE is defined by
196     * - the couples resulting from the INTERSECTION of the two clouds, and
197     * - the associated track parameters (evaluated by performing a zero-order
198     * track fitting)
199     *
200     * The NTRACKS candidate-track parameters are stored in common block:
201     *
202     * - common/track_candidates/NTRACKS,AL_STORE
203     * $ ,XV_STORE,YV_STORE,ZV_STORE
204     * $ ,XM_STORE,YM_STORE,ZM_STORE
205     * $ ,RESX_STORE,RESY_STORE
206     * $ ,AXV_STORE,AYV_STORE
207     * $ ,XGOOD_STORE,YGOOD_STORE
208     * $ ,CP_STORE,RCHI2_STORE
209     *
210     *-------------------------------------------------------------------------------
211     *-------------------------------------------------------------------------------
212     ntrk=0 !counter of identified physical tracks
213    
214     11111 continue !<<<<<<< come here when performing a new search
215    
216     c iflag=0
217     call clouds_to_ctrack(iflag)
218     if(iflag.eq.1)then !no candidate tracks found
219     goto 880 !fill ntp and go to next event
220     endif
221    
222     FIMAGE=.false. !processing best track (not track image)
223     ibest=0 !best track among candidates
224     iimage=0 !track image
225     * ------------- select the best track -------------
226 pam-fi 1.9 c$$$ rchi2best=1000000000.
227     c$$$ do i=1,ntracks
228     c$$$ if(RCHI2_STORE(i).lt.rchi2best.and.
229     c$$$ $ RCHI2_STORE(i).gt.0)then
230     c$$$ ibest=i
231     c$$$ rchi2best=RCHI2_STORE(i)
232     c$$$ endif
233     c$$$ enddo
234     c$$$ if(ibest.eq.0)goto 880 !>> no good candidates
235    
236 pam-fi 1.15 * -------------------------------------------------------
237     * order track-candidates according to:
238     * 1st) decreasing n.points
239     * 2nd) increasing chi**2
240     * -------------------------------------------------------
241     rchi2best=1000000000.
242 pam-fi 1.9 ndofbest=0 !(1)
243 mocchiut 1.1 do i=1,ntracks
244 pam-fi 1.15 ndof=0 !(1)
245     do ii=1,nplanes !(1)
246     ndof=ndof !(1)
247     $ +int(xgood_store(ii,i)) !(1)
248     $ +int(ygood_store(ii,i)) !(1)
249     enddo !(1)
250     if(ndof.gt.ndofbest)then !(1)
251     ibest=i
252     rchi2best=RCHI2_STORE(i)
253     ndofbest=ndof !(1)
254     elseif(ndof.eq.ndofbest)then !(1)
255     if(RCHI2_STORE(i).lt.rchi2best.and.
256     $ RCHI2_STORE(i).gt.0)then
257 mocchiut 1.1 ibest=i
258     rchi2best=RCHI2_STORE(i)
259 pam-fi 1.9 ndofbest=ndof !(1)
260     endif !(1)
261     endif
262 mocchiut 1.1 enddo
263 pam-fi 1.15
264     c$$$ rchi2best=1000000000.
265     c$$$ ndofbest=0 !(1)
266     c$$$ do i=1,ntracks
267     c$$$ if(RCHI2_STORE(i).lt.rchi2best.and.
268     c$$$ $ RCHI2_STORE(i).gt.0)then
269     c$$$ ndof=0 !(1)
270     c$$$ do ii=1,nplanes !(1)
271     c$$$ ndof=ndof !(1)
272     c$$$ $ +int(xgood_store(ii,i)) !(1)
273     c$$$ $ +int(ygood_store(ii,i)) !(1)
274     c$$$ enddo !(1)
275     c$$$ if(ndof.ge.ndofbest)then !(1)
276     c$$$ ibest=i
277     c$$$ rchi2best=RCHI2_STORE(i)
278     c$$$ ndofbest=ndof !(1)
279     c$$$ endif !(1)
280     c$$$ endif
281     c$$$ enddo
282    
283 mocchiut 1.1 if(ibest.eq.0)goto 880 !>> no good candidates
284     *-------------------------------------------------------------------------------
285     * The best track candidate (ibest) is selected and a new fitting is performed.
286     * Previous to this, the track is refined by:
287     * - possibly adding new COUPLES or SINGLETS from the missing planes
288     * - evaluating the coordinates with improved PFAs
289     * ( angle-dependent ETA algorithms )
290     *-------------------------------------------------------------------------------
291    
292     1212 continue !<<<<< come here to fit track-image
293    
294     if(.not.FIMAGE)then !processing best candidate
295     icand=ibest
296     else !processing image
297     icand=iimage
298     iimage=0
299     endif
300     if(icand.eq.0)then
301     print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand
302     $ ,ibest,iimage
303     return
304     endif
305    
306     * *-*-*-*-*-*-*-*-*-*-*-*-*-*-*
307     call refine_track(icand)
308     * *-*-*-*-*-*-*-*-*-*-*-*-*-*-*
309    
310     * **********************************************************
311     * ************************** FIT *** FIT *** FIT *** FIT ***
312     * **********************************************************
313 pam-fi 1.11 call guess()
314     do i=1,5
315     AL_GUESS(i)=AL(i)
316     enddo
317 pam-fi 1.17 c print*,'## guess: ',al
318 pam-fi 1.11
319 mocchiut 1.1 do i=1,5
320 pam-fi 1.3 AL(i)=dble(AL_STORE(i,icand))
321 mocchiut 1.1 enddo
322 pam-fi 1.11
323 pam-fi 1.3 IDCAND = icand !fitted track-candidate
324 mocchiut 1.1 ifail=0 !error flag in chi2 computation
325     jstep=0 !# minimization steps
326 pam-fi 1.9
327 pam-fi 1.8 iprint=0
328 pam-fi 1.11 c if(DEBUG)iprint=1
329 pam-fi 1.13 if(VERBOSE)iprint=1
330 pam-fi 1.16 if(DEBUG)iprint=2
331 pam-fi 1.8 call mini2(jstep,ifail,iprint)
332 mocchiut 1.1 if(ifail.ne.0) then
333 pam-fi 1.16 if(VERBOSE)then
334 mocchiut 1.1 print *,
335 pam-fi 1.11 $ '*** MINIMIZATION FAILURE *** (after refinement) '
336 mocchiut 1.1 $ ,iev
337 pam-fi 1.11
338 pam-fi 1.12 c$$$ print*,'guess: ',(al_guess(i),i=1,5)
339     c$$$ print*,'previous: ',(al_store(i,icand),i=1,5)
340     c$$$ print*,'result: ',(al(i),i=1,5)
341     c$$$ print*,'xgood ',xgood
342     c$$$ print*,'ygood ',ygood
343     c$$$ print*,'----------------------------------------------'
344 mocchiut 1.1 endif
345 pam-fi 1.11 c chi2=-chi2
346 mocchiut 1.1 endif
347    
348     if(DEBUG)then
349     print*,'----------------------------- improved track coord'
350     22222 format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
351     do ip=1,6
352     write(*,22222)ip,zm(ip),xm(ip),ym(ip)
353     $ ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip)
354     $ ,xgood(ip),ygood(ip),resx(ip),resy(ip)
355     enddo
356     endif
357    
358     c rchi2=chi2/dble(ndof)
359     if(DEBUG)then
360     print*,' '
361     print*,'****** SELECTED TRACK *************'
362     print*,'# R. chi2 RIG'
363     print*,' --- ',chi2,' --- '
364     $ ,1./abs(AL(5))
365     print*,'***********************************'
366     endif
367     * **********************************************************
368     * ************************** FIT *** FIT *** FIT *** FIT ***
369     * **********************************************************
370    
371    
372     * ------------- search if the track has an IMAGE -------------
373     * ------------- (also this is stored ) -------------
374     if(FIMAGE)goto 122 !>>> jump! (this is already an image)
375     * now search for track-image, by comparing couples IDs
376     do i=1,ntracks
377     iimage=i
378     do ip=1,nplanes
379     if( CP_STORE(nplanes-ip+1,icand).ne.
380     $ -1*CP_STORE(nplanes-ip+1,i) )iimage=0
381     enddo
382     if( iimage.ne.0.and.
383     c $ RCHI2_STORE(i).le.CHI2MAX.and.
384     c $ RCHI2_STORE(i).gt.0.and.
385     $ .true.)then
386     if(DEBUG)print*,'Track candidate ',iimage
387     $ ,' >>> TRACK IMAGE >>> of'
388     $ ,ibest
389     goto 122 !image track found
390     endif
391     enddo
392     122 continue
393    
394     * --- and store the results --------------------------------
395     ntrk = ntrk + 1 !counter of found tracks
396     if(.not.FIMAGE
397     $ .and.iimage.eq.0) image(ntrk)= 0
398     if(.not.FIMAGE
399     $ .and.iimage.ne.0)image(ntrk)=ntrk+1 !this is the image of the next
400     if(FIMAGE) image(ntrk)=ntrk-1 !this is the image of the previous
401     call fill_level2_tracks(ntrk) !==> good2=.true.
402     c print*,'++++++++++ iimage,fimage,ntrk,image '
403     c $ ,iimage,fimage,ntrk,image(ntrk)
404    
405     if(ntrk.eq.NTRKMAX)then
406 pam-fi 1.5 if(verbose)
407 mocchiut 1.1 $ print*,
408     $ '** warning ** number of identified '//
409     $ 'tracks exceeds vector dimension '
410     $ ,'( ',NTRKMAX,' )'
411     cc good2=.false.
412     goto 880 !fill ntp and go to next event
413     endif
414     if(iimage.ne.0)then
415     FIMAGE=.true. !
416     goto 1212 !>>> fit image-track
417     endif
418    
419     * --- then remove selected clusters (ibest+iimage) from clouds ----
420     call clean_XYclouds(ibest,iflag)
421     if(iflag.eq.1)then !bad event
422     goto 880 !fill ntp and go to next event
423     endif
424    
425     * **********************************************************
426     * condition to start a new search
427     * **********************************************************
428     ixznew=0
429     do ixz=1,nclouds_xz
430     if(ptcloud_xz(ixz).ge.nptxz_min)ixznew=1
431     enddo
432     iyznew=0
433     do iyz=1,nclouds_yz
434     if(ptcloud_yz(iyz).ge.nptyz_min)iyznew=1
435     enddo
436    
437     if(ixznew.ne.0.and.
438     $ iyznew.ne.0.and.
439     $ rchi2best.le.CHI2MAX.and.
440     c $ rchi2best.lt.15..and.
441     $ .true.)then
442     if(DEBUG)then
443     print*,'***** NEW SEARCH ****'
444     endif
445     goto 11111 !try new search
446    
447     endif
448     * **********************************************
449    
450    
451    
452     880 return
453     end
454    
455    
456    
457     ************************************************************
458     ************************************************************
459     ************************************************************
460     ************************************************************
461     *
462     * This routine provides the coordinates (in cm) in the PAMELA reference system:
463     * - of the point associated with a COUPLE ---> (xPAM,yPAM,zPAM)
464     * - of the extremes of the segment
465     * associated with a SINGLET ---------------> (xPAM_A,yPAM_A,zPAM_A)
466     * ---> (xPAM_B,yPAM_B,zPAM_B)
467     *
468     * It also assigns the spatial resolution to the evaluated coordinates,
469     * as a function (in principle) of the multiplicity, the angle, the PFA etc...
470     *
471     *
472     * To call the routine you must pass the arguments:
473     * icx - ID of cluster x
474     * icy - ID of cluster y
475     * sensor - sensor (1,2)
476     * PFAx - Position Finding Algorithm in x (COG2,ETA2,...)
477     * PFAy - Position Finding Algorithm in y (COG2,ETA2,...)
478     * angx - Projected angle in x
479     * angy - Projected angle in y
480 pam-fi 1.18 * bfx - x-component of magnetci field
481     * bfy - y-component of magnetic field
482 mocchiut 1.1 *
483     * --------- COUPLES -------------------------------------------------------
484     * The couple defines a point in the space.
485     * The coordinates of the point are evaluated as follows:
486     * 1 - the corrected coordinates relative to the sensor are evaluated
487     * according to the chosen PFA --> (xi,yi,0)
488     * 2 - coordinates are rotated and traslated, according to the aligmnet
489     * parameters, and expressed in the reference system of the mechanical
490     * sensor --> (xrt,yrt,zrt)
491     * 3 - coordinates are finally converted to the PAMELA reference system
492     * --> (xPAM,yPAM,zPAM)
493     *
494     * --------- SINGLETS -------------------------------------------------------
495     * Since a coordinate is missing, the singlet defines not a point
496     * in the space but a segment AB (parallel to the strips).
497     * In this case the routine returns the coordinates in the PAMELA reference
498     * system of the two extremes A and B of the segment:
499     * --> (xPAM_A,yPAM_A,zPAM_A)
500     * --> (xPAM_B,yPAM_B,zPAM_B)
501     *
502     * ==========================================================
503     *
504     * The output of the routine is stored in the commons:
505     *
506     * double precision xPAM,yPAM,zPAM
507     * common/coord_xyz_PAM/xPAM,yPAM,zPAM
508     *
509     * double precision xPAM_A,yPAM_A,zPAM_A
510     * double precision xPAM_B,yPAM_B,zPAM_B
511     * common/coord_AB_PAM/xPAM_A,yPAM_A,zPAM_A,xPAM_B,yPAM_B,zPAM_B
512     *
513     * double precision resxPAM,resyPAM
514     * common/resolution_PAM/resxPAM,resyPAM
515     *
516     * (in file common_xyzPAM.f)
517     *
518     *
519    
520 pam-fi 1.18 subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
521 mocchiut 1.1
522    
523     include 'commontracker.f'
524 pam-fi 1.9 include 'level1.f'
525 mocchiut 1.1 include 'calib.f'
526 pam-fi 1.9 c include 'level1.f'
527 mocchiut 1.1 include 'common_align.f'
528     include 'common_mech.f'
529     include 'common_xyzPAM.f'
530 pam-fi 1.11 c include 'common_resxy.f'
531 mocchiut 1.1
532 pam-fi 1.2 c logical DEBUG
533     c common/dbg/DEBUG
534 mocchiut 1.1
535     integer icx,icy !X-Y cluster ID
536     integer sensor
537     integer viewx,viewy
538     character*4 PFAx,PFAy !PFA to be used
539 pam-fi 1.18 real ax,ay !X-Y geometric angle
540     real angx,angy !X-Y effective angle
541     real bfx,bfy !X-Y b-field components
542 mocchiut 1.1
543     real stripx,stripy
544    
545     double precision xrt,yrt,zrt
546     double precision xrt_A,yrt_A,zrt_A
547     double precision xrt_B,yrt_B,zrt_B
548     c double precision xi,yi,zi
549     c double precision xi_A,yi_A,zi_A
550     c double precision xi_B,yi_B,zi_B
551    
552    
553     parameter (ndivx=30)
554    
555     resxPAM = 0
556     resyPAM = 0
557    
558     xPAM = 0.
559     yPAM = 0.
560     zPAM = 0.
561     xPAM_A = 0.
562     yPAM_A = 0.
563     zPAM_A = 0.
564     xPAM_B = 0.
565     yPAM_B = 0.
566     zPAM_B = 0.
567 pam-fi 1.17 c print*,'## xyz_PAM: ',icx,icy,sensor,PFAx,PFAy,angx,angy
568 mocchiut 1.1 * -----------------
569     * CLUSTER X
570     * -----------------
571    
572     if(icx.ne.0)then
573 pam-fi 1.18
574 mocchiut 1.1 viewx = VIEW(icx)
575     nldx = nld(MAXS(icx),VIEW(icx))
576     nplx = npl(VIEW(icx))
577 pam-fi 1.18 resxPAM = RESXAV
578 mocchiut 1.1 stripx = float(MAXS(icx))
579 pam-fi 1.18 * --------------------------
580     * magnetic-field corrections
581     * --------------------------
582     c$$$ print*,nplx,ax,bfy/10.
583     angtemp = ax
584     bfytemp = bfy
585     if(nplx.eq.6) angtemp = -1. * ax
586     if(nplx.eq.6) bfytemp = -1. * bfy
587     tgtemp = tan(angtemp*acos(-1.)/180.) + pmuH_h*bfytemp*0.00001
588     angx = 180.*atan(tgtemp)/acos(-1.)
589     stripx = stripx - 0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
590     c$$$ print*,angx,0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
591     c$$$ print*,'========================'
592     * --------------------------
593    
594     if(PFAx.eq.'COG1')then
595     stripx = stripx
596     resxPAM = resxPAM
597 mocchiut 1.1 elseif(PFAx.eq.'COG2')then
598     stripx = stripx + cog(2,icx)
599     resxPAM = resxPAM*fbad_cog(2,icx)
600 pam-fi 1.18 elseif(PFAx.eq.'COG3')then
601     stripx = stripx + cog(3,icx)
602     resxPAM = resxPAM*fbad_cog(3,icx)
603     elseif(PFAx.eq.'COG4')then
604     c print*,'COG4'
605     stripx = stripx + cog(4,icx)
606     resxPAM = resxPAM*fbad_cog(4,icx)
607 mocchiut 1.1 elseif(PFAx.eq.'ETA2')then
608 pam-fi 1.18 stripx = stripx + pfaeta2(icx,angx)
609     resxPAM = risx_eta2(abs(angx))
610 mocchiut 1.1 if(DEBUG.and.fbad_cog(2,icx).ne.1)
611     $ print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
612     resxPAM = resxPAM*fbad_cog(2,icx)
613 pam-fi 1.18 elseif(PFAx.eq.'ETA3')then
614     stripx = stripx + pfaeta3(icx,angx)
615     resxPAM = risx_eta3(abs(angx))
616     if(DEBUG.and.fbad_cog(3,icx).ne.1)
617     $ print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)
618     resxPAM = resxPAM*fbad_cog(3,icx)
619     elseif(PFAx.eq.'ETA4')then
620     stripx = stripx + pfaeta4(icx,angx)
621     resxPAM = risx_eta4(abs(angx))
622     if(DEBUG.and.fbad_cog(4,icx).ne.1)
623     $ print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)
624     resxPAM = resxPAM*fbad_cog(4,icx)
625     elseif(PFAx.eq.'ETA')then
626     c print*,'ETA'
627     stripx = stripx + pfaeta(icx,angx)
628     resxPAM = ris_eta(icx,angx)
629     if(DEBUG.and.fbad_cog(2,icx).ne.1)
630     $ print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
631     resxPAM = resxPAM*fbad_eta(icx,angx)
632     elseif(PFAx.eq.'COG')then
633     stripx = stripx + cog(0,icx)
634     resxPAM = risx_cog(abs(angx))
635     resxPAM = resxPAM*fbad_cog(0,icx)
636 mocchiut 1.1 else
637     print*,'*** Non valid p.f.a. (x) --> ',PFAx
638     endif
639    
640 pam-fi 1.18 c print*,'%%%%%%%%%%%%'
641    
642 mocchiut 1.1 endif
643    
644     * -----------------
645     * CLUSTER Y
646     * -----------------
647    
648     if(icy.ne.0)then
649 pam-fi 1.18
650 mocchiut 1.1 viewy = VIEW(icy)
651     nldy = nld(MAXS(icy),VIEW(icy))
652     nply = npl(VIEW(icy))
653 pam-fi 1.18 resyPAM = RESYAV
654     stripy = float(MAXS(icy))
655 mocchiut 1.1
656     if(icx.ne.0.and.(nply.ne.nplx.or.nldy.ne.nldx))then
657     print*,'xyz_PAM ***ERROR*** invalid cluster couple!!! '
658     $ ,icx,icy
659     goto 100
660     endif
661 pam-fi 1.18 * --------------------------
662     * magnetic-field corrections
663     * --------------------------
664     tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001
665     angy = 180.*atan(tgtemp)/acos(-1.)
666     stripy = stripy + 0.5*pmuH_e*bfx*0.00001*SiDimZ/pitchY
667     * --------------------------
668 mocchiut 1.1
669     if(PFAy.eq.'COG1')then !(1)
670     stripy = stripy !(1)
671     resyPAM = resyPAM !(1)
672     elseif(PFAy.eq.'COG2')then
673     stripy = stripy + cog(2,icy)
674     resyPAM = resyPAM*fbad_cog(2,icy)
675 pam-fi 1.18 elseif(PFAy.eq.'COG3')then
676     stripy = stripy + cog(3,icy)
677     resyPAM = resyPAM*fbad_cog(3,icy)
678     elseif(PFAy.eq.'COG4')then
679     stripy = stripy + cog(4,icy)
680     resyPAM = resyPAM*fbad_cog(4,icy)
681 mocchiut 1.1 elseif(PFAy.eq.'ETA2')then
682     c cog2 = cog(2,icy)
683 pam-fi 1.7 c etacorr = pfaeta2(cog2,viewy,nldy,angy)
684 mocchiut 1.1 c stripy = stripy + etacorr
685 pam-fi 1.7 stripy = stripy + pfaeta2(icy,angy) !(3)
686 pam-fi 1.18 resyPAM = risy_eta2(abs(angy)) ! (4)
687 mocchiut 1.1 resyPAM = resyPAM*fbad_cog(2,icy)
688     if(DEBUG.and.fbad_cog(2,icy).ne.1)
689     $ print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
690     elseif(PFAy.eq.'ETA3')then !(3)
691 pam-fi 1.7 stripy = stripy + pfaeta3(icy,angy) !(3)
692 mocchiut 1.1 resyPAM = resyPAM*fbad_cog(3,icy) !(3)
693     if(DEBUG.and.fbad_cog(3,icy).ne.1) !(3)
694     $ print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)!(3)
695     elseif(PFAy.eq.'ETA4')then !(3)
696 pam-fi 1.7 stripy = stripy + pfaeta4(icy,angy) !(3)
697 mocchiut 1.1 resyPAM = resyPAM*fbad_cog(4,icy) !(3)
698     if(DEBUG.and.fbad_cog(4,icy).ne.1) !(3)
699     $ print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)!(3)
700     elseif(PFAy.eq.'ETA')then !(3)
701 pam-fi 1.7 stripy = stripy + pfaeta(icy,angy) !(3)
702 mocchiut 1.1 resyPAM = ris_eta(icy,angy) ! (4)
703     c resyPAM = resyPAM*fbad_cog(2,icy) !(3)TEMPORANEO
704     resyPAM = resyPAM*fbad_eta(icy,angy) ! (4)
705     if(DEBUG.and.fbad_cog(2,icy).ne.1) !(3)
706     $ print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)!(3)
707     elseif(PFAy.eq.'COG')then
708     stripy = stripy + cog(0,icy)
709 pam-fi 1.18 resyPAM = risy_cog(abs(angy)) ! (4)
710 mocchiut 1.1 c resyPAM = ris_eta(icy,angy) ! (4)
711     resyPAM = resyPAM*fbad_cog(0,icy)
712     else
713     print*,'*** Non valid p.f.a. (x) --> ',PFAx
714     endif
715    
716     endif
717    
718 pam-fi 1.17 c print*,'## stripx,stripy ',stripx,stripy
719    
720 mocchiut 1.1 c===========================================================
721     C COUPLE
722     C===========================================================
723     if(icx.ne.0.and.icy.ne.0)then
724    
725     c------------------------------------------------------------------------
726     c (xi,yi,zi) = mechanical coordinates in the silicon sensor frame
727     c------------------------------------------------------------------------
728 pam-fi 1.4 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
729     $ .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
730     print*,'xyz_PAM (couple):',
731     $ ' WARNING: false X strip: strip ',stripx
732     endif
733 mocchiut 1.1 xi = acoordsi(stripx,viewx)
734     yi = acoordsi(stripy,viewy)
735     zi = 0.
736    
737    
738     c------------------------------------------------------------------------
739     c (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
740     c------------------------------------------------------------------------
741     c N.B. I convert angles from microradiants to radiants
742    
743     xrt = xi
744     $ - omega(nplx,nldx,sensor)*yi
745     $ + gamma(nplx,nldx,sensor)*zi
746     $ + dx(nplx,nldx,sensor)
747    
748     yrt = omega(nplx,nldx,sensor)*xi
749     $ + yi
750     $ - beta(nplx,nldx,sensor)*zi
751     $ + dy(nplx,nldx,sensor)
752    
753     zrt = -gamma(nplx,nldx,sensor)*xi
754     $ + beta(nplx,nldx,sensor)*yi
755     $ + zi
756     $ + dz(nplx,nldx,sensor)
757    
758     c xrt = xi
759     c yrt = yi
760     c zrt = zi
761    
762     c------------------------------------------------------------------------
763     c (xPAM,yPAM,zPAM) = measured coordinates (in cm)
764     c in PAMELA reference system
765     c------------------------------------------------------------------------
766    
767     xPAM = dcoord(xrt,viewx,nldx,sensor) / 1.d4
768     yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4
769     zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4
770    
771     xPAM_A = 0.
772     yPAM_A = 0.
773     zPAM_A = 0.
774    
775     xPAM_B = 0.
776     yPAM_B = 0.
777     zPAM_B = 0.
778    
779     elseif(
780     $ (icx.ne.0.and.icy.eq.0).or.
781     $ (icx.eq.0.and.icy.ne.0).or.
782     $ .false.
783     $ )then
784    
785     c------------------------------------------------------------------------
786     c (xi,yi,zi) = mechanical coordinates in the silicon sensor frame
787     c------------------------------------------------------------------------
788    
789     if(icy.ne.0)then
790     c===========================================================
791     C Y-SINGLET
792     C===========================================================
793     nplx = nply
794     nldx = nldy
795     viewx = viewy + 1
796    
797     yi = acoordsi(stripy,viewy)
798    
799     xi_A = edgeY_d - SiDimX/2
800     yi_A = yi
801     zi_A = 0.
802    
803     xi_B = SiDimX/2 - edgeY_u
804     yi_B = yi
805     zi_B = 0.
806    
807     c print*,'Y-cl ',icy,stripy,' --> ',yi
808     c print*,xi_A,' <--> ',xi_B
809    
810     elseif(icx.ne.0)then
811     c===========================================================
812     C X-SINGLET
813     C===========================================================
814    
815     nply = nplx
816     nldy = nldx
817     viewy = viewx - 1
818    
819 pam-fi 1.4 c print*,'X-singlet ',icx,nplx,nldx,viewx,stripx
820     c if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...
821     if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
822     $ .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
823     print*,'xyz_PAM (X-singlet):',
824     $ ' WARNING: false X strip: strip ',stripx
825     endif
826 mocchiut 1.1 xi = acoordsi(stripx,viewx)
827    
828     xi_A = xi
829     yi_A = edgeX_d - SiDimY/2
830     zi_A = 0.
831    
832     xi_B = xi
833     yi_B = SiDimY/2 - edgeX_u
834     zi_B = 0.
835    
836     if(viewy.eq.11)then
837     yi = yi_A
838     yi_A = yi_B
839     yi_B = yi
840     endif
841    
842     c print*,'X-cl ',icx,stripx,' --> ',xi
843     c print*,yi_A,' <--> ',yi_B
844    
845     else
846    
847     print *,'routine xyz_PAM ---> not properly used !!!'
848     print *,'icx = ',icx
849     print *,'icy = ',icy
850     goto 100
851    
852     endif
853     c------------------------------------------------------------------------
854     c (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
855     c------------------------------------------------------------------------
856     c N.B. I convert angles from microradiants to radiants
857    
858     xrt_A = xi_A
859     $ - omega(nplx,nldx,sensor)*yi_A
860     $ + gamma(nplx,nldx,sensor)*zi_A
861     $ + dx(nplx,nldx,sensor)
862    
863     yrt_A = omega(nplx,nldx,sensor)*xi_A
864     $ + yi_A
865     $ - beta(nplx,nldx,sensor)*zi_A
866     $ + dy(nplx,nldx,sensor)
867    
868     zrt_A = -gamma(nplx,nldx,sensor)*xi_A
869     $ + beta(nplx,nldx,sensor)*yi_A
870     $ + zi_A
871     $ + dz(nplx,nldx,sensor)
872    
873     xrt_B = xi_B
874     $ - omega(nplx,nldx,sensor)*yi_B
875     $ + gamma(nplx,nldx,sensor)*zi_B
876     $ + dx(nplx,nldx,sensor)
877    
878     yrt_B = omega(nplx,nldx,sensor)*xi_B
879     $ + yi_B
880     $ - beta(nplx,nldx,sensor)*zi_B
881     $ + dy(nplx,nldx,sensor)
882    
883     zrt_B = -gamma(nplx,nldx,sensor)*xi_B
884     $ + beta(nplx,nldx,sensor)*yi_B
885     $ + zi_B
886     $ + dz(nplx,nldx,sensor)
887    
888    
889     c xrt = xi
890     c yrt = yi
891     c zrt = zi
892    
893     c------------------------------------------------------------------------
894     c (xPAM,yPAM,zPAM) = measured coordinates (in cm)
895     c in PAMELA reference system
896     c------------------------------------------------------------------------
897    
898     xPAM = 0.
899     yPAM = 0.
900     zPAM = 0.
901    
902     xPAM_A = dcoord(xrt_A,viewx,nldx,sensor) / 1.d4
903     yPAM_A = dcoord(yrt_A,viewy,nldy,sensor) / 1.d4
904     zPAM_A = ( zrt_A + z_mech_sensor(nplx,nldx,sensor)*1000.)/ 1.d4
905    
906     xPAM_B = dcoord(xrt_B,viewx,nldx,sensor) / 1.d4
907     yPAM_B = dcoord(yrt_B,viewy,nldy,sensor) / 1.d4
908     zPAM_B = ( zrt_B + z_mech_sensor(nplx,nldx,sensor)*1000.)/ 1.d4
909    
910    
911     c print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'
912    
913     else
914    
915     print *,'routine xyz_PAM ---> not properly used !!!'
916     print *,'icx = ',icx
917     print *,'icy = ',icy
918    
919     endif
920    
921 pam-fi 1.17
922     c print*,'## xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM
923     c print*,'## xPAM_A,yPAM_A,zPAM_A ',xPAM_A,yPAM_A,zPAM_A
924     c print*,'## xPAM_B,yPAM_B,zPAM_B ',xPAM_B,yPAM_B,zPAM_B
925    
926 mocchiut 1.1 100 continue
927     end
928    
929    
930     ********************************************************************************
931     ********************************************************************************
932     ********************************************************************************
933     *
934     * The function distance_to(XP,YP) should be used after
935     * a call to the xyz_PAM routine and it evaluate the
936     * NORMALIZED distance (PROJECTED on the XY plane) between
937     * the point (XP,YP), argument of the function,
938     * and:
939     *
940     * - the point (xPAM,yPAM,zPAM), in the case of a COUPLE
941     * or
942     * - the segment (xPAM_A,yPAM_A,zPAM_A)-(xPAM_B,yPAM_B,zPAM_B),
943     * in the case of a SINGLET.
944     *
945     * ( The routine xyz_PAM fills the common defined in "common_xyzPAM.f",
946     * which stores the coordinates of the couple/singlet )
947     *
948     ********************************************************************************
949    
950     real function distance_to(XPP,YPP)
951    
952     include 'common_xyzPAM.f'
953    
954     * -----------------------------------
955     * it computes the normalized distance
956     * ( i.e. distance/resolution )
957     * -----------------------------------
958    
959     double precision distance,RE
960     double precision BETA,ALFA,xmi,ymi
961    
962     * ----------------------
963     if (
964     + xPAM.eq.0.and.
965     + yPAM.eq.0.and.
966     + zPAM.eq.0.and.
967     + xPAM_A.ne.0.and.
968     + yPAM_A.ne.0.and.
969     + zPAM_A.ne.0.and.
970     + xPAM_B.ne.0.and.
971     + yPAM_B.ne.0.and.
972     + zPAM_B.ne.0.and.
973     + .true.)then
974     * -----------------------
975     * DISTANCE TO --- SINGLET
976     * -----------------------
977     if(abs(sngl(xPAM_B-xPAM_A)).lt.abs(sngl(yPAM_B-yPAM_A)))then
978     * |||---------- X CLUSTER
979    
980     BETA = (xPAM_B-xPAM_A)/(yPAM_B-yPAM_A)
981     ALFA = xPAM_A - BETA * yPAM_A
982    
983     ymi = ( YPP + BETA*XPP - BETA*ALFA )/(1+BETA**2)
984     if(ymi.lt.dmin1(yPAM_A,yPAM_B))ymi=dmin1(yPAM_A,yPAM_B)
985     if(ymi.gt.dmax1(yPAM_A,yPAM_B))ymi=dmax1(yPAM_A,yPAM_B)
986     xmi = ALFA + BETA * ymi
987     RE = resxPAM
988    
989     else
990     * |||---------- Y CLUSTER
991    
992     BETA = (yPAM_B-yPAM_A)/(xPAM_B-xPAM_A)
993     ALFA = yPAM_A - BETA * xPAM_A
994    
995     xmi = ( XPP + BETA*YPP - BETA*ALFA )/(1+BETA**2)
996     if(xmi.lt.dmin1(xPAM_A,xPAM_B))xmi=dmin1(xPAM_A,xPAM_B)
997     if(xmi.gt.dmax1(xPAM_A,xPAM_B))xmi=dmax1(xPAM_A,xPAM_B)
998     ymi = ALFA + BETA * xmi
999     RE = resyPAM
1000    
1001     endif
1002    
1003     distance=
1004     $ ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1005     distance=dsqrt(distance)
1006    
1007     c$$$ print*,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b
1008     c$$$ $ ,' --- distance_to --- ',xpp,ypp
1009     c$$$ print*,' resolution ',re
1010    
1011    
1012     * ----------------------
1013     elseif(
1014     + xPAM.ne.0.and.
1015     + yPAM.ne.0.and.
1016     + zPAM.ne.0.and.
1017     + xPAM_A.eq.0.and.
1018     + yPAM_A.eq.0.and.
1019     + zPAM_A.eq.0.and.
1020     + xPAM_B.eq.0.and.
1021     + yPAM_B.eq.0.and.
1022     + zPAM_B.eq.0.and.
1023     + .true.)then
1024     * ----------------------
1025     * DISTANCE TO --- COUPLE
1026     * ----------------------
1027    
1028     distance=
1029     $ ((xPAM-XPP)/resxPAM)**2
1030     $ +
1031     $ ((yPAM-YPP)/resyPAM)**2
1032     distance=dsqrt(distance)
1033    
1034     c$$$ print*,xPAM,yPAM,zPAM
1035     c$$$ $ ,' --- distance_to --- ',xpp,ypp
1036     c$$$ print*,' resolution ',resxPAM,resyPAM
1037    
1038     else
1039    
1040     print*
1041     $ ,' function distance_to ---> wrong usage!!!'
1042     print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM
1043     print*,' xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b '
1044     $ ,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b
1045     endif
1046    
1047     distance_to = sngl(distance)
1048    
1049     return
1050     end
1051    
1052     ********************************************************************************
1053     ********************************************************************************
1054     ********************************************************************************
1055     ********************************************************************************
1056    
1057     subroutine whichsensor(nplPAM,xPAM,yPAM,ladder,sensor)
1058     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1059     * Given the plane (1-6 from BOTTOM to TOP!!) and the (xPAM,yPAM)
1060     * coordinates (in the PAMELA reference system), it returns
1061     * the ladder and the sensor which the point belongs to.
1062     *
1063     * The method to assign a point to a sensor consists in
1064     * - calculating the sum of the distances between the point
1065     * and the sensor edges
1066     * - requiring that it is less-equal than (SiDimX+SiDimY)
1067     *
1068     * NB -- SiDimX and SiDimY are not the dimentions of the SENSITIVE volume
1069     * but of the whole silicon sensor
1070     *
1071     * CONVENTION:
1072     * - sensor 1 is the one closest to the hybrid
1073     * - ladder 1 is the first to be read out (strips from 1 to 1024)
1074     *
1075     * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1076     include 'commontracker.f'
1077     include 'common_align.f'
1078    
1079     integer ladder,sensor,viewx,viewy
1080     real c1(4),c2(4),c3(4)
1081     data c1/1.,0.,0.,1./
1082     data c2/1.,-1.,-1.,1./
1083     data c3/1.,1.,0.,0./
1084     real*8 yvvv,xvvv
1085     double precision xi,yi,zi
1086     double precision xrt,yrt,zrt
1087     real AA,BB
1088     real yvv(4),xvv(4)
1089    
1090     * tollerance to consider the track inside the sensitive area
1091     real ptoll
1092     data ptoll/150./ !um
1093    
1094     external nviewx,nviewy,acoordsi,dcoord
1095    
1096     nplpt = nplPAM !plane
1097     viewx = nviewx(nplpt)
1098     viewy = nviewy(nplpt)
1099    
1100     do il=1,nladders_view
1101     do is=1,2
1102    
1103     do iv=1,4 !loop on sensor vertexes
1104     stripx = (il-c1(iv))*1024 + c1(iv) + c2(iv)*3
1105     stripy = (il-c3(iv))*1024 + c3(iv)
1106     c------------------------------------------------------------------------
1107     c (xi,yi,zi) = mechanical coordinates in the silicon sensor frame
1108     c------------------------------------------------------------------------
1109 pam-fi 1.4 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1110     $ .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
1111     c if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...
1112     print*,'whichsensor: ',
1113     $ ' WARNING: false X strip: strip ',stripx
1114     endif
1115 mocchiut 1.1 xi = acoordsi(stripx,viewx)
1116     yi = acoordsi(stripy,viewy)
1117     zi = 0.
1118     c------------------------------------------------------------------------
1119     c (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
1120     c------------------------------------------------------------------------
1121     c N.B. I convert angles from microradiants to radiants
1122     xrt = xi
1123     $ - omega(nplpt,il,is)*yi
1124     $ + gamma(nplpt,il,is)*zi
1125     $ + dx(nplpt,il,is)
1126     yrt = omega(nplpt,il,is)*xi
1127     $ + yi
1128     $ - beta(nplpt,il,is)*zi
1129     $ + dy(nplpt,il,is)
1130     zrt = -gamma(nplpt,il,is)*xi
1131     $ + beta(nplpt,il,is)*yi
1132     $ + zi
1133     $ + dz(nplpt,il,is)
1134     c------------------------------------------------------------------------
1135     c measured coordinates (in cm) in PAMELA reference system
1136     c------------------------------------------------------------------------
1137     yvvv = dcoord(yrt,viewy,il,is) / 1.d4
1138     xvvv = dcoord(xrt,viewx,il,is) / 1.d4
1139    
1140     yvv(iv)=sngl(yvvv)
1141     xvv(iv)=sngl(xvvv)
1142     c print*,'LADDER ',il,' SENSOR ',is,' vertexes >> '
1143     c $ ,iv,xvv(iv),yvv(iv)
1144     enddo !end loop on sensor vertexes
1145    
1146     dtot=0.
1147     do iside=1,4,2 !loop on sensor edges X
1148     iv1=iside
1149     iv2=mod(iside,4)+1
1150     * straight line passing trhough two consecutive vertexes
1151     AA = (yvv(iv1)-yvv(iv2))/(xvv(iv1)-xvv(iv2))
1152     BB = yvv(iv1) - AA*xvv(iv1)
1153     * point along the straight line closer to the track
1154     xoo = (xPAM+AA*yPAM-AA*BB)/(1+AA**2)
1155     yoo = AA*xoo + BB
1156     * sum of the distances
1157     dtot = dtot +
1158     $ sqrt((xPAM-xoo)**2+(yPAM-yoo)**2)
1159     enddo !end loop on sensor edges
1160     do iside=2,4,2 !loop on sensor edges Y
1161     iv1=iside
1162     iv2=mod(iside,4)+1
1163     * straight line passing trhough two consecutive vertexes
1164     AA = (xvv(iv1)-xvv(iv2))/(yvv(iv1)-yvv(iv2))
1165     BB = xvv(iv1) - AA*yvv(iv1)
1166     * point along the straight line closer to the track
1167     yoo = (yPAM+AA*xPAM-AA*BB)/(1+AA**2)
1168     xoo = AA*yoo + BB
1169     * sum of the distances
1170     dtot = dtot +
1171     $ sqrt((xPAM-xoo)**2+(yPAM-yoo)**2)
1172     enddo !end loop on sensor edges
1173    
1174    
1175     * half-perimeter of sensitive area
1176     Perim =
1177     $ SiDimX - edgeX_l - edgeX_r
1178     $ +SiDimY - edgeY_l - edgeY_r
1179     Perim = (Perim + ptoll)/1.e4
1180     if(dtot.le.Perim)goto 100
1181    
1182    
1183     enddo
1184     enddo
1185    
1186     ladder = 0
1187     sensor = 0
1188     goto 200
1189    
1190     100 continue
1191     ladder = il
1192     sensor = is
1193    
1194    
1195     200 return
1196     end
1197    
1198    
1199    
1200     *************************************************************************
1201    
1202     subroutine reverse(v,n,temp) !invert the order of the components of v(n) vector
1203    
1204     implicit double precision (A-H,O-Z)
1205    
1206     dimension v(*)
1207     dimension temp(*)
1208     integer i,n
1209    
1210     do i=1,n
1211     temp(i)=v(n+1-i)
1212     enddo
1213    
1214     do i=1,n
1215     v(i)=temp(i)
1216     enddo
1217    
1218     return
1219     end
1220    
1221     *************************************************************************
1222     *************************************************************************
1223     *************************************************************************
1224     *************************************************************************
1225     *************************************************************************
1226     *************************************************************************
1227     *************************************************************************
1228     *************************************************************************
1229     *************************************************************************
1230     *************************************************************************
1231     *************************************************************************
1232     *************************************************************************
1233     *************************************************************************
1234     *************************************************************************
1235     *************************************************************************
1236     integer function ip_cp(id)
1237     *
1238     * given the couple id,
1239     * it returns the plane number
1240     *
1241     include 'commontracker.f'
1242 pam-fi 1.9 include 'level1.f'
1243 mocchiut 1.1 c include 'common_analysis.f'
1244     include 'common_momanhough.f'
1245    
1246     ip_cp=0
1247     ncpp=0
1248     do ip=1,nplanes
1249     ncpp=ncpp+ncp_plane(ip)
1250     if(ncpp.ge.abs(id))then
1251     ip_cp=ip
1252     goto 100
1253     endif
1254     enddo
1255     100 continue
1256     return
1257     end
1258    
1259    
1260     integer function is_cp(id)
1261     *
1262     * given the couple id,
1263     * it returns the sensor number
1264     *
1265     is_cp=0
1266     if(id.lt.0)is_cp=1
1267     if(id.gt.0)is_cp=2
1268     if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'
1269    
1270     return
1271     end
1272    
1273    
1274     integer function icp_cp(id)
1275     *
1276     * given the couple id,
1277     * it returns the id number ON THE PLANE
1278     *
1279     include 'commontracker.f'
1280 pam-fi 1.9 include 'level1.f'
1281 mocchiut 1.1 c include 'common_analysis.f'
1282     include 'common_momanhough.f'
1283    
1284     icp_cp=0
1285    
1286     ncpp=0
1287     do ip=1,nplanes
1288     ncppold=ncpp
1289     ncpp=ncpp+ncp_plane(ip)
1290     if(ncpp.ge.abs(id))then
1291     icp_cp=abs(id)-ncppold
1292     goto 100
1293     endif
1294     enddo
1295     100 continue
1296     return
1297     end
1298    
1299    
1300    
1301     integer function id_cp(ip,icp,is)
1302     *
1303     * given a plane, a couple and the sensor
1304     * it returns the absolute couple id
1305     * negative if sensor =1
1306     * positive if sensor =2
1307     *
1308     include 'commontracker.f'
1309 pam-fi 1.9 include 'level1.f'
1310 mocchiut 1.1 c include 'calib.f'
1311     c include 'level1.f'
1312     c include 'common_analysis.f'
1313     include 'common_momanhough.f'
1314    
1315     id_cp=0
1316    
1317     if(ip.gt.1)then
1318     do i=1,ip-1
1319     id_cp = id_cp + ncp_plane(i)
1320     enddo
1321     endif
1322    
1323     id_cp = id_cp + icp
1324    
1325     if(is.eq.1) id_cp = -id_cp
1326    
1327     return
1328     end
1329    
1330    
1331    
1332    
1333     *************************************************************************
1334     *************************************************************************
1335     *************************************************************************
1336     *************************************************************************
1337     *************************************************************************
1338     *************************************************************************
1339    
1340    
1341     ***************************************************
1342     * *
1343     * *
1344     * *
1345     * *
1346     * *
1347     * *
1348     **************************************************
1349    
1350     subroutine cl_to_couples(iflag)
1351    
1352     include 'commontracker.f'
1353 pam-fi 1.9 include 'level1.f'
1354 mocchiut 1.1 include 'common_momanhough.f'
1355 pam-fi 1.9 c include 'momanhough_init.f'
1356 mocchiut 1.1 include 'calib.f'
1357 pam-fi 1.9 c include 'level1.f'
1358 mocchiut 1.1
1359     * output flag
1360     * --------------
1361     * 0 = good event
1362     * 1 = bad event
1363     * --------------
1364     integer iflag
1365    
1366 pam-fi 1.6 integer badseed,badclx,badcly
1367 mocchiut 1.1
1368     * init variables
1369     ncp_tot=0
1370     do ip=1,nplanes
1371     do ico=1,ncouplemax
1372     clx(ip,ico)=0
1373     cly(ip,ico)=0
1374     enddo
1375     ncp_plane(ip)=0
1376     do icl=1,nclstrmax_level2
1377     cls(ip,icl)=1
1378     enddo
1379     ncls(ip)=0
1380     enddo
1381     do icl=1,nclstrmax_level2
1382 pam-fi 1.9 cl_single(icl) = 1
1383     cl_good(icl) = 0
1384     enddo
1385     do iv=1,nviews
1386     ncl_view(iv) = 0
1387     mask_view(iv) = 0 !all included
1388 mocchiut 1.1 enddo
1389    
1390 pam-fi 1.9 * count number of cluster per view
1391     do icl=1,nclstr1
1392     ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1
1393     enddo
1394     * mask views with too many clusters
1395     do iv=1,nviews
1396 pam-fi 1.14 if( ncl_view(iv).gt. nclusterlimit)then
1397 pam-fi 1.9 mask_view(iv) = 1
1398 pam-fi 1.11 if(DEBUG)print*,' * WARNING * cl_to_couple: n.clusters > '
1399 pam-fi 1.14 $ ,nclusterlimit,' on view ', iv,' --> masked!'
1400 pam-fi 1.9 endif
1401     enddo
1402    
1403    
1404 mocchiut 1.1 * start association
1405     ncouples=0
1406     do icx=1,nclstr1 !loop on cluster (X)
1407     if(mod(VIEW(icx),2).eq.1)goto 10
1408    
1409     * ----------------------------------------------------
1410 pam-fi 1.9 * jump masked views (X VIEW)
1411     * ----------------------------------------------------
1412     if( mask_view(VIEW(icx)).ne.0 ) goto 10
1413     * ----------------------------------------------------
1414 mocchiut 1.1 * cut on charge (X VIEW)
1415 pam-fi 1.4 * ----------------------------------------------------
1416 pam-fi 1.18 if(sgnl(icx).lt.dedx_x_min)then
1417 mocchiut 1.1 cl_single(icx)=0
1418     goto 10
1419     endif
1420 pam-fi 1.4 * ----------------------------------------------------
1421 mocchiut 1.1 * cut BAD (X VIEW)
1422 pam-fi 1.4 * ----------------------------------------------------
1423 mocchiut 1.1 badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
1424     ifirst=INDSTART(icx)
1425     if(icx.ne.nclstr1) then
1426     ilast=INDSTART(icx+1)-1
1427     else
1428     ilast=TOTCLLENGTH
1429     endif
1430 pam-fi 1.6 badclx=badseed
1431 mocchiut 1.1 do igood=-ngoodstr,ngoodstr
1432     ibad=1
1433     if((INDMAX(icx)+igood).gt.ifirst.and.
1434     $ (INDMAX(icx)+igood).lt.ilast.and.
1435     $ .true.)then
1436     ibad=BAD(VIEW(icx),
1437     $ nvk(MAXS(icx)+igood),
1438     $ nst(MAXS(icx)+igood))
1439     endif
1440 pam-fi 1.6 badclx=badclx*ibad
1441 mocchiut 1.1 enddo
1442 pam-fi 1.4 * ----------------------------------------------------
1443     * >>> eliminato il taglio sulle BAD <<<
1444     * ----------------------------------------------------
1445 mocchiut 1.1 c if(badcl.eq.0)then
1446     c cl_single(icx)=0
1447     c goto 10
1448     c endif
1449     * ----------------------------------------------------
1450    
1451     cl_good(icx)=1
1452     nplx=npl(VIEW(icx))
1453     nldx=nld(MAXS(icx),VIEW(icx))
1454    
1455     do icy=1,nclstr1 !loop on cluster (Y)
1456     if(mod(VIEW(icy),2).eq.0)goto 20
1457    
1458     * ----------------------------------------------------
1459 pam-fi 1.9 * jump masked views (Y VIEW)
1460     * ----------------------------------------------------
1461     if( mask_view(VIEW(icy)).ne.0 ) goto 20
1462    
1463     * ----------------------------------------------------
1464 mocchiut 1.1 * cut on charge (Y VIEW)
1465 pam-fi 1.4 * ----------------------------------------------------
1466 pam-fi 1.18 if(sgnl(icy).lt.dedx_y_min)then
1467 mocchiut 1.1 cl_single(icy)=0
1468     goto 20
1469     endif
1470 pam-fi 1.4 * ----------------------------------------------------
1471 mocchiut 1.1 * cut BAD (Y VIEW)
1472 pam-fi 1.4 * ----------------------------------------------------
1473 mocchiut 1.1 badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
1474     ifirst=INDSTART(icy)
1475     if(icy.ne.nclstr1) then
1476     ilast=INDSTART(icy+1)-1
1477     else
1478     ilast=TOTCLLENGTH
1479     endif
1480 pam-fi 1.6 badcly=badseed
1481 mocchiut 1.1 do igood=-ngoodstr,ngoodstr
1482     ibad=1
1483     if((INDMAX(icy)+igood).gt.ifirst.and.
1484     $ (INDMAX(icy)+igood).lt.ilast.and.
1485     $ .true.)
1486     $ ibad=BAD(VIEW(icy),
1487     $ nvk(MAXS(icy)+igood),
1488     $ nst(MAXS(icy)+igood))
1489 pam-fi 1.6 badcly=badcly*ibad
1490 mocchiut 1.1 enddo
1491 pam-fi 1.4 * ----------------------------------------------------
1492     * >>> eliminato il taglio sulle BAD <<<
1493     * ----------------------------------------------------
1494 mocchiut 1.1 c if(badcl.eq.0)then
1495     c cl_single(icy)=0
1496     c goto 20
1497     c endif
1498     * ----------------------------------------------------
1499    
1500     cl_good(icy)=1
1501     nply=npl(VIEW(icy))
1502     nldy=nld(MAXS(icy),VIEW(icy))
1503    
1504     * ----------------------------------------------
1505     * CONDITION TO FORM A COUPLE
1506     * ----------------------------------------------
1507     * geometrical consistency (same plane and ladder)
1508     if(nply.eq.nplx.and.nldy.eq.nldx)then
1509     * charge correlation
1510 pam-fi 1.4 * (modified to be applied only below saturation... obviously)
1511    
1512 pam-fi 1.18 if( .not.(sgnl(icy).gt.chsaty.and.sgnl(icx).gt.chsatx)
1513 pam-fi 1.6 $ .and.
1514 pam-fi 1.18 $ .not.(sgnl(icy).lt.chmipy.and.sgnl(icx).lt.chmipx)
1515 pam-fi 1.6 $ .and.
1516     $ (badclx.eq.1.and.badcly.eq.1)
1517     $ .and.
1518     $ .true.)then
1519    
1520 pam-fi 1.18 ddd=(sgnl(icy)
1521     $ -kch(nplx,nldx)*sgnl(icx)-cch(nplx,nldx))
1522 pam-fi 1.6 ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
1523    
1524     c cut = chcut * sch(nplx,nldx)
1525    
1526 pam-fi 1.18 sss=(kch(nplx,nldx)*sgnl(icy)+sgnl(icx)
1527 pam-fi 1.6 $ -kch(nplx,nldx)*cch(nplx,nldx))
1528     sss=sss/sqrt(kch(nplx,nldx)**2+1)
1529     cut = chcut * (16 + sss/50.)
1530    
1531     if(abs(ddd).gt.cut)then
1532     goto 20 !charge not consistent
1533     endif
1534     endif
1535 pam-fi 1.14
1536 pam-fi 1.15 if(ncp_plane(nplx).gt.ncouplemax)then
1537 pam-fi 1.5 if(verbose)print*,
1538     $ '** warning ** number of identified '//
1539     $ 'couples on plane ',nplx,
1540     $ 'exceeds vector dimention '
1541 pam-fi 1.14 $ ,'( ',ncouplemax,' ) --> masked!'
1542 pam-fi 1.10 mask_view(nviewx(nplx)) = 2
1543     mask_view(nviewy(nply)) = 2
1544 pam-fi 1.15 goto 10
1545 pam-fi 1.5 endif
1546 pam-fi 1.15
1547     * ------------------> COUPLE <------------------
1548     ncp_plane(nplx) = ncp_plane(nplx) + 1
1549     clx(nplx,ncp_plane(nplx))=icx
1550     cly(nply,ncp_plane(nplx))=icy
1551     cl_single(icx)=0
1552     cl_single(icy)=0
1553 pam-fi 1.14 * ----------------------------------------------
1554    
1555 mocchiut 1.1 endif
1556    
1557     20 continue
1558     enddo !end loop on clusters(Y)
1559    
1560     10 continue
1561     enddo !end loop on clusters(X)
1562    
1563    
1564     do icl=1,nclstr1
1565     if(cl_single(icl).eq.1)then
1566     ip=npl(VIEW(icl))
1567     ncls(ip)=ncls(ip)+1
1568     cls(ip,ncls(ip))=icl
1569     endif
1570     enddo
1571    
1572    
1573     if(DEBUG)then
1574     print*,'clusters ',nclstr1
1575     print*,'good ',(cl_good(i),i=1,nclstr1)
1576     print*,'singles ',(cl_single(i),i=1,nclstr1)
1577     print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
1578     endif
1579    
1580     do ip=1,6
1581 pam-fi 1.10 ncp_tot = ncp_tot + ncp_plane(ip)
1582 mocchiut 1.1 enddo
1583    
1584     return
1585     end
1586    
1587     ***************************************************
1588     * *
1589     * *
1590     * *
1591     * *
1592     * *
1593     * *
1594     **************************************************
1595    
1596     subroutine cp_to_doubtrip(iflag)
1597    
1598     include 'commontracker.f'
1599 pam-fi 1.9 include 'level1.f'
1600 mocchiut 1.1 include 'common_momanhough.f'
1601     include 'common_xyzPAM.f'
1602     include 'common_mini_2.f'
1603     include 'calib.f'
1604    
1605    
1606     * output flag
1607     * --------------
1608     * 0 = good event
1609     * 1 = bad event
1610     * --------------
1611     integer iflag
1612    
1613    
1614     * -----------------------------
1615     * DOUBLETS/TRIPLETS coordinates
1616     c double precision xm1,ym1,zm1
1617     c double precision xm2,ym2,zm2
1618     c double precision xm3,ym3,zm3
1619    
1620     real xm1,ym1,zm1
1621     real xm2,ym2,zm2
1622     real xm3,ym3,zm3
1623     * -----------------------------
1624     * variable needed for tricircle:
1625     real xp(3),zp(3)!TRIPLETS coordinates, to find a circle
1626     EQUIVALENCE (xm1,xp(1))
1627     EQUIVALENCE (xm2,xp(2))
1628     EQUIVALENCE (xm3,xp(3))
1629     EQUIVALENCE (zm1,zp(1))
1630     EQUIVALENCE (zm2,zp(2))
1631     EQUIVALENCE (zm3,zp(3))
1632     real angp(3),resp(3),chi
1633     real xc,zc,radius
1634     * -----------------------------
1635    
1636    
1637 pam-fi 1.14 * --------------------------------------------
1638     * put a limit to the maximum number of couples
1639     * per plane, in order to apply hough transform
1640     * (couples recovered during track refinement)
1641     * --------------------------------------------
1642     do ip=1,nplanes
1643     if(ncp_plane(ip).gt.ncouplelimit)then
1644     mask_view(nviewx(ip)) = 8
1645     mask_view(nviewy(ip)) = 8
1646     endif
1647     enddo
1648    
1649 mocchiut 1.1
1650     ndblt=0 !number of doublets
1651     ntrpt=0 !number of triplets
1652    
1653     do ip1=1,(nplanes-1) !loop on planes - COPPIA 1
1654 pam-fi 1.14 if( mask_view(nviewx(ip1)).ne.0 .or.
1655     $ mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
1656     do is1=1,2 !loop on sensors - COPPIA 1
1657 mocchiut 1.1 do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
1658     icx1=clx(ip1,icp1)
1659     icy1=cly(ip1,icp1)
1660     c call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
1661 pam-fi 1.18 c call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
1662     call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
1663 mocchiut 1.1 xm1=xPAM
1664     ym1=yPAM
1665     zm1=zPAM
1666     c print*,'***',is1,xm1,ym1,zm1
1667 pam-fi 1.14
1668 mocchiut 1.1 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
1669 pam-fi 1.14 if( mask_view(nviewx(ip2)).ne.0 .or.
1670     $ mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
1671 mocchiut 1.1 do is2=1,2 !loop on sensors -ndblt COPPIA 2
1672    
1673     do icp2=1,ncp_plane(ip2) !loop on COPPIA 2
1674     icx2=clx(ip2,icp2)
1675     icy2=cly(ip2,icp2)
1676     c call xyz_PAM
1677     c $ (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
1678 pam-fi 1.18 c call xyz_PAM
1679     c $ (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)
1680 mocchiut 1.1 call xyz_PAM
1681 pam-fi 1.18 $ (icx2,icy2,is2,PFAdef,PFAdef,0.,0.,0.,0.)
1682 mocchiut 1.1 xm2=xPAM
1683     ym2=yPAM
1684     zm2=zPAM
1685    
1686     * - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1687     * track parameters on Y VIEW
1688     * (2 couples needed)
1689     * - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1690     if(ndblt.eq.ndblt_max)then
1691 pam-fi 1.5 if(verbose)print*,
1692 mocchiut 1.1 $ '** warning ** number of identified '//
1693     $ 'doublets exceeds vector dimention '
1694     $ ,'( ',ndblt_max,' )'
1695     c good2=.false.
1696     c goto 880 !fill ntp and go to next event
1697 pam-fi 1.10 do iv=1,12
1698     mask_view(iv) = 3
1699     enddo
1700 mocchiut 1.1 iflag=1
1701     return
1702     endif
1703     ndblt = ndblt + 1
1704     * store doublet info
1705     cpyz1(ndblt)=id_cp(ip1,icp1,is1)
1706     cpyz2(ndblt)=id_cp(ip2,icp2,is2)
1707     * tg(th_yz)
1708     alfayz2(ndblt)=(ym1-ym2)/(zm1-zm2)
1709     * y0 (cm)
1710     alfayz1(ndblt)=alfayz2(ndblt)*(zini-zm1)+ym1
1711    
1712     **** -----------------------------------------------****
1713     **** reject non phisical couples ****
1714     **** -----------------------------------------------****
1715     if(
1716     $ abs(alfayz2(ndblt)).gt.alfyz2_max
1717     $ .or.
1718     $ abs(alfayz1(ndblt)).gt.alfyz1_max
1719     $ )ndblt = ndblt-1
1720    
1721     c$$$ if(iev.eq.33)then
1722     c$$$ print*,'********* ',ndblt,' -- ',icp1,icp2,is1,is2
1723     c$$$ $ ,' || ',icx1,icy1,icx2,icy2
1724     c$$$ $ ,' || ',xm1,ym1,xm2,ym2
1725     c$$$ $ ,' || ',alfayz2(ndblt),alfayz1(ndblt)
1726     c$$$ endif
1727     c$$$
1728     * - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1729     * track parameters on Y VIEW - end
1730     * - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1731    
1732    
1733 pam-fi 1.14 if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
1734    
1735 mocchiut 1.1 do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
1736 pam-fi 1.14 if( mask_view(nviewx(ip3)).ne.0 .or.
1737     $ mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
1738 mocchiut 1.1 do is3=1,2 !loop on sensors - COPPIA 3
1739    
1740     do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
1741     icx3=clx(ip3,icp3)
1742     icy3=cly(ip3,icp3)
1743     c call xyz_PAM
1744     c $ (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
1745 pam-fi 1.18 c call xyz_PAM
1746     c $ (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)
1747 mocchiut 1.1 call xyz_PAM
1748 pam-fi 1.18 $ (icx3,icy3,is3,PFAdef,PFAdef
1749     $ ,0.,0.,0.,0.)
1750 mocchiut 1.1 xm3=xPAM
1751     ym3=yPAM
1752     zm3=zPAM
1753     * find the circle passing through the three points
1754     call tricircle(3,xp,zp,angp,resp,chi
1755     $ ,xc,zc,radius,iflag)
1756     c print*,xc,zc,radius
1757     * the circle must intersect the reference plane
1758     if(
1759     c $ (xc.le.-1.*xclimit.or.
1760     c $ xc.ge.xclimit).and.
1761     $ radius**2.ge.(ZINI-zc)**2.and.
1762     $ iflag.eq.0.and.
1763     $ .true.)then
1764    
1765     * - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1766     * track parameters on X VIEW
1767     * (3 couples needed)
1768     * - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1769     if(ntrpt.eq.ntrpt_max)then
1770 pam-fi 1.5 if(verbose)print*,
1771 mocchiut 1.1 $ '** warning ** number of identified '//
1772     $ 'triplets exceeds vector dimention '
1773     $ ,'( ',ntrpt_max,' )'
1774     c good2=.false.
1775     c goto 880 !fill ntp and go to next event
1776 pam-fi 1.10 do iv=1,nviews
1777     mask_view(iv) = 4
1778     enddo
1779 mocchiut 1.1 iflag=1
1780     return
1781     endif
1782     ntrpt = ntrpt +1
1783     * store triplet info
1784     cpxz1(ntrpt)=id_cp(ip1,icp1,is1)
1785     cpxz2(ntrpt)=id_cp(ip2,icp2,is2)
1786     cpxz3(ntrpt)=id_cp(ip3,icp3,is3)
1787    
1788     if(xc.lt.0)then
1789     *************POSITIVE DEFLECTION
1790     alfaxz1(ntrpt) = xc+sqrt(radius**2-(ZINI-zc)**2)
1791     alfaxz2(ntrpt) = (ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)
1792     alfaxz3(ntrpt) = 1/radius
1793     else
1794     *************NEGATIVE DEFLECTION
1795     alfaxz1(ntrpt) = xc-sqrt(radius**2-(ZINI-zc)**2)
1796     alfaxz2(ntrpt) = -(ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)
1797     alfaxz3(ntrpt) = -1/radius
1798     endif
1799    
1800     **** -----------------------------------------------****
1801     **** reject non phisical triplets ****
1802     **** -----------------------------------------------****
1803     if(
1804     $ abs(alfaxz2(ntrpt)).gt.alfxz2_max
1805     $ .or.
1806     $ abs(alfaxz1(ntrpt)).gt.alfxz1_max
1807     $ )ntrpt = ntrpt-1
1808    
1809    
1810     c print*,alfaxz1(ntrpt),alfaxz2(ntrpt),alfaxz3(ntrpt)
1811     * - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1812     * track parameters on X VIEW - end
1813     * - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1814     endif
1815     enddo !end loop on COPPIA 3
1816     enddo !end loop on sensors - COPPIA 3
1817 pam-fi 1.14 30 continue
1818 mocchiut 1.1 enddo !end loop on planes - COPPIA 3
1819 pam-fi 1.14 31 continue
1820 mocchiut 1.1
1821     1 enddo !end loop on COPPIA 2
1822     enddo !end loop on sensors - COPPIA 2
1823 pam-fi 1.14 20 continue
1824 mocchiut 1.1 enddo !end loop on planes - COPPIA 2
1825    
1826     enddo !end loop on COPPIA1
1827     enddo !end loop on sensors - COPPIA 1
1828 pam-fi 1.14 10 continue
1829 mocchiut 1.1 enddo !end loop on planes - COPPIA 1
1830    
1831     if(DEBUG)then
1832     print*,'--- doublets ',ndblt
1833     print*,'--- triplets ',ntrpt
1834     endif
1835    
1836     c goto 880 !ntp fill
1837    
1838    
1839     return
1840     end
1841    
1842    
1843    
1844     ***************************************************
1845     * *
1846     * *
1847     * *
1848     * *
1849     * *
1850     * *
1851     **************************************************
1852    
1853     subroutine doub_to_YZcloud(iflag)
1854    
1855     include 'commontracker.f'
1856 pam-fi 1.9 include 'level1.f'
1857 mocchiut 1.1 include 'common_momanhough.f'
1858 pam-fi 1.9 c include 'momanhough_init.f'
1859 mocchiut 1.1
1860    
1861     * output flag
1862     * --------------
1863     * 0 = good event
1864     * 1 = bad event
1865     * --------------
1866     integer iflag
1867    
1868     integer db_used(ndblt_max)
1869     integer db_temp(ndblt_max)
1870     integer db_all(ndblt_max) !stores db ID in each cloud
1871    
1872     integer hit_plane(nplanes)
1873    
1874     * mask for used couples
1875     integer cp_useds1(ncouplemaxtot) ! sensor 1
1876     integer cp_useds2(ncouplemaxtot) ! sensor 2
1877    
1878    
1879     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1880     * classification of DOUBLETS
1881     * according to distance in parameter space
1882     * (cloud = group of points (doublets) in parameter space)
1883     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1884     do idb=1,ndblt
1885     db_used(idb)=0
1886     enddo
1887    
1888     distance=0
1889     nclouds_yz=0 !number of clouds
1890     npt_tot=0
1891 pam-fi 1.9 nloop=0
1892     90 continue
1893 mocchiut 1.1 do idb1=1,ndblt !loop (1) on DOUBLETS
1894     if(db_used(idb1).eq.1)goto 2228 !db already included in a cloud
1895    
1896     c print*,'--------------'
1897     c print*,'** ',idb1,' **'
1898    
1899     do icp=1,ncp_tot
1900     cp_useds1(icp)=0 !init
1901     cp_useds2(icp)=0 !init
1902     enddo
1903     do idb=1,ndblt
1904     db_all(idb)=0
1905     enddo
1906     if(cpyz1(idb1).gt.0)cp_useds2(cpyz1(idb1))=1
1907     if(cpyz1(idb1).lt.0)cp_useds1(-cpyz1(idb1))=1
1908     if(cpyz2(idb1).gt.0)cp_useds2(cpyz2(idb1))=1
1909     if(cpyz2(idb1).lt.0)cp_useds1(-cpyz2(idb1))=1
1910     temp1 = alfayz1(idb1)
1911     temp2 = alfayz2(idb1)
1912     npt=1 !counter of points in the cloud
1913    
1914     db_all(npt) = idb1
1915    
1916     nptloop=1
1917     db_temp(1)=idb1
1918    
1919     88 continue
1920    
1921     npv=0 !# new points inlcuded
1922     do iloop=1,nptloop
1923     idbref=db_temp(iloop) !local point of reference
1924     ccccc if(db_used(idbref).eq.1)goto 1188 !next
1925    
1926     do idb2=1,ndblt !loop (2) on DOUBLETS
1927     if(idb2.eq.idbref)goto 1118 !next doublet
1928     if(db_used(idb2).eq.1)goto 1118
1929    
1930    
1931     * doublet distance in parameter space
1932     distance=
1933     $ ((alfayz1(idbref)-alfayz1(idb2))/Dalfayz1)**2
1934     $ +((alfayz2(idbref)-alfayz2(idb2))/Dalfayz2)**2
1935     distance = sqrt(distance)
1936    
1937     c$$$ if(iev.eq.33)then
1938     c$$$ if(distance.lt.100)
1939     c$$$ $ print*,'********* ',idb1,idbref,idb2,distance
1940     c$$$ if(distance.lt.100)
1941     c$$$ $ print*,'********* ',alfayz1(idbref),alfayz1(idb2)
1942     c$$$ $ ,alfayz2(idbref),alfayz2(idb2)
1943     c$$$ endif
1944     if(distance.lt.cutdistyz)then
1945    
1946     c print*,idb1,idb2,distance,' cloud ',nclouds_yz
1947     if(cpyz1(idb2).gt.0)cp_useds2(cpyz1(idb2))=1
1948     if(cpyz1(idb2).lt.0)cp_useds1(-cpyz1(idb2))=1
1949     if(cpyz2(idb2).gt.0)cp_useds2(cpyz2(idb2))=1
1950     if(cpyz2(idb2).lt.0)cp_useds1(-cpyz2(idb2))=1
1951     npt = npt + 1 !counter of points in the cloud
1952    
1953     npv = npv +1
1954     db_temp(npv) = idb2
1955     db_used(idbref) = 1
1956     db_used(idb2) = 1
1957    
1958     db_all(npt) = idb2
1959    
1960     temp1 = temp1 + alfayz1(idb2)
1961     temp2 = temp2 + alfayz2(idb2)
1962     c print*,'* idbref,idb2 ',idbref,idb2
1963     endif
1964    
1965     1118 continue
1966     enddo !end loop (2) on DOUBLETS
1967    
1968     1188 continue
1969     enddo !end loop on... bo?
1970    
1971     nptloop=npv
1972     if(nptloop.ne.0)goto 88
1973    
1974     * ------------------------------------------
1975     * stores the cloud only if
1976     * 1) it includes a minimum number of REAL couples
1977     * 1bis) it inlcudes a minimum number of doublets
1978     * 2) it is not already stored
1979     * ------------------------------------------
1980     do ip=1,nplanes
1981     hit_plane(ip)=0
1982     enddo
1983     ncpused=0
1984     do icp=1,ncp_tot
1985     if(cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0)then
1986     ncpused=ncpused+1
1987     ip=ip_cp(icp)
1988     hit_plane(ip)=1
1989     endif
1990     enddo
1991     nplused=0
1992     do ip=1,nplanes
1993     nplused=nplused+ hit_plane(ip)
1994     enddo
1995     c print*,'>>>> ',ncpused,npt,nplused
1996 pam-fi 1.9 c if(ncpused.lt.ncpyz_min)goto 2228 !next doublet
1997 mocchiut 1.1 if(npt.lt.nptyz_min)goto 2228 !next doublet
1998     if(nplused.lt.nplyz_min)goto 2228 !next doublet
1999    
2000     * ~~~~~~~~~~~~~~~~~
2001     * >>> NEW CLOUD <<<
2002    
2003     if(nclouds_yz.ge.ncloyz_max)then
2004 pam-fi 1.5 if(verbose)print*,
2005 mocchiut 1.1 $ '** warning ** number of identified '//
2006     $ 'YZ clouds exceeds vector dimention '
2007     $ ,'( ',ncloyz_max,' )'
2008     c good2=.false.
2009     c goto 880 !fill ntp and go to next event
2010 pam-fi 1.10 do iv=1,nviews
2011     mask_view(iv) = 5
2012     enddo
2013 mocchiut 1.1 iflag=1
2014     return
2015     endif
2016    
2017     nclouds_yz = nclouds_yz + 1 !increase counter
2018     alfayz1_av(nclouds_yz) = temp1/npt !store average parameter
2019     alfayz2_av(nclouds_yz) = temp2/npt ! "
2020     do icp=1,ncp_tot
2021     cpcloud_yz(nclouds_yz,icp)=
2022     $ cp_useds1(icp)+2*cp_useds2(icp) !store cp info
2023     enddo
2024     ptcloud_yz(nclouds_yz)=npt
2025     c ptcloud_yz_nt(nclouds_yz)=npt
2026     do ipt=1,npt
2027     db_cloud(npt_tot+ipt) = db_all(ipt)
2028     c print*,'>> ',ipt,db_all(ipt)
2029     enddo
2030     npt_tot=npt_tot+npt
2031     if(DEBUG)then
2032     print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'
2033     print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'
2034     print*,'- alfayz1 ',alfayz1_av(nclouds_yz)
2035     print*,'- alfayz2 ',alfayz2_av(nclouds_yz)
2036     print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)
2037     print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)
2038     print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)
2039     c$$$ print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '
2040     c$$$ $ ,ptcloud_yz(nclouds_yz)
2041     c$$$ print*,'nt-uple: db_cloud(...) = '
2042     c$$$ $ ,(db_cloud(iii),iii=npt_tot-npt+1,npt_tot)
2043     endif
2044     * >>> NEW CLOUD <<<
2045     * ~~~~~~~~~~~~~~~~~
2046     2228 continue
2047     enddo !end loop (1) on DOUBLETS
2048    
2049    
2050 pam-fi 1.9 if(nloop.lt.nstepy)then
2051     cutdistyz = cutdistyz+cutystep
2052     nloop = nloop+1
2053     goto 90
2054     endif
2055    
2056 mocchiut 1.1 if(DEBUG)then
2057     print*,'---------------------- '
2058     print*,'Y-Z total clouds ',nclouds_yz
2059     print*,' '
2060     endif
2061    
2062    
2063     return
2064     end
2065    
2066    
2067    
2068    
2069    
2070     ***************************************************
2071     * *
2072     * *
2073     * *
2074     * *
2075     * *
2076     * *
2077     **************************************************
2078    
2079     subroutine trip_to_XZcloud(iflag)
2080    
2081     include 'commontracker.f'
2082 pam-fi 1.9 include 'level1.f'
2083 mocchiut 1.1 include 'common_momanhough.f'
2084 pam-fi 1.9 c include 'momanhough_init.f'
2085 mocchiut 1.1
2086    
2087     * output flag
2088     * --------------
2089     * 0 = good event
2090     * 1 = bad event
2091     * --------------
2092     integer iflag
2093    
2094     integer tr_used(ntrpt_max)
2095     integer tr_temp(ntrpt_max)
2096     integer tr_incl(ntrpt_max)
2097     integer tr_all(ntrpt_max) !stores tr ID in each cloud
2098    
2099     integer hit_plane(nplanes)
2100    
2101     * mask for used couples
2102     integer cp_useds1(ncouplemaxtot) ! sensor 1
2103     integer cp_useds2(ncouplemaxtot) ! sensor 2
2104    
2105     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2106     * classification of TRIPLETS
2107     * according to distance in parameter space
2108     *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2109     do itr=1,ntrpt
2110     tr_used(itr)=0
2111     enddo
2112    
2113     distance=0
2114     nclouds_xz=0 !number of clouds
2115     npt_tot=0 !total number of selected triplets
2116 pam-fi 1.9 nloop=0
2117     91 continue
2118 mocchiut 1.1 do itr1=1,ntrpt !loop (1) on TRIPLETS
2119     if(tr_used(itr1).eq.1)goto 22288 !already included in a cloud
2120     c print*,'--------------'
2121     c print*,'** ',itr1,' **'
2122    
2123     do icp=1,ncp_tot
2124     cp_useds1(icp)=0
2125     cp_useds2(icp)=0
2126     enddo
2127     do itr=1,ntrpt
2128     tr_all(itr)=0 !list of included triplets
2129     enddo
2130     if(cpxz1(itr1).gt.0)cp_useds2(cpxz1(itr1))=1
2131     if(cpxz1(itr1).lt.0)cp_useds1(-cpxz1(itr1))=1
2132     if(cpxz2(itr1).gt.0)cp_useds2(cpxz2(itr1))=1
2133     if(cpxz2(itr1).lt.0)cp_useds1(-cpxz2(itr1))=1
2134     if(cpxz3(itr1).gt.0)cp_useds2(cpxz3(itr1))=1
2135     if(cpxz3(itr1).lt.0)cp_useds1(-cpxz3(itr1))=1
2136     temp1 = alfaxz1(itr1)
2137     temp2 = alfaxz2(itr1)
2138     temp3 = alfaxz3(itr1)
2139     npt=1 !counter of points in the cloud
2140    
2141     tr_all(npt) = itr1
2142    
2143     nptloop=1
2144     c tr_temp(1)=itr1
2145     tr_incl(1)=itr1
2146    
2147     8881 continue
2148    
2149     npv=0 !# new points inlcuded
2150     do iloop=1,nptloop
2151     itrref=tr_incl(iloop) !local point of reference
2152     do itr2=1,ntrpt !loop (2) on TRIPLETS
2153     if(itr2.eq.itr1)goto 11188 !next triplet
2154     if(tr_used(itr2).eq.1)goto 11188 !next triplet
2155     * triplet distance in parameter space
2156     * solo i due parametri spaziali per il momemnto
2157     distance=
2158     $ ((alfaxz1(itrref)-alfaxz1(itr2))/Dalfaxz1)**2
2159     $ +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2
2160     distance = sqrt(distance)
2161    
2162     if(distance.lt.cutdistxz)then
2163     c print*,idb1,idb2,distance,' cloud ',nclouds_yz
2164     if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1
2165     if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1
2166     if(cpxz2(itr2).gt.0)cp_useds2(cpxz2(itr2))=1
2167     if(cpxz2(itr2).lt.0)cp_useds1(-cpxz2(itr2))=1
2168     if(cpxz3(itr2).gt.0)cp_useds2(cpxz3(itr2))=1
2169     if(cpxz3(itr2).lt.0)cp_useds1(-cpxz3(itr2))=1
2170     npt = npt + 1 !counter of points in the cloud
2171    
2172     npv = npv +1
2173     tr_temp(npv) = itr2
2174     tr_used(itrref) = 1
2175     tr_used(itr2) = 1
2176    
2177     tr_all(npt) = itr2
2178    
2179     temp1 = temp1 + alfaxz1(itr2)
2180     temp2 = temp2 + alfaxz2(itr2)
2181     temp3 = temp3 + alfaxz3(itr2)
2182     c print*,'* itrref,itr2 ',itrref,itr2,distance
2183     endif
2184    
2185     11188 continue
2186     enddo !end loop (2) on TRIPLETS
2187    
2188     11888 continue
2189     enddo !end loop on... bo?
2190    
2191     nptloop=npv
2192     do i=1,npv
2193     tr_incl(i)=tr_temp(i)
2194     enddo
2195     if(nptloop.ne.0)goto 8881
2196    
2197     * ------------------------------------------
2198     * stores the cloud only if
2199     * 1) it includes a minimum number of REAL couples
2200     * 1bis)
2201     * 2) it is not already stored
2202     * ------------------------------------------
2203     c print*,'check cp_used'
2204     do ip=1,nplanes
2205     hit_plane(ip)=0
2206     enddo
2207     ncpused=0
2208     do icp=1,ncp_tot
2209     if(cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0)then
2210     ncpused=ncpused+1
2211     ip=ip_cp(icp)
2212     hit_plane(ip)=1
2213     endif
2214     enddo
2215     nplused=0
2216     do ip=1,nplanes
2217     nplused=nplused+ hit_plane(ip)
2218     enddo
2219 pam-fi 1.9 c if(ncpused.lt.ncpxz_min)goto 22288 !next triplet
2220 mocchiut 1.1 if(npt.lt.nptxz_min)goto 22288 !next triplet
2221     if(nplused.lt.nplxz_min)goto 22288 !next doublet
2222    
2223     * ~~~~~~~~~~~~~~~~~
2224     * >>> NEW CLOUD <<<
2225     if(nclouds_xz.ge.ncloxz_max)then
2226 pam-fi 1.5 if(verbose)print*,
2227 mocchiut 1.1 $ '** warning ** number of identified '//
2228     $ 'XZ clouds exceeds vector dimention '
2229     $ ,'( ',ncloxz_max,' )'
2230     c good2=.false.
2231     c goto 880 !fill ntp and go to next event
2232 pam-fi 1.10 do iv=1,nviews
2233     mask_view(iv) = 6
2234     enddo
2235 mocchiut 1.1 iflag=1
2236     return
2237     endif
2238     nclouds_xz = nclouds_xz + 1 !increase counter
2239     alfaxz1_av(nclouds_xz) = temp1/npt !store average parameter
2240     alfaxz2_av(nclouds_xz) = temp2/npt ! "
2241     alfaxz3_av(nclouds_xz) = temp3/npt ! "
2242     do icp=1,ncp_tot
2243     cpcloud_xz(nclouds_xz,icp)=
2244     $ cp_useds1(icp)+2*cp_useds2(icp) !store cp info
2245     enddo
2246     ptcloud_xz(nclouds_xz)=npt
2247     do ipt=1,npt
2248     tr_cloud(npt_tot+ipt) = tr_all(ipt)
2249     enddo
2250     npt_tot=npt_tot+npt
2251    
2252     if(DEBUG)then
2253     print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'
2254     print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'
2255     print*,'- alfaxz1 ',alfaxz1_av(nclouds_xz)
2256     print*,'- alfaxz2 ',alfaxz2_av(nclouds_xz)
2257     print*,'- alfaxz3 ',alfaxz3_av(nclouds_xz)
2258     print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)
2259     print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)
2260     print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)
2261     c$$$ print*,'nt-uple: ptcloud_xz(',nclouds_xz,') = '
2262     c$$$ $ ,ptcloud_xz(nclouds_xz)
2263     c$$$ print*,'nt-uple: tr_cloud(...) = '
2264     c$$$ $ ,(tr_cloud(iii),iii=npt_tot-npt+1,npt_tot)
2265     endif
2266     * >>> NEW CLOUD <<<
2267     * ~~~~~~~~~~~~~~~~~
2268     22288 continue
2269     enddo !end loop (1) on DOUBLETS
2270 pam-fi 1.9
2271     if(nloop.lt.nstepx)then
2272     cutdistxz=cutdistxz+cutxstep
2273     nloop=nloop+1
2274     goto 91
2275     endif
2276    
2277 mocchiut 1.1 if(DEBUG)then
2278     print*,'---------------------- '
2279     print*,'X-Z total clouds ',nclouds_xz
2280     print*,' '
2281     endif
2282    
2283    
2284     return
2285     end
2286    
2287    
2288     ***************************************************
2289     * *
2290     * *
2291     * *
2292     * *
2293     * *
2294     * *
2295     **************************************************
2296    
2297     subroutine clouds_to_ctrack(iflag)
2298     c*****************************************************
2299     c 02/02/2006 modified by Elena Vannuccini --> (1)
2300     c*****************************************************
2301    
2302     include 'commontracker.f'
2303 pam-fi 1.9 include 'level1.f'
2304 mocchiut 1.1 include 'common_momanhough.f'
2305     include 'common_xyzPAM.f'
2306     include 'common_mini_2.f'
2307     include 'common_mech.f'
2308 pam-fi 1.9 c include 'momanhough_init.f'
2309 mocchiut 1.1
2310    
2311     * output flag
2312     * --------------
2313     * 0 = good event
2314     * 1 = bad event
2315     * --------------
2316     integer iflag
2317    
2318     * -----------------------------------------------------------
2319     * mask to store (locally) the couples included
2320     * in the intersection bewteen a XZ and YZ cloud
2321     integer cpintersec(ncouplemaxtot)
2322     * -----------------------------------------------------------
2323     * list of matching couples in the combination
2324     * between a XZ and YZ cloud
2325 pam-fi 1.9 integer cp_match(nplanes,2*ncouplemax)
2326 mocchiut 1.1 integer ncp_match(nplanes)
2327     * -----------------------------------------------------------
2328     integer hit_plane(nplanes)
2329     * -----------------------------------------------------------
2330     * variables for track fitting
2331     double precision AL_INI(5)
2332 pam-fi 1.11 c double precision tath
2333 mocchiut 1.1 * -----------------------------------------------------------
2334     c real fitz(nplanes) !z coordinates of the planes in cm
2335    
2336    
2337    
2338     ntracks=0 !counter of track candidates
2339    
2340     do iyz=1,nclouds_yz !loop on YZ couds
2341     do ixz=1,nclouds_xz !loop on XZ couds
2342    
2343     * --------------------------------------------------
2344     * check of consistency of the clouds
2345     * ---> required a minimum number of matching couples
2346     * the track fit will be performed on the INTERSECTION
2347     * of the two clouds
2348     * --------------------------------------------------
2349     do ip=1,nplanes
2350     hit_plane(ip)=0
2351     ncp_match(ip)=0
2352     do icpp=1,ncouplemax
2353     cp_match(ip,icpp)=0 !init couple list
2354     enddo
2355     enddo
2356     ncp_ok=0
2357     do icp=1,ncp_tot !loop on couples
2358     * get info on
2359     cpintersec(icp)=min(
2360     $ cpcloud_yz(iyz,icp),
2361     $ cpcloud_xz(ixz,icp))
2362     if(
2363     $ (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.
2364     $ (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.
2365     $ .false.)cpintersec(icp)=0
2366     if(cpintersec(icp).ne.0)then
2367     ncp_ok=ncp_ok+1
2368    
2369     ip=ip_cp(icp)
2370     hit_plane(ip)=1
2371     if(cpintersec(icp).eq.1)then
2372     * 1) only the couple image in sensor 1 matches
2373     id=-icp
2374     ncp_match(ip)=ncp_match(ip)+1
2375     cp_match(ip,ncp_match(ip))=id
2376     elseif(cpintersec(icp).eq.2)then
2377     * 2) only the couple image in sensor 2 matches
2378     id=icp
2379     ncp_match(ip)=ncp_match(ip)+1
2380     cp_match(ip,ncp_match(ip))=id
2381     else
2382     * 3) both couple images match
2383     id=icp
2384     do is=1,2
2385     id=-id
2386     ncp_match(ip)=ncp_match(ip)+1
2387     cp_match(ip,ncp_match(ip))=id
2388     enddo
2389     endif
2390     endif !end matching condition
2391     enddo !end loop on couples
2392    
2393     nplused=0
2394     do ip=1,nplanes
2395     nplused=nplused+ hit_plane(ip)
2396     enddo
2397    
2398 pam-fi 1.15 c if(nplused.lt.nplxz_min)goto 888 !next doublet
2399     if(nplused.lt.nplyz_min)goto 888 !next doublet
2400 mocchiut 1.1 if(ncp_ok.lt.ncpok)goto 888 !next cloud
2401    
2402     if(DEBUG)then
2403     print*,'Combination ',iyz,ixz
2404     $ ,' db ',ptcloud_yz(iyz)
2405     $ ,' tr ',ptcloud_xz(ixz)
2406     $ ,' -----> # matching couples ',ncp_ok
2407     endif
2408     c$$$ print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2409     c$$$ print*,'Configurazione cluster XZ'
2410     c$$$ print*,'1 -- ',(clx(1,i),i=1,ncp_plane(1))
2411     c$$$ print*,'2 -- ',(clx(2,i),i=1,ncp_plane(1))
2412     c$$$ print*,'3 -- ',(clx(3,i),i=1,ncp_plane(1))
2413     c$$$ print*,'4 -- ',(clx(4,i),i=1,ncp_plane(1))
2414     c$$$ print*,'5 -- ',(clx(5,i),i=1,ncp_plane(1))
2415     c$$$ print*,'6 -- ',(clx(6,i),i=1,ncp_plane(1))
2416     c$$$ print*,'Configurazione cluster YZ'
2417     c$$$ print*,'1 -- ',(cly(1,i),i=1,ncp_plane(1))
2418     c$$$ print*,'2 -- ',(cly(2,i),i=1,ncp_plane(1))
2419     c$$$ print*,'3 -- ',(cly(3,i),i=1,ncp_plane(1))
2420     c$$$ print*,'4 -- ',(cly(4,i),i=1,ncp_plane(1))
2421     c$$$ print*,'5 -- ',(cly(5,i),i=1,ncp_plane(1))
2422     c$$$ print*,'6 -- ',(cly(6,i),i=1,ncp_plane(1))
2423     c$$$ print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2424    
2425     * -------> INITIAL GUESS <-------
2426 pam-fi 1.11 cccc SBAGLIATO
2427     c$$$ AL_INI(1) = dreal(alfaxz1_av(ixz))
2428     c$$$ AL_INI(2) = dreal(alfayz1_av(iyz))
2429     c$$$ AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2430     c$$$ $ /dreal(alfaxz2_av(ixz)))
2431     c$$$ tath = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2432     c$$$ AL_INI(3) = tath/sqrt(1+tath**2)
2433     c$$$ AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2434     cccc GIUSTO (ma si sua guess())
2435     c$$$ AL_INI(1) = dreal(alfaxz1_av(ixz))
2436     c$$$ AL_INI(2) = dreal(alfayz1_av(iyz))
2437     c$$$ tath = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2438     c$$$ AL_INI(3) = tath/sqrt(1+tath**2)
2439     c$$$ IF(alfaxz2_av(ixz).NE.0)THEN
2440     c$$$ AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2441     c$$$ $ /dreal(alfaxz2_av(ixz)))
2442     c$$$ ELSE
2443     c$$$ AL_INI(4) = acos(-1.)/2
2444     c$$$ IF(alfayz2_av(iyz).LT.0)AL_INI(4) = AL_INI(4)+acos(-1.)
2445     c$$$ ENDIF
2446     c$$$ IF(alfaxz2_av(ixz).LT.0)AL_INI(4)= acos(-1.)+ AL_INI(4)
2447     c$$$ AL_INI(4) = -acos(-1.) + AL_INI(4) !from incidence direction to tracking rs
2448     c$$$
2449     c$$$ AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2450     c$$$
2451     c$$$ if(AL_INI(5).gt.defmax)goto 888 !next cloud
2452    
2453 mocchiut 1.1 if(DEBUG)then
2454     print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2455     print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))
2456     print*,'3 >>> ',(cp_match(4,i),i=1,ncp_match(4))
2457     print*,'4 >>> ',(cp_match(3,i),i=1,ncp_match(3))
2458     print*,'5 >>> ',(cp_match(2,i),i=1,ncp_match(2))
2459     print*,'6 >>> ',(cp_match(1,i),i=1,ncp_match(1))
2460     endif
2461    
2462     do icp1=1,max(1,ncp_match(1))
2463     hit_plane(1)=icp1
2464     if(ncp_match(1).eq.0)hit_plane(1)=0 !-icp1
2465    
2466     do icp2=1,max(1,ncp_match(2))
2467     hit_plane(2)=icp2
2468     if(ncp_match(2).eq.0)hit_plane(2)=0 !-icp2
2469    
2470     do icp3=1,max(1,ncp_match(3))
2471     hit_plane(3)=icp3
2472     if(ncp_match(3).eq.0)hit_plane(3)=0 !-icp3
2473    
2474     do icp4=1,max(1,ncp_match(4))
2475     hit_plane(4)=icp4
2476     if(ncp_match(4).eq.0)hit_plane(4)=0 !-icp4
2477    
2478     do icp5=1,max(1,ncp_match(5))
2479     hit_plane(5)=icp5
2480     if(ncp_match(5).eq.0)hit_plane(5)=0 !-icp5
2481    
2482     do icp6=1,max(1,ncp_match(6))
2483     hit_plane(6)=icp6
2484     if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6
2485    
2486    
2487     call track_init !init TRACK common
2488    
2489     do ip=1,nplanes !loop on planes
2490     if(hit_plane(ip).ne.0)then
2491     id=cp_match(ip,hit_plane(ip))
2492     is=is_cp(id)
2493     icp=icp_cp(id)
2494     if(ip_cp(id).ne.ip)
2495     $ print*,'OKKIO!!'
2496     $ ,'id ',id,is,icp
2497     $ ,ip_cp(id),ip
2498     icx=clx(ip,icp)
2499     icy=cly(ip,icp)
2500     * *************************
2501     c call xyz_PAM(icx,icy,is,
2502     c $ 'COG2','COG2',0.,0.)
2503 pam-fi 1.18 c call xyz_PAM(icx,icy,is, !(1)
2504     c $ PFAdef,PFAdef,0.,0.) !(1)
2505 mocchiut 1.1 call xyz_PAM(icx,icy,is, !(1)
2506 pam-fi 1.18 $ PFAdef,PFAdef,0.,0.,0.,0.)
2507 mocchiut 1.1 * *************************
2508     * -----------------------------
2509     xgood(nplanes-ip+1)=1.
2510     ygood(nplanes-ip+1)=1.
2511     xm(nplanes-ip+1)=xPAM
2512     ym(nplanes-ip+1)=yPAM
2513     zm(nplanes-ip+1)=zPAM
2514     resx(nplanes-ip+1)=resxPAM
2515     resy(nplanes-ip+1)=resyPAM
2516     * -----------------------------
2517     endif
2518     enddo !end loop on planes
2519     * **********************************************************
2520     * ************************** FIT *** FIT *** FIT *** FIT ***
2521     * **********************************************************
2522 pam-fi 1.11 cccc scommentare se si usa al_ini della nuvola
2523     c$$$ do i=1,5
2524     c$$$ AL(i)=AL_INI(i)
2525     c$$$ enddo
2526     call guess()
2527 mocchiut 1.1 do i=1,5
2528 pam-fi 1.11 AL_INI(i)=AL(i)
2529 mocchiut 1.1 enddo
2530     ifail=0 !error flag in chi^2 computation
2531     jstep=0 !number of minimization steps
2532 pam-fi 1.8 iprint=0
2533 pam-fi 1.11 c if(DEBUG)iprint=1
2534 pam-fi 1.16 if(DEBUG)iprint=2
2535 pam-fi 1.8 call mini2(jstep,ifail,iprint)
2536 mocchiut 1.1 if(ifail.ne.0) then
2537     if(DEBUG)then
2538     print *,
2539     $ '*** MINIMIZATION FAILURE *** '
2540 pam-fi 1.11 $ //'(clouds_to_ctrack)'
2541     print*,'initial guess: '
2542    
2543     print*,'AL_INI(1) = ',AL_INI(1)
2544     print*,'AL_INI(2) = ',AL_INI(2)
2545     print*,'AL_INI(3) = ',AL_INI(3)
2546     print*,'AL_INI(4) = ',AL_INI(4)
2547     print*,'AL_INI(5) = ',AL_INI(5)
2548 mocchiut 1.1 endif
2549 pam-fi 1.11 c chi2=-chi2
2550 mocchiut 1.1 endif
2551     * **********************************************************
2552     * ************************** FIT *** FIT *** FIT *** FIT ***
2553     * **********************************************************
2554    
2555     if(chi2.le.0.)goto 666
2556    
2557     * --------------------------
2558     * STORE candidate TRACK INFO
2559     * --------------------------
2560     if(ntracks.eq.NTRACKSMAX)then
2561    
2562 pam-fi 1.5 if(verbose)print*,
2563 mocchiut 1.1 $ '** warning ** number of candidate tracks '//
2564     $ ' exceeds vector dimension '
2565     $ ,'( ',NTRACKSMAX,' )'
2566     c good2=.false.
2567     c goto 880 !fill ntp and go to next event
2568 pam-fi 1.10 do iv=1,nviews
2569     mask_view(iv) = 7
2570     enddo
2571 mocchiut 1.1 iflag=1
2572     return
2573     endif
2574    
2575     ntracks = ntracks + 1
2576    
2577     c$$$ ndof=0
2578     do ip=1,nplanes
2579     c$$$ ndof=ndof
2580     c$$$ $ +int(xgood(ip))
2581     c$$$ $ +int(ygood(ip))
2582     XV_STORE(ip,ntracks)=sngl(xv(ip))
2583     YV_STORE(ip,ntracks)=sngl(yv(ip))
2584     ZV_STORE(ip,ntracks)=sngl(zv(ip))
2585     XM_STORE(ip,ntracks)=sngl(xm(ip))
2586     YM_STORE(ip,ntracks)=sngl(ym(ip))
2587     ZM_STORE(ip,ntracks)=sngl(zm(ip))
2588     RESX_STORE(ip,ntracks)=sngl(resx(ip))
2589     RESY_STORE(ip,ntracks)=sngl(resy(ip))
2590     XV_STORE(ip,ntracks)=sngl(xv(ip))
2591     YV_STORE(ip,ntracks)=sngl(yv(ip))
2592     ZV_STORE(ip,ntracks)=sngl(zv(ip))
2593     AXV_STORE(ip,ntracks)=sngl(axv(ip))
2594     AYV_STORE(ip,ntracks)=sngl(ayv(ip))
2595     XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))
2596     YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))
2597     if(hit_plane(ip).ne.0)then
2598     CP_STORE(nplanes-ip+1,ntracks)=
2599     $ cp_match(ip,hit_plane(ip))
2600     else
2601     CP_STORE(nplanes-ip+1,ntracks)=0
2602     endif
2603     CLS_STORE(nplanes-ip+1,ntracks)=0
2604     do i=1,5
2605     AL_STORE(i,ntracks)=sngl(AL(i))
2606     enddo
2607     enddo
2608    
2609     c$$$ * Number of Degree Of Freedom
2610     c$$$ ndof=ndof-5
2611     c$$$ * reduced chi^2
2612     c$$$ rchi2=chi2/dble(ndof)
2613     RCHI2_STORE(ntracks)=chi2
2614    
2615     * --------------------------------
2616     * STORE candidate TRACK INFO - end
2617     * --------------------------------
2618    
2619     666 continue
2620     enddo !end loop on cp in plane 6
2621     enddo !end loop on cp in plane 5
2622     enddo !end loop on cp in plane 4
2623     enddo !end loop on cp in plane 3
2624     enddo !end loop on cp in plane 2
2625     enddo !end loop on cp in plane 1
2626    
2627     888 continue
2628     enddo !end loop on XZ couds
2629     enddo !end loop on YZ couds
2630    
2631     if(ntracks.eq.0)then
2632     iflag=1
2633     return
2634     endif
2635    
2636     if(DEBUG)then
2637     print*,'****** TRACK CANDIDATES ***********'
2638     print*,'# R. chi2 RIG'
2639     do i=1,ntracks
2640     print*,i,' --- ',rchi2_store(i),' --- '
2641     $ ,1./abs(AL_STORE(5,i))
2642     enddo
2643     print*,'***********************************'
2644     endif
2645    
2646    
2647     return
2648     end
2649    
2650    
2651     ***************************************************
2652     * *
2653     * *
2654     * *
2655     * *
2656     * *
2657     * *
2658     **************************************************
2659    
2660     subroutine refine_track(ibest)
2661    
2662     c******************************************************
2663     cccccc 06/10/2005 modified by elena vannuccini ---> (1)
2664     cccccc 31/01/2006 modified by elena vannuccini ---> (2)
2665 pam-fi 1.3 cccccc 12/08/2006 modified by elena vannucicni ---> (3)
2666 mocchiut 1.1 c******************************************************
2667    
2668     include 'commontracker.f'
2669 pam-fi 1.9 include 'level1.f'
2670 mocchiut 1.1 include 'common_momanhough.f'
2671     include 'common_xyzPAM.f'
2672     include 'common_mini_2.f'
2673     include 'common_mech.f'
2674 pam-fi 1.9 c include 'momanhough_init.f'
2675     c include 'level1.f'
2676 mocchiut 1.1 include 'calib.f'
2677    
2678     * flag to chose PFA
2679     character*10 PFA
2680     common/FINALPFA/PFA
2681    
2682 pam-fi 1.18 real xp,yp,zp
2683     real xyzp(3),bxyz(3)
2684     equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
2685    
2686 mocchiut 1.1 * =================================================
2687     * new estimate of positions using ETA algorithm
2688     * and
2689     * search for new couples and single clusters to add
2690     * =================================================
2691     call track_init
2692     do ip=1,nplanes !loop on planes
2693    
2694 pam-fi 1.18 xP=XV_STORE(nplanes-ip+1,ibest)
2695     yP=YV_STORE(nplanes-ip+1,ibest)
2696     zP=ZV_STORE(nplanes-ip+1,ibest)
2697     call gufld(xyzp,bxyz)
2698     c$$$ bxyz(1)=0
2699     c$$$ bxyz(2)=0
2700     c$$$ bxyz(3)=0
2701 pam-fi 1.11 * |||||||||||||||||||||||||||||||||||||||||||||||||
2702 mocchiut 1.1 * -------------------------------------------------
2703     * If the plane has been already included, it just
2704     * computes again the coordinates of the x-y couple
2705     * using improved PFAs
2706     * -------------------------------------------------
2707 pam-fi 1.11 * |||||||||||||||||||||||||||||||||||||||||||||||||
2708 mocchiut 1.1 if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
2709     $ YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
2710    
2711     id=CP_STORE(nplanes-ip+1,ibest)
2712    
2713     is=is_cp(id)
2714     icp=icp_cp(id)
2715     if(ip_cp(id).ne.ip)
2716     $ print*,'OKKIO!!'
2717     $ ,'id ',id,is,icp
2718     $ ,ip_cp(id),ip
2719     icx=clx(ip,icp)
2720     icy=cly(ip,icp)
2721 pam-fi 1.18 c call xyz_PAM(icx,icy,is,
2722     c $ PFA,PFA,
2723     c $ AXV_STORE(nplanes-ip+1,ibest),
2724     c $ AYV_STORE(nplanes-ip+1,ibest))
2725 mocchiut 1.1 call xyz_PAM(icx,icy,is,
2726     $ PFA,PFA,
2727     $ AXV_STORE(nplanes-ip+1,ibest),
2728 pam-fi 1.18 $ AYV_STORE(nplanes-ip+1,ibest),
2729     $ bxyz(1),
2730     $ bxyz(2)
2731     $ )
2732 mocchiut 1.1 c$$$ call xyz_PAM(icx,icy,is,
2733     c$$$ $ 'COG2','COG2',
2734     c$$$ $ 0.,
2735     c$$$ $ 0.)
2736     xm(nplanes-ip+1) = xPAM
2737     ym(nplanes-ip+1) = yPAM
2738     zm(nplanes-ip+1) = zPAM
2739     xgood(nplanes-ip+1) = 1
2740     ygood(nplanes-ip+1) = 1
2741     resx(nplanes-ip+1) = resxPAM
2742     resy(nplanes-ip+1) = resyPAM
2743    
2744 pam-fi 1.18 c dedxtrk(nplanes-ip+1) = (sgnl(icx)+sgnl(icy))/2. !(1)
2745     dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
2746     dedxtrk_y(nplanes-ip+1)=sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
2747 mocchiut 1.1
2748 pam-fi 1.11 * |||||||||||||||||||||||||||||||||||||||||||||||||
2749 mocchiut 1.1 * -------------------------------------------------
2750     * If the plane has NOT been already included,
2751     * it tries to include a COUPLE or a single cluster
2752     * -------------------------------------------------
2753 pam-fi 1.11 * |||||||||||||||||||||||||||||||||||||||||||||||||
2754 mocchiut 1.1 else
2755    
2756     xgood(nplanes-ip+1)=0
2757     ygood(nplanes-ip+1)=0
2758    
2759     * --------------------------------------------------------------
2760     * determine which ladder and sensor are intersected by the track
2761 pam-fi 1.18 c$$$ xP=XV_STORE(nplanes-ip+1,ibest)
2762     c$$$ yP=YV_STORE(nplanes-ip+1,ibest)
2763     c$$$ zP=ZV_STORE(nplanes-ip+1,ibest)
2764 mocchiut 1.1 call whichsensor(ip,xP,yP,nldt,ist)
2765     * if the track hit the plane in a dead area, go to the next plane
2766     if(nldt.eq.0.or.ist.eq.0)goto 133
2767     * --------------------------------------------------------------
2768    
2769     if(DEBUG)then
2770     print*,
2771     $ '------ Plane ',ip,' intersected on LADDER ',nldt
2772     $ ,' SENSOR ',ist
2773     print*,
2774     $ '------ coord: ',XP,YP
2775     endif
2776    
2777     * ===========================================
2778     * STEP 1 >>>>>>> try to include a new couple
2779     * ===========================================
2780     c if(DEBUG)print*,'>>>> try to include a new couple'
2781     distmin=1000000.
2782     xmm = 0.
2783     ymm = 0.
2784     zmm = 0.
2785     rxmm = 0.
2786     rymm = 0.
2787     dedxmmx = 0. !(1)
2788     dedxmmy = 0. !(1)
2789     idm = 0 !ID of the closer couple
2790     distance=0.
2791     do icp=1,ncp_plane(ip) !loop on couples on plane icp
2792     icx=clx(ip,icp)
2793     icy=cly(ip,icp)
2794     if(LADDER(icx).ne.nldt.or. !If the ladder number does not match
2795 pam-fi 1.3 c $ cl_used(icx).eq.1.or. !or the X cluster is already used
2796     c $ cl_used(icy).eq.1.or. !or the Y cluster is already used
2797     $ cl_used(icx).ne.0.or. !or the X cluster is already used !(3)
2798     $ cl_used(icy).ne.0.or. !or the Y cluster is already used !(3)
2799 mocchiut 1.1 $ .false.)goto 1188 !then jump to next couple.
2800     *
2801 pam-fi 1.18 c call xyz_PAM(icx,icy,ist,
2802     c $ PFA,PFA,
2803     c $ AXV_STORE(nplanes-ip+1,ibest),
2804     c $ AYV_STORE(nplanes-ip+1,ibest))
2805 mocchiut 1.1 call xyz_PAM(icx,icy,ist,
2806     $ PFA,PFA,
2807     $ AXV_STORE(nplanes-ip+1,ibest),
2808 pam-fi 1.18 $ AYV_STORE(nplanes-ip+1,ibest),
2809     $ bxyz(1),
2810     $ bxyz(2)
2811     $ )
2812 mocchiut 1.1
2813     distance = distance_to(XP,YP)
2814 pam-fi 1.11 distance = distance / RCHI2_STORE(ibest)!<<< MS
2815 mocchiut 1.1 id=id_cp(ip,icp,ist)
2816     if(DEBUG)print*,'( couple ',id
2817     $ ,' ) normalized distance ',distance
2818     if(distance.lt.distmin)then
2819     xmm = xPAM
2820     ymm = yPAM
2821     zmm = zPAM
2822     rxmm = resxPAM
2823     rymm = resyPAM
2824     distmin = distance
2825     idm = id
2826 pam-fi 1.18 c dedxmm = (sgnl(icx)+sgnl(icy))/2. !(1)
2827     dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
2828     dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
2829 mocchiut 1.1 endif
2830     1188 continue
2831     enddo !end loop on couples on plane icp
2832     if(distmin.le.clinc)then
2833     * -----------------------------------
2834     xm(nplanes-ip+1) = xmm !<<<
2835     ym(nplanes-ip+1) = ymm !<<<
2836     zm(nplanes-ip+1) = zmm !<<<
2837     xgood(nplanes-ip+1) = 1 !<<<
2838     ygood(nplanes-ip+1) = 1 !<<<
2839     resx(nplanes-ip+1)=rxmm !<<<
2840     resy(nplanes-ip+1)=rymm !<<<
2841     c dedxtrk(nplanes-ip+1) = dedxmm !<<< !(1)
2842     dedxtrk_x(nplanes-ip+1) = dedxmmx !(1)
2843     dedxtrk_y(nplanes-ip+1) = dedxmmy !(1)
2844     * -----------------------------------
2845     CP_STORE(nplanes-ip+1,ibest)=idm
2846     if(DEBUG)print*,'%%%% included couple ',idm
2847     $ ,' (norm.dist.= ',distmin,', cut ',clinc,' )'
2848     goto 133 !next plane
2849     endif
2850     * ================================================
2851     * STEP 2 >>>>>>> try to include a single cluster
2852     * either from a couple or single
2853     * ================================================
2854     c if(DEBUG)print*,'>>>> try to include a new cluster'
2855     distmin=1000000.
2856     xmm_A = 0. !---------------------------
2857     ymm_A = 0. ! init variables that
2858     zmm_A = 0. ! define the SINGLET
2859     xmm_B = 0. !
2860     ymm_B = 0. !
2861     zmm_B = 0. !
2862     rxmm = 0. !
2863     rymm = 0. !
2864     dedxmmx = 0. !(1)
2865     dedxmmy = 0. !(1)
2866     iclm=0 !---------------------------
2867     distance=0.
2868    
2869     *----- clusters inside couples -------------------------------------
2870     do icp=1,ncp_plane(ip) !loop on cluster inside couples
2871     icx=clx(ip,icp)
2872     icy=cly(ip,icp)
2873     id=id_cp(ip,icp,ist)
2874     if(LADDER(icx).ne.nldt)goto 11882 !if the ladder number does not match
2875     * !jump to the next couple
2876     *----- try cluster x -----------------------------------------------
2877 pam-fi 1.3 c if(cl_used(icx).eq.1)goto 11881 !if the X cluster is already used
2878     if(cl_used(icx).ne.0)goto 11881 !if the X cluster is already used !(3)
2879 mocchiut 1.1 * !jump to the Y cluster
2880 pam-fi 1.18 c call xyz_PAM(icx,0,ist,
2881     c $ PFA,PFA,
2882     c $ AXV_STORE(nplanes-ip+1,ibest),0.)
2883 mocchiut 1.1 call xyz_PAM(icx,0,ist,
2884     $ PFA,PFA,
2885 pam-fi 1.18 $ AXV_STORE(nplanes-ip+1,ibest),0.,
2886     $ bxyz(1),
2887     $ bxyz(2)
2888     $ )
2889 mocchiut 1.1 distance = distance_to(XP,YP)
2890 pam-fi 1.11 distance = distance / RCHI2_STORE(ibest)!<<< MS
2891 mocchiut 1.1 if(DEBUG)print*,'( cl-X ',icx
2892     $ ,' in cp ',id,' ) normalized distance ',distance
2893     if(distance.lt.distmin)then
2894     xmm_A = xPAM_A
2895     ymm_A = yPAM_A
2896     zmm_A = zPAM_A
2897     xmm_B = xPAM_B
2898     ymm_B = yPAM_B
2899     zmm_B = zPAM_B
2900     rxmm = resxPAM
2901     rymm = resyPAM
2902     distmin = distance
2903     iclm = icx
2904 pam-fi 1.18 c dedxmm = sgnl(icx) !(1)
2905     dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
2906 mocchiut 1.1 dedxmmy = 0. !(1)
2907     endif
2908     11881 continue
2909     *----- try cluster y -----------------------------------------------
2910 pam-fi 1.3 c if(cl_used(icy).eq.1)goto 11882 !if the Y cluster is already used
2911     if(cl_used(icy).ne.0)goto 11882 !if the Y cluster is already used !(3)
2912 mocchiut 1.1 * !jump to the next couple
2913 pam-fi 1.18 c call xyz_PAM(0,icy,ist,
2914     c $ PFA,PFA,
2915     c $ 0.,AYV_STORE(nplanes-ip+1,ibest))
2916 mocchiut 1.1 call xyz_PAM(0,icy,ist,
2917     $ PFA,PFA,
2918 pam-fi 1.18 $ 0.,AYV_STORE(nplanes-ip+1,ibest),
2919     $ bxyz(1),
2920     $ bxyz(2)
2921     $ )
2922 mocchiut 1.1 distance = distance_to(XP,YP)
2923 pam-fi 1.11 distance = distance / RCHI2_STORE(ibest)!<<< MS
2924 mocchiut 1.1 if(DEBUG)print*,'( cl-Y ',icy
2925     $ ,' in cp ',id,' ) normalized distance ',distance
2926     if(distance.lt.distmin)then
2927     xmm_A = xPAM_A
2928     ymm_A = yPAM_A
2929     zmm_A = zPAM_A
2930     xmm_B = xPAM_B
2931     ymm_B = yPAM_B
2932     zmm_B = zPAM_B
2933     rxmm = resxPAM
2934     rymm = resyPAM
2935     distmin = distance
2936     iclm = icy
2937 pam-fi 1.18 c dedxmm = sgnl(icy) !(1)
2938 mocchiut 1.1 dedxmmx = 0. !(1)
2939 pam-fi 1.18 dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
2940 mocchiut 1.1 endif
2941     11882 continue
2942     enddo !end loop on cluster inside couples
2943 pam-fi 1.17 *----- single clusters -----------------------------------------------
2944     c print*,'## ncls(',ip,') ',ncls(ip)
2945 mocchiut 1.1 do ic=1,ncls(ip) !loop on single clusters
2946     icl=cls(ip,ic)
2947 pam-fi 1.17 c print*,'## ic ',ic,' ist ',ist
2948 pam-fi 1.3 c if(cl_used(icl).eq.1.or. !if the cluster is already used
2949     if(cl_used(icl).ne.0.or. !if the cluster is already used !(3)
2950 mocchiut 1.1 $ LADDER(icl).ne.nldt.or. !or the ladder number does not match
2951     $ .false.)goto 18882 !jump to the next singlet
2952     if(mod(VIEW(icl),2).eq.0)then!<---- X view
2953 pam-fi 1.18 c call xyz_PAM(icl,0,ist,
2954     c $ PFA,PFA,
2955     c $ AXV_STORE(nplanes-ip+1,ibest),0.)
2956 mocchiut 1.1 call xyz_PAM(icl,0,ist,
2957     $ PFA,PFA,
2958 pam-fi 1.18 $ AXV_STORE(nplanes-ip+1,ibest),0.,
2959     $ bxyz(1),
2960     $ bxyz(2)
2961     $ )
2962 mocchiut 1.1 else !<---- Y view
2963 pam-fi 1.18 c call xyz_PAM(0,icl,ist,
2964     c $ PFA,PFA,
2965     c $ 0.,AYV_STORE(nplanes-ip+1,ibest))
2966 mocchiut 1.1 call xyz_PAM(0,icl,ist,
2967     $ PFA,PFA,
2968 pam-fi 1.18 $ 0.,AYV_STORE(nplanes-ip+1,ibest),
2969     $ bxyz(1),
2970     $ bxyz(2)
2971     $ )
2972 mocchiut 1.1 endif
2973    
2974     distance = distance_to(XP,YP)
2975 pam-fi 1.11 distance = distance / RCHI2_STORE(ibest)!<<< MS
2976 mocchiut 1.1 if(DEBUG)print*,'( cl-s ',icl
2977 pam-fi 1.17 $ ,' ) normalized distance ',distance,'<',distmin,' ?'
2978 mocchiut 1.1 if(distance.lt.distmin)then
2979 pam-fi 1.17 if(DEBUG)print*,'YES'
2980 mocchiut 1.1 xmm_A = xPAM_A
2981     ymm_A = yPAM_A
2982     zmm_A = zPAM_A
2983     xmm_B = xPAM_B
2984     ymm_B = yPAM_B
2985     zmm_B = zPAM_B
2986     rxmm = resxPAM
2987     rymm = resyPAM
2988     distmin = distance
2989     iclm = icl
2990 pam-fi 1.18 c dedxmm = sgnl(icl) !(1)
2991 mocchiut 1.1 if(mod(VIEW(icl),2).eq.0)then !<---- X view
2992 pam-fi 1.18 dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)
2993 mocchiut 1.1 dedxmmy = 0. !(1)
2994     else !<---- Y view
2995     dedxmmx = 0. !(1)
2996 pam-fi 1.18 dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)
2997 mocchiut 1.1 endif
2998     endif
2999     18882 continue
3000     enddo !end loop on single clusters
3001 pam-fi 1.17 c print*,'## distmin ', distmin,' clinc ',clinc
3002 mocchiut 1.1 if(distmin.le.clinc)then
3003    
3004     CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<
3005     * ----------------------------
3006 pam-fi 1.11 c print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3007 mocchiut 1.1 if(mod(VIEW(iclm),2).eq.0)then
3008     XGOOD(nplanes-ip+1)=1.
3009     resx(nplanes-ip+1)=rxmm
3010     if(DEBUG)print*,'%%%% included X-cl ',iclm
3011 pam-fi 1.11 c if(.true.)print*,'%%%% included X-cl ',iclm
3012     $ ,'( chi^2, ',RCHI2_STORE(ibest)
3013     $ ,', norm.dist.= ',distmin
3014     $ ,', cut ',clinc,' )'
3015 mocchiut 1.1 else
3016     YGOOD(nplanes-ip+1)=1.
3017     resy(nplanes-ip+1)=rymm
3018     if(DEBUG)print*,'%%%% included Y-cl ',iclm
3019 pam-fi 1.11 c if(.true.)print*,'%%%% included Y-cl ',iclm
3020     $ ,'( chi^2, ',RCHI2_STORE(ibest)
3021     $ ,', norm.dist.= ', distmin
3022     $ ,', cut ',clinc,' )'
3023 mocchiut 1.1 endif
3024 pam-fi 1.11 c print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3025 mocchiut 1.1 * ----------------------------
3026     xm_A(nplanes-ip+1) = xmm_A
3027     ym_A(nplanes-ip+1) = ymm_A
3028     xm_B(nplanes-ip+1) = xmm_B
3029     ym_B(nplanes-ip+1) = ymm_B
3030     zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3031     c dedxtrk(nplanes-ip+1) = dedxmm !<<< !(1)
3032     dedxtrk_x(nplanes-ip+1) = dedxmmx !<<< !(1)
3033     dedxtrk_y(nplanes-ip+1) = dedxmmy !<<< !(1)
3034     * ----------------------------
3035     endif
3036     endif
3037     133 continue
3038     enddo !end loop on planes
3039    
3040    
3041    
3042     return
3043     end
3044    
3045     ***************************************************
3046     * *
3047     * *
3048     * *
3049     * *
3050     * *
3051     * *
3052     **************************************************
3053 pam-fi 1.3 cccccc 12/08/2006 modified by elena ---> (1)
3054     *
3055 mocchiut 1.1 subroutine clean_XYclouds(ibest,iflag)
3056    
3057     include 'commontracker.f'
3058 pam-fi 1.9 include 'level1.f'
3059 mocchiut 1.1 include 'common_momanhough.f'
3060 pam-fi 1.9 c include 'momanhough_init.f'
3061 pam-fi 1.3 include 'level2.f' !(1)
3062 mocchiut 1.1 c include 'calib.f'
3063     c include 'level1.f'
3064    
3065    
3066    
3067     do ip=1,nplanes !loop on planes
3068    
3069     id=CP_STORE(nplanes-ip+1,ibest)
3070     icl=CLS_STORE(nplanes-ip+1,ibest)
3071     if(id.ne.0.or.icl.ne.0)then
3072     if(id.ne.0)then
3073     iclx=clx(ip,icp_cp(id))
3074     icly=cly(ip,icp_cp(id))
3075 pam-fi 1.3 c cl_used(iclx)=1 !tag used clusters
3076     c cl_used(icly)=1 !tag used clusters
3077     cl_used(iclx)=ntrk !tag used clusters !(1)
3078     cl_used(icly)=ntrk !tag used clusters !(1)
3079 mocchiut 1.1 elseif(icl.ne.0)then
3080 pam-fi 1.3 c cl_used(icl)=1 !tag used clusters
3081     cl_used(icl)=ntrk !tag used clusters !1)
3082 mocchiut 1.1 endif
3083    
3084     c if(DEBUG)then
3085     c print*,ip,' <<< ',id
3086     c endif
3087     * -----------------------------
3088     * remove the couple from clouds
3089     * remove also vitual couples containing the
3090     * selected clusters
3091     * -----------------------------
3092     do icp=1,ncp_plane(ip)
3093     if(
3094     $ clx(ip,icp).eq.iclx
3095     $ .or.
3096     $ clx(ip,icp).eq.icl
3097     $ .or.
3098     $ cly(ip,icp).eq.icly
3099     $ .or.
3100     $ cly(ip,icp).eq.icl
3101     $ )then
3102     id=id_cp(ip,icp,1)
3103     if(DEBUG)then
3104     print*,ip,' <<< cp ',id
3105     $ ,' ( cl-x '
3106     $ ,clx(ip,icp)
3107     $ ,' cl-y '
3108     $ ,cly(ip,icp),' ) --> removed'
3109     endif
3110     * -----------------------------
3111     * remove the couple from clouds
3112     do iyz=1,nclouds_yz
3113     if(cpcloud_yz(iyz,abs(id)).ne.0)then
3114     ptcloud_yz(iyz)=ptcloud_yz(iyz)-1
3115     cpcloud_yz(iyz,abs(id))=0
3116     endif
3117     enddo
3118     do ixz=1,nclouds_xz
3119     if(cpcloud_xz(ixz,abs(id)).ne.0)then
3120     ptcloud_xz(ixz)=ptcloud_xz(ixz)-1
3121     cpcloud_xz(ixz,abs(id))=0
3122     endif
3123     enddo
3124     * -----------------------------
3125     endif
3126     enddo
3127    
3128     endif
3129     enddo !end loop on planes
3130    
3131     return
3132     end
3133    
3134    
3135    
3136    
3137    
3138    
3139     * ****************************************************
3140    
3141     subroutine init_level2
3142    
3143     include 'commontracker.f'
3144 pam-fi 1.9 include 'level1.f'
3145 mocchiut 1.1 include 'common_momanhough.f'
3146     include 'level2.f'
3147 pam-fi 1.9 c include 'level1.f'
3148 mocchiut 1.1
3149 pam-fi 1.4 do i=1,nviews
3150     good2(i)=good1(i)
3151     enddo
3152 mocchiut 1.1
3153    
3154     NTRK = 0
3155 pam-fi 1.9 do it=1,NTRKMAX
3156 mocchiut 1.1 IMAGE(IT)=0
3157     CHI2_nt(IT) = -100000.
3158     do ip=1,nplanes
3159     XM_nt(IP,IT) = 0
3160     YM_nt(IP,IT) = 0
3161     ZM_nt(IP,IT) = 0
3162     RESX_nt(IP,IT) = 0
3163     RESY_nt(IP,IT) = 0
3164     XGOOD_nt(IP,IT) = 0
3165     YGOOD_nt(IP,IT) = 0
3166     DEDX_X(IP,IT) = 0
3167     DEDX_Y(IP,IT) = 0
3168 pam-fi 1.3 CLTRX(IP,IT) = 0
3169     CLTRY(IP,IT) = 0
3170 mocchiut 1.1 enddo
3171     do ipa=1,5
3172     AL_nt(IPA,IT) = 0
3173     do ipaa=1,5
3174     coval(ipa,ipaa,IT)=0
3175     enddo
3176     enddo
3177     enddo
3178     nclsx=0
3179     nclsy=0
3180     do ip=1,NSINGMAX
3181     planex(ip)=0
3182     xs(1,ip)=0
3183     xs(2,ip)=0
3184     sgnlxs(ip)=0
3185     planey(ip)=0
3186     ys(1,ip)=0
3187     ys(2,ip)=0
3188     sgnlys(ip)=0
3189     enddo
3190     end
3191    
3192    
3193     ************************************************************
3194     *
3195     *
3196     *
3197     *
3198     *
3199     *
3200     *
3201     ************************************************************
3202    
3203    
3204 pam-fi 1.9 subroutine init_hough
3205    
3206     include 'commontracker.f'
3207     include 'level1.f'
3208     include 'common_momanhough.f'
3209     include 'common_hough.f'
3210     include 'level2.f'
3211    
3212     ntrpt_nt=0
3213     ndblt_nt=0
3214     NCLOUDS_XZ_nt=0
3215     NCLOUDS_YZ_nt=0
3216     do idb=1,ndblt_max_nt
3217     db_cloud_nt(idb)=0
3218     alfayz1_nt(idb)=0
3219     alfayz2_nt(idb)=0
3220     enddo
3221 pam-fi 1.14 do itr=1,ntrpt_max_nt
3222 pam-fi 1.9 tr_cloud_nt(itr)=0
3223     alfaxz1_nt(itr)=0
3224     alfaxz2_nt(itr)=0
3225     alfaxz3_nt(itr)=0
3226     enddo
3227     do idb=1,ncloyz_max
3228     ptcloud_yz_nt(idb)=0
3229     alfayz1_av_nt(idb)=0
3230     alfayz2_av_nt(idb)=0
3231     enddo
3232     do itr=1,ncloxz_max
3233     ptcloud_xz_nt(itr)=0
3234     alfaxz1_av_nt(itr)=0
3235     alfaxz2_av_nt(itr)=0
3236     alfaxz3_av_nt(itr)=0
3237     enddo
3238    
3239     ntrpt=0
3240     ndblt=0
3241     NCLOUDS_XZ=0
3242     NCLOUDS_YZ=0
3243     do idb=1,ndblt_max
3244     db_cloud(idb)=0
3245     cpyz1(idb)=0
3246     cpyz2(idb)=0
3247     alfayz1(idb)=0
3248     alfayz2(idb)=0
3249     enddo
3250 pam-fi 1.14 do itr=1,ntrpt_max
3251 pam-fi 1.9 tr_cloud(itr)=0
3252     cpxz1(itr)=0
3253     cpxz2(itr)=0
3254     cpxz3(itr)=0
3255     alfaxz1(itr)=0
3256     alfaxz2(itr)=0
3257     alfaxz3(itr)=0
3258     enddo
3259     do idb=1,ncloyz_max
3260     ptcloud_yz(idb)=0
3261     alfayz1_av(idb)=0
3262     alfayz2_av(idb)=0
3263     do idbb=1,ncouplemaxtot
3264     cpcloud_yz(idb,idbb)=0
3265     enddo
3266     enddo
3267     do itr=1,ncloxz_max
3268     ptcloud_xz(itr)=0
3269     alfaxz1_av(itr)=0
3270     alfaxz2_av(itr)=0
3271     alfaxz3_av(itr)=0
3272     do itrr=1,ncouplemaxtot
3273     cpcloud_xz(itr,itrr)=0
3274     enddo
3275     enddo
3276     end
3277     ************************************************************
3278     *
3279     *
3280     *
3281     *
3282     *
3283     *
3284     *
3285     ************************************************************
3286    
3287    
3288 mocchiut 1.1 subroutine fill_level2_tracks(ntr)
3289    
3290     * -------------------------------------------------------
3291     * This routine fills the ntr-th element of the variables
3292     * inside the level2_tracks common, which correspond
3293     * to the ntr-th track info.
3294     * -------------------------------------------------------
3295    
3296    
3297     include 'commontracker.f'
3298 pam-fi 1.9 c include 'level1.f'
3299 pam-fi 1.3 include 'level1.f'
3300 pam-fi 1.9 include 'common_momanhough.f'
3301 mocchiut 1.1 include 'level2.f'
3302     include 'common_mini_2.f'
3303 pam-fi 1.9 real sinth,phi,pig
3304 mocchiut 1.1 pig=acos(-1.)
3305    
3306     chi2_nt(ntr) = sngl(chi2)
3307 pam-fi 1.8 nstep_nt(ntr) = nstep
3308 mocchiut 1.1
3309 pam-fi 1.9 phi = al(4)
3310     sinth = al(3)
3311     if(sinth.lt.0)then
3312     sinth = -sinth
3313     phi = phi + pig
3314     endif
3315     npig = aint(phi/(2*pig))
3316     phi = phi - npig*2*pig
3317     if(phi.lt.0)
3318     $ phi = phi + 2*pig
3319     al(4) = phi
3320     al(3) = sinth
3321    
3322 mocchiut 1.1 do i=1,5
3323     al_nt(i,ntr) = sngl(al(i))
3324     do j=1,5
3325     coval(i,j,ntr) = sngl(cov(i,j))
3326     enddo
3327     enddo
3328    
3329     do ip=1,nplanes ! loop on planes
3330     xgood_nt(ip,ntr) = int(xgood(ip))
3331     ygood_nt(ip,ntr) = int(ygood(ip))
3332     xm_nt(ip,ntr) = sngl(xm(ip))
3333     ym_nt(ip,ntr) = sngl(ym(ip))
3334     zm_nt(ip,ntr) = sngl(zm(ip))
3335     RESX_nt(IP,ntr) = sngl(resx(ip))
3336     RESY_nt(IP,ntr) = sngl(resy(ip))
3337     xv_nt(ip,ntr) = sngl(xv(ip))
3338     yv_nt(ip,ntr) = sngl(yv(ip))
3339     zv_nt(ip,ntr) = sngl(zv(ip))
3340     axv_nt(ip,ntr) = sngl(axv(ip))
3341 pam-fi 1.18 ayv_nt(ip,ntr) = sngl(ayv(ip))
3342     c l'avevo dimenticato!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3343     factor = sqrt(
3344 pam-fi 1.19 $ tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3345     $ tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3346 pam-fi 1.18 $ 1. )
3347     c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3348     dedx_x(ip,ntr) = sngl(dedxtrk_x(ip)/factor)
3349     dedx_y(ip,ntr) = sngl(dedxtrk_y(ip)/factor)
3350 pam-fi 1.3
3351     id = CP_STORE(ip,IDCAND)
3352     icl = CLS_STORE(ip,IDCAND)
3353     if(id.ne.0)then
3354     cltrx(ip,ntr) = clx(nplanes-ip+1,icp_cp(id))
3355     cltry(ip,ntr) = cly(nplanes-ip+1,icp_cp(id))
3356     c print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)
3357     elseif(icl.ne.0)then
3358     if(mod(VIEW(icl),2).eq.0)cltrx(ip,ntr)=icl
3359     if(mod(VIEW(icl),2).eq.1)cltry(ip,ntr)=icl
3360     c print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)
3361     endif
3362    
3363 mocchiut 1.1 enddo
3364    
3365    
3366     end
3367    
3368     subroutine fill_level2_siglets
3369    
3370     * -------------------------------------------------------
3371     * This routine fills the elements of the variables
3372     * inside the level2_singletsx and level2_singletsy commons,
3373     * which store info on clusters outside the tracks
3374     * -------------------------------------------------------
3375    
3376     include 'commontracker.f'
3377 pam-fi 1.9 c include 'level1.f'
3378     include 'calib.f'
3379 mocchiut 1.1 include 'level1.f'
3380 pam-fi 1.9 include 'common_momanhough.f'
3381 mocchiut 1.1 include 'level2.f'
3382     include 'common_xyzPAM.f'
3383    
3384     * count #cluster per plane not associated to any track
3385 pam-fi 1.4 c good2=1!.true.
3386 mocchiut 1.1 nclsx = 0
3387     nclsy = 0
3388    
3389 pam-fi 1.9 do iv = 1,nviews
3390     if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
3391     enddo
3392    
3393 mocchiut 1.1 do icl=1,nclstr1
3394     if(cl_used(icl).eq.0)then !cluster not included in any track
3395     ip=nplanes-npl(VIEW(icl))+1
3396     if(mod(VIEW(icl),2).eq.0)then !=== X views
3397     nclsx = nclsx + 1
3398     planex(nclsx) = ip
3399 pam-fi 1.18 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))!(2)
3400 pam-fi 1.3 clsx(nclsx) = icl
3401 mocchiut 1.1 do is=1,2
3402     c call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
3403 pam-fi 1.18 c call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
3404     call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
3405 mocchiut 1.1 xs(is,nclsx) = (xPAM_A+xPAM_B)/2
3406     enddo
3407     c$$$ print*,'nclsx ',nclsx
3408     c$$$ print*,'planex(nclsx) ',planex(nclsx)
3409     c$$$ print*,'sgnlxs(nclsx) ',sgnlxs(nclsx)
3410     c$$$ print*,'xs(1,nclsx) ',xs(1,nclsx)
3411     c$$$ print*,'xs(2,nclsx) ',xs(2,nclsx)
3412     else !=== Y views
3413     nclsy = nclsy + 1
3414     planey(nclsy) = ip
3415 pam-fi 1.18 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))!(2)
3416 pam-fi 1.3 clsy(nclsy) = icl
3417 mocchiut 1.1 do is=1,2
3418     c call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
3419 pam-fi 1.18 c call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
3420     call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
3421 mocchiut 1.1 ys(is,nclsy) = (yPAM_A+yPAM_B)/2
3422     enddo
3423     c$$$ print*,'nclsy ',nclsy
3424     c$$$ print*,'planey(nclsy) ',planey(nclsy)
3425     c$$$ print*,'sgnlys(nclsy) ',sgnlys(nclsy)
3426     c$$$ print*,'ys(1,nclsy) ',ys(1,nclsy)
3427     c$$$ print*,'ys(2,nclsy) ',ys(2,nclsy)
3428     endif
3429     endif
3430     c print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)
3431 pam-fi 1.3
3432     ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
3433     whichtrack(icl) = cl_used(icl)
3434    
3435 mocchiut 1.1 enddo
3436     end
3437    
3438 pam-fi 1.9 ***************************************************
3439     * *
3440     * *
3441     * *
3442     * *
3443     * *
3444     * *
3445     **************************************************
3446 mocchiut 1.1
3447 pam-fi 1.9 subroutine fill_hough
3448 mocchiut 1.1
3449 pam-fi 1.9 * -------------------------------------------------------
3450     * This routine fills the variables related to the hough
3451     * transform, for the debig n-tuple
3452     * -------------------------------------------------------
3453 mocchiut 1.1
3454 pam-fi 1.9 include 'commontracker.f'
3455     include 'level1.f'
3456     include 'common_momanhough.f'
3457     include 'common_hough.f'
3458     include 'level2.f'
3459 mocchiut 1.1
3460 pam-fi 1.9 if(.false.
3461     $ .or.ntrpt.gt.ntrpt_max_nt
3462     $ .or.ndblt.gt.ndblt_max_nt
3463     $ .or.NCLOUDS_XZ.gt.ncloxz_max
3464     $ .or.NCLOUDS_yZ.gt.ncloyz_max
3465     $ )then
3466     ntrpt_nt=0
3467     ndblt_nt=0
3468     NCLOUDS_XZ_nt=0
3469     NCLOUDS_YZ_nt=0
3470     else
3471     ndblt_nt=ndblt
3472     ntrpt_nt=ntrpt
3473     if(ndblt.ne.0)then
3474     do id=1,ndblt
3475     alfayz1_nt(id)=alfayz1(id) !Y0
3476     alfayz2_nt(id)=alfayz2(id) !tg theta-yz
3477     enddo
3478     endif
3479     if(ndblt.ne.0)then
3480     do it=1,ntrpt
3481     alfaxz1_nt(it)=alfaxz1(it) !X0
3482     alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
3483     alfaxz3_nt(it)=alfaxz3(it) !1/r
3484     enddo
3485     endif
3486     nclouds_yz_nt=nclouds_yz
3487     nclouds_xz_nt=nclouds_xz
3488     if(nclouds_yz.ne.0)then
3489     nnn=0
3490     do iyz=1,nclouds_yz
3491     ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
3492     alfayz1_av_nt(iyz)=alfayz1_av(iyz)
3493     alfayz2_av_nt(iyz)=alfayz2_av(iyz)
3494     nnn=nnn+ptcloud_yz(iyz)
3495     enddo
3496     do ipt=1,nnn
3497     db_cloud_nt(ipt)=db_cloud(ipt)
3498     enddo
3499     endif
3500     if(nclouds_xz.ne.0)then
3501     nnn=0
3502     do ixz=1,nclouds_xz
3503     ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
3504     alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
3505     alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
3506     alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
3507     nnn=nnn+ptcloud_xz(ixz)
3508     enddo
3509     do ipt=1,nnn
3510     tr_cloud_nt(ipt)=tr_cloud(ipt)
3511     enddo
3512     endif
3513     endif
3514     end
3515    

  ViewVC Help
Powered by ViewVC 1.1.23