/[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.22 by pam-fi, Wed May 9 07:50:58 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    *        /////////////////////////////////
613    *        AAAAHHHHHHHH!!!!!!!!!!!!!!!!!!!!!
614    *        *grvzkkjsdgjhhhgngbn###>:(
615    *        /////////////////////////////////
616    c         if(nplx.eq.6) angtemp = -1. * ax
617    c         if(nplx.eq.6) bfytemp = -1. * bfy
618             if(viewx.eq.12) angtemp = -1. * ax
619             if(viewx.eq.12) bfytemp = -1. * bfy
620             tgtemp   = tan(angtemp*acos(-1.)/180.) + pmuH_h*bfytemp*0.00001
621             angx     = 180.*atan(tgtemp)/acos(-1.)
622             stripx   = stripx - 0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
623    c$$$         print*,nplx,ax,bfy/10.
624    c$$$         print*,angx,0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
625    c$$$         print*,'========================'
626    c$$$         if(bfy.ne.0.)print*,viewx,'-x- '
627    c$$$     $        ,bfy,-1*0.5*pmuH_h*bfytemp*0.00001*SiDimZ
628    *        --------------------------
629    
630    c$$$         print*,'--- x-cl ---'
631    c$$$         istart = INDSTART(ICX)
632    c$$$         istop  = TOTCLLENGTH
633    c$$$         if(icx.lt.NCLSTR1)istop=INDSTART(ICX+1)-1
634    c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
635    c$$$         print*,(CLSIGNAL(i),i=istart,istop)
636    c$$$         print*,INDMAX(icx)
637    c$$$         print*,cog(4,icx)
638    c$$$         print*,fbad_cog(4,icx)
639            
640    
641             if(PFAx.eq.'COG1')then
642    
643                stripx  = stripx
644                resxPAM = 1e-4*pitchX/sqrt(12.)!!resxPAM
645    
646           elseif(PFAx.eq.'COG2')then           elseif(PFAx.eq.'COG2')then
647              stripx = stripx + cog(2,icx)              
648                stripx  = stripx + cog(2,icx)            
649                resxPAM = risx_cog(abs(angx))!TEMPORANEO              
650              resxPAM = resxPAM*fbad_cog(2,icx)              resxPAM = resxPAM*fbad_cog(2,icx)
651    
652             elseif(PFAx.eq.'COG3')then
653    
654                stripx  = stripx + cog(3,icx)            
655                resxPAM = risx_cog(abs(angx))!TEMPORANEO                      
656                resxPAM = resxPAM*fbad_cog(3,icx)
657    
658             elseif(PFAx.eq.'COG4')then
659    
660                stripx  = stripx + cog(4,icx)            
661                resxPAM = risx_cog(abs(angx))!TEMPORANEO                      
662                resxPAM = resxPAM*fbad_cog(4,icx)
663    
664           elseif(PFAx.eq.'ETA2')then           elseif(PFAx.eq.'ETA2')then
665  c            cog2 = cog(2,icx)  
666  c            etacorr = pfa_eta2(cog2,viewx,nldx,angx)                          stripx  = stripx + pfaeta2(icx,angx)          
667  c            stripx = stripx + etacorr              resxPAM = risx_eta2(abs(angx))
668              stripx = stripx + pfa_eta2(icx,angx)            !(3)              resxPAM = resxPAM*fbad_cog(2,icx)
             resxPAM = risx_eta2(angx)                       !   (4)  
669              if(DEBUG.and.fbad_cog(2,icx).ne.1)              if(DEBUG.and.fbad_cog(2,icx).ne.1)
670       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
671              resxPAM = resxPAM*fbad_cog(2,icx)  
672           elseif(PFAx.eq.'ETA3')then                         !(3)           elseif(PFAx.eq.'ETA3')then                        
673              stripx = stripx + pfa_eta3(icx,angx)            !(3)  
674              resxPAM = risx_eta3(angx)                       !   (4)              stripx  = stripx + pfaeta3(icx,angx)          
675              if(DEBUG.and.fbad_cog(3,icx).ne.1)              !(3)              resxPAM = risx_eta3(abs(angx))                      
676       $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)!(3)              resxPAM = resxPAM*fbad_cog(3,icx)              
677              resxPAM = resxPAM*fbad_cog(3,icx)               !(3)              if(DEBUG.and.fbad_cog(3,icx).ne.1)            
678           elseif(PFAx.eq.'ETA4')then                         !(3)       $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)
679              stripx = stripx + pfa_eta4(icx,angx)            !(3)  
680              resxPAM = risx_eta4(angx)                       !   (4)           elseif(PFAx.eq.'ETA4')then                        
681              if(DEBUG.and.fbad_cog(4,icx).ne.1)              !(3)  
682       $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)!(3)              stripx  = stripx + pfaeta4(icx,angx)            
683              resxPAM = resxPAM*fbad_cog(4,icx)               !(3)              resxPAM = risx_eta4(abs(angx))                      
684           elseif(PFAx.eq.'ETA')then                          !(3)              resxPAM = resxPAM*fbad_cog(4,icx)              
685              stripx = stripx + pfa_eta(icx,angx)             !(3)              if(DEBUG.and.fbad_cog(4,icx).ne.1)              
686              resxPAM = ris_eta(icx,angx)                     !   (4)       $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)
687              if(DEBUG.and.fbad_cog(2,icx).ne.1)              !(3)  
688       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)!(3)           elseif(PFAx.eq.'ETA')then  
689  c            resxPAM = resxPAM*fbad_cog(2,icx)               !(3)TEMPORANEO  
690              resxPAM = resxPAM*fbad_eta(icx,angx)             !(3)(4)              stripx  = stripx + pfaeta(icx,angx)            
691           elseif(PFAx.eq.'COG')then           !(2)              resxPAM = ris_eta(icx,angx)                    
692              stripx = stripx + cog(0,icx)     !(2)                      resxPAM = resxPAM*fbad_eta(icx,angx)            
693              resxPAM = risx_cog(angx)                        !   (4)              if(DEBUG.and.fbad_cog(2,icx).ne.1)              
694              resxPAM = resxPAM*fbad_cog(0,icx)!(2)       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
695    
696             elseif(PFAx.eq.'COG')then          
697    
698                stripx  = stripx + cog(0,icx)            
699                resxPAM = risx_cog(abs(angx))                    
700                resxPAM = resxPAM*fbad_cog(0,icx)
701    
702           else           else
703              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx
704             endif
705    
706    
707    *     ======================================
708    *     temporary patch for saturated clusters
709    *     ======================================
710             if( nsatstrips(icx).gt.0 )then
711                stripx  = stripx + cog(4,icx)            
712                resxPAM = pitchX*1e-4/sqrt(12.)
713                cc=cog(4,icx)
714    c$$$            print*,icx,' *** ',cc
715    c$$$            print*,icx,' *** ',resxPAM
716           endif           endif
717    
718        endif        endif
 c      if(icy.eq.0.and.icx.ne.0)  
 c     $     print*,PFAx,icx,angx,stripx,resxPAM,'***'  
719                
720  *     -----------------  *     -----------------
721  *     CLUSTER Y  *     CLUSTER Y
722  *     -----------------  *     -----------------
723    
724        if(icy.ne.0)then        if(icy.ne.0)then
725    
726           viewy = VIEW(icy)           viewy = VIEW(icy)
727           nldy = nld(MAXS(icy),VIEW(icy))           nldy = nld(MAXS(icy),VIEW(icy))
728           nply = npl(VIEW(icy))           nply = npl(VIEW(icy))
729           resyPAM = RESYAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           resyPAM = RESYAV
730             stripy = float(MAXS(icy))
731    
732           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
733              print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '              if(DEBUG) then
734       $           ,icx,icy                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '
735         $              ,icx,icy
736                endif
737              goto 100              goto 100
738           endif           endif
739            *        --------------------------
740           stripy = float(MAXS(icy))  *        magnetic-field corrections
741           if(PFAy.eq.'COG1')then !(1)  *        --------------------------
742              stripy = stripy     !(1)           tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
743              resyPAM = resyPAM   !(1)           angy    = 180.*atan(tgtemp)/acos(-1.)
744             stripy = stripy + 0.5*pmuH_e*bfx*0.00001*SiDimZ/pitchY
745    c$$$         if(bfx.ne.0.)print*,viewy,'-y- '
746    c$$$     $        ,bfx,0.5*pmuH_e*bfx*0.00001*SiDimZ
747    *        --------------------------
748            
749    c$$$         print*,'--- y-cl ---'
750    c$$$         istart = INDSTART(ICY)
751    c$$$         istop  = TOTCLLENGTH
752    c$$$         if(icy.lt.NCLSTR1)istop=INDSTART(ICY+1)-1
753    c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
754    c$$$         print*,(CLSIGNAL(i),i=istart,istop)
755    c$$$         print*,INDMAX(icy)
756    c$$$         print*,cog(4,icy)
757    c$$$         print*,fbad_cog(4,icy)
758    
759             if(PFAy.eq.'COG1')then
760    
761                stripy  = stripy    
762                resyPAM = 1e-4*pitchY/sqrt(12.)!resyPAM  
763    
764           elseif(PFAy.eq.'COG2')then           elseif(PFAy.eq.'COG2')then
765              stripy = stripy + cog(2,icy)  
766                stripy  = stripy + cog(2,icy)
767                resyPAM = risy_cog(abs(angy))!TEMPORANEO
768              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
769    
770             elseif(PFAy.eq.'COG3')then
771    
772                stripy  = stripy + cog(3,icy)
773                resyPAM = risy_cog(abs(angy))!TEMPORANEO
774                resyPAM = resyPAM*fbad_cog(3,icy)
775    
776             elseif(PFAy.eq.'COG4')then
777    
778                stripy  = stripy + cog(4,icy)
779                resyPAM = risy_cog(abs(angy))!TEMPORANEO
780                resyPAM = resyPAM*fbad_cog(4,icy)
781    
782           elseif(PFAy.eq.'ETA2')then           elseif(PFAy.eq.'ETA2')then
783  c            cog2 = cog(2,icy)  
784  c            etacorr = pfa_eta2(cog2,viewy,nldy,angy)              stripy  = stripy + pfaeta2(icy,angy)          
785  c            stripy = stripy + etacorr              resyPAM = risy_eta2(abs(angy))              
             stripy = stripy + pfa_eta2(icy,angy)            !(3)  
             resyPAM = risy_eta2(angy)                       !   (4)  
786              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
787              if(DEBUG.and.fbad_cog(2,icy).ne.1)              if(DEBUG.and.fbad_cog(2,icy).ne.1)
788       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
789           elseif(PFAy.eq.'ETA3')then                         !(3)  
790              stripy = stripy + pfa_eta3(icy,angy)            !(3)           elseif(PFAy.eq.'ETA3')then                      
791              resyPAM = resyPAM*fbad_cog(3,icy)               !(3)  
792              if(DEBUG.and.fbad_cog(3,icy).ne.1)              !(3)              stripy  = stripy + pfaeta3(icy,angy)
793       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)!(3)              resyPAM = resyPAM*fbad_cog(3,icy)  
794           elseif(PFAy.eq.'ETA4')then                         !(3)              if(DEBUG.and.fbad_cog(3,icy).ne.1)
795              stripy = stripy + pfa_eta4(icy,angy)            !(3)       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)
796              resyPAM = resyPAM*fbad_cog(4,icy)               !(3)  
797              if(DEBUG.and.fbad_cog(4,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA4')then  
798       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)!(3)  
799           elseif(PFAy.eq.'ETA')then                          !(3)              stripy  = stripy + pfaeta4(icy,angy)
800              stripy = stripy + pfa_eta(icy,angy)             !(3)              resyPAM = resyPAM*fbad_cog(4,icy)
801              resyPAM = ris_eta(icy,angy)                     !   (4)              if(DEBUG.and.fbad_cog(4,icy).ne.1)
802  c            resyPAM = resyPAM*fbad_cog(2,icy)              !(3)TEMPORANEO       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)
803              resyPAM = resyPAM*fbad_eta(icy,angy)            !   (4)  
804              if(DEBUG.and.fbad_cog(2,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA')then
805       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)!(3)  
806                stripy  = stripy + pfaeta(icy,angy)
807                resyPAM = ris_eta(icy,angy)  
808                resyPAM = resyPAM*fbad_eta(icy,angy)
809                if(DEBUG.and.fbad_cog(2,icy).ne.1)
810         $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
811    
812           elseif(PFAy.eq.'COG')then           elseif(PFAy.eq.'COG')then
813              stripy = stripy + cog(0,icy)              
814              resyPAM = risy_cog(angy)                        !   (4)              stripy  = stripy + cog(0,icy)            
815  c            resyPAM = ris_eta(icy,angy)                    !   (4)              resyPAM = risy_cog(abs(angy))
816              resyPAM = resyPAM*fbad_cog(0,icy)              resyPAM = resyPAM*fbad_cog(0,icy)
817    
818           else           else
819              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx
820             endif
821    
822    
823    *     ======================================
824    *     temporary patch for saturated clusters
825    *     ======================================
826             if( nsatstrips(icy).gt.0 )then
827                stripy  = stripy + cog(4,icy)            
828                resyPAM = pitchY*1e-4/sqrt(12.)
829                cc=cog(4,icy)
830    c$$$            print*,icy,' *** ',cc
831    c$$$            print*,icy,' *** ',resyPAM
832           endif           endif
833    
834    
835        endif        endif
836    
837          c      print*,'## stripx,stripy ',stripx,stripy
838    
839  c===========================================================  c===========================================================
840  C     COUPLE  C     COUPLE
841  C===========================================================  C===========================================================
# Line 777  c     (xi,yi,zi) = mechanical coordinate Line 846  c     (xi,yi,zi) = mechanical coordinate
846  c------------------------------------------------------------------------  c------------------------------------------------------------------------
847           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
848       $        .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...
849              print*,'xyz_PAM (couple):',              if(DEBUG) then
850       $          ' WARNING: false X strip: strip ',stripx                 print*,'xyz_PAM (couple):',
851         $              ' WARNING: false X strip: strip ',stripx
852                endif
853           endif           endif
854           xi = acoordsi(stripx,viewx)           xi = acoordsi(stripx,viewx)
855           yi = acoordsi(stripy,viewy)           yi = acoordsi(stripy,viewy)
# Line 870  c            print*,'X-singlet ',icx,npl Line 941  c            print*,'X-singlet ',icx,npl
941  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...
942              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
943       $           .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...
944                 print*,'xyz_PAM (X-singlet):',                 if(DEBUG) then
945       $             ' WARNING: false X strip: strip ',stripx                    print*,'xyz_PAM (X-singlet):',
946         $                 ' WARNING: false X strip: strip ',stripx
947                   endif
948              endif              endif
949              xi   = acoordsi(stripx,viewx)              xi   = acoordsi(stripx,viewx)
950    
# Line 893  c            print*,'X-cl ',icx,stripx,' Line 966  c            print*,'X-cl ',icx,stripx,'
966  c            print*,yi_A,' <--> ',yi_B  c            print*,yi_A,' <--> ',yi_B
967    
968           else           else
969                if(DEBUG) then
970              print *,'routine xyz_PAM ---> not properly used !!!'                 print *,'routine xyz_PAM ---> not properly used !!!'
971              print *,'icx = ',icx                 print *,'icx = ',icx
972              print *,'icy = ',icy                 print *,'icy = ',icy
973                endif
974              goto 100              goto 100
975                            
976           endif           endif
# Line 961  c--------------------------------------- Line 1035  c---------------------------------------
1035  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'
1036    
1037        else        else
1038                       if(DEBUG) then
1039           print *,'routine xyz_PAM ---> not properly used !!!'              print *,'routine xyz_PAM ---> not properly used !!!'
1040           print *,'icx = ',icx              print *,'icx = ',icx
1041           print *,'icy = ',icy              print *,'icy = ',icy
1042                         endif
1043        endif        endif
1044                    
1045    
1046    c      print*,'## xPAM,yPAM,zPAM       ',xPAM,yPAM,zPAM
1047    c      print*,'## xPAM_A,yPAM_A,zPAM_A ',xPAM_A,yPAM_A,zPAM_A
1048    c      print*,'## xPAM_B,yPAM_B,zPAM_B ',xPAM_B,yPAM_B,zPAM_B
1049    
1050   100  continue   100  continue
1051        end        end
1052    
# Line 1046  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1125  c         print*,'A-(',xPAM_A,yPAM_A,')
1125           endif                   endif        
1126    
1127           distance=           distance=
1128       $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2       $       ((xmi-XPP)**2+(ymi-YPP)**2)!QUIQUI
1129    cc     $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1130           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1131    
1132  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 1151  c$$$         print*,' resolution ',re
1151  *     ----------------------  *     ----------------------
1152                    
1153           distance=           distance=
1154       $        ((xPAM-XPP)/resxPAM)**2       $       ((xPAM-XPP))**2 !QUIQUI
1155       $        +       $       +
1156       $        ((yPAM-YPP)/resyPAM)**2       $       ((yPAM-YPP))**2
1157    c$$$     $        ((xPAM-XPP)/resxPAM)**2
1158    c$$$     $        +
1159    c$$$     $        ((yPAM-YPP)/resyPAM)**2
1160           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1161    
1162  c$$$         print*,xPAM,yPAM,zPAM  c$$$         print*,xPAM,yPAM,zPAM
# Line 1082  c$$$         print*,' resolution ',resxP Line 1165  c$$$         print*,' resolution ',resxP
1165                    
1166        else        else
1167                    
1168           print*  c         print*
1169       $        ,' function distance_to ---> wrong usage!!!'  c     $        ,' function distance_to ---> wrong usage!!!'
1170           print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM  c         print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM
1171           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 '
1172       $        ,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
1173        endif          endif  
1174    
1175        distance_to = sngl(distance)        distance_to = sngl(distance)
# Line 1154  c--------------------------------------- Line 1237  c---------------------------------------
1237                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1238       $              .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...
1239  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...
1240                    print*,'whichsensor: ',  c                  print*,'whichsensor: ',
1241       $                ' WARNING: false X strip: strip ',stripx  c     $                ' WARNING: false X strip: strip ',stripx
1242                 endif                 endif
1243                 xi = acoordsi(stripx,viewx)                 xi = acoordsi(stripx,viewx)
1244                 yi = acoordsi(stripy,viewy)                 yi = acoordsi(stripy,viewy)
# Line 1284  c     $              ,iv,xvv(iv),yvv(iv) Line 1367  c     $              ,iv,xvv(iv),yvv(iv)
1367  *     it returns the plane number  *     it returns the plane number
1368  *      *    
1369        include 'commontracker.f'        include 'commontracker.f'
1370          include 'level1.f'
1371  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1372        include 'common_momanhough.f'        include 'common_momanhough.f'
1373                
# Line 1309  c      include 'common_analysis.f' Line 1393  c      include 'common_analysis.f'
1393        is_cp=0        is_cp=0
1394        if(id.lt.0)is_cp=1        if(id.lt.0)is_cp=1
1395        if(id.gt.0)is_cp=2        if(id.gt.0)is_cp=2
1396        if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'  c      if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'
1397    
1398        return        return
1399        end        end
# Line 1321  c      include 'common_analysis.f' Line 1405  c      include 'common_analysis.f'
1405  *     it returns the id number ON THE PLANE  *     it returns the id number ON THE PLANE
1406  *      *    
1407        include 'commontracker.f'        include 'commontracker.f'
1408          include 'level1.f'
1409  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1410        include 'common_momanhough.f'        include 'common_momanhough.f'
1411                
# Line 1349  c      include 'common_analysis.f' Line 1434  c      include 'common_analysis.f'
1434  *     positive if sensor =2  *     positive if sensor =2
1435  *  *
1436        include 'commontracker.f'        include 'commontracker.f'
1437          include 'level1.f'
1438  c      include 'calib.f'  c      include 'calib.f'
1439  c      include 'level1.f'  c      include 'level1.f'
1440  c      include 'common_analysis.f'  c      include 'common_analysis.f'
# Line 1365  c      include 'common_analysis.f' Line 1451  c      include 'common_analysis.f'
1451        id_cp = id_cp + icp        id_cp = id_cp + icp
1452    
1453        if(is.eq.1) id_cp = -id_cp        if(is.eq.1) id_cp = -id_cp
1454    
       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  
         
1455        return        return
1456        end        end
1457    
1458    
1459    
1460    
1461    *************************************************************************
1462    *************************************************************************
1463    *************************************************************************
1464    *************************************************************************
1465    *************************************************************************
1466    *************************************************************************
1467                
1468    
1469  ***************************************************  ***************************************************
1470  *                                                 *  *                                                 *
1471  *                                                 *  *                                                 *
# Line 1889  c     goto 880       !fill ntp and go to Line 1474  c     goto 880       !fill ntp and go to
1474  *                                                 *  *                                                 *
1475  *                                                 *  *                                                 *
1476  **************************************************  **************************************************
1477        subroutine cl_to_couples_nocharge(iflag)  
1478          subroutine cl_to_couples(iflag)
1479    
1480        include 'commontracker.f'        include 'commontracker.f'
1481          include 'level1.f'
1482        include 'common_momanhough.f'        include 'common_momanhough.f'
1483        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1484        include 'calib.f'        include 'calib.f'
1485        include 'level1.f'  c      include 'level1.f'
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1486    
1487  *     output flag  *     output flag
1488  *     --------------  *     --------------
# Line 1907  c      common/dbg/DEBUG Line 1491  c      common/dbg/DEBUG
1491  *     --------------  *     --------------
1492        integer iflag        integer iflag
1493    
1494        integer badseed,badcl        integer badseed,badclx,badcly
1495    
1496  *     init variables  *     init variables
1497        ncp_tot=0        ncp_tot=0
# Line 1923  c      common/dbg/DEBUG Line 1507  c      common/dbg/DEBUG
1507           ncls(ip)=0           ncls(ip)=0
1508        enddo        enddo
1509        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1510           cl_single(icl)=1           cl_single(icl) = 1
1511           cl_good(icl)=0           cl_good(icl)   = 0
1512          enddo
1513          do iv=1,nviews
1514             ncl_view(iv)  = 0
1515             mask_view(iv) = 0      !all included
1516        enddo        enddo
1517                
1518    *     count number of cluster per view
1519          do icl=1,nclstr1
1520             ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1        
1521          enddo
1522    *     mask views with too many clusters
1523          do iv=1,nviews
1524             if( ncl_view(iv).gt. nclusterlimit)then
1525                mask_view(iv) = 1
1526                if(DEBUG)print*,' * WARNING * cl_to_couple: n.clusters > '
1527         $           ,nclusterlimit,' on view ', iv,' --> masked!'
1528             endif
1529          enddo
1530    
1531    
1532  *     start association  *     start association
1533        ncouples=0        ncouples=0
1534        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1535           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1536                    
1537  *     ----------------------------------------------------  *     ----------------------------------------------------
1538    *     jump masked views (X VIEW)
1539    *     ----------------------------------------------------
1540             if( mask_view(VIEW(icx)).ne.0 ) goto 10
1541    *     ----------------------------------------------------
1542  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1543           if(dedx(icx).lt.dedx_x_min)then  *     ----------------------------------------------------
1544             if(sgnl(icx).lt.dedx_x_min)then
1545              cl_single(icx)=0              cl_single(icx)=0
1546              goto 10              goto 10
1547           endif           endif
1548    *     ----------------------------------------------------
1549  *     cut BAD (X VIEW)              *     cut BAD (X VIEW)            
1550    *     ----------------------------------------------------
1551           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
1552           ifirst=INDSTART(icx)           ifirst=INDSTART(icx)
1553           if(icx.ne.nclstr1) then           if(icx.ne.nclstr1) then
# Line 1946  c      common/dbg/DEBUG Line 1555  c      common/dbg/DEBUG
1555           else           else
1556              ilast=TOTCLLENGTH              ilast=TOTCLLENGTH
1557           endif           endif
1558           badcl=badseed           badclx=badseed
1559           do igood=-ngoodstr,ngoodstr           do igood=-ngoodstr,ngoodstr
1560              ibad=1              ibad=1
1561              if((INDMAX(icx)+igood).gt.ifirst.and.              if((INDMAX(icx)+igood).gt.ifirst.and.
# Line 1956  c      common/dbg/DEBUG Line 1565  c      common/dbg/DEBUG
1565       $              nvk(MAXS(icx)+igood),       $              nvk(MAXS(icx)+igood),
1566       $              nst(MAXS(icx)+igood))       $              nst(MAXS(icx)+igood))
1567              endif              endif
1568              badcl=badcl*ibad              badclx=badclx*ibad
1569           enddo           enddo
1570           if(badcl.eq.0)then     !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1571              cl_single(icx)=0    !<<<<<<<<<<<<<< BAD cut  *     >>> eliminato il taglio sulle BAD <<<
1572              goto 10             !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1573           endif                  !<<<<<<<<<<<<<< BAD cut  c     if(badcl.eq.0)then
1574    c     cl_single(icx)=0
1575    c     goto 10
1576    c     endif
1577  *     ----------------------------------------------------  *     ----------------------------------------------------
1578                    
1579           cl_good(icx)=1           cl_good(icx)=1
# Line 1972  c      common/dbg/DEBUG Line 1584  c      common/dbg/DEBUG
1584              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1585                            
1586  *     ----------------------------------------------------  *     ----------------------------------------------------
1587    *     jump masked views (Y VIEW)
1588    *     ----------------------------------------------------
1589                if( mask_view(VIEW(icy)).ne.0 ) goto 20
1590    
1591    *     ----------------------------------------------------
1592  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1593              if(dedx(icy).lt.dedx_y_min)then  *     ----------------------------------------------------
1594                if(sgnl(icy).lt.dedx_y_min)then
1595                 cl_single(icy)=0                 cl_single(icy)=0
1596                 goto 20                 goto 20
1597              endif              endif
1598    *     ----------------------------------------------------
1599  *     cut BAD (Y VIEW)              *     cut BAD (Y VIEW)            
1600    *     ----------------------------------------------------
1601              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
1602              ifirst=INDSTART(icy)              ifirst=INDSTART(icy)
1603              if(icy.ne.nclstr1) then              if(icy.ne.nclstr1) then
# Line 1985  c      common/dbg/DEBUG Line 1605  c      common/dbg/DEBUG
1605              else              else
1606                 ilast=TOTCLLENGTH                 ilast=TOTCLLENGTH
1607              endif              endif
1608              badcl=badseed              badcly=badseed
1609              do igood=-ngoodstr,ngoodstr              do igood=-ngoodstr,ngoodstr
1610                 ibad=1                 ibad=1
1611                 if((INDMAX(icy)+igood).gt.ifirst.and.                 if((INDMAX(icy)+igood).gt.ifirst.and.
# Line 1994  c      common/dbg/DEBUG Line 1614  c      common/dbg/DEBUG
1614       $              ibad=BAD(VIEW(icy),       $              ibad=BAD(VIEW(icy),
1615       $              nvk(MAXS(icy)+igood),       $              nvk(MAXS(icy)+igood),
1616       $              nst(MAXS(icy)+igood))       $              nst(MAXS(icy)+igood))
1617                 badcl=badcl*ibad                 badcly=badcly*ibad
1618              enddo              enddo
             if(badcl.eq.0)then  !<<<<<<<<<<<<<< BAD cut  
                cl_single(icy)=0 !<<<<<<<<<<<<<< BAD cut  
                goto 20          !<<<<<<<<<<<<<< BAD cut  
             endif               !<<<<<<<<<<<<<< BAD cut  
1619  *     ----------------------------------------------------  *     ----------------------------------------------------
1620                *     >>> eliminato il taglio sulle BAD <<<
1621    *     ----------------------------------------------------
1622    c     if(badcl.eq.0)then
1623    c     cl_single(icy)=0
1624    c     goto 20
1625    c     endif
1626    *     ----------------------------------------------------
1627                            
1628              cl_good(icy)=1                                cl_good(icy)=1                  
1629              nply=npl(VIEW(icy))              nply=npl(VIEW(icy))
# Line 2012  c      common/dbg/DEBUG Line 1634  c      common/dbg/DEBUG
1634  *     ----------------------------------------------  *     ----------------------------------------------
1635  *     geometrical consistency (same plane and ladder)  *     geometrical consistency (same plane and ladder)
1636              if(nply.eq.nplx.and.nldy.eq.nldx)then              if(nply.eq.nplx.and.nldy.eq.nldx)then
1637  *     charge correlation  *     charge correlation
1638  *     ===========================================================  *     (modified to be applied only below saturation... obviously)
1639  *     this version of the subroutine is used for the calibration  
1640  *     thus charge-correlation selection is obviously removed                 if(  .not.(sgnl(icy).gt.chsaty.and.sgnl(icx).gt.chsatx)
1641  *     ===========================================================       $              .and.
1642  c$$$               ddd=(dedx(icy)       $              .not.(sgnl(icy).lt.chmipy.and.sgnl(icx).lt.chmipx)
1643  c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))       $              .and.
1644  c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)       $              (badclx.eq.1.and.badcly.eq.1)
1645  c$$$               cut=chcut*sch(nplx,nldx)       $              .and.
1646  c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent       $              .true.)then
1647  *     ===========================================================  
1648                                    ddd=(sgnl(icy)
1649                       $                 -kch(nplx,nldx)*sgnl(icx)-cch(nplx,nldx))
1650  *     ------------------> COUPLE <------------------                    ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
1651  *     check to do not overflow vector dimentions  
1652    c                  cut = chcut * sch(nplx,nldx)
1653    
1654                      sss=(kch(nplx,nldx)*sgnl(icy)+sgnl(icx)
1655         $                 -kch(nplx,nldx)*cch(nplx,nldx))
1656                      sss=sss/sqrt(kch(nplx,nldx)**2+1)
1657                      cut = chcut * (16 + sss/50.)
1658    
1659                      if(abs(ddd).gt.cut)then
1660                         goto 20    !charge not consistent
1661                      endif
1662                   endif
1663    
1664                 if(ncp_plane(nplx).gt.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
1665                    if(DEBUG)print*,                    if(verbose)print*,
1666       $                    ' ** warning ** number of identified'//       $                 '** warning ** number of identified '//
1667       $                    ' couples on plane ',nplx,       $                 'couples on plane ',nplx,
1668       $                    ' exceeds vector dimention'//       $                 'exceeds vector dimention '
1669       $                    ' ( ',ncouplemax,' )'       $                 ,'( ',ncouplemax,' ) --> masked!'
1670  c     good2=.false.                    mask_view(nviewx(nplx)) = 2
1671  c     goto 880   !fill ntp and go to next event                    mask_view(nviewy(nply)) = 2
1672                    iflag=1                    goto 10
                   return  
1673                 endif                 endif
1674                                
1675  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  
                 
1676                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
1677                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
1678                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
1679                 cl_single(icx)=0                 cl_single(icx)=0
1680                 cl_single(icy)=0                 cl_single(icy)=0
             endif                                
1681  *     ----------------------------------------------  *     ----------------------------------------------
1682    
1683                endif                              
1684    
1685   20         continue   20         continue
1686           enddo                  !end loop on clusters(Y)           enddo                  !end loop on clusters(Y)
1687                    
# Line 2083  c$$$               endif Line 1706  c$$$               endif
1706        endif        endif
1707                
1708        do ip=1,6        do ip=1,6
1709           ncp_tot=ncp_tot+ncp_plane(ip)           ncp_tot = ncp_tot + ncp_plane(ip)
1710        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  
1711                
1712        return        return
1713        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  
1714                
1715  ***************************************************  ***************************************************
1716  *                                                 *  *                                                 *
# Line 2321  c$$$      end Line 1722  c$$$      end
1722  **************************************************  **************************************************
1723    
1724        subroutine cp_to_doubtrip(iflag)        subroutine cp_to_doubtrip(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
1725    
1726        include 'commontracker.f'        include 'commontracker.f'
1727          include 'level1.f'
1728        include 'common_momanhough.f'        include 'common_momanhough.f'
       include 'momanhough_init.f'  
1729        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1730        include 'common_mini_2.f'        include 'common_mini_2.f'
1731        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
1732    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1733    
1734  *     output flag  *     output flag
1735  *     --------------  *     --------------
# Line 2367  c      double precision xm3,ym3,zm3 Line 1762  c      double precision xm3,ym3,zm3
1762  *     -----------------------------  *     -----------------------------
1763    
1764    
1765    *     --------------------------------------------
1766    *     put a limit to the maximum number of couples
1767    *     per plane, in order to apply hough transform
1768    *     (couples recovered during track refinement)
1769    *     --------------------------------------------
1770          do ip=1,nplanes
1771             if(ncp_plane(ip).gt.ncouplelimit)then
1772                mask_view(nviewx(ip)) = 8
1773                mask_view(nviewy(ip)) = 8
1774             endif
1775          enddo
1776    
1777    
1778        ndblt=0                   !number of doublets        ndblt=0                   !number of doublets
1779        ntrpt=0                   !number of triplets        ntrpt=0                   !number of triplets
1780                
1781        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1
1782           do is1=1,2             !loop on sensors - COPPIA 1           if(  mask_view(nviewx(ip1)).ne.0 .or.
1783                     $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
1784             do is1=1,2             !loop on sensors - COPPIA 1            
1785              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
1786                 icx1=clx(ip1,icp1)                 icx1=clx(ip1,icp1)
1787                 icy1=cly(ip1,icp1)                 icy1=cly(ip1,icp1)
1788  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
1789                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
1790                   call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
1791                 xm1=xPAM                 xm1=xPAM
1792                 ym1=yPAM                 ym1=yPAM
1793                 zm1=zPAM                                   zm1=zPAM                  
1794  c     print*,'***',is1,xm1,ym1,zm1  c     print*,'***',is1,xm1,ym1,zm1
1795    
1796                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
1797                      if(  mask_view(nviewx(ip2)).ne.0 .or.
1798         $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
1799                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    do is2=1,2    !loop on sensors -ndblt COPPIA 2
1800                                            
1801                       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 1803  c     print*,'***',is1,xm1,ym1,zm1
1803                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
1804  c                        call xyz_PAM  c                        call xyz_PAM
1805  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
1806    c                        call xyz_PAM
1807    c     $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)
1808                          call xyz_PAM                          call xyz_PAM
1809       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.,0.,0.)
1810                          xm2=xPAM                          xm2=xPAM
1811                          ym2=yPAM                          ym2=yPAM
1812                          zm2=zPAM                          zm2=zPAM
# Line 2402  c     $                       (icx2,icy2 Line 1816  c     $                       (icx2,icy2
1816  *     (2 couples needed)  *     (2 couples needed)
1817  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1818                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
1819                             if(DEBUG)print*,                             if(verbose)print*,
1820       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
1821       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
1822       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
1823  c                           good2=.false.  c                           good2=.false.
1824  c                           goto 880 !fill ntp and go to next event  c                           goto 880 !fill ntp and go to next event
1825                               do iv=1,12
1826                                  mask_view(iv) = 3
1827                               enddo
1828                             iflag=1                             iflag=1
1829                             return                             return
1830                          endif                          endif
# Line 2441  c$$$ Line 1858  c$$$
1858  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1859    
1860    
1861                          if(ip2.eq.nplanes)goto 30 !no possible combination with 3 couples                          if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
1862    
1863                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
1864                               if(  mask_view(nviewx(ip3)).ne.0 .or.
1865         $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
1866                             do is3=1,2 !loop on sensors - COPPIA 3                             do is3=1,2 !loop on sensors - COPPIA 3
1867                                                                
1868                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
# Line 2450  c$$$ Line 1870  c$$$
1870                                   icy3=cly(ip3,icp3)                                   icy3=cly(ip3,icp3)
1871  c                                 call xyz_PAM  c                                 call xyz_PAM
1872  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
1873    c                                 call xyz_PAM
1874    c     $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)
1875                                   call xyz_PAM                                   call xyz_PAM
1876       $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)       $                                (icx3,icy3,is3,PFAdef,PFAdef
1877         $                                ,0.,0.,0.,0.)
1878                                   xm3=xPAM                                   xm3=xPAM
1879                                   ym3=yPAM                                   ym3=yPAM
1880                                   zm3=zPAM                                   zm3=zPAM
# Line 2472  c     $                                 Line 1895  c     $                                
1895  *     (3 couples needed)  *     (3 couples needed)
1896  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1897                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
1898                                      if(DEBUG)print*,                                      if(verbose)print*,
1899       $                     '** warning ** number of identified '//       $                     '** warning ** number of identified '//
1900       $                     'triplets exceeds vector dimention '       $                     'triplets exceeds vector dimention '
1901       $                    ,'( ',ntrpt_max,' )'       $                    ,'( ',ntrpt_max,' )'
1902  c                                    good2=.false.  c                                    good2=.false.
1903  c                                    goto 880 !fill ntp and go to next event  c                                    goto 880 !fill ntp and go to next event
1904                                        do iv=1,nviews
1905                                           mask_view(iv) = 4
1906                                        enddo
1907                                      iflag=1                                      iflag=1
1908                                      return                                      return
1909                                   endif                                   endif
# Line 2516  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp Line 1942  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp
1942                                endif                                endif
1943                             enddo !end loop on COPPIA 3                             enddo !end loop on COPPIA 3
1944                          enddo   !end loop on sensors - COPPIA 3                          enddo   !end loop on sensors - COPPIA 3
1945     30                     continue
1946                       enddo      !end loop on planes  - COPPIA 3                       enddo      !end loop on planes  - COPPIA 3
1947   30                  continue   31                  continue
1948                                            
1949   1                enddo         !end loop on COPPIA 2   1                enddo         !end loop on COPPIA 2
1950                 enddo            !end loop on sensors - COPPIA 2                 enddo            !end loop on sensors - COPPIA 2
1951     20            continue
1952              enddo               !end loop on planes  - COPPIA 2              enddo               !end loop on planes  - COPPIA 2
1953                            
1954           enddo                  !end loop on COPPIA1           enddo                  !end loop on COPPIA1
1955        enddo                     !end loop on sensors - COPPIA 1        enddo                     !end loop on sensors - COPPIA 1
1956     10   continue
1957        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
1958                
1959        if(DEBUG)then        if(DEBUG)then
# Line 2552  c     goto 880               !ntp fill Line 1981  c     goto 880               !ntp fill
1981        subroutine doub_to_YZcloud(iflag)        subroutine doub_to_YZcloud(iflag)
1982    
1983        include 'commontracker.f'        include 'commontracker.f'
1984          include 'level1.f'
1985        include 'common_momanhough.f'        include 'common_momanhough.f'
1986        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1987    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1988    
1989  *     output flag  *     output flag
1990  *     --------------  *     --------------
# Line 2588  c      common/dbg/DEBUG Line 2016  c      common/dbg/DEBUG
2016        distance=0        distance=0
2017        nclouds_yz=0              !number of clouds        nclouds_yz=0              !number of clouds
2018        npt_tot=0        npt_tot=0
2019          nloop=0                  
2020     90   continue                  
2021        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2022           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
2023                            
# Line 2691  c     print*,'*   idbref,idb2 ',idbref,i Line 2121  c     print*,'*   idbref,idb2 ',idbref,i
2121              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2122           enddo           enddo
2123  c     print*,'>>>> ',ncpused,npt,nplused  c     print*,'>>>> ',ncpused,npt,nplused
2124           if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  c         if(ncpused.lt.ncpyz_min)goto 2228 !next doublet
2125           if(npt.lt.nptyz_min)goto 2228 !next doublet           if(npt.lt.nptyz_min)goto 2228 !next doublet
2126           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2127                    
# Line 2699  c     print*,'>>>> ',ncpused,npt,nplused Line 2129  c     print*,'>>>> ',ncpused,npt,nplused
2129  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2130    
2131           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2132              if(DEBUG)print*,              if(verbose)print*,
2133       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2134       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2135       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2136  c               good2=.false.  c               good2=.false.
2137  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2138                do iv=1,nviews
2139                   mask_view(iv) = 5
2140                enddo
2141              iflag=1              iflag=1
2142              return              return
2143           endif           endif
# Line 2742  c$$$     $           ,(db_cloud(iii),iii Line 2175  c$$$     $           ,(db_cloud(iii),iii
2175        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2176                
2177                
2178          if(nloop.lt.nstepy)then      
2179            cutdistyz = cutdistyz+cutystep
2180            nloop     = nloop+1          
2181            goto 90                
2182          endif                    
2183          
2184        if(DEBUG)then        if(DEBUG)then
2185           print*,'---------------------- '           print*,'---------------------- '
2186           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
# Line 2768  c$$$     $           ,(db_cloud(iii),iii Line 2207  c$$$     $           ,(db_cloud(iii),iii
2207        subroutine trip_to_XZcloud(iflag)        subroutine trip_to_XZcloud(iflag)
2208    
2209        include 'commontracker.f'        include 'commontracker.f'
2210          include 'level1.f'
2211        include 'common_momanhough.f'        include 'common_momanhough.f'
2212        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2213    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2214    
2215  *     output flag  *     output flag
2216  *     --------------  *     --------------
# Line 2803  c      common/dbg/DEBUG Line 2241  c      common/dbg/DEBUG
2241        distance=0        distance=0
2242        nclouds_xz=0              !number of clouds                nclouds_xz=0              !number of clouds        
2243        npt_tot=0                 !total number of selected triplets        npt_tot=0                 !total number of selected triplets
2244          nloop=0                  
2245     91   continue                  
2246        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2247           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
2248  c     print*,'--------------'  c     print*,'--------------'
# Line 2904  c     print*,'check cp_used' Line 2344  c     print*,'check cp_used'
2344           do ip=1,nplanes           do ip=1,nplanes
2345              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2346           enddo           enddo
2347           if(ncpused.lt.ncpxz_min)goto 22288 !next triplet  c         if(ncpused.lt.ncpxz_min)goto 22288 !next triplet
2348           if(npt.lt.nptxz_min)goto 22288     !next triplet           if(npt.lt.nptxz_min)goto 22288     !next triplet
2349           if(nplused.lt.nplxz_min)goto 22288 !next doublet           if(nplused.lt.nplxz_min)goto 22288 !next triplet
2350                    
2351  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2352  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2353           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2354              if(DEBUG)print*,              if(verbose)print*,
2355       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2356       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2357       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2358  c     good2=.false.  c     good2=.false.
2359  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2360                do iv=1,nviews
2361                   mask_view(iv) = 6
2362                enddo
2363              iflag=1              iflag=1
2364              return              return
2365           endif           endif
# Line 2952  c$$$     $           ,(tr_cloud(iii),iii Line 2395  c$$$     $           ,(tr_cloud(iii),iii
2395  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2396  22288    continue  22288    continue
2397        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2398          
2399           if(nloop.lt.nstepx)then      
2400             cutdistxz=cutdistxz+cutxstep
2401             nloop=nloop+1          
2402             goto 91                
2403           endif                    
2404          
2405        if(DEBUG)then        if(DEBUG)then
2406           print*,'---------------------- '           print*,'---------------------- '
2407           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
# Line 2974  c$$$     $           ,(tr_cloud(iii),iii Line 2423  c$$$     $           ,(tr_cloud(iii),iii
2423  **************************************************  **************************************************
2424    
2425        subroutine clouds_to_ctrack(iflag)        subroutine clouds_to_ctrack(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2426    
2427        include 'commontracker.f'        include 'commontracker.f'
2428          include 'level1.f'
2429        include 'common_momanhough.f'        include 'common_momanhough.f'
2430        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2431        include 'common_mini_2.f'        include 'common_mini_2.f'
2432        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
2433    
2434  c      logical DEBUG  
 c      common/dbg/DEBUG  
2435    
2436  *     output flag  *     output flag
2437  *     --------------  *     --------------
# Line 3002  c      common/dbg/DEBUG Line 2447  c      common/dbg/DEBUG
2447  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2448  *     list of matching couples in the combination  *     list of matching couples in the combination
2449  *     between a XZ and YZ cloud  *     between a XZ and YZ cloud
2450        integer cp_match(nplanes,ncouplemax)        integer cp_match(nplanes,2*ncouplemax)
2451        integer ncp_match(nplanes)        integer ncp_match(nplanes)
2452  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2453        integer hit_plane(nplanes)        integer hit_plane(nplanes)
2454  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2455  *     variables for track fitting  *     variables for track fitting
2456        double precision AL_INI(5)        double precision AL_INI(5)
2457        double precision tath  c      double precision tath
2458  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2459  c      real fitz(nplanes)        !z coordinates of the planes in cm  c      real fitz(nplanes)        !z coordinates of the planes in cm
2460    
# Line 3075  c      real fitz(nplanes)        !z coor Line 2520  c      real fitz(nplanes)        !z coor
2520                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2521              enddo              enddo
2522                            
2523              if(nplused.lt.nplxz_min)goto 888 !next doublet  c            if(nplused.lt.nplxz_min)goto 888 !next doublet
2524                if(nplused.lt.nplyz_min)goto 888 !next doublet
2525              if(ncp_ok.lt.ncpok)goto 888 !next cloud              if(ncp_ok.lt.ncpok)goto 888 !next cloud
2526                            
2527              if(DEBUG)then              if(DEBUG)then
# Line 3102  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p Line 2548  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p
2548  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2549                            
2550  *     -------> INITIAL GUESS <-------  *     -------> INITIAL GUESS <-------
2551              AL_INI(1)=dreal(alfaxz1_av(ixz))  cccc       SBAGLIATO
2552              AL_INI(2)=dreal(alfayz1_av(iyz))  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2553              AL_INI(4)=datan(dreal(alfayz2_av(iyz))  c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2554       $           /dreal(alfaxz2_av(ixz)))  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2555              tath=-dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))  c$$$     $           /dreal(alfaxz2_av(ixz)))
2556              AL_INI(3)=tath/sqrt(1+tath**2)  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2557              AL_INI(5)=(1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2558                c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2559  c     print*,'*******',AL_INI(5)  cccc       GIUSTO (ma si sua guess())
2560              if(AL_INI(5).gt.defmax)goto 888 !next cloud  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2561                c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2562  c     print*,'alfaxz2, alfayz2 '  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2563  c     $              ,alfaxz2_av(ixz),alfayz2_av(iyz)  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2564                c$$$            IF(alfaxz2_av(ixz).NE.0)THEN
2565  *     -------> INITIAL GUESS <-------  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2566  c     print*,'AL_INI ',(al_ini(i),i=1,5)  c$$$     $           /dreal(alfaxz2_av(ixz)))
2567                c$$$            ELSE
2568    c$$$               AL_INI(4) = acos(-1.)/2
2569    c$$$               IF(alfayz2_av(iyz).LT.0)AL_INI(4) = AL_INI(4)+acos(-1.)
2570    c$$$            ENDIF
2571    c$$$            IF(alfaxz2_av(ixz).LT.0)AL_INI(4)= acos(-1.)+ AL_INI(4)
2572    c$$$            AL_INI(4) = -acos(-1.) + AL_INI(4) !from incidence direction to tracking rs
2573    c$$$            
2574    c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2575    c$$$            
2576    c$$$            if(AL_INI(5).gt.defmax)goto 888 !next cloud
2577                            
2578              if(DEBUG)then              if(DEBUG)then
2579                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2580                 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 2625  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2625  *                                   *************************  *                                   *************************
2626  c                                    call xyz_PAM(icx,icy,is,  c                                    call xyz_PAM(icx,icy,is,
2627  c     $                                   'COG2','COG2',0.,0.)  c     $                                   'COG2','COG2',0.,0.)
2628    c                                    call xyz_PAM(icx,icy,is, !(1)
2629    c     $                                   PFAdef,PFAdef,0.,0.) !(1)
2630                                      call xyz_PAM(icx,icy,is, !(1)                                      call xyz_PAM(icx,icy,is, !(1)
2631       $                                   PFAdef,PFAdef,0.,0.) !(1)       $                                   PFAdef,PFAdef,0.,0.,0.,0.)
2632  *                                   *************************  *                                   *************************
2633  *                                   -----------------------------  *                                   -----------------------------
2634                                      xgood(nplanes-ip+1)=1.                                      xgood(nplanes-ip+1)=1.
# Line 3186  c     $                                 Line 2644  c     $                                
2644  *     **********************************************************  *     **********************************************************
2645  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
2646  *     **********************************************************  *     **********************************************************
2647    cccc  scommentare se si usa al_ini della nuvola
2648    c$$$                              do i=1,5
2649    c$$$                                 AL(i)=AL_INI(i)
2650    c$$$                              enddo
2651                                  call guess()
2652                                do i=1,5                                do i=1,5
2653                                   AL(i)=AL_INI(i)                                   AL_INI(i)=AL(i)
2654                                enddo                                enddo
2655                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
2656                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
2657                                call mini_2(jstep,ifail)                                iprint=0
2658    c                              if(DEBUG)iprint=1
2659                                  if(DEBUG)iprint=2
2660                                  call mini2(jstep,ifail,iprint)
2661                                if(ifail.ne.0) then                                if(ifail.ne.0) then
2662                                   if(DEBUG)then                                   if(DEBUG)then
2663                                      print *,                                      print *,
2664       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
2665       $                              //'(mini_2 in clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
2666                                        print*,'initial guess: '
2667    
2668                                        print*,'AL_INI(1) = ',AL_INI(1)
2669                                        print*,'AL_INI(2) = ',AL_INI(2)
2670                                        print*,'AL_INI(3) = ',AL_INI(3)
2671                                        print*,'AL_INI(4) = ',AL_INI(4)
2672                                        print*,'AL_INI(5) = ',AL_INI(5)
2673                                   endif                                   endif
2674                                   chi2=-chi2  c                                 chi2=-chi2
2675                                endif                                endif
2676  *     **********************************************************  *     **********************************************************
2677  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
# Line 3211  c     $                                 Line 2684  c     $                                
2684  *     --------------------------  *     --------------------------
2685                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
2686                                                                    
2687                                   if(DEBUG)print*,                                   if(verbose)print*,
2688       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
2689       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
2690       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
2691  c                                 good2=.false.  c                                 good2=.false.
2692  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
2693                                     do iv=1,nviews
2694                                        mask_view(iv) = 7
2695                                     enddo
2696                                   iflag=1                                   iflag=1
2697                                   return                                   return
2698                                endif                                endif
2699                                                                
2700                                ntracks = ntracks + 1                                ntracks = ntracks + 1
2701                                                                
 c$$$                              ndof=0                                  
2702                                do ip=1,nplanes                                do ip=1,nplanes
2703  c$$$                                 ndof=ndof  
 c$$$     $                                +int(xgood(ip))  
 c$$$     $                                +int(ygood(ip))  
2704                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
2705                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
2706                                   ZV_STORE(ip,ntracks)=sngl(zv(ip))                                                                       ZV_STORE(ip,ntracks)=sngl(zv(ip))                                    
# Line 3246  c$$$     $                               Line 2719  c$$$     $                              
2719                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2720                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
2721       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
2722                                        SENSOR_STORE(nplanes-ip+1,ntracks)
2723         $                              = is_cp(cp_match(ip,hit_plane(ip)))
2724                                        LADDER_STORE(nplanes-ip+1,ntracks)
2725         $                                   = LADDER(
2726         $                                   clx(ip,icp_cp(
2727         $                                   cp_match(ip,hit_plane(ip)
2728         $                                   ))));
2729                                   else                                   else
2730                                      CP_STORE(nplanes-ip+1,ntracks)=0                                      CP_STORE(nplanes-ip+1,ntracks)=0
2731                                        SENSOR_STORE(nplanes-ip+1,ntracks)=0
2732                                        LADDER_STORE(nplanes-ip+1,ntracks)=0
2733                                   endif                                   endif
2734                                     BX_STORE(nplanes-ip+1,ntracks)=0!I dont need it now
2735                                     BY_STORE(nplanes-ip+1,ntracks)=0!I dont need it now
2736                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   CLS_STORE(nplanes-ip+1,ntracks)=0
2737                                   do i=1,5                                   do i=1,5
2738                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
2739                                   enddo                                   enddo
2740                                enddo                                enddo
2741                                                                
 c$$$  *                             Number of Degree Of Freedom  
 c$$$  ndof=ndof-5                            
 c$$$  *                             reduced chi^2  
 c$$$  rchi2=chi2/dble(ndof)  
2742                                RCHI2_STORE(ntracks)=chi2                                RCHI2_STORE(ntracks)=chi2
2743                                                                
2744  *     --------------------------------  *     --------------------------------
# Line 3282  c$$$  rchi2=chi2/dble(ndof) Line 2762  c$$$  rchi2=chi2/dble(ndof)
2762           return           return
2763        endif        endif
2764                
2765    c$$$      if(DEBUG)then
2766    c$$$         print*,'****** TRACK CANDIDATES ***********'
2767    c$$$         print*,'#         R. chi2        RIG'
2768    c$$$         do i=1,ntracks
2769    c$$$            print*,i,' --- ',rchi2_store(i),' --- '
2770    c$$$     $           ,1./abs(AL_STORE(5,i))
2771    c$$$         enddo
2772    c$$$         print*,'***********************************'
2773    c$$$      endif
2774        if(DEBUG)then        if(DEBUG)then
2775           print*,'****** TRACK CANDIDATES ***********'          print*,'****** TRACK CANDIDATES *****************'
2776           print*,'#         R. chi2        RIG'          print*,'#         R. chi2        RIG         ndof'
2777           do i=1,ntracks          do i=1,ntracks
2778              print*,i,' --- ',rchi2_store(i),' --- '            ndof=0                !(1)
2779       $           ,1./abs(AL_STORE(5,i))            do ii=1,nplanes       !(1)
2780           enddo              ndof=ndof           !(1)
2781           print*,'***********************************'       $           +int(xgood_store(ii,i)) !(1)
2782         $           +int(ygood_store(ii,i)) !(1)
2783              enddo                 !(1)
2784              print*,i,' --- ',rchi2_store(i),' --- '
2785         $         ,1./abs(AL_STORE(5,i)),' --- ',ndof
2786            enddo
2787            print*,'*****************************************'
2788        endif        endif
2789                
2790                
# Line 3308  c$$$  rchi2=chi2/dble(ndof) Line 2803  c$$$  rchi2=chi2/dble(ndof)
2803    
2804        subroutine refine_track(ibest)        subroutine refine_track(ibest)
2805    
 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******************************************************  
2806    
2807        include 'commontracker.f'        include 'commontracker.f'
2808          include 'level1.f'
2809        include 'common_momanhough.f'        include 'common_momanhough.f'
2810        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2811        include 'common_mini_2.f'        include 'common_mini_2.f'
2812        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
       include 'level1.f'  
2813        include 'calib.f'        include 'calib.f'
2814    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
2815  *     flag to chose PFA  *     flag to chose PFA
2816        character*10 PFA        character*10 PFA
2817        common/FINALPFA/PFA        common/FINALPFA/PFA
2818    
2819          real k(6)
2820          DATA k/1.099730,0.418900,0.220939,0.220907,0.418771,1.100674/
2821    
2822          real xp,yp,zp
2823          real xyzp(3),bxyz(3)
2824          equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
2825    
2826  *     =================================================  *     =================================================
2827  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
2828  *                          and  *                          and
# Line 3338  c      common/dbg/DEBUG Line 2831  c      common/dbg/DEBUG
2831        call track_init        call track_init
2832        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
2833    
2834             xP=XV_STORE(nplanes-ip+1,ibest)
2835             yP=YV_STORE(nplanes-ip+1,ibest)
2836             zP=ZV_STORE(nplanes-ip+1,ibest)
2837             call gufld(xyzp,bxyz)
2838             BX_STORE(nplanes-ip+1,ibest)=bxyz(1)
2839             BY_STORE(nplanes-ip+1,ibest)=bxyz(2)
2840    c$$$  bxyz(1)=0
2841    c$$$         bxyz(2)=0
2842    c$$$         bxyz(3)=0
2843    *     |||||||||||||||||||||||||||||||||||||||||||||||||
2844  *     -------------------------------------------------  *     -------------------------------------------------
2845  *     If the plane has been already included, it just  *     If the plane has been already included, it just
2846  *     computes again the coordinates of the x-y couple  *     computes again the coordinates of the x-y couple
2847  *     using improved PFAs  *     using improved PFAs
2848  *     -------------------------------------------------  *     -------------------------------------------------
2849    *     |||||||||||||||||||||||||||||||||||||||||||||||||
2850           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
2851       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
2852                            
# Line 3356  c      common/dbg/DEBUG Line 2860  c      common/dbg/DEBUG
2860       $           ,ip_cp(id),ip       $           ,ip_cp(id),ip
2861              icx=clx(ip,icp)              icx=clx(ip,icp)
2862              icy=cly(ip,icp)              icy=cly(ip,icp)
2863    c            call xyz_PAM(icx,icy,is,
2864    c     $           PFA,PFA,
2865    c     $           AXV_STORE(nplanes-ip+1,ibest),
2866    c     $           AYV_STORE(nplanes-ip+1,ibest))
2867              call xyz_PAM(icx,icy,is,              call xyz_PAM(icx,icy,is,
 c     $           'ETA2','ETA2',  
2868       $           PFA,PFA,       $           PFA,PFA,
2869       $           AXV_STORE(nplanes-ip+1,ibest),       $           AXV_STORE(nplanes-ip+1,ibest),
2870       $           AYV_STORE(nplanes-ip+1,ibest))       $           AYV_STORE(nplanes-ip+1,ibest),
2871  c$$$  call xyz_PAM(icx,icy,is,       $           bxyz(1),
2872  c$$$  $              'COG2','COG2',       $           bxyz(2)
2873  c$$$  $              0.,       $           )
2874  c$$$  $              0.)  
2875              xm(nplanes-ip+1) = xPAM              xm(nplanes-ip+1) = xPAM
2876              ym(nplanes-ip+1) = yPAM              ym(nplanes-ip+1) = yPAM
2877              zm(nplanes-ip+1) = zPAM              zm(nplanes-ip+1) = zPAM
# Line 3373  c$$$  $              0.) Line 2880  c$$$  $              0.)
2880              resx(nplanes-ip+1) = resxPAM              resx(nplanes-ip+1) = resxPAM
2881              resy(nplanes-ip+1) = resyPAM              resy(nplanes-ip+1) = resyPAM
2882    
2883  c            dedxtrk(nplanes-ip+1) = (dedx(icx)+dedx(icy))/2. !(1)              dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx))
2884              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)  
2885                            
2886    *     |||||||||||||||||||||||||||||||||||||||||||||||||
2887  *     -------------------------------------------------  *     -------------------------------------------------
2888  *     If the plane has NOT  been already included,  *     If the plane has NOT  been already included,
2889  *     it tries to include a COUPLE or a single cluster  *     it tries to include a COUPLE or a single cluster
2890  *     -------------------------------------------------  *     -------------------------------------------------
2891    *     |||||||||||||||||||||||||||||||||||||||||||||||||
2892           else                             else                  
2893                                
2894              xgood(nplanes-ip+1)=0              xgood(nplanes-ip+1)=0
# Line 3388  c            dedxtrk(nplanes-ip+1) = (de Line 2896  c            dedxtrk(nplanes-ip+1) = (de
2896                                
2897  *     --------------------------------------------------------------  *     --------------------------------------------------------------
2898  *     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)  
2899              call whichsensor(ip,xP,yP,nldt,ist)              call whichsensor(ip,xP,yP,nldt,ist)
2900  *     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
2901              if(nldt.eq.0.or.ist.eq.0)goto 133              if(nldt.eq.0.or.ist.eq.0)goto 133
2902    
2903                SENSOR_STORE(nplanes-ip+1,IBEST)=ist
2904                LADDER_STORE(nplanes-ip+1,IBEST)=nldt
2905  *     --------------------------------------------------------------  *     --------------------------------------------------------------
2906    
2907              if(DEBUG)then              if(DEBUG)then
# Line 3430  c     $              cl_used(icy).eq.1.o Line 2938  c     $              cl_used(icy).eq.1.o
2938  *            *          
2939                 call xyz_PAM(icx,icy,ist,                 call xyz_PAM(icx,icy,ist,
2940       $              PFA,PFA,       $              PFA,PFA,
 c     $              'ETA2','ETA2',  
2941       $              AXV_STORE(nplanes-ip+1,ibest),       $              AXV_STORE(nplanes-ip+1,ibest),
2942       $              AYV_STORE(nplanes-ip+1,ibest))       $              AYV_STORE(nplanes-ip+1,ibest),
2943         $              bxyz(1),
2944         $              bxyz(2)
2945         $              )
2946                                
2947                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
2948    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
2949                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
2950                 if(DEBUG)print*,'( couple ',id                 if(DEBUG)print*,'( couple ',id
2951       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance
2952                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
2953                    xmm = xPAM                    xmm = xPAM
2954                    ymm = yPAM                    ymm = yPAM
# Line 3446  c     $              'ETA2','ETA2', Line 2957  c     $              'ETA2','ETA2',
2957                    rymm = resyPAM                    rymm = resyPAM
2958                    distmin = distance                    distmin = distance
2959                    idm = id                                      idm = id                  
2960  c                 dedxmm = (dedx(icx)+dedx(icy))/2. !(1)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
2961                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
2962                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)  c     QUIQUI --> non devo moltiplicare per clinc?!?!?!
2963                      clincnewc=10*sqrt(rymm**2+rxmm**2 !QUIQUI
2964         $                 +RCHI2_STORE(ibest)*k(ip)*(cov(1,1)+cov(2,2))) !QUIQUI
2965                 endif                 endif
2966   1188          continue   1188          continue
2967              enddo               !end loop on couples on plane icp              enddo               !end loop on couples on plane icp
2968              if(distmin.le.clinc)then                    c            if(distmin.le.clinc)then     !QUIQUI              
2969                if(distmin.le.clincnewc)then     !QUIQUI              
2970  *              -----------------------------------  *              -----------------------------------
2971                 xm(nplanes-ip+1) = xmm         !<<<                 xm(nplanes-ip+1) = xmm !<<<
2972                 ym(nplanes-ip+1) = ymm         !<<<                 ym(nplanes-ip+1) = ymm !<<<
2973                 zm(nplanes-ip+1) = zmm         !<<<                 zm(nplanes-ip+1) = zmm !<<<
2974                 xgood(nplanes-ip+1) = 1        !<<<                 xgood(nplanes-ip+1) = 1 !<<<
2975                 ygood(nplanes-ip+1) = 1        !<<<                 ygood(nplanes-ip+1) = 1 !<<<
2976                 resx(nplanes-ip+1)=rxmm        !<<<                 resx(nplanes-ip+1)=rxmm !<<<
2977                 resy(nplanes-ip+1)=rymm        !<<<                 resy(nplanes-ip+1)=rymm !<<<
2978  c              dedxtrk(nplanes-ip+1) = dedxmm !<<<  !(1)                 dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
2979                 dedxtrk_x(nplanes-ip+1) = dedxmmx    !(1)                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
                dedxtrk_y(nplanes-ip+1) = dedxmmy    !(1)  
2980  *              -----------------------------------  *              -----------------------------------
2981                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
2982                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG)print*,'%%%% included couple ',idm
2983       $              ,' (norm.dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clinc,' )'
2984                 goto 133         !next plane                 goto 133         !next plane
2985              endif              endif
2986  *     ================================================  *     ================================================
# Line 3500  c            if(DEBUG)print*,'>>>> try t Line 3013  c            if(DEBUG)print*,'>>>> try t
3013  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
3014                 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)
3015  *                                              !jump to the Y cluster  *                                              !jump to the Y cluster
3016    c               call xyz_PAM(icx,0,ist,
3017    c     $              PFA,PFA,
3018    c     $              AXV_STORE(nplanes-ip+1,ibest),0.)              
3019                 call xyz_PAM(icx,0,ist,                 call xyz_PAM(icx,0,ist,
 c     $              'ETA2','ETA2',  
3020       $              PFA,PFA,       $              PFA,PFA,
3021       $              AXV_STORE(nplanes-ip+1,ibest),0.)                     $              AXV_STORE(nplanes-ip+1,ibest),0.,
3022         $              bxyz(1),
3023         $              bxyz(2)
3024         $              )              
3025                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3026  c     if(DEBUG)print*,'normalized distance ',distance  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3027                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG)print*,'( cl-X ',icx
3028       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3029                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3030                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3031                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3519  c     if(DEBUG)print*,'normalized distan Line 3037  c     if(DEBUG)print*,'normalized distan
3037                    rymm = resyPAM                    rymm = resyPAM
3038                    distmin = distance                    distmin = distance
3039                    iclm = icx                    iclm = icx
3040  c                  dedxmm = dedx(icx) !(1)  c                  dedxmm = sgnl(icx) !(1)
3041                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3042                    dedxmmy = 0.        !(1)                    dedxmmy = 0.        !(1)
3043                 endif                                   endif                  
3044  11881          continue  11881          continue
# Line 3528  c                  dedxmm = dedx(icx) !( Line 3046  c                  dedxmm = dedx(icx) !(
3046  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
3047                 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)
3048  *                                              !jump to the next couple  *                                              !jump to the next couple
3049    c               call xyz_PAM(0,icy,ist,
3050    c     $              PFA,PFA,
3051    c     $              0.,AYV_STORE(nplanes-ip+1,ibest))
3052                 call xyz_PAM(0,icy,ist,                 call xyz_PAM(0,icy,ist,
 c     $              'ETA2','ETA2',  
3053       $              PFA,PFA,       $              PFA,PFA,
3054       $              0.,AYV_STORE(nplanes-ip+1,ibest))       $              0.,AYV_STORE(nplanes-ip+1,ibest),
3055         $              bxyz(1),
3056         $              bxyz(2)
3057         $              )
3058                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3059    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3060                 if(DEBUG)print*,'( cl-Y ',icy                 if(DEBUG)print*,'( cl-Y ',icy
3061       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3062                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3063                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3064                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3546  c     $              'ETA2','ETA2', Line 3070  c     $              'ETA2','ETA2',
3070                    rymm = resyPAM                    rymm = resyPAM
3071                    distmin = distance                    distmin = distance
3072                    iclm = icy                    iclm = icy
3073  c                 dedxmm = dedx(icy)  !(1)  c                 dedxmm = sgnl(icy)  !(1)
3074                    dedxmmx = 0.        !(1)                    dedxmmx = 0.        !(1)
3075                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3076                 endif                                   endif                  
3077  11882          continue  11882          continue
3078              enddo               !end loop on cluster inside couples              enddo               !end loop on cluster inside couples
3079  *----- single clusters -----------------------------------------------      *----- single clusters -----------------------------------------------  
3080    c            print*,'## ncls(',ip,') ',ncls(ip)
3081              do ic=1,ncls(ip)    !loop on single clusters              do ic=1,ncls(ip)    !loop on single clusters
3082                 icl=cls(ip,ic)                 icl=cls(ip,ic)
3083  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 3086  c               if(cl_used(icl).eq.1.or.
3086       $              .false.)goto 18882      !jump to the next singlet       $              .false.)goto 18882      !jump to the next singlet
3087                 if(mod(VIEW(icl),2).eq.0)then!<---- X view                 if(mod(VIEW(icl),2).eq.0)then!<---- X view
3088                    call xyz_PAM(icl,0,ist,                    call xyz_PAM(icl,0,ist,
 c     $                 'ETA2','ETA2',  
3089       $                 PFA,PFA,       $                 PFA,PFA,
3090       $                 AXV_STORE(nplanes-ip+1,ibest),0.)       $                 AXV_STORE(nplanes-ip+1,ibest),0.,
3091         $                 bxyz(1),
3092         $                 bxyz(2)
3093         $                 )
3094                 else                         !<---- Y view                 else                         !<---- Y view
3095                    call xyz_PAM(0,icl,ist,                    call xyz_PAM(0,icl,ist,
 c     $                 'ETA2','ETA2',  
3096       $                 PFA,PFA,       $                 PFA,PFA,
3097       $                 0.,AYV_STORE(nplanes-ip+1,ibest))       $                 0.,AYV_STORE(nplanes-ip+1,ibest),
3098         $                 bxyz(1),
3099         $                 bxyz(2)
3100         $                 )
3101                 endif                 endif
3102    
3103                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3104    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3105                 if(DEBUG)print*,'( cl-s ',icl                 if(DEBUG)print*,'( cl-s ',icl
3106       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance,'<',distmin,' ?'
3107                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3108                      if(DEBUG)print*,'YES'
3109                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3110                    ymm_A = yPAM_A                    ymm_A = yPAM_A
3111                    zmm_A = zPAM_A                    zmm_A = zPAM_A
# Line 3585  c     $                 'ETA2','ETA2', Line 3116  c     $                 'ETA2','ETA2',
3116                    rymm = resyPAM                    rymm = resyPAM
3117                    distmin = distance                      distmin = distance  
3118                    iclm = icl                    iclm = icl
 c                  dedxmm = dedx(icl)                   !(1)  
3119                    if(mod(VIEW(icl),2).eq.0)then !<---- X view                    if(mod(VIEW(icl),2).eq.0)then !<---- X view
3120                       dedxmmx = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3121                       dedxmmy = 0.                       !(1)                       dedxmmy = 0.                  
3122                    else          !<---- Y view                    else          !<---- Y view
3123                       dedxmmx = 0.                       !(1)                       dedxmmx = 0.                  
3124                       dedxmmy = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3125                    endif                    endif
3126                 endif                                   endif                  
3127  18882          continue  18882          continue
3128              enddo               !end loop on single clusters              enddo               !end loop on single clusters
3129    c            print*,'## distmin ', distmin,' clinc ',clinc
3130    
3131              if(distmin.le.clinc)then                    c     QUIQUI------------
3132                  c     anche qui: non ci vuole clinc???
3133                 CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<                  if(iclm.ne.0)then
 *              ----------------------------  
3134                 if(mod(VIEW(iclm),2).eq.0)then                 if(mod(VIEW(iclm),2).eq.0)then
3135                    XGOOD(nplanes-ip+1)=1.                    clincnew=
3136                    resx(nplanes-ip+1)=rxmm       $                 20*
3137                    if(DEBUG)print*,'%%%% included X-cl ',iclm       $                 sqrt(rxmm**2+RCHI2_STORE(ibest)*k(ip)*cov(1,1))
3138       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'                 else if(mod(VIEW(iclm),2).ne.0)then
3139                 else                    clincnew=
3140                    YGOOD(nplanes-ip+1)=1.       $                 10*
3141                    resy(nplanes-ip+1)=rymm       $                 sqrt(rymm**2+RCHI2_STORE(ibest)*k(ip)*cov(2,2))
3142                    if(DEBUG)print*,'%%%% included Y-cl ',iclm                 endif
3143       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'  c     QUIQUI------------
3144                  
3145                   if(distmin.le.clincnew)then   !QUIQUI
3146    c     if(distmin.le.clinc)then          !QUIQUI          
3147                      
3148                      CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<    
3149    *     ----------------------------
3150    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3151                      if(mod(VIEW(iclm),2).eq.0)then
3152                         XGOOD(nplanes-ip+1)=1.
3153                         resx(nplanes-ip+1)=rxmm
3154                         if(DEBUG)print*,'%%%% included X-cl ',iclm
3155         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3156         $                    ,', dist.= ',distmin
3157         $                    ,', cut ',clinc,' )'
3158                      else
3159                         YGOOD(nplanes-ip+1)=1.
3160                         resy(nplanes-ip+1)=rymm
3161                         if(DEBUG)print*,'%%%% included Y-cl ',iclm
3162         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3163         $                    ,', dist.= ', distmin
3164         $                    ,', cut ',clinc,' )'
3165                      endif
3166    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3167    *     ----------------------------
3168                      xm_A(nplanes-ip+1) = xmm_A
3169                      ym_A(nplanes-ip+1) = ymm_A
3170                      xm_B(nplanes-ip+1) = xmm_B
3171                      ym_B(nplanes-ip+1) = ymm_B
3172                      zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3173                      dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3174                      dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3175    *     ----------------------------
3176                 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)  
 *              ----------------------------  
3177              endif              endif
3178           endif           endif
3179   133     continue   133     continue
# Line 3640  c              dedxtrk(nplanes-ip+1) = d Line 3192  c              dedxtrk(nplanes-ip+1) = d
3192  *                                                 *  *                                                 *
3193  *                                                 *  *                                                 *
3194  **************************************************  **************************************************
 cccccc 12/08/2006 modified by elena ---> (1)  
3195  *  *
3196        subroutine clean_XYclouds(ibest,iflag)        subroutine clean_XYclouds(ibest,iflag)
3197    
3198        include 'commontracker.f'        include 'commontracker.f'
3199          include 'level1.f'
3200        include 'common_momanhough.f'        include 'common_momanhough.f'
3201        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  
   
3202    
3203        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3204    
# Line 3663  c      common/dbg/DEBUG Line 3208  c      common/dbg/DEBUG
3208              if(id.ne.0)then              if(id.ne.0)then
3209                 iclx=clx(ip,icp_cp(id))                 iclx=clx(ip,icp_cp(id))
3210                 icly=cly(ip,icp_cp(id))                 icly=cly(ip,icp_cp(id))
3211  c               cl_used(iclx)=1  !tag used clusters                 cl_used(iclx)=ntrk  !tag used clusters
3212  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)  
3213              elseif(icl.ne.0)then              elseif(icl.ne.0)then
3214  c               cl_used(icl)=1   !tag used clusters                 cl_used(icl)=ntrk   !tag used clusters
                cl_used(icl)=ntrk   !tag used clusters !1)  
3215              endif              endif
3216                            
 c               if(DEBUG)then  
 c                  print*,ip,' <<< ',id  
 c               endif  
3217  *     -----------------------------  *     -----------------------------
3218  *     remove the couple from clouds  *     remove the couple from clouds
3219  *     remove also vitual couples containing the  *     remove also vitual couples containing the
# Line 3725  c               endif Line 3264  c               endif
3264    
3265    
3266    
 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$$$  
   
3267    
3268    
3269  *     ****************************************************  *     ****************************************************
3270    
3271        subroutine init_level2        subroutine init_level2
3272    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c*****************************************************  
   
3273        include 'commontracker.f'        include 'commontracker.f'
3274          include 'level1.f'
3275        include 'common_momanhough.f'        include 'common_momanhough.f'
3276        include 'level2.f'        include 'level2.f'
       include 'level1.f'  
3277    
3278    *     ---------------------------------
3279    *     variables initialized from level1
3280    *     ---------------------------------
3281        do i=1,nviews        do i=1,nviews
3282           good2(i)=good1(i)           good2(i)=good1(i)
3283             do j=1,nva1_view
3284                vkflag(i,j)=1
3285                if(cnnev(i,j).le.0)then
3286                   vkflag(i,j)=cnnev(i,j)
3287                endif
3288             enddo
3289        enddo        enddo
3290    *     ----------------
3291  c      good2 = 0!.false.  *     level2 variables
3292  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*****************************************************  
   
3293        NTRK = 0        NTRK = 0
3294        do it=1,NTRKMAX!NTRACKSMAX        do it=1,NTRKMAX
3295           IMAGE(IT)=0           IMAGE(IT)=0
3296           CHI2_nt(IT) = -100000.           CHI2_nt(IT) = -100000.
 c         BdL(IT) = 0.  
3297           do ip=1,nplanes           do ip=1,nplanes
3298              XM_nt(IP,IT) = 0              XM_nt(IP,IT) = 0
3299              YM_nt(IP,IT) = 0              YM_nt(IP,IT) = 0
3300              ZM_nt(IP,IT) = 0              ZM_nt(IP,IT) = 0
3301              RESX_nt(IP,IT) = 0              RESX_nt(IP,IT) = 0
3302              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3303                TAILX_nt(IP,IT) = 0
3304                TAILY_nt(IP,IT) = 0
3305                XBAD(IP,IT) = 0
3306                YBAD(IP,IT) = 0
3307              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3308              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
3309  c*****************************************************              LS(IP,IT) = 0
 cccccc 11/9/2005 modified by david fedele  
3310              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3311              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
 c******************************************************  
 cccccc 17/8/2006 modified by elena  
3312              CLTRX(IP,IT) = 0              CLTRX(IP,IT) = 0
3313              CLTRY(IP,IT) = 0              CLTRY(IP,IT) = 0
3314           enddo           enddo
# Line 3893  cccccc 17/8/2006 modified by elena Line 3319  cccccc 17/8/2006 modified by elena
3319              enddo                                enddo                  
3320           enddo                             enddo                  
3321        enddo        enddo
         
         
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3322        nclsx=0        nclsx=0
3323        nclsy=0              nclsy=0      
3324        do ip=1,NSINGMAX        do ip=1,NSINGMAX
3325          planex(ip)=0          planex(ip)=0
 c        xs(ip)=0  
3326          xs(1,ip)=0          xs(1,ip)=0
3327          xs(2,ip)=0          xs(2,ip)=0
3328          sgnlxs(ip)=0          sgnlxs(ip)=0
3329          planey(ip)=0          planey(ip)=0
 c        ys(ip)=0  
3330          ys(1,ip)=0          ys(1,ip)=0
3331          ys(2,ip)=0          ys(2,ip)=0
3332          sgnlys(ip)=0          sgnlys(ip)=0
3333        enddo        enddo
 c*******************************************************  
3334        end        end
3335    
3336    
# Line 3926  c*************************************** Line 3345  c***************************************
3345  ************************************************************  ************************************************************
3346    
3347    
3348          subroutine init_hough
3349    
3350          include 'commontracker.f'
3351          include 'level1.f'
3352          include 'common_momanhough.f'
3353          include 'common_hough.f'
3354          include 'level2.f'
3355    
3356          ntrpt_nt=0
3357          ndblt_nt=0
3358          NCLOUDS_XZ_nt=0
3359          NCLOUDS_YZ_nt=0
3360          do idb=1,ndblt_max_nt
3361             db_cloud_nt(idb)=0
3362             alfayz1_nt(idb)=0      
3363             alfayz2_nt(idb)=0      
3364          enddo
3365          do itr=1,ntrpt_max_nt
3366             tr_cloud_nt(itr)=0
3367             alfaxz1_nt(itr)=0      
3368             alfaxz2_nt(itr)=0      
3369             alfaxz3_nt(itr)=0      
3370          enddo
3371          do idb=1,ncloyz_max      
3372            ptcloud_yz_nt(idb)=0    
3373            alfayz1_av_nt(idb)=0    
3374            alfayz2_av_nt(idb)=0    
3375          enddo                    
3376          do itr=1,ncloxz_max      
3377            ptcloud_xz_nt(itr)=0    
3378            alfaxz1_av_nt(itr)=0    
3379            alfaxz2_av_nt(itr)=0    
3380            alfaxz3_av_nt(itr)=0    
3381          enddo                    
3382    
3383          ntrpt=0                  
3384          ndblt=0                  
3385          NCLOUDS_XZ=0              
3386          NCLOUDS_YZ=0              
3387          do idb=1,ndblt_max        
3388            db_cloud(idb)=0        
3389            cpyz1(idb)=0            
3390            cpyz2(idb)=0            
3391            alfayz1(idb)=0          
3392            alfayz2(idb)=0          
3393          enddo                    
3394          do itr=1,ntrpt_max        
3395            tr_cloud(itr)=0        
3396            cpxz1(itr)=0            
3397            cpxz2(itr)=0            
3398            cpxz3(itr)=0            
3399            alfaxz1(itr)=0          
3400            alfaxz2(itr)=0          
3401            alfaxz3(itr)=0          
3402          enddo                    
3403          do idb=1,ncloyz_max      
3404            ptcloud_yz(idb)=0      
3405            alfayz1_av(idb)=0      
3406            alfayz2_av(idb)=0      
3407            do idbb=1,ncouplemaxtot
3408              cpcloud_yz(idb,idbb)=0
3409            enddo                  
3410          enddo                    
3411          do itr=1,ncloxz_max      
3412            ptcloud_xz(itr)=0      
3413            alfaxz1_av(itr)=0      
3414            alfaxz2_av(itr)=0      
3415            alfaxz3_av(itr)=0      
3416            do itrr=1,ncouplemaxtot
3417              cpcloud_xz(itr,itrr)=0
3418            enddo                  
3419          enddo                    
3420          end
3421    ************************************************************
3422    *
3423    *
3424    *
3425    *
3426    *
3427    *
3428    *
3429    ************************************************************
3430    
3431    
3432        subroutine fill_level2_tracks(ntr)        subroutine fill_level2_tracks(ntr)
3433    
3434  *     -------------------------------------------------------  *     -------------------------------------------------------
# Line 3937  c*************************************** Line 3440  c***************************************
3440            
3441        include 'commontracker.f'        include 'commontracker.f'
3442        include 'level1.f'        include 'level1.f'
3443          include 'common_momanhough.f'
3444        include 'level2.f'        include 'level2.f'
3445        include 'common_mini_2.f'        include 'common_mini_2.f'
3446        include 'common_momanhough.f'        include 'calib.f'
3447        real sinth,phi,pig        !(4)  
3448          character*10 PFA
3449          common/FINALPFA/PFA
3450    
3451          real sinth,phi,pig
3452          integer ssensor,sladder
3453        pig=acos(-1.)        pig=acos(-1.)
3454    
3455  c      good2=1!.true.  *     -------------------------------------
3456        chi2_nt(ntr)        = sngl(chi2)        chi2_nt(ntr)        = sngl(chi2)
3457        nstep_nt(ntr)       = 0!nstep        nstep_nt(ntr)       = nstep
3458    *     -------------------------------------
3459        phi   = al(4)             !(4)        phi   = al(4)          
3460        sinth = al(3)             !(4)        sinth = al(3)            
3461        if(sinth.lt.0)then        !(4)        if(sinth.lt.0)then      
3462           sinth = -sinth         !(4)           sinth = -sinth        
3463           phi = phi + pig        !(4)           phi = phi + pig      
3464        endif                     !(4)        endif                    
3465        npig = aint(phi/(2*pig))  !(4)        npig = aint(phi/(2*pig))
3466        phi = phi - npig*2*pig    !(4)        phi = phi - npig*2*pig  
3467        if(phi.lt.0)              !(4)        if(phi.lt.0)            
3468       $     phi = phi + 2*pig    !(4)       $     phi = phi + 2*pig  
3469        al(4) = phi               !(4)        al(4) = phi              
3470        al(3) = sinth             !(4)        al(3) = sinth            
 *****************************************************  
3471        do i=1,5        do i=1,5
3472           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3473           do j=1,5           do j=1,5
3474              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3475           enddo           enddo
 c     print*,al_nt(i,ntr)  
3476        enddo        enddo
3477          *     -------------------------------------      
3478        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
3479           xgood_nt(ip,ntr) = int(xgood(ip))           xgood_nt(ip,ntr) = int(xgood(ip))
3480           ygood_nt(ip,ntr) = int(ygood(ip))           ygood_nt(ip,ntr) = int(ygood(ip))
# Line 3976  c     print*,al_nt(i,ntr) Line 3483  c     print*,al_nt(i,ntr)
3483           zm_nt(ip,ntr)    = sngl(zm(ip))           zm_nt(ip,ntr)    = sngl(zm(ip))
3484           RESX_nt(IP,ntr)  = sngl(resx(ip))           RESX_nt(IP,ntr)  = sngl(resx(ip))
3485           RESY_nt(IP,ntr)  = sngl(resy(ip))           RESY_nt(IP,ntr)  = sngl(resy(ip))
3486             TAILX_nt(IP,ntr) = 0.
3487             TAILY_nt(IP,ntr) = 0.
3488           xv_nt(ip,ntr)    = sngl(xv(ip))           xv_nt(ip,ntr)    = sngl(xv(ip))
3489           yv_nt(ip,ntr)    = sngl(yv(ip))           yv_nt(ip,ntr)    = sngl(yv(ip))
3490           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3491           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3492           ayv_nt(ip,ntr)   = sngl(ayv(ip))           ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3493  c        dedxp(ip,ntr)    = sngl(dedxtrk(ip))   !(1)  c     l'avevo dimenticato!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3494           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)           factor = sqrt(
3495           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)         $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3496         $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3497         $        1. )
3498    c     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3499             dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3500             dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3501        
3502           id  = CP_STORE(ip,IDCAND)           ax   = axv_nt(ip,ntr)
3503             ay   = ayv_nt(ip,ntr)
3504             bfx  = BX_STORE(ip,IDCAND)
3505             bfy  = BY_STORE(ip,IDCAND)
3506             if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3507             if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3508             tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3509             angx     = 180.*atan(tgtemp)/acos(-1.)
3510             tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3511             angy    = 180.*atan(tgtemp)/acos(-1.)
3512            
3513    c         print*,'* ',ip,bfx,bfy,angx,angy
3514    
3515             id  = CP_STORE(ip,IDCAND) ! couple id
3516           icl = CLS_STORE(ip,IDCAND)           icl = CLS_STORE(ip,IDCAND)
3517             ssensor = -1
3518             sladder = -1
3519             ssensor = SENSOR_STORE(ip,IDCAND)
3520             sladder = LADDER_STORE(ip,IDCAND)
3521             if(ip.eq.6.and.ssensor.ne.0)ssensor = 3 - ssensor !notazione paolo x align
3522             LS(IP,ntr)      = ssensor+10*sladder
3523    
3524           if(id.ne.0)then           if(id.ne.0)then
3525    c           >>> is a couple
3526              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3527              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3528  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  
3529    c$$$            if(is_cp(id).ne.ssensor)
3530    c$$$     $           print*,'ERROR is sensor assignment (couple)'
3531    c$$$     $           ,is_cp(id),ssensor
3532    c$$$            if(LADDER(clx(nplanes-ip+1,icp_cp(id))).ne.sladder)
3533    c$$$     $           print*,'ERROR is ladder assignment (couple)'
3534    c$$$     $           ,LADDER(clx(nplanes-ip+1,icp_cp(id))),sladder
3535                
3536                nnnnx = npfastrips(clx(nplanes-ip+1,icp_cp(id)),PFA,angx)
3537                nnnny = npfastrips(cly(nplanes-ip+1,icp_cp(id)),PFA,angy)            
3538                xbad(ip,ntr)= nbadstrips(nnnnx,clx(nplanes-ip+1,icp_cp(id)))
3539                ybad(ip,ntr)= nbadstrips(nnnny,cly(nplanes-ip+1,icp_cp(id)))
3540    
3541                if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3542         $           dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3543                if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3544         $           dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3545    
3546           elseif(icl.ne.0)then           elseif(icl.ne.0)then
3547              if(mod(VIEW(icl),2).eq.0)cltrx(ip,ntr)=icl  c           >>> is a singlet
3548              if(mod(VIEW(icl),2).eq.1)cltry(ip,ntr)=icl  c$$$            if(LADDER(icl).ne.sladder)
3549  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  c$$$     $           print*,'ERROR is ladder assignment (single)'
3550    c$$$     $           ,LADDER(icl),sladder
3551                if(mod(VIEW(icl),2).eq.0)then
3552                   cltrx(ip,ntr)=icl
3553                   nnnnn = npfastrips(icl,PFA,angx)
3554                   xbad(ip,ntr) = nbadstrips(nnnnn,icl)
3555                   if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3556                elseif(mod(VIEW(icl),2).eq.1)then
3557                   cltry(ip,ntr)=icl
3558                   nnnnn = npfastrips(icl,PFA,angy)
3559                   ybad(ip,ntr) = nbadstrips(nnnnn,icl)
3560                   if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3561                endif
3562           endif                     endif          
3563    
3564        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)  
3565    
3566    
3567    c$$$      print*,(xgood(i),i=1,6)
3568    c$$$      print*,(ygood(i),i=1,6)
3569    c$$$      print*,(ls(i,ntr),i=1,6)
3570    c$$$      print*,(dedx_x(i,ntr),i=1,6)
3571    c$$$      print*,(dedx_y(i,ntr),i=1,6)
3572    c$$$      print*,'-----------------------'
3573    
3574        end        end
3575    
3576        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*****************************************************  
3577    
3578  *     -------------------------------------------------------  *     -------------------------------------------------------
3579  *     This routine fills the  elements of the variables  *     This routine fills the  elements of the variables
# Line 4022  c*************************************** Line 3582  c***************************************
3582  *     -------------------------------------------------------  *     -------------------------------------------------------
3583    
3584        include 'commontracker.f'        include 'commontracker.f'
       include 'level1.f'  
       include 'level2.f'  
3585        include 'calib.f'        include 'calib.f'
3586          include 'level1.f'
3587        include 'common_momanhough.f'        include 'common_momanhough.f'
3588          include 'level2.f'
3589        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3590    
3591  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
 c      good2=1!.true.  
3592        nclsx = 0        nclsx = 0
3593        nclsy = 0        nclsy = 0
3594    
3595          do iv = 1,nviews
3596             if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
3597          enddo
3598    
3599        do icl=1,nclstr1        do icl=1,nclstr1
3600           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
3601              ip=nplanes-npl(VIEW(icl))+1                          ip=nplanes-npl(VIEW(icl))+1            
3602              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
3603                 nclsx = nclsx + 1                 nclsx = nclsx + 1
3604                 planex(nclsx) = ip                 planex(nclsx) = ip
3605                 sgnlxs(nclsx) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3606                   if(nsatstrips(icl).gt.0)sgnlxs(nclsx)=-sgnlxs(nclsx)
3607                 clsx(nclsx)   = icl                 clsx(nclsx)   = icl
3608                 do is=1,2                 do is=1,2
3609  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
3610                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
3611                      call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
3612                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2
3613                 enddo                 enddo
3614  c$$$               print*,'nclsx         ',nclsx  c$$$               print*,'nclsx         ',nclsx
# Line 4054  c$$$               print*,'xs(2,nclsx)   Line 3619  c$$$               print*,'xs(2,nclsx)  
3619              else                          !=== Y views              else                          !=== Y views
3620                 nclsy = nclsy + 1                 nclsy = nclsy + 1
3621                 planey(nclsy) = ip                 planey(nclsy) = ip
3622                 sgnlys(nclsy) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3623                   if(nsatstrips(icl).gt.0)sgnlys(nclsy)=-sgnlys(nclsy)
3624                 clsy(nclsy)   = icl                 clsy(nclsy)   = icl
3625                 do is=1,2                 do is=1,2
3626  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
3627                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
3628                      call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
3629                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2
3630                 enddo                 enddo
3631  c$$$               print*,'nclsy         ',nclsy  c$$$               print*,'nclsy         ',nclsy
# Line 4068  c$$$               print*,'ys(1,nclsy)   Line 3635  c$$$               print*,'ys(1,nclsy)  
3635  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)
3636              endif              endif
3637           endif           endif
 c      print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)  
3638    
3639  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
3640           whichtrack(icl) = cl_used(icl)           whichtrack(icl) = cl_used(icl)
# Line 4076  c      print*,icl,cl_used(icl),cl_good(i Line 3642  c      print*,icl,cl_used(icl),cl_good(i
3642        enddo        enddo
3643        end        end
3644    
3645    ***************************************************
3646    *                                                 *
3647    *                                                 *
3648    *                                                 *
3649    *                                                 *
3650    *                                                 *
3651    *                                                 *
3652    **************************************************
3653    
3654          subroutine fill_hough
3655    
3656    *     -------------------------------------------------------
3657    *     This routine fills the  variables related to the hough
3658    *     transform, for the debig n-tuple
3659    *     -------------------------------------------------------
3660    
3661          include 'commontracker.f'
3662          include 'level1.f'
3663          include 'common_momanhough.f'
3664          include 'common_hough.f'
3665          include 'level2.f'
3666    
3667          if(.false.
3668         $     .or.ntrpt.gt.ntrpt_max_nt
3669         $     .or.ndblt.gt.ndblt_max_nt
3670         $     .or.NCLOUDS_XZ.gt.ncloxz_max
3671         $     .or.NCLOUDS_yZ.gt.ncloyz_max
3672         $     )then
3673             ntrpt_nt=0
3674             ndblt_nt=0
3675             NCLOUDS_XZ_nt=0
3676             NCLOUDS_YZ_nt=0
3677          else
3678             ndblt_nt=ndblt
3679             ntrpt_nt=ntrpt
3680             if(ndblt.ne.0)then
3681                do id=1,ndblt
3682                   alfayz1_nt(id)=alfayz1(id) !Y0
3683                   alfayz2_nt(id)=alfayz2(id) !tg theta-yz
3684                enddo
3685             endif
3686             if(ndblt.ne.0)then
3687                do it=1,ntrpt
3688                   alfaxz1_nt(it)=alfaxz1(it) !X0
3689                   alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
3690                   alfaxz3_nt(it)=alfaxz3(it) !1/r
3691                enddo
3692             endif
3693             nclouds_yz_nt=nclouds_yz
3694             nclouds_xz_nt=nclouds_xz
3695             if(nclouds_yz.ne.0)then
3696                nnn=0
3697                do iyz=1,nclouds_yz
3698                   ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
3699                   alfayz1_av_nt(iyz)=alfayz1_av(iyz)
3700                   alfayz2_av_nt(iyz)=alfayz2_av(iyz)
3701                   nnn=nnn+ptcloud_yz(iyz)
3702                enddo
3703                do ipt=1,nnn
3704                   db_cloud_nt(ipt)=db_cloud(ipt)
3705                 enddo
3706             endif
3707             if(nclouds_xz.ne.0)then
3708                nnn=0
3709                do ixz=1,nclouds_xz
3710                   ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
3711                   alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
3712                   alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
3713                   alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
3714                   nnn=nnn+ptcloud_xz(ixz)              
3715                enddo
3716                do ipt=1,nnn
3717                  tr_cloud_nt(ipt)=tr_cloud(ipt)
3718                 enddo
3719             endif
3720          endif
3721          end
3722          

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

  ViewVC Help
Powered by ViewVC 1.1.23