/[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.4 - (hide annotations) (download)
Thu Sep 28 14:04:40 2006 UTC (18 years, 2 months ago) by pam-fi
Branch: MAIN
Changes since 1.3: +73 -33 lines
some bugs fixed, some changings in the classes:

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

  ViewVC Help
Powered by ViewVC 1.1.23