/[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.8 - (hide annotations) (download)
Wed Oct 25 16:18:41 2006 UTC (18 years, 1 month ago) by pam-fi
Branch: MAIN
Changes since 1.7: +23 -6 lines
*** empty log message ***

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

  ViewVC Help
Powered by ViewVC 1.1.23