/[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.5 by pam-fi, Fri Sep 29 08:13:04 2006 UTC revision 1.28 by pam-fi, Mon Aug 20 16:07:16 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(verbose)              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=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=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          if(icx.gt.nclstr1.or.icy.gt.nclstr1)then
1257                print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1258         $           ,' does not exists (nclstr1=',nclstr1,')'
1259                icx = -1*icx
1260                icy = -1*icy
1261                return
1262            
1263          endif
1264          
1265          call idtoc(pfaid,PFAx)
1266          call idtoc(pfaid,PFAy)
1267    
1268    c$$$      call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1269    
1270    c$$$      print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy
1271          
1272          if(icx.ne.0.and.icy.ne.0)then
1273    
1274             ipx=npl(VIEW(icx))
1275             ipy=npl(VIEW(icy))
1276    c$$$         if( (nplanes-ipx+1).ne.ip.or.(nplanes-ipy+1).ne.ip )
1277    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1278    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1279            
1280             if( (nplanes-ipx+1).ne.ip )then
1281                print*,'xyzpam: ***WARNING*** cluster ',icx
1282         $           ,' does not belong to plane: ',ip
1283                icx = -1*icx
1284                return
1285             endif
1286             if( (nplanes-ipy+1).ne.ip )then
1287                print*,'xyzpam: ***WARNING*** cluster ',icy
1288         $           ,' does not belong to plane: ',ip
1289                icy = -1*icy
1290                return
1291             endif
1292    
1293             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1294    
1295             xgood(ip) = 1.
1296             ygood(ip) = 1.
1297             resx(ip)  = resxPAM
1298             resy(ip)  = resyPAM
1299    
1300             xm(ip) = xPAM
1301             ym(ip) = yPAM
1302             zm(ip) = zPAM
1303             xm_A(ip) = 0.
1304             ym_A(ip) = 0.
1305             xm_B(ip) = 0.
1306             ym_B(ip) = 0.
1307    
1308    c         zv(ip) = zPAM
1309    
1310          elseif(icx.eq.0.and.icy.ne.0)then
1311    
1312             ipy=npl(VIEW(icy))
1313    c$$$         if((nplanes-ipy+1).ne.ip)
1314    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1315    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1316             if( (nplanes-ipy+1).ne.ip )then
1317                print*,'xyzpam: ***WARNING*** cluster ',icy
1318         $           ,' does not belong to plane: ',ip
1319                icy = -1*icy
1320                return
1321             endif
1322    
1323             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1324            
1325             xgood(ip) = 0.
1326             ygood(ip) = 1.
1327             resx(ip)  = 1000.
1328             resy(ip)  = resyPAM
1329    
1330             xm(ip) = -100.
1331             ym(ip) = -100.
1332             zm(ip) = (zPAM_A+zPAM_B)/2.
1333             xm_A(ip) = xPAM_A
1334             ym_A(ip) = yPAM_A
1335             xm_B(ip) = xPAM_B
1336             ym_B(ip) = yPAM_B
1337    
1338    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1339            
1340          elseif(icx.ne.0.and.icy.eq.0)then
1341    
1342             ipx=npl(VIEW(icx))
1343    c$$$         if((nplanes-ipx+1).ne.ip)
1344    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1345    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1346    
1347             if( (nplanes-ipx+1).ne.ip )then
1348                print*,'xyzpam: ***WARNING*** cluster ',icx
1349         $           ,' does not belong to plane: ',ip
1350                icx = -1*icx
1351                return
1352             endif
1353    
1354             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1355          
1356             xgood(ip) = 1.
1357             ygood(ip) = 0.
1358             resx(ip)  = resxPAM
1359             resy(ip)  = 1000.
1360    
1361             xm(ip) = -100.
1362             ym(ip) = -100.
1363             zm(ip) = (zPAM_A+zPAM_B)/2.
1364             xm_A(ip) = xPAM_A
1365             ym_A(ip) = yPAM_A
1366             xm_B(ip) = xPAM_B
1367             ym_B(ip) = yPAM_B
1368            
1369    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1370    
1371          else
1372    
1373             il = 2
1374             if(lad.ne.0)il=lad
1375             is = 1
1376             if(sensor.ne.0)is=sensor
1377    c         print*,nplanes-ip+1,il,is
1378    
1379             xgood(ip) = 0.
1380             ygood(ip) = 0.
1381             resx(ip)  = 1000.
1382             resy(ip)  = 1000.
1383    
1384             xm(ip) = -100.
1385             ym(ip) = -100.          
1386             zm(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1387             xm_A(ip) = 0.
1388             ym_A(ip) = 0.
1389             xm_B(ip) = 0.
1390             ym_B(ip) = 0.
1391    
1392    c         zv(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1393    
1394          endif
1395    
1396          if(DEBUG.EQ.1)then
1397    c         print*,'----------------------------- track coord'
1398    22222    format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
1399             write(*,22222)ip,zm(ip),xm(ip),ym(ip)
1400         $        ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip)
1401         $        ,xgood(ip),ygood(ip),resx(ip),resy(ip)
1402    c$$$         print*,'-----------------------------'
1403          endif
1404          end
1405    
1406  ********************************************************************************  ********************************************************************************
1407  ********************************************************************************  ********************************************************************************
# Line 1046  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1477  c         print*,'A-(',xPAM_A,yPAM_A,')
1477           endif                   endif        
1478    
1479           distance=           distance=
1480       $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2       $       ((xmi-XPP)**2+(ymi-YPP)**2)!QUIQUI
1481    cc     $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1482           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1483    
1484  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 1503  c$$$         print*,' resolution ',re
1503  *     ----------------------  *     ----------------------
1504                    
1505           distance=           distance=
1506       $        ((xPAM-XPP)/resxPAM)**2       $       ((xPAM-XPP))**2 !QUIQUI
1507       $        +       $       +
1508       $        ((yPAM-YPP)/resyPAM)**2       $       ((yPAM-YPP))**2
1509    c$$$     $        ((xPAM-XPP)/resxPAM)**2
1510    c$$$     $        +
1511    c$$$     $        ((yPAM-YPP)/resyPAM)**2
1512           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1513    
1514  c$$$         print*,xPAM,yPAM,zPAM  c$$$         print*,xPAM,yPAM,zPAM
# Line 1082  c$$$         print*,' resolution ',resxP Line 1517  c$$$         print*,' resolution ',resxP
1517                    
1518        else        else
1519                    
1520           print*  c         print*
1521       $        ,' function distance_to ---> wrong usage!!!'  c     $        ,' function distance_to ---> wrong usage!!!'
1522           print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM  c         print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM
1523           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 '
1524       $        ,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
1525        endif          endif  
1526    
1527        distance_to = sngl(distance)        distance_to = sngl(distance)
# Line 1154  c--------------------------------------- Line 1589  c---------------------------------------
1589                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1590       $              .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...
1591  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...
1592                    print*,'whichsensor: ',  c                  print*,'whichsensor: ',
1593       $                ' WARNING: false X strip: strip ',stripx  c     $                ' WARNING: false X strip: strip ',stripx
1594                 endif                 endif
1595                 xi = acoordsi(stripx,viewx)                 xi = acoordsi(stripx,viewx)
1596                 yi = acoordsi(stripy,viewy)                 yi = acoordsi(stripy,viewy)
# Line 1284  c     $              ,iv,xvv(iv),yvv(iv) Line 1719  c     $              ,iv,xvv(iv),yvv(iv)
1719  *     it returns the plane number  *     it returns the plane number
1720  *      *    
1721        include 'commontracker.f'        include 'commontracker.f'
1722          include 'level1.f'
1723  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1724        include 'common_momanhough.f'        include 'common_momanhough.f'
1725                
# Line 1309  c      include 'common_analysis.f' Line 1745  c      include 'common_analysis.f'
1745        is_cp=0        is_cp=0
1746        if(id.lt.0)is_cp=1        if(id.lt.0)is_cp=1
1747        if(id.gt.0)is_cp=2        if(id.gt.0)is_cp=2
1748        if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'  c      if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'
1749    
1750        return        return
1751        end        end
# Line 1321  c      include 'common_analysis.f' Line 1757  c      include 'common_analysis.f'
1757  *     it returns the id number ON THE PLANE  *     it returns the id number ON THE PLANE
1758  *      *    
1759        include 'commontracker.f'        include 'commontracker.f'
1760          include 'level1.f'
1761  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1762        include 'common_momanhough.f'        include 'common_momanhough.f'
1763                
# Line 1349  c      include 'common_analysis.f' Line 1786  c      include 'common_analysis.f'
1786  *     positive if sensor =2  *     positive if sensor =2
1787  *  *
1788        include 'commontracker.f'        include 'commontracker.f'
1789          include 'level1.f'
1790  c      include 'calib.f'  c      include 'calib.f'
1791  c      include 'level1.f'  c      include 'level1.f'
1792  c      include 'common_analysis.f'  c      include 'common_analysis.f'
# Line 1378  c      include 'common_analysis.f' Line 1816  c      include 'common_analysis.f'
1816  *************************************************************************  *************************************************************************
1817  *************************************************************************  *************************************************************************
1818  *************************************************************************  *************************************************************************
 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  
1819                
1820    
1821  ***************************************************  ***************************************************
# Line 1660  c$$$      end Line 1830  c$$$      end
1830        subroutine cl_to_couples(iflag)        subroutine cl_to_couples(iflag)
1831    
1832        include 'commontracker.f'        include 'commontracker.f'
1833          include 'level1.f'
1834        include 'common_momanhough.f'        include 'common_momanhough.f'
1835        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1836        include 'calib.f'        include 'calib.f'
1837        include 'level1.f'  c      include 'level1.f'
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1838    
1839  *     output flag  *     output flag
1840  *     --------------  *     --------------
# Line 1675  c      common/dbg/DEBUG Line 1843  c      common/dbg/DEBUG
1843  *     --------------  *     --------------
1844        integer iflag        integer iflag
1845    
1846        integer badseed,badcl        integer badseed,badclx,badcly
1847        
1848          if(DEBUG.EQ.1)print*,'cl_to_couples:'
1849    
1850  *     init variables  *     init variables
1851        ncp_tot=0        ncp_tot=0
# Line 1691  c      common/dbg/DEBUG Line 1861  c      common/dbg/DEBUG
1861           ncls(ip)=0           ncls(ip)=0
1862        enddo        enddo
1863        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1864           cl_single(icl)=1           cl_single(icl) = 1
1865           cl_good(icl)=0           cl_good(icl)   = 0
1866          enddo
1867          do iv=1,nviews
1868             ncl_view(iv)  = 0
1869             mask_view(iv) = 0      !all included
1870        enddo        enddo
1871                
1872  *     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  
 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  
                 
                if(ncp_plane(nplx).eq.ncouplemax)then  
                   if(verbose)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  
                 
                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)  
         
         
1873        do icl=1,nclstr1        do icl=1,nclstr1
1874           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  
1875        enddo        enddo
1876          *     mask views with too many clusters
1877                do iv=1,nviews
1878        if(DEBUG)then           if( ncl_view(iv).gt. nclusterlimit)then
1879           print*,'clusters  ',nclstr1  c            mask_view(iv) = 1
1880           print*,'good    ',(cl_good(i),i=1,nclstr1)              mask_view(iv) = mask_view(iv) + 2**0
1881           print*,'singles ',(cl_single(i),i=1,nclstr1)              if(DEBUG.EQ.1)
1882           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)       $        print*,' * WARNING * cl_to_couple: n.clusters > '
1883        endif       $        ,nclusterlimit,' on view ', iv,' --> masked!'
1884                   endif
       do ip=1,6  
          ncp_tot=ncp_tot+ncp_plane(ip)  
1885        enddo        enddo
 c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
         
       if(ncp_tot.gt.ncp_max)then  
          if(verbose)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  
1886    
       integer badseed,badcl  
1887    
 *     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  
         
1888  *     start association  *     start association
1889        ncouples=0        ncouples=0
1890        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1891           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1892                    
1893  *     ----------------------------------------------------  *     ----------------------------------------------------
1894    *     jump masked views (X VIEW)
1895    *     ----------------------------------------------------
1896             if( mask_view(VIEW(icx)).ne.0 ) goto 10
1897    *     ----------------------------------------------------
1898  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1899           if(dedx(icx).lt.dedx_x_min)then  *     ----------------------------------------------------
1900             if(sgnl(icx).lt.dedx_x_min)then
1901              cl_single(icx)=0              cl_single(icx)=0
1902              goto 10              goto 10
1903           endif           endif
1904    *     ----------------------------------------------------
1905  *     cut BAD (X VIEW)              *     cut BAD (X VIEW)            
1906    *     ----------------------------------------------------
1907           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
1908           ifirst=INDSTART(icx)           ifirst=INDSTART(icx)
1909           if(icx.ne.nclstr1) then           if(icx.ne.nclstr1) then
# Line 1946  c      common/dbg/DEBUG Line 1911  c      common/dbg/DEBUG
1911           else           else
1912              ilast=TOTCLLENGTH              ilast=TOTCLLENGTH
1913           endif           endif
1914           badcl=badseed           badclx=badseed
1915           do igood=-ngoodstr,ngoodstr           do igood=-ngoodstr,ngoodstr
1916              ibad=1              ibad=1
1917              if((INDMAX(icx)+igood).gt.ifirst.and.              if((INDMAX(icx)+igood).gt.ifirst.and.
# Line 1956  c      common/dbg/DEBUG Line 1921  c      common/dbg/DEBUG
1921       $              nvk(MAXS(icx)+igood),       $              nvk(MAXS(icx)+igood),
1922       $              nst(MAXS(icx)+igood))       $              nst(MAXS(icx)+igood))
1923              endif              endif
1924              badcl=badcl*ibad              badclx=badclx*ibad
1925           enddo           enddo
1926           if(badcl.eq.0)then     !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1927              cl_single(icx)=0    !<<<<<<<<<<<<<< BAD cut  *     >>> eliminato il taglio sulle BAD <<<
1928              goto 10             !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1929           endif                  !<<<<<<<<<<<<<< BAD cut  c     if(badcl.eq.0)then
1930    c     cl_single(icx)=0
1931    c     goto 10
1932    c     endif
1933  *     ----------------------------------------------------  *     ----------------------------------------------------
1934                    
1935           cl_good(icx)=1           cl_good(icx)=1
# Line 1972  c      common/dbg/DEBUG Line 1940  c      common/dbg/DEBUG
1940              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1941                            
1942  *     ----------------------------------------------------  *     ----------------------------------------------------
1943    *     jump masked views (Y VIEW)
1944    *     ----------------------------------------------------
1945                if( mask_view(VIEW(icy)).ne.0 ) goto 20
1946    
1947    *     ----------------------------------------------------
1948  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1949              if(dedx(icy).lt.dedx_y_min)then  *     ----------------------------------------------------
1950                if(sgnl(icy).lt.dedx_y_min)then
1951                 cl_single(icy)=0                 cl_single(icy)=0
1952                 goto 20                 goto 20
1953              endif              endif
1954    *     ----------------------------------------------------
1955  *     cut BAD (Y VIEW)              *     cut BAD (Y VIEW)            
1956    *     ----------------------------------------------------
1957              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
1958              ifirst=INDSTART(icy)              ifirst=INDSTART(icy)
1959              if(icy.ne.nclstr1) then              if(icy.ne.nclstr1) then
# Line 1985  c      common/dbg/DEBUG Line 1961  c      common/dbg/DEBUG
1961              else              else
1962                 ilast=TOTCLLENGTH                 ilast=TOTCLLENGTH
1963              endif              endif
1964              badcl=badseed              badcly=badseed
1965              do igood=-ngoodstr,ngoodstr              do igood=-ngoodstr,ngoodstr
1966                 ibad=1                 ibad=1
1967                 if((INDMAX(icy)+igood).gt.ifirst.and.                 if((INDMAX(icy)+igood).gt.ifirst.and.
# Line 1994  c      common/dbg/DEBUG Line 1970  c      common/dbg/DEBUG
1970       $              ibad=BAD(VIEW(icy),       $              ibad=BAD(VIEW(icy),
1971       $              nvk(MAXS(icy)+igood),       $              nvk(MAXS(icy)+igood),
1972       $              nst(MAXS(icy)+igood))       $              nst(MAXS(icy)+igood))
1973                 badcl=badcl*ibad                 badcly=badcly*ibad
1974              enddo              enddo
             if(badcl.eq.0)then  !<<<<<<<<<<<<<< BAD cut  
                cl_single(icy)=0 !<<<<<<<<<<<<<< BAD cut  
                goto 20          !<<<<<<<<<<<<<< BAD cut  
             endif               !<<<<<<<<<<<<<< BAD cut  
1975  *     ----------------------------------------------------  *     ----------------------------------------------------
1976                *     >>> eliminato il taglio sulle BAD <<<
1977    *     ----------------------------------------------------
1978    c     if(badcl.eq.0)then
1979    c     cl_single(icy)=0
1980    c     goto 20
1981    c     endif
1982    *     ----------------------------------------------------
1983                            
1984              cl_good(icy)=1                                cl_good(icy)=1                  
1985              nply=npl(VIEW(icy))              nply=npl(VIEW(icy))
# Line 2012  c      common/dbg/DEBUG Line 1990  c      common/dbg/DEBUG
1990  *     ----------------------------------------------  *     ----------------------------------------------
1991  *     geometrical consistency (same plane and ladder)  *     geometrical consistency (same plane and ladder)
1992              if(nply.eq.nplx.and.nldy.eq.nldx)then              if(nply.eq.nplx.and.nldy.eq.nldx)then
1993  *     charge correlation  *     charge correlation
1994  *     ===========================================================  *     (modified to be applied only below saturation... obviously)
1995  *     this version of the subroutine is used for the calibration  
1996  *     thus charge-correlation selection is obviously removed                 if(  .not.(sgnl(icy).gt.chsaty.and.sgnl(icx).gt.chsatx)
1997  *     ===========================================================       $              .and.
1998  c$$$               ddd=(dedx(icy)       $              .not.(sgnl(icy).lt.chmipy.and.sgnl(icx).lt.chmipx)
1999  c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))       $              .and.
2000  c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)       $              (badclx.eq.1.and.badcly.eq.1)
2001  c$$$               cut=chcut*sch(nplx,nldx)       $              .and.
2002  c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent       $              .true.)then
2003  *     ===========================================================  
2004                                    ddd=(sgnl(icy)
2005                       $                 -kch(nplx,nldx)*sgnl(icx)-cch(nplx,nldx))
2006  *     ------------------> COUPLE <------------------                    ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
2007  *     check to do not overflow vector dimentions  
2008  c$$$               if(ncp_plane(nplx).gt.ncouplemax)then  c                  cut = chcut * sch(nplx,nldx)
2009  c$$$                  if(DEBUG)print*,  
2010  c$$$     $                    ' ** warning ** number of identified'//                    sss=(kch(nplx,nldx)*sgnl(icy)+sgnl(icx)
2011  c$$$     $                    ' couples on plane ',nplx,       $                 -kch(nplx,nldx)*cch(nplx,nldx))
2012  c$$$     $                    ' exceeds vector dimention'//                    sss=sss/sqrt(kch(nplx,nldx)**2+1)
2013  c$$$     $                    ' ( ',ncouplemax,' )'                    cut = chcut * (16 + sss/50.)
2014  c$$$c     good2=.false.  
2015  c$$$c     goto 880   !fill ntp and go to next event                    if(abs(ddd).gt.cut)then
2016  c$$$                  iflag=1                       goto 20    !charge not consistent
2017  c$$$                  return                    endif
2018  c$$$               endif                 endif
2019                  
2020                 if(ncp_plane(nplx).eq.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
2021                    if(verbose)print*,                    if(verbose.eq.1)print*,
2022       $                 '** warning ** number of identified '//       $                 '** warning ** number of identified '//
2023       $                 'couples on plane ',nplx,       $                 'couples on plane ',nplx,
2024       $                 'exceeds vector dimention '       $                 'exceeds vector dimention '
2025       $                 ,'( ',ncouplemax,' )'       $                 ,'( ',ncouplemax,' ) --> masked!'
2026  c     good2=.false.  c                  mask_view(nviewx(nplx)) = 2
2027  c     goto 880   !fill ntp and go to next event                      c                  mask_view(nviewy(nply)) = 2
2028                    iflag=1                    mask_view(nviewx(nplx))= mask_view(nviewx(nplx))+ 2**1
2029                    return                    mask_view(nviewy(nply))= mask_view(nviewy(nply))+ 2**1
2030                      goto 10
2031                 endif                 endif
2032                                
2033    *     ------------------> COUPLE <------------------
2034                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
2035                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
2036                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
2037                 cl_single(icx)=0                 cl_single(icx)=0
2038                 cl_single(icy)=0                 cl_single(icy)=0
             endif                                
2039  *     ----------------------------------------------  *     ----------------------------------------------
2040    
2041                endif                              
2042    
2043   20         continue   20         continue
2044           enddo                  !end loop on clusters(Y)           enddo                  !end loop on clusters(Y)
2045                    
# Line 2075  c     goto 880   !fill ntp and go to nex Line 2056  c     goto 880   !fill ntp and go to nex
2056        enddo        enddo
2057                
2058                
2059        if(DEBUG)then        if(DEBUG.EQ.1)then
2060           print*,'clusters  ',nclstr1           print*,'clusters  ',nclstr1
2061           print*,'good    ',(cl_good(i),i=1,nclstr1)           print*,'good    ',(cl_good(i),i=1,nclstr1)
2062           print*,'singles ',(cl_single(i),i=1,nclstr1)           print*,'singlets',(cl_single(i),i=1,nclstr1)
2063           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
2064        endif        endif
2065                
2066        do ip=1,6        do ip=1,6
2067           ncp_tot=ncp_tot+ncp_plane(ip)           ncp_tot = ncp_tot + ncp_plane(ip)
2068        enddo        enddo
 c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
         
       if(ncp_tot.gt.ncp_max)then  
          if(verbose)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  
2069                
2070        return        return
2071        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  
2072                
2073  ***************************************************  ***************************************************
2074  *                                                 *  *                                                 *
# Line 2321  c$$$      end Line 2080  c$$$      end
2080  **************************************************  **************************************************
2081    
2082        subroutine cp_to_doubtrip(iflag)        subroutine cp_to_doubtrip(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2083    
2084        include 'commontracker.f'        include 'commontracker.f'
2085          include 'level1.f'
2086        include 'common_momanhough.f'        include 'common_momanhough.f'
       include 'momanhough_init.f'  
2087        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2088        include 'common_mini_2.f'        include 'common_mini_2.f'
2089        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
2090    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2091    
2092  *     output flag  *     output flag
2093  *     --------------  *     --------------
# Line 2366  c      double precision xm3,ym3,zm3 Line 2119  c      double precision xm3,ym3,zm3
2119        real xc,zc,radius        real xc,zc,radius
2120  *     -----------------------------  *     -----------------------------
2121    
2122          if(DEBUG.EQ.1)print*,'cp_to_doubtrip:'
2123    
2124    *     --------------------------------------------
2125    *     put a limit to the maximum number of couples
2126    *     per plane, in order to apply hough transform
2127    *     (couples recovered during track refinement)
2128    *     --------------------------------------------
2129          do ip=1,nplanes
2130             if(ncp_plane(ip).gt.ncouplelimit)then
2131    c            mask_view(nviewx(ip)) = 8
2132    c            mask_view(nviewy(ip)) = 8
2133                mask_view(nviewx(ip)) = mask_view(nviewx(ip)) + 2**7
2134                mask_view(nviewy(ip)) = mask_view(nviewy(ip)) + 2**7
2135             endif
2136          enddo
2137    
2138    
2139        ndblt=0                   !number of doublets        ndblt=0                   !number of doublets
2140        ntrpt=0                   !number of triplets        ntrpt=0                   !number of triplets
2141                
2142        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1
2143           do is1=1,2             !loop on sensors - COPPIA 1           if(  mask_view(nviewx(ip1)).ne.0 .or.
2144                     $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
2145             do is1=1,2             !loop on sensors - COPPIA 1            
2146              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
2147                 icx1=clx(ip1,icp1)                 icx1=clx(ip1,icp1)
2148                 icy1=cly(ip1,icp1)                 icy1=cly(ip1,icp1)
2149  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
2150                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
2151                   call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
2152                 xm1=xPAM                 xm1=xPAM
2153                 ym1=yPAM                 ym1=yPAM
2154                 zm1=zPAM                                   zm1=zPAM                  
2155  c     print*,'***',is1,xm1,ym1,zm1  c     print*,'***',is1,xm1,ym1,zm1
2156    
2157                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
2158                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    if(  mask_view(nviewx(ip2)).ne.0 .or.
2159                             $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
2160                      do is2=1,2    !loop on sensors -ndblt COPPIA 2                    
2161                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2
2162                          icx2=clx(ip2,icp2)                          icx2=clx(ip2,icp2)
2163                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
2164  c                        call xyz_PAM  c                        call xyz_PAM
2165  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
2166    c                        call xyz_PAM
2167    c     $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)
2168                          call xyz_PAM                          call xyz_PAM
2169       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.,0.,0.)
2170                          xm2=xPAM                          xm2=xPAM
2171                          ym2=yPAM                          ym2=yPAM
2172                          zm2=zPAM                          zm2=zPAM
# Line 2402  c     $                       (icx2,icy2 Line 2176  c     $                       (icx2,icy2
2176  *     (2 couples needed)  *     (2 couples needed)
2177  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2178                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
2179                             if(verbose)print*,                             if(verbose.eq.1)print*,
2180       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
2181       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
2182       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
2183  c                           good2=.false.  c                           good2=.false.
2184  c                           goto 880 !fill ntp and go to next event  c                           goto 880 !fill ntp and go to next event
2185                               do iv=1,12
2186    c                              mask_view(iv) = 3
2187                                  mask_view(iv) = mask_view(iv)+ 2**2
2188                               enddo
2189                             iflag=1                             iflag=1
2190                             return                             return
2191                          endif                          endif
# Line 2441  c$$$ Line 2219  c$$$
2219  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2220    
2221    
2222                          if(ip2.eq.nplanes)goto 30 !no possible combination with 3 couples                          if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
2223    
2224                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
2225                               if(  mask_view(nviewx(ip3)).ne.0 .or.
2226         $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
2227                             do is3=1,2 !loop on sensors - COPPIA 3                             do is3=1,2 !loop on sensors - COPPIA 3
2228                                                                
2229                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
# Line 2450  c$$$ Line 2231  c$$$
2231                                   icy3=cly(ip3,icp3)                                   icy3=cly(ip3,icp3)
2232  c                                 call xyz_PAM  c                                 call xyz_PAM
2233  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
2234    c                                 call xyz_PAM
2235    c     $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)
2236                                   call xyz_PAM                                   call xyz_PAM
2237       $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)       $                                (icx3,icy3,is3,PFAdef,PFAdef
2238         $                                ,0.,0.,0.,0.)
2239                                   xm3=xPAM                                   xm3=xPAM
2240                                   ym3=yPAM                                   ym3=yPAM
2241                                   zm3=zPAM                                   zm3=zPAM
# Line 2472  c     $                                 Line 2256  c     $                                
2256  *     (3 couples needed)  *     (3 couples needed)
2257  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2258                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
2259                                      if(verbose)print*,                                      if(verbose.eq.1)print*,
2260       $                     '** warning ** number of identified '//       $                     '** warning ** number of identified '//
2261       $                     'triplets exceeds vector dimention '       $                     'triplets exceeds vector dimention '
2262       $                    ,'( ',ntrpt_max,' )'       $                    ,'( ',ntrpt_max,' )'
2263  c                                    good2=.false.  c                                    good2=.false.
2264  c                                    goto 880 !fill ntp and go to next event  c                                    goto 880 !fill ntp and go to next event
2265                                        do iv=1,nviews
2266    c                                       mask_view(iv) = 4
2267                                           mask_view(iv)=mask_view(iv)+ 2**3
2268                                        enddo
2269                                      iflag=1                                      iflag=1
2270                                      return                                      return
2271                                   endif                                   endif
# Line 2516  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp Line 2304  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp
2304                                endif                                endif
2305                             enddo !end loop on COPPIA 3                             enddo !end loop on COPPIA 3
2306                          enddo   !end loop on sensors - COPPIA 3                          enddo   !end loop on sensors - COPPIA 3
2307     30                     continue
2308                       enddo      !end loop on planes  - COPPIA 3                       enddo      !end loop on planes  - COPPIA 3
2309   30                  continue   31                  continue
2310                                            
2311   1                enddo         !end loop on COPPIA 2   1                enddo         !end loop on COPPIA 2
2312                 enddo            !end loop on sensors - COPPIA 2                 enddo            !end loop on sensors - COPPIA 2
2313     20            continue
2314              enddo               !end loop on planes  - COPPIA 2              enddo               !end loop on planes  - COPPIA 2
2315                            
2316           enddo                  !end loop on COPPIA1           enddo                  !end loop on COPPIA1
2317        enddo                     !end loop on sensors - COPPIA 1        enddo                     !end loop on sensors - COPPIA 1
2318     10   continue
2319        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
2320                
2321        if(DEBUG)then        if(DEBUG.EQ.1)then
2322           print*,'--- doublets ',ndblt           print*,'--- doublets ',ndblt
2323           print*,'--- triplets ',ntrpt           print*,'--- triplets ',ntrpt
2324        endif        endif
# Line 2552  c     goto 880               !ntp fill Line 2343  c     goto 880               !ntp fill
2343        subroutine doub_to_YZcloud(iflag)        subroutine doub_to_YZcloud(iflag)
2344    
2345        include 'commontracker.f'        include 'commontracker.f'
2346          include 'level1.f'
2347        include 'common_momanhough.f'        include 'common_momanhough.f'
2348        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2349    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2350    
2351  *     output flag  *     output flag
2352  *     --------------  *     --------------
# Line 2575  c      common/dbg/DEBUG Line 2365  c      common/dbg/DEBUG
2365        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2366        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2367    
2368          if(DEBUG.EQ.1)print*,'doub_to_YZcloud:'
2369    
2370  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2371  *     classification of DOUBLETS  *     classification of DOUBLETS
# Line 2588  c      common/dbg/DEBUG Line 2379  c      common/dbg/DEBUG
2379        distance=0        distance=0
2380        nclouds_yz=0              !number of clouds        nclouds_yz=0              !number of clouds
2381        npt_tot=0        npt_tot=0
2382          nloop=0                  
2383     90   continue                  
2384        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2385           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
2386                            
# Line 2691  c     print*,'*   idbref,idb2 ',idbref,i Line 2484  c     print*,'*   idbref,idb2 ',idbref,i
2484              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2485           enddo           enddo
2486  c     print*,'>>>> ',ncpused,npt,nplused  c     print*,'>>>> ',ncpused,npt,nplused
2487           if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  c         if(ncpused.lt.ncpyz_min)goto 2228 !next doublet
2488           if(npt.lt.nptyz_min)goto 2228 !next doublet           if(npt.lt.nptyz_min)goto 2228 !next doublet
2489           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2490                    
# Line 2699  c     print*,'>>>> ',ncpused,npt,nplused Line 2492  c     print*,'>>>> ',ncpused,npt,nplused
2492  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2493    
2494           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2495              if(verbose)print*,              if(verbose.eq.1)print*,
2496       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2497       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2498       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2499  c               good2=.false.  c               good2=.false.
2500  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2501                do iv=1,nviews
2502    c               mask_view(iv) = 5
2503                   mask_view(iv) = mask_view(iv) + 2**4
2504                enddo
2505              iflag=1              iflag=1
2506              return              return
2507           endif           endif
# Line 2723  c     ptcloud_yz_nt(nclouds_yz)=npt Line 2520  c     ptcloud_yz_nt(nclouds_yz)=npt
2520  c     print*,'>> ',ipt,db_all(ipt)  c     print*,'>> ',ipt,db_all(ipt)
2521           enddo             enddo  
2522           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2523           if(DEBUG)then           if(DEBUG.EQ.1)then
2524              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'
2525              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'
2526              print*,'- alfayz1 ',alfayz1_av(nclouds_yz)              print*,'- alfayz1  ',alfayz1_av(nclouds_yz)
2527              print*,'- alfayz2 ',alfayz2_av(nclouds_yz)              print*,'- alfayz2  ',alfayz2_av(nclouds_yz)
2528              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2529              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2530              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'cpcloud_yz '
2531         $           ,(cpcloud_yz(nclouds_yz,icp),icp=1,ncp_tot)
2532                print*,'hit_plane  ',(hit_plane(ip),ip=1,nplanes)
2533  c$$$            print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '  c$$$            print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '
2534  c$$$     $           ,ptcloud_yz(nclouds_yz)  c$$$     $           ,ptcloud_yz(nclouds_yz)
2535  c$$$            print*,'nt-uple: db_cloud(...) = '  c$$$            print*,'nt-uple: db_cloud(...) = '
# Line 2742  c$$$     $           ,(db_cloud(iii),iii Line 2541  c$$$     $           ,(db_cloud(iii),iii
2541        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2542                
2543                
2544        if(DEBUG)then        if(nloop.lt.nstepy)then      
2545            cutdistyz = cutdistyz+cutystep
2546            nloop     = nloop+1          
2547            goto 90                
2548          endif                    
2549          
2550          if(DEBUG.EQ.1)then
2551           print*,'---------------------- '           print*,'---------------------- '
2552           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
2553           print*,' '           print*,' '
# Line 2768  c$$$     $           ,(db_cloud(iii),iii Line 2573  c$$$     $           ,(db_cloud(iii),iii
2573        subroutine trip_to_XZcloud(iflag)        subroutine trip_to_XZcloud(iflag)
2574    
2575        include 'commontracker.f'        include 'commontracker.f'
2576          include 'level1.f'
2577        include 'common_momanhough.f'        include 'common_momanhough.f'
2578        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2579    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2580    
2581  *     output flag  *     output flag
2582  *     --------------  *     --------------
# Line 2792  c      common/dbg/DEBUG Line 2596  c      common/dbg/DEBUG
2596        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2597        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2598    
2599          if(DEBUG.EQ.1)print*,'trip_to_XZcloud:'
2600    
2601  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2602  *     classification of TRIPLETS  *     classification of TRIPLETS
2603  *     according to distance in parameter space  *     according to distance in parameter space
# Line 2803  c      common/dbg/DEBUG Line 2609  c      common/dbg/DEBUG
2609        distance=0        distance=0
2610        nclouds_xz=0              !number of clouds                nclouds_xz=0              !number of clouds        
2611        npt_tot=0                 !total number of selected triplets        npt_tot=0                 !total number of selected triplets
2612          nloop=0                  
2613     91   continue                  
2614        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2615           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
2616  c     print*,'--------------'  c     print*,'--------------'
# Line 2847  c         tr_temp(1)=itr1 Line 2655  c         tr_temp(1)=itr1
2655       $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2                     $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2              
2656                 distance = sqrt(distance)                 distance = sqrt(distance)
2657                                
2658                 if(distance.lt.cutdistxz)then  *     ------------------------------------------------------------------------
2659    *     FORCE INCLUSION OF TRIPLETS COMPOSED BY SAME COUPLES, IGNORING THE IMAGE
2660    *     ------------------------------------------------------------------------
2661    *     (added in august 2007)
2662                   istrimage=0
2663                   if(
2664         $              abs(cpxz1(itrref)).eq.abs(cpxz1(itr2)).and.
2665         $              abs(cpxz2(itrref)).eq.abs(cpxz2(itr2)).and.
2666         $              abs(cpxz3(itrref)).eq.abs(cpxz3(itr2)).and.
2667         $              .true.)istrimage=1
2668    
2669                   if(distance.lt.cutdistxz.or.istrimage.eq.1)then
2670  c     print*,idb1,idb2,distance,' cloud ',nclouds_yz  c     print*,idb1,idb2,distance,' cloud ',nclouds_yz
2671                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1
2672                    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 2723  c     print*,'check cp_used'
2723           do ip=1,nplanes           do ip=1,nplanes
2724              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2725           enddo           enddo
2726           if(ncpused.lt.ncpxz_min)goto 22288 !next triplet  c         if(ncpused.lt.ncpxz_min)goto 22288 !next triplet
2727           if(npt.lt.nptxz_min)goto 22288     !next triplet           if(npt.lt.nptxz_min)goto 22288     !next triplet
2728           if(nplused.lt.nplxz_min)goto 22288 !next doublet           if(nplused.lt.nplxz_min)goto 22288 !next triplet
2729                    
2730  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2731  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2732           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2733              if(verbose)print*,              if(verbose.eq.1)print*,
2734       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2735       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2736       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2737  c     good2=.false.  c     good2=.false.
2738  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2739                do iv=1,nviews
2740    c               mask_view(iv) = 6
2741                   mask_view(iv) =  mask_view(iv) + 2**5
2742                enddo
2743              iflag=1              iflag=1
2744              return              return
2745           endif           endif
# Line 2934  c     goto 880         !fill ntp and go Line 2757  c     goto 880         !fill ntp and go
2757           enddo           enddo
2758           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2759                    
2760           if(DEBUG)then           if(DEBUG.EQ.1)then
2761              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'
2762              print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'                            print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'              
2763              print*,'- alfaxz1 ',alfaxz1_av(nclouds_xz)              print*,'- alfaxz1  ',alfaxz1_av(nclouds_xz)
2764              print*,'- alfaxz2 ',alfaxz2_av(nclouds_xz)              print*,'- alfaxz2  ',alfaxz2_av(nclouds_xz)
2765              print*,'- alfaxz3 ',alfaxz3_av(nclouds_xz)              print*,'- alfaxz3  ',alfaxz3_av(nclouds_xz)
2766              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2767              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2768                print*,'cpcloud_xz '
2769         $           ,(cpcloud_xz(nclouds_xz,icp),icp=1,ncp_tot)
2770              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)
2771  c$$$            print*,'nt-uple: ptcloud_xz(',nclouds_xz,') = '  c$$$            print*,'nt-uple: ptcloud_xz(',nclouds_xz,') = '
2772  c$$$     $           ,ptcloud_xz(nclouds_xz)  c$$$     $           ,ptcloud_xz(nclouds_xz)
# Line 2952  c$$$     $           ,(tr_cloud(iii),iii Line 2777  c$$$     $           ,(tr_cloud(iii),iii
2777  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2778  22288    continue  22288    continue
2779        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2780          
2781        if(DEBUG)then         if(nloop.lt.nstepx)then      
2782             cutdistxz=cutdistxz+cutxstep
2783             nloop=nloop+1          
2784             goto 91                
2785           endif                    
2786          
2787          if(DEBUG.EQ.1)then
2788           print*,'---------------------- '           print*,'---------------------- '
2789           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
2790           print*,' '           print*,' '
# Line 2974  c$$$     $           ,(tr_cloud(iii),iii Line 2805  c$$$     $           ,(tr_cloud(iii),iii
2805  **************************************************  **************************************************
2806    
2807        subroutine clouds_to_ctrack(iflag)        subroutine clouds_to_ctrack(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2808    
2809        include 'commontracker.f'        include 'commontracker.f'
2810          include 'level1.f'
2811        include 'common_momanhough.f'        include 'common_momanhough.f'
2812        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2813        include 'common_mini_2.f'        include 'common_mini_2.f'
2814        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
2815    
2816  c      logical DEBUG  
 c      common/dbg/DEBUG  
2817    
2818  *     output flag  *     output flag
2819  *     --------------  *     --------------
# Line 3002  c      common/dbg/DEBUG Line 2829  c      common/dbg/DEBUG
2829  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2830  *     list of matching couples in the combination  *     list of matching couples in the combination
2831  *     between a XZ and YZ cloud  *     between a XZ and YZ cloud
2832        integer cp_match(nplanes,ncouplemax)        integer cp_match(nplanes,2*ncouplemax)
2833        integer ncp_match(nplanes)        integer ncp_match(nplanes)
2834  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2835        integer hit_plane(nplanes)        integer hit_plane(nplanes)
2836  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2837  *     variables for track fitting  *     variables for track fitting
2838        double precision AL_INI(5)        double precision AL_INI(5)
       double precision tath  
2839  *     -----------------------------------------------------------  *     -----------------------------------------------------------
 c      real fitz(nplanes)        !z coordinates of the planes in cm  
2840    
2841          if(DEBUG.EQ.1)print*,'clouds_to_ctrack:'
2842    
2843    
2844        ntracks=0                 !counter of track candidates        ntracks=0                 !counter of track candidates
# Line 3034  c      real fitz(nplanes)        !z coor Line 2860  c      real fitz(nplanes)        !z coor
2860                 enddo                 enddo
2861              enddo              enddo
2862              ncp_ok=0              ncp_ok=0
2863              do icp=1,ncp_tot    !loop on couples              do icp=1,ncp_tot    !loop over couples
2864  *     get info on  *     get info on
2865                 cpintersec(icp)=min(                 cpintersec(icp)=min(
2866       $              cpcloud_yz(iyz,icp),       $              cpcloud_yz(iyz,icp),
# Line 3043  c      real fitz(nplanes)        !z coor Line 2869  c      real fitz(nplanes)        !z coor
2869       $    (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.
2870       $    (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.
2871       $              .false.)cpintersec(icp)=0       $              .false.)cpintersec(icp)=0
2872    *     cpintersec is >0 if yz and xz clouds contain the same image of couple icp
2873                 if(cpintersec(icp).ne.0)then                 if(cpintersec(icp).ne.0)then
2874                    ncp_ok=ncp_ok+1                      ncp_ok=ncp_ok+1  
2875                                        
# Line 3075  c      real fitz(nplanes)        !z coor Line 2902  c      real fitz(nplanes)        !z coor
2902                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2903              enddo              enddo
2904                            
             if(nplused.lt.nplxz_min)goto 888 !next doublet  
             if(ncp_ok.lt.ncpok)goto 888 !next cloud  
2905                            
2906              if(DEBUG)then              if(DEBUG.EQ.1)then
2907                 print*,'Combination ',iyz,ixz                 print*,'Combination ',iyz,ixz
2908       $              ,' db ',ptcloud_yz(iyz)       $              ,' db ',ptcloud_yz(iyz)
2909       $              ,' tr ',ptcloud_xz(ixz)       $              ,' tr ',ptcloud_xz(ixz)
2910       $              ,'  -----> # matching couples ',ncp_ok       $              ,'  -----> # matching couples ',ncp_ok
2911              endif              endif
2912    
2913    c            if(nplused.lt.nplxz_min)goto 888 !next combination
2914                if(nplused.lt.nplyz_min)goto 888 !next combination
2915                if(ncp_ok.lt.ncpok)goto 888 !next combination
2916    
2917  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2918  c$$$  print*,'Configurazione cluster XZ'  c$$$  print*,'Configurazione cluster XZ'
2919  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 2932  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p
2932  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2933                            
2934  *     -------> INITIAL GUESS <-------  *     -------> INITIAL GUESS <-------
2935              AL_INI(1)=dreal(alfaxz1_av(ixz))  cccc       SBAGLIATO
2936              AL_INI(2)=dreal(alfayz1_av(iyz))  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2937              AL_INI(4)=datan(dreal(alfayz2_av(iyz))  c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2938       $           /dreal(alfaxz2_av(ixz)))  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2939              tath=-dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))  c$$$     $           /dreal(alfaxz2_av(ixz)))
2940              AL_INI(3)=tath/sqrt(1+tath**2)  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2941              AL_INI(5)=(1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2942                c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2943  c     print*,'*******',AL_INI(5)  cccc       GIUSTO (ma si sua guess())
2944              if(AL_INI(5).gt.defmax)goto 888 !next cloud  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2945                c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2946  c     print*,'alfaxz2, alfayz2 '  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2947  c     $              ,alfaxz2_av(ixz),alfayz2_av(iyz)  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2948                c$$$            IF(alfaxz2_av(ixz).NE.0)THEN
2949  *     -------> INITIAL GUESS <-------  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2950  c     print*,'AL_INI ',(al_ini(i),i=1,5)  c$$$     $           /dreal(alfaxz2_av(ixz)))
2951                c$$$            ELSE
2952              if(DEBUG)then  c$$$               AL_INI(4) = acos(-1.)/2
2953    c$$$               IF(alfayz2_av(iyz).LT.0)AL_INI(4) = AL_INI(4)+acos(-1.)
2954    c$$$            ENDIF
2955    c$$$            IF(alfaxz2_av(ixz).LT.0)AL_INI(4)= acos(-1.)+ AL_INI(4)
2956    c$$$            AL_INI(4) = -acos(-1.) + AL_INI(4) !from incidence direction to tracking rs
2957    c$$$            
2958    c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2959    c$$$            
2960    c$$$            if(AL_INI(5).gt.defmax)goto 888 !next cloud
2961                            
2962                if(DEBUG.EQ.1)then
2963                   print*,'track candidate', ntracks+1
2964                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2965                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))
2966                 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 2993  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2993                                hit_plane(6)=icp6                                hit_plane(6)=icp6
2994                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6
2995                                                                
2996                                  *                             ---------------------------------------
2997    *                             check if this group of couples has been
2998    *                             already fitted    
2999    *                             ---------------------------------------
3000                                  do ica=1,ntracks
3001                                     isthesame=1
3002                                     do ip=1,NPLANES
3003                                        if(hit_plane(ip).ne.0)then
3004                                           if(  CP_STORE(nplanes-ip+1,ica)
3005         $                                      .ne.
3006         $                                      cp_match(ip,hit_plane(ip)) )
3007         $                                      isthesame=0
3008                                        else
3009                                           if(  CP_STORE(nplanes-ip+1,ica)
3010         $                                      .ne.
3011         $                                      0 )
3012         $                                      isthesame=0
3013                                        endif
3014                                     enddo
3015                                     if(isthesame.eq.1)then
3016                                        if(DEBUG.eq.1)
3017         $                                   print*,'(already fitted)'
3018                                        goto 666 !jump to next combination
3019                                     endif
3020                                  enddo
3021    
3022                                call track_init !init TRACK common                                call track_init !init TRACK common
3023    
3024                                do ip=1,nplanes !loop on planes                                do ip=1,nplanes !loop on planes (bottom to top)
3025                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
3026                                      id=cp_match(ip,hit_plane(ip))                                      id=cp_match(ip,hit_plane(ip))
3027                                      is=is_cp(id)                                      is=is_cp(id)
# Line 3169  c     print*,'AL_INI ',(al_ini(i),i=1,5) Line 3035  c     print*,'AL_INI ',(al_ini(i),i=1,5)
3035  *                                   *************************  *                                   *************************
3036  c                                    call xyz_PAM(icx,icy,is,  c                                    call xyz_PAM(icx,icy,is,
3037  c     $                                   'COG2','COG2',0.,0.)  c     $                                   'COG2','COG2',0.,0.)
3038    c                                    call xyz_PAM(icx,icy,is, !(1)
3039    c     $                                   PFAdef,PFAdef,0.,0.) !(1)
3040                                      call xyz_PAM(icx,icy,is, !(1)                                      call xyz_PAM(icx,icy,is, !(1)
3041       $                                   PFAdef,PFAdef,0.,0.) !(1)       $                                   PFAdef,PFAdef,0.,0.,0.,0.)
3042  *                                   *************************  *                                   *************************
3043  *                                   -----------------------------  *                                   -----------------------------
3044                                      xgood(nplanes-ip+1)=1.                                      xgood(nplanes-ip+1)=1.
# Line 3186  c     $                                 Line 3054  c     $                                
3054  *     **********************************************************  *     **********************************************************
3055  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
3056  *     **********************************************************  *     **********************************************************
3057    cccc  scommentare se si usa al_ini della nuvola
3058    c$$$                              do i=1,5
3059    c$$$                                 AL(i)=AL_INI(i)
3060    c$$$                              enddo
3061                                  call guess()
3062                                do i=1,5                                do i=1,5
3063                                   AL(i)=AL_INI(i)                                   AL_INI(i)=AL(i)
3064                                enddo                                enddo
3065                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
3066                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
3067                                call mini_2(jstep,ifail)                                iprint=0
3068    c                              if(DEBUG.EQ.1)iprint=1
3069                                  if(DEBUG.EQ.1)iprint=2
3070                                  call mini2(jstep,ifail,iprint)
3071                                if(ifail.ne.0) then                                if(ifail.ne.0) then
3072                                   if(DEBUG)then                                   if(DEBUG.EQ.1)then
3073                                      print *,                                      print *,
3074       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
3075       $                              //'(mini_2 in clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
3076                                        print*,'initial guess: '
3077    
3078                                        print*,'AL_INI(1) = ',AL_INI(1)
3079                                        print*,'AL_INI(2) = ',AL_INI(2)
3080                                        print*,'AL_INI(3) = ',AL_INI(3)
3081                                        print*,'AL_INI(4) = ',AL_INI(4)
3082                                        print*,'AL_INI(5) = ',AL_INI(5)
3083                                   endif                                   endif
3084                                   chi2=-chi2  c                                 chi2=-chi2
3085                                endif                                endif
3086  *     **********************************************************  *     **********************************************************
3087  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
# Line 3211  c     $                                 Line 3094  c     $                                
3094  *     --------------------------  *     --------------------------
3095                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
3096                                                                    
3097                                   if(verbose)print*,                                   if(verbose.eq.1)print*,
3098       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
3099       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
3100       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
3101  c                                 good2=.false.  c                                 good2=.false.
3102  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
3103                                     do iv=1,nviews
3104    c                                    mask_view(iv) = 7
3105                                        mask_view(iv) = mask_view(iv) + 2**6
3106                                     enddo
3107                                   iflag=1                                   iflag=1
3108                                   return                                   return
3109                                endif                                endif
3110                                                                
3111                                ntracks = ntracks + 1                                ntracks = ntracks + 1
3112                                                                
3113  c$$$                              ndof=0                                                                do ip=1,nplanes !top to bottom
3114                                do ip=1,nplanes  
 c$$$                                 ndof=ndof  
 c$$$     $                                +int(xgood(ip))  
 c$$$     $                                +int(ygood(ip))  
3115                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
3116                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
3117                                   ZV_STORE(ip,ntracks)=sngl(zv(ip))                                                                       ZV_STORE(ip,ntracks)=sngl(zv(ip))                                    
# Line 3243  c$$$     $                               Line 3127  c$$$     $                              
3127                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))
3128                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))
3129                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))
3130    *                                NB! hit_plane is defined from bottom to top
3131                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
3132                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
3133       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
3134                                        SENSOR_STORE(nplanes-ip+1,ntracks)
3135         $                              = is_cp(cp_match(ip,hit_plane(ip)))
3136                                        LADDER_STORE(nplanes-ip+1,ntracks)
3137         $                                   = LADDER(
3138         $                                   clx(ip,icp_cp(
3139         $                                   cp_match(ip,hit_plane(ip)
3140         $                                   ))));
3141                                   else                                   else
3142                                      CP_STORE(nplanes-ip+1,ntracks)=0                                      CP_STORE(nplanes-ip+1,ntracks)=0
3143                                        SENSOR_STORE(nplanes-ip+1,ntracks)=0
3144                                        LADDER_STORE(nplanes-ip+1,ntracks)=0
3145                                   endif                                   endif
3146                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   BX_STORE(ip,ntracks)=0!I dont need it now
3147                                     BY_STORE(ip,ntracks)=0!I dont need it now
3148                                     CLS_STORE(ip,ntracks)=0
3149                                   do i=1,5                                   do i=1,5
3150                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
3151                                   enddo                                   enddo
3152                                enddo                                enddo
3153                                                                
 c$$$  *                             Number of Degree Of Freedom  
 c$$$  ndof=ndof-5                            
 c$$$  *                             reduced chi^2  
 c$$$  rchi2=chi2/dble(ndof)  
3154                                RCHI2_STORE(ntracks)=chi2                                RCHI2_STORE(ntracks)=chi2
3155                                                                
3156  *     --------------------------------  *     --------------------------------
# Line 3282  c$$$  rchi2=chi2/dble(ndof) Line 3174  c$$$  rchi2=chi2/dble(ndof)
3174           return           return
3175        endif        endif
3176                
3177        if(DEBUG)then  c$$$      if(DEBUG.EQ.1)then
3178           print*,'****** TRACK CANDIDATES ***********'  c$$$         print*,'****** TRACK CANDIDATES ***********'
3179           print*,'#         R. chi2        RIG'  c$$$         print*,'#         R. chi2        RIG'
3180           do i=1,ntracks  c$$$         do i=1,ntracks
3181              print*,i,' --- ',rchi2_store(i),' --- '  c$$$            print*,i,' --- ',rchi2_store(i),' --- '
3182       $           ,1./abs(AL_STORE(5,i))  c$$$     $           ,1./abs(AL_STORE(5,i))
3183           enddo  c$$$         enddo
3184           print*,'***********************************'  c$$$         print*,'***********************************'
3185    c$$$      endif
3186          if(DEBUG.EQ.1)then
3187            print*,'****** TRACK CANDIDATES *****************'
3188            print*,'#         R. chi2        RIG         ndof'
3189            do i=1,ntracks
3190              ndof=0                !(1)
3191              do ii=1,nplanes       !(1)
3192                ndof=ndof           !(1)
3193         $           +int(xgood_store(ii,i)) !(1)
3194         $           +int(ygood_store(ii,i)) !(1)
3195              enddo                 !(1)
3196              print*,i,' --- ',rchi2_store(i),' --- '
3197         $         ,1./abs(AL_STORE(5,i)),' --- ',ndof
3198            enddo
3199            print*,'*****************************************'
3200        endif        endif
3201                
3202                
# Line 3308  c$$$  rchi2=chi2/dble(ndof) Line 3215  c$$$  rchi2=chi2/dble(ndof)
3215    
3216        subroutine refine_track(ibest)        subroutine refine_track(ibest)
3217    
 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******************************************************  
3218    
3219        include 'commontracker.f'        include 'commontracker.f'
3220          include 'level1.f'
3221        include 'common_momanhough.f'        include 'common_momanhough.f'
3222        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3223        include 'common_mini_2.f'        include 'common_mini_2.f'
3224        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
       include 'level1.f'  
3225        include 'calib.f'        include 'calib.f'
3226    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
3227  *     flag to chose PFA  *     flag to chose PFA
3228        character*10 PFA        character*10 PFA
3229        common/FINALPFA/PFA        common/FINALPFA/PFA
3230    
3231          real k(6)
3232          DATA k/1.099730,0.418900,0.220939,0.220907,0.418771,1.100674/
3233    
3234          real xp,yp,zp
3235          real xyzp(3),bxyz(3)
3236          equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
3237    
3238          if(DEBUG.EQ.1)print*,'refine_track:'
3239  *     =================================================  *     =================================================
3240  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
3241  *                          and  *                          and
# Line 3338  c      common/dbg/DEBUG Line 3244  c      common/dbg/DEBUG
3244        call track_init        call track_init
3245        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3246    
3247             xP=XV_STORE(nplanes-ip+1,ibest)
3248             yP=YV_STORE(nplanes-ip+1,ibest)
3249             zP=ZV_STORE(nplanes-ip+1,ibest)
3250             call gufld(xyzp,bxyz)
3251             BX_STORE(nplanes-ip+1,ibest)=bxyz(1)
3252             BY_STORE(nplanes-ip+1,ibest)=bxyz(2)
3253    c$$$  bxyz(1)=0
3254    c$$$         bxyz(2)=0
3255    c$$$         bxyz(3)=0
3256    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3257  *     -------------------------------------------------  *     -------------------------------------------------
3258  *     If the plane has been already included, it just  *     If the plane has been already included, it just
3259  *     computes again the coordinates of the x-y couple  *     computes again the coordinates of the x-y couple
3260  *     using improved PFAs  *     using improved PFAs
3261  *     -------------------------------------------------  *     -------------------------------------------------
3262    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3263           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
3264       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
3265                            
# Line 3356  c      common/dbg/DEBUG Line 3273  c      common/dbg/DEBUG
3273       $           ,ip_cp(id),ip       $           ,ip_cp(id),ip
3274              icx=clx(ip,icp)              icx=clx(ip,icp)
3275              icy=cly(ip,icp)              icy=cly(ip,icp)
3276    c            call xyz_PAM(icx,icy,is,
3277    c     $           PFA,PFA,
3278    c     $           AXV_STORE(nplanes-ip+1,ibest),
3279    c     $           AYV_STORE(nplanes-ip+1,ibest))
3280              call xyz_PAM(icx,icy,is,              call xyz_PAM(icx,icy,is,
 c     $           'ETA2','ETA2',  
3281       $           PFA,PFA,       $           PFA,PFA,
3282       $           AXV_STORE(nplanes-ip+1,ibest),       $           AXV_STORE(nplanes-ip+1,ibest),
3283       $           AYV_STORE(nplanes-ip+1,ibest))       $           AYV_STORE(nplanes-ip+1,ibest),
3284  c$$$  call xyz_PAM(icx,icy,is,       $           bxyz(1),
3285  c$$$  $              'COG2','COG2',       $           bxyz(2)
3286  c$$$  $              0.,       $           )
3287  c$$$  $              0.)  
3288              xm(nplanes-ip+1) = xPAM              xm(nplanes-ip+1) = xPAM
3289              ym(nplanes-ip+1) = yPAM              ym(nplanes-ip+1) = yPAM
3290              zm(nplanes-ip+1) = zPAM              zm(nplanes-ip+1) = zPAM
# Line 3373  c$$$  $              0.) Line 3293  c$$$  $              0.)
3293              resx(nplanes-ip+1) = resxPAM              resx(nplanes-ip+1) = resxPAM
3294              resy(nplanes-ip+1) = resyPAM              resy(nplanes-ip+1) = resyPAM
3295    
3296  c            dedxtrk(nplanes-ip+1) = (dedx(icx)+dedx(icy))/2. !(1)              dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3297              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)  
3298                            
3299    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3300  *     -------------------------------------------------  *     -------------------------------------------------
3301  *     If the plane has NOT  been already included,  *     If the plane has NOT  been already included,
3302  *     it tries to include a COUPLE or a single cluster  *     it tries to include a COUPLE or a single cluster
3303  *     -------------------------------------------------  *     -------------------------------------------------
3304    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3305           else                             else                  
3306                                
3307              xgood(nplanes-ip+1)=0              xgood(nplanes-ip+1)=0
# Line 3388  c            dedxtrk(nplanes-ip+1) = (de Line 3309  c            dedxtrk(nplanes-ip+1) = (de
3309                                
3310  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3311  *     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)  
3312              call whichsensor(ip,xP,yP,nldt,ist)              call whichsensor(ip,xP,yP,nldt,ist)
3313  *     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
3314              if(nldt.eq.0.or.ist.eq.0)goto 133              if(nldt.eq.0.or.ist.eq.0)goto 133
3315    
3316                SENSOR_STORE(nplanes-ip+1,IBEST)=ist
3317                LADDER_STORE(nplanes-ip+1,IBEST)=nldt
3318  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3319    
3320              if(DEBUG)then              if(DEBUG.EQ.1)then
3321                 print*,                 print*,
3322       $              '------ Plane ',ip,' intersected on LADDER ',nldt       $              '------ Plane ',ip,' intersected on LADDER ',nldt
3323       $              ,' SENSOR ',ist       $              ,' SENSOR ',ist
# Line 3407  c            dedxtrk(nplanes-ip+1) = (de Line 3328  c            dedxtrk(nplanes-ip+1) = (de
3328  *     ===========================================  *     ===========================================
3329  *     STEP 1 >>>>>>>  try to include a new couple  *     STEP 1 >>>>>>>  try to include a new couple
3330  *     ===========================================  *     ===========================================
3331  c            if(DEBUG)print*,'>>>> try to include a new couple'  c            if(DEBUG.EQ.1)print*,'>>>> try to include a new couple'
3332              distmin=1000000.              distmin=1000000.
3333              xmm = 0.              xmm = 0.
3334              ymm = 0.              ymm = 0.
# Line 3430  c     $              cl_used(icy).eq.1.o Line 3351  c     $              cl_used(icy).eq.1.o
3351  *            *          
3352                 call xyz_PAM(icx,icy,ist,                 call xyz_PAM(icx,icy,ist,
3353       $              PFA,PFA,       $              PFA,PFA,
 c     $              'ETA2','ETA2',  
3354       $              AXV_STORE(nplanes-ip+1,ibest),       $              AXV_STORE(nplanes-ip+1,ibest),
3355       $              AYV_STORE(nplanes-ip+1,ibest))       $              AYV_STORE(nplanes-ip+1,ibest),
3356         $              bxyz(1),
3357         $              bxyz(2)
3358         $              )
3359                                
3360                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3361    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3362                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3363                 if(DEBUG)print*,'( couple ',id                 if(DEBUG.EQ.1)print*,'( couple ',id
3364       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance
3365                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3366                    xmm = xPAM                    xmm = xPAM
3367                    ymm = yPAM                    ymm = yPAM
# Line 3446  c     $              'ETA2','ETA2', Line 3370  c     $              'ETA2','ETA2',
3370                    rymm = resyPAM                    rymm = resyPAM
3371                    distmin = distance                    distmin = distance
3372                    idm = id                                      idm = id                  
3373  c                 dedxmm = (dedx(icx)+dedx(icy))/2. !(1)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3374                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3375                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)  c     QUIQUI --> non devo moltiplicare per clinc?!?!?!
3376                      clincnewc=10*sqrt(rymm**2+rxmm**2 !QUIQUI
3377         $                 +RCHI2_STORE(ibest)*k(ip)*(cov(1,1)+cov(2,2))) !QUIQUI
3378                 endif                 endif
3379   1188          continue   1188          continue
3380              enddo               !end loop on couples on plane icp              enddo               !end loop on couples on plane icp
3381              if(distmin.le.clinc)then                    c            if(distmin.le.clinc)then     !QUIQUI              
3382                if(distmin.le.clincnewc)then     !QUIQUI              
3383  *              -----------------------------------  *              -----------------------------------
3384                 xm(nplanes-ip+1) = xmm         !<<<                 xm(nplanes-ip+1) = xmm !<<<
3385                 ym(nplanes-ip+1) = ymm         !<<<                 ym(nplanes-ip+1) = ymm !<<<
3386                 zm(nplanes-ip+1) = zmm         !<<<                 zm(nplanes-ip+1) = zmm !<<<
3387                 xgood(nplanes-ip+1) = 1        !<<<                 xgood(nplanes-ip+1) = 1 !<<<
3388                 ygood(nplanes-ip+1) = 1        !<<<                 ygood(nplanes-ip+1) = 1 !<<<
3389                 resx(nplanes-ip+1)=rxmm        !<<<                 resx(nplanes-ip+1)=rxmm !<<<
3390                 resy(nplanes-ip+1)=rymm        !<<<                 resy(nplanes-ip+1)=rymm !<<<
3391  c              dedxtrk(nplanes-ip+1) = dedxmm !<<<  !(1)                 dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3392                 dedxtrk_x(nplanes-ip+1) = dedxmmx    !(1)                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
                dedxtrk_y(nplanes-ip+1) = dedxmmy    !(1)  
3393  *              -----------------------------------  *              -----------------------------------
3394                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
3395                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG.EQ.1)print*,'%%%% included couple ',idm
3396       $              ,' (norm.dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clinc,' )'
3397                 goto 133         !next plane                 goto 133         !next plane
3398              endif              endif
3399  *     ================================================  *     ================================================
3400  *     STEP 2 >>>>>>>  try to include a single cluster  *     STEP 2 >>>>>>>  try to include a single cluster
3401  *                     either from a couple or single  *                     either from a couple or single
3402  *     ================================================  *     ================================================
3403  c            if(DEBUG)print*,'>>>> try to include a new cluster'  c            if(DEBUG.EQ.1)print*,'>>>> try to include a new cluster'
3404              distmin=1000000.              distmin=1000000.
3405              xmm_A = 0.          !---------------------------              xmm_A = 0.          !---------------------------
3406              ymm_A = 0.          ! init variables that              ymm_A = 0.          ! init variables that
# Line 3500  c            if(DEBUG)print*,'>>>> try t Line 3426  c            if(DEBUG)print*,'>>>> try t
3426  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
3427                 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)
3428  *                                              !jump to the Y cluster  *                                              !jump to the Y cluster
3429    c               call xyz_PAM(icx,0,ist,
3430    c     $              PFA,PFA,
3431    c     $              AXV_STORE(nplanes-ip+1,ibest),0.)              
3432                 call xyz_PAM(icx,0,ist,                 call xyz_PAM(icx,0,ist,
 c     $              'ETA2','ETA2',  
3433       $              PFA,PFA,       $              PFA,PFA,
3434       $              AXV_STORE(nplanes-ip+1,ibest),0.)                     $              AXV_STORE(nplanes-ip+1,ibest),0.,
3435         $              bxyz(1),
3436         $              bxyz(2)
3437         $              )              
3438                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3439  c     if(DEBUG)print*,'normalized distance ',distance  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3440                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG.EQ.1)print*,'( cl-X ',icx
3441       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3442                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3443                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3444                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3519  c     if(DEBUG)print*,'normalized distan Line 3450  c     if(DEBUG)print*,'normalized distan
3450                    rymm = resyPAM                    rymm = resyPAM
3451                    distmin = distance                    distmin = distance
3452                    iclm = icx                    iclm = icx
3453  c                  dedxmm = dedx(icx) !(1)  c                  dedxmm = sgnl(icx) !(1)
3454                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3455                    dedxmmy = 0.        !(1)                    dedxmmy = 0.        !(1)
3456                 endif                                   endif                  
3457  11881          continue  11881          continue
# Line 3528  c                  dedxmm = dedx(icx) !( Line 3459  c                  dedxmm = dedx(icx) !(
3459  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
3460                 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)
3461  *                                              !jump to the next couple  *                                              !jump to the next couple
3462    c               call xyz_PAM(0,icy,ist,
3463    c     $              PFA,PFA,
3464    c     $              0.,AYV_STORE(nplanes-ip+1,ibest))
3465                 call xyz_PAM(0,icy,ist,                 call xyz_PAM(0,icy,ist,
 c     $              'ETA2','ETA2',  
3466       $              PFA,PFA,       $              PFA,PFA,
3467       $              0.,AYV_STORE(nplanes-ip+1,ibest))       $              0.,AYV_STORE(nplanes-ip+1,ibest),
3468         $              bxyz(1),
3469         $              bxyz(2)
3470         $              )
3471                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3472                 if(DEBUG)print*,'( cl-Y ',icy  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3473       $              ,' in cp ',id,' ) normalized distance ',distance                 if(DEBUG.EQ.1)print*,'( cl-Y ',icy
3474         $              ,' in cp ',id,' ) distance ',distance
3475                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3476                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3477                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3546  c     $              'ETA2','ETA2', Line 3483  c     $              'ETA2','ETA2',
3483                    rymm = resyPAM                    rymm = resyPAM
3484                    distmin = distance                    distmin = distance
3485                    iclm = icy                    iclm = icy
3486  c                 dedxmm = dedx(icy)  !(1)  c                 dedxmm = sgnl(icy)  !(1)
3487                    dedxmmx = 0.        !(1)                    dedxmmx = 0.        !(1)
3488                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3489                 endif                                   endif                  
3490  11882          continue  11882          continue
3491              enddo               !end loop on cluster inside couples              enddo               !end loop on cluster inside couples
3492  *----- single clusters -----------------------------------------------      *----- single clusters -----------------------------------------------  
3493    c            print*,'## ncls(',ip,') ',ncls(ip)
3494              do ic=1,ncls(ip)    !loop on single clusters              do ic=1,ncls(ip)    !loop on single clusters
3495                 icl=cls(ip,ic)                 icl=cls(ip,ic)
3496  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 3499  c               if(cl_used(icl).eq.1.or.
3499       $              .false.)goto 18882      !jump to the next singlet       $              .false.)goto 18882      !jump to the next singlet
3500                 if(mod(VIEW(icl),2).eq.0)then!<---- X view                 if(mod(VIEW(icl),2).eq.0)then!<---- X view
3501                    call xyz_PAM(icl,0,ist,                    call xyz_PAM(icl,0,ist,
 c     $                 'ETA2','ETA2',  
3502       $                 PFA,PFA,       $                 PFA,PFA,
3503       $                 AXV_STORE(nplanes-ip+1,ibest),0.)       $                 AXV_STORE(nplanes-ip+1,ibest),0.,
3504         $                 bxyz(1),
3505         $                 bxyz(2)
3506         $                 )
3507                 else                         !<---- Y view                 else                         !<---- Y view
3508                    call xyz_PAM(0,icl,ist,                    call xyz_PAM(0,icl,ist,
 c     $                 'ETA2','ETA2',  
3509       $                 PFA,PFA,       $                 PFA,PFA,
3510       $                 0.,AYV_STORE(nplanes-ip+1,ibest))       $                 0.,AYV_STORE(nplanes-ip+1,ibest),
3511         $                 bxyz(1),
3512         $                 bxyz(2)
3513         $                 )
3514                 endif                 endif
3515    
3516                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3517                 if(DEBUG)print*,'( cl-s ',icl  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3518       $              ,' ) normalized distance ',distance                 if(DEBUG.EQ.1)print*,'( cl-s ',icl
3519         $              ,' ) distance ',distance
3520                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3521    c                  if(DEBUG.EQ.1)print*,'YES'
3522                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3523                    ymm_A = yPAM_A                    ymm_A = yPAM_A
3524                    zmm_A = zPAM_A                    zmm_A = zPAM_A
# Line 3585  c     $                 'ETA2','ETA2', Line 3529  c     $                 'ETA2','ETA2',
3529                    rymm = resyPAM                    rymm = resyPAM
3530                    distmin = distance                      distmin = distance  
3531                    iclm = icl                    iclm = icl
 c                  dedxmm = dedx(icl)                   !(1)  
3532                    if(mod(VIEW(icl),2).eq.0)then !<---- X view                    if(mod(VIEW(icl),2).eq.0)then !<---- X view
3533                       dedxmmx = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3534                       dedxmmy = 0.                       !(1)                       dedxmmy = 0.                  
3535                    else          !<---- Y view                    else          !<---- Y view
3536                       dedxmmx = 0.                       !(1)                       dedxmmx = 0.                  
3537                       dedxmmy = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3538                    endif                    endif
3539                 endif                                   endif                  
3540  18882          continue  18882          continue
3541              enddo               !end loop on single clusters              enddo               !end loop on single clusters
3542    c            print*,'## distmin ', distmin,' clinc ',clinc
3543    
3544              if(distmin.le.clinc)then                    c     QUIQUI------------
3545                  c     anche qui: non ci vuole clinc???
3546                 CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<                  if(iclm.ne.0)then
 *              ----------------------------  
3547                 if(mod(VIEW(iclm),2).eq.0)then                 if(mod(VIEW(iclm),2).eq.0)then
3548                    XGOOD(nplanes-ip+1)=1.                    clincnew=
3549                    resx(nplanes-ip+1)=rxmm       $                 20*
3550                    if(DEBUG)print*,'%%%% included X-cl ',iclm       $                 sqrt(rxmm**2+RCHI2_STORE(ibest)*k(ip)*cov(1,1))
3551       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'                 else if(mod(VIEW(iclm),2).ne.0)then
3552                 else                    clincnew=
3553                    YGOOD(nplanes-ip+1)=1.       $                 10*
3554                    resy(nplanes-ip+1)=rymm       $                 sqrt(rymm**2+RCHI2_STORE(ibest)*k(ip)*cov(2,2))
3555                    if(DEBUG)print*,'%%%% included Y-cl ',iclm                 endif
3556       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'  c     QUIQUI------------
3557                  
3558                   if(distmin.le.clincnew)then   !QUIQUI
3559    c     if(distmin.le.clinc)then          !QUIQUI          
3560                      
3561                      CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<    
3562    *     ----------------------------
3563    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3564                      if(mod(VIEW(iclm),2).eq.0)then
3565                         XGOOD(nplanes-ip+1)=1.
3566                         resx(nplanes-ip+1)=rxmm
3567                         if(DEBUG.EQ.1)print*,'%%%% included X-cl ',iclm
3568         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3569         $                    ,', dist.= ',distmin
3570         $                    ,', cut ',clinc,' )'
3571                      else
3572                         YGOOD(nplanes-ip+1)=1.
3573                         resy(nplanes-ip+1)=rymm
3574                         if(DEBUG.EQ.1)print*,'%%%% included Y-cl ',iclm
3575         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3576         $                    ,', dist.= ', distmin
3577         $                    ,', cut ',clinc,' )'
3578                      endif
3579    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3580    *     ----------------------------
3581                      xm_A(nplanes-ip+1) = xmm_A
3582                      ym_A(nplanes-ip+1) = ymm_A
3583                      xm_B(nplanes-ip+1) = xmm_B
3584                      ym_B(nplanes-ip+1) = ymm_B
3585                      zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3586                      dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3587                      dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3588    *     ----------------------------
3589                 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)  
 *              ----------------------------  
3590              endif              endif
3591           endif           endif
3592   133     continue   133     continue
# Line 3640  c              dedxtrk(nplanes-ip+1) = d Line 3605  c              dedxtrk(nplanes-ip+1) = d
3605  *                                                 *  *                                                 *
3606  *                                                 *  *                                                 *
3607  **************************************************  **************************************************
 cccccc 12/08/2006 modified by elena ---> (1)  
3608  *  *
3609        subroutine clean_XYclouds(ibest,iflag)        subroutine clean_XYclouds(ibest,iflag)
3610    
3611        include 'commontracker.f'        include 'commontracker.f'
3612          include 'level1.f'
3613        include 'common_momanhough.f'        include 'common_momanhough.f'
3614        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  
3615    
3616          if(DEBUG.EQ.1)print*,'clean_XYclouds:'
3617    
3618        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3619    
# Line 3663  c      common/dbg/DEBUG Line 3623  c      common/dbg/DEBUG
3623              if(id.ne.0)then              if(id.ne.0)then
3624                 iclx=clx(ip,icp_cp(id))                 iclx=clx(ip,icp_cp(id))
3625                 icly=cly(ip,icp_cp(id))                 icly=cly(ip,icp_cp(id))
3626  c               cl_used(iclx)=1  !tag used clusters  c$$$               cl_used(iclx)=ntrk  !tag used clusters
3627  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)  
3628              elseif(icl.ne.0)then              elseif(icl.ne.0)then
3629  c               cl_used(icl)=1   !tag used clusters  c$$$               cl_used(icl)=ntrk   !tag used clusters
                cl_used(icl)=ntrk   !tag used clusters !1)  
3630              endif              endif
3631                            
 c               if(DEBUG)then  
 c                  print*,ip,' <<< ',id  
 c               endif  
3632  *     -----------------------------  *     -----------------------------
3633  *     remove the couple from clouds  *     remove the couple from clouds
3634  *     remove also vitual couples containing the  *     remove also vitual couples containing the
# Line 3691  c               endif Line 3645  c               endif
3645       $              cly(ip,icp).eq.icl       $              cly(ip,icp).eq.icl
3646       $              )then       $              )then
3647                    id=id_cp(ip,icp,1)                    id=id_cp(ip,icp,1)
3648                    if(DEBUG)then                    if(DEBUG.EQ.1)then
3649                       print*,ip,' <<< cp ',id                       print*,ip,' <<< cp ',id
3650       $                    ,' ( cl-x '       $                    ,' ( cl-x '
3651       $                    ,clx(ip,icp)       $                    ,clx(ip,icp)
# Line 3725  c               endif Line 3679  c               endif
3679    
3680    
3681    
 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$$$  
   
3682    
3683    
3684  *     ****************************************************  *     ****************************************************
3685    
3686        subroutine init_level2        subroutine init_level2
3687    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c*****************************************************  
   
3688        include 'commontracker.f'        include 'commontracker.f'
3689          include 'level1.f'
3690        include 'common_momanhough.f'        include 'common_momanhough.f'
3691        include 'level2.f'        include 'level2.f'
       include 'level1.f'  
3692    
3693    *     ---------------------------------
3694    *     variables initialized from level1
3695    *     ---------------------------------
3696        do i=1,nviews        do i=1,nviews
3697           good2(i)=good1(i)           good2(i)=good1(i)
3698             do j=1,nva1_view
3699                vkflag(i,j)=1
3700                if(cnnev(i,j).le.0)then
3701                   vkflag(i,j)=cnnev(i,j)
3702                endif
3703             enddo
3704        enddo        enddo
3705    *     ----------------
3706  c      good2 = 0!.false.  *     level2 variables
3707  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*****************************************************  
   
3708        NTRK = 0        NTRK = 0
3709        do it=1,NTRKMAX!NTRACKSMAX        do it=1,NTRKMAX
3710           IMAGE(IT)=0           IMAGE(IT)=0
3711           CHI2_nt(IT) = -100000.           CHI2_nt(IT) = -100000.
 c         BdL(IT) = 0.  
3712           do ip=1,nplanes           do ip=1,nplanes
3713              XM_nt(IP,IT) = 0              XM_nt(IP,IT) = 0
3714              YM_nt(IP,IT) = 0              YM_nt(IP,IT) = 0
3715              ZM_nt(IP,IT) = 0              ZM_nt(IP,IT) = 0
3716              RESX_nt(IP,IT) = 0              RESX_nt(IP,IT) = 0
3717              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3718                TAILX_nt(IP,IT) = 0
3719                TAILY_nt(IP,IT) = 0
3720                XBAD(IP,IT) = 0
3721                YBAD(IP,IT) = 0
3722              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3723              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
3724  c*****************************************************              LS(IP,IT) = 0
 cccccc 11/9/2005 modified by david fedele  
3725              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3726              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
 c******************************************************  
 cccccc 17/8/2006 modified by elena  
3727              CLTRX(IP,IT) = 0              CLTRX(IP,IT) = 0
3728              CLTRY(IP,IT) = 0              CLTRY(IP,IT) = 0
3729           enddo           enddo
# Line 3893  cccccc 17/8/2006 modified by elena Line 3734  cccccc 17/8/2006 modified by elena
3734              enddo                                enddo                  
3735           enddo                             enddo                  
3736        enddo        enddo
         
         
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3737        nclsx=0        nclsx=0
3738        nclsy=0              nclsy=0      
3739        do ip=1,NSINGMAX        do ip=1,NSINGMAX
3740          planex(ip)=0          planex(ip)=0
 c        xs(ip)=0  
3741          xs(1,ip)=0          xs(1,ip)=0
3742          xs(2,ip)=0          xs(2,ip)=0
3743          sgnlxs(ip)=0          sgnlxs(ip)=0
3744          planey(ip)=0          planey(ip)=0
 c        ys(ip)=0  
3745          ys(1,ip)=0          ys(1,ip)=0
3746          ys(2,ip)=0          ys(2,ip)=0
3747          sgnlys(ip)=0          sgnlys(ip)=0
3748        enddo        enddo
 c*******************************************************  
3749        end        end
3750    
3751    
# Line 3926  c*************************************** Line 3760  c***************************************
3760  ************************************************************  ************************************************************
3761    
3762    
3763          subroutine init_hough
3764    
3765          include 'commontracker.f'
3766          include 'level1.f'
3767          include 'common_momanhough.f'
3768          include 'common_hough.f'
3769          include 'level2.f'
3770    
3771          ntrpt_nt=0
3772          ndblt_nt=0
3773          NCLOUDS_XZ_nt=0
3774          NCLOUDS_YZ_nt=0
3775          do idb=1,ndblt_max_nt
3776             db_cloud_nt(idb)=0
3777             alfayz1_nt(idb)=0      
3778             alfayz2_nt(idb)=0      
3779          enddo
3780          do itr=1,ntrpt_max_nt
3781             tr_cloud_nt(itr)=0
3782             alfaxz1_nt(itr)=0      
3783             alfaxz2_nt(itr)=0      
3784             alfaxz3_nt(itr)=0      
3785          enddo
3786          do idb=1,ncloyz_max      
3787            ptcloud_yz_nt(idb)=0    
3788            alfayz1_av_nt(idb)=0    
3789            alfayz2_av_nt(idb)=0    
3790          enddo                    
3791          do itr=1,ncloxz_max      
3792            ptcloud_xz_nt(itr)=0    
3793            alfaxz1_av_nt(itr)=0    
3794            alfaxz2_av_nt(itr)=0    
3795            alfaxz3_av_nt(itr)=0    
3796          enddo                    
3797    
3798          ntrpt=0                  
3799          ndblt=0                  
3800          NCLOUDS_XZ=0              
3801          NCLOUDS_YZ=0              
3802          do idb=1,ndblt_max        
3803            db_cloud(idb)=0        
3804            cpyz1(idb)=0            
3805            cpyz2(idb)=0            
3806            alfayz1(idb)=0          
3807            alfayz2(idb)=0          
3808          enddo                    
3809          do itr=1,ntrpt_max        
3810            tr_cloud(itr)=0        
3811            cpxz1(itr)=0            
3812            cpxz2(itr)=0            
3813            cpxz3(itr)=0            
3814            alfaxz1(itr)=0          
3815            alfaxz2(itr)=0          
3816            alfaxz3(itr)=0          
3817          enddo                    
3818          do idb=1,ncloyz_max      
3819            ptcloud_yz(idb)=0      
3820            alfayz1_av(idb)=0      
3821            alfayz2_av(idb)=0      
3822            do idbb=1,ncouplemaxtot
3823              cpcloud_yz(idb,idbb)=0
3824            enddo                  
3825          enddo                    
3826          do itr=1,ncloxz_max      
3827            ptcloud_xz(itr)=0      
3828            alfaxz1_av(itr)=0      
3829            alfaxz2_av(itr)=0      
3830            alfaxz3_av(itr)=0      
3831            do itrr=1,ncouplemaxtot
3832              cpcloud_xz(itr,itrr)=0
3833            enddo                  
3834          enddo                    
3835          end
3836    ************************************************************
3837    *
3838    *
3839    *
3840    *
3841    *
3842    *
3843    *
3844    ************************************************************
3845    
3846    
3847        subroutine fill_level2_tracks(ntr)        subroutine fill_level2_tracks(ntr)
3848    
3849  *     -------------------------------------------------------  *     -------------------------------------------------------
# Line 3937  c*************************************** Line 3855  c***************************************
3855            
3856        include 'commontracker.f'        include 'commontracker.f'
3857        include 'level1.f'        include 'level1.f'
3858          include 'common_momanhough.f'
3859        include 'level2.f'        include 'level2.f'
3860        include 'common_mini_2.f'        include 'common_mini_2.f'
3861        include 'common_momanhough.f'        include 'calib.f'
3862        real sinth,phi,pig        !(4)  
3863          character*10 PFA
3864          common/FINALPFA/PFA
3865    
3866          real sinth,phi,pig
3867          integer ssensor,sladder
3868        pig=acos(-1.)        pig=acos(-1.)
3869    
3870  c      good2=1!.true.  *     -------------------------------------
3871        chi2_nt(ntr)        = sngl(chi2)        chi2_nt(ntr)        = sngl(chi2)
3872        nstep_nt(ntr)       = 0!nstep        nstep_nt(ntr)       = nstep
3873    *     -------------------------------------
3874        phi   = al(4)             !(4)        phi   = al(4)          
3875        sinth = al(3)             !(4)        sinth = al(3)            
3876        if(sinth.lt.0)then        !(4)        if(sinth.lt.0)then      
3877           sinth = -sinth         !(4)           sinth = -sinth        
3878           phi = phi + pig        !(4)           phi = phi + pig      
3879        endif                     !(4)        endif                    
3880        npig = aint(phi/(2*pig))  !(4)        npig = aint(phi/(2*pig))
3881        phi = phi - npig*2*pig    !(4)        phi = phi - npig*2*pig  
3882        if(phi.lt.0)              !(4)        if(phi.lt.0)            
3883       $     phi = phi + 2*pig    !(4)       $     phi = phi + 2*pig  
3884        al(4) = phi               !(4)        al(4) = phi              
3885        al(3) = sinth             !(4)        al(3) = sinth            
 *****************************************************  
3886        do i=1,5        do i=1,5
3887           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3888           do j=1,5           do j=1,5
3889              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3890           enddo           enddo
 c     print*,al_nt(i,ntr)  
3891        enddo        enddo
3892          *     -------------------------------------      
3893        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
3894           xgood_nt(ip,ntr) = int(xgood(ip))           xgood_nt(ip,ntr) = int(xgood(ip))
3895           ygood_nt(ip,ntr) = int(ygood(ip))           ygood_nt(ip,ntr) = int(ygood(ip))
# Line 3976  c     print*,al_nt(i,ntr) Line 3898  c     print*,al_nt(i,ntr)
3898           zm_nt(ip,ntr)    = sngl(zm(ip))           zm_nt(ip,ntr)    = sngl(zm(ip))
3899           RESX_nt(IP,ntr)  = sngl(resx(ip))           RESX_nt(IP,ntr)  = sngl(resx(ip))
3900           RESY_nt(IP,ntr)  = sngl(resy(ip))           RESY_nt(IP,ntr)  = sngl(resy(ip))
3901             TAILX_nt(IP,ntr) = 0.
3902             TAILY_nt(IP,ntr) = 0.
3903           xv_nt(ip,ntr)    = sngl(xv(ip))           xv_nt(ip,ntr)    = sngl(xv(ip))
3904           yv_nt(ip,ntr)    = sngl(yv(ip))           yv_nt(ip,ntr)    = sngl(yv(ip))
3905           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3906           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3907           ayv_nt(ip,ntr)   = sngl(ayv(ip))           ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3908  c        dedxp(ip,ntr)    = sngl(dedxtrk(ip))   !(1)  
3909           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)           factor = sqrt(
3910           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)         $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3911         $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3912         $        1. )
3913    
3914             dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3915             dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3916        
3917           id  = CP_STORE(ip,IDCAND)           ax   = axv_nt(ip,ntr)
3918             ay   = ayv_nt(ip,ntr)
3919             bfx  = BX_STORE(ip,IDCAND)
3920             bfy  = BY_STORE(ip,IDCAND)
3921             if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3922             if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3923             tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3924             angx     = 180.*atan(tgtemp)/acos(-1.)
3925             tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3926             angy    = 180.*atan(tgtemp)/acos(-1.)
3927            
3928    c         print*,'* ',ip,bfx,bfy,angx,angy
3929    
3930             id  = CP_STORE(ip,IDCAND) ! couple id
3931           icl = CLS_STORE(ip,IDCAND)           icl = CLS_STORE(ip,IDCAND)
3932             ssensor = -1
3933             sladder = -1
3934             ssensor = SENSOR_STORE(ip,IDCAND)
3935             sladder = LADDER_STORE(ip,IDCAND)
3936             if(ip.eq.6.and.ssensor.ne.0)ssensor = 3 - ssensor !notazione paolo x align
3937             LS(IP,ntr)      = ssensor+10*sladder
3938    
3939           if(id.ne.0)then           if(id.ne.0)then
3940    c           >>> is a couple
3941              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3942              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3943  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  
3944                cl_used(cltrx(ip,ntr)) = 1     !tag used clusters          
3945                cl_used(cltry(ip,ntr)) = 1     !tag used clusters          
3946    
3947    c$$$            nnnnx = npfastrips(clx(nplanes-ip+1,icp_cp(id)),PFA,angx)
3948    c$$$            nnnny = npfastrips(cly(nplanes-ip+1,icp_cp(id)),PFA,angy)            
3949    c$$$            xbad(ip,ntr)= nbadstrips(nnnnx,clx(nplanes-ip+1,icp_cp(id)))
3950    c$$$            ybad(ip,ntr)= nbadstrips(nnnny,cly(nplanes-ip+1,icp_cp(id)))
3951                xbad(ip,ntr)= nbadstrips(4,clx(nplanes-ip+1,icp_cp(id)))
3952                ybad(ip,ntr)= nbadstrips(4,cly(nplanes-ip+1,icp_cp(id)))
3953    
3954    
3955                if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3956         $           dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3957                if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3958         $           dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3959    
3960           elseif(icl.ne.0)then           elseif(icl.ne.0)then
3961              if(mod(VIEW(icl),2).eq.0)cltrx(ip,ntr)=icl  
3962              if(mod(VIEW(icl),2).eq.1)cltry(ip,ntr)=icl              cl_used(icl) = 1    !tag used clusters          
3963  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  
3964                if(mod(VIEW(icl),2).eq.0)then
3965                   cltrx(ip,ntr)=icl
3966    c$$$               nnnnn = npfastrips(icl,PFA,angx)
3967    c$$$               xbad(ip,ntr) = nbadstrips(nnnnn,icl)
3968                   xbad(ip,ntr) = nbadstrips(4,icl)
3969    
3970                   if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3971                elseif(mod(VIEW(icl),2).eq.1)then
3972                   cltry(ip,ntr)=icl
3973    c$$$               nnnnn = npfastrips(icl,PFA,angy)
3974    c$$$               ybad(ip,ntr) = nbadstrips(nnnnn,icl)
3975                   ybad(ip,ntr) = nbadstrips(4,icl)
3976                   if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3977                endif
3978    
3979           endif                     endif          
3980    
3981        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)  
3982    
3983          if(DEBUG.eq.1)then
3984             print*,'> STORING TRACK ',ntr
3985             print*,'clusters: '
3986             do ip=1,6
3987                print*,'> ',ip,' -- ',cltrx(ip,ntr),cltry(ip,ntr)
3988             enddo
3989          endif
3990    
3991    c$$$      print*,(xgood(i),i=1,6)
3992    c$$$      print*,(ygood(i),i=1,6)
3993    c$$$      print*,(ls(i,ntr),i=1,6)
3994    c$$$      print*,(dedx_x(i,ntr),i=1,6)
3995    c$$$      print*,(dedx_y(i,ntr),i=1,6)
3996    c$$$      print*,'-----------------------'
3997    
3998        end        end
3999    
4000        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*****************************************************  
4001    
4002  *     -------------------------------------------------------  *     -------------------------------------------------------
4003  *     This routine fills the  elements of the variables  *     This routine fills the  elements of the variables
# Line 4022  c*************************************** Line 4006  c***************************************
4006  *     -------------------------------------------------------  *     -------------------------------------------------------
4007    
4008        include 'commontracker.f'        include 'commontracker.f'
       include 'level1.f'  
       include 'level2.f'  
4009        include 'calib.f'        include 'calib.f'
4010          include 'level1.f'
4011        include 'common_momanhough.f'        include 'common_momanhough.f'
4012          include 'level2.f'
4013        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
4014    
4015  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
 c      good2=1!.true.  
4016        nclsx = 0        nclsx = 0
4017        nclsy = 0        nclsy = 0
4018    
4019          do iv = 1,nviews
4020    c         if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
4021             good2(iv) = good2(iv) + mask_view(iv)*2**8
4022          enddo
4023    
4024          if(DEBUG.eq.1)then
4025             print*,'> STORING SINGLETS '
4026          endif
4027    
4028        do icl=1,nclstr1        do icl=1,nclstr1
4029    
4030             ip=nplanes-npl(VIEW(icl))+1            
4031            
4032           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              
4033              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
4034                 nclsx = nclsx + 1                 nclsx = nclsx + 1
4035                 planex(nclsx) = ip                 planex(nclsx) = ip
4036                 sgnlxs(nclsx) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
4037                   if(nsatstrips(icl).gt.0)sgnlxs(nclsx)=-sgnlxs(nclsx)
4038                 clsx(nclsx)   = icl                 clsx(nclsx)   = icl
4039                 do is=1,2                 do is=1,2
4040  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
4041                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
4042                      call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
4043                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2
4044                 enddo                 enddo
4045  c$$$               print*,'nclsx         ',nclsx  c$$$               print*,'nclsx         ',nclsx
# Line 4054  c$$$               print*,'xs(2,nclsx)   Line 4050  c$$$               print*,'xs(2,nclsx)  
4050              else                          !=== Y views              else                          !=== Y views
4051                 nclsy = nclsy + 1                 nclsy = nclsy + 1
4052                 planey(nclsy) = ip                 planey(nclsy) = ip
4053                 sgnlys(nclsy) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
4054                   if(nsatstrips(icl).gt.0)sgnlys(nclsy)=-sgnlys(nclsy)
4055                 clsy(nclsy)   = icl                 clsy(nclsy)   = icl
4056                 do is=1,2                 do is=1,2
4057  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
4058                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
4059                      call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
4060                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2
4061                 enddo                 enddo
4062  c$$$               print*,'nclsy         ',nclsy  c$$$               print*,'nclsy         ',nclsy
# Line 4068  c$$$               print*,'ys(1,nclsy)   Line 4066  c$$$               print*,'ys(1,nclsy)  
4066  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)
4067              endif              endif
4068           endif           endif
 c      print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)  
4069    
4070  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
4071           whichtrack(icl) = cl_used(icl)           whichtrack(icl) = cl_used(icl)
4072    *     --------------------------------------------------
4073    *     per non perdere la testa...
4074    *     whichtrack(icl) e` una variabile del common level1
4075    *     che serve solo per sapere quali cluster sono stati
4076    *     associati ad una traccia, e permettere di salvare
4077    *     solo questi nell'albero di uscita
4078    *     --------------------------------------------------
4079            
4080    
4081    c$$$         print*,' cl ',icl,' --> ',cl_used(icl)
4082    c$$$
4083    c$$$         if( cl_used(icl).ne.0 )then
4084    c$$$            if(
4085    c$$$     $           mod(VIEW(icl),2).eq.0.and.
4086    c$$$     $           cltrx(ip,whichtrack(icl)).ne.icl )
4087    c$$$     $           print*,'**WARNING** cltrx(',ip,',',whichtrack(icl)
4088    c$$$     $           ,')=',cltrx(ip,whichtrack(icl)),'.ne.',icl
4089    c$$$            if(
4090    c$$$     $           mod(VIEW(icl),2).eq.1.and.
4091    c$$$     $           cltry(ip,whichtrack(icl)).ne.icl )
4092    c$$$     $           print*,'**WARNING** cltry(',ip,',',whichtrack(icl)
4093    c$$$     $           ,')=',cltry(ip,whichtrack(icl)),'.ne.',icl
4094    c$$$         endif
4095            
4096    
4097        enddo        enddo
4098        end        end
4099    
4100    ***************************************************
4101    *                                                 *
4102    *                                                 *
4103    *                                                 *
4104    *                                                 *
4105    *                                                 *
4106    *                                                 *
4107    **************************************************
4108    
4109          subroutine fill_hough
4110    
4111    *     -------------------------------------------------------
4112    *     This routine fills the  variables related to the hough
4113    *     transform, for the debig n-tuple
4114    *     -------------------------------------------------------
4115    
4116          include 'commontracker.f'
4117          include 'level1.f'
4118          include 'common_momanhough.f'
4119          include 'common_hough.f'
4120          include 'level2.f'
4121    
4122          if(.false.
4123         $     .or.ntrpt.gt.ntrpt_max_nt
4124         $     .or.ndblt.gt.ndblt_max_nt
4125         $     .or.NCLOUDS_XZ.gt.ncloxz_max
4126         $     .or.NCLOUDS_yZ.gt.ncloyz_max
4127         $     )then
4128             ntrpt_nt=0
4129             ndblt_nt=0
4130             NCLOUDS_XZ_nt=0
4131             NCLOUDS_YZ_nt=0
4132          else
4133             ndblt_nt=ndblt
4134             ntrpt_nt=ntrpt
4135             if(ndblt.ne.0)then
4136                do id=1,ndblt
4137                   alfayz1_nt(id)=alfayz1(id) !Y0
4138                   alfayz2_nt(id)=alfayz2(id) !tg theta-yz
4139                enddo
4140             endif
4141             if(ndblt.ne.0)then
4142                do it=1,ntrpt
4143                   alfaxz1_nt(it)=alfaxz1(it) !X0
4144                   alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
4145                   alfaxz3_nt(it)=alfaxz3(it) !1/r
4146                enddo
4147             endif
4148             nclouds_yz_nt=nclouds_yz
4149             nclouds_xz_nt=nclouds_xz
4150             if(nclouds_yz.ne.0)then
4151                nnn=0
4152                do iyz=1,nclouds_yz
4153                   ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
4154                   alfayz1_av_nt(iyz)=alfayz1_av(iyz)
4155                   alfayz2_av_nt(iyz)=alfayz2_av(iyz)
4156                   nnn=nnn+ptcloud_yz(iyz)
4157                enddo
4158                do ipt=1,nnn
4159                   db_cloud_nt(ipt)=db_cloud(ipt)
4160                 enddo
4161             endif
4162             if(nclouds_xz.ne.0)then
4163                nnn=0
4164                do ixz=1,nclouds_xz
4165                   ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
4166                   alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
4167                   alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
4168                   alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
4169                   nnn=nnn+ptcloud_xz(ixz)              
4170                enddo
4171                do ipt=1,nnn
4172                  tr_cloud_nt(ipt)=tr_cloud(ipt)
4173                 enddo
4174             endif
4175          endif
4176          end
4177          

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.28

  ViewVC Help
Powered by ViewVC 1.1.23