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

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

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

revision 1.4 by pam-fi, Thu Sep 28 14:04:40 2006 UTC revision 1.21 by mocchiut, Fri Apr 27 12:11:02 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*8 AL_GUESS(5)
219    
220  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
221  *     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 256  c         iflag=0
256           ibest=0                !best track among candidates           ibest=0                !best track among candidates
257           iimage=0               !track image           iimage=0               !track image
258  *     ------------- select the best track -------------  *     ------------- select the best track -------------
259           rchi2best=1000000000.  c$$$         rchi2best=1000000000.
260    c$$$         do i=1,ntracks
261    c$$$            if(RCHI2_STORE(i).lt.rchi2best.and.
262    c$$$     $         RCHI2_STORE(i).gt.0)then
263    c$$$               ibest=i
264    c$$$               rchi2best=RCHI2_STORE(i)
265    c$$$            endif
266    c$$$         enddo
267    c$$$         if(ibest.eq.0)goto 880 !>> no good candidates
268    
269    *     -------------------------------------------------------
270    *     order track-candidates according to:
271    *     1st) decreasing n.points
272    *     2nd) increasing chi**2
273    *     -------------------------------------------------------
274             rchi2best=1000000000.
275             ndofbest=0            
276           do i=1,ntracks           do i=1,ntracks
277              if(RCHI2_STORE(i).lt.rchi2best.and.             ndof=0              
278       $         RCHI2_STORE(i).gt.0)then             do ii=1,nplanes    
279                 ndof=ndof        
280         $            +int(xgood_store(ii,i))
281         $            +int(ygood_store(ii,i))
282               enddo              
283               if(ndof.gt.ndofbest)then
284                 ibest=i
285                 rchi2best=RCHI2_STORE(i)
286                 ndofbest=ndof    
287               elseif(ndof.eq.ndofbest)then
288                 if(RCHI2_STORE(i).lt.rchi2best.and.
289         $            RCHI2_STORE(i).gt.0)then
290                 ibest=i                 ibest=i
291                 rchi2best=RCHI2_STORE(i)                 rchi2best=RCHI2_STORE(i)
292              endif                 ndofbest=ndof  
293           enddo               endif            
294               endif
295             enddo
296    
297    c$$$         rchi2best=1000000000.
298    c$$$         ndofbest=0             !(1)
299    c$$$         do i=1,ntracks
300    c$$$           if(RCHI2_STORE(i).lt.rchi2best.and.
301    c$$$     $          RCHI2_STORE(i).gt.0)then
302    c$$$             ndof=0             !(1)
303    c$$$             do ii=1,nplanes    !(1)
304    c$$$               ndof=ndof        !(1)
305    c$$$     $              +int(xgood_store(ii,i)) !(1)
306    c$$$     $              +int(ygood_store(ii,i)) !(1)
307    c$$$             enddo              !(1)
308    c$$$             if(ndof.ge.ndofbest)then !(1)
309    c$$$               ibest=i
310    c$$$               rchi2best=RCHI2_STORE(i)
311    c$$$               ndofbest=ndof    !(1)
312    c$$$             endif              !(1)
313    c$$$           endif
314    c$$$         enddo
315    
316           if(ibest.eq.0)goto 880 !>> no good candidates           if(ibest.eq.0)goto 880 !>> no good candidates
317  *-------------------------------------------------------------------------------      *-------------------------------------------------------------------------------    
318  *     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 331  c         iflag=0
331              iimage=0              iimage=0
332           endif           endif
333           if(icand.eq.0)then           if(icand.eq.0)then
334              print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand              if(VERBOSE)then
335       $           ,ibest,iimage                 print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand
336         $              ,ibest,iimage
337                endif
338              return              return
339           endif           endif
340    
# Line 236  c         iflag=0 Line 345  c         iflag=0
345  *     **********************************************************  *     **********************************************************
346  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
347  *     **********************************************************  *     **********************************************************
348             call guess()
349             do i=1,5
350                AL_GUESS(i)=AL(i)
351             enddo
352    c         print*,'## guess: ',al
353    
354           do i=1,5           do i=1,5
355              AL(i)=dble(AL_STORE(i,icand))                          AL(i)=dble(AL_STORE(i,icand))            
356           enddo           enddo
357            
358           IDCAND = icand         !fitted track-candidate           IDCAND = icand         !fitted track-candidate
359           ifail=0                !error flag in chi2 computation           ifail=0                !error flag in chi2 computation
360           jstep=0                !# minimization steps           jstep=0                !# minimization steps
361    
362           call mini_2(jstep,ifail)           iprint=0
363    c         if(DEBUG)iprint=1
364             if(VERBOSE)iprint=1
365             if(DEBUG)iprint=2
366             call mini2(jstep,ifail,iprint)
367           if(ifail.ne.0) then           if(ifail.ne.0) then
368              if(DEBUG)then              if(VERBOSE)then
369                 print *,                 print *,
370       $              '*** MINIMIZATION FAILURE *** (mini_2) '       $              '*** MINIMIZATION FAILURE *** (after refinement) '
371       $              ,iev       $              ,iev
372    
373    c$$$               print*,'guess:   ',(al_guess(i),i=1,5)
374    c$$$               print*,'previous: ',(al_store(i,icand),i=1,5)
375    c$$$               print*,'result:   ',(al(i),i=1,5)
376    c$$$               print*,'xgood ',xgood
377    c$$$               print*,'ygood ',ygood
378    c$$$               print*,'----------------------------------------------'
379              endif              endif
380              chi2=-chi2  c            chi2=-chi2
381           endif           endif
382                    
383           if(DEBUG)then           if(DEBUG)then
# Line 311  c         print*,'++++++++++ iimage,fima Line 438  c         print*,'++++++++++ iimage,fima
438  c     $        ,iimage,fimage,ntrk,image(ntrk)  c     $        ,iimage,fimage,ntrk,image(ntrk)
439    
440           if(ntrk.eq.NTRKMAX)then           if(ntrk.eq.NTRKMAX)then
441              if(DEBUG)              if(verbose)
442       $           print*,       $           print*,
443       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
444       $           'tracks exceeds vector dimension '       $           'tracks exceeds vector dimension '
# Line 361  c     $        rchi2best.lt.15..and. Line 488  c     $        rchi2best.lt.15..and.
488        end        end
489    
490    
   
   
 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$$$  
   
491                
492  ************************************************************  ************************************************************
493  ************************************************************  ************************************************************
# Line 557  c$$$ Line 512  c$$$
512  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)
513  *     angx   - Projected angle in x  *     angx   - Projected angle in x
514  *     angy   - Projected angle in y  *     angy   - Projected angle in y
515    *     bfx    - x-component of magnetci field
516    *     bfy    - y-component of magnetic field
517  *  *
518  *     --------- COUPLES -------------------------------------------------------  *     --------- COUPLES -------------------------------------------------------
519  *     The couple defines a point in the space.  *     The couple defines a point in the space.
# Line 595  c$$$ Line 552  c$$$
552  *  *
553  *  *
554    
555        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,angx,angy)        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
556    
 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*****************************************************  
557                
558        include 'commontracker.f'        include 'commontracker.f'
       include 'calib.f'  
559        include 'level1.f'        include 'level1.f'
560          include 'calib.f'
561        include 'common_align.f'        include 'common_align.f'
562        include 'common_mech.f'        include 'common_mech.f'
563        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
       include 'common_resxy.f'  
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
564    
565        integer icx,icy           !X-Y cluster ID        integer icx,icy           !X-Y cluster ID
566        integer sensor        integer sensor
567        integer viewx,viewy        integer viewx,viewy
568        character*4 PFAx,PFAy     !PFA to be used        character*4 PFAx,PFAy     !PFA to be used
569        real angx,angy            !X-Y angle        real ax,ay                !X-Y geometric angle
570          real angx,angy            !X-Y effective angle
571          real bfx,bfy              !X-Y b-field components
572    
573        real stripx,stripy        real stripx,stripy
574    
575        double precision xrt,yrt,zrt        double precision xrt,yrt,zrt
576        double precision xrt_A,yrt_A,zrt_A        double precision xrt_A,yrt_A,zrt_A
577        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  
578                
579    
580        parameter (ndivx=30)        parameter (ndivx=30)
# Line 647  c      double precision xi_B,yi_B,zi_B Line 591  c      double precision xi_B,yi_B,zi_B
591        xPAM_B = 0.        xPAM_B = 0.
592        yPAM_B = 0.        yPAM_B = 0.
593        zPAM_B = 0.        zPAM_B = 0.
594    c      print*,'## xyz_PAM: ',icx,icy,sensor,PFAx,PFAy,angx,angy
595    
596  *     -----------------  *     -----------------
597  *     CLUSTER X  *     CLUSTER X
598  *     -----------------  *     -----------------
599    
600        if(icx.ne.0)then        if(icx.ne.0)then
601           viewx = VIEW(icx)  
602           nldx = nld(MAXS(icx),VIEW(icx))           viewx   = VIEW(icx)
603           nplx = npl(VIEW(icx))           nldx    = nld(MAXS(icx),VIEW(icx))
604           resxPAM = RESXAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           nplx    = npl(VIEW(icx))
605                     resxPAM = RESXAV
606           stripx = float(MAXS(icx))           stripx  = float(MAXS(icx))
607           if(PFAx.eq.'COG1')then  !(1)  *        --------------------------
608              stripx = stripx      !(1)  *        magnetic-field corrections
609              resxPAM = resxPAM    !(1)  *        --------------------------
610             angtemp  = ax
611             bfytemp  = bfy
612             if(nplx.eq.6) angtemp = -1. * ax
613             if(nplx.eq.6) bfytemp = -1. * bfy
614             tgtemp   = tan(angtemp*acos(-1.)/180.) + pmuH_h*bfytemp*0.00001
615             angx     = 180.*atan(tgtemp)/acos(-1.)
616             stripx   = stripx - 0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
617    c$$$         print*,nplx,ax,bfy/10.
618    c$$$         print*,angx,0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
619    c$$$         print*,'========================'
620    *        --------------------------
621    
622    c$$$         print*,'--- x-cl ---'
623    c$$$         istart = INDSTART(ICX)
624    c$$$         istop  = TOTCLLENGTH
625    c$$$         if(icx.lt.NCLSTR1)istop=INDSTART(ICX+1)-1
626    c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
627    c$$$         print*,(CLSIGNAL(i),i=istart,istop)
628    c$$$         print*,INDMAX(icx)
629    c$$$         print*,cog(4,icx)
630    c$$$         print*,fbad_cog(4,icx)
631            
632    
633             if(PFAx.eq.'COG1')then
634    
635                stripx  = stripx
636                resxPAM = 1e-4*pitchX/sqrt(12.)!!resxPAM
637    
638           elseif(PFAx.eq.'COG2')then           elseif(PFAx.eq.'COG2')then
639              stripx = stripx + cog(2,icx)              
640                stripx  = stripx + cog(2,icx)            
641                resxPAM = risx_cog(abs(angx))!TEMPORANEO              
642              resxPAM = resxPAM*fbad_cog(2,icx)              resxPAM = resxPAM*fbad_cog(2,icx)
643    
644             elseif(PFAx.eq.'COG3')then
645    
646                stripx  = stripx + cog(3,icx)            
647                resxPAM = risx_cog(abs(angx))!TEMPORANEO                      
648                resxPAM = resxPAM*fbad_cog(3,icx)
649    
650             elseif(PFAx.eq.'COG4')then
651    
652                stripx  = stripx + cog(4,icx)            
653                resxPAM = risx_cog(abs(angx))!TEMPORANEO                      
654                resxPAM = resxPAM*fbad_cog(4,icx)
655    
656           elseif(PFAx.eq.'ETA2')then           elseif(PFAx.eq.'ETA2')then
657  c            cog2 = cog(2,icx)  
658  c            etacorr = pfa_eta2(cog2,viewx,nldx,angx)                          stripx  = stripx + pfaeta2(icx,angx)          
659  c            stripx = stripx + etacorr              resxPAM = risx_eta2(abs(angx))
660              stripx = stripx + pfa_eta2(icx,angx)            !(3)              resxPAM = resxPAM*fbad_cog(2,icx)
             resxPAM = risx_eta2(angx)                       !   (4)  
661              if(DEBUG.and.fbad_cog(2,icx).ne.1)              if(DEBUG.and.fbad_cog(2,icx).ne.1)
662       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
663              resxPAM = resxPAM*fbad_cog(2,icx)  
664           elseif(PFAx.eq.'ETA3')then                         !(3)           elseif(PFAx.eq.'ETA3')then                        
665              stripx = stripx + pfa_eta3(icx,angx)            !(3)  
666              resxPAM = risx_eta3(angx)                       !   (4)              stripx  = stripx + pfaeta3(icx,angx)          
667              if(DEBUG.and.fbad_cog(3,icx).ne.1)              !(3)              resxPAM = risx_eta3(abs(angx))                      
668       $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)!(3)              resxPAM = resxPAM*fbad_cog(3,icx)              
669              resxPAM = resxPAM*fbad_cog(3,icx)               !(3)              if(DEBUG.and.fbad_cog(3,icx).ne.1)            
670           elseif(PFAx.eq.'ETA4')then                         !(3)       $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)
671              stripx = stripx + pfa_eta4(icx,angx)            !(3)  
672              resxPAM = risx_eta4(angx)                       !   (4)           elseif(PFAx.eq.'ETA4')then                        
673              if(DEBUG.and.fbad_cog(4,icx).ne.1)              !(3)  
674       $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)!(3)              stripx  = stripx + pfaeta4(icx,angx)            
675              resxPAM = resxPAM*fbad_cog(4,icx)               !(3)              resxPAM = risx_eta4(abs(angx))                      
676           elseif(PFAx.eq.'ETA')then                          !(3)              resxPAM = resxPAM*fbad_cog(4,icx)              
677              stripx = stripx + pfa_eta(icx,angx)             !(3)              if(DEBUG.and.fbad_cog(4,icx).ne.1)              
678              resxPAM = ris_eta(icx,angx)                     !   (4)       $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)
679              if(DEBUG.and.fbad_cog(2,icx).ne.1)              !(3)  
680       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)!(3)           elseif(PFAx.eq.'ETA')then  
681  c            resxPAM = resxPAM*fbad_cog(2,icx)               !(3)TEMPORANEO  
682              resxPAM = resxPAM*fbad_eta(icx,angx)             !(3)(4)              stripx  = stripx + pfaeta(icx,angx)            
683           elseif(PFAx.eq.'COG')then           !(2)              resxPAM = ris_eta(icx,angx)                    
684              stripx = stripx + cog(0,icx)     !(2)                      resxPAM = resxPAM*fbad_eta(icx,angx)            
685              resxPAM = risx_cog(angx)                        !   (4)              if(DEBUG.and.fbad_cog(2,icx).ne.1)              
686              resxPAM = resxPAM*fbad_cog(0,icx)!(2)       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
687    
688             elseif(PFAx.eq.'COG')then          
689    
690                stripx  = stripx + cog(0,icx)            
691                resxPAM = risx_cog(abs(angx))                    
692                resxPAM = resxPAM*fbad_cog(0,icx)
693    
694           else           else
695              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx
696             endif
697    
698    
699    *     ======================================
700    *     temporary patch for saturated clusters
701    *     ======================================
702             if( nsatstrips(icx).gt.0 )then
703                stripx  = stripx + cog(4,icx)            
704                resxPAM = pitchX*1e-4/sqrt(12.)
705                cc=cog(4,icx)
706    c$$$            print*,icx,' *** ',cc
707    c$$$            print*,icx,' *** ',resxPAM
708           endif           endif
709    
710        endif        endif
 c      if(icy.eq.0.and.icx.ne.0)  
 c     $     print*,PFAx,icx,angx,stripx,resxPAM,'***'  
711                
712  *     -----------------  *     -----------------
713  *     CLUSTER Y  *     CLUSTER Y
714  *     -----------------  *     -----------------
715    
716        if(icy.ne.0)then        if(icy.ne.0)then
717    
718           viewy = VIEW(icy)           viewy = VIEW(icy)
719           nldy = nld(MAXS(icy),VIEW(icy))           nldy = nld(MAXS(icy),VIEW(icy))
720           nply = npl(VIEW(icy))           nply = npl(VIEW(icy))
721           resyPAM = RESYAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           resyPAM = RESYAV
722             stripy = float(MAXS(icy))
723    
724           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
725              print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '              if(DEBUG) then
726       $           ,icx,icy                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '
727         $              ,icx,icy
728                endif
729              goto 100              goto 100
730           endif           endif
731            *        --------------------------
732           stripy = float(MAXS(icy))  *        magnetic-field corrections
733           if(PFAy.eq.'COG1')then !(1)  *        --------------------------
734              stripy = stripy     !(1)           tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
735              resyPAM = resyPAM   !(1)           angy    = 180.*atan(tgtemp)/acos(-1.)
736             stripy = stripy + 0.5*pmuH_e*bfx*0.00001*SiDimZ/pitchY
737    *        --------------------------
738            
739    c$$$         print*,'--- y-cl ---'
740    c$$$         istart = INDSTART(ICY)
741    c$$$         istop  = TOTCLLENGTH
742    c$$$         if(icy.lt.NCLSTR1)istop=INDSTART(ICY+1)-1
743    c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
744    c$$$         print*,(CLSIGNAL(i),i=istart,istop)
745    c$$$         print*,INDMAX(icy)
746    c$$$         print*,cog(4,icy)
747    c$$$         print*,fbad_cog(4,icy)
748    
749             if(PFAy.eq.'COG1')then
750    
751                stripy  = stripy    
752                resyPAM = 1e-4*pitchY/sqrt(12.)!resyPAM  
753    
754           elseif(PFAy.eq.'COG2')then           elseif(PFAy.eq.'COG2')then
755              stripy = stripy + cog(2,icy)  
756                stripy  = stripy + cog(2,icy)
757                resyPAM = risy_cog(abs(angy))!TEMPORANEO
758              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
759    
760             elseif(PFAy.eq.'COG3')then
761    
762                stripy  = stripy + cog(3,icy)
763                resyPAM = risy_cog(abs(angy))!TEMPORANEO
764                resyPAM = resyPAM*fbad_cog(3,icy)
765    
766             elseif(PFAy.eq.'COG4')then
767    
768                stripy  = stripy + cog(4,icy)
769                resyPAM = risy_cog(abs(angy))!TEMPORANEO
770                resyPAM = resyPAM*fbad_cog(4,icy)
771    
772           elseif(PFAy.eq.'ETA2')then           elseif(PFAy.eq.'ETA2')then
773  c            cog2 = cog(2,icy)  
774  c            etacorr = pfa_eta2(cog2,viewy,nldy,angy)              stripy  = stripy + pfaeta2(icy,angy)          
775  c            stripy = stripy + etacorr              resyPAM = risy_eta2(abs(angy))              
             stripy = stripy + pfa_eta2(icy,angy)            !(3)  
             resyPAM = risy_eta2(angy)                       !   (4)  
776              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
777              if(DEBUG.and.fbad_cog(2,icy).ne.1)              if(DEBUG.and.fbad_cog(2,icy).ne.1)
778       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
779           elseif(PFAy.eq.'ETA3')then                         !(3)  
780              stripy = stripy + pfa_eta3(icy,angy)            !(3)           elseif(PFAy.eq.'ETA3')then                      
781              resyPAM = resyPAM*fbad_cog(3,icy)               !(3)  
782              if(DEBUG.and.fbad_cog(3,icy).ne.1)              !(3)              stripy  = stripy + pfaeta3(icy,angy)
783       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)!(3)              resyPAM = resyPAM*fbad_cog(3,icy)  
784           elseif(PFAy.eq.'ETA4')then                         !(3)              if(DEBUG.and.fbad_cog(3,icy).ne.1)
785              stripy = stripy + pfa_eta4(icy,angy)            !(3)       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)
786              resyPAM = resyPAM*fbad_cog(4,icy)               !(3)  
787              if(DEBUG.and.fbad_cog(4,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA4')then  
788       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)!(3)  
789           elseif(PFAy.eq.'ETA')then                          !(3)              stripy  = stripy + pfaeta4(icy,angy)
790              stripy = stripy + pfa_eta(icy,angy)             !(3)              resyPAM = resyPAM*fbad_cog(4,icy)
791              resyPAM = ris_eta(icy,angy)                     !   (4)              if(DEBUG.and.fbad_cog(4,icy).ne.1)
792  c            resyPAM = resyPAM*fbad_cog(2,icy)              !(3)TEMPORANEO       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)
793              resyPAM = resyPAM*fbad_eta(icy,angy)            !   (4)  
794              if(DEBUG.and.fbad_cog(2,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA')then
795       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)!(3)  
796                stripy  = stripy + pfaeta(icy,angy)
797                resyPAM = ris_eta(icy,angy)  
798                resyPAM = resyPAM*fbad_eta(icy,angy)
799                if(DEBUG.and.fbad_cog(2,icy).ne.1)
800         $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
801    
802           elseif(PFAy.eq.'COG')then           elseif(PFAy.eq.'COG')then
803              stripy = stripy + cog(0,icy)              
804              resyPAM = risy_cog(angy)                        !   (4)              stripy  = stripy + cog(0,icy)            
805  c            resyPAM = ris_eta(icy,angy)                    !   (4)              resyPAM = risy_cog(abs(angy))
806              resyPAM = resyPAM*fbad_cog(0,icy)              resyPAM = resyPAM*fbad_cog(0,icy)
807    
808           else           else
809              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx
810             endif
811    
812    
813    *     ======================================
814    *     temporary patch for saturated clusters
815    *     ======================================
816             if( nsatstrips(icy).gt.0 )then
817                stripy  = stripy + cog(4,icy)            
818                resyPAM = pitchY*1e-4/sqrt(12.)
819                cc=cog(4,icy)
820    c$$$            print*,icy,' *** ',cc
821    c$$$            print*,icy,' *** ',resyPAM
822           endif           endif
823    
824    
825        endif        endif
826    
827          c      print*,'## stripx,stripy ',stripx,stripy
828    
829  c===========================================================  c===========================================================
830  C     COUPLE  C     COUPLE
831  C===========================================================  C===========================================================
# Line 777  c     (xi,yi,zi) = mechanical coordinate Line 836  c     (xi,yi,zi) = mechanical coordinate
836  c------------------------------------------------------------------------  c------------------------------------------------------------------------
837           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
838       $        .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...
839              print*,'xyz_PAM (couple):',              if(DEBUG) then
840       $          ' WARNING: false X strip: strip ',stripx                 print*,'xyz_PAM (couple):',
841         $              ' WARNING: false X strip: strip ',stripx
842                endif
843           endif           endif
844           xi = acoordsi(stripx,viewx)           xi = acoordsi(stripx,viewx)
845           yi = acoordsi(stripy,viewy)           yi = acoordsi(stripy,viewy)
# Line 870  c            print*,'X-singlet ',icx,npl Line 931  c            print*,'X-singlet ',icx,npl
931  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...
932              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
933       $           .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...
934                 print*,'xyz_PAM (X-singlet):',                 if(DEBUG) then
935       $             ' WARNING: false X strip: strip ',stripx                    print*,'xyz_PAM (X-singlet):',
936         $                 ' WARNING: false X strip: strip ',stripx
937                   endif
938              endif              endif
939              xi   = acoordsi(stripx,viewx)              xi   = acoordsi(stripx,viewx)
940    
# Line 893  c            print*,'X-cl ',icx,stripx,' Line 956  c            print*,'X-cl ',icx,stripx,'
956  c            print*,yi_A,' <--> ',yi_B  c            print*,yi_A,' <--> ',yi_B
957    
958           else           else
959                if(DEBUG) then
960              print *,'routine xyz_PAM ---> not properly used !!!'                 print *,'routine xyz_PAM ---> not properly used !!!'
961              print *,'icx = ',icx                 print *,'icx = ',icx
962              print *,'icy = ',icy                 print *,'icy = ',icy
963                endif
964              goto 100              goto 100
965                            
966           endif           endif
# Line 961  c--------------------------------------- Line 1025  c---------------------------------------
1025  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'
1026    
1027        else        else
1028                       if(DEBUG) then
1029           print *,'routine xyz_PAM ---> not properly used !!!'              print *,'routine xyz_PAM ---> not properly used !!!'
1030           print *,'icx = ',icx              print *,'icx = ',icx
1031           print *,'icy = ',icy              print *,'icy = ',icy
1032                         endif
1033        endif        endif
1034                    
1035    
1036    c      print*,'## xPAM,yPAM,zPAM       ',xPAM,yPAM,zPAM
1037    c      print*,'## xPAM_A,yPAM_A,zPAM_A ',xPAM_A,yPAM_A,zPAM_A
1038    c      print*,'## xPAM_B,yPAM_B,zPAM_B ',xPAM_B,yPAM_B,zPAM_B
1039    
1040   100  continue   100  continue
1041        end        end
1042    
# Line 1046  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1115  c         print*,'A-(',xPAM_A,yPAM_A,')
1115           endif                   endif        
1116    
1117           distance=           distance=
1118       $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2       $       ((xmi-XPP)**2+(ymi-YPP)**2)!QUIQUI
1119    cc     $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1120           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1121    
1122  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 1141  c$$$         print*,' resolution ',re
1141  *     ----------------------  *     ----------------------
1142                    
1143           distance=           distance=
1144       $        ((xPAM-XPP)/resxPAM)**2       $       ((xPAM-XPP))**2 !QUIQUI
1145       $        +       $       +
1146       $        ((yPAM-YPP)/resyPAM)**2       $       ((yPAM-YPP))**2
1147    c$$$     $        ((xPAM-XPP)/resxPAM)**2
1148    c$$$     $        +
1149    c$$$     $        ((yPAM-YPP)/resyPAM)**2
1150           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1151    
1152  c$$$         print*,xPAM,yPAM,zPAM  c$$$         print*,xPAM,yPAM,zPAM
# Line 1082  c$$$         print*,' resolution ',resxP Line 1155  c$$$         print*,' resolution ',resxP
1155                    
1156        else        else
1157                    
1158           print*  c         print*
1159       $        ,' function distance_to ---> wrong usage!!!'  c     $        ,' function distance_to ---> wrong usage!!!'
1160           print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM  c         print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM
1161           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 '
1162       $        ,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
1163        endif          endif  
1164    
1165        distance_to = sngl(distance)        distance_to = sngl(distance)
# Line 1154  c--------------------------------------- Line 1227  c---------------------------------------
1227                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1228       $              .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...
1229  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...
1230                    print*,'whichsensor: ',  c                  print*,'whichsensor: ',
1231       $                ' WARNING: false X strip: strip ',stripx  c     $                ' WARNING: false X strip: strip ',stripx
1232                 endif                 endif
1233                 xi = acoordsi(stripx,viewx)                 xi = acoordsi(stripx,viewx)
1234                 yi = acoordsi(stripy,viewy)                 yi = acoordsi(stripy,viewy)
# Line 1284  c     $              ,iv,xvv(iv),yvv(iv) Line 1357  c     $              ,iv,xvv(iv),yvv(iv)
1357  *     it returns the plane number  *     it returns the plane number
1358  *      *    
1359        include 'commontracker.f'        include 'commontracker.f'
1360          include 'level1.f'
1361  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1362        include 'common_momanhough.f'        include 'common_momanhough.f'
1363                
# Line 1309  c      include 'common_analysis.f' Line 1383  c      include 'common_analysis.f'
1383        is_cp=0        is_cp=0
1384        if(id.lt.0)is_cp=1        if(id.lt.0)is_cp=1
1385        if(id.gt.0)is_cp=2        if(id.gt.0)is_cp=2
1386        if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'  c      if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'
1387    
1388        return        return
1389        end        end
# Line 1321  c      include 'common_analysis.f' Line 1395  c      include 'common_analysis.f'
1395  *     it returns the id number ON THE PLANE  *     it returns the id number ON THE PLANE
1396  *      *    
1397        include 'commontracker.f'        include 'commontracker.f'
1398          include 'level1.f'
1399  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1400        include 'common_momanhough.f'        include 'common_momanhough.f'
1401                
# Line 1349  c      include 'common_analysis.f' Line 1424  c      include 'common_analysis.f'
1424  *     positive if sensor =2  *     positive if sensor =2
1425  *  *
1426        include 'commontracker.f'        include 'commontracker.f'
1427          include 'level1.f'
1428  c      include 'calib.f'  c      include 'calib.f'
1429  c      include 'level1.f'  c      include 'level1.f'
1430  c      include 'common_analysis.f'  c      include 'common_analysis.f'
# Line 1365  c      include 'common_analysis.f' Line 1441  c      include 'common_analysis.f'
1441        id_cp = id_cp + icp        id_cp = id_cp + icp
1442    
1443        if(is.eq.1) id_cp = -id_cp        if(is.eq.1) id_cp = -id_cp
1444    
       return  
       end  
   
   
   
   
 *************************************************************************  
 *************************************************************************  
 *************************************************************************  
 *************************************************************************  
 *************************************************************************  
 *************************************************************************  
 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  
         
   
 ***************************************************  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 **************************************************  
   
       subroutine cl_to_couples(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  
   
       integer badseed,badcl  
   
 *     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  
         
 *     start association  
       ncouples=0  
       do icx=1,nclstr1          !loop on cluster (X)  
          if(mod(VIEW(icx),2).eq.1)goto 10  
           
 *     ----------------------------------------------------  
 *     cut on charge (X VIEW)  
 *     ----------------------------------------------------  
          if(dedx(icx).lt.dedx_x_min)then  
             cl_single(icx)=0  
             goto 10  
          endif  
 *     ----------------------------------------------------  
 *     cut BAD (X VIEW)              
 *     ----------------------------------------------------  
          badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))  
          ifirst=INDSTART(icx)  
          if(icx.ne.nclstr1) then  
             ilast=INDSTART(icx+1)-1  
          else  
             ilast=TOTCLLENGTH  
          endif  
          badcl=badseed  
          do igood=-ngoodstr,ngoodstr  
             ibad=1  
             if((INDMAX(icx)+igood).gt.ifirst.and.  
      $           (INDMAX(icx)+igood).lt.ilast.and.  
      $           .true.)then  
                ibad=BAD(VIEW(icx),  
      $              nvk(MAXS(icx)+igood),  
      $              nst(MAXS(icx)+igood))  
             endif  
             badcl=badcl*ibad  
          enddo  
 *     ----------------------------------------------------  
 *     >>> eliminato il taglio sulle BAD <<<  
 *     ----------------------------------------------------  
 c     if(badcl.eq.0)then  
 c     cl_single(icx)=0  
 c     goto 10  
 c     endif  
 *     ----------------------------------------------------  
           
          cl_good(icx)=1  
          nplx=npl(VIEW(icx))  
          nldx=nld(MAXS(icx),VIEW(icx))  
           
          do icy=1,nclstr1       !loop on cluster (Y)  
             if(mod(VIEW(icy),2).eq.0)goto 20  
               
 *     ----------------------------------------------------  
 *     cut on charge (Y VIEW)  
 *     ----------------------------------------------------  
             if(dedx(icy).lt.dedx_y_min)then  
                cl_single(icy)=0  
                goto 20  
             endif  
 *     ----------------------------------------------------  
 *     cut BAD (Y VIEW)              
 *     ----------------------------------------------------  
             badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))  
             ifirst=INDSTART(icy)  
             if(icy.ne.nclstr1) then  
                ilast=INDSTART(icy+1)-1  
             else  
                ilast=TOTCLLENGTH  
             endif  
             badcl=badseed  
             do igood=-ngoodstr,ngoodstr  
                ibad=1  
                if((INDMAX(icy)+igood).gt.ifirst.and.  
      $              (INDMAX(icy)+igood).lt.ilast.and.  
      $              .true.)  
      $              ibad=BAD(VIEW(icy),  
      $              nvk(MAXS(icy)+igood),  
      $              nst(MAXS(icy)+igood))  
                badcl=badcl*ibad  
             enddo  
 *     ----------------------------------------------------  
 *     >>> eliminato il taglio sulle BAD <<<  
 *     ----------------------------------------------------  
 c     if(badcl.eq.0)then  
 c     cl_single(icy)=0  
 c     goto 20  
 c     endif  
 *     ----------------------------------------------------  
               
             cl_good(icy)=1                    
             nply=npl(VIEW(icy))  
             nldy=nld(MAXS(icy),VIEW(icy))  
               
 *     ----------------------------------------------  
 *     CONDITION TO FORM A COUPLE  
 *     ----------------------------------------------  
 *     geometrical consistency (same plane and ladder)  
             if(nply.eq.nplx.and.nldy.eq.nldx)then  
 *     charge correlation  
 *     (modified to be applied only below saturation... obviously)  
   
 *     -------------------------------------------------------------  
 *     >>> eliminata (TEMPORANEAMENTE) la correlazione di carica <<<  
 *     -------------------------------------------------------------  
 c$$$               if(dedx(icy).lt.chsaty.or.dedx(icx).lt.chsatx)then  
 c$$$                  ddd=(dedx(icy)  
 c$$$     $                 -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  
 c$$$                  ddd=ddd/sqrt(kch(nplx,nldx)**2+1)  
 c$$$                  cut=chcut*sch(nplx,nldx)  
 c$$$                  if(abs(ddd).gt.cut)goto 20 !charge not consistent  
 c$$$               endif  
                 
 *     ------------------> COUPLE <------------------  
 *     check to do not overflow vector dimentions  
                if(ncp_plane(nplx).gt.ncouplemax)then  
                   if(DEBUG)print*,  
      $                    ' ** warning ** number of identified'//  
      $                    ' couples on plane ',nplx,  
      $                    ' exceeds vector dimention'//  
      $                    ' ( ',ncouplemax,' )'  
 c     good2=.false.  
 c     goto 880   !fill ntp and go to next event  
                   iflag=1  
                   return  
                endif  
                 
 c$$$               if(ncp_plane(nplx).eq.ncouplemax)then  
 c$$$                  if(DEBUG)print*,  
 c$$$     $                 '** warning ** number of identified '//  
 c$$$     $                 'couples on plane ',nplx,  
 c$$$     $                 'exceeds vector dimention '  
 c$$$     $                 ,'( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event                      
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
                 
                ncp_plane(nplx) = ncp_plane(nplx) + 1  
                clx(nplx,ncp_plane(nplx))=icx  
                cly(nply,ncp_plane(nplx))=icy  
                cl_single(icx)=0  
                cl_single(icy)=0  
             endif                                
 *     ----------------------------------------------  
   
  20         continue  
          enddo                  !end loop on clusters(Y)  
           
  10      continue  
       enddo                     !end loop on clusters(X)  
         
         
       do icl=1,nclstr1  
          if(cl_single(icl).eq.1)then  
             ip=npl(VIEW(icl))  
             ncls(ip)=ncls(ip)+1  
             cls(ip,ncls(ip))=icl  
          endif  
       enddo  
         
         
       if(DEBUG)then  
          print*,'clusters  ',nclstr1  
          print*,'good    ',(cl_good(i),i=1,nclstr1)  
          print*,'singles ',(cl_single(i),i=1,nclstr1)  
          print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)  
       endif  
         
       do ip=1,6  
          ncp_tot=ncp_tot+ncp_plane(ip)  
       enddo  
 c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
         
       if(ncp_tot.gt.ncp_max)then  
          if(DEBUG)print*,  
      $           '** warning ** number of identified '//  
      $           'couples exceeds upper limit for Hough tr. '  
      $           ,'( ',ncp_max,' )'              
 c            good2=.false.  
 c     goto 880       !fill ntp and go to next event  
          iflag=1  
          return  
       endif  
         
1445        return        return
1446        end        end
1447    
1448    
1449    
1450    
1451    *************************************************************************
1452    *************************************************************************
1453    *************************************************************************
1454    *************************************************************************
1455    *************************************************************************
1456    *************************************************************************
1457                
1458    
1459  ***************************************************  ***************************************************
1460  *                                                 *  *                                                 *
1461  *                                                 *  *                                                 *
# Line 1889  c     goto 880       !fill ntp and go to Line 1464  c     goto 880       !fill ntp and go to
1464  *                                                 *  *                                                 *
1465  *                                                 *  *                                                 *
1466  **************************************************  **************************************************
1467        subroutine cl_to_couples_nocharge(iflag)  
1468          subroutine cl_to_couples(iflag)
1469    
1470        include 'commontracker.f'        include 'commontracker.f'
1471          include 'level1.f'
1472        include 'common_momanhough.f'        include 'common_momanhough.f'
1473        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1474        include 'calib.f'        include 'calib.f'
1475        include 'level1.f'  c      include 'level1.f'
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1476    
1477  *     output flag  *     output flag
1478  *     --------------  *     --------------
# Line 1907  c      common/dbg/DEBUG Line 1481  c      common/dbg/DEBUG
1481  *     --------------  *     --------------
1482        integer iflag        integer iflag
1483    
1484        integer badseed,badcl        integer badseed,badclx,badcly
1485    
1486  *     init variables  *     init variables
1487        ncp_tot=0        ncp_tot=0
# Line 1923  c      common/dbg/DEBUG Line 1497  c      common/dbg/DEBUG
1497           ncls(ip)=0           ncls(ip)=0
1498        enddo        enddo
1499        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1500           cl_single(icl)=1           cl_single(icl) = 1
1501           cl_good(icl)=0           cl_good(icl)   = 0
1502          enddo
1503          do iv=1,nviews
1504             ncl_view(iv)  = 0
1505             mask_view(iv) = 0      !all included
1506        enddo        enddo
1507                
1508    *     count number of cluster per view
1509          do icl=1,nclstr1
1510             ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1        
1511          enddo
1512    *     mask views with too many clusters
1513          do iv=1,nviews
1514             if( ncl_view(iv).gt. nclusterlimit)then
1515                mask_view(iv) = 1
1516                if(DEBUG)print*,' * WARNING * cl_to_couple: n.clusters > '
1517         $           ,nclusterlimit,' on view ', iv,' --> masked!'
1518             endif
1519          enddo
1520    
1521    
1522  *     start association  *     start association
1523        ncouples=0        ncouples=0
1524        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1525           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1526                    
1527  *     ----------------------------------------------------  *     ----------------------------------------------------
1528    *     jump masked views (X VIEW)
1529    *     ----------------------------------------------------
1530             if( mask_view(VIEW(icx)).ne.0 ) goto 10
1531    *     ----------------------------------------------------
1532  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1533           if(dedx(icx).lt.dedx_x_min)then  *     ----------------------------------------------------
1534             if(sgnl(icx).lt.dedx_x_min)then
1535              cl_single(icx)=0              cl_single(icx)=0
1536              goto 10              goto 10
1537           endif           endif
1538    *     ----------------------------------------------------
1539  *     cut BAD (X VIEW)              *     cut BAD (X VIEW)            
1540    *     ----------------------------------------------------
1541           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
1542           ifirst=INDSTART(icx)           ifirst=INDSTART(icx)
1543           if(icx.ne.nclstr1) then           if(icx.ne.nclstr1) then
# Line 1946  c      common/dbg/DEBUG Line 1545  c      common/dbg/DEBUG
1545           else           else
1546              ilast=TOTCLLENGTH              ilast=TOTCLLENGTH
1547           endif           endif
1548           badcl=badseed           badclx=badseed
1549           do igood=-ngoodstr,ngoodstr           do igood=-ngoodstr,ngoodstr
1550              ibad=1              ibad=1
1551              if((INDMAX(icx)+igood).gt.ifirst.and.              if((INDMAX(icx)+igood).gt.ifirst.and.
# Line 1956  c      common/dbg/DEBUG Line 1555  c      common/dbg/DEBUG
1555       $              nvk(MAXS(icx)+igood),       $              nvk(MAXS(icx)+igood),
1556       $              nst(MAXS(icx)+igood))       $              nst(MAXS(icx)+igood))
1557              endif              endif
1558              badcl=badcl*ibad              badclx=badclx*ibad
1559           enddo           enddo
1560           if(badcl.eq.0)then     !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1561              cl_single(icx)=0    !<<<<<<<<<<<<<< BAD cut  *     >>> eliminato il taglio sulle BAD <<<
1562              goto 10             !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1563           endif                  !<<<<<<<<<<<<<< BAD cut  c     if(badcl.eq.0)then
1564    c     cl_single(icx)=0
1565    c     goto 10
1566    c     endif
1567  *     ----------------------------------------------------  *     ----------------------------------------------------
1568                    
1569           cl_good(icx)=1           cl_good(icx)=1
# Line 1972  c      common/dbg/DEBUG Line 1574  c      common/dbg/DEBUG
1574              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1575                            
1576  *     ----------------------------------------------------  *     ----------------------------------------------------
1577    *     jump masked views (Y VIEW)
1578    *     ----------------------------------------------------
1579                if( mask_view(VIEW(icy)).ne.0 ) goto 20
1580    
1581    *     ----------------------------------------------------
1582  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1583              if(dedx(icy).lt.dedx_y_min)then  *     ----------------------------------------------------
1584                if(sgnl(icy).lt.dedx_y_min)then
1585                 cl_single(icy)=0                 cl_single(icy)=0
1586                 goto 20                 goto 20
1587              endif              endif
1588    *     ----------------------------------------------------
1589  *     cut BAD (Y VIEW)              *     cut BAD (Y VIEW)            
1590    *     ----------------------------------------------------
1591              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
1592              ifirst=INDSTART(icy)              ifirst=INDSTART(icy)
1593              if(icy.ne.nclstr1) then              if(icy.ne.nclstr1) then
# Line 1985  c      common/dbg/DEBUG Line 1595  c      common/dbg/DEBUG
1595              else              else
1596                 ilast=TOTCLLENGTH                 ilast=TOTCLLENGTH
1597              endif              endif
1598              badcl=badseed              badcly=badseed
1599              do igood=-ngoodstr,ngoodstr              do igood=-ngoodstr,ngoodstr
1600                 ibad=1                 ibad=1
1601                 if((INDMAX(icy)+igood).gt.ifirst.and.                 if((INDMAX(icy)+igood).gt.ifirst.and.
# Line 1994  c      common/dbg/DEBUG Line 1604  c      common/dbg/DEBUG
1604       $              ibad=BAD(VIEW(icy),       $              ibad=BAD(VIEW(icy),
1605       $              nvk(MAXS(icy)+igood),       $              nvk(MAXS(icy)+igood),
1606       $              nst(MAXS(icy)+igood))       $              nst(MAXS(icy)+igood))
1607                 badcl=badcl*ibad                 badcly=badcly*ibad
1608              enddo              enddo
             if(badcl.eq.0)then  !<<<<<<<<<<<<<< BAD cut  
                cl_single(icy)=0 !<<<<<<<<<<<<<< BAD cut  
                goto 20          !<<<<<<<<<<<<<< BAD cut  
             endif               !<<<<<<<<<<<<<< BAD cut  
1609  *     ----------------------------------------------------  *     ----------------------------------------------------
1610                *     >>> eliminato il taglio sulle BAD <<<
1611    *     ----------------------------------------------------
1612    c     if(badcl.eq.0)then
1613    c     cl_single(icy)=0
1614    c     goto 20
1615    c     endif
1616    *     ----------------------------------------------------
1617                            
1618              cl_good(icy)=1                                cl_good(icy)=1                  
1619              nply=npl(VIEW(icy))              nply=npl(VIEW(icy))
# Line 2012  c      common/dbg/DEBUG Line 1624  c      common/dbg/DEBUG
1624  *     ----------------------------------------------  *     ----------------------------------------------
1625  *     geometrical consistency (same plane and ladder)  *     geometrical consistency (same plane and ladder)
1626              if(nply.eq.nplx.and.nldy.eq.nldx)then              if(nply.eq.nplx.and.nldy.eq.nldx)then
1627  *     charge correlation  *     charge correlation
1628  *     ===========================================================  *     (modified to be applied only below saturation... obviously)
1629  *     this version of the subroutine is used for the calibration  
1630  *     thus charge-correlation selection is obviously removed                 if(  .not.(sgnl(icy).gt.chsaty.and.sgnl(icx).gt.chsatx)
1631  *     ===========================================================       $              .and.
1632  c$$$               ddd=(dedx(icy)       $              .not.(sgnl(icy).lt.chmipy.and.sgnl(icx).lt.chmipx)
1633  c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))       $              .and.
1634  c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)       $              (badclx.eq.1.and.badcly.eq.1)
1635  c$$$               cut=chcut*sch(nplx,nldx)       $              .and.
1636  c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent       $              .true.)then
1637  *     ===========================================================  
1638                                    ddd=(sgnl(icy)
1639                       $                 -kch(nplx,nldx)*sgnl(icx)-cch(nplx,nldx))
1640  *     ------------------> COUPLE <------------------                    ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
1641  *     check to do not overflow vector dimentions  
1642    c                  cut = chcut * sch(nplx,nldx)
1643    
1644                      sss=(kch(nplx,nldx)*sgnl(icy)+sgnl(icx)
1645         $                 -kch(nplx,nldx)*cch(nplx,nldx))
1646                      sss=sss/sqrt(kch(nplx,nldx)**2+1)
1647                      cut = chcut * (16 + sss/50.)
1648    
1649                      if(abs(ddd).gt.cut)then
1650                         goto 20    !charge not consistent
1651                      endif
1652                   endif
1653    
1654                 if(ncp_plane(nplx).gt.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
1655                    if(DEBUG)print*,                    if(verbose)print*,
1656       $                    ' ** warning ** number of identified'//       $                 '** warning ** number of identified '//
1657       $                    ' couples on plane ',nplx,       $                 'couples on plane ',nplx,
1658       $                    ' exceeds vector dimention'//       $                 'exceeds vector dimention '
1659       $                    ' ( ',ncouplemax,' )'       $                 ,'( ',ncouplemax,' ) --> masked!'
1660  c     good2=.false.                    mask_view(nviewx(nplx)) = 2
1661  c     goto 880   !fill ntp and go to next event                    mask_view(nviewy(nply)) = 2
1662                    iflag=1                    goto 10
                   return  
1663                 endif                 endif
1664                                
1665  c$$$               if(ncp_plane(nplx).eq.ncouplemax)then  *     ------------------> COUPLE <------------------
 c$$$                  if(DEBUG)print*,  
 c$$$     $                 '** warning ** number of identified '//  
 c$$$     $                 'couples on plane ',nplx,  
 c$$$     $                 'exceeds vector dimention '  
 c$$$     $                 ,'( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event                      
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
                 
1666                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
1667                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
1668                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
1669                 cl_single(icx)=0                 cl_single(icx)=0
1670                 cl_single(icy)=0                 cl_single(icy)=0
             endif                                
1671  *     ----------------------------------------------  *     ----------------------------------------------
1672    
1673                endif                              
1674    
1675   20         continue   20         continue
1676           enddo                  !end loop on clusters(Y)           enddo                  !end loop on clusters(Y)
1677                    
# Line 2083  c$$$               endif Line 1696  c$$$               endif
1696        endif        endif
1697                
1698        do ip=1,6        do ip=1,6
1699           ncp_tot=ncp_tot+ncp_plane(ip)           ncp_tot = ncp_tot + ncp_plane(ip)
1700        enddo        enddo
 c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
         
       if(ncp_tot.gt.ncp_max)then  
          if(DEBUG)print*,  
      $           '** warning ** number of identified '//  
      $           'couples exceeds upper limit for Hough tr. '  
      $           ,'( ',ncp_max,' )'              
 c            good2=.false.  
 c     goto 880       !fill ntp and go to next event  
          iflag=1  
          return  
       endif  
1701                
1702        return        return
1703        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  
1704                
1705  ***************************************************  ***************************************************
1706  *                                                 *  *                                                 *
# Line 2321  c$$$      end Line 1712  c$$$      end
1712  **************************************************  **************************************************
1713    
1714        subroutine cp_to_doubtrip(iflag)        subroutine cp_to_doubtrip(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
1715    
1716        include 'commontracker.f'        include 'commontracker.f'
1717          include 'level1.f'
1718        include 'common_momanhough.f'        include 'common_momanhough.f'
       include 'momanhough_init.f'  
1719        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1720        include 'common_mini_2.f'        include 'common_mini_2.f'
1721        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
1722    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1723    
1724  *     output flag  *     output flag
1725  *     --------------  *     --------------
# Line 2367  c      double precision xm3,ym3,zm3 Line 1752  c      double precision xm3,ym3,zm3
1752  *     -----------------------------  *     -----------------------------
1753    
1754    
1755    *     --------------------------------------------
1756    *     put a limit to the maximum number of couples
1757    *     per plane, in order to apply hough transform
1758    *     (couples recovered during track refinement)
1759    *     --------------------------------------------
1760          do ip=1,nplanes
1761             if(ncp_plane(ip).gt.ncouplelimit)then
1762                mask_view(nviewx(ip)) = 8
1763                mask_view(nviewy(ip)) = 8
1764             endif
1765          enddo
1766    
1767    
1768        ndblt=0                   !number of doublets        ndblt=0                   !number of doublets
1769        ntrpt=0                   !number of triplets        ntrpt=0                   !number of triplets
1770                
1771        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1
1772           do is1=1,2             !loop on sensors - COPPIA 1           if(  mask_view(nviewx(ip1)).ne.0 .or.
1773                     $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
1774             do is1=1,2             !loop on sensors - COPPIA 1            
1775              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
1776                 icx1=clx(ip1,icp1)                 icx1=clx(ip1,icp1)
1777                 icy1=cly(ip1,icp1)                 icy1=cly(ip1,icp1)
1778  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
1779                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
1780                   call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
1781                 xm1=xPAM                 xm1=xPAM
1782                 ym1=yPAM                 ym1=yPAM
1783                 zm1=zPAM                                   zm1=zPAM                  
1784  c     print*,'***',is1,xm1,ym1,zm1  c     print*,'***',is1,xm1,ym1,zm1
1785    
1786                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
1787                      if(  mask_view(nviewx(ip2)).ne.0 .or.
1788         $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
1789                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    do is2=1,2    !loop on sensors -ndblt COPPIA 2
1790                                            
1791                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2
# Line 2391  c     print*,'***',is1,xm1,ym1,zm1 Line 1793  c     print*,'***',is1,xm1,ym1,zm1
1793                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
1794  c                        call xyz_PAM  c                        call xyz_PAM
1795  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
1796    c                        call xyz_PAM
1797    c     $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)
1798                          call xyz_PAM                          call xyz_PAM
1799       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.,0.,0.)
1800                          xm2=xPAM                          xm2=xPAM
1801                          ym2=yPAM                          ym2=yPAM
1802                          zm2=zPAM                          zm2=zPAM
# Line 2402  c     $                       (icx2,icy2 Line 1806  c     $                       (icx2,icy2
1806  *     (2 couples needed)  *     (2 couples needed)
1807  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1808                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
1809                             if(DEBUG)print*,                             if(verbose)print*,
1810       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
1811       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
1812       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
1813  c                           good2=.false.  c                           good2=.false.
1814  c                           goto 880 !fill ntp and go to next event  c                           goto 880 !fill ntp and go to next event
1815                               do iv=1,12
1816                                  mask_view(iv) = 3
1817                               enddo
1818                             iflag=1                             iflag=1
1819                             return                             return
1820                          endif                          endif
# Line 2441  c$$$ Line 1848  c$$$
1848  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1849    
1850    
1851                          if(ip2.eq.nplanes)goto 30 !no possible combination with 3 couples                          if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
1852    
1853                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
1854                               if(  mask_view(nviewx(ip3)).ne.0 .or.
1855         $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
1856                             do is3=1,2 !loop on sensors - COPPIA 3                             do is3=1,2 !loop on sensors - COPPIA 3
1857                                                                
1858                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
# Line 2450  c$$$ Line 1860  c$$$
1860                                   icy3=cly(ip3,icp3)                                   icy3=cly(ip3,icp3)
1861  c                                 call xyz_PAM  c                                 call xyz_PAM
1862  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
1863    c                                 call xyz_PAM
1864    c     $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)
1865                                   call xyz_PAM                                   call xyz_PAM
1866       $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)       $                                (icx3,icy3,is3,PFAdef,PFAdef
1867         $                                ,0.,0.,0.,0.)
1868                                   xm3=xPAM                                   xm3=xPAM
1869                                   ym3=yPAM                                   ym3=yPAM
1870                                   zm3=zPAM                                   zm3=zPAM
# Line 2472  c     $                                 Line 1885  c     $                                
1885  *     (3 couples needed)  *     (3 couples needed)
1886  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1887                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
1888                                      if(DEBUG)print*,                                      if(verbose)print*,
1889       $                     '** warning ** number of identified '//       $                     '** warning ** number of identified '//
1890       $                     'triplets exceeds vector dimention '       $                     'triplets exceeds vector dimention '
1891       $                    ,'( ',ntrpt_max,' )'       $                    ,'( ',ntrpt_max,' )'
1892  c                                    good2=.false.  c                                    good2=.false.
1893  c                                    goto 880 !fill ntp and go to next event  c                                    goto 880 !fill ntp and go to next event
1894                                        do iv=1,nviews
1895                                           mask_view(iv) = 4
1896                                        enddo
1897                                      iflag=1                                      iflag=1
1898                                      return                                      return
1899                                   endif                                   endif
# Line 2516  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp Line 1932  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp
1932                                endif                                endif
1933                             enddo !end loop on COPPIA 3                             enddo !end loop on COPPIA 3
1934                          enddo   !end loop on sensors - COPPIA 3                          enddo   !end loop on sensors - COPPIA 3
1935     30                     continue
1936                       enddo      !end loop on planes  - COPPIA 3                       enddo      !end loop on planes  - COPPIA 3
1937   30                  continue   31                  continue
1938                                            
1939   1                enddo         !end loop on COPPIA 2   1                enddo         !end loop on COPPIA 2
1940                 enddo            !end loop on sensors - COPPIA 2                 enddo            !end loop on sensors - COPPIA 2
1941     20            continue
1942              enddo               !end loop on planes  - COPPIA 2              enddo               !end loop on planes  - COPPIA 2
1943                            
1944           enddo                  !end loop on COPPIA1           enddo                  !end loop on COPPIA1
1945        enddo                     !end loop on sensors - COPPIA 1        enddo                     !end loop on sensors - COPPIA 1
1946     10   continue
1947        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
1948                
1949        if(DEBUG)then        if(DEBUG)then
# Line 2552  c     goto 880               !ntp fill Line 1971  c     goto 880               !ntp fill
1971        subroutine doub_to_YZcloud(iflag)        subroutine doub_to_YZcloud(iflag)
1972    
1973        include 'commontracker.f'        include 'commontracker.f'
1974          include 'level1.f'
1975        include 'common_momanhough.f'        include 'common_momanhough.f'
1976        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1977    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1978    
1979  *     output flag  *     output flag
1980  *     --------------  *     --------------
# Line 2588  c      common/dbg/DEBUG Line 2006  c      common/dbg/DEBUG
2006        distance=0        distance=0
2007        nclouds_yz=0              !number of clouds        nclouds_yz=0              !number of clouds
2008        npt_tot=0        npt_tot=0
2009          nloop=0                  
2010     90   continue                  
2011        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2012           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
2013                            
# Line 2691  c     print*,'*   idbref,idb2 ',idbref,i Line 2111  c     print*,'*   idbref,idb2 ',idbref,i
2111              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2112           enddo           enddo
2113  c     print*,'>>>> ',ncpused,npt,nplused  c     print*,'>>>> ',ncpused,npt,nplused
2114           if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  c         if(ncpused.lt.ncpyz_min)goto 2228 !next doublet
2115           if(npt.lt.nptyz_min)goto 2228 !next doublet           if(npt.lt.nptyz_min)goto 2228 !next doublet
2116           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2117                    
# Line 2699  c     print*,'>>>> ',ncpused,npt,nplused Line 2119  c     print*,'>>>> ',ncpused,npt,nplused
2119  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2120    
2121           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2122              if(DEBUG)print*,              if(verbose)print*,
2123       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2124       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2125       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2126  c               good2=.false.  c               good2=.false.
2127  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2128                do iv=1,nviews
2129                   mask_view(iv) = 5
2130                enddo
2131              iflag=1              iflag=1
2132              return              return
2133           endif           endif
# Line 2742  c$$$     $           ,(db_cloud(iii),iii Line 2165  c$$$     $           ,(db_cloud(iii),iii
2165        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2166                
2167                
2168          if(nloop.lt.nstepy)then      
2169            cutdistyz = cutdistyz+cutystep
2170            nloop     = nloop+1          
2171            goto 90                
2172          endif                    
2173          
2174        if(DEBUG)then        if(DEBUG)then
2175           print*,'---------------------- '           print*,'---------------------- '
2176           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
# Line 2768  c$$$     $           ,(db_cloud(iii),iii Line 2197  c$$$     $           ,(db_cloud(iii),iii
2197        subroutine trip_to_XZcloud(iflag)        subroutine trip_to_XZcloud(iflag)
2198    
2199        include 'commontracker.f'        include 'commontracker.f'
2200          include 'level1.f'
2201        include 'common_momanhough.f'        include 'common_momanhough.f'
2202        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2203    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2204    
2205  *     output flag  *     output flag
2206  *     --------------  *     --------------
# Line 2803  c      common/dbg/DEBUG Line 2231  c      common/dbg/DEBUG
2231        distance=0        distance=0
2232        nclouds_xz=0              !number of clouds                nclouds_xz=0              !number of clouds        
2233        npt_tot=0                 !total number of selected triplets        npt_tot=0                 !total number of selected triplets
2234          nloop=0                  
2235     91   continue                  
2236        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2237           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
2238  c     print*,'--------------'  c     print*,'--------------'
# Line 2904  c     print*,'check cp_used' Line 2334  c     print*,'check cp_used'
2334           do ip=1,nplanes           do ip=1,nplanes
2335              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2336           enddo           enddo
2337           if(ncpused.lt.ncpxz_min)goto 22288 !next triplet  c         if(ncpused.lt.ncpxz_min)goto 22288 !next triplet
2338           if(npt.lt.nptxz_min)goto 22288     !next triplet           if(npt.lt.nptxz_min)goto 22288     !next triplet
2339           if(nplused.lt.nplxz_min)goto 22288 !next doublet           if(nplused.lt.nplxz_min)goto 22288 !next triplet
2340                    
2341  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2342  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2343           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2344              if(DEBUG)print*,              if(verbose)print*,
2345       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2346       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2347       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2348  c     good2=.false.  c     good2=.false.
2349  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2350                do iv=1,nviews
2351                   mask_view(iv) = 6
2352                enddo
2353              iflag=1              iflag=1
2354              return              return
2355           endif           endif
# Line 2952  c$$$     $           ,(tr_cloud(iii),iii Line 2385  c$$$     $           ,(tr_cloud(iii),iii
2385  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2386  22288    continue  22288    continue
2387        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2388          
2389           if(nloop.lt.nstepx)then      
2390             cutdistxz=cutdistxz+cutxstep
2391             nloop=nloop+1          
2392             goto 91                
2393           endif                    
2394          
2395        if(DEBUG)then        if(DEBUG)then
2396           print*,'---------------------- '           print*,'---------------------- '
2397           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
# Line 2974  c$$$     $           ,(tr_cloud(iii),iii Line 2413  c$$$     $           ,(tr_cloud(iii),iii
2413  **************************************************  **************************************************
2414    
2415        subroutine clouds_to_ctrack(iflag)        subroutine clouds_to_ctrack(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2416    
2417        include 'commontracker.f'        include 'commontracker.f'
2418          include 'level1.f'
2419        include 'common_momanhough.f'        include 'common_momanhough.f'
2420        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2421        include 'common_mini_2.f'        include 'common_mini_2.f'
2422        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
2423    
2424  c      logical DEBUG  
 c      common/dbg/DEBUG  
2425    
2426  *     output flag  *     output flag
2427  *     --------------  *     --------------
# Line 3002  c      common/dbg/DEBUG Line 2437  c      common/dbg/DEBUG
2437  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2438  *     list of matching couples in the combination  *     list of matching couples in the combination
2439  *     between a XZ and YZ cloud  *     between a XZ and YZ cloud
2440        integer cp_match(nplanes,ncouplemax)        integer cp_match(nplanes,2*ncouplemax)
2441        integer ncp_match(nplanes)        integer ncp_match(nplanes)
2442  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2443        integer hit_plane(nplanes)        integer hit_plane(nplanes)
2444  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2445  *     variables for track fitting  *     variables for track fitting
2446        double precision AL_INI(5)        double precision AL_INI(5)
2447        double precision tath  c      double precision tath
2448  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2449  c      real fitz(nplanes)        !z coordinates of the planes in cm  c      real fitz(nplanes)        !z coordinates of the planes in cm
2450    
# Line 3075  c      real fitz(nplanes)        !z coor Line 2510  c      real fitz(nplanes)        !z coor
2510                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2511              enddo              enddo
2512                            
2513              if(nplused.lt.nplxz_min)goto 888 !next doublet  c            if(nplused.lt.nplxz_min)goto 888 !next doublet
2514                if(nplused.lt.nplyz_min)goto 888 !next doublet
2515              if(ncp_ok.lt.ncpok)goto 888 !next cloud              if(ncp_ok.lt.ncpok)goto 888 !next cloud
2516                            
2517              if(DEBUG)then              if(DEBUG)then
# Line 3102  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p Line 2538  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p
2538  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2539                            
2540  *     -------> INITIAL GUESS <-------  *     -------> INITIAL GUESS <-------
2541              AL_INI(1)=dreal(alfaxz1_av(ixz))  cccc       SBAGLIATO
2542              AL_INI(2)=dreal(alfayz1_av(iyz))  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2543              AL_INI(4)=datan(dreal(alfayz2_av(iyz))  c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2544       $           /dreal(alfaxz2_av(ixz)))  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2545              tath=-dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))  c$$$     $           /dreal(alfaxz2_av(ixz)))
2546              AL_INI(3)=tath/sqrt(1+tath**2)  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2547              AL_INI(5)=(1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2548                c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2549  c     print*,'*******',AL_INI(5)  cccc       GIUSTO (ma si sua guess())
2550              if(AL_INI(5).gt.defmax)goto 888 !next cloud  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2551                c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2552  c     print*,'alfaxz2, alfayz2 '  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2553  c     $              ,alfaxz2_av(ixz),alfayz2_av(iyz)  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2554                c$$$            IF(alfaxz2_av(ixz).NE.0)THEN
2555  *     -------> INITIAL GUESS <-------  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2556  c     print*,'AL_INI ',(al_ini(i),i=1,5)  c$$$     $           /dreal(alfaxz2_av(ixz)))
2557                c$$$            ELSE
2558    c$$$               AL_INI(4) = acos(-1.)/2
2559    c$$$               IF(alfayz2_av(iyz).LT.0)AL_INI(4) = AL_INI(4)+acos(-1.)
2560    c$$$            ENDIF
2561    c$$$            IF(alfaxz2_av(ixz).LT.0)AL_INI(4)= acos(-1.)+ AL_INI(4)
2562    c$$$            AL_INI(4) = -acos(-1.) + AL_INI(4) !from incidence direction to tracking rs
2563    c$$$            
2564    c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2565    c$$$            
2566    c$$$            if(AL_INI(5).gt.defmax)goto 888 !next cloud
2567                            
2568              if(DEBUG)then              if(DEBUG)then
2569                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2570                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))
# Line 3169  c     print*,'AL_INI ',(al_ini(i),i=1,5) Line 2615  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2615  *                                   *************************  *                                   *************************
2616  c                                    call xyz_PAM(icx,icy,is,  c                                    call xyz_PAM(icx,icy,is,
2617  c     $                                   'COG2','COG2',0.,0.)  c     $                                   'COG2','COG2',0.,0.)
2618    c                                    call xyz_PAM(icx,icy,is, !(1)
2619    c     $                                   PFAdef,PFAdef,0.,0.) !(1)
2620                                      call xyz_PAM(icx,icy,is, !(1)                                      call xyz_PAM(icx,icy,is, !(1)
2621       $                                   PFAdef,PFAdef,0.,0.) !(1)       $                                   PFAdef,PFAdef,0.,0.,0.,0.)
2622  *                                   *************************  *                                   *************************
2623  *                                   -----------------------------  *                                   -----------------------------
2624                                      xgood(nplanes-ip+1)=1.                                      xgood(nplanes-ip+1)=1.
# Line 3186  c     $                                 Line 2634  c     $                                
2634  *     **********************************************************  *     **********************************************************
2635  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
2636  *     **********************************************************  *     **********************************************************
2637    cccc  scommentare se si usa al_ini della nuvola
2638    c$$$                              do i=1,5
2639    c$$$                                 AL(i)=AL_INI(i)
2640    c$$$                              enddo
2641                                  call guess()
2642                                do i=1,5                                do i=1,5
2643                                   AL(i)=AL_INI(i)                                   AL_INI(i)=AL(i)
2644                                enddo                                enddo
2645                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
2646                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
2647                                call mini_2(jstep,ifail)                                iprint=0
2648    c                              if(DEBUG)iprint=1
2649                                  if(DEBUG)iprint=2
2650                                  call mini2(jstep,ifail,iprint)
2651                                if(ifail.ne.0) then                                if(ifail.ne.0) then
2652                                   if(DEBUG)then                                   if(DEBUG)then
2653                                      print *,                                      print *,
2654       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
2655       $                              //'(mini_2 in clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
2656                                        print*,'initial guess: '
2657    
2658                                        print*,'AL_INI(1) = ',AL_INI(1)
2659                                        print*,'AL_INI(2) = ',AL_INI(2)
2660                                        print*,'AL_INI(3) = ',AL_INI(3)
2661                                        print*,'AL_INI(4) = ',AL_INI(4)
2662                                        print*,'AL_INI(5) = ',AL_INI(5)
2663                                   endif                                   endif
2664                                   chi2=-chi2  c                                 chi2=-chi2
2665                                endif                                endif
2666  *     **********************************************************  *     **********************************************************
2667  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
# Line 3211  c     $                                 Line 2674  c     $                                
2674  *     --------------------------  *     --------------------------
2675                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
2676                                                                    
2677                                   if(DEBUG)print*,                                   if(verbose)print*,
2678       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
2679       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
2680       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
2681  c                                 good2=.false.  c                                 good2=.false.
2682  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
2683                                     do iv=1,nviews
2684                                        mask_view(iv) = 7
2685                                     enddo
2686                                   iflag=1                                   iflag=1
2687                                   return                                   return
2688                                endif                                endif
2689                                                                
2690                                ntracks = ntracks + 1                                ntracks = ntracks + 1
2691                                                                
 c$$$                              ndof=0                                  
2692                                do ip=1,nplanes                                do ip=1,nplanes
2693  c$$$                                 ndof=ndof  
 c$$$     $                                +int(xgood(ip))  
 c$$$     $                                +int(ygood(ip))  
2694                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
2695                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
2696                                   ZV_STORE(ip,ntracks)=sngl(zv(ip))                                                                       ZV_STORE(ip,ntracks)=sngl(zv(ip))                                    
# Line 3246  c$$$     $                               Line 2709  c$$$     $                              
2709                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2710                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
2711       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
2712                                        SENSOR_STORE(nplanes-ip+1,ntracks)
2713         $                              = is_cp(cp_match(ip,hit_plane(ip)))
2714                                        LADDER_STORE(nplanes-ip+1,ntracks)
2715         $                                   = LADDER(
2716         $                                   clx(ip,icp_cp(
2717         $                                   cp_match(ip,hit_plane(ip)
2718         $                                   ))));
2719                                   else                                   else
2720                                      CP_STORE(nplanes-ip+1,ntracks)=0                                      CP_STORE(nplanes-ip+1,ntracks)=0
2721                                        SENSOR_STORE(nplanes-ip+1,ntracks)=0
2722                                        LADDER_STORE(nplanes-ip+1,ntracks)=0
2723                                   endif                                   endif
2724                                     BX_STORE(nplanes-ip+1,ntracks)=0!I dont need it now
2725                                     BY_STORE(nplanes-ip+1,ntracks)=0!I dont need it now
2726                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   CLS_STORE(nplanes-ip+1,ntracks)=0
2727                                   do i=1,5                                   do i=1,5
2728                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
2729                                   enddo                                   enddo
2730                                enddo                                enddo
2731                                                                
 c$$$  *                             Number of Degree Of Freedom  
 c$$$  ndof=ndof-5                            
 c$$$  *                             reduced chi^2  
 c$$$  rchi2=chi2/dble(ndof)  
2732                                RCHI2_STORE(ntracks)=chi2                                RCHI2_STORE(ntracks)=chi2
2733                                                                
2734  *     --------------------------------  *     --------------------------------
# Line 3282  c$$$  rchi2=chi2/dble(ndof) Line 2752  c$$$  rchi2=chi2/dble(ndof)
2752           return           return
2753        endif        endif
2754                
2755    c$$$      if(DEBUG)then
2756    c$$$         print*,'****** TRACK CANDIDATES ***********'
2757    c$$$         print*,'#         R. chi2        RIG'
2758    c$$$         do i=1,ntracks
2759    c$$$            print*,i,' --- ',rchi2_store(i),' --- '
2760    c$$$     $           ,1./abs(AL_STORE(5,i))
2761    c$$$         enddo
2762    c$$$         print*,'***********************************'
2763    c$$$      endif
2764        if(DEBUG)then        if(DEBUG)then
2765           print*,'****** TRACK CANDIDATES ***********'          print*,'****** TRACK CANDIDATES *****************'
2766           print*,'#         R. chi2        RIG'          print*,'#         R. chi2        RIG         ndof'
2767           do i=1,ntracks          do i=1,ntracks
2768              print*,i,' --- ',rchi2_store(i),' --- '            ndof=0                !(1)
2769       $           ,1./abs(AL_STORE(5,i))            do ii=1,nplanes       !(1)
2770           enddo              ndof=ndof           !(1)
2771           print*,'***********************************'       $           +int(xgood_store(ii,i)) !(1)
2772         $           +int(ygood_store(ii,i)) !(1)
2773              enddo                 !(1)
2774              print*,i,' --- ',rchi2_store(i),' --- '
2775         $         ,1./abs(AL_STORE(5,i)),' --- ',ndof
2776            enddo
2777            print*,'*****************************************'
2778        endif        endif
2779                
2780                
# Line 3308  c$$$  rchi2=chi2/dble(ndof) Line 2793  c$$$  rchi2=chi2/dble(ndof)
2793    
2794        subroutine refine_track(ibest)        subroutine refine_track(ibest)
2795    
 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******************************************************  
2796    
2797        include 'commontracker.f'        include 'commontracker.f'
2798          include 'level1.f'
2799        include 'common_momanhough.f'        include 'common_momanhough.f'
2800        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2801        include 'common_mini_2.f'        include 'common_mini_2.f'
2802        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
       include 'level1.f'  
2803        include 'calib.f'        include 'calib.f'
2804    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
2805  *     flag to chose PFA  *     flag to chose PFA
2806        character*10 PFA        character*10 PFA
2807        common/FINALPFA/PFA        common/FINALPFA/PFA
2808    
2809          real k(6)
2810          DATA k/1.099730,0.418900,0.220939,0.220907,0.418771,1.100674/
2811    
2812          real xp,yp,zp
2813          real xyzp(3),bxyz(3)
2814          equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
2815    
2816  *     =================================================  *     =================================================
2817  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
2818  *                          and  *                          and
# Line 3338  c      common/dbg/DEBUG Line 2821  c      common/dbg/DEBUG
2821        call track_init        call track_init
2822        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
2823    
2824             xP=XV_STORE(nplanes-ip+1,ibest)
2825             yP=YV_STORE(nplanes-ip+1,ibest)
2826             zP=ZV_STORE(nplanes-ip+1,ibest)
2827             call gufld(xyzp,bxyz)
2828             BX_STORE(nplanes-ip+1,ibest)=bxyz(1)
2829             BY_STORE(nplanes-ip+1,ibest)=bxyz(2)
2830    c$$$  bxyz(1)=0
2831    c$$$         bxyz(2)=0
2832    c$$$         bxyz(3)=0
2833    *     |||||||||||||||||||||||||||||||||||||||||||||||||
2834  *     -------------------------------------------------  *     -------------------------------------------------
2835  *     If the plane has been already included, it just  *     If the plane has been already included, it just
2836  *     computes again the coordinates of the x-y couple  *     computes again the coordinates of the x-y couple
2837  *     using improved PFAs  *     using improved PFAs
2838  *     -------------------------------------------------  *     -------------------------------------------------
2839    *     |||||||||||||||||||||||||||||||||||||||||||||||||
2840           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
2841       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
2842                            
# Line 3356  c      common/dbg/DEBUG Line 2850  c      common/dbg/DEBUG
2850       $           ,ip_cp(id),ip       $           ,ip_cp(id),ip
2851              icx=clx(ip,icp)              icx=clx(ip,icp)
2852              icy=cly(ip,icp)              icy=cly(ip,icp)
2853    c            call xyz_PAM(icx,icy,is,
2854    c     $           PFA,PFA,
2855    c     $           AXV_STORE(nplanes-ip+1,ibest),
2856    c     $           AYV_STORE(nplanes-ip+1,ibest))
2857              call xyz_PAM(icx,icy,is,              call xyz_PAM(icx,icy,is,
 c     $           'ETA2','ETA2',  
2858       $           PFA,PFA,       $           PFA,PFA,
2859       $           AXV_STORE(nplanes-ip+1,ibest),       $           AXV_STORE(nplanes-ip+1,ibest),
2860       $           AYV_STORE(nplanes-ip+1,ibest))       $           AYV_STORE(nplanes-ip+1,ibest),
2861  c$$$  call xyz_PAM(icx,icy,is,       $           bxyz(1),
2862  c$$$  $              'COG2','COG2',       $           bxyz(2)
2863  c$$$  $              0.,       $           )
2864  c$$$  $              0.)  
2865              xm(nplanes-ip+1) = xPAM              xm(nplanes-ip+1) = xPAM
2866              ym(nplanes-ip+1) = yPAM              ym(nplanes-ip+1) = yPAM
2867              zm(nplanes-ip+1) = zPAM              zm(nplanes-ip+1) = zPAM
# Line 3373  c$$$  $              0.) Line 2870  c$$$  $              0.)
2870              resx(nplanes-ip+1) = resxPAM              resx(nplanes-ip+1) = resxPAM
2871              resy(nplanes-ip+1) = resyPAM              resy(nplanes-ip+1) = resyPAM
2872    
2873  c            dedxtrk(nplanes-ip+1) = (dedx(icx)+dedx(icy))/2. !(1)              dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx))
2874              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)  
2875                            
2876    *     |||||||||||||||||||||||||||||||||||||||||||||||||
2877  *     -------------------------------------------------  *     -------------------------------------------------
2878  *     If the plane has NOT  been already included,  *     If the plane has NOT  been already included,
2879  *     it tries to include a COUPLE or a single cluster  *     it tries to include a COUPLE or a single cluster
2880  *     -------------------------------------------------  *     -------------------------------------------------
2881    *     |||||||||||||||||||||||||||||||||||||||||||||||||
2882           else                             else                  
2883                                
2884              xgood(nplanes-ip+1)=0              xgood(nplanes-ip+1)=0
# Line 3388  c            dedxtrk(nplanes-ip+1) = (de Line 2886  c            dedxtrk(nplanes-ip+1) = (de
2886                                
2887  *     --------------------------------------------------------------  *     --------------------------------------------------------------
2888  *     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)  
2889              call whichsensor(ip,xP,yP,nldt,ist)              call whichsensor(ip,xP,yP,nldt,ist)
2890  *     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
2891              if(nldt.eq.0.or.ist.eq.0)goto 133              if(nldt.eq.0.or.ist.eq.0)goto 133
2892    
2893                SENSOR_STORE(nplanes-ip+1,IBEST)=ist
2894                LADDER_STORE(nplanes-ip+1,IBEST)=nldt
2895  *     --------------------------------------------------------------  *     --------------------------------------------------------------
2896    
2897              if(DEBUG)then              if(DEBUG)then
# Line 3430  c     $              cl_used(icy).eq.1.o Line 2928  c     $              cl_used(icy).eq.1.o
2928  *            *          
2929                 call xyz_PAM(icx,icy,ist,                 call xyz_PAM(icx,icy,ist,
2930       $              PFA,PFA,       $              PFA,PFA,
 c     $              'ETA2','ETA2',  
2931       $              AXV_STORE(nplanes-ip+1,ibest),       $              AXV_STORE(nplanes-ip+1,ibest),
2932       $              AYV_STORE(nplanes-ip+1,ibest))       $              AYV_STORE(nplanes-ip+1,ibest),
2933         $              bxyz(1),
2934         $              bxyz(2)
2935         $              )
2936                                
2937                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
2938    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
2939                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
2940                 if(DEBUG)print*,'( couple ',id                 if(DEBUG)print*,'( couple ',id
2941       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance
2942                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
2943                    xmm = xPAM                    xmm = xPAM
2944                    ymm = yPAM                    ymm = yPAM
# Line 3446  c     $              'ETA2','ETA2', Line 2947  c     $              'ETA2','ETA2',
2947                    rymm = resyPAM                    rymm = resyPAM
2948                    distmin = distance                    distmin = distance
2949                    idm = id                                      idm = id                  
2950  c                 dedxmm = (dedx(icx)+dedx(icy))/2. !(1)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
2951                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
2952                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)  c     QUIQUI --> non devo moltiplicare per clinc?!?!?!
2953                      clincnewc=10*sqrt(rymm**2+rxmm**2 !QUIQUI
2954         $                 +RCHI2_STORE(ibest)*k(ip)*(cov(1,1)+cov(2,2))) !QUIQUI
2955                 endif                 endif
2956   1188          continue   1188          continue
2957              enddo               !end loop on couples on plane icp              enddo               !end loop on couples on plane icp
2958              if(distmin.le.clinc)then                    c            if(distmin.le.clinc)then     !QUIQUI              
2959                if(distmin.le.clincnewc)then     !QUIQUI              
2960  *              -----------------------------------  *              -----------------------------------
2961                 xm(nplanes-ip+1) = xmm         !<<<                 xm(nplanes-ip+1) = xmm !<<<
2962                 ym(nplanes-ip+1) = ymm         !<<<                 ym(nplanes-ip+1) = ymm !<<<
2963                 zm(nplanes-ip+1) = zmm         !<<<                 zm(nplanes-ip+1) = zmm !<<<
2964                 xgood(nplanes-ip+1) = 1        !<<<                 xgood(nplanes-ip+1) = 1 !<<<
2965                 ygood(nplanes-ip+1) = 1        !<<<                 ygood(nplanes-ip+1) = 1 !<<<
2966                 resx(nplanes-ip+1)=rxmm        !<<<                 resx(nplanes-ip+1)=rxmm !<<<
2967                 resy(nplanes-ip+1)=rymm        !<<<                 resy(nplanes-ip+1)=rymm !<<<
2968  c              dedxtrk(nplanes-ip+1) = dedxmm !<<<  !(1)                 dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
2969                 dedxtrk_x(nplanes-ip+1) = dedxmmx    !(1)                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
                dedxtrk_y(nplanes-ip+1) = dedxmmy    !(1)  
2970  *              -----------------------------------  *              -----------------------------------
2971                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
2972                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG)print*,'%%%% included couple ',idm
2973       $              ,' (norm.dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clinc,' )'
2974                 goto 133         !next plane                 goto 133         !next plane
2975              endif              endif
2976  *     ================================================  *     ================================================
# Line 3500  c            if(DEBUG)print*,'>>>> try t Line 3003  c            if(DEBUG)print*,'>>>> try t
3003  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
3004                 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)
3005  *                                              !jump to the Y cluster  *                                              !jump to the Y cluster
3006    c               call xyz_PAM(icx,0,ist,
3007    c     $              PFA,PFA,
3008    c     $              AXV_STORE(nplanes-ip+1,ibest),0.)              
3009                 call xyz_PAM(icx,0,ist,                 call xyz_PAM(icx,0,ist,
 c     $              'ETA2','ETA2',  
3010       $              PFA,PFA,       $              PFA,PFA,
3011       $              AXV_STORE(nplanes-ip+1,ibest),0.)                     $              AXV_STORE(nplanes-ip+1,ibest),0.,
3012         $              bxyz(1),
3013         $              bxyz(2)
3014         $              )              
3015                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3016  c     if(DEBUG)print*,'normalized distance ',distance  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3017                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG)print*,'( cl-X ',icx
3018       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3019                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3020                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3021                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3519  c     if(DEBUG)print*,'normalized distan Line 3027  c     if(DEBUG)print*,'normalized distan
3027                    rymm = resyPAM                    rymm = resyPAM
3028                    distmin = distance                    distmin = distance
3029                    iclm = icx                    iclm = icx
3030  c                  dedxmm = dedx(icx) !(1)  c                  dedxmm = sgnl(icx) !(1)
3031                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3032                    dedxmmy = 0.        !(1)                    dedxmmy = 0.        !(1)
3033                 endif                                   endif                  
3034  11881          continue  11881          continue
# Line 3528  c                  dedxmm = dedx(icx) !( Line 3036  c                  dedxmm = dedx(icx) !(
3036  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
3037                 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)
3038  *                                              !jump to the next couple  *                                              !jump to the next couple
3039    c               call xyz_PAM(0,icy,ist,
3040    c     $              PFA,PFA,
3041    c     $              0.,AYV_STORE(nplanes-ip+1,ibest))
3042                 call xyz_PAM(0,icy,ist,                 call xyz_PAM(0,icy,ist,
 c     $              'ETA2','ETA2',  
3043       $              PFA,PFA,       $              PFA,PFA,
3044       $              0.,AYV_STORE(nplanes-ip+1,ibest))       $              0.,AYV_STORE(nplanes-ip+1,ibest),
3045         $              bxyz(1),
3046         $              bxyz(2)
3047         $              )
3048                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3049    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3050                 if(DEBUG)print*,'( cl-Y ',icy                 if(DEBUG)print*,'( cl-Y ',icy
3051       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3052                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3053                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3054                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3546  c     $              'ETA2','ETA2', Line 3060  c     $              'ETA2','ETA2',
3060                    rymm = resyPAM                    rymm = resyPAM
3061                    distmin = distance                    distmin = distance
3062                    iclm = icy                    iclm = icy
3063  c                 dedxmm = dedx(icy)  !(1)  c                 dedxmm = sgnl(icy)  !(1)
3064                    dedxmmx = 0.        !(1)                    dedxmmx = 0.        !(1)
3065                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3066                 endif                                   endif                  
3067  11882          continue  11882          continue
3068              enddo               !end loop on cluster inside couples              enddo               !end loop on cluster inside couples
3069  *----- single clusters -----------------------------------------------      *----- single clusters -----------------------------------------------  
3070    c            print*,'## ncls(',ip,') ',ncls(ip)
3071              do ic=1,ncls(ip)    !loop on single clusters              do ic=1,ncls(ip)    !loop on single clusters
3072                 icl=cls(ip,ic)                 icl=cls(ip,ic)
3073  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 3076  c               if(cl_used(icl).eq.1.or.
3076       $              .false.)goto 18882      !jump to the next singlet       $              .false.)goto 18882      !jump to the next singlet
3077                 if(mod(VIEW(icl),2).eq.0)then!<---- X view                 if(mod(VIEW(icl),2).eq.0)then!<---- X view
3078                    call xyz_PAM(icl,0,ist,                    call xyz_PAM(icl,0,ist,
 c     $                 'ETA2','ETA2',  
3079       $                 PFA,PFA,       $                 PFA,PFA,
3080       $                 AXV_STORE(nplanes-ip+1,ibest),0.)       $                 AXV_STORE(nplanes-ip+1,ibest),0.,
3081         $                 bxyz(1),
3082         $                 bxyz(2)
3083         $                 )
3084                 else                         !<---- Y view                 else                         !<---- Y view
3085                    call xyz_PAM(0,icl,ist,                    call xyz_PAM(0,icl,ist,
 c     $                 'ETA2','ETA2',  
3086       $                 PFA,PFA,       $                 PFA,PFA,
3087       $                 0.,AYV_STORE(nplanes-ip+1,ibest))       $                 0.,AYV_STORE(nplanes-ip+1,ibest),
3088         $                 bxyz(1),
3089         $                 bxyz(2)
3090         $                 )
3091                 endif                 endif
3092    
3093                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3094    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3095                 if(DEBUG)print*,'( cl-s ',icl                 if(DEBUG)print*,'( cl-s ',icl
3096       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance,'<',distmin,' ?'
3097                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3098                      if(DEBUG)print*,'YES'
3099                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3100                    ymm_A = yPAM_A                    ymm_A = yPAM_A
3101                    zmm_A = zPAM_A                    zmm_A = zPAM_A
# Line 3585  c     $                 'ETA2','ETA2', Line 3106  c     $                 'ETA2','ETA2',
3106                    rymm = resyPAM                    rymm = resyPAM
3107                    distmin = distance                      distmin = distance  
3108                    iclm = icl                    iclm = icl
 c                  dedxmm = dedx(icl)                   !(1)  
3109                    if(mod(VIEW(icl),2).eq.0)then !<---- X view                    if(mod(VIEW(icl),2).eq.0)then !<---- X view
3110                       dedxmmx = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3111                       dedxmmy = 0.                       !(1)                       dedxmmy = 0.                  
3112                    else          !<---- Y view                    else          !<---- Y view
3113                       dedxmmx = 0.                       !(1)                       dedxmmx = 0.                  
3114                       dedxmmy = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3115                    endif                    endif
3116                 endif                                   endif                  
3117  18882          continue  18882          continue
3118              enddo               !end loop on single clusters              enddo               !end loop on single clusters
3119    c            print*,'## distmin ', distmin,' clinc ',clinc
3120    
3121              if(distmin.le.clinc)then                    c     QUIQUI------------
3122                  c     anche qui: non ci vuole clinc???
3123                 CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<                  if(iclm.ne.0)then
 *              ----------------------------  
3124                 if(mod(VIEW(iclm),2).eq.0)then                 if(mod(VIEW(iclm),2).eq.0)then
3125                    XGOOD(nplanes-ip+1)=1.                    clincnew=
3126                    resx(nplanes-ip+1)=rxmm       $                 20*
3127                    if(DEBUG)print*,'%%%% included X-cl ',iclm       $                 sqrt(rxmm**2+RCHI2_STORE(ibest)*k(ip)*cov(1,1))
3128       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'                 else if(mod(VIEW(iclm),2).ne.0)then
3129                 else                    clincnew=
3130                    YGOOD(nplanes-ip+1)=1.       $                 10*
3131                    resy(nplanes-ip+1)=rymm       $                 sqrt(rymm**2+RCHI2_STORE(ibest)*k(ip)*cov(2,2))
3132                    if(DEBUG)print*,'%%%% included Y-cl ',iclm                 endif
3133       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'  c     QUIQUI------------
3134                  
3135                   if(distmin.le.clincnew)then   !QUIQUI
3136    c     if(distmin.le.clinc)then          !QUIQUI          
3137                      
3138                      CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<    
3139    *     ----------------------------
3140    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3141                      if(mod(VIEW(iclm),2).eq.0)then
3142                         XGOOD(nplanes-ip+1)=1.
3143                         resx(nplanes-ip+1)=rxmm
3144                         if(DEBUG)print*,'%%%% included X-cl ',iclm
3145         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3146         $                    ,', dist.= ',distmin
3147         $                    ,', cut ',clinc,' )'
3148                      else
3149                         YGOOD(nplanes-ip+1)=1.
3150                         resy(nplanes-ip+1)=rymm
3151                         if(DEBUG)print*,'%%%% included Y-cl ',iclm
3152         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3153         $                    ,', dist.= ', distmin
3154         $                    ,', cut ',clinc,' )'
3155                      endif
3156    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3157    *     ----------------------------
3158                      xm_A(nplanes-ip+1) = xmm_A
3159                      ym_A(nplanes-ip+1) = ymm_A
3160                      xm_B(nplanes-ip+1) = xmm_B
3161                      ym_B(nplanes-ip+1) = ymm_B
3162                      zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3163                      dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3164                      dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3165    *     ----------------------------
3166                 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)  
 *              ----------------------------  
3167              endif              endif
3168           endif           endif
3169   133     continue   133     continue
# Line 3640  c              dedxtrk(nplanes-ip+1) = d Line 3182  c              dedxtrk(nplanes-ip+1) = d
3182  *                                                 *  *                                                 *
3183  *                                                 *  *                                                 *
3184  **************************************************  **************************************************
 cccccc 12/08/2006 modified by elena ---> (1)  
3185  *  *
3186        subroutine clean_XYclouds(ibest,iflag)        subroutine clean_XYclouds(ibest,iflag)
3187    
3188        include 'commontracker.f'        include 'commontracker.f'
3189          include 'level1.f'
3190        include 'common_momanhough.f'        include 'common_momanhough.f'
3191        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  
   
3192    
3193        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3194    
# Line 3663  c      common/dbg/DEBUG Line 3198  c      common/dbg/DEBUG
3198              if(id.ne.0)then              if(id.ne.0)then
3199                 iclx=clx(ip,icp_cp(id))                 iclx=clx(ip,icp_cp(id))
3200                 icly=cly(ip,icp_cp(id))                 icly=cly(ip,icp_cp(id))
3201  c               cl_used(iclx)=1  !tag used clusters                 cl_used(iclx)=ntrk  !tag used clusters
3202  c               cl_used(icly)=1  !tag used clusters                 cl_used(icly)=ntrk  !tag used clusters
                cl_used(iclx)=ntrk  !tag used clusters !(1)  
                cl_used(icly)=ntrk  !tag used clusters !(1)  
3203              elseif(icl.ne.0)then              elseif(icl.ne.0)then
3204  c               cl_used(icl)=1   !tag used clusters                 cl_used(icl)=ntrk   !tag used clusters
                cl_used(icl)=ntrk   !tag used clusters !1)  
3205              endif              endif
3206                            
 c               if(DEBUG)then  
 c                  print*,ip,' <<< ',id  
 c               endif  
3207  *     -----------------------------  *     -----------------------------
3208  *     remove the couple from clouds  *     remove the couple from clouds
3209  *     remove also vitual couples containing the  *     remove also vitual couples containing the
# Line 3725  c               endif Line 3254  c               endif
3254    
3255    
3256    
 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$$$  
   
3257    
3258    
3259  *     ****************************************************  *     ****************************************************
3260    
3261        subroutine init_level2        subroutine init_level2
3262    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c*****************************************************  
   
3263        include 'commontracker.f'        include 'commontracker.f'
3264          include 'level1.f'
3265        include 'common_momanhough.f'        include 'common_momanhough.f'
3266        include 'level2.f'        include 'level2.f'
       include 'level1.f'  
3267    
3268    *     ---------------------------------
3269    *     variables initialized from level1
3270    *     ---------------------------------
3271        do i=1,nviews        do i=1,nviews
3272           good2(i)=good1(i)           good2(i)=good1(i)
3273             do j=1,nva1_view
3274                vkflag(i,j)=1
3275                if(cnnev(i,j).le.0)then
3276                   vkflag(i,j)=cnnev(i,j)
3277                endif
3278             enddo
3279        enddo        enddo
3280    *     ----------------
3281  c      good2 = 0!.false.  *     level2 variables
3282  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*****************************************************  
   
3283        NTRK = 0        NTRK = 0
3284        do it=1,NTRKMAX!NTRACKSMAX        do it=1,NTRKMAX
3285           IMAGE(IT)=0           IMAGE(IT)=0
3286           CHI2_nt(IT) = -100000.           CHI2_nt(IT) = -100000.
 c         BdL(IT) = 0.  
3287           do ip=1,nplanes           do ip=1,nplanes
3288              XM_nt(IP,IT) = 0              XM_nt(IP,IT) = 0
3289              YM_nt(IP,IT) = 0              YM_nt(IP,IT) = 0
3290              ZM_nt(IP,IT) = 0              ZM_nt(IP,IT) = 0
3291              RESX_nt(IP,IT) = 0              RESX_nt(IP,IT) = 0
3292              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3293                TAILX_nt(IP,IT) = 0
3294                TAILY_nt(IP,IT) = 0
3295                XBAD(IP,IT) = 0
3296                YBAD(IP,IT) = 0
3297              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3298              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
3299  c*****************************************************              LS(IP,IT) = 0
 cccccc 11/9/2005 modified by david fedele  
3300              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3301              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
 c******************************************************  
 cccccc 17/8/2006 modified by elena  
3302              CLTRX(IP,IT) = 0              CLTRX(IP,IT) = 0
3303              CLTRY(IP,IT) = 0              CLTRY(IP,IT) = 0
3304           enddo           enddo
# Line 3893  cccccc 17/8/2006 modified by elena Line 3309  cccccc 17/8/2006 modified by elena
3309              enddo                                enddo                  
3310           enddo                             enddo                  
3311        enddo        enddo
         
         
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3312        nclsx=0        nclsx=0
3313        nclsy=0              nclsy=0      
3314        do ip=1,NSINGMAX        do ip=1,NSINGMAX
3315          planex(ip)=0          planex(ip)=0
 c        xs(ip)=0  
3316          xs(1,ip)=0          xs(1,ip)=0
3317          xs(2,ip)=0          xs(2,ip)=0
3318          sgnlxs(ip)=0          sgnlxs(ip)=0
3319          planey(ip)=0          planey(ip)=0
 c        ys(ip)=0  
3320          ys(1,ip)=0          ys(1,ip)=0
3321          ys(2,ip)=0          ys(2,ip)=0
3322          sgnlys(ip)=0          sgnlys(ip)=0
3323        enddo        enddo
 c*******************************************************  
3324        end        end
3325    
3326    
# Line 3926  c*************************************** Line 3335  c***************************************
3335  ************************************************************  ************************************************************
3336    
3337    
3338          subroutine init_hough
3339    
3340          include 'commontracker.f'
3341          include 'level1.f'
3342          include 'common_momanhough.f'
3343          include 'common_hough.f'
3344          include 'level2.f'
3345    
3346          ntrpt_nt=0
3347          ndblt_nt=0
3348          NCLOUDS_XZ_nt=0
3349          NCLOUDS_YZ_nt=0
3350          do idb=1,ndblt_max_nt
3351             db_cloud_nt(idb)=0
3352             alfayz1_nt(idb)=0      
3353             alfayz2_nt(idb)=0      
3354          enddo
3355          do itr=1,ntrpt_max_nt
3356             tr_cloud_nt(itr)=0
3357             alfaxz1_nt(itr)=0      
3358             alfaxz2_nt(itr)=0      
3359             alfaxz3_nt(itr)=0      
3360          enddo
3361          do idb=1,ncloyz_max      
3362            ptcloud_yz_nt(idb)=0    
3363            alfayz1_av_nt(idb)=0    
3364            alfayz2_av_nt(idb)=0    
3365          enddo                    
3366          do itr=1,ncloxz_max      
3367            ptcloud_xz_nt(itr)=0    
3368            alfaxz1_av_nt(itr)=0    
3369            alfaxz2_av_nt(itr)=0    
3370            alfaxz3_av_nt(itr)=0    
3371          enddo                    
3372    
3373          ntrpt=0                  
3374          ndblt=0                  
3375          NCLOUDS_XZ=0              
3376          NCLOUDS_YZ=0              
3377          do idb=1,ndblt_max        
3378            db_cloud(idb)=0        
3379            cpyz1(idb)=0            
3380            cpyz2(idb)=0            
3381            alfayz1(idb)=0          
3382            alfayz2(idb)=0          
3383          enddo                    
3384          do itr=1,ntrpt_max        
3385            tr_cloud(itr)=0        
3386            cpxz1(itr)=0            
3387            cpxz2(itr)=0            
3388            cpxz3(itr)=0            
3389            alfaxz1(itr)=0          
3390            alfaxz2(itr)=0          
3391            alfaxz3(itr)=0          
3392          enddo                    
3393          do idb=1,ncloyz_max      
3394            ptcloud_yz(idb)=0      
3395            alfayz1_av(idb)=0      
3396            alfayz2_av(idb)=0      
3397            do idbb=1,ncouplemaxtot
3398              cpcloud_yz(idb,idbb)=0
3399            enddo                  
3400          enddo                    
3401          do itr=1,ncloxz_max      
3402            ptcloud_xz(itr)=0      
3403            alfaxz1_av(itr)=0      
3404            alfaxz2_av(itr)=0      
3405            alfaxz3_av(itr)=0      
3406            do itrr=1,ncouplemaxtot
3407              cpcloud_xz(itr,itrr)=0
3408            enddo                  
3409          enddo                    
3410          end
3411    ************************************************************
3412    *
3413    *
3414    *
3415    *
3416    *
3417    *
3418    *
3419    ************************************************************
3420    
3421    
3422        subroutine fill_level2_tracks(ntr)        subroutine fill_level2_tracks(ntr)
3423    
3424  *     -------------------------------------------------------  *     -------------------------------------------------------
# Line 3937  c*************************************** Line 3430  c***************************************
3430            
3431        include 'commontracker.f'        include 'commontracker.f'
3432        include 'level1.f'        include 'level1.f'
3433          include 'common_momanhough.f'
3434        include 'level2.f'        include 'level2.f'
3435        include 'common_mini_2.f'        include 'common_mini_2.f'
3436        include 'common_momanhough.f'        include 'calib.f'
3437        real sinth,phi,pig        !(4)  
3438          character*10 PFA
3439          common/FINALPFA/PFA
3440    
3441          real sinth,phi,pig
3442          integer ssensor,sladder
3443        pig=acos(-1.)        pig=acos(-1.)
3444    
3445  c      good2=1!.true.  *     -------------------------------------
3446        chi2_nt(ntr)        = sngl(chi2)        chi2_nt(ntr)        = sngl(chi2)
3447        nstep_nt(ntr)       = 0!nstep        nstep_nt(ntr)       = nstep
3448    *     -------------------------------------
3449        phi   = al(4)             !(4)        phi   = al(4)          
3450        sinth = al(3)             !(4)        sinth = al(3)            
3451        if(sinth.lt.0)then        !(4)        if(sinth.lt.0)then      
3452           sinth = -sinth         !(4)           sinth = -sinth        
3453           phi = phi + pig        !(4)           phi = phi + pig      
3454        endif                     !(4)        endif                    
3455        npig = aint(phi/(2*pig))  !(4)        npig = aint(phi/(2*pig))
3456        phi = phi - npig*2*pig    !(4)        phi = phi - npig*2*pig  
3457        if(phi.lt.0)              !(4)        if(phi.lt.0)            
3458       $     phi = phi + 2*pig    !(4)       $     phi = phi + 2*pig  
3459        al(4) = phi               !(4)        al(4) = phi              
3460        al(3) = sinth             !(4)        al(3) = sinth            
 *****************************************************  
3461        do i=1,5        do i=1,5
3462           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3463           do j=1,5           do j=1,5
3464              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3465           enddo           enddo
 c     print*,al_nt(i,ntr)  
3466        enddo        enddo
3467          *     -------------------------------------      
3468        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
3469           xgood_nt(ip,ntr) = int(xgood(ip))           xgood_nt(ip,ntr) = int(xgood(ip))
3470           ygood_nt(ip,ntr) = int(ygood(ip))           ygood_nt(ip,ntr) = int(ygood(ip))
# Line 3976  c     print*,al_nt(i,ntr) Line 3473  c     print*,al_nt(i,ntr)
3473           zm_nt(ip,ntr)    = sngl(zm(ip))           zm_nt(ip,ntr)    = sngl(zm(ip))
3474           RESX_nt(IP,ntr)  = sngl(resx(ip))           RESX_nt(IP,ntr)  = sngl(resx(ip))
3475           RESY_nt(IP,ntr)  = sngl(resy(ip))           RESY_nt(IP,ntr)  = sngl(resy(ip))
3476             TAILX_nt(IP,ntr) = 0.
3477             TAILY_nt(IP,ntr) = 0.
3478           xv_nt(ip,ntr)    = sngl(xv(ip))           xv_nt(ip,ntr)    = sngl(xv(ip))
3479           yv_nt(ip,ntr)    = sngl(yv(ip))           yv_nt(ip,ntr)    = sngl(yv(ip))
3480           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3481           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3482           ayv_nt(ip,ntr)   = sngl(ayv(ip))           ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3483  c        dedxp(ip,ntr)    = sngl(dedxtrk(ip))   !(1)  c     l'avevo dimenticato!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3484           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)           factor = sqrt(
3485           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)         $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3486         $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3487         $        1. )
3488    c     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3489             dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3490             dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3491        
3492           id  = CP_STORE(ip,IDCAND)           ax   = axv_nt(ip,ntr)
3493             ay   = ayv_nt(ip,ntr)
3494             bfx  = BX_STORE(ip,IDCAND)
3495             bfy  = BY_STORE(ip,IDCAND)
3496             if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3497             if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3498             tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3499             angx     = 180.*atan(tgtemp)/acos(-1.)
3500             tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3501             angy    = 180.*atan(tgtemp)/acos(-1.)
3502            
3503    c         print*,'* ',ip,bfx,bfy,angx,angy
3504    
3505             id  = CP_STORE(ip,IDCAND) ! couple id
3506           icl = CLS_STORE(ip,IDCAND)           icl = CLS_STORE(ip,IDCAND)
3507             ssensor = -1
3508             sladder = -1
3509             ssensor = SENSOR_STORE(ip,IDCAND)
3510             sladder = LADDER_STORE(ip,IDCAND)
3511             if(ip.eq.6.and.ssensor.ne.0)ssensor = 3 - ssensor !notazione paolo x align
3512             LS(IP,ntr)      = ssensor+10*sladder
3513    
3514           if(id.ne.0)then           if(id.ne.0)then
3515    c           >>> is a couple
3516              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3517              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3518  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  
3519    c$$$            if(is_cp(id).ne.ssensor)
3520    c$$$     $           print*,'ERROR is sensor assignment (couple)'
3521    c$$$     $           ,is_cp(id),ssensor
3522    c$$$            if(LADDER(clx(nplanes-ip+1,icp_cp(id))).ne.sladder)
3523    c$$$     $           print*,'ERROR is ladder assignment (couple)'
3524    c$$$     $           ,LADDER(clx(nplanes-ip+1,icp_cp(id))),sladder
3525                
3526                nnnnx = npfastrips(clx(nplanes-ip+1,icp_cp(id)),PFA,angx)
3527                nnnny = npfastrips(cly(nplanes-ip+1,icp_cp(id)),PFA,angy)            
3528                xbad(ip,ntr)= nbadstrips(nnnnx,clx(nplanes-ip+1,icp_cp(id)))
3529                ybad(ip,ntr)= nbadstrips(nnnny,cly(nplanes-ip+1,icp_cp(id)))
3530    
3531                if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3532         $           dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3533                if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3534         $           dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3535    
3536           elseif(icl.ne.0)then           elseif(icl.ne.0)then
3537              if(mod(VIEW(icl),2).eq.0)cltrx(ip,ntr)=icl  c           >>> is a singlet
3538              if(mod(VIEW(icl),2).eq.1)cltry(ip,ntr)=icl  c$$$            if(LADDER(icl).ne.sladder)
3539  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  c$$$     $           print*,'ERROR is ladder assignment (single)'
3540    c$$$     $           ,LADDER(icl),sladder
3541                if(mod(VIEW(icl),2).eq.0)then
3542                   cltrx(ip,ntr)=icl
3543                   nnnnn = npfastrips(icl,PFA,angx)
3544                   xbad(ip,ntr) = nbadstrips(nnnnn,icl)
3545                   if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3546                elseif(mod(VIEW(icl),2).eq.1)then
3547                   cltry(ip,ntr)=icl
3548                   nnnnn = npfastrips(icl,PFA,angy)
3549                   ybad(ip,ntr) = nbadstrips(nnnnn,icl)
3550                   if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3551                endif
3552           endif                     endif          
3553    
3554        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)  
3555    
3556    
3557    c$$$      print*,(xgood(i),i=1,6)
3558    c$$$      print*,(ygood(i),i=1,6)
3559    c$$$      print*,(ls(i,ntr),i=1,6)
3560    c$$$      print*,(dedx_x(i,ntr),i=1,6)
3561    c$$$      print*,(dedx_y(i,ntr),i=1,6)
3562    c$$$      print*,'-----------------------'
3563    
3564        end        end
3565    
3566        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*****************************************************  
3567    
3568  *     -------------------------------------------------------  *     -------------------------------------------------------
3569  *     This routine fills the  elements of the variables  *     This routine fills the  elements of the variables
# Line 4022  c*************************************** Line 3572  c***************************************
3572  *     -------------------------------------------------------  *     -------------------------------------------------------
3573    
3574        include 'commontracker.f'        include 'commontracker.f'
       include 'level1.f'  
       include 'level2.f'  
3575        include 'calib.f'        include 'calib.f'
3576          include 'level1.f'
3577        include 'common_momanhough.f'        include 'common_momanhough.f'
3578          include 'level2.f'
3579        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3580    
3581  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
 c      good2=1!.true.  
3582        nclsx = 0        nclsx = 0
3583        nclsy = 0        nclsy = 0
3584    
3585          do iv = 1,nviews
3586             if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
3587          enddo
3588    
3589        do icl=1,nclstr1        do icl=1,nclstr1
3590           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
3591              ip=nplanes-npl(VIEW(icl))+1                          ip=nplanes-npl(VIEW(icl))+1            
3592              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
3593                 nclsx = nclsx + 1                 nclsx = nclsx + 1
3594                 planex(nclsx) = ip                 planex(nclsx) = ip
3595                 sgnlxs(nclsx) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3596                   if(nsatstrips(icl).gt.0)sgnlxs(nclsx)=-sgnlxs(nclsx)
3597                 clsx(nclsx)   = icl                 clsx(nclsx)   = icl
3598                 do is=1,2                 do is=1,2
3599  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
3600                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
3601                      call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
3602                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2
3603                 enddo                 enddo
3604  c$$$               print*,'nclsx         ',nclsx  c$$$               print*,'nclsx         ',nclsx
# Line 4054  c$$$               print*,'xs(2,nclsx)   Line 3609  c$$$               print*,'xs(2,nclsx)  
3609              else                          !=== Y views              else                          !=== Y views
3610                 nclsy = nclsy + 1                 nclsy = nclsy + 1
3611                 planey(nclsy) = ip                 planey(nclsy) = ip
3612                 sgnlys(nclsy) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3613                   if(nsatstrips(icl).gt.0)sgnlys(nclsy)=-sgnlys(nclsy)
3614                 clsy(nclsy)   = icl                 clsy(nclsy)   = icl
3615                 do is=1,2                 do is=1,2
3616  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
3617                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
3618                      call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
3619                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2
3620                 enddo                 enddo
3621  c$$$               print*,'nclsy         ',nclsy  c$$$               print*,'nclsy         ',nclsy
# Line 4068  c$$$               print*,'ys(1,nclsy)   Line 3625  c$$$               print*,'ys(1,nclsy)  
3625  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)
3626              endif              endif
3627           endif           endif
 c      print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)  
3628    
3629  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
3630           whichtrack(icl) = cl_used(icl)           whichtrack(icl) = cl_used(icl)
# Line 4076  c      print*,icl,cl_used(icl),cl_good(i Line 3632  c      print*,icl,cl_used(icl),cl_good(i
3632        enddo        enddo
3633        end        end
3634    
3635    ***************************************************
3636    *                                                 *
3637    *                                                 *
3638    *                                                 *
3639    *                                                 *
3640    *                                                 *
3641    *                                                 *
3642    **************************************************
3643    
3644          subroutine fill_hough
3645    
3646    *     -------------------------------------------------------
3647    *     This routine fills the  variables related to the hough
3648    *     transform, for the debig n-tuple
3649    *     -------------------------------------------------------
3650    
3651          include 'commontracker.f'
3652          include 'level1.f'
3653          include 'common_momanhough.f'
3654          include 'common_hough.f'
3655          include 'level2.f'
3656    
3657          if(.false.
3658         $     .or.ntrpt.gt.ntrpt_max_nt
3659         $     .or.ndblt.gt.ndblt_max_nt
3660         $     .or.NCLOUDS_XZ.gt.ncloxz_max
3661         $     .or.NCLOUDS_yZ.gt.ncloyz_max
3662         $     )then
3663             ntrpt_nt=0
3664             ndblt_nt=0
3665             NCLOUDS_XZ_nt=0
3666             NCLOUDS_YZ_nt=0
3667          else
3668             ndblt_nt=ndblt
3669             ntrpt_nt=ntrpt
3670             if(ndblt.ne.0)then
3671                do id=1,ndblt
3672                   alfayz1_nt(id)=alfayz1(id) !Y0
3673                   alfayz2_nt(id)=alfayz2(id) !tg theta-yz
3674                enddo
3675             endif
3676             if(ndblt.ne.0)then
3677                do it=1,ntrpt
3678                   alfaxz1_nt(it)=alfaxz1(it) !X0
3679                   alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
3680                   alfaxz3_nt(it)=alfaxz3(it) !1/r
3681                enddo
3682             endif
3683             nclouds_yz_nt=nclouds_yz
3684             nclouds_xz_nt=nclouds_xz
3685             if(nclouds_yz.ne.0)then
3686                nnn=0
3687                do iyz=1,nclouds_yz
3688                   ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
3689                   alfayz1_av_nt(iyz)=alfayz1_av(iyz)
3690                   alfayz2_av_nt(iyz)=alfayz2_av(iyz)
3691                   nnn=nnn+ptcloud_yz(iyz)
3692                enddo
3693                do ipt=1,nnn
3694                   db_cloud_nt(ipt)=db_cloud(ipt)
3695                 enddo
3696             endif
3697             if(nclouds_xz.ne.0)then
3698                nnn=0
3699                do ixz=1,nclouds_xz
3700                   ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
3701                   alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
3702                   alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
3703                   alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
3704                   nnn=nnn+ptcloud_xz(ixz)              
3705                enddo
3706                do ipt=1,nnn
3707                  tr_cloud_nt(ipt)=tr_cloud(ipt)
3708                 enddo
3709             endif
3710          endif
3711          end
3712          

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

  ViewVC Help
Powered by ViewVC 1.1.23