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

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

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

revision 1.4 by pam-fi, Thu Sep 28 14:04:40 2006 UTC revision 1.26 by pam-fi, Thu May 24 16:45:48 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           call mini_2(jstep,ifail)           iprint=0
363    c         if(DEBUG)iprint=1
364             if(VERBOSE)iprint=1
365             if(DEBUG)iprint=2
366             call mini2(jstep,ifail,iprint)
367           if(ifail.ne.0) then           if(ifail.ne.0) then
368              if(DEBUG)then              if(VERBOSE)then
369                 print *,                 print *,
370       $              '*** MINIMIZATION FAILURE *** (mini_2) '       $              '*** MINIMIZATION FAILURE *** (after refinement) '
371       $              ,iev       $              ,iev
372    
373    c$$$               print*,'guess:   ',(al_guess(i),i=1,5)
374    c$$$               print*,'previous: ',(al_store(i,icand),i=1,5)
375    c$$$               print*,'result:   ',(al(i),i=1,5)
376    c$$$               print*,'xgood ',xgood
377    c$$$               print*,'ygood ',ygood
378    c$$$               print*,'----------------------------------------------'
379              endif              endif
380              chi2=-chi2  c            chi2=-chi2
381           endif           endif
382                    
383           if(DEBUG)then           if(DEBUG)then
# Line 311  c         print*,'++++++++++ iimage,fima Line 438  c         print*,'++++++++++ iimage,fima
438  c     $        ,iimage,fimage,ntrk,image(ntrk)  c     $        ,iimage,fimage,ntrk,image(ntrk)
439    
440           if(ntrk.eq.NTRKMAX)then           if(ntrk.eq.NTRKMAX)then
441              if(DEBUG)              if(verbose)
442       $           print*,       $           print*,
443       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
444       $           'tracks exceeds vector dimension '       $           'tracks exceeds vector dimension '
# Line 361  c     $        rchi2best.lt.15..and. Line 488  c     $        rchi2best.lt.15..and.
488        end        end
489    
490    
   
   
 c$$$************************************************************  
 c$$$  
 c$$$      subroutine readmipparam  
 c$$$              
 c$$$      include 'commontracker.f'  
 c$$$      include 'calib.f'  
 c$$$  
 c$$$      character*60 fname_param  
 c$$$ 201  format('trk-LADDER',i1,'-mip.dat')  
 c$$$      do ilad=1,nladders_view          
 c$$$         write(fname_param,201)ilad  
 c$$$         print *,'Opening file: ',fname_param  
 c$$$         open(10,  
 c$$$     $        FILE='./bin-aux/'//fname_param(1:LNBLNK(fname_param))  
 c$$$     $        ,STATUS='UNKNOWN'  
 c$$$     $        ,IOSTAT=iostat  
 c$$$     $        )  
 c$$$         if(iostat.ne.0)then  
 c$$$            print*,'READMIPPARAM: *** Error in opening file ***'  
 c$$$            return  
 c$$$         endif  
 c$$$         do iv=1,nviews  
 c$$$            read(10,*  
 c$$$     $           ,IOSTAT=iostat  
 c$$$     $           )pip,  
 c$$$     $            mip(int(pip),ilad)  
 c$$$c            print*,ilad,iv,pip,mip(int(pip),ilad)  
 c$$$         enddo  
 c$$$         close(10)  
 c$$$      enddo  
 c$$$  
 c$$$      return  
 c$$$      end  
 c$$$*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  
 c$$$      subroutine readchargeparam  
 c$$$        
 c$$$        
 c$$$      include 'commontracker.f'  
 c$$$      include 'calib.f'  
 c$$$  
 c$$$      character*60 fname_param  
 c$$$ 201  format('charge-l',i1,'.dat')  
 c$$$      do ilad=1,nladders_view          
 c$$$         write(fname_param,201)ilad  
 c$$$         print *,'Opening file: ',fname_param  
 c$$$         open(10,  
 c$$$     $        FILE='./bin-aux/'//fname_param(1:LNBLNK(fname_param))  
 c$$$     $        ,STATUS='UNKNOWN'  
 c$$$     $        ,IOSTAT=iostat  
 c$$$     $        )  
 c$$$         if(iostat.ne.0)then  
 c$$$            print*,'READCHARGEPARAM: *** Error in opening file ***'  
 c$$$            return  
 c$$$         endif  
 c$$$         do ip=1,nplanes  
 c$$$            read(10,*  
 c$$$     $           ,IOSTAT=iostat  
 c$$$     $           )pip,  
 c$$$     $            kch(ip,ilad),cch(ip,ilad),sch(ip,ilad)          
 c$$$c            print*,ilad,ip,pip,kch(ip,ilad),  
 c$$$c     $           cch(ip,ilad),sch(ip,ilad)  
 c$$$         enddo  
 c$$$         close(10)  
 c$$$      enddo  
 c$$$  
 c$$$      return  
 c$$$      end  
 c$$$*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  
 c$$$      subroutine readetaparam  
 c$$$*     -----------------------------------------  
 c$$$*     read eta2,3,4 calibration parameters  
 c$$$*     and fill variables:  
 c$$$*  
 c$$$*     eta2(netabin,nladders_view,nviews)  
 c$$$*     eta3(2*netabin,nladders_view,nviews)  
 c$$$*     eta4(2*netabin,nladders_view,nviews)  
 c$$$*  
 c$$$      include 'commontracker.f'  
 c$$$      include 'calib.f'  
 c$$$  
 c$$$      character*40 fname_binning  
 c$$$      character*40 fname_param  
 c$$$c      character*120 cmd1  
 c$$$c      character*120 cmd2  
 c$$$  
 c$$$  
 c$$$******retrieve ANGULAR BINNING info  
 c$$$      fname_binning='binning.dat'  
 c$$$      print *,'Opening file: ',fname_binning  
 c$$$      open(10,  
 c$$$     $     FILE='./bin-aux/'//fname_binning(1:LNBLNK(fname_binning))  
 c$$$     $     ,STATUS='UNKNOWN'  
 c$$$     $     ,IOSTAT=iostat  
 c$$$     $     )  
 c$$$      if(iostat.ne.0)then  
 c$$$         print*,'READETAPARAM: *** Error in opening file ***'  
 c$$$         return  
 c$$$      endif  
 c$$$      print*,'---- ANGULAR BINNING ----'  
 c$$$      print*,'Bin   -   angL   -   angR'  
 c$$$ 101  format(i2,'       ',f6.2,'     ',f6.2)  
 c$$$      do ibin=1,nangmax  
 c$$$         read(10,*  
 c$$$     $        ,IOSTAT=iostat  
 c$$$     $        )xnn,angL(ibin),angR(ibin)  
 c$$$         if(iostat.ne.0)goto 1000  
 c$$$         write(*,101)int(xnn),angL(ibin),angR(ibin)  
 c$$$      enddo          
 c$$$ 1000 nangbin=int(xnn)  
 c$$$      close(10)  
 c$$$      print*,'-------------------------'  
 c$$$        
 c$$$  
 c$$$  
 c$$$      do ieta=2,4               !loop on eta 2,3,4          
 c$$$******retrieve correction parameters  
 c$$$ 200     format(' Opening eta',i1,' files...')  
 c$$$         write(*,200)ieta  
 c$$$  
 c$$$ 201     format('eta',i1,'-bin',i1,'-l',i1,'.dat')  
 c$$$ 202     format('eta',i1,'-bin',i2,'-l',i1,'.dat')  
 c$$$         do iang=1,nangbin  
 c$$$            do ilad=1,nladders_view  
 c$$$               if(iang.lt.10)write(fname_param,201)ieta,iang,ilad  
 c$$$               if(iang.ge.10)write(fname_param,202)ieta,iang,ilad  
 c$$$c               print *,'Opening file: ',fname_param  
 c$$$               open(10,  
 c$$$     $             FILE='./bin-aux/'//fname_param(1:LNBLNK(fname_param))  
 c$$$     $              ,STATUS='UNKNOWN'  
 c$$$     $              ,IOSTAT=iostat  
 c$$$     $              )  
 c$$$               if(iostat.ne.0)then  
 c$$$                  print*,'READETAPARAM: *** Error in opening file ***'  
 c$$$                  return  
 c$$$               endif  
 c$$$               do ival=1,netavalmax  
 c$$$                  if(ieta.eq.2)read(10,*  
 c$$$     $                 ,IOSTAT=iostat  
 c$$$     $                 )  
 c$$$     $                 eta2(ival,iang),  
 c$$$     $                 (feta2(ival,iv,ilad,iang),iv=1,nviews)  
 c$$$                  if(ieta.eq.3)read(10,*  
 c$$$     $                 ,IOSTAT=iostat  
 c$$$     $                 )  
 c$$$     $                 eta3(ival,iang),  
 c$$$     $                 (feta3(ival,iv,ilad,iang),iv=1,nviews)  
 c$$$                  if(ieta.eq.4)read(10,*  
 c$$$     $                 ,IOSTAT=iostat  
 c$$$     $                 )  
 c$$$     $                 eta4(ival,iang),  
 c$$$     $                 (feta4(ival,iv,ilad,iang),iv=1,nviews)  
 c$$$                  if(iostat.ne.0)then  
 c$$$                     netaval=ival-1  
 c$$$c$$$                     if(eta2(1,iang).ne.-eta2(netaval,iang))  
 c$$$c$$$     $                    print*,'**** ERROR on parameters !!! ****'  
 c$$$                     goto 2000  
 c$$$                  endif  
 c$$$               enddo  
 c$$$ 2000          close(10)  
 c$$$*               print*,'... done'  
 c$$$            enddo  
 c$$$         enddo  
 c$$$  
 c$$$      enddo                     !end loop on eta 2,3,4  
 c$$$  
 c$$$  
 c$$$      return  
 c$$$      end  
 c$$$  
   
491                
492  ************************************************************  ************************************************************
493  ************************************************************  ************************************************************
# Line 557  c$$$ Line 512  c$$$
512  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)
513  *     angx   - Projected angle in x  *     angx   - Projected angle in x
514  *     angy   - Projected angle in y  *     angy   - Projected angle in y
515    *     bfx    - x-component of magnetci field
516    *     bfy    - y-component of magnetic field
517  *  *
518  *     --------- COUPLES -------------------------------------------------------  *     --------- COUPLES -------------------------------------------------------
519  *     The couple defines a point in the space.  *     The couple defines a point in the space.
# Line 595  c$$$ Line 552  c$$$
552  *  *
553  *  *
554    
555        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,angx,angy)        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
556    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c     01/02/2006 modified by elena vannuccini --> (2)  
 c     02/02/2006 modified by Elena Vannuccini --> (3)  
 c                (implemented new p.f.a.)  
 c     03/02/2006 modified by Elena Vannuccini --> (4)  
 c                (implemented variable resolution)  
 c*****************************************************  
557                
558        include 'commontracker.f'        include 'commontracker.f'
       include 'calib.f'  
559        include 'level1.f'        include 'level1.f'
560          include 'calib.f'
561        include 'common_align.f'        include 'common_align.f'
562        include 'common_mech.f'        include 'common_mech.f'
563        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
       include 'common_resxy.f'  
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
564    
565        integer icx,icy           !X-Y cluster ID        integer icx,icy           !X-Y cluster ID
566        integer sensor        integer sensor
567        integer viewx,viewy        integer viewx,viewy
568        character*4 PFAx,PFAy     !PFA to be used        character*4 PFAx,PFAy     !PFA to be used
569        real angx,angy            !X-Y angle        real ax,ay                !X-Y geometric angle
570          real angx,angy            !X-Y effective angle
571          real bfx,bfy              !X-Y b-field components
572    
573        real stripx,stripy        real stripx,stripy
574    
575        double precision xrt,yrt,zrt        double precision xrt,yrt,zrt
576        double precision xrt_A,yrt_A,zrt_A        double precision xrt_A,yrt_A,zrt_A
577        double precision xrt_B,yrt_B,zrt_B        double precision xrt_B,yrt_B,zrt_B
 c      double precision xi,yi,zi  
 c      double precision xi_A,yi_A,zi_A  
 c      double precision xi_B,yi_B,zi_B  
578                
579    
580        parameter (ndivx=30)        parameter (ndivx=30)
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 647  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          if(sensor.lt.1.or.sensor.gt.2)then
600             print*,'xyz_PAM   ***ERROR*** wrong input '
601             print*,'sensor ',sensor
602             icx=0
603             icy=0
604          endif
605    
606  *     -----------------  *     -----------------
607  *     CLUSTER X  *     CLUSTER X
608  *     -----------------  *     -----------------      
   
609        if(icx.ne.0)then        if(icx.ne.0)then
610           viewx = VIEW(icx)  
611           nldx = nld(MAXS(icx),VIEW(icx))           viewx   = VIEW(icx)
612           nplx = npl(VIEW(icx))           nldx    = nld(MAXS(icx),VIEW(icx))
613           resxPAM = RESXAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           nplx    = npl(VIEW(icx))
614                     resxPAM = RESXAV
615           stripx = float(MAXS(icx))           stripx  = float(MAXS(icx))
616           if(PFAx.eq.'COG1')then  !(1)  
617              stripx = stripx      !(1)           if(
618              resxPAM = resxPAM    !(1)       $        viewx.lt.1.or.        
619         $        viewx.gt.12.or.
620         $        nldx.lt.1.or.
621         $        nldx.gt.3.or.
622         $        stripx.lt.1.or.
623         $        stripx.gt.3072.or.
624         $        .false.)then
625                print*,'xyz_PAM   ***ERROR*** wrong input '
626                print*,'icx ',icx,'view ',viewx,'nld ',nldx,'strip ',stripx
627                icx = 0
628                goto 10
629             endif
630    
631    *        --------------------------
632    *        magnetic-field corrections
633    *        --------------------------
634             angtemp  = ax
635             bfytemp  = bfy
636    *        /////////////////////////////////
637    *        AAAAHHHHHHHH!!!!!!!!!!!!!!!!!!!!!
638    *        *grvzkkjsdgjhhhgngbn###>:(
639    *        /////////////////////////////////
640    c         if(nplx.eq.6) angtemp = -1. * ax
641    c         if(nplx.eq.6) bfytemp = -1. * bfy
642             if(viewx.eq.12) angtemp = -1. * ax
643             if(viewx.eq.12) bfytemp = -1. * bfy
644             tgtemp   = tan(angtemp*acos(-1.)/180.) + pmuH_h*bfytemp*0.00001
645             angx     = 180.*atan(tgtemp)/acos(-1.)
646             stripx   = stripx - 0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
647    c$$$         print*,nplx,ax,bfy/10.
648    c$$$         print*,angx,0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX
649    c$$$         print*,'========================'
650    c$$$         if(bfy.ne.0.)print*,viewx,'-x- '
651    c$$$     $        ,bfy,-1*0.5*pmuH_h*bfytemp*0.00001*SiDimZ
652    *        --------------------------
653    
654    c$$$         print*,'--- x-cl ---'
655    c$$$         istart = INDSTART(ICX)
656    c$$$         istop  = TOTCLLENGTH
657    c$$$         if(icx.lt.NCLSTR1)istop=INDSTART(ICX+1)-1
658    c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
659    c$$$         print*,(CLSIGNAL(i),i=istart,istop)
660    c$$$         print*,INDMAX(icx)
661    c$$$         print*,cog(4,icx)
662    c$$$         print*,fbad_cog(4,icx)
663            
664    
665             if(PFAx.eq.'COG1')then
666    
667                stripx  = stripx
668                resxPAM = 1e-4*pitchX/sqrt(12.)!!resxPAM
669    
670           elseif(PFAx.eq.'COG2')then           elseif(PFAx.eq.'COG2')then
671              stripx = stripx + cog(2,icx)              
672                stripx  = stripx + cog(2,icx)            
673                resxPAM = risx_cog(abs(angx))!TEMPORANEO              
674              resxPAM = resxPAM*fbad_cog(2,icx)              resxPAM = resxPAM*fbad_cog(2,icx)
675    
676             elseif(PFAx.eq.'COG3')then
677    
678                stripx  = stripx + cog(3,icx)            
679                resxPAM = risx_cog(abs(angx))!TEMPORANEO                      
680                resxPAM = resxPAM*fbad_cog(3,icx)
681    
682             elseif(PFAx.eq.'COG4')then
683    
684                stripx  = stripx + cog(4,icx)            
685                resxPAM = risx_cog(abs(angx))!TEMPORANEO                      
686                resxPAM = resxPAM*fbad_cog(4,icx)
687    
688           elseif(PFAx.eq.'ETA2')then           elseif(PFAx.eq.'ETA2')then
689  c            cog2 = cog(2,icx)  
690  c            etacorr = pfa_eta2(cog2,viewx,nldx,angx)                          stripx  = stripx + pfaeta2(icx,angx)          
691  c            stripx = stripx + etacorr              resxPAM = risxeta2(abs(angx))
692              stripx = stripx + pfa_eta2(icx,angx)            !(3)              resxPAM = resxPAM*fbad_cog(2,icx)
             resxPAM = risx_eta2(angx)                       !   (4)  
693              if(DEBUG.and.fbad_cog(2,icx).ne.1)              if(DEBUG.and.fbad_cog(2,icx).ne.1)
694       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
695              resxPAM = resxPAM*fbad_cog(2,icx)  
696           elseif(PFAx.eq.'ETA3')then                         !(3)           elseif(PFAx.eq.'ETA3')then                        
697              stripx = stripx + pfa_eta3(icx,angx)            !(3)  
698              resxPAM = risx_eta3(angx)                       !   (4)              stripx  = stripx + pfaeta3(icx,angx)          
699              if(DEBUG.and.fbad_cog(3,icx).ne.1)              !(3)              resxPAM = risxeta3(abs(angx))                      
700       $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)!(3)              resxPAM = resxPAM*fbad_cog(3,icx)              
701              resxPAM = resxPAM*fbad_cog(3,icx)               !(3)              if(DEBUG.and.fbad_cog(3,icx).ne.1)            
702           elseif(PFAx.eq.'ETA4')then                         !(3)       $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)
703              stripx = stripx + pfa_eta4(icx,angx)            !(3)  
704              resxPAM = risx_eta4(angx)                       !   (4)           elseif(PFAx.eq.'ETA4')then                        
705              if(DEBUG.and.fbad_cog(4,icx).ne.1)              !(3)  
706       $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)!(3)              stripx  = stripx + pfaeta4(icx,angx)            
707              resxPAM = resxPAM*fbad_cog(4,icx)               !(3)              resxPAM = risxeta4(abs(angx))                      
708           elseif(PFAx.eq.'ETA')then                          !(3)              resxPAM = resxPAM*fbad_cog(4,icx)              
709              stripx = stripx + pfa_eta(icx,angx)             !(3)              if(DEBUG.and.fbad_cog(4,icx).ne.1)              
710              resxPAM = ris_eta(icx,angx)                     !   (4)       $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)
711              if(DEBUG.and.fbad_cog(2,icx).ne.1)              !(3)  
712       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)!(3)           elseif(PFAx.eq.'ETA')then  
713  c            resxPAM = resxPAM*fbad_cog(2,icx)               !(3)TEMPORANEO  
714              resxPAM = resxPAM*fbad_eta(icx,angx)             !(3)(4)              stripx  = stripx + pfaeta(icx,angx)            
715           elseif(PFAx.eq.'COG')then           !(2)  c            resxPAM = riseta(icx,angx)                    
716              stripx = stripx + cog(0,icx)     !(2)                      resxPAM = riseta(viewx,angx)                    
717              resxPAM = risx_cog(angx)                        !   (4)              resxPAM = resxPAM*fbad_eta(icx,angx)            
718              resxPAM = resxPAM*fbad_cog(0,icx)!(2)              if(DEBUG.and.fbad_cog(2,icx).ne.1)              
719         $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
720    
721             elseif(PFAx.eq.'COG')then          
722    
723                stripx  = stripx + cog(0,icx)            
724                resxPAM = risx_cog(abs(angx))                    
725                resxPAM = resxPAM*fbad_cog(0,icx)
726    
727           else           else
728              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx
729           endif           endif
730    
731        endif  
732  c      if(icy.eq.0.and.icx.ne.0)  *     ======================================
733  c     $     print*,PFAx,icx,angx,stripx,resxPAM,'***'  *     temporary patch for saturated clusters
734          *     ======================================
735             if( nsatstrips(icx).gt.0 )then
736                stripx  = stripx + cog(4,icx)            
737                resxPAM = pitchX*1e-4/sqrt(12.)
738                cc=cog(4,icx)
739    c$$$            print*,icx,' *** ',cc
740    c$$$            print*,icx,' *** ',resxPAM
741             endif
742    
743     10   endif
744    
745        
746  *     -----------------  *     -----------------
747  *     CLUSTER Y  *     CLUSTER Y
748  *     -----------------  *     -----------------
749    
750        if(icy.ne.0)then        if(icy.ne.0)then
751    
752           viewy = VIEW(icy)           viewy = VIEW(icy)
753           nldy = nld(MAXS(icy),VIEW(icy))           nldy = nld(MAXS(icy),VIEW(icy))
754           nply = npl(VIEW(icy))           nply = npl(VIEW(icy))
755           resyPAM = RESYAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           resyPAM = RESYAV
756             stripy = float(MAXS(icy))
757    
758             if(
759         $        viewy.lt.1.or.        
760         $        viewy.gt.12.or.
761         $        nldy.lt.1.or.
762         $        nldy.gt.3.or.
763         $        stripy.lt.1.or.
764         $        stripy.gt.3072.or.
765         $        .false.)then
766                print*,'xyz_PAM   ***ERROR*** wrong input '
767                print*,'icy ',icy,'view ',viewy,'nld ',nldy,'strip ',stripy
768                icy = 0
769                goto 20
770             endif
771    
772           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
773              print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '              if(DEBUG) then
774       $           ,icx,icy                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '
775         $              ,icx,icy
776                endif
777              goto 100              goto 100
778           endif           endif
779            *        --------------------------
780           stripy = float(MAXS(icy))  *        magnetic-field corrections
781           if(PFAy.eq.'COG1')then !(1)  *        --------------------------
782              stripy = stripy     !(1)           tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
783              resyPAM = resyPAM   !(1)           angy    = 180.*atan(tgtemp)/acos(-1.)
784             stripy = stripy + 0.5*pmuH_e*bfx*0.00001*SiDimZ/pitchY
785    c$$$         if(bfx.ne.0.)print*,viewy,'-y- '
786    c$$$     $        ,bfx,0.5*pmuH_e*bfx*0.00001*SiDimZ
787    *        --------------------------
788            
789    c$$$         print*,'--- y-cl ---'
790    c$$$         istart = INDSTART(ICY)
791    c$$$         istop  = TOTCLLENGTH
792    c$$$         if(icy.lt.NCLSTR1)istop=INDSTART(ICY+1)-1
793    c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
794    c$$$         print*,(CLSIGNAL(i),i=istart,istop)
795    c$$$         print*,INDMAX(icy)
796    c$$$         print*,cog(4,icy)
797    c$$$         print*,fbad_cog(4,icy)
798    
799             if(PFAy.eq.'COG1')then
800    
801                stripy  = stripy    
802                resyPAM = 1e-4*pitchY/sqrt(12.)!resyPAM  
803    
804           elseif(PFAy.eq.'COG2')then           elseif(PFAy.eq.'COG2')then
805              stripy = stripy + cog(2,icy)  
806                stripy  = stripy + cog(2,icy)
807                resyPAM = risy_cog(abs(angy))!TEMPORANEO
808              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
809    
810             elseif(PFAy.eq.'COG3')then
811    
812                stripy  = stripy + cog(3,icy)
813                resyPAM = risy_cog(abs(angy))!TEMPORANEO
814                resyPAM = resyPAM*fbad_cog(3,icy)
815    
816             elseif(PFAy.eq.'COG4')then
817    
818                stripy  = stripy + cog(4,icy)
819                resyPAM = risy_cog(abs(angy))!TEMPORANEO
820                resyPAM = resyPAM*fbad_cog(4,icy)
821    
822           elseif(PFAy.eq.'ETA2')then           elseif(PFAy.eq.'ETA2')then
823  c            cog2 = cog(2,icy)  
824  c            etacorr = pfa_eta2(cog2,viewy,nldy,angy)              stripy  = stripy + pfaeta2(icy,angy)          
825  c            stripy = stripy + etacorr              resyPAM = risyeta2(abs(angy))              
             stripy = stripy + pfa_eta2(icy,angy)            !(3)  
             resyPAM = risy_eta2(angy)                       !   (4)  
826              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
827              if(DEBUG.and.fbad_cog(2,icy).ne.1)              if(DEBUG.and.fbad_cog(2,icy).ne.1)
828       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
829           elseif(PFAy.eq.'ETA3')then                         !(3)  
830              stripy = stripy + pfa_eta3(icy,angy)            !(3)           elseif(PFAy.eq.'ETA3')then                      
831              resyPAM = resyPAM*fbad_cog(3,icy)               !(3)  
832              if(DEBUG.and.fbad_cog(3,icy).ne.1)              !(3)              stripy  = stripy + pfaeta3(icy,angy)
833       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)!(3)              resyPAM = resyPAM*fbad_cog(3,icy)  
834           elseif(PFAy.eq.'ETA4')then                         !(3)              if(DEBUG.and.fbad_cog(3,icy).ne.1)
835              stripy = stripy + pfa_eta4(icy,angy)            !(3)       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)
836              resyPAM = resyPAM*fbad_cog(4,icy)               !(3)  
837              if(DEBUG.and.fbad_cog(4,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA4')then  
838       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)!(3)  
839           elseif(PFAy.eq.'ETA')then                          !(3)              stripy  = stripy + pfaeta4(icy,angy)
840              stripy = stripy + pfa_eta(icy,angy)             !(3)              resyPAM = resyPAM*fbad_cog(4,icy)
841              resyPAM = ris_eta(icy,angy)                     !   (4)              if(DEBUG.and.fbad_cog(4,icy).ne.1)
842  c            resyPAM = resyPAM*fbad_cog(2,icy)              !(3)TEMPORANEO       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)
843              resyPAM = resyPAM*fbad_eta(icy,angy)            !   (4)  
844              if(DEBUG.and.fbad_cog(2,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA')then
845       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)!(3)  
846                stripy  = stripy + pfaeta(icy,angy)
847    c            resyPAM = riseta(icy,angy)  
848                resyPAM = riseta(viewy,angy)  
849                resyPAM = resyPAM*fbad_eta(icy,angy)
850                if(DEBUG.and.fbad_cog(2,icy).ne.1)
851         $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
852    
853           elseif(PFAy.eq.'COG')then           elseif(PFAy.eq.'COG')then
854              stripy = stripy + cog(0,icy)              
855              resyPAM = risy_cog(angy)                        !   (4)              stripy  = stripy + cog(0,icy)            
856  c            resyPAM = ris_eta(icy,angy)                    !   (4)              resyPAM = risy_cog(abs(angy))
857              resyPAM = resyPAM*fbad_cog(0,icy)              resyPAM = resyPAM*fbad_cog(0,icy)
858    
859           else           else
860              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx
861           endif           endif
862    
       endif  
863    
864          *     ======================================
865    *     temporary patch for saturated clusters
866    *     ======================================
867             if( nsatstrips(icy).gt.0 )then
868                stripy  = stripy + cog(4,icy)            
869                resyPAM = pitchY*1e-4/sqrt(12.)
870                cc=cog(4,icy)
871    c$$$            print*,icy,' *** ',cc
872    c$$$            print*,icy,' *** ',resyPAM
873             endif
874    
875    
876     20   endif
877    
878    c$$$      print*,'## stripx,stripy ',stripx,stripy
879    
880  c===========================================================  c===========================================================
881  C     COUPLE  C     COUPLE
882  C===========================================================  C===========================================================
# Line 777  c     (xi,yi,zi) = mechanical coordinate Line 887  c     (xi,yi,zi) = mechanical coordinate
887  c------------------------------------------------------------------------  c------------------------------------------------------------------------
888           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
889       $        .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...
890              print*,'xyz_PAM (couple):',              if(DEBUG) then
891       $          ' WARNING: false X strip: strip ',stripx                 print*,'xyz_PAM (couple):',
892         $              ' WARNING: false X strip: strip ',stripx
893                endif
894           endif           endif
895           xi = acoordsi(stripx,viewx)           xi = acoordsi(stripx,viewx)
896           yi = acoordsi(stripy,viewy)           yi = acoordsi(stripy,viewy)
# Line 870  c            print*,'X-singlet ',icx,npl Line 982  c            print*,'X-singlet ',icx,npl
982  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...
983              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
984       $           .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...
985                 print*,'xyz_PAM (X-singlet):',                 if(DEBUG) then
986       $             ' WARNING: false X strip: strip ',stripx                    print*,'xyz_PAM (X-singlet):',
987         $                 ' WARNING: false X strip: strip ',stripx
988                   endif
989              endif              endif
990              xi   = acoordsi(stripx,viewx)              xi   = acoordsi(stripx,viewx)
991    
# Line 893  c            print*,'X-cl ',icx,stripx,' Line 1007  c            print*,'X-cl ',icx,stripx,'
1007  c            print*,yi_A,' <--> ',yi_B  c            print*,yi_A,' <--> ',yi_B
1008    
1009           else           else
1010                if(DEBUG) then
1011              print *,'routine xyz_PAM ---> not properly used !!!'                 print *,'routine xyz_PAM ---> not properly used !!!'
1012              print *,'icx = ',icx                 print *,'icx = ',icx
1013              print *,'icy = ',icy                 print *,'icy = ',icy
1014                endif
1015              goto 100              goto 100
1016                            
1017           endif           endif
# Line 961  c--------------------------------------- Line 1076  c---------------------------------------
1076  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'
1077    
1078        else        else
1079                       if(DEBUG) then
1080           print *,'routine xyz_PAM ---> not properly used !!!'              print *,'routine xyz_PAM ---> not properly used !!!'
1081           print *,'icx = ',icx              print *,'icx = ',icx
1082           print *,'icy = ',icy              print *,'icy = ',icy
1083                         endif
1084        endif        endif
1085                    
1086    
1087    c      print*,'## xPAM,yPAM,zPAM       ',xPAM,yPAM,zPAM
1088    c      print*,'## xPAM_A,yPAM_A,zPAM_A ',xPAM_A,yPAM_A,zPAM_A
1089    c      print*,'## xPAM_B,yPAM_B,zPAM_B ',xPAM_B,yPAM_B,zPAM_B
1090    
1091   100  continue   100  continue
1092        end        end
1093    
1094    ************************************************************************
1095    *     Call xyz_PAM subroutine with default PFA and fill the mini2 common.
1096    *     (done to be called from c/c++)
1097    ************************************************************************
1098    
1099          subroutine xyzpam(ip,icx,icy,lad,sensor,ax,ay,bfx,bfy)
1100    
1101          include 'commontracker.f'
1102          include 'level1.f'
1103          include 'common_mini_2.f'
1104          include 'common_xyzPAM.f'
1105          include 'common_mech.f'
1106          include 'calib.f'
1107          
1108    *     flag to chose PFA
1109    c$$$      character*10 PFA
1110    c$$$      common/FINALPFA/PFA
1111    
1112          integer icx,icy           !X-Y cluster ID
1113          integer sensor
1114          character*4 PFAx,PFAy     !PFA to be used
1115          real ax,ay                !X-Y geometric angle
1116          real bfx,bfy              !X-Y b-field components
1117    
1118          ipx=0
1119          ipy=0      
1120          
1121    c$$$      PFAx = 'COG4'!PFA
1122    c$$$      PFAy = 'COG4'!PFA
1123    
1124          if(icx.gt.nclstr1.or.icy.gt.nclstr1)then
1125                print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1126         $           ,' does not exists (nclstr1=',nclstr1,')'
1127                icx = -1*icx
1128                icy = -1*icy
1129                return
1130            
1131          endif
1132          
1133          call idtoc(pfaid,PFAx)
1134          call idtoc(pfaid,PFAy)
1135    
1136    c$$$      call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1137    
1138    c$$$      print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy
1139          
1140          if(icx.ne.0.and.icy.ne.0)then
1141    
1142             ipx=npl(VIEW(icx))
1143             ipy=npl(VIEW(icy))
1144    c$$$         if( (nplanes-ipx+1).ne.ip.or.(nplanes-ipy+1).ne.ip )
1145    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1146    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1147            
1148             if( (nplanes-ipx+1).ne.ip )then
1149                print*,'xyzpam: ***WARNING*** cluster ',icx
1150         $           ,' does not belong to plane: ',ip
1151                icx = -1*icx
1152                return
1153             endif
1154             if( (nplanes-ipy+1).ne.ip )then
1155                print*,'xyzpam: ***WARNING*** cluster ',icy
1156         $           ,' does not belong to plane: ',ip
1157                icy = -1*icy
1158                return
1159             endif
1160    
1161             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1162    
1163             xgood(ip) = 1.
1164             ygood(ip) = 1.
1165             resx(ip)  = resxPAM
1166             resy(ip)  = resyPAM
1167    
1168             xm(ip) = xPAM
1169             ym(ip) = yPAM
1170             zm(ip) = zPAM
1171             xm_A(ip) = 0.
1172             ym_A(ip) = 0.
1173             xm_B(ip) = 0.
1174             ym_B(ip) = 0.
1175    
1176    c         zv(ip) = zPAM
1177    
1178          elseif(icx.eq.0.and.icy.ne.0)then
1179    
1180             ipy=npl(VIEW(icy))
1181    c$$$         if((nplanes-ipy+1).ne.ip)
1182    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1183    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1184             if( (nplanes-ipy+1).ne.ip )then
1185                print*,'xyzpam: ***WARNING*** cluster ',icy
1186         $           ,' does not belong to plane: ',ip
1187                icy = -1*icy
1188                return
1189             endif
1190    
1191             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1192            
1193             xgood(ip) = 0.
1194             ygood(ip) = 1.
1195             resx(ip)  = 1000.
1196             resy(ip)  = resyPAM
1197    
1198             xm(ip) = -100.
1199             ym(ip) = -100.
1200             zm(ip) = (zPAM_A+zPAM_B)/2.
1201             xm_A(ip) = xPAM_A
1202             ym_A(ip) = yPAM_A
1203             xm_B(ip) = xPAM_B
1204             ym_B(ip) = yPAM_B
1205    
1206    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1207            
1208          elseif(icx.ne.0.and.icy.eq.0)then
1209    
1210             ipx=npl(VIEW(icx))
1211    c$$$         if((nplanes-ipx+1).ne.ip)
1212    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1213    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1214    
1215             if( (nplanes-ipx+1).ne.ip )then
1216                print*,'xyzpam: ***WARNING*** cluster ',icx
1217         $           ,' does not belong to plane: ',ip
1218                icx = -1*icx
1219                return
1220             endif
1221    
1222             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1223          
1224             xgood(ip) = 1.
1225             ygood(ip) = 0.
1226             resx(ip)  = resxPAM
1227             resy(ip)  = 1000.
1228    
1229             xm(ip) = -100.
1230             ym(ip) = -100.
1231             zm(ip) = (zPAM_A+zPAM_B)/2.
1232             xm_A(ip) = xPAM_A
1233             ym_A(ip) = yPAM_A
1234             xm_B(ip) = xPAM_B
1235             ym_B(ip) = yPAM_B
1236            
1237    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1238    
1239          else
1240    
1241             il = 2
1242             if(lad.ne.0)il=lad
1243             is = 1
1244             if(sensor.ne.0)is=sensor
1245    c         print*,nplanes-ip+1,il,is
1246    
1247             xgood(ip) = 0.
1248             ygood(ip) = 0.
1249             resx(ip)  = 1000.
1250             resy(ip)  = 1000.
1251    
1252             xm(ip) = -100.
1253             ym(ip) = -100.          
1254             zm(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1255             xm_A(ip) = 0.
1256             ym_A(ip) = 0.
1257             xm_B(ip) = 0.
1258             ym_B(ip) = 0.
1259    
1260    c         zv(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1261    
1262          endif
1263    
1264          if(DEBUG)then
1265    c         print*,'----------------------------- track coord'
1266    22222    format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
1267             write(*,22222)ip,zm(ip),xm(ip),ym(ip)
1268         $        ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip)
1269         $        ,xgood(ip),ygood(ip),resx(ip),resy(ip)
1270    c$$$         print*,'-----------------------------'
1271          endif
1272          end
1273    
1274  ********************************************************************************  ********************************************************************************
1275  ********************************************************************************  ********************************************************************************
# Line 1046  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1345  c         print*,'A-(',xPAM_A,yPAM_A,')
1345           endif                   endif        
1346    
1347           distance=           distance=
1348       $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2       $       ((xmi-XPP)**2+(ymi-YPP)**2)!QUIQUI
1349    cc     $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1350           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1351    
1352  c$$$         print*,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b  c$$$         print*,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b
# Line 1071  c$$$         print*,' resolution ',re Line 1371  c$$$         print*,' resolution ',re
1371  *     ----------------------  *     ----------------------
1372                    
1373           distance=           distance=
1374       $        ((xPAM-XPP)/resxPAM)**2       $       ((xPAM-XPP))**2 !QUIQUI
1375       $        +       $       +
1376       $        ((yPAM-YPP)/resyPAM)**2       $       ((yPAM-YPP))**2
1377    c$$$     $        ((xPAM-XPP)/resxPAM)**2
1378    c$$$     $        +
1379    c$$$     $        ((yPAM-YPP)/resyPAM)**2
1380           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1381    
1382  c$$$         print*,xPAM,yPAM,zPAM  c$$$         print*,xPAM,yPAM,zPAM
# Line 1082  c$$$         print*,' resolution ',resxP Line 1385  c$$$         print*,' resolution ',resxP
1385                    
1386        else        else
1387                    
1388           print*  c         print*
1389       $        ,' function distance_to ---> wrong usage!!!'  c     $        ,' function distance_to ---> wrong usage!!!'
1390           print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM  c         print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM
1391           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 '
1392       $        ,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
1393        endif          endif  
1394    
1395        distance_to = sngl(distance)        distance_to = sngl(distance)
# Line 1154  c--------------------------------------- Line 1457  c---------------------------------------
1457                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1458       $              .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...
1459  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...
1460                    print*,'whichsensor: ',  c                  print*,'whichsensor: ',
1461       $                ' WARNING: false X strip: strip ',stripx  c     $                ' WARNING: false X strip: strip ',stripx
1462                 endif                 endif
1463                 xi = acoordsi(stripx,viewx)                 xi = acoordsi(stripx,viewx)
1464                 yi = acoordsi(stripy,viewy)                 yi = acoordsi(stripy,viewy)
# Line 1284  c     $              ,iv,xvv(iv),yvv(iv) Line 1587  c     $              ,iv,xvv(iv),yvv(iv)
1587  *     it returns the plane number  *     it returns the plane number
1588  *      *    
1589        include 'commontracker.f'        include 'commontracker.f'
1590          include 'level1.f'
1591  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1592        include 'common_momanhough.f'        include 'common_momanhough.f'
1593                
# Line 1309  c      include 'common_analysis.f' Line 1613  c      include 'common_analysis.f'
1613        is_cp=0        is_cp=0
1614        if(id.lt.0)is_cp=1        if(id.lt.0)is_cp=1
1615        if(id.gt.0)is_cp=2        if(id.gt.0)is_cp=2
1616        if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'  c      if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'
1617    
1618        return        return
1619        end        end
# Line 1321  c      include 'common_analysis.f' Line 1625  c      include 'common_analysis.f'
1625  *     it returns the id number ON THE PLANE  *     it returns the id number ON THE PLANE
1626  *      *    
1627        include 'commontracker.f'        include 'commontracker.f'
1628          include 'level1.f'
1629  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1630        include 'common_momanhough.f'        include 'common_momanhough.f'
1631                
# Line 1349  c      include 'common_analysis.f' Line 1654  c      include 'common_analysis.f'
1654  *     positive if sensor =2  *     positive if sensor =2
1655  *  *
1656        include 'commontracker.f'        include 'commontracker.f'
1657          include 'level1.f'
1658  c      include 'calib.f'  c      include 'calib.f'
1659  c      include 'level1.f'  c      include 'level1.f'
1660  c      include 'common_analysis.f'  c      include 'common_analysis.f'
# Line 1371  c      include 'common_analysis.f' Line 1677  c      include 'common_analysis.f'
1677    
1678    
1679    
1680    
1681  *************************************************************************  *************************************************************************
1682  *************************************************************************  *************************************************************************
1683  *************************************************************************  *************************************************************************
1684  *************************************************************************  *************************************************************************
1685  *************************************************************************  *************************************************************************
1686  *************************************************************************  *************************************************************************
 c$$$      subroutine book_debug  
 c$$$  
 c$$$      include 'commontracker.f'  
 c$$$      include 'common_momanhough.f'  
 c$$$      include 'common_level2debug.f'  
 c$$$  
 c$$$      character*35 block1,block2,block3!,block4  
 c$$$     $     ,block5!,block6        
 c$$$        
 c$$$* * * * * * * * * * * * * * * * * * * * * * * *  
 c$$$*     HOUGH TRANSFORM PARAMETERS  
 c$$$        
 c$$$      call HBOOK2(1003  
 c$$$     $     ,'y vs tg thyz'  
 c$$$     $     ,300,-1.,1.         !x          
 c$$$     $     ,3000,-70.,70.,0.)   !y  
 c$$$  
 c$$$      call HBOOK1(1004  
 c$$$     $     ,'Dy'  
 c$$$     $     ,100,0.,2.,0.)    
 c$$$  
 c$$$      call HBOOK1(1005  
 c$$$     $     ,'D thyz'  
 c$$$     $     ,100,0.,.05,0.)    
 c$$$  
 c$$$  
 c$$$  
 c$$$*     DEBUG ntuple:  
 c$$$      call HBNT(ntp_level2+1,'LEVEL2',' ')  
 c$$$        
 c$$$      call HBNAME(ntp_level2+1,'EVENT',good2_nt,  
 c$$$     $     'GOOD2:L,NEV2:I')  
 c$$$  
 c$$$ 411  format('NDBLT:I::[0,',I5,']')  
 c$$$      write(block1,411) ndblt_max_nt  
 c$$$      call HBNAME(ntp_level2+1,'HOUGH YZ',ndblt_nt,  
 c$$$     $     block1//'  
 c$$$     $     ,ALFAYZ1(NDBLT):R  
 c$$$     $     ,ALFAYZ2(NDBLT):R  
 c$$$     $     ,DB_CLOUD(NDBLT):I  
 c$$$     $     ')    
 c$$$  
 c$$$ 412  format('NTRPT:I::[0,',I5,']')  
 c$$$      write(block2,412) ntrpt_max_nt  
 c$$$      call HBNAME(ntp_level2+1,'HOUGH XZ',NTRPT_nt,  
 c$$$     $     block2//'  
 c$$$     $     ,ALFAXZ1(NTRPT):R  
 c$$$     $     ,ALFAXZ2(NTRPT):R    
 c$$$     $     ,ALFAXZ3(NTRPT):R  
 c$$$     $     ,TR_CLOUD(NTRPT):I  
 c$$$     $     ')  
 c$$$        
 c$$$    
 c$$$ 413  format('NCLOUDS_YZ:I::[0,',I4,']')  
 c$$$c$$$ 414  format('DB_CLOUD(',I4,'):I')  
 c$$$      write(block3,413) ncloyz_max  
 c$$$c$$$      write(block4,414) ndblt_max_nt  
 c$$$      call HBNAME(ntp_level2+1,'CLOUD YZ',NCLOUDS_YZ,  
 c$$$     $     block3//'  
 c$$$     $     ,ALFAYZ1_AV(NCLOUDS_YZ):R  
 c$$$     $     ,ALFAYZ2_AV(NCLOUDS_YZ):R  
 c$$$     $     ,PTCLOUD_YZ(NCLOUDS_YZ):I'  
 c$$$c$$$     $     ,'//block4  
 c$$$     $     )  
 c$$$  
 c$$$ 415  format('NCLOUDS_XZ:I::[0,',I4,']')  
 c$$$c$$$ 416  format('TR_CLOUD(',I5,'):I')  
 c$$$      write(block5,415) ncloxz_max  
 c$$$c$$$      write(block6,416) ntrpt_max_nt  
 c$$$      call HBNAME(ntp_level2+1,'CLOUD XZ',NCLOUDS_XZ,  
 c$$$     $     block5//'  
 c$$$     $     ,ALFAXZ1_AV(NCLOUDS_XZ):R  
 c$$$     $     ,ALFAXZ2_AV(NCLOUDS_XZ):R  
 c$$$     $     ,ALFAXZ3_AV(NCLOUDS_XZ):R  
 c$$$     $     ,PTCLOUD_XZ(NCLOUDS_XZ):I'  
 c$$$c$$$     $     ,'//block6  
 c$$$     $     )  
 c$$$  
 c$$$        
 c$$$      return  
 c$$$      end  
 ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***  
 *  
 *  
 *  
 *  
 *  
 *  
 *  
 *  
 *  
 ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***  
 c$$$      subroutine book_level2  
 c$$$c*****************************************************  
 c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$cccccc 07/10/2005 modified by elena vannuccini --> (2)  
 c$$$c*****************************************************  
 c$$$  
 c$$$      include 'commontracker.f'  
 c$$$      include 'common_momanhough.f'  
 c$$$      include 'level2.f'  
 c$$$  
 c$$$      character*35 block1,block2  
 c$$$  
 c$$$c      print*,'__________ booking LEVEL2 n-tuple __________'  
 c$$$  
 c$$$*     LEVEL1 ntuple:  
 c$$$      call HBNT(ntp_level2,'LEVEL2',' ')  
 c$$$        
 c$$$c*****************************************************  
 c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$c      call HBNAME(ntp_level2,'EVENT',good2,'GOOD2:L,NEV2:I')  
 c$$$cccccc 06/10/2005 modified by elena vannuccini  
 c$$$c      call HBNAME(ntp_level2,'GENERAL',good2,'GOOD2:L,NEV2:I  
 c$$$c     $     ,WHIC_CALIB:I,SWCODE:I')  
 c$$$      call HBNAME(ntp_level2,'GENERAL',good2,'GOOD2:L,NEV2:I  
 c$$$     $     ,WHICH_CALIB:I,SWCODE:I,CRC(12):L')  
 c$$$c*********************************************************  
 c$$$    
 c$$$  
 c$$$c$$$# ifndef TEST2003  
 c$$$c$$$  
 c$$$c$$$      call HBNAME(ntp_level2,'CPU',pkt_type  
 c$$$c$$$     $     ,'PKT_TYPE:I::[0,50]  
 c$$$c$$$     $     ,PKT_NUM:I  
 c$$$c$$$     $     ,OBT:I'//  
 c$$$c$$$c********************************************************  
 c$$$c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$c$$$c     $     ,WHICH_CALIB:I::[0,50]')  
 c$$$c$$$     $     ',CPU_CRC:L')  
 c$$$c$$$c********************************************************  
 c$$$c$$$  
 c$$$c$$$# endif  
 c$$$  
 c$$$ 417  format('NTRK:I::[0,',I4,']')  
 c$$$ 418  format(',IMAGE(NTRK):I::[0,',I4,']')  
 c$$$      write(block1,417)NTRKMAX  
 c$$$      write(block2,418)NTRKMAX  
 c$$$      call HBNAME(ntp_level2,'TRACKS',NTRK,  
 c$$$     $     block1//  
 c$$$     $     block2//'  
 c$$$     $     ,XM(6,NTRK):R  
 c$$$     $     ,YM(6,NTRK):R  
 c$$$     $     ,ZM(6,NTRK):R  
 c$$$     $     ,RESX(6,NTRK):R  
 c$$$     $     ,RESY(6,NTRK):R  
 c$$$     $     ,AL(5,NTRK):R  
 c$$$     $     ,COVAL(5,5,NTRK):R  
 c$$$     $     ,CHI2(NTRK):R  
 c$$$     $     ,XGOOD(6,NTRK):I::[0,1]  
 c$$$     $     ,YGOOD(6,NTRK):I::[0,1]  
 c$$$     $     ,XV(6,NTRK):R  
 c$$$     $     ,YV(6,NTRK):R  
 c$$$     $     ,ZV(6,NTRK):R  
 c$$$     $     ,AXV(6,NTRK):R  
 c$$$     $     ,AYV(6,NTRK):R'//  
 c$$$c*****************************************************  
 c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$c     $     ,DEDXP(6,NTRK):R'//  
 c$$$c     $     ')  
 c$$$     $     ',DEDX_X(6,NTRK):R  
 c$$$     $     ,DEDX_Y(6,NTRK):R'//  
 c$$$c****************************************************  
 c$$$cccccc 06/10/2005 modified by elena vannuccini  
 c$$$c     $     ,CRC(12):L  
 c$$$     $     ',BdL(NTRK):R'  
 c$$$     $     )  
 c$$$c****************************************************  
 c$$$  
 c$$$    
 c$$$      call HBNAME(ntp_level2,'SINGLETX',nclsx,  
 c$$$c*****************************************************  
 c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$c     $     'NCLSX(6):I,NCLSY(6):I')  
 c$$$     $     'NCLSX:I::[0,500],PLANEX(NCLSX):I  
 c$$$     $     ,XS(2,NCLSX):R,SGNLXS(NCLSX):R') !(2)  
 c$$$c    $     ,XS(NCLSX):R,SGNLXS(NCLSX):R')   !(2)  
 c$$$      call HBNAME(ntp_level2,'SINGLETY',nclsy,  
 c$$$     $     'NCLSY:I::[0,500],PLANEY(NCLSY):I  
 c$$$     $     ,YS(2,NCLSY):R,SGNLYS(NCLSY):R') !(2)  
 c$$$c    $     ,YS(NCLSY):R,SGNLYS(NCLSY):R')   !(2)  
 c$$$      return  
 c$$$      end  
   
 c$$$      subroutine fill_level2_clouds  
 c$$$c*****************************************************  
 c$$$c     29/11/2005 created by elena vannuccini  
 c$$$c*****************************************************  
 c$$$  
 c$$$*     -------------------------------------------------------  
 c$$$*     This routine fills the  variables related to the hough  
 c$$$*     transform, for the debig n-tuple  
 c$$$*     -------------------------------------------------------  
 c$$$  
 c$$$      include 'commontracker.f'  
 c$$$      include 'common_momanhough.f'  
 c$$$      include 'common_level2debug.f'  
 c$$$      include 'level2.f'  
 c$$$  
 c$$$      good2_nt=.true.!good2  
 c$$$c      nev2_nt=nev2  
 c$$$        
 c$$$      if(.false.  
 c$$$     $     .or.ntrpt.gt.ntrpt_max_nt  
 c$$$     $     .or.ndblt.gt.ndblt_max_nt  
 c$$$     $     .or.NCLOUDS_XZ.gt.ncloxz_max  
 c$$$     $     .or.NCLOUDS_yZ.gt.ncloyz_max  
 c$$$     $     )then  
 c$$$         good2_nt=.false.  
 c$$$         ntrpt_nt=0  
 c$$$         ndblt_nt=0  
 c$$$         NCLOUDS_XZ_nt=0  
 c$$$         NCLOUDS_YZ_nt=0  
 c$$$      else  
 c$$$         ndblt_nt=ndblt  
 c$$$         ntrpt_nt=ntrpt  
 c$$$         if(ndblt.ne.0)then  
 c$$$            do id=1,ndblt  
 c$$$               alfayz1_nt(id)=alfayz1(id) !Y0  
 c$$$               alfayz2_nt(id)=alfayz2(id) !tg theta-yz  
 c$$$c               db_cloud_nt(id)=db_cloud(id)  
 c$$$            enddo  
 c$$$         endif  
 c$$$         if(ndblt.ne.0)then  
 c$$$            do it=1,ntrpt  
 c$$$               alfaxz1_nt(it)=alfaxz1(it) !X0  
 c$$$               alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz  
 c$$$               alfaxz3_nt(it)=alfaxz3(it) !1/r  
 c$$$c               tr_cloud_nt(it)=tr_cloud(it)  
 c$$$            enddo  
 c$$$         endif  
 c$$$         nclouds_yz_nt=nclouds_yz  
 c$$$         nclouds_xz_nt=nclouds_xz  
 c$$$         if(nclouds_yz.ne.0)then  
 c$$$            nnn=0  
 c$$$            do iyz=1,nclouds_yz  
 c$$$               ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)  
 c$$$               alfayz1_av_nt(iyz)=alfayz1_av(iyz)  
 c$$$               alfayz2_av_nt(iyz)=alfayz2_av(iyz)  
 c$$$               nnn=nnn+ptcloud_yz(iyz)  
 c$$$            enddo  
 c$$$            do ipt=1,nnn  
 c$$$               db_cloud_nt(ipt)=db_cloud(ipt)  
 c$$$            enddo  
 c$$$c            print*,'#### ntupla #### ptcloud_yz '  
 c$$$c     $           ,(ptcloud_yz(i),i=1,nclouds_yz)  
 c$$$c            print*,'#### ntupla #### db_cloud '  
 c$$$c     $           ,(db_cloud(i),i=1,nnn)  
 c$$$         endif  
 c$$$         if(nclouds_xz.ne.0)then  
 c$$$            nnn=0  
 c$$$            do ixz=1,nclouds_xz  
 c$$$               ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)  
 c$$$               alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)  
 c$$$               alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)  
 c$$$               alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)  
 c$$$               nnn=nnn+ptcloud_xz(ixz)                
 c$$$            enddo  
 c$$$            do ipt=1,nnn  
 c$$$               tr_cloud_nt(ipt)=tr_cloud(ipt)  
 c$$$            enddo  
 c$$$c            print*,'#### ntupla #### ptcloud_xz '  
 c$$$c     $           ,(ptcloud_xz(i),i=1,nclouds_xz)  
 c$$$c            print*,'#### ntupla #### tr_cloud '  
 c$$$c     $           ,(tr_cloud(i),i=1,nnn)  
 c$$$         endif  
 c$$$      endif  
 c$$$      end  
         
   
 ***************************************************  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 **************************************************  
   
       subroutine cl_to_couples(iflag)  
   
       include 'commontracker.f'  
       include 'common_momanhough.f'  
       include 'momanhough_init.f'  
       include 'calib.f'  
       include 'level1.f'  
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
 *     output flag  
 *     --------------  
 *     0 = good event  
 *     1 = bad event  
 *     --------------  
       integer iflag  
   
       integer badseed,badcl  
   
 *     init variables  
       ncp_tot=0  
       do ip=1,nplanes  
          do ico=1,ncouplemax  
             clx(ip,ico)=0  
             cly(ip,ico)=0  
          enddo  
          ncp_plane(ip)=0  
          do icl=1,nclstrmax_level2  
             cls(ip,icl)=1  
          enddo  
          ncls(ip)=0  
       enddo  
       do icl=1,nclstrmax_level2  
          cl_single(icl)=1  
          cl_good(icl)=0  
       enddo  
         
 *     start association  
       ncouples=0  
       do icx=1,nclstr1          !loop on cluster (X)  
          if(mod(VIEW(icx),2).eq.1)goto 10  
           
 *     ----------------------------------------------------  
 *     cut on charge (X VIEW)  
 *     ----------------------------------------------------  
          if(dedx(icx).lt.dedx_x_min)then  
             cl_single(icx)=0  
             goto 10  
          endif  
 *     ----------------------------------------------------  
 *     cut BAD (X VIEW)              
 *     ----------------------------------------------------  
          badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))  
          ifirst=INDSTART(icx)  
          if(icx.ne.nclstr1) then  
             ilast=INDSTART(icx+1)-1  
          else  
             ilast=TOTCLLENGTH  
          endif  
          badcl=badseed  
          do igood=-ngoodstr,ngoodstr  
             ibad=1  
             if((INDMAX(icx)+igood).gt.ifirst.and.  
      $           (INDMAX(icx)+igood).lt.ilast.and.  
      $           .true.)then  
                ibad=BAD(VIEW(icx),  
      $              nvk(MAXS(icx)+igood),  
      $              nst(MAXS(icx)+igood))  
             endif  
             badcl=badcl*ibad  
          enddo  
 *     ----------------------------------------------------  
 *     >>> eliminato il taglio sulle BAD <<<  
 *     ----------------------------------------------------  
 c     if(badcl.eq.0)then  
 c     cl_single(icx)=0  
 c     goto 10  
 c     endif  
 *     ----------------------------------------------------  
           
          cl_good(icx)=1  
          nplx=npl(VIEW(icx))  
          nldx=nld(MAXS(icx),VIEW(icx))  
           
          do icy=1,nclstr1       !loop on cluster (Y)  
             if(mod(VIEW(icy),2).eq.0)goto 20  
               
 *     ----------------------------------------------------  
 *     cut on charge (Y VIEW)  
 *     ----------------------------------------------------  
             if(dedx(icy).lt.dedx_y_min)then  
                cl_single(icy)=0  
                goto 20  
             endif  
 *     ----------------------------------------------------  
 *     cut BAD (Y VIEW)              
 *     ----------------------------------------------------  
             badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))  
             ifirst=INDSTART(icy)  
             if(icy.ne.nclstr1) then  
                ilast=INDSTART(icy+1)-1  
             else  
                ilast=TOTCLLENGTH  
             endif  
             badcl=badseed  
             do igood=-ngoodstr,ngoodstr  
                ibad=1  
                if((INDMAX(icy)+igood).gt.ifirst.and.  
      $              (INDMAX(icy)+igood).lt.ilast.and.  
      $              .true.)  
      $              ibad=BAD(VIEW(icy),  
      $              nvk(MAXS(icy)+igood),  
      $              nst(MAXS(icy)+igood))  
                badcl=badcl*ibad  
             enddo  
 *     ----------------------------------------------------  
 *     >>> eliminato il taglio sulle BAD <<<  
 *     ----------------------------------------------------  
 c     if(badcl.eq.0)then  
 c     cl_single(icy)=0  
 c     goto 20  
 c     endif  
 *     ----------------------------------------------------  
               
             cl_good(icy)=1                    
             nply=npl(VIEW(icy))  
             nldy=nld(MAXS(icy),VIEW(icy))  
               
 *     ----------------------------------------------  
 *     CONDITION TO FORM A COUPLE  
 *     ----------------------------------------------  
 *     geometrical consistency (same plane and ladder)  
             if(nply.eq.nplx.and.nldy.eq.nldx)then  
 *     charge correlation  
 *     (modified to be applied only below saturation... obviously)  
   
 *     -------------------------------------------------------------  
 *     >>> eliminata (TEMPORANEAMENTE) la correlazione di carica <<<  
 *     -------------------------------------------------------------  
 c$$$               if(dedx(icy).lt.chsaty.or.dedx(icx).lt.chsatx)then  
 c$$$                  ddd=(dedx(icy)  
 c$$$     $                 -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  
 c$$$                  ddd=ddd/sqrt(kch(nplx,nldx)**2+1)  
 c$$$                  cut=chcut*sch(nplx,nldx)  
 c$$$                  if(abs(ddd).gt.cut)goto 20 !charge not consistent  
 c$$$               endif  
                 
 *     ------------------> COUPLE <------------------  
 *     check to do not overflow vector dimentions  
                if(ncp_plane(nplx).gt.ncouplemax)then  
                   if(DEBUG)print*,  
      $                    ' ** warning ** number of identified'//  
      $                    ' couples on plane ',nplx,  
      $                    ' exceeds vector dimention'//  
      $                    ' ( ',ncouplemax,' )'  
 c     good2=.false.  
 c     goto 880   !fill ntp and go to next event  
                   iflag=1  
                   return  
                endif  
                 
 c$$$               if(ncp_plane(nplx).eq.ncouplemax)then  
 c$$$                  if(DEBUG)print*,  
 c$$$     $                 '** warning ** number of identified '//  
 c$$$     $                 'couples on plane ',nplx,  
 c$$$     $                 'exceeds vector dimention '  
 c$$$     $                 ,'( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event                      
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
                 
                ncp_plane(nplx) = ncp_plane(nplx) + 1  
                clx(nplx,ncp_plane(nplx))=icx  
                cly(nply,ncp_plane(nplx))=icy  
                cl_single(icx)=0  
                cl_single(icy)=0  
             endif                                
 *     ----------------------------------------------  
   
  20         continue  
          enddo                  !end loop on clusters(Y)  
           
  10      continue  
       enddo                     !end loop on clusters(X)  
         
         
       do icl=1,nclstr1  
          if(cl_single(icl).eq.1)then  
             ip=npl(VIEW(icl))  
             ncls(ip)=ncls(ip)+1  
             cls(ip,ncls(ip))=icl  
          endif  
       enddo  
         
         
       if(DEBUG)then  
          print*,'clusters  ',nclstr1  
          print*,'good    ',(cl_good(i),i=1,nclstr1)  
          print*,'singles ',(cl_single(i),i=1,nclstr1)  
          print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)  
       endif  
         
       do ip=1,6  
          ncp_tot=ncp_tot+ncp_plane(ip)  
       enddo  
 c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
         
       if(ncp_tot.gt.ncp_max)then  
          if(DEBUG)print*,  
      $           '** warning ** number of identified '//  
      $           'couples exceeds upper limit for Hough tr. '  
      $           ,'( ',ncp_max,' )'              
 c            good2=.false.  
 c     goto 880       !fill ntp and go to next event  
          iflag=1  
          return  
       endif  
         
       return  
       end  
1687                
1688    
1689  ***************************************************  ***************************************************
1690  *                                                 *  *                                                 *
1691  *                                                 *  *                                                 *
# Line 1889  c     goto 880       !fill ntp and go to Line 1694  c     goto 880       !fill ntp and go to
1694  *                                                 *  *                                                 *
1695  *                                                 *  *                                                 *
1696  **************************************************  **************************************************
1697        subroutine cl_to_couples_nocharge(iflag)  
1698          subroutine cl_to_couples(iflag)
1699    
1700        include 'commontracker.f'        include 'commontracker.f'
1701          include 'level1.f'
1702        include 'common_momanhough.f'        include 'common_momanhough.f'
1703        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1704        include 'calib.f'        include 'calib.f'
1705        include 'level1.f'  c      include 'level1.f'
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1706    
1707  *     output flag  *     output flag
1708  *     --------------  *     --------------
# Line 1907  c      common/dbg/DEBUG Line 1711  c      common/dbg/DEBUG
1711  *     --------------  *     --------------
1712        integer iflag        integer iflag
1713    
1714        integer badseed,badcl        integer badseed,badclx,badcly
1715    
1716  *     init variables  *     init variables
1717        ncp_tot=0        ncp_tot=0
# Line 1923  c      common/dbg/DEBUG Line 1727  c      common/dbg/DEBUG
1727           ncls(ip)=0           ncls(ip)=0
1728        enddo        enddo
1729        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1730           cl_single(icl)=1           cl_single(icl) = 1
1731           cl_good(icl)=0           cl_good(icl)   = 0
1732          enddo
1733          do iv=1,nviews
1734             ncl_view(iv)  = 0
1735             mask_view(iv) = 0      !all included
1736        enddo        enddo
1737                
1738    *     count number of cluster per view
1739          do icl=1,nclstr1
1740             ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1        
1741          enddo
1742    *     mask views with too many clusters
1743          do iv=1,nviews
1744             if( ncl_view(iv).gt. nclusterlimit)then
1745    c            mask_view(iv) = 1
1746                mask_view(iv) = mask_view(iv) + 2**0
1747                if(DEBUG)print*,' * WARNING * cl_to_couple: n.clusters > '
1748         $           ,nclusterlimit,' on view ', iv,' --> masked!'
1749             endif
1750          enddo
1751    
1752    
1753  *     start association  *     start association
1754        ncouples=0        ncouples=0
1755        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1756           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1757                    
1758  *     ----------------------------------------------------  *     ----------------------------------------------------
1759    *     jump masked views (X VIEW)
1760    *     ----------------------------------------------------
1761             if( mask_view(VIEW(icx)).ne.0 ) goto 10
1762    *     ----------------------------------------------------
1763  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1764           if(dedx(icx).lt.dedx_x_min)then  *     ----------------------------------------------------
1765             if(sgnl(icx).lt.dedx_x_min)then
1766              cl_single(icx)=0              cl_single(icx)=0
1767              goto 10              goto 10
1768           endif           endif
1769    *     ----------------------------------------------------
1770  *     cut BAD (X VIEW)              *     cut BAD (X VIEW)            
1771    *     ----------------------------------------------------
1772           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
1773           ifirst=INDSTART(icx)           ifirst=INDSTART(icx)
1774           if(icx.ne.nclstr1) then           if(icx.ne.nclstr1) then
# Line 1946  c      common/dbg/DEBUG Line 1776  c      common/dbg/DEBUG
1776           else           else
1777              ilast=TOTCLLENGTH              ilast=TOTCLLENGTH
1778           endif           endif
1779           badcl=badseed           badclx=badseed
1780           do igood=-ngoodstr,ngoodstr           do igood=-ngoodstr,ngoodstr
1781              ibad=1              ibad=1
1782              if((INDMAX(icx)+igood).gt.ifirst.and.              if((INDMAX(icx)+igood).gt.ifirst.and.
# Line 1956  c      common/dbg/DEBUG Line 1786  c      common/dbg/DEBUG
1786       $              nvk(MAXS(icx)+igood),       $              nvk(MAXS(icx)+igood),
1787       $              nst(MAXS(icx)+igood))       $              nst(MAXS(icx)+igood))
1788              endif              endif
1789              badcl=badcl*ibad              badclx=badclx*ibad
1790           enddo           enddo
1791           if(badcl.eq.0)then     !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1792              cl_single(icx)=0    !<<<<<<<<<<<<<< BAD cut  *     >>> eliminato il taglio sulle BAD <<<
1793              goto 10             !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1794           endif                  !<<<<<<<<<<<<<< BAD cut  c     if(badcl.eq.0)then
1795    c     cl_single(icx)=0
1796    c     goto 10
1797    c     endif
1798  *     ----------------------------------------------------  *     ----------------------------------------------------
1799                    
1800           cl_good(icx)=1           cl_good(icx)=1
# Line 1972  c      common/dbg/DEBUG Line 1805  c      common/dbg/DEBUG
1805              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1806                            
1807  *     ----------------------------------------------------  *     ----------------------------------------------------
1808    *     jump masked views (Y VIEW)
1809    *     ----------------------------------------------------
1810                if( mask_view(VIEW(icy)).ne.0 ) goto 20
1811    
1812    *     ----------------------------------------------------
1813  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1814              if(dedx(icy).lt.dedx_y_min)then  *     ----------------------------------------------------
1815                if(sgnl(icy).lt.dedx_y_min)then
1816                 cl_single(icy)=0                 cl_single(icy)=0
1817                 goto 20                 goto 20
1818              endif              endif
1819    *     ----------------------------------------------------
1820  *     cut BAD (Y VIEW)              *     cut BAD (Y VIEW)            
1821    *     ----------------------------------------------------
1822              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
1823              ifirst=INDSTART(icy)              ifirst=INDSTART(icy)
1824              if(icy.ne.nclstr1) then              if(icy.ne.nclstr1) then
# Line 1985  c      common/dbg/DEBUG Line 1826  c      common/dbg/DEBUG
1826              else              else
1827                 ilast=TOTCLLENGTH                 ilast=TOTCLLENGTH
1828              endif              endif
1829              badcl=badseed              badcly=badseed
1830              do igood=-ngoodstr,ngoodstr              do igood=-ngoodstr,ngoodstr
1831                 ibad=1                 ibad=1
1832                 if((INDMAX(icy)+igood).gt.ifirst.and.                 if((INDMAX(icy)+igood).gt.ifirst.and.
# Line 1994  c      common/dbg/DEBUG Line 1835  c      common/dbg/DEBUG
1835       $              ibad=BAD(VIEW(icy),       $              ibad=BAD(VIEW(icy),
1836       $              nvk(MAXS(icy)+igood),       $              nvk(MAXS(icy)+igood),
1837       $              nst(MAXS(icy)+igood))       $              nst(MAXS(icy)+igood))
1838                 badcl=badcl*ibad                 badcly=badcly*ibad
1839              enddo              enddo
             if(badcl.eq.0)then  !<<<<<<<<<<<<<< BAD cut  
                cl_single(icy)=0 !<<<<<<<<<<<<<< BAD cut  
                goto 20          !<<<<<<<<<<<<<< BAD cut  
             endif               !<<<<<<<<<<<<<< BAD cut  
1840  *     ----------------------------------------------------  *     ----------------------------------------------------
1841                *     >>> eliminato il taglio sulle BAD <<<
1842    *     ----------------------------------------------------
1843    c     if(badcl.eq.0)then
1844    c     cl_single(icy)=0
1845    c     goto 20
1846    c     endif
1847    *     ----------------------------------------------------
1848                            
1849              cl_good(icy)=1                                cl_good(icy)=1                  
1850              nply=npl(VIEW(icy))              nply=npl(VIEW(icy))
# Line 2012  c      common/dbg/DEBUG Line 1855  c      common/dbg/DEBUG
1855  *     ----------------------------------------------  *     ----------------------------------------------
1856  *     geometrical consistency (same plane and ladder)  *     geometrical consistency (same plane and ladder)
1857              if(nply.eq.nplx.and.nldy.eq.nldx)then              if(nply.eq.nplx.and.nldy.eq.nldx)then
1858  *     charge correlation  *     charge correlation
1859  *     ===========================================================  *     (modified to be applied only below saturation... obviously)
1860  *     this version of the subroutine is used for the calibration  
1861  *     thus charge-correlation selection is obviously removed                 if(  .not.(sgnl(icy).gt.chsaty.and.sgnl(icx).gt.chsatx)
1862  *     ===========================================================       $              .and.
1863  c$$$               ddd=(dedx(icy)       $              .not.(sgnl(icy).lt.chmipy.and.sgnl(icx).lt.chmipx)
1864  c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))       $              .and.
1865  c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)       $              (badclx.eq.1.and.badcly.eq.1)
1866  c$$$               cut=chcut*sch(nplx,nldx)       $              .and.
1867  c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent       $              .true.)then
1868  *     ===========================================================  
1869                                    ddd=(sgnl(icy)
1870                       $                 -kch(nplx,nldx)*sgnl(icx)-cch(nplx,nldx))
1871  *     ------------------> COUPLE <------------------                    ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
1872  *     check to do not overflow vector dimentions  
1873    c                  cut = chcut * sch(nplx,nldx)
1874    
1875                      sss=(kch(nplx,nldx)*sgnl(icy)+sgnl(icx)
1876         $                 -kch(nplx,nldx)*cch(nplx,nldx))
1877                      sss=sss/sqrt(kch(nplx,nldx)**2+1)
1878                      cut = chcut * (16 + sss/50.)
1879    
1880                      if(abs(ddd).gt.cut)then
1881                         goto 20    !charge not consistent
1882                      endif
1883                   endif
1884    
1885                 if(ncp_plane(nplx).gt.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
1886                    if(DEBUG)print*,                    if(verbose)print*,
1887       $                    ' ** warning ** number of identified'//       $                 '** warning ** number of identified '//
1888       $                    ' couples on plane ',nplx,       $                 'couples on plane ',nplx,
1889       $                    ' exceeds vector dimention'//       $                 'exceeds vector dimention '
1890       $                    ' ( ',ncouplemax,' )'       $                 ,'( ',ncouplemax,' ) --> masked!'
1891  c     good2=.false.  c                  mask_view(nviewx(nplx)) = 2
1892  c     goto 880   !fill ntp and go to next event  c                  mask_view(nviewy(nply)) = 2
1893                    iflag=1                    mask_view(nviewx(nplx))= mask_view(nviewx(nplx))+ 2**1
1894                    return                    mask_view(nviewy(nply))= mask_view(nviewy(nply))+ 2**1
1895                      goto 10
1896                 endif                 endif
1897                                
1898  c$$$               if(ncp_plane(nplx).eq.ncouplemax)then  *     ------------------> COUPLE <------------------
 c$$$                  if(DEBUG)print*,  
 c$$$     $                 '** warning ** number of identified '//  
 c$$$     $                 'couples on plane ',nplx,  
 c$$$     $                 'exceeds vector dimention '  
 c$$$     $                 ,'( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event                      
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
                 
1899                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
1900                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
1901                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
1902                 cl_single(icx)=0                 cl_single(icx)=0
1903                 cl_single(icy)=0                 cl_single(icy)=0
             endif                                
1904  *     ----------------------------------------------  *     ----------------------------------------------
1905    
1906                endif                              
1907    
1908   20         continue   20         continue
1909           enddo                  !end loop on clusters(Y)           enddo                  !end loop on clusters(Y)
1910                    
# Line 2083  c$$$               endif Line 1929  c$$$               endif
1929        endif        endif
1930                
1931        do ip=1,6        do ip=1,6
1932           ncp_tot=ncp_tot+ncp_plane(ip)           ncp_tot = ncp_tot + ncp_plane(ip)
1933        enddo        enddo
 c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
         
       if(ncp_tot.gt.ncp_max)then  
          if(DEBUG)print*,  
      $           '** warning ** number of identified '//  
      $           'couples exceeds upper limit for Hough tr. '  
      $           ,'( ',ncp_max,' )'              
 c            good2=.false.  
 c     goto 880       !fill ntp and go to next event  
          iflag=1  
          return  
       endif  
1934                
1935        return        return
1936        end        end
   
 c$$$      subroutine cl_to_couples_2(iflag)  
 c$$$  
 c$$$      include 'commontracker.f'  
 c$$$      include 'common_momanhough.f'  
 c$$$      include 'momanhough_init.f'  
 c$$$      include 'calib.f'  
 c$$$      include 'level1.f'  
 c$$$  
 c$$$      logical DEBUG  
 c$$$      common/dbg/DEBUG  
 c$$$  
 c$$$*     output flag  
 c$$$*     --------------  
 c$$$*     0 = good event  
 c$$$*     1 = bad event  
 c$$$*     --------------  
 c$$$      integer iflag  
 c$$$  
 c$$$      integer badseed,badcl  
 c$$$  
 c$$$*     init variables  
 c$$$      ncp_tot=0  
 c$$$      do ip=1,nplanes  
 c$$$         do ico=1,ncouplemax  
 c$$$            clx(ip,ico)=0  
 c$$$            cly(ip,ico)=0  
 c$$$         enddo  
 c$$$         ncp_plane(ip)=0  
 c$$$         do icl=1,nclstrmax_level2  
 c$$$            cls(ip,icl)=1  
 c$$$         enddo  
 c$$$         ncls(ip)=0  
 c$$$      enddo  
 c$$$      do icl=1,nclstrmax_level2  
 c$$$         cl_single(icl)=1  
 c$$$         cl_good(icl)=0  
 c$$$      enddo  
 c$$$        
 c$$$*     start association  
 c$$$      ncouples=0  
 c$$$      do icx=1,nclstr1          !loop on cluster (X)  
 c$$$         if(mod(VIEW(icx),2).eq.1)goto 10  
 c$$$          
 c$$$*     ----------------------------------------------------  
 c$$$*     cut on charge (X VIEW)  
 c$$$         if(dedx(icx).lt.dedx_x_min)then  
 c$$$            cl_single(icx)=0  
 c$$$            goto 10  
 c$$$         endif  
 c$$$*     cut BAD (X VIEW)              
 c$$$         badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))  
 c$$$         ifirst=INDSTART(icx)  
 c$$$         if(icx.ne.nclstr1) then  
 c$$$            ilast=INDSTART(icx+1)-1  
 c$$$         else  
 c$$$            ilast=TOTCLLENGTH  
 c$$$         endif  
 c$$$         badcl=badseed  
 c$$$         do igood=-ngoodstr,ngoodstr  
 c$$$            ibad=1  
 c$$$            if((INDMAX(icx)+igood).gt.ifirst.and.  
 c$$$     $           (INDMAX(icx)+igood).lt.ilast.and.  
 c$$$     $           .true.)then  
 c$$$               ibad=BAD(VIEW(icx),  
 c$$$     $              nvk(MAXS(icx)+igood),  
 c$$$     $              nst(MAXS(icx)+igood))  
 c$$$            endif  
 c$$$            badcl=badcl*ibad  
 c$$$         enddo  
 c$$$*         print*,'icx ',icx,badcl  
 c$$$         if(badcl.eq.0)then  
 c$$$            cl_single(icx)=0  
 c$$$            goto 10  
 c$$$         endif  
 c$$$*     ----------------------------------------------------  
 c$$$          
 c$$$         cl_good(icx)=1  
 c$$$         nplx=npl(VIEW(icx))  
 c$$$         nldx=nld(MAXS(icx),VIEW(icx))  
 c$$$          
 c$$$         do icy=1,nclstr1       !loop on cluster (Y)  
 c$$$            if(mod(VIEW(icy),2).eq.0)goto 20  
 c$$$              
 c$$$*     ----------------------------------------------------  
 c$$$*     cut on charge (Y VIEW)  
 c$$$            if(dedx(icy).lt.dedx_y_min)then  
 c$$$               cl_single(icy)=0  
 c$$$               goto 20  
 c$$$            endif  
 c$$$*     cut BAD (Y VIEW)              
 c$$$            badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))  
 c$$$            ifirst=INDSTART(icy)  
 c$$$            if(icy.ne.nclstr1) then  
 c$$$               ilast=INDSTART(icy+1)-1  
 c$$$            else  
 c$$$               ilast=TOTCLLENGTH  
 c$$$            endif  
 c$$$            badcl=badseed  
 c$$$            do igood=-ngoodstr,ngoodstr  
 c$$$               ibad=1  
 c$$$               if((INDMAX(icy)+igood).gt.ifirst.and.  
 c$$$     $              (INDMAX(icy)+igood).lt.ilast.and.  
 c$$$     $              .true.)  
 c$$$     $              ibad=BAD(VIEW(icy),  
 c$$$     $              nvk(MAXS(icy)+igood),  
 c$$$     $              nst(MAXS(icy)+igood))  
 c$$$               badcl=badcl*ibad  
 c$$$            enddo  
 c$$$*            print*,'icy ',icy,badcl  
 c$$$            if(badcl.eq.0)then  
 c$$$               cl_single(icy)=0  
 c$$$               goto 20  
 c$$$            endif  
 c$$$*     ----------------------------------------------------  
 c$$$              
 c$$$              
 c$$$            cl_good(icy)=1                    
 c$$$            nply=npl(VIEW(icy))  
 c$$$            nldy=nld(MAXS(icy),VIEW(icy))  
 c$$$              
 c$$$*     ----------------------------------------------  
 c$$$*     CONDITION TO FORM A COUPLE  
 c$$$*     ----------------------------------------------  
 c$$$*     geometrical consistency (same plane and ladder)  
 c$$$            if(nply.eq.nplx.and.nldy.eq.nldx)then  
 c$$$  
 c$$$c$$$*     charge correlation  
 c$$$c$$$               ddd=(dedx(icy)  
 c$$$c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  
 c$$$c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)  
 c$$$c$$$               cut=chcut*sch(nplx,nldx)  
 c$$$c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent  
 c$$$                
 c$$$*     ------------------> COUPLE <------------------  
 c$$$*     check to do not overflow vector dimentions  
 c$$$               if(ncp_plane(nplx).gt.ncouplemax)then  
 c$$$                  if(DEBUG)print*,  
 c$$$     $                    ' ** warning ** number of identified'//  
 c$$$     $                    ' couples on plane ',nplx,  
 c$$$     $                    ' exceeds vector dimention'//  
 c$$$     $                    ' ( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event  
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
 c$$$                
 c$$$               if(ncp_plane(nplx).eq.ncouplemax)then  
 c$$$                  if(DEBUG)print*,  
 c$$$     $                 '** warning ** number of identified '//  
 c$$$     $                 'couples on plane ',nplx,  
 c$$$     $                 'exceeds vector dimention '  
 c$$$     $                 ,'( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event                      
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
 c$$$                
 c$$$               ncp_plane(nplx) = ncp_plane(nplx) + 1  
 c$$$               clx(nplx,ncp_plane(nplx))=icx  
 c$$$               cly(nply,ncp_plane(nplx))=icy  
 c$$$               cl_single(icx)=0  
 c$$$               cl_single(icy)=0  
 c$$$c               print*,'couple ',nplx,ncp_plane(nplx),' --- ',icx,icy  
 c$$$            endif                                
 c$$$*     ----------------------------------------------  
 c$$$  
 c$$$ 20         continue  
 c$$$         enddo                  !end loop on clusters(Y)  
 c$$$          
 c$$$ 10      continue  
 c$$$      enddo                     !end loop on clusters(X)  
 c$$$        
 c$$$        
 c$$$      do icl=1,nclstr1  
 c$$$         if(cl_single(icl).eq.1)then  
 c$$$            ip=npl(VIEW(icl))  
 c$$$            ncls(ip)=ncls(ip)+1  
 c$$$            cls(ip,ncls(ip))=icl  
 c$$$         endif  
 c$$$      enddo  
 c$$$        
 c$$$        
 c$$$      if(DEBUG)then  
 c$$$         print*,'clusters  ',nclstr1  
 c$$$         print*,'good    ',(cl_good(i),i=1,nclstr1)  
 c$$$         print*,'singles ',(cl_single(i),i=1,nclstr1)  
 c$$$         print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)  
 c$$$      endif  
 c$$$        
 c$$$      do ip=1,6  
 c$$$         ncp_tot=ncp_tot+ncp_plane(ip)  
 c$$$      enddo  
 c$$$c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
 c$$$        
 c$$$      if(ncp_tot.gt.ncp_max)then  
 c$$$         if(DEBUG)print*,  
 c$$$     $           '** warning ** number of identified '//  
 c$$$     $           'couples exceeds upper limit for Hough tr. '  
 c$$$     $           ,'( ',ncp_max,' )'              
 c$$$c            good2=.false.  
 c$$$c     goto 880       !fill ntp and go to next event  
 c$$$         iflag=1  
 c$$$         return  
 c$$$      endif  
 c$$$        
 c$$$      return  
 c$$$      end  
1937                
1938  ***************************************************  ***************************************************
1939  *                                                 *  *                                                 *
# Line 2321  c$$$      end Line 1945  c$$$      end
1945  **************************************************  **************************************************
1946    
1947        subroutine cp_to_doubtrip(iflag)        subroutine cp_to_doubtrip(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
1948    
1949        include 'commontracker.f'        include 'commontracker.f'
1950          include 'level1.f'
1951        include 'common_momanhough.f'        include 'common_momanhough.f'
       include 'momanhough_init.f'  
1952        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1953        include 'common_mini_2.f'        include 'common_mini_2.f'
1954        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
1955    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1956    
1957  *     output flag  *     output flag
1958  *     --------------  *     --------------
# Line 2367  c      double precision xm3,ym3,zm3 Line 1985  c      double precision xm3,ym3,zm3
1985  *     -----------------------------  *     -----------------------------
1986    
1987    
1988    *     --------------------------------------------
1989    *     put a limit to the maximum number of couples
1990    *     per plane, in order to apply hough transform
1991    *     (couples recovered during track refinement)
1992    *     --------------------------------------------
1993          do ip=1,nplanes
1994             if(ncp_plane(ip).gt.ncouplelimit)then
1995    c            mask_view(nviewx(ip)) = 8
1996    c            mask_view(nviewy(ip)) = 8
1997                mask_view(nviewx(ip)) = mask_view(nviewx(ip)) + 2**7
1998                mask_view(nviewy(ip)) = mask_view(nviewy(ip)) + 2**7
1999             endif
2000          enddo
2001    
2002    
2003        ndblt=0                   !number of doublets        ndblt=0                   !number of doublets
2004        ntrpt=0                   !number of triplets        ntrpt=0                   !number of triplets
2005                
2006        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1
2007           do is1=1,2             !loop on sensors - COPPIA 1           if(  mask_view(nviewx(ip1)).ne.0 .or.
2008                     $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
2009             do is1=1,2             !loop on sensors - COPPIA 1            
2010              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
2011                 icx1=clx(ip1,icp1)                 icx1=clx(ip1,icp1)
2012                 icy1=cly(ip1,icp1)                 icy1=cly(ip1,icp1)
2013  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
2014                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
2015                   call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
2016                 xm1=xPAM                 xm1=xPAM
2017                 ym1=yPAM                 ym1=yPAM
2018                 zm1=zPAM                                   zm1=zPAM                  
2019  c     print*,'***',is1,xm1,ym1,zm1  c     print*,'***',is1,xm1,ym1,zm1
2020    
2021                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
2022                      if(  mask_view(nviewx(ip2)).ne.0 .or.
2023         $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
2024                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    do is2=1,2    !loop on sensors -ndblt COPPIA 2
2025                                            
2026                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2
# Line 2391  c     print*,'***',is1,xm1,ym1,zm1 Line 2028  c     print*,'***',is1,xm1,ym1,zm1
2028                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
2029  c                        call xyz_PAM  c                        call xyz_PAM
2030  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
2031    c                        call xyz_PAM
2032    c     $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)
2033                          call xyz_PAM                          call xyz_PAM
2034       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.,0.,0.)
2035                          xm2=xPAM                          xm2=xPAM
2036                          ym2=yPAM                          ym2=yPAM
2037                          zm2=zPAM                          zm2=zPAM
# Line 2402  c     $                       (icx2,icy2 Line 2041  c     $                       (icx2,icy2
2041  *     (2 couples needed)  *     (2 couples needed)
2042  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2043                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
2044                             if(DEBUG)print*,                             if(verbose)print*,
2045       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
2046       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
2047       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
2048  c                           good2=.false.  c                           good2=.false.
2049  c                           goto 880 !fill ntp and go to next event  c                           goto 880 !fill ntp and go to next event
2050                               do iv=1,12
2051    c                              mask_view(iv) = 3
2052                                  mask_view(iv) = mask_view(iv)+ 2**2
2053                               enddo
2054                             iflag=1                             iflag=1
2055                             return                             return
2056                          endif                          endif
# Line 2441  c$$$ Line 2084  c$$$
2084  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2085    
2086    
2087                          if(ip2.eq.nplanes)goto 30 !no possible combination with 3 couples                          if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
2088    
2089                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
2090                               if(  mask_view(nviewx(ip3)).ne.0 .or.
2091         $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
2092                             do is3=1,2 !loop on sensors - COPPIA 3                             do is3=1,2 !loop on sensors - COPPIA 3
2093                                                                
2094                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
# Line 2450  c$$$ Line 2096  c$$$
2096                                   icy3=cly(ip3,icp3)                                   icy3=cly(ip3,icp3)
2097  c                                 call xyz_PAM  c                                 call xyz_PAM
2098  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
2099    c                                 call xyz_PAM
2100    c     $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)
2101                                   call xyz_PAM                                   call xyz_PAM
2102       $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)       $                                (icx3,icy3,is3,PFAdef,PFAdef
2103         $                                ,0.,0.,0.,0.)
2104                                   xm3=xPAM                                   xm3=xPAM
2105                                   ym3=yPAM                                   ym3=yPAM
2106                                   zm3=zPAM                                   zm3=zPAM
# Line 2472  c     $                                 Line 2121  c     $                                
2121  *     (3 couples needed)  *     (3 couples needed)
2122  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2123                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
2124                                      if(DEBUG)print*,                                      if(verbose)print*,
2125       $                     '** warning ** number of identified '//       $                     '** warning ** number of identified '//
2126       $                     'triplets exceeds vector dimention '       $                     'triplets exceeds vector dimention '
2127       $                    ,'( ',ntrpt_max,' )'       $                    ,'( ',ntrpt_max,' )'
2128  c                                    good2=.false.  c                                    good2=.false.
2129  c                                    goto 880 !fill ntp and go to next event  c                                    goto 880 !fill ntp and go to next event
2130                                        do iv=1,nviews
2131    c                                       mask_view(iv) = 4
2132                                           mask_view(iv)=mask_view(iv)+ 2**3
2133                                        enddo
2134                                      iflag=1                                      iflag=1
2135                                      return                                      return
2136                                   endif                                   endif
# Line 2516  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp Line 2169  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp
2169                                endif                                endif
2170                             enddo !end loop on COPPIA 3                             enddo !end loop on COPPIA 3
2171                          enddo   !end loop on sensors - COPPIA 3                          enddo   !end loop on sensors - COPPIA 3
2172     30                     continue
2173                       enddo      !end loop on planes  - COPPIA 3                       enddo      !end loop on planes  - COPPIA 3
2174   30                  continue   31                  continue
2175                                            
2176   1                enddo         !end loop on COPPIA 2   1                enddo         !end loop on COPPIA 2
2177                 enddo            !end loop on sensors - COPPIA 2                 enddo            !end loop on sensors - COPPIA 2
2178     20            continue
2179              enddo               !end loop on planes  - COPPIA 2              enddo               !end loop on planes  - COPPIA 2
2180                            
2181           enddo                  !end loop on COPPIA1           enddo                  !end loop on COPPIA1
2182        enddo                     !end loop on sensors - COPPIA 1        enddo                     !end loop on sensors - COPPIA 1
2183     10   continue
2184        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
2185                
2186        if(DEBUG)then        if(DEBUG)then
# Line 2552  c     goto 880               !ntp fill Line 2208  c     goto 880               !ntp fill
2208        subroutine doub_to_YZcloud(iflag)        subroutine doub_to_YZcloud(iflag)
2209    
2210        include 'commontracker.f'        include 'commontracker.f'
2211          include 'level1.f'
2212        include 'common_momanhough.f'        include 'common_momanhough.f'
2213        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2214    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2215    
2216  *     output flag  *     output flag
2217  *     --------------  *     --------------
# Line 2588  c      common/dbg/DEBUG Line 2243  c      common/dbg/DEBUG
2243        distance=0        distance=0
2244        nclouds_yz=0              !number of clouds        nclouds_yz=0              !number of clouds
2245        npt_tot=0        npt_tot=0
2246          nloop=0                  
2247     90   continue                  
2248        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2249           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
2250                            
# Line 2691  c     print*,'*   idbref,idb2 ',idbref,i Line 2348  c     print*,'*   idbref,idb2 ',idbref,i
2348              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2349           enddo           enddo
2350  c     print*,'>>>> ',ncpused,npt,nplused  c     print*,'>>>> ',ncpused,npt,nplused
2351           if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  c         if(ncpused.lt.ncpyz_min)goto 2228 !next doublet
2352           if(npt.lt.nptyz_min)goto 2228 !next doublet           if(npt.lt.nptyz_min)goto 2228 !next doublet
2353           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2354                    
# Line 2699  c     print*,'>>>> ',ncpused,npt,nplused Line 2356  c     print*,'>>>> ',ncpused,npt,nplused
2356  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2357    
2358           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2359              if(DEBUG)print*,              if(verbose)print*,
2360       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2361       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2362       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2363  c               good2=.false.  c               good2=.false.
2364  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2365                do iv=1,nviews
2366    c               mask_view(iv) = 5
2367                   mask_view(iv) = mask_view(iv) + 2**4
2368                enddo
2369              iflag=1              iflag=1
2370              return              return
2371           endif           endif
# Line 2742  c$$$     $           ,(db_cloud(iii),iii Line 2403  c$$$     $           ,(db_cloud(iii),iii
2403        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2404                
2405                
2406          if(nloop.lt.nstepy)then      
2407            cutdistyz = cutdistyz+cutystep
2408            nloop     = nloop+1          
2409            goto 90                
2410          endif                    
2411          
2412        if(DEBUG)then        if(DEBUG)then
2413           print*,'---------------------- '           print*,'---------------------- '
2414           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
# Line 2768  c$$$     $           ,(db_cloud(iii),iii Line 2435  c$$$     $           ,(db_cloud(iii),iii
2435        subroutine trip_to_XZcloud(iflag)        subroutine trip_to_XZcloud(iflag)
2436    
2437        include 'commontracker.f'        include 'commontracker.f'
2438          include 'level1.f'
2439        include 'common_momanhough.f'        include 'common_momanhough.f'
2440        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2441    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2442    
2443  *     output flag  *     output flag
2444  *     --------------  *     --------------
# Line 2803  c      common/dbg/DEBUG Line 2469  c      common/dbg/DEBUG
2469        distance=0        distance=0
2470        nclouds_xz=0              !number of clouds                nclouds_xz=0              !number of clouds        
2471        npt_tot=0                 !total number of selected triplets        npt_tot=0                 !total number of selected triplets
2472          nloop=0                  
2473     91   continue                  
2474        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2475           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
2476  c     print*,'--------------'  c     print*,'--------------'
# Line 2904  c     print*,'check cp_used' Line 2572  c     print*,'check cp_used'
2572           do ip=1,nplanes           do ip=1,nplanes
2573              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2574           enddo           enddo
2575           if(ncpused.lt.ncpxz_min)goto 22288 !next triplet  c         if(ncpused.lt.ncpxz_min)goto 22288 !next triplet
2576           if(npt.lt.nptxz_min)goto 22288     !next triplet           if(npt.lt.nptxz_min)goto 22288     !next triplet
2577           if(nplused.lt.nplxz_min)goto 22288 !next doublet           if(nplused.lt.nplxz_min)goto 22288 !next triplet
2578                    
2579  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2580  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2581           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2582              if(DEBUG)print*,              if(verbose)print*,
2583       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2584       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2585       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2586  c     good2=.false.  c     good2=.false.
2587  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2588                do iv=1,nviews
2589    c               mask_view(iv) = 6
2590                   mask_view(iv) =  mask_view(iv) + 2**5
2591                enddo
2592              iflag=1              iflag=1
2593              return              return
2594           endif           endif
# Line 2952  c$$$     $           ,(tr_cloud(iii),iii Line 2624  c$$$     $           ,(tr_cloud(iii),iii
2624  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2625  22288    continue  22288    continue
2626        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2627          
2628           if(nloop.lt.nstepx)then      
2629             cutdistxz=cutdistxz+cutxstep
2630             nloop=nloop+1          
2631             goto 91                
2632           endif                    
2633          
2634        if(DEBUG)then        if(DEBUG)then
2635           print*,'---------------------- '           print*,'---------------------- '
2636           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
# Line 2974  c$$$     $           ,(tr_cloud(iii),iii Line 2652  c$$$     $           ,(tr_cloud(iii),iii
2652  **************************************************  **************************************************
2653    
2654        subroutine clouds_to_ctrack(iflag)        subroutine clouds_to_ctrack(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2655    
2656        include 'commontracker.f'        include 'commontracker.f'
2657          include 'level1.f'
2658        include 'common_momanhough.f'        include 'common_momanhough.f'
2659        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2660        include 'common_mini_2.f'        include 'common_mini_2.f'
2661        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
2662    
2663  c      logical DEBUG  
 c      common/dbg/DEBUG  
2664    
2665  *     output flag  *     output flag
2666  *     --------------  *     --------------
# Line 3002  c      common/dbg/DEBUG Line 2676  c      common/dbg/DEBUG
2676  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2677  *     list of matching couples in the combination  *     list of matching couples in the combination
2678  *     between a XZ and YZ cloud  *     between a XZ and YZ cloud
2679        integer cp_match(nplanes,ncouplemax)        integer cp_match(nplanes,2*ncouplemax)
2680        integer ncp_match(nplanes)        integer ncp_match(nplanes)
2681  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2682        integer hit_plane(nplanes)        integer hit_plane(nplanes)
2683  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2684  *     variables for track fitting  *     variables for track fitting
2685        double precision AL_INI(5)        double precision AL_INI(5)
2686        double precision tath  c      double precision tath
2687  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2688  c      real fitz(nplanes)        !z coordinates of the planes in cm  c      real fitz(nplanes)        !z coordinates of the planes in cm
2689    
# Line 3075  c      real fitz(nplanes)        !z coor Line 2749  c      real fitz(nplanes)        !z coor
2749                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2750              enddo              enddo
2751                            
2752              if(nplused.lt.nplxz_min)goto 888 !next doublet  c            if(nplused.lt.nplxz_min)goto 888 !next doublet
2753                if(nplused.lt.nplyz_min)goto 888 !next doublet
2754              if(ncp_ok.lt.ncpok)goto 888 !next cloud              if(ncp_ok.lt.ncpok)goto 888 !next cloud
2755                            
2756              if(DEBUG)then              if(DEBUG)then
# Line 3102  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p Line 2777  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p
2777  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2778                            
2779  *     -------> INITIAL GUESS <-------  *     -------> INITIAL GUESS <-------
2780              AL_INI(1)=dreal(alfaxz1_av(ixz))  cccc       SBAGLIATO
2781              AL_INI(2)=dreal(alfayz1_av(iyz))  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2782              AL_INI(4)=datan(dreal(alfayz2_av(iyz))  c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2783       $           /dreal(alfaxz2_av(ixz)))  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2784              tath=-dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))  c$$$     $           /dreal(alfaxz2_av(ixz)))
2785              AL_INI(3)=tath/sqrt(1+tath**2)  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2786              AL_INI(5)=(1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2787                c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2788  c     print*,'*******',AL_INI(5)  cccc       GIUSTO (ma si sua guess())
2789              if(AL_INI(5).gt.defmax)goto 888 !next cloud  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2790                c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2791  c     print*,'alfaxz2, alfayz2 '  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2792  c     $              ,alfaxz2_av(ixz),alfayz2_av(iyz)  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2793                c$$$            IF(alfaxz2_av(ixz).NE.0)THEN
2794  *     -------> INITIAL GUESS <-------  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2795  c     print*,'AL_INI ',(al_ini(i),i=1,5)  c$$$     $           /dreal(alfaxz2_av(ixz)))
2796                c$$$            ELSE
2797    c$$$               AL_INI(4) = acos(-1.)/2
2798    c$$$               IF(alfayz2_av(iyz).LT.0)AL_INI(4) = AL_INI(4)+acos(-1.)
2799    c$$$            ENDIF
2800    c$$$            IF(alfaxz2_av(ixz).LT.0)AL_INI(4)= acos(-1.)+ AL_INI(4)
2801    c$$$            AL_INI(4) = -acos(-1.) + AL_INI(4) !from incidence direction to tracking rs
2802    c$$$            
2803    c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2804    c$$$            
2805    c$$$            if(AL_INI(5).gt.defmax)goto 888 !next cloud
2806                            
2807              if(DEBUG)then              if(DEBUG)then
2808                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2809                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))
# Line 3169  c     print*,'AL_INI ',(al_ini(i),i=1,5) Line 2854  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2854  *                                   *************************  *                                   *************************
2855  c                                    call xyz_PAM(icx,icy,is,  c                                    call xyz_PAM(icx,icy,is,
2856  c     $                                   'COG2','COG2',0.,0.)  c     $                                   'COG2','COG2',0.,0.)
2857    c                                    call xyz_PAM(icx,icy,is, !(1)
2858    c     $                                   PFAdef,PFAdef,0.,0.) !(1)
2859                                      call xyz_PAM(icx,icy,is, !(1)                                      call xyz_PAM(icx,icy,is, !(1)
2860       $                                   PFAdef,PFAdef,0.,0.) !(1)       $                                   PFAdef,PFAdef,0.,0.,0.,0.)
2861  *                                   *************************  *                                   *************************
2862  *                                   -----------------------------  *                                   -----------------------------
2863                                      xgood(nplanes-ip+1)=1.                                      xgood(nplanes-ip+1)=1.
# Line 3186  c     $                                 Line 2873  c     $                                
2873  *     **********************************************************  *     **********************************************************
2874  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
2875  *     **********************************************************  *     **********************************************************
2876    cccc  scommentare se si usa al_ini della nuvola
2877    c$$$                              do i=1,5
2878    c$$$                                 AL(i)=AL_INI(i)
2879    c$$$                              enddo
2880                                  call guess()
2881                                do i=1,5                                do i=1,5
2882                                   AL(i)=AL_INI(i)                                   AL_INI(i)=AL(i)
2883                                enddo                                enddo
2884                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
2885                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
2886                                call mini_2(jstep,ifail)                                iprint=0
2887    c                              if(DEBUG)iprint=1
2888                                  if(DEBUG)iprint=2
2889                                  call mini2(jstep,ifail,iprint)
2890                                if(ifail.ne.0) then                                if(ifail.ne.0) then
2891                                   if(DEBUG)then                                   if(DEBUG)then
2892                                      print *,                                      print *,
2893       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
2894       $                              //'(mini_2 in clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
2895                                        print*,'initial guess: '
2896    
2897                                        print*,'AL_INI(1) = ',AL_INI(1)
2898                                        print*,'AL_INI(2) = ',AL_INI(2)
2899                                        print*,'AL_INI(3) = ',AL_INI(3)
2900                                        print*,'AL_INI(4) = ',AL_INI(4)
2901                                        print*,'AL_INI(5) = ',AL_INI(5)
2902                                   endif                                   endif
2903                                   chi2=-chi2  c                                 chi2=-chi2
2904                                endif                                endif
2905  *     **********************************************************  *     **********************************************************
2906  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
# Line 3211  c     $                                 Line 2913  c     $                                
2913  *     --------------------------  *     --------------------------
2914                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
2915                                                                    
2916                                   if(DEBUG)print*,                                   if(verbose)print*,
2917       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
2918       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
2919       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
2920  c                                 good2=.false.  c                                 good2=.false.
2921  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
2922                                     do iv=1,nviews
2923    c                                    mask_view(iv) = 7
2924                                        mask_view(iv) = mask_view(iv) + 2**6
2925                                     enddo
2926                                   iflag=1                                   iflag=1
2927                                   return                                   return
2928                                endif                                endif
2929                                                                
2930                                ntracks = ntracks + 1                                ntracks = ntracks + 1
2931                                                                
 c$$$                              ndof=0                                  
2932                                do ip=1,nplanes                                do ip=1,nplanes
2933  c$$$                                 ndof=ndof  
 c$$$     $                                +int(xgood(ip))  
 c$$$     $                                +int(ygood(ip))  
2934                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
2935                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
2936                                   ZV_STORE(ip,ntracks)=sngl(zv(ip))                                                                       ZV_STORE(ip,ntracks)=sngl(zv(ip))                                    
# Line 3246  c$$$     $                               Line 2949  c$$$     $                              
2949                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2950                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
2951       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
2952                                        SENSOR_STORE(nplanes-ip+1,ntracks)
2953         $                              = is_cp(cp_match(ip,hit_plane(ip)))
2954                                        LADDER_STORE(nplanes-ip+1,ntracks)
2955         $                                   = LADDER(
2956         $                                   clx(ip,icp_cp(
2957         $                                   cp_match(ip,hit_plane(ip)
2958         $                                   ))));
2959                                   else                                   else
2960                                      CP_STORE(nplanes-ip+1,ntracks)=0                                      CP_STORE(nplanes-ip+1,ntracks)=0
2961                                        SENSOR_STORE(nplanes-ip+1,ntracks)=0
2962                                        LADDER_STORE(nplanes-ip+1,ntracks)=0
2963                                   endif                                   endif
2964                                     BX_STORE(nplanes-ip+1,ntracks)=0!I dont need it now
2965                                     BY_STORE(nplanes-ip+1,ntracks)=0!I dont need it now
2966                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   CLS_STORE(nplanes-ip+1,ntracks)=0
2967                                   do i=1,5                                   do i=1,5
2968                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
2969                                   enddo                                   enddo
2970                                enddo                                enddo
2971                                                                
 c$$$  *                             Number of Degree Of Freedom  
 c$$$  ndof=ndof-5                            
 c$$$  *                             reduced chi^2  
 c$$$  rchi2=chi2/dble(ndof)  
2972                                RCHI2_STORE(ntracks)=chi2                                RCHI2_STORE(ntracks)=chi2
2973                                                                
2974  *     --------------------------------  *     --------------------------------
# Line 3282  c$$$  rchi2=chi2/dble(ndof) Line 2992  c$$$  rchi2=chi2/dble(ndof)
2992           return           return
2993        endif        endif
2994                
2995    c$$$      if(DEBUG)then
2996    c$$$         print*,'****** TRACK CANDIDATES ***********'
2997    c$$$         print*,'#         R. chi2        RIG'
2998    c$$$         do i=1,ntracks
2999    c$$$            print*,i,' --- ',rchi2_store(i),' --- '
3000    c$$$     $           ,1./abs(AL_STORE(5,i))
3001    c$$$         enddo
3002    c$$$         print*,'***********************************'
3003    c$$$      endif
3004        if(DEBUG)then        if(DEBUG)then
3005           print*,'****** TRACK CANDIDATES ***********'          print*,'****** TRACK CANDIDATES *****************'
3006           print*,'#         R. chi2        RIG'          print*,'#         R. chi2        RIG         ndof'
3007           do i=1,ntracks          do i=1,ntracks
3008              print*,i,' --- ',rchi2_store(i),' --- '            ndof=0                !(1)
3009       $           ,1./abs(AL_STORE(5,i))            do ii=1,nplanes       !(1)
3010           enddo              ndof=ndof           !(1)
3011           print*,'***********************************'       $           +int(xgood_store(ii,i)) !(1)
3012         $           +int(ygood_store(ii,i)) !(1)
3013              enddo                 !(1)
3014              print*,i,' --- ',rchi2_store(i),' --- '
3015         $         ,1./abs(AL_STORE(5,i)),' --- ',ndof
3016            enddo
3017            print*,'*****************************************'
3018        endif        endif
3019                
3020                
# Line 3308  c$$$  rchi2=chi2/dble(ndof) Line 3033  c$$$  rchi2=chi2/dble(ndof)
3033    
3034        subroutine refine_track(ibest)        subroutine refine_track(ibest)
3035    
 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******************************************************  
3036    
3037        include 'commontracker.f'        include 'commontracker.f'
3038          include 'level1.f'
3039        include 'common_momanhough.f'        include 'common_momanhough.f'
3040        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3041        include 'common_mini_2.f'        include 'common_mini_2.f'
3042        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
       include 'level1.f'  
3043        include 'calib.f'        include 'calib.f'
3044    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
3045  *     flag to chose PFA  *     flag to chose PFA
3046        character*10 PFA        character*10 PFA
3047        common/FINALPFA/PFA        common/FINALPFA/PFA
3048    
3049          real k(6)
3050          DATA k/1.099730,0.418900,0.220939,0.220907,0.418771,1.100674/
3051    
3052          real xp,yp,zp
3053          real xyzp(3),bxyz(3)
3054          equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
3055    
3056  *     =================================================  *     =================================================
3057  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
3058  *                          and  *                          and
# Line 3338  c      common/dbg/DEBUG Line 3061  c      common/dbg/DEBUG
3061        call track_init        call track_init
3062        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3063    
3064             xP=XV_STORE(nplanes-ip+1,ibest)
3065             yP=YV_STORE(nplanes-ip+1,ibest)
3066             zP=ZV_STORE(nplanes-ip+1,ibest)
3067             call gufld(xyzp,bxyz)
3068             BX_STORE(nplanes-ip+1,ibest)=bxyz(1)
3069             BY_STORE(nplanes-ip+1,ibest)=bxyz(2)
3070    c$$$  bxyz(1)=0
3071    c$$$         bxyz(2)=0
3072    c$$$         bxyz(3)=0
3073    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3074  *     -------------------------------------------------  *     -------------------------------------------------
3075  *     If the plane has been already included, it just  *     If the plane has been already included, it just
3076  *     computes again the coordinates of the x-y couple  *     computes again the coordinates of the x-y couple
3077  *     using improved PFAs  *     using improved PFAs
3078  *     -------------------------------------------------  *     -------------------------------------------------
3079    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3080           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
3081       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
3082                            
# Line 3356  c      common/dbg/DEBUG Line 3090  c      common/dbg/DEBUG
3090       $           ,ip_cp(id),ip       $           ,ip_cp(id),ip
3091              icx=clx(ip,icp)              icx=clx(ip,icp)
3092              icy=cly(ip,icp)              icy=cly(ip,icp)
3093    c            call xyz_PAM(icx,icy,is,
3094    c     $           PFA,PFA,
3095    c     $           AXV_STORE(nplanes-ip+1,ibest),
3096    c     $           AYV_STORE(nplanes-ip+1,ibest))
3097              call xyz_PAM(icx,icy,is,              call xyz_PAM(icx,icy,is,
 c     $           'ETA2','ETA2',  
3098       $           PFA,PFA,       $           PFA,PFA,
3099       $           AXV_STORE(nplanes-ip+1,ibest),       $           AXV_STORE(nplanes-ip+1,ibest),
3100       $           AYV_STORE(nplanes-ip+1,ibest))       $           AYV_STORE(nplanes-ip+1,ibest),
3101  c$$$  call xyz_PAM(icx,icy,is,       $           bxyz(1),
3102  c$$$  $              'COG2','COG2',       $           bxyz(2)
3103  c$$$  $              0.,       $           )
3104  c$$$  $              0.)  
3105              xm(nplanes-ip+1) = xPAM              xm(nplanes-ip+1) = xPAM
3106              ym(nplanes-ip+1) = yPAM              ym(nplanes-ip+1) = yPAM
3107              zm(nplanes-ip+1) = zPAM              zm(nplanes-ip+1) = zPAM
# Line 3373  c$$$  $              0.) Line 3110  c$$$  $              0.)
3110              resx(nplanes-ip+1) = resxPAM              resx(nplanes-ip+1) = resxPAM
3111              resy(nplanes-ip+1) = resyPAM              resy(nplanes-ip+1) = resyPAM
3112    
3113  c            dedxtrk(nplanes-ip+1) = (dedx(icx)+dedx(icy))/2. !(1)              dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3114              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)  
3115                            
3116    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3117  *     -------------------------------------------------  *     -------------------------------------------------
3118  *     If the plane has NOT  been already included,  *     If the plane has NOT  been already included,
3119  *     it tries to include a COUPLE or a single cluster  *     it tries to include a COUPLE or a single cluster
3120  *     -------------------------------------------------  *     -------------------------------------------------
3121    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3122           else                             else                  
3123                                
3124              xgood(nplanes-ip+1)=0              xgood(nplanes-ip+1)=0
# Line 3388  c            dedxtrk(nplanes-ip+1) = (de Line 3126  c            dedxtrk(nplanes-ip+1) = (de
3126                                
3127  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3128  *     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)  
3129              call whichsensor(ip,xP,yP,nldt,ist)              call whichsensor(ip,xP,yP,nldt,ist)
3130  *     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
3131              if(nldt.eq.0.or.ist.eq.0)goto 133              if(nldt.eq.0.or.ist.eq.0)goto 133
3132    
3133                SENSOR_STORE(nplanes-ip+1,IBEST)=ist
3134                LADDER_STORE(nplanes-ip+1,IBEST)=nldt
3135  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3136    
3137              if(DEBUG)then              if(DEBUG)then
# Line 3430  c     $              cl_used(icy).eq.1.o Line 3168  c     $              cl_used(icy).eq.1.o
3168  *            *          
3169                 call xyz_PAM(icx,icy,ist,                 call xyz_PAM(icx,icy,ist,
3170       $              PFA,PFA,       $              PFA,PFA,
 c     $              'ETA2','ETA2',  
3171       $              AXV_STORE(nplanes-ip+1,ibest),       $              AXV_STORE(nplanes-ip+1,ibest),
3172       $              AYV_STORE(nplanes-ip+1,ibest))       $              AYV_STORE(nplanes-ip+1,ibest),
3173         $              bxyz(1),
3174         $              bxyz(2)
3175         $              )
3176                                
3177                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3178    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3179                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3180                 if(DEBUG)print*,'( couple ',id                 if(DEBUG)print*,'( couple ',id
3181       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance
3182                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3183                    xmm = xPAM                    xmm = xPAM
3184                    ymm = yPAM                    ymm = yPAM
# Line 3446  c     $              'ETA2','ETA2', Line 3187  c     $              'ETA2','ETA2',
3187                    rymm = resyPAM                    rymm = resyPAM
3188                    distmin = distance                    distmin = distance
3189                    idm = id                                      idm = id                  
3190  c                 dedxmm = (dedx(icx)+dedx(icy))/2. !(1)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3191                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3192                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)  c     QUIQUI --> non devo moltiplicare per clinc?!?!?!
3193                      clincnewc=10*sqrt(rymm**2+rxmm**2 !QUIQUI
3194         $                 +RCHI2_STORE(ibest)*k(ip)*(cov(1,1)+cov(2,2))) !QUIQUI
3195                 endif                 endif
3196   1188          continue   1188          continue
3197              enddo               !end loop on couples on plane icp              enddo               !end loop on couples on plane icp
3198              if(distmin.le.clinc)then                    c            if(distmin.le.clinc)then     !QUIQUI              
3199                if(distmin.le.clincnewc)then     !QUIQUI              
3200  *              -----------------------------------  *              -----------------------------------
3201                 xm(nplanes-ip+1) = xmm         !<<<                 xm(nplanes-ip+1) = xmm !<<<
3202                 ym(nplanes-ip+1) = ymm         !<<<                 ym(nplanes-ip+1) = ymm !<<<
3203                 zm(nplanes-ip+1) = zmm         !<<<                 zm(nplanes-ip+1) = zmm !<<<
3204                 xgood(nplanes-ip+1) = 1        !<<<                 xgood(nplanes-ip+1) = 1 !<<<
3205                 ygood(nplanes-ip+1) = 1        !<<<                 ygood(nplanes-ip+1) = 1 !<<<
3206                 resx(nplanes-ip+1)=rxmm        !<<<                 resx(nplanes-ip+1)=rxmm !<<<
3207                 resy(nplanes-ip+1)=rymm        !<<<                 resy(nplanes-ip+1)=rymm !<<<
3208  c              dedxtrk(nplanes-ip+1) = dedxmm !<<<  !(1)                 dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3209                 dedxtrk_x(nplanes-ip+1) = dedxmmx    !(1)                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
                dedxtrk_y(nplanes-ip+1) = dedxmmy    !(1)  
3210  *              -----------------------------------  *              -----------------------------------
3211                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
3212                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG)print*,'%%%% included couple ',idm
3213       $              ,' (norm.dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clinc,' )'
3214                 goto 133         !next plane                 goto 133         !next plane
3215              endif              endif
3216  *     ================================================  *     ================================================
# Line 3500  c            if(DEBUG)print*,'>>>> try t Line 3243  c            if(DEBUG)print*,'>>>> try t
3243  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
3244                 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)
3245  *                                              !jump to the Y cluster  *                                              !jump to the Y cluster
3246    c               call xyz_PAM(icx,0,ist,
3247    c     $              PFA,PFA,
3248    c     $              AXV_STORE(nplanes-ip+1,ibest),0.)              
3249                 call xyz_PAM(icx,0,ist,                 call xyz_PAM(icx,0,ist,
 c     $              'ETA2','ETA2',  
3250       $              PFA,PFA,       $              PFA,PFA,
3251       $              AXV_STORE(nplanes-ip+1,ibest),0.)                     $              AXV_STORE(nplanes-ip+1,ibest),0.,
3252         $              bxyz(1),
3253         $              bxyz(2)
3254         $              )              
3255                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3256  c     if(DEBUG)print*,'normalized distance ',distance  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3257                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG)print*,'( cl-X ',icx
3258       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3259                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3260                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3261                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3519  c     if(DEBUG)print*,'normalized distan Line 3267  c     if(DEBUG)print*,'normalized distan
3267                    rymm = resyPAM                    rymm = resyPAM
3268                    distmin = distance                    distmin = distance
3269                    iclm = icx                    iclm = icx
3270  c                  dedxmm = dedx(icx) !(1)  c                  dedxmm = sgnl(icx) !(1)
3271                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3272                    dedxmmy = 0.        !(1)                    dedxmmy = 0.        !(1)
3273                 endif                                   endif                  
3274  11881          continue  11881          continue
# Line 3528  c                  dedxmm = dedx(icx) !( Line 3276  c                  dedxmm = dedx(icx) !(
3276  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
3277                 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)
3278  *                                              !jump to the next couple  *                                              !jump to the next couple
3279    c               call xyz_PAM(0,icy,ist,
3280    c     $              PFA,PFA,
3281    c     $              0.,AYV_STORE(nplanes-ip+1,ibest))
3282                 call xyz_PAM(0,icy,ist,                 call xyz_PAM(0,icy,ist,
 c     $              'ETA2','ETA2',  
3283       $              PFA,PFA,       $              PFA,PFA,
3284       $              0.,AYV_STORE(nplanes-ip+1,ibest))       $              0.,AYV_STORE(nplanes-ip+1,ibest),
3285         $              bxyz(1),
3286         $              bxyz(2)
3287         $              )
3288                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3289    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3290                 if(DEBUG)print*,'( cl-Y ',icy                 if(DEBUG)print*,'( cl-Y ',icy
3291       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3292                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3293                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3294                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3546  c     $              'ETA2','ETA2', Line 3300  c     $              'ETA2','ETA2',
3300                    rymm = resyPAM                    rymm = resyPAM
3301                    distmin = distance                    distmin = distance
3302                    iclm = icy                    iclm = icy
3303  c                 dedxmm = dedx(icy)  !(1)  c                 dedxmm = sgnl(icy)  !(1)
3304                    dedxmmx = 0.        !(1)                    dedxmmx = 0.        !(1)
3305                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3306                 endif                                   endif                  
3307  11882          continue  11882          continue
3308              enddo               !end loop on cluster inside couples              enddo               !end loop on cluster inside couples
3309  *----- single clusters -----------------------------------------------      *----- single clusters -----------------------------------------------  
3310    c            print*,'## ncls(',ip,') ',ncls(ip)
3311              do ic=1,ncls(ip)    !loop on single clusters              do ic=1,ncls(ip)    !loop on single clusters
3312                 icl=cls(ip,ic)                 icl=cls(ip,ic)
3313  c               if(cl_used(icl).eq.1.or.     !if the cluster is already used  c               if(cl_used(icl).eq.1.or.     !if the cluster is already used
# Line 3561  c               if(cl_used(icl).eq.1.or. Line 3316  c               if(cl_used(icl).eq.1.or.
3316       $              .false.)goto 18882      !jump to the next singlet       $              .false.)goto 18882      !jump to the next singlet
3317                 if(mod(VIEW(icl),2).eq.0)then!<---- X view                 if(mod(VIEW(icl),2).eq.0)then!<---- X view
3318                    call xyz_PAM(icl,0,ist,                    call xyz_PAM(icl,0,ist,
 c     $                 'ETA2','ETA2',  
3319       $                 PFA,PFA,       $                 PFA,PFA,
3320       $                 AXV_STORE(nplanes-ip+1,ibest),0.)       $                 AXV_STORE(nplanes-ip+1,ibest),0.,
3321         $                 bxyz(1),
3322         $                 bxyz(2)
3323         $                 )
3324                 else                         !<---- Y view                 else                         !<---- Y view
3325                    call xyz_PAM(0,icl,ist,                    call xyz_PAM(0,icl,ist,
 c     $                 'ETA2','ETA2',  
3326       $                 PFA,PFA,       $                 PFA,PFA,
3327       $                 0.,AYV_STORE(nplanes-ip+1,ibest))       $                 0.,AYV_STORE(nplanes-ip+1,ibest),
3328         $                 bxyz(1),
3329         $                 bxyz(2)
3330         $                 )
3331                 endif                 endif
3332    
3333                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3334    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3335                 if(DEBUG)print*,'( cl-s ',icl                 if(DEBUG)print*,'( cl-s ',icl
3336       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance,'<',distmin,' ?'
3337                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3338                      if(DEBUG)print*,'YES'
3339                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3340                    ymm_A = yPAM_A                    ymm_A = yPAM_A
3341                    zmm_A = zPAM_A                    zmm_A = zPAM_A
# Line 3585  c     $                 'ETA2','ETA2', Line 3346  c     $                 'ETA2','ETA2',
3346                    rymm = resyPAM                    rymm = resyPAM
3347                    distmin = distance                      distmin = distance  
3348                    iclm = icl                    iclm = icl
 c                  dedxmm = dedx(icl)                   !(1)  
3349                    if(mod(VIEW(icl),2).eq.0)then !<---- X view                    if(mod(VIEW(icl),2).eq.0)then !<---- X view
3350                       dedxmmx = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3351                       dedxmmy = 0.                       !(1)                       dedxmmy = 0.                  
3352                    else          !<---- Y view                    else          !<---- Y view
3353                       dedxmmx = 0.                       !(1)                       dedxmmx = 0.                  
3354                       dedxmmy = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3355                    endif                    endif
3356                 endif                                   endif                  
3357  18882          continue  18882          continue
3358              enddo               !end loop on single clusters              enddo               !end loop on single clusters
3359    c            print*,'## distmin ', distmin,' clinc ',clinc
3360    
3361              if(distmin.le.clinc)then                    c     QUIQUI------------
3362                  c     anche qui: non ci vuole clinc???
3363                 CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<                  if(iclm.ne.0)then
 *              ----------------------------  
3364                 if(mod(VIEW(iclm),2).eq.0)then                 if(mod(VIEW(iclm),2).eq.0)then
3365                    XGOOD(nplanes-ip+1)=1.                    clincnew=
3366                    resx(nplanes-ip+1)=rxmm       $                 20*
3367                    if(DEBUG)print*,'%%%% included X-cl ',iclm       $                 sqrt(rxmm**2+RCHI2_STORE(ibest)*k(ip)*cov(1,1))
3368       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'                 else if(mod(VIEW(iclm),2).ne.0)then
3369                 else                    clincnew=
3370                    YGOOD(nplanes-ip+1)=1.       $                 10*
3371                    resy(nplanes-ip+1)=rymm       $                 sqrt(rymm**2+RCHI2_STORE(ibest)*k(ip)*cov(2,2))
3372                    if(DEBUG)print*,'%%%% included Y-cl ',iclm                 endif
3373       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'  c     QUIQUI------------
3374                  
3375                   if(distmin.le.clincnew)then   !QUIQUI
3376    c     if(distmin.le.clinc)then          !QUIQUI          
3377                      
3378                      CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<    
3379    *     ----------------------------
3380    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3381                      if(mod(VIEW(iclm),2).eq.0)then
3382                         XGOOD(nplanes-ip+1)=1.
3383                         resx(nplanes-ip+1)=rxmm
3384                         if(DEBUG)print*,'%%%% included X-cl ',iclm
3385         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3386         $                    ,', dist.= ',distmin
3387         $                    ,', cut ',clinc,' )'
3388                      else
3389                         YGOOD(nplanes-ip+1)=1.
3390                         resy(nplanes-ip+1)=rymm
3391                         if(DEBUG)print*,'%%%% included Y-cl ',iclm
3392         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3393         $                    ,', dist.= ', distmin
3394         $                    ,', cut ',clinc,' )'
3395                      endif
3396    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3397    *     ----------------------------
3398                      xm_A(nplanes-ip+1) = xmm_A
3399                      ym_A(nplanes-ip+1) = ymm_A
3400                      xm_B(nplanes-ip+1) = xmm_B
3401                      ym_B(nplanes-ip+1) = ymm_B
3402                      zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3403                      dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3404                      dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3405    *     ----------------------------
3406                 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)  
 *              ----------------------------  
3407              endif              endif
3408           endif           endif
3409   133     continue   133     continue
# Line 3640  c              dedxtrk(nplanes-ip+1) = d Line 3422  c              dedxtrk(nplanes-ip+1) = d
3422  *                                                 *  *                                                 *
3423  *                                                 *  *                                                 *
3424  **************************************************  **************************************************
 cccccc 12/08/2006 modified by elena ---> (1)  
3425  *  *
3426        subroutine clean_XYclouds(ibest,iflag)        subroutine clean_XYclouds(ibest,iflag)
3427    
3428        include 'commontracker.f'        include 'commontracker.f'
3429          include 'level1.f'
3430        include 'common_momanhough.f'        include 'common_momanhough.f'
3431        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  
   
3432    
3433        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3434    
# Line 3663  c      common/dbg/DEBUG Line 3438  c      common/dbg/DEBUG
3438              if(id.ne.0)then              if(id.ne.0)then
3439                 iclx=clx(ip,icp_cp(id))                 iclx=clx(ip,icp_cp(id))
3440                 icly=cly(ip,icp_cp(id))                 icly=cly(ip,icp_cp(id))
3441  c               cl_used(iclx)=1  !tag used clusters                 cl_used(iclx)=ntrk  !tag used clusters
3442  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)  
3443              elseif(icl.ne.0)then              elseif(icl.ne.0)then
3444  c               cl_used(icl)=1   !tag used clusters                 cl_used(icl)=ntrk   !tag used clusters
                cl_used(icl)=ntrk   !tag used clusters !1)  
3445              endif              endif
3446                            
 c               if(DEBUG)then  
 c                  print*,ip,' <<< ',id  
 c               endif  
3447  *     -----------------------------  *     -----------------------------
3448  *     remove the couple from clouds  *     remove the couple from clouds
3449  *     remove also vitual couples containing the  *     remove also vitual couples containing the
# Line 3725  c               endif Line 3494  c               endif
3494    
3495    
3496    
 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$$$  
   
3497    
3498    
3499  *     ****************************************************  *     ****************************************************
3500    
3501        subroutine init_level2        subroutine init_level2
3502    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c*****************************************************  
   
3503        include 'commontracker.f'        include 'commontracker.f'
3504          include 'level1.f'
3505        include 'common_momanhough.f'        include 'common_momanhough.f'
3506        include 'level2.f'        include 'level2.f'
       include 'level1.f'  
3507    
3508    *     ---------------------------------
3509    *     variables initialized from level1
3510    *     ---------------------------------
3511        do i=1,nviews        do i=1,nviews
3512           good2(i)=good1(i)           good2(i)=good1(i)
3513             do j=1,nva1_view
3514                vkflag(i,j)=1
3515                if(cnnev(i,j).le.0)then
3516                   vkflag(i,j)=cnnev(i,j)
3517                endif
3518             enddo
3519        enddo        enddo
3520    *     ----------------
3521  c      good2 = 0!.false.  *     level2 variables
3522  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*****************************************************  
   
3523        NTRK = 0        NTRK = 0
3524        do it=1,NTRKMAX!NTRACKSMAX        do it=1,NTRKMAX
3525           IMAGE(IT)=0           IMAGE(IT)=0
3526           CHI2_nt(IT) = -100000.           CHI2_nt(IT) = -100000.
 c         BdL(IT) = 0.  
3527           do ip=1,nplanes           do ip=1,nplanes
3528              XM_nt(IP,IT) = 0              XM_nt(IP,IT) = 0
3529              YM_nt(IP,IT) = 0              YM_nt(IP,IT) = 0
3530              ZM_nt(IP,IT) = 0              ZM_nt(IP,IT) = 0
3531              RESX_nt(IP,IT) = 0              RESX_nt(IP,IT) = 0
3532              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3533                TAILX_nt(IP,IT) = 0
3534                TAILY_nt(IP,IT) = 0
3535                XBAD(IP,IT) = 0
3536                YBAD(IP,IT) = 0
3537              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3538              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
3539  c*****************************************************              LS(IP,IT) = 0
 cccccc 11/9/2005 modified by david fedele  
3540              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3541              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
 c******************************************************  
 cccccc 17/8/2006 modified by elena  
3542              CLTRX(IP,IT) = 0              CLTRX(IP,IT) = 0
3543              CLTRY(IP,IT) = 0              CLTRY(IP,IT) = 0
3544           enddo           enddo
# Line 3893  cccccc 17/8/2006 modified by elena Line 3549  cccccc 17/8/2006 modified by elena
3549              enddo                                enddo                  
3550           enddo                             enddo                  
3551        enddo        enddo
         
         
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3552        nclsx=0        nclsx=0
3553        nclsy=0              nclsy=0      
3554        do ip=1,NSINGMAX        do ip=1,NSINGMAX
3555          planex(ip)=0          planex(ip)=0
 c        xs(ip)=0  
3556          xs(1,ip)=0          xs(1,ip)=0
3557          xs(2,ip)=0          xs(2,ip)=0
3558          sgnlxs(ip)=0          sgnlxs(ip)=0
3559          planey(ip)=0          planey(ip)=0
 c        ys(ip)=0  
3560          ys(1,ip)=0          ys(1,ip)=0
3561          ys(2,ip)=0          ys(2,ip)=0
3562          sgnlys(ip)=0          sgnlys(ip)=0
3563        enddo        enddo
 c*******************************************************  
3564        end        end
3565    
3566    
# Line 3926  c*************************************** Line 3575  c***************************************
3575  ************************************************************  ************************************************************
3576    
3577    
3578          subroutine init_hough
3579    
3580          include 'commontracker.f'
3581          include 'level1.f'
3582          include 'common_momanhough.f'
3583          include 'common_hough.f'
3584          include 'level2.f'
3585    
3586          ntrpt_nt=0
3587          ndblt_nt=0
3588          NCLOUDS_XZ_nt=0
3589          NCLOUDS_YZ_nt=0
3590          do idb=1,ndblt_max_nt
3591             db_cloud_nt(idb)=0
3592             alfayz1_nt(idb)=0      
3593             alfayz2_nt(idb)=0      
3594          enddo
3595          do itr=1,ntrpt_max_nt
3596             tr_cloud_nt(itr)=0
3597             alfaxz1_nt(itr)=0      
3598             alfaxz2_nt(itr)=0      
3599             alfaxz3_nt(itr)=0      
3600          enddo
3601          do idb=1,ncloyz_max      
3602            ptcloud_yz_nt(idb)=0    
3603            alfayz1_av_nt(idb)=0    
3604            alfayz2_av_nt(idb)=0    
3605          enddo                    
3606          do itr=1,ncloxz_max      
3607            ptcloud_xz_nt(itr)=0    
3608            alfaxz1_av_nt(itr)=0    
3609            alfaxz2_av_nt(itr)=0    
3610            alfaxz3_av_nt(itr)=0    
3611          enddo                    
3612    
3613          ntrpt=0                  
3614          ndblt=0                  
3615          NCLOUDS_XZ=0              
3616          NCLOUDS_YZ=0              
3617          do idb=1,ndblt_max        
3618            db_cloud(idb)=0        
3619            cpyz1(idb)=0            
3620            cpyz2(idb)=0            
3621            alfayz1(idb)=0          
3622            alfayz2(idb)=0          
3623          enddo                    
3624          do itr=1,ntrpt_max        
3625            tr_cloud(itr)=0        
3626            cpxz1(itr)=0            
3627            cpxz2(itr)=0            
3628            cpxz3(itr)=0            
3629            alfaxz1(itr)=0          
3630            alfaxz2(itr)=0          
3631            alfaxz3(itr)=0          
3632          enddo                    
3633          do idb=1,ncloyz_max      
3634            ptcloud_yz(idb)=0      
3635            alfayz1_av(idb)=0      
3636            alfayz2_av(idb)=0      
3637            do idbb=1,ncouplemaxtot
3638              cpcloud_yz(idb,idbb)=0
3639            enddo                  
3640          enddo                    
3641          do itr=1,ncloxz_max      
3642            ptcloud_xz(itr)=0      
3643            alfaxz1_av(itr)=0      
3644            alfaxz2_av(itr)=0      
3645            alfaxz3_av(itr)=0      
3646            do itrr=1,ncouplemaxtot
3647              cpcloud_xz(itr,itrr)=0
3648            enddo                  
3649          enddo                    
3650          end
3651    ************************************************************
3652    *
3653    *
3654    *
3655    *
3656    *
3657    *
3658    *
3659    ************************************************************
3660    
3661    
3662        subroutine fill_level2_tracks(ntr)        subroutine fill_level2_tracks(ntr)
3663    
3664  *     -------------------------------------------------------  *     -------------------------------------------------------
# Line 3937  c*************************************** Line 3670  c***************************************
3670            
3671        include 'commontracker.f'        include 'commontracker.f'
3672        include 'level1.f'        include 'level1.f'
3673          include 'common_momanhough.f'
3674        include 'level2.f'        include 'level2.f'
3675        include 'common_mini_2.f'        include 'common_mini_2.f'
3676        include 'common_momanhough.f'        include 'calib.f'
3677        real sinth,phi,pig        !(4)  
3678          character*10 PFA
3679          common/FINALPFA/PFA
3680    
3681          real sinth,phi,pig
3682          integer ssensor,sladder
3683        pig=acos(-1.)        pig=acos(-1.)
3684    
3685  c      good2=1!.true.  *     -------------------------------------
3686        chi2_nt(ntr)        = sngl(chi2)        chi2_nt(ntr)        = sngl(chi2)
3687        nstep_nt(ntr)       = 0!nstep        nstep_nt(ntr)       = nstep
3688    *     -------------------------------------
3689        phi   = al(4)             !(4)        phi   = al(4)          
3690        sinth = al(3)             !(4)        sinth = al(3)            
3691        if(sinth.lt.0)then        !(4)        if(sinth.lt.0)then      
3692           sinth = -sinth         !(4)           sinth = -sinth        
3693           phi = phi + pig        !(4)           phi = phi + pig      
3694        endif                     !(4)        endif                    
3695        npig = aint(phi/(2*pig))  !(4)        npig = aint(phi/(2*pig))
3696        phi = phi - npig*2*pig    !(4)        phi = phi - npig*2*pig  
3697        if(phi.lt.0)              !(4)        if(phi.lt.0)            
3698       $     phi = phi + 2*pig    !(4)       $     phi = phi + 2*pig  
3699        al(4) = phi               !(4)        al(4) = phi              
3700        al(3) = sinth             !(4)        al(3) = sinth            
 *****************************************************  
3701        do i=1,5        do i=1,5
3702           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3703           do j=1,5           do j=1,5
3704              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3705           enddo           enddo
 c     print*,al_nt(i,ntr)  
3706        enddo        enddo
3707          *     -------------------------------------      
3708        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
3709           xgood_nt(ip,ntr) = int(xgood(ip))           xgood_nt(ip,ntr) = int(xgood(ip))
3710           ygood_nt(ip,ntr) = int(ygood(ip))           ygood_nt(ip,ntr) = int(ygood(ip))
# Line 3976  c     print*,al_nt(i,ntr) Line 3713  c     print*,al_nt(i,ntr)
3713           zm_nt(ip,ntr)    = sngl(zm(ip))           zm_nt(ip,ntr)    = sngl(zm(ip))
3714           RESX_nt(IP,ntr)  = sngl(resx(ip))           RESX_nt(IP,ntr)  = sngl(resx(ip))
3715           RESY_nt(IP,ntr)  = sngl(resy(ip))           RESY_nt(IP,ntr)  = sngl(resy(ip))
3716             TAILX_nt(IP,ntr) = 0.
3717             TAILY_nt(IP,ntr) = 0.
3718           xv_nt(ip,ntr)    = sngl(xv(ip))           xv_nt(ip,ntr)    = sngl(xv(ip))
3719           yv_nt(ip,ntr)    = sngl(yv(ip))           yv_nt(ip,ntr)    = sngl(yv(ip))
3720           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3721           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3722           ayv_nt(ip,ntr)   = sngl(ayv(ip))           ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3723  c        dedxp(ip,ntr)    = sngl(dedxtrk(ip))   !(1)  c     l'avevo dimenticato!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3724           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)           factor = sqrt(
3725           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)         $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3726         $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3727         $        1. )
3728    c     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3729             dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3730             dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3731        
3732           id  = CP_STORE(ip,IDCAND)           ax   = axv_nt(ip,ntr)
3733             ay   = ayv_nt(ip,ntr)
3734             bfx  = BX_STORE(ip,IDCAND)
3735             bfy  = BY_STORE(ip,IDCAND)
3736             if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3737             if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3738             tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3739             angx     = 180.*atan(tgtemp)/acos(-1.)
3740             tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3741             angy    = 180.*atan(tgtemp)/acos(-1.)
3742            
3743    c         print*,'* ',ip,bfx,bfy,angx,angy
3744    
3745             id  = CP_STORE(ip,IDCAND) ! couple id
3746           icl = CLS_STORE(ip,IDCAND)           icl = CLS_STORE(ip,IDCAND)
3747             ssensor = -1
3748             sladder = -1
3749             ssensor = SENSOR_STORE(ip,IDCAND)
3750             sladder = LADDER_STORE(ip,IDCAND)
3751             if(ip.eq.6.and.ssensor.ne.0)ssensor = 3 - ssensor !notazione paolo x align
3752             LS(IP,ntr)      = ssensor+10*sladder
3753    
3754           if(id.ne.0)then           if(id.ne.0)then
3755    c           >>> is a couple
3756              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3757              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3758  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)              
3759    c$$$            nnnnx = npfastrips(clx(nplanes-ip+1,icp_cp(id)),PFA,angx)
3760    c$$$            nnnny = npfastrips(cly(nplanes-ip+1,icp_cp(id)),PFA,angy)            
3761    c$$$            xbad(ip,ntr)= nbadstrips(nnnnx,clx(nplanes-ip+1,icp_cp(id)))
3762    c$$$            ybad(ip,ntr)= nbadstrips(nnnny,cly(nplanes-ip+1,icp_cp(id)))
3763                xbad(ip,ntr)= nbadstrips(4,clx(nplanes-ip+1,icp_cp(id)))
3764                ybad(ip,ntr)= nbadstrips(4,cly(nplanes-ip+1,icp_cp(id)))
3765    
3766    
3767                if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3768         $           dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3769                if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3770         $           dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3771    
3772           elseif(icl.ne.0)then           elseif(icl.ne.0)then
3773              if(mod(VIEW(icl),2).eq.0)cltrx(ip,ntr)=icl  
3774              if(mod(VIEW(icl),2).eq.1)cltry(ip,ntr)=icl              if(mod(VIEW(icl),2).eq.0)then
3775  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)                 cltrx(ip,ntr)=icl
3776    c$$$               nnnnn = npfastrips(icl,PFA,angx)
3777    c$$$               xbad(ip,ntr) = nbadstrips(nnnnn,icl)
3778                   xbad(ip,ntr) = nbadstrips(4,icl)
3779    
3780                   if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3781                elseif(mod(VIEW(icl),2).eq.1)then
3782                   cltry(ip,ntr)=icl
3783    c$$$               nnnnn = npfastrips(icl,PFA,angy)
3784    c$$$               ybad(ip,ntr) = nbadstrips(nnnnn,icl)
3785                   ybad(ip,ntr) = nbadstrips(4,icl)
3786                   if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3787                endif
3788    
3789           endif                     endif          
3790    
3791        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)  
3792    
3793    
3794    c$$$      print*,(xgood(i),i=1,6)
3795    c$$$      print*,(ygood(i),i=1,6)
3796    c$$$      print*,(ls(i,ntr),i=1,6)
3797    c$$$      print*,(dedx_x(i,ntr),i=1,6)
3798    c$$$      print*,(dedx_y(i,ntr),i=1,6)
3799    c$$$      print*,'-----------------------'
3800    
3801        end        end
3802    
3803        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*****************************************************  
3804    
3805  *     -------------------------------------------------------  *     -------------------------------------------------------
3806  *     This routine fills the  elements of the variables  *     This routine fills the  elements of the variables
# Line 4022  c*************************************** Line 3809  c***************************************
3809  *     -------------------------------------------------------  *     -------------------------------------------------------
3810    
3811        include 'commontracker.f'        include 'commontracker.f'
       include 'level1.f'  
       include 'level2.f'  
3812        include 'calib.f'        include 'calib.f'
3813          include 'level1.f'
3814        include 'common_momanhough.f'        include 'common_momanhough.f'
3815          include 'level2.f'
3816        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3817    
3818  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
 c      good2=1!.true.  
3819        nclsx = 0        nclsx = 0
3820        nclsy = 0        nclsy = 0
3821    
3822          do iv = 1,nviews
3823    c         if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
3824             good2(iv) = good2(iv) + mask_view(iv)*2**8
3825          enddo
3826    
3827        do icl=1,nclstr1        do icl=1,nclstr1
3828           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
3829              ip=nplanes-npl(VIEW(icl))+1                          ip=nplanes-npl(VIEW(icl))+1            
3830              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
3831                 nclsx = nclsx + 1                 nclsx = nclsx + 1
3832                 planex(nclsx) = ip                 planex(nclsx) = ip
3833                 sgnlxs(nclsx) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3834                   if(nsatstrips(icl).gt.0)sgnlxs(nclsx)=-sgnlxs(nclsx)
3835                 clsx(nclsx)   = icl                 clsx(nclsx)   = icl
3836                 do is=1,2                 do is=1,2
3837  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
3838                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
3839                      call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
3840                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2
3841                 enddo                 enddo
3842  c$$$               print*,'nclsx         ',nclsx  c$$$               print*,'nclsx         ',nclsx
# Line 4054  c$$$               print*,'xs(2,nclsx)   Line 3847  c$$$               print*,'xs(2,nclsx)  
3847              else                          !=== Y views              else                          !=== Y views
3848                 nclsy = nclsy + 1                 nclsy = nclsy + 1
3849                 planey(nclsy) = ip                 planey(nclsy) = ip
3850                 sgnlys(nclsy) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3851                   if(nsatstrips(icl).gt.0)sgnlys(nclsy)=-sgnlys(nclsy)
3852                 clsy(nclsy)   = icl                 clsy(nclsy)   = icl
3853                 do is=1,2                 do is=1,2
3854  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
3855                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
3856                      call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
3857                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2
3858                 enddo                 enddo
3859  c$$$               print*,'nclsy         ',nclsy  c$$$               print*,'nclsy         ',nclsy
# Line 4068  c$$$               print*,'ys(1,nclsy)   Line 3863  c$$$               print*,'ys(1,nclsy)  
3863  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)
3864              endif              endif
3865           endif           endif
 c      print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)  
3866    
3867  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
3868           whichtrack(icl) = cl_used(icl)           whichtrack(icl) = cl_used(icl)
# Line 4076  c      print*,icl,cl_used(icl),cl_good(i Line 3870  c      print*,icl,cl_used(icl),cl_good(i
3870        enddo        enddo
3871        end        end
3872    
3873    ***************************************************
3874    *                                                 *
3875    *                                                 *
3876    *                                                 *
3877    *                                                 *
3878    *                                                 *
3879    *                                                 *
3880    **************************************************
3881    
3882          subroutine fill_hough
3883    
3884    *     -------------------------------------------------------
3885    *     This routine fills the  variables related to the hough
3886    *     transform, for the debig n-tuple
3887    *     -------------------------------------------------------
3888    
3889          include 'commontracker.f'
3890          include 'level1.f'
3891          include 'common_momanhough.f'
3892          include 'common_hough.f'
3893          include 'level2.f'
3894    
3895          if(.false.
3896         $     .or.ntrpt.gt.ntrpt_max_nt
3897         $     .or.ndblt.gt.ndblt_max_nt
3898         $     .or.NCLOUDS_XZ.gt.ncloxz_max
3899         $     .or.NCLOUDS_yZ.gt.ncloyz_max
3900         $     )then
3901             ntrpt_nt=0
3902             ndblt_nt=0
3903             NCLOUDS_XZ_nt=0
3904             NCLOUDS_YZ_nt=0
3905          else
3906             ndblt_nt=ndblt
3907             ntrpt_nt=ntrpt
3908             if(ndblt.ne.0)then
3909                do id=1,ndblt
3910                   alfayz1_nt(id)=alfayz1(id) !Y0
3911                   alfayz2_nt(id)=alfayz2(id) !tg theta-yz
3912                enddo
3913             endif
3914             if(ndblt.ne.0)then
3915                do it=1,ntrpt
3916                   alfaxz1_nt(it)=alfaxz1(it) !X0
3917                   alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
3918                   alfaxz3_nt(it)=alfaxz3(it) !1/r
3919                enddo
3920             endif
3921             nclouds_yz_nt=nclouds_yz
3922             nclouds_xz_nt=nclouds_xz
3923             if(nclouds_yz.ne.0)then
3924                nnn=0
3925                do iyz=1,nclouds_yz
3926                   ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
3927                   alfayz1_av_nt(iyz)=alfayz1_av(iyz)
3928                   alfayz2_av_nt(iyz)=alfayz2_av(iyz)
3929                   nnn=nnn+ptcloud_yz(iyz)
3930                enddo
3931                do ipt=1,nnn
3932                   db_cloud_nt(ipt)=db_cloud(ipt)
3933                 enddo
3934             endif
3935             if(nclouds_xz.ne.0)then
3936                nnn=0
3937                do ixz=1,nclouds_xz
3938                   ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
3939                   alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
3940                   alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
3941                   alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
3942                   nnn=nnn+ptcloud_xz(ixz)              
3943                enddo
3944                do ipt=1,nnn
3945                  tr_cloud_nt(ipt)=tr_cloud(ipt)
3946                 enddo
3947             endif
3948          endif
3949          end
3950          

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

  ViewVC Help
Powered by ViewVC 1.1.23