/[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.4 by pam-fi, Thu Sep 28 14:04:40 2006 UTC revision 1.29 by pam-fi, Tue Aug 21 15:21:52 2007 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    
       include 'momanhough_init.f'  
         
 c      logical DEBUG  
 c      common/dbg/DEBUG  
23    
24    
25    c      print*,'======================================================'
26    c$$$      do ic=1,NCLSTR1
27    c$$$         if(.false.
28    c$$$     $        .or.nsatstrips(ic).gt.0
29    c$$$c     $        .or.nbadstrips(0,ic).gt.0
30    c$$$c     $        .or.nbadstrips(4,ic).gt.0
31    c$$$c     $        .or.nbadstrips(3,ic).gt.0
32    c$$$     $        .or..false.)then
33    c$$$            print*,'--- cl-',ic,' ------------------------'
34    c$$$            istart = INDSTART(IC)
35    c$$$            istop  = TOTCLLENGTH
36    c$$$            if(ic.lt.NCLSTR1)istop=INDSTART(IC+1)-1
37    c$$$            print*,'ADC   ',(CLADC(i),i=istart,istop)
38    c$$$            print*,'s/n   ',(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
39    c$$$            print*,'sgnl  ',(CLSIGNAL(i),i=istart,istop)
40    c$$$            print*,'strip ',(i-INDMAX(ic),i=istart,istop)
41    c$$$            print*,'view ',VIEW(ic)
42    c$$$            print*,'maxs ',MAXS(ic)
43    c$$$            print*,'COG4 ',cog(4,ic)
44    c$$$            ff = fbad_cog(4,ic)
45    c$$$            print*,'fbad ',ff
46    c$$$            print*,(CLBAD(i),i=istart,istop)
47    c$$$            bb=nbadstrips(0,ic)
48    c$$$            print*,'#BAD (tot)',bb
49    c$$$            bb=nbadstrips(4,ic)
50    c$$$            print*,'#BAD (4)',bb
51    c$$$            bb=nbadstrips(3,ic)
52    c$$$            print*,'#BAD (3)',bb
53    c$$$            ss=nsatstrips(ic)
54    c$$$            print*,'#saturated ',ss
55    c$$$         endif
56    c$$$      enddo
57          
58  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
59  *     STEP 1  *     STEP 1
60  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
# Line 44  c      common/dbg/DEBUG Line 74  c      common/dbg/DEBUG
74  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
75  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
76    
77  c      iflag=0  
78        call cl_to_couples(iflag)        call cl_to_couples(iflag)
79        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
80           goto 880               !fill ntp and go to next event                       goto 880               !go to next event
81        endif        endif
82                
 *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  
 *     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  
           
   
   
83  *-----------------------------------------------------  *-----------------------------------------------------
84  *-----------------------------------------------------  *-----------------------------------------------------
85  *     HOUGH TRASFORM  *     HOUGH TRASFORM
# Line 91  c$$$         endif Line 108  c$$$         endif
108  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
109  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
110    
111  c      iflag=0  
112        call cp_to_doubtrip(iflag)        call cp_to_doubtrip(iflag)
113        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
114           goto 880               !fill ntp and go to next event                       goto 880               !go to next event            
115        endif        endif
116                
117                
# Line 123  c      iflag=0 Line 140  c      iflag=0
140  *     $     ,ptcloud_xz,tr_cloud,cpcloud_xz            *     $     ,ptcloud_xz,tr_cloud,cpcloud_xz          
141  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
142  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
143    *     count number of hit planes
144          planehit=0                
145          do np=1,nplanes          
146            if(ncp_plane(np).ne.0)then  
147              planehit=planehit+1  
148            endif                  
149          enddo                    
150          if(planehit.lt.3) goto 880 ! exit              
151          
152          nptxz_min=x_min_start              
153          nplxz_min=x_min_start              
154                
155          nptyz_min=y_min_start              
156          nplyz_min=y_min_start              
157    
158  c      iflag=0        cutdistyz=cutystart      
159          cutdistxz=cutxstart      
160    
161     878  continue
162        call doub_to_YZcloud(iflag)        call doub_to_YZcloud(iflag)
163        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
164           goto 880               !fill ntp and go to next event                       goto 880               !fill ntp and go to next event            
165        endif        endif
166  c      iflag=0        if(nclouds_yz.eq.0.and.cutdistyz.lt.maxcuty)then
167            if(cutdistyz.lt.maxcuty/2)then
168              cutdistyz=cutdistyz+cutystep
169            else
170              cutdistyz=cutdistyz+(3*cutystep)
171            endif
172            goto 878                
173          endif                    
174    
175          if(planehit.eq.3) goto 881          
176          
177     879  continue  
178        call trip_to_XZcloud(iflag)        call trip_to_XZcloud(iflag)
179        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
180           goto 880               !fill ntp and go to next event                       goto 880               !fill ntp and go to next event            
181        endif        endif
182                                    
183          if(nclouds_xz.eq.0.and.cutdistxz.lt.maxcutx)then
184            cutdistxz=cutdistxz+cutxstep
185            goto 879                
186          endif                    
187    
188        
189     881  continue  
190    *     if there is at least three planes on the Y view decreases cuts on X view
191          if(nclouds_xz.eq.0.and.nclouds_yz.gt.0.and.
192         $     nplxz_min.ne.y_min_start)then
193            nptxz_min=x_min_step    
194            nplxz_min=x_min_start-x_min_step              
195            goto 879                
196          endif                    
197            
198   880  return   880  return
199        end        end
200    
# Line 144  c      iflag=0 Line 204  c      iflag=0
204        subroutine track_fitting(iflag)        subroutine track_fitting(iflag)
205    
206        include 'commontracker.f'        include 'commontracker.f'
207          include 'level1.f'
208        include 'common_momanhough.f'        include 'common_momanhough.f'
209        include 'common_mech.f'        include 'common_mech.f'
210        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
211        include 'common_mini_2.f'        include 'common_mini_2.f'
212        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
213        include 'level2.f'        include 'level2.f'
214    
215        include 'momanhough_init.f'  c      include 'momanhough_init.f'
216                
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
217        logical FIMAGE            !        logical FIMAGE            !
218          real trackimage(NTRACKSMAX)
219          real*8 AL_GUESS(5)
220    
221  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
222  *     STEP 4   (ITERATED until any other physical track isn't found)  *     STEP 4   (ITERATED until any other physical track isn't found)
# Line 198  c         iflag=0 Line 257  c         iflag=0
257           ibest=0                !best track among candidates           ibest=0                !best track among candidates
258           iimage=0               !track image           iimage=0               !track image
259  *     ------------- select the best track -------------  *     ------------- select the best track -------------
260           rchi2best=1000000000.  c$$$         rchi2best=1000000000.
261    c$$$         do i=1,ntracks
262    c$$$            if(RCHI2_STORE(i).lt.rchi2best.and.
263    c$$$     $         RCHI2_STORE(i).gt.0)then
264    c$$$               ibest=i
265    c$$$               rchi2best=RCHI2_STORE(i)
266    c$$$            endif
267    c$$$         enddo
268    c$$$         if(ibest.eq.0)goto 880 !>> no good candidates
269    
270    *     -------------------------------------------------------
271    *     order track-candidates according to:
272    *     1st) decreasing n.points
273    *     2nd) increasing chi**2
274    *     -------------------------------------------------------
275             rchi2best=1000000000.
276             ndofbest=0            
277           do i=1,ntracks           do i=1,ntracks
278              if(RCHI2_STORE(i).lt.rchi2best.and.             ndof=0              
279       $         RCHI2_STORE(i).gt.0)then             do ii=1,nplanes    
280                 ndof=ndof        
281         $            +int(xgood_store(ii,i))
282         $            +int(ygood_store(ii,i))
283               enddo              
284               if(ndof.gt.ndofbest)then
285                 ibest=i
286                 rchi2best=RCHI2_STORE(i)
287                 ndofbest=ndof    
288               elseif(ndof.eq.ndofbest)then
289                 if(RCHI2_STORE(i).lt.rchi2best.and.
290         $            RCHI2_STORE(i).gt.0)then
291                 ibest=i                 ibest=i
292                 rchi2best=RCHI2_STORE(i)                 rchi2best=RCHI2_STORE(i)
293              endif                 ndofbest=ndof  
294                 endif            
295               endif
296           enddo           enddo
297    
298    c$$$         rchi2best=1000000000.
299    c$$$         ndofbest=0             !(1)
300    c$$$         do i=1,ntracks
301    c$$$           if(RCHI2_STORE(i).lt.rchi2best.and.
302    c$$$     $          RCHI2_STORE(i).gt.0)then
303    c$$$             ndof=0             !(1)
304    c$$$             do ii=1,nplanes    !(1)
305    c$$$               ndof=ndof        !(1)
306    c$$$     $              +int(xgood_store(ii,i)) !(1)
307    c$$$     $              +int(ygood_store(ii,i)) !(1)
308    c$$$             enddo              !(1)
309    c$$$             if(ndof.ge.ndofbest)then !(1)
310    c$$$               ibest=i
311    c$$$               rchi2best=RCHI2_STORE(i)
312    c$$$               ndofbest=ndof    !(1)
313    c$$$             endif              !(1)
314    c$$$           endif
315    c$$$         enddo
316    
317           if(ibest.eq.0)goto 880 !>> no good candidates           if(ibest.eq.0)goto 880 !>> no good candidates
318  *-------------------------------------------------------------------------------      *-------------------------------------------------------------------------------    
319  *     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 332  c         iflag=0
332              iimage=0              iimage=0
333           endif           endif
334           if(icand.eq.0)then           if(icand.eq.0)then
335              print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand              if(VERBOSE.EQ.1)then
336       $           ,ibest,iimage                 print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand
337         $              ,ibest,iimage
338                endif
339              return              return
340           endif           endif
341    
# Line 236  c         iflag=0 Line 346  c         iflag=0
346  *     **********************************************************  *     **********************************************************
347  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
348  *     **********************************************************  *     **********************************************************
349             call guess()
350             do i=1,5
351                AL_GUESS(i)=AL(i)
352             enddo
353    c         print*,'## guess: ',al
354    
355           do i=1,5           do i=1,5
356              AL(i)=dble(AL_STORE(i,icand))                          AL(i)=dble(AL_STORE(i,icand))            
357           enddo           enddo
358            
359           IDCAND = icand         !fitted track-candidate           IDCAND = icand         !fitted track-candidate
360           ifail=0                !error flag in chi2 computation           ifail=0                !error flag in chi2 computation
361           jstep=0                !# minimization steps           jstep=0                !# minimization steps
362    
363           call mini_2(jstep,ifail)           iprint=0
364    c         if(DEBUG.EQ.1)iprint=1
365             if(VERBOSE.EQ.1)iprint=1
366             if(DEBUG.EQ.1)iprint=2
367             call mini2(jstep,ifail,iprint)
368           if(ifail.ne.0) then           if(ifail.ne.0) then
369              if(DEBUG)then              if(VERBOSE.EQ.1)then
370                 print *,                 print *,
371       $              '*** MINIMIZATION FAILURE *** (mini_2) '       $              '*** MINIMIZATION FAILURE *** (after refinement) '
372       $              ,iev       $              ,iev
373    
374    c$$$               print*,'guess:   ',(al_guess(i),i=1,5)
375    c$$$               print*,'previous: ',(al_store(i,icand),i=1,5)
376    c$$$               print*,'result:   ',(al(i),i=1,5)
377    c$$$               print*,'xgood ',xgood
378    c$$$               print*,'ygood ',ygood
379    c$$$               print*,'----------------------------------------------'
380              endif              endif
381              chi2=-chi2  c            chi2=-chi2
382           endif           endif
383                    
384           if(DEBUG)then           if(DEBUG.EQ.1)then
385              print*,'----------------------------- improved track coord'              print*,'----------------------------- improved track coord'
386  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
387              do ip=1,6              do ip=1,6
# Line 264  c         iflag=0 Line 392  c         iflag=0
392           endif           endif
393    
394  c         rchi2=chi2/dble(ndof)  c         rchi2=chi2/dble(ndof)
395           if(DEBUG)then           if(DEBUG.EQ.1)then
396              print*,' '              print*,' '
397              print*,'****** SELECTED TRACK *************'              print*,'****** SELECTED TRACK *************'
398              print*,'#         R. chi2        RIG'              print*,'#         R. chi2        RIG'
# Line 280  c         rchi2=chi2/dble(ndof) Line 408  c         rchi2=chi2/dble(ndof)
408  *     ------------- search if the track has an IMAGE -------------  *     ------------- search if the track has an IMAGE -------------
409  *     ------------- (also this is stored )           -------------  *     ------------- (also this is stored )           -------------
410           if(FIMAGE)goto 122     !>>> jump! (this is already an image)           if(FIMAGE)goto 122     !>>> jump! (this is already an image)
411  *     now search for track-image, by comparing couples IDs  
412    *     -----------------------------------------------------
413    *     first check if the track is ambiguous
414    *     -----------------------------------------------------
415    *     (modified on august 2007 by ElenaV)
416             is1=0
417             do ip=1,NPLANES
418                if(SENSOR_STORE(ip,icand).ne.0)then
419                   is1=SENSOR_STORE(ip,icand)
420                   if(ip.eq.6)is1=3-is1 !last plane inverted
421                endif
422             enddo
423             if(is1.eq.0)then
424                if(WARNING.EQ.1)print*,'** WARNING ** sensor=0'
425                goto 122            !jump
426             endif
427    c         print*,'is1 ',is1
428             do ip=1,NPLANES
429                is2 = SENSOR_STORE(ip,icand) !sensor
430    c            print*,'is2 ',is2,' ip ',ip
431                if(ip.eq.6.and.is2.ne.0)is2=3-is2 !last plane inverted
432                if(
433         $           (is1.ne.is2.and.is2.ne.0)
434         $           )goto 122      !jump (this track cannot have an image)
435             enddo
436             if(DEBUG.eq.1)print*,' >>> ambiguous track! '
437    *     now search for track-image among track candidates
438    c$$$         do i=1,ntracks
439    c$$$            iimage=i
440    c$$$            do ip=1,nplanes
441    c$$$               if(     CP_STORE(nplanes-ip+1,icand).ne.
442    c$$$     $              -1*CP_STORE(nplanes-ip+1,i).and.
443    c$$$     $              CP_STORE(nplanes-ip+1,i).ne.0.and.
444    c$$$     $              CP_STORE(nplanes-ip+1,icand).ne.0 )iimage=0
445    c$$$               print*,' track ',i,' CP ',CP_STORE(nplanes-ip+1,i)
446    c$$$     $              ,CP_STORE(nplanes-ip+1,icand),iimage
447    c$$$            enddo
448    c$$$            if(  iimage.ne.0.and.
449    c$$$c     $           RCHI2_STORE(i).le.CHI2MAX.and.
450    c$$$c     $           RCHI2_STORE(i).gt.0.and.
451    c$$$     $           .true.)then
452    c$$$               if(DEBUG.EQ.1)print*,'Track candidate ',iimage
453    c$$$     $              ,' >>> TRACK IMAGE >>> of'
454    c$$$     $              ,ibest
455    c$$$               goto 122         !image track found
456    c$$$            endif
457    c$$$         enddo
458    *     ---------------------------------------------------------------
459    *     take the candidate with the greatest number of matching couples
460    *     if more than one satisfies the requirement,
461    *     choose the one with more points and lower chi2
462    *     ---------------------------------------------------------------
463    *     count the number of matching couples
464             ncpmax = 0
465             iimage   = 0           !id of candidate with better matching
466           do i=1,ntracks           do i=1,ntracks
467              iimage=i              ncp=0
468              do ip=1,nplanes              do ip=1,nplanes
469                 if(     CP_STORE(nplanes-ip+1,icand).ne.                 if(CP_STORE(nplanes-ip+1,icand).ne.0)then
470       $              -1*CP_STORE(nplanes-ip+1,i) )iimage=0                    if(
471         $                 CP_STORE(nplanes-ip+1,i).ne.0
472         $                 .and.
473         $                 CP_STORE(nplanes-ip+1,icand).eq.
474         $                 -1*CP_STORE(nplanes-ip+1,i)
475         $                 )then
476                         ncp=ncp+1  !ok
477                      elseif(
478         $                    CP_STORE(nplanes-ip+1,i).ne.0
479         $                    .and.
480         $                    CP_STORE(nplanes-ip+1,icand).ne.
481         $                    -1*CP_STORE(nplanes-ip+1,i)
482         $                    )then
483                         ncp = 0
484                         goto 117   !it is not an image candidate
485                      else
486                        
487                      endif
488                   endif
489    c$$$               print*,' track ',i,' CP ',CP_STORE(nplanes-ip+1,i)
490    c$$$     $              ,CP_STORE(nplanes-ip+1,icand),ncp
491              enddo              enddo
492              if(  iimage.ne.0.and.   117        continue
493  c     $           RCHI2_STORE(i).le.CHI2MAX.and.              trackimage(i)=ncp   !number of matching couples
494  c     $           RCHI2_STORE(i).gt.0.and.              if(ncp>ncpmax)then
495       $           .true.)then                 ncpmax=ncp
496                 if(DEBUG)print*,'Track candidate ',iimage                 iimage=i
      $              ,' >>> TRACK IMAGE >>> of'  
      $              ,ibest  
                goto 122         !image track found  
497              endif              endif
498           enddo           enddo
499    *     check if there are more than one image candidates
500             ngood=0
501             do i=1,ntracks
502                if( ncpmax.ne.0.and.trackimage(i).eq.ncpmax )ngood=ngood+1
503             enddo
504    *     if there are, choose the best one
505             if(ngood.gt.1)then
506    *     -------------------------------------------------------
507    *     order track-candidates according to:
508    *     1st) decreasing n.points
509    *     2nd) increasing chi**2
510    *     -------------------------------------------------------
511                rchi2best=1000000000.
512                ndofbest=0            
513                do i=1,ntracks
514                   if( trackimage(i).eq.ncpmax )then
515                      ndof=0              
516                      do ii=1,nplanes    
517                         ndof=ndof        
518         $                    +int(xgood_store(ii,i))
519         $                    +int(ygood_store(ii,i))
520                      enddo              
521                      if(ndof.gt.ndofbest)then
522                         iimage=i
523                         rchi2best=RCHI2_STORE(i)
524                         ndofbest=ndof    
525                      elseif(ndof.eq.ndofbest)then
526                         if(RCHI2_STORE(i).lt.rchi2best.and.
527         $                    RCHI2_STORE(i).gt.0)then
528                            iimage=i
529                            rchi2best=RCHI2_STORE(i)
530                            ndofbest=ndof  
531                         endif            
532                      endif
533                   endif
534                enddo
535                
536             endif
537    
538             if(DEBUG.EQ.1)print*,'Track candidate ',iimage
539         $        ,' >>> TRACK IMAGE >>> of'
540         $        ,ibest
541    
542   122     continue   122     continue
543    
544    
545  *     --- and store the results --------------------------------  *     --- and store the results --------------------------------
546           ntrk = ntrk + 1                   !counter of found tracks           ntrk = ntrk + 1                   !counter of found tracks
547           if(.not.FIMAGE           if(.not.FIMAGE
# Line 311  c         print*,'++++++++++ iimage,fima Line 554  c         print*,'++++++++++ iimage,fima
554  c     $        ,iimage,fimage,ntrk,image(ntrk)  c     $        ,iimage,fimage,ntrk,image(ntrk)
555    
556           if(ntrk.eq.NTRKMAX)then           if(ntrk.eq.NTRKMAX)then
557              if(DEBUG)              if(verbose.eq.1)
558       $           print*,       $           print*,
559       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
560       $           'tracks exceeds vector dimension '       $           'tracks exceeds vector dimension '
# Line 347  cc            good2=.false. Line 590  cc            good2=.false.
590       $        rchi2best.le.CHI2MAX.and.       $        rchi2best.le.CHI2MAX.and.
591  c     $        rchi2best.lt.15..and.  c     $        rchi2best.lt.15..and.
592       $        .true.)then       $        .true.)then
593              if(DEBUG)then              if(DEBUG.EQ.1)then
594                 print*,'***** NEW SEARCH ****'                 print*,'***** NEW SEARCH ****'
595              endif              endif
596              goto 11111          !try new search              goto 11111          !try new search
# Line 361  c     $        rchi2best.lt.15..and. Line 604  c     $        rchi2best.lt.15..and.
604        end        end
605    
606    
   
   
 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$$$  
   
607                
608  ************************************************************  ************************************************************
609  ************************************************************  ************************************************************
# Line 557  c$$$ Line 628  c$$$
628  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)
629  *     angx   - Projected angle in x  *     angx   - Projected angle in x
630  *     angy   - Projected angle in y  *     angy   - Projected angle in y
631    *     bfx    - x-component of magnetci field
632    *     bfy    - y-component of magnetic field
633  *  *
634  *     --------- COUPLES -------------------------------------------------------  *     --------- COUPLES -------------------------------------------------------
635  *     The couple defines a point in the space.  *     The couple defines a point in the space.
# Line 595  c$$$ Line 668  c$$$
668  *  *
669  *  *
670    
671        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,angx,angy)        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
672    
 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*****************************************************  
673                
674        include 'commontracker.f'        include 'commontracker.f'
       include 'calib.f'  
675        include 'level1.f'        include 'level1.f'
676          include 'calib.f'
677        include 'common_align.f'        include 'common_align.f'
678        include 'common_mech.f'        include 'common_mech.f'
679        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
       include 'common_resxy.f'  
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
680    
681        integer icx,icy           !X-Y cluster ID        integer icx,icy           !X-Y cluster ID
682        integer sensor        integer sensor
683        integer viewx,viewy        integer viewx,viewy
684        character*4 PFAx,PFAy     !PFA to be used        character*4 PFAx,PFAy     !PFA to be used
685        real angx,angy            !X-Y angle        real ax,ay                !X-Y geometric angle
686          real angx,angy            !X-Y effective angle
687          real bfx,bfy              !X-Y b-field components
688    
689        real stripx,stripy        real stripx,stripy
690    
691        double precision xrt,yrt,zrt        double precision xrt,yrt,zrt
692        double precision xrt_A,yrt_A,zrt_A        double precision xrt_A,yrt_A,zrt_A
693        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  
694                
695    
696        parameter (ndivx=30)        parameter (ndivx=30)
697    
698    
699    c$$$      print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy
700                
701        resxPAM = 0        resxPAM = 0
702        resyPAM = 0        resyPAM = 0
# Line 647  c      double precision xi_B,yi_B,zi_B Line 710  c      double precision xi_B,yi_B,zi_B
710        xPAM_B = 0.        xPAM_B = 0.
711        yPAM_B = 0.        yPAM_B = 0.
712        zPAM_B = 0.        zPAM_B = 0.
713    c      print*,'## xyz_PAM: ',icx,icy,sensor,PFAx,PFAy,angx,angy
714    
715          if(sensor.lt.1.or.sensor.gt.2)then
716             print*,'xyz_PAM   ***ERROR*** wrong input '
717             print*,'sensor ',sensor
718             icx=0
719             icy=0
720          endif
721    
722  *     -----------------  *     -----------------
723  *     CLUSTER X  *     CLUSTER X
724  *     -----------------  *     -----------------      
   
725        if(icx.ne.0)then        if(icx.ne.0)then
726           viewx = VIEW(icx)  
727           nldx = nld(MAXS(icx),VIEW(icx))           viewx   = VIEW(icx)
728           nplx = npl(VIEW(icx))           nldx    = nld(MAXS(icx),VIEW(icx))
729           resxPAM = RESXAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           nplx    = npl(VIEW(icx))
730                     resxPAM = RESXAV
731           stripx = float(MAXS(icx))           stripx  = float(MAXS(icx))
732           if(PFAx.eq.'COG1')then  !(1)  
733              stripx = stripx      !(1)           if(
734              resxPAM = resxPAM    !(1)       $        viewx.lt.1.or.        
735         $        viewx.gt.12.or.
736         $        nldx.lt.1.or.
737         $        nldx.gt.3.or.
738         $        stripx.lt.1.or.
739         $        stripx.gt.3072.or.
740         $        .false.)then
741                print*,'xyz_PAM   ***ERROR*** wrong input '
742                print*,'icx ',icx,'view ',viewx,'nld ',nldx,'strip ',stripx
743                icx = 0
744                goto 10
745             endif
746    
747    *        --------------------------
748    *        magnetic-field corrections
749    *        --------------------------
750             angtemp  = ax
751             bfytemp  = bfy
752    *        /////////////////////////////////
753    *        AAAAHHHHHHHH!!!!!!!!!!!!!!!!!!!!!
754    *        *grvzkkjsdgjhhhgngbn###>:(
755    *        /////////////////////////////////
756    c         if(nplx.eq.6) angtemp = -1. * ax
757    c         if(nplx.eq.6) bfytemp = -1. * bfy
758             if(viewx.eq.12) angtemp = -1. * ax
759             if(viewx.eq.12) bfytemp = -1. * bfy
760             tgtemp   = tan(angtemp*acos(-1.)/180.) + pmuH_h*bfytemp*0.00001
761             angx     = 180.*atan(tgtemp)/acos(-1.)
762             stripx   = stripx - 0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
763    c$$$         print*,nplx,ax,bfy/10.
764    c$$$         print*,angx,0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
765    c$$$         print*,'========================'
766    c$$$         if(bfy.ne.0.)print*,viewx,'-x- '
767    c$$$     $        ,bfy,-1*0.5*pmuH_h*bfytemp*0.00001*SiDimZ
768    *        --------------------------
769    
770    c$$$         print*,'--- x-cl ---'
771    c$$$         istart = INDSTART(ICX)
772    c$$$         istop  = TOTCLLENGTH
773    c$$$         if(icx.lt.NCLSTR1)istop=INDSTART(ICX+1)-1
774    c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
775    c$$$         print*,(CLSIGNAL(i),i=istart,istop)
776    c$$$         print*,INDMAX(icx)
777    c$$$         print*,cog(4,icx)
778    c$$$         print*,fbad_cog(4,icx)
779            
780    
781             if(PFAx.eq.'COG1')then
782    
783                stripx  = stripx
784                resxPAM = 1e-4*pitchX/sqrt(12.)!!resxPAM
785    
786           elseif(PFAx.eq.'COG2')then           elseif(PFAx.eq.'COG2')then
787              stripx = stripx + cog(2,icx)              
788                stripx  = stripx + cog(2,icx)            
789                resxPAM = risx_cog(abs(angx))!TEMPORANEO              
790              resxPAM = resxPAM*fbad_cog(2,icx)              resxPAM = resxPAM*fbad_cog(2,icx)
791    
792             elseif(PFAx.eq.'COG3')then
793    
794                stripx  = stripx + cog(3,icx)            
795                resxPAM = risx_cog(abs(angx))!TEMPORANEO                      
796                resxPAM = resxPAM*fbad_cog(3,icx)
797    
798             elseif(PFAx.eq.'COG4')then
799    
800                stripx  = stripx + cog(4,icx)            
801                resxPAM = risx_cog(abs(angx))!TEMPORANEO                      
802                resxPAM = resxPAM*fbad_cog(4,icx)
803    
804           elseif(PFAx.eq.'ETA2')then           elseif(PFAx.eq.'ETA2')then
805  c            cog2 = cog(2,icx)  
806  c            etacorr = pfa_eta2(cog2,viewx,nldx,angx)                          stripx  = stripx + pfaeta2(icx,angx)          
807  c            stripx = stripx + etacorr              resxPAM = risxeta2(abs(angx))
             stripx = stripx + pfa_eta2(icx,angx)            !(3)  
             resxPAM = risx_eta2(angx)                       !   (4)  
             if(DEBUG.and.fbad_cog(2,icx).ne.1)  
      $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)  
808              resxPAM = resxPAM*fbad_cog(2,icx)              resxPAM = resxPAM*fbad_cog(2,icx)
809           elseif(PFAx.eq.'ETA3')then                         !(3)  c$$$            if(DEBUG.EQ.1.and.fbad_cog(2,icx).ne.1)
810              stripx = stripx + pfa_eta3(icx,angx)            !(3)  c$$$     $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
811              resxPAM = risx_eta3(angx)                       !   (4)  
812              if(DEBUG.and.fbad_cog(3,icx).ne.1)              !(3)           elseif(PFAx.eq.'ETA3')then                        
813       $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)!(3)  
814              resxPAM = resxPAM*fbad_cog(3,icx)               !(3)              stripx  = stripx + pfaeta3(icx,angx)          
815           elseif(PFAx.eq.'ETA4')then                         !(3)              resxPAM = risxeta3(abs(angx))                      
816              stripx = stripx + pfa_eta4(icx,angx)            !(3)              resxPAM = resxPAM*fbad_cog(3,icx)              
817              resxPAM = risx_eta4(angx)                       !   (4)  c            if(DEBUG.and.fbad_cog(3,icx).ne.1)            
818              if(DEBUG.and.fbad_cog(4,icx).ne.1)              !(3)  c     $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)
819       $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)!(3)  
820              resxPAM = resxPAM*fbad_cog(4,icx)               !(3)           elseif(PFAx.eq.'ETA4')then                        
821           elseif(PFAx.eq.'ETA')then                          !(3)  
822              stripx = stripx + pfa_eta(icx,angx)             !(3)              stripx  = stripx + pfaeta4(icx,angx)            
823              resxPAM = ris_eta(icx,angx)                     !   (4)              resxPAM = risxeta4(abs(angx))                      
824              if(DEBUG.and.fbad_cog(2,icx).ne.1)              !(3)              resxPAM = resxPAM*fbad_cog(4,icx)              
825       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)!(3)  c            if(DEBUG.and.fbad_cog(4,icx).ne.1)              
826  c            resxPAM = resxPAM*fbad_cog(2,icx)               !(3)TEMPORANEO  c     $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)
827              resxPAM = resxPAM*fbad_eta(icx,angx)             !(3)(4)  
828           elseif(PFAx.eq.'COG')then           !(2)           elseif(PFAx.eq.'ETA')then  
829              stripx = stripx + cog(0,icx)     !(2)          
830              resxPAM = risx_cog(angx)                        !   (4)              stripx  = stripx + pfaeta(icx,angx)            
831              resxPAM = resxPAM*fbad_cog(0,icx)!(2)  c            resxPAM = riseta(icx,angx)                    
832                resxPAM = riseta(viewx,angx)                    
833                resxPAM = resxPAM*fbad_eta(icx,angx)            
834    c            if(DEBUG.and.fbad_cog(2,icx).ne.1)              
835    c     $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
836    
837             elseif(PFAx.eq.'ETAL')then  
838    
839                stripx  = stripx + pfaetal(icx,angx)            
840                resxPAM = riseta(viewx,angx)                    
841                resxPAM = resxPAM*fbad_eta(icx,angx)            
842    c            if(DEBUG.and.fbad_cog(2,icx).ne.1)              
843    c     $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
844    
845             elseif(PFAx.eq.'COG')then          
846    
847                stripx  = stripx + cog(0,icx)            
848                resxPAM = risx_cog(abs(angx))                    
849                resxPAM = resxPAM*fbad_cog(0,icx)
850    
851           else           else
852              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG.EQ.1) print*,'*** Non valid p.f.a. (x) --> ',PFAx
853           endif           endif
854    
855        endif  
856  c      if(icy.eq.0.and.icx.ne.0)  *     ======================================
857  c     $     print*,PFAx,icx,angx,stripx,resxPAM,'***'  *     temporary patch for saturated clusters
858          *     ======================================
859             if( nsatstrips(icx).gt.0 )then
860                stripx  = stripx + cog(4,icx)            
861                resxPAM = pitchX*1e-4/sqrt(12.)
862    cc            cc=cog(4,icx)
863    c$$$            print*,icx,' *** ',cc
864    c$$$            print*,icx,' *** ',resxPAM
865             endif
866    
867     10   endif
868    
869        
870  *     -----------------  *     -----------------
871  *     CLUSTER Y  *     CLUSTER Y
872  *     -----------------  *     -----------------
873    
874        if(icy.ne.0)then        if(icy.ne.0)then
875    
876           viewy = VIEW(icy)           viewy = VIEW(icy)
877           nldy = nld(MAXS(icy),VIEW(icy))           nldy = nld(MAXS(icy),VIEW(icy))
878           nply = npl(VIEW(icy))           nply = npl(VIEW(icy))
879           resyPAM = RESYAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           resyPAM = RESYAV
880             stripy = float(MAXS(icy))
881    
882             if(
883         $        viewy.lt.1.or.        
884         $        viewy.gt.12.or.
885         $        nldy.lt.1.or.
886         $        nldy.gt.3.or.
887         $        stripy.lt.1.or.
888         $        stripy.gt.3072.or.
889         $        .false.)then
890                print*,'xyz_PAM   ***ERROR*** wrong input '
891                print*,'icy ',icy,'view ',viewy,'nld ',nldy,'strip ',stripy
892                icy = 0
893                goto 20
894             endif
895    
896           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
897              print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '              if(DEBUG.EQ.1) then
898       $           ,icx,icy                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '
899         $              ,icx,icy
900                endif
901              goto 100              goto 100
902           endif           endif
903            *        --------------------------
904           stripy = float(MAXS(icy))  *        magnetic-field corrections
905           if(PFAy.eq.'COG1')then !(1)  *        --------------------------
906              stripy = stripy     !(1)           tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
907              resyPAM = resyPAM   !(1)           angy    = 180.*atan(tgtemp)/acos(-1.)
908             stripy = stripy + 0.5*pmuH_e*bfx*0.00001*SiDimZ/pitchY
909    c$$$         if(bfx.ne.0.)print*,viewy,'-y- '
910    c$$$     $        ,bfx,0.5*pmuH_e*bfx*0.00001*SiDimZ
911    *        --------------------------
912            
913    c$$$         print*,'--- y-cl ---'
914    c$$$         istart = INDSTART(ICY)
915    c$$$         istop  = TOTCLLENGTH
916    c$$$         if(icy.lt.NCLSTR1)istop=INDSTART(ICY+1)-1
917    c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
918    c$$$         print*,(CLSIGNAL(i),i=istart,istop)
919    c$$$         print*,INDMAX(icy)
920    c$$$         print*,cog(4,icy)
921    c$$$         print*,fbad_cog(4,icy)
922    
923             if(PFAy.eq.'COG1')then
924    
925                stripy  = stripy    
926                resyPAM = 1e-4*pitchY/sqrt(12.)!resyPAM  
927    
928           elseif(PFAy.eq.'COG2')then           elseif(PFAy.eq.'COG2')then
929              stripy = stripy + cog(2,icy)  
930                stripy  = stripy + cog(2,icy)
931                resyPAM = risy_cog(abs(angy))!TEMPORANEO
932              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
933    
934             elseif(PFAy.eq.'COG3')then
935    
936                stripy  = stripy + cog(3,icy)
937                resyPAM = risy_cog(abs(angy))!TEMPORANEO
938                resyPAM = resyPAM*fbad_cog(3,icy)
939    
940             elseif(PFAy.eq.'COG4')then
941    
942                stripy  = stripy + cog(4,icy)
943                resyPAM = risy_cog(abs(angy))!TEMPORANEO
944                resyPAM = resyPAM*fbad_cog(4,icy)
945    
946           elseif(PFAy.eq.'ETA2')then           elseif(PFAy.eq.'ETA2')then
947  c            cog2 = cog(2,icy)  
948  c            etacorr = pfa_eta2(cog2,viewy,nldy,angy)              stripy  = stripy + pfaeta2(icy,angy)          
949  c            stripy = stripy + etacorr              resyPAM = risyeta2(abs(angy))              
             stripy = stripy + pfa_eta2(icy,angy)            !(3)  
             resyPAM = risy_eta2(angy)                       !   (4)  
950              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
951              if(DEBUG.and.fbad_cog(2,icy).ne.1)  c            if(DEBUG.and.fbad_cog(2,icy).ne.1)
952       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)  c     $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
953           elseif(PFAy.eq.'ETA3')then                         !(3)  
954              stripy = stripy + pfa_eta3(icy,angy)            !(3)           elseif(PFAy.eq.'ETA3')then                      
955              resyPAM = resyPAM*fbad_cog(3,icy)               !(3)  
956              if(DEBUG.and.fbad_cog(3,icy).ne.1)              !(3)              stripy  = stripy + pfaeta3(icy,angy)
957       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)!(3)              resyPAM = resyPAM*fbad_cog(3,icy)  
958           elseif(PFAy.eq.'ETA4')then                         !(3)  c            if(DEBUG.and.fbad_cog(3,icy).ne.1)
959              stripy = stripy + pfa_eta4(icy,angy)            !(3)  c     $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)
960              resyPAM = resyPAM*fbad_cog(4,icy)               !(3)  
961              if(DEBUG.and.fbad_cog(4,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA4')then  
962       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)!(3)  
963           elseif(PFAy.eq.'ETA')then                          !(3)              stripy  = stripy + pfaeta4(icy,angy)
964              stripy = stripy + pfa_eta(icy,angy)             !(3)              resyPAM = resyPAM*fbad_cog(4,icy)
965              resyPAM = ris_eta(icy,angy)                     !   (4)  c            if(DEBUG.and.fbad_cog(4,icy).ne.1)
966  c            resyPAM = resyPAM*fbad_cog(2,icy)              !(3)TEMPORANEO  c     $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)
967              resyPAM = resyPAM*fbad_eta(icy,angy)            !   (4)  
968              if(DEBUG.and.fbad_cog(2,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA')then
969       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)!(3)  
970                stripy  = stripy + pfaeta(icy,angy)
971    c            resyPAM = riseta(icy,angy)  
972                resyPAM = riseta(viewy,angy)  
973                resyPAM = resyPAM*fbad_eta(icy,angy)
974    c            if(DEBUG.and.fbad_cog(2,icy).ne.1)
975    c     $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
976    
977             elseif(PFAy.eq.'ETAL')then
978    
979                stripy  = stripy + pfaetal(icy,angy)
980                resyPAM = riseta(viewy,angy)  
981                resyPAM = resyPAM*fbad_eta(icy,angy)
982    c            if(DEBUG.and.fbad_cog(2,icy).ne.1)
983    c     $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
984    
985           elseif(PFAy.eq.'COG')then           elseif(PFAy.eq.'COG')then
986              stripy = stripy + cog(0,icy)              
987              resyPAM = risy_cog(angy)                        !   (4)              stripy  = stripy + cog(0,icy)            
988  c            resyPAM = ris_eta(icy,angy)                    !   (4)              resyPAM = risy_cog(abs(angy))
989              resyPAM = resyPAM*fbad_cog(0,icy)              resyPAM = resyPAM*fbad_cog(0,icy)
990    
991           else           else
992              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG.EQ.1) print*,'*** Non valid p.f.a. (x) --> ',PFAx
993           endif           endif
994    
       endif  
995    
996          *     ======================================
997    *     temporary patch for saturated clusters
998    *     ======================================
999             if( nsatstrips(icy).gt.0 )then
1000                stripy  = stripy + cog(4,icy)            
1001                resyPAM = pitchY*1e-4/sqrt(12.)
1002    cc            cc=cog(4,icy)
1003    c$$$            print*,icy,' *** ',cc
1004    c$$$            print*,icy,' *** ',resyPAM
1005             endif
1006    
1007    
1008     20   endif
1009    
1010    c$$$      print*,'## stripx,stripy ',stripx,stripy
1011    
1012  c===========================================================  c===========================================================
1013  C     COUPLE  C     COUPLE
1014  C===========================================================  C===========================================================
# Line 777  c     (xi,yi,zi) = mechanical coordinate Line 1019  c     (xi,yi,zi) = mechanical coordinate
1019  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1020           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1021       $        .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...       $        .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
1022              print*,'xyz_PAM (couple):',              if(DEBUG.EQ.1) then
1023       $          ' WARNING: false X strip: strip ',stripx                 print*,'xyz_PAM (couple):',
1024         $              ' WARNING: false X strip: strip ',stripx
1025                endif
1026           endif           endif
1027           xi = acoordsi(stripx,viewx)           xi = acoordsi(stripx,viewx)
1028           yi = acoordsi(stripy,viewy)           yi = acoordsi(stripy,viewy)
# Line 870  c            print*,'X-singlet ',icx,npl Line 1114  c            print*,'X-singlet ',icx,npl
1114  c            if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...  c            if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...
1115              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1116       $           .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...       $           .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
1117                 print*,'xyz_PAM (X-singlet):',                 if(DEBUG.EQ.1) then
1118       $             ' WARNING: false X strip: strip ',stripx                    print*,'xyz_PAM (X-singlet):',
1119         $                 ' WARNING: false X strip: strip ',stripx
1120                   endif
1121              endif              endif
1122              xi   = acoordsi(stripx,viewx)              xi   = acoordsi(stripx,viewx)
1123    
# Line 893  c            print*,'X-cl ',icx,stripx,' Line 1139  c            print*,'X-cl ',icx,stripx,'
1139  c            print*,yi_A,' <--> ',yi_B  c            print*,yi_A,' <--> ',yi_B
1140    
1141           else           else
1142                if(DEBUG.EQ.1) then
1143              print *,'routine xyz_PAM ---> not properly used !!!'                 print *,'routine xyz_PAM ---> not properly used !!!'
1144              print *,'icx = ',icx                 print *,'icx = ',icx
1145              print *,'icy = ',icy                 print *,'icy = ',icy
1146                endif
1147              goto 100              goto 100
1148                            
1149           endif           endif
# Line 961  c--------------------------------------- Line 1208  c---------------------------------------
1208  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'
1209    
1210        else        else
1211                       if(DEBUG.EQ.1) then
1212           print *,'routine xyz_PAM ---> not properly used !!!'              print *,'routine xyz_PAM ---> not properly used !!!'
1213           print *,'icx = ',icx              print *,'icx = ',icx
1214           print *,'icy = ',icy              print *,'icy = ',icy
1215                         endif
1216        endif        endif
1217                    
1218    
1219    c      print*,'## xPAM,yPAM,zPAM       ',xPAM,yPAM,zPAM
1220    c      print*,'## xPAM_A,yPAM_A,zPAM_A ',xPAM_A,yPAM_A,zPAM_A
1221    c      print*,'## xPAM_B,yPAM_B,zPAM_B ',xPAM_B,yPAM_B,zPAM_B
1222    
1223   100  continue   100  continue
1224        end        end
1225    
1226    ************************************************************************
1227    *     Call xyz_PAM subroutine with default PFA and fill the mini2 common.
1228    *     (done to be called from c/c++)
1229    ************************************************************************
1230    
1231          subroutine xyzpam(ip,icx,icy,lad,sensor,ax,ay,bfx,bfy)
1232    
1233          include 'commontracker.f'
1234          include 'level1.f'
1235          include 'common_mini_2.f'
1236          include 'common_xyzPAM.f'
1237          include 'common_mech.f'
1238          include 'calib.f'
1239          
1240    *     flag to chose PFA
1241    c$$$      character*10 PFA
1242    c$$$      common/FINALPFA/PFA
1243    
1244          integer icx,icy           !X-Y cluster ID
1245          integer sensor
1246          character*4 PFAx,PFAy     !PFA to be used
1247          real ax,ay                !X-Y geometric angle
1248          real bfx,bfy              !X-Y b-field components
1249    
1250          ipx=0
1251          ipy=0      
1252          
1253    c$$$      PFAx = 'COG4'!PFA
1254    c$$$      PFAy = 'COG4'!PFA
1255    
1256    
1257          if(icx.gt.nclstr1.or.icy.gt.nclstr1)then
1258                print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1259         $           ,' does not exists (nclstr1=',nclstr1,')'
1260                icx = -1*icx
1261                icy = -1*icy
1262                return
1263            
1264          endif
1265          
1266          call idtoc(pfaid,PFAx)
1267          call idtoc(pfaid,PFAy)
1268    
1269    cc      print*,PFAx,PFAy
1270    
1271    c$$$      call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1272    
1273    c$$$      print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy
1274          
1275          if(icx.ne.0.and.icy.ne.0)then
1276    
1277             ipx=npl(VIEW(icx))
1278             ipy=npl(VIEW(icy))
1279    c$$$         if( (nplanes-ipx+1).ne.ip.or.(nplanes-ipy+1).ne.ip )
1280    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1281    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1282            
1283             if( (nplanes-ipx+1).ne.ip )then
1284                print*,'xyzpam: ***WARNING*** cluster ',icx
1285         $           ,' does not belong to plane: ',ip
1286                icx = -1*icx
1287                return
1288             endif
1289             if( (nplanes-ipy+1).ne.ip )then
1290                print*,'xyzpam: ***WARNING*** cluster ',icy
1291         $           ,' does not belong to plane: ',ip
1292                icy = -1*icy
1293                return
1294             endif
1295    
1296             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1297    
1298             xgood(ip) = 1.
1299             ygood(ip) = 1.
1300             resx(ip)  = resxPAM
1301             resy(ip)  = resyPAM
1302    
1303             xm(ip) = xPAM
1304             ym(ip) = yPAM
1305             zm(ip) = zPAM
1306             xm_A(ip) = 0.
1307             ym_A(ip) = 0.
1308             xm_B(ip) = 0.
1309             ym_B(ip) = 0.
1310    
1311    c         zv(ip) = zPAM
1312    
1313          elseif(icx.eq.0.and.icy.ne.0)then
1314    
1315             ipy=npl(VIEW(icy))
1316    c$$$         if((nplanes-ipy+1).ne.ip)
1317    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1318    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1319             if( (nplanes-ipy+1).ne.ip )then
1320                print*,'xyzpam: ***WARNING*** cluster ',icy
1321         $           ,' does not belong to plane: ',ip
1322                icy = -1*icy
1323                return
1324             endif
1325    
1326             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1327            
1328             xgood(ip) = 0.
1329             ygood(ip) = 1.
1330             resx(ip)  = 1000.
1331             resy(ip)  = resyPAM
1332    
1333             xm(ip) = -100.
1334             ym(ip) = -100.
1335             zm(ip) = (zPAM_A+zPAM_B)/2.
1336             xm_A(ip) = xPAM_A
1337             ym_A(ip) = yPAM_A
1338             xm_B(ip) = xPAM_B
1339             ym_B(ip) = yPAM_B
1340    
1341    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1342            
1343          elseif(icx.ne.0.and.icy.eq.0)then
1344    
1345             ipx=npl(VIEW(icx))
1346    c$$$         if((nplanes-ipx+1).ne.ip)
1347    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1348    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1349    
1350             if( (nplanes-ipx+1).ne.ip )then
1351                print*,'xyzpam: ***WARNING*** cluster ',icx
1352         $           ,' does not belong to plane: ',ip
1353                icx = -1*icx
1354                return
1355             endif
1356    
1357             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1358          
1359             xgood(ip) = 1.
1360             ygood(ip) = 0.
1361             resx(ip)  = resxPAM
1362             resy(ip)  = 1000.
1363    
1364             xm(ip) = -100.
1365             ym(ip) = -100.
1366             zm(ip) = (zPAM_A+zPAM_B)/2.
1367             xm_A(ip) = xPAM_A
1368             ym_A(ip) = yPAM_A
1369             xm_B(ip) = xPAM_B
1370             ym_B(ip) = yPAM_B
1371            
1372    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1373    
1374          else
1375    
1376             il = 2
1377             if(lad.ne.0)il=lad
1378             is = 1
1379             if(sensor.ne.0)is=sensor
1380    c         print*,nplanes-ip+1,il,is
1381    
1382             xgood(ip) = 0.
1383             ygood(ip) = 0.
1384             resx(ip)  = 1000.
1385             resy(ip)  = 1000.
1386    
1387             xm(ip) = -100.
1388             ym(ip) = -100.          
1389             zm(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1390             xm_A(ip) = 0.
1391             ym_A(ip) = 0.
1392             xm_B(ip) = 0.
1393             ym_B(ip) = 0.
1394    
1395    c         zv(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1396    
1397          endif
1398    
1399          if(DEBUG.EQ.1)then
1400    c         print*,'----------------------------- track coord'
1401    22222    format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
1402             write(*,22222)ip,zm(ip),xm(ip),ym(ip)
1403         $        ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip)
1404         $        ,xgood(ip),ygood(ip),resx(ip),resy(ip)
1405    c$$$         print*,'-----------------------------'
1406          endif
1407          end
1408    
1409  ********************************************************************************  ********************************************************************************
1410  ********************************************************************************  ********************************************************************************
# Line 1046  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1480  c         print*,'A-(',xPAM_A,yPAM_A,')
1480           endif                   endif        
1481    
1482           distance=           distance=
1483       $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2       $       ((xmi-XPP)**2+(ymi-YPP)**2)!QUIQUI
1484    cc     $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1485           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1486    
1487  c$$$         print*,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b  c$$$         print*,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b
# Line 1071  c$$$         print*,' resolution ',re Line 1506  c$$$         print*,' resolution ',re
1506  *     ----------------------  *     ----------------------
1507                    
1508           distance=           distance=
1509       $        ((xPAM-XPP)/resxPAM)**2       $       ((xPAM-XPP))**2 !QUIQUI
1510       $        +       $       +
1511       $        ((yPAM-YPP)/resyPAM)**2       $       ((yPAM-YPP))**2
1512    c$$$     $        ((xPAM-XPP)/resxPAM)**2
1513    c$$$     $        +
1514    c$$$     $        ((yPAM-YPP)/resyPAM)**2
1515           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1516    
1517  c$$$         print*,xPAM,yPAM,zPAM  c$$$         print*,xPAM,yPAM,zPAM
# Line 1082  c$$$         print*,' resolution ',resxP Line 1520  c$$$         print*,' resolution ',resxP
1520                    
1521        else        else
1522                    
1523           print*  c         print*
1524       $        ,' function distance_to ---> wrong usage!!!'  c     $        ,' function distance_to ---> wrong usage!!!'
1525           print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM  c         print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM
1526           print*,' xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b '  c         print*,' xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b '
1527       $        ,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b  c     $        ,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b
1528        endif          endif  
1529    
1530        distance_to = sngl(distance)        distance_to = sngl(distance)
# Line 1154  c--------------------------------------- Line 1592  c---------------------------------------
1592                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1593       $              .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...       $              .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
1594  c     if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...  c     if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...
1595                    print*,'whichsensor: ',  c                  print*,'whichsensor: ',
1596       $                ' WARNING: false X strip: strip ',stripx  c     $                ' WARNING: false X strip: strip ',stripx
1597                 endif                 endif
1598                 xi = acoordsi(stripx,viewx)                 xi = acoordsi(stripx,viewx)
1599                 yi = acoordsi(stripy,viewy)                 yi = acoordsi(stripy,viewy)
# Line 1284  c     $              ,iv,xvv(iv),yvv(iv) Line 1722  c     $              ,iv,xvv(iv),yvv(iv)
1722  *     it returns the plane number  *     it returns the plane number
1723  *      *    
1724        include 'commontracker.f'        include 'commontracker.f'
1725          include 'level1.f'
1726  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1727        include 'common_momanhough.f'        include 'common_momanhough.f'
1728                
# Line 1309  c      include 'common_analysis.f' Line 1748  c      include 'common_analysis.f'
1748        is_cp=0        is_cp=0
1749        if(id.lt.0)is_cp=1        if(id.lt.0)is_cp=1
1750        if(id.gt.0)is_cp=2        if(id.gt.0)is_cp=2
1751        if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'  c      if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'
1752    
1753        return        return
1754        end        end
# Line 1321  c      include 'common_analysis.f' Line 1760  c      include 'common_analysis.f'
1760  *     it returns the id number ON THE PLANE  *     it returns the id number ON THE PLANE
1761  *      *    
1762        include 'commontracker.f'        include 'commontracker.f'
1763          include 'level1.f'
1764  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1765        include 'common_momanhough.f'        include 'common_momanhough.f'
1766                
# Line 1349  c      include 'common_analysis.f' Line 1789  c      include 'common_analysis.f'
1789  *     positive if sensor =2  *     positive if sensor =2
1790  *  *
1791        include 'commontracker.f'        include 'commontracker.f'
1792          include 'level1.f'
1793  c      include 'calib.f'  c      include 'calib.f'
1794  c      include 'level1.f'  c      include 'level1.f'
1795  c      include 'common_analysis.f'  c      include 'common_analysis.f'
# Line 1378  c      include 'common_analysis.f' Line 1819  c      include 'common_analysis.f'
1819  *************************************************************************  *************************************************************************
1820  *************************************************************************  *************************************************************************
1821  *************************************************************************  *************************************************************************
 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  
1822                
1823    
1824  ***************************************************  ***************************************************
# Line 1660  c$$$      end Line 1833  c$$$      end
1833        subroutine cl_to_couples(iflag)        subroutine cl_to_couples(iflag)
1834    
1835        include 'commontracker.f'        include 'commontracker.f'
1836          include 'level1.f'
1837        include 'common_momanhough.f'        include 'common_momanhough.f'
1838        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1839        include 'calib.f'        include 'calib.f'
1840        include 'level1.f'  c      include 'level1.f'
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1841    
1842  *     output flag  *     output flag
1843  *     --------------  *     --------------
# Line 1675  c      common/dbg/DEBUG Line 1846  c      common/dbg/DEBUG
1846  *     --------------  *     --------------
1847        integer iflag        integer iflag
1848    
1849        integer badseed,badcl        integer badseed,badclx,badcly
1850        
1851          if(DEBUG.EQ.1)print*,'cl_to_couples:'
1852    
1853  *     init variables  *     init variables
1854        ncp_tot=0        ncp_tot=0
# Line 1691  c      common/dbg/DEBUG Line 1864  c      common/dbg/DEBUG
1864           ncls(ip)=0           ncls(ip)=0
1865        enddo        enddo
1866        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1867           cl_single(icl)=1           cl_single(icl) = 1
1868           cl_good(icl)=0           cl_good(icl)   = 0
1869          enddo
1870          do iv=1,nviews
1871             ncl_view(iv)  = 0
1872             mask_view(iv) = 0      !all included
1873        enddo        enddo
1874                
1875  *     start association  *     count number of cluster per view
       ncouples=0  
       do icx=1,nclstr1          !loop on cluster (X)  
          if(mod(VIEW(icx),2).eq.1)goto 10  
           
 *     ----------------------------------------------------  
 *     cut on charge (X VIEW)  
 *     ----------------------------------------------------  
          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  
 *     ----------------------------------------------------  
 *     >>> eliminato il taglio sulle BAD <<<  
 *     ----------------------------------------------------  
 c     if(badcl.eq.0)then  
 c     cl_single(icx)=0  
 c     goto 10  
 c     endif  
 *     ----------------------------------------------------  
           
          cl_good(icx)=1  
          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  
               
 *     ----------------------------------------------------  
 *     cut on charge (Y 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  
 *     ----------------------------------------------------  
 *     >>> eliminato il taglio sulle BAD <<<  
 *     ----------------------------------------------------  
 c     if(badcl.eq.0)then  
 c     cl_single(icy)=0  
 c     goto 20  
 c     endif  
 *     ----------------------------------------------------  
               
             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  
 *     (modified to be applied only below saturation... obviously)  
   
 *     -------------------------------------------------------------  
 *     >>> eliminata (TEMPORANEAMENTE) la correlazione di carica <<<  
 *     -------------------------------------------------------------  
 c$$$               if(dedx(icy).lt.chsaty.or.dedx(icx).lt.chsatx)then  
 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  
 c$$$               endif  
                 
 *     ------------------> COUPLE <------------------  
 *     check to do not overflow vector dimentions  
                if(ncp_plane(nplx).gt.ncouplemax)then  
                   if(DEBUG)print*,  
      $                    ' ** warning ** number of identified'//  
      $                    ' 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  
                 
 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  
                 
                ncp_plane(nplx) = ncp_plane(nplx) + 1  
                clx(nplx,ncp_plane(nplx))=icx  
                cly(nply,ncp_plane(nplx))=icy  
                cl_single(icx)=0  
                cl_single(icy)=0  
             endif                                
 *     ----------------------------------------------  
   
  20         continue  
          enddo                  !end loop on clusters(Y)  
           
  10      continue  
       enddo                     !end loop on clusters(X)  
         
         
1876        do icl=1,nclstr1        do icl=1,nclstr1
1877           if(cl_single(icl).eq.1)then           ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1        
             ip=npl(VIEW(icl))  
             ncls(ip)=ncls(ip)+1  
             cls(ip,ncls(ip))=icl  
          endif  
1878        enddo        enddo
1879          *     mask views with too many clusters
1880                do iv=1,nviews
1881        if(DEBUG)then           if( ncl_view(iv).gt. nclusterlimit)then
1882           print*,'clusters  ',nclstr1  c            mask_view(iv) = 1
1883           print*,'good    ',(cl_good(i),i=1,nclstr1)              mask_view(iv) = mask_view(iv) + 2**0
1884           print*,'singles ',(cl_single(i),i=1,nclstr1)              if(DEBUG.EQ.1)
1885           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)       $        print*,' * WARNING * cl_to_couple: n.clusters > '
1886        endif       $        ,nclusterlimit,' on view ', iv,' --> masked!'
1887                   endif
       do ip=1,6  
          ncp_tot=ncp_tot+ncp_plane(ip)  
1888        enddo        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'  
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
 *     output flag  
 *     --------------  
 *     0 = good event  
 *     1 = bad event  
 *     --------------  
       integer iflag  
1889    
       integer badseed,badcl  
1890    
 *     init variables  
       ncp_tot=0  
       do ip=1,nplanes  
          do ico=1,ncouplemax  
             clx(ip,ico)=0  
             cly(ip,ico)=0  
          enddo  
          ncp_plane(ip)=0  
          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  
         
1891  *     start association  *     start association
1892        ncouples=0        ncouples=0
1893        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1894           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1895                    
1896  *     ----------------------------------------------------  *     ----------------------------------------------------
1897    *     jump masked views (X VIEW)
1898    *     ----------------------------------------------------
1899             if( mask_view(VIEW(icx)).ne.0 ) goto 10
1900    *     ----------------------------------------------------
1901  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1902           if(dedx(icx).lt.dedx_x_min)then  *     ----------------------------------------------------
1903             if(sgnl(icx).lt.dedx_x_min)then
1904              cl_single(icx)=0              cl_single(icx)=0
1905              goto 10              goto 10
1906           endif           endif
1907    *     ----------------------------------------------------
1908  *     cut BAD (X VIEW)              *     cut BAD (X VIEW)            
1909    *     ----------------------------------------------------
1910           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
1911           ifirst=INDSTART(icx)           ifirst=INDSTART(icx)
1912           if(icx.ne.nclstr1) then           if(icx.ne.nclstr1) then
# Line 1946  c      common/dbg/DEBUG Line 1914  c      common/dbg/DEBUG
1914           else           else
1915              ilast=TOTCLLENGTH              ilast=TOTCLLENGTH
1916           endif           endif
1917           badcl=badseed           badclx=badseed
1918           do igood=-ngoodstr,ngoodstr           do igood=-ngoodstr,ngoodstr
1919              ibad=1              ibad=1
1920              if((INDMAX(icx)+igood).gt.ifirst.and.              if((INDMAX(icx)+igood).gt.ifirst.and.
# Line 1956  c      common/dbg/DEBUG Line 1924  c      common/dbg/DEBUG
1924       $              nvk(MAXS(icx)+igood),       $              nvk(MAXS(icx)+igood),
1925       $              nst(MAXS(icx)+igood))       $              nst(MAXS(icx)+igood))
1926              endif              endif
1927              badcl=badcl*ibad              badclx=badclx*ibad
1928           enddo           enddo
1929           if(badcl.eq.0)then     !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1930              cl_single(icx)=0    !<<<<<<<<<<<<<< BAD cut  *     >>> eliminato il taglio sulle BAD <<<
1931              goto 10             !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1932           endif                  !<<<<<<<<<<<<<< BAD cut  c     if(badcl.eq.0)then
1933    c     cl_single(icx)=0
1934    c     goto 10
1935    c     endif
1936  *     ----------------------------------------------------  *     ----------------------------------------------------
1937                    
1938           cl_good(icx)=1           cl_good(icx)=1
# Line 1972  c      common/dbg/DEBUG Line 1943  c      common/dbg/DEBUG
1943              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1944                            
1945  *     ----------------------------------------------------  *     ----------------------------------------------------
1946    *     jump masked views (Y VIEW)
1947    *     ----------------------------------------------------
1948                if( mask_view(VIEW(icy)).ne.0 ) goto 20
1949    
1950    *     ----------------------------------------------------
1951  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1952              if(dedx(icy).lt.dedx_y_min)then  *     ----------------------------------------------------
1953                if(sgnl(icy).lt.dedx_y_min)then
1954                 cl_single(icy)=0                 cl_single(icy)=0
1955                 goto 20                 goto 20
1956              endif              endif
1957    *     ----------------------------------------------------
1958  *     cut BAD (Y VIEW)              *     cut BAD (Y VIEW)            
1959    *     ----------------------------------------------------
1960              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
1961              ifirst=INDSTART(icy)              ifirst=INDSTART(icy)
1962              if(icy.ne.nclstr1) then              if(icy.ne.nclstr1) then
# Line 1985  c      common/dbg/DEBUG Line 1964  c      common/dbg/DEBUG
1964              else              else
1965                 ilast=TOTCLLENGTH                 ilast=TOTCLLENGTH
1966              endif              endif
1967              badcl=badseed              badcly=badseed
1968              do igood=-ngoodstr,ngoodstr              do igood=-ngoodstr,ngoodstr
1969                 ibad=1                 ibad=1
1970                 if((INDMAX(icy)+igood).gt.ifirst.and.                 if((INDMAX(icy)+igood).gt.ifirst.and.
# Line 1994  c      common/dbg/DEBUG Line 1973  c      common/dbg/DEBUG
1973       $              ibad=BAD(VIEW(icy),       $              ibad=BAD(VIEW(icy),
1974       $              nvk(MAXS(icy)+igood),       $              nvk(MAXS(icy)+igood),
1975       $              nst(MAXS(icy)+igood))       $              nst(MAXS(icy)+igood))
1976                 badcl=badcl*ibad                 badcly=badcly*ibad
1977              enddo              enddo
             if(badcl.eq.0)then  !<<<<<<<<<<<<<< BAD cut  
                cl_single(icy)=0 !<<<<<<<<<<<<<< BAD cut  
                goto 20          !<<<<<<<<<<<<<< BAD cut  
             endif               !<<<<<<<<<<<<<< BAD cut  
1978  *     ----------------------------------------------------  *     ----------------------------------------------------
1979                *     >>> eliminato il taglio sulle BAD <<<
1980    *     ----------------------------------------------------
1981    c     if(badcl.eq.0)then
1982    c     cl_single(icy)=0
1983    c     goto 20
1984    c     endif
1985    *     ----------------------------------------------------
1986                            
1987              cl_good(icy)=1                                cl_good(icy)=1                  
1988              nply=npl(VIEW(icy))              nply=npl(VIEW(icy))
# Line 2012  c      common/dbg/DEBUG Line 1993  c      common/dbg/DEBUG
1993  *     ----------------------------------------------  *     ----------------------------------------------
1994  *     geometrical consistency (same plane and ladder)  *     geometrical consistency (same plane and ladder)
1995              if(nply.eq.nplx.and.nldy.eq.nldx)then              if(nply.eq.nplx.and.nldy.eq.nldx)then
1996  *     charge correlation  *     charge correlation
1997  *     ===========================================================  *     (modified to be applied only below saturation... obviously)
1998  *     this version of the subroutine is used for the calibration  
1999  *     thus charge-correlation selection is obviously removed                 if(  .not.(sgnl(icy).gt.chsaty.and.sgnl(icx).gt.chsatx)
2000  *     ===========================================================       $              .and.
2001  c$$$               ddd=(dedx(icy)       $              .not.(sgnl(icy).lt.chmipy.and.sgnl(icx).lt.chmipx)
2002  c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))       $              .and.
2003  c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)       $              (badclx.eq.1.and.badcly.eq.1)
2004  c$$$               cut=chcut*sch(nplx,nldx)       $              .and.
2005  c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent       $              .true.)then
2006  *     ===========================================================  
2007                                    ddd=(sgnl(icy)
2008                       $                 -kch(nplx,nldx)*sgnl(icx)-cch(nplx,nldx))
2009  *     ------------------> COUPLE <------------------                    ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
2010  *     check to do not overflow vector dimentions  
2011    c                  cut = chcut * sch(nplx,nldx)
2012    
2013                      sss=(kch(nplx,nldx)*sgnl(icy)+sgnl(icx)
2014         $                 -kch(nplx,nldx)*cch(nplx,nldx))
2015                      sss=sss/sqrt(kch(nplx,nldx)**2+1)
2016                      cut = chcut * (16 + sss/50.)
2017    
2018                      if(abs(ddd).gt.cut)then
2019                         goto 20    !charge not consistent
2020                      endif
2021                   endif
2022    
2023                 if(ncp_plane(nplx).gt.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
2024                    if(DEBUG)print*,                    if(verbose.eq.1)print*,
2025       $                    ' ** warning ** number of identified'//       $                 '** warning ** number of identified '//
2026       $                    ' couples on plane ',nplx,       $                 'couples on plane ',nplx,
2027       $                    ' exceeds vector dimention'//       $                 'exceeds vector dimention '
2028       $                    ' ( ',ncouplemax,' )'       $                 ,'( ',ncouplemax,' ) --> masked!'
2029  c     good2=.false.  c                  mask_view(nviewx(nplx)) = 2
2030  c     goto 880   !fill ntp and go to next event  c                  mask_view(nviewy(nply)) = 2
2031                    iflag=1                    mask_view(nviewx(nplx))= mask_view(nviewx(nplx))+ 2**1
2032                    return                    mask_view(nviewy(nply))= mask_view(nviewy(nply))+ 2**1
2033                      goto 10
2034                 endif                 endif
2035                                
2036  c$$$               if(ncp_plane(nplx).eq.ncouplemax)then  *     ------------------> COUPLE <------------------
 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  
                 
2037                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
2038                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
2039                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
2040                 cl_single(icx)=0                 cl_single(icx)=0
2041                 cl_single(icy)=0                 cl_single(icy)=0
             endif                                
2042  *     ----------------------------------------------  *     ----------------------------------------------
2043    
2044                endif                              
2045    
2046   20         continue   20         continue
2047           enddo                  !end loop on clusters(Y)           enddo                  !end loop on clusters(Y)
2048                    
# Line 2075  c$$$               endif Line 2059  c$$$               endif
2059        enddo        enddo
2060                
2061                
2062        if(DEBUG)then        if(DEBUG.EQ.1)then
2063           print*,'clusters  ',nclstr1           print*,'clusters  ',nclstr1
2064           print*,'good    ',(cl_good(i),i=1,nclstr1)           print*,'good    ',(cl_good(i),i=1,nclstr1)
2065           print*,'singles ',(cl_single(i),i=1,nclstr1)           print*,'singlets',(cl_single(i),i=1,nclstr1)
2066           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
2067        endif        endif
2068                
2069        do ip=1,6        do ip=1,6
2070           ncp_tot=ncp_tot+ncp_plane(ip)           ncp_tot = ncp_tot + ncp_plane(ip)
2071        enddo        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  
2072                
2073        return        return
2074        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  
2075                
2076  ***************************************************  ***************************************************
2077  *                                                 *  *                                                 *
# Line 2321  c$$$      end Line 2083  c$$$      end
2083  **************************************************  **************************************************
2084    
2085        subroutine cp_to_doubtrip(iflag)        subroutine cp_to_doubtrip(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2086    
2087        include 'commontracker.f'        include 'commontracker.f'
2088          include 'level1.f'
2089        include 'common_momanhough.f'        include 'common_momanhough.f'
       include 'momanhough_init.f'  
2090        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2091        include 'common_mini_2.f'        include 'common_mini_2.f'
2092        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
2093    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2094    
2095  *     output flag  *     output flag
2096  *     --------------  *     --------------
# Line 2366  c      double precision xm3,ym3,zm3 Line 2122  c      double precision xm3,ym3,zm3
2122        real xc,zc,radius        real xc,zc,radius
2123  *     -----------------------------  *     -----------------------------
2124    
2125          if(DEBUG.EQ.1)print*,'cp_to_doubtrip:'
2126    
2127    *     --------------------------------------------
2128    *     put a limit to the maximum number of couples
2129    *     per plane, in order to apply hough transform
2130    *     (couples recovered during track refinement)
2131    *     --------------------------------------------
2132          do ip=1,nplanes
2133             if(ncp_plane(ip).gt.ncouplelimit)then
2134    c            mask_view(nviewx(ip)) = 8
2135    c            mask_view(nviewy(ip)) = 8
2136                mask_view(nviewx(ip)) = mask_view(nviewx(ip)) + 2**7
2137                mask_view(nviewy(ip)) = mask_view(nviewy(ip)) + 2**7
2138             endif
2139          enddo
2140    
2141    
2142        ndblt=0                   !number of doublets        ndblt=0                   !number of doublets
2143        ntrpt=0                   !number of triplets        ntrpt=0                   !number of triplets
2144                
2145        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1
2146           do is1=1,2             !loop on sensors - COPPIA 1           if(  mask_view(nviewx(ip1)).ne.0 .or.
2147                     $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
2148             do is1=1,2             !loop on sensors - COPPIA 1            
2149              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
2150                 icx1=clx(ip1,icp1)                 icx1=clx(ip1,icp1)
2151                 icy1=cly(ip1,icp1)                 icy1=cly(ip1,icp1)
2152  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
2153                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
2154                   call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
2155                 xm1=xPAM                 xm1=xPAM
2156                 ym1=yPAM                 ym1=yPAM
2157                 zm1=zPAM                                   zm1=zPAM                  
2158  c     print*,'***',is1,xm1,ym1,zm1  c     print*,'***',is1,xm1,ym1,zm1
2159    
2160                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
2161                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    if(  mask_view(nviewx(ip2)).ne.0 .or.
2162                             $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
2163                      do is2=1,2    !loop on sensors -ndblt COPPIA 2                    
2164                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2
2165                          icx2=clx(ip2,icp2)                          icx2=clx(ip2,icp2)
2166                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
2167  c                        call xyz_PAM  c                        call xyz_PAM
2168  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
2169    c                        call xyz_PAM
2170    c     $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)
2171                          call xyz_PAM                          call xyz_PAM
2172       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.,0.,0.)
2173                          xm2=xPAM                          xm2=xPAM
2174                          ym2=yPAM                          ym2=yPAM
2175                          zm2=zPAM                          zm2=zPAM
# Line 2402  c     $                       (icx2,icy2 Line 2179  c     $                       (icx2,icy2
2179  *     (2 couples needed)  *     (2 couples needed)
2180  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2181                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
2182                             if(DEBUG)print*,                             if(verbose.eq.1)print*,
2183       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
2184       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
2185       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
2186  c                           good2=.false.  c                           good2=.false.
2187  c                           goto 880 !fill ntp and go to next event  c                           goto 880 !fill ntp and go to next event
2188                               do iv=1,12
2189    c                              mask_view(iv) = 3
2190                                  mask_view(iv) = mask_view(iv)+ 2**2
2191                               enddo
2192                             iflag=1                             iflag=1
2193                             return                             return
2194                          endif                          endif
# Line 2441  c$$$ Line 2222  c$$$
2222  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2223    
2224    
2225                          if(ip2.eq.nplanes)goto 30 !no possible combination with 3 couples                          if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
2226    
2227                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
2228                               if(  mask_view(nviewx(ip3)).ne.0 .or.
2229         $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
2230                             do is3=1,2 !loop on sensors - COPPIA 3                             do is3=1,2 !loop on sensors - COPPIA 3
2231                                                                
2232                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
# Line 2450  c$$$ Line 2234  c$$$
2234                                   icy3=cly(ip3,icp3)                                   icy3=cly(ip3,icp3)
2235  c                                 call xyz_PAM  c                                 call xyz_PAM
2236  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
2237    c                                 call xyz_PAM
2238    c     $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)
2239                                   call xyz_PAM                                   call xyz_PAM
2240       $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)       $                                (icx3,icy3,is3,PFAdef,PFAdef
2241         $                                ,0.,0.,0.,0.)
2242                                   xm3=xPAM                                   xm3=xPAM
2243                                   ym3=yPAM                                   ym3=yPAM
2244                                   zm3=zPAM                                   zm3=zPAM
# Line 2472  c     $                                 Line 2259  c     $                                
2259  *     (3 couples needed)  *     (3 couples needed)
2260  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2261                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
2262                                      if(DEBUG)print*,                                      if(verbose.eq.1)print*,
2263       $                     '** warning ** number of identified '//       $                     '** warning ** number of identified '//
2264       $                     'triplets exceeds vector dimention '       $                     'triplets exceeds vector dimention '
2265       $                    ,'( ',ntrpt_max,' )'       $                    ,'( ',ntrpt_max,' )'
2266  c                                    good2=.false.  c                                    good2=.false.
2267  c                                    goto 880 !fill ntp and go to next event  c                                    goto 880 !fill ntp and go to next event
2268                                        do iv=1,nviews
2269    c                                       mask_view(iv) = 4
2270                                           mask_view(iv)=mask_view(iv)+ 2**3
2271                                        enddo
2272                                      iflag=1                                      iflag=1
2273                                      return                                      return
2274                                   endif                                   endif
# Line 2516  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp Line 2307  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp
2307                                endif                                endif
2308                             enddo !end loop on COPPIA 3                             enddo !end loop on COPPIA 3
2309                          enddo   !end loop on sensors - COPPIA 3                          enddo   !end loop on sensors - COPPIA 3
2310     30                     continue
2311                       enddo      !end loop on planes  - COPPIA 3                       enddo      !end loop on planes  - COPPIA 3
2312   30                  continue   31                  continue
2313                                            
2314   1                enddo         !end loop on COPPIA 2   1                enddo         !end loop on COPPIA 2
2315                 enddo            !end loop on sensors - COPPIA 2                 enddo            !end loop on sensors - COPPIA 2
2316     20            continue
2317              enddo               !end loop on planes  - COPPIA 2              enddo               !end loop on planes  - COPPIA 2
2318                            
2319           enddo                  !end loop on COPPIA1           enddo                  !end loop on COPPIA1
2320        enddo                     !end loop on sensors - COPPIA 1        enddo                     !end loop on sensors - COPPIA 1
2321     10   continue
2322        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
2323                
2324        if(DEBUG)then        if(DEBUG.EQ.1)then
2325           print*,'--- doublets ',ndblt           print*,'--- doublets ',ndblt
2326           print*,'--- triplets ',ntrpt           print*,'--- triplets ',ntrpt
2327        endif        endif
# Line 2552  c     goto 880               !ntp fill Line 2346  c     goto 880               !ntp fill
2346        subroutine doub_to_YZcloud(iflag)        subroutine doub_to_YZcloud(iflag)
2347    
2348        include 'commontracker.f'        include 'commontracker.f'
2349          include 'level1.f'
2350        include 'common_momanhough.f'        include 'common_momanhough.f'
2351        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2352    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2353    
2354  *     output flag  *     output flag
2355  *     --------------  *     --------------
# Line 2575  c      common/dbg/DEBUG Line 2368  c      common/dbg/DEBUG
2368        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2369        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2370    
2371          if(DEBUG.EQ.1)print*,'doub_to_YZcloud:'
2372    
2373  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2374  *     classification of DOUBLETS  *     classification of DOUBLETS
# Line 2588  c      common/dbg/DEBUG Line 2382  c      common/dbg/DEBUG
2382        distance=0        distance=0
2383        nclouds_yz=0              !number of clouds        nclouds_yz=0              !number of clouds
2384        npt_tot=0        npt_tot=0
2385          nloop=0                  
2386     90   continue                  
2387        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2388           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
2389                            
# Line 2691  c     print*,'*   idbref,idb2 ',idbref,i Line 2487  c     print*,'*   idbref,idb2 ',idbref,i
2487              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2488           enddo           enddo
2489  c     print*,'>>>> ',ncpused,npt,nplused  c     print*,'>>>> ',ncpused,npt,nplused
2490           if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  c         if(ncpused.lt.ncpyz_min)goto 2228 !next doublet
2491           if(npt.lt.nptyz_min)goto 2228 !next doublet           if(npt.lt.nptyz_min)goto 2228 !next doublet
2492           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2493                    
# Line 2699  c     print*,'>>>> ',ncpused,npt,nplused Line 2495  c     print*,'>>>> ',ncpused,npt,nplused
2495  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2496    
2497           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2498              if(DEBUG)print*,              if(verbose.eq.1)print*,
2499       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2500       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2501       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2502  c               good2=.false.  c               good2=.false.
2503  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2504                do iv=1,nviews
2505    c               mask_view(iv) = 5
2506                   mask_view(iv) = mask_view(iv) + 2**4
2507                enddo
2508              iflag=1              iflag=1
2509              return              return
2510           endif           endif
# Line 2723  c     ptcloud_yz_nt(nclouds_yz)=npt Line 2523  c     ptcloud_yz_nt(nclouds_yz)=npt
2523  c     print*,'>> ',ipt,db_all(ipt)  c     print*,'>> ',ipt,db_all(ipt)
2524           enddo             enddo  
2525           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2526           if(DEBUG)then           if(DEBUG.EQ.1)then
2527              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'
2528              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'
2529              print*,'- alfayz1 ',alfayz1_av(nclouds_yz)              print*,'- alfayz1  ',alfayz1_av(nclouds_yz)
2530              print*,'- alfayz2 ',alfayz2_av(nclouds_yz)              print*,'- alfayz2  ',alfayz2_av(nclouds_yz)
2531              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2532              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2533              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'cpcloud_yz '
2534         $           ,(cpcloud_yz(nclouds_yz,icp),icp=1,ncp_tot)
2535                print*,'hit_plane  ',(hit_plane(ip),ip=1,nplanes)
2536  c$$$            print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '  c$$$            print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '
2537  c$$$     $           ,ptcloud_yz(nclouds_yz)  c$$$     $           ,ptcloud_yz(nclouds_yz)
2538  c$$$            print*,'nt-uple: db_cloud(...) = '  c$$$            print*,'nt-uple: db_cloud(...) = '
# Line 2742  c$$$     $           ,(db_cloud(iii),iii Line 2544  c$$$     $           ,(db_cloud(iii),iii
2544        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2545                
2546                
2547        if(DEBUG)then        if(nloop.lt.nstepy)then      
2548            cutdistyz = cutdistyz+cutystep
2549            nloop     = nloop+1          
2550            goto 90                
2551          endif                    
2552          
2553          if(DEBUG.EQ.1)then
2554           print*,'---------------------- '           print*,'---------------------- '
2555           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
2556           print*,' '           print*,' '
# Line 2768  c$$$     $           ,(db_cloud(iii),iii Line 2576  c$$$     $           ,(db_cloud(iii),iii
2576        subroutine trip_to_XZcloud(iflag)        subroutine trip_to_XZcloud(iflag)
2577    
2578        include 'commontracker.f'        include 'commontracker.f'
2579          include 'level1.f'
2580        include 'common_momanhough.f'        include 'common_momanhough.f'
2581        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2582    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2583    
2584  *     output flag  *     output flag
2585  *     --------------  *     --------------
# Line 2792  c      common/dbg/DEBUG Line 2599  c      common/dbg/DEBUG
2599        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2600        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2601    
2602          if(DEBUG.EQ.1)print*,'trip_to_XZcloud:'
2603    
2604  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2605  *     classification of TRIPLETS  *     classification of TRIPLETS
2606  *     according to distance in parameter space  *     according to distance in parameter space
# Line 2803  c      common/dbg/DEBUG Line 2612  c      common/dbg/DEBUG
2612        distance=0        distance=0
2613        nclouds_xz=0              !number of clouds                nclouds_xz=0              !number of clouds        
2614        npt_tot=0                 !total number of selected triplets        npt_tot=0                 !total number of selected triplets
2615          nloop=0                  
2616     91   continue                  
2617        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2618           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
2619  c     print*,'--------------'  c     print*,'--------------'
# Line 2847  c         tr_temp(1)=itr1 Line 2658  c         tr_temp(1)=itr1
2658       $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2                     $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2              
2659                 distance = sqrt(distance)                 distance = sqrt(distance)
2660                                
2661                 if(distance.lt.cutdistxz)then  *     ------------------------------------------------------------------------
2662    *     FORCE INCLUSION OF TRIPLETS COMPOSED BY SAME COUPLES, IGNORING THE IMAGE
2663    *     ------------------------------------------------------------------------
2664    *     (added in august 2007)
2665                   istrimage=0
2666                   if(
2667         $              abs(cpxz1(itrref)).eq.abs(cpxz1(itr2)).and.
2668         $              abs(cpxz2(itrref)).eq.abs(cpxz2(itr2)).and.
2669         $              abs(cpxz3(itrref)).eq.abs(cpxz3(itr2)).and.
2670         $              .true.)istrimage=1
2671    
2672                   if(distance.lt.cutdistxz.or.istrimage.eq.1)then
2673  c     print*,idb1,idb2,distance,' cloud ',nclouds_yz  c     print*,idb1,idb2,distance,' cloud ',nclouds_yz
2674                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1
2675                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1
# Line 2904  c     print*,'check cp_used' Line 2726  c     print*,'check cp_used'
2726           do ip=1,nplanes           do ip=1,nplanes
2727              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2728           enddo           enddo
2729           if(ncpused.lt.ncpxz_min)goto 22288 !next triplet  c         if(ncpused.lt.ncpxz_min)goto 22288 !next triplet
2730           if(npt.lt.nptxz_min)goto 22288     !next triplet           if(npt.lt.nptxz_min)goto 22288     !next triplet
2731           if(nplused.lt.nplxz_min)goto 22288 !next doublet           if(nplused.lt.nplxz_min)goto 22288 !next triplet
2732                    
2733  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2734  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2735           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2736              if(DEBUG)print*,              if(verbose.eq.1)print*,
2737       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2738       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2739       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2740  c     good2=.false.  c     good2=.false.
2741  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2742                do iv=1,nviews
2743    c               mask_view(iv) = 6
2744                   mask_view(iv) =  mask_view(iv) + 2**5
2745                enddo
2746              iflag=1              iflag=1
2747              return              return
2748           endif           endif
# Line 2934  c     goto 880         !fill ntp and go Line 2760  c     goto 880         !fill ntp and go
2760           enddo           enddo
2761           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2762                    
2763           if(DEBUG)then           if(DEBUG.EQ.1)then
2764              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'
2765              print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'                            print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'              
2766              print*,'- alfaxz1 ',alfaxz1_av(nclouds_xz)              print*,'- alfaxz1  ',alfaxz1_av(nclouds_xz)
2767              print*,'- alfaxz2 ',alfaxz2_av(nclouds_xz)              print*,'- alfaxz2  ',alfaxz2_av(nclouds_xz)
2768              print*,'- alfaxz3 ',alfaxz3_av(nclouds_xz)              print*,'- alfaxz3  ',alfaxz3_av(nclouds_xz)
2769              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2770              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2771                print*,'cpcloud_xz '
2772         $           ,(cpcloud_xz(nclouds_xz,icp),icp=1,ncp_tot)
2773              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)
2774  c$$$            print*,'nt-uple: ptcloud_xz(',nclouds_xz,') = '  c$$$            print*,'nt-uple: ptcloud_xz(',nclouds_xz,') = '
2775  c$$$     $           ,ptcloud_xz(nclouds_xz)  c$$$     $           ,ptcloud_xz(nclouds_xz)
# Line 2952  c$$$     $           ,(tr_cloud(iii),iii Line 2780  c$$$     $           ,(tr_cloud(iii),iii
2780  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2781  22288    continue  22288    continue
2782        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2783          
2784        if(DEBUG)then         if(nloop.lt.nstepx)then      
2785             cutdistxz=cutdistxz+cutxstep
2786             nloop=nloop+1          
2787             goto 91                
2788           endif                    
2789          
2790          if(DEBUG.EQ.1)then
2791           print*,'---------------------- '           print*,'---------------------- '
2792           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
2793           print*,' '           print*,' '
# Line 2974  c$$$     $           ,(tr_cloud(iii),iii Line 2808  c$$$     $           ,(tr_cloud(iii),iii
2808  **************************************************  **************************************************
2809    
2810        subroutine clouds_to_ctrack(iflag)        subroutine clouds_to_ctrack(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2811    
2812        include 'commontracker.f'        include 'commontracker.f'
2813          include 'level1.f'
2814        include 'common_momanhough.f'        include 'common_momanhough.f'
2815        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2816        include 'common_mini_2.f'        include 'common_mini_2.f'
2817        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
2818    
2819  c      logical DEBUG  
 c      common/dbg/DEBUG  
2820    
2821  *     output flag  *     output flag
2822  *     --------------  *     --------------
# Line 3002  c      common/dbg/DEBUG Line 2832  c      common/dbg/DEBUG
2832  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2833  *     list of matching couples in the combination  *     list of matching couples in the combination
2834  *     between a XZ and YZ cloud  *     between a XZ and YZ cloud
2835        integer cp_match(nplanes,ncouplemax)        integer cp_match(nplanes,2*ncouplemax)
2836        integer ncp_match(nplanes)        integer ncp_match(nplanes)
2837  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2838        integer hit_plane(nplanes)        integer hit_plane(nplanes)
2839  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2840  *     variables for track fitting  *     variables for track fitting
2841        double precision AL_INI(5)        double precision AL_INI(5)
       double precision tath  
2842  *     -----------------------------------------------------------  *     -----------------------------------------------------------
 c      real fitz(nplanes)        !z coordinates of the planes in cm  
2843    
2844          if(DEBUG.EQ.1)print*,'clouds_to_ctrack:'
2845    
2846    
2847        ntracks=0                 !counter of track candidates        ntracks=0                 !counter of track candidates
# Line 3034  c      real fitz(nplanes)        !z coor Line 2863  c      real fitz(nplanes)        !z coor
2863                 enddo                 enddo
2864              enddo              enddo
2865              ncp_ok=0              ncp_ok=0
2866              do icp=1,ncp_tot    !loop on couples              do icp=1,ncp_tot    !loop over couples
2867  *     get info on  *     get info on
2868                 cpintersec(icp)=min(                 cpintersec(icp)=min(
2869       $              cpcloud_yz(iyz,icp),       $              cpcloud_yz(iyz,icp),
# Line 3043  c      real fitz(nplanes)        !z coor Line 2872  c      real fitz(nplanes)        !z coor
2872       $    (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.       $    (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.
2873       $    (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.       $    (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.
2874       $              .false.)cpintersec(icp)=0       $              .false.)cpintersec(icp)=0
2875    *     cpintersec is >0 if yz and xz clouds contain the same image of couple icp
2876                 if(cpintersec(icp).ne.0)then                 if(cpintersec(icp).ne.0)then
2877                    ncp_ok=ncp_ok+1                      ncp_ok=ncp_ok+1  
2878                                        
# Line 3075  c      real fitz(nplanes)        !z coor Line 2905  c      real fitz(nplanes)        !z coor
2905                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2906              enddo              enddo
2907                            
             if(nplused.lt.nplxz_min)goto 888 !next doublet  
             if(ncp_ok.lt.ncpok)goto 888 !next cloud  
2908                            
2909              if(DEBUG)then              if(DEBUG.EQ.1)then
2910                 print*,'Combination ',iyz,ixz                 print*,'Combination ',iyz,ixz
2911       $              ,' db ',ptcloud_yz(iyz)       $              ,' db ',ptcloud_yz(iyz)
2912       $              ,' tr ',ptcloud_xz(ixz)       $              ,' tr ',ptcloud_xz(ixz)
2913       $              ,'  -----> # matching couples ',ncp_ok       $              ,'  -----> # matching couples ',ncp_ok
2914              endif              endif
2915    
2916    c            if(nplused.lt.nplxz_min)goto 888 !next combination
2917                if(nplused.lt.nplyz_min)goto 888 !next combination
2918                if(ncp_ok.lt.ncpok)goto 888 !next combination
2919    
2920  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2921  c$$$  print*,'Configurazione cluster XZ'  c$$$  print*,'Configurazione cluster XZ'
2922  c$$$  print*,'1 -- ',(clx(1,i),i=1,ncp_plane(1))  c$$$  print*,'1 -- ',(clx(1,i),i=1,ncp_plane(1))
# Line 3102  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p Line 2935  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p
2935  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2936                            
2937  *     -------> INITIAL GUESS <-------  *     -------> INITIAL GUESS <-------
2938              AL_INI(1)=dreal(alfaxz1_av(ixz))  cccc       SBAGLIATO
2939              AL_INI(2)=dreal(alfayz1_av(iyz))  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2940              AL_INI(4)=datan(dreal(alfayz2_av(iyz))  c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2941       $           /dreal(alfaxz2_av(ixz)))  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2942              tath=-dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))  c$$$     $           /dreal(alfaxz2_av(ixz)))
2943              AL_INI(3)=tath/sqrt(1+tath**2)  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2944              AL_INI(5)=(1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2945                c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2946  c     print*,'*******',AL_INI(5)  cccc       GIUSTO (ma si sua guess())
2947              if(AL_INI(5).gt.defmax)goto 888 !next cloud  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2948                c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2949  c     print*,'alfaxz2, alfayz2 '  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2950  c     $              ,alfaxz2_av(ixz),alfayz2_av(iyz)  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2951                c$$$            IF(alfaxz2_av(ixz).NE.0)THEN
2952  *     -------> INITIAL GUESS <-------  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2953  c     print*,'AL_INI ',(al_ini(i),i=1,5)  c$$$     $           /dreal(alfaxz2_av(ixz)))
2954                c$$$            ELSE
2955              if(DEBUG)then  c$$$               AL_INI(4) = acos(-1.)/2
2956    c$$$               IF(alfayz2_av(iyz).LT.0)AL_INI(4) = AL_INI(4)+acos(-1.)
2957    c$$$            ENDIF
2958    c$$$            IF(alfaxz2_av(ixz).LT.0)AL_INI(4)= acos(-1.)+ AL_INI(4)
2959    c$$$            AL_INI(4) = -acos(-1.) + AL_INI(4) !from incidence direction to tracking rs
2960    c$$$            
2961    c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2962    c$$$            
2963    c$$$            if(AL_INI(5).gt.defmax)goto 888 !next cloud
2964                            
2965                if(DEBUG.EQ.1)then
2966                   print*,'track candidate', ntracks+1
2967                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2968                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))
2969                 print*,'3 >>> ',(cp_match(4,i),i=1,ncp_match(4))                 print*,'3 >>> ',(cp_match(4,i),i=1,ncp_match(4))
# Line 3152  c     print*,'AL_INI ',(al_ini(i),i=1,5) Line 2996  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2996                                hit_plane(6)=icp6                                hit_plane(6)=icp6
2997                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6
2998                                                                
2999                                  *                             ---------------------------------------
3000    *                             check if this group of couples has been
3001    *                             already fitted    
3002    *                             ---------------------------------------
3003                                  do ica=1,ntracks
3004                                     isthesame=1
3005                                     do ip=1,NPLANES
3006                                        if(hit_plane(ip).ne.0)then
3007                                           if(  CP_STORE(nplanes-ip+1,ica)
3008         $                                      .ne.
3009         $                                      cp_match(ip,hit_plane(ip)) )
3010         $                                      isthesame=0
3011                                        else
3012                                           if(  CP_STORE(nplanes-ip+1,ica)
3013         $                                      .ne.
3014         $                                      0 )
3015         $                                      isthesame=0
3016                                        endif
3017                                     enddo
3018                                     if(isthesame.eq.1)then
3019                                        if(DEBUG.eq.1)
3020         $                                   print*,'(already fitted)'
3021                                        goto 666 !jump to next combination
3022                                     endif
3023                                  enddo
3024    
3025                                call track_init !init TRACK common                                call track_init !init TRACK common
3026    
3027                                do ip=1,nplanes !loop on planes                                do ip=1,nplanes !loop on planes (bottom to top)
3028                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
3029                                      id=cp_match(ip,hit_plane(ip))                                      id=cp_match(ip,hit_plane(ip))
3030                                      is=is_cp(id)                                      is=is_cp(id)
# Line 3169  c     print*,'AL_INI ',(al_ini(i),i=1,5) Line 3038  c     print*,'AL_INI ',(al_ini(i),i=1,5)
3038  *                                   *************************  *                                   *************************
3039  c                                    call xyz_PAM(icx,icy,is,  c                                    call xyz_PAM(icx,icy,is,
3040  c     $                                   'COG2','COG2',0.,0.)  c     $                                   'COG2','COG2',0.,0.)
3041    c                                    call xyz_PAM(icx,icy,is, !(1)
3042    c     $                                   PFAdef,PFAdef,0.,0.) !(1)
3043                                      call xyz_PAM(icx,icy,is, !(1)                                      call xyz_PAM(icx,icy,is, !(1)
3044       $                                   PFAdef,PFAdef,0.,0.) !(1)       $                                   PFAdef,PFAdef,0.,0.,0.,0.)
3045  *                                   *************************  *                                   *************************
3046  *                                   -----------------------------  *                                   -----------------------------
3047                                      xgood(nplanes-ip+1)=1.                                      xgood(nplanes-ip+1)=1.
# Line 3186  c     $                                 Line 3057  c     $                                
3057  *     **********************************************************  *     **********************************************************
3058  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
3059  *     **********************************************************  *     **********************************************************
3060    cccc  scommentare se si usa al_ini della nuvola
3061    c$$$                              do i=1,5
3062    c$$$                                 AL(i)=AL_INI(i)
3063    c$$$                              enddo
3064                                  call guess()
3065                                do i=1,5                                do i=1,5
3066                                   AL(i)=AL_INI(i)                                   AL_INI(i)=AL(i)
3067                                enddo                                enddo
3068                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
3069                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
3070                                call mini_2(jstep,ifail)                                iprint=0
3071    c                              if(DEBUG.EQ.1)iprint=1
3072                                  if(DEBUG.EQ.1)iprint=2
3073                                  call mini2(jstep,ifail,iprint)
3074                                if(ifail.ne.0) then                                if(ifail.ne.0) then
3075                                   if(DEBUG)then                                   if(DEBUG.EQ.1)then
3076                                      print *,                                      print *,
3077       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
3078       $                              //'(mini_2 in clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
3079                                        print*,'initial guess: '
3080    
3081                                        print*,'AL_INI(1) = ',AL_INI(1)
3082                                        print*,'AL_INI(2) = ',AL_INI(2)
3083                                        print*,'AL_INI(3) = ',AL_INI(3)
3084                                        print*,'AL_INI(4) = ',AL_INI(4)
3085                                        print*,'AL_INI(5) = ',AL_INI(5)
3086                                   endif                                   endif
3087                                   chi2=-chi2  c                                 chi2=-chi2
3088                                endif                                endif
3089  *     **********************************************************  *     **********************************************************
3090  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
# Line 3211  c     $                                 Line 3097  c     $                                
3097  *     --------------------------  *     --------------------------
3098                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
3099                                                                    
3100                                   if(DEBUG)print*,                                   if(verbose.eq.1)print*,
3101       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
3102       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
3103       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
3104  c                                 good2=.false.  c                                 good2=.false.
3105  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
3106                                     do iv=1,nviews
3107    c                                    mask_view(iv) = 7
3108                                        mask_view(iv) = mask_view(iv) + 2**6
3109                                     enddo
3110                                   iflag=1                                   iflag=1
3111                                   return                                   return
3112                                endif                                endif
3113                                                                
3114                                ntracks = ntracks + 1                                ntracks = ntracks + 1
3115                                                                
3116  c$$$                              ndof=0                                                                do ip=1,nplanes !top to bottom
3117                                do ip=1,nplanes  
 c$$$                                 ndof=ndof  
 c$$$     $                                +int(xgood(ip))  
 c$$$     $                                +int(ygood(ip))  
3118                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
3119                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
3120                                   ZV_STORE(ip,ntracks)=sngl(zv(ip))                                                                       ZV_STORE(ip,ntracks)=sngl(zv(ip))                                    
# Line 3243  c$$$     $                               Line 3130  c$$$     $                              
3130                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))
3131                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))
3132                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))
3133    *                                NB! hit_plane is defined from bottom to top
3134                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
3135                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
3136       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
3137                                        SENSOR_STORE(nplanes-ip+1,ntracks)
3138         $                              = is_cp(cp_match(ip,hit_plane(ip)))
3139                                        LADDER_STORE(nplanes-ip+1,ntracks)
3140         $                                   = LADDER(
3141         $                                   clx(ip,icp_cp(
3142         $                                   cp_match(ip,hit_plane(ip)
3143         $                                   ))));
3144                                   else                                   else
3145                                      CP_STORE(nplanes-ip+1,ntracks)=0                                      CP_STORE(nplanes-ip+1,ntracks)=0
3146                                        SENSOR_STORE(nplanes-ip+1,ntracks)=0
3147                                        LADDER_STORE(nplanes-ip+1,ntracks)=0
3148                                   endif                                   endif
3149                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   BX_STORE(ip,ntracks)=0!I dont need it now
3150                                     BY_STORE(ip,ntracks)=0!I dont need it now
3151                                     CLS_STORE(ip,ntracks)=0
3152                                   do i=1,5                                   do i=1,5
3153                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
3154                                   enddo                                   enddo
3155                                enddo                                enddo
3156                                                                
 c$$$  *                             Number of Degree Of Freedom  
 c$$$  ndof=ndof-5                            
 c$$$  *                             reduced chi^2  
 c$$$  rchi2=chi2/dble(ndof)  
3157                                RCHI2_STORE(ntracks)=chi2                                RCHI2_STORE(ntracks)=chi2
3158                                                                
3159  *     --------------------------------  *     --------------------------------
# Line 3282  c$$$  rchi2=chi2/dble(ndof) Line 3177  c$$$  rchi2=chi2/dble(ndof)
3177           return           return
3178        endif        endif
3179                
3180        if(DEBUG)then  c$$$      if(DEBUG.EQ.1)then
3181           print*,'****** TRACK CANDIDATES ***********'  c$$$         print*,'****** TRACK CANDIDATES ***********'
3182           print*,'#         R. chi2        RIG'  c$$$         print*,'#         R. chi2        RIG'
3183           do i=1,ntracks  c$$$         do i=1,ntracks
3184              print*,i,' --- ',rchi2_store(i),' --- '  c$$$            print*,i,' --- ',rchi2_store(i),' --- '
3185       $           ,1./abs(AL_STORE(5,i))  c$$$     $           ,1./abs(AL_STORE(5,i))
3186           enddo  c$$$         enddo
3187           print*,'***********************************'  c$$$         print*,'***********************************'
3188    c$$$      endif
3189          if(DEBUG.EQ.1)then
3190            print*,'****** TRACK CANDIDATES *****************'
3191            print*,'#         R. chi2        RIG         ndof'
3192            do i=1,ntracks
3193              ndof=0                !(1)
3194              do ii=1,nplanes       !(1)
3195                ndof=ndof           !(1)
3196         $           +int(xgood_store(ii,i)) !(1)
3197         $           +int(ygood_store(ii,i)) !(1)
3198              enddo                 !(1)
3199              print*,i,' --- ',rchi2_store(i),' --- '
3200         $         ,1./abs(AL_STORE(5,i)),' --- ',ndof
3201            enddo
3202            print*,'*****************************************'
3203        endif        endif
3204                
3205                
# Line 3308  c$$$  rchi2=chi2/dble(ndof) Line 3218  c$$$  rchi2=chi2/dble(ndof)
3218    
3219        subroutine refine_track(ibest)        subroutine refine_track(ibest)
3220    
 c******************************************************  
 cccccc 06/10/2005 modified by elena vannuccini ---> (1)  
 cccccc 31/01/2006 modified by elena vannuccini ---> (2)  
 cccccc 12/08/2006 modified by elena vannucicni ---> (3)  
 c******************************************************  
3221    
3222        include 'commontracker.f'        include 'commontracker.f'
3223          include 'level1.f'
3224        include 'common_momanhough.f'        include 'common_momanhough.f'
3225        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3226        include 'common_mini_2.f'        include 'common_mini_2.f'
3227        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
       include 'level1.f'  
3228        include 'calib.f'        include 'calib.f'
3229    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
3230  *     flag to chose PFA  *     flag to chose PFA
3231        character*10 PFA        character*10 PFA
3232        common/FINALPFA/PFA        common/FINALPFA/PFA
3233    
3234          real k(6)
3235          DATA k/1.099730,0.418900,0.220939,0.220907,0.418771,1.100674/
3236    
3237          real xp,yp,zp
3238          real xyzp(3),bxyz(3)
3239          equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
3240    
3241          if(DEBUG.EQ.1)print*,'refine_track:'
3242  *     =================================================  *     =================================================
3243  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
3244  *                          and  *                          and
# Line 3338  c      common/dbg/DEBUG Line 3247  c      common/dbg/DEBUG
3247        call track_init        call track_init
3248        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3249    
3250             xP=XV_STORE(nplanes-ip+1,ibest)
3251             yP=YV_STORE(nplanes-ip+1,ibest)
3252             zP=ZV_STORE(nplanes-ip+1,ibest)
3253             call gufld(xyzp,bxyz)
3254             BX_STORE(nplanes-ip+1,ibest)=bxyz(1)
3255             BY_STORE(nplanes-ip+1,ibest)=bxyz(2)
3256    c$$$  bxyz(1)=0
3257    c$$$         bxyz(2)=0
3258    c$$$         bxyz(3)=0
3259    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3260  *     -------------------------------------------------  *     -------------------------------------------------
3261  *     If the plane has been already included, it just  *     If the plane has been already included, it just
3262  *     computes again the coordinates of the x-y couple  *     computes again the coordinates of the x-y couple
3263  *     using improved PFAs  *     using improved PFAs
3264  *     -------------------------------------------------  *     -------------------------------------------------
3265    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3266           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
3267       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
3268                            
# Line 3356  c      common/dbg/DEBUG Line 3276  c      common/dbg/DEBUG
3276       $           ,ip_cp(id),ip       $           ,ip_cp(id),ip
3277              icx=clx(ip,icp)              icx=clx(ip,icp)
3278              icy=cly(ip,icp)              icy=cly(ip,icp)
3279    c            call xyz_PAM(icx,icy,is,
3280    c     $           PFA,PFA,
3281    c     $           AXV_STORE(nplanes-ip+1,ibest),
3282    c     $           AYV_STORE(nplanes-ip+1,ibest))
3283              call xyz_PAM(icx,icy,is,              call xyz_PAM(icx,icy,is,
 c     $           'ETA2','ETA2',  
3284       $           PFA,PFA,       $           PFA,PFA,
3285       $           AXV_STORE(nplanes-ip+1,ibest),       $           AXV_STORE(nplanes-ip+1,ibest),
3286       $           AYV_STORE(nplanes-ip+1,ibest))       $           AYV_STORE(nplanes-ip+1,ibest),
3287  c$$$  call xyz_PAM(icx,icy,is,       $           bxyz(1),
3288  c$$$  $              'COG2','COG2',       $           bxyz(2)
3289  c$$$  $              0.,       $           )
3290  c$$$  $              0.)  
3291              xm(nplanes-ip+1) = xPAM              xm(nplanes-ip+1) = xPAM
3292              ym(nplanes-ip+1) = yPAM              ym(nplanes-ip+1) = yPAM
3293              zm(nplanes-ip+1) = zPAM              zm(nplanes-ip+1) = zPAM
# Line 3373  c$$$  $              0.) Line 3296  c$$$  $              0.)
3296              resx(nplanes-ip+1) = resxPAM              resx(nplanes-ip+1) = resxPAM
3297              resy(nplanes-ip+1) = resyPAM              resy(nplanes-ip+1) = resyPAM
3298    
3299  c            dedxtrk(nplanes-ip+1) = (dedx(icx)+dedx(icy))/2. !(1)              dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3300              dedxtrk_x(nplanes-ip+1)=dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)              dedxtrk_y(nplanes-ip+1)=sgnl(icy)/mip(VIEW(icy),LADDER(icy))
             dedxtrk_y(nplanes-ip+1)=dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)  
3301                            
3302    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3303  *     -------------------------------------------------  *     -------------------------------------------------
3304  *     If the plane has NOT  been already included,  *     If the plane has NOT  been already included,
3305  *     it tries to include a COUPLE or a single cluster  *     it tries to include a COUPLE or a single cluster
3306  *     -------------------------------------------------  *     -------------------------------------------------
3307    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3308           else                             else                  
3309                                
3310              xgood(nplanes-ip+1)=0              xgood(nplanes-ip+1)=0
# Line 3388  c            dedxtrk(nplanes-ip+1) = (de Line 3312  c            dedxtrk(nplanes-ip+1) = (de
3312                                
3313  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3314  *     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)  
3315              call whichsensor(ip,xP,yP,nldt,ist)              call whichsensor(ip,xP,yP,nldt,ist)
3316  *     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
3317              if(nldt.eq.0.or.ist.eq.0)goto 133              if(nldt.eq.0.or.ist.eq.0)goto 133
3318    
3319                SENSOR_STORE(nplanes-ip+1,IBEST)=ist
3320                LADDER_STORE(nplanes-ip+1,IBEST)=nldt
3321  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3322    
3323              if(DEBUG)then              if(DEBUG.EQ.1)then
3324                 print*,                 print*,
3325       $              '------ Plane ',ip,' intersected on LADDER ',nldt       $              '------ Plane ',ip,' intersected on LADDER ',nldt
3326       $              ,' SENSOR ',ist       $              ,' SENSOR ',ist
# Line 3407  c            dedxtrk(nplanes-ip+1) = (de Line 3331  c            dedxtrk(nplanes-ip+1) = (de
3331  *     ===========================================  *     ===========================================
3332  *     STEP 1 >>>>>>>  try to include a new couple  *     STEP 1 >>>>>>>  try to include a new couple
3333  *     ===========================================  *     ===========================================
3334  c            if(DEBUG)print*,'>>>> try to include a new couple'  c            if(DEBUG.EQ.1)print*,'>>>> try to include a new couple'
3335              distmin=1000000.              distmin=1000000.
3336              xmm = 0.              xmm = 0.
3337              ymm = 0.              ymm = 0.
# Line 3430  c     $              cl_used(icy).eq.1.o Line 3354  c     $              cl_used(icy).eq.1.o
3354  *            *          
3355                 call xyz_PAM(icx,icy,ist,                 call xyz_PAM(icx,icy,ist,
3356       $              PFA,PFA,       $              PFA,PFA,
 c     $              'ETA2','ETA2',  
3357       $              AXV_STORE(nplanes-ip+1,ibest),       $              AXV_STORE(nplanes-ip+1,ibest),
3358       $              AYV_STORE(nplanes-ip+1,ibest))       $              AYV_STORE(nplanes-ip+1,ibest),
3359         $              bxyz(1),
3360         $              bxyz(2)
3361         $              )
3362                                
3363                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3364    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3365                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3366                 if(DEBUG)print*,'( couple ',id                 if(DEBUG.EQ.1)print*,'( couple ',id
3367       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance
3368                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3369                    xmm = xPAM                    xmm = xPAM
3370                    ymm = yPAM                    ymm = yPAM
# Line 3446  c     $              'ETA2','ETA2', Line 3373  c     $              'ETA2','ETA2',
3373                    rymm = resyPAM                    rymm = resyPAM
3374                    distmin = distance                    distmin = distance
3375                    idm = id                                      idm = id                  
3376  c                 dedxmm = (dedx(icx)+dedx(icy))/2. !(1)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3377                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3378                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)  c     QUIQUI --> non devo moltiplicare per clinc?!?!?!
3379                      clincnewc=10*sqrt(rymm**2+rxmm**2 !QUIQUI
3380         $                 +RCHI2_STORE(ibest)*k(ip)*(cov(1,1)+cov(2,2))) !QUIQUI
3381                 endif                 endif
3382   1188          continue   1188          continue
3383              enddo               !end loop on couples on plane icp              enddo               !end loop on couples on plane icp
3384              if(distmin.le.clinc)then                    c            if(distmin.le.clinc)then     !QUIQUI              
3385                if(distmin.le.clincnewc)then     !QUIQUI              
3386  *              -----------------------------------  *              -----------------------------------
3387                 xm(nplanes-ip+1) = xmm         !<<<                 xm(nplanes-ip+1) = xmm !<<<
3388                 ym(nplanes-ip+1) = ymm         !<<<                 ym(nplanes-ip+1) = ymm !<<<
3389                 zm(nplanes-ip+1) = zmm         !<<<                 zm(nplanes-ip+1) = zmm !<<<
3390                 xgood(nplanes-ip+1) = 1        !<<<                 xgood(nplanes-ip+1) = 1 !<<<
3391                 ygood(nplanes-ip+1) = 1        !<<<                 ygood(nplanes-ip+1) = 1 !<<<
3392                 resx(nplanes-ip+1)=rxmm        !<<<                 resx(nplanes-ip+1)=rxmm !<<<
3393                 resy(nplanes-ip+1)=rymm        !<<<                 resy(nplanes-ip+1)=rymm !<<<
3394  c              dedxtrk(nplanes-ip+1) = dedxmm !<<<  !(1)                 dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3395                 dedxtrk_x(nplanes-ip+1) = dedxmmx    !(1)                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
                dedxtrk_y(nplanes-ip+1) = dedxmmy    !(1)  
3396  *              -----------------------------------  *              -----------------------------------
3397                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
3398                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG.EQ.1)print*,'%%%% included couple ',idm
3399       $              ,' (norm.dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clinc,' )'
3400                 goto 133         !next plane                 goto 133         !next plane
3401              endif              endif
3402  *     ================================================  *     ================================================
3403  *     STEP 2 >>>>>>>  try to include a single cluster  *     STEP 2 >>>>>>>  try to include a single cluster
3404  *                     either from a couple or single  *                     either from a couple or single
3405  *     ================================================  *     ================================================
3406  c            if(DEBUG)print*,'>>>> try to include a new cluster'  c            if(DEBUG.EQ.1)print*,'>>>> try to include a new cluster'
3407              distmin=1000000.              distmin=1000000.
3408              xmm_A = 0.          !---------------------------              xmm_A = 0.          !---------------------------
3409              ymm_A = 0.          ! init variables that              ymm_A = 0.          ! init variables that
# Line 3500  c            if(DEBUG)print*,'>>>> try t Line 3429  c            if(DEBUG)print*,'>>>> try t
3429  c               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
3430                 if(cl_used(icx).ne.0)goto 11881 !if the X cluster is already used  !(3)                 if(cl_used(icx).ne.0)goto 11881 !if the X cluster is already used  !(3)
3431  *                                              !jump to the Y cluster  *                                              !jump to the Y cluster
3432    c               call xyz_PAM(icx,0,ist,
3433    c     $              PFA,PFA,
3434    c     $              AXV_STORE(nplanes-ip+1,ibest),0.)              
3435                 call xyz_PAM(icx,0,ist,                 call xyz_PAM(icx,0,ist,
 c     $              'ETA2','ETA2',  
3436       $              PFA,PFA,       $              PFA,PFA,
3437       $              AXV_STORE(nplanes-ip+1,ibest),0.)                     $              AXV_STORE(nplanes-ip+1,ibest),0.,
3438         $              bxyz(1),
3439         $              bxyz(2)
3440         $              )              
3441                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3442  c     if(DEBUG)print*,'normalized distance ',distance  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3443                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG.EQ.1)print*,'( cl-X ',icx
3444       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3445                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3446                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3447                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3519  c     if(DEBUG)print*,'normalized distan Line 3453  c     if(DEBUG)print*,'normalized distan
3453                    rymm = resyPAM                    rymm = resyPAM
3454                    distmin = distance                    distmin = distance
3455                    iclm = icx                    iclm = icx
3456  c                  dedxmm = dedx(icx) !(1)  c                  dedxmm = sgnl(icx) !(1)
3457                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3458                    dedxmmy = 0.        !(1)                    dedxmmy = 0.        !(1)
3459                 endif                                   endif                  
3460  11881          continue  11881          continue
# Line 3528  c                  dedxmm = dedx(icx) !( Line 3462  c                  dedxmm = dedx(icx) !(
3462  c               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
3463                 if(cl_used(icy).ne.0)goto 11882 !if the Y cluster is already used !(3)                 if(cl_used(icy).ne.0)goto 11882 !if the Y cluster is already used !(3)
3464  *                                              !jump to the next couple  *                                              !jump to the next couple
3465    c               call xyz_PAM(0,icy,ist,
3466    c     $              PFA,PFA,
3467    c     $              0.,AYV_STORE(nplanes-ip+1,ibest))
3468                 call xyz_PAM(0,icy,ist,                 call xyz_PAM(0,icy,ist,
 c     $              'ETA2','ETA2',  
3469       $              PFA,PFA,       $              PFA,PFA,
3470       $              0.,AYV_STORE(nplanes-ip+1,ibest))       $              0.,AYV_STORE(nplanes-ip+1,ibest),
3471         $              bxyz(1),
3472         $              bxyz(2)
3473         $              )
3474                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3475                 if(DEBUG)print*,'( cl-Y ',icy  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3476       $              ,' in cp ',id,' ) normalized distance ',distance                 if(DEBUG.EQ.1)print*,'( cl-Y ',icy
3477         $              ,' in cp ',id,' ) distance ',distance
3478                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3479                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3480                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3546  c     $              'ETA2','ETA2', Line 3486  c     $              'ETA2','ETA2',
3486                    rymm = resyPAM                    rymm = resyPAM
3487                    distmin = distance                    distmin = distance
3488                    iclm = icy                    iclm = icy
3489  c                 dedxmm = dedx(icy)  !(1)  c                 dedxmm = sgnl(icy)  !(1)
3490                    dedxmmx = 0.        !(1)                    dedxmmx = 0.        !(1)
3491                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3492                 endif                                   endif                  
3493  11882          continue  11882          continue
3494              enddo               !end loop on cluster inside couples              enddo               !end loop on cluster inside couples
3495  *----- single clusters -----------------------------------------------      *----- single clusters -----------------------------------------------  
3496    c            print*,'## ncls(',ip,') ',ncls(ip)
3497              do ic=1,ncls(ip)    !loop on single clusters              do ic=1,ncls(ip)    !loop on single clusters
3498                 icl=cls(ip,ic)                 icl=cls(ip,ic)
3499  c               if(cl_used(icl).eq.1.or.     !if the cluster is already used  c               if(cl_used(icl).eq.1.or.     !if the cluster is already used
# Line 3561  c               if(cl_used(icl).eq.1.or. Line 3502  c               if(cl_used(icl).eq.1.or.
3502       $              .false.)goto 18882      !jump to the next singlet       $              .false.)goto 18882      !jump to the next singlet
3503                 if(mod(VIEW(icl),2).eq.0)then!<---- X view                 if(mod(VIEW(icl),2).eq.0)then!<---- X view
3504                    call xyz_PAM(icl,0,ist,                    call xyz_PAM(icl,0,ist,
 c     $                 'ETA2','ETA2',  
3505       $                 PFA,PFA,       $                 PFA,PFA,
3506       $                 AXV_STORE(nplanes-ip+1,ibest),0.)       $                 AXV_STORE(nplanes-ip+1,ibest),0.,
3507         $                 bxyz(1),
3508         $                 bxyz(2)
3509         $                 )
3510                 else                         !<---- Y view                 else                         !<---- Y view
3511                    call xyz_PAM(0,icl,ist,                    call xyz_PAM(0,icl,ist,
 c     $                 'ETA2','ETA2',  
3512       $                 PFA,PFA,       $                 PFA,PFA,
3513       $                 0.,AYV_STORE(nplanes-ip+1,ibest))       $                 0.,AYV_STORE(nplanes-ip+1,ibest),
3514         $                 bxyz(1),
3515         $                 bxyz(2)
3516         $                 )
3517                 endif                 endif
3518    
3519                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3520                 if(DEBUG)print*,'( cl-s ',icl  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3521       $              ,' ) normalized distance ',distance                 if(DEBUG.EQ.1)print*,'( cl-s ',icl
3522         $              ,' ) distance ',distance
3523                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3524    c                  if(DEBUG.EQ.1)print*,'YES'
3525                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3526                    ymm_A = yPAM_A                    ymm_A = yPAM_A
3527                    zmm_A = zPAM_A                    zmm_A = zPAM_A
# Line 3585  c     $                 'ETA2','ETA2', Line 3532  c     $                 'ETA2','ETA2',
3532                    rymm = resyPAM                    rymm = resyPAM
3533                    distmin = distance                      distmin = distance  
3534                    iclm = icl                    iclm = icl
 c                  dedxmm = dedx(icl)                   !(1)  
3535                    if(mod(VIEW(icl),2).eq.0)then !<---- X view                    if(mod(VIEW(icl),2).eq.0)then !<---- X view
3536                       dedxmmx = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3537                       dedxmmy = 0.                       !(1)                       dedxmmy = 0.                  
3538                    else          !<---- Y view                    else          !<---- Y view
3539                       dedxmmx = 0.                       !(1)                       dedxmmx = 0.                  
3540                       dedxmmy = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3541                    endif                    endif
3542                 endif                                   endif                  
3543  18882          continue  18882          continue
3544              enddo               !end loop on single clusters              enddo               !end loop on single clusters
3545    c            print*,'## distmin ', distmin,' clinc ',clinc
3546    
3547              if(distmin.le.clinc)then                    c     QUIQUI------------
3548                  c     anche qui: non ci vuole clinc???
3549                 CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<                  if(iclm.ne.0)then
 *              ----------------------------  
3550                 if(mod(VIEW(iclm),2).eq.0)then                 if(mod(VIEW(iclm),2).eq.0)then
3551                    XGOOD(nplanes-ip+1)=1.                    clincnew=
3552                    resx(nplanes-ip+1)=rxmm       $                 20*
3553                    if(DEBUG)print*,'%%%% included X-cl ',iclm       $                 sqrt(rxmm**2+RCHI2_STORE(ibest)*k(ip)*cov(1,1))
3554       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'                 else if(mod(VIEW(iclm),2).ne.0)then
3555                 else                    clincnew=
3556                    YGOOD(nplanes-ip+1)=1.       $                 10*
3557                    resy(nplanes-ip+1)=rymm       $                 sqrt(rymm**2+RCHI2_STORE(ibest)*k(ip)*cov(2,2))
3558                    if(DEBUG)print*,'%%%% included Y-cl ',iclm                 endif
3559       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'  c     QUIQUI------------
3560                  
3561                   if(distmin.le.clincnew)then   !QUIQUI
3562    c     if(distmin.le.clinc)then          !QUIQUI          
3563                      
3564                      CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<    
3565    *     ----------------------------
3566    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3567                      if(mod(VIEW(iclm),2).eq.0)then
3568                         XGOOD(nplanes-ip+1)=1.
3569                         resx(nplanes-ip+1)=rxmm
3570                         if(DEBUG.EQ.1)print*,'%%%% included X-cl ',iclm
3571         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3572         $                    ,', dist.= ',distmin
3573         $                    ,', cut ',clinc,' )'
3574                      else
3575                         YGOOD(nplanes-ip+1)=1.
3576                         resy(nplanes-ip+1)=rymm
3577                         if(DEBUG.EQ.1)print*,'%%%% included Y-cl ',iclm
3578         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3579         $                    ,', dist.= ', distmin
3580         $                    ,', cut ',clinc,' )'
3581                      endif
3582    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3583    *     ----------------------------
3584                      xm_A(nplanes-ip+1) = xmm_A
3585                      ym_A(nplanes-ip+1) = ymm_A
3586                      xm_B(nplanes-ip+1) = xmm_B
3587                      ym_B(nplanes-ip+1) = ymm_B
3588                      zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3589                      dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3590                      dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3591    *     ----------------------------
3592                 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)  
 *              ----------------------------  
3593              endif              endif
3594           endif           endif
3595   133     continue   133     continue
# Line 3640  c              dedxtrk(nplanes-ip+1) = d Line 3608  c              dedxtrk(nplanes-ip+1) = d
3608  *                                                 *  *                                                 *
3609  *                                                 *  *                                                 *
3610  **************************************************  **************************************************
 cccccc 12/08/2006 modified by elena ---> (1)  
3611  *  *
3612        subroutine clean_XYclouds(ibest,iflag)        subroutine clean_XYclouds(ibest,iflag)
3613    
3614        include 'commontracker.f'        include 'commontracker.f'
3615          include 'level1.f'
3616        include 'common_momanhough.f'        include 'common_momanhough.f'
3617        include 'momanhough_init.f'        include 'level2.f'      
       include 'level2.f'        !(1)  
 c      include 'calib.f'  
 c      include 'level1.f'  
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
3618    
3619          if(DEBUG.EQ.1)print*,'clean_XYclouds:'
3620    
3621        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3622    
# Line 3663  c      common/dbg/DEBUG Line 3626  c      common/dbg/DEBUG
3626              if(id.ne.0)then              if(id.ne.0)then
3627                 iclx=clx(ip,icp_cp(id))                 iclx=clx(ip,icp_cp(id))
3628                 icly=cly(ip,icp_cp(id))                 icly=cly(ip,icp_cp(id))
3629  c               cl_used(iclx)=1  !tag used clusters  c$$$               cl_used(iclx)=ntrk  !tag used clusters
3630  c               cl_used(icly)=1  !tag used clusters  c$$$               cl_used(icly)=ntrk  !tag used clusters
                cl_used(iclx)=ntrk  !tag used clusters !(1)  
                cl_used(icly)=ntrk  !tag used clusters !(1)  
3631              elseif(icl.ne.0)then              elseif(icl.ne.0)then
3632  c               cl_used(icl)=1   !tag used clusters  c$$$               cl_used(icl)=ntrk   !tag used clusters
                cl_used(icl)=ntrk   !tag used clusters !1)  
3633              endif              endif
3634                            
 c               if(DEBUG)then  
 c                  print*,ip,' <<< ',id  
 c               endif  
3635  *     -----------------------------  *     -----------------------------
3636  *     remove the couple from clouds  *     remove the couple from clouds
3637  *     remove also vitual couples containing the  *     remove also vitual couples containing the
# Line 3691  c               endif Line 3648  c               endif
3648       $              cly(ip,icp).eq.icl       $              cly(ip,icp).eq.icl
3649       $              )then       $              )then
3650                    id=id_cp(ip,icp,1)                    id=id_cp(ip,icp,1)
3651                    if(DEBUG)then                    if(DEBUG.EQ.1)then
3652                       print*,ip,' <<< cp ',id                       print*,ip,' <<< cp ',id
3653       $                    ,' ( cl-x '       $                    ,' ( cl-x '
3654       $                    ,clx(ip,icp)       $                    ,clx(ip,icp)
# Line 3725  c               endif Line 3682  c               endif
3682    
3683    
3684    
 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$$$  
   
3685    
3686    
3687  *     ****************************************************  *     ****************************************************
3688    
3689        subroutine init_level2        subroutine init_level2
3690    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c*****************************************************  
   
3691        include 'commontracker.f'        include 'commontracker.f'
3692          include 'level1.f'
3693        include 'common_momanhough.f'        include 'common_momanhough.f'
3694        include 'level2.f'        include 'level2.f'
       include 'level1.f'  
3695    
3696    *     ---------------------------------
3697    *     variables initialized from level1
3698    *     ---------------------------------
3699        do i=1,nviews        do i=1,nviews
3700           good2(i)=good1(i)           good2(i)=good1(i)
3701             do j=1,nva1_view
3702                vkflag(i,j)=1
3703                if(cnnev(i,j).le.0)then
3704                   vkflag(i,j)=cnnev(i,j)
3705                endif
3706             enddo
3707        enddo        enddo
3708    *     ----------------
3709  c      good2 = 0!.false.  *     level2 variables
3710  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*****************************************************  
   
3711        NTRK = 0        NTRK = 0
3712        do it=1,NTRKMAX!NTRACKSMAX        do it=1,NTRKMAX
3713           IMAGE(IT)=0           IMAGE(IT)=0
3714           CHI2_nt(IT) = -100000.           CHI2_nt(IT) = -100000.
 c         BdL(IT) = 0.  
3715           do ip=1,nplanes           do ip=1,nplanes
3716              XM_nt(IP,IT) = 0              XM_nt(IP,IT) = 0
3717              YM_nt(IP,IT) = 0              YM_nt(IP,IT) = 0
3718              ZM_nt(IP,IT) = 0              ZM_nt(IP,IT) = 0
3719              RESX_nt(IP,IT) = 0              RESX_nt(IP,IT) = 0
3720              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3721                TAILX_nt(IP,IT) = 0
3722                TAILY_nt(IP,IT) = 0
3723                XBAD(IP,IT) = 0
3724                YBAD(IP,IT) = 0
3725              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3726              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
3727  c*****************************************************              LS(IP,IT) = 0
 cccccc 11/9/2005 modified by david fedele  
3728              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3729              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
 c******************************************************  
 cccccc 17/8/2006 modified by elena  
3730              CLTRX(IP,IT) = 0              CLTRX(IP,IT) = 0
3731              CLTRY(IP,IT) = 0              CLTRY(IP,IT) = 0
3732           enddo           enddo
# Line 3893  cccccc 17/8/2006 modified by elena Line 3737  cccccc 17/8/2006 modified by elena
3737              enddo                                enddo                  
3738           enddo                             enddo                  
3739        enddo        enddo
         
         
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3740        nclsx=0        nclsx=0
3741        nclsy=0              nclsy=0      
3742        do ip=1,NSINGMAX        do ip=1,NSINGMAX
3743          planex(ip)=0          planex(ip)=0
 c        xs(ip)=0  
3744          xs(1,ip)=0          xs(1,ip)=0
3745          xs(2,ip)=0          xs(2,ip)=0
3746          sgnlxs(ip)=0          sgnlxs(ip)=0
3747          planey(ip)=0          planey(ip)=0
 c        ys(ip)=0  
3748          ys(1,ip)=0          ys(1,ip)=0
3749          ys(2,ip)=0          ys(2,ip)=0
3750          sgnlys(ip)=0          sgnlys(ip)=0
3751        enddo        enddo
 c*******************************************************  
3752        end        end
3753    
3754    
# Line 3926  c*************************************** Line 3763  c***************************************
3763  ************************************************************  ************************************************************
3764    
3765    
3766          subroutine init_hough
3767    
3768          include 'commontracker.f'
3769          include 'level1.f'
3770          include 'common_momanhough.f'
3771          include 'common_hough.f'
3772          include 'level2.f'
3773    
3774          ntrpt_nt=0
3775          ndblt_nt=0
3776          NCLOUDS_XZ_nt=0
3777          NCLOUDS_YZ_nt=0
3778          do idb=1,ndblt_max_nt
3779             db_cloud_nt(idb)=0
3780             alfayz1_nt(idb)=0      
3781             alfayz2_nt(idb)=0      
3782          enddo
3783          do itr=1,ntrpt_max_nt
3784             tr_cloud_nt(itr)=0
3785             alfaxz1_nt(itr)=0      
3786             alfaxz2_nt(itr)=0      
3787             alfaxz3_nt(itr)=0      
3788          enddo
3789          do idb=1,ncloyz_max      
3790            ptcloud_yz_nt(idb)=0    
3791            alfayz1_av_nt(idb)=0    
3792            alfayz2_av_nt(idb)=0    
3793          enddo                    
3794          do itr=1,ncloxz_max      
3795            ptcloud_xz_nt(itr)=0    
3796            alfaxz1_av_nt(itr)=0    
3797            alfaxz2_av_nt(itr)=0    
3798            alfaxz3_av_nt(itr)=0    
3799          enddo                    
3800    
3801          ntrpt=0                  
3802          ndblt=0                  
3803          NCLOUDS_XZ=0              
3804          NCLOUDS_YZ=0              
3805          do idb=1,ndblt_max        
3806            db_cloud(idb)=0        
3807            cpyz1(idb)=0            
3808            cpyz2(idb)=0            
3809            alfayz1(idb)=0          
3810            alfayz2(idb)=0          
3811          enddo                    
3812          do itr=1,ntrpt_max        
3813            tr_cloud(itr)=0        
3814            cpxz1(itr)=0            
3815            cpxz2(itr)=0            
3816            cpxz3(itr)=0            
3817            alfaxz1(itr)=0          
3818            alfaxz2(itr)=0          
3819            alfaxz3(itr)=0          
3820          enddo                    
3821          do idb=1,ncloyz_max      
3822            ptcloud_yz(idb)=0      
3823            alfayz1_av(idb)=0      
3824            alfayz2_av(idb)=0      
3825            do idbb=1,ncouplemaxtot
3826              cpcloud_yz(idb,idbb)=0
3827            enddo                  
3828          enddo                    
3829          do itr=1,ncloxz_max      
3830            ptcloud_xz(itr)=0      
3831            alfaxz1_av(itr)=0      
3832            alfaxz2_av(itr)=0      
3833            alfaxz3_av(itr)=0      
3834            do itrr=1,ncouplemaxtot
3835              cpcloud_xz(itr,itrr)=0
3836            enddo                  
3837          enddo                    
3838          end
3839    ************************************************************
3840    *
3841    *
3842    *
3843    *
3844    *
3845    *
3846    *
3847    ************************************************************
3848    
3849    
3850        subroutine fill_level2_tracks(ntr)        subroutine fill_level2_tracks(ntr)
3851    
3852  *     -------------------------------------------------------  *     -------------------------------------------------------
# Line 3937  c*************************************** Line 3858  c***************************************
3858            
3859        include 'commontracker.f'        include 'commontracker.f'
3860        include 'level1.f'        include 'level1.f'
3861          include 'common_momanhough.f'
3862        include 'level2.f'        include 'level2.f'
3863        include 'common_mini_2.f'        include 'common_mini_2.f'
3864        include 'common_momanhough.f'        include 'calib.f'
3865        real sinth,phi,pig        !(4)  
3866          character*10 PFA
3867          common/FINALPFA/PFA
3868    
3869          real sinth,phi,pig
3870          integer ssensor,sladder
3871        pig=acos(-1.)        pig=acos(-1.)
3872    
3873  c      good2=1!.true.  *     -------------------------------------
3874        chi2_nt(ntr)        = sngl(chi2)        chi2_nt(ntr)        = sngl(chi2)
3875        nstep_nt(ntr)       = 0!nstep        nstep_nt(ntr)       = nstep
3876    *     -------------------------------------
3877        phi   = al(4)             !(4)        phi   = al(4)          
3878        sinth = al(3)             !(4)        sinth = al(3)            
3879        if(sinth.lt.0)then        !(4)        if(sinth.lt.0)then      
3880           sinth = -sinth         !(4)           sinth = -sinth        
3881           phi = phi + pig        !(4)           phi = phi + pig      
3882        endif                     !(4)        endif                    
3883        npig = aint(phi/(2*pig))  !(4)        npig = aint(phi/(2*pig))
3884        phi = phi - npig*2*pig    !(4)        phi = phi - npig*2*pig  
3885        if(phi.lt.0)              !(4)        if(phi.lt.0)            
3886       $     phi = phi + 2*pig    !(4)       $     phi = phi + 2*pig  
3887        al(4) = phi               !(4)        al(4) = phi              
3888        al(3) = sinth             !(4)        al(3) = sinth            
 *****************************************************  
3889        do i=1,5        do i=1,5
3890           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3891           do j=1,5           do j=1,5
3892              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3893           enddo           enddo
 c     print*,al_nt(i,ntr)  
3894        enddo        enddo
3895          *     -------------------------------------      
3896        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
3897           xgood_nt(ip,ntr) = int(xgood(ip))           xgood_nt(ip,ntr) = int(xgood(ip))
3898           ygood_nt(ip,ntr) = int(ygood(ip))           ygood_nt(ip,ntr) = int(ygood(ip))
# Line 3976  c     print*,al_nt(i,ntr) Line 3901  c     print*,al_nt(i,ntr)
3901           zm_nt(ip,ntr)    = sngl(zm(ip))           zm_nt(ip,ntr)    = sngl(zm(ip))
3902           RESX_nt(IP,ntr)  = sngl(resx(ip))           RESX_nt(IP,ntr)  = sngl(resx(ip))
3903           RESY_nt(IP,ntr)  = sngl(resy(ip))           RESY_nt(IP,ntr)  = sngl(resy(ip))
3904             TAILX_nt(IP,ntr) = 0.
3905             TAILY_nt(IP,ntr) = 0.
3906           xv_nt(ip,ntr)    = sngl(xv(ip))           xv_nt(ip,ntr)    = sngl(xv(ip))
3907           yv_nt(ip,ntr)    = sngl(yv(ip))           yv_nt(ip,ntr)    = sngl(yv(ip))
3908           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3909           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3910           ayv_nt(ip,ntr)   = sngl(ayv(ip))           ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3911  c        dedxp(ip,ntr)    = sngl(dedxtrk(ip))   !(1)  
3912           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)           factor = sqrt(
3913           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)         $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3914         $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3915         $        1. )
3916    
3917             dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3918             dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3919        
3920           id  = CP_STORE(ip,IDCAND)           ax   = axv_nt(ip,ntr)
3921             ay   = ayv_nt(ip,ntr)
3922             bfx  = BX_STORE(ip,IDCAND)
3923             bfy  = BY_STORE(ip,IDCAND)
3924             if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3925             if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3926             tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3927             angx     = 180.*atan(tgtemp)/acos(-1.)
3928             tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3929             angy    = 180.*atan(tgtemp)/acos(-1.)
3930            
3931    c         print*,'* ',ip,bfx,bfy,angx,angy
3932    
3933             id  = CP_STORE(ip,IDCAND) ! couple id
3934           icl = CLS_STORE(ip,IDCAND)           icl = CLS_STORE(ip,IDCAND)
3935             ssensor = -1
3936             sladder = -1
3937             ssensor = SENSOR_STORE(ip,IDCAND)
3938             sladder = LADDER_STORE(ip,IDCAND)
3939             if(ip.eq.6.and.ssensor.ne.0)ssensor = 3 - ssensor !notazione paolo x align
3940             LS(IP,ntr)      = ssensor+10*sladder
3941    
3942           if(id.ne.0)then           if(id.ne.0)then
3943    c           >>> is a couple
3944              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3945              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3946  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  
3947                cl_used(cltrx(ip,ntr)) = 1     !tag used clusters          
3948                cl_used(cltry(ip,ntr)) = 1     !tag used clusters          
3949    
3950    c$$$            nnnnx = npfastrips(clx(nplanes-ip+1,icp_cp(id)),PFA,angx)
3951    c$$$            nnnny = npfastrips(cly(nplanes-ip+1,icp_cp(id)),PFA,angy)            
3952    c$$$            xbad(ip,ntr)= nbadstrips(nnnnx,clx(nplanes-ip+1,icp_cp(id)))
3953    c$$$            ybad(ip,ntr)= nbadstrips(nnnny,cly(nplanes-ip+1,icp_cp(id)))
3954                xbad(ip,ntr)= nbadstrips(4,clx(nplanes-ip+1,icp_cp(id)))
3955                ybad(ip,ntr)= nbadstrips(4,cly(nplanes-ip+1,icp_cp(id)))
3956    
3957    
3958                if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3959         $           dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3960                if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3961         $           dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3962    
3963           elseif(icl.ne.0)then           elseif(icl.ne.0)then
3964              if(mod(VIEW(icl),2).eq.0)cltrx(ip,ntr)=icl  
3965              if(mod(VIEW(icl),2).eq.1)cltry(ip,ntr)=icl              cl_used(icl) = 1    !tag used clusters          
3966  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  
3967                if(mod(VIEW(icl),2).eq.0)then
3968                   cltrx(ip,ntr)=icl
3969    c$$$               nnnnn = npfastrips(icl,PFA,angx)
3970    c$$$               xbad(ip,ntr) = nbadstrips(nnnnn,icl)
3971                   xbad(ip,ntr) = nbadstrips(4,icl)
3972    
3973                   if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3974                elseif(mod(VIEW(icl),2).eq.1)then
3975                   cltry(ip,ntr)=icl
3976    c$$$               nnnnn = npfastrips(icl,PFA,angy)
3977    c$$$               ybad(ip,ntr) = nbadstrips(nnnnn,icl)
3978                   ybad(ip,ntr) = nbadstrips(4,icl)
3979                   if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3980                endif
3981    
3982           endif                     endif          
3983    
3984        enddo        enddo
 c      call CalcBdL(100,xxxx,IFAIL)  
 c      if(ifps(xxxx).eq.1)BdL(ntr) = xxxx  
 c$$$      print*,'xgood(ip,ntr) ',(xgood_nt(ip,ntr),ip=1,6)  
 c$$$      print*,'ygood(ip,ntr) ',(ygood_nt(ip,ntr),ip=1,6)  
 c$$$      print*,'dedx_x(ip,ntr) ',(dedx_x(ip,ntr),ip=1,6)  
 c$$$      print*,'dedx_y(ip,ntr) ',(dedx_y(ip,ntr),ip=1,6)  
3985    
3986          if(DEBUG.eq.1)then
3987             print*,'> STORING TRACK ',ntr
3988             print*,'clusters: '
3989             do ip=1,6
3990                print*,'> ',ip,' -- ',cltrx(ip,ntr),cltry(ip,ntr)
3991             enddo
3992          endif
3993    
3994    c$$$      print*,(xgood(i),i=1,6)
3995    c$$$      print*,(ygood(i),i=1,6)
3996    c$$$      print*,(ls(i,ntr),i=1,6)
3997    c$$$      print*,(dedx_x(i,ntr),i=1,6)
3998    c$$$      print*,(dedx_y(i,ntr),i=1,6)
3999    c$$$      print*,'-----------------------'
4000    
4001        end        end
4002    
4003        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*****************************************************  
4004    
4005  *     -------------------------------------------------------  *     -------------------------------------------------------
4006  *     This routine fills the  elements of the variables  *     This routine fills the  elements of the variables
# Line 4022  c*************************************** Line 4009  c***************************************
4009  *     -------------------------------------------------------  *     -------------------------------------------------------
4010    
4011        include 'commontracker.f'        include 'commontracker.f'
       include 'level1.f'  
       include 'level2.f'  
4012        include 'calib.f'        include 'calib.f'
4013          include 'level1.f'
4014        include 'common_momanhough.f'        include 'common_momanhough.f'
4015          include 'level2.f'
4016        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
4017    
4018  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
 c      good2=1!.true.  
4019        nclsx = 0        nclsx = 0
4020        nclsy = 0        nclsy = 0
4021    
4022          do iv = 1,nviews
4023    c         if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
4024             good2(iv) = good2(iv) + mask_view(iv)*2**8
4025          enddo
4026    
4027          if(DEBUG.eq.1)then
4028             print*,'> STORING SINGLETS '
4029          endif
4030    
4031        do icl=1,nclstr1        do icl=1,nclstr1
4032    
4033             ip=nplanes-npl(VIEW(icl))+1            
4034            
4035           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
             ip=nplanes-npl(VIEW(icl))+1              
4036              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
4037                 nclsx = nclsx + 1                 nclsx = nclsx + 1
4038                 planex(nclsx) = ip                 planex(nclsx) = ip
4039                 sgnlxs(nclsx) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
4040                   if(nsatstrips(icl).gt.0)sgnlxs(nclsx)=-sgnlxs(nclsx)
4041                 clsx(nclsx)   = icl                 clsx(nclsx)   = icl
4042                 do is=1,2                 do is=1,2
4043  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
4044                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
4045                      call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
4046                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2
4047                 enddo                 enddo
4048  c$$$               print*,'nclsx         ',nclsx  c$$$               print*,'nclsx         ',nclsx
# Line 4054  c$$$               print*,'xs(2,nclsx)   Line 4053  c$$$               print*,'xs(2,nclsx)  
4053              else                          !=== Y views              else                          !=== Y views
4054                 nclsy = nclsy + 1                 nclsy = nclsy + 1
4055                 planey(nclsy) = ip                 planey(nclsy) = ip
4056                 sgnlys(nclsy) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
4057                   if(nsatstrips(icl).gt.0)sgnlys(nclsy)=-sgnlys(nclsy)
4058                 clsy(nclsy)   = icl                 clsy(nclsy)   = icl
4059                 do is=1,2                 do is=1,2
4060  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
4061                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
4062                      call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
4063                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2
4064                 enddo                 enddo
4065  c$$$               print*,'nclsy         ',nclsy  c$$$               print*,'nclsy         ',nclsy
# Line 4068  c$$$               print*,'ys(1,nclsy)   Line 4069  c$$$               print*,'ys(1,nclsy)  
4069  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)
4070              endif              endif
4071           endif           endif
 c      print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)  
4072    
4073  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
4074           whichtrack(icl) = cl_used(icl)           whichtrack(icl) = cl_used(icl)
4075    *     --------------------------------------------------
4076    *     per non perdere la testa...
4077    *     whichtrack(icl) e` una variabile del common level1
4078    *     che serve solo per sapere quali cluster sono stati
4079    *     associati ad una traccia, e permettere di salvare
4080    *     solo questi nell'albero di uscita
4081    *     --------------------------------------------------
4082            
4083    
4084    c$$$         print*,' cl ',icl,' --> ',cl_used(icl)
4085    c$$$
4086    c$$$         if( cl_used(icl).ne.0 )then
4087    c$$$            if(
4088    c$$$     $           mod(VIEW(icl),2).eq.0.and.
4089    c$$$     $           cltrx(ip,whichtrack(icl)).ne.icl )
4090    c$$$     $           print*,'**WARNING** cltrx(',ip,',',whichtrack(icl)
4091    c$$$     $           ,')=',cltrx(ip,whichtrack(icl)),'.ne.',icl
4092    c$$$            if(
4093    c$$$     $           mod(VIEW(icl),2).eq.1.and.
4094    c$$$     $           cltry(ip,whichtrack(icl)).ne.icl )
4095    c$$$     $           print*,'**WARNING** cltry(',ip,',',whichtrack(icl)
4096    c$$$     $           ,')=',cltry(ip,whichtrack(icl)),'.ne.',icl
4097    c$$$         endif
4098            
4099    
4100        enddo        enddo
4101        end        end
4102    
4103    ***************************************************
4104    *                                                 *
4105    *                                                 *
4106    *                                                 *
4107    *                                                 *
4108    *                                                 *
4109    *                                                 *
4110    **************************************************
4111    
4112          subroutine fill_hough
4113    
4114    *     -------------------------------------------------------
4115    *     This routine fills the  variables related to the hough
4116    *     transform, for the debig n-tuple
4117    *     -------------------------------------------------------
4118    
4119          include 'commontracker.f'
4120          include 'level1.f'
4121          include 'common_momanhough.f'
4122          include 'common_hough.f'
4123          include 'level2.f'
4124    
4125          if(.false.
4126         $     .or.ntrpt.gt.ntrpt_max_nt
4127         $     .or.ndblt.gt.ndblt_max_nt
4128         $     .or.NCLOUDS_XZ.gt.ncloxz_max
4129         $     .or.NCLOUDS_yZ.gt.ncloyz_max
4130         $     )then
4131             ntrpt_nt=0
4132             ndblt_nt=0
4133             NCLOUDS_XZ_nt=0
4134             NCLOUDS_YZ_nt=0
4135          else
4136             ndblt_nt=ndblt
4137             ntrpt_nt=ntrpt
4138             if(ndblt.ne.0)then
4139                do id=1,ndblt
4140                   alfayz1_nt(id)=alfayz1(id) !Y0
4141                   alfayz2_nt(id)=alfayz2(id) !tg theta-yz
4142                enddo
4143             endif
4144             if(ndblt.ne.0)then
4145                do it=1,ntrpt
4146                   alfaxz1_nt(it)=alfaxz1(it) !X0
4147                   alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
4148                   alfaxz3_nt(it)=alfaxz3(it) !1/r
4149                enddo
4150             endif
4151             nclouds_yz_nt=nclouds_yz
4152             nclouds_xz_nt=nclouds_xz
4153             if(nclouds_yz.ne.0)then
4154                nnn=0
4155                do iyz=1,nclouds_yz
4156                   ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
4157                   alfayz1_av_nt(iyz)=alfayz1_av(iyz)
4158                   alfayz2_av_nt(iyz)=alfayz2_av(iyz)
4159                   nnn=nnn+ptcloud_yz(iyz)
4160                enddo
4161                do ipt=1,nnn
4162                   db_cloud_nt(ipt)=db_cloud(ipt)
4163                 enddo
4164             endif
4165             if(nclouds_xz.ne.0)then
4166                nnn=0
4167                do ixz=1,nclouds_xz
4168                   ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
4169                   alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
4170                   alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
4171                   alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
4172                   nnn=nnn+ptcloud_xz(ixz)              
4173                enddo
4174                do ipt=1,nnn
4175                  tr_cloud_nt(ipt)=tr_cloud(ipt)
4176                 enddo
4177             endif
4178          endif
4179          end
4180          

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.29

  ViewVC Help
Powered by ViewVC 1.1.23