/[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.9 - (hide annotations) (download)
Fri Oct 27 16:08:19 2006 UTC (18 years, 1 month ago) by pam-fi
Branch: MAIN
Changes since 1.8: +343 -164 lines
new version of the Hough transform

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

  ViewVC Help
Powered by ViewVC 1.1.23