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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by mocchiut, Fri May 19 13:15:54 2006 UTC revision 1.40 by mocchiut, Tue Aug 4 14:01:35 2009 UTC
# Line 12  Line 12 
12        subroutine track_finding(iflag)        subroutine track_finding(iflag)
13    
14        include 'commontracker.f'        include 'commontracker.f'
15          include 'level1.f'
16        include 'common_momanhough.f'        include 'common_momanhough.f'
17        include 'common_mech.f'        include 'common_mech.f'
18        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
19        include 'common_mini_2.f'        include 'common_mini_2.f'
20        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
21        include 'level2.f'        include 'level2.f'
22    
23        include 'momanhough_init.f'  c      print*,'======================================================'
24    c$$$      do ic=1,NCLSTR1
25    c$$$         if(.false.
26    c$$$     $        .or.nsatstrips(ic).gt.0
27    c$$$c     $        .or.nbadstrips(0,ic).gt.0
28    c$$$c     $        .or.nbadstrips(4,ic).gt.0
29    c$$$c     $        .or.nbadstrips(3,ic).gt.0
30    c$$$     $        .or..false.)then
31    c$$$            print*,'--- cl-',ic,' ------------------------'
32    c$$$            istart = INDSTART(IC)
33    c$$$            istop  = TOTCLLENGTH
34    c$$$            if(ic.lt.NCLSTR1)istop=INDSTART(IC+1)-1
35    c$$$            print*,'ADC   ',(CLADC(i),i=istart,istop)
36    c$$$            print*,'s/n   ',(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
37    c$$$            print*,'sgnl  ',(CLSIGNAL(i),i=istart,istop)
38    c$$$            print*,'strip ',(i-INDMAX(ic),i=istart,istop)
39    c$$$            print*,'view ',VIEW(ic)
40    c$$$            print*,'maxs ',MAXS(ic)
41    c$$$            print*,'COG4 ',cog(4,ic)
42    c$$$            ff = fbad_cog(4,ic)
43    c$$$            print*,'fbad ',ff
44    c$$$            print*,(CLBAD(i),i=istart,istop)
45    c$$$            bb=nbadstrips(0,ic)
46    c$$$            print*,'#BAD (tot)',bb
47    c$$$            bb=nbadstrips(4,ic)
48    c$$$            print*,'#BAD (4)',bb
49    c$$$            bb=nbadstrips(3,ic)
50    c$$$            print*,'#BAD (3)',bb
51    c$$$            ss=nsatstrips(ic)
52    c$$$            print*,'#saturated ',ss
53    c$$$         endif
54    c$$$      enddo
55                
       logical DEBUG  
       common/dbg/DEBUG  
   
56  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
57  *     STEP 1  *     STEP 1
58  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
# Line 44  Line 72 
72  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
73  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
74    
 c      iflag=0  
75        call cl_to_couples(iflag)        call cl_to_couples(iflag)
76        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
77           goto 880               !fill ntp and go to next event                       goto 880               !go to next event
78        endif        endif
79                if(ncp_tot.eq.0)goto 880  !go to next event    
 *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  
 *     selezione di tracce pulite per diagnostica  
 *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  
 c$$$         if(DEBUG)then  
 c$$$            do ip=1,nplanes  
 c$$$               if(ncp_plane(ip).ne.1)good2=.false.  
 c$$$            enddo  
 c$$$c            if(good2.eq.0)goto 100!next event  
 c$$$c            if(good2.eq.0)goto 880!fill ntp and go to next event  
 c$$$         endif  
           
   
   
80  *-----------------------------------------------------  *-----------------------------------------------------
81  *-----------------------------------------------------  *-----------------------------------------------------
82  *     HOUGH TRASFORM  *     HOUGH TRASFORM
# Line 91  c$$$         endif Line 105  c$$$         endif
105  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
106  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
107    
108  c      iflag=0  
109        call cp_to_doubtrip(iflag)        call cp_to_doubtrip(iflag)
110        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
111           goto 880               !fill ntp and go to next event                       goto 880               !go to next event            
112        endif        endif
113          if(ndblt.eq.0.or.ntrpt.eq.0)goto 880 !go to next event    
114                
115                
116  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
# Line 123  c      iflag=0 Line 138  c      iflag=0
138  *     $     ,ptcloud_xz,tr_cloud,cpcloud_xz            *     $     ,ptcloud_xz,tr_cloud,cpcloud_xz          
139  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
140  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
141    *     count number of hit planes
142          planehit=0                
143          do np=1,nplanes          
144            if(ncp_plane(np).ne.0)then  
145              planehit=planehit+1  
146            endif                  
147          enddo                    
148          if(planehit.lt.3) goto 880 ! exit              
149          
150          nptxz_min=x_min_start              
151          nplxz_min=x_min_start              
152                
153          nptyz_min=y_min_start              
154          nplyz_min=y_min_start              
155    
156          cutdistyz=cutystart      
157          cutdistxz=cutxstart      
158    
159  c      iflag=0   878  continue
160        call doub_to_YZcloud(iflag)        call doub_to_YZcloud(iflag)
161        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
162           goto 880               !fill ntp and go to next event                       goto 880               !fill ntp and go to next event            
163          endif
164    *     ------------------------------------------------
165    *     first try to release the tolerance
166    *     ------------------------------------------------
167          if(nclouds_yz.eq.0.and.cutdistyz.lt.maxcuty)then
168             if(cutdistyz.lt.maxcuty/2)then
169                cutdistyz=cutdistyz+cutystep
170             else
171                cutdistyz=cutdistyz+(3*cutystep)
172             endif
173             if(DEBUG.EQ.1)print*,'try again - cutdistyz ',cutdistyz
174             goto 878                
175          endif    
176    *     ------------------------------------------------
177    *     hence reduce the minimum number of plane
178    *     ------------------------------------------------
179          if(nclouds_yz.eq.0.and.nplyz_min.gt.3)then
180             nplyz_min=nplyz_min-1
181             if(DEBUG.EQ.1)print*,'try again - nplyz_min ',nplyz_min
182             goto 878
183        endif        endif
184  c      iflag=0  
185          if(nclouds_yz.eq.0)goto 880 !go to next event    
186    
187    
188    ccc   if(planehit.eq.3) goto 881    
189          
190     879  continue  
191        call trip_to_XZcloud(iflag)        call trip_to_XZcloud(iflag)
192        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
193           goto 880               !fill ntp and go to next event                       goto 880               !fill ntp and go to next event            
194        endif        endif
195          *     ------------------------------------------------
196    *     first try to release the tolerance
197    *     ------------------------------------------------                          
198          if(nclouds_xz.eq.0.and.cutdistxz.lt.maxcutx)then
199            cutdistxz=cutdistxz+cutxstep
200             if(DEBUG.EQ.1)print*,'try again - cutdistxz ',cutdistxz
201            goto 879                
202          endif                    
203    *     ------------------------------------------------
204    *     hence reduce the minimum number of plane
205    *     ------------------------------------------------
206          if(nclouds_xz.eq.0.and.nplxz_min.gt.3)then
207             nplxz_min=nplxz_min-1
208             if(DEBUG.EQ.1)print*,'try again - nplxz_min ',nplxz_min
209             goto 879
210          endif
211    
212          if(nclouds_xz.eq.0)goto 880 !go to next event    
213    
214        
215    c$$$ 881  continue  
216    c$$$*     if there is at least three planes on the Y view decreases cuts on X view
217    c$$$      if(nclouds_xz.eq.0.and.nclouds_yz.gt.0.and.
218    c$$$     $     nplxz_min.ne.y_min_start)then
219    c$$$        nptxz_min=x_min_step    
220    c$$$        nplxz_min=x_min_start-x_min_step              
221    c$$$        goto 879                
222    c$$$      endif                    
223            
224   880  return   880  return
225        end        end
226    
# Line 144  c      iflag=0 Line 230  c      iflag=0
230        subroutine track_fitting(iflag)        subroutine track_fitting(iflag)
231    
232        include 'commontracker.f'        include 'commontracker.f'
233          include 'level1.f'
234        include 'common_momanhough.f'        include 'common_momanhough.f'
235        include 'common_mech.f'        include 'common_mech.f'
236        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
237        include 'common_mini_2.f'        include 'common_mini_2.f'
238        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
239        include 'level2.f'        include 'level2.f'
240    
241        include 'momanhough_init.f'  c      include 'momanhough_init.f'
242                
       logical DEBUG  
       common/dbg/DEBUG  
   
243        logical FIMAGE            !        logical FIMAGE            !
244          real trackimage(NTRACKSMAX)
245          real*8 AL_GUESS(5)
246    
247  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
248  *     STEP 4   (ITERATED until any other physical track isn't found)  *     STEP 4   (ITERATED until any other physical track isn't found)
# Line 184  c      iflag=0 Line 269  c      iflag=0
269  *  *
270  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
271  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
272           ntrk=0                 !counter of identified physical tracks  ccc         ntrk=0                 !counter of identified physical tracks
273    
274  11111    continue               !<<<<<<< come here when performing a new search  c11111    continue               !<<<<<<< come here when performing a new search
275             continue                  !<<<<<<< come here when performing a new search
276    
277             if(nclouds_xz.eq.0)goto 880 !go to next event    
278             if(nclouds_yz.eq.0)goto 880 !go to next event    
279    
280  c         iflag=0  c         iflag=0
281           call clouds_to_ctrack(iflag)           call clouds_to_ctrack(iflag)
282           if(iflag.eq.1)then     !no candidate tracks found           if(iflag.eq.1)then     !no candidate tracks found
283              goto 880            !fill ntp and go to next event                goto 880            !fill ntp and go to next event  
284           endif           endif
285             if(ntracks.eq.0)goto 880 !go to next event    
286    
287           FIMAGE=.false.         !processing best track (not track image)           FIMAGE=.false.         !processing best track (not track image)
288           ibest=0                !best track among candidates           ibest=0                !best track among candidates
289           iimage=0               !track image           iimage=0               !track image
290  *     ------------- select the best track -------------  *     ------------- select the best track -------------
291           rchi2best=1000000000.  c$$$         rchi2best=1000000000.
292    c$$$         do i=1,ntracks
293    c$$$            if(RCHI2_STORE(i).lt.rchi2best.and.
294    c$$$     $         RCHI2_STORE(i).gt.0)then
295    c$$$               ibest=i
296    c$$$               rchi2best=RCHI2_STORE(i)
297    c$$$            endif
298    c$$$         enddo
299    c$$$         if(ibest.eq.0)goto 880 !>> no good candidates
300    
301    *     -------------------------------------------------------
302    *     order track-candidates according to:
303    *     1st) decreasing n.points
304    *     2nd) increasing chi**2
305    *     -------------------------------------------------------
306             rchi2best=1000000000.
307             ndofbest=0            
308           do i=1,ntracks           do i=1,ntracks
309              if(RCHI2_STORE(i).lt.rchi2best.and.             ndof=0              
310       $         RCHI2_STORE(i).gt.0)then             do ii=1,nplanes    
311                 ndof=ndof        
312         $            +int(xgood_store(ii,i))
313         $            +int(ygood_store(ii,i))
314               enddo              
315               if(ndof.gt.ndofbest)then
316                 ibest=i
317                 rchi2best=RCHI2_STORE(i)
318                 ndofbest=ndof    
319               elseif(ndof.eq.ndofbest)then
320                 if(RCHI2_STORE(i).lt.rchi2best.and.
321         $            RCHI2_STORE(i).gt.0)then
322                 ibest=i                 ibest=i
323                 rchi2best=RCHI2_STORE(i)                 rchi2best=RCHI2_STORE(i)
324              endif                 ndofbest=ndof  
325                 endif            
326               endif
327           enddo           enddo
328    
329    
330           if(ibest.eq.0)goto 880 !>> no good candidates           if(ibest.eq.0)goto 880 !>> no good candidates
331  *-------------------------------------------------------------------------------      *-------------------------------------------------------------------------------    
332  *     The best track candidate (ibest) is selected and a new fitting is performed.  *     The best track candidate (ibest) is selected and a new fitting is performed.
# Line 224  c         iflag=0 Line 345  c         iflag=0
345              iimage=0              iimage=0
346           endif           endif
347           if(icand.eq.0)then           if(icand.eq.0)then
348              print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand              if(VERBOSE.EQ.1)then
349       $           ,ibest,iimage                 print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand
350         $              ,ibest,iimage
351                endif
352              return              return
353           endif           endif
354    
# Line 236  c         iflag=0 Line 359  c         iflag=0
359  *     **********************************************************  *     **********************************************************
360  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
361  *     **********************************************************  *     **********************************************************
362             call guess()
363             do i=1,5
364                AL_GUESS(i)=AL(i)
365             enddo
366    
367           do i=1,5           do i=1,5
368              AL(i)=dble(AL_STORE(i,icand))              AL(i)=dble(AL_STORE(i,icand))            
369           enddo           enddo
370            
371             IDCAND = icand         !fitted track-candidate
372           ifail=0                !error flag in chi2 computation           ifail=0                !error flag in chi2 computation
373           jstep=0                !# minimization steps           jstep=0                !# minimization steps
374    
375           call mini_2(jstep,ifail)           iprint=0
376           if(ifail.ne.0) then  c         if(DEBUG.EQ.1)iprint=1
377              if(DEBUG)then           if(VERBOSE.EQ.1)iprint=1
378             if(DEBUG.EQ.1)iprint=2
379             call mini2(jstep,ifail,iprint)
380    cc         if(ifail.ne.0) then
381             if(ifail.ne.0.or.CHI2.ne.CHI2) then !new
382                if(CHI2.ne.CHI2)CHI2=-9999. !new
383                if(VERBOSE.EQ.1)then
384                 print *,                 print *,
385       $              '*** MINIMIZATION FAILURE *** (mini_2) '       $              '*** MINIMIZATION FAILURE *** (after refinement) '
386       $              ,iev       $              ,iev
387              endif              endif
             chi2=-chi2  
388           endif           endif
389                    
390           if(DEBUG)then           if(DEBUG.EQ.1)then
391              print*,'----------------------------- improved track coord'              print*,'----------------------------- improved track coord'
392  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
393              do ip=1,6              do ip=1,6
# Line 263  c         iflag=0 Line 398  c         iflag=0
398           endif           endif
399    
400  c         rchi2=chi2/dble(ndof)  c         rchi2=chi2/dble(ndof)
401           if(DEBUG)then           if(DEBUG.EQ.1)then
402              print*,' '              print*,' '
403              print*,'****** SELECTED TRACK *************'              print*,'****** SELECTED TRACK *************'
404              print*,'#         R. chi2        RIG'              print*,'#         R. chi2        RIG'
# Line 279  c         rchi2=chi2/dble(ndof) Line 414  c         rchi2=chi2/dble(ndof)
414  *     ------------- search if the track has an IMAGE -------------  *     ------------- search if the track has an IMAGE -------------
415  *     ------------- (also this is stored )           -------------  *     ------------- (also this is stored )           -------------
416           if(FIMAGE)goto 122     !>>> jump! (this is already an image)           if(FIMAGE)goto 122     !>>> jump! (this is already an image)
417  *     now search for track-image, by comparing couples IDs  
418    *     -----------------------------------------------------
419    *     first check if the track is ambiguous
420    *     -----------------------------------------------------
421    *     (modified on august 2007 by ElenaV)
422             is1=0
423             do ip=1,NPLANES
424                if(SENSOR_STORE(ip,icand).ne.0)then
425                   is1=SENSOR_STORE(ip,icand)
426                   if(ip.eq.6)is1=3-is1 !last plane inverted
427                endif
428             enddo
429             if(is1.eq.0)then
430                if(WARNING.EQ.1)print*,'** WARNING ** sensor=0'
431                goto 122            !jump
432             endif
433             do ip=1,NPLANES
434                is2 = SENSOR_STORE(ip,icand) !sensor
435                if(ip.eq.6.and.is2.ne.0)is2=3-is2 !last plane inverted
436                if(
437         $           (is1.ne.is2.and.is2.ne.0)
438         $           )goto 122      !jump (this track cannot have an image)
439             enddo
440             if(DEBUG.eq.1)print*,' >>> ambiguous track! '
441    *     ---------------------------------------------------------------
442    *     take the candidate with the greatest number of matching couples
443    *     if more than one satisfies the requirement,
444    *     choose the one with more points and lower chi2
445    *     ---------------------------------------------------------------
446    *     count the number of matching couples
447             ncpmax = 0
448             iimage   = 0           !id of candidate with better matching
449           do i=1,ntracks           do i=1,ntracks
450              iimage=i              ncp=0
451              do ip=1,nplanes              do ip=1,nplanes
452                 if(     CP_STORE(nplanes-ip+1,icand).ne.                 if(CP_STORE(nplanes-ip+1,icand).ne.0)then
453       $              -1*CP_STORE(nplanes-ip+1,i) )iimage=0                    if(
454         $                 CP_STORE(nplanes-ip+1,i).ne.0
455         $                 .and.
456         $                 CP_STORE(nplanes-ip+1,icand).eq.
457         $                 -1*CP_STORE(nplanes-ip+1,i)
458         $                 )then
459                         ncp=ncp+1  !ok
460                      elseif(
461         $                    CP_STORE(nplanes-ip+1,i).ne.0
462         $                    .and.
463         $                    CP_STORE(nplanes-ip+1,icand).ne.
464         $                    -1*CP_STORE(nplanes-ip+1,i)
465         $                    )then
466                         ncp = 0
467                         goto 117   !it is not an image candidate
468                      else
469                        
470                      endif
471                   endif
472                enddo
473     117        continue
474                trackimage(i)=ncp   !number of matching couples
475                if(ncp>ncpmax)then
476                   ncpmax=ncp
477                   iimage=i
478                endif
479             enddo
480    *     check if there are more than one image candidates
481             ngood=0
482             do i=1,ntracks
483                if( ncpmax.ne.0.and.trackimage(i).eq.ncpmax )ngood=ngood+1
484             enddo
485             if(DEBUG.eq.1)print*,' n.image-candidates : ',ngood
486    *     if there are, choose the best one
487             if(ngood.gt.0)then
488    *     -------------------------------------------------------
489    *     order track-candidates according to:
490    *     1st) decreasing n.points
491    *     2nd) increasing chi**2
492    *     -------------------------------------------------------
493                rchi2best=1000000000.
494                ndofbest=0            
495                do i=1,ntracks
496                   if( trackimage(i).eq.ncpmax )then
497                      ndof=0              
498                      do ii=1,nplanes    
499                         ndof=ndof        
500         $                    +int(xgood_store(ii,i))
501         $                    +int(ygood_store(ii,i))
502                      enddo              
503                      if(ndof.gt.ndofbest)then
504                         iimage=i
505                         rchi2best=RCHI2_STORE(i)
506                         ndofbest=ndof    
507                      elseif(ndof.eq.ndofbest)then
508                         if(RCHI2_STORE(i).lt.rchi2best.and.
509         $                    RCHI2_STORE(i).gt.0)then
510                            iimage=i
511                            rchi2best=RCHI2_STORE(i)
512                            ndofbest=ndof  
513                         endif            
514                      endif
515                   endif
516              enddo              enddo
517              if(  iimage.ne.0.and.  
518  c     $           RCHI2_STORE(i).le.CHI2MAX.and.              if(DEBUG.EQ.1)then
519  c     $           RCHI2_STORE(i).gt.0.and.                 print*,'Track candidate ',iimage
      $           .true.)then  
                if(DEBUG)print*,'Track candidate ',iimage  
520       $              ,' >>> TRACK IMAGE >>> of'       $              ,' >>> TRACK IMAGE >>> of'
521       $              ,ibest       $              ,ibest
                goto 122         !image track found  
522              endif              endif
523           enddo              
524             endif
525    
526    
527   122     continue   122     continue
528    
529    
530  *     --- and store the results --------------------------------  *     --- and store the results --------------------------------
531           ntrk = ntrk + 1                   !counter of found tracks           ntrk = ntrk + 1                   !counter of found tracks
532           if(.not.FIMAGE           if(.not.FIMAGE
# Line 306  c     $           RCHI2_STORE(i).gt.0.an Line 535  c     $           RCHI2_STORE(i).gt.0.an
535       $        .and.iimage.ne.0)image(ntrk)=ntrk+1 !this is the image of the next       $        .and.iimage.ne.0)image(ntrk)=ntrk+1 !this is the image of the next
536           if(FIMAGE)     image(ntrk)=ntrk-1 !this is the image of the previous           if(FIMAGE)     image(ntrk)=ntrk-1 !this is the image of the previous
537           call fill_level2_tracks(ntrk)     !==> good2=.true.           call fill_level2_tracks(ntrk)     !==> good2=.true.
 c         print*,'++++++++++ iimage,fimage,ntrk,image '  
 c     $        ,iimage,fimage,ntrk,image(ntrk)  
538    
539           if(ntrk.eq.NTRKMAX)then           if(ntrk.eq.NTRKMAX)then
540              if(DEBUG)              if(verbose.eq.1)
541       $           print*,       $           print*,
542       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
543       $           'tracks exceeds vector dimension '       $           'tracks exceeds vector dimension '
# Line 323  cc            good2=.false. Line 550  cc            good2=.false.
550              goto 1212           !>>> fit image-track              goto 1212           !>>> fit image-track
551           endif           endif
552    
 *     --- then remove selected clusters (ibest+iimage) from clouds ----  
          call clean_XYclouds(ibest,iflag)  
          if(iflag.eq.1)then     !bad event  
             goto 880            !fill ntp and go to next event              
          endif  
   
 *     **********************************************************  
 *     condition to start a new search  
 *     **********************************************************  
          ixznew=0  
          do ixz=1,nclouds_xz  
             if(ptcloud_xz(ixz).ge.nptxz_min)ixznew=1  
          enddo  
          iyznew=0  
          do iyz=1,nclouds_yz  
             if(ptcloud_yz(iyz).ge.nptyz_min)iyznew=1  
          enddo  
           
          if(ixznew.ne.0.and.  
      $      iyznew.ne.0.and.  
      $        rchi2best.le.CHI2MAX.and.  
 c     $        rchi2best.lt.15..and.  
      $        .true.)then  
             if(DEBUG)then  
                print*,'***** NEW SEARCH ****'  
             endif  
             goto 11111          !try new search  
               
          endif  
 *     **********************************************  
   
   
553    
554   880     return   880     return
555        end        end
556    
557    
   
   
 c$$$************************************************************  
 c$$$  
 c$$$      subroutine readmipparam  
 c$$$              
 c$$$      include 'commontracker.f'  
 c$$$      include 'calib.f'  
 c$$$  
 c$$$      character*60 fname_param  
 c$$$ 201  format('trk-LADDER',i1,'-mip.dat')  
 c$$$      do ilad=1,nladders_view          
 c$$$         write(fname_param,201)ilad  
 c$$$         print *,'Opening file: ',fname_param  
 c$$$         open(10,  
 c$$$     $        FILE='./bin-aux/'//fname_param(1:LNBLNK(fname_param))  
 c$$$     $        ,STATUS='UNKNOWN'  
 c$$$     $        ,IOSTAT=iostat  
 c$$$     $        )  
 c$$$         if(iostat.ne.0)then  
 c$$$            print*,'READMIPPARAM: *** Error in opening file ***'  
 c$$$            return  
 c$$$         endif  
 c$$$         do iv=1,nviews  
 c$$$            read(10,*  
 c$$$     $           ,IOSTAT=iostat  
 c$$$     $           )pip,  
 c$$$     $            mip(int(pip),ilad)  
 c$$$c            print*,ilad,iv,pip,mip(int(pip),ilad)  
 c$$$         enddo  
 c$$$         close(10)  
 c$$$      enddo  
 c$$$  
 c$$$      return  
 c$$$      end  
 c$$$*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  
 c$$$      subroutine readchargeparam  
 c$$$        
 c$$$        
 c$$$      include 'commontracker.f'  
 c$$$      include 'calib.f'  
 c$$$  
 c$$$      character*60 fname_param  
 c$$$ 201  format('charge-l',i1,'.dat')  
 c$$$      do ilad=1,nladders_view          
 c$$$         write(fname_param,201)ilad  
 c$$$         print *,'Opening file: ',fname_param  
 c$$$         open(10,  
 c$$$     $        FILE='./bin-aux/'//fname_param(1:LNBLNK(fname_param))  
 c$$$     $        ,STATUS='UNKNOWN'  
 c$$$     $        ,IOSTAT=iostat  
 c$$$     $        )  
 c$$$         if(iostat.ne.0)then  
 c$$$            print*,'READCHARGEPARAM: *** Error in opening file ***'  
 c$$$            return  
 c$$$         endif  
 c$$$         do ip=1,nplanes  
 c$$$            read(10,*  
 c$$$     $           ,IOSTAT=iostat  
 c$$$     $           )pip,  
 c$$$     $            kch(ip,ilad),cch(ip,ilad),sch(ip,ilad)          
 c$$$c            print*,ilad,ip,pip,kch(ip,ilad),  
 c$$$c     $           cch(ip,ilad),sch(ip,ilad)  
 c$$$         enddo  
 c$$$         close(10)  
 c$$$      enddo  
 c$$$  
 c$$$      return  
 c$$$      end  
 c$$$*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  
 c$$$      subroutine readetaparam  
 c$$$*     -----------------------------------------  
 c$$$*     read eta2,3,4 calibration parameters  
 c$$$*     and fill variables:  
 c$$$*  
 c$$$*     eta2(netabin,nladders_view,nviews)  
 c$$$*     eta3(2*netabin,nladders_view,nviews)  
 c$$$*     eta4(2*netabin,nladders_view,nviews)  
 c$$$*  
 c$$$      include 'commontracker.f'  
 c$$$      include 'calib.f'  
 c$$$  
 c$$$      character*40 fname_binning  
 c$$$      character*40 fname_param  
 c$$$c      character*120 cmd1  
 c$$$c      character*120 cmd2  
 c$$$  
 c$$$  
 c$$$******retrieve ANGULAR BINNING info  
 c$$$      fname_binning='binning.dat'  
 c$$$      print *,'Opening file: ',fname_binning  
 c$$$      open(10,  
 c$$$     $     FILE='./bin-aux/'//fname_binning(1:LNBLNK(fname_binning))  
 c$$$     $     ,STATUS='UNKNOWN'  
 c$$$     $     ,IOSTAT=iostat  
 c$$$     $     )  
 c$$$      if(iostat.ne.0)then  
 c$$$         print*,'READETAPARAM: *** Error in opening file ***'  
 c$$$         return  
 c$$$      endif  
 c$$$      print*,'---- ANGULAR BINNING ----'  
 c$$$      print*,'Bin   -   angL   -   angR'  
 c$$$ 101  format(i2,'       ',f6.2,'     ',f6.2)  
 c$$$      do ibin=1,nangmax  
 c$$$         read(10,*  
 c$$$     $        ,IOSTAT=iostat  
 c$$$     $        )xnn,angL(ibin),angR(ibin)  
 c$$$         if(iostat.ne.0)goto 1000  
 c$$$         write(*,101)int(xnn),angL(ibin),angR(ibin)  
 c$$$      enddo          
 c$$$ 1000 nangbin=int(xnn)  
 c$$$      close(10)  
 c$$$      print*,'-------------------------'  
 c$$$        
 c$$$  
 c$$$  
 c$$$      do ieta=2,4               !loop on eta 2,3,4          
 c$$$******retrieve correction parameters  
 c$$$ 200     format(' Opening eta',i1,' files...')  
 c$$$         write(*,200)ieta  
 c$$$  
 c$$$ 201     format('eta',i1,'-bin',i1,'-l',i1,'.dat')  
 c$$$ 202     format('eta',i1,'-bin',i2,'-l',i1,'.dat')  
 c$$$         do iang=1,nangbin  
 c$$$            do ilad=1,nladders_view  
 c$$$               if(iang.lt.10)write(fname_param,201)ieta,iang,ilad  
 c$$$               if(iang.ge.10)write(fname_param,202)ieta,iang,ilad  
 c$$$c               print *,'Opening file: ',fname_param  
 c$$$               open(10,  
 c$$$     $             FILE='./bin-aux/'//fname_param(1:LNBLNK(fname_param))  
 c$$$     $              ,STATUS='UNKNOWN'  
 c$$$     $              ,IOSTAT=iostat  
 c$$$     $              )  
 c$$$               if(iostat.ne.0)then  
 c$$$                  print*,'READETAPARAM: *** Error in opening file ***'  
 c$$$                  return  
 c$$$               endif  
 c$$$               do ival=1,netavalmax  
 c$$$                  if(ieta.eq.2)read(10,*  
 c$$$     $                 ,IOSTAT=iostat  
 c$$$     $                 )  
 c$$$     $                 eta2(ival,iang),  
 c$$$     $                 (feta2(ival,iv,ilad,iang),iv=1,nviews)  
 c$$$                  if(ieta.eq.3)read(10,*  
 c$$$     $                 ,IOSTAT=iostat  
 c$$$     $                 )  
 c$$$     $                 eta3(ival,iang),  
 c$$$     $                 (feta3(ival,iv,ilad,iang),iv=1,nviews)  
 c$$$                  if(ieta.eq.4)read(10,*  
 c$$$     $                 ,IOSTAT=iostat  
 c$$$     $                 )  
 c$$$     $                 eta4(ival,iang),  
 c$$$     $                 (feta4(ival,iv,ilad,iang),iv=1,nviews)  
 c$$$                  if(iostat.ne.0)then  
 c$$$                     netaval=ival-1  
 c$$$c$$$                     if(eta2(1,iang).ne.-eta2(netaval,iang))  
 c$$$c$$$     $                    print*,'**** ERROR on parameters !!! ****'  
 c$$$                     goto 2000  
 c$$$                  endif  
 c$$$               enddo  
 c$$$ 2000          close(10)  
 c$$$*               print*,'... done'  
 c$$$            enddo  
 c$$$         enddo  
 c$$$  
 c$$$      enddo                     !end loop on eta 2,3,4  
 c$$$  
 c$$$  
 c$$$      return  
 c$$$      end  
 c$$$  
   
558                
559  ************************************************************  ************************************************************
560  ************************************************************  ************************************************************
# Line 556  c$$$ Line 579  c$$$
579  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)
580  *     angx   - Projected angle in x  *     angx   - Projected angle in x
581  *     angy   - Projected angle in y  *     angy   - Projected angle in y
582    *     bfx    - x-component of magnetci field
583    *     bfy    - y-component of magnetic field
584  *  *
585  *     --------- COUPLES -------------------------------------------------------  *     --------- COUPLES -------------------------------------------------------
586  *     The couple defines a point in the space.  *     The couple defines a point in the space.
# Line 594  c$$$ Line 619  c$$$
619  *  *
620  *  *
621    
622        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,angx,angy)        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
623    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c     01/02/2006 modified by elena vannuccini --> (2)  
 c     02/02/2006 modified by Elena Vannuccini --> (3)  
 c                (implemented new p.f.a.)  
 c     03/02/2006 modified by Elena Vannuccini --> (4)  
 c                (implemented variable resolution)  
 c*****************************************************  
624                
625        include 'commontracker.f'        include 'commontracker.f'
       include 'calib.f'  
626        include 'level1.f'        include 'level1.f'
627          include 'calib.f'
628        include 'common_align.f'        include 'common_align.f'
629        include 'common_mech.f'        include 'common_mech.f'
630        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
       include 'common_resxy.f'  
   
       logical DEBUG  
       common/dbg/DEBUG  
631    
632        integer icx,icy           !X-Y cluster ID        integer icx,icy           !X-Y cluster ID
633        integer sensor        integer sensor
634        integer viewx,viewy        integer viewx,viewy
635        character*4 PFAx,PFAy     !PFA to be used        character*4 PFAx,PFAy     !PFA to be used
636        real angx,angy            !X-Y angle        real ax,ay                !X-Y geometric angle
637          real angx,angy            !X-Y effective angle
638          real bfx,bfy              !X-Y b-field components
639    
640        real stripx,stripy        real stripx,stripy
641    
642          double precision xi,yi,zi
643          double precision xi_A,yi_A,zi_A
644          double precision xi_B,yi_B,zi_B
645        double precision xrt,yrt,zrt        double precision xrt,yrt,zrt
646        double precision xrt_A,yrt_A,zrt_A        double precision xrt_A,yrt_A,zrt_A
647        double precision xrt_B,yrt_B,zrt_B        double precision xrt_B,yrt_B,zrt_B
 c      double precision xi,yi,zi  
 c      double precision xi_A,yi_A,zi_A  
 c      double precision xi_B,yi_B,zi_B  
648                
649    
650        parameter (ndivx=30)        parameter (ndivx=30)
651    
652    
653                
654        resxPAM = 0        resxPAM = 0
655        resyPAM = 0        resyPAM = 0
656    
657        xPAM = 0.        xPAM = 0.D0
658        yPAM = 0.        yPAM = 0.D0
659        zPAM = 0.        zPAM = 0.D0
660        xPAM_A = 0.        xPAM_A = 0.D0
661        yPAM_A = 0.        yPAM_A = 0.D0
662        zPAM_A = 0.        zPAM_A = 0.D0
663        xPAM_B = 0.        xPAM_B = 0.D0
664        yPAM_B = 0.        yPAM_B = 0.D0
665        zPAM_B = 0.        zPAM_B = 0.D0
666    
667          if(sensor.lt.1.or.sensor.gt.2)then
668             print*,'xyz_PAM   ***ERROR*** wrong input '
669             print*,'sensor ',sensor
670             icx=0
671             icy=0
672          endif
673    
674  *     -----------------  *     -----------------
675  *     CLUSTER X  *     CLUSTER X
676  *     -----------------  *     -----------------      
   
677        if(icx.ne.0)then        if(icx.ne.0)then
678           viewx = VIEW(icx)  
679           nldx = nld(MAXS(icx),VIEW(icx))           viewx   = VIEW(icx)
680           nplx = npl(VIEW(icx))           nldx    = nld(MAXS(icx),VIEW(icx))
681           resxPAM = RESXAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           nplx    = npl(VIEW(icx))
682            c         resxPAM = RESXAV
683           stripx = float(MAXS(icx))           stripx  = float(MAXS(icx))
684           if(PFAx.eq.'COG1')then  !(1)  
685              stripx = stripx      !(1)           if(
686              resxPAM = resxPAM    !(1)       $        viewx.lt.1.or.        
687           elseif(PFAx.eq.'COG2')then       $        viewx.gt.12.or.
688              stripx = stripx + cog(2,icx)                   $        nldx.lt.1.or.
689              resxPAM = resxPAM*fbad_cog(2,icx)       $        nldx.gt.3.or.
690           elseif(PFAx.eq.'ETA2')then       $        stripx.lt.1.or.
691  c            cog2 = cog(2,icx)       $        stripx.gt.3072.or.
692  c            etacorr = pfa_eta2(cog2,viewx,nldx,angx)                   $        .false.)then
693  c            stripx = stripx + etacorr              print*,'xyz_PAM   ***ERROR*** wrong input '
694              stripx = stripx + pfa_eta2(icx,angx)            !(3)              print*,'icx ',icx,'view ',viewx,'nld ',nldx,'strip ',stripx
695              resxPAM = risx_eta2(angx)                       !   (4)              icx = 0
696              if(DEBUG.and.fbad_cog(2,icx).ne.1)              goto 10
      $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)  
             resxPAM = resxPAM*fbad_cog(2,icx)  
          elseif(PFAx.eq.'ETA3')then                         !(3)  
             stripx = stripx + pfa_eta3(icx,angx)            !(3)  
             resxPAM = risx_eta3(angx)                       !   (4)  
             if(DEBUG.and.fbad_cog(3,icx).ne.1)              !(3)  
      $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)!(3)  
             resxPAM = resxPAM*fbad_cog(3,icx)               !(3)  
          elseif(PFAx.eq.'ETA4')then                         !(3)  
             stripx = stripx + pfa_eta4(icx,angx)            !(3)  
             resxPAM = risx_eta4(angx)                       !   (4)  
             if(DEBUG.and.fbad_cog(4,icx).ne.1)              !(3)  
      $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)!(3)  
             resxPAM = resxPAM*fbad_cog(4,icx)               !(3)  
          elseif(PFAx.eq.'ETA')then                          !(3)  
             stripx = stripx + pfa_eta(icx,angx)             !(3)  
             resxPAM = ris_eta(icx,angx)                     !   (4)  
             if(DEBUG.and.fbad_cog(2,icx).ne.1)              !(3)  
      $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)!(3)  
 c            resxPAM = resxPAM*fbad_cog(2,icx)               !(3)TEMPORANEO  
             resxPAM = resxPAM*fbad_eta(icx,angx)             !(3)(4)  
          elseif(PFAx.eq.'COG')then           !(2)  
             stripx = stripx + cog(0,icx)     !(2)          
             resxPAM = risx_cog(angx)                        !   (4)  
             resxPAM = resxPAM*fbad_cog(0,icx)!(2)  
          else  
             print*,'*** Non valid p.f.a. (x) --> ',PFAx  
697           endif           endif
698    
699        endif  *        --------------------------
700          *        magnetic-field corrections
701    *        --------------------------
702             stripx  = stripx +  fieldcorr(viewx,bfy)      
703             angx    = effectiveangle(ax,viewx,bfy)
704            
705             call applypfa(PFAx,icx,angx,corr,res)
706             stripx  = stripx + corr
707             resxPAM = res
708    
709     10   endif
710        
711  *     -----------------  *     -----------------
712  *     CLUSTER Y  *     CLUSTER Y
713  *     -----------------  *     -----------------
714    
715        if(icy.ne.0)then        if(icy.ne.0)then
716    
717           viewy = VIEW(icy)           viewy = VIEW(icy)
718           nldy = nld(MAXS(icy),VIEW(icy))           nldy = nld(MAXS(icy),VIEW(icy))
719           nply = npl(VIEW(icy))           nply = npl(VIEW(icy))
720           resyPAM = RESYAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!  c         resyPAM = RESYAV
721             stripy = float(MAXS(icy))
722    
723             if(
724         $        viewy.lt.1.or.        
725         $        viewy.gt.12.or.
726         $        nldy.lt.1.or.
727         $        nldy.gt.3.or.
728         $        stripy.lt.1.or.
729         $        stripy.gt.3072.or.
730         $        .false.)then
731                print*,'xyz_PAM   ***ERROR*** wrong input '
732                print*,'icy ',icy,'view ',viewy,'nld ',nldy,'strip ',stripy
733                icy = 0
734                goto 20
735             endif
736    
737           if(icx.ne.0.and.(nply.ne.nplx.or.nldy.ne.nldx))then           if(icx.ne.0.and.(nply.ne.nplx.or.nldy.ne.nldx))then
738              print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '              if(DEBUG.EQ.1) then
739       $           ,icx,icy                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '
740         $              ,icx,icy
741                endif
742              goto 100              goto 100
743           endif           endif
           
          stripy = float(MAXS(icy))  
          if(PFAy.eq.'COG1')then !(1)  
             stripy = stripy     !(1)  
             resyPAM = resyPAM   !(1)  
          elseif(PFAy.eq.'COG2')then  
             stripy = stripy + cog(2,icy)  
             resyPAM = resyPAM*fbad_cog(2,icy)  
          elseif(PFAy.eq.'ETA2')then  
 c            cog2 = cog(2,icy)  
 c            etacorr = pfa_eta2(cog2,viewy,nldy,angy)  
 c            stripy = stripy + etacorr  
             stripy = stripy + pfa_eta2(icy,angy)            !(3)  
             resyPAM = risy_eta2(angy)                       !   (4)  
             resyPAM = resyPAM*fbad_cog(2,icy)  
             if(DEBUG.and.fbad_cog(2,icy).ne.1)  
      $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)  
          elseif(PFAy.eq.'ETA3')then                         !(3)  
             stripy = stripy + pfa_eta3(icy,angy)            !(3)  
             resyPAM = resyPAM*fbad_cog(3,icy)               !(3)  
             if(DEBUG.and.fbad_cog(3,icy).ne.1)              !(3)  
      $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)!(3)  
          elseif(PFAy.eq.'ETA4')then                         !(3)  
             stripy = stripy + pfa_eta4(icy,angy)            !(3)  
             resyPAM = resyPAM*fbad_cog(4,icy)               !(3)  
             if(DEBUG.and.fbad_cog(4,icy).ne.1)              !(3)  
      $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)!(3)  
          elseif(PFAy.eq.'ETA')then                          !(3)  
             stripy = stripy + pfa_eta(icy,angy)             !(3)  
             resyPAM = ris_eta(icy,angy)                     !   (4)  
 c            resyPAM = resyPAM*fbad_cog(2,icy)              !(3)TEMPORANEO  
             resyPAM = resyPAM*fbad_eta(icy,angy)            !   (4)  
             if(DEBUG.and.fbad_cog(2,icy).ne.1)              !(3)  
      $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)!(3)  
          elseif(PFAy.eq.'COG')then  
             stripy = stripy + cog(0,icy)              
             resyPAM = risy_cog(angy)                        !   (4)  
 c            resyPAM = ris_eta(icy,angy)                    !   (4)  
             resyPAM = resyPAM*fbad_cog(0,icy)  
          else  
             print*,'*** Non valid p.f.a. (x) --> ',PFAx  
          endif  
744    
745        endif  *        --------------------------
746    *        magnetic-field corrections
747    *        --------------------------
748             stripy  = stripy +  fieldcorr(viewy,bfx)      
749             angy    = effectiveangle(ay,viewy,bfx)
750            
751             call applypfa(PFAy,icy,angy,corr,res)
752             stripy  = stripy + corr
753             resyPAM = res
754    
755     20   endif
756    
757    
         
758  c===========================================================  c===========================================================
759  C     COUPLE  C     COUPLE
760  C===========================================================  C===========================================================
# Line 772  C======================================= Line 763  C=======================================
763  c------------------------------------------------------------------------  c------------------------------------------------------------------------
764  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame
765  c------------------------------------------------------------------------  c------------------------------------------------------------------------
766           xi = acoordsi(stripx,viewx)           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
767           yi = acoordsi(stripy,viewy)       $        .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
768           zi = 0.              if(DEBUG.EQ.1) then
769                   print*,'xyz_PAM (couple):',
770         $              ' WARNING: false X strip: strip ',stripx
771                endif
772             endif
773             xi = dcoordsi(stripx,viewx)
774             yi = dcoordsi(stripy,viewy)
775             zi = 0.D0
776                    
   
777  c------------------------------------------------------------------------  c------------------------------------------------------------------------
778  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
779  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 810  c--------------------------------------- Line 807  c---------------------------------------
807           yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4           yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4
808           zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4           zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4
809    
810           xPAM_A = 0.           xPAM_A = 0.D0
811           yPAM_A = 0.           yPAM_A = 0.D0
812           zPAM_A = 0.           zPAM_A = 0.D0
813    
814           xPAM_B = 0.           xPAM_B = 0.D0
815           yPAM_B = 0.           yPAM_B = 0.D0
816           zPAM_B = 0.           zPAM_B = 0.D0
817    
818        elseif(        elseif(
819       $        (icx.ne.0.and.icy.eq.0).or.       $        (icx.ne.0.and.icy.eq.0).or.
# Line 836  C======================================= Line 833  C=======================================
833              nldx = nldy              nldx = nldy
834              viewx = viewy + 1              viewx = viewy + 1
835    
836              yi   = acoordsi(stripy,viewy)              xi = dcoordsi(0.5*(nstrips+1),viewx) !sensor center
837                yi = dcoordsi(stripy,viewy)
838                zi = 0.D0
839    
840              xi_A = edgeY_d - SiDimX/2              xi_A = edgeY_d - SiDimX/2
841              yi_A = yi              yi_A = yi
# Line 846  C======================================= Line 845  C=======================================
845              yi_B = yi              yi_B = yi
846              zi_B = 0.              zi_B = 0.
847    
 c            print*,'Y-cl ',icy,stripy,' --> ',yi  
 c            print*,xi_A,' <--> ',xi_B  
848                            
849           elseif(icx.ne.0)then           elseif(icx.ne.0)then
850  c===========================================================  c===========================================================
# Line 858  C======================================= Line 855  C=======================================
855              nldy = nldx              nldy = nldx
856              viewy = viewx - 1              viewy = viewx - 1
857    
858              xi   = acoordsi(stripx,viewx)              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
859         $           .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
860                   if(DEBUG.EQ.1) then
861                      print*,'xyz_PAM (X-singlet):',
862         $                 ' WARNING: false X strip: strip ',stripx
863                   endif
864                endif
865    
866                xi = dcoordsi(stripx,viewx)
867                yi = dcoordsi(0.5*(nstrips+1),viewy) !sensor center
868                zi = 0.D0
869    
870              xi_A = xi              xi_A = xi
871              yi_A = edgeX_d - SiDimY/2              yi_A = edgeX_d - SiDimY/2
# Line 874  C======================================= Line 881  C=======================================
881                 yi_B = yi                 yi_B = yi
882              endif              endif
883    
 c            print*,'X-cl ',icx,stripx,' --> ',xi  
 c            print*,yi_A,' <--> ',yi_B  
884    
885           else           else
886                if(DEBUG.EQ.1) then
887              print *,'routine xyz_PAM ---> not properly used !!!'                 print *,'routine xyz_PAM ---> not properly used !!!'
888              print *,'icx = ',icx                 print *,'icx = ',icx
889              print *,'icy = ',icy                 print *,'icy = ',icy
890                endif
891              goto 100              goto 100
892                            
893           endif           endif
# Line 920  c     N.B. I convert angles from microra Line 926  c     N.B. I convert angles from microra
926       $        + zi_B       $        + zi_B
927       $        + dz(nplx,nldx,sensor)       $        + dz(nplx,nldx,sensor)
928    
929    
930    
931             xrt = xi
932         $        - omega(nplx,nldx,sensor)*yi
933         $        + gamma(nplx,nldx,sensor)*zi
934         $        + dx(nplx,nldx,sensor)
935            
936             yrt = omega(nplx,nldx,sensor)*xi
937         $        + yi
938         $        - beta(nplx,nldx,sensor)*zi
939         $        + dy(nplx,nldx,sensor)
940            
941             zrt = -gamma(nplx,nldx,sensor)*xi
942         $        + beta(nplx,nldx,sensor)*yi
943         $        + zi
944         $        + dz(nplx,nldx,sensor)
945    
946    
947                    
948  c      xrt = xi  c      xrt = xi
949  c      yrt = yi  c      yrt = yi
# Line 930  c     (xPAM,yPAM,zPAM) = measured coordi Line 954  c     (xPAM,yPAM,zPAM) = measured coordi
954  c                        in PAMELA reference system  c                        in PAMELA reference system
955  c------------------------------------------------------------------------  c------------------------------------------------------------------------
956    
957           xPAM = 0.           xPAM = dcoord(xrt,viewx,nldx,sensor) / 1.d4
958           yPAM = 0.           yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4
959           zPAM = 0.           zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4
960    c$$$         xPAM = 0.D0
961    c$$$         yPAM = 0.D0
962    c$$$         zPAM = 0.D0
963    
964           xPAM_A = dcoord(xrt_A,viewx,nldx,sensor) / 1.d4           xPAM_A = dcoord(xrt_A,viewx,nldx,sensor) / 1.d4
965           yPAM_A = dcoord(yrt_A,viewy,nldy,sensor) / 1.d4           yPAM_A = dcoord(yrt_A,viewy,nldy,sensor) / 1.d4
# Line 943  c--------------------------------------- Line 970  c---------------------------------------
970           zPAM_B = ( zrt_B + z_mech_sensor(nplx,nldx,sensor)*1000.)/ 1.d4           zPAM_B = ( zrt_B + z_mech_sensor(nplx,nldx,sensor)*1000.)/ 1.d4
971                    
972    
 c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'  
973    
974        else        else
975                       if(DEBUG.EQ.1) then
976           print *,'routine xyz_PAM ---> not properly used !!!'              print *,'routine xyz_PAM ---> not properly used !!!'
977           print *,'icx = ',icx              print *,'icx = ',icx
978           print *,'icy = ',icy              print *,'icy = ',icy
979                         endif
980        endif        endif
981                    
982    
983    
984   100  continue   100  continue
985        end        end
986    
987    ************************************************************************
988    *     Call xyz_PAM subroutine with default PFA and fill the mini2 common.
989    *     (done to be called from c/c++)
990    ************************************************************************
991    
992          subroutine xyzpam(ip,icx,icy,lad,sensor,ax,ay,bfx,bfy)
993    
994          include 'commontracker.f'
995          include 'level1.f'
996          include 'common_mini_2.f'
997          include 'common_xyzPAM.f'
998          include 'common_mech.f'
999          include 'calib.f'
1000          
1001    *     flag to chose PFA
1002    c$$$      character*10 PFA
1003    c$$$      common/FINALPFA/PFA
1004    
1005          integer icx,icy           !X-Y cluster ID
1006          integer sensor
1007          character*4 PFAx,PFAy     !PFA to be used
1008          real ax,ay                !X-Y geometric angle
1009          real bfx,bfy              !X-Y b-field components
1010    
1011          ipx=0
1012          ipy=0      
1013          
1014    c$$$      PFAx = 'COG4'!PFA
1015    c$$$      PFAy = 'COG4'!PFA
1016    
1017    
1018          if(icx.gt.nclstr1.or.icy.gt.nclstr1)then
1019                print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1020         $           ,' do not exists (n.clusters=',nclstr1,')'
1021                icx = -1*icx
1022                icy = -1*icy
1023                return
1024            
1025          endif
1026          
1027          call idtoc(pfaid,PFAx)
1028          call idtoc(pfaid,PFAy)
1029    
1030          
1031          if(icx.ne.0.and.icy.ne.0)then
1032    
1033             ipx=npl(VIEW(icx))
1034             ipy=npl(VIEW(icy))
1035            
1036             if( (nplanes-ipx+1).ne.ip )then
1037                print*,'xyzpam: ***WARNING*** cluster ',icx
1038         $           ,' does not belong to plane: ',ip
1039                icx = -1*icx
1040                return
1041             endif
1042             if( (nplanes-ipy+1).ne.ip )then
1043                print*,'xyzpam: ***WARNING*** cluster ',icy
1044         $           ,' does not belong to plane: ',ip
1045                icy = -1*icy
1046                return
1047             endif
1048    
1049             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1050    
1051             xgood(ip) = 1.
1052             ygood(ip) = 1.
1053             resx(ip)  = resxPAM
1054             resy(ip)  = resyPAM
1055    
1056             xm(ip) = xPAM
1057             ym(ip) = yPAM
1058             zm(ip) = zPAM
1059             xm_A(ip) = 0.D0
1060             ym_A(ip) = 0.D0
1061             xm_B(ip) = 0.D0
1062             ym_B(ip) = 0.D0
1063    
1064    c         zv(ip) = zPAM
1065    
1066          elseif(icx.eq.0.and.icy.ne.0)then
1067    
1068             ipy=npl(VIEW(icy))
1069             if( (nplanes-ipy+1).ne.ip )then
1070                print*,'xyzpam: ***WARNING*** cluster ',icy
1071         $           ,' does not belong to plane: ',ip
1072                icy = -1*icy
1073                return
1074             endif
1075    
1076             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1077            
1078             xgood(ip) = 0.
1079             ygood(ip) = 1.
1080             resx(ip)  = 1000.
1081             resy(ip)  = resyPAM
1082    
1083    c$$$         xm(ip) = -100.
1084    c$$$         ym(ip) = -100.
1085    c$$$         zm(ip) = (zPAM_A+zPAM_B)/2.
1086             xm(ip) = xPAM
1087             ym(ip) = yPAM
1088             zm(ip) = zPAM
1089             xm_A(ip) = xPAM_A
1090             ym_A(ip) = yPAM_A
1091             xm_B(ip) = xPAM_B
1092             ym_B(ip) = yPAM_B
1093    
1094    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1095            
1096          elseif(icx.ne.0.and.icy.eq.0)then
1097    
1098             ipx=npl(VIEW(icx))
1099    
1100             if( (nplanes-ipx+1).ne.ip )then
1101                print*,'xyzpam: ***WARNING*** cluster ',icx
1102         $           ,' does not belong to plane: ',ip
1103                icx = -1*icx
1104                return
1105             endif
1106    
1107             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1108          
1109             xgood(ip) = 1.
1110             ygood(ip) = 0.
1111             resx(ip)  = resxPAM
1112             resy(ip)  = 1000.
1113    
1114    c$$$         xm(ip) = -100.
1115    c$$$         ym(ip) = -100.
1116    c$$$         zm(ip) = (zPAM_A+zPAM_B)/2.
1117             xm(ip) = xPAM
1118             ym(ip) = yPAM
1119             zm(ip) = zPAM
1120             xm_A(ip) = xPAM_A
1121             ym_A(ip) = yPAM_A
1122             xm_B(ip) = xPAM_B
1123             ym_B(ip) = yPAM_B
1124            
1125    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1126    
1127          else
1128    
1129             il = 2
1130             if(lad.ne.0)il=lad
1131             is = 1
1132             if(sensor.ne.0)is=sensor
1133    
1134             xgood(ip) = 0.
1135             ygood(ip) = 0.
1136             resx(ip)  = 1000.
1137             resy(ip)  = 1000.
1138    
1139             xm(ip) = -100.
1140             ym(ip) = -100.          
1141             zm(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1142             xm_A(ip) = 0.
1143             ym_A(ip) = 0.
1144             xm_B(ip) = 0.
1145             ym_B(ip) = 0.
1146    
1147    c         zv(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1148    
1149          endif
1150    
1151          if(DEBUG.EQ.1)then
1152    22222    format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
1153             write(*,22222)ip,zm(ip),xm(ip),ym(ip)
1154         $        ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip)
1155         $        ,xgood(ip),ygood(ip),resx(ip),resy(ip)
1156          endif
1157          end
1158    
1159  ********************************************************************************  ********************************************************************************
1160  ********************************************************************************  ********************************************************************************
# Line 977  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1176  c         print*,'A-(',xPAM_A,yPAM_A,')
1176  *      *    
1177  ********************************************************************************  ********************************************************************************
1178    
1179        real function distance_to(XPP,YPP)        real function distance_to(rXPP,rYPP)
1180    
1181        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1182    
# Line 986  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1185  c         print*,'A-(',xPAM_A,yPAM_A,')
1185  *     ( i.e. distance/resolution )  *     ( i.e. distance/resolution )
1186  *     -----------------------------------  *     -----------------------------------
1187    
1188          real rXPP,rYPP
1189          double precision XPP,YPP
1190        double precision distance,RE        double precision distance,RE
1191        double precision BETA,ALFA,xmi,ymi        double precision BETA,ALFA,xmi,ymi
1192    
1193          XPP=DBLE(rXPP)
1194          YPP=DBLE(rYPP)
1195    
1196  *     ----------------------  *     ----------------------
1197        if (        if (
1198       +     xPAM.eq.0.and.  c$$$     +     xPAM.eq.0.and.
1199       +     yPAM.eq.0.and.  c$$$     +     yPAM.eq.0.and.
1200       +     zPAM.eq.0.and.  c$$$     +     zPAM.eq.0.and.
1201       +     xPAM_A.ne.0.and.       +     xPAM_A.ne.0.and.
1202       +     yPAM_A.ne.0.and.       +     yPAM_A.ne.0.and.
1203       +     zPAM_A.ne.0.and.       +     zPAM_A.ne.0.and.
# Line 1031  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1235  c         print*,'A-(',xPAM_A,yPAM_A,')
1235           endif                   endif        
1236    
1237           distance=           distance=
1238       $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2       $       ((xmi-XPP)**2+(ymi-YPP)**2)!QUIQUI
1239    cc     $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1240           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1241    
 c$$$         print*,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b  
 c$$$     $        ,' --- distance_to --- ',xpp,ypp  
 c$$$         print*,' resolution ',re  
1242    
1243                    
1244  *     ----------------------  *     ----------------------
1245        elseif(        elseif(
1246       +     xPAM.ne.0.and.  c$$$     +     xPAM.ne.0.and.
1247       +     yPAM.ne.0.and.  c$$$     +     yPAM.ne.0.and.
1248       +     zPAM.ne.0.and.  c$$$     +     zPAM.ne.0.and.
1249       +     xPAM_A.eq.0.and.       +     xPAM_A.eq.0.and.
1250       +     yPAM_A.eq.0.and.       +     yPAM_A.eq.0.and.
1251       +     zPAM_A.eq.0.and.       +     zPAM_A.eq.0.and.
# Line 1056  c$$$         print*,' resolution ',re Line 1258  c$$$         print*,' resolution ',re
1258  *     ----------------------  *     ----------------------
1259                    
1260           distance=           distance=
1261       $        ((xPAM-XPP)/resxPAM)**2       $       ((xPAM-XPP))**2 !QUIQUI
1262       $        +       $       +
1263       $        ((yPAM-YPP)/resyPAM)**2       $       ((yPAM-YPP))**2
1264    c$$$     $        ((xPAM-XPP)/resxPAM)**2
1265    c$$$     $        +
1266    c$$$     $        ((yPAM-YPP)/resyPAM)**2
1267           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1268    
 c$$$         print*,xPAM,yPAM,zPAM  
 c$$$     $        ,' --- distance_to --- ',xpp,ypp  
 c$$$         print*,' resolution ',resxPAM,resyPAM  
1269                    
1270        else        else
1271                    
          print*  
      $        ,' function distance_to ---> wrong usage!!!'  
          print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM  
          print*,' xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b '  
      $        ,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b  
1272        endif          endif  
1273    
1274        distance_to = sngl(distance)        distance_to = sngl(distance)
# Line 1111  c$$$         print*,' resolution ',resxP Line 1308  c$$$         print*,' resolution ',resxP
1308        data c1/1.,0.,0.,1./        data c1/1.,0.,0.,1./
1309        data c2/1.,-1.,-1.,1./        data c2/1.,-1.,-1.,1./
1310        data c3/1.,1.,0.,0./        data c3/1.,1.,0.,0./
1311        real*8 yvvv,xvvv        double precision yvvv,xvvv
1312        double precision xi,yi,zi        double precision xi,yi,zi
1313        double precision xrt,yrt,zrt        double precision xrt,yrt,zrt
1314        real AA,BB        real AA,BB
1315        real yvv(4),xvv(4)        double precision yvv(4),xvv(4)
1316    
1317  *     tollerance to consider the track inside the sensitive area  *     tollerance to consider the track inside the sensitive area
1318        real ptoll        real ptoll
1319        data ptoll/150./          !um        data ptoll/150./          !um
1320    
1321        external nviewx,nviewy,acoordsi,dcoord        external nviewx,nviewy,dcoordsi,dcoord
1322    
1323        nplpt = nplPAM            !plane        nplpt = nplPAM            !plane
1324        viewx = nviewx(nplpt)        viewx = nviewx(nplpt)
# Line 1136  c$$$         print*,' resolution ',resxP Line 1333  c$$$         print*,' resolution ',resxP
1333  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1334  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame
1335  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1336                 xi = acoordsi(stripx,viewx)                 xi = dcoordsi(stripx,viewx)
1337                 yi = acoordsi(stripy,viewy)                 yi = dcoordsi(stripy,viewy)
1338                 zi = 0.                 zi = 0.D0
1339  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1340  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
1341  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 1163  c--------------------------------------- Line 1360  c---------------------------------------
1360    
1361                 yvv(iv)=sngl(yvvv)                 yvv(iv)=sngl(yvvv)
1362                 xvv(iv)=sngl(xvvv)                 xvv(iv)=sngl(xvvv)
 c               print*,'LADDER ',il,' SENSOR ',is,' vertexes >> '  
 c     $              ,iv,xvv(iv),yvv(iv)  
1363              enddo               !end loop on sensor vertexes              enddo               !end loop on sensor vertexes
1364    
1365              dtot=0.              dtot=0.
# Line 1263  c     $              ,iv,xvv(iv),yvv(iv) Line 1458  c     $              ,iv,xvv(iv),yvv(iv)
1458  *     it returns the plane number  *     it returns the plane number
1459  *      *    
1460        include 'commontracker.f'        include 'commontracker.f'
1461          include 'level1.f'
1462  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1463        include 'common_momanhough.f'        include 'common_momanhough.f'
1464                
# Line 1288  c      include 'common_analysis.f' Line 1484  c      include 'common_analysis.f'
1484        is_cp=0        is_cp=0
1485        if(id.lt.0)is_cp=1        if(id.lt.0)is_cp=1
1486        if(id.gt.0)is_cp=2        if(id.gt.0)is_cp=2
       if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'  
1487    
1488        return        return
1489        end        end
# Line 1300  c      include 'common_analysis.f' Line 1495  c      include 'common_analysis.f'
1495  *     it returns the id number ON THE PLANE  *     it returns the id number ON THE PLANE
1496  *      *    
1497        include 'commontracker.f'        include 'commontracker.f'
1498          include 'level1.f'
1499  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1500        include 'common_momanhough.f'        include 'common_momanhough.f'
1501                
# Line 1328  c      include 'common_analysis.f' Line 1524  c      include 'common_analysis.f'
1524  *     positive if sensor =2  *     positive if sensor =2
1525  *  *
1526        include 'commontracker.f'        include 'commontracker.f'
1527          include 'level1.f'
1528  c      include 'calib.f'  c      include 'calib.f'
1529  c      include 'level1.f'  c      include 'level1.f'
1530  c      include 'common_analysis.f'  c      include 'common_analysis.f'
# Line 1357  c      include 'common_analysis.f' Line 1554  c      include 'common_analysis.f'
1554  *************************************************************************  *************************************************************************
1555  *************************************************************************  *************************************************************************
1556  *************************************************************************  *************************************************************************
 c$$$      subroutine book_debug  
 c$$$  
 c$$$      include 'commontracker.f'  
 c$$$      include 'common_momanhough.f'  
 c$$$      include 'common_level2debug.f'  
 c$$$  
 c$$$      character*35 block1,block2,block3!,block4  
 c$$$     $     ,block5!,block6        
 c$$$        
 c$$$* * * * * * * * * * * * * * * * * * * * * * * *  
 c$$$*     HOUGH TRANSFORM PARAMETERS  
 c$$$        
 c$$$      call HBOOK2(1003  
 c$$$     $     ,'y vs tg thyz'  
 c$$$     $     ,300,-1.,1.         !x          
 c$$$     $     ,3000,-70.,70.,0.)   !y  
 c$$$  
 c$$$      call HBOOK1(1004  
 c$$$     $     ,'Dy'  
 c$$$     $     ,100,0.,2.,0.)    
 c$$$  
 c$$$      call HBOOK1(1005  
 c$$$     $     ,'D thyz'  
 c$$$     $     ,100,0.,.05,0.)    
 c$$$  
 c$$$  
 c$$$  
 c$$$*     DEBUG ntuple:  
 c$$$      call HBNT(ntp_level2+1,'LEVEL2',' ')  
 c$$$        
 c$$$      call HBNAME(ntp_level2+1,'EVENT',good2_nt,  
 c$$$     $     'GOOD2:L,NEV2:I')  
 c$$$  
 c$$$ 411  format('NDBLT:I::[0,',I5,']')  
 c$$$      write(block1,411) ndblt_max_nt  
 c$$$      call HBNAME(ntp_level2+1,'HOUGH YZ',ndblt_nt,  
 c$$$     $     block1//'  
 c$$$     $     ,ALFAYZ1(NDBLT):R  
 c$$$     $     ,ALFAYZ2(NDBLT):R  
 c$$$     $     ,DB_CLOUD(NDBLT):I  
 c$$$     $     ')    
 c$$$  
 c$$$ 412  format('NTRPT:I::[0,',I5,']')  
 c$$$      write(block2,412) ntrpt_max_nt  
 c$$$      call HBNAME(ntp_level2+1,'HOUGH XZ',NTRPT_nt,  
 c$$$     $     block2//'  
 c$$$     $     ,ALFAXZ1(NTRPT):R  
 c$$$     $     ,ALFAXZ2(NTRPT):R    
 c$$$     $     ,ALFAXZ3(NTRPT):R  
 c$$$     $     ,TR_CLOUD(NTRPT):I  
 c$$$     $     ')  
 c$$$        
 c$$$    
 c$$$ 413  format('NCLOUDS_YZ:I::[0,',I4,']')  
 c$$$c$$$ 414  format('DB_CLOUD(',I4,'):I')  
 c$$$      write(block3,413) ncloyz_max  
 c$$$c$$$      write(block4,414) ndblt_max_nt  
 c$$$      call HBNAME(ntp_level2+1,'CLOUD YZ',NCLOUDS_YZ,  
 c$$$     $     block3//'  
 c$$$     $     ,ALFAYZ1_AV(NCLOUDS_YZ):R  
 c$$$     $     ,ALFAYZ2_AV(NCLOUDS_YZ):R  
 c$$$     $     ,PTCLOUD_YZ(NCLOUDS_YZ):I'  
 c$$$c$$$     $     ,'//block4  
 c$$$     $     )  
 c$$$  
 c$$$ 415  format('NCLOUDS_XZ:I::[0,',I4,']')  
 c$$$c$$$ 416  format('TR_CLOUD(',I5,'):I')  
 c$$$      write(block5,415) ncloxz_max  
 c$$$c$$$      write(block6,416) ntrpt_max_nt  
 c$$$      call HBNAME(ntp_level2+1,'CLOUD XZ',NCLOUDS_XZ,  
 c$$$     $     block5//'  
 c$$$     $     ,ALFAXZ1_AV(NCLOUDS_XZ):R  
 c$$$     $     ,ALFAXZ2_AV(NCLOUDS_XZ):R  
 c$$$     $     ,ALFAXZ3_AV(NCLOUDS_XZ):R  
 c$$$     $     ,PTCLOUD_XZ(NCLOUDS_XZ):I'  
 c$$$c$$$     $     ,'//block6  
 c$$$     $     )  
 c$$$  
 c$$$        
 c$$$      return  
 c$$$      end  
 ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***  
 *  
 *  
 *  
 *  
 *  
 *  
 *  
 *  
 *  
 ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***  
 c$$$      subroutine book_level2  
 c$$$c*****************************************************  
 c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$cccccc 07/10/2005 modified by elena vannuccini --> (2)  
 c$$$c*****************************************************  
 c$$$  
 c$$$      include 'commontracker.f'  
 c$$$      include 'common_momanhough.f'  
 c$$$      include 'level2.f'  
 c$$$  
 c$$$      character*35 block1,block2  
 c$$$  
 c$$$c      print*,'__________ booking LEVEL2 n-tuple __________'  
 c$$$  
 c$$$*     LEVEL1 ntuple:  
 c$$$      call HBNT(ntp_level2,'LEVEL2',' ')  
 c$$$        
 c$$$c*****************************************************  
 c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$c      call HBNAME(ntp_level2,'EVENT',good2,'GOOD2:L,NEV2:I')  
 c$$$cccccc 06/10/2005 modified by elena vannuccini  
 c$$$c      call HBNAME(ntp_level2,'GENERAL',good2,'GOOD2:L,NEV2:I  
 c$$$c     $     ,WHIC_CALIB:I,SWCODE:I')  
 c$$$      call HBNAME(ntp_level2,'GENERAL',good2,'GOOD2:L,NEV2:I  
 c$$$     $     ,WHICH_CALIB:I,SWCODE:I,CRC(12):L')  
 c$$$c*********************************************************  
 c$$$    
 c$$$  
 c$$$c$$$# ifndef TEST2003  
 c$$$c$$$  
 c$$$c$$$      call HBNAME(ntp_level2,'CPU',pkt_type  
 c$$$c$$$     $     ,'PKT_TYPE:I::[0,50]  
 c$$$c$$$     $     ,PKT_NUM:I  
 c$$$c$$$     $     ,OBT:I'//  
 c$$$c$$$c********************************************************  
 c$$$c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$c$$$c     $     ,WHICH_CALIB:I::[0,50]')  
 c$$$c$$$     $     ',CPU_CRC:L')  
 c$$$c$$$c********************************************************  
 c$$$c$$$  
 c$$$c$$$# endif  
 c$$$  
 c$$$ 417  format('NTRK:I::[0,',I4,']')  
 c$$$ 418  format(',IMAGE(NTRK):I::[0,',I4,']')  
 c$$$      write(block1,417)NTRKMAX  
 c$$$      write(block2,418)NTRKMAX  
 c$$$      call HBNAME(ntp_level2,'TRACKS',NTRK,  
 c$$$     $     block1//  
 c$$$     $     block2//'  
 c$$$     $     ,XM(6,NTRK):R  
 c$$$     $     ,YM(6,NTRK):R  
 c$$$     $     ,ZM(6,NTRK):R  
 c$$$     $     ,RESX(6,NTRK):R  
 c$$$     $     ,RESY(6,NTRK):R  
 c$$$     $     ,AL(5,NTRK):R  
 c$$$     $     ,COVAL(5,5,NTRK):R  
 c$$$     $     ,CHI2(NTRK):R  
 c$$$     $     ,XGOOD(6,NTRK):I::[0,1]  
 c$$$     $     ,YGOOD(6,NTRK):I::[0,1]  
 c$$$     $     ,XV(6,NTRK):R  
 c$$$     $     ,YV(6,NTRK):R  
 c$$$     $     ,ZV(6,NTRK):R  
 c$$$     $     ,AXV(6,NTRK):R  
 c$$$     $     ,AYV(6,NTRK):R'//  
 c$$$c*****************************************************  
 c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$c     $     ,DEDXP(6,NTRK):R'//  
 c$$$c     $     ')  
 c$$$     $     ',DEDX_X(6,NTRK):R  
 c$$$     $     ,DEDX_Y(6,NTRK):R'//  
 c$$$c****************************************************  
 c$$$cccccc 06/10/2005 modified by elena vannuccini  
 c$$$c     $     ,CRC(12):L  
 c$$$     $     ',BdL(NTRK):R'  
 c$$$     $     )  
 c$$$c****************************************************  
 c$$$  
 c$$$    
 c$$$      call HBNAME(ntp_level2,'SINGLETX',nclsx,  
 c$$$c*****************************************************  
 c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$c     $     'NCLSX(6):I,NCLSY(6):I')  
 c$$$     $     'NCLSX:I::[0,500],PLANEX(NCLSX):I  
 c$$$     $     ,XS(2,NCLSX):R,SGNLXS(NCLSX):R') !(2)  
 c$$$c    $     ,XS(NCLSX):R,SGNLXS(NCLSX):R')   !(2)  
 c$$$      call HBNAME(ntp_level2,'SINGLETY',nclsy,  
 c$$$     $     'NCLSY:I::[0,500],PLANEY(NCLSY):I  
 c$$$     $     ,YS(2,NCLSY):R,SGNLYS(NCLSY):R') !(2)  
 c$$$c    $     ,YS(NCLSY):R,SGNLYS(NCLSY):R')   !(2)  
 c$$$      return  
 c$$$      end  
   
 c$$$      subroutine fill_level2_clouds  
 c$$$c*****************************************************  
 c$$$c     29/11/2005 created by elena vannuccini  
 c$$$c*****************************************************  
 c$$$  
 c$$$*     -------------------------------------------------------  
 c$$$*     This routine fills the  variables related to the hough  
 c$$$*     transform, for the debig n-tuple  
 c$$$*     -------------------------------------------------------  
 c$$$  
 c$$$      include 'commontracker.f'  
 c$$$      include 'common_momanhough.f'  
 c$$$      include 'common_level2debug.f'  
 c$$$      include 'level2.f'  
 c$$$  
 c$$$      good2_nt=.true.!good2  
 c$$$c      nev2_nt=nev2  
 c$$$        
 c$$$      if(.false.  
 c$$$     $     .or.ntrpt.gt.ntrpt_max_nt  
 c$$$     $     .or.ndblt.gt.ndblt_max_nt  
 c$$$     $     .or.NCLOUDS_XZ.gt.ncloxz_max  
 c$$$     $     .or.NCLOUDS_yZ.gt.ncloyz_max  
 c$$$     $     )then  
 c$$$         good2_nt=.false.  
 c$$$         ntrpt_nt=0  
 c$$$         ndblt_nt=0  
 c$$$         NCLOUDS_XZ_nt=0  
 c$$$         NCLOUDS_YZ_nt=0  
 c$$$      else  
 c$$$         ndblt_nt=ndblt  
 c$$$         ntrpt_nt=ntrpt  
 c$$$         if(ndblt.ne.0)then  
 c$$$            do id=1,ndblt  
 c$$$               alfayz1_nt(id)=alfayz1(id) !Y0  
 c$$$               alfayz2_nt(id)=alfayz2(id) !tg theta-yz  
 c$$$c               db_cloud_nt(id)=db_cloud(id)  
 c$$$            enddo  
 c$$$         endif  
 c$$$         if(ndblt.ne.0)then  
 c$$$            do it=1,ntrpt  
 c$$$               alfaxz1_nt(it)=alfaxz1(it) !X0  
 c$$$               alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz  
 c$$$               alfaxz3_nt(it)=alfaxz3(it) !1/r  
 c$$$c               tr_cloud_nt(it)=tr_cloud(it)  
 c$$$            enddo  
 c$$$         endif  
 c$$$         nclouds_yz_nt=nclouds_yz  
 c$$$         nclouds_xz_nt=nclouds_xz  
 c$$$         if(nclouds_yz.ne.0)then  
 c$$$            nnn=0  
 c$$$            do iyz=1,nclouds_yz  
 c$$$               ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)  
 c$$$               alfayz1_av_nt(iyz)=alfayz1_av(iyz)  
 c$$$               alfayz2_av_nt(iyz)=alfayz2_av(iyz)  
 c$$$               nnn=nnn+ptcloud_yz(iyz)  
 c$$$            enddo  
 c$$$            do ipt=1,nnn  
 c$$$               db_cloud_nt(ipt)=db_cloud(ipt)  
 c$$$            enddo  
 c$$$c            print*,'#### ntupla #### ptcloud_yz '  
 c$$$c     $           ,(ptcloud_yz(i),i=1,nclouds_yz)  
 c$$$c            print*,'#### ntupla #### db_cloud '  
 c$$$c     $           ,(db_cloud(i),i=1,nnn)  
 c$$$         endif  
 c$$$         if(nclouds_xz.ne.0)then  
 c$$$            nnn=0  
 c$$$            do ixz=1,nclouds_xz  
 c$$$               ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)  
 c$$$               alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)  
 c$$$               alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)  
 c$$$               alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)  
 c$$$               nnn=nnn+ptcloud_xz(ixz)                
 c$$$            enddo  
 c$$$            do ipt=1,nnn  
 c$$$               tr_cloud_nt(ipt)=tr_cloud(ipt)  
 c$$$            enddo  
 c$$$c            print*,'#### ntupla #### ptcloud_xz '  
 c$$$c     $           ,(ptcloud_xz(i),i=1,nclouds_xz)  
 c$$$c            print*,'#### ntupla #### tr_cloud '  
 c$$$c     $           ,(tr_cloud(i),i=1,nnn)  
 c$$$         endif  
 c$$$      endif  
 c$$$      end  
1557                
1558    
1559  ***************************************************  ***************************************************
# Line 1639  c$$$      end Line 1568  c$$$      end
1568        subroutine cl_to_couples(iflag)        subroutine cl_to_couples(iflag)
1569    
1570        include 'commontracker.f'        include 'commontracker.f'
1571          include 'level1.f'
1572        include 'common_momanhough.f'        include 'common_momanhough.f'
1573        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1574        include 'calib.f'        include 'calib.f'
1575        include 'level1.f'  c      include 'level1.f'
   
       logical DEBUG  
       common/dbg/DEBUG  
1576    
1577  *     output flag  *     output flag
1578  *     --------------  *     --------------
# Line 1654  c$$$      end Line 1581  c$$$      end
1581  *     --------------  *     --------------
1582        integer iflag        integer iflag
1583    
1584        integer badseed,badcl        integer badseed,badclx,badcly
1585    
1586          iflag = iflag
1587          if(DEBUG.EQ.1)print*,'cl_to_couples:'
1588    
1589    cc      if(RECOVER_SINGLETS.and..not.SECOND_SEARCH)goto 80
1590    
1591  *     init variables  *     init variables
       ncp_tot=0  
1592        do ip=1,nplanes        do ip=1,nplanes
1593           do ico=1,ncouplemax           do ico=1,ncouplemax
1594              clx(ip,ico)=0              clx(ip,ico)=0
# Line 1670  c$$$      end Line 1601  c$$$      end
1601           ncls(ip)=0           ncls(ip)=0
1602        enddo        enddo
1603        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1604           cl_single(icl)=1           cl_single(icl) = 1     !all are single
1605           cl_good(icl)=0           cl_good(icl)   = 0     !all are bad
1606          enddo
1607          do iv=1,nviews
1608             ncl_view(iv)  = 0
1609             mask_view(iv) = 0      !all included
1610        enddo        enddo
1611                
1612    *     count number of cluster per view
1613          do icl=1,nclstr1
1614             ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1        
1615          enddo
1616    *     mask views with too many clusters
1617          do iv=1,nviews
1618             if( ncl_view(iv).gt. nclusterlimit)then
1619    c            mask_view(iv) = 1
1620                mask_view(iv) = mask_view(iv) + 2**0
1621                if(DEBUG.EQ.1)
1622         $        print*,' * WARNING * cl_to_couple: n.clusters > '
1623         $        ,nclusterlimit,' on view ', iv,' --> masked!'
1624             endif
1625          enddo
1626    
1627    
1628  *     start association  *     start association
1629        ncouples=0        ncouples=0
1630        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1631           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1632                    
1633             if(cl_used(icx).ne.0)goto 10
1634    
1635    *     ----------------------------------------------------
1636    *     jump masked views (X VIEW)
1637    *     ----------------------------------------------------
1638             if( mask_view(VIEW(icx)).ne.0 ) goto 10
1639  *     ----------------------------------------------------  *     ----------------------------------------------------
1640  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1641           if(dedx(icx).lt.dedx_x_min)then  *     ----------------------------------------------------
1642             if(sgnl(icx)/mip(VIEW(icx),LADDER(icx)).lt.dedx_x_min)then
1643              cl_single(icx)=0              cl_single(icx)=0
1644              goto 10              goto 10
1645           endif           endif
1646    *     ----------------------------------------------------
1647  *     cut BAD (X VIEW)              *     cut BAD (X VIEW)            
1648    *     ----------------------------------------------------
1649           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
1650           ifirst=INDSTART(icx)           ifirst=INDSTART(icx)
1651           if(icx.ne.nclstr1) then           if(icx.ne.nclstr1) then
# Line 1693  c$$$      end Line 1653  c$$$      end
1653           else           else
1654              ilast=TOTCLLENGTH              ilast=TOTCLLENGTH
1655           endif           endif
1656           badcl=badseed           badclx=badseed
1657           do igood=-ngoodstr,ngoodstr           do igood=-ngoodstr,ngoodstr
1658              ibad=1              ibad=1
1659              if((INDMAX(icx)+igood).gt.ifirst.and.              if((INDMAX(icx)+igood).gt.ifirst.and.
# Line 1703  c$$$      end Line 1663  c$$$      end
1663       $              nvk(MAXS(icx)+igood),       $              nvk(MAXS(icx)+igood),
1664       $              nst(MAXS(icx)+igood))       $              nst(MAXS(icx)+igood))
1665              endif              endif
1666              badcl=badcl*ibad              badclx=badclx*ibad
1667           enddo           enddo
1668    *     ----------------------------------------------------
1669    *     >>> eliminato il taglio sulle BAD <<<
1670    *     ----------------------------------------------------
1671  c     if(badcl.eq.0)then  c     if(badcl.eq.0)then
1672  c     cl_single(icx)=0  c     cl_single(icx)=0
1673  c     goto 10  c     goto 10
# Line 1717  c     endif Line 1680  c     endif
1680                    
1681           do icy=1,nclstr1       !loop on cluster (Y)           do icy=1,nclstr1       !loop on cluster (Y)
1682              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1683    
1684                if(cl_used(icx).ne.0)goto 20
1685                            
1686  *     ----------------------------------------------------  *     ----------------------------------------------------
1687    *     jump masked views (Y VIEW)
1688    *     ----------------------------------------------------
1689                if( mask_view(VIEW(icy)).ne.0 ) goto 20
1690    
1691    *     ----------------------------------------------------
1692  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1693              if(dedx(icy).lt.dedx_y_min)then  *     ----------------------------------------------------
1694                if(sgnl(icy)/mip(VIEW(icy),LADDER(icy)) .lt.dedx_y_min)then
1695                 cl_single(icy)=0                 cl_single(icy)=0
1696                 goto 20                 goto 20
1697              endif              endif
1698    *     ----------------------------------------------------
1699  *     cut BAD (Y VIEW)              *     cut BAD (Y VIEW)            
1700    *     ----------------------------------------------------
1701              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
1702              ifirst=INDSTART(icy)              ifirst=INDSTART(icy)
1703              if(icy.ne.nclstr1) then              if(icy.ne.nclstr1) then
# Line 1732  c     endif Line 1705  c     endif
1705              else              else
1706                 ilast=TOTCLLENGTH                 ilast=TOTCLLENGTH
1707              endif              endif
1708              badcl=badseed              badcly=badseed
1709              do igood=-ngoodstr,ngoodstr              do igood=-ngoodstr,ngoodstr
1710                 ibad=1                 ibad=1
1711                 if((INDMAX(icy)+igood).gt.ifirst.and.                 if((INDMAX(icy)+igood).gt.ifirst.and.
# Line 1741  c     endif Line 1714  c     endif
1714       $              ibad=BAD(VIEW(icy),       $              ibad=BAD(VIEW(icy),
1715       $              nvk(MAXS(icy)+igood),       $              nvk(MAXS(icy)+igood),
1716       $              nst(MAXS(icy)+igood))       $              nst(MAXS(icy)+igood))
1717                 badcl=badcl*ibad                 badcly=badcly*ibad
1718              enddo              enddo
1719    *     ----------------------------------------------------
1720    *     >>> eliminato il taglio sulle BAD <<<
1721    *     ----------------------------------------------------
1722  c     if(badcl.eq.0)then  c     if(badcl.eq.0)then
1723  c     cl_single(icy)=0  c     cl_single(icy)=0
1724  c     goto 20  c     goto 20
1725  c     endif  c     endif
1726  *     ----------------------------------------------------  *     ----------------------------------------------------
1727                            
               
1728              cl_good(icy)=1                                cl_good(icy)=1                  
1729              nply=npl(VIEW(icy))              nply=npl(VIEW(icy))
1730              nldy=nld(MAXS(icy),VIEW(icy))              nldy=nld(MAXS(icy),VIEW(icy))
# Line 1760  c     endif Line 1735  c     endif
1735  *     geometrical consistency (same plane and ladder)  *     geometrical consistency (same plane and ladder)
1736              if(nply.eq.nplx.and.nldy.eq.nldx)then              if(nply.eq.nplx.and.nldy.eq.nldx)then
1737  *     charge correlation  *     charge correlation
1738                 ddd=(dedx(icy)  *     (modified to be applied only below saturation... obviously)
1739       $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  
1740                 ddd=ddd/sqrt(kch(nplx,nldx)**2+1)                 if(  .not.(sgnl(icy).gt.chsaty.and.sgnl(icx).gt.chsatx)
1741                 cut=chcut*sch(nplx,nldx)       $              .and.
1742                 if(abs(ddd).gt.cut)goto 20 !charge not consistent       $              .not.(sgnl(icy).lt.chmipy.and.sgnl(icx).lt.chmipx)
1743                       $              .and.
1744                       $              (badclx.eq.1.and.badcly.eq.1)
1745  *     ------------------> COUPLE <------------------       $              .and.
1746  *     check to do not overflow vector dimentions       $              .true.)then
1747                 if(ncp_plane(nplx).gt.ncouplemax)then  
1748                    if(DEBUG)print*,                    ddd=(sgnl(icy)
1749       $                    ' ** warning ** number of identified'//       $                 -kch(nplx,nldx)*sgnl(icx)-cch(nplx,nldx))
1750       $                    ' couples on plane ',nplx,                    ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
1751       $                    ' exceeds vector dimention'//  
1752       $                    ' ( ',ncouplemax,' )'  c                  cut = chcut * sch(nplx,nldx)
1753  c     good2=.false.  
1754  c     goto 880   !fill ntp and go to next event                    sss=(kch(nplx,nldx)*sgnl(icy)+sgnl(icx)
1755                    iflag=1       $                 -kch(nplx,nldx)*cch(nplx,nldx))
1756                    return                    sss=sss/sqrt(kch(nplx,nldx)**2+1)
1757                      cut = chcut * (16 + sss/50.)
1758    
1759                      if(abs(ddd).gt.cut)then
1760                         goto 20    !charge not consistent
1761                      endif
1762                 endif                 endif
1763                  
1764                 if(ncp_plane(nplx).eq.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
1765                    if(DEBUG)print*,                    if(verbose.eq.1)print*,
1766       $                 '** warning ** number of identified '//       $                 '** warning ** number of identified '//
1767       $                 'couples on plane ',nplx,       $                 'couples on plane ',nplx,
1768       $                 'exceeds vector dimention '       $                 'exceeds vector dimention '
1769       $                 ,'( ',ncouplemax,' )'       $                 ,'( ',ncouplemax,' ) --> masked!'
1770  c     good2=.false.  c                  mask_view(nviewx(nplx)) = 2
1771  c     goto 880   !fill ntp and go to next event                      c                  mask_view(nviewy(nply)) = 2
1772                    iflag=1                   mask_view(nviewx(nplx))= mask_view(nviewx(nplx))+ 2**1
1773                    return                   mask_view(nviewy(nply))= mask_view(nviewy(nply))+ 2**1
1774                      goto 10
1775                 endif                 endif
1776                                
1777    *     ------------------> COUPLE <------------------
1778                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
1779                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
1780                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
1781                 cl_single(icx)=0                 cl_single(icx)=0
1782                 cl_single(icy)=0                 cl_single(icy)=0
             endif                                
1783  *     ----------------------------------------------  *     ----------------------------------------------
1784    
1785                endif                              
1786    
1787   20         continue   20         continue
1788           enddo                  !end loop on clusters(Y)           enddo                  !end loop on clusters(Y)
1789                    
1790   10      continue   10      continue
1791        enddo                     !end loop on clusters(X)        enddo                     !end loop on clusters(X)
1792                
         
1793        do icl=1,nclstr1        do icl=1,nclstr1
1794           if(cl_single(icl).eq.1)then           if(cl_single(icl).eq.1)then
1795              ip=npl(VIEW(icl))              ip=npl(VIEW(icl))
# Line 1815  c     goto 880   !fill ntp and go to nex Line 1797  c     goto 880   !fill ntp and go to nex
1797              cls(ip,ncls(ip))=icl              cls(ip,ncls(ip))=icl
1798           endif           endif
1799        enddo        enddo
1800    
1801    c 80   continue
1802          continue
1803                
1804                
1805        if(DEBUG)then        if(DEBUG.EQ.1)then
1806           print*,'clusters  ',nclstr1           print*,'clusters  ',nclstr1
1807           print*,'good    ',(cl_good(i),i=1,nclstr1)           print*,'good    ',(cl_good(i),i=1,nclstr1)
1808           print*,'singles ',(cl_single(i),i=1,nclstr1)           print*,'used    ',(cl_used(i),i=1,nclstr1)
1809             print*,'singlets',(cl_single(i),i=1,nclstr1)
1810           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
1811        endif        endif
         
       do ip=1,6  
          ncp_tot=ncp_tot+ncp_plane(ip)  
       enddo  
 c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
         
       if(ncp_tot.gt.ncp_max)then  
          if(DEBUG)print*,  
      $           '** warning ** number of identified '//  
      $           'couples exceeds upper limit for Hough tr. '  
      $           ,'( ',ncp_max,' )'              
 c            good2=.false.  
 c     goto 880       !fill ntp and go to next event  
          iflag=1  
          return  
       endif  
         
       return  
       end  
         
 ***************************************************  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 **************************************************  
       subroutine cl_to_couples_nocharge(iflag)  
1812    
1813        include 'commontracker.f'    
1814        include 'common_momanhough.f'        if(.not.RECOVER_SINGLETS)goto 81
       include 'momanhough_init.f'  
       include 'calib.f'  
       include 'level1.f'  
   
       logical DEBUG  
       common/dbg/DEBUG  
   
 *     output flag  
 *     --------------  
 *     0 = good event  
 *     1 = bad event  
 *     --------------  
       integer iflag  
1815    
1816        integer badseed,badcl  *     ////////////////////////////////////////////////
1817    *     PATCH to recover events with less than 3 couples
1818    *     ////////////////////////////////////////////////    
1819    *     loop over singlet and create "fake" couples
1820    *     (with clx=0 or cly=0)
1821    *    
1822    
1823  *     init variables        if(DEBUG.EQ.1)
1824        ncp_tot=0       $     print*,'>>> Recover singlets '
1825        do ip=1,nplanes       $     ,'(creates fake couples) <<<'
1826           do ico=1,ncouplemax        do icl=1,nclstr1
1827              clx(ip,ico)=0           if(
1828              cly(ip,ico)=0       $        cl_single(icl).eq.1.and.
1829           enddo       $        cl_used(icl).eq.0.and.
1830           ncp_plane(ip)=0       $        .true.)then
          do icl=1,nclstrmax_level2  
             cls(ip,icl)=1  
          enddo  
          ncls(ip)=0  
       enddo  
       do icl=1,nclstrmax_level2  
          cl_single(icl)=1  
          cl_good(icl)=0  
       enddo  
         
 *     start association  
       ncouples=0  
       do icx=1,nclstr1          !loop on cluster (X)  
          if(mod(VIEW(icx),2).eq.1)goto 10  
           
1831  *     ----------------------------------------------------  *     ----------------------------------------------------
1832  *     cut on charge (X VIEW)  *     jump masked views
          if(dedx(icx).lt.dedx_x_min)then  
             cl_single(icx)=0  
             goto 10  
          endif  
 *     cut BAD (X VIEW)              
          badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))  
          ifirst=INDSTART(icx)  
          if(icx.ne.nclstr1) then  
             ilast=INDSTART(icx+1)-1  
          else  
             ilast=TOTCLLENGTH  
          endif  
          badcl=badseed  
          do igood=-ngoodstr,ngoodstr  
             ibad=1  
             if((INDMAX(icx)+igood).gt.ifirst.and.  
      $           (INDMAX(icx)+igood).lt.ilast.and.  
      $           .true.)then  
                ibad=BAD(VIEW(icx),  
      $              nvk(MAXS(icx)+igood),  
      $              nst(MAXS(icx)+igood))  
             endif  
             badcl=badcl*ibad  
          enddo  
          if(badcl.eq.0)then     !<<<<<<<<<<<<<< BAD cut  
             cl_single(icx)=0    !<<<<<<<<<<<<<< BAD cut  
             goto 10             !<<<<<<<<<<<<<< BAD cut  
          endif                  !<<<<<<<<<<<<<< BAD cut  
1833  *     ----------------------------------------------------  *     ----------------------------------------------------
1834                        if( mask_view(VIEW(icl)).ne.0 ) goto 21
1835           cl_good(icx)=1              if(mod(VIEW(icl),2).eq.0)then !=== X views
          nplx=npl(VIEW(icx))  
          nldx=nld(MAXS(icx),VIEW(icx))  
           
          do icy=1,nclstr1       !loop on cluster (Y)  
             if(mod(VIEW(icy),2).eq.0)goto 20  
               
1836  *     ----------------------------------------------------  *     ----------------------------------------------------
1837  *     cut on charge (Y VIEW)  *     cut on charge (X VIEW)
             if(dedx(icy).lt.dedx_y_min)then  
                cl_single(icy)=0  
                goto 20  
             endif  
 *     cut BAD (Y VIEW)              
             badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))  
             ifirst=INDSTART(icy)  
             if(icy.ne.nclstr1) then  
                ilast=INDSTART(icy+1)-1  
             else  
                ilast=TOTCLLENGTH  
             endif  
             badcl=badseed  
             do igood=-ngoodstr,ngoodstr  
                ibad=1  
                if((INDMAX(icy)+igood).gt.ifirst.and.  
      $              (INDMAX(icy)+igood).lt.ilast.and.  
      $              .true.)  
      $              ibad=BAD(VIEW(icy),  
      $              nvk(MAXS(icy)+igood),  
      $              nst(MAXS(icy)+igood))  
                badcl=badcl*ibad  
             enddo  
             if(badcl.eq.0)then  !<<<<<<<<<<<<<< BAD cut  
                cl_single(icy)=0 !<<<<<<<<<<<<<< BAD cut  
                goto 20          !<<<<<<<<<<<<<< BAD cut  
             endif               !<<<<<<<<<<<<<< BAD cut  
1838  *     ----------------------------------------------------  *     ----------------------------------------------------
1839                               if(sgnl(icl).lt.dedx_x_min) goto 21
               
             cl_good(icy)=1                    
             nply=npl(VIEW(icy))  
             nldy=nld(MAXS(icy),VIEW(icy))  
               
 *     ----------------------------------------------  
 *     CONDITION TO FORM A COUPLE  
 *     ----------------------------------------------  
 *     geometrical consistency (same plane and ladder)  
             if(nply.eq.nplx.and.nldy.eq.nldx)then  
 *     charge correlation  
 *     ===========================================================  
 *     this version of the subroutine is used for the calibration  
 *     thus charge-correlation selection is obviously removed  
 *     ===========================================================  
 c$$$               ddd=(dedx(icy)  
 c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  
 c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)  
 c$$$               cut=chcut*sch(nplx,nldx)  
 c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent  
 *     ===========================================================  
1840                                
1841                   nplx=npl(VIEW(icl))
1842    *     ------------------> (FAKE) COUPLE <-----------------
1843                   ncp_plane(nplx) = ncp_plane(nplx) + 1
1844                   clx(nplx,ncp_plane(nplx))=icl
1845                   cly(nplx,ncp_plane(nplx))=0
1846    c$$$  cl_single(icl)=0! I leave the cluster tagged as singlet!!!
1847    *     ----------------------------------------------------
1848                                
1849  *     ------------------> COUPLE <------------------              else                !=== Y views
1850  *     check to do not overflow vector dimentions  *     ----------------------------------------------------
1851                 if(ncp_plane(nplx).gt.ncouplemax)then  *     cut on charge (Y VIEW)
1852                    if(DEBUG)print*,  *     ----------------------------------------------------
1853       $                    ' ** warning ** number of identified'//                 if(sgnl(icl).lt.dedx_y_min) goto 21
      $                    ' couples on plane ',nplx,  
      $                    ' exceeds vector dimention'//  
      $                    ' ( ',ncouplemax,' )'  
 c     good2=.false.  
 c     goto 880   !fill ntp and go to next event  
                   iflag=1  
                   return  
                endif  
1854                                
1855                 if(ncp_plane(nplx).eq.ncouplemax)then                 nply=npl(VIEW(icl))
1856                    if(DEBUG)print*,  *     ------------------> (FAKE) COUPLE <-----------------
1857       $                 '** warning ** number of identified '//                 ncp_plane(nply) = ncp_plane(nply) + 1
1858       $                 'couples on plane ',nplx,                 clx(nply,ncp_plane(nply))=0
1859       $                 'exceeds vector dimention '                 cly(nply,ncp_plane(nply))=icl
1860       $                 ,'( ',ncouplemax,' )'  c$$$  cl_single(icl)=0! I leave the cluster tagged as singlet!!!
1861  c     good2=.false.  *     ----------------------------------------------------
 c     goto 880   !fill ntp and go to next event                      
                   iflag=1  
                   return  
                endif  
1862                                
1863                 ncp_plane(nplx) = ncp_plane(nplx) + 1              endif
1864                 clx(nplx,ncp_plane(nplx))=icx           endif                  !end "single" condition
1865                 cly(nply,ncp_plane(nplx))=icy   21      continue
1866                 cl_single(icx)=0        enddo                     !end loop over clusters
                cl_single(icy)=0  
             endif                                
 *     ----------------------------------------------  
1867    
1868   20         continue        if(DEBUG.EQ.1)
1869           enddo                  !end loop on clusters(Y)       $     print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
1870            
1871   10      continue  
1872        enddo                     !end loop on clusters(X)   81   continue
         
         
       do icl=1,nclstr1  
          if(cl_single(icl).eq.1)then  
             ip=npl(VIEW(icl))  
             ncls(ip)=ncls(ip)+1  
             cls(ip,ncls(ip))=icl  
          endif  
       enddo  
         
         
       if(DEBUG)then  
          print*,'clusters  ',nclstr1  
          print*,'good    ',(cl_good(i),i=1,nclstr1)  
          print*,'singles ',(cl_single(i),i=1,nclstr1)  
          print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)  
       endif  
1873                
1874        do ip=1,6        ncp_tot=0
1875           ncp_tot=ncp_tot+ncp_plane(ip)        do ip=1,NPLANES
1876             ncp_tot = ncp_tot + ncp_plane(ip)
1877        enddo        enddo
1878  c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)        if(DEBUG.EQ.1)
1879               $     print*,'n.couple tot:      ',ncp_tot
       if(ncp_tot.gt.ncp_max)then  
          if(DEBUG)print*,  
      $           '** warning ** number of identified '//  
      $           'couples exceeds upper limit for Hough tr. '  
      $           ,'( ',ncp_max,' )'              
 c            good2=.false.  
 c     goto 880       !fill ntp and go to next event  
          iflag=1  
          return  
       endif  
1880                
1881        return        return
1882        end        end
   
 c$$$      subroutine cl_to_couples_2(iflag)  
 c$$$  
 c$$$      include 'commontracker.f'  
 c$$$      include 'common_momanhough.f'  
 c$$$      include 'momanhough_init.f'  
 c$$$      include 'calib.f'  
 c$$$      include 'level1.f'  
 c$$$  
 c$$$      logical DEBUG  
 c$$$      common/dbg/DEBUG  
 c$$$  
 c$$$*     output flag  
 c$$$*     --------------  
 c$$$*     0 = good event  
 c$$$*     1 = bad event  
 c$$$*     --------------  
 c$$$      integer iflag  
 c$$$  
 c$$$      integer badseed,badcl  
 c$$$  
 c$$$*     init variables  
 c$$$      ncp_tot=0  
 c$$$      do ip=1,nplanes  
 c$$$         do ico=1,ncouplemax  
 c$$$            clx(ip,ico)=0  
 c$$$            cly(ip,ico)=0  
 c$$$         enddo  
 c$$$         ncp_plane(ip)=0  
 c$$$         do icl=1,nclstrmax_level2  
 c$$$            cls(ip,icl)=1  
 c$$$         enddo  
 c$$$         ncls(ip)=0  
 c$$$      enddo  
 c$$$      do icl=1,nclstrmax_level2  
 c$$$         cl_single(icl)=1  
 c$$$         cl_good(icl)=0  
 c$$$      enddo  
 c$$$        
 c$$$*     start association  
 c$$$      ncouples=0  
 c$$$      do icx=1,nclstr1          !loop on cluster (X)  
 c$$$         if(mod(VIEW(icx),2).eq.1)goto 10  
 c$$$          
 c$$$*     ----------------------------------------------------  
 c$$$*     cut on charge (X VIEW)  
 c$$$         if(dedx(icx).lt.dedx_x_min)then  
 c$$$            cl_single(icx)=0  
 c$$$            goto 10  
 c$$$         endif  
 c$$$*     cut BAD (X VIEW)              
 c$$$         badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))  
 c$$$         ifirst=INDSTART(icx)  
 c$$$         if(icx.ne.nclstr1) then  
 c$$$            ilast=INDSTART(icx+1)-1  
 c$$$         else  
 c$$$            ilast=TOTCLLENGTH  
 c$$$         endif  
 c$$$         badcl=badseed  
 c$$$         do igood=-ngoodstr,ngoodstr  
 c$$$            ibad=1  
 c$$$            if((INDMAX(icx)+igood).gt.ifirst.and.  
 c$$$     $           (INDMAX(icx)+igood).lt.ilast.and.  
 c$$$     $           .true.)then  
 c$$$               ibad=BAD(VIEW(icx),  
 c$$$     $              nvk(MAXS(icx)+igood),  
 c$$$     $              nst(MAXS(icx)+igood))  
 c$$$            endif  
 c$$$            badcl=badcl*ibad  
 c$$$         enddo  
 c$$$*         print*,'icx ',icx,badcl  
 c$$$         if(badcl.eq.0)then  
 c$$$            cl_single(icx)=0  
 c$$$            goto 10  
 c$$$         endif  
 c$$$*     ----------------------------------------------------  
 c$$$          
 c$$$         cl_good(icx)=1  
 c$$$         nplx=npl(VIEW(icx))  
 c$$$         nldx=nld(MAXS(icx),VIEW(icx))  
 c$$$          
 c$$$         do icy=1,nclstr1       !loop on cluster (Y)  
 c$$$            if(mod(VIEW(icy),2).eq.0)goto 20  
 c$$$              
 c$$$*     ----------------------------------------------------  
 c$$$*     cut on charge (Y VIEW)  
 c$$$            if(dedx(icy).lt.dedx_y_min)then  
 c$$$               cl_single(icy)=0  
 c$$$               goto 20  
 c$$$            endif  
 c$$$*     cut BAD (Y VIEW)              
 c$$$            badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))  
 c$$$            ifirst=INDSTART(icy)  
 c$$$            if(icy.ne.nclstr1) then  
 c$$$               ilast=INDSTART(icy+1)-1  
 c$$$            else  
 c$$$               ilast=TOTCLLENGTH  
 c$$$            endif  
 c$$$            badcl=badseed  
 c$$$            do igood=-ngoodstr,ngoodstr  
 c$$$               ibad=1  
 c$$$               if((INDMAX(icy)+igood).gt.ifirst.and.  
 c$$$     $              (INDMAX(icy)+igood).lt.ilast.and.  
 c$$$     $              .true.)  
 c$$$     $              ibad=BAD(VIEW(icy),  
 c$$$     $              nvk(MAXS(icy)+igood),  
 c$$$     $              nst(MAXS(icy)+igood))  
 c$$$               badcl=badcl*ibad  
 c$$$            enddo  
 c$$$*            print*,'icy ',icy,badcl  
 c$$$            if(badcl.eq.0)then  
 c$$$               cl_single(icy)=0  
 c$$$               goto 20  
 c$$$            endif  
 c$$$*     ----------------------------------------------------  
 c$$$              
 c$$$              
 c$$$            cl_good(icy)=1                    
 c$$$            nply=npl(VIEW(icy))  
 c$$$            nldy=nld(MAXS(icy),VIEW(icy))  
 c$$$              
 c$$$*     ----------------------------------------------  
 c$$$*     CONDITION TO FORM A COUPLE  
 c$$$*     ----------------------------------------------  
 c$$$*     geometrical consistency (same plane and ladder)  
 c$$$            if(nply.eq.nplx.and.nldy.eq.nldx)then  
 c$$$  
 c$$$c$$$*     charge correlation  
 c$$$c$$$               ddd=(dedx(icy)  
 c$$$c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  
 c$$$c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)  
 c$$$c$$$               cut=chcut*sch(nplx,nldx)  
 c$$$c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent  
 c$$$                
 c$$$*     ------------------> COUPLE <------------------  
 c$$$*     check to do not overflow vector dimentions  
 c$$$               if(ncp_plane(nplx).gt.ncouplemax)then  
 c$$$                  if(DEBUG)print*,  
 c$$$     $                    ' ** warning ** number of identified'//  
 c$$$     $                    ' couples on plane ',nplx,  
 c$$$     $                    ' exceeds vector dimention'//  
 c$$$     $                    ' ( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event  
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
 c$$$                
 c$$$               if(ncp_plane(nplx).eq.ncouplemax)then  
 c$$$                  if(DEBUG)print*,  
 c$$$     $                 '** warning ** number of identified '//  
 c$$$     $                 'couples on plane ',nplx,  
 c$$$     $                 'exceeds vector dimention '  
 c$$$     $                 ,'( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event                      
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
 c$$$                
 c$$$               ncp_plane(nplx) = ncp_plane(nplx) + 1  
 c$$$               clx(nplx,ncp_plane(nplx))=icx  
 c$$$               cly(nply,ncp_plane(nplx))=icy  
 c$$$               cl_single(icx)=0  
 c$$$               cl_single(icy)=0  
 c$$$c               print*,'couple ',nplx,ncp_plane(nplx),' --- ',icx,icy  
 c$$$            endif                                
 c$$$*     ----------------------------------------------  
 c$$$  
 c$$$ 20         continue  
 c$$$         enddo                  !end loop on clusters(Y)  
 c$$$          
 c$$$ 10      continue  
 c$$$      enddo                     !end loop on clusters(X)  
 c$$$        
 c$$$        
 c$$$      do icl=1,nclstr1  
 c$$$         if(cl_single(icl).eq.1)then  
 c$$$            ip=npl(VIEW(icl))  
 c$$$            ncls(ip)=ncls(ip)+1  
 c$$$            cls(ip,ncls(ip))=icl  
 c$$$         endif  
 c$$$      enddo  
 c$$$        
 c$$$        
 c$$$      if(DEBUG)then  
 c$$$         print*,'clusters  ',nclstr1  
 c$$$         print*,'good    ',(cl_good(i),i=1,nclstr1)  
 c$$$         print*,'singles ',(cl_single(i),i=1,nclstr1)  
 c$$$         print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)  
 c$$$      endif  
 c$$$        
 c$$$      do ip=1,6  
 c$$$         ncp_tot=ncp_tot+ncp_plane(ip)  
 c$$$      enddo  
 c$$$c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
 c$$$        
 c$$$      if(ncp_tot.gt.ncp_max)then  
 c$$$         if(DEBUG)print*,  
 c$$$     $           '** warning ** number of identified '//  
 c$$$     $           'couples exceeds upper limit for Hough tr. '  
 c$$$     $           ,'( ',ncp_max,' )'              
 c$$$c            good2=.false.  
 c$$$c     goto 880       !fill ntp and go to next event  
 c$$$         iflag=1  
 c$$$         return  
 c$$$      endif  
 c$$$        
 c$$$      return  
 c$$$      end  
1883                
1884  ***************************************************  ***************************************************
1885  *                                                 *  *                                                 *
# Line 2283  c$$$      end Line 1891  c$$$      end
1891  **************************************************  **************************************************
1892    
1893        subroutine cp_to_doubtrip(iflag)        subroutine cp_to_doubtrip(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
1894    
1895        include 'commontracker.f'        include 'commontracker.f'
1896          include 'level1.f'
1897        include 'common_momanhough.f'        include 'common_momanhough.f'
       include 'momanhough_init.f'  
1898        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1899        include 'common_mini_2.f'        include 'common_mini_2.f'
1900        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
1901    
       logical DEBUG  
       common/dbg/DEBUG  
1902    
1903  *     output flag  *     output flag
1904  *     --------------  *     --------------
# Line 2328  c      double precision xm3,ym3,zm3 Line 1930  c      double precision xm3,ym3,zm3
1930        real xc,zc,radius        real xc,zc,radius
1931  *     -----------------------------  *     -----------------------------
1932    
1933          if(DEBUG.EQ.1)print*,'cp_to_doubtrip:'
1934    
1935    *     --------------------------------------------
1936    *     put a limit to the maximum number of couples
1937    *     per plane, in order to apply hough transform
1938    *     (couples recovered during track refinement)
1939    *     --------------------------------------------
1940          do ip=1,nplanes
1941             if(ncp_plane(ip).gt.ncouplelimit)then
1942                mask_view(nviewx(ip)) = mask_view(nviewx(ip)) + 2**7
1943                mask_view(nviewy(ip)) = mask_view(nviewy(ip)) + 2**7
1944             endif
1945          enddo
1946    
1947    
1948        ndblt=0                   !number of doublets        ndblt=0                   !number of doublets
1949        ntrpt=0                   !number of triplets        ntrpt=0                   !number of triplets
1950                
1951        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1
1952           do is1=1,2             !loop on sensors - COPPIA 1  c$$$         print*,'(1) ip ',ip1
1953                c$$$     $        ,mask_view(nviewx(ip1))
1954    c$$$     $        ,mask_view(nviewy(ip1))        
1955             if(  mask_view(nviewx(ip1)).ne.0 .or.
1956         $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
1957             do is1=1,2             !loop on sensors - COPPIA 1            
1958              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
1959                 icx1=clx(ip1,icp1)                 icx1=clx(ip1,icp1)
1960                 icy1=cly(ip1,icp1)                 icy1=cly(ip1,icp1)
1961                  
1962    c$$$               print*,'(1) ip ',ip1,' icp ',icp1
1963    
1964  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
1965                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
1966                   call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
1967                 xm1=xPAM                 xm1=xPAM
1968                 ym1=yPAM                 ym1=yPAM
1969                 zm1=zPAM                                   zm1=zPAM                  
1970  c     print*,'***',is1,xm1,ym1,zm1  
1971                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
1972                    do is2=1,2    !loop on sensors -ndblt COPPIA 2  c$$$                  print*,'(2) ip ',ip2
1973                        c$$$     $                 ,mask_view(nviewx(ip2))
1974    c$$$     $                 ,mask_view(nviewy(ip2))
1975                      if(  mask_view(nviewx(ip2)).ne.0 .or.
1976         $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
1977                      do is2=1,2    !loop on sensors -ndblt COPPIA 2                    
1978                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2
1979                          icx2=clx(ip2,icp2)                          icx2=clx(ip2,icp2)
1980                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
1981    
1982    c$$$                        print*,'(2) ip ',ip2,' icp ',icp2
1983    
1984  c                        call xyz_PAM  c                        call xyz_PAM
1985  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
1986    c                        call xyz_PAM
1987    c     $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)
1988                          call xyz_PAM                          call xyz_PAM
1989       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.,0.,0.)
1990                          xm2=xPAM                          xm2=xPAM
1991                          ym2=yPAM                          ym2=yPAM
1992                          zm2=zPAM                          zm2=zPAM
1993                                                    
1994    *                       ---------------------------------------------------
1995    *                       both couples must have a y-cluster
1996    *                       (condition necessary when in RECOVER_SINGLETS mode)
1997    *                       ---------------------------------------------------
1998                            if(icy1.eq.0.or.icy2.eq.0)goto 111
1999    
2000                            if(cl_used(icy1).ne.0)goto 111
2001                            if(cl_used(icy2).ne.0)goto 111
2002    
2003                            
2004  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2005  *     track parameters on Y VIEW  *     track parameters on Y VIEW
2006  *     (2 couples needed)  *     (2 couples needed)
2007  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2008                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
2009                             if(DEBUG)print*,                             if(verbose.eq.1)print*,
2010       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
2011       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
2012       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
2013  c                           good2=.false.  c     good2=.false.
2014  c                           goto 880 !fill ntp and go to next event  c     goto 880 !fill ntp and go to next event
2015                               do iv=1,12
2016    c     mask_view(iv) = 3
2017                                  mask_view(iv) = mask_view(iv)+ 2**2
2018                               enddo
2019                             iflag=1                             iflag=1
2020                             return                             return
2021                          endif                          endif
2022                            
2023                            
2024    ccc                        print*,'<doublet> ',icp1,icp2
2025    
2026                          ndblt = ndblt + 1                          ndblt = ndblt + 1
2027  *     store doublet info  *     store doublet info
2028                          cpyz1(ndblt)=id_cp(ip1,icp1,is1)                          cpyz1(ndblt)=id_cp(ip1,icp1,is1)
# Line 2381  c                           goto 880 !fi Line 2031  c                           goto 880 !fi
2031                          alfayz2(ndblt)=(ym1-ym2)/(zm1-zm2)                          alfayz2(ndblt)=(ym1-ym2)/(zm1-zm2)
2032  *     y0 (cm)  *     y0 (cm)
2033                          alfayz1(ndblt)=alfayz2(ndblt)*(zini-zm1)+ym1                          alfayz1(ndblt)=alfayz2(ndblt)*(zini-zm1)+ym1
2034                                                      
2035  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2036  ****  reject non phisical couples                    ****  ****  reject non phisical couples                    ****
2037  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2038                            if(SECOND_SEARCH)goto 111
2039                          if(                          if(
2040       $                       abs(alfayz2(ndblt)).gt.alfyz2_max       $                       abs(alfayz2(ndblt)).gt.alfyz2_max
2041       $                       .or.       $                       .or.
2042       $                       abs(alfayz1(ndblt)).gt.alfyz1_max       $                       abs(alfayz1(ndblt)).gt.alfyz1_max
2043       $                       )ndblt = ndblt-1       $                       )ndblt = ndblt-1
2044                                                    
2045  c$$$      if(iev.eq.33)then                          
2046  c$$$      print*,'********* ',ndblt,' -- ',icp1,icp2,is1,is2   111                    continue
 c$$$     $        ,' || ',icx1,icy1,icx2,icy2  
 c$$$     $        ,' || ',xm1,ym1,xm2,ym2  
 c$$$     $        ,' || ',alfayz2(ndblt),alfayz1(ndblt)  
 c$$$      endif  
 c$$$  
2047  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2048  *     track parameters on Y VIEW - end  *     track parameters on Y VIEW - end
2049  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2050    
2051    
2052                          if(ip2.eq.nplanes)goto 30 !no possible combination with 3 couples                          if(icx1.ne.0)then
2053                               if(cl_used(icx1).ne.0)goto 31
2054                            endif
2055                            if(icx2.ne.0)then
2056                               if(cl_used(icx2).ne.0)goto 31
2057                            endif
2058    
2059                            if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
2060    
2061                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
2062    c$$$                           print*,'(3) ip ',ip3
2063    c$$$     $                          ,mask_view(nviewx(ip3))
2064    c$$$     $                          ,mask_view(nviewy(ip3))                          
2065                               if(  mask_view(nviewx(ip3)).ne.0 .or.
2066         $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
2067                             do is3=1,2 !loop on sensors - COPPIA 3                             do is3=1,2 !loop on sensors - COPPIA 3
2068                                                                
2069                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
2070                                   icx3=clx(ip3,icp3)                                   icx3=clx(ip3,icp3)
2071                                   icy3=cly(ip3,icp3)                                   icy3=cly(ip3,icp3)
2072    
2073    c$$$                                 print*,'(3) ip ',ip3,' icp ',icp3
2074    
2075    *     ---------------------------------------------------
2076    *     all three couples must have a x-cluster
2077    *     (condition necessary when in RECOVER_SINGLETS mode)
2078    *     ---------------------------------------------------
2079                                     if(
2080         $                                icx1.eq.0.or.
2081         $                                icx2.eq.0.or.
2082         $                                icx3.eq.0.or.
2083         $                                .false.)goto 29
2084                                    
2085                                     if(cl_used(icx1).ne.0)goto 29
2086                                     if(cl_used(icx2).ne.0)goto 29
2087                                     if(cl_used(icx3).ne.0)goto 29
2088    
2089  c                                 call xyz_PAM  c                                 call xyz_PAM
2090  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
2091    c                                 call xyz_PAM
2092    c     $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)
2093                                   call xyz_PAM                                   call xyz_PAM
2094       $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)       $                                (icx3,icy3,is3,PFAdef,PFAdef
2095         $                                ,0.,0.,0.,0.)
2096                                   xm3=xPAM                                   xm3=xPAM
2097                                   ym3=yPAM                                   ym3=yPAM
2098                                   zm3=zPAM                                   zm3=zPAM
2099    
2100    
2101  *     find the circle passing through the three points  *     find the circle passing through the three points
2102                                     iflag_t = DEBUG
2103                                   call tricircle(3,xp,zp,angp,resp,chi                                   call tricircle(3,xp,zp,angp,resp,chi
2104       $                                ,xc,zc,radius,iflag)       $                                ,xc,zc,radius,iflag_t)
 c     print*,xc,zc,radius  
2105  *     the circle must intersect the reference plane  *     the circle must intersect the reference plane
2106                                   if(  cc                                 if(iflag.ne.0)goto 29
2107  c     $                                 (xc.le.-1.*xclimit.or.                                   if(iflag_t.ne.0)then
2108  c     $                                 xc.ge.xclimit).and.  *     if tricircle fails, evaluate a straight line
2109       $                                radius**2.ge.(ZINI-zc)**2.and.                                      if(DEBUG.eq.1)
2110       $                                iflag.eq.0.and.       $                                   print*,'TRICIRCLE failure'
2111       $                                .true.)then       $                                   ,' >>> straight line'
2112                                                                        radius=0.
2113                                        xc=0.
2114                                        yc=0.
2115                                        
2116                                        SZZ=0.                  
2117                                        SZX=0.
2118                                        SSX=0.
2119                                        SZ=0.
2120                                        S1=0.
2121                                        X0=0.
2122                                        Ax=0.
2123                                        BX=0.
2124                                        DO I=1,3
2125                                           XX = XP(I)
2126                                           SZZ=SZZ+ZP(I)*ZP(I)
2127                                           SZX=SZX+ZP(I)*XX
2128                                           SSX=SSX+XX
2129                                           SZ=SZ+ZP(I)
2130                                           S1=S1+1.
2131                                        ENDDO
2132                                        DET=SZZ*S1-SZ*SZ
2133                                        AX=(SZX*S1-SZ*SSX)/DET
2134                                        BX=(SZZ*SSX-SZX*SZ)/DET
2135                                        X0  = AX*ZINI+BX
2136                                        
2137                                     endif
2138    
2139                                     if(  .not.SECOND_SEARCH.and.
2140         $                                radius**2.lt.(ZINI-zc)**2)goto 29
2141                                                                      
2142  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2143  *     track parameters on X VIEW  *     track parameters on X VIEW
2144  *     (3 couples needed)  *     (3 couples needed)
2145  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2146                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
2147                                      if(DEBUG)print*,                                      if(verbose.eq.1)print*,
2148       $                     '** warning ** number of identified '//       $                                   '** warning **'//
2149       $                     'triplets exceeds vector dimention '       $                                   ' number of identified '//
2150       $                    ,'( ',ntrpt_max,' )'       $                                   'triplets exceeds'//
2151  c                                    good2=.false.       $                                   ' vector dimention '
2152  c                                    goto 880 !fill ntp and go to next event       $                                   ,'( ',ntrpt_max,' )'
2153    c     good2=.false.
2154    c     goto 880 !fill ntp and go to next event
2155                                        do iv=1,nviews
2156    c     mask_view(iv) = 4
2157                                           mask_view(iv) =
2158         $                                      mask_view(iv)+ 2**3
2159                                        enddo
2160                                      iflag=1                                      iflag=1
2161                                      return                                      return
2162                                   endif                                   endif
2163    
2164    ccc                                 print*,'<triplet> ',icp1,icp2,icp3
2165                                    
2166                                   ntrpt = ntrpt +1                                   ntrpt = ntrpt +1
2167  *     store triplet info  *     store triplet info
2168                                   cpxz1(ntrpt)=id_cp(ip1,icp1,is1)                                   cpxz1(ntrpt)=id_cp(ip1,icp1,is1)
2169                                   cpxz2(ntrpt)=id_cp(ip2,icp2,is2)                                   cpxz2(ntrpt)=id_cp(ip2,icp2,is2)
2170                                   cpxz3(ntrpt)=id_cp(ip3,icp3,is3)                                   cpxz3(ntrpt)=id_cp(ip3,icp3,is3)
2171                                                                    
2172                                   if(xc.lt.0)then                                   if(radius.ne.0.and.xc.lt.0)then
2173  *************POSITIVE DEFLECTION  *************POSITIVE DEFLECTION
2174                alfaxz1(ntrpt) = xc+sqrt(radius**2-(ZINI-zc)**2)               alfaxz1(ntrpt) = xc+sqrt(radius**2-(ZINI-zc)**2)
2175                alfaxz2(ntrpt) = (ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)               alfaxz2(ntrpt) = (ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)
2176                alfaxz3(ntrpt) = 1/radius               alfaxz3(ntrpt) = 1/radius
2177                                   else                                  else if(radius.ne.0.and.xc.ge.0)then
2178  *************NEGATIVE DEFLECTION  *************NEGATIVE DEFLECTION
2179                alfaxz1(ntrpt) = xc-sqrt(radius**2-(ZINI-zc)**2)               alfaxz1(ntrpt) = xc-sqrt(radius**2-(ZINI-zc)**2)
2180                alfaxz2(ntrpt) = -(ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)               alfaxz2(ntrpt) = -(ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)
2181                alfaxz3(ntrpt) = -1/radius               alfaxz3(ntrpt) = -1/radius
2182                                   endif                                  else if(radius.eq.0)then
2183                                    *************straight fit
2184                 alfaxz1(ntrpt) = X0
2185                 alfaxz2(ntrpt) = AX
2186                 alfaxz3(ntrpt) = 0.
2187                                    endif
2188    
2189    c$$$                                print*,'alfaxz1 ', alfaxz1(ntrpt)
2190    c$$$                                print*,'alfaxz2 ', alfaxz2(ntrpt)
2191    c$$$                                print*,'alfaxz3 ', alfaxz3(ntrpt)
2192                                        
2193  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2194  ****  reject non phisical triplets                   ****  ****  reject non phisical triplets                   ****
2195  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2196                                   if(                                  if(SECOND_SEARCH)goto 29
2197       $                                abs(alfaxz2(ntrpt)).gt.alfxz2_max                                  if(
2198       $                                .or.       $                               abs(alfaxz2(ntrpt)).gt.
2199       $                                abs(alfaxz1(ntrpt)).gt.alfxz1_max       $                               alfxz2_max
2200       $                                )ntrpt = ntrpt-1       $                               .or.
2201                                         $                               abs(alfaxz1(ntrpt)).gt.
2202                                         $                               alfxz1_max
2203  c     print*,alfaxz1(ntrpt),alfaxz2(ntrpt),alfaxz3(ntrpt)       $                               )ntrpt = ntrpt-1
2204                                                                    
2205  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2206  *     track parameters on X VIEW - end  *     track parameters on X VIEW - end
2207  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2208                                endif                                
2209     29                           continue
2210                             enddo !end loop on COPPIA 3                             enddo !end loop on COPPIA 3
2211                          enddo   !end loop on sensors - COPPIA 3                          enddo   !end loop on sensors - COPPIA 3
2212     30                     continue
2213                       enddo      !end loop on planes  - COPPIA 3                       enddo      !end loop on planes  - COPPIA 3
2214   30                  continue  
2215                         31                  continue                    
2216   1                enddo         !end loop on COPPIA 2  c 1                enddo         !end loop on COPPIA 2
2217                     enddo         !end loop on COPPIA 2
2218                 enddo            !end loop on sensors - COPPIA 2                 enddo            !end loop on sensors - COPPIA 2
2219     20            continue
2220              enddo               !end loop on planes  - COPPIA 2              enddo               !end loop on planes  - COPPIA 2
2221                
2222    c 11         continue
2223              continue
2224           enddo                  !end loop on COPPIA1           enddo                  !end loop on COPPIA1
2225        enddo                     !end loop on sensors - COPPIA 1        enddo                     !end loop on sensors - COPPIA 1
2226     10   continue
2227        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
2228                
2229        if(DEBUG)then        if(DEBUG.EQ.1)then
2230           print*,'--- doublets ',ndblt           print*,'--- doublets ',ndblt
2231           print*,'--- triplets ',ntrpt           print*,'--- triplets ',ntrpt
2232        endif        endif
# Line 2514  c     goto 880               !ntp fill Line 2251  c     goto 880               !ntp fill
2251        subroutine doub_to_YZcloud(iflag)        subroutine doub_to_YZcloud(iflag)
2252    
2253        include 'commontracker.f'        include 'commontracker.f'
2254          include 'level1.f'
2255        include 'common_momanhough.f'        include 'common_momanhough.f'
2256        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2257    
       logical DEBUG  
       common/dbg/DEBUG  
2258    
2259  *     output flag  *     output flag
2260  *     --------------  *     --------------
# Line 2537  c     goto 880               !ntp fill Line 2273  c     goto 880               !ntp fill
2273        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2274        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2275    
2276          if(DEBUG.EQ.1)print*,'doub_to_YZcloud:'
2277    
2278  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2279  *     classification of DOUBLETS  *     classification of DOUBLETS
# Line 2550  c     goto 880               !ntp fill Line 2287  c     goto 880               !ntp fill
2287        distance=0        distance=0
2288        nclouds_yz=0              !number of clouds        nclouds_yz=0              !number of clouds
2289        npt_tot=0        npt_tot=0
2290          nloop=0                  
2291     90   continue                  
2292        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2293           if(db_used(idb1).eq.1)goto 2228 !db already included in a cloud           if(db_used(idb1).eq.1)goto 2228 !db already included in a cloud
2294                            
 c     print*,'--------------'  
 c     print*,'** ',idb1,' **'  
               
2295           do icp=1,ncp_tot           do icp=1,ncp_tot
2296              cp_useds1(icp)=0    !init              cp_useds1(icp)=0    !init
2297              cp_useds2(icp)=0    !init              cp_useds2(icp)=0    !init
# Line 2591  ccccc if(db_used(idbref).eq.1)goto 1188 Line 2327  ccccc if(db_used(idbref).eq.1)goto 1188
2327  *     doublet distance in parameter space  *     doublet distance in parameter space
2328                 distance=                 distance=
2329       $              ((alfayz1(idbref)-alfayz1(idb2))/Dalfayz1)**2       $              ((alfayz1(idbref)-alfayz1(idb2))/Dalfayz1)**2
2330       $              +((alfayz2(idbref)-alfayz2(idb2))/Dalfayz2)**2                     $              +((alfayz2(idbref)-alfayz2(idb2))/Dalfayz2)**2
2331                 distance = sqrt(distance)                 distance = sqrt(distance)
2332                                
 c$$$      if(iev.eq.33)then  
 c$$$      if(distance.lt.100)  
 c$$$     $ print*,'********* ',idb1,idbref,idb2,distance  
 c$$$      if(distance.lt.100)  
 c$$$     $ print*,'********* ',alfayz1(idbref),alfayz1(idb2)  
 c$$$     $                    ,alfayz2(idbref),alfayz2(idb2)  
 c$$$      endif  
2333                 if(distance.lt.cutdistyz)then                 if(distance.lt.cutdistyz)then
2334    
 c     print*,idb1,idb2,distance,' cloud ',nclouds_yz  
2335                    if(cpyz1(idb2).gt.0)cp_useds2(cpyz1(idb2))=1                    if(cpyz1(idb2).gt.0)cp_useds2(cpyz1(idb2))=1
2336                    if(cpyz1(idb2).lt.0)cp_useds1(-cpyz1(idb2))=1                    if(cpyz1(idb2).lt.0)cp_useds1(-cpyz1(idb2))=1
2337                    if(cpyz2(idb2).gt.0)cp_useds2(cpyz2(idb2))=1                    if(cpyz2(idb2).gt.0)cp_useds2(cpyz2(idb2))=1
# Line 2619  c     print*,idb1,idb2,distance,' cloud Line 2347  c     print*,idb1,idb2,distance,' cloud
2347    
2348                    temp1 = temp1 + alfayz1(idb2)                    temp1 = temp1 + alfayz1(idb2)
2349                    temp2 = temp2 + alfayz2(idb2)                    temp2 = temp2 + alfayz2(idb2)
 c     print*,'*   idbref,idb2 ',idbref,idb2  
2350                 endif                               endif              
2351                                
2352   1118          continue   1118          continue
2353              enddo               !end loop (2) on DOUBLETS              enddo               !end loop (2) on DOUBLETS
2354                            
2355   1188       continue  c 1188       continue
2356                continue
2357           enddo                  !end loop on... bo?           enddo                  !end loop on... bo?
2358                    
2359           nptloop=npv           nptloop=npv
# Line 2642  c     print*,'*   idbref,idb2 ',idbref,i Line 2370  c     print*,'*   idbref,idb2 ',idbref,i
2370           enddo           enddo
2371           ncpused=0           ncpused=0
2372           do icp=1,ncp_tot           do icp=1,ncp_tot
2373              if(cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0)then              if(
2374         $           (cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0).and.
2375         $           .true.)then
2376                 ncpused=ncpused+1                 ncpused=ncpused+1
2377                 ip=ip_cp(icp)                 ip=ip_cp(icp)
2378                 hit_plane(ip)=1                 hit_plane(ip)=1
# Line 2652  c     print*,'*   idbref,idb2 ',idbref,i Line 2382  c     print*,'*   idbref,idb2 ',idbref,i
2382           do ip=1,nplanes           do ip=1,nplanes
2383              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2384           enddo           enddo
2385  c     print*,'>>>> ',ncpused,npt,nplused          
          if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  
          if(npt.lt.nptyz_min)goto 2228 !next doublet  
2386           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2387                    
2388  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2389  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2390    
2391           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2392              if(DEBUG)print*,              if(verbose.eq.1)print*,
2393       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2394       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2395       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2396  c               good2=.false.  c               good2=.false.
2397  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2398                do iv=1,nviews
2399    c               mask_view(iv) = 5
2400                   mask_view(iv) = mask_view(iv) + 2**4
2401                enddo
2402              iflag=1              iflag=1
2403              return              return
2404           endif           endif
# Line 2682  c     goto 880         !fill ntp and go Line 2414  c     goto 880         !fill ntp and go
2414  c     ptcloud_yz_nt(nclouds_yz)=npt  c     ptcloud_yz_nt(nclouds_yz)=npt
2415           do ipt=1,npt           do ipt=1,npt
2416              db_cloud(npt_tot+ipt) = db_all(ipt)              db_cloud(npt_tot+ipt) = db_all(ipt)
 c     print*,'>> ',ipt,db_all(ipt)  
2417           enddo             enddo  
2418           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2419           if(DEBUG)then           if(DEBUG.EQ.1)then
             print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'  
2420              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'
2421              print*,'- alfayz1 ',alfayz1_av(nclouds_yz)              print*,'- alfayz1  ',alfayz1_av(nclouds_yz)
2422              print*,'- alfayz2 ',alfayz2_av(nclouds_yz)              print*,'- alfayz2  ',alfayz2_av(nclouds_yz)
2423              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2424              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2425              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'cpcloud_yz '
2426  c$$$            print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '       $           ,(cpcloud_yz(nclouds_yz,icp),icp=1,ncp_tot)
2427  c$$$     $           ,ptcloud_yz(nclouds_yz)              print*,'hit_plane  ',(hit_plane(ip),ip=1,nplanes)
 c$$$            print*,'nt-uple: db_cloud(...) = '  
 c$$$     $           ,(db_cloud(iii),iii=npt_tot-npt+1,npt_tot)  
2428           endif           endif
2429  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2430  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
# Line 2704  c$$$     $           ,(db_cloud(iii),iii Line 2432  c$$$     $           ,(db_cloud(iii),iii
2432        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2433                
2434                
2435        if(DEBUG)then        if(nloop.lt.nstepy)then      
2436           print*,'---------------------- '          cutdistyz = cutdistyz+cutystep
2437            nloop     = nloop+1          
2438            goto 90                
2439          endif                    
2440          
2441          if(DEBUG.EQ.1)then
2442           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
          print*,' '  
2443        endif        endif
2444                
2445                
# Line 2730  c$$$     $           ,(db_cloud(iii),iii Line 2462  c$$$     $           ,(db_cloud(iii),iii
2462        subroutine trip_to_XZcloud(iflag)        subroutine trip_to_XZcloud(iflag)
2463    
2464        include 'commontracker.f'        include 'commontracker.f'
2465          include 'level1.f'
2466        include 'common_momanhough.f'        include 'common_momanhough.f'
2467        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2468    
       logical DEBUG  
       common/dbg/DEBUG  
2469    
2470  *     output flag  *     output flag
2471  *     --------------  *     --------------
# Line 2754  c$$$     $           ,(db_cloud(iii),iii Line 2485  c$$$     $           ,(db_cloud(iii),iii
2485        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2486        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2487    
2488          if(DEBUG.EQ.1)print*,'trip_to_XZcloud:'
2489    
2490  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2491  *     classification of TRIPLETS  *     classification of TRIPLETS
2492  *     according to distance in parameter space  *     according to distance in parameter space
# Line 2765  c$$$     $           ,(db_cloud(iii),iii Line 2498  c$$$     $           ,(db_cloud(iii),iii
2498        distance=0        distance=0
2499        nclouds_xz=0              !number of clouds                nclouds_xz=0              !number of clouds        
2500        npt_tot=0                 !total number of selected triplets        npt_tot=0                 !total number of selected triplets
2501          nloop=0                  
2502     91   continue                  
2503        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2504           if(tr_used(itr1).eq.1)goto 22288 !already included in a cloud           if(tr_used(itr1).eq.1)goto 22288 !already included in a cloud
 c     print*,'--------------'  
 c     print*,'** ',itr1,' **'  
2505                    
2506           do icp=1,ncp_tot           do icp=1,ncp_tot
2507              cp_useds1(icp)=0              cp_useds1(icp)=0
# Line 2802  c         tr_temp(1)=itr1 Line 2535  c         tr_temp(1)=itr1
2535              do itr2=1,ntrpt     !loop (2) on TRIPLETS              do itr2=1,ntrpt     !loop (2) on TRIPLETS
2536                 if(itr2.eq.itr1)goto 11188       !next triplet                 if(itr2.eq.itr1)goto 11188       !next triplet
2537                 if(tr_used(itr2).eq.1)goto 11188 !next triplet                               if(tr_used(itr2).eq.1)goto 11188 !next triplet              
2538    
2539    
2540  *     triplet distance in parameter space  *     triplet distance in parameter space
2541  *     solo i due parametri spaziali per il momemnto  *     solo i due parametri spaziali per il momemnto
2542                 distance=                 distance=
2543       $              ((alfaxz1(itrref)-alfaxz1(itr2))/Dalfaxz1)**2       $              ((alfaxz1(itrref)-alfaxz1(itr2))/Dalfaxz1)**2
2544       $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2                     $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2
2545                 distance = sqrt(distance)                 distance = sqrt(distance)
2546                  
2547                 if(distance.lt.cutdistxz)then  
2548  c     print*,idb1,idb2,distance,' cloud ',nclouds_yz  *     ------------------------------------------------------------------------
2549    *     FORCE INCLUSION OF TRIPLETS COMPOSED BY SAME COUPLES, IGNORING THE IMAGE
2550    *     ------------------------------------------------------------------------
2551    *     (added in august 2007)
2552                   istrimage=0
2553                   if(
2554         $              abs(cpxz1(itrref)).eq.abs(cpxz1(itr2)).and.
2555         $              abs(cpxz2(itrref)).eq.abs(cpxz2(itr2)).and.
2556         $              abs(cpxz3(itrref)).eq.abs(cpxz3(itr2)).and.
2557         $              .true.)istrimage=1
2558    
2559                   if(distance.lt.cutdistxz.or.istrimage.eq.1)then
2560                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1
2561                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1
2562                    if(cpxz2(itr2).gt.0)cp_useds2(cpxz2(itr2))=1                    if(cpxz2(itr2).gt.0)cp_useds2(cpxz2(itr2))=1
# Line 2829  c     print*,idb1,idb2,distance,' cloud Line 2575  c     print*,idb1,idb2,distance,' cloud
2575                    temp1 = temp1 + alfaxz1(itr2)                    temp1 = temp1 + alfaxz1(itr2)
2576                    temp2 = temp2 + alfaxz2(itr2)                    temp2 = temp2 + alfaxz2(itr2)
2577                    temp3 = temp3 + alfaxz3(itr2)                    temp3 = temp3 + alfaxz3(itr2)
 c     print*,'*   itrref,itr2 ',itrref,itr2,distance  
2578                 endif                               endif              
2579                                
2580  11188          continue  11188          continue
2581              enddo               !end loop (2) on TRIPLETS              enddo               !end loop (2) on TRIPLETS
2582                                                
2583  11888       continue  c11888       continue
2584                continue
2585           enddo                  !end loop on... bo?               enddo                  !end loop on... bo?    
2586                    
2587           nptloop=npv           nptloop=npv
# Line 2850  c     print*,'*   itrref,itr2 ',itrref,i Line 2596  c     print*,'*   itrref,itr2 ',itrref,i
2596  *     1bis)  *     1bis)
2597  *     2) it is not already stored  *     2) it is not already stored
2598  *     ------------------------------------------  *     ------------------------------------------
 c     print*,'check cp_used'  
2599           do ip=1,nplanes           do ip=1,nplanes
2600              hit_plane(ip)=0              hit_plane(ip)=0
2601           enddo           enddo
2602           ncpused=0           ncpused=0
2603           do icp=1,ncp_tot           do icp=1,ncp_tot
2604              if(cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0)then              if(
2605         $           (cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0).and.
2606         $           .true.)then
2607                 ncpused=ncpused+1                 ncpused=ncpused+1
2608                 ip=ip_cp(icp)                 ip=ip_cp(icp)
2609                 hit_plane(ip)=1                 hit_plane(ip)=1
# Line 2866  c     print*,'check cp_used' Line 2613  c     print*,'check cp_used'
2613           do ip=1,nplanes           do ip=1,nplanes
2614              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2615           enddo           enddo
2616           if(ncpused.lt.ncpxz_min)goto 22288 !next triplet           if(nplused.lt.nplxz_min)goto 22288 !next triplet
          if(npt.lt.nptxz_min)goto 22288     !next triplet  
          if(nplused.lt.nplxz_min)goto 22288 !next doublet  
2617                    
2618  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2619  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2620           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2621              if(DEBUG)print*,              if(verbose.eq.1)print*,
2622       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2623       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2624       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2625  c     good2=.false.  c     good2=.false.
2626  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2627                do iv=1,nviews
2628    c               mask_view(iv) = 6
2629                   mask_view(iv) =  mask_view(iv) + 2**5
2630                enddo
2631              iflag=1              iflag=1
2632              return              return
2633           endif           endif
# Line 2896  c     goto 880         !fill ntp and go Line 2645  c     goto 880         !fill ntp and go
2645           enddo           enddo
2646           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2647                    
2648           if(DEBUG)then           if(DEBUG.EQ.1)then
2649              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'              print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'
2650              print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'                            print*,'- alfaxz1  ',alfaxz1_av(nclouds_xz)
2651              print*,'- alfaxz1 ',alfaxz1_av(nclouds_xz)              print*,'- alfaxz2  ',alfaxz2_av(nclouds_xz)
2652              print*,'- alfaxz2 ',alfaxz2_av(nclouds_xz)              print*,'- alfaxz3  ',alfaxz3_av(nclouds_xz)
2653              print*,'- alfaxz3 ',alfaxz3_av(nclouds_xz)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2654              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2655              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cpcloud_xz '
2656         $           ,(cpcloud_xz(nclouds_xz,icp),icp=1,ncp_tot)
2657              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)
 c$$$            print*,'nt-uple: ptcloud_xz(',nclouds_xz,') = '  
 c$$$     $           ,ptcloud_xz(nclouds_xz)  
 c$$$            print*,'nt-uple: tr_cloud(...) = '  
 c$$$     $           ,(tr_cloud(iii),iii=npt_tot-npt+1,npt_tot)  
2658           endif           endif
2659  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2660  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2661  22288    continue  22288    continue
2662        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2663          
2664        if(DEBUG)then         if(nloop.lt.nstepx)then      
2665           print*,'---------------------- '           cutdistxz=cutdistxz+cutxstep
2666             nloop=nloop+1          
2667             goto 91                
2668           endif                    
2669          
2670          if(DEBUG.EQ.1)then
2671           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
          print*,' '  
2672        endif        endif
2673                
2674                
# Line 2936  c$$$     $           ,(tr_cloud(iii),iii Line 2686  c$$$     $           ,(tr_cloud(iii),iii
2686  **************************************************  **************************************************
2687    
2688        subroutine clouds_to_ctrack(iflag)        subroutine clouds_to_ctrack(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2689    
2690        include 'commontracker.f'        include 'commontracker.f'
2691          include 'level1.f'
2692        include 'common_momanhough.f'        include 'common_momanhough.f'
2693        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2694        include 'common_mini_2.f'        include 'common_mini_2.f'
2695        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
2696    
2697        logical DEBUG  
       common/dbg/DEBUG  
2698    
2699  *     output flag  *     output flag
2700  *     --------------  *     --------------
# Line 2964  c*************************************** Line 2710  c***************************************
2710  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2711  *     list of matching couples in the combination  *     list of matching couples in the combination
2712  *     between a XZ and YZ cloud  *     between a XZ and YZ cloud
2713        integer cp_match(nplanes,ncouplemax)        integer cp_match(nplanes,2*ncouplemax)
2714        integer ncp_match(nplanes)        integer ncp_match(nplanes)
2715  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2716        integer hit_plane(nplanes)        integer hit_plane(nplanes)
2717  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2718  *     variables for track fitting  *     variables for track fitting
2719        double precision AL_INI(5)        double precision AL_INI(5)
       double precision tath  
2720  *     -----------------------------------------------------------  *     -----------------------------------------------------------
 c      real fitz(nplanes)        !z coordinates of the planes in cm  
2721    
2722          if(DEBUG.EQ.1)print*,'clouds_to_ctrack:'
2723    
2724    
2725        ntracks=0                 !counter of track candidates        ntracks=0                 !counter of track candidates
2726                
2727        do iyz=1,nclouds_yz       !loop on YZ couds        do iyz=1,nclouds_yz       !loop on YZ clouds
2728           do ixz=1,nclouds_xz    !loop on XZ couds           do ixz=1,nclouds_xz    !loop on XZ clouds
2729                            
2730  *     --------------------------------------------------  *     --------------------------------------------------
2731  *     check of consistency of the clouds  *     check of consistency of the clouds
# Line 2989  c      real fitz(nplanes)        !z coor Line 2734  c      real fitz(nplanes)        !z coor
2734  *     of the two clouds  *     of the two clouds
2735  *     --------------------------------------------------  *     --------------------------------------------------
2736              do ip=1,nplanes              do ip=1,nplanes
2737                 hit_plane(ip)=0                 hit_plane(ip)=0  !n.matching couples (REAL couples, not SINGLETS)
2738                 ncp_match(ip)=0                 ncp_match(ip)=0  !n.matching couples per plane
2739                 do icpp=1,ncouplemax                 do icpp=1,ncouplemax
2740                    cp_match(ip,icpp)=0 !init couple list                    cp_match(ip,icpp)=0 !init couple list
2741                 enddo                 enddo
2742              enddo              enddo
2743              ncp_ok=0              ncp_ok=0            !count n.matching-couples
2744              do icp=1,ncp_tot    !loop on couples              ncpx_ok=0           !count n.matching-couples with x cluster
2745  *     get info on              ncpy_ok=0           !count n.matching-couples with y cluster
2746                 cpintersec(icp)=min(  
2747       $              cpcloud_yz(iyz,icp),  
2748       $              cpcloud_xz(ixz,icp))              do icp=1,ncp_tot    !loop over couples
2749                 if(  
2750       $    (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.                 if(.not.RECOVER_SINGLETS)then
2751       $    (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.  *     ------------------------------------------------------
2752       $              .false.)cpintersec(icp)=0  *     if NOT in RECOVER_SINGLETS mode, take the intersection
2753    *     between xz yz clouds
2754    *     ------------------------------------------------------
2755                      cpintersec(icp)=min(
2756         $                 cpcloud_yz(iyz,icp),
2757         $                 cpcloud_xz(ixz,icp))
2758    *     cpintersec is >0 if yz and xz clouds contain the same image of couple icp
2759    *     ------------------------------------------------------
2760    *     discard the couple if the sensor is in conflict
2761    *     ------------------------------------------------------
2762                      if(
2763         $       (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.
2764         $       (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.
2765         $                 .false.)cpintersec(icp)=0
2766                   else
2767    *     ------------------------------------------------------
2768    *     if RECOVER_SINGLETS take the union
2769    *     (otherwise the fake couples formed by singlets would be
2770    *     discarded)    
2771    *     ------------------------------------------------------
2772                      cpintersec(icp)=max(
2773         $                 cpcloud_yz(iyz,icp),
2774         $                 cpcloud_xz(ixz,icp))
2775    c$$$                  if(cpcloud_yz(iyz,icp).gt.0)
2776    c$$$     $                 cpintersec(icp)=cpcloud_yz(iyz,icp)
2777    *     cpintersec is >0 if either yz or xz cloud contains the couple icp
2778                   endif
2779    
2780    c$$$               print*,icp,ip_cp(icp),' -- ',cpintersec(icp)
2781    
2782                 if(cpintersec(icp).ne.0)then                 if(cpintersec(icp).ne.0)then
                   ncp_ok=ncp_ok+1    
2783                                        
2784                    ip=ip_cp(icp)                    ip=ip_cp(icp)
2785                    hit_plane(ip)=1                    hit_plane(ip)=1
2786    c$$$                  if(clx(ip,icp).gt.0.and.cly(ip,icp).gt.0)
2787    c$$$     $                 ncp_ok=ncp_ok+1  
2788    c$$$                  if(clx(ip,icp).gt.0.and.cly(ip,icp).eq.0)
2789    c$$$     $                 ncpx_ok=ncpx_ok+1
2790    c$$$                  if(clx(ip,icp).eq.0.and.cly(ip,icp).gt.0)
2791    c$$$     $                 ncpy_ok=ncpy_ok+1
2792    
2793                      if(  cpcloud_yz(iyz,icp).gt.0.and.
2794         $                 cpcloud_xz(ixz,icp).gt.0)
2795         $                 ncp_ok=ncp_ok+1  
2796                      if(  cpcloud_yz(iyz,icp).gt.0.and.
2797         $                 cpcloud_xz(ixz,icp).eq.0)
2798         $                 ncpy_ok=ncpy_ok+1  
2799                      if(  cpcloud_yz(iyz,icp).eq.0.and.
2800         $                 cpcloud_xz(ixz,icp).gt.0)
2801         $                 ncpx_ok=ncpx_ok+1  
2802    
2803                    if(cpintersec(icp).eq.1)then                    if(cpintersec(icp).eq.1)then
2804  *     1) only the couple image in sensor 1 matches  *     1) only the couple image in sensor 1 matches
2805                       id=-icp                       id=-icp
# Line 3036  c      real fitz(nplanes)        !z coor Line 2826  c      real fitz(nplanes)        !z coor
2826              do ip=1,nplanes              do ip=1,nplanes
2827                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2828              enddo              enddo
2829                                        
2830              if(nplused.lt.nplxz_min)goto 888 !next doublet              if(nplused.lt.3)goto 888 !next combination
2831              if(ncp_ok.lt.ncpok)goto 888 !next cloud  ccc            if(nplused.lt.nplxz_min)goto 888 !next combination
2832                ccc            if(nplused.lt.nplyz_min)goto 888 !next combination
2833              if(DEBUG)then  *     -----------------------------------------------------------
2834                 print*,'Combination ',iyz,ixz  *     if in RECOVER_SINGLET mode, the two clouds must have
2835       $              ,' db ',ptcloud_yz(iyz)  *     at least ONE intersecting real couple
2836       $              ,' tr ',ptcloud_xz(ixz)  *     -----------------------------------------------------------
2837       $              ,'  -----> # matching couples ',ncp_ok              if(ncp_ok.lt.1)goto 888 !next combination
2838              endif  
2839  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'              if(DEBUG.EQ.1)then
2840  c$$$  print*,'Configurazione cluster XZ'                 print*,'////////////////////////////'
2841  c$$$  print*,'1 -- ',(clx(1,i),i=1,ncp_plane(1))                 print*,'Cloud combination (Y,X): ',iyz,ixz
2842  c$$$  print*,'2 -- ',(clx(2,i),i=1,ncp_plane(1))                 print*,' db ',ptcloud_yz(iyz)
2843  c$$$  print*,'3 -- ',(clx(3,i),i=1,ncp_plane(1))                 print*,' tr ',ptcloud_xz(ixz)
2844  c$$$  print*,'4 -- ',(clx(4,i),i=1,ncp_plane(1))                 print*,'  -----> # matching couples ',ncp_ok
2845  c$$$  print*,'5 -- ',(clx(5,i),i=1,ncp_plane(1))                 print*,'  -----> # fake couples (X)',ncpx_ok
2846  c$$$  print*,'6 -- ',(clx(6,i),i=1,ncp_plane(1))                 print*,'  -----> # fake couples (Y)',ncpy_ok
2847  c$$$  print*,'Configurazione cluster YZ'                 do icp=1,ncp_tot
2848  c$$$  print*,'1 -- ',(cly(1,i),i=1,ncp_plane(1))                    print*,'cp ',icp,' >'
2849  c$$$  print*,'2 -- ',(cly(2,i),i=1,ncp_plane(1))       $                 ,' x ',cpcloud_xz(ixz,icp)
2850  c$$$  print*,'3 -- ',(cly(3,i),i=1,ncp_plane(1))       $                 ,' y ',cpcloud_yz(iyz,icp)
2851  c$$$  print*,'4 -- ',(cly(4,i),i=1,ncp_plane(1))       $                 ,' ==> ',cpintersec(icp)
2852  c$$$  print*,'5 -- ',(cly(5,i),i=1,ncp_plane(1))                 enddo
2853  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_plane(1))              endif
2854  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'                          
2855                            if(DEBUG.EQ.1)then
 *     -------> INITIAL GUESS <-------  
             AL_INI(1)=dreal(alfaxz1_av(ixz))  
             AL_INI(2)=dreal(alfayz1_av(iyz))  
             AL_INI(4)=datan(dreal(alfayz2_av(iyz))  
      $           /dreal(alfaxz2_av(ixz)))  
             tath=-dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))  
             AL_INI(3)=tath/sqrt(1+tath**2)  
             AL_INI(5)=(1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.  
               
 c     print*,'*******',AL_INI(5)  
             if(AL_INI(5).gt.defmax)goto 888 !next cloud  
               
 c     print*,'alfaxz2, alfayz2 '  
 c     $              ,alfaxz2_av(ixz),alfayz2_av(iyz)  
               
 *     -------> INITIAL GUESS <-------  
 c     print*,'AL_INI ',(al_ini(i),i=1,5)  
               
             if(DEBUG)then  
2856                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2857                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))
2858                 print*,'3 >>> ',(cp_match(4,i),i=1,ncp_match(4))                 print*,'3 >>> ',(cp_match(4,i),i=1,ncp_match(4))
# Line 3114  c     print*,'AL_INI ',(al_ini(i),i=1,5) Line 2885  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2885                                hit_plane(6)=icp6                                hit_plane(6)=icp6
2886                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6
2887                                                                
2888                                                                if(DEBUG.eq.1)
2889         $                             print*,'combination: '
2890         $                             ,cp_match(6,icp1)
2891         $                             ,cp_match(5,icp2)
2892         $                             ,cp_match(4,icp3)
2893         $                             ,cp_match(3,icp4)
2894         $                             ,cp_match(2,icp5)
2895         $                             ,cp_match(1,icp6)
2896    
2897    
2898    *                             ---------------------------------------
2899    *                             check if this group of couples has been
2900    *                             already fitted    
2901    *                             ---------------------------------------
2902                                  do ica=1,ntracks
2903                                     isthesame=1
2904                                     do ip=1,NPLANES
2905                                        if(hit_plane(ip).ne.0)then
2906                                           if(  CP_STORE(nplanes-ip+1,ica)
2907         $                                      .ne.
2908         $                                      cp_match(ip,hit_plane(ip)) )
2909         $                                      isthesame=0
2910                                        else
2911                                           if(  CP_STORE(nplanes-ip+1,ica)
2912         $                                      .ne.
2913         $                                      0 )
2914         $                                      isthesame=0
2915                                        endif
2916                                     enddo
2917                                     if(isthesame.eq.1)then
2918                                        if(DEBUG.eq.1)
2919         $                                   print*,'(already fitted)'
2920                                        goto 666 !jump to next combination
2921                                     endif
2922                                  enddo
2923    
2924                                call track_init !init TRACK common                                call track_init !init TRACK common
2925    
2926                                do ip=1,nplanes !loop on planes                                do ip=1,nplanes !loop on planes (bottom to top)
2927                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2928                                      id=cp_match(ip,hit_plane(ip))                                      id=cp_match(ip,hit_plane(ip))
2929                                      is=is_cp(id)                                      is=is_cp(id)
# Line 3131  c     print*,'AL_INI ',(al_ini(i),i=1,5) Line 2937  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2937  *                                   *************************  *                                   *************************
2938  c                                    call xyz_PAM(icx,icy,is,  c                                    call xyz_PAM(icx,icy,is,
2939  c     $                                   'COG2','COG2',0.,0.)  c     $                                   'COG2','COG2',0.,0.)
2940    c                                    call xyz_PAM(icx,icy,is, !(1)
2941    c     $                                   PFAdef,PFAdef,0.,0.) !(1)
2942                                      call xyz_PAM(icx,icy,is, !(1)                                      call xyz_PAM(icx,icy,is, !(1)
2943       $                                   PFAdef,PFAdef,0.,0.) !(1)       $                                   PFAdef,PFAdef,0.,0.,0.,0.)
2944  *                                   *************************  *                                   *************************
2945  *                                   -----------------------------  *                                   -----------------------------
2946                                      xgood(nplanes-ip+1)=1.                                      if(icx.gt.0.and.icy.gt.0)then
2947                                      ygood(nplanes-ip+1)=1.                                         xgood(nplanes-ip+1)=1.
2948                                      xm(nplanes-ip+1)=xPAM                                         ygood(nplanes-ip+1)=1.
2949                                      ym(nplanes-ip+1)=yPAM                                         xm(nplanes-ip+1)=xPAM
2950                                      zm(nplanes-ip+1)=zPAM                                         ym(nplanes-ip+1)=yPAM
2951                                      resx(nplanes-ip+1)=resxPAM                                         zm(nplanes-ip+1)=zPAM
2952                                      resy(nplanes-ip+1)=resyPAM                                         resx(nplanes-ip+1)=resxPAM
2953                                           resy(nplanes-ip+1)=resyPAM
2954                                           if(DEBUG.EQ.1)print*,'(X,Y)'
2955         $                                      ,nplanes-ip+1,xPAM,yPAM
2956                                        else
2957                                           xm_A(nplanes-ip+1) = xPAM_A
2958                                           ym_A(nplanes-ip+1) = yPAM_A
2959                                           xm_B(nplanes-ip+1) = xPAM_B
2960                                           ym_B(nplanes-ip+1) = yPAM_B
2961                                           zm(nplanes-ip+1)
2962         $                                      = (zPAM_A+zPAM_B)/2.
2963                                           resx(nplanes-ip+1) = resxPAM
2964                                           resy(nplanes-ip+1) = resyPAM
2965                                           if(icx.eq.0.and.icy.gt.0)then
2966                                              xgood(nplanes-ip+1)=0.
2967                                              ygood(nplanes-ip+1)=1.
2968                                              resx(nplanes-ip+1) = 1000.
2969                                              if(DEBUG.EQ.1)print*,'(  Y)'
2970         $                                         ,nplanes-ip+1,xPAM,yPAM
2971                                           elseif(icx.gt.0.and.icy.eq.0)then
2972                                              xgood(nplanes-ip+1)=1.
2973                                              ygood(nplanes-ip+1)=0.
2974                                              if(DEBUG.EQ.1)print*,'(X  )'
2975         $                                         ,nplanes-ip+1,xPAM,yPAM
2976                                              resy(nplanes-ip+1) = 1000.
2977                                           else
2978                                              print*,'both icx=0 and icy=0'
2979         $                                         ,' ==> IMPOSSIBLE!!'
2980                                           endif
2981                                        endif
2982  *                                   -----------------------------  *                                   -----------------------------
2983                                   endif                                   endif
2984                                enddo !end loop on planes                                enddo !end loop on planes
2985  *     **********************************************************  *     **********************************************************
2986  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
2987  *     **********************************************************  *     **********************************************************
2988    cccc  scommentare se si usa al_ini della nuvola
2989    c$$$                              do i=1,5
2990    c$$$                                 AL(i)=AL_INI(i)
2991    c$$$                              enddo
2992                                  call guess()
2993                                do i=1,5                                do i=1,5
2994                                   AL(i)=AL_INI(i)                                   AL_INI(i)=AL(i)
2995                                enddo                                enddo
2996                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
2997                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
2998                                call mini_2(jstep,ifail)                                iprint=0
2999    c                              if(DEBUG.EQ.1)iprint=1
3000                                  if(DEBUG.EQ.1)iprint=2
3001                                  call mini2(jstep,ifail,iprint)
3002                                if(ifail.ne.0) then                                if(ifail.ne.0) then
3003                                   if(DEBUG)then                                   if(DEBUG.EQ.1)then
3004                                      print *,                                      print *,
3005       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
3006       $                              //'(mini_2 in clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
3007                                        print*,'initial guess: '
3008    
3009                                        print*,'AL_INI(1) = ',AL_INI(1)
3010                                        print*,'AL_INI(2) = ',AL_INI(2)
3011                                        print*,'AL_INI(3) = ',AL_INI(3)
3012                                        print*,'AL_INI(4) = ',AL_INI(4)
3013                                        print*,'AL_INI(5) = ',AL_INI(5)
3014                                   endif                                   endif
3015                                   chi2=-chi2  c                                 chi2=-chi2
3016                                endif                                endif
3017  *     **********************************************************  *     **********************************************************
3018  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
3019  *     **********************************************************  *     **********************************************************
3020    
3021                                if(chi2.le.0.)goto 666                                              if(chi2.le.0.)goto 666              
3022                                  if(chi2.ge.1.e08)goto 666 !OPTIMIZATION
3023                                  if(chi2.ne.chi2)goto 666  !OPTIMIZATION
3024    
3025  *     --------------------------  *     --------------------------
3026  *     STORE candidate TRACK INFO  *     STORE candidate TRACK INFO
3027  *     --------------------------  *     --------------------------
3028                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
3029                                                                    
3030                                   if(DEBUG)print*,                                   if(verbose.eq.1)print*,
3031       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
3032       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
3033       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
3034  c                                 good2=.false.  c                                 good2=.false.
3035  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
3036                                     do iv=1,nviews
3037    c                                    mask_view(iv) = 7
3038                                        mask_view(iv) = mask_view(iv) + 2**6
3039                                     enddo
3040                                   iflag=1                                   iflag=1
3041                                   return                                   return
3042                                endif                                endif
3043                                                                
3044                                ntracks = ntracks + 1                                ntracks = ntracks + 1
3045                                                                
3046  c$$$                              ndof=0                                                                do ip=1,nplanes !top to bottom
3047                                do ip=1,nplanes  
 c$$$                                 ndof=ndof  
 c$$$     $                                +int(xgood(ip))  
 c$$$     $                                +int(ygood(ip))  
3048                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
3049                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
3050                                   ZV_STORE(ip,ntracks)=sngl(zv(ip))                                                                       ZV_STORE(ip,ntracks)=sngl(zv(ip))
3051                                   XM_STORE(ip,ntracks)=sngl(xm(ip))                                   XM_STORE(ip,ntracks)=sngl(xm(ip))
3052                                   YM_STORE(ip,ntracks)=sngl(ym(ip))                                   YM_STORE(ip,ntracks)=sngl(ym(ip))
3053                                   ZM_STORE(ip,ntracks)=sngl(zm(ip))                                   ZM_STORE(ip,ntracks)=sngl(zm(ip))
# Line 3205  c$$$     $                               Line 3060  c$$$     $                              
3060                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))
3061                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))
3062                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))
3063    *                                NB! hit_plane is defined from bottom to top
3064                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
3065                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
3066       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
3067                                        SENSOR_STORE(nplanes-ip+1,ntracks)
3068         $                              = is_cp(cp_match(ip,hit_plane(ip)))
3069                                        
3070                                        icl=
3071         $                                   clx(ip,icp_cp(
3072         $                                   cp_match(ip,hit_plane(ip)
3073         $                                   )));
3074                                        if(icl.eq.0)
3075         $                                   icl=
3076         $                                   cly(ip,icp_cp(
3077         $                                   cp_match(ip,hit_plane(ip)
3078         $                                   )));
3079    
3080                                        LADDER_STORE(nplanes-ip+1,ntracks)
3081         $                                   = LADDER(icl);
3082                                   else                                   else
3083                                      CP_STORE(nplanes-ip+1,ntracks)=0                                      CP_STORE(nplanes-ip+1,ntracks)=0
3084                                        SENSOR_STORE(nplanes-ip+1,ntracks)=0
3085                                        LADDER_STORE(nplanes-ip+1,ntracks)=0
3086                                   endif                                   endif
3087                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   BX_STORE(ip,ntracks)=0!I dont need it now
3088                                     BY_STORE(ip,ntracks)=0!I dont need it now
3089                                     CLS_STORE(ip,ntracks)=0
3090                                   do i=1,5                                   do i=1,5
3091                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
3092                                   enddo                                   enddo
3093                                enddo                                enddo
3094                                                                
 c$$$  *                             Number of Degree Of Freedom  
 c$$$  ndof=ndof-5                            
 c$$$  *                             reduced chi^2  
 c$$$  rchi2=chi2/dble(ndof)  
3095                                RCHI2_STORE(ntracks)=chi2                                RCHI2_STORE(ntracks)=chi2
3096                                                                
3097  *     --------------------------------  *     --------------------------------
# Line 3241  c$$$  rchi2=chi2/dble(ndof) Line 3112  c$$$  rchi2=chi2/dble(ndof)
3112                
3113        if(ntracks.eq.0)then        if(ntracks.eq.0)then
3114           iflag=1           iflag=1
3115           return  cc         return
3116        endif        endif
3117                
3118        if(DEBUG)then        if(DEBUG.EQ.1)then
3119           print*,'****** TRACK CANDIDATES ***********'          print*,'****** TRACK CANDIDATES *****************'
3120           print*,'#         R. chi2        RIG'          print*,'#         R. chi2        RIG         ndof'
3121           do i=1,ntracks          do i=1,ntracks
3122              print*,i,' --- ',rchi2_store(i),' --- '            ndof=0                !(1)
3123       $           ,1./abs(AL_STORE(5,i))            do ii=1,nplanes       !(1)
3124           enddo              ndof=ndof           !(1)
3125           print*,'***********************************'       $           +int(xgood_store(ii,i)) !(1)
3126         $           +int(ygood_store(ii,i)) !(1)
3127              enddo                 !(1)
3128              print*,i,' --- ',rchi2_store(i),' --- '
3129         $         ,1./abs(AL_STORE(5,i)),' --- ',ndof
3130            enddo
3131            print*,'*****************************************'
3132        endif        endif
3133                
3134                
# Line 3270  c$$$  rchi2=chi2/dble(ndof) Line 3147  c$$$  rchi2=chi2/dble(ndof)
3147    
3148        subroutine refine_track(ibest)        subroutine refine_track(ibest)
3149    
 c******************************************************  
 cccccc 06/10/2005 modified by elena vannuccini ---> (1)  
 cccccc 31/01/2006 modified by elena vannuccini ---> (2)  
 c******************************************************  
3150    
3151        include 'commontracker.f'        include 'commontracker.f'
3152          include 'level1.f'
3153        include 'common_momanhough.f'        include 'common_momanhough.f'
3154        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3155        include 'common_mini_2.f'        include 'common_mini_2.f'
3156        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
       include 'level1.f'  
3157        include 'calib.f'        include 'calib.f'
3158    
       logical DEBUG  
       common/dbg/DEBUG  
   
3159  *     flag to chose PFA  *     flag to chose PFA
3160        character*10 PFA        character*10 PFA
3161        common/FINALPFA/PFA        common/FINALPFA/PFA
3162    
3163          real k(6)
3164          DATA k/1.099730,0.418900,0.220939,0.220907,0.418771,1.100674/
3165    
3166          real xp,yp,zp
3167          real xyzp(3),bxyz(3)
3168          equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
3169    
3170          if(DEBUG.EQ.1)print*,'refine_track:'
3171  *     =================================================  *     =================================================
3172  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
3173  *                          and  *                          and
# Line 3299  c*************************************** Line 3176  c***************************************
3176        call track_init        call track_init
3177        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3178    
3179             if(DEBUG.EQ.1)print*,' ........... plane ',ip,' ........... '
3180    
3181             xP=XV_STORE(nplanes-ip+1,ibest)
3182             yP=YV_STORE(nplanes-ip+1,ibest)
3183             zP=ZV_STORE(nplanes-ip+1,ibest)
3184             call gufld(xyzp,bxyz)
3185             BX_STORE(nplanes-ip+1,ibest)=bxyz(1)
3186             BY_STORE(nplanes-ip+1,ibest)=bxyz(2)
3187    c$$$  bxyz(1)=0
3188    c$$$         bxyz(2)=0
3189    c$$$         bxyz(3)=0
3190    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3191  *     -------------------------------------------------  *     -------------------------------------------------
3192  *     If the plane has been already included, it just  *     If the plane has been already included, it just
3193  *     computes again the coordinates of the x-y couple  *     computes again the coordinates of the x-y couple
3194  *     using improved PFAs  *     using improved PFAs
3195  *     -------------------------------------------------  *     -------------------------------------------------
3196           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.  *     |||||||||||||||||||||||||||||||||||||||||||||||||
3197    c$$$         if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
3198    c$$$     $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
3199    c$$$            
3200    c$$$            id=CP_STORE(nplanes-ip+1,ibest)
3201    c$$$            
3202    c$$$            is=is_cp(id)
3203    c$$$            icp=icp_cp(id)
3204    c$$$            if(ip_cp(id).ne.ip)
3205    c$$$     $           print*,'OKKIO!!'
3206    c$$$     $           ,'id ',id,is,icp
3207    c$$$     $           ,ip_cp(id),ip
3208    c$$$            icx=clx(ip,icp)
3209    c$$$            icy=cly(ip,icp)
3210    c$$$c            call xyz_PAM(icx,icy,is,
3211    c$$$c     $           PFA,PFA,
3212    c$$$c     $           AXV_STORE(nplanes-ip+1,ibest),
3213    c$$$c     $           AYV_STORE(nplanes-ip+1,ibest))
3214    c$$$            call xyz_PAM(icx,icy,is,
3215    c$$$     $           PFA,PFA,
3216    c$$$     $           AXV_STORE(nplanes-ip+1,ibest),
3217    c$$$     $           AYV_STORE(nplanes-ip+1,ibest),
3218    c$$$     $           bxyz(1),
3219    c$$$     $           bxyz(2)
3220    c$$$     $           )
3221    c$$$
3222    c$$$            xm(nplanes-ip+1) = xPAM
3223    c$$$            ym(nplanes-ip+1) = yPAM
3224    c$$$            zm(nplanes-ip+1) = zPAM
3225    c$$$            xgood(nplanes-ip+1) = 1
3226    c$$$            ygood(nplanes-ip+1) = 1
3227    c$$$            resx(nplanes-ip+1) = resxPAM
3228    c$$$            resy(nplanes-ip+1) = resyPAM
3229    c$$$
3230    c$$$            dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3231    c$$$            dedxtrk_y(nplanes-ip+1)=sgnl(icy)/mip(VIEW(icy),LADDER(icy))
3232             if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..or.
3233       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
3234                            
3235              id=CP_STORE(nplanes-ip+1,ibest)              id=CP_STORE(nplanes-ip+1,ibest)
# Line 3317  c*************************************** Line 3242  c***************************************
3242       $           ,ip_cp(id),ip       $           ,ip_cp(id),ip
3243              icx=clx(ip,icp)              icx=clx(ip,icp)
3244              icy=cly(ip,icp)              icy=cly(ip,icp)
3245    c            call xyz_PAM(icx,icy,is,
3246    c     $           PFA,PFA,
3247    c     $           AXV_STORE(nplanes-ip+1,ibest),
3248    c     $           AYV_STORE(nplanes-ip+1,ibest))
3249              call xyz_PAM(icx,icy,is,              call xyz_PAM(icx,icy,is,
 c     $           'ETA2','ETA2',  
3250       $           PFA,PFA,       $           PFA,PFA,
3251       $           AXV_STORE(nplanes-ip+1,ibest),       $           AXV_STORE(nplanes-ip+1,ibest),
3252       $           AYV_STORE(nplanes-ip+1,ibest))       $           AYV_STORE(nplanes-ip+1,ibest),
3253  c$$$  call xyz_PAM(icx,icy,is,       $           bxyz(1),
3254  c$$$  $              'COG2','COG2',       $           bxyz(2)
3255  c$$$  $              0.,       $           )
3256  c$$$  $              0.)  
3257              xm(nplanes-ip+1) = xPAM              if(icx.gt.0.and.icy.gt.0)then
3258              ym(nplanes-ip+1) = yPAM                 xm(nplanes-ip+1) = xPAM
3259              zm(nplanes-ip+1) = zPAM                 ym(nplanes-ip+1) = yPAM
3260              xgood(nplanes-ip+1) = 1                 zm(nplanes-ip+1) = zPAM
3261              ygood(nplanes-ip+1) = 1                 xm_A(nplanes-ip+1) = 0.
3262              resx(nplanes-ip+1) = resxPAM                 ym_A(nplanes-ip+1) = 0.
3263              resy(nplanes-ip+1) = resyPAM                 xm_B(nplanes-ip+1) = 0.
3264                   ym_B(nplanes-ip+1) = 0.
3265  c            dedxtrk(nplanes-ip+1) = (dedx(icx)+dedx(icy))/2. !(1)                 xgood(nplanes-ip+1) = 1
3266              dedxtrk_x(nplanes-ip+1)=dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                 ygood(nplanes-ip+1) = 1
3267              dedxtrk_y(nplanes-ip+1)=dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                 resx(nplanes-ip+1) = resxPAM
3268                   resy(nplanes-ip+1) = resyPAM
3269                   dedxtrk_x(nplanes-ip+1)=
3270         $              sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3271                   dedxtrk_y(nplanes-ip+1)=
3272         $              sgnl(icy)/mip(VIEW(icy),LADDER(icy))
3273                else
3274                   xm(nplanes-ip+1) = 0.
3275                   ym(nplanes-ip+1) = 0.
3276                   zm(nplanes-ip+1) = (zPAM_A+zPAM_B)/2.
3277                   xm_A(nplanes-ip+1) = xPAM_A
3278                   ym_A(nplanes-ip+1) = yPAM_A
3279                   xm_B(nplanes-ip+1) = xPAM_B
3280                   ym_B(nplanes-ip+1) = yPAM_B
3281                   xgood(nplanes-ip+1) = 0
3282                   ygood(nplanes-ip+1) = 0
3283                   resx(nplanes-ip+1) = 1000.!resxPAM
3284                   resy(nplanes-ip+1) = 1000.!resyPAM
3285                   dedxtrk_x(nplanes-ip+1)= 0
3286                   dedxtrk_y(nplanes-ip+1)= 0
3287                   if(icx.gt.0)then
3288                      xgood(nplanes-ip+1) = 1
3289                      resx(nplanes-ip+1) = resxPAM
3290                      dedxtrk_x(nplanes-ip+1)=
3291         $                 sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3292                   elseif(icy.gt.0)then
3293                      ygood(nplanes-ip+1) = 1
3294                      resy(nplanes-ip+1) = resyPAM
3295                      dedxtrk_y(nplanes-ip+1)=
3296         $                 sgnl(icy)/mip(VIEW(icy),LADDER(icy))
3297                   endif
3298                endif
3299                            
3300    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3301  *     -------------------------------------------------  *     -------------------------------------------------
3302  *     If the plane has NOT  been already included,  *     If the plane has NOT  been already included,
3303  *     it tries to include a COUPLE or a single cluster  *     it tries to include a COUPLE or a single cluster
3304  *     -------------------------------------------------  *     -------------------------------------------------
3305    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3306           else                             else                  
3307                                
3308              xgood(nplanes-ip+1)=0              xgood(nplanes-ip+1)=0
3309              ygood(nplanes-ip+1)=0              ygood(nplanes-ip+1)=0
3310    
3311                CP_STORE(nplanes-ip+1,ibest)=0 !re-init
3312                CLS_STORE(nplanes-ip+1,ibest)=0
3313    
3314                                
3315  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3316  *     determine which ladder and sensor are intersected by the track  *     determine which ladder and sensor are intersected by the track
             xP=XV_STORE(nplanes-ip+1,ibest)  
             yP=YV_STORE(nplanes-ip+1,ibest)  
             zP=ZV_STORE(nplanes-ip+1,ibest)  
3317              call whichsensor(ip,xP,yP,nldt,ist)              call whichsensor(ip,xP,yP,nldt,ist)
3318  *     if the track hit the plane in a dead area, go to the next plane  *     if the track hit the plane in a dead area, go to the next plane
3319              if(nldt.eq.0.or.ist.eq.0)goto 133              if(nldt.eq.0.or.ist.eq.0)goto 133
3320    
3321                SENSOR_STORE(nplanes-ip+1,IBEST)=ist
3322                LADDER_STORE(nplanes-ip+1,IBEST)=nldt
3323  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3324    
3325              if(DEBUG)then              if(DEBUG.EQ.1)then
3326                 print*,                 print*,
3327       $              '------ Plane ',ip,' intersected on LADDER ',nldt       $              '------ Plane ',ip,' intersected on LADDER ',nldt
3328       $              ,' SENSOR ',ist       $              ,' SENSOR ',ist
# Line 3368  c            dedxtrk(nplanes-ip+1) = (de Line 3333  c            dedxtrk(nplanes-ip+1) = (de
3333  *     ===========================================  *     ===========================================
3334  *     STEP 1 >>>>>>>  try to include a new couple  *     STEP 1 >>>>>>>  try to include a new couple
3335  *     ===========================================  *     ===========================================
3336  c            if(DEBUG)print*,'>>>> try to include a new couple'              distmin=100000000.
             distmin=1000000.  
3337              xmm = 0.              xmm = 0.
3338              ymm = 0.              ymm = 0.
3339              zmm = 0.              zmm = 0.
# Line 3382  c            if(DEBUG)print*,'>>>> try t Line 3346  c            if(DEBUG)print*,'>>>> try t
3346              do icp=1,ncp_plane(ip) !loop on couples on plane icp              do icp=1,ncp_plane(ip) !loop on couples on plane icp
3347                 icx=clx(ip,icp)                 icx=clx(ip,icp)
3348                 icy=cly(ip,icp)                 icy=cly(ip,icp)
3349                   if(icx.eq.0.or.icy.eq.0)goto 1188!if fake couple, jump to next
3350                 if(LADDER(icx).ne.nldt.or. !If the ladder number does not match                 if(LADDER(icx).ne.nldt.or. !If the ladder number does not match
3351       $              cl_used(icx).eq.1.or. !or the X cluster is already used  c     $              cl_used(icx).eq.1.or. !or the X cluster is already used
3352       $              cl_used(icy).eq.1.or. !or the Y cluster is already used  c     $              cl_used(icy).eq.1.or. !or the Y cluster is already used
3353         $              cl_used(icx).ne.0.or. !or the X cluster is already used
3354         $              cl_used(icy).ne.0.or. !or the Y cluster is already used
3355       $              .false.)goto 1188 !then jump to next couple.       $              .false.)goto 1188 !then jump to next couple.
3356  *            *          
3357                 call xyz_PAM(icx,icy,ist,                 call xyz_PAM(icx,icy,ist,
3358       $              PFA,PFA,       $              PFA,PFA,
 c     $              'ETA2','ETA2',  
3359       $              AXV_STORE(nplanes-ip+1,ibest),       $              AXV_STORE(nplanes-ip+1,ibest),
3360       $              AYV_STORE(nplanes-ip+1,ibest))       $              AYV_STORE(nplanes-ip+1,ibest),
3361         $              bxyz(1),
3362         $              bxyz(2)
3363         $              )
3364                                
3365                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3366    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3367                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3368                 if(DEBUG)print*,'( couple ',id                 if(DEBUG.EQ.1)
3369       $              ,' ) normalized distance ',distance       $              print*,'( couple ',id
3370         $              ,' ) distance ',distance
3371                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3372                    xmm = xPAM                    xmm = xPAM
3373                    ymm = yPAM                    ymm = yPAM
# Line 3405  c     $              'ETA2','ETA2', Line 3376  c     $              'ETA2','ETA2',
3376                    rymm = resyPAM                    rymm = resyPAM
3377                    distmin = distance                    distmin = distance
3378                    idm = id                                      idm = id                  
3379  c                 dedxmm = (dedx(icx)+dedx(icy))/2. !(1)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3380                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3381                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    clincnewc=10*sqrt(rymm**2+rxmm**2
3382         $                 +RCHI2_STORE(ibest)*k(ip)*(cov(1,1)+cov(2,2)))
3383                 endif                 endif
3384   1188          continue   1188          continue
3385              enddo               !end loop on couples on plane icp              enddo               !end loop on couples on plane icp
3386              if(distmin.le.clinc)then                                if(distmin.le.clincnewc)then    
3387  *              -----------------------------------  *              -----------------------------------
3388                 xm(nplanes-ip+1) = xmm         !<<<                 xm(nplanes-ip+1) = xmm !<<<
3389                 ym(nplanes-ip+1) = ymm         !<<<                 ym(nplanes-ip+1) = ymm !<<<
3390                 zm(nplanes-ip+1) = zmm         !<<<                 zm(nplanes-ip+1) = zmm !<<<
3391                 xgood(nplanes-ip+1) = 1        !<<<                 xgood(nplanes-ip+1) = 1 !<<<
3392                 ygood(nplanes-ip+1) = 1        !<<<                 ygood(nplanes-ip+1) = 1 !<<<
3393                 resx(nplanes-ip+1)=rxmm        !<<<                 resx(nplanes-ip+1)=rxmm !<<<
3394                 resy(nplanes-ip+1)=rymm        !<<<                 resy(nplanes-ip+1)=rymm !<<<
3395  c              dedxtrk(nplanes-ip+1) = dedxmm !<<<  !(1)                 dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3396                 dedxtrk_x(nplanes-ip+1) = dedxmmx    !(1)                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
                dedxtrk_y(nplanes-ip+1) = dedxmmy    !(1)  
3397  *              -----------------------------------  *              -----------------------------------
3398                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
3399                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG.EQ.1)print*,'%%%% included couple ',idm
3400       $              ,' (norm.dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clincnewc,' )'
3401                 goto 133         !next plane                 goto 133         !next plane
3402              endif              endif
3403  *     ================================================  *     ================================================
3404  *     STEP 2 >>>>>>>  try to include a single cluster  *     STEP 2 >>>>>>>  try to include a single cluster
3405  *                     either from a couple or single  *                     either from a couple or single
3406  *     ================================================  *     ================================================
 c            if(DEBUG)print*,'>>>> try to include a new cluster'  
3407              distmin=1000000.              distmin=1000000.
3408              xmm_A = 0.          !---------------------------              xmm_A = 0.          !---------------------------
3409              ymm_A = 0.          ! init variables that              ymm_A = 0.          ! init variables that
# Line 3452  c            if(DEBUG)print*,'>>>> try t Line 3422  c            if(DEBUG)print*,'>>>> try t
3422              do icp=1,ncp_plane(ip) !loop on cluster inside couples              do icp=1,ncp_plane(ip) !loop on cluster inside couples
3423                 icx=clx(ip,icp)                 icx=clx(ip,icp)
3424                 icy=cly(ip,icp)                 icy=cly(ip,icp)
3425                   if(icx.eq.0.or.icy.eq.0)goto 11882!if fake couple, jump to next
3426                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3427                 if(LADDER(icx).ne.nldt)goto 11882 !if the ladder number does not match                 if(LADDER(icx).ne.nldt)goto 11882 !if the ladder number does not match
3428  *                                                !jump to the next couple  *                                                !jump to the next couple
3429  *----- try cluster x -----------------------------------------------  *----- try cluster x -----------------------------------------------
3430                 if(cl_used(icx).eq.1)goto 11881 !if the X cluster is already used  c               if(cl_used(icx).eq.1)goto 11881 !if the X cluster is already used
3431                   if(cl_used(icx).ne.0)goto 11881 !if the X cluster is already used  !(3)
3432  *                                              !jump to the Y cluster  *                                              !jump to the Y cluster
3433    c               call xyz_PAM(icx,0,ist,
3434    c     $              PFA,PFA,
3435    c     $              AXV_STORE(nplanes-ip+1,ibest),0.)              
3436                 call xyz_PAM(icx,0,ist,                 call xyz_PAM(icx,0,ist,
 c     $              'ETA2','ETA2',  
3437       $              PFA,PFA,       $              PFA,PFA,
3438       $              AXV_STORE(nplanes-ip+1,ibest),0.)                     $              AXV_STORE(nplanes-ip+1,ibest),0.,
3439         $              bxyz(1),
3440         $              bxyz(2)
3441         $              )              
3442                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3443  c     if(DEBUG)print*,'normalized distance ',distance  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3444                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG.EQ.1)
3445       $              ,' in cp ',id,' ) normalized distance ',distance       $              print*,'( cl-X ',icx
3446         $              ,' in cp ',id,' ) distance ',distance
3447                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3448                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3449                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3477  c     if(DEBUG)print*,'normalized distan Line 3455  c     if(DEBUG)print*,'normalized distan
3455                    rymm = resyPAM                    rymm = resyPAM
3456                    distmin = distance                    distmin = distance
3457                    iclm = icx                    iclm = icx
3458  c                  dedxmm = dedx(icx) !(1)  c                  dedxmm = sgnl(icx) !(1)
3459                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3460                    dedxmmy = 0.        !(1)                    dedxmmy = 0.        !(1)
3461                 endif                                   endif                  
3462  11881          continue  11881          continue
3463  *----- try cluster y -----------------------------------------------  *----- try cluster y -----------------------------------------------
3464                 if(cl_used(icy).eq.1)goto 11882 !if the Y cluster is already used  c               if(cl_used(icy).eq.1)goto 11882 !if the Y cluster is already used
3465                   if(cl_used(icy).ne.0)goto 11882 !if the Y cluster is already used !(3)
3466  *                                              !jump to the next couple  *                                              !jump to the next couple
3467    c               call xyz_PAM(0,icy,ist,
3468    c     $              PFA,PFA,
3469    c     $              0.,AYV_STORE(nplanes-ip+1,ibest))
3470                 call xyz_PAM(0,icy,ist,                 call xyz_PAM(0,icy,ist,
 c     $              'ETA2','ETA2',  
3471       $              PFA,PFA,       $              PFA,PFA,
3472       $              0.,AYV_STORE(nplanes-ip+1,ibest))       $              0.,AYV_STORE(nplanes-ip+1,ibest),
3473         $              bxyz(1),
3474         $              bxyz(2)
3475         $              )
3476                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3477                 if(DEBUG)print*,'( cl-Y ',icy  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3478       $              ,' in cp ',id,' ) normalized distance ',distance                 if(DEBUG.EQ.1)
3479         $              print*,'( cl-Y ',icy
3480         $              ,' in cp ',id,' ) distance ',distance
3481                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3482                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3483                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3503  c     $              'ETA2','ETA2', Line 3489  c     $              'ETA2','ETA2',
3489                    rymm = resyPAM                    rymm = resyPAM
3490                    distmin = distance                    distmin = distance
3491                    iclm = icy                    iclm = icy
3492  c                 dedxmm = dedx(icy)  !(1)  c                 dedxmm = sgnl(icy)  !(1)
3493                    dedxmmx = 0.        !(1)                    dedxmmx = 0.        !(1)
3494                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3495                 endif                                   endif                  
3496  11882          continue  11882          continue
3497              enddo               !end loop on cluster inside couples              enddo               !end loop on cluster inside couples
3498  *----- single clusters -----------------------------------------------      *----- single clusters -----------------------------------------------  
3499              do ic=1,ncls(ip)    !loop on single clusters              do ic=1,ncls(ip)    !loop on single clusters
3500                 icl=cls(ip,ic)                 icl=cls(ip,ic)
3501                 if(cl_used(icl).eq.1.or.     !if the cluster is already used                 if(cl_used(icl).ne.0.or.     !if the cluster is already used !(3)
3502       $              LADDER(icl).ne.nldt.or. !or the ladder number does not match       $              LADDER(icl).ne.nldt.or. !or the ladder number does not match
3503       $              .false.)goto 18882      !jump to the next singlet       $              .false.)goto 18882      !jump to the next singlet
3504                 if(mod(VIEW(icl),2).eq.0)then!<---- X view                 if(mod(VIEW(icl),2).eq.0)then!<---- X view
3505                    call xyz_PAM(icl,0,ist,                    call xyz_PAM(icl,0,ist,
 c     $                 'ETA2','ETA2',  
3506       $                 PFA,PFA,       $                 PFA,PFA,
3507       $                 AXV_STORE(nplanes-ip+1,ibest),0.)       $                 AXV_STORE(nplanes-ip+1,ibest),0.,
3508         $                 bxyz(1),
3509         $                 bxyz(2)
3510         $                 )
3511                 else                         !<---- Y view                 else                         !<---- Y view
3512                    call xyz_PAM(0,icl,ist,                    call xyz_PAM(0,icl,ist,
 c     $                 'ETA2','ETA2',  
3513       $                 PFA,PFA,       $                 PFA,PFA,
3514       $                 0.,AYV_STORE(nplanes-ip+1,ibest))       $                 0.,AYV_STORE(nplanes-ip+1,ibest),
3515         $                 bxyz(1),
3516         $                 bxyz(2)
3517         $                 )
3518                 endif                 endif
3519    
3520                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3521                 if(DEBUG)print*,'( cl-s ',icl  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3522       $              ,' ) normalized distance ',distance                 if(DEBUG.EQ.1)
3523         $              print*,'( cl-s ',icl
3524         $              ,' ) distance ',distance
3525                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3526                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3527                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3541  c     $                 'ETA2','ETA2', Line 3533  c     $                 'ETA2','ETA2',
3533                    rymm = resyPAM                    rymm = resyPAM
3534                    distmin = distance                      distmin = distance  
3535                    iclm = icl                    iclm = icl
 c                  dedxmm = dedx(icl)                   !(1)  
3536                    if(mod(VIEW(icl),2).eq.0)then !<---- X view                    if(mod(VIEW(icl),2).eq.0)then !<---- X view
3537                       dedxmmx = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3538                       dedxmmy = 0.                       !(1)                       dedxmmy = 0.                  
3539                    else          !<---- Y view                    else          !<---- Y view
3540                       dedxmmx = 0.                       !(1)                       dedxmmx = 0.                  
3541                       dedxmmy = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3542                    endif                    endif
3543                 endif                                   endif                  
3544  18882          continue  18882          continue
3545              enddo               !end loop on single clusters              enddo               !end loop on single clusters
3546    
3547              if(distmin.le.clinc)then                                if(iclm.ne.0)then
                 
                CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<      
 *              ----------------------------  
3548                 if(mod(VIEW(iclm),2).eq.0)then                 if(mod(VIEW(iclm),2).eq.0)then
3549                    XGOOD(nplanes-ip+1)=1.                    clincnew=
3550                    resx(nplanes-ip+1)=rxmm       $                 20*
3551                    if(DEBUG)print*,'%%%% included X-cl ',iclm       $                 sqrt(rxmm**2+RCHI2_STORE(ibest)*k(ip)*cov(1,1))
3552       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'                 else if(mod(VIEW(iclm),2).ne.0)then
3553                 else                    clincnew=
3554                    YGOOD(nplanes-ip+1)=1.       $                 10*
3555                    resy(nplanes-ip+1)=rymm       $                 sqrt(rymm**2+RCHI2_STORE(ibest)*k(ip)*cov(2,2))
3556                    if(DEBUG)print*,'%%%% included Y-cl ',iclm                 endif
3557       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'  
3558                   if(distmin.le.clincnew)then  
3559                      
3560                      CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<    
3561    *     ----------------------------
3562                      if(mod(VIEW(iclm),2).eq.0)then
3563                         XGOOD(nplanes-ip+1)=1.
3564                         resx(nplanes-ip+1)=rxmm
3565                         if(DEBUG.EQ.1)
3566         $                    print*,'%%%% included X-cl ',iclm
3567         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3568         $                    ,', dist.= ',distmin
3569         $                    ,', cut ',clincnew,' )'
3570                      else
3571                         YGOOD(nplanes-ip+1)=1.
3572                         resy(nplanes-ip+1)=rymm
3573                         if(DEBUG.EQ.1)
3574         $                    print*,'%%%% included Y-cl ',iclm
3575         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3576         $                    ,', dist.= ', distmin
3577         $                    ,', cut ',clincnew,' )'
3578                      endif
3579    *     ----------------------------
3580                      xm_A(nplanes-ip+1) = xmm_A
3581                      ym_A(nplanes-ip+1) = ymm_A
3582                      xm_B(nplanes-ip+1) = xmm_B
3583                      ym_B(nplanes-ip+1) = ymm_B
3584                      zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3585                      dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3586                      dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3587    *     ----------------------------
3588                 endif                 endif
 *              ----------------------------  
                xm_A(nplanes-ip+1) = xmm_A  
                ym_A(nplanes-ip+1) = ymm_A  
                xm_B(nplanes-ip+1) = xmm_B  
                ym_B(nplanes-ip+1) = ymm_B  
                zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.  
 c              dedxtrk(nplanes-ip+1) = dedxmm !<<<    !(1)  
                dedxtrk_x(nplanes-ip+1) = dedxmmx !<<< !(1)  
                dedxtrk_y(nplanes-ip+1) = dedxmmy !<<< !(1)  
 *              ----------------------------  
3589              endif              endif
3590           endif           endif
3591   133     continue   133     continue
# Line 3588  c              dedxtrk(nplanes-ip+1) = d Line 3596  c              dedxtrk(nplanes-ip+1) = d
3596        return        return
3597        end        end
3598    
3599    
3600  ***************************************************  ***************************************************
3601  *                                                 *  *                                                 *
3602  *                                                 *  *                                                 *
# Line 3596  c              dedxtrk(nplanes-ip+1) = d Line 3605  c              dedxtrk(nplanes-ip+1) = d
3605  *                                                 *  *                                                 *
3606  *                                                 *  *                                                 *
3607  **************************************************  **************************************************
3608    *
       subroutine clean_XYclouds(ibest,iflag)  
   
       include 'commontracker.f'  
       include 'common_momanhough.f'  
       include 'momanhough_init.f'  
 c      include 'calib.f'  
 c      include 'level1.f'  
   
       logical DEBUG  
       common/dbg/DEBUG  
   
   
       do ip=1,nplanes           !loop on planes  
   
          id=CP_STORE(nplanes-ip+1,ibest)  
          icl=CLS_STORE(nplanes-ip+1,ibest)  
          if(id.ne.0.or.icl.ne.0)then                
             if(id.ne.0)then  
                iclx=clx(ip,icp_cp(id))  
                icly=cly(ip,icp_cp(id))  
                cl_used(iclx)=1  !tag used clusters  
                cl_used(icly)=1  !tag used clusters  
             elseif(icl.ne.0)then  
                cl_used(icl)=1   !tag used clusters  
             endif  
               
 c               if(DEBUG)then  
 c                  print*,ip,' <<< ',id  
 c               endif  
 *     -----------------------------  
 *     remove the couple from clouds  
 *     remove also vitual couples containing the  
 *     selected clusters  
 *     -----------------------------  
             do icp=1,ncp_plane(ip)  
                if(  
      $              clx(ip,icp).eq.iclx  
      $              .or.  
      $              clx(ip,icp).eq.icl  
      $              .or.  
      $              cly(ip,icp).eq.icly  
      $              .or.  
      $              cly(ip,icp).eq.icl  
      $              )then  
                   id=id_cp(ip,icp,1)  
                   if(DEBUG)then  
                      print*,ip,' <<< cp ',id  
      $                    ,' ( cl-x '  
      $                    ,clx(ip,icp)  
      $                    ,' cl-y '  
      $                    ,cly(ip,icp),' ) --> removed'  
                   endif  
 *     -----------------------------  
 *     remove the couple from clouds  
                   do iyz=1,nclouds_yz  
                      if(cpcloud_yz(iyz,abs(id)).ne.0)then  
                         ptcloud_yz(iyz)=ptcloud_yz(iyz)-1  
                         cpcloud_yz(iyz,abs(id))=0  
                      endif  
                   enddo  
                   do ixz=1,nclouds_xz  
                      if(cpcloud_xz(ixz,abs(id)).ne.0)then  
                         ptcloud_xz(ixz)=ptcloud_xz(ixz)-1  
                         cpcloud_xz(ixz,abs(id))=0  
                      endif  
                   enddo                      
 *     -----------------------------  
                endif  
             enddo  
               
          endif                
       enddo                     !end loop on planes  
         
       return  
       end  
   
   
   
   
 c$$$*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  
 c$$$      real function fbad_cog(ncog,ic)  
 c$$$  
 c$$$  
 c$$$      include 'commontracker.f'  
 c$$$      include 'level1.f'  
 c$$$      include 'calib.f'  
 c$$$  
 c$$$*     --> signal of the central strip  
 c$$$      sc = CLSIGNAL(INDMAX(ic)) !center  
 c$$$  
 c$$$*     signal of adjacent strips  
 c$$$*     --> left  
 c$$$      sl1 = 0                  !left 1  
 c$$$      if(  
 c$$$     $     (INDMAX(ic)-1).ge.INDSTART(ic)  
 c$$$     $     )  
 c$$$     $     sl1 = max(0.,CLSIGNAL(INDMAX(ic)-1))  
 c$$$  
 c$$$      sl2 = 0                  !left 2  
 c$$$      if(  
 c$$$     $     (INDMAX(ic)-2).ge.INDSTART(ic)  
 c$$$     $     )  
 c$$$     $     sl2 = max(0.,CLSIGNAL(INDMAX(ic)-2))  
 c$$$  
 c$$$*     --> right  
 c$$$      sr1 = 0                  !right 1  
 c$$$      if(  
 c$$$     $     (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1))  
 c$$$     $     .or.  
 c$$$     $     (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH)  
 c$$$     $     )  
 c$$$     $     sr1 = max(0.,CLSIGNAL(INDMAX(ic)+1))  
 c$$$  
 c$$$      sr2 = 0                  !right 2  
 c$$$      if(  
 c$$$     $     (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1))  
 c$$$     $     .or.  
 c$$$     $     (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH)  
 c$$$     $     )  
 c$$$     $     sr2 = max(0.,CLSIGNAL(INDMAX(ic)+2))  
 c$$$  
 c$$$  
 c$$$      if(mod(int(VIEW(ic)),2).eq.1)then !Y-view  
 c$$$         f  = 4.  
 c$$$         si = 8.4  
 c$$$      else                              !X-view  
 c$$$         f  = 6.  
 c$$$         si = 3.9  
 c$$$      endif  
 c$$$  
 c$$$      fbad_cog = 1.  
 c$$$      f0 = 1  
 c$$$      f1 = 1  
 c$$$      f2 = 1  
 c$$$      f3 = 1    
 c$$$      if(sl1.gt.sr1.and.sl1.gt.0.)then  
 c$$$          
 c$$$         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic))  ).eq.0)f0=f  
 c$$$         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)-1)).eq.0)f1=f  
 c$$$c         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)+1)).eq.0)f3=f  
 c$$$  
 c$$$         if(ncog.eq.2.and.sl1.ne.0)then  
 c$$$            fbad_cog = (f1**2*sc**2/sl1**2+f0**2)/(sc**2/sl1**2+1.)  
 c$$$         elseif(ncog.eq.3.and.sl1.ne.0.and.sr1.ne.0)then  
 c$$$            fbad_cog = 1.  
 c$$$         elseif(ncog.eq.4.and.sl1.ne.0.and.sr1.ne.0.and.sl2.ne.0)then  
 c$$$            fbad_cog = 1.  
 c$$$         else  
 c$$$            fbad_cog = 1.  
 c$$$         endif  
 c$$$          
 c$$$      elseif(sl1.le.sr1.and.sr1.gt.0.)then  
 c$$$  
 c$$$  
 c$$$         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic))  ).eq.0)f0=f  
 c$$$         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)+1)).eq.0)f1=f  
 c$$$c         if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)-1)).eq.0)f3=f  
 c$$$  
 c$$$         if(ncog.eq.2.and.sr1.ne.0)then  
 c$$$            fbad_cog = (f1**2*sc**2/sr1**2+f0**2)/(sc**2/sr1**2+1.)  
 c$$$         elseif(ncog.eq.3.and.sr1.ne.0.and.sl1.ne.0)then  
 c$$$            fbad_cog = 1.  
 c$$$         elseif(ncog.eq.4.and.sr1.ne.0.and.sl1.ne.0.and.sr2.ne.0)then  
 c$$$            fbad_cog = 1.  
 c$$$         else  
 c$$$            fbad_cog = 1.  
 c$$$         endif  
 c$$$  
 c$$$      endif  
 c$$$  
 c$$$      fbad_cog = sqrt(fbad_cog)  
 c$$$  
 c$$$      return  
 c$$$      end  
 c$$$  
3609    
3610    
3611    
# Line 3779  c$$$ Line 3613  c$$$
3613    
3614        subroutine init_level2        subroutine init_level2
3615    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c*****************************************************  
   
3616        include 'commontracker.f'        include 'commontracker.f'
3617          include 'level1.f'
3618        include 'common_momanhough.f'        include 'common_momanhough.f'
3619        include 'level2.f'        include 'level2.f'
       include 'level1.f'  
   
   
   
       good2 = 0!.false.  
 c$$$      nev2 = nev1  
   
 c$$$# ifndef TEST2003  
 c$$$c*****************************************************  
 c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$c      pkt_type = pkt_type1  
 c$$$c      pkt_num = pkt_num1  
 c$$$c      obt = obt1  
 c$$$c      which_calib = which_calib1  
 c$$$      swcode = 302  
 c$$$  
 c$$$      which_calib = which_calib1  
 c$$$      pkt_type = pkt_type1  
 c$$$      pkt_num = pkt_num1  
 c$$$      obt = obt1  
 c$$$      cpu_crc = cpu_crc1  
 c$$$      do iv=1,12  
 c$$$         crc(iv)=crc1(iv)  
 c$$$      enddo  
 c$$$# endif  
 c*****************************************************  
3620    
3621    *     ---------------------------------
3622    *     variables initialized from level1
3623    *     ---------------------------------
3624          do i=1,nviews
3625             good2(i)=good1(i)
3626             do j=1,nva1_view
3627                vkflag(i,j)=1
3628                if(cnnev(i,j).le.0)then
3629                   vkflag(i,j)=cnnev(i,j)
3630                endif
3631             enddo
3632          enddo
3633    *     ----------------
3634    *     level2 variables
3635    *     ----------------
3636        NTRK = 0        NTRK = 0
3637        do it=1,NTRKMAX!NTRACKSMAX        do it=1,NTRKMAX
3638           IMAGE(IT)=0           IMAGE(IT)=0
3639           CHI2_nt(IT) = -100000.           CHI2_nt(IT) = -100000.
          BdL(IT) = 0.  
3640           do ip=1,nplanes           do ip=1,nplanes
3641              XM_nt(IP,IT) = 0              XM_nt(IP,IT) = 0
3642              YM_nt(IP,IT) = 0              YM_nt(IP,IT) = 0
3643              ZM_nt(IP,IT) = 0              ZM_nt(IP,IT) = 0
3644              RESX_nt(IP,IT) = 0              RESX_nt(IP,IT) = 0
3645              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3646                TAILX_nt(IP,IT) = 0
3647                TAILY_nt(IP,IT) = 0
3648                XBAD(IP,IT) = 0
3649                YBAD(IP,IT) = 0
3650              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3651              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
3652  c*****************************************************              LS(IP,IT) = 0
 cccccc 11/9/2005 modified by david fedele  
3653              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3654              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
3655  c******************************************************              CLTRX(IP,IT) = 0
3656                CLTRY(IP,IT) = 0
3657                multmaxx(ip,it) = 0
3658                seedx(ip,it)    = 0
3659                xpu(ip,it)      = 0
3660                multmaxy(ip,it) = 0
3661                seedy(ip,it)    = 0
3662                ypu(ip,it)      = 0
3663           enddo           enddo
3664           do ipa=1,5           do ipa=1,5
3665              AL_nt(IPA,IT) = 0              AL_nt(IPA,IT) = 0
# Line 3839  c*************************************** Line 3668  c***************************************
3668              enddo                                enddo                  
3669           enddo                             enddo                  
3670        enddo        enddo
         
         
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3671        nclsx=0        nclsx=0
3672        nclsy=0              nclsy=0      
3673        do ip=1,NSINGMAX        do ip=1,NSINGMAX
3674          planex(ip)=0          planex(ip)=0
 c        xs(ip)=0  
3675          xs(1,ip)=0          xs(1,ip)=0
3676          xs(2,ip)=0          xs(2,ip)=0
3677          sgnlxs(ip)=0          sgnlxs(ip)=0
3678          planey(ip)=0          planey(ip)=0
 c        ys(ip)=0  
3679          ys(1,ip)=0          ys(1,ip)=0
3680          ys(2,ip)=0          ys(2,ip)=0
3681          sgnlys(ip)=0          sgnlys(ip)=0
3682            sxbad(ip)=0
3683            sybad(ip)=0
3684            multmaxsx(ip)=0
3685            multmaxsy(ip)=0
3686        enddo        enddo
 c*******************************************************  
3687        end        end
3688    
3689    
# Line 3872  c*************************************** Line 3698  c***************************************
3698  ************************************************************  ************************************************************
3699    
3700    
3701          subroutine init_hough
3702    
3703          include 'commontracker.f'
3704          include 'level1.f'
3705          include 'common_momanhough.f'
3706          include 'common_hough.f'
3707          include 'level2.f'
3708    
3709          ntrpt_nt=0
3710          ndblt_nt=0
3711          NCLOUDS_XZ_nt=0
3712          NCLOUDS_YZ_nt=0
3713          do idb=1,ndblt_max_nt
3714             db_cloud_nt(idb)=0
3715             alfayz1_nt(idb)=0      
3716             alfayz2_nt(idb)=0      
3717          enddo
3718          do itr=1,ntrpt_max_nt
3719             tr_cloud_nt(itr)=0
3720             alfaxz1_nt(itr)=0      
3721             alfaxz2_nt(itr)=0      
3722             alfaxz3_nt(itr)=0      
3723          enddo
3724          do idb=1,ncloyz_max      
3725            ptcloud_yz_nt(idb)=0    
3726            alfayz1_av_nt(idb)=0    
3727            alfayz2_av_nt(idb)=0    
3728          enddo                    
3729          do itr=1,ncloxz_max      
3730            ptcloud_xz_nt(itr)=0    
3731            alfaxz1_av_nt(itr)=0    
3732            alfaxz2_av_nt(itr)=0    
3733            alfaxz3_av_nt(itr)=0    
3734          enddo                    
3735    
3736          ntrpt=0                  
3737          ndblt=0                  
3738          NCLOUDS_XZ=0              
3739          NCLOUDS_YZ=0              
3740          do idb=1,ndblt_max        
3741            db_cloud(idb)=0        
3742            cpyz1(idb)=0            
3743            cpyz2(idb)=0            
3744            alfayz1(idb)=0          
3745            alfayz2(idb)=0          
3746          enddo                    
3747          do itr=1,ntrpt_max        
3748            tr_cloud(itr)=0        
3749            cpxz1(itr)=0            
3750            cpxz2(itr)=0            
3751            cpxz3(itr)=0            
3752            alfaxz1(itr)=0          
3753            alfaxz2(itr)=0          
3754            alfaxz3(itr)=0          
3755          enddo                    
3756          do idb=1,ncloyz_max      
3757            ptcloud_yz(idb)=0      
3758            alfayz1_av(idb)=0      
3759            alfayz2_av(idb)=0      
3760            do idbb=1,ncouplemaxtot
3761              cpcloud_yz(idb,idbb)=0
3762            enddo                  
3763          enddo                    
3764          do itr=1,ncloxz_max      
3765            ptcloud_xz(itr)=0      
3766            alfaxz1_av(itr)=0      
3767            alfaxz2_av(itr)=0      
3768            alfaxz3_av(itr)=0      
3769            do itrr=1,ncouplemaxtot
3770              cpcloud_xz(itr,itrr)=0
3771            enddo                  
3772          enddo                    
3773          end
3774    ************************************************************
3775    *
3776    *
3777    *
3778    *
3779    *
3780    *
3781    *
3782    ************************************************************
3783    
3784    
3785        subroutine fill_level2_tracks(ntr)        subroutine fill_level2_tracks(ntr)
3786    
3787  *     -------------------------------------------------------  *     -------------------------------------------------------
# Line 3882  c*************************************** Line 3792  c***************************************
3792    
3793            
3794        include 'commontracker.f'        include 'commontracker.f'
3795          include 'level1.f'
3796          include 'common_momanhough.f'
3797        include 'level2.f'        include 'level2.f'
3798        include 'common_mini_2.f'        include 'common_mini_2.f'
3799        real sinth,phi,pig        !(4)        include 'calib.f'
3800    
3801          character*10 PFA
3802          common/FINALPFA/PFA
3803    
3804          real sinth,phi,pig
3805          integer ssensor,sladder
3806        pig=acos(-1.)        pig=acos(-1.)
3807    
       good2=1!.true.  
       chi2_nt(ntr)        = sngl(chi2)  
3808    
3809        phi   = al(4)             !(4)  
3810        sinth = al(3)             !(4)  *     -------------------------------------
3811        if(sinth.lt.0)then        !(4)        chi2_nt(ntr)        = sngl(chi2)
3812           sinth = -sinth         !(4)        nstep_nt(ntr)       = nstep
3813           phi = phi + pig        !(4)  *     -------------------------------------
3814        endif                     !(4)        phi   = al(4)          
3815        npig = aint(phi/(2*pig))  !(4)        sinth = al(3)            
3816        phi = phi - npig*2*pig    !(4)        if(sinth.lt.0)then      
3817        if(phi.lt.0)              !(4)           sinth = -sinth        
3818       $     phi = phi + 2*pig    !(4)           phi = phi + pig      
3819        al(4) = phi               !(4)        endif                    
3820        al(3) = sinth             !(4)        npig = aint(phi/(2*pig))
3821  *****************************************************        phi = phi - npig*2*pig  
3822          if(phi.lt.0)            
3823         $     phi = phi + 2*pig  
3824          al(4) = phi              
3825          al(3) = sinth            
3826        do i=1,5        do i=1,5
3827           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3828           do j=1,5           do j=1,5
3829              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3830           enddo           enddo
 c     print*,al_nt(i,ntr)  
3831        enddo        enddo
3832          *     -------------------------------------      
3833        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
3834           xgood_nt(ip,ntr) = int(xgood(ip))           xgood_nt(ip,ntr) = int(xgood(ip))
3835           ygood_nt(ip,ntr) = int(ygood(ip))           ygood_nt(ip,ntr) = int(ygood(ip))
# Line 3919  c     print*,al_nt(i,ntr) Line 3838  c     print*,al_nt(i,ntr)
3838           zm_nt(ip,ntr)    = sngl(zm(ip))           zm_nt(ip,ntr)    = sngl(zm(ip))
3839           RESX_nt(IP,ntr)  = sngl(resx(ip))           RESX_nt(IP,ntr)  = sngl(resx(ip))
3840           RESY_nt(IP,ntr)  = sngl(resy(ip))           RESY_nt(IP,ntr)  = sngl(resy(ip))
3841             TAILX_nt(IP,ntr) = 0.
3842             TAILY_nt(IP,ntr) = 0.
3843           xv_nt(ip,ntr)    = sngl(xv(ip))           xv_nt(ip,ntr)    = sngl(xv(ip))
3844           yv_nt(ip,ntr)    = sngl(yv(ip))           yv_nt(ip,ntr)    = sngl(yv(ip))
3845           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3846           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3847           ayv_nt(ip,ntr)   = sngl(ayv(ip))           ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3848  c        dedxp(ip,ntr)    = sngl(dedxtrk(ip))   !(1)  
3849           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)           factor = sqrt(
3850           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)                 $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3851        enddo       $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3852  c      call CalcBdL(100,xxxx,IFAIL)       $        1. )
3853  c      if(ifps(xxxx).eq.1)BdL(ntr) = xxxx  
3854  c$$$      print*,'xgood(ip,ntr) ',(xgood_nt(ip,ntr),ip=1,6)           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3855  c$$$      print*,'ygood(ip,ntr) ',(ygood_nt(ip,ntr),ip=1,6)           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3856  c$$$      print*,'dedx_x(ip,ntr) ',(dedx_x(ip,ntr),ip=1,6)    
3857  c$$$      print*,'dedx_y(ip,ntr) ',(dedx_y(ip,ntr),ip=1,6)  
3858    ccc         print*,ip,'dedx >>> ',dedx_x(ip,ntr),dedx_y(ip,ntr)
3859    
3860             ax   = axv_nt(ip,ntr)
3861             ay   = ayv_nt(ip,ntr)
3862             bfx  = BX_STORE(ip,IDCAND)
3863             bfy  = BY_STORE(ip,IDCAND)
3864    c$$$         if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3865    c$$$         if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3866    c$$$         tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3867    c$$$         angx     = 180.*atan(tgtemp)/acos(-1.)
3868    c$$$         tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3869    c$$$         angy    = 180.*atan(tgtemp)/acos(-1.)
3870    
3871             angx = effectiveangle(ax,2*ip,bfy)
3872             angy = effectiveangle(ay,2*ip-1,bfx)
3873            
3874            
3875    
3876             id  = CP_STORE(ip,IDCAND) ! couple id
3877             icl = CLS_STORE(ip,IDCAND)
3878             ssensor = -1
3879             sladder = -1
3880             ssensor = SENSOR_STORE(ip,IDCAND)
3881             sladder = LADDER_STORE(ip,IDCAND)
3882             if(ip.eq.6.and.ssensor.ne.0)ssensor = 3 - ssensor !notazione paolo x align
3883             LS(IP,ntr)      = ssensor+10*sladder
3884    
3885             if(id.ne.0)then
3886    c           >>> is a couple
3887                cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3888                cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3889    
3890                if(clx(nplanes-ip+1,icp_cp(id)).gt.0)then
3891    
3892                   cl_used(cltrx(ip,ntr)) = 1 !tag used clusters          
3893    
3894                   xbad(ip,ntr)= nbadstrips(4,clx(nplanes-ip+1,icp_cp(id)))
3895    
3896                   if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3897         $              dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3898                  
3899                   multmaxx(ip,ntr) = maxs(cltrx(ip,ntr))
3900         $              +10000*mult(cltrx(ip,ntr))
3901                   seedx(ip,ntr)    = clsignal(indmax(cltrx(ip,ntr)))
3902         $              /clsigma(indmax(cltrx(ip,ntr)))
3903                   call applypfa(PFA,cltrx(ip,ntr),angx,corr,res)
3904                   xpu(ip,ntr)      = corr
3905    
3906                endif
3907                if(cly(nplanes-ip+1,icp_cp(id)).gt.0)then
3908    
3909                   cl_used(cltry(ip,ntr)) = 1 !tag used clusters          
3910    
3911                   ybad(ip,ntr)= nbadstrips(4,cly(nplanes-ip+1,icp_cp(id)))
3912    
3913                   if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3914         $              dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3915                  
3916                   multmaxy(ip,ntr) = maxs(cltry(ip,ntr))
3917         $              +10000*mult(cltry(ip,ntr))
3918                   seedy(ip,ntr)    = clsignal(indmax(cltry(ip,ntr)))
3919         $              /clsigma(indmax(cltry(ip,ntr)))
3920                   call applypfa(PFA,cltry(ip,ntr),angy,corr,res)
3921                   ypu(ip,ntr)      = corr
3922                endif
3923    
3924             elseif(icl.ne.0)then
3925    
3926                cl_used(icl) = 1    !tag used clusters          
3927    
3928                if(mod(VIEW(icl),2).eq.0)then
3929                   cltrx(ip,ntr)=icl
3930                   xbad(ip,ntr) = nbadstrips(4,icl)
3931    
3932                   if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3933    
3934                   multmaxx(ip,ntr) = maxs(cltrx(ip,ntr))
3935         $                         +10000*mult(cltrx(ip,ntr))
3936                   seedx(ip,ntr)    = clsignal(indmax(cltrx(ip,ntr)))
3937         $           /clsigma(indmax(cltrx(ip,ntr)))
3938                   call applypfa(PFA,cltrx(ip,ntr),angx,corr,res)
3939                   xpu(ip,ntr)      = corr
3940    
3941                elseif(mod(VIEW(icl),2).eq.1)then
3942                   cltry(ip,ntr)=icl
3943                   ybad(ip,ntr) = nbadstrips(4,icl)
3944    
3945                   if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3946    
3947                   multmaxy(ip,ntr) = maxs(cltry(ip,ntr))
3948         $                         +10000*mult(cltry(ip,ntr))
3949                   seedy(ip,ntr)    = clsignal(indmax(cltry(ip,ntr)))
3950         $           /clsigma(indmax(cltry(ip,ntr)))
3951                   call applypfa(PFA,cltry(ip,ntr),angy,corr,res)
3952                   ypu(ip,ntr)      = corr
3953                  
3954                endif
3955    
3956             endif          
3957    
3958          enddo
3959    
3960          if(DEBUG.eq.1)then
3961             print*,'> STORING TRACK ',ntr
3962             print*,'clusters: '
3963             do ip=1,6
3964                print*,'> ',ip,' -- ',cltrx(ip,ntr),cltry(ip,ntr)
3965             enddo
3966             print*,'dedx: '
3967             do ip=1,6
3968                print*,'> ',ip,' -- ',dedx_x(ip,ntr),dedx_y(ip,ntr)
3969             enddo
3970          endif
3971    
3972        end        end
3973    
3974        subroutine fill_level2_siglets        subroutine fill_level2_siglets
 c*****************************************************  
 c     07/10/2005 created by elena vannuccini  
 c     31/01/2006 modified by elena vannuccini  
 *     to convert adc to mip  --> (2)  
 c*****************************************************  
3975    
3976  *     -------------------------------------------------------  *     -------------------------------------------------------
3977  *     This routine fills the  elements of the variables  *     This routine fills the  elements of the variables
# Line 3952  c*************************************** Line 3980  c***************************************
3980  *     -------------------------------------------------------  *     -------------------------------------------------------
3981    
3982        include 'commontracker.f'        include 'commontracker.f'
       include 'level1.f'  
       include 'level2.f'  
3983        include 'calib.f'        include 'calib.f'
3984          include 'level1.f'
3985        include 'common_momanhough.f'        include 'common_momanhough.f'
3986          include 'level2.f'
3987        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3988    
3989  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
       good2=1!.true.  
3990        nclsx = 0        nclsx = 0
3991        nclsy = 0        nclsy = 0
3992    
3993          do iv = 1,nviews
3994    c         if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
3995             good2(iv) = good2(iv) + mask_view(iv)*2**8
3996          enddo
3997    
3998          if(DEBUG.eq.1)then
3999             print*,'> STORING SINGLETS '
4000          endif
4001    
4002        do icl=1,nclstr1        do icl=1,nclstr1
4003    
4004             ip=nplanes-npl(VIEW(icl))+1            
4005            
4006           if(cl_used(icl).eq.0)then !cluster not included in any track           if(cl_used(icl).eq.0)then !cluster not included in any track
4007              ip=nplanes-npl(VIEW(icl))+1              
4008              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
4009    
4010                 nclsx = nclsx + 1                 nclsx = nclsx + 1
4011                 planex(nclsx) = ip                 planex(nclsx) = ip
4012                 sgnlxs(nclsx) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
4013                   if(nsatstrips(icl).gt.0)sgnlxs(nclsx)=-sgnlxs(nclsx)
4014                   clsx(nclsx)   = icl
4015                   sxbad(nclsx)  = nbadstrips(1,icl)
4016                   multmaxsx(nclsx) = maxs(icl)+10000*mult(icl)
4017                  
4018    
4019                 do is=1,2                 do is=1,2
4020  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
4021                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
4022                      call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
4023                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2
4024                 enddo                 enddo
 c$$$               print*,'nclsx         ',nclsx  
 c$$$               print*,'planex(nclsx) ',planex(nclsx)  
 c$$$               print*,'sgnlxs(nclsx) ',sgnlxs(nclsx)  
 c$$$               print*,'xs(1,nclsx)   ',xs(1,nclsx)  
 c$$$               print*,'xs(2,nclsx)   ',xs(2,nclsx)  
4025              else                          !=== Y views              else                          !=== Y views
4026                 nclsy = nclsy + 1                 nclsy = nclsy + 1
4027                 planey(nclsy) = ip                 planey(nclsy) = ip
4028                 sgnlys(nclsy) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
4029                   if(nsatstrips(icl).gt.0)sgnlys(nclsy)=-sgnlys(nclsy)
4030                   clsy(nclsy)   = icl
4031                   sybad(nclsy)  = nbadstrips(1,icl)
4032                   multmaxsy(nclsy) = maxs(icl)+10000*mult(icl)
4033    
4034    
4035                 do is=1,2                 do is=1,2
4036  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
4037                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
4038                      call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
4039                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2
4040                 enddo                 enddo
 c$$$               print*,'nclsy         ',nclsy  
 c$$$               print*,'planey(nclsy) ',planey(nclsy)  
 c$$$               print*,'sgnlys(nclsy) ',sgnlys(nclsy)  
 c$$$               print*,'ys(1,nclsy)   ',ys(1,nclsy)  
 c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)  
4041              endif              endif
4042           endif           endif
4043  c      print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)  
4044    ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
4045             whichtrack(icl) = cl_used(icl)
4046    *     --------------------------------------------------
4047    *     per non perdere la testa...
4048    *     whichtrack(icl) e` una variabile del common level1
4049    *     che serve solo per sapere quali cluster sono stati
4050    *     associati ad una traccia, e permettere di salvare
4051    *     solo questi nell'albero di uscita
4052    *     --------------------------------------------------
4053                    
4054        enddo        enddo
4055        end        end
4056    
4057    ***************************************************
4058    *                                                 *
4059    *                                                 *
4060    *                                                 *
4061    *                                                 *
4062    *                                                 *
4063    *                                                 *
4064    **************************************************
4065    
4066          subroutine fill_hough
4067    
4068    *     -------------------------------------------------------
4069    *     This routine fills the  variables related to the hough
4070    *     transform, for the debig n-tuple
4071    *     -------------------------------------------------------
4072    
4073          include 'commontracker.f'
4074          include 'level1.f'
4075          include 'common_momanhough.f'
4076          include 'common_hough.f'
4077          include 'level2.f'
4078    
4079          if(.false.
4080         $     .or.ntrpt.gt.ntrpt_max_nt
4081         $     .or.ndblt.gt.ndblt_max_nt
4082         $     .or.NCLOUDS_XZ.gt.ncloxz_max
4083         $     .or.NCLOUDS_yZ.gt.ncloyz_max
4084         $     )then
4085             ntrpt_nt=0
4086             ndblt_nt=0
4087             NCLOUDS_XZ_nt=0
4088             NCLOUDS_YZ_nt=0
4089          else
4090             ndblt_nt=ndblt
4091             ntrpt_nt=ntrpt
4092             if(ndblt.ne.0)then
4093                do id=1,ndblt
4094                   alfayz1_nt(id)=alfayz1(id) !Y0
4095                   alfayz2_nt(id)=alfayz2(id) !tg theta-yz
4096                enddo
4097             endif
4098             if(ndblt.ne.0)then
4099                do it=1,ntrpt
4100                   alfaxz1_nt(it)=alfaxz1(it) !X0
4101                   alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
4102                   alfaxz3_nt(it)=alfaxz3(it) !1/r
4103                enddo
4104             endif
4105             nclouds_yz_nt=nclouds_yz
4106             nclouds_xz_nt=nclouds_xz
4107             if(nclouds_yz.ne.0)then
4108                nnn=0
4109                do iyz=1,nclouds_yz
4110                   ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
4111                   alfayz1_av_nt(iyz)=alfayz1_av(iyz)
4112                   alfayz2_av_nt(iyz)=alfayz2_av(iyz)
4113                   nnn=nnn+ptcloud_yz(iyz)
4114                enddo
4115                do ipt=1,min(ndblt_max_nt,nnn)
4116                   db_cloud_nt(ipt)=db_cloud(ipt)
4117                 enddo
4118             endif
4119             if(nclouds_xz.ne.0)then
4120                nnn=0
4121                do ixz=1,nclouds_xz
4122                   ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
4123                   alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
4124                   alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
4125                   alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
4126                   nnn=nnn+ptcloud_xz(ixz)              
4127                enddo
4128                do ipt=1,min(ntrpt_max_nt,nnn)
4129                  tr_cloud_nt(ipt)=tr_cloud(ipt)
4130                 enddo
4131             endif
4132          endif
4133          end
4134          

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.40

  ViewVC Help
Powered by ViewVC 1.1.23