/[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.8 by pam-fi, Wed Oct 25 16:18:41 2006 UTC revision 1.24 by pam-fi, Tue May 15 16:22:18 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          cutdistyz=cutystart      
159          cutdistxz=cutxstart      
160    
161  c      iflag=0   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           iprint=0           iprint=0
363           if(DEBUG)iprint=1  c         if(DEBUG)iprint=1
364             if(VERBOSE)iprint=1
365             if(DEBUG)iprint=2
366           call mini2(jstep,ifail,iprint)           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 *** (mini2) '       $              '*** 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 362  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 558  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 596  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)
581    
582    
583    c$$$      print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy
584                
585        resxPAM = 0        resxPAM = 0
586        resyPAM = 0        resyPAM = 0
# Line 648  c      double precision xi_B,yi_B,zi_B Line 594  c      double precision xi_B,yi_B,zi_B
594        xPAM_B = 0.        xPAM_B = 0.
595        yPAM_B = 0.        yPAM_B = 0.
596        zPAM_B = 0.        zPAM_B = 0.
597    c      print*,'## xyz_PAM: ',icx,icy,sensor,PFAx,PFAy,angx,angy
598    
599  *     -----------------  *     -----------------
600  *     CLUSTER X  *     CLUSTER X
601  *     -----------------  *     -----------------
602    
603        if(icx.ne.0)then        if(icx.ne.0)then
604           viewx = VIEW(icx)  
605           nldx = nld(MAXS(icx),VIEW(icx))           viewx   = VIEW(icx)
606           nplx = npl(VIEW(icx))           nldx    = nld(MAXS(icx),VIEW(icx))
607           resxPAM = RESXAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           nplx    = npl(VIEW(icx))
608                     resxPAM = RESXAV
609           stripx = float(MAXS(icx))           stripx  = float(MAXS(icx))
610           if(PFAx.eq.'COG1')then  !(1)  *        --------------------------
611              stripx = stripx      !(1)  *        magnetic-field corrections
612              resxPAM = resxPAM    !(1)  *        --------------------------
613             angtemp  = ax
614             bfytemp  = bfy
615    *        /////////////////////////////////
616    *        AAAAHHHHHHHH!!!!!!!!!!!!!!!!!!!!!
617    *        *grvzkkjsdgjhhhgngbn###>:(
618    *        /////////////////////////////////
619    c         if(nplx.eq.6) angtemp = -1. * ax
620    c         if(nplx.eq.6) bfytemp = -1. * bfy
621             if(viewx.eq.12) angtemp = -1. * ax
622             if(viewx.eq.12) bfytemp = -1. * bfy
623             tgtemp   = tan(angtemp*acos(-1.)/180.) + pmuH_h*bfytemp*0.00001
624             angx     = 180.*atan(tgtemp)/acos(-1.)
625             stripx   = stripx - 0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
626    c$$$         print*,nplx,ax,bfy/10.
627    c$$$         print*,angx,0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
628    c$$$         print*,'========================'
629    c$$$         if(bfy.ne.0.)print*,viewx,'-x- '
630    c$$$     $        ,bfy,-1*0.5*pmuH_h*bfytemp*0.00001*SiDimZ
631    *        --------------------------
632    
633    c$$$         print*,'--- x-cl ---'
634    c$$$         istart = INDSTART(ICX)
635    c$$$         istop  = TOTCLLENGTH
636    c$$$         if(icx.lt.NCLSTR1)istop=INDSTART(ICX+1)-1
637    c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
638    c$$$         print*,(CLSIGNAL(i),i=istart,istop)
639    c$$$         print*,INDMAX(icx)
640    c$$$         print*,cog(4,icx)
641    c$$$         print*,fbad_cog(4,icx)
642            
643    
644             if(PFAx.eq.'COG1')then
645    
646                stripx  = stripx
647                resxPAM = 1e-4*pitchX/sqrt(12.)!!resxPAM
648    
649           elseif(PFAx.eq.'COG2')then           elseif(PFAx.eq.'COG2')then
650              stripx = stripx + cog(2,icx)              
651                stripx  = stripx + cog(2,icx)            
652                resxPAM = risx_cog(abs(angx))!TEMPORANEO              
653              resxPAM = resxPAM*fbad_cog(2,icx)              resxPAM = resxPAM*fbad_cog(2,icx)
654    
655             elseif(PFAx.eq.'COG3')then
656    
657                stripx  = stripx + cog(3,icx)            
658                resxPAM = risx_cog(abs(angx))!TEMPORANEO                      
659                resxPAM = resxPAM*fbad_cog(3,icx)
660    
661             elseif(PFAx.eq.'COG4')then
662    
663                stripx  = stripx + cog(4,icx)            
664                resxPAM = risx_cog(abs(angx))!TEMPORANEO                      
665                resxPAM = resxPAM*fbad_cog(4,icx)
666    
667           elseif(PFAx.eq.'ETA2')then           elseif(PFAx.eq.'ETA2')then
668  c            cog2 = cog(2,icx)  
669  c            etacorr = pfaeta2(cog2,viewx,nldx,angx)                          stripx  = stripx + pfaeta2(icx,angx)          
670  c            stripx = stripx + etacorr              resxPAM = risx_eta2(abs(angx))
671              stripx = stripx + pfaeta2(icx,angx)            !(3)              resxPAM = resxPAM*fbad_cog(2,icx)
             resxPAM = risx_eta2(angx)                       !   (4)  
672              if(DEBUG.and.fbad_cog(2,icx).ne.1)              if(DEBUG.and.fbad_cog(2,icx).ne.1)
673       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
674              resxPAM = resxPAM*fbad_cog(2,icx)  
675           elseif(PFAx.eq.'ETA3')then                         !(3)           elseif(PFAx.eq.'ETA3')then                        
676              stripx = stripx + pfaeta3(icx,angx)            !(3)  
677              resxPAM = risx_eta3(angx)                       !   (4)              stripx  = stripx + pfaeta3(icx,angx)          
678              if(DEBUG.and.fbad_cog(3,icx).ne.1)              !(3)              resxPAM = risx_eta3(abs(angx))                      
679       $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)!(3)              resxPAM = resxPAM*fbad_cog(3,icx)              
680              resxPAM = resxPAM*fbad_cog(3,icx)               !(3)              if(DEBUG.and.fbad_cog(3,icx).ne.1)            
681           elseif(PFAx.eq.'ETA4')then                         !(3)       $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)
682              stripx = stripx + pfaeta4(icx,angx)            !(3)  
683              resxPAM = risx_eta4(angx)                       !   (4)           elseif(PFAx.eq.'ETA4')then                        
684              if(DEBUG.and.fbad_cog(4,icx).ne.1)              !(3)  
685       $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)!(3)              stripx  = stripx + pfaeta4(icx,angx)            
686              resxPAM = resxPAM*fbad_cog(4,icx)               !(3)              resxPAM = risx_eta4(abs(angx))                      
687           elseif(PFAx.eq.'ETA')then                          !(3)              resxPAM = resxPAM*fbad_cog(4,icx)              
688              stripx = stripx + pfaeta(icx,angx)             !(3)              if(DEBUG.and.fbad_cog(4,icx).ne.1)              
689              resxPAM = ris_eta(icx,angx)                     !   (4)       $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)
690              if(DEBUG.and.fbad_cog(2,icx).ne.1)              !(3)  
691       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)!(3)           elseif(PFAx.eq.'ETA')then  
692  c            resxPAM = resxPAM*fbad_cog(2,icx)               !(3)TEMPORANEO  
693              resxPAM = resxPAM*fbad_eta(icx,angx)             !(3)(4)              stripx  = stripx + pfaeta(icx,angx)            
694           elseif(PFAx.eq.'COG')then           !(2)  c            resxPAM = riseta(icx,angx)                    
695              stripx = stripx + cog(0,icx)     !(2)                      resxPAM = riseta(viewx,angx)                    
696              resxPAM = risx_cog(angx)                        !   (4)              resxPAM = resxPAM*fbad_eta(icx,angx)            
697              resxPAM = resxPAM*fbad_cog(0,icx)!(2)              if(DEBUG.and.fbad_cog(2,icx).ne.1)              
698         $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
699    
700             elseif(PFAx.eq.'COG')then          
701    
702                stripx  = stripx + cog(0,icx)            
703                resxPAM = risx_cog(abs(angx))                    
704                resxPAM = resxPAM*fbad_cog(0,icx)
705    
706           else           else
707              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx
708             endif
709    
710    
711    *     ======================================
712    *     temporary patch for saturated clusters
713    *     ======================================
714             if( nsatstrips(icx).gt.0 )then
715                stripx  = stripx + cog(4,icx)            
716                resxPAM = pitchX*1e-4/sqrt(12.)
717                cc=cog(4,icx)
718    c$$$            print*,icx,' *** ',cc
719    c$$$            print*,icx,' *** ',resxPAM
720           endif           endif
721    
722        endif        endif
 c      if(icy.eq.0.and.icx.ne.0)  
 c     $     print*,PFAx,icx,angx,stripx,resxPAM,'***'  
723                
724  *     -----------------  *     -----------------
725  *     CLUSTER Y  *     CLUSTER Y
726  *     -----------------  *     -----------------
727    
728        if(icy.ne.0)then        if(icy.ne.0)then
729    
730           viewy = VIEW(icy)           viewy = VIEW(icy)
731           nldy = nld(MAXS(icy),VIEW(icy))           nldy = nld(MAXS(icy),VIEW(icy))
732           nply = npl(VIEW(icy))           nply = npl(VIEW(icy))
733           resyPAM = RESYAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           resyPAM = RESYAV
734             stripy = float(MAXS(icy))
735    
736           if(icx.ne.0.and.(nply.ne.nplx.or.nldy.ne.nldx))then           if(icx.ne.0.and.(nply.ne.nplx.or.nldy.ne.nldx))then
737              print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '              if(DEBUG) then
738       $           ,icx,icy                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '
739         $              ,icx,icy
740                endif
741              goto 100              goto 100
742           endif           endif
743            *        --------------------------
744           stripy = float(MAXS(icy))  *        magnetic-field corrections
745           if(PFAy.eq.'COG1')then !(1)  *        --------------------------
746              stripy = stripy     !(1)           tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
747              resyPAM = resyPAM   !(1)           angy    = 180.*atan(tgtemp)/acos(-1.)
748             stripy = stripy + 0.5*pmuH_e*bfx*0.00001*SiDimZ/pitchY
749    c$$$         if(bfx.ne.0.)print*,viewy,'-y- '
750    c$$$     $        ,bfx,0.5*pmuH_e*bfx*0.00001*SiDimZ
751    *        --------------------------
752            
753    c$$$         print*,'--- y-cl ---'
754    c$$$         istart = INDSTART(ICY)
755    c$$$         istop  = TOTCLLENGTH
756    c$$$         if(icy.lt.NCLSTR1)istop=INDSTART(ICY+1)-1
757    c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
758    c$$$         print*,(CLSIGNAL(i),i=istart,istop)
759    c$$$         print*,INDMAX(icy)
760    c$$$         print*,cog(4,icy)
761    c$$$         print*,fbad_cog(4,icy)
762    
763             if(PFAy.eq.'COG1')then
764    
765                stripy  = stripy    
766                resyPAM = 1e-4*pitchY/sqrt(12.)!resyPAM  
767    
768           elseif(PFAy.eq.'COG2')then           elseif(PFAy.eq.'COG2')then
769              stripy = stripy + cog(2,icy)  
770                stripy  = stripy + cog(2,icy)
771                resyPAM = risy_cog(abs(angy))!TEMPORANEO
772              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
773    
774             elseif(PFAy.eq.'COG3')then
775    
776                stripy  = stripy + cog(3,icy)
777                resyPAM = risy_cog(abs(angy))!TEMPORANEO
778                resyPAM = resyPAM*fbad_cog(3,icy)
779    
780             elseif(PFAy.eq.'COG4')then
781    
782                stripy  = stripy + cog(4,icy)
783                resyPAM = risy_cog(abs(angy))!TEMPORANEO
784                resyPAM = resyPAM*fbad_cog(4,icy)
785    
786           elseif(PFAy.eq.'ETA2')then           elseif(PFAy.eq.'ETA2')then
787  c            cog2 = cog(2,icy)  
788  c            etacorr = pfaeta2(cog2,viewy,nldy,angy)              stripy  = stripy + pfaeta2(icy,angy)          
789  c            stripy = stripy + etacorr              resyPAM = risy_eta2(abs(angy))              
             stripy = stripy + pfaeta2(icy,angy)            !(3)  
             resyPAM = risy_eta2(angy)                       !   (4)  
790              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
791              if(DEBUG.and.fbad_cog(2,icy).ne.1)              if(DEBUG.and.fbad_cog(2,icy).ne.1)
792       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
793           elseif(PFAy.eq.'ETA3')then                         !(3)  
794              stripy = stripy + pfaeta3(icy,angy)            !(3)           elseif(PFAy.eq.'ETA3')then                      
795              resyPAM = resyPAM*fbad_cog(3,icy)               !(3)  
796              if(DEBUG.and.fbad_cog(3,icy).ne.1)              !(3)              stripy  = stripy + pfaeta3(icy,angy)
797       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)!(3)              resyPAM = resyPAM*fbad_cog(3,icy)  
798           elseif(PFAy.eq.'ETA4')then                         !(3)              if(DEBUG.and.fbad_cog(3,icy).ne.1)
799              stripy = stripy + pfaeta4(icy,angy)            !(3)       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)
800              resyPAM = resyPAM*fbad_cog(4,icy)               !(3)  
801              if(DEBUG.and.fbad_cog(4,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA4')then  
802       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)!(3)  
803           elseif(PFAy.eq.'ETA')then                          !(3)              stripy  = stripy + pfaeta4(icy,angy)
804              stripy = stripy + pfaeta(icy,angy)             !(3)              resyPAM = resyPAM*fbad_cog(4,icy)
805              resyPAM = ris_eta(icy,angy)                     !   (4)              if(DEBUG.and.fbad_cog(4,icy).ne.1)
806  c            resyPAM = resyPAM*fbad_cog(2,icy)              !(3)TEMPORANEO       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)
807              resyPAM = resyPAM*fbad_eta(icy,angy)            !   (4)  
808              if(DEBUG.and.fbad_cog(2,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA')then
809       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)!(3)  
810                stripy  = stripy + pfaeta(icy,angy)
811    c            resyPAM = riseta(icy,angy)  
812                resyPAM = riseta(viewy,angy)  
813                resyPAM = resyPAM*fbad_eta(icy,angy)
814                if(DEBUG.and.fbad_cog(2,icy).ne.1)
815         $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
816    
817           elseif(PFAy.eq.'COG')then           elseif(PFAy.eq.'COG')then
818              stripy = stripy + cog(0,icy)              
819              resyPAM = risy_cog(angy)                        !   (4)              stripy  = stripy + cog(0,icy)            
820  c            resyPAM = ris_eta(icy,angy)                    !   (4)              resyPAM = risy_cog(abs(angy))
821              resyPAM = resyPAM*fbad_cog(0,icy)              resyPAM = resyPAM*fbad_cog(0,icy)
822    
823           else           else
824              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx
825           endif           endif
826    
827    
828    *     ======================================
829    *     temporary patch for saturated clusters
830    *     ======================================
831             if( nsatstrips(icy).gt.0 )then
832                stripy  = stripy + cog(4,icy)            
833                resyPAM = pitchY*1e-4/sqrt(12.)
834                cc=cog(4,icy)
835    c$$$            print*,icy,' *** ',cc
836    c$$$            print*,icy,' *** ',resyPAM
837             endif
838    
839    
840        endif        endif
841    
842          c$$$      print*,'## stripx,stripy ',stripx,stripy
843    
844  c===========================================================  c===========================================================
845  C     COUPLE  C     COUPLE
846  C===========================================================  C===========================================================
# Line 778  c     (xi,yi,zi) = mechanical coordinate Line 851  c     (xi,yi,zi) = mechanical coordinate
851  c------------------------------------------------------------------------  c------------------------------------------------------------------------
852           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
853       $        .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...
854              print*,'xyz_PAM (couple):',              if(DEBUG) then
855       $          ' WARNING: false X strip: strip ',stripx                 print*,'xyz_PAM (couple):',
856         $              ' WARNING: false X strip: strip ',stripx
857                endif
858           endif           endif
859           xi = acoordsi(stripx,viewx)           xi = acoordsi(stripx,viewx)
860           yi = acoordsi(stripy,viewy)           yi = acoordsi(stripy,viewy)
# Line 871  c            print*,'X-singlet ',icx,npl Line 946  c            print*,'X-singlet ',icx,npl
946  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...
947              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
948       $           .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...
949                 print*,'xyz_PAM (X-singlet):',                 if(DEBUG) then
950       $             ' WARNING: false X strip: strip ',stripx                    print*,'xyz_PAM (X-singlet):',
951         $                 ' WARNING: false X strip: strip ',stripx
952                   endif
953              endif              endif
954              xi   = acoordsi(stripx,viewx)              xi   = acoordsi(stripx,viewx)
955    
# Line 894  c            print*,'X-cl ',icx,stripx,' Line 971  c            print*,'X-cl ',icx,stripx,'
971  c            print*,yi_A,' <--> ',yi_B  c            print*,yi_A,' <--> ',yi_B
972    
973           else           else
974                if(DEBUG) then
975              print *,'routine xyz_PAM ---> not properly used !!!'                 print *,'routine xyz_PAM ---> not properly used !!!'
976              print *,'icx = ',icx                 print *,'icx = ',icx
977              print *,'icy = ',icy                 print *,'icy = ',icy
978                endif
979              goto 100              goto 100
980                            
981           endif           endif
# Line 962  c--------------------------------------- Line 1040  c---------------------------------------
1040  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'
1041    
1042        else        else
1043                       if(DEBUG) then
1044           print *,'routine xyz_PAM ---> not properly used !!!'              print *,'routine xyz_PAM ---> not properly used !!!'
1045           print *,'icx = ',icx              print *,'icx = ',icx
1046           print *,'icy = ',icy              print *,'icy = ',icy
1047                         endif
1048        endif        endif
1049                    
1050    
1051    c      print*,'## xPAM,yPAM,zPAM       ',xPAM,yPAM,zPAM
1052    c      print*,'## xPAM_A,yPAM_A,zPAM_A ',xPAM_A,yPAM_A,zPAM_A
1053    c      print*,'## xPAM_B,yPAM_B,zPAM_B ',xPAM_B,yPAM_B,zPAM_B
1054    
1055   100  continue   100  continue
1056        end        end
1057    
1058    ************************************************************************
1059    *     Call xyz_PAM subroutine with default PFA and fill the mini2 common.
1060    *     (done to be called from c/c++)
1061    ************************************************************************
1062    
1063          subroutine xyzpam(ip,icx,icy,lad,sensor,ax,ay,bfx,bfy)
1064    
1065          include 'commontracker.f'
1066          include 'level1.f'
1067          include 'common_mini_2.f'
1068          include 'common_xyzPAM.f'
1069          include 'common_mech.f'
1070          include 'calib.f'
1071          
1072    *     flag to chose PFA
1073    c$$$      character*10 PFA
1074    c$$$      common/FINALPFA/PFA
1075    
1076          integer icx,icy           !X-Y cluster ID
1077          integer sensor
1078          character*4 PFAx,PFAy     !PFA to be used
1079          real ax,ay                !X-Y geometric angle
1080          real bfx,bfy              !X-Y b-field components
1081    
1082          ipx=0
1083          ipy=0      
1084          
1085    c$$$      PFAx = 'COG4'!PFA
1086    c$$$      PFAy = 'COG4'!PFA
1087          
1088          call idtoc(pfaid,PFAx)
1089          call idtoc(pfaid,PFAy)
1090    
1091          call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1092    
1093    c$$$      print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy
1094          
1095          if(icx.ne.0.and.icy.ne.0)then
1096    
1097             ipx=npl(VIEW(icx))
1098             ipy=npl(VIEW(icy))
1099             if( (nplanes-ipx+1).ne.ip.or.(nplanes-ipy+1).ne.ip )
1100         $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1101         $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1102    
1103             xgood(ip) = 1.
1104             ygood(ip) = 1.
1105             resx(ip)  = resxPAM
1106             resy(ip)  = resyPAM
1107    
1108             xm(ip) = xPAM
1109             ym(ip) = yPAM
1110             zm(ip) = zPAM
1111             xm_A(ip) = 0.
1112             ym_A(ip) = 0.
1113             xm_B(ip) = 0.
1114             ym_B(ip) = 0.
1115    
1116    c         zv(ip) = zPAM
1117    
1118          elseif(icx.eq.0.and.icy.ne.0)then
1119    
1120             ipy=npl(VIEW(icy))
1121             if((nplanes-ipy+1).ne.ip)
1122         $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1123         $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1124    
1125             xgood(ip) = 0.
1126             ygood(ip) = 1.
1127             resx(ip)  = 1000.
1128             resy(ip)  = resyPAM
1129    
1130             xm(ip) = -100.
1131             ym(ip) = -100.
1132             zm(ip) = (zPAM_A+zPAM_B)/2.
1133             xm_A(ip) = xPAM_A
1134             ym_A(ip) = yPAM_A
1135             xm_B(ip) = xPAM_B
1136             ym_B(ip) = yPAM_B
1137    
1138    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1139            
1140          elseif(icx.ne.0.and.icy.eq.0)then
1141    
1142             ipx=npl(VIEW(icx))
1143             if((nplanes-ipx+1).ne.ip)
1144         $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1145         $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1146    
1147             xgood(ip) = 1.
1148             ygood(ip) = 0.
1149             resx(ip)  = resxPAM
1150             resy(ip)  = 1000.
1151    
1152             xm(ip) = -100.
1153             ym(ip) = -100.
1154             zm(ip) = (zPAM_A+zPAM_B)/2.
1155             xm_A(ip) = xPAM_A
1156             ym_A(ip) = yPAM_A
1157             xm_B(ip) = xPAM_B
1158             ym_B(ip) = yPAM_B
1159            
1160    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1161    
1162          else
1163    
1164             il = 2
1165             if(lad.ne.0)il=lad
1166             is = 1
1167             if(sensor.ne.0)is=sensor
1168    c         print*,nplanes-ip+1,il,is
1169    
1170             xgood(ip) = 0.
1171             ygood(ip) = 0.
1172             resx(ip)  = 1000.
1173             resy(ip)  = 1000.
1174    
1175             xm(ip) = -100.
1176             ym(ip) = -100.          
1177             zm(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1178             xm_A(ip) = 0.
1179             ym_A(ip) = 0.
1180             xm_B(ip) = 0.
1181             ym_B(ip) = 0.
1182    
1183    c         zv(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1184    
1185          endif
1186    
1187          if(DEBUG)then
1188    c         print*,'----------------------------- track coord'
1189    22222    format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
1190             write(*,22222)ip,zm(ip),xm(ip),ym(ip)
1191         $        ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip)
1192         $        ,xgood(ip),ygood(ip),resx(ip),resy(ip)
1193    c$$$         print*,'-----------------------------'
1194          endif
1195          end
1196    
1197  ********************************************************************************  ********************************************************************************
1198  ********************************************************************************  ********************************************************************************
# Line 1047  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1268  c         print*,'A-(',xPAM_A,yPAM_A,')
1268           endif                   endif        
1269    
1270           distance=           distance=
1271       $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2       $       ((xmi-XPP)**2+(ymi-YPP)**2)!QUIQUI
1272    cc     $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1273           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1274    
1275  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 1072  c$$$         print*,' resolution ',re Line 1294  c$$$         print*,' resolution ',re
1294  *     ----------------------  *     ----------------------
1295                    
1296           distance=           distance=
1297       $        ((xPAM-XPP)/resxPAM)**2       $       ((xPAM-XPP))**2 !QUIQUI
1298       $        +       $       +
1299       $        ((yPAM-YPP)/resyPAM)**2       $       ((yPAM-YPP))**2
1300    c$$$     $        ((xPAM-XPP)/resxPAM)**2
1301    c$$$     $        +
1302    c$$$     $        ((yPAM-YPP)/resyPAM)**2
1303           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1304    
1305  c$$$         print*,xPAM,yPAM,zPAM  c$$$         print*,xPAM,yPAM,zPAM
# Line 1083  c$$$         print*,' resolution ',resxP Line 1308  c$$$         print*,' resolution ',resxP
1308                    
1309        else        else
1310                    
1311           print*  c         print*
1312       $        ,' function distance_to ---> wrong usage!!!'  c     $        ,' function distance_to ---> wrong usage!!!'
1313           print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM  c         print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM
1314           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 '
1315       $        ,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
1316        endif          endif  
1317    
1318        distance_to = sngl(distance)        distance_to = sngl(distance)
# Line 1155  c--------------------------------------- Line 1380  c---------------------------------------
1380                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1381       $              .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...
1382  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...
1383                    print*,'whichsensor: ',  c                  print*,'whichsensor: ',
1384       $                ' WARNING: false X strip: strip ',stripx  c     $                ' WARNING: false X strip: strip ',stripx
1385                 endif                 endif
1386                 xi = acoordsi(stripx,viewx)                 xi = acoordsi(stripx,viewx)
1387                 yi = acoordsi(stripy,viewy)                 yi = acoordsi(stripy,viewy)
# Line 1285  c     $              ,iv,xvv(iv),yvv(iv) Line 1510  c     $              ,iv,xvv(iv),yvv(iv)
1510  *     it returns the plane number  *     it returns the plane number
1511  *      *    
1512        include 'commontracker.f'        include 'commontracker.f'
1513          include 'level1.f'
1514  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1515        include 'common_momanhough.f'        include 'common_momanhough.f'
1516                
# Line 1310  c      include 'common_analysis.f' Line 1536  c      include 'common_analysis.f'
1536        is_cp=0        is_cp=0
1537        if(id.lt.0)is_cp=1        if(id.lt.0)is_cp=1
1538        if(id.gt.0)is_cp=2        if(id.gt.0)is_cp=2
1539        if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'  c      if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'
1540    
1541        return        return
1542        end        end
# Line 1322  c      include 'common_analysis.f' Line 1548  c      include 'common_analysis.f'
1548  *     it returns the id number ON THE PLANE  *     it returns the id number ON THE PLANE
1549  *      *    
1550        include 'commontracker.f'        include 'commontracker.f'
1551          include 'level1.f'
1552  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1553        include 'common_momanhough.f'        include 'common_momanhough.f'
1554                
# Line 1350  c      include 'common_analysis.f' Line 1577  c      include 'common_analysis.f'
1577  *     positive if sensor =2  *     positive if sensor =2
1578  *  *
1579        include 'commontracker.f'        include 'commontracker.f'
1580          include 'level1.f'
1581  c      include 'calib.f'  c      include 'calib.f'
1582  c      include 'level1.f'  c      include 'level1.f'
1583  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1584        include 'common_momanhough.f'        include 'common_momanhough.f'
1585                
1586        id_cp=0        id_cp=0
1587    
1588        if(ip.gt.1)then        if(ip.gt.1)then
1589           do i=1,ip-1           do i=1,ip-1
1590              id_cp = id_cp + ncp_plane(i)              id_cp = id_cp + ncp_plane(i)
1591           enddo           enddo
       endif  
   
       id_cp = id_cp + icp  
   
       if(is.eq.1) id_cp = -id_cp  
   
       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,badclx,badcly  
   
 *     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 on multiplicity (X VIEW)  
 *     ----------------------------------------------------  
          if(mult(icx).ge.mult_x_max)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  
          badclx=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  
             badclx=badclx*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 on multiplicity (X VIEW)  
 *     ----------------------------------------------------  
             if(mult(icy).ge.mult_y_max)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  
             badcly=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))  
                badcly=badcly*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 <<<  
 *     -------------------------------------------------------------  
                if(  .not.(dedx(icy).gt.chsaty.and.dedx(icx).gt.chsatx)  
      $              .and.  
      $              .not.(dedx(icy).lt.chmipy.and.dedx(icx).lt.chmipx)  
      $              .and.  
      $              (badclx.eq.1.and.badcly.eq.1)  
      $              .and.  
      $              .true.)then  
   
                   ddd=(dedx(icy)  
      $                 -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  
                   ddd=ddd/sqrt(kch(nplx,nldx)**2+1)  
   
 c                  cut = chcut * sch(nplx,nldx)  
   
                   sss=(kch(nplx,nldx)*dedx(icy)+dedx(icx)  
      $                 -kch(nplx,nldx)*cch(nplx,nldx))  
                   sss=sss/sqrt(kch(nplx,nldx)**2+1)  
                   cut = chcut * (16 + sss/50.)  
   
                   if(abs(ddd).gt.cut)then  
                      goto 20    !charge not consistent  
                   endif  
                endif  
                 
 *     ------------------> COUPLE <------------------  
 *     check to do not overflow vector dimentions  
 c$$$               if(ncp_plane(nplx).gt.ncouplemax)then  
 c$$$                  if(DEBUG)print*,  
 c$$$     $                    ' ** warning ** number of identified'//  
 c$$$     $                    ' couples on plane ',nplx,  
 c$$$     $                    ' exceeds vector dimention'//  
 c$$$     $                    ' ( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event  
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
                 
                if(ncp_plane(nplx).eq.ncouplemax)then  
                   if(verbose)print*,  
      $                 '** warning ** number of identified '//  
      $                 'couples on plane ',nplx,  
      $                 'exceeds vector dimention '  
      $                 ,'( ',ncouplemax,' )'  
 c     good2=.false.  
 c     goto 880   !fill ntp and go to next event                      
                   iflag=1  
                   return  
                endif  
                 
                ncp_plane(nplx) = ncp_plane(nplx) + 1  
                clx(nplx,ncp_plane(nplx))=icx  
                cly(nply,ncp_plane(nplx))=icy  
                cl_single(icx)=0  
                cl_single(icy)=0  
             endif                                
 *     ----------------------------------------------  
   
  20         continue  
          enddo                  !end loop on clusters(Y)  
           
  10      continue  
       enddo                     !end loop on clusters(X)  
         
         
       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(verbose)print*,  
      $           '** warning ** number of identified '//  
      $           'couples exceeds upper limit for Hough tr. '  
      $           ,'( ',ncp_max,' )'              
 c            good2=.false.  
 c     goto 880       !fill ntp and go to next event  
          iflag=1  
          return  
1592        endif        endif
1593          
1594          id_cp = id_cp + icp
1595    
1596          if(is.eq.1) id_cp = -id_cp
1597    
1598        return        return
1599        end        end
1600    
1601    
1602    
1603    
1604    *************************************************************************
1605    *************************************************************************
1606    *************************************************************************
1607    *************************************************************************
1608    *************************************************************************
1609    *************************************************************************
1610                
1611    
1612  ***************************************************  ***************************************************
1613  *                                                 *  *                                                 *
1614  *                                                 *  *                                                 *
# Line 1920  c     goto 880       !fill ntp and go to Line 1617  c     goto 880       !fill ntp and go to
1617  *                                                 *  *                                                 *
1618  *                                                 *  *                                                 *
1619  **************************************************  **************************************************
1620        subroutine cl_to_couples_nocharge(iflag)  
1621          subroutine cl_to_couples(iflag)
1622    
1623        include 'commontracker.f'        include 'commontracker.f'
1624          include 'level1.f'
1625        include 'common_momanhough.f'        include 'common_momanhough.f'
1626        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1627        include 'calib.f'        include 'calib.f'
1628        include 'level1.f'  c      include 'level1.f'
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1629    
1630  *     output flag  *     output flag
1631  *     --------------  *     --------------
# Line 1938  c      common/dbg/DEBUG Line 1634  c      common/dbg/DEBUG
1634  *     --------------  *     --------------
1635        integer iflag        integer iflag
1636    
1637        integer badseed,badcl        integer badseed,badclx,badcly
1638    
1639  *     init variables  *     init variables
1640        ncp_tot=0        ncp_tot=0
# Line 1954  c      common/dbg/DEBUG Line 1650  c      common/dbg/DEBUG
1650           ncls(ip)=0           ncls(ip)=0
1651        enddo        enddo
1652        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1653           cl_single(icl)=1           cl_single(icl) = 1
1654           cl_good(icl)=0           cl_good(icl)   = 0
1655          enddo
1656          do iv=1,nviews
1657             ncl_view(iv)  = 0
1658             mask_view(iv) = 0      !all included
1659        enddo        enddo
1660                
1661    *     count number of cluster per view
1662          do icl=1,nclstr1
1663             ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1        
1664          enddo
1665    *     mask views with too many clusters
1666          do iv=1,nviews
1667             if( ncl_view(iv).gt. nclusterlimit)then
1668                mask_view(iv) = 1
1669                if(DEBUG)print*,' * WARNING * cl_to_couple: n.clusters > '
1670         $           ,nclusterlimit,' on view ', iv,' --> masked!'
1671             endif
1672          enddo
1673    
1674    
1675  *     start association  *     start association
1676        ncouples=0        ncouples=0
1677        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1678           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1679                    
1680  *     ----------------------------------------------------  *     ----------------------------------------------------
1681    *     jump masked views (X VIEW)
1682    *     ----------------------------------------------------
1683             if( mask_view(VIEW(icx)).ne.0 ) goto 10
1684    *     ----------------------------------------------------
1685  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1686           if(dedx(icx).lt.dedx_x_min)then  *     ----------------------------------------------------
1687             if(sgnl(icx).lt.dedx_x_min)then
1688              cl_single(icx)=0              cl_single(icx)=0
1689              goto 10              goto 10
1690           endif           endif
1691    *     ----------------------------------------------------
1692  *     cut BAD (X VIEW)              *     cut BAD (X VIEW)            
1693    *     ----------------------------------------------------
1694           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
1695           ifirst=INDSTART(icx)           ifirst=INDSTART(icx)
1696           if(icx.ne.nclstr1) then           if(icx.ne.nclstr1) then
# Line 1977  c      common/dbg/DEBUG Line 1698  c      common/dbg/DEBUG
1698           else           else
1699              ilast=TOTCLLENGTH              ilast=TOTCLLENGTH
1700           endif           endif
1701           badcl=badseed           badclx=badseed
1702           do igood=-ngoodstr,ngoodstr           do igood=-ngoodstr,ngoodstr
1703              ibad=1              ibad=1
1704              if((INDMAX(icx)+igood).gt.ifirst.and.              if((INDMAX(icx)+igood).gt.ifirst.and.
# Line 1987  c      common/dbg/DEBUG Line 1708  c      common/dbg/DEBUG
1708       $              nvk(MAXS(icx)+igood),       $              nvk(MAXS(icx)+igood),
1709       $              nst(MAXS(icx)+igood))       $              nst(MAXS(icx)+igood))
1710              endif              endif
1711              badcl=badcl*ibad              badclx=badclx*ibad
1712           enddo           enddo
1713           if(badcl.eq.0)then     !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1714              cl_single(icx)=0    !<<<<<<<<<<<<<< BAD cut  *     >>> eliminato il taglio sulle BAD <<<
1715              goto 10             !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1716           endif                  !<<<<<<<<<<<<<< BAD cut  c     if(badcl.eq.0)then
1717    c     cl_single(icx)=0
1718    c     goto 10
1719    c     endif
1720  *     ----------------------------------------------------  *     ----------------------------------------------------
1721                    
1722           cl_good(icx)=1           cl_good(icx)=1
# Line 2003  c      common/dbg/DEBUG Line 1727  c      common/dbg/DEBUG
1727              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1728                            
1729  *     ----------------------------------------------------  *     ----------------------------------------------------
1730    *     jump masked views (Y VIEW)
1731    *     ----------------------------------------------------
1732                if( mask_view(VIEW(icy)).ne.0 ) goto 20
1733    
1734    *     ----------------------------------------------------
1735  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1736              if(dedx(icy).lt.dedx_y_min)then  *     ----------------------------------------------------
1737                if(sgnl(icy).lt.dedx_y_min)then
1738                 cl_single(icy)=0                 cl_single(icy)=0
1739                 goto 20                 goto 20
1740              endif              endif
1741    *     ----------------------------------------------------
1742  *     cut BAD (Y VIEW)              *     cut BAD (Y VIEW)            
1743    *     ----------------------------------------------------
1744              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
1745              ifirst=INDSTART(icy)              ifirst=INDSTART(icy)
1746              if(icy.ne.nclstr1) then              if(icy.ne.nclstr1) then
# Line 2016  c      common/dbg/DEBUG Line 1748  c      common/dbg/DEBUG
1748              else              else
1749                 ilast=TOTCLLENGTH                 ilast=TOTCLLENGTH
1750              endif              endif
1751              badcl=badseed              badcly=badseed
1752              do igood=-ngoodstr,ngoodstr              do igood=-ngoodstr,ngoodstr
1753                 ibad=1                 ibad=1
1754                 if((INDMAX(icy)+igood).gt.ifirst.and.                 if((INDMAX(icy)+igood).gt.ifirst.and.
# Line 2025  c      common/dbg/DEBUG Line 1757  c      common/dbg/DEBUG
1757       $              ibad=BAD(VIEW(icy),       $              ibad=BAD(VIEW(icy),
1758       $              nvk(MAXS(icy)+igood),       $              nvk(MAXS(icy)+igood),
1759       $              nst(MAXS(icy)+igood))       $              nst(MAXS(icy)+igood))
1760                 badcl=badcl*ibad                 badcly=badcly*ibad
1761              enddo              enddo
             if(badcl.eq.0)then  !<<<<<<<<<<<<<< BAD cut  
                cl_single(icy)=0 !<<<<<<<<<<<<<< BAD cut  
                goto 20          !<<<<<<<<<<<<<< BAD cut  
             endif               !<<<<<<<<<<<<<< BAD cut  
1762  *     ----------------------------------------------------  *     ----------------------------------------------------
1763                *     >>> eliminato il taglio sulle BAD <<<
1764    *     ----------------------------------------------------
1765    c     if(badcl.eq.0)then
1766    c     cl_single(icy)=0
1767    c     goto 20
1768    c     endif
1769    *     ----------------------------------------------------
1770                            
1771              cl_good(icy)=1                                cl_good(icy)=1                  
1772              nply=npl(VIEW(icy))              nply=npl(VIEW(icy))
# Line 2043  c      common/dbg/DEBUG Line 1777  c      common/dbg/DEBUG
1777  *     ----------------------------------------------  *     ----------------------------------------------
1778  *     geometrical consistency (same plane and ladder)  *     geometrical consistency (same plane and ladder)
1779              if(nply.eq.nplx.and.nldy.eq.nldx)then              if(nply.eq.nplx.and.nldy.eq.nldx)then
1780  *     charge correlation  *     charge correlation
1781  *     ===========================================================  *     (modified to be applied only below saturation... obviously)
1782  *     this version of the subroutine is used for the calibration  
1783  *     thus charge-correlation selection is obviously removed                 if(  .not.(sgnl(icy).gt.chsaty.and.sgnl(icx).gt.chsatx)
1784  *     ===========================================================       $              .and.
1785  c$$$               ddd=(dedx(icy)       $              .not.(sgnl(icy).lt.chmipy.and.sgnl(icx).lt.chmipx)
1786  c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))       $              .and.
1787  c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)       $              (badclx.eq.1.and.badcly.eq.1)
1788  c$$$               cut=chcut*sch(nplx,nldx)       $              .and.
1789  c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent       $              .true.)then
1790  *     ===========================================================  
1791                                    ddd=(sgnl(icy)
1792                       $                 -kch(nplx,nldx)*sgnl(icx)-cch(nplx,nldx))
1793  *     ------------------> COUPLE <------------------                    ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
1794  *     check to do not overflow vector dimentions  
1795  c$$$               if(ncp_plane(nplx).gt.ncouplemax)then  c                  cut = chcut * sch(nplx,nldx)
1796  c$$$                  if(DEBUG)print*,  
1797  c$$$     $                    ' ** warning ** number of identified'//                    sss=(kch(nplx,nldx)*sgnl(icy)+sgnl(icx)
1798  c$$$     $                    ' couples on plane ',nplx,       $                 -kch(nplx,nldx)*cch(nplx,nldx))
1799  c$$$     $                    ' exceeds vector dimention'//                    sss=sss/sqrt(kch(nplx,nldx)**2+1)
1800  c$$$     $                    ' ( ',ncouplemax,' )'                    cut = chcut * (16 + sss/50.)
1801  c$$$c     good2=.false.  
1802  c$$$c     goto 880   !fill ntp and go to next event                    if(abs(ddd).gt.cut)then
1803  c$$$                  iflag=1                       goto 20    !charge not consistent
1804  c$$$                  return                    endif
1805  c$$$               endif                 endif
1806                  
1807                 if(ncp_plane(nplx).eq.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
1808                    if(verbose)print*,                    if(verbose)print*,
1809       $                 '** warning ** number of identified '//       $                 '** warning ** number of identified '//
1810       $                 'couples on plane ',nplx,       $                 'couples on plane ',nplx,
1811       $                 'exceeds vector dimention '       $                 'exceeds vector dimention '
1812       $                 ,'( ',ncouplemax,' )'       $                 ,'( ',ncouplemax,' ) --> masked!'
1813  c     good2=.false.                    mask_view(nviewx(nplx)) = 2
1814  c     goto 880   !fill ntp and go to next event                                        mask_view(nviewy(nply)) = 2
1815                    iflag=1                    goto 10
                   return  
1816                 endif                 endif
1817                                
1818    *     ------------------> COUPLE <------------------
1819                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
1820                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
1821                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
1822                 cl_single(icx)=0                 cl_single(icx)=0
1823                 cl_single(icy)=0                 cl_single(icy)=0
             endif                                
1824  *     ----------------------------------------------  *     ----------------------------------------------
1825    
1826                endif                              
1827    
1828   20         continue   20         continue
1829           enddo                  !end loop on clusters(Y)           enddo                  !end loop on clusters(Y)
1830                    
# Line 2114  c     goto 880   !fill ntp and go to nex Line 1849  c     goto 880   !fill ntp and go to nex
1849        endif        endif
1850                
1851        do ip=1,6        do ip=1,6
1852           ncp_tot=ncp_tot+ncp_plane(ip)           ncp_tot = ncp_tot + ncp_plane(ip)
1853        enddo        enddo
 c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
         
       if(ncp_tot.gt.ncp_max)then  
          if(verbose)print*,  
      $           '** warning ** number of identified '//  
      $           'couples exceeds upper limit for Hough tr. '  
      $           ,'( ',ncp_max,' )'              
 c            good2=.false.  
 c     goto 880       !fill ntp and go to next event  
          iflag=1  
          return  
       endif  
1854                
1855        return        return
1856        end        end
   
1857                
1858  ***************************************************  ***************************************************
1859  *                                                 *  *                                                 *
# Line 2143  c     goto 880       !fill ntp and go to Line 1865  c     goto 880       !fill ntp and go to
1865  **************************************************  **************************************************
1866    
1867        subroutine cp_to_doubtrip(iflag)        subroutine cp_to_doubtrip(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
1868    
1869        include 'commontracker.f'        include 'commontracker.f'
1870          include 'level1.f'
1871        include 'common_momanhough.f'        include 'common_momanhough.f'
       include 'momanhough_init.f'  
1872        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1873        include 'common_mini_2.f'        include 'common_mini_2.f'
1874        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
1875    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1876    
1877  *     output flag  *     output flag
1878  *     --------------  *     --------------
# Line 2189  c      double precision xm3,ym3,zm3 Line 1905  c      double precision xm3,ym3,zm3
1905  *     -----------------------------  *     -----------------------------
1906    
1907    
1908    *     --------------------------------------------
1909    *     put a limit to the maximum number of couples
1910    *     per plane, in order to apply hough transform
1911    *     (couples recovered during track refinement)
1912    *     --------------------------------------------
1913          do ip=1,nplanes
1914             if(ncp_plane(ip).gt.ncouplelimit)then
1915                mask_view(nviewx(ip)) = 8
1916                mask_view(nviewy(ip)) = 8
1917             endif
1918          enddo
1919    
1920    
1921        ndblt=0                   !number of doublets        ndblt=0                   !number of doublets
1922        ntrpt=0                   !number of triplets        ntrpt=0                   !number of triplets
1923                
1924        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1
1925           do is1=1,2             !loop on sensors - COPPIA 1           if(  mask_view(nviewx(ip1)).ne.0 .or.
1926                     $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
1927             do is1=1,2             !loop on sensors - COPPIA 1            
1928              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
1929                 icx1=clx(ip1,icp1)                 icx1=clx(ip1,icp1)
1930                 icy1=cly(ip1,icp1)                 icy1=cly(ip1,icp1)
1931  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
1932                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
1933                   call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
1934                 xm1=xPAM                 xm1=xPAM
1935                 ym1=yPAM                 ym1=yPAM
1936                 zm1=zPAM                                   zm1=zPAM                  
1937  c     print*,'***',is1,xm1,ym1,zm1  c     print*,'***',is1,xm1,ym1,zm1
1938    
1939                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
1940                      if(  mask_view(nviewx(ip2)).ne.0 .or.
1941         $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
1942                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    do is2=1,2    !loop on sensors -ndblt COPPIA 2
1943                                            
1944                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2
# Line 2213  c     print*,'***',is1,xm1,ym1,zm1 Line 1946  c     print*,'***',is1,xm1,ym1,zm1
1946                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
1947  c                        call xyz_PAM  c                        call xyz_PAM
1948  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
1949    c                        call xyz_PAM
1950    c     $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)
1951                          call xyz_PAM                          call xyz_PAM
1952       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.,0.,0.)
1953                          xm2=xPAM                          xm2=xPAM
1954                          ym2=yPAM                          ym2=yPAM
1955                          zm2=zPAM                          zm2=zPAM
# Line 2230  c     $                       (icx2,icy2 Line 1965  c     $                       (icx2,icy2
1965       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
1966  c                           good2=.false.  c                           good2=.false.
1967  c                           goto 880 !fill ntp and go to next event  c                           goto 880 !fill ntp and go to next event
1968                               do iv=1,12
1969                                  mask_view(iv) = 3
1970                               enddo
1971                             iflag=1                             iflag=1
1972                             return                             return
1973                          endif                          endif
# Line 2263  c$$$ Line 2001  c$$$
2001  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2002    
2003    
2004                          if(ip2.eq.nplanes)goto 30 !no possible combination with 3 couples                          if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
2005    
2006                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
2007                               if(  mask_view(nviewx(ip3)).ne.0 .or.
2008         $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
2009                             do is3=1,2 !loop on sensors - COPPIA 3                             do is3=1,2 !loop on sensors - COPPIA 3
2010                                                                
2011                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
# Line 2272  c$$$ Line 2013  c$$$
2013                                   icy3=cly(ip3,icp3)                                   icy3=cly(ip3,icp3)
2014  c                                 call xyz_PAM  c                                 call xyz_PAM
2015  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
2016    c                                 call xyz_PAM
2017    c     $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)
2018                                   call xyz_PAM                                   call xyz_PAM
2019       $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)       $                                (icx3,icy3,is3,PFAdef,PFAdef
2020         $                                ,0.,0.,0.,0.)
2021                                   xm3=xPAM                                   xm3=xPAM
2022                                   ym3=yPAM                                   ym3=yPAM
2023                                   zm3=zPAM                                   zm3=zPAM
# Line 2300  c     $                                 Line 2044  c     $                                
2044       $                    ,'( ',ntrpt_max,' )'       $                    ,'( ',ntrpt_max,' )'
2045  c                                    good2=.false.  c                                    good2=.false.
2046  c                                    goto 880 !fill ntp and go to next event  c                                    goto 880 !fill ntp and go to next event
2047                                        do iv=1,nviews
2048                                           mask_view(iv) = 4
2049                                        enddo
2050                                      iflag=1                                      iflag=1
2051                                      return                                      return
2052                                   endif                                   endif
# Line 2338  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp Line 2085  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp
2085                                endif                                endif
2086                             enddo !end loop on COPPIA 3                             enddo !end loop on COPPIA 3
2087                          enddo   !end loop on sensors - COPPIA 3                          enddo   !end loop on sensors - COPPIA 3
2088     30                     continue
2089                       enddo      !end loop on planes  - COPPIA 3                       enddo      !end loop on planes  - COPPIA 3
2090   30                  continue   31                  continue
2091                                            
2092   1                enddo         !end loop on COPPIA 2   1                enddo         !end loop on COPPIA 2
2093                 enddo            !end loop on sensors - COPPIA 2                 enddo            !end loop on sensors - COPPIA 2
2094     20            continue
2095              enddo               !end loop on planes  - COPPIA 2              enddo               !end loop on planes  - COPPIA 2
2096                            
2097           enddo                  !end loop on COPPIA1           enddo                  !end loop on COPPIA1
2098        enddo                     !end loop on sensors - COPPIA 1        enddo                     !end loop on sensors - COPPIA 1
2099     10   continue
2100        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
2101                
2102        if(DEBUG)then        if(DEBUG)then
# Line 2374  c     goto 880               !ntp fill Line 2124  c     goto 880               !ntp fill
2124        subroutine doub_to_YZcloud(iflag)        subroutine doub_to_YZcloud(iflag)
2125    
2126        include 'commontracker.f'        include 'commontracker.f'
2127          include 'level1.f'
2128        include 'common_momanhough.f'        include 'common_momanhough.f'
2129        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2130    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2131    
2132  *     output flag  *     output flag
2133  *     --------------  *     --------------
# Line 2410  c      common/dbg/DEBUG Line 2159  c      common/dbg/DEBUG
2159        distance=0        distance=0
2160        nclouds_yz=0              !number of clouds        nclouds_yz=0              !number of clouds
2161        npt_tot=0        npt_tot=0
2162          nloop=0                  
2163     90   continue                  
2164        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2165           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
2166                            
# Line 2513  c     print*,'*   idbref,idb2 ',idbref,i Line 2264  c     print*,'*   idbref,idb2 ',idbref,i
2264              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2265           enddo           enddo
2266  c     print*,'>>>> ',ncpused,npt,nplused  c     print*,'>>>> ',ncpused,npt,nplused
2267           if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  c         if(ncpused.lt.ncpyz_min)goto 2228 !next doublet
2268           if(npt.lt.nptyz_min)goto 2228 !next doublet           if(npt.lt.nptyz_min)goto 2228 !next doublet
2269           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2270                    
# Line 2527  c     print*,'>>>> ',ncpused,npt,nplused Line 2278  c     print*,'>>>> ',ncpused,npt,nplused
2278       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2279  c               good2=.false.  c               good2=.false.
2280  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2281                do iv=1,nviews
2282                   mask_view(iv) = 5
2283                enddo
2284              iflag=1              iflag=1
2285              return              return
2286           endif           endif
# Line 2564  c$$$     $           ,(db_cloud(iii),iii Line 2318  c$$$     $           ,(db_cloud(iii),iii
2318        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2319                
2320                
2321          if(nloop.lt.nstepy)then      
2322            cutdistyz = cutdistyz+cutystep
2323            nloop     = nloop+1          
2324            goto 90                
2325          endif                    
2326          
2327        if(DEBUG)then        if(DEBUG)then
2328           print*,'---------------------- '           print*,'---------------------- '
2329           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
# Line 2590  c$$$     $           ,(db_cloud(iii),iii Line 2350  c$$$     $           ,(db_cloud(iii),iii
2350        subroutine trip_to_XZcloud(iflag)        subroutine trip_to_XZcloud(iflag)
2351    
2352        include 'commontracker.f'        include 'commontracker.f'
2353          include 'level1.f'
2354        include 'common_momanhough.f'        include 'common_momanhough.f'
2355        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2356    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2357    
2358  *     output flag  *     output flag
2359  *     --------------  *     --------------
# Line 2625  c      common/dbg/DEBUG Line 2384  c      common/dbg/DEBUG
2384        distance=0        distance=0
2385        nclouds_xz=0              !number of clouds                nclouds_xz=0              !number of clouds        
2386        npt_tot=0                 !total number of selected triplets        npt_tot=0                 !total number of selected triplets
2387          nloop=0                  
2388     91   continue                  
2389        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2390           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
2391  c     print*,'--------------'  c     print*,'--------------'
# Line 2726  c     print*,'check cp_used' Line 2487  c     print*,'check cp_used'
2487           do ip=1,nplanes           do ip=1,nplanes
2488              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2489           enddo           enddo
2490           if(ncpused.lt.ncpxz_min)goto 22288 !next triplet  c         if(ncpused.lt.ncpxz_min)goto 22288 !next triplet
2491           if(npt.lt.nptxz_min)goto 22288     !next triplet           if(npt.lt.nptxz_min)goto 22288     !next triplet
2492           if(nplused.lt.nplxz_min)goto 22288 !next doublet           if(nplused.lt.nplxz_min)goto 22288 !next triplet
2493                    
2494  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2495  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
# Line 2739  c     print*,'check cp_used' Line 2500  c     print*,'check cp_used'
2500       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2501  c     good2=.false.  c     good2=.false.
2502  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2503                do iv=1,nviews
2504                   mask_view(iv) = 6
2505                enddo
2506              iflag=1              iflag=1
2507              return              return
2508           endif           endif
# Line 2774  c$$$     $           ,(tr_cloud(iii),iii Line 2538  c$$$     $           ,(tr_cloud(iii),iii
2538  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2539  22288    continue  22288    continue
2540        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2541          
2542           if(nloop.lt.nstepx)then      
2543             cutdistxz=cutdistxz+cutxstep
2544             nloop=nloop+1          
2545             goto 91                
2546           endif                    
2547          
2548        if(DEBUG)then        if(DEBUG)then
2549           print*,'---------------------- '           print*,'---------------------- '
2550           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
# Line 2796  c$$$     $           ,(tr_cloud(iii),iii Line 2566  c$$$     $           ,(tr_cloud(iii),iii
2566  **************************************************  **************************************************
2567    
2568        subroutine clouds_to_ctrack(iflag)        subroutine clouds_to_ctrack(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2569    
2570        include 'commontracker.f'        include 'commontracker.f'
2571          include 'level1.f'
2572        include 'common_momanhough.f'        include 'common_momanhough.f'
2573        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2574        include 'common_mini_2.f'        include 'common_mini_2.f'
2575        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
2576    
2577  c      logical DEBUG  
 c      common/dbg/DEBUG  
2578    
2579  *     output flag  *     output flag
2580  *     --------------  *     --------------
# Line 2824  c      common/dbg/DEBUG Line 2590  c      common/dbg/DEBUG
2590  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2591  *     list of matching couples in the combination  *     list of matching couples in the combination
2592  *     between a XZ and YZ cloud  *     between a XZ and YZ cloud
2593        integer cp_match(nplanes,ncouplemax)        integer cp_match(nplanes,2*ncouplemax)
2594        integer ncp_match(nplanes)        integer ncp_match(nplanes)
2595  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2596        integer hit_plane(nplanes)        integer hit_plane(nplanes)
2597  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2598  *     variables for track fitting  *     variables for track fitting
2599        double precision AL_INI(5)        double precision AL_INI(5)
2600        double precision tath  c      double precision tath
2601  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2602  c      real fitz(nplanes)        !z coordinates of the planes in cm  c      real fitz(nplanes)        !z coordinates of the planes in cm
2603    
# Line 2897  c      real fitz(nplanes)        !z coor Line 2663  c      real fitz(nplanes)        !z coor
2663                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2664              enddo              enddo
2665                            
2666              if(nplused.lt.nplxz_min)goto 888 !next doublet  c            if(nplused.lt.nplxz_min)goto 888 !next doublet
2667                if(nplused.lt.nplyz_min)goto 888 !next doublet
2668              if(ncp_ok.lt.ncpok)goto 888 !next cloud              if(ncp_ok.lt.ncpok)goto 888 !next cloud
2669                            
2670              if(DEBUG)then              if(DEBUG)then
# Line 2924  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p Line 2691  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p
2691  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2692                            
2693  *     -------> INITIAL GUESS <-------  *     -------> INITIAL GUESS <-------
2694              AL_INI(1)=dreal(alfaxz1_av(ixz))  cccc       SBAGLIATO
2695              AL_INI(2)=dreal(alfayz1_av(iyz))  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2696              AL_INI(4)=datan(dreal(alfayz2_av(iyz))  c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2697       $           /dreal(alfaxz2_av(ixz)))  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2698              tath=-dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))  c$$$     $           /dreal(alfaxz2_av(ixz)))
2699              AL_INI(3)=tath/sqrt(1+tath**2)  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2700              AL_INI(5)=(1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2701                c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2702  c     print*,'*******',AL_INI(5)  cccc       GIUSTO (ma si sua guess())
2703              if(AL_INI(5).gt.defmax)goto 888 !next cloud  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2704                c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2705  c     print*,'alfaxz2, alfayz2 '  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2706  c     $              ,alfaxz2_av(ixz),alfayz2_av(iyz)  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2707                c$$$            IF(alfaxz2_av(ixz).NE.0)THEN
2708  *     -------> INITIAL GUESS <-------  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2709  c     print*,'AL_INI ',(al_ini(i),i=1,5)  c$$$     $           /dreal(alfaxz2_av(ixz)))
2710                c$$$            ELSE
2711    c$$$               AL_INI(4) = acos(-1.)/2
2712    c$$$               IF(alfayz2_av(iyz).LT.0)AL_INI(4) = AL_INI(4)+acos(-1.)
2713    c$$$            ENDIF
2714    c$$$            IF(alfaxz2_av(ixz).LT.0)AL_INI(4)= acos(-1.)+ AL_INI(4)
2715    c$$$            AL_INI(4) = -acos(-1.) + AL_INI(4) !from incidence direction to tracking rs
2716    c$$$            
2717    c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2718    c$$$            
2719    c$$$            if(AL_INI(5).gt.defmax)goto 888 !next cloud
2720                            
2721              if(DEBUG)then              if(DEBUG)then
2722                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2723                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))
# Line 2991  c     print*,'AL_INI ',(al_ini(i),i=1,5) Line 2768  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2768  *                                   *************************  *                                   *************************
2769  c                                    call xyz_PAM(icx,icy,is,  c                                    call xyz_PAM(icx,icy,is,
2770  c     $                                   'COG2','COG2',0.,0.)  c     $                                   'COG2','COG2',0.,0.)
2771    c                                    call xyz_PAM(icx,icy,is, !(1)
2772    c     $                                   PFAdef,PFAdef,0.,0.) !(1)
2773                                      call xyz_PAM(icx,icy,is, !(1)                                      call xyz_PAM(icx,icy,is, !(1)
2774       $                                   PFAdef,PFAdef,0.,0.) !(1)       $                                   PFAdef,PFAdef,0.,0.,0.,0.)
2775  *                                   *************************  *                                   *************************
2776  *                                   -----------------------------  *                                   -----------------------------
2777                                      xgood(nplanes-ip+1)=1.                                      xgood(nplanes-ip+1)=1.
# Line 3008  c     $                                 Line 2787  c     $                                
2787  *     **********************************************************  *     **********************************************************
2788  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
2789  *     **********************************************************  *     **********************************************************
2790    cccc  scommentare se si usa al_ini della nuvola
2791    c$$$                              do i=1,5
2792    c$$$                                 AL(i)=AL_INI(i)
2793    c$$$                              enddo
2794                                  call guess()
2795                                do i=1,5                                do i=1,5
2796                                   AL(i)=AL_INI(i)                                   AL_INI(i)=AL(i)
2797                                enddo                                enddo
2798                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
2799                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
2800                                iprint=0                                iprint=0
2801                                if(DEBUG)iprint=1  c                              if(DEBUG)iprint=1
2802                                  if(DEBUG)iprint=2
2803                                call mini2(jstep,ifail,iprint)                                call mini2(jstep,ifail,iprint)
2804                                if(ifail.ne.0) then                                if(ifail.ne.0) then
2805                                   if(DEBUG)then                                   if(DEBUG)then
2806                                      print *,                                      print *,
2807       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
2808       $                              //'(mini2 in clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
2809                                        print*,'initial guess: '
2810    
2811                                        print*,'AL_INI(1) = ',AL_INI(1)
2812                                        print*,'AL_INI(2) = ',AL_INI(2)
2813                                        print*,'AL_INI(3) = ',AL_INI(3)
2814                                        print*,'AL_INI(4) = ',AL_INI(4)
2815                                        print*,'AL_INI(5) = ',AL_INI(5)
2816                                   endif                                   endif
2817                                   chi2=-chi2  c                                 chi2=-chi2
2818                                endif                                endif
2819  *     **********************************************************  *     **********************************************************
2820  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
# Line 3041  c     $                                 Line 2833  c     $                                
2833       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
2834  c                                 good2=.false.  c                                 good2=.false.
2835  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
2836                                     do iv=1,nviews
2837                                        mask_view(iv) = 7
2838                                     enddo
2839                                   iflag=1                                   iflag=1
2840                                   return                                   return
2841                                endif                                endif
2842                                                                
2843                                ntracks = ntracks + 1                                ntracks = ntracks + 1
2844                                                                
 c$$$                              ndof=0                                  
2845                                do ip=1,nplanes                                do ip=1,nplanes
2846  c$$$                                 ndof=ndof  
 c$$$     $                                +int(xgood(ip))  
 c$$$     $                                +int(ygood(ip))  
2847                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
2848                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
2849                                   ZV_STORE(ip,ntracks)=sngl(zv(ip))                                                                       ZV_STORE(ip,ntracks)=sngl(zv(ip))                                    
# Line 3070  c$$$     $                               Line 2862  c$$$     $                              
2862                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2863                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
2864       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
2865                                        SENSOR_STORE(nplanes-ip+1,ntracks)
2866         $                              = is_cp(cp_match(ip,hit_plane(ip)))
2867                                        LADDER_STORE(nplanes-ip+1,ntracks)
2868         $                                   = LADDER(
2869         $                                   clx(ip,icp_cp(
2870         $                                   cp_match(ip,hit_plane(ip)
2871         $                                   ))));
2872                                   else                                   else
2873                                      CP_STORE(nplanes-ip+1,ntracks)=0                                      CP_STORE(nplanes-ip+1,ntracks)=0
2874                                        SENSOR_STORE(nplanes-ip+1,ntracks)=0
2875                                        LADDER_STORE(nplanes-ip+1,ntracks)=0
2876                                   endif                                   endif
2877                                     BX_STORE(nplanes-ip+1,ntracks)=0!I dont need it now
2878                                     BY_STORE(nplanes-ip+1,ntracks)=0!I dont need it now
2879                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   CLS_STORE(nplanes-ip+1,ntracks)=0
2880                                   do i=1,5                                   do i=1,5
2881                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
2882                                   enddo                                   enddo
2883                                enddo                                enddo
2884                                                                
 c$$$  *                             Number of Degree Of Freedom  
 c$$$  ndof=ndof-5                            
 c$$$  *                             reduced chi^2  
 c$$$  rchi2=chi2/dble(ndof)  
2885                                RCHI2_STORE(ntracks)=chi2                                RCHI2_STORE(ntracks)=chi2
2886                                                                
2887  *     --------------------------------  *     --------------------------------
# Line 3106  c$$$  rchi2=chi2/dble(ndof) Line 2905  c$$$  rchi2=chi2/dble(ndof)
2905           return           return
2906        endif        endif
2907                
2908    c$$$      if(DEBUG)then
2909    c$$$         print*,'****** TRACK CANDIDATES ***********'
2910    c$$$         print*,'#         R. chi2        RIG'
2911    c$$$         do i=1,ntracks
2912    c$$$            print*,i,' --- ',rchi2_store(i),' --- '
2913    c$$$     $           ,1./abs(AL_STORE(5,i))
2914    c$$$         enddo
2915    c$$$         print*,'***********************************'
2916    c$$$      endif
2917        if(DEBUG)then        if(DEBUG)then
2918           print*,'****** TRACK CANDIDATES ***********'          print*,'****** TRACK CANDIDATES *****************'
2919           print*,'#         R. chi2        RIG'          print*,'#         R. chi2        RIG         ndof'
2920           do i=1,ntracks          do i=1,ntracks
2921              print*,i,' --- ',rchi2_store(i),' --- '            ndof=0                !(1)
2922       $           ,1./abs(AL_STORE(5,i))            do ii=1,nplanes       !(1)
2923           enddo              ndof=ndof           !(1)
2924           print*,'***********************************'       $           +int(xgood_store(ii,i)) !(1)
2925         $           +int(ygood_store(ii,i)) !(1)
2926              enddo                 !(1)
2927              print*,i,' --- ',rchi2_store(i),' --- '
2928         $         ,1./abs(AL_STORE(5,i)),' --- ',ndof
2929            enddo
2930            print*,'*****************************************'
2931        endif        endif
2932                
2933                
# Line 3132  c$$$  rchi2=chi2/dble(ndof) Line 2946  c$$$  rchi2=chi2/dble(ndof)
2946    
2947        subroutine refine_track(ibest)        subroutine refine_track(ibest)
2948    
 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******************************************************  
2949    
2950        include 'commontracker.f'        include 'commontracker.f'
2951          include 'level1.f'
2952        include 'common_momanhough.f'        include 'common_momanhough.f'
2953        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2954        include 'common_mini_2.f'        include 'common_mini_2.f'
2955        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
       include 'level1.f'  
2956        include 'calib.f'        include 'calib.f'
2957    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
2958  *     flag to chose PFA  *     flag to chose PFA
2959        character*10 PFA        character*10 PFA
2960        common/FINALPFA/PFA        common/FINALPFA/PFA
2961    
2962          real k(6)
2963          DATA k/1.099730,0.418900,0.220939,0.220907,0.418771,1.100674/
2964    
2965          real xp,yp,zp
2966          real xyzp(3),bxyz(3)
2967          equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
2968    
2969  *     =================================================  *     =================================================
2970  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
2971  *                          and  *                          and
# Line 3162  c      common/dbg/DEBUG Line 2974  c      common/dbg/DEBUG
2974        call track_init        call track_init
2975        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
2976    
2977             xP=XV_STORE(nplanes-ip+1,ibest)
2978             yP=YV_STORE(nplanes-ip+1,ibest)
2979             zP=ZV_STORE(nplanes-ip+1,ibest)
2980             call gufld(xyzp,bxyz)
2981             BX_STORE(nplanes-ip+1,ibest)=bxyz(1)
2982             BY_STORE(nplanes-ip+1,ibest)=bxyz(2)
2983    c$$$  bxyz(1)=0
2984    c$$$         bxyz(2)=0
2985    c$$$         bxyz(3)=0
2986    *     |||||||||||||||||||||||||||||||||||||||||||||||||
2987  *     -------------------------------------------------  *     -------------------------------------------------
2988  *     If the plane has been already included, it just  *     If the plane has been already included, it just
2989  *     computes again the coordinates of the x-y couple  *     computes again the coordinates of the x-y couple
2990  *     using improved PFAs  *     using improved PFAs
2991  *     -------------------------------------------------  *     -------------------------------------------------
2992    *     |||||||||||||||||||||||||||||||||||||||||||||||||
2993           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
2994       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
2995                            
# Line 3180  c      common/dbg/DEBUG Line 3003  c      common/dbg/DEBUG
3003       $           ,ip_cp(id),ip       $           ,ip_cp(id),ip
3004              icx=clx(ip,icp)              icx=clx(ip,icp)
3005              icy=cly(ip,icp)              icy=cly(ip,icp)
3006    c            call xyz_PAM(icx,icy,is,
3007    c     $           PFA,PFA,
3008    c     $           AXV_STORE(nplanes-ip+1,ibest),
3009    c     $           AYV_STORE(nplanes-ip+1,ibest))
3010              call xyz_PAM(icx,icy,is,              call xyz_PAM(icx,icy,is,
 c     $           'ETA2','ETA2',  
3011       $           PFA,PFA,       $           PFA,PFA,
3012       $           AXV_STORE(nplanes-ip+1,ibest),       $           AXV_STORE(nplanes-ip+1,ibest),
3013       $           AYV_STORE(nplanes-ip+1,ibest))       $           AYV_STORE(nplanes-ip+1,ibest),
3014  c$$$  call xyz_PAM(icx,icy,is,       $           bxyz(1),
3015  c$$$  $              'COG2','COG2',       $           bxyz(2)
3016  c$$$  $              0.,       $           )
3017  c$$$  $              0.)  
3018              xm(nplanes-ip+1) = xPAM              xm(nplanes-ip+1) = xPAM
3019              ym(nplanes-ip+1) = yPAM              ym(nplanes-ip+1) = yPAM
3020              zm(nplanes-ip+1) = zPAM              zm(nplanes-ip+1) = zPAM
# Line 3197  c$$$  $              0.) Line 3023  c$$$  $              0.)
3023              resx(nplanes-ip+1) = resxPAM              resx(nplanes-ip+1) = resxPAM
3024              resy(nplanes-ip+1) = resyPAM              resy(nplanes-ip+1) = resyPAM
3025    
3026  c            dedxtrk(nplanes-ip+1) = (dedx(icx)+dedx(icy))/2. !(1)              dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3027              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)  
3028                            
3029    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3030  *     -------------------------------------------------  *     -------------------------------------------------
3031  *     If the plane has NOT  been already included,  *     If the plane has NOT  been already included,
3032  *     it tries to include a COUPLE or a single cluster  *     it tries to include a COUPLE or a single cluster
3033  *     -------------------------------------------------  *     -------------------------------------------------
3034    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3035           else                             else                  
3036                                
3037              xgood(nplanes-ip+1)=0              xgood(nplanes-ip+1)=0
# Line 3212  c            dedxtrk(nplanes-ip+1) = (de Line 3039  c            dedxtrk(nplanes-ip+1) = (de
3039                                
3040  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3041  *     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)  
3042              call whichsensor(ip,xP,yP,nldt,ist)              call whichsensor(ip,xP,yP,nldt,ist)
3043  *     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
3044              if(nldt.eq.0.or.ist.eq.0)goto 133              if(nldt.eq.0.or.ist.eq.0)goto 133
3045    
3046                SENSOR_STORE(nplanes-ip+1,IBEST)=ist
3047                LADDER_STORE(nplanes-ip+1,IBEST)=nldt
3048  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3049    
3050              if(DEBUG)then              if(DEBUG)then
# Line 3254  c     $              cl_used(icy).eq.1.o Line 3081  c     $              cl_used(icy).eq.1.o
3081  *            *          
3082                 call xyz_PAM(icx,icy,ist,                 call xyz_PAM(icx,icy,ist,
3083       $              PFA,PFA,       $              PFA,PFA,
 c     $              'ETA2','ETA2',  
3084       $              AXV_STORE(nplanes-ip+1,ibest),       $              AXV_STORE(nplanes-ip+1,ibest),
3085       $              AYV_STORE(nplanes-ip+1,ibest))       $              AYV_STORE(nplanes-ip+1,ibest),
3086         $              bxyz(1),
3087         $              bxyz(2)
3088         $              )
3089                                
3090                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3091    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3092                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3093                 if(DEBUG)print*,'( couple ',id                 if(DEBUG)print*,'( couple ',id
3094       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance
3095                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3096                    xmm = xPAM                    xmm = xPAM
3097                    ymm = yPAM                    ymm = yPAM
# Line 3270  c     $              'ETA2','ETA2', Line 3100  c     $              'ETA2','ETA2',
3100                    rymm = resyPAM                    rymm = resyPAM
3101                    distmin = distance                    distmin = distance
3102                    idm = id                                      idm = id                  
3103  c                 dedxmm = (dedx(icx)+dedx(icy))/2. !(1)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3104                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3105                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)  c     QUIQUI --> non devo moltiplicare per clinc?!?!?!
3106                      clincnewc=10*sqrt(rymm**2+rxmm**2 !QUIQUI
3107         $                 +RCHI2_STORE(ibest)*k(ip)*(cov(1,1)+cov(2,2))) !QUIQUI
3108                 endif                 endif
3109   1188          continue   1188          continue
3110              enddo               !end loop on couples on plane icp              enddo               !end loop on couples on plane icp
3111              if(distmin.le.clinc)then                    c            if(distmin.le.clinc)then     !QUIQUI              
3112                if(distmin.le.clincnewc)then     !QUIQUI              
3113  *              -----------------------------------  *              -----------------------------------
3114                 xm(nplanes-ip+1) = xmm         !<<<                 xm(nplanes-ip+1) = xmm !<<<
3115                 ym(nplanes-ip+1) = ymm         !<<<                 ym(nplanes-ip+1) = ymm !<<<
3116                 zm(nplanes-ip+1) = zmm         !<<<                 zm(nplanes-ip+1) = zmm !<<<
3117                 xgood(nplanes-ip+1) = 1        !<<<                 xgood(nplanes-ip+1) = 1 !<<<
3118                 ygood(nplanes-ip+1) = 1        !<<<                 ygood(nplanes-ip+1) = 1 !<<<
3119                 resx(nplanes-ip+1)=rxmm        !<<<                 resx(nplanes-ip+1)=rxmm !<<<
3120                 resy(nplanes-ip+1)=rymm        !<<<                 resy(nplanes-ip+1)=rymm !<<<
3121  c              dedxtrk(nplanes-ip+1) = dedxmm !<<<  !(1)                 dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3122                 dedxtrk_x(nplanes-ip+1) = dedxmmx    !(1)                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
                dedxtrk_y(nplanes-ip+1) = dedxmmy    !(1)  
3123  *              -----------------------------------  *              -----------------------------------
3124                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
3125                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG)print*,'%%%% included couple ',idm
3126       $              ,' (norm.dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clinc,' )'
3127                 goto 133         !next plane                 goto 133         !next plane
3128              endif              endif
3129  *     ================================================  *     ================================================
# Line 3324  c            if(DEBUG)print*,'>>>> try t Line 3156  c            if(DEBUG)print*,'>>>> try t
3156  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
3157                 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)
3158  *                                              !jump to the Y cluster  *                                              !jump to the Y cluster
3159    c               call xyz_PAM(icx,0,ist,
3160    c     $              PFA,PFA,
3161    c     $              AXV_STORE(nplanes-ip+1,ibest),0.)              
3162                 call xyz_PAM(icx,0,ist,                 call xyz_PAM(icx,0,ist,
 c     $              'ETA2','ETA2',  
3163       $              PFA,PFA,       $              PFA,PFA,
3164       $              AXV_STORE(nplanes-ip+1,ibest),0.)                     $              AXV_STORE(nplanes-ip+1,ibest),0.,
3165         $              bxyz(1),
3166         $              bxyz(2)
3167         $              )              
3168                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3169  c     if(DEBUG)print*,'normalized distance ',distance  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3170                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG)print*,'( cl-X ',icx
3171       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3172                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3173                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3174                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3343  c     if(DEBUG)print*,'normalized distan Line 3180  c     if(DEBUG)print*,'normalized distan
3180                    rymm = resyPAM                    rymm = resyPAM
3181                    distmin = distance                    distmin = distance
3182                    iclm = icx                    iclm = icx
3183  c                  dedxmm = dedx(icx) !(1)  c                  dedxmm = sgnl(icx) !(1)
3184                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3185                    dedxmmy = 0.        !(1)                    dedxmmy = 0.        !(1)
3186                 endif                                   endif                  
3187  11881          continue  11881          continue
# Line 3352  c                  dedxmm = dedx(icx) !( Line 3189  c                  dedxmm = dedx(icx) !(
3189  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
3190                 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)
3191  *                                              !jump to the next couple  *                                              !jump to the next couple
3192    c               call xyz_PAM(0,icy,ist,
3193    c     $              PFA,PFA,
3194    c     $              0.,AYV_STORE(nplanes-ip+1,ibest))
3195                 call xyz_PAM(0,icy,ist,                 call xyz_PAM(0,icy,ist,
 c     $              'ETA2','ETA2',  
3196       $              PFA,PFA,       $              PFA,PFA,
3197       $              0.,AYV_STORE(nplanes-ip+1,ibest))       $              0.,AYV_STORE(nplanes-ip+1,ibest),
3198         $              bxyz(1),
3199         $              bxyz(2)
3200         $              )
3201                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3202    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3203                 if(DEBUG)print*,'( cl-Y ',icy                 if(DEBUG)print*,'( cl-Y ',icy
3204       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3205                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3206                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3207                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3370  c     $              'ETA2','ETA2', Line 3213  c     $              'ETA2','ETA2',
3213                    rymm = resyPAM                    rymm = resyPAM
3214                    distmin = distance                    distmin = distance
3215                    iclm = icy                    iclm = icy
3216  c                 dedxmm = dedx(icy)  !(1)  c                 dedxmm = sgnl(icy)  !(1)
3217                    dedxmmx = 0.        !(1)                    dedxmmx = 0.        !(1)
3218                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3219                 endif                                   endif                  
3220  11882          continue  11882          continue
3221              enddo               !end loop on cluster inside couples              enddo               !end loop on cluster inside couples
3222  *----- single clusters -----------------------------------------------      *----- single clusters -----------------------------------------------  
3223    c            print*,'## ncls(',ip,') ',ncls(ip)
3224              do ic=1,ncls(ip)    !loop on single clusters              do ic=1,ncls(ip)    !loop on single clusters
3225                 icl=cls(ip,ic)                 icl=cls(ip,ic)
3226  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 3385  c               if(cl_used(icl).eq.1.or. Line 3229  c               if(cl_used(icl).eq.1.or.
3229       $              .false.)goto 18882      !jump to the next singlet       $              .false.)goto 18882      !jump to the next singlet
3230                 if(mod(VIEW(icl),2).eq.0)then!<---- X view                 if(mod(VIEW(icl),2).eq.0)then!<---- X view
3231                    call xyz_PAM(icl,0,ist,                    call xyz_PAM(icl,0,ist,
 c     $                 'ETA2','ETA2',  
3232       $                 PFA,PFA,       $                 PFA,PFA,
3233       $                 AXV_STORE(nplanes-ip+1,ibest),0.)       $                 AXV_STORE(nplanes-ip+1,ibest),0.,
3234         $                 bxyz(1),
3235         $                 bxyz(2)
3236         $                 )
3237                 else                         !<---- Y view                 else                         !<---- Y view
3238                    call xyz_PAM(0,icl,ist,                    call xyz_PAM(0,icl,ist,
 c     $                 'ETA2','ETA2',  
3239       $                 PFA,PFA,       $                 PFA,PFA,
3240       $                 0.,AYV_STORE(nplanes-ip+1,ibest))       $                 0.,AYV_STORE(nplanes-ip+1,ibest),
3241         $                 bxyz(1),
3242         $                 bxyz(2)
3243         $                 )
3244                 endif                 endif
3245    
3246                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3247    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3248                 if(DEBUG)print*,'( cl-s ',icl                 if(DEBUG)print*,'( cl-s ',icl
3249       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance,'<',distmin,' ?'
3250                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3251                      if(DEBUG)print*,'YES'
3252                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3253                    ymm_A = yPAM_A                    ymm_A = yPAM_A
3254                    zmm_A = zPAM_A                    zmm_A = zPAM_A
# Line 3409  c     $                 'ETA2','ETA2', Line 3259  c     $                 'ETA2','ETA2',
3259                    rymm = resyPAM                    rymm = resyPAM
3260                    distmin = distance                      distmin = distance  
3261                    iclm = icl                    iclm = icl
 c                  dedxmm = dedx(icl)                   !(1)  
3262                    if(mod(VIEW(icl),2).eq.0)then !<---- X view                    if(mod(VIEW(icl),2).eq.0)then !<---- X view
3263                       dedxmmx = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3264                       dedxmmy = 0.                       !(1)                       dedxmmy = 0.                  
3265                    else          !<---- Y view                    else          !<---- Y view
3266                       dedxmmx = 0.                       !(1)                       dedxmmx = 0.                  
3267                       dedxmmy = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3268                    endif                    endif
3269                 endif                                   endif                  
3270  18882          continue  18882          continue
3271              enddo               !end loop on single clusters              enddo               !end loop on single clusters
3272    c            print*,'## distmin ', distmin,' clinc ',clinc
3273    
3274              if(distmin.le.clinc)then                    c     QUIQUI------------
3275                  c     anche qui: non ci vuole clinc???
3276                 CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<                  if(iclm.ne.0)then
 *              ----------------------------  
3277                 if(mod(VIEW(iclm),2).eq.0)then                 if(mod(VIEW(iclm),2).eq.0)then
3278                    XGOOD(nplanes-ip+1)=1.                    clincnew=
3279                    resx(nplanes-ip+1)=rxmm       $                 20*
3280                    if(DEBUG)print*,'%%%% included X-cl ',iclm       $                 sqrt(rxmm**2+RCHI2_STORE(ibest)*k(ip)*cov(1,1))
3281       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'                 else if(mod(VIEW(iclm),2).ne.0)then
3282                 else                    clincnew=
3283                    YGOOD(nplanes-ip+1)=1.       $                 10*
3284                    resy(nplanes-ip+1)=rymm       $                 sqrt(rymm**2+RCHI2_STORE(ibest)*k(ip)*cov(2,2))
3285                    if(DEBUG)print*,'%%%% included Y-cl ',iclm                 endif
3286       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'  c     QUIQUI------------
3287                  
3288                   if(distmin.le.clincnew)then   !QUIQUI
3289    c     if(distmin.le.clinc)then          !QUIQUI          
3290                      
3291                      CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<    
3292    *     ----------------------------
3293    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3294                      if(mod(VIEW(iclm),2).eq.0)then
3295                         XGOOD(nplanes-ip+1)=1.
3296                         resx(nplanes-ip+1)=rxmm
3297                         if(DEBUG)print*,'%%%% included X-cl ',iclm
3298         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3299         $                    ,', dist.= ',distmin
3300         $                    ,', cut ',clinc,' )'
3301                      else
3302                         YGOOD(nplanes-ip+1)=1.
3303                         resy(nplanes-ip+1)=rymm
3304                         if(DEBUG)print*,'%%%% included Y-cl ',iclm
3305         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3306         $                    ,', dist.= ', distmin
3307         $                    ,', cut ',clinc,' )'
3308                      endif
3309    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3310    *     ----------------------------
3311                      xm_A(nplanes-ip+1) = xmm_A
3312                      ym_A(nplanes-ip+1) = ymm_A
3313                      xm_B(nplanes-ip+1) = xmm_B
3314                      ym_B(nplanes-ip+1) = ymm_B
3315                      zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3316                      dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3317                      dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3318    *     ----------------------------
3319                 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)  
 *              ----------------------------  
3320              endif              endif
3321           endif           endif
3322   133     continue   133     continue
# Line 3464  c              dedxtrk(nplanes-ip+1) = d Line 3335  c              dedxtrk(nplanes-ip+1) = d
3335  *                                                 *  *                                                 *
3336  *                                                 *  *                                                 *
3337  **************************************************  **************************************************
 cccccc 12/08/2006 modified by elena ---> (1)  
3338  *  *
3339        subroutine clean_XYclouds(ibest,iflag)        subroutine clean_XYclouds(ibest,iflag)
3340    
3341        include 'commontracker.f'        include 'commontracker.f'
3342          include 'level1.f'
3343        include 'common_momanhough.f'        include 'common_momanhough.f'
3344        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  
   
3345    
3346        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3347    
# Line 3487  c      common/dbg/DEBUG Line 3351  c      common/dbg/DEBUG
3351              if(id.ne.0)then              if(id.ne.0)then
3352                 iclx=clx(ip,icp_cp(id))                 iclx=clx(ip,icp_cp(id))
3353                 icly=cly(ip,icp_cp(id))                 icly=cly(ip,icp_cp(id))
3354  c               cl_used(iclx)=1  !tag used clusters                 cl_used(iclx)=ntrk  !tag used clusters
3355  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)  
3356              elseif(icl.ne.0)then              elseif(icl.ne.0)then
3357  c               cl_used(icl)=1   !tag used clusters                 cl_used(icl)=ntrk   !tag used clusters
                cl_used(icl)=ntrk   !tag used clusters !1)  
3358              endif              endif
3359                            
 c               if(DEBUG)then  
 c                  print*,ip,' <<< ',id  
 c               endif  
3360  *     -----------------------------  *     -----------------------------
3361  *     remove the couple from clouds  *     remove the couple from clouds
3362  *     remove also vitual couples containing the  *     remove also vitual couples containing the
# Line 3549  c               endif Line 3407  c               endif
3407    
3408    
3409    
 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$$$  
   
3410    
3411    
3412  *     ****************************************************  *     ****************************************************
3413    
3414        subroutine init_level2        subroutine init_level2
3415    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c*****************************************************  
   
3416        include 'commontracker.f'        include 'commontracker.f'
3417          include 'level1.f'
3418        include 'common_momanhough.f'        include 'common_momanhough.f'
3419        include 'level2.f'        include 'level2.f'
       include 'level1.f'  
3420    
3421    *     ---------------------------------
3422    *     variables initialized from level1
3423    *     ---------------------------------
3424        do i=1,nviews        do i=1,nviews
3425           good2(i)=good1(i)           good2(i)=good1(i)
3426             do j=1,nva1_view
3427                vkflag(i,j)=1
3428                if(cnnev(i,j).le.0)then
3429                   vkflag(i,j)=cnnev(i,j)
3430                endif
3431             enddo
3432        enddo        enddo
3433    *     ----------------
3434  c      good2 = 0!.false.  *     level2 variables
3435  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*****************************************************  
   
3436        NTRK = 0        NTRK = 0
3437        do it=1,NTRKMAX!NTRACKSMAX        do it=1,NTRKMAX
3438           IMAGE(IT)=0           IMAGE(IT)=0
3439           CHI2_nt(IT) = -100000.           CHI2_nt(IT) = -100000.
 c         BdL(IT) = 0.  
3440           do ip=1,nplanes           do ip=1,nplanes
3441              XM_nt(IP,IT) = 0              XM_nt(IP,IT) = 0
3442              YM_nt(IP,IT) = 0              YM_nt(IP,IT) = 0
3443              ZM_nt(IP,IT) = 0              ZM_nt(IP,IT) = 0
3444              RESX_nt(IP,IT) = 0              RESX_nt(IP,IT) = 0
3445              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3446                TAILX_nt(IP,IT) = 0
3447                TAILY_nt(IP,IT) = 0
3448                XBAD(IP,IT) = 0
3449                YBAD(IP,IT) = 0
3450              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3451              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
3452  c*****************************************************              LS(IP,IT) = 0
 cccccc 11/9/2005 modified by david fedele  
3453              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3454              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
 c******************************************************  
 cccccc 17/8/2006 modified by elena  
3455              CLTRX(IP,IT) = 0              CLTRX(IP,IT) = 0
3456              CLTRY(IP,IT) = 0              CLTRY(IP,IT) = 0
3457           enddo           enddo
# Line 3717  cccccc 17/8/2006 modified by elena Line 3462  cccccc 17/8/2006 modified by elena
3462              enddo                                enddo                  
3463           enddo                             enddo                  
3464        enddo        enddo
         
         
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3465        nclsx=0        nclsx=0
3466        nclsy=0              nclsy=0      
3467        do ip=1,NSINGMAX        do ip=1,NSINGMAX
3468          planex(ip)=0          planex(ip)=0
 c        xs(ip)=0  
3469          xs(1,ip)=0          xs(1,ip)=0
3470          xs(2,ip)=0          xs(2,ip)=0
3471          sgnlxs(ip)=0          sgnlxs(ip)=0
3472          planey(ip)=0          planey(ip)=0
 c        ys(ip)=0  
3473          ys(1,ip)=0          ys(1,ip)=0
3474          ys(2,ip)=0          ys(2,ip)=0
3475          sgnlys(ip)=0          sgnlys(ip)=0
3476        enddo        enddo
 c*******************************************************  
3477        end        end
3478    
3479    
# Line 3750  c*************************************** Line 3488  c***************************************
3488  ************************************************************  ************************************************************
3489    
3490    
3491          subroutine init_hough
3492    
3493          include 'commontracker.f'
3494          include 'level1.f'
3495          include 'common_momanhough.f'
3496          include 'common_hough.f'
3497          include 'level2.f'
3498    
3499          ntrpt_nt=0
3500          ndblt_nt=0
3501          NCLOUDS_XZ_nt=0
3502          NCLOUDS_YZ_nt=0
3503          do idb=1,ndblt_max_nt
3504             db_cloud_nt(idb)=0
3505             alfayz1_nt(idb)=0      
3506             alfayz2_nt(idb)=0      
3507          enddo
3508          do itr=1,ntrpt_max_nt
3509             tr_cloud_nt(itr)=0
3510             alfaxz1_nt(itr)=0      
3511             alfaxz2_nt(itr)=0      
3512             alfaxz3_nt(itr)=0      
3513          enddo
3514          do idb=1,ncloyz_max      
3515            ptcloud_yz_nt(idb)=0    
3516            alfayz1_av_nt(idb)=0    
3517            alfayz2_av_nt(idb)=0    
3518          enddo                    
3519          do itr=1,ncloxz_max      
3520            ptcloud_xz_nt(itr)=0    
3521            alfaxz1_av_nt(itr)=0    
3522            alfaxz2_av_nt(itr)=0    
3523            alfaxz3_av_nt(itr)=0    
3524          enddo                    
3525    
3526          ntrpt=0                  
3527          ndblt=0                  
3528          NCLOUDS_XZ=0              
3529          NCLOUDS_YZ=0              
3530          do idb=1,ndblt_max        
3531            db_cloud(idb)=0        
3532            cpyz1(idb)=0            
3533            cpyz2(idb)=0            
3534            alfayz1(idb)=0          
3535            alfayz2(idb)=0          
3536          enddo                    
3537          do itr=1,ntrpt_max        
3538            tr_cloud(itr)=0        
3539            cpxz1(itr)=0            
3540            cpxz2(itr)=0            
3541            cpxz3(itr)=0            
3542            alfaxz1(itr)=0          
3543            alfaxz2(itr)=0          
3544            alfaxz3(itr)=0          
3545          enddo                    
3546          do idb=1,ncloyz_max      
3547            ptcloud_yz(idb)=0      
3548            alfayz1_av(idb)=0      
3549            alfayz2_av(idb)=0      
3550            do idbb=1,ncouplemaxtot
3551              cpcloud_yz(idb,idbb)=0
3552            enddo                  
3553          enddo                    
3554          do itr=1,ncloxz_max      
3555            ptcloud_xz(itr)=0      
3556            alfaxz1_av(itr)=0      
3557            alfaxz2_av(itr)=0      
3558            alfaxz3_av(itr)=0      
3559            do itrr=1,ncouplemaxtot
3560              cpcloud_xz(itr,itrr)=0
3561            enddo                  
3562          enddo                    
3563          end
3564    ************************************************************
3565    *
3566    *
3567    *
3568    *
3569    *
3570    *
3571    *
3572    ************************************************************
3573    
3574    
3575        subroutine fill_level2_tracks(ntr)        subroutine fill_level2_tracks(ntr)
3576    
3577  *     -------------------------------------------------------  *     -------------------------------------------------------
# Line 3761  c*************************************** Line 3583  c***************************************
3583            
3584        include 'commontracker.f'        include 'commontracker.f'
3585        include 'level1.f'        include 'level1.f'
3586          include 'common_momanhough.f'
3587        include 'level2.f'        include 'level2.f'
3588        include 'common_mini_2.f'        include 'common_mini_2.f'
3589        include 'common_momanhough.f'        include 'calib.f'
3590        real sinth,phi,pig        !(4)  
3591          character*10 PFA
3592          common/FINALPFA/PFA
3593    
3594          real sinth,phi,pig
3595          integer ssensor,sladder
3596        pig=acos(-1.)        pig=acos(-1.)
3597    
3598  c      good2=1!.true.  *     -------------------------------------
3599        chi2_nt(ntr)        = sngl(chi2)        chi2_nt(ntr)        = sngl(chi2)
3600        nstep_nt(ntr)       = nstep        nstep_nt(ntr)       = nstep
3601    *     -------------------------------------
3602        phi   = al(4)             !(4)        phi   = al(4)          
3603        sinth = al(3)             !(4)        sinth = al(3)            
3604        if(sinth.lt.0)then        !(4)        if(sinth.lt.0)then      
3605           sinth = -sinth         !(4)           sinth = -sinth        
3606           phi = phi + pig        !(4)           phi = phi + pig      
3607        endif                     !(4)        endif                    
3608        npig = aint(phi/(2*pig))  !(4)        npig = aint(phi/(2*pig))
3609        phi = phi - npig*2*pig    !(4)        phi = phi - npig*2*pig  
3610        if(phi.lt.0)              !(4)        if(phi.lt.0)            
3611       $     phi = phi + 2*pig    !(4)       $     phi = phi + 2*pig  
3612        al(4) = phi               !(4)        al(4) = phi              
3613        al(3) = sinth             !(4)        al(3) = sinth            
 *****************************************************  
3614        do i=1,5        do i=1,5
3615           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3616           do j=1,5           do j=1,5
3617              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3618           enddo           enddo
 c     print*,al_nt(i,ntr)  
3619        enddo        enddo
3620          *     -------------------------------------      
3621        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
3622           xgood_nt(ip,ntr) = int(xgood(ip))           xgood_nt(ip,ntr) = int(xgood(ip))
3623           ygood_nt(ip,ntr) = int(ygood(ip))           ygood_nt(ip,ntr) = int(ygood(ip))
# Line 3800  c     print*,al_nt(i,ntr) Line 3626  c     print*,al_nt(i,ntr)
3626           zm_nt(ip,ntr)    = sngl(zm(ip))           zm_nt(ip,ntr)    = sngl(zm(ip))
3627           RESX_nt(IP,ntr)  = sngl(resx(ip))           RESX_nt(IP,ntr)  = sngl(resx(ip))
3628           RESY_nt(IP,ntr)  = sngl(resy(ip))           RESY_nt(IP,ntr)  = sngl(resy(ip))
3629             TAILX_nt(IP,ntr) = 0.
3630             TAILY_nt(IP,ntr) = 0.
3631           xv_nt(ip,ntr)    = sngl(xv(ip))           xv_nt(ip,ntr)    = sngl(xv(ip))
3632           yv_nt(ip,ntr)    = sngl(yv(ip))           yv_nt(ip,ntr)    = sngl(yv(ip))
3633           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3634           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3635           ayv_nt(ip,ntr)   = sngl(ayv(ip))           ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3636  c        dedxp(ip,ntr)    = sngl(dedxtrk(ip))   !(1)  c     l'avevo dimenticato!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3637           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)           factor = sqrt(
3638           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)         $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3639         $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3640         $        1. )
3641    c     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3642             dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3643             dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3644        
3645           id  = CP_STORE(ip,IDCAND)           ax   = axv_nt(ip,ntr)
3646             ay   = ayv_nt(ip,ntr)
3647             bfx  = BX_STORE(ip,IDCAND)
3648             bfy  = BY_STORE(ip,IDCAND)
3649             if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3650             if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3651             tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3652             angx     = 180.*atan(tgtemp)/acos(-1.)
3653             tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3654             angy    = 180.*atan(tgtemp)/acos(-1.)
3655            
3656    c         print*,'* ',ip,bfx,bfy,angx,angy
3657    
3658             id  = CP_STORE(ip,IDCAND) ! couple id
3659           icl = CLS_STORE(ip,IDCAND)           icl = CLS_STORE(ip,IDCAND)
3660             ssensor = -1
3661             sladder = -1
3662             ssensor = SENSOR_STORE(ip,IDCAND)
3663             sladder = LADDER_STORE(ip,IDCAND)
3664             if(ip.eq.6.and.ssensor.ne.0)ssensor = 3 - ssensor !notazione paolo x align
3665             LS(IP,ntr)      = ssensor+10*sladder
3666    
3667           if(id.ne.0)then           if(id.ne.0)then
3668    c           >>> is a couple
3669              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3670              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3671  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  
3672    c$$$            if(is_cp(id).ne.ssensor)
3673    c$$$     $           print*,'ERROR is sensor assignment (couple)'
3674    c$$$     $           ,is_cp(id),ssensor
3675    c$$$            if(LADDER(clx(nplanes-ip+1,icp_cp(id))).ne.sladder)
3676    c$$$     $           print*,'ERROR is ladder assignment (couple)'
3677    c$$$     $           ,LADDER(clx(nplanes-ip+1,icp_cp(id))),sladder
3678                
3679                nnnnx = npfastrips(clx(nplanes-ip+1,icp_cp(id)),PFA,angx)
3680                nnnny = npfastrips(cly(nplanes-ip+1,icp_cp(id)),PFA,angy)            
3681                xbad(ip,ntr)= nbadstrips(nnnnx,clx(nplanes-ip+1,icp_cp(id)))
3682                ybad(ip,ntr)= nbadstrips(nnnny,cly(nplanes-ip+1,icp_cp(id)))
3683    
3684                if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3685         $           dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3686                if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3687         $           dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3688    
3689           elseif(icl.ne.0)then           elseif(icl.ne.0)then
3690              if(mod(VIEW(icl),2).eq.0)cltrx(ip,ntr)=icl  c           >>> is a singlet
3691              if(mod(VIEW(icl),2).eq.1)cltry(ip,ntr)=icl  c$$$            if(LADDER(icl).ne.sladder)
3692  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  c$$$     $           print*,'ERROR is ladder assignment (single)'
3693    c$$$     $           ,LADDER(icl),sladder
3694                if(mod(VIEW(icl),2).eq.0)then
3695                   cltrx(ip,ntr)=icl
3696                   nnnnn = npfastrips(icl,PFA,angx)
3697                   xbad(ip,ntr) = nbadstrips(nnnnn,icl)
3698                   if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3699                elseif(mod(VIEW(icl),2).eq.1)then
3700                   cltry(ip,ntr)=icl
3701                   nnnnn = npfastrips(icl,PFA,angy)
3702                   ybad(ip,ntr) = nbadstrips(nnnnn,icl)
3703                   if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3704                endif
3705           endif                     endif          
3706    
3707        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)  
3708    
3709    
3710    c$$$      print*,(xgood(i),i=1,6)
3711    c$$$      print*,(ygood(i),i=1,6)
3712    c$$$      print*,(ls(i,ntr),i=1,6)
3713    c$$$      print*,(dedx_x(i,ntr),i=1,6)
3714    c$$$      print*,(dedx_y(i,ntr),i=1,6)
3715    c$$$      print*,'-----------------------'
3716    
3717        end        end
3718    
3719        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*****************************************************  
3720    
3721  *     -------------------------------------------------------  *     -------------------------------------------------------
3722  *     This routine fills the  elements of the variables  *     This routine fills the  elements of the variables
# Line 3846  c*************************************** Line 3725  c***************************************
3725  *     -------------------------------------------------------  *     -------------------------------------------------------
3726    
3727        include 'commontracker.f'        include 'commontracker.f'
       include 'level1.f'  
       include 'level2.f'  
3728        include 'calib.f'        include 'calib.f'
3729          include 'level1.f'
3730        include 'common_momanhough.f'        include 'common_momanhough.f'
3731          include 'level2.f'
3732        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3733    
3734  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
 c      good2=1!.true.  
3735        nclsx = 0        nclsx = 0
3736        nclsy = 0        nclsy = 0
3737    
3738          do iv = 1,nviews
3739             if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
3740          enddo
3741    
3742        do icl=1,nclstr1        do icl=1,nclstr1
3743           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
3744              ip=nplanes-npl(VIEW(icl))+1                          ip=nplanes-npl(VIEW(icl))+1            
3745              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
3746                 nclsx = nclsx + 1                 nclsx = nclsx + 1
3747                 planex(nclsx) = ip                 planex(nclsx) = ip
3748                 sgnlxs(nclsx) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3749                   if(nsatstrips(icl).gt.0)sgnlxs(nclsx)=-sgnlxs(nclsx)
3750                 clsx(nclsx)   = icl                 clsx(nclsx)   = icl
3751                 do is=1,2                 do is=1,2
3752  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
3753                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
3754                      call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
3755                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2
3756                 enddo                 enddo
3757  c$$$               print*,'nclsx         ',nclsx  c$$$               print*,'nclsx         ',nclsx
# Line 3878  c$$$               print*,'xs(2,nclsx)   Line 3762  c$$$               print*,'xs(2,nclsx)  
3762              else                          !=== Y views              else                          !=== Y views
3763                 nclsy = nclsy + 1                 nclsy = nclsy + 1
3764                 planey(nclsy) = ip                 planey(nclsy) = ip
3765                 sgnlys(nclsy) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3766                   if(nsatstrips(icl).gt.0)sgnlys(nclsy)=-sgnlys(nclsy)
3767                 clsy(nclsy)   = icl                 clsy(nclsy)   = icl
3768                 do is=1,2                 do is=1,2
3769  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
3770                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
3771                      call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
3772                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2
3773                 enddo                 enddo
3774  c$$$               print*,'nclsy         ',nclsy  c$$$               print*,'nclsy         ',nclsy
# Line 3892  c$$$               print*,'ys(1,nclsy)   Line 3778  c$$$               print*,'ys(1,nclsy)  
3778  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)
3779              endif              endif
3780           endif           endif
 c      print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)  
3781    
3782  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
3783           whichtrack(icl) = cl_used(icl)           whichtrack(icl) = cl_used(icl)
# Line 3900  c      print*,icl,cl_used(icl),cl_good(i Line 3785  c      print*,icl,cl_used(icl),cl_good(i
3785        enddo        enddo
3786        end        end
3787    
3788    ***************************************************
3789    *                                                 *
3790    *                                                 *
3791    *                                                 *
3792    *                                                 *
3793    *                                                 *
3794    *                                                 *
3795    **************************************************
3796    
3797          subroutine fill_hough
3798    
3799    *     -------------------------------------------------------
3800    *     This routine fills the  variables related to the hough
3801    *     transform, for the debig n-tuple
3802    *     -------------------------------------------------------
3803    
3804          include 'commontracker.f'
3805          include 'level1.f'
3806          include 'common_momanhough.f'
3807          include 'common_hough.f'
3808          include 'level2.f'
3809    
3810          if(.false.
3811         $     .or.ntrpt.gt.ntrpt_max_nt
3812         $     .or.ndblt.gt.ndblt_max_nt
3813         $     .or.NCLOUDS_XZ.gt.ncloxz_max
3814         $     .or.NCLOUDS_yZ.gt.ncloyz_max
3815         $     )then
3816             ntrpt_nt=0
3817             ndblt_nt=0
3818             NCLOUDS_XZ_nt=0
3819             NCLOUDS_YZ_nt=0
3820          else
3821             ndblt_nt=ndblt
3822             ntrpt_nt=ntrpt
3823             if(ndblt.ne.0)then
3824                do id=1,ndblt
3825                   alfayz1_nt(id)=alfayz1(id) !Y0
3826                   alfayz2_nt(id)=alfayz2(id) !tg theta-yz
3827                enddo
3828             endif
3829             if(ndblt.ne.0)then
3830                do it=1,ntrpt
3831                   alfaxz1_nt(it)=alfaxz1(it) !X0
3832                   alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
3833                   alfaxz3_nt(it)=alfaxz3(it) !1/r
3834                enddo
3835             endif
3836             nclouds_yz_nt=nclouds_yz
3837             nclouds_xz_nt=nclouds_xz
3838             if(nclouds_yz.ne.0)then
3839                nnn=0
3840                do iyz=1,nclouds_yz
3841                   ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
3842                   alfayz1_av_nt(iyz)=alfayz1_av(iyz)
3843                   alfayz2_av_nt(iyz)=alfayz2_av(iyz)
3844                   nnn=nnn+ptcloud_yz(iyz)
3845                enddo
3846                do ipt=1,nnn
3847                   db_cloud_nt(ipt)=db_cloud(ipt)
3848                 enddo
3849             endif
3850             if(nclouds_xz.ne.0)then
3851                nnn=0
3852                do ixz=1,nclouds_xz
3853                   ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
3854                   alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
3855                   alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
3856                   alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
3857                   nnn=nnn+ptcloud_xz(ixz)              
3858                enddo
3859                do ipt=1,nnn
3860                  tr_cloud_nt(ipt)=tr_cloud(ipt)
3861                 enddo
3862             endif
3863          endif
3864          end
3865          

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.24

  ViewVC Help
Powered by ViewVC 1.1.23