/[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.6 - (hide annotations) (download)
Mon Oct 2 13:12:48 2006 UTC (18 years, 2 months ago) by pam-fi
Branch: MAIN
Changes since 1.5: +28 -221 lines
modified charge correlation

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

  ViewVC Help
Powered by ViewVC 1.1.23