/[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.38 by pam-fi, Tue Dec 23 11:28:36 2008 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  11111    continue               !<<<<<<< come here when performing a new search
275    
276             if(nclouds_xz.eq.0)goto 880 !go to next event    
277             if(nclouds_yz.eq.0)goto 880 !go to next event    
278    
279  c         iflag=0  c         iflag=0
280           call clouds_to_ctrack(iflag)           call clouds_to_ctrack(iflag)
281           if(iflag.eq.1)then     !no candidate tracks found           if(iflag.eq.1)then     !no candidate tracks found
282              goto 880            !fill ntp and go to next event                goto 880            !fill ntp and go to next event  
283           endif           endif
284             if(ntracks.eq.0)goto 880 !go to next event    
285    
286           FIMAGE=.false.         !processing best track (not track image)           FIMAGE=.false.         !processing best track (not track image)
287           ibest=0                !best track among candidates           ibest=0                !best track among candidates
288           iimage=0               !track image           iimage=0               !track image
289  *     ------------- select the best track -------------  *     ------------- select the best track -------------
290           rchi2best=1000000000.  c$$$         rchi2best=1000000000.
291    c$$$         do i=1,ntracks
292    c$$$            if(RCHI2_STORE(i).lt.rchi2best.and.
293    c$$$     $         RCHI2_STORE(i).gt.0)then
294    c$$$               ibest=i
295    c$$$               rchi2best=RCHI2_STORE(i)
296    c$$$            endif
297    c$$$         enddo
298    c$$$         if(ibest.eq.0)goto 880 !>> no good candidates
299    
300    *     -------------------------------------------------------
301    *     order track-candidates according to:
302    *     1st) decreasing n.points
303    *     2nd) increasing chi**2
304    *     -------------------------------------------------------
305             rchi2best=1000000000.
306             ndofbest=0            
307           do i=1,ntracks           do i=1,ntracks
308              if(RCHI2_STORE(i).lt.rchi2best.and.             ndof=0              
309       $         RCHI2_STORE(i).gt.0)then             do ii=1,nplanes    
310                 ndof=ndof        
311         $            +int(xgood_store(ii,i))
312         $            +int(ygood_store(ii,i))
313               enddo              
314               if(ndof.gt.ndofbest)then
315                 ibest=i
316                 rchi2best=RCHI2_STORE(i)
317                 ndofbest=ndof    
318               elseif(ndof.eq.ndofbest)then
319                 if(RCHI2_STORE(i).lt.rchi2best.and.
320         $            RCHI2_STORE(i).gt.0)then
321                 ibest=i                 ibest=i
322                 rchi2best=RCHI2_STORE(i)                 rchi2best=RCHI2_STORE(i)
323              endif                 ndofbest=ndof  
324                 endif            
325               endif
326           enddo           enddo
327    
328    
329           if(ibest.eq.0)goto 880 !>> no good candidates           if(ibest.eq.0)goto 880 !>> no good candidates
330  *-------------------------------------------------------------------------------      *-------------------------------------------------------------------------------    
331  *     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 344  c         iflag=0
344              iimage=0              iimage=0
345           endif           endif
346           if(icand.eq.0)then           if(icand.eq.0)then
347              print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand              if(VERBOSE.EQ.1)then
348       $           ,ibest,iimage                 print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand
349         $              ,ibest,iimage
350                endif
351              return              return
352           endif           endif
353    
# Line 236  c         iflag=0 Line 358  c         iflag=0
358  *     **********************************************************  *     **********************************************************
359  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
360  *     **********************************************************  *     **********************************************************
361             call guess()
362             do i=1,5
363                AL_GUESS(i)=AL(i)
364             enddo
365    
366           do i=1,5           do i=1,5
367              AL(i)=dble(AL_STORE(i,icand))              AL(i)=dble(AL_STORE(i,icand))            
368           enddo           enddo
369            
370             IDCAND = icand         !fitted track-candidate
371           ifail=0                !error flag in chi2 computation           ifail=0                !error flag in chi2 computation
372           jstep=0                !# minimization steps           jstep=0                !# minimization steps
373    
374           call mini_2(jstep,ifail)           iprint=0
375           if(ifail.ne.0) then  c         if(DEBUG.EQ.1)iprint=1
376              if(DEBUG)then           if(VERBOSE.EQ.1)iprint=1
377             if(DEBUG.EQ.1)iprint=2
378             call mini2(jstep,ifail,iprint)
379    cc         if(ifail.ne.0) then
380             if(ifail.ne.0.or.CHI2.ne.CHI2) then !new
381                if(CHI2.ne.CHI2)CHI2=-9999. !new
382                if(VERBOSE.EQ.1)then
383                 print *,                 print *,
384       $              '*** MINIMIZATION FAILURE *** (mini_2) '       $              '*** MINIMIZATION FAILURE *** (after refinement) '
385       $              ,iev       $              ,iev
386              endif              endif
             chi2=-chi2  
387           endif           endif
388                    
389           if(DEBUG)then           if(DEBUG.EQ.1)then
390              print*,'----------------------------- improved track coord'              print*,'----------------------------- improved track coord'
391  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
392              do ip=1,6              do ip=1,6
# Line 263  c         iflag=0 Line 397  c         iflag=0
397           endif           endif
398    
399  c         rchi2=chi2/dble(ndof)  c         rchi2=chi2/dble(ndof)
400           if(DEBUG)then           if(DEBUG.EQ.1)then
401              print*,' '              print*,' '
402              print*,'****** SELECTED TRACK *************'              print*,'****** SELECTED TRACK *************'
403              print*,'#         R. chi2        RIG'              print*,'#         R. chi2        RIG'
# Line 279  c         rchi2=chi2/dble(ndof) Line 413  c         rchi2=chi2/dble(ndof)
413  *     ------------- search if the track has an IMAGE -------------  *     ------------- search if the track has an IMAGE -------------
414  *     ------------- (also this is stored )           -------------  *     ------------- (also this is stored )           -------------
415           if(FIMAGE)goto 122     !>>> jump! (this is already an image)           if(FIMAGE)goto 122     !>>> jump! (this is already an image)
416  *     now search for track-image, by comparing couples IDs  
417    *     -----------------------------------------------------
418    *     first check if the track is ambiguous
419    *     -----------------------------------------------------
420    *     (modified on august 2007 by ElenaV)
421             is1=0
422             do ip=1,NPLANES
423                if(SENSOR_STORE(ip,icand).ne.0)then
424                   is1=SENSOR_STORE(ip,icand)
425                   if(ip.eq.6)is1=3-is1 !last plane inverted
426                endif
427             enddo
428             if(is1.eq.0)then
429                if(WARNING.EQ.1)print*,'** WARNING ** sensor=0'
430                goto 122            !jump
431             endif
432             do ip=1,NPLANES
433                is2 = SENSOR_STORE(ip,icand) !sensor
434                if(ip.eq.6.and.is2.ne.0)is2=3-is2 !last plane inverted
435                if(
436         $           (is1.ne.is2.and.is2.ne.0)
437         $           )goto 122      !jump (this track cannot have an image)
438             enddo
439             if(DEBUG.eq.1)print*,' >>> ambiguous track! '
440    *     ---------------------------------------------------------------
441    *     take the candidate with the greatest number of matching couples
442    *     if more than one satisfies the requirement,
443    *     choose the one with more points and lower chi2
444    *     ---------------------------------------------------------------
445    *     count the number of matching couples
446             ncpmax = 0
447             iimage   = 0           !id of candidate with better matching
448           do i=1,ntracks           do i=1,ntracks
449              iimage=i              ncp=0
450              do ip=1,nplanes              do ip=1,nplanes
451                 if(     CP_STORE(nplanes-ip+1,icand).ne.                 if(CP_STORE(nplanes-ip+1,icand).ne.0)then
452       $              -1*CP_STORE(nplanes-ip+1,i) )iimage=0                    if(
453         $                 CP_STORE(nplanes-ip+1,i).ne.0
454         $                 .and.
455         $                 CP_STORE(nplanes-ip+1,icand).eq.
456         $                 -1*CP_STORE(nplanes-ip+1,i)
457         $                 )then
458                         ncp=ncp+1  !ok
459                      elseif(
460         $                    CP_STORE(nplanes-ip+1,i).ne.0
461         $                    .and.
462         $                    CP_STORE(nplanes-ip+1,icand).ne.
463         $                    -1*CP_STORE(nplanes-ip+1,i)
464         $                    )then
465                         ncp = 0
466                         goto 117   !it is not an image candidate
467                      else
468                        
469                      endif
470                   endif
471                enddo
472     117        continue
473                trackimage(i)=ncp   !number of matching couples
474                if(ncp>ncpmax)then
475                   ncpmax=ncp
476                   iimage=i
477                endif
478             enddo
479    *     check if there are more than one image candidates
480             ngood=0
481             do i=1,ntracks
482                if( ncpmax.ne.0.and.trackimage(i).eq.ncpmax )ngood=ngood+1
483             enddo
484             if(DEBUG.eq.1)print*,' n.image-candidates : ',ngood
485    *     if there are, choose the best one
486             if(ngood.gt.0)then
487    *     -------------------------------------------------------
488    *     order track-candidates according to:
489    *     1st) decreasing n.points
490    *     2nd) increasing chi**2
491    *     -------------------------------------------------------
492                rchi2best=1000000000.
493                ndofbest=0            
494                do i=1,ntracks
495                   if( trackimage(i).eq.ncpmax )then
496                      ndof=0              
497                      do ii=1,nplanes    
498                         ndof=ndof        
499         $                    +int(xgood_store(ii,i))
500         $                    +int(ygood_store(ii,i))
501                      enddo              
502                      if(ndof.gt.ndofbest)then
503                         iimage=i
504                         rchi2best=RCHI2_STORE(i)
505                         ndofbest=ndof    
506                      elseif(ndof.eq.ndofbest)then
507                         if(RCHI2_STORE(i).lt.rchi2best.and.
508         $                    RCHI2_STORE(i).gt.0)then
509                            iimage=i
510                            rchi2best=RCHI2_STORE(i)
511                            ndofbest=ndof  
512                         endif            
513                      endif
514                   endif
515              enddo              enddo
516              if(  iimage.ne.0.and.  
517  c     $           RCHI2_STORE(i).le.CHI2MAX.and.              if(DEBUG.EQ.1)then
518  c     $           RCHI2_STORE(i).gt.0.and.                 print*,'Track candidate ',iimage
      $           .true.)then  
                if(DEBUG)print*,'Track candidate ',iimage  
519       $              ,' >>> TRACK IMAGE >>> of'       $              ,' >>> TRACK IMAGE >>> of'
520       $              ,ibest       $              ,ibest
                goto 122         !image track found  
521              endif              endif
522           enddo              
523             endif
524    
525    
526   122     continue   122     continue
527    
528    
529  *     --- and store the results --------------------------------  *     --- and store the results --------------------------------
530           ntrk = ntrk + 1                   !counter of found tracks           ntrk = ntrk + 1                   !counter of found tracks
531           if(.not.FIMAGE           if(.not.FIMAGE
# Line 306  c     $           RCHI2_STORE(i).gt.0.an Line 534  c     $           RCHI2_STORE(i).gt.0.an
534       $        .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
535           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
536           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)  
537    
538           if(ntrk.eq.NTRKMAX)then           if(ntrk.eq.NTRKMAX)then
539              if(DEBUG)              if(verbose.eq.1)
540       $           print*,       $           print*,
541       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
542       $           'tracks exceeds vector dimension '       $           'tracks exceeds vector dimension '
# Line 323  cc            good2=.false. Line 549  cc            good2=.false.
549              goto 1212           !>>> fit image-track              goto 1212           !>>> fit image-track
550           endif           endif
551    
 *     --- 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  
 *     **********************************************  
   
   
552    
553   880     return   880     return
554        end        end
555    
556    
   
   
 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$$$  
   
557                
558  ************************************************************  ************************************************************
559  ************************************************************  ************************************************************
# Line 556  c$$$ Line 578  c$$$
578  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)
579  *     angx   - Projected angle in x  *     angx   - Projected angle in x
580  *     angy   - Projected angle in y  *     angy   - Projected angle in y
581    *     bfx    - x-component of magnetci field
582    *     bfy    - y-component of magnetic field
583  *  *
584  *     --------- COUPLES -------------------------------------------------------  *     --------- COUPLES -------------------------------------------------------
585  *     The couple defines a point in the space.  *     The couple defines a point in the space.
# Line 594  c$$$ Line 618  c$$$
618  *  *
619  *  *
620    
621        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,angx,angy)        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
622    
 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*****************************************************  
623                
624        include 'commontracker.f'        include 'commontracker.f'
       include 'calib.f'  
625        include 'level1.f'        include 'level1.f'
626          include 'calib.f'
627        include 'common_align.f'        include 'common_align.f'
628        include 'common_mech.f'        include 'common_mech.f'
629        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
       include 'common_resxy.f'  
   
       logical DEBUG  
       common/dbg/DEBUG  
630    
631        integer icx,icy           !X-Y cluster ID        integer icx,icy           !X-Y cluster ID
632        integer sensor        integer sensor
633        integer viewx,viewy        integer viewx,viewy
634        character*4 PFAx,PFAy     !PFA to be used        character*4 PFAx,PFAy     !PFA to be used
635        real angx,angy            !X-Y angle        real ax,ay                !X-Y geometric angle
636          real angx,angy            !X-Y effective angle
637          real bfx,bfy              !X-Y b-field components
638    
639        real stripx,stripy        real stripx,stripy
640    
641          double precision xi,yi,zi
642          double precision xi_A,yi_A,zi_A
643          double precision xi_B,yi_B,zi_B
644        double precision xrt,yrt,zrt        double precision xrt,yrt,zrt
645        double precision xrt_A,yrt_A,zrt_A        double precision xrt_A,yrt_A,zrt_A
646        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  
647                
648    
649        parameter (ndivx=30)        parameter (ndivx=30)
650    
651    
652                
653        resxPAM = 0        resxPAM = 0
654        resyPAM = 0        resyPAM = 0
655    
656        xPAM = 0.        xPAM = 0.D0
657        yPAM = 0.        yPAM = 0.D0
658        zPAM = 0.        zPAM = 0.D0
659        xPAM_A = 0.        xPAM_A = 0.D0
660        yPAM_A = 0.        yPAM_A = 0.D0
661        zPAM_A = 0.        zPAM_A = 0.D0
662        xPAM_B = 0.        xPAM_B = 0.D0
663        yPAM_B = 0.        yPAM_B = 0.D0
664        zPAM_B = 0.        zPAM_B = 0.D0
665    
666          if(sensor.lt.1.or.sensor.gt.2)then
667             print*,'xyz_PAM   ***ERROR*** wrong input '
668             print*,'sensor ',sensor
669             icx=0
670             icy=0
671          endif
672    
673  *     -----------------  *     -----------------
674  *     CLUSTER X  *     CLUSTER X
675  *     -----------------  *     -----------------      
   
676        if(icx.ne.0)then        if(icx.ne.0)then
677           viewx = VIEW(icx)  
678           nldx = nld(MAXS(icx),VIEW(icx))           viewx   = VIEW(icx)
679           nplx = npl(VIEW(icx))           nldx    = nld(MAXS(icx),VIEW(icx))
680           resxPAM = RESXAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           nplx    = npl(VIEW(icx))
681            c         resxPAM = RESXAV
682           stripx = float(MAXS(icx))           stripx  = float(MAXS(icx))
683           if(PFAx.eq.'COG1')then  !(1)  
684              stripx = stripx      !(1)           if(
685              resxPAM = resxPAM    !(1)       $        viewx.lt.1.or.        
686           elseif(PFAx.eq.'COG2')then       $        viewx.gt.12.or.
687              stripx = stripx + cog(2,icx)                   $        nldx.lt.1.or.
688              resxPAM = resxPAM*fbad_cog(2,icx)       $        nldx.gt.3.or.
689           elseif(PFAx.eq.'ETA2')then       $        stripx.lt.1.or.
690  c            cog2 = cog(2,icx)       $        stripx.gt.3072.or.
691  c            etacorr = pfa_eta2(cog2,viewx,nldx,angx)                   $        .false.)then
692  c            stripx = stripx + etacorr              print*,'xyz_PAM   ***ERROR*** wrong input '
693              stripx = stripx + pfa_eta2(icx,angx)            !(3)              print*,'icx ',icx,'view ',viewx,'nld ',nldx,'strip ',stripx
694              resxPAM = risx_eta2(angx)                       !   (4)              icx = 0
695              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  
696           endif           endif
697    
698        endif  *        --------------------------
699          *        magnetic-field corrections
700    *        --------------------------
701             stripx  = stripx +  fieldcorr(viewx,bfy)      
702             angx    = effectiveangle(ax,viewx,bfy)
703            
704             call applypfa(PFAx,icx,angx,corr,res)
705             stripx  = stripx + corr
706             resxPAM = res
707    
708     10   endif
709        
710  *     -----------------  *     -----------------
711  *     CLUSTER Y  *     CLUSTER Y
712  *     -----------------  *     -----------------
713    
714        if(icy.ne.0)then        if(icy.ne.0)then
715    
716           viewy = VIEW(icy)           viewy = VIEW(icy)
717           nldy = nld(MAXS(icy),VIEW(icy))           nldy = nld(MAXS(icy),VIEW(icy))
718           nply = npl(VIEW(icy))           nply = npl(VIEW(icy))
719           resyPAM = RESYAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!  c         resyPAM = RESYAV
720             stripy = float(MAXS(icy))
721    
722             if(
723         $        viewy.lt.1.or.        
724         $        viewy.gt.12.or.
725         $        nldy.lt.1.or.
726         $        nldy.gt.3.or.
727         $        stripy.lt.1.or.
728         $        stripy.gt.3072.or.
729         $        .false.)then
730                print*,'xyz_PAM   ***ERROR*** wrong input '
731                print*,'icy ',icy,'view ',viewy,'nld ',nldy,'strip ',stripy
732                icy = 0
733                goto 20
734             endif
735    
736           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
737              print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '              if(DEBUG.EQ.1) then
738       $           ,icx,icy                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '
739         $              ,icx,icy
740                endif
741              goto 100              goto 100
742           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  
743    
744        endif  *        --------------------------
745    *        magnetic-field corrections
746    *        --------------------------
747             stripy  = stripy +  fieldcorr(viewy,bfx)      
748             angy    = effectiveangle(ay,viewy,bfx)
749            
750             call applypfa(PFAy,icy,angy,corr,res)
751             stripy  = stripy + corr
752             resyPAM = res
753    
754     20   endif
755    
756    
         
757  c===========================================================  c===========================================================
758  C     COUPLE  C     COUPLE
759  C===========================================================  C===========================================================
# Line 772  C======================================= Line 762  C=======================================
762  c------------------------------------------------------------------------  c------------------------------------------------------------------------
763  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame
764  c------------------------------------------------------------------------  c------------------------------------------------------------------------
765           xi = acoordsi(stripx,viewx)           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
766           yi = acoordsi(stripy,viewy)       $        .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
767           zi = 0.              if(DEBUG.EQ.1) then
768                   print*,'xyz_PAM (couple):',
769         $              ' WARNING: false X strip: strip ',stripx
770                endif
771             endif
772             xi = dcoordsi(stripx,viewx)
773             yi = dcoordsi(stripy,viewy)
774             zi = 0.D0
775                    
   
776  c------------------------------------------------------------------------  c------------------------------------------------------------------------
777  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
778  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 810  c--------------------------------------- Line 806  c---------------------------------------
806           yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4           yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4
807           zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4           zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4
808    
809           xPAM_A = 0.           xPAM_A = 0.D0
810           yPAM_A = 0.           yPAM_A = 0.D0
811           zPAM_A = 0.           zPAM_A = 0.D0
812    
813           xPAM_B = 0.           xPAM_B = 0.D0
814           yPAM_B = 0.           yPAM_B = 0.D0
815           zPAM_B = 0.           zPAM_B = 0.D0
816    
817        elseif(        elseif(
818       $        (icx.ne.0.and.icy.eq.0).or.       $        (icx.ne.0.and.icy.eq.0).or.
# Line 836  C======================================= Line 832  C=======================================
832              nldx = nldy              nldx = nldy
833              viewx = viewy + 1              viewx = viewy + 1
834    
835              yi   = acoordsi(stripy,viewy)              xi = dcoordsi(0.5*(nstrips+1),viewx) !sensor center
836                yi = dcoordsi(stripy,viewy)
837                zi = 0.D0
838    
839              xi_A = edgeY_d - SiDimX/2              xi_A = edgeY_d - SiDimX/2
840              yi_A = yi              yi_A = yi
# Line 846  C======================================= Line 844  C=======================================
844              yi_B = yi              yi_B = yi
845              zi_B = 0.              zi_B = 0.
846    
 c            print*,'Y-cl ',icy,stripy,' --> ',yi  
 c            print*,xi_A,' <--> ',xi_B  
847                            
848           elseif(icx.ne.0)then           elseif(icx.ne.0)then
849  c===========================================================  c===========================================================
# Line 858  C======================================= Line 854  C=======================================
854              nldy = nldx              nldy = nldx
855              viewy = viewx - 1              viewy = viewx - 1
856    
857              xi   = acoordsi(stripx,viewx)              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
858         $           .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
859                   if(DEBUG.EQ.1) then
860                      print*,'xyz_PAM (X-singlet):',
861         $                 ' WARNING: false X strip: strip ',stripx
862                   endif
863                endif
864    
865                xi = dcoordsi(stripx,viewx)
866                yi = dcoordsi(0.5*(nstrips+1),viewy) !sensor center
867                zi = 0.D0
868    
869              xi_A = xi              xi_A = xi
870              yi_A = edgeX_d - SiDimY/2              yi_A = edgeX_d - SiDimY/2
# Line 874  C======================================= Line 880  C=======================================
880                 yi_B = yi                 yi_B = yi
881              endif              endif
882    
 c            print*,'X-cl ',icx,stripx,' --> ',xi  
 c            print*,yi_A,' <--> ',yi_B  
883    
884           else           else
885                if(DEBUG.EQ.1) then
886              print *,'routine xyz_PAM ---> not properly used !!!'                 print *,'routine xyz_PAM ---> not properly used !!!'
887              print *,'icx = ',icx                 print *,'icx = ',icx
888              print *,'icy = ',icy                 print *,'icy = ',icy
889                endif
890              goto 100              goto 100
891                            
892           endif           endif
# Line 920  c     N.B. I convert angles from microra Line 925  c     N.B. I convert angles from microra
925       $        + zi_B       $        + zi_B
926       $        + dz(nplx,nldx,sensor)       $        + dz(nplx,nldx,sensor)
927    
928    
929    
930             xrt = xi
931         $        - omega(nplx,nldx,sensor)*yi
932         $        + gamma(nplx,nldx,sensor)*zi
933         $        + dx(nplx,nldx,sensor)
934            
935             yrt = omega(nplx,nldx,sensor)*xi
936         $        + yi
937         $        - beta(nplx,nldx,sensor)*zi
938         $        + dy(nplx,nldx,sensor)
939            
940             zrt = -gamma(nplx,nldx,sensor)*xi
941         $        + beta(nplx,nldx,sensor)*yi
942         $        + zi
943         $        + dz(nplx,nldx,sensor)
944    
945    
946                    
947  c      xrt = xi  c      xrt = xi
948  c      yrt = yi  c      yrt = yi
# Line 930  c     (xPAM,yPAM,zPAM) = measured coordi Line 953  c     (xPAM,yPAM,zPAM) = measured coordi
953  c                        in PAMELA reference system  c                        in PAMELA reference system
954  c------------------------------------------------------------------------  c------------------------------------------------------------------------
955    
956           xPAM = 0.           xPAM = dcoord(xrt,viewx,nldx,sensor) / 1.d4
957           yPAM = 0.           yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4
958           zPAM = 0.           zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4
959    c$$$         xPAM = 0.D0
960    c$$$         yPAM = 0.D0
961    c$$$         zPAM = 0.D0
962    
963           xPAM_A = dcoord(xrt_A,viewx,nldx,sensor) / 1.d4           xPAM_A = dcoord(xrt_A,viewx,nldx,sensor) / 1.d4
964           yPAM_A = dcoord(yrt_A,viewy,nldy,sensor) / 1.d4           yPAM_A = dcoord(yrt_A,viewy,nldy,sensor) / 1.d4
# Line 943  c--------------------------------------- Line 969  c---------------------------------------
969           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
970                    
971    
 c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'  
972    
973        else        else
974                       if(DEBUG.EQ.1) then
975           print *,'routine xyz_PAM ---> not properly used !!!'              print *,'routine xyz_PAM ---> not properly used !!!'
976           print *,'icx = ',icx              print *,'icx = ',icx
977           print *,'icy = ',icy              print *,'icy = ',icy
978                         endif
979        endif        endif
980                    
981    
982    
983   100  continue   100  continue
984        end        end
985    
986    ************************************************************************
987    *     Call xyz_PAM subroutine with default PFA and fill the mini2 common.
988    *     (done to be called from c/c++)
989    ************************************************************************
990    
991          subroutine xyzpam(ip,icx,icy,lad,sensor,ax,ay,bfx,bfy)
992    
993          include 'commontracker.f'
994          include 'level1.f'
995          include 'common_mini_2.f'
996          include 'common_xyzPAM.f'
997          include 'common_mech.f'
998          include 'calib.f'
999          
1000    *     flag to chose PFA
1001    c$$$      character*10 PFA
1002    c$$$      common/FINALPFA/PFA
1003    
1004          integer icx,icy           !X-Y cluster ID
1005          integer sensor
1006          character*4 PFAx,PFAy     !PFA to be used
1007          real ax,ay                !X-Y geometric angle
1008          real bfx,bfy              !X-Y b-field components
1009    
1010          ipx=0
1011          ipy=0      
1012          
1013    c$$$      PFAx = 'COG4'!PFA
1014    c$$$      PFAy = 'COG4'!PFA
1015    
1016    
1017          if(icx.gt.nclstr1.or.icy.gt.nclstr1)then
1018                print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1019         $           ,' do not exists (n.clusters=',nclstr1,')'
1020                icx = -1*icx
1021                icy = -1*icy
1022                return
1023            
1024          endif
1025          
1026          call idtoc(pfaid,PFAx)
1027          call idtoc(pfaid,PFAy)
1028    
1029          
1030          if(icx.ne.0.and.icy.ne.0)then
1031    
1032             ipx=npl(VIEW(icx))
1033             ipy=npl(VIEW(icy))
1034            
1035             if( (nplanes-ipx+1).ne.ip )then
1036                print*,'xyzpam: ***WARNING*** cluster ',icx
1037         $           ,' does not belong to plane: ',ip
1038                icx = -1*icx
1039                return
1040             endif
1041             if( (nplanes-ipy+1).ne.ip )then
1042                print*,'xyzpam: ***WARNING*** cluster ',icy
1043         $           ,' does not belong to plane: ',ip
1044                icy = -1*icy
1045                return
1046             endif
1047    
1048             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1049    
1050             xgood(ip) = 1.
1051             ygood(ip) = 1.
1052             resx(ip)  = resxPAM
1053             resy(ip)  = resyPAM
1054    
1055             xm(ip) = xPAM
1056             ym(ip) = yPAM
1057             zm(ip) = zPAM
1058             xm_A(ip) = 0.D0
1059             ym_A(ip) = 0.D0
1060             xm_B(ip) = 0.D0
1061             ym_B(ip) = 0.D0
1062    
1063    c         zv(ip) = zPAM
1064    
1065          elseif(icx.eq.0.and.icy.ne.0)then
1066    
1067             ipy=npl(VIEW(icy))
1068             if( (nplanes-ipy+1).ne.ip )then
1069                print*,'xyzpam: ***WARNING*** cluster ',icy
1070         $           ,' does not belong to plane: ',ip
1071                icy = -1*icy
1072                return
1073             endif
1074    
1075             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1076            
1077             xgood(ip) = 0.
1078             ygood(ip) = 1.
1079             resx(ip)  = 1000.
1080             resy(ip)  = resyPAM
1081    
1082    c$$$         xm(ip) = -100.
1083    c$$$         ym(ip) = -100.
1084    c$$$         zm(ip) = (zPAM_A+zPAM_B)/2.
1085             xm(ip) = xPAM
1086             ym(ip) = yPAM
1087             zm(ip) = zPAM
1088             xm_A(ip) = xPAM_A
1089             ym_A(ip) = yPAM_A
1090             xm_B(ip) = xPAM_B
1091             ym_B(ip) = yPAM_B
1092    
1093    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1094            
1095          elseif(icx.ne.0.and.icy.eq.0)then
1096    
1097             ipx=npl(VIEW(icx))
1098    
1099             if( (nplanes-ipx+1).ne.ip )then
1100                print*,'xyzpam: ***WARNING*** cluster ',icx
1101         $           ,' does not belong to plane: ',ip
1102                icx = -1*icx
1103                return
1104             endif
1105    
1106             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1107          
1108             xgood(ip) = 1.
1109             ygood(ip) = 0.
1110             resx(ip)  = resxPAM
1111             resy(ip)  = 1000.
1112    
1113    c$$$         xm(ip) = -100.
1114    c$$$         ym(ip) = -100.
1115    c$$$         zm(ip) = (zPAM_A+zPAM_B)/2.
1116             xm(ip) = xPAM
1117             ym(ip) = yPAM
1118             zm(ip) = zPAM
1119             xm_A(ip) = xPAM_A
1120             ym_A(ip) = yPAM_A
1121             xm_B(ip) = xPAM_B
1122             ym_B(ip) = yPAM_B
1123            
1124    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1125    
1126          else
1127    
1128             il = 2
1129             if(lad.ne.0)il=lad
1130             is = 1
1131             if(sensor.ne.0)is=sensor
1132    
1133             xgood(ip) = 0.
1134             ygood(ip) = 0.
1135             resx(ip)  = 1000.
1136             resy(ip)  = 1000.
1137    
1138             xm(ip) = -100.
1139             ym(ip) = -100.          
1140             zm(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1141             xm_A(ip) = 0.
1142             ym_A(ip) = 0.
1143             xm_B(ip) = 0.
1144             ym_B(ip) = 0.
1145    
1146    c         zv(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1147    
1148          endif
1149    
1150          if(DEBUG.EQ.1)then
1151    22222    format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
1152             write(*,22222)ip,zm(ip),xm(ip),ym(ip)
1153         $        ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip)
1154         $        ,xgood(ip),ygood(ip),resx(ip),resy(ip)
1155          endif
1156          end
1157    
1158  ********************************************************************************  ********************************************************************************
1159  ********************************************************************************  ********************************************************************************
# Line 977  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1175  c         print*,'A-(',xPAM_A,yPAM_A,')
1175  *      *    
1176  ********************************************************************************  ********************************************************************************
1177    
1178        real function distance_to(XPP,YPP)        real function distance_to(rXPP,rYPP)
1179    
1180        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1181    
# Line 986  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1184  c         print*,'A-(',xPAM_A,yPAM_A,')
1184  *     ( i.e. distance/resolution )  *     ( i.e. distance/resolution )
1185  *     -----------------------------------  *     -----------------------------------
1186    
1187          real rXPP,rYPP
1188          double precision XPP,YPP
1189        double precision distance,RE        double precision distance,RE
1190        double precision BETA,ALFA,xmi,ymi        double precision BETA,ALFA,xmi,ymi
1191    
1192          XPP=DBLE(rXPP)
1193          YPP=DBLE(rYPP)
1194    
1195  *     ----------------------  *     ----------------------
1196        if (        if (
1197       +     xPAM.eq.0.and.  c$$$     +     xPAM.eq.0.and.
1198       +     yPAM.eq.0.and.  c$$$     +     yPAM.eq.0.and.
1199       +     zPAM.eq.0.and.  c$$$     +     zPAM.eq.0.and.
1200       +     xPAM_A.ne.0.and.       +     xPAM_A.ne.0.and.
1201       +     yPAM_A.ne.0.and.       +     yPAM_A.ne.0.and.
1202       +     zPAM_A.ne.0.and.       +     zPAM_A.ne.0.and.
# Line 1031  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1234  c         print*,'A-(',xPAM_A,yPAM_A,')
1234           endif                   endif        
1235    
1236           distance=           distance=
1237       $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2       $       ((xmi-XPP)**2+(ymi-YPP)**2)!QUIQUI
1238    cc     $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1239           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1240    
 c$$$         print*,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b  
 c$$$     $        ,' --- distance_to --- ',xpp,ypp  
 c$$$         print*,' resolution ',re  
1241    
1242                    
1243  *     ----------------------  *     ----------------------
1244        elseif(        elseif(
1245       +     xPAM.ne.0.and.  c$$$     +     xPAM.ne.0.and.
1246       +     yPAM.ne.0.and.  c$$$     +     yPAM.ne.0.and.
1247       +     zPAM.ne.0.and.  c$$$     +     zPAM.ne.0.and.
1248       +     xPAM_A.eq.0.and.       +     xPAM_A.eq.0.and.
1249       +     yPAM_A.eq.0.and.       +     yPAM_A.eq.0.and.
1250       +     zPAM_A.eq.0.and.       +     zPAM_A.eq.0.and.
# Line 1056  c$$$         print*,' resolution ',re Line 1257  c$$$         print*,' resolution ',re
1257  *     ----------------------  *     ----------------------
1258                    
1259           distance=           distance=
1260       $        ((xPAM-XPP)/resxPAM)**2       $       ((xPAM-XPP))**2 !QUIQUI
1261       $        +       $       +
1262       $        ((yPAM-YPP)/resyPAM)**2       $       ((yPAM-YPP))**2
1263    c$$$     $        ((xPAM-XPP)/resxPAM)**2
1264    c$$$     $        +
1265    c$$$     $        ((yPAM-YPP)/resyPAM)**2
1266           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1267    
 c$$$         print*,xPAM,yPAM,zPAM  
 c$$$     $        ,' --- distance_to --- ',xpp,ypp  
 c$$$         print*,' resolution ',resxPAM,resyPAM  
1268                    
1269        else        else
1270                    
          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  
1271        endif          endif  
1272    
1273        distance_to = sngl(distance)        distance_to = sngl(distance)
# Line 1111  c$$$         print*,' resolution ',resxP Line 1307  c$$$         print*,' resolution ',resxP
1307        data c1/1.,0.,0.,1./        data c1/1.,0.,0.,1./
1308        data c2/1.,-1.,-1.,1./        data c2/1.,-1.,-1.,1./
1309        data c3/1.,1.,0.,0./        data c3/1.,1.,0.,0./
1310        real*8 yvvv,xvvv        double precision yvvv,xvvv
1311        double precision xi,yi,zi        double precision xi,yi,zi
1312        double precision xrt,yrt,zrt        double precision xrt,yrt,zrt
1313        real AA,BB        real AA,BB
1314        real yvv(4),xvv(4)        double precision yvv(4),xvv(4)
1315    
1316  *     tollerance to consider the track inside the sensitive area  *     tollerance to consider the track inside the sensitive area
1317        real ptoll        real ptoll
1318        data ptoll/150./          !um        data ptoll/150./          !um
1319    
1320        external nviewx,nviewy,acoordsi,dcoord        external nviewx,nviewy,dcoordsi,dcoord
1321    
1322        nplpt = nplPAM            !plane        nplpt = nplPAM            !plane
1323        viewx = nviewx(nplpt)        viewx = nviewx(nplpt)
# Line 1136  c$$$         print*,' resolution ',resxP Line 1332  c$$$         print*,' resolution ',resxP
1332  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1333  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame
1334  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1335                 xi = acoordsi(stripx,viewx)                 xi = dcoordsi(stripx,viewx)
1336                 yi = acoordsi(stripy,viewy)                 yi = dcoordsi(stripy,viewy)
1337                 zi = 0.                 zi = 0.D0
1338  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1339  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
1340  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 1163  c--------------------------------------- Line 1359  c---------------------------------------
1359    
1360                 yvv(iv)=sngl(yvvv)                 yvv(iv)=sngl(yvvv)
1361                 xvv(iv)=sngl(xvvv)                 xvv(iv)=sngl(xvvv)
 c               print*,'LADDER ',il,' SENSOR ',is,' vertexes >> '  
 c     $              ,iv,xvv(iv),yvv(iv)  
1362              enddo               !end loop on sensor vertexes              enddo               !end loop on sensor vertexes
1363    
1364              dtot=0.              dtot=0.
# Line 1263  c     $              ,iv,xvv(iv),yvv(iv) Line 1457  c     $              ,iv,xvv(iv),yvv(iv)
1457  *     it returns the plane number  *     it returns the plane number
1458  *      *    
1459        include 'commontracker.f'        include 'commontracker.f'
1460          include 'level1.f'
1461  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1462        include 'common_momanhough.f'        include 'common_momanhough.f'
1463                
# Line 1288  c      include 'common_analysis.f' Line 1483  c      include 'common_analysis.f'
1483        is_cp=0        is_cp=0
1484        if(id.lt.0)is_cp=1        if(id.lt.0)is_cp=1
1485        if(id.gt.0)is_cp=2        if(id.gt.0)is_cp=2
       if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'  
1486    
1487        return        return
1488        end        end
# Line 1300  c      include 'common_analysis.f' Line 1494  c      include 'common_analysis.f'
1494  *     it returns the id number ON THE PLANE  *     it returns the id number ON THE PLANE
1495  *      *    
1496        include 'commontracker.f'        include 'commontracker.f'
1497          include 'level1.f'
1498  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1499        include 'common_momanhough.f'        include 'common_momanhough.f'
1500                
# Line 1328  c      include 'common_analysis.f' Line 1523  c      include 'common_analysis.f'
1523  *     positive if sensor =2  *     positive if sensor =2
1524  *  *
1525        include 'commontracker.f'        include 'commontracker.f'
1526          include 'level1.f'
1527  c      include 'calib.f'  c      include 'calib.f'
1528  c      include 'level1.f'  c      include 'level1.f'
1529  c      include 'common_analysis.f'  c      include 'common_analysis.f'
# Line 1357  c      include 'common_analysis.f' Line 1553  c      include 'common_analysis.f'
1553  *************************************************************************  *************************************************************************
1554  *************************************************************************  *************************************************************************
1555  *************************************************************************  *************************************************************************
 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  
1556                
1557    
1558  ***************************************************  ***************************************************
# Line 1639  c$$$      end Line 1567  c$$$      end
1567        subroutine cl_to_couples(iflag)        subroutine cl_to_couples(iflag)
1568    
1569        include 'commontracker.f'        include 'commontracker.f'
1570          include 'level1.f'
1571        include 'common_momanhough.f'        include 'common_momanhough.f'
1572        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1573        include 'calib.f'        include 'calib.f'
1574        include 'level1.f'  c      include 'level1.f'
   
       logical DEBUG  
       common/dbg/DEBUG  
1575    
1576  *     output flag  *     output flag
1577  *     --------------  *     --------------
# Line 1654  c$$$      end Line 1580  c$$$      end
1580  *     --------------  *     --------------
1581        integer iflag        integer iflag
1582    
1583        integer badseed,badcl        integer badseed,badclx,badcly
1584        
1585          if(DEBUG.EQ.1)print*,'cl_to_couples:'
1586    
1587    cc      if(RECOVER_SINGLETS.and..not.SECOND_SEARCH)goto 80
1588    
1589  *     init variables  *     init variables
       ncp_tot=0  
1590        do ip=1,nplanes        do ip=1,nplanes
1591           do ico=1,ncouplemax           do ico=1,ncouplemax
1592              clx(ip,ico)=0              clx(ip,ico)=0
# Line 1670  c$$$      end Line 1599  c$$$      end
1599           ncls(ip)=0           ncls(ip)=0
1600        enddo        enddo
1601        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1602           cl_single(icl)=1           cl_single(icl) = 1     !all are single
1603           cl_good(icl)=0           cl_good(icl)   = 0     !all are bad
1604          enddo
1605          do iv=1,nviews
1606             ncl_view(iv)  = 0
1607             mask_view(iv) = 0      !all included
1608        enddo        enddo
1609                
1610    *     count number of cluster per view
1611          do icl=1,nclstr1
1612             ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1        
1613          enddo
1614    *     mask views with too many clusters
1615          do iv=1,nviews
1616             if( ncl_view(iv).gt. nclusterlimit)then
1617    c            mask_view(iv) = 1
1618                mask_view(iv) = mask_view(iv) + 2**0
1619                if(DEBUG.EQ.1)
1620         $        print*,' * WARNING * cl_to_couple: n.clusters > '
1621         $        ,nclusterlimit,' on view ', iv,' --> masked!'
1622             endif
1623          enddo
1624    
1625    
1626  *     start association  *     start association
1627        ncouples=0        ncouples=0
1628        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1629           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1630                    
1631             if(cl_used(icx).ne.0)goto 10
1632    
1633    *     ----------------------------------------------------
1634    *     jump masked views (X VIEW)
1635    *     ----------------------------------------------------
1636             if( mask_view(VIEW(icx)).ne.0 ) goto 10
1637  *     ----------------------------------------------------  *     ----------------------------------------------------
1638  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1639           if(dedx(icx).lt.dedx_x_min)then  *     ----------------------------------------------------
1640             if(sgnl(icx)/mip(VIEW(icx),LADDER(icx)).lt.dedx_x_min)then
1641              cl_single(icx)=0              cl_single(icx)=0
1642              goto 10              goto 10
1643           endif           endif
1644    *     ----------------------------------------------------
1645  *     cut BAD (X VIEW)              *     cut BAD (X VIEW)            
1646    *     ----------------------------------------------------
1647           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
1648           ifirst=INDSTART(icx)           ifirst=INDSTART(icx)
1649           if(icx.ne.nclstr1) then           if(icx.ne.nclstr1) then
# Line 1693  c$$$      end Line 1651  c$$$      end
1651           else           else
1652              ilast=TOTCLLENGTH              ilast=TOTCLLENGTH
1653           endif           endif
1654           badcl=badseed           badclx=badseed
1655           do igood=-ngoodstr,ngoodstr           do igood=-ngoodstr,ngoodstr
1656              ibad=1              ibad=1
1657              if((INDMAX(icx)+igood).gt.ifirst.and.              if((INDMAX(icx)+igood).gt.ifirst.and.
# Line 1703  c$$$      end Line 1661  c$$$      end
1661       $              nvk(MAXS(icx)+igood),       $              nvk(MAXS(icx)+igood),
1662       $              nst(MAXS(icx)+igood))       $              nst(MAXS(icx)+igood))
1663              endif              endif
1664              badcl=badcl*ibad              badclx=badclx*ibad
1665           enddo           enddo
1666    *     ----------------------------------------------------
1667    *     >>> eliminato il taglio sulle BAD <<<
1668    *     ----------------------------------------------------
1669  c     if(badcl.eq.0)then  c     if(badcl.eq.0)then
1670  c     cl_single(icx)=0  c     cl_single(icx)=0
1671  c     goto 10  c     goto 10
# Line 1717  c     endif Line 1678  c     endif
1678                    
1679           do icy=1,nclstr1       !loop on cluster (Y)           do icy=1,nclstr1       !loop on cluster (Y)
1680              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1681    
1682                if(cl_used(icx).ne.0)goto 20
1683                            
1684  *     ----------------------------------------------------  *     ----------------------------------------------------
1685    *     jump masked views (Y VIEW)
1686    *     ----------------------------------------------------
1687                if( mask_view(VIEW(icy)).ne.0 ) goto 20
1688    
1689    *     ----------------------------------------------------
1690  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1691              if(dedx(icy).lt.dedx_y_min)then  *     ----------------------------------------------------
1692                if(sgnl(icy)/mip(VIEW(icy),LADDER(icy)) .lt.dedx_y_min)then
1693                 cl_single(icy)=0                 cl_single(icy)=0
1694                 goto 20                 goto 20
1695              endif              endif
1696    *     ----------------------------------------------------
1697  *     cut BAD (Y VIEW)              *     cut BAD (Y VIEW)            
1698    *     ----------------------------------------------------
1699              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
1700              ifirst=INDSTART(icy)              ifirst=INDSTART(icy)
1701              if(icy.ne.nclstr1) then              if(icy.ne.nclstr1) then
# Line 1732  c     endif Line 1703  c     endif
1703              else              else
1704                 ilast=TOTCLLENGTH                 ilast=TOTCLLENGTH
1705              endif              endif
1706              badcl=badseed              badcly=badseed
1707              do igood=-ngoodstr,ngoodstr              do igood=-ngoodstr,ngoodstr
1708                 ibad=1                 ibad=1
1709                 if((INDMAX(icy)+igood).gt.ifirst.and.                 if((INDMAX(icy)+igood).gt.ifirst.and.
# Line 1741  c     endif Line 1712  c     endif
1712       $              ibad=BAD(VIEW(icy),       $              ibad=BAD(VIEW(icy),
1713       $              nvk(MAXS(icy)+igood),       $              nvk(MAXS(icy)+igood),
1714       $              nst(MAXS(icy)+igood))       $              nst(MAXS(icy)+igood))
1715                 badcl=badcl*ibad                 badcly=badcly*ibad
1716              enddo              enddo
1717    *     ----------------------------------------------------
1718    *     >>> eliminato il taglio sulle BAD <<<
1719    *     ----------------------------------------------------
1720  c     if(badcl.eq.0)then  c     if(badcl.eq.0)then
1721  c     cl_single(icy)=0  c     cl_single(icy)=0
1722  c     goto 20  c     goto 20
1723  c     endif  c     endif
1724  *     ----------------------------------------------------  *     ----------------------------------------------------
1725                            
               
1726              cl_good(icy)=1                                cl_good(icy)=1                  
1727              nply=npl(VIEW(icy))              nply=npl(VIEW(icy))
1728              nldy=nld(MAXS(icy),VIEW(icy))              nldy=nld(MAXS(icy),VIEW(icy))
# Line 1760  c     endif Line 1733  c     endif
1733  *     geometrical consistency (same plane and ladder)  *     geometrical consistency (same plane and ladder)
1734              if(nply.eq.nplx.and.nldy.eq.nldx)then              if(nply.eq.nplx.and.nldy.eq.nldx)then
1735  *     charge correlation  *     charge correlation
1736                 ddd=(dedx(icy)  *     (modified to be applied only below saturation... obviously)
1737       $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  
1738                 ddd=ddd/sqrt(kch(nplx,nldx)**2+1)                 if(  .not.(sgnl(icy).gt.chsaty.and.sgnl(icx).gt.chsatx)
1739                 cut=chcut*sch(nplx,nldx)       $              .and.
1740                 if(abs(ddd).gt.cut)goto 20 !charge not consistent       $              .not.(sgnl(icy).lt.chmipy.and.sgnl(icx).lt.chmipx)
1741                       $              .and.
1742                       $              (badclx.eq.1.and.badcly.eq.1)
1743  *     ------------------> COUPLE <------------------       $              .and.
1744  *     check to do not overflow vector dimentions       $              .true.)then
1745                 if(ncp_plane(nplx).gt.ncouplemax)then  
1746                    if(DEBUG)print*,                    ddd=(sgnl(icy)
1747       $                    ' ** warning ** number of identified'//       $                 -kch(nplx,nldx)*sgnl(icx)-cch(nplx,nldx))
1748       $                    ' couples on plane ',nplx,                    ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
1749       $                    ' exceeds vector dimention'//  
1750       $                    ' ( ',ncouplemax,' )'  c                  cut = chcut * sch(nplx,nldx)
1751  c     good2=.false.  
1752  c     goto 880   !fill ntp and go to next event                    sss=(kch(nplx,nldx)*sgnl(icy)+sgnl(icx)
1753                    iflag=1       $                 -kch(nplx,nldx)*cch(nplx,nldx))
1754                    return                    sss=sss/sqrt(kch(nplx,nldx)**2+1)
1755                      cut = chcut * (16 + sss/50.)
1756    
1757                      if(abs(ddd).gt.cut)then
1758                         goto 20    !charge not consistent
1759                      endif
1760                 endif                 endif
1761                  
1762                 if(ncp_plane(nplx).eq.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
1763                    if(DEBUG)print*,                    if(verbose.eq.1)print*,
1764       $                 '** warning ** number of identified '//       $                 '** warning ** number of identified '//
1765       $                 'couples on plane ',nplx,       $                 'couples on plane ',nplx,
1766       $                 'exceeds vector dimention '       $                 'exceeds vector dimention '
1767       $                 ,'( ',ncouplemax,' )'       $                 ,'( ',ncouplemax,' ) --> masked!'
1768  c     good2=.false.  c                  mask_view(nviewx(nplx)) = 2
1769  c     goto 880   !fill ntp and go to next event                      c                  mask_view(nviewy(nply)) = 2
1770                    iflag=1                    mask_view(nviewx(nplx))= mask_view(nviewx(nplx))+ 2**1
1771                    return                    mask_view(nviewy(nply))= mask_view(nviewy(nply))+ 2**1
1772                      goto 10
1773                 endif                 endif
1774                                
1775    *     ------------------> COUPLE <------------------
1776                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
1777                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
1778                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
1779                 cl_single(icx)=0                 cl_single(icx)=0
1780                 cl_single(icy)=0                 cl_single(icy)=0
             endif                                
1781  *     ----------------------------------------------  *     ----------------------------------------------
1782    
1783                endif                              
1784    
1785   20         continue   20         continue
1786           enddo                  !end loop on clusters(Y)           enddo                  !end loop on clusters(Y)
1787                    
1788   10      continue   10      continue
1789        enddo                     !end loop on clusters(X)        enddo                     !end loop on clusters(X)
1790                
         
1791        do icl=1,nclstr1        do icl=1,nclstr1
1792           if(cl_single(icl).eq.1)then           if(cl_single(icl).eq.1)then
1793              ip=npl(VIEW(icl))              ip=npl(VIEW(icl))
# Line 1815  c     goto 880   !fill ntp and go to nex Line 1795  c     goto 880   !fill ntp and go to nex
1795              cls(ip,ncls(ip))=icl              cls(ip,ncls(ip))=icl
1796           endif           endif
1797        enddo        enddo
1798    
1799     80   continue
1800                
1801                
1802        if(DEBUG)then        if(DEBUG.EQ.1)then
1803           print*,'clusters  ',nclstr1           print*,'clusters  ',nclstr1
1804           print*,'good    ',(cl_good(i),i=1,nclstr1)           print*,'good    ',(cl_good(i),i=1,nclstr1)
1805           print*,'singles ',(cl_single(i),i=1,nclstr1)           print*,'used    ',(cl_used(i),i=1,nclstr1)
1806             print*,'singlets',(cl_single(i),i=1,nclstr1)
1807           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
1808        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)  
   
       include 'commontracker.f'  
       include 'common_momanhough.f'  
       include 'momanhough_init.f'  
       include 'calib.f'  
       include 'level1.f'  
   
       logical DEBUG  
       common/dbg/DEBUG  
1809    
1810  *     output flag    
1811  *     --------------        if(.not.RECOVER_SINGLETS)goto 81
 *     0 = good event  
 *     1 = bad event  
 *     --------------  
       integer iflag  
1812    
1813        integer badseed,badcl  *     ////////////////////////////////////////////////
1814    *     PATCH to recover events with less than 3 couples
1815    *     ////////////////////////////////////////////////    
1816    *     loop over singlet and create "fake" couples
1817    *     (with clx=0 or cly=0)
1818    *    
1819    
1820  *     init variables        if(DEBUG.EQ.1)
1821        ncp_tot=0       $     print*,'>>> Recover singlets '
1822        do ip=1,nplanes       $     ,'(creates fake couples) <<<'
1823           do ico=1,ncouplemax        do icl=1,nclstr1
1824              clx(ip,ico)=0           if(
1825              cly(ip,ico)=0       $        cl_single(icl).eq.1.and.
1826           enddo       $        cl_used(icl).eq.0.and.
1827           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  
           
1828  *     ----------------------------------------------------  *     ----------------------------------------------------
1829  *     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  
1830  *     ----------------------------------------------------  *     ----------------------------------------------------
1831                        if( mask_view(VIEW(icl)).ne.0 ) goto 21
1832           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  
               
1833  *     ----------------------------------------------------  *     ----------------------------------------------------
1834  *     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  
1835  *     ----------------------------------------------------  *     ----------------------------------------------------
1836                               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  
 *     ===========================================================  
1837                                
1838                   nplx=npl(VIEW(icl))
1839    *     ------------------> (FAKE) COUPLE <-----------------
1840                   ncp_plane(nplx) = ncp_plane(nplx) + 1
1841                   clx(nplx,ncp_plane(nplx))=icl
1842                   cly(nplx,ncp_plane(nplx))=0
1843    c$$$  cl_single(icl)=0! I leave the cluster tagged as singlet!!!
1844    *     ----------------------------------------------------
1845                                
1846  *     ------------------> COUPLE <------------------              else                !=== Y views
1847  *     check to do not overflow vector dimentions  *     ----------------------------------------------------
1848                 if(ncp_plane(nplx).gt.ncouplemax)then  *     cut on charge (Y VIEW)
1849                    if(DEBUG)print*,  *     ----------------------------------------------------
1850       $                    ' ** 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  
1851                                
1852                 if(ncp_plane(nplx).eq.ncouplemax)then                 nply=npl(VIEW(icl))
1853                    if(DEBUG)print*,  *     ------------------> (FAKE) COUPLE <-----------------
1854       $                 '** warning ** number of identified '//                 ncp_plane(nply) = ncp_plane(nply) + 1
1855       $                 'couples on plane ',nplx,                 clx(nply,ncp_plane(nply))=0
1856       $                 'exceeds vector dimention '                 cly(nply,ncp_plane(nply))=icl
1857       $                 ,'( ',ncouplemax,' )'  c$$$  cl_single(icl)=0! I leave the cluster tagged as singlet!!!
1858  c     good2=.false.  *     ----------------------------------------------------
 c     goto 880   !fill ntp and go to next event                      
                   iflag=1  
                   return  
                endif  
1859                                
1860                 ncp_plane(nplx) = ncp_plane(nplx) + 1              endif
1861                 clx(nplx,ncp_plane(nplx))=icx           endif                  !end "single" condition
1862                 cly(nply,ncp_plane(nplx))=icy   21      continue
1863                 cl_single(icx)=0        enddo                     !end loop over clusters
                cl_single(icy)=0  
             endif                                
 *     ----------------------------------------------  
1864    
1865   20         continue        if(DEBUG.EQ.1)
1866           enddo                  !end loop on clusters(Y)       $     print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
1867            
1868   10      continue  
1869        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  
1870                
1871        do ip=1,6        ncp_tot=0
1872           ncp_tot=ncp_tot+ncp_plane(ip)        do ip=1,NPLANES
1873             ncp_tot = ncp_tot + ncp_plane(ip)
1874        enddo        enddo
1875  c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)        if(DEBUG.EQ.1)
1876               $     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  
1877                
1878        return        return
1879        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  
1880                
1881  ***************************************************  ***************************************************
1882  *                                                 *  *                                                 *
# Line 2283  c$$$      end Line 1888  c$$$      end
1888  **************************************************  **************************************************
1889    
1890        subroutine cp_to_doubtrip(iflag)        subroutine cp_to_doubtrip(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
1891    
1892        include 'commontracker.f'        include 'commontracker.f'
1893          include 'level1.f'
1894        include 'common_momanhough.f'        include 'common_momanhough.f'
       include 'momanhough_init.f'  
1895        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1896        include 'common_mini_2.f'        include 'common_mini_2.f'
1897        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
1898    
       logical DEBUG  
       common/dbg/DEBUG  
1899    
1900  *     output flag  *     output flag
1901  *     --------------  *     --------------
# Line 2328  c      double precision xm3,ym3,zm3 Line 1927  c      double precision xm3,ym3,zm3
1927        real xc,zc,radius        real xc,zc,radius
1928  *     -----------------------------  *     -----------------------------
1929    
1930          if(DEBUG.EQ.1)print*,'cp_to_doubtrip:'
1931    
1932    *     --------------------------------------------
1933    *     put a limit to the maximum number of couples
1934    *     per plane, in order to apply hough transform
1935    *     (couples recovered during track refinement)
1936    *     --------------------------------------------
1937          do ip=1,nplanes
1938             if(ncp_plane(ip).gt.ncouplelimit)then
1939                mask_view(nviewx(ip)) = mask_view(nviewx(ip)) + 2**7
1940                mask_view(nviewy(ip)) = mask_view(nviewy(ip)) + 2**7
1941             endif
1942          enddo
1943    
1944    
1945        ndblt=0                   !number of doublets        ndblt=0                   !number of doublets
1946        ntrpt=0                   !number of triplets        ntrpt=0                   !number of triplets
1947                
1948        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1
1949           do is1=1,2             !loop on sensors - COPPIA 1  c$$$         print*,'(1) ip ',ip1
1950                c$$$     $        ,mask_view(nviewx(ip1))
1951    c$$$     $        ,mask_view(nviewy(ip1))        
1952             if(  mask_view(nviewx(ip1)).ne.0 .or.
1953         $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
1954             do is1=1,2             !loop on sensors - COPPIA 1            
1955              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
1956                 icx1=clx(ip1,icp1)                 icx1=clx(ip1,icp1)
1957                 icy1=cly(ip1,icp1)                 icy1=cly(ip1,icp1)
1958                  
1959    c$$$               print*,'(1) ip ',ip1,' icp ',icp1
1960    
1961  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
1962                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
1963                   call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
1964                 xm1=xPAM                 xm1=xPAM
1965                 ym1=yPAM                 ym1=yPAM
1966                 zm1=zPAM                                   zm1=zPAM                  
1967  c     print*,'***',is1,xm1,ym1,zm1  
1968                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
1969                    do is2=1,2    !loop on sensors -ndblt COPPIA 2  c$$$                  print*,'(2) ip ',ip2
1970                        c$$$     $                 ,mask_view(nviewx(ip2))
1971    c$$$     $                 ,mask_view(nviewy(ip2))
1972                      if(  mask_view(nviewx(ip2)).ne.0 .or.
1973         $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
1974                      do is2=1,2    !loop on sensors -ndblt COPPIA 2                    
1975                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2
1976                          icx2=clx(ip2,icp2)                          icx2=clx(ip2,icp2)
1977                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
1978    
1979    c$$$                        print*,'(2) ip ',ip2,' icp ',icp2
1980    
1981  c                        call xyz_PAM  c                        call xyz_PAM
1982  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
1983    c                        call xyz_PAM
1984    c     $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)
1985                          call xyz_PAM                          call xyz_PAM
1986       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.,0.,0.)
1987                          xm2=xPAM                          xm2=xPAM
1988                          ym2=yPAM                          ym2=yPAM
1989                          zm2=zPAM                          zm2=zPAM
1990                                                    
1991    *                       ---------------------------------------------------
1992    *                       both couples must have a y-cluster
1993    *                       (condition necessary when in RECOVER_SINGLETS mode)
1994    *                       ---------------------------------------------------
1995                            if(icy1.eq.0.or.icy2.eq.0)goto 111
1996    
1997                            if(cl_used(icy1).ne.0)goto 111
1998                            if(cl_used(icy2).ne.0)goto 111
1999    
2000                            
2001  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2002  *     track parameters on Y VIEW  *     track parameters on Y VIEW
2003  *     (2 couples needed)  *     (2 couples needed)
2004  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2005                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
2006                             if(DEBUG)print*,                             if(verbose.eq.1)print*,
2007       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
2008       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
2009       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
2010  c                           good2=.false.  c     good2=.false.
2011  c                           goto 880 !fill ntp and go to next event  c     goto 880 !fill ntp and go to next event
2012                               do iv=1,12
2013    c     mask_view(iv) = 3
2014                                  mask_view(iv) = mask_view(iv)+ 2**2
2015                               enddo
2016                             iflag=1                             iflag=1
2017                             return                             return
2018                          endif                          endif
2019                            
2020                            
2021    ccc                        print*,'<doublet> ',icp1,icp2
2022    
2023                          ndblt = ndblt + 1                          ndblt = ndblt + 1
2024  *     store doublet info  *     store doublet info
2025                          cpyz1(ndblt)=id_cp(ip1,icp1,is1)                          cpyz1(ndblt)=id_cp(ip1,icp1,is1)
# Line 2381  c                           goto 880 !fi Line 2028  c                           goto 880 !fi
2028                          alfayz2(ndblt)=(ym1-ym2)/(zm1-zm2)                          alfayz2(ndblt)=(ym1-ym2)/(zm1-zm2)
2029  *     y0 (cm)  *     y0 (cm)
2030                          alfayz1(ndblt)=alfayz2(ndblt)*(zini-zm1)+ym1                          alfayz1(ndblt)=alfayz2(ndblt)*(zini-zm1)+ym1
2031                                                      
2032  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2033  ****  reject non phisical couples                    ****  ****  reject non phisical couples                    ****
2034  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2035                            if(SECOND_SEARCH)goto 111
2036                          if(                          if(
2037       $                       abs(alfayz2(ndblt)).gt.alfyz2_max       $                       abs(alfayz2(ndblt)).gt.alfyz2_max
2038       $                       .or.       $                       .or.
2039       $                       abs(alfayz1(ndblt)).gt.alfyz1_max       $                       abs(alfayz1(ndblt)).gt.alfyz1_max
2040       $                       )ndblt = ndblt-1       $                       )ndblt = ndblt-1
2041                                                    
2042  c$$$      if(iev.eq.33)then                          
2043  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$$$  
2044  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2045  *     track parameters on Y VIEW - end  *     track parameters on Y VIEW - end
2046  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2047    
2048    
2049                          if(ip2.eq.nplanes)goto 30 !no possible combination with 3 couples                          if(icx1.ne.0)then
2050                               if(cl_used(icx1).ne.0)goto 31
2051                            endif
2052                            if(icx2.ne.0)then
2053                               if(cl_used(icx2).ne.0)goto 31
2054                            endif
2055    
2056                            if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
2057    
2058                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
2059    c$$$                           print*,'(3) ip ',ip3
2060    c$$$     $                          ,mask_view(nviewx(ip3))
2061    c$$$     $                          ,mask_view(nviewy(ip3))                          
2062                               if(  mask_view(nviewx(ip3)).ne.0 .or.
2063         $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
2064                             do is3=1,2 !loop on sensors - COPPIA 3                             do is3=1,2 !loop on sensors - COPPIA 3
2065                                                                
2066                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
2067                                   icx3=clx(ip3,icp3)                                   icx3=clx(ip3,icp3)
2068                                   icy3=cly(ip3,icp3)                                   icy3=cly(ip3,icp3)
2069    
2070    c$$$                                 print*,'(3) ip ',ip3,' icp ',icp3
2071    
2072    *     ---------------------------------------------------
2073    *     all three couples must have a x-cluster
2074    *     (condition necessary when in RECOVER_SINGLETS mode)
2075    *     ---------------------------------------------------
2076                                     if(
2077         $                                icx1.eq.0.or.
2078         $                                icx2.eq.0.or.
2079         $                                icx3.eq.0.or.
2080         $                                .false.)goto 29
2081                                    
2082                                     if(cl_used(icx1).ne.0)goto 29
2083                                     if(cl_used(icx2).ne.0)goto 29
2084                                     if(cl_used(icx3).ne.0)goto 29
2085    
2086  c                                 call xyz_PAM  c                                 call xyz_PAM
2087  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
2088    c                                 call xyz_PAM
2089    c     $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)
2090                                   call xyz_PAM                                   call xyz_PAM
2091       $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)       $                                (icx3,icy3,is3,PFAdef,PFAdef
2092         $                                ,0.,0.,0.,0.)
2093                                   xm3=xPAM                                   xm3=xPAM
2094                                   ym3=yPAM                                   ym3=yPAM
2095                                   zm3=zPAM                                   zm3=zPAM
2096    
2097    
2098  *     find the circle passing through the three points  *     find the circle passing through the three points
2099                                     iflag_t = DEBUG
2100                                   call tricircle(3,xp,zp,angp,resp,chi                                   call tricircle(3,xp,zp,angp,resp,chi
2101       $                                ,xc,zc,radius,iflag)       $                                ,xc,zc,radius,iflag_t)
2102  c     print*,xc,zc,radius  *     the circle must intersect the reference plane
2103  *     the circle must intersect the reference plane  cc                                 if(iflag.ne.0)goto 29
2104                                   if(                                   if(iflag_t.ne.0)then
2105  c     $                                 (xc.le.-1.*xclimit.or.  *     if tricircle fails, evaluate a straight line
2106  c     $                                 xc.ge.xclimit).and.                                      if(DEBUG.eq.1)
2107       $                                radius**2.ge.(ZINI-zc)**2.and.       $                                   print*,'TRICIRCLE failure'
2108       $                                iflag.eq.0.and.       $                                   ,' >>> straight line'
2109       $                                .true.)then                                      radius=0.
2110                                                                        xc=0.
2111                                        yc=0.
2112                                        
2113                                        SZZ=0.                  
2114                                        SZX=0.
2115                                        SSX=0.
2116                                        SZ=0.
2117                                        S1=0.
2118                                        X0=0.
2119                                        Ax=0.
2120                                        BX=0.
2121                                        DO I=1,3
2122                                           XX = XP(I)
2123                                           SZZ=SZZ+ZP(I)*ZP(I)
2124                                           SZX=SZX+ZP(I)*XX
2125                                           SSX=SSX+XX
2126                                           SZ=SZ+ZP(I)
2127                                           S1=S1+1.                                    
2128                                        ENDDO
2129                                        DET=SZZ*S1-SZ*SZ
2130                                        AX=(SZX*S1-SZ*SSX)/DET
2131                                        BX=(SZZ*SSX-SZX*SZ)/DET
2132                                        X0  = AX*ZINI+BX
2133                                        
2134                                     endif
2135    
2136                                     if(  .not.SECOND_SEARCH.and.
2137         $                                radius**2.lt.(ZINI-zc)**2)goto 29
2138                                                                      
2139  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2140  *     track parameters on X VIEW  *     track parameters on X VIEW
2141  *     (3 couples needed)  *     (3 couples needed)
2142  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2143                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
2144                                      if(DEBUG)print*,                                      if(verbose.eq.1)print*,
2145       $                     '** warning ** number of identified '//       $                                   '** warning **'//
2146       $                     'triplets exceeds vector dimention '       $                                   ' number of identified '//
2147       $                    ,'( ',ntrpt_max,' )'       $                                   'triplets exceeds'//
2148  c                                    good2=.false.       $                                   ' vector dimention '
2149  c                                    goto 880 !fill ntp and go to next event       $                                   ,'( ',ntrpt_max,' )'
2150    c     good2=.false.
2151    c     goto 880 !fill ntp and go to next event
2152                                        do iv=1,nviews
2153    c     mask_view(iv) = 4
2154                                           mask_view(iv) =
2155         $                                      mask_view(iv)+ 2**3
2156                                        enddo
2157                                      iflag=1                                      iflag=1
2158                                      return                                      return
2159                                   endif                                   endif
2160    
2161    ccc                                 print*,'<triplet> ',icp1,icp2,icp3
2162                                    
2163                                   ntrpt = ntrpt +1                                   ntrpt = ntrpt +1
2164  *     store triplet info  *     store triplet info
2165                                   cpxz1(ntrpt)=id_cp(ip1,icp1,is1)                                   cpxz1(ntrpt)=id_cp(ip1,icp1,is1)
2166                                   cpxz2(ntrpt)=id_cp(ip2,icp2,is2)                                   cpxz2(ntrpt)=id_cp(ip2,icp2,is2)
2167                                   cpxz3(ntrpt)=id_cp(ip3,icp3,is3)                                   cpxz3(ntrpt)=id_cp(ip3,icp3,is3)
2168                                                                    
2169                                   if(xc.lt.0)then                                   if(radius.ne.0.and.xc.lt.0)then
2170  *************POSITIVE DEFLECTION  *************POSITIVE DEFLECTION
2171                alfaxz1(ntrpt) = xc+sqrt(radius**2-(ZINI-zc)**2)               alfaxz1(ntrpt) = xc+sqrt(radius**2-(ZINI-zc)**2)
2172                alfaxz2(ntrpt) = (ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)               alfaxz2(ntrpt) = (ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)
2173                alfaxz3(ntrpt) = 1/radius               alfaxz3(ntrpt) = 1/radius
2174                                   else                                  else if(radius.ne.0.and.xc.ge.0)then
2175  *************NEGATIVE DEFLECTION  *************NEGATIVE DEFLECTION
2176                alfaxz1(ntrpt) = xc-sqrt(radius**2-(ZINI-zc)**2)               alfaxz1(ntrpt) = xc-sqrt(radius**2-(ZINI-zc)**2)
2177                alfaxz2(ntrpt) = -(ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)               alfaxz2(ntrpt) = -(ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)
2178                alfaxz3(ntrpt) = -1/radius               alfaxz3(ntrpt) = -1/radius
2179                                   endif                                  else if(radius.eq.0)then
2180                                    *************straight fit
2181                 alfaxz1(ntrpt) = X0
2182                 alfaxz2(ntrpt) = AX
2183                 alfaxz3(ntrpt) = 0.
2184                                    endif
2185    
2186    c$$$                                print*,'alfaxz1 ', alfaxz1(ntrpt)
2187    c$$$                                print*,'alfaxz2 ', alfaxz2(ntrpt)
2188    c$$$                                print*,'alfaxz3 ', alfaxz3(ntrpt)
2189                                        
2190  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2191  ****  reject non phisical triplets                   ****  ****  reject non phisical triplets                   ****
2192  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2193                                   if(                                  if(SECOND_SEARCH)goto 29
2194       $                                abs(alfaxz2(ntrpt)).gt.alfxz2_max                                  if(
2195       $                                .or.       $                               abs(alfaxz2(ntrpt)).gt.
2196       $                                abs(alfaxz1(ntrpt)).gt.alfxz1_max       $                               alfxz2_max
2197       $                                )ntrpt = ntrpt-1       $                               .or.
2198                                         $                               abs(alfaxz1(ntrpt)).gt.
2199                                         $                               alfxz1_max
2200  c     print*,alfaxz1(ntrpt),alfaxz2(ntrpt),alfaxz3(ntrpt)       $                               )ntrpt = ntrpt-1
2201                                                                    
2202  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2203  *     track parameters on X VIEW - end  *     track parameters on X VIEW - end
2204  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2205                                endif                                
2206     29                           continue
2207                             enddo !end loop on COPPIA 3                             enddo !end loop on COPPIA 3
2208                          enddo   !end loop on sensors - COPPIA 3                          enddo   !end loop on sensors - COPPIA 3
2209     30                     continue
2210                       enddo      !end loop on planes  - COPPIA 3                       enddo      !end loop on planes  - COPPIA 3
2211   30                  continue  
2212                         31                  continue                    
2213   1                enddo         !end loop on COPPIA 2   1                enddo         !end loop on COPPIA 2
2214                 enddo            !end loop on sensors - COPPIA 2                 enddo            !end loop on sensors - COPPIA 2
2215     20            continue
2216              enddo               !end loop on planes  - COPPIA 2              enddo               !end loop on planes  - COPPIA 2
2217                
2218     11         continue
2219           enddo                  !end loop on COPPIA1           enddo                  !end loop on COPPIA1
2220        enddo                     !end loop on sensors - COPPIA 1        enddo                     !end loop on sensors - COPPIA 1
2221     10   continue
2222        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
2223                
2224        if(DEBUG)then        if(DEBUG.EQ.1)then
2225           print*,'--- doublets ',ndblt           print*,'--- doublets ',ndblt
2226           print*,'--- triplets ',ntrpt           print*,'--- triplets ',ntrpt
2227        endif        endif
# Line 2514  c     goto 880               !ntp fill Line 2246  c     goto 880               !ntp fill
2246        subroutine doub_to_YZcloud(iflag)        subroutine doub_to_YZcloud(iflag)
2247    
2248        include 'commontracker.f'        include 'commontracker.f'
2249          include 'level1.f'
2250        include 'common_momanhough.f'        include 'common_momanhough.f'
2251        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2252    
       logical DEBUG  
       common/dbg/DEBUG  
2253    
2254  *     output flag  *     output flag
2255  *     --------------  *     --------------
# Line 2537  c     goto 880               !ntp fill Line 2268  c     goto 880               !ntp fill
2268        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2269        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2270    
2271          if(DEBUG.EQ.1)print*,'doub_to_YZcloud:'
2272    
2273  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2274  *     classification of DOUBLETS  *     classification of DOUBLETS
# Line 2550  c     goto 880               !ntp fill Line 2282  c     goto 880               !ntp fill
2282        distance=0        distance=0
2283        nclouds_yz=0              !number of clouds        nclouds_yz=0              !number of clouds
2284        npt_tot=0        npt_tot=0
2285          nloop=0                  
2286     90   continue                  
2287        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2288           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
2289                            
 c     print*,'--------------'  
 c     print*,'** ',idb1,' **'  
               
2290           do icp=1,ncp_tot           do icp=1,ncp_tot
2291              cp_useds1(icp)=0    !init              cp_useds1(icp)=0    !init
2292              cp_useds2(icp)=0    !init              cp_useds2(icp)=0    !init
# Line 2594  ccccc if(db_used(idbref).eq.1)goto 1188 Line 2325  ccccc if(db_used(idbref).eq.1)goto 1188
2325       $              +((alfayz2(idbref)-alfayz2(idb2))/Dalfayz2)**2                     $              +((alfayz2(idbref)-alfayz2(idb2))/Dalfayz2)**2              
2326                 distance = sqrt(distance)                 distance = sqrt(distance)
2327                                
 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  
2328                 if(distance.lt.cutdistyz)then                 if(distance.lt.cutdistyz)then
2329    
 c     print*,idb1,idb2,distance,' cloud ',nclouds_yz  
2330                    if(cpyz1(idb2).gt.0)cp_useds2(cpyz1(idb2))=1                    if(cpyz1(idb2).gt.0)cp_useds2(cpyz1(idb2))=1
2331                    if(cpyz1(idb2).lt.0)cp_useds1(-cpyz1(idb2))=1                    if(cpyz1(idb2).lt.0)cp_useds1(-cpyz1(idb2))=1
2332                    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 2342  c     print*,idb1,idb2,distance,' cloud
2342    
2343                    temp1 = temp1 + alfayz1(idb2)                    temp1 = temp1 + alfayz1(idb2)
2344                    temp2 = temp2 + alfayz2(idb2)                    temp2 = temp2 + alfayz2(idb2)
 c     print*,'*   idbref,idb2 ',idbref,idb2  
2345                 endif                               endif              
2346                                
2347   1118          continue   1118          continue
# Line 2642  c     print*,'*   idbref,idb2 ',idbref,i Line 2364  c     print*,'*   idbref,idb2 ',idbref,i
2364           enddo           enddo
2365           ncpused=0           ncpused=0
2366           do icp=1,ncp_tot           do icp=1,ncp_tot
2367              if(cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0)then              if(
2368         $           (cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0).and.
2369         $           .true.)then
2370                 ncpused=ncpused+1                 ncpused=ncpused+1
2371                 ip=ip_cp(icp)                 ip=ip_cp(icp)
2372                 hit_plane(ip)=1                 hit_plane(ip)=1
# Line 2652  c     print*,'*   idbref,idb2 ',idbref,i Line 2376  c     print*,'*   idbref,idb2 ',idbref,i
2376           do ip=1,nplanes           do ip=1,nplanes
2377              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2378           enddo           enddo
2379  c     print*,'>>>> ',ncpused,npt,nplused          
          if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  
          if(npt.lt.nptyz_min)goto 2228 !next doublet  
2380           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2381                    
2382  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2383  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2384    
2385           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2386              if(DEBUG)print*,              if(verbose.eq.1)print*,
2387       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2388       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2389       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2390  c               good2=.false.  c               good2=.false.
2391  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2392                do iv=1,nviews
2393    c               mask_view(iv) = 5
2394                   mask_view(iv) = mask_view(iv) + 2**4
2395                enddo
2396              iflag=1              iflag=1
2397              return              return
2398           endif           endif
# Line 2682  c     goto 880         !fill ntp and go Line 2408  c     goto 880         !fill ntp and go
2408  c     ptcloud_yz_nt(nclouds_yz)=npt  c     ptcloud_yz_nt(nclouds_yz)=npt
2409           do ipt=1,npt           do ipt=1,npt
2410              db_cloud(npt_tot+ipt) = db_all(ipt)              db_cloud(npt_tot+ipt) = db_all(ipt)
 c     print*,'>> ',ipt,db_all(ipt)  
2411           enddo             enddo  
2412           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2413           if(DEBUG)then           if(DEBUG.EQ.1)then
             print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'  
2414              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'
2415              print*,'- alfayz1 ',alfayz1_av(nclouds_yz)              print*,'- alfayz1  ',alfayz1_av(nclouds_yz)
2416              print*,'- alfayz2 ',alfayz2_av(nclouds_yz)              print*,'- alfayz2  ',alfayz2_av(nclouds_yz)
2417              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2418              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2419              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'cpcloud_yz '
2420  c$$$            print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '       $           ,(cpcloud_yz(nclouds_yz,icp),icp=1,ncp_tot)
2421  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)  
2422           endif           endif
2423  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2424  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
# Line 2704  c$$$     $           ,(db_cloud(iii),iii Line 2426  c$$$     $           ,(db_cloud(iii),iii
2426        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2427                
2428                
2429        if(DEBUG)then        if(nloop.lt.nstepy)then      
2430           print*,'---------------------- '          cutdistyz = cutdistyz+cutystep
2431            nloop     = nloop+1          
2432            goto 90                
2433          endif                    
2434          
2435          if(DEBUG.EQ.1)then
2436           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
          print*,' '  
2437        endif        endif
2438                
2439                
# Line 2730  c$$$     $           ,(db_cloud(iii),iii Line 2456  c$$$     $           ,(db_cloud(iii),iii
2456        subroutine trip_to_XZcloud(iflag)        subroutine trip_to_XZcloud(iflag)
2457    
2458        include 'commontracker.f'        include 'commontracker.f'
2459          include 'level1.f'
2460        include 'common_momanhough.f'        include 'common_momanhough.f'
2461        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2462    
       logical DEBUG  
       common/dbg/DEBUG  
2463    
2464  *     output flag  *     output flag
2465  *     --------------  *     --------------
# Line 2754  c$$$     $           ,(db_cloud(iii),iii Line 2479  c$$$     $           ,(db_cloud(iii),iii
2479        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2480        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2481    
2482          if(DEBUG.EQ.1)print*,'trip_to_XZcloud:'
2483    
2484  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2485  *     classification of TRIPLETS  *     classification of TRIPLETS
2486  *     according to distance in parameter space  *     according to distance in parameter space
# Line 2765  c$$$     $           ,(db_cloud(iii),iii Line 2492  c$$$     $           ,(db_cloud(iii),iii
2492        distance=0        distance=0
2493        nclouds_xz=0              !number of clouds                nclouds_xz=0              !number of clouds        
2494        npt_tot=0                 !total number of selected triplets        npt_tot=0                 !total number of selected triplets
2495          nloop=0                  
2496     91   continue                  
2497        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2498           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,' **'  
2499                    
2500           do icp=1,ncp_tot           do icp=1,ncp_tot
2501              cp_useds1(icp)=0              cp_useds1(icp)=0
# Line 2802  c         tr_temp(1)=itr1 Line 2529  c         tr_temp(1)=itr1
2529              do itr2=1,ntrpt     !loop (2) on TRIPLETS              do itr2=1,ntrpt     !loop (2) on TRIPLETS
2530                 if(itr2.eq.itr1)goto 11188       !next triplet                 if(itr2.eq.itr1)goto 11188       !next triplet
2531                 if(tr_used(itr2).eq.1)goto 11188 !next triplet                               if(tr_used(itr2).eq.1)goto 11188 !next triplet              
2532    
2533    
2534  *     triplet distance in parameter space  *     triplet distance in parameter space
2535  *     solo i due parametri spaziali per il momemnto  *     solo i due parametri spaziali per il momemnto
2536                 distance=                 distance=
2537       $              ((alfaxz1(itrref)-alfaxz1(itr2))/Dalfaxz1)**2       $              ((alfaxz1(itrref)-alfaxz1(itr2))/Dalfaxz1)**2
2538       $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2                     $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2              
2539                 distance = sqrt(distance)                 distance = sqrt(distance)
2540                  
2541                 if(distance.lt.cutdistxz)then  
2542  c     print*,idb1,idb2,distance,' cloud ',nclouds_yz  *     ------------------------------------------------------------------------
2543    *     FORCE INCLUSION OF TRIPLETS COMPOSED BY SAME COUPLES, IGNORING THE IMAGE
2544    *     ------------------------------------------------------------------------
2545    *     (added in august 2007)
2546                   istrimage=0
2547                   if(
2548         $              abs(cpxz1(itrref)).eq.abs(cpxz1(itr2)).and.
2549         $              abs(cpxz2(itrref)).eq.abs(cpxz2(itr2)).and.
2550         $              abs(cpxz3(itrref)).eq.abs(cpxz3(itr2)).and.
2551         $              .true.)istrimage=1
2552    
2553                   if(distance.lt.cutdistxz.or.istrimage.eq.1)then
2554                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1
2555                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1
2556                    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 2569  c     print*,idb1,idb2,distance,' cloud
2569                    temp1 = temp1 + alfaxz1(itr2)                    temp1 = temp1 + alfaxz1(itr2)
2570                    temp2 = temp2 + alfaxz2(itr2)                    temp2 = temp2 + alfaxz2(itr2)
2571                    temp3 = temp3 + alfaxz3(itr2)                    temp3 = temp3 + alfaxz3(itr2)
 c     print*,'*   itrref,itr2 ',itrref,itr2,distance  
2572                 endif                               endif              
2573                                
2574  11188          continue  11188          continue
# Line 2850  c     print*,'*   itrref,itr2 ',itrref,i Line 2589  c     print*,'*   itrref,itr2 ',itrref,i
2589  *     1bis)  *     1bis)
2590  *     2) it is not already stored  *     2) it is not already stored
2591  *     ------------------------------------------  *     ------------------------------------------
 c     print*,'check cp_used'  
2592           do ip=1,nplanes           do ip=1,nplanes
2593              hit_plane(ip)=0              hit_plane(ip)=0
2594           enddo           enddo
2595           ncpused=0           ncpused=0
2596           do icp=1,ncp_tot           do icp=1,ncp_tot
2597              if(cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0)then              if(
2598         $           (cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0).and.
2599         $           .true.)then
2600                 ncpused=ncpused+1                 ncpused=ncpused+1
2601                 ip=ip_cp(icp)                 ip=ip_cp(icp)
2602                 hit_plane(ip)=1                 hit_plane(ip)=1
# Line 2866  c     print*,'check cp_used' Line 2606  c     print*,'check cp_used'
2606           do ip=1,nplanes           do ip=1,nplanes
2607              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2608           enddo           enddo
2609           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  
2610                    
2611  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2612  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2613           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2614              if(DEBUG)print*,              if(verbose.eq.1)print*,
2615       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2616       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2617       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2618  c     good2=.false.  c     good2=.false.
2619  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2620                do iv=1,nviews
2621    c               mask_view(iv) = 6
2622                   mask_view(iv) =  mask_view(iv) + 2**5
2623                enddo
2624              iflag=1              iflag=1
2625              return              return
2626           endif           endif
# Line 2896  c     goto 880         !fill ntp and go Line 2638  c     goto 880         !fill ntp and go
2638           enddo           enddo
2639           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2640                    
2641           if(DEBUG)then           if(DEBUG.EQ.1)then
             print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'  
2642              print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'                            print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'              
2643              print*,'- alfaxz1 ',alfaxz1_av(nclouds_xz)              print*,'- alfaxz1  ',alfaxz1_av(nclouds_xz)
2644              print*,'- alfaxz2 ',alfaxz2_av(nclouds_xz)              print*,'- alfaxz2  ',alfaxz2_av(nclouds_xz)
2645              print*,'- alfaxz3 ',alfaxz3_av(nclouds_xz)              print*,'- alfaxz3  ',alfaxz3_av(nclouds_xz)
2646              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2647              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2648                print*,'cpcloud_xz '
2649         $           ,(cpcloud_xz(nclouds_xz,icp),icp=1,ncp_tot)
2650              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)  
2651           endif           endif
2652  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2653  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2654  22288    continue  22288    continue
2655        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2656          
2657        if(DEBUG)then         if(nloop.lt.nstepx)then      
2658           print*,'---------------------- '           cutdistxz=cutdistxz+cutxstep
2659             nloop=nloop+1          
2660             goto 91                
2661           endif                    
2662          
2663          if(DEBUG.EQ.1)then
2664           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
          print*,' '  
2665        endif        endif
2666                
2667                
# Line 2936  c$$$     $           ,(tr_cloud(iii),iii Line 2679  c$$$     $           ,(tr_cloud(iii),iii
2679  **************************************************  **************************************************
2680    
2681        subroutine clouds_to_ctrack(iflag)        subroutine clouds_to_ctrack(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2682    
2683        include 'commontracker.f'        include 'commontracker.f'
2684          include 'level1.f'
2685        include 'common_momanhough.f'        include 'common_momanhough.f'
2686        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2687        include 'common_mini_2.f'        include 'common_mini_2.f'
2688        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
2689    
2690        logical DEBUG  
       common/dbg/DEBUG  
2691    
2692  *     output flag  *     output flag
2693  *     --------------  *     --------------
# Line 2964  c*************************************** Line 2703  c***************************************
2703  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2704  *     list of matching couples in the combination  *     list of matching couples in the combination
2705  *     between a XZ and YZ cloud  *     between a XZ and YZ cloud
2706        integer cp_match(nplanes,ncouplemax)        integer cp_match(nplanes,2*ncouplemax)
2707        integer ncp_match(nplanes)        integer ncp_match(nplanes)
2708  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2709        integer hit_plane(nplanes)        integer hit_plane(nplanes)
2710  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2711  *     variables for track fitting  *     variables for track fitting
2712        double precision AL_INI(5)        double precision AL_INI(5)
       double precision tath  
2713  *     -----------------------------------------------------------  *     -----------------------------------------------------------
 c      real fitz(nplanes)        !z coordinates of the planes in cm  
2714    
2715          if(DEBUG.EQ.1)print*,'clouds_to_ctrack:'
2716    
2717    
2718        ntracks=0                 !counter of track candidates        ntracks=0                 !counter of track candidates
2719                
2720        do iyz=1,nclouds_yz       !loop on YZ couds        do iyz=1,nclouds_yz       !loop on YZ clouds
2721           do ixz=1,nclouds_xz    !loop on XZ couds           do ixz=1,nclouds_xz    !loop on XZ clouds
2722                            
2723  *     --------------------------------------------------  *     --------------------------------------------------
2724  *     check of consistency of the clouds  *     check of consistency of the clouds
# Line 2989  c      real fitz(nplanes)        !z coor Line 2727  c      real fitz(nplanes)        !z coor
2727  *     of the two clouds  *     of the two clouds
2728  *     --------------------------------------------------  *     --------------------------------------------------
2729              do ip=1,nplanes              do ip=1,nplanes
2730                 hit_plane(ip)=0                 hit_plane(ip)=0  !n.matching couples (REAL couples, not SINGLETS)
2731                 ncp_match(ip)=0                 ncp_match(ip)=0  !n.matching couples per plane
2732                 do icpp=1,ncouplemax                 do icpp=1,ncouplemax
2733                    cp_match(ip,icpp)=0 !init couple list                    cp_match(ip,icpp)=0 !init couple list
2734                 enddo                 enddo
2735              enddo              enddo
2736              ncp_ok=0              ncp_ok=0            !count n.matching-couples
2737              do icp=1,ncp_tot    !loop on couples              ncpx_ok=0           !count n.matching-couples with x cluster
2738  *     get info on              ncpy_ok=0           !count n.matching-couples with y cluster
2739                 cpintersec(icp)=min(  
2740       $              cpcloud_yz(iyz,icp),  
2741       $              cpcloud_xz(ixz,icp))              do icp=1,ncp_tot    !loop over couples
2742                 if(  
2743       $    (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.                 if(.not.RECOVER_SINGLETS)then
2744       $    (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.  *     ------------------------------------------------------
2745       $              .false.)cpintersec(icp)=0  *     if NOT in RECOVER_SINGLETS mode, take the intersection
2746    *     between xz yz clouds
2747    *     ------------------------------------------------------
2748                      cpintersec(icp)=min(
2749         $                 cpcloud_yz(iyz,icp),
2750         $                 cpcloud_xz(ixz,icp))
2751    *     cpintersec is >0 if yz and xz clouds contain the same image of couple icp
2752    *     ------------------------------------------------------
2753    *     discard the couple if the sensor is in conflict
2754    *     ------------------------------------------------------
2755                      if(
2756         $       (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.
2757         $       (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.
2758         $                 .false.)cpintersec(icp)=0
2759                   else
2760    *     ------------------------------------------------------
2761    *     if RECOVER_SINGLETS take the union
2762    *     (otherwise the fake couples formed by singlets would be
2763    *     discarded)    
2764    *     ------------------------------------------------------
2765                      cpintersec(icp)=max(
2766         $                 cpcloud_yz(iyz,icp),
2767         $                 cpcloud_xz(ixz,icp))
2768    c$$$                  if(cpcloud_yz(iyz,icp).gt.0)
2769    c$$$     $                 cpintersec(icp)=cpcloud_yz(iyz,icp)
2770    *     cpintersec is >0 if either yz or xz cloud contains the couple icp
2771                   endif
2772    
2773    c$$$               print*,icp,ip_cp(icp),' -- ',cpintersec(icp)
2774    
2775                 if(cpintersec(icp).ne.0)then                 if(cpintersec(icp).ne.0)then
                   ncp_ok=ncp_ok+1    
2776                                        
2777                    ip=ip_cp(icp)                    ip=ip_cp(icp)
2778                    hit_plane(ip)=1                    hit_plane(ip)=1
2779    c$$$                  if(clx(ip,icp).gt.0.and.cly(ip,icp).gt.0)
2780    c$$$     $                 ncp_ok=ncp_ok+1  
2781    c$$$                  if(clx(ip,icp).gt.0.and.cly(ip,icp).eq.0)
2782    c$$$     $                 ncpx_ok=ncpx_ok+1
2783    c$$$                  if(clx(ip,icp).eq.0.and.cly(ip,icp).gt.0)
2784    c$$$     $                 ncpy_ok=ncpy_ok+1
2785    
2786                      if(  cpcloud_yz(iyz,icp).gt.0.and.
2787         $                 cpcloud_xz(ixz,icp).gt.0)
2788         $                 ncp_ok=ncp_ok+1  
2789                      if(  cpcloud_yz(iyz,icp).gt.0.and.
2790         $                 cpcloud_xz(ixz,icp).eq.0)
2791         $                 ncpy_ok=ncpy_ok+1  
2792                      if(  cpcloud_yz(iyz,icp).eq.0.and.
2793         $                 cpcloud_xz(ixz,icp).gt.0)
2794         $                 ncpx_ok=ncpx_ok+1  
2795    
2796                    if(cpintersec(icp).eq.1)then                    if(cpintersec(icp).eq.1)then
2797  *     1) only the couple image in sensor 1 matches  *     1) only the couple image in sensor 1 matches
2798                       id=-icp                       id=-icp
# Line 3036  c      real fitz(nplanes)        !z coor Line 2819  c      real fitz(nplanes)        !z coor
2819              do ip=1,nplanes              do ip=1,nplanes
2820                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2821              enddo              enddo
2822                                        
2823              if(nplused.lt.nplxz_min)goto 888 !next doublet              if(nplused.lt.3)goto 888 !next combination
2824              if(ncp_ok.lt.ncpok)goto 888 !next cloud  ccc            if(nplused.lt.nplxz_min)goto 888 !next combination
2825                ccc            if(nplused.lt.nplyz_min)goto 888 !next combination
2826              if(DEBUG)then  *     -----------------------------------------------------------
2827                 print*,'Combination ',iyz,ixz  *     if in RECOVER_SINGLET mode, the two clouds must have
2828       $              ,' db ',ptcloud_yz(iyz)  *     at least ONE intersecting real couple
2829       $              ,' tr ',ptcloud_xz(ixz)  *     -----------------------------------------------------------
2830       $              ,'  -----> # matching couples ',ncp_ok              if(ncp_ok.lt.1)goto 888 !next combination
2831              endif  
2832  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'              if(DEBUG.EQ.1)then
2833  c$$$  print*,'Configurazione cluster XZ'                 print*,'////////////////////////////'
2834  c$$$  print*,'1 -- ',(clx(1,i),i=1,ncp_plane(1))                 print*,'Cloud combination (Y,X): ',iyz,ixz
2835  c$$$  print*,'2 -- ',(clx(2,i),i=1,ncp_plane(1))                 print*,' db ',ptcloud_yz(iyz)
2836  c$$$  print*,'3 -- ',(clx(3,i),i=1,ncp_plane(1))                 print*,' tr ',ptcloud_xz(ixz)
2837  c$$$  print*,'4 -- ',(clx(4,i),i=1,ncp_plane(1))                 print*,'  -----> # matching couples ',ncp_ok
2838  c$$$  print*,'5 -- ',(clx(5,i),i=1,ncp_plane(1))                 print*,'  -----> # fake couples (X)',ncpx_ok
2839  c$$$  print*,'6 -- ',(clx(6,i),i=1,ncp_plane(1))                 print*,'  -----> # fake couples (Y)',ncpy_ok
2840  c$$$  print*,'Configurazione cluster YZ'                 do icp=1,ncp_tot
2841  c$$$  print*,'1 -- ',(cly(1,i),i=1,ncp_plane(1))                    print*,'cp ',icp,' >'
2842  c$$$  print*,'2 -- ',(cly(2,i),i=1,ncp_plane(1))       $                 ,' x ',cpcloud_xz(ixz,icp)
2843  c$$$  print*,'3 -- ',(cly(3,i),i=1,ncp_plane(1))       $                 ,' y ',cpcloud_yz(iyz,icp)
2844  c$$$  print*,'4 -- ',(cly(4,i),i=1,ncp_plane(1))       $                 ,' ==> ',cpintersec(icp)
2845  c$$$  print*,'5 -- ',(cly(5,i),i=1,ncp_plane(1))                 enddo
2846  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_plane(1))              endif
2847  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'                          
2848                            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  
2849                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2850                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))
2851                 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 2878  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2878                                hit_plane(6)=icp6                                hit_plane(6)=icp6
2879                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6
2880                                                                
2881                                                                if(DEBUG.eq.1)
2882         $                             print*,'combination: '
2883         $                             ,cp_match(6,icp1)
2884         $                             ,cp_match(5,icp2)
2885         $                             ,cp_match(4,icp3)
2886         $                             ,cp_match(3,icp4)
2887         $                             ,cp_match(2,icp5)
2888         $                             ,cp_match(1,icp6)
2889    
2890    
2891    *                             ---------------------------------------
2892    *                             check if this group of couples has been
2893    *                             already fitted    
2894    *                             ---------------------------------------
2895                                  do ica=1,ntracks
2896                                     isthesame=1
2897                                     do ip=1,NPLANES
2898                                        if(hit_plane(ip).ne.0)then
2899                                           if(  CP_STORE(nplanes-ip+1,ica)
2900         $                                      .ne.
2901         $                                      cp_match(ip,hit_plane(ip)) )
2902         $                                      isthesame=0
2903                                        else
2904                                           if(  CP_STORE(nplanes-ip+1,ica)
2905         $                                      .ne.
2906         $                                      0 )
2907         $                                      isthesame=0
2908                                        endif
2909                                     enddo
2910                                     if(isthesame.eq.1)then
2911                                        if(DEBUG.eq.1)
2912         $                                   print*,'(already fitted)'
2913                                        goto 666 !jump to next combination
2914                                     endif
2915                                  enddo
2916    
2917                                call track_init !init TRACK common                                call track_init !init TRACK common
2918    
2919                                do ip=1,nplanes !loop on planes                                do ip=1,nplanes !loop on planes (bottom to top)
2920                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2921                                      id=cp_match(ip,hit_plane(ip))                                      id=cp_match(ip,hit_plane(ip))
2922                                      is=is_cp(id)                                      is=is_cp(id)
# Line 3131  c     print*,'AL_INI ',(al_ini(i),i=1,5) Line 2930  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2930  *                                   *************************  *                                   *************************
2931  c                                    call xyz_PAM(icx,icy,is,  c                                    call xyz_PAM(icx,icy,is,
2932  c     $                                   'COG2','COG2',0.,0.)  c     $                                   'COG2','COG2',0.,0.)
2933    c                                    call xyz_PAM(icx,icy,is, !(1)
2934    c     $                                   PFAdef,PFAdef,0.,0.) !(1)
2935                                      call xyz_PAM(icx,icy,is, !(1)                                      call xyz_PAM(icx,icy,is, !(1)
2936       $                                   PFAdef,PFAdef,0.,0.) !(1)       $                                   PFAdef,PFAdef,0.,0.,0.,0.)
2937  *                                   *************************  *                                   *************************
2938  *                                   -----------------------------  *                                   -----------------------------
2939                                      xgood(nplanes-ip+1)=1.                                      if(icx.gt.0.and.icy.gt.0)then
2940                                      ygood(nplanes-ip+1)=1.                                         xgood(nplanes-ip+1)=1.
2941                                      xm(nplanes-ip+1)=xPAM                                         ygood(nplanes-ip+1)=1.
2942                                      ym(nplanes-ip+1)=yPAM                                         xm(nplanes-ip+1)=xPAM
2943                                      zm(nplanes-ip+1)=zPAM                                         ym(nplanes-ip+1)=yPAM
2944                                      resx(nplanes-ip+1)=resxPAM                                         zm(nplanes-ip+1)=zPAM
2945                                      resy(nplanes-ip+1)=resyPAM                                         resx(nplanes-ip+1)=resxPAM                                      
2946                                           resy(nplanes-ip+1)=resyPAM
2947                                           if(DEBUG.EQ.1)print*,'(X,Y)'
2948         $                                      ,nplanes-ip+1,xPAM,yPAM
2949                                        else
2950                                           xm_A(nplanes-ip+1) = xPAM_A
2951                                           ym_A(nplanes-ip+1) = yPAM_A
2952                                           xm_B(nplanes-ip+1) = xPAM_B
2953                                           ym_B(nplanes-ip+1) = yPAM_B
2954                                           zm(nplanes-ip+1)
2955         $                                      = (zPAM_A+zPAM_B)/2.
2956                                           resx(nplanes-ip+1) = resxPAM                                      
2957                                           resy(nplanes-ip+1) = resyPAM
2958                                           if(icx.eq.0.and.icy.gt.0)then
2959                                              xgood(nplanes-ip+1)=0.
2960                                              ygood(nplanes-ip+1)=1.
2961                                              resx(nplanes-ip+1) = 1000.
2962                                              if(DEBUG.EQ.1)print*,'(  Y)'
2963         $                                         ,nplanes-ip+1,xPAM,yPAM
2964                                           elseif(icx.gt.0.and.icy.eq.0)then
2965                                              xgood(nplanes-ip+1)=1.
2966                                              ygood(nplanes-ip+1)=0.
2967                                              if(DEBUG.EQ.1)print*,'(X  )'
2968         $                                         ,nplanes-ip+1,xPAM,yPAM
2969                                              resy(nplanes-ip+1) = 1000.
2970                                           else
2971                                              print*,'both icx=0 and icy=0'
2972         $                                         ,' ==> IMPOSSIBLE!!'
2973                                           endif
2974                                        endif
2975  *                                   -----------------------------  *                                   -----------------------------
2976                                   endif                                   endif
2977                                enddo !end loop on planes                                enddo !end loop on planes
2978  *     **********************************************************  *     **********************************************************
2979  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
2980  *     **********************************************************  *     **********************************************************
2981    cccc  scommentare se si usa al_ini della nuvola
2982    c$$$                              do i=1,5
2983    c$$$                                 AL(i)=AL_INI(i)
2984    c$$$                              enddo
2985                                  call guess()
2986                                do i=1,5                                do i=1,5
2987                                   AL(i)=AL_INI(i)                                   AL_INI(i)=AL(i)
2988                                enddo                                enddo
2989                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
2990                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
2991                                call mini_2(jstep,ifail)                                iprint=0
2992    c                              if(DEBUG.EQ.1)iprint=1
2993                                  if(DEBUG.EQ.1)iprint=2
2994                                  call mini2(jstep,ifail,iprint)
2995                                if(ifail.ne.0) then                                if(ifail.ne.0) then
2996                                   if(DEBUG)then                                   if(DEBUG.EQ.1)then
2997                                      print *,                                      print *,
2998       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
2999       $                              //'(mini_2 in clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
3000                                        print*,'initial guess: '
3001    
3002                                        print*,'AL_INI(1) = ',AL_INI(1)
3003                                        print*,'AL_INI(2) = ',AL_INI(2)
3004                                        print*,'AL_INI(3) = ',AL_INI(3)
3005                                        print*,'AL_INI(4) = ',AL_INI(4)
3006                                        print*,'AL_INI(5) = ',AL_INI(5)
3007                                   endif                                   endif
3008                                   chi2=-chi2  c                                 chi2=-chi2
3009                                endif                                endif
3010  *     **********************************************************  *     **********************************************************
3011  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
3012  *     **********************************************************  *     **********************************************************
3013    
3014                                if(chi2.le.0.)goto 666                                              if(chi2.le.0.)goto 666              
3015                                  if(chi2.ge.1.e08)goto 666 !OPTIMIZATION
3016                                  if(chi2.ne.chi2)goto 666  !OPTIMIZATION
3017    
3018  *     --------------------------  *     --------------------------
3019  *     STORE candidate TRACK INFO  *     STORE candidate TRACK INFO
3020  *     --------------------------  *     --------------------------
3021                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
3022                                                                    
3023                                   if(DEBUG)print*,                                   if(verbose.eq.1)print*,
3024       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
3025       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
3026       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
3027  c                                 good2=.false.  c                                 good2=.false.
3028  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
3029                                     do iv=1,nviews
3030    c                                    mask_view(iv) = 7
3031                                        mask_view(iv) = mask_view(iv) + 2**6
3032                                     enddo
3033                                   iflag=1                                   iflag=1
3034                                   return                                   return
3035                                endif                                endif
3036                                                                
3037                                ntracks = ntracks + 1                                ntracks = ntracks + 1
3038                                                                
3039  c$$$                              ndof=0                                                                do ip=1,nplanes !top to bottom
3040                                do ip=1,nplanes  
 c$$$                                 ndof=ndof  
 c$$$     $                                +int(xgood(ip))  
 c$$$     $                                +int(ygood(ip))  
3041                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
3042                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
3043                                   ZV_STORE(ip,ntracks)=sngl(zv(ip))                                                                       ZV_STORE(ip,ntracks)=sngl(zv(ip))                                    
# Line 3205  c$$$     $                               Line 3053  c$$$     $                              
3053                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))
3054                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))
3055                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))
3056    *                                NB! hit_plane is defined from bottom to top
3057                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
3058                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
3059       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
3060                                        SENSOR_STORE(nplanes-ip+1,ntracks)
3061         $                              = is_cp(cp_match(ip,hit_plane(ip)))
3062                                        
3063                                        icl=
3064         $                                   clx(ip,icp_cp(
3065         $                                   cp_match(ip,hit_plane(ip)
3066         $                                   )));
3067                                        if(icl.eq.0)
3068         $                                   icl=
3069         $                                   cly(ip,icp_cp(
3070         $                                   cp_match(ip,hit_plane(ip)
3071         $                                   )));
3072    
3073                                        LADDER_STORE(nplanes-ip+1,ntracks)
3074         $                                   = LADDER(icl);
3075                                   else                                   else
3076                                      CP_STORE(nplanes-ip+1,ntracks)=0                                      CP_STORE(nplanes-ip+1,ntracks)=0
3077                                        SENSOR_STORE(nplanes-ip+1,ntracks)=0
3078                                        LADDER_STORE(nplanes-ip+1,ntracks)=0
3079                                   endif                                   endif
3080                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   BX_STORE(ip,ntracks)=0!I dont need it now
3081                                     BY_STORE(ip,ntracks)=0!I dont need it now
3082                                     CLS_STORE(ip,ntracks)=0
3083                                   do i=1,5                                   do i=1,5
3084                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
3085                                   enddo                                   enddo
3086                                enddo                                enddo
3087                                                                
 c$$$  *                             Number of Degree Of Freedom  
 c$$$  ndof=ndof-5                            
 c$$$  *                             reduced chi^2  
 c$$$  rchi2=chi2/dble(ndof)  
3088                                RCHI2_STORE(ntracks)=chi2                                RCHI2_STORE(ntracks)=chi2
3089                                                                
3090  *     --------------------------------  *     --------------------------------
# Line 3241  c$$$  rchi2=chi2/dble(ndof) Line 3105  c$$$  rchi2=chi2/dble(ndof)
3105                
3106        if(ntracks.eq.0)then        if(ntracks.eq.0)then
3107           iflag=1           iflag=1
3108           return  cc         return
3109        endif        endif
3110                
3111        if(DEBUG)then        if(DEBUG.EQ.1)then
3112           print*,'****** TRACK CANDIDATES ***********'          print*,'****** TRACK CANDIDATES *****************'
3113           print*,'#         R. chi2        RIG'          print*,'#         R. chi2        RIG         ndof'
3114           do i=1,ntracks          do i=1,ntracks
3115              print*,i,' --- ',rchi2_store(i),' --- '            ndof=0                !(1)
3116       $           ,1./abs(AL_STORE(5,i))            do ii=1,nplanes       !(1)
3117           enddo              ndof=ndof           !(1)
3118           print*,'***********************************'       $           +int(xgood_store(ii,i)) !(1)
3119         $           +int(ygood_store(ii,i)) !(1)
3120              enddo                 !(1)
3121              print*,i,' --- ',rchi2_store(i),' --- '
3122         $         ,1./abs(AL_STORE(5,i)),' --- ',ndof
3123            enddo
3124            print*,'*****************************************'
3125        endif        endif
3126                
3127                
# Line 3270  c$$$  rchi2=chi2/dble(ndof) Line 3140  c$$$  rchi2=chi2/dble(ndof)
3140    
3141        subroutine refine_track(ibest)        subroutine refine_track(ibest)
3142    
 c******************************************************  
 cccccc 06/10/2005 modified by elena vannuccini ---> (1)  
 cccccc 31/01/2006 modified by elena vannuccini ---> (2)  
 c******************************************************  
3143    
3144        include 'commontracker.f'        include 'commontracker.f'
3145          include 'level1.f'
3146        include 'common_momanhough.f'        include 'common_momanhough.f'
3147        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3148        include 'common_mini_2.f'        include 'common_mini_2.f'
3149        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
       include 'level1.f'  
3150        include 'calib.f'        include 'calib.f'
3151    
       logical DEBUG  
       common/dbg/DEBUG  
   
3152  *     flag to chose PFA  *     flag to chose PFA
3153        character*10 PFA        character*10 PFA
3154        common/FINALPFA/PFA        common/FINALPFA/PFA
3155    
3156          real k(6)
3157          DATA k/1.099730,0.418900,0.220939,0.220907,0.418771,1.100674/
3158    
3159          real xp,yp,zp
3160          real xyzp(3),bxyz(3)
3161          equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
3162    
3163          if(DEBUG.EQ.1)print*,'refine_track:'
3164  *     =================================================  *     =================================================
3165  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
3166  *                          and  *                          and
# Line 3299  c*************************************** Line 3169  c***************************************
3169        call track_init        call track_init
3170        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3171    
3172             if(DEBUG.EQ.1)print*,' ........... plane ',ip,' ........... '
3173    
3174             xP=XV_STORE(nplanes-ip+1,ibest)
3175             yP=YV_STORE(nplanes-ip+1,ibest)
3176             zP=ZV_STORE(nplanes-ip+1,ibest)
3177             call gufld(xyzp,bxyz)
3178             BX_STORE(nplanes-ip+1,ibest)=bxyz(1)
3179             BY_STORE(nplanes-ip+1,ibest)=bxyz(2)
3180    c$$$  bxyz(1)=0
3181    c$$$         bxyz(2)=0
3182    c$$$         bxyz(3)=0
3183    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3184  *     -------------------------------------------------  *     -------------------------------------------------
3185  *     If the plane has been already included, it just  *     If the plane has been already included, it just
3186  *     computes again the coordinates of the x-y couple  *     computes again the coordinates of the x-y couple
3187  *     using improved PFAs  *     using improved PFAs
3188  *     -------------------------------------------------  *     -------------------------------------------------
3189           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.  *     |||||||||||||||||||||||||||||||||||||||||||||||||
3190    c$$$         if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
3191    c$$$     $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
3192    c$$$            
3193    c$$$            id=CP_STORE(nplanes-ip+1,ibest)
3194    c$$$            
3195    c$$$            is=is_cp(id)
3196    c$$$            icp=icp_cp(id)
3197    c$$$            if(ip_cp(id).ne.ip)
3198    c$$$     $           print*,'OKKIO!!'
3199    c$$$     $           ,'id ',id,is,icp
3200    c$$$     $           ,ip_cp(id),ip
3201    c$$$            icx=clx(ip,icp)
3202    c$$$            icy=cly(ip,icp)
3203    c$$$c            call xyz_PAM(icx,icy,is,
3204    c$$$c     $           PFA,PFA,
3205    c$$$c     $           AXV_STORE(nplanes-ip+1,ibest),
3206    c$$$c     $           AYV_STORE(nplanes-ip+1,ibest))
3207    c$$$            call xyz_PAM(icx,icy,is,
3208    c$$$     $           PFA,PFA,
3209    c$$$     $           AXV_STORE(nplanes-ip+1,ibest),
3210    c$$$     $           AYV_STORE(nplanes-ip+1,ibest),
3211    c$$$     $           bxyz(1),
3212    c$$$     $           bxyz(2)
3213    c$$$     $           )
3214    c$$$
3215    c$$$            xm(nplanes-ip+1) = xPAM
3216    c$$$            ym(nplanes-ip+1) = yPAM
3217    c$$$            zm(nplanes-ip+1) = zPAM
3218    c$$$            xgood(nplanes-ip+1) = 1
3219    c$$$            ygood(nplanes-ip+1) = 1
3220    c$$$            resx(nplanes-ip+1) = resxPAM
3221    c$$$            resy(nplanes-ip+1) = resyPAM
3222    c$$$
3223    c$$$            dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3224    c$$$            dedxtrk_y(nplanes-ip+1)=sgnl(icy)/mip(VIEW(icy),LADDER(icy))
3225             if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..or.
3226       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
3227                            
3228              id=CP_STORE(nplanes-ip+1,ibest)              id=CP_STORE(nplanes-ip+1,ibest)
# Line 3317  c*************************************** Line 3235  c***************************************
3235       $           ,ip_cp(id),ip       $           ,ip_cp(id),ip
3236              icx=clx(ip,icp)              icx=clx(ip,icp)
3237              icy=cly(ip,icp)              icy=cly(ip,icp)
3238    c            call xyz_PAM(icx,icy,is,
3239    c     $           PFA,PFA,
3240    c     $           AXV_STORE(nplanes-ip+1,ibest),
3241    c     $           AYV_STORE(nplanes-ip+1,ibest))
3242              call xyz_PAM(icx,icy,is,              call xyz_PAM(icx,icy,is,
 c     $           'ETA2','ETA2',  
3243       $           PFA,PFA,       $           PFA,PFA,
3244       $           AXV_STORE(nplanes-ip+1,ibest),       $           AXV_STORE(nplanes-ip+1,ibest),
3245       $           AYV_STORE(nplanes-ip+1,ibest))       $           AYV_STORE(nplanes-ip+1,ibest),
3246  c$$$  call xyz_PAM(icx,icy,is,       $           bxyz(1),
3247  c$$$  $              'COG2','COG2',       $           bxyz(2)
3248  c$$$  $              0.,       $           )
3249  c$$$  $              0.)  
3250              xm(nplanes-ip+1) = xPAM              if(icx.gt.0.and.icy.gt.0)then
3251              ym(nplanes-ip+1) = yPAM                 xm(nplanes-ip+1) = xPAM
3252              zm(nplanes-ip+1) = zPAM                 ym(nplanes-ip+1) = yPAM
3253              xgood(nplanes-ip+1) = 1                 zm(nplanes-ip+1) = zPAM
3254              ygood(nplanes-ip+1) = 1                 xm_A(nplanes-ip+1) = 0.
3255              resx(nplanes-ip+1) = resxPAM                 ym_A(nplanes-ip+1) = 0.
3256              resy(nplanes-ip+1) = resyPAM                 xm_B(nplanes-ip+1) = 0.
3257                   ym_B(nplanes-ip+1) = 0.
3258  c            dedxtrk(nplanes-ip+1) = (dedx(icx)+dedx(icy))/2. !(1)                 xgood(nplanes-ip+1) = 1
3259              dedxtrk_x(nplanes-ip+1)=dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                 ygood(nplanes-ip+1) = 1
3260              dedxtrk_y(nplanes-ip+1)=dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                 resx(nplanes-ip+1) = resxPAM
3261                   resy(nplanes-ip+1) = resyPAM
3262                   dedxtrk_x(nplanes-ip+1)=
3263         $              sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3264                   dedxtrk_y(nplanes-ip+1)=
3265         $              sgnl(icy)/mip(VIEW(icy),LADDER(icy))
3266                else
3267                   xm(nplanes-ip+1) = 0.
3268                   ym(nplanes-ip+1) = 0.
3269                   zm(nplanes-ip+1) = (zPAM_A+zPAM_B)/2.
3270                   xm_A(nplanes-ip+1) = xPAM_A
3271                   ym_A(nplanes-ip+1) = yPAM_A
3272                   xm_B(nplanes-ip+1) = xPAM_B
3273                   ym_B(nplanes-ip+1) = yPAM_B
3274                   xgood(nplanes-ip+1) = 0
3275                   ygood(nplanes-ip+1) = 0
3276                   resx(nplanes-ip+1) = 1000.!resxPAM
3277                   resy(nplanes-ip+1) = 1000.!resyPAM
3278                   dedxtrk_x(nplanes-ip+1)= 0
3279                   dedxtrk_y(nplanes-ip+1)= 0
3280                   if(icx.gt.0)then
3281                      xgood(nplanes-ip+1) = 1
3282                      resx(nplanes-ip+1) = resxPAM
3283                      dedxtrk_x(nplanes-ip+1)=
3284         $                 sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3285                   elseif(icy.gt.0)then
3286                      ygood(nplanes-ip+1) = 1
3287                      resy(nplanes-ip+1) = resyPAM
3288                      dedxtrk_y(nplanes-ip+1)=
3289         $                 sgnl(icy)/mip(VIEW(icy),LADDER(icy))
3290                   endif
3291                endif
3292                            
3293    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3294  *     -------------------------------------------------  *     -------------------------------------------------
3295  *     If the plane has NOT  been already included,  *     If the plane has NOT  been already included,
3296  *     it tries to include a COUPLE or a single cluster  *     it tries to include a COUPLE or a single cluster
3297  *     -------------------------------------------------  *     -------------------------------------------------
3298    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3299           else                             else                  
3300                                
3301              xgood(nplanes-ip+1)=0              xgood(nplanes-ip+1)=0
3302              ygood(nplanes-ip+1)=0              ygood(nplanes-ip+1)=0
3303    
3304                CP_STORE(nplanes-ip+1,ibest)=0 !re-init
3305                CLS_STORE(nplanes-ip+1,ibest)=0
3306    
3307                                
3308  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3309  *     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)  
3310              call whichsensor(ip,xP,yP,nldt,ist)              call whichsensor(ip,xP,yP,nldt,ist)
3311  *     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
3312              if(nldt.eq.0.or.ist.eq.0)goto 133              if(nldt.eq.0.or.ist.eq.0)goto 133
3313    
3314                SENSOR_STORE(nplanes-ip+1,IBEST)=ist
3315                LADDER_STORE(nplanes-ip+1,IBEST)=nldt
3316  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3317    
3318              if(DEBUG)then              if(DEBUG.EQ.1)then
3319                 print*,                 print*,
3320       $              '------ Plane ',ip,' intersected on LADDER ',nldt       $              '------ Plane ',ip,' intersected on LADDER ',nldt
3321       $              ,' SENSOR ',ist       $              ,' SENSOR ',ist
# Line 3368  c            dedxtrk(nplanes-ip+1) = (de Line 3326  c            dedxtrk(nplanes-ip+1) = (de
3326  *     ===========================================  *     ===========================================
3327  *     STEP 1 >>>>>>>  try to include a new couple  *     STEP 1 >>>>>>>  try to include a new couple
3328  *     ===========================================  *     ===========================================
3329  c            if(DEBUG)print*,'>>>> try to include a new couple'              distmin=100000000.
             distmin=1000000.  
3330              xmm = 0.              xmm = 0.
3331              ymm = 0.              ymm = 0.
3332              zmm = 0.              zmm = 0.
# Line 3382  c            if(DEBUG)print*,'>>>> try t Line 3339  c            if(DEBUG)print*,'>>>> try t
3339              do icp=1,ncp_plane(ip) !loop on couples on plane icp              do icp=1,ncp_plane(ip) !loop on couples on plane icp
3340                 icx=clx(ip,icp)                 icx=clx(ip,icp)
3341                 icy=cly(ip,icp)                 icy=cly(ip,icp)
3342                   if(icx.eq.0.or.icy.eq.0)goto 1188!if fake couple, jump to next
3343                 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
3344       $              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
3345       $              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
3346         $              cl_used(icx).ne.0.or. !or the X cluster is already used
3347         $              cl_used(icy).ne.0.or. !or the Y cluster is already used
3348       $              .false.)goto 1188 !then jump to next couple.       $              .false.)goto 1188 !then jump to next couple.
3349  *            *          
3350                 call xyz_PAM(icx,icy,ist,                 call xyz_PAM(icx,icy,ist,
3351       $              PFA,PFA,       $              PFA,PFA,
 c     $              'ETA2','ETA2',  
3352       $              AXV_STORE(nplanes-ip+1,ibest),       $              AXV_STORE(nplanes-ip+1,ibest),
3353       $              AYV_STORE(nplanes-ip+1,ibest))       $              AYV_STORE(nplanes-ip+1,ibest),
3354         $              bxyz(1),
3355         $              bxyz(2)
3356         $              )
3357                                
3358                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3359    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3360                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3361                 if(DEBUG)print*,'( couple ',id                 if(DEBUG.EQ.1)
3362       $              ,' ) normalized distance ',distance       $              print*,'( couple ',id
3363         $              ,' ) distance ',distance
3364                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3365                    xmm = xPAM                    xmm = xPAM
3366                    ymm = yPAM                    ymm = yPAM
# Line 3405  c     $              'ETA2','ETA2', Line 3369  c     $              'ETA2','ETA2',
3369                    rymm = resyPAM                    rymm = resyPAM
3370                    distmin = distance                    distmin = distance
3371                    idm = id                                      idm = id                  
3372  c                 dedxmm = (dedx(icx)+dedx(icy))/2. !(1)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3373                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3374                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    clincnewc=10*sqrt(rymm**2+rxmm**2
3375         $                 +RCHI2_STORE(ibest)*k(ip)*(cov(1,1)+cov(2,2)))
3376                 endif                 endif
3377   1188          continue   1188          continue
3378              enddo               !end loop on couples on plane icp              enddo               !end loop on couples on plane icp
3379              if(distmin.le.clinc)then                                if(distmin.le.clincnewc)then    
3380  *              -----------------------------------  *              -----------------------------------
3381                 xm(nplanes-ip+1) = xmm         !<<<                 xm(nplanes-ip+1) = xmm !<<<
3382                 ym(nplanes-ip+1) = ymm         !<<<                 ym(nplanes-ip+1) = ymm !<<<
3383                 zm(nplanes-ip+1) = zmm         !<<<                 zm(nplanes-ip+1) = zmm !<<<
3384                 xgood(nplanes-ip+1) = 1        !<<<                 xgood(nplanes-ip+1) = 1 !<<<
3385                 ygood(nplanes-ip+1) = 1        !<<<                 ygood(nplanes-ip+1) = 1 !<<<
3386                 resx(nplanes-ip+1)=rxmm        !<<<                 resx(nplanes-ip+1)=rxmm !<<<
3387                 resy(nplanes-ip+1)=rymm        !<<<                 resy(nplanes-ip+1)=rymm !<<<
3388  c              dedxtrk(nplanes-ip+1) = dedxmm !<<<  !(1)                 dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3389                 dedxtrk_x(nplanes-ip+1) = dedxmmx    !(1)                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
                dedxtrk_y(nplanes-ip+1) = dedxmmy    !(1)  
3390  *              -----------------------------------  *              -----------------------------------
3391                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
3392                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG.EQ.1)print*,'%%%% included couple ',idm
3393       $              ,' (norm.dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clincnewc,' )'
3394                 goto 133         !next plane                 goto 133         !next plane
3395              endif              endif
3396  *     ================================================  *     ================================================
3397  *     STEP 2 >>>>>>>  try to include a single cluster  *     STEP 2 >>>>>>>  try to include a single cluster
3398  *                     either from a couple or single  *                     either from a couple or single
3399  *     ================================================  *     ================================================
 c            if(DEBUG)print*,'>>>> try to include a new cluster'  
3400              distmin=1000000.              distmin=1000000.
3401              xmm_A = 0.          !---------------------------              xmm_A = 0.          !---------------------------
3402              ymm_A = 0.          ! init variables that              ymm_A = 0.          ! init variables that
# Line 3452  c            if(DEBUG)print*,'>>>> try t Line 3415  c            if(DEBUG)print*,'>>>> try t
3415              do icp=1,ncp_plane(ip) !loop on cluster inside couples              do icp=1,ncp_plane(ip) !loop on cluster inside couples
3416                 icx=clx(ip,icp)                 icx=clx(ip,icp)
3417                 icy=cly(ip,icp)                 icy=cly(ip,icp)
3418                   if(icx.eq.0.or.icy.eq.0)goto 11882!if fake couple, jump to next
3419                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3420                 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
3421  *                                                !jump to the next couple  *                                                !jump to the next couple
3422  *----- try cluster x -----------------------------------------------  *----- try cluster x -----------------------------------------------
3423                 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
3424                   if(cl_used(icx).ne.0)goto 11881 !if the X cluster is already used  !(3)
3425  *                                              !jump to the Y cluster  *                                              !jump to the Y cluster
3426    c               call xyz_PAM(icx,0,ist,
3427    c     $              PFA,PFA,
3428    c     $              AXV_STORE(nplanes-ip+1,ibest),0.)              
3429                 call xyz_PAM(icx,0,ist,                 call xyz_PAM(icx,0,ist,
 c     $              'ETA2','ETA2',  
3430       $              PFA,PFA,       $              PFA,PFA,
3431       $              AXV_STORE(nplanes-ip+1,ibest),0.)                     $              AXV_STORE(nplanes-ip+1,ibest),0.,
3432         $              bxyz(1),
3433         $              bxyz(2)
3434         $              )              
3435                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3436  c     if(DEBUG)print*,'normalized distance ',distance  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3437                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG.EQ.1)
3438       $              ,' in cp ',id,' ) normalized distance ',distance       $              print*,'( cl-X ',icx
3439         $              ,' in cp ',id,' ) distance ',distance
3440                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3441                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3442                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3477  c     if(DEBUG)print*,'normalized distan Line 3448  c     if(DEBUG)print*,'normalized distan
3448                    rymm = resyPAM                    rymm = resyPAM
3449                    distmin = distance                    distmin = distance
3450                    iclm = icx                    iclm = icx
3451  c                  dedxmm = dedx(icx) !(1)  c                  dedxmm = sgnl(icx) !(1)
3452                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3453                    dedxmmy = 0.        !(1)                    dedxmmy = 0.        !(1)
3454                 endif                                   endif                  
3455  11881          continue  11881          continue
3456  *----- try cluster y -----------------------------------------------  *----- try cluster y -----------------------------------------------
3457                 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
3458                   if(cl_used(icy).ne.0)goto 11882 !if the Y cluster is already used !(3)
3459  *                                              !jump to the next couple  *                                              !jump to the next couple
3460    c               call xyz_PAM(0,icy,ist,
3461    c     $              PFA,PFA,
3462    c     $              0.,AYV_STORE(nplanes-ip+1,ibest))
3463                 call xyz_PAM(0,icy,ist,                 call xyz_PAM(0,icy,ist,
 c     $              'ETA2','ETA2',  
3464       $              PFA,PFA,       $              PFA,PFA,
3465       $              0.,AYV_STORE(nplanes-ip+1,ibest))       $              0.,AYV_STORE(nplanes-ip+1,ibest),
3466         $              bxyz(1),
3467         $              bxyz(2)
3468         $              )
3469                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3470                 if(DEBUG)print*,'( cl-Y ',icy  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3471       $              ,' in cp ',id,' ) normalized distance ',distance                 if(DEBUG.EQ.1)
3472         $              print*,'( cl-Y ',icy
3473         $              ,' in cp ',id,' ) distance ',distance
3474                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3475                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3476                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3503  c     $              'ETA2','ETA2', Line 3482  c     $              'ETA2','ETA2',
3482                    rymm = resyPAM                    rymm = resyPAM
3483                    distmin = distance                    distmin = distance
3484                    iclm = icy                    iclm = icy
3485  c                 dedxmm = dedx(icy)  !(1)  c                 dedxmm = sgnl(icy)  !(1)
3486                    dedxmmx = 0.        !(1)                    dedxmmx = 0.        !(1)
3487                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3488                 endif                                   endif                  
3489  11882          continue  11882          continue
3490              enddo               !end loop on cluster inside couples              enddo               !end loop on cluster inside couples
3491  *----- single clusters -----------------------------------------------      *----- single clusters -----------------------------------------------  
3492              do ic=1,ncls(ip)    !loop on single clusters              do ic=1,ncls(ip)    !loop on single clusters
3493                 icl=cls(ip,ic)                 icl=cls(ip,ic)
3494                 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)
3495       $              LADDER(icl).ne.nldt.or. !or the ladder number does not match       $              LADDER(icl).ne.nldt.or. !or the ladder number does not match
3496       $              .false.)goto 18882      !jump to the next singlet       $              .false.)goto 18882      !jump to the next singlet
3497                 if(mod(VIEW(icl),2).eq.0)then!<---- X view                 if(mod(VIEW(icl),2).eq.0)then!<---- X view
3498                    call xyz_PAM(icl,0,ist,                    call xyz_PAM(icl,0,ist,
 c     $                 'ETA2','ETA2',  
3499       $                 PFA,PFA,       $                 PFA,PFA,
3500       $                 AXV_STORE(nplanes-ip+1,ibest),0.)       $                 AXV_STORE(nplanes-ip+1,ibest),0.,
3501         $                 bxyz(1),
3502         $                 bxyz(2)
3503         $                 )
3504                 else                         !<---- Y view                 else                         !<---- Y view
3505                    call xyz_PAM(0,icl,ist,                    call xyz_PAM(0,icl,ist,
 c     $                 'ETA2','ETA2',  
3506       $                 PFA,PFA,       $                 PFA,PFA,
3507       $                 0.,AYV_STORE(nplanes-ip+1,ibest))       $                 0.,AYV_STORE(nplanes-ip+1,ibest),
3508         $                 bxyz(1),
3509         $                 bxyz(2)
3510         $                 )
3511                 endif                 endif
3512    
3513                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3514                 if(DEBUG)print*,'( cl-s ',icl  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3515       $              ,' ) normalized distance ',distance                 if(DEBUG.EQ.1)
3516         $              print*,'( cl-s ',icl
3517         $              ,' ) distance ',distance
3518                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3519                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3520                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3541  c     $                 'ETA2','ETA2', Line 3526  c     $                 'ETA2','ETA2',
3526                    rymm = resyPAM                    rymm = resyPAM
3527                    distmin = distance                      distmin = distance  
3528                    iclm = icl                    iclm = icl
 c                  dedxmm = dedx(icl)                   !(1)  
3529                    if(mod(VIEW(icl),2).eq.0)then !<---- X view                    if(mod(VIEW(icl),2).eq.0)then !<---- X view
3530                       dedxmmx = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3531                       dedxmmy = 0.                       !(1)                       dedxmmy = 0.                  
3532                    else          !<---- Y view                    else          !<---- Y view
3533                       dedxmmx = 0.                       !(1)                       dedxmmx = 0.                  
3534                       dedxmmy = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3535                    endif                    endif
3536                 endif                                   endif                  
3537  18882          continue  18882          continue
3538              enddo               !end loop on single clusters              enddo               !end loop on single clusters
3539    
3540              if(distmin.le.clinc)then                                if(iclm.ne.0)then
                 
                CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<      
 *              ----------------------------  
3541                 if(mod(VIEW(iclm),2).eq.0)then                 if(mod(VIEW(iclm),2).eq.0)then
3542                    XGOOD(nplanes-ip+1)=1.                    clincnew=
3543                    resx(nplanes-ip+1)=rxmm       $                 20*
3544                    if(DEBUG)print*,'%%%% included X-cl ',iclm       $                 sqrt(rxmm**2+RCHI2_STORE(ibest)*k(ip)*cov(1,1))
3545       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'                 else if(mod(VIEW(iclm),2).ne.0)then
3546                 else                    clincnew=
3547                    YGOOD(nplanes-ip+1)=1.       $                 10*
3548                    resy(nplanes-ip+1)=rymm       $                 sqrt(rymm**2+RCHI2_STORE(ibest)*k(ip)*cov(2,2))
3549                    if(DEBUG)print*,'%%%% included Y-cl ',iclm                 endif
3550       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'  
3551                   if(distmin.le.clincnew)then  
3552                      
3553                      CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<    
3554    *     ----------------------------
3555                      if(mod(VIEW(iclm),2).eq.0)then
3556                         XGOOD(nplanes-ip+1)=1.
3557                         resx(nplanes-ip+1)=rxmm
3558                         if(DEBUG.EQ.1)
3559         $                    print*,'%%%% included X-cl ',iclm
3560         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3561         $                    ,', dist.= ',distmin
3562         $                    ,', cut ',clincnew,' )'
3563                      else
3564                         YGOOD(nplanes-ip+1)=1.
3565                         resy(nplanes-ip+1)=rymm
3566                         if(DEBUG.EQ.1)
3567         $                    print*,'%%%% included Y-cl ',iclm
3568         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3569         $                    ,', dist.= ', distmin
3570         $                    ,', cut ',clincnew,' )'
3571                      endif
3572    *     ----------------------------
3573                      xm_A(nplanes-ip+1) = xmm_A
3574                      ym_A(nplanes-ip+1) = ymm_A
3575                      xm_B(nplanes-ip+1) = xmm_B
3576                      ym_B(nplanes-ip+1) = ymm_B
3577                      zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3578                      dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3579                      dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3580    *     ----------------------------
3581                 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)  
 *              ----------------------------  
3582              endif              endif
3583           endif           endif
3584   133     continue   133     continue
# Line 3588  c              dedxtrk(nplanes-ip+1) = d Line 3589  c              dedxtrk(nplanes-ip+1) = d
3589        return        return
3590        end        end
3591    
3592    
3593  ***************************************************  ***************************************************
3594  *                                                 *  *                                                 *
3595  *                                                 *  *                                                 *
# Line 3596  c              dedxtrk(nplanes-ip+1) = d Line 3598  c              dedxtrk(nplanes-ip+1) = d
3598  *                                                 *  *                                                 *
3599  *                                                 *  *                                                 *
3600  **************************************************  **************************************************
3601    *
       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$$$  
3602    
3603    
3604    
# Line 3779  c$$$ Line 3606  c$$$
3606    
3607        subroutine init_level2        subroutine init_level2
3608    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c*****************************************************  
   
3609        include 'commontracker.f'        include 'commontracker.f'
3610          include 'level1.f'
3611        include 'common_momanhough.f'        include 'common_momanhough.f'
3612        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*****************************************************  
3613    
3614    *     ---------------------------------
3615    *     variables initialized from level1
3616    *     ---------------------------------
3617          do i=1,nviews
3618             good2(i)=good1(i)
3619             do j=1,nva1_view
3620                vkflag(i,j)=1
3621                if(cnnev(i,j).le.0)then
3622                   vkflag(i,j)=cnnev(i,j)
3623                endif
3624             enddo
3625          enddo
3626    *     ----------------
3627    *     level2 variables
3628    *     ----------------
3629        NTRK = 0        NTRK = 0
3630        do it=1,NTRKMAX!NTRACKSMAX        do it=1,NTRKMAX
3631           IMAGE(IT)=0           IMAGE(IT)=0
3632           CHI2_nt(IT) = -100000.           CHI2_nt(IT) = -100000.
          BdL(IT) = 0.  
3633           do ip=1,nplanes           do ip=1,nplanes
3634              XM_nt(IP,IT) = 0              XM_nt(IP,IT) = 0
3635              YM_nt(IP,IT) = 0              YM_nt(IP,IT) = 0
3636              ZM_nt(IP,IT) = 0              ZM_nt(IP,IT) = 0
3637              RESX_nt(IP,IT) = 0              RESX_nt(IP,IT) = 0
3638              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3639                TAILX_nt(IP,IT) = 0
3640                TAILY_nt(IP,IT) = 0
3641                XBAD(IP,IT) = 0
3642                YBAD(IP,IT) = 0
3643              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3644              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
3645  c*****************************************************              LS(IP,IT) = 0
 cccccc 11/9/2005 modified by david fedele  
3646              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3647              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
3648  c******************************************************              CLTRX(IP,IT) = 0
3649                CLTRY(IP,IT) = 0
3650                multmaxx(ip,it) = 0
3651                seedx(ip,it)    = 0
3652                xpu(ip,it)      = 0
3653                multmaxy(ip,it) = 0
3654                seedy(ip,it)    = 0
3655                ypu(ip,it)      = 0
3656           enddo           enddo
3657           do ipa=1,5           do ipa=1,5
3658              AL_nt(IPA,IT) = 0              AL_nt(IPA,IT) = 0
# Line 3839  c*************************************** Line 3661  c***************************************
3661              enddo                                enddo                  
3662           enddo                             enddo                  
3663        enddo        enddo
         
         
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3664        nclsx=0        nclsx=0
3665        nclsy=0              nclsy=0      
3666        do ip=1,NSINGMAX        do ip=1,NSINGMAX
3667          planex(ip)=0          planex(ip)=0
 c        xs(ip)=0  
3668          xs(1,ip)=0          xs(1,ip)=0
3669          xs(2,ip)=0          xs(2,ip)=0
3670          sgnlxs(ip)=0          sgnlxs(ip)=0
3671          planey(ip)=0          planey(ip)=0
 c        ys(ip)=0  
3672          ys(1,ip)=0          ys(1,ip)=0
3673          ys(2,ip)=0          ys(2,ip)=0
3674          sgnlys(ip)=0          sgnlys(ip)=0
3675            sxbad(ip)=0
3676            sybad(ip)=0
3677            multmaxsx(ip)=0
3678            multmaxsy(ip)=0
3679        enddo        enddo
 c*******************************************************  
3680        end        end
3681    
3682    
# Line 3872  c*************************************** Line 3691  c***************************************
3691  ************************************************************  ************************************************************
3692    
3693    
3694          subroutine init_hough
3695    
3696          include 'commontracker.f'
3697          include 'level1.f'
3698          include 'common_momanhough.f'
3699          include 'common_hough.f'
3700          include 'level2.f'
3701    
3702          ntrpt_nt=0
3703          ndblt_nt=0
3704          NCLOUDS_XZ_nt=0
3705          NCLOUDS_YZ_nt=0
3706          do idb=1,ndblt_max_nt
3707             db_cloud_nt(idb)=0
3708             alfayz1_nt(idb)=0      
3709             alfayz2_nt(idb)=0      
3710          enddo
3711          do itr=1,ntrpt_max_nt
3712             tr_cloud_nt(itr)=0
3713             alfaxz1_nt(itr)=0      
3714             alfaxz2_nt(itr)=0      
3715             alfaxz3_nt(itr)=0      
3716          enddo
3717          do idb=1,ncloyz_max      
3718            ptcloud_yz_nt(idb)=0    
3719            alfayz1_av_nt(idb)=0    
3720            alfayz2_av_nt(idb)=0    
3721          enddo                    
3722          do itr=1,ncloxz_max      
3723            ptcloud_xz_nt(itr)=0    
3724            alfaxz1_av_nt(itr)=0    
3725            alfaxz2_av_nt(itr)=0    
3726            alfaxz3_av_nt(itr)=0    
3727          enddo                    
3728    
3729          ntrpt=0                  
3730          ndblt=0                  
3731          NCLOUDS_XZ=0              
3732          NCLOUDS_YZ=0              
3733          do idb=1,ndblt_max        
3734            db_cloud(idb)=0        
3735            cpyz1(idb)=0            
3736            cpyz2(idb)=0            
3737            alfayz1(idb)=0          
3738            alfayz2(idb)=0          
3739          enddo                    
3740          do itr=1,ntrpt_max        
3741            tr_cloud(itr)=0        
3742            cpxz1(itr)=0            
3743            cpxz2(itr)=0            
3744            cpxz3(itr)=0            
3745            alfaxz1(itr)=0          
3746            alfaxz2(itr)=0          
3747            alfaxz3(itr)=0          
3748          enddo                    
3749          do idb=1,ncloyz_max      
3750            ptcloud_yz(idb)=0      
3751            alfayz1_av(idb)=0      
3752            alfayz2_av(idb)=0      
3753            do idbb=1,ncouplemaxtot
3754              cpcloud_yz(idb,idbb)=0
3755            enddo                  
3756          enddo                    
3757          do itr=1,ncloxz_max      
3758            ptcloud_xz(itr)=0      
3759            alfaxz1_av(itr)=0      
3760            alfaxz2_av(itr)=0      
3761            alfaxz3_av(itr)=0      
3762            do itrr=1,ncouplemaxtot
3763              cpcloud_xz(itr,itrr)=0
3764            enddo                  
3765          enddo                    
3766          end
3767    ************************************************************
3768    *
3769    *
3770    *
3771    *
3772    *
3773    *
3774    *
3775    ************************************************************
3776    
3777    
3778        subroutine fill_level2_tracks(ntr)        subroutine fill_level2_tracks(ntr)
3779    
3780  *     -------------------------------------------------------  *     -------------------------------------------------------
# Line 3882  c*************************************** Line 3785  c***************************************
3785    
3786            
3787        include 'commontracker.f'        include 'commontracker.f'
3788          include 'level1.f'
3789          include 'common_momanhough.f'
3790        include 'level2.f'        include 'level2.f'
3791        include 'common_mini_2.f'        include 'common_mini_2.f'
3792        real sinth,phi,pig        !(4)        include 'calib.f'
3793    
3794          character*10 PFA
3795          common/FINALPFA/PFA
3796    
3797          real sinth,phi,pig
3798          integer ssensor,sladder
3799        pig=acos(-1.)        pig=acos(-1.)
3800    
       good2=1!.true.  
       chi2_nt(ntr)        = sngl(chi2)  
3801    
3802        phi   = al(4)             !(4)  
3803        sinth = al(3)             !(4)  *     -------------------------------------
3804        if(sinth.lt.0)then        !(4)        chi2_nt(ntr)        = sngl(chi2)
3805           sinth = -sinth         !(4)        nstep_nt(ntr)       = nstep
3806           phi = phi + pig        !(4)  *     -------------------------------------
3807        endif                     !(4)        phi   = al(4)          
3808        npig = aint(phi/(2*pig))  !(4)        sinth = al(3)            
3809        phi = phi - npig*2*pig    !(4)        if(sinth.lt.0)then      
3810        if(phi.lt.0)              !(4)           sinth = -sinth        
3811       $     phi = phi + 2*pig    !(4)           phi = phi + pig      
3812        al(4) = phi               !(4)        endif                    
3813        al(3) = sinth             !(4)        npig = aint(phi/(2*pig))
3814  *****************************************************        phi = phi - npig*2*pig  
3815          if(phi.lt.0)            
3816         $     phi = phi + 2*pig  
3817          al(4) = phi              
3818          al(3) = sinth            
3819        do i=1,5        do i=1,5
3820           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3821           do j=1,5           do j=1,5
3822              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3823           enddo           enddo
 c     print*,al_nt(i,ntr)  
3824        enddo        enddo
3825          *     -------------------------------------      
3826        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
3827           xgood_nt(ip,ntr) = int(xgood(ip))           xgood_nt(ip,ntr) = int(xgood(ip))
3828           ygood_nt(ip,ntr) = int(ygood(ip))           ygood_nt(ip,ntr) = int(ygood(ip))
# Line 3919  c     print*,al_nt(i,ntr) Line 3831  c     print*,al_nt(i,ntr)
3831           zm_nt(ip,ntr)    = sngl(zm(ip))           zm_nt(ip,ntr)    = sngl(zm(ip))
3832           RESX_nt(IP,ntr)  = sngl(resx(ip))           RESX_nt(IP,ntr)  = sngl(resx(ip))
3833           RESY_nt(IP,ntr)  = sngl(resy(ip))           RESY_nt(IP,ntr)  = sngl(resy(ip))
3834             TAILX_nt(IP,ntr) = 0.
3835             TAILY_nt(IP,ntr) = 0.
3836           xv_nt(ip,ntr)    = sngl(xv(ip))           xv_nt(ip,ntr)    = sngl(xv(ip))
3837           yv_nt(ip,ntr)    = sngl(yv(ip))           yv_nt(ip,ntr)    = sngl(yv(ip))
3838           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3839           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3840           ayv_nt(ip,ntr)   = sngl(ayv(ip))           ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3841  c        dedxp(ip,ntr)    = sngl(dedxtrk(ip))   !(1)  
3842           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)           factor = sqrt(
3843           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)                 $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3844        enddo       $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3845  c      call CalcBdL(100,xxxx,IFAIL)       $        1. )
3846  c      if(ifps(xxxx).eq.1)BdL(ntr) = xxxx  
3847  c$$$      print*,'xgood(ip,ntr) ',(xgood_nt(ip,ntr),ip=1,6)           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3848  c$$$      print*,'ygood(ip,ntr) ',(ygood_nt(ip,ntr),ip=1,6)           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3849  c$$$      print*,'dedx_x(ip,ntr) ',(dedx_x(ip,ntr),ip=1,6)    
3850  c$$$      print*,'dedx_y(ip,ntr) ',(dedx_y(ip,ntr),ip=1,6)  
3851    ccc         print*,ip,'dedx >>> ',dedx_x(ip,ntr),dedx_y(ip,ntr)
3852    
3853             ax   = axv_nt(ip,ntr)
3854             ay   = ayv_nt(ip,ntr)
3855             bfx  = BX_STORE(ip,IDCAND)
3856             bfy  = BY_STORE(ip,IDCAND)
3857    c$$$         if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3858    c$$$         if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3859    c$$$         tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3860    c$$$         angx     = 180.*atan(tgtemp)/acos(-1.)
3861    c$$$         tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3862    c$$$         angy    = 180.*atan(tgtemp)/acos(-1.)
3863    
3864             angx = effectiveangle(ax,2*ip,bfy)
3865             angy = effectiveangle(ay,2*ip-1,bfx)
3866            
3867            
3868    
3869             id  = CP_STORE(ip,IDCAND) ! couple id
3870             icl = CLS_STORE(ip,IDCAND)
3871             ssensor = -1
3872             sladder = -1
3873             ssensor = SENSOR_STORE(ip,IDCAND)
3874             sladder = LADDER_STORE(ip,IDCAND)
3875             if(ip.eq.6.and.ssensor.ne.0)ssensor = 3 - ssensor !notazione paolo x align
3876             LS(IP,ntr)      = ssensor+10*sladder
3877    
3878             if(id.ne.0)then
3879    c           >>> is a couple
3880                cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3881                cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3882    
3883                if(clx(nplanes-ip+1,icp_cp(id)).gt.0)then
3884    
3885                   cl_used(cltrx(ip,ntr)) = 1 !tag used clusters          
3886    
3887                   xbad(ip,ntr)= nbadstrips(4,clx(nplanes-ip+1,icp_cp(id)))              
3888    
3889                   if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3890         $              dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3891                  
3892                   multmaxx(ip,ntr) = maxs(cltrx(ip,ntr))
3893         $              +10000*mult(cltrx(ip,ntr))
3894                   seedx(ip,ntr)    = clsignal(indmax(cltrx(ip,ntr)))
3895         $              /clsigma(indmax(cltrx(ip,ntr)))
3896                   call applypfa(PFA,cltrx(ip,ntr),angx,corr,res)
3897                   xpu(ip,ntr)      = corr
3898    
3899                endif
3900                if(cly(nplanes-ip+1,icp_cp(id)).gt.0)then
3901    
3902                   cl_used(cltry(ip,ntr)) = 1 !tag used clusters          
3903    
3904                   ybad(ip,ntr)= nbadstrips(4,cly(nplanes-ip+1,icp_cp(id)))
3905    
3906                   if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3907         $              dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3908                  
3909                   multmaxy(ip,ntr) = maxs(cltry(ip,ntr))
3910         $              +10000*mult(cltry(ip,ntr))
3911                   seedy(ip,ntr)    = clsignal(indmax(cltry(ip,ntr)))
3912         $              /clsigma(indmax(cltry(ip,ntr)))
3913                   call applypfa(PFA,cltry(ip,ntr),angy,corr,res)
3914                   ypu(ip,ntr)      = corr
3915                endif
3916    
3917             elseif(icl.ne.0)then
3918    
3919                cl_used(icl) = 1    !tag used clusters          
3920    
3921                if(mod(VIEW(icl),2).eq.0)then
3922                   cltrx(ip,ntr)=icl
3923                   xbad(ip,ntr) = nbadstrips(4,icl)
3924    
3925                   if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3926    
3927                   multmaxx(ip,ntr) = maxs(cltrx(ip,ntr))
3928         $                         +10000*mult(cltrx(ip,ntr))
3929                   seedx(ip,ntr)    = clsignal(indmax(cltrx(ip,ntr)))
3930         $           /clsigma(indmax(cltrx(ip,ntr)))
3931                   call applypfa(PFA,cltrx(ip,ntr),angx,corr,res)
3932                   xpu(ip,ntr)      = corr
3933    
3934                elseif(mod(VIEW(icl),2).eq.1)then
3935                   cltry(ip,ntr)=icl
3936                   ybad(ip,ntr) = nbadstrips(4,icl)
3937    
3938                   if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3939    
3940                   multmaxy(ip,ntr) = maxs(cltry(ip,ntr))
3941         $                         +10000*mult(cltry(ip,ntr))
3942                   seedy(ip,ntr)    = clsignal(indmax(cltry(ip,ntr)))
3943         $           /clsigma(indmax(cltry(ip,ntr)))
3944                   call applypfa(PFA,cltry(ip,ntr),angy,corr,res)
3945                   ypu(ip,ntr)      = corr
3946                  
3947                endif
3948    
3949             endif          
3950    
3951          enddo
3952    
3953          if(DEBUG.eq.1)then
3954             print*,'> STORING TRACK ',ntr
3955             print*,'clusters: '
3956             do ip=1,6
3957                print*,'> ',ip,' -- ',cltrx(ip,ntr),cltry(ip,ntr)
3958             enddo
3959             print*,'dedx: '
3960             do ip=1,6
3961                print*,'> ',ip,' -- ',dedx_x(ip,ntr),dedx_y(ip,ntr)
3962             enddo
3963          endif
3964    
3965        end        end
3966    
3967        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*****************************************************  
3968    
3969  *     -------------------------------------------------------  *     -------------------------------------------------------
3970  *     This routine fills the  elements of the variables  *     This routine fills the  elements of the variables
# Line 3952  c*************************************** Line 3973  c***************************************
3973  *     -------------------------------------------------------  *     -------------------------------------------------------
3974    
3975        include 'commontracker.f'        include 'commontracker.f'
       include 'level1.f'  
       include 'level2.f'  
3976        include 'calib.f'        include 'calib.f'
3977          include 'level1.f'
3978        include 'common_momanhough.f'        include 'common_momanhough.f'
3979          include 'level2.f'
3980        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3981    
3982  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
       good2=1!.true.  
3983        nclsx = 0        nclsx = 0
3984        nclsy = 0        nclsy = 0
3985    
3986          do iv = 1,nviews
3987    c         if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
3988             good2(iv) = good2(iv) + mask_view(iv)*2**8
3989          enddo
3990    
3991          if(DEBUG.eq.1)then
3992             print*,'> STORING SINGLETS '
3993          endif
3994    
3995        do icl=1,nclstr1        do icl=1,nclstr1
3996    
3997             ip=nplanes-npl(VIEW(icl))+1            
3998            
3999           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
4000              ip=nplanes-npl(VIEW(icl))+1              
4001              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
4002    
4003                 nclsx = nclsx + 1                 nclsx = nclsx + 1
4004                 planex(nclsx) = ip                 planex(nclsx) = ip
4005                 sgnlxs(nclsx) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
4006                   if(nsatstrips(icl).gt.0)sgnlxs(nclsx)=-sgnlxs(nclsx)
4007                   clsx(nclsx)   = icl
4008                   sxbad(nclsx)  = nbadstrips(1,icl)
4009                   multmaxsx(nclsx) = maxs(icl)+10000*mult(icl)
4010                  
4011    
4012                 do is=1,2                 do is=1,2
4013  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
4014                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
4015                      call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
4016                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2
4017                 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)  
4018              else                          !=== Y views              else                          !=== Y views
4019                 nclsy = nclsy + 1                 nclsy = nclsy + 1
4020                 planey(nclsy) = ip                 planey(nclsy) = ip
4021                 sgnlys(nclsy) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
4022                   if(nsatstrips(icl).gt.0)sgnlys(nclsy)=-sgnlys(nclsy)
4023                   clsy(nclsy)   = icl
4024                   sybad(nclsy)  = nbadstrips(1,icl)
4025                   multmaxsy(nclsy) = maxs(icl)+10000*mult(icl)
4026    
4027    
4028                 do is=1,2                 do is=1,2
4029  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
4030                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
4031                      call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
4032                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2
4033                 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)  
4034              endif              endif
4035           endif           endif
4036  c      print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)  
4037    ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
4038             whichtrack(icl) = cl_used(icl)
4039    *     --------------------------------------------------
4040    *     per non perdere la testa...
4041    *     whichtrack(icl) e` una variabile del common level1
4042    *     che serve solo per sapere quali cluster sono stati
4043    *     associati ad una traccia, e permettere di salvare
4044    *     solo questi nell'albero di uscita
4045    *     --------------------------------------------------
4046                    
4047        enddo        enddo
4048        end        end
4049    
4050    ***************************************************
4051    *                                                 *
4052    *                                                 *
4053    *                                                 *
4054    *                                                 *
4055    *                                                 *
4056    *                                                 *
4057    **************************************************
4058    
4059          subroutine fill_hough
4060    
4061    *     -------------------------------------------------------
4062    *     This routine fills the  variables related to the hough
4063    *     transform, for the debig n-tuple
4064    *     -------------------------------------------------------
4065    
4066          include 'commontracker.f'
4067          include 'level1.f'
4068          include 'common_momanhough.f'
4069          include 'common_hough.f'
4070          include 'level2.f'
4071    
4072          if(.false.
4073         $     .or.ntrpt.gt.ntrpt_max_nt
4074         $     .or.ndblt.gt.ndblt_max_nt
4075         $     .or.NCLOUDS_XZ.gt.ncloxz_max
4076         $     .or.NCLOUDS_yZ.gt.ncloyz_max
4077         $     )then
4078             ntrpt_nt=0
4079             ndblt_nt=0
4080             NCLOUDS_XZ_nt=0
4081             NCLOUDS_YZ_nt=0
4082          else
4083             ndblt_nt=ndblt
4084             ntrpt_nt=ntrpt
4085             if(ndblt.ne.0)then
4086                do id=1,ndblt
4087                   alfayz1_nt(id)=alfayz1(id) !Y0
4088                   alfayz2_nt(id)=alfayz2(id) !tg theta-yz
4089                enddo
4090             endif
4091             if(ndblt.ne.0)then
4092                do it=1,ntrpt
4093                   alfaxz1_nt(it)=alfaxz1(it) !X0
4094                   alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
4095                   alfaxz3_nt(it)=alfaxz3(it) !1/r
4096                enddo
4097             endif
4098             nclouds_yz_nt=nclouds_yz
4099             nclouds_xz_nt=nclouds_xz
4100             if(nclouds_yz.ne.0)then
4101                nnn=0
4102                do iyz=1,nclouds_yz
4103                   ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
4104                   alfayz1_av_nt(iyz)=alfayz1_av(iyz)
4105                   alfayz2_av_nt(iyz)=alfayz2_av(iyz)
4106                   nnn=nnn+ptcloud_yz(iyz)
4107                enddo
4108                do ipt=1,nnn
4109                   db_cloud_nt(ipt)=db_cloud(ipt)
4110                 enddo
4111             endif
4112             if(nclouds_xz.ne.0)then
4113                nnn=0
4114                do ixz=1,nclouds_xz
4115                   ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
4116                   alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
4117                   alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
4118                   alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
4119                   nnn=nnn+ptcloud_xz(ixz)              
4120                enddo
4121                do ipt=1,nnn
4122                  tr_cloud_nt(ipt)=tr_cloud(ipt)
4123                 enddo
4124             endif
4125          endif
4126          end
4127          

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

  ViewVC Help
Powered by ViewVC 1.1.23