/[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.27 by pam-fi, Fri Aug 17 14:36:05 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)  c            if(DEBUG.and.fbad_cog(3,icx).ne.1)            
702           elseif(PFAx.eq.'ETA4')then                         !(3)  c     $           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)  c            if(DEBUG.and.fbad_cog(4,icx).ne.1)              
710              resxPAM = ris_eta(icx,angx)                     !   (4)  c     $           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)  c            if(DEBUG.and.fbad_cog(2,icx).ne.1)              
719    c     $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
720    
721             elseif(PFAx.eq.'ETAL')then  
722    
723                stripx  = stripx + pfaetal(icx,angx)            
724                resxPAM = riseta(viewx,angx)                    
725                resxPAM = resxPAM*fbad_eta(icx,angx)            
726    c            if(DEBUG.and.fbad_cog(2,icx).ne.1)              
727    c     $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
728    
729             elseif(PFAx.eq.'COG')then          
730    
731                stripx  = stripx + cog(0,icx)            
732                resxPAM = risx_cog(abs(angx))                    
733                resxPAM = resxPAM*fbad_cog(0,icx)
734    
735           else           else
736              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx
737           endif           endif
738    
739        endif  
740  c      if(icy.eq.0.and.icx.ne.0)  *     ======================================
741  c     $     print*,PFAx,icx,angx,stripx,resxPAM,'***'  *     temporary patch for saturated clusters
742          *     ======================================
743             if( nsatstrips(icx).gt.0 )then
744                stripx  = stripx + cog(4,icx)            
745                resxPAM = pitchX*1e-4/sqrt(12.)
746                cc=cog(4,icx)
747    c$$$            print*,icx,' *** ',cc
748    c$$$            print*,icx,' *** ',resxPAM
749             endif
750    
751     10   endif
752    
753        
754  *     -----------------  *     -----------------
755  *     CLUSTER Y  *     CLUSTER Y
756  *     -----------------  *     -----------------
757    
758        if(icy.ne.0)then        if(icy.ne.0)then
759    
760           viewy = VIEW(icy)           viewy = VIEW(icy)
761           nldy = nld(MAXS(icy),VIEW(icy))           nldy = nld(MAXS(icy),VIEW(icy))
762           nply = npl(VIEW(icy))           nply = npl(VIEW(icy))
763           resyPAM = RESYAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           resyPAM = RESYAV
764             stripy = float(MAXS(icy))
765    
766             if(
767         $        viewy.lt.1.or.        
768         $        viewy.gt.12.or.
769         $        nldy.lt.1.or.
770         $        nldy.gt.3.or.
771         $        stripy.lt.1.or.
772         $        stripy.gt.3072.or.
773         $        .false.)then
774                print*,'xyz_PAM   ***ERROR*** wrong input '
775                print*,'icy ',icy,'view ',viewy,'nld ',nldy,'strip ',stripy
776                icy = 0
777                goto 20
778             endif
779    
780           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
781              print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '              if(DEBUG) then
782       $           ,icx,icy                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '
783         $              ,icx,icy
784                endif
785              goto 100              goto 100
786           endif           endif
787            *        --------------------------
788           stripy = float(MAXS(icy))  *        magnetic-field corrections
789           if(PFAy.eq.'COG1')then !(1)  *        --------------------------
790              stripy = stripy     !(1)           tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
791              resyPAM = resyPAM   !(1)           angy    = 180.*atan(tgtemp)/acos(-1.)
792             stripy = stripy + 0.5*pmuH_e*bfx*0.00001*SiDimZ/pitchY
793    c$$$         if(bfx.ne.0.)print*,viewy,'-y- '
794    c$$$     $        ,bfx,0.5*pmuH_e*bfx*0.00001*SiDimZ
795    *        --------------------------
796            
797    c$$$         print*,'--- y-cl ---'
798    c$$$         istart = INDSTART(ICY)
799    c$$$         istop  = TOTCLLENGTH
800    c$$$         if(icy.lt.NCLSTR1)istop=INDSTART(ICY+1)-1
801    c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
802    c$$$         print*,(CLSIGNAL(i),i=istart,istop)
803    c$$$         print*,INDMAX(icy)
804    c$$$         print*,cog(4,icy)
805    c$$$         print*,fbad_cog(4,icy)
806    
807             if(PFAy.eq.'COG1')then
808    
809                stripy  = stripy    
810                resyPAM = 1e-4*pitchY/sqrt(12.)!resyPAM  
811    
812           elseif(PFAy.eq.'COG2')then           elseif(PFAy.eq.'COG2')then
813              stripy = stripy + cog(2,icy)  
814                stripy  = stripy + cog(2,icy)
815                resyPAM = risy_cog(abs(angy))!TEMPORANEO
816              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
817    
818             elseif(PFAy.eq.'COG3')then
819    
820                stripy  = stripy + cog(3,icy)
821                resyPAM = risy_cog(abs(angy))!TEMPORANEO
822                resyPAM = resyPAM*fbad_cog(3,icy)
823    
824             elseif(PFAy.eq.'COG4')then
825    
826                stripy  = stripy + cog(4,icy)
827                resyPAM = risy_cog(abs(angy))!TEMPORANEO
828                resyPAM = resyPAM*fbad_cog(4,icy)
829    
830           elseif(PFAy.eq.'ETA2')then           elseif(PFAy.eq.'ETA2')then
831  c            cog2 = cog(2,icy)  
832  c            etacorr = pfa_eta2(cog2,viewy,nldy,angy)              stripy  = stripy + pfaeta2(icy,angy)          
833  c            stripy = stripy + etacorr              resyPAM = risyeta2(abs(angy))              
             stripy = stripy + pfa_eta2(icy,angy)            !(3)  
             resyPAM = risy_eta2(angy)                       !   (4)  
834              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
835              if(DEBUG.and.fbad_cog(2,icy).ne.1)  c            if(DEBUG.and.fbad_cog(2,icy).ne.1)
836       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)  c     $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
837           elseif(PFAy.eq.'ETA3')then                         !(3)  
838              stripy = stripy + pfa_eta3(icy,angy)            !(3)           elseif(PFAy.eq.'ETA3')then                      
839              resyPAM = resyPAM*fbad_cog(3,icy)               !(3)  
840              if(DEBUG.and.fbad_cog(3,icy).ne.1)              !(3)              stripy  = stripy + pfaeta3(icy,angy)
841       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)!(3)              resyPAM = resyPAM*fbad_cog(3,icy)  
842           elseif(PFAy.eq.'ETA4')then                         !(3)  c            if(DEBUG.and.fbad_cog(3,icy).ne.1)
843              stripy = stripy + pfa_eta4(icy,angy)            !(3)  c     $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)
844              resyPAM = resyPAM*fbad_cog(4,icy)               !(3)  
845              if(DEBUG.and.fbad_cog(4,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA4')then  
846       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)!(3)  
847           elseif(PFAy.eq.'ETA')then                          !(3)              stripy  = stripy + pfaeta4(icy,angy)
848              stripy = stripy + pfa_eta(icy,angy)             !(3)              resyPAM = resyPAM*fbad_cog(4,icy)
849              resyPAM = ris_eta(icy,angy)                     !   (4)  c            if(DEBUG.and.fbad_cog(4,icy).ne.1)
850  c            resyPAM = resyPAM*fbad_cog(2,icy)              !(3)TEMPORANEO  c     $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)
851              resyPAM = resyPAM*fbad_eta(icy,angy)            !   (4)  
852              if(DEBUG.and.fbad_cog(2,icy).ne.1)              !(3)           elseif(PFAy.eq.'ETA')then
853       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)!(3)  
854                stripy  = stripy + pfaeta(icy,angy)
855    c            resyPAM = riseta(icy,angy)  
856                resyPAM = riseta(viewy,angy)  
857                resyPAM = resyPAM*fbad_eta(icy,angy)
858    c            if(DEBUG.and.fbad_cog(2,icy).ne.1)
859    c     $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
860    
861             elseif(PFAy.eq.'ETAL')then
862    
863                stripy  = stripy + pfaetal(icy,angy)
864                resyPAM = riseta(viewy,angy)  
865                resyPAM = resyPAM*fbad_eta(icy,angy)
866    c            if(DEBUG.and.fbad_cog(2,icy).ne.1)
867    c     $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
868    
869           elseif(PFAy.eq.'COG')then           elseif(PFAy.eq.'COG')then
870              stripy = stripy + cog(0,icy)              
871              resyPAM = risy_cog(angy)                        !   (4)              stripy  = stripy + cog(0,icy)            
872  c            resyPAM = ris_eta(icy,angy)                    !   (4)              resyPAM = risy_cog(abs(angy))
873              resyPAM = resyPAM*fbad_cog(0,icy)              resyPAM = resyPAM*fbad_cog(0,icy)
874    
875           else           else
876              print*,'*** Non valid p.f.a. (x) --> ',PFAx              if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx
877           endif           endif
878    
       endif  
879    
880          *     ======================================
881    *     temporary patch for saturated clusters
882    *     ======================================
883             if( nsatstrips(icy).gt.0 )then
884                stripy  = stripy + cog(4,icy)            
885                resyPAM = pitchY*1e-4/sqrt(12.)
886                cc=cog(4,icy)
887    c$$$            print*,icy,' *** ',cc
888    c$$$            print*,icy,' *** ',resyPAM
889             endif
890    
891    
892     20   endif
893    
894    c$$$      print*,'## stripx,stripy ',stripx,stripy
895    
896  c===========================================================  c===========================================================
897  C     COUPLE  C     COUPLE
898  C===========================================================  C===========================================================
# Line 777  c     (xi,yi,zi) = mechanical coordinate Line 903  c     (xi,yi,zi) = mechanical coordinate
903  c------------------------------------------------------------------------  c------------------------------------------------------------------------
904           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
905       $        .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...
906              print*,'xyz_PAM (couple):',              if(DEBUG) then
907       $          ' WARNING: false X strip: strip ',stripx                 print*,'xyz_PAM (couple):',
908         $              ' WARNING: false X strip: strip ',stripx
909                endif
910           endif           endif
911           xi = acoordsi(stripx,viewx)           xi = acoordsi(stripx,viewx)
912           yi = acoordsi(stripy,viewy)           yi = acoordsi(stripy,viewy)
# Line 870  c            print*,'X-singlet ',icx,npl Line 998  c            print*,'X-singlet ',icx,npl
998  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...
999              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1000       $           .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...
1001                 print*,'xyz_PAM (X-singlet):',                 if(DEBUG) then
1002       $             ' WARNING: false X strip: strip ',stripx                    print*,'xyz_PAM (X-singlet):',
1003         $                 ' WARNING: false X strip: strip ',stripx
1004                   endif
1005              endif              endif
1006              xi   = acoordsi(stripx,viewx)              xi   = acoordsi(stripx,viewx)
1007    
# Line 893  c            print*,'X-cl ',icx,stripx,' Line 1023  c            print*,'X-cl ',icx,stripx,'
1023  c            print*,yi_A,' <--> ',yi_B  c            print*,yi_A,' <--> ',yi_B
1024    
1025           else           else
1026                if(DEBUG) then
1027              print *,'routine xyz_PAM ---> not properly used !!!'                 print *,'routine xyz_PAM ---> not properly used !!!'
1028              print *,'icx = ',icx                 print *,'icx = ',icx
1029              print *,'icy = ',icy                 print *,'icy = ',icy
1030                endif
1031              goto 100              goto 100
1032                            
1033           endif           endif
# Line 961  c--------------------------------------- Line 1092  c---------------------------------------
1092  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'
1093    
1094        else        else
1095                       if(DEBUG) then
1096           print *,'routine xyz_PAM ---> not properly used !!!'              print *,'routine xyz_PAM ---> not properly used !!!'
1097           print *,'icx = ',icx              print *,'icx = ',icx
1098           print *,'icy = ',icy              print *,'icy = ',icy
1099                         endif
1100        endif        endif
1101                    
1102    
1103    c      print*,'## xPAM,yPAM,zPAM       ',xPAM,yPAM,zPAM
1104    c      print*,'## xPAM_A,yPAM_A,zPAM_A ',xPAM_A,yPAM_A,zPAM_A
1105    c      print*,'## xPAM_B,yPAM_B,zPAM_B ',xPAM_B,yPAM_B,zPAM_B
1106    
1107   100  continue   100  continue
1108        end        end
1109    
1110    ************************************************************************
1111    *     Call xyz_PAM subroutine with default PFA and fill the mini2 common.
1112    *     (done to be called from c/c++)
1113    ************************************************************************
1114    
1115          subroutine xyzpam(ip,icx,icy,lad,sensor,ax,ay,bfx,bfy)
1116    
1117          include 'commontracker.f'
1118          include 'level1.f'
1119          include 'common_mini_2.f'
1120          include 'common_xyzPAM.f'
1121          include 'common_mech.f'
1122          include 'calib.f'
1123          
1124    *     flag to chose PFA
1125    c$$$      character*10 PFA
1126    c$$$      common/FINALPFA/PFA
1127    
1128          integer icx,icy           !X-Y cluster ID
1129          integer sensor
1130          character*4 PFAx,PFAy     !PFA to be used
1131          real ax,ay                !X-Y geometric angle
1132          real bfx,bfy              !X-Y b-field components
1133    
1134          ipx=0
1135          ipy=0      
1136          
1137    c$$$      PFAx = 'COG4'!PFA
1138    c$$$      PFAy = 'COG4'!PFA
1139    
1140          if(icx.gt.nclstr1.or.icy.gt.nclstr1)then
1141                print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1142         $           ,' does not exists (nclstr1=',nclstr1,')'
1143                icx = -1*icx
1144                icy = -1*icy
1145                return
1146            
1147          endif
1148          
1149          call idtoc(pfaid,PFAx)
1150          call idtoc(pfaid,PFAy)
1151    
1152    c$$$      call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1153    
1154    c$$$      print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy
1155          
1156          if(icx.ne.0.and.icy.ne.0)then
1157    
1158             ipx=npl(VIEW(icx))
1159             ipy=npl(VIEW(icy))
1160    c$$$         if( (nplanes-ipx+1).ne.ip.or.(nplanes-ipy+1).ne.ip )
1161    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1162    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1163            
1164             if( (nplanes-ipx+1).ne.ip )then
1165                print*,'xyzpam: ***WARNING*** cluster ',icx
1166         $           ,' does not belong to plane: ',ip
1167                icx = -1*icx
1168                return
1169             endif
1170             if( (nplanes-ipy+1).ne.ip )then
1171                print*,'xyzpam: ***WARNING*** cluster ',icy
1172         $           ,' does not belong to plane: ',ip
1173                icy = -1*icy
1174                return
1175             endif
1176    
1177             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1178    
1179             xgood(ip) = 1.
1180             ygood(ip) = 1.
1181             resx(ip)  = resxPAM
1182             resy(ip)  = resyPAM
1183    
1184             xm(ip) = xPAM
1185             ym(ip) = yPAM
1186             zm(ip) = zPAM
1187             xm_A(ip) = 0.
1188             ym_A(ip) = 0.
1189             xm_B(ip) = 0.
1190             ym_B(ip) = 0.
1191    
1192    c         zv(ip) = zPAM
1193    
1194          elseif(icx.eq.0.and.icy.ne.0)then
1195    
1196             ipy=npl(VIEW(icy))
1197    c$$$         if((nplanes-ipy+1).ne.ip)
1198    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1199    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1200             if( (nplanes-ipy+1).ne.ip )then
1201                print*,'xyzpam: ***WARNING*** cluster ',icy
1202         $           ,' does not belong to plane: ',ip
1203                icy = -1*icy
1204                return
1205             endif
1206    
1207             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1208            
1209             xgood(ip) = 0.
1210             ygood(ip) = 1.
1211             resx(ip)  = 1000.
1212             resy(ip)  = resyPAM
1213    
1214             xm(ip) = -100.
1215             ym(ip) = -100.
1216             zm(ip) = (zPAM_A+zPAM_B)/2.
1217             xm_A(ip) = xPAM_A
1218             ym_A(ip) = yPAM_A
1219             xm_B(ip) = xPAM_B
1220             ym_B(ip) = yPAM_B
1221    
1222    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1223            
1224          elseif(icx.ne.0.and.icy.eq.0)then
1225    
1226             ipx=npl(VIEW(icx))
1227    c$$$         if((nplanes-ipx+1).ne.ip)
1228    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1229    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1230    
1231             if( (nplanes-ipx+1).ne.ip )then
1232                print*,'xyzpam: ***WARNING*** cluster ',icx
1233         $           ,' does not belong to plane: ',ip
1234                icx = -1*icx
1235                return
1236             endif
1237    
1238             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1239          
1240             xgood(ip) = 1.
1241             ygood(ip) = 0.
1242             resx(ip)  = resxPAM
1243             resy(ip)  = 1000.
1244    
1245             xm(ip) = -100.
1246             ym(ip) = -100.
1247             zm(ip) = (zPAM_A+zPAM_B)/2.
1248             xm_A(ip) = xPAM_A
1249             ym_A(ip) = yPAM_A
1250             xm_B(ip) = xPAM_B
1251             ym_B(ip) = yPAM_B
1252            
1253    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1254    
1255          else
1256    
1257             il = 2
1258             if(lad.ne.0)il=lad
1259             is = 1
1260             if(sensor.ne.0)is=sensor
1261    c         print*,nplanes-ip+1,il,is
1262    
1263             xgood(ip) = 0.
1264             ygood(ip) = 0.
1265             resx(ip)  = 1000.
1266             resy(ip)  = 1000.
1267    
1268             xm(ip) = -100.
1269             ym(ip) = -100.          
1270             zm(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1271             xm_A(ip) = 0.
1272             ym_A(ip) = 0.
1273             xm_B(ip) = 0.
1274             ym_B(ip) = 0.
1275    
1276    c         zv(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1277    
1278          endif
1279    
1280          if(DEBUG)then
1281    c         print*,'----------------------------- track coord'
1282    22222    format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
1283             write(*,22222)ip,zm(ip),xm(ip),ym(ip)
1284         $        ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip)
1285         $        ,xgood(ip),ygood(ip),resx(ip),resy(ip)
1286    c$$$         print*,'-----------------------------'
1287          endif
1288          end
1289    
1290  ********************************************************************************  ********************************************************************************
1291  ********************************************************************************  ********************************************************************************
# Line 1046  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1361  c         print*,'A-(',xPAM_A,yPAM_A,')
1361           endif                   endif        
1362    
1363           distance=           distance=
1364       $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2       $       ((xmi-XPP)**2+(ymi-YPP)**2)!QUIQUI
1365    cc     $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1366           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1367    
1368  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 1387  c$$$         print*,' resolution ',re
1387  *     ----------------------  *     ----------------------
1388                    
1389           distance=           distance=
1390       $        ((xPAM-XPP)/resxPAM)**2       $       ((xPAM-XPP))**2 !QUIQUI
1391       $        +       $       +
1392       $        ((yPAM-YPP)/resyPAM)**2       $       ((yPAM-YPP))**2
1393    c$$$     $        ((xPAM-XPP)/resxPAM)**2
1394    c$$$     $        +
1395    c$$$     $        ((yPAM-YPP)/resyPAM)**2
1396           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1397    
1398  c$$$         print*,xPAM,yPAM,zPAM  c$$$         print*,xPAM,yPAM,zPAM
# Line 1082  c$$$         print*,' resolution ',resxP Line 1401  c$$$         print*,' resolution ',resxP
1401                    
1402        else        else
1403                    
1404           print*  c         print*
1405       $        ,' function distance_to ---> wrong usage!!!'  c     $        ,' function distance_to ---> wrong usage!!!'
1406           print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM  c         print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM
1407           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 '
1408       $        ,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
1409        endif          endif  
1410    
1411        distance_to = sngl(distance)        distance_to = sngl(distance)
# Line 1154  c--------------------------------------- Line 1473  c---------------------------------------
1473                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1474       $              .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...
1475  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...
1476                    print*,'whichsensor: ',  c                  print*,'whichsensor: ',
1477       $                ' WARNING: false X strip: strip ',stripx  c     $                ' WARNING: false X strip: strip ',stripx
1478                 endif                 endif
1479                 xi = acoordsi(stripx,viewx)                 xi = acoordsi(stripx,viewx)
1480                 yi = acoordsi(stripy,viewy)                 yi = acoordsi(stripy,viewy)
# Line 1284  c     $              ,iv,xvv(iv),yvv(iv) Line 1603  c     $              ,iv,xvv(iv),yvv(iv)
1603  *     it returns the plane number  *     it returns the plane number
1604  *      *    
1605        include 'commontracker.f'        include 'commontracker.f'
1606          include 'level1.f'
1607  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1608        include 'common_momanhough.f'        include 'common_momanhough.f'
1609                
# Line 1309  c      include 'common_analysis.f' Line 1629  c      include 'common_analysis.f'
1629        is_cp=0        is_cp=0
1630        if(id.lt.0)is_cp=1        if(id.lt.0)is_cp=1
1631        if(id.gt.0)is_cp=2        if(id.gt.0)is_cp=2
1632        if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'  c      if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'
1633    
1634        return        return
1635        end        end
# Line 1321  c      include 'common_analysis.f' Line 1641  c      include 'common_analysis.f'
1641  *     it returns the id number ON THE PLANE  *     it returns the id number ON THE PLANE
1642  *      *    
1643        include 'commontracker.f'        include 'commontracker.f'
1644          include 'level1.f'
1645  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1646        include 'common_momanhough.f'        include 'common_momanhough.f'
1647                
# Line 1349  c      include 'common_analysis.f' Line 1670  c      include 'common_analysis.f'
1670  *     positive if sensor =2  *     positive if sensor =2
1671  *  *
1672        include 'commontracker.f'        include 'commontracker.f'
1673          include 'level1.f'
1674  c      include 'calib.f'  c      include 'calib.f'
1675  c      include 'level1.f'  c      include 'level1.f'
1676  c      include 'common_analysis.f'  c      include 'common_analysis.f'
# Line 1371  c      include 'common_analysis.f' Line 1693  c      include 'common_analysis.f'
1693    
1694    
1695    
1696    
1697  *************************************************************************  *************************************************************************
1698  *************************************************************************  *************************************************************************
1699  *************************************************************************  *************************************************************************
1700  *************************************************************************  *************************************************************************
1701  *************************************************************************  *************************************************************************
1702  *************************************************************************  *************************************************************************
 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  
1703                
1704    
1705  ***************************************************  ***************************************************
1706  *                                                 *  *                                                 *
1707  *                                                 *  *                                                 *
# Line 1889  c     goto 880       !fill ntp and go to Line 1710  c     goto 880       !fill ntp and go to
1710  *                                                 *  *                                                 *
1711  *                                                 *  *                                                 *
1712  **************************************************  **************************************************
1713        subroutine cl_to_couples_nocharge(iflag)  
1714          subroutine cl_to_couples(iflag)
1715    
1716        include 'commontracker.f'        include 'commontracker.f'
1717          include 'level1.f'
1718        include 'common_momanhough.f'        include 'common_momanhough.f'
1719        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1720        include 'calib.f'        include 'calib.f'
1721        include 'level1.f'  c      include 'level1.f'
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1722    
1723  *     output flag  *     output flag
1724  *     --------------  *     --------------
# Line 1907  c      common/dbg/DEBUG Line 1727  c      common/dbg/DEBUG
1727  *     --------------  *     --------------
1728        integer iflag        integer iflag
1729    
1730        integer badseed,badcl        integer badseed,badclx,badcly
1731    
1732  *     init variables  *     init variables
1733        ncp_tot=0        ncp_tot=0
# Line 1923  c      common/dbg/DEBUG Line 1743  c      common/dbg/DEBUG
1743           ncls(ip)=0           ncls(ip)=0
1744        enddo        enddo
1745        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1746           cl_single(icl)=1           cl_single(icl) = 1
1747           cl_good(icl)=0           cl_good(icl)   = 0
1748          enddo
1749          do iv=1,nviews
1750             ncl_view(iv)  = 0
1751             mask_view(iv) = 0      !all included
1752        enddo        enddo
1753                
1754    *     count number of cluster per view
1755          do icl=1,nclstr1
1756             ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1        
1757          enddo
1758    *     mask views with too many clusters
1759          do iv=1,nviews
1760             if( ncl_view(iv).gt. nclusterlimit)then
1761    c            mask_view(iv) = 1
1762                mask_view(iv) = mask_view(iv) + 2**0
1763                if(DEBUG)print*,' * WARNING * cl_to_couple: n.clusters > '
1764         $           ,nclusterlimit,' on view ', iv,' --> masked!'
1765             endif
1766          enddo
1767    
1768    
1769  *     start association  *     start association
1770        ncouples=0        ncouples=0
1771        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1772           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1773                    
1774  *     ----------------------------------------------------  *     ----------------------------------------------------
1775    *     jump masked views (X VIEW)
1776    *     ----------------------------------------------------
1777             if( mask_view(VIEW(icx)).ne.0 ) goto 10
1778    *     ----------------------------------------------------
1779  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1780           if(dedx(icx).lt.dedx_x_min)then  *     ----------------------------------------------------
1781             if(sgnl(icx).lt.dedx_x_min)then
1782              cl_single(icx)=0              cl_single(icx)=0
1783              goto 10              goto 10
1784           endif           endif
1785    *     ----------------------------------------------------
1786  *     cut BAD (X VIEW)              *     cut BAD (X VIEW)            
1787    *     ----------------------------------------------------
1788           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
1789           ifirst=INDSTART(icx)           ifirst=INDSTART(icx)
1790           if(icx.ne.nclstr1) then           if(icx.ne.nclstr1) then
# Line 1946  c      common/dbg/DEBUG Line 1792  c      common/dbg/DEBUG
1792           else           else
1793              ilast=TOTCLLENGTH              ilast=TOTCLLENGTH
1794           endif           endif
1795           badcl=badseed           badclx=badseed
1796           do igood=-ngoodstr,ngoodstr           do igood=-ngoodstr,ngoodstr
1797              ibad=1              ibad=1
1798              if((INDMAX(icx)+igood).gt.ifirst.and.              if((INDMAX(icx)+igood).gt.ifirst.and.
# Line 1956  c      common/dbg/DEBUG Line 1802  c      common/dbg/DEBUG
1802       $              nvk(MAXS(icx)+igood),       $              nvk(MAXS(icx)+igood),
1803       $              nst(MAXS(icx)+igood))       $              nst(MAXS(icx)+igood))
1804              endif              endif
1805              badcl=badcl*ibad              badclx=badclx*ibad
1806           enddo           enddo
1807           if(badcl.eq.0)then     !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1808              cl_single(icx)=0    !<<<<<<<<<<<<<< BAD cut  *     >>> eliminato il taglio sulle BAD <<<
1809              goto 10             !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1810           endif                  !<<<<<<<<<<<<<< BAD cut  c     if(badcl.eq.0)then
1811    c     cl_single(icx)=0
1812    c     goto 10
1813    c     endif
1814  *     ----------------------------------------------------  *     ----------------------------------------------------
1815                    
1816           cl_good(icx)=1           cl_good(icx)=1
# Line 1972  c      common/dbg/DEBUG Line 1821  c      common/dbg/DEBUG
1821              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1822                            
1823  *     ----------------------------------------------------  *     ----------------------------------------------------
1824    *     jump masked views (Y VIEW)
1825    *     ----------------------------------------------------
1826                if( mask_view(VIEW(icy)).ne.0 ) goto 20
1827    
1828    *     ----------------------------------------------------
1829  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1830              if(dedx(icy).lt.dedx_y_min)then  *     ----------------------------------------------------
1831                if(sgnl(icy).lt.dedx_y_min)then
1832                 cl_single(icy)=0                 cl_single(icy)=0
1833                 goto 20                 goto 20
1834              endif              endif
1835    *     ----------------------------------------------------
1836  *     cut BAD (Y VIEW)              *     cut BAD (Y VIEW)            
1837    *     ----------------------------------------------------
1838              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
1839              ifirst=INDSTART(icy)              ifirst=INDSTART(icy)
1840              if(icy.ne.nclstr1) then              if(icy.ne.nclstr1) then
# Line 1985  c      common/dbg/DEBUG Line 1842  c      common/dbg/DEBUG
1842              else              else
1843                 ilast=TOTCLLENGTH                 ilast=TOTCLLENGTH
1844              endif              endif
1845              badcl=badseed              badcly=badseed
1846              do igood=-ngoodstr,ngoodstr              do igood=-ngoodstr,ngoodstr
1847                 ibad=1                 ibad=1
1848                 if((INDMAX(icy)+igood).gt.ifirst.and.                 if((INDMAX(icy)+igood).gt.ifirst.and.
# Line 1994  c      common/dbg/DEBUG Line 1851  c      common/dbg/DEBUG
1851       $              ibad=BAD(VIEW(icy),       $              ibad=BAD(VIEW(icy),
1852       $              nvk(MAXS(icy)+igood),       $              nvk(MAXS(icy)+igood),
1853       $              nst(MAXS(icy)+igood))       $              nst(MAXS(icy)+igood))
1854                 badcl=badcl*ibad                 badcly=badcly*ibad
1855              enddo              enddo
             if(badcl.eq.0)then  !<<<<<<<<<<<<<< BAD cut  
                cl_single(icy)=0 !<<<<<<<<<<<<<< BAD cut  
                goto 20          !<<<<<<<<<<<<<< BAD cut  
             endif               !<<<<<<<<<<<<<< BAD cut  
1856  *     ----------------------------------------------------  *     ----------------------------------------------------
1857                *     >>> eliminato il taglio sulle BAD <<<
1858    *     ----------------------------------------------------
1859    c     if(badcl.eq.0)then
1860    c     cl_single(icy)=0
1861    c     goto 20
1862    c     endif
1863    *     ----------------------------------------------------
1864                            
1865              cl_good(icy)=1                                cl_good(icy)=1                  
1866              nply=npl(VIEW(icy))              nply=npl(VIEW(icy))
# Line 2012  c      common/dbg/DEBUG Line 1871  c      common/dbg/DEBUG
1871  *     ----------------------------------------------  *     ----------------------------------------------
1872  *     geometrical consistency (same plane and ladder)  *     geometrical consistency (same plane and ladder)
1873              if(nply.eq.nplx.and.nldy.eq.nldx)then              if(nply.eq.nplx.and.nldy.eq.nldx)then
1874  *     charge correlation  *     charge correlation
1875  *     ===========================================================  *     (modified to be applied only below saturation... obviously)
1876  *     this version of the subroutine is used for the calibration  
1877  *     thus charge-correlation selection is obviously removed                 if(  .not.(sgnl(icy).gt.chsaty.and.sgnl(icx).gt.chsatx)
1878  *     ===========================================================       $              .and.
1879  c$$$               ddd=(dedx(icy)       $              .not.(sgnl(icy).lt.chmipy.and.sgnl(icx).lt.chmipx)
1880  c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))       $              .and.
1881  c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)       $              (badclx.eq.1.and.badcly.eq.1)
1882  c$$$               cut=chcut*sch(nplx,nldx)       $              .and.
1883  c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent       $              .true.)then
1884  *     ===========================================================  
1885                                    ddd=(sgnl(icy)
1886                       $                 -kch(nplx,nldx)*sgnl(icx)-cch(nplx,nldx))
1887  *     ------------------> COUPLE <------------------                    ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
1888  *     check to do not overflow vector dimentions  
1889    c                  cut = chcut * sch(nplx,nldx)
1890    
1891                      sss=(kch(nplx,nldx)*sgnl(icy)+sgnl(icx)
1892         $                 -kch(nplx,nldx)*cch(nplx,nldx))
1893                      sss=sss/sqrt(kch(nplx,nldx)**2+1)
1894                      cut = chcut * (16 + sss/50.)
1895    
1896                      if(abs(ddd).gt.cut)then
1897                         goto 20    !charge not consistent
1898                      endif
1899                   endif
1900    
1901                 if(ncp_plane(nplx).gt.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
1902                    if(DEBUG)print*,                    if(verbose)print*,
1903       $                    ' ** warning ** number of identified'//       $                 '** warning ** number of identified '//
1904       $                    ' couples on plane ',nplx,       $                 'couples on plane ',nplx,
1905       $                    ' exceeds vector dimention'//       $                 'exceeds vector dimention '
1906       $                    ' ( ',ncouplemax,' )'       $                 ,'( ',ncouplemax,' ) --> masked!'
1907  c     good2=.false.  c                  mask_view(nviewx(nplx)) = 2
1908  c     goto 880   !fill ntp and go to next event  c                  mask_view(nviewy(nply)) = 2
1909                    iflag=1                    mask_view(nviewx(nplx))= mask_view(nviewx(nplx))+ 2**1
1910                    return                    mask_view(nviewy(nply))= mask_view(nviewy(nply))+ 2**1
1911                      goto 10
1912                 endif                 endif
1913                                
1914  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  
                 
1915                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
1916                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
1917                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
1918                 cl_single(icx)=0                 cl_single(icx)=0
1919                 cl_single(icy)=0                 cl_single(icy)=0
             endif                                
1920  *     ----------------------------------------------  *     ----------------------------------------------
1921    
1922                endif                              
1923    
1924   20         continue   20         continue
1925           enddo                  !end loop on clusters(Y)           enddo                  !end loop on clusters(Y)
1926                    
# Line 2083  c$$$               endif Line 1945  c$$$               endif
1945        endif        endif
1946                
1947        do ip=1,6        do ip=1,6
1948           ncp_tot=ncp_tot+ncp_plane(ip)           ncp_tot = ncp_tot + ncp_plane(ip)
1949        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  
1950                
1951        return        return
1952        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  
1953                
1954  ***************************************************  ***************************************************
1955  *                                                 *  *                                                 *
# Line 2321  c$$$      end Line 1961  c$$$      end
1961  **************************************************  **************************************************
1962    
1963        subroutine cp_to_doubtrip(iflag)        subroutine cp_to_doubtrip(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
1964    
1965        include 'commontracker.f'        include 'commontracker.f'
1966          include 'level1.f'
1967        include 'common_momanhough.f'        include 'common_momanhough.f'
       include 'momanhough_init.f'  
1968        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1969        include 'common_mini_2.f'        include 'common_mini_2.f'
1970        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
1971    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1972    
1973  *     output flag  *     output flag
1974  *     --------------  *     --------------
# Line 2367  c      double precision xm3,ym3,zm3 Line 2001  c      double precision xm3,ym3,zm3
2001  *     -----------------------------  *     -----------------------------
2002    
2003    
2004    *     --------------------------------------------
2005    *     put a limit to the maximum number of couples
2006    *     per plane, in order to apply hough transform
2007    *     (couples recovered during track refinement)
2008    *     --------------------------------------------
2009          do ip=1,nplanes
2010             if(ncp_plane(ip).gt.ncouplelimit)then
2011    c            mask_view(nviewx(ip)) = 8
2012    c            mask_view(nviewy(ip)) = 8
2013                mask_view(nviewx(ip)) = mask_view(nviewx(ip)) + 2**7
2014                mask_view(nviewy(ip)) = mask_view(nviewy(ip)) + 2**7
2015             endif
2016          enddo
2017    
2018    
2019        ndblt=0                   !number of doublets        ndblt=0                   !number of doublets
2020        ntrpt=0                   !number of triplets        ntrpt=0                   !number of triplets
2021                
2022        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1
2023           do is1=1,2             !loop on sensors - COPPIA 1           if(  mask_view(nviewx(ip1)).ne.0 .or.
2024                     $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
2025             do is1=1,2             !loop on sensors - COPPIA 1            
2026              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
2027                 icx1=clx(ip1,icp1)                 icx1=clx(ip1,icp1)
2028                 icy1=cly(ip1,icp1)                 icy1=cly(ip1,icp1)
2029  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
2030                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
2031                   call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
2032                 xm1=xPAM                 xm1=xPAM
2033                 ym1=yPAM                 ym1=yPAM
2034                 zm1=zPAM                                   zm1=zPAM                  
2035  c     print*,'***',is1,xm1,ym1,zm1  c     print*,'***',is1,xm1,ym1,zm1
2036    
2037                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
2038                      if(  mask_view(nviewx(ip2)).ne.0 .or.
2039         $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
2040                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    do is2=1,2    !loop on sensors -ndblt COPPIA 2
2041                                            
2042                       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 2044  c     print*,'***',is1,xm1,ym1,zm1
2044                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
2045  c                        call xyz_PAM  c                        call xyz_PAM
2046  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
2047    c                        call xyz_PAM
2048    c     $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)
2049                          call xyz_PAM                          call xyz_PAM
2050       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.,0.,0.)
2051                          xm2=xPAM                          xm2=xPAM
2052                          ym2=yPAM                          ym2=yPAM
2053                          zm2=zPAM                          zm2=zPAM
# Line 2402  c     $                       (icx2,icy2 Line 2057  c     $                       (icx2,icy2
2057  *     (2 couples needed)  *     (2 couples needed)
2058  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2059                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
2060                             if(DEBUG)print*,                             if(verbose)print*,
2061       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
2062       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
2063       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
2064  c                           good2=.false.  c                           good2=.false.
2065  c                           goto 880 !fill ntp and go to next event  c                           goto 880 !fill ntp and go to next event
2066                               do iv=1,12
2067    c                              mask_view(iv) = 3
2068                                  mask_view(iv) = mask_view(iv)+ 2**2
2069                               enddo
2070                             iflag=1                             iflag=1
2071                             return                             return
2072                          endif                          endif
# Line 2441  c$$$ Line 2100  c$$$
2100  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2101    
2102    
2103                          if(ip2.eq.nplanes)goto 30 !no possible combination with 3 couples                          if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
2104    
2105                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
2106                               if(  mask_view(nviewx(ip3)).ne.0 .or.
2107         $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
2108                             do is3=1,2 !loop on sensors - COPPIA 3                             do is3=1,2 !loop on sensors - COPPIA 3
2109                                                                
2110                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
# Line 2450  c$$$ Line 2112  c$$$
2112                                   icy3=cly(ip3,icp3)                                   icy3=cly(ip3,icp3)
2113  c                                 call xyz_PAM  c                                 call xyz_PAM
2114  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
2115    c                                 call xyz_PAM
2116    c     $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)
2117                                   call xyz_PAM                                   call xyz_PAM
2118       $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)       $                                (icx3,icy3,is3,PFAdef,PFAdef
2119         $                                ,0.,0.,0.,0.)
2120                                   xm3=xPAM                                   xm3=xPAM
2121                                   ym3=yPAM                                   ym3=yPAM
2122                                   zm3=zPAM                                   zm3=zPAM
# Line 2472  c     $                                 Line 2137  c     $                                
2137  *     (3 couples needed)  *     (3 couples needed)
2138  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2139                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
2140                                      if(DEBUG)print*,                                      if(verbose)print*,
2141       $                     '** warning ** number of identified '//       $                     '** warning ** number of identified '//
2142       $                     'triplets exceeds vector dimention '       $                     'triplets exceeds vector dimention '
2143       $                    ,'( ',ntrpt_max,' )'       $                    ,'( ',ntrpt_max,' )'
2144  c                                    good2=.false.  c                                    good2=.false.
2145  c                                    goto 880 !fill ntp and go to next event  c                                    goto 880 !fill ntp and go to next event
2146                                        do iv=1,nviews
2147    c                                       mask_view(iv) = 4
2148                                           mask_view(iv)=mask_view(iv)+ 2**3
2149                                        enddo
2150                                      iflag=1                                      iflag=1
2151                                      return                                      return
2152                                   endif                                   endif
# Line 2516  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp Line 2185  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp
2185                                endif                                endif
2186                             enddo !end loop on COPPIA 3                             enddo !end loop on COPPIA 3
2187                          enddo   !end loop on sensors - COPPIA 3                          enddo   !end loop on sensors - COPPIA 3
2188     30                     continue
2189                       enddo      !end loop on planes  - COPPIA 3                       enddo      !end loop on planes  - COPPIA 3
2190   30                  continue   31                  continue
2191                                            
2192   1                enddo         !end loop on COPPIA 2   1                enddo         !end loop on COPPIA 2
2193                 enddo            !end loop on sensors - COPPIA 2                 enddo            !end loop on sensors - COPPIA 2
2194     20            continue
2195              enddo               !end loop on planes  - COPPIA 2              enddo               !end loop on planes  - COPPIA 2
2196                            
2197           enddo                  !end loop on COPPIA1           enddo                  !end loop on COPPIA1
2198        enddo                     !end loop on sensors - COPPIA 1        enddo                     !end loop on sensors - COPPIA 1
2199     10   continue
2200        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
2201                
2202        if(DEBUG)then        if(DEBUG)then
# Line 2552  c     goto 880               !ntp fill Line 2224  c     goto 880               !ntp fill
2224        subroutine doub_to_YZcloud(iflag)        subroutine doub_to_YZcloud(iflag)
2225    
2226        include 'commontracker.f'        include 'commontracker.f'
2227          include 'level1.f'
2228        include 'common_momanhough.f'        include 'common_momanhough.f'
2229        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2230    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2231    
2232  *     output flag  *     output flag
2233  *     --------------  *     --------------
# Line 2588  c      common/dbg/DEBUG Line 2259  c      common/dbg/DEBUG
2259        distance=0        distance=0
2260        nclouds_yz=0              !number of clouds        nclouds_yz=0              !number of clouds
2261        npt_tot=0        npt_tot=0
2262          nloop=0                  
2263     90   continue                  
2264        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2265           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
2266                            
# Line 2691  c     print*,'*   idbref,idb2 ',idbref,i Line 2364  c     print*,'*   idbref,idb2 ',idbref,i
2364              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2365           enddo           enddo
2366  c     print*,'>>>> ',ncpused,npt,nplused  c     print*,'>>>> ',ncpused,npt,nplused
2367           if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  c         if(ncpused.lt.ncpyz_min)goto 2228 !next doublet
2368           if(npt.lt.nptyz_min)goto 2228 !next doublet           if(npt.lt.nptyz_min)goto 2228 !next doublet
2369           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2370                    
# Line 2699  c     print*,'>>>> ',ncpused,npt,nplused Line 2372  c     print*,'>>>> ',ncpused,npt,nplused
2372  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2373    
2374           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2375              if(DEBUG)print*,              if(verbose)print*,
2376       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2377       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2378       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2379  c               good2=.false.  c               good2=.false.
2380  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2381                do iv=1,nviews
2382    c               mask_view(iv) = 5
2383                   mask_view(iv) = mask_view(iv) + 2**4
2384                enddo
2385              iflag=1              iflag=1
2386              return              return
2387           endif           endif
# Line 2742  c$$$     $           ,(db_cloud(iii),iii Line 2419  c$$$     $           ,(db_cloud(iii),iii
2419        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2420                
2421                
2422          if(nloop.lt.nstepy)then      
2423            cutdistyz = cutdistyz+cutystep
2424            nloop     = nloop+1          
2425            goto 90                
2426          endif                    
2427          
2428        if(DEBUG)then        if(DEBUG)then
2429           print*,'---------------------- '           print*,'---------------------- '
2430           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
# Line 2768  c$$$     $           ,(db_cloud(iii),iii Line 2451  c$$$     $           ,(db_cloud(iii),iii
2451        subroutine trip_to_XZcloud(iflag)        subroutine trip_to_XZcloud(iflag)
2452    
2453        include 'commontracker.f'        include 'commontracker.f'
2454          include 'level1.f'
2455        include 'common_momanhough.f'        include 'common_momanhough.f'
2456        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2457    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2458    
2459  *     output flag  *     output flag
2460  *     --------------  *     --------------
# Line 2803  c      common/dbg/DEBUG Line 2485  c      common/dbg/DEBUG
2485        distance=0        distance=0
2486        nclouds_xz=0              !number of clouds                nclouds_xz=0              !number of clouds        
2487        npt_tot=0                 !total number of selected triplets        npt_tot=0                 !total number of selected triplets
2488          nloop=0                  
2489     91   continue                  
2490        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2491           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
2492  c     print*,'--------------'  c     print*,'--------------'
# Line 2904  c     print*,'check cp_used' Line 2588  c     print*,'check cp_used'
2588           do ip=1,nplanes           do ip=1,nplanes
2589              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2590           enddo           enddo
2591           if(ncpused.lt.ncpxz_min)goto 22288 !next triplet  c         if(ncpused.lt.ncpxz_min)goto 22288 !next triplet
2592           if(npt.lt.nptxz_min)goto 22288     !next triplet           if(npt.lt.nptxz_min)goto 22288     !next triplet
2593           if(nplused.lt.nplxz_min)goto 22288 !next doublet           if(nplused.lt.nplxz_min)goto 22288 !next triplet
2594                    
2595  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2596  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2597           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2598              if(DEBUG)print*,              if(verbose)print*,
2599       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2600       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2601       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2602  c     good2=.false.  c     good2=.false.
2603  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2604                do iv=1,nviews
2605    c               mask_view(iv) = 6
2606                   mask_view(iv) =  mask_view(iv) + 2**5
2607                enddo
2608              iflag=1              iflag=1
2609              return              return
2610           endif           endif
# Line 2952  c$$$     $           ,(tr_cloud(iii),iii Line 2640  c$$$     $           ,(tr_cloud(iii),iii
2640  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2641  22288    continue  22288    continue
2642        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2643          
2644           if(nloop.lt.nstepx)then      
2645             cutdistxz=cutdistxz+cutxstep
2646             nloop=nloop+1          
2647             goto 91                
2648           endif                    
2649          
2650        if(DEBUG)then        if(DEBUG)then
2651           print*,'---------------------- '           print*,'---------------------- '
2652           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
# Line 2974  c$$$     $           ,(tr_cloud(iii),iii Line 2668  c$$$     $           ,(tr_cloud(iii),iii
2668  **************************************************  **************************************************
2669    
2670        subroutine clouds_to_ctrack(iflag)        subroutine clouds_to_ctrack(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2671    
2672        include 'commontracker.f'        include 'commontracker.f'
2673          include 'level1.f'
2674        include 'common_momanhough.f'        include 'common_momanhough.f'
2675        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2676        include 'common_mini_2.f'        include 'common_mini_2.f'
2677        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
2678    
2679  c      logical DEBUG  
 c      common/dbg/DEBUG  
2680    
2681  *     output flag  *     output flag
2682  *     --------------  *     --------------
# Line 3002  c      common/dbg/DEBUG Line 2692  c      common/dbg/DEBUG
2692  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2693  *     list of matching couples in the combination  *     list of matching couples in the combination
2694  *     between a XZ and YZ cloud  *     between a XZ and YZ cloud
2695        integer cp_match(nplanes,ncouplemax)        integer cp_match(nplanes,2*ncouplemax)
2696        integer ncp_match(nplanes)        integer ncp_match(nplanes)
2697  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2698        integer hit_plane(nplanes)        integer hit_plane(nplanes)
2699  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2700  *     variables for track fitting  *     variables for track fitting
2701        double precision AL_INI(5)        double precision AL_INI(5)
2702        double precision tath  c      double precision tath
2703  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2704  c      real fitz(nplanes)        !z coordinates of the planes in cm  c      real fitz(nplanes)        !z coordinates of the planes in cm
2705    
# Line 3075  c      real fitz(nplanes)        !z coor Line 2765  c      real fitz(nplanes)        !z coor
2765                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2766              enddo              enddo
2767                            
2768              if(nplused.lt.nplxz_min)goto 888 !next doublet  c            if(nplused.lt.nplxz_min)goto 888 !next doublet
2769                if(nplused.lt.nplyz_min)goto 888 !next doublet
2770              if(ncp_ok.lt.ncpok)goto 888 !next cloud              if(ncp_ok.lt.ncpok)goto 888 !next cloud
2771                            
2772              if(DEBUG)then              if(DEBUG)then
# Line 3102  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p Line 2793  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p
2793  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2794                            
2795  *     -------> INITIAL GUESS <-------  *     -------> INITIAL GUESS <-------
2796              AL_INI(1)=dreal(alfaxz1_av(ixz))  cccc       SBAGLIATO
2797              AL_INI(2)=dreal(alfayz1_av(iyz))  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2798              AL_INI(4)=datan(dreal(alfayz2_av(iyz))  c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2799       $           /dreal(alfaxz2_av(ixz)))  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2800              tath=-dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))  c$$$     $           /dreal(alfaxz2_av(ixz)))
2801              AL_INI(3)=tath/sqrt(1+tath**2)  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2802              AL_INI(5)=(1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2803                c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2804  c     print*,'*******',AL_INI(5)  cccc       GIUSTO (ma si sua guess())
2805              if(AL_INI(5).gt.defmax)goto 888 !next cloud  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2806                c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2807  c     print*,'alfaxz2, alfayz2 '  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2808  c     $              ,alfaxz2_av(ixz),alfayz2_av(iyz)  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2809                c$$$            IF(alfaxz2_av(ixz).NE.0)THEN
2810  *     -------> INITIAL GUESS <-------  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2811  c     print*,'AL_INI ',(al_ini(i),i=1,5)  c$$$     $           /dreal(alfaxz2_av(ixz)))
2812                c$$$            ELSE
2813    c$$$               AL_INI(4) = acos(-1.)/2
2814    c$$$               IF(alfayz2_av(iyz).LT.0)AL_INI(4) = AL_INI(4)+acos(-1.)
2815    c$$$            ENDIF
2816    c$$$            IF(alfaxz2_av(ixz).LT.0)AL_INI(4)= acos(-1.)+ AL_INI(4)
2817    c$$$            AL_INI(4) = -acos(-1.) + AL_INI(4) !from incidence direction to tracking rs
2818    c$$$            
2819    c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2820    c$$$            
2821    c$$$            if(AL_INI(5).gt.defmax)goto 888 !next cloud
2822                            
2823              if(DEBUG)then              if(DEBUG)then
2824                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2825                 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 2870  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2870  *                                   *************************  *                                   *************************
2871  c                                    call xyz_PAM(icx,icy,is,  c                                    call xyz_PAM(icx,icy,is,
2872  c     $                                   'COG2','COG2',0.,0.)  c     $                                   'COG2','COG2',0.,0.)
2873    c                                    call xyz_PAM(icx,icy,is, !(1)
2874    c     $                                   PFAdef,PFAdef,0.,0.) !(1)
2875                                      call xyz_PAM(icx,icy,is, !(1)                                      call xyz_PAM(icx,icy,is, !(1)
2876       $                                   PFAdef,PFAdef,0.,0.) !(1)       $                                   PFAdef,PFAdef,0.,0.,0.,0.)
2877  *                                   *************************  *                                   *************************
2878  *                                   -----------------------------  *                                   -----------------------------
2879                                      xgood(nplanes-ip+1)=1.                                      xgood(nplanes-ip+1)=1.
# Line 3186  c     $                                 Line 2889  c     $                                
2889  *     **********************************************************  *     **********************************************************
2890  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
2891  *     **********************************************************  *     **********************************************************
2892    cccc  scommentare se si usa al_ini della nuvola
2893    c$$$                              do i=1,5
2894    c$$$                                 AL(i)=AL_INI(i)
2895    c$$$                              enddo
2896                                  call guess()
2897                                do i=1,5                                do i=1,5
2898                                   AL(i)=AL_INI(i)                                   AL_INI(i)=AL(i)
2899                                enddo                                enddo
2900                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
2901                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
2902                                call mini_2(jstep,ifail)                                iprint=0
2903    c                              if(DEBUG)iprint=1
2904                                  if(DEBUG)iprint=2
2905                                  call mini2(jstep,ifail,iprint)
2906                                if(ifail.ne.0) then                                if(ifail.ne.0) then
2907                                   if(DEBUG)then                                   if(DEBUG)then
2908                                      print *,                                      print *,
2909       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
2910       $                              //'(mini_2 in clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
2911                                        print*,'initial guess: '
2912    
2913                                        print*,'AL_INI(1) = ',AL_INI(1)
2914                                        print*,'AL_INI(2) = ',AL_INI(2)
2915                                        print*,'AL_INI(3) = ',AL_INI(3)
2916                                        print*,'AL_INI(4) = ',AL_INI(4)
2917                                        print*,'AL_INI(5) = ',AL_INI(5)
2918                                   endif                                   endif
2919                                   chi2=-chi2  c                                 chi2=-chi2
2920                                endif                                endif
2921  *     **********************************************************  *     **********************************************************
2922  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
# Line 3211  c     $                                 Line 2929  c     $                                
2929  *     --------------------------  *     --------------------------
2930                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
2931                                                                    
2932                                   if(DEBUG)print*,                                   if(verbose)print*,
2933       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
2934       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
2935       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
2936  c                                 good2=.false.  c                                 good2=.false.
2937  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
2938                                     do iv=1,nviews
2939    c                                    mask_view(iv) = 7
2940                                        mask_view(iv) = mask_view(iv) + 2**6
2941                                     enddo
2942                                   iflag=1                                   iflag=1
2943                                   return                                   return
2944                                endif                                endif
2945                                                                
2946                                ntracks = ntracks + 1                                ntracks = ntracks + 1
2947                                                                
 c$$$                              ndof=0                                  
2948                                do ip=1,nplanes                                do ip=1,nplanes
2949  c$$$                                 ndof=ndof  
 c$$$     $                                +int(xgood(ip))  
 c$$$     $                                +int(ygood(ip))  
2950                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
2951                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
2952                                   ZV_STORE(ip,ntracks)=sngl(zv(ip))                                                                       ZV_STORE(ip,ntracks)=sngl(zv(ip))                                    
# Line 3246  c$$$     $                               Line 2965  c$$$     $                              
2965                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2966                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
2967       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
2968                                        SENSOR_STORE(nplanes-ip+1,ntracks)
2969         $                              = is_cp(cp_match(ip,hit_plane(ip)))
2970                                        LADDER_STORE(nplanes-ip+1,ntracks)
2971         $                                   = LADDER(
2972         $                                   clx(ip,icp_cp(
2973         $                                   cp_match(ip,hit_plane(ip)
2974         $                                   ))));
2975                                   else                                   else
2976                                      CP_STORE(nplanes-ip+1,ntracks)=0                                      CP_STORE(nplanes-ip+1,ntracks)=0
2977                                        SENSOR_STORE(nplanes-ip+1,ntracks)=0
2978                                        LADDER_STORE(nplanes-ip+1,ntracks)=0
2979                                   endif                                   endif
2980                                     BX_STORE(nplanes-ip+1,ntracks)=0!I dont need it now
2981                                     BY_STORE(nplanes-ip+1,ntracks)=0!I dont need it now
2982                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   CLS_STORE(nplanes-ip+1,ntracks)=0
2983                                   do i=1,5                                   do i=1,5
2984                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
2985                                   enddo                                   enddo
2986                                enddo                                enddo
2987                                                                
 c$$$  *                             Number of Degree Of Freedom  
 c$$$  ndof=ndof-5                            
 c$$$  *                             reduced chi^2  
 c$$$  rchi2=chi2/dble(ndof)  
2988                                RCHI2_STORE(ntracks)=chi2                                RCHI2_STORE(ntracks)=chi2
2989                                                                
2990  *     --------------------------------  *     --------------------------------
# Line 3282  c$$$  rchi2=chi2/dble(ndof) Line 3008  c$$$  rchi2=chi2/dble(ndof)
3008           return           return
3009        endif        endif
3010                
3011    c$$$      if(DEBUG)then
3012    c$$$         print*,'****** TRACK CANDIDATES ***********'
3013    c$$$         print*,'#         R. chi2        RIG'
3014    c$$$         do i=1,ntracks
3015    c$$$            print*,i,' --- ',rchi2_store(i),' --- '
3016    c$$$     $           ,1./abs(AL_STORE(5,i))
3017    c$$$         enddo
3018    c$$$         print*,'***********************************'
3019    c$$$      endif
3020        if(DEBUG)then        if(DEBUG)then
3021           print*,'****** TRACK CANDIDATES ***********'          print*,'****** TRACK CANDIDATES *****************'
3022           print*,'#         R. chi2        RIG'          print*,'#         R. chi2        RIG         ndof'
3023           do i=1,ntracks          do i=1,ntracks
3024              print*,i,' --- ',rchi2_store(i),' --- '            ndof=0                !(1)
3025       $           ,1./abs(AL_STORE(5,i))            do ii=1,nplanes       !(1)
3026           enddo              ndof=ndof           !(1)
3027           print*,'***********************************'       $           +int(xgood_store(ii,i)) !(1)
3028         $           +int(ygood_store(ii,i)) !(1)
3029              enddo                 !(1)
3030              print*,i,' --- ',rchi2_store(i),' --- '
3031         $         ,1./abs(AL_STORE(5,i)),' --- ',ndof
3032            enddo
3033            print*,'*****************************************'
3034        endif        endif
3035                
3036                
# Line 3308  c$$$  rchi2=chi2/dble(ndof) Line 3049  c$$$  rchi2=chi2/dble(ndof)
3049    
3050        subroutine refine_track(ibest)        subroutine refine_track(ibest)
3051    
 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******************************************************  
3052    
3053        include 'commontracker.f'        include 'commontracker.f'
3054          include 'level1.f'
3055        include 'common_momanhough.f'        include 'common_momanhough.f'
3056        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3057        include 'common_mini_2.f'        include 'common_mini_2.f'
3058        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
       include 'level1.f'  
3059        include 'calib.f'        include 'calib.f'
3060    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
3061  *     flag to chose PFA  *     flag to chose PFA
3062        character*10 PFA        character*10 PFA
3063        common/FINALPFA/PFA        common/FINALPFA/PFA
3064    
3065          real k(6)
3066          DATA k/1.099730,0.418900,0.220939,0.220907,0.418771,1.100674/
3067    
3068          real xp,yp,zp
3069          real xyzp(3),bxyz(3)
3070          equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
3071    
3072  *     =================================================  *     =================================================
3073  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
3074  *                          and  *                          and
# Line 3338  c      common/dbg/DEBUG Line 3077  c      common/dbg/DEBUG
3077        call track_init        call track_init
3078        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3079    
3080             xP=XV_STORE(nplanes-ip+1,ibest)
3081             yP=YV_STORE(nplanes-ip+1,ibest)
3082             zP=ZV_STORE(nplanes-ip+1,ibest)
3083             call gufld(xyzp,bxyz)
3084             BX_STORE(nplanes-ip+1,ibest)=bxyz(1)
3085             BY_STORE(nplanes-ip+1,ibest)=bxyz(2)
3086    c$$$  bxyz(1)=0
3087    c$$$         bxyz(2)=0
3088    c$$$         bxyz(3)=0
3089    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3090  *     -------------------------------------------------  *     -------------------------------------------------
3091  *     If the plane has been already included, it just  *     If the plane has been already included, it just
3092  *     computes again the coordinates of the x-y couple  *     computes again the coordinates of the x-y couple
3093  *     using improved PFAs  *     using improved PFAs
3094  *     -------------------------------------------------  *     -------------------------------------------------
3095    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3096           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
3097       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
3098                            
# Line 3356  c      common/dbg/DEBUG Line 3106  c      common/dbg/DEBUG
3106       $           ,ip_cp(id),ip       $           ,ip_cp(id),ip
3107              icx=clx(ip,icp)              icx=clx(ip,icp)
3108              icy=cly(ip,icp)              icy=cly(ip,icp)
3109    c            call xyz_PAM(icx,icy,is,
3110    c     $           PFA,PFA,
3111    c     $           AXV_STORE(nplanes-ip+1,ibest),
3112    c     $           AYV_STORE(nplanes-ip+1,ibest))
3113              call xyz_PAM(icx,icy,is,              call xyz_PAM(icx,icy,is,
 c     $           'ETA2','ETA2',  
3114       $           PFA,PFA,       $           PFA,PFA,
3115       $           AXV_STORE(nplanes-ip+1,ibest),       $           AXV_STORE(nplanes-ip+1,ibest),
3116       $           AYV_STORE(nplanes-ip+1,ibest))       $           AYV_STORE(nplanes-ip+1,ibest),
3117  c$$$  call xyz_PAM(icx,icy,is,       $           bxyz(1),
3118  c$$$  $              'COG2','COG2',       $           bxyz(2)
3119  c$$$  $              0.,       $           )
3120  c$$$  $              0.)  
3121              xm(nplanes-ip+1) = xPAM              xm(nplanes-ip+1) = xPAM
3122              ym(nplanes-ip+1) = yPAM              ym(nplanes-ip+1) = yPAM
3123              zm(nplanes-ip+1) = zPAM              zm(nplanes-ip+1) = zPAM
# Line 3373  c$$$  $              0.) Line 3126  c$$$  $              0.)
3126              resx(nplanes-ip+1) = resxPAM              resx(nplanes-ip+1) = resxPAM
3127              resy(nplanes-ip+1) = resyPAM              resy(nplanes-ip+1) = resyPAM
3128    
3129  c            dedxtrk(nplanes-ip+1) = (dedx(icx)+dedx(icy))/2. !(1)              dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3130              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)  
3131                            
3132    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3133  *     -------------------------------------------------  *     -------------------------------------------------
3134  *     If the plane has NOT  been already included,  *     If the plane has NOT  been already included,
3135  *     it tries to include a COUPLE or a single cluster  *     it tries to include a COUPLE or a single cluster
3136  *     -------------------------------------------------  *     -------------------------------------------------
3137    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3138           else                             else                  
3139                                
3140              xgood(nplanes-ip+1)=0              xgood(nplanes-ip+1)=0
# Line 3388  c            dedxtrk(nplanes-ip+1) = (de Line 3142  c            dedxtrk(nplanes-ip+1) = (de
3142                                
3143  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3144  *     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)  
3145              call whichsensor(ip,xP,yP,nldt,ist)              call whichsensor(ip,xP,yP,nldt,ist)
3146  *     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
3147              if(nldt.eq.0.or.ist.eq.0)goto 133              if(nldt.eq.0.or.ist.eq.0)goto 133
3148    
3149                SENSOR_STORE(nplanes-ip+1,IBEST)=ist
3150                LADDER_STORE(nplanes-ip+1,IBEST)=nldt
3151  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3152    
3153              if(DEBUG)then              if(DEBUG)then
# Line 3430  c     $              cl_used(icy).eq.1.o Line 3184  c     $              cl_used(icy).eq.1.o
3184  *            *          
3185                 call xyz_PAM(icx,icy,ist,                 call xyz_PAM(icx,icy,ist,
3186       $              PFA,PFA,       $              PFA,PFA,
 c     $              'ETA2','ETA2',  
3187       $              AXV_STORE(nplanes-ip+1,ibest),       $              AXV_STORE(nplanes-ip+1,ibest),
3188       $              AYV_STORE(nplanes-ip+1,ibest))       $              AYV_STORE(nplanes-ip+1,ibest),
3189         $              bxyz(1),
3190         $              bxyz(2)
3191         $              )
3192                                
3193                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3194    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3195                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3196                 if(DEBUG)print*,'( couple ',id                 if(DEBUG)print*,'( couple ',id
3197       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance
3198                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3199                    xmm = xPAM                    xmm = xPAM
3200                    ymm = yPAM                    ymm = yPAM
# Line 3446  c     $              'ETA2','ETA2', Line 3203  c     $              'ETA2','ETA2',
3203                    rymm = resyPAM                    rymm = resyPAM
3204                    distmin = distance                    distmin = distance
3205                    idm = id                                      idm = id                  
3206  c                 dedxmm = (dedx(icx)+dedx(icy))/2. !(1)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3207                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3208                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)  c     QUIQUI --> non devo moltiplicare per clinc?!?!?!
3209                      clincnewc=10*sqrt(rymm**2+rxmm**2 !QUIQUI
3210         $                 +RCHI2_STORE(ibest)*k(ip)*(cov(1,1)+cov(2,2))) !QUIQUI
3211                 endif                 endif
3212   1188          continue   1188          continue
3213              enddo               !end loop on couples on plane icp              enddo               !end loop on couples on plane icp
3214              if(distmin.le.clinc)then                    c            if(distmin.le.clinc)then     !QUIQUI              
3215                if(distmin.le.clincnewc)then     !QUIQUI              
3216  *              -----------------------------------  *              -----------------------------------
3217                 xm(nplanes-ip+1) = xmm         !<<<                 xm(nplanes-ip+1) = xmm !<<<
3218                 ym(nplanes-ip+1) = ymm         !<<<                 ym(nplanes-ip+1) = ymm !<<<
3219                 zm(nplanes-ip+1) = zmm         !<<<                 zm(nplanes-ip+1) = zmm !<<<
3220                 xgood(nplanes-ip+1) = 1        !<<<                 xgood(nplanes-ip+1) = 1 !<<<
3221                 ygood(nplanes-ip+1) = 1        !<<<                 ygood(nplanes-ip+1) = 1 !<<<
3222                 resx(nplanes-ip+1)=rxmm        !<<<                 resx(nplanes-ip+1)=rxmm !<<<
3223                 resy(nplanes-ip+1)=rymm        !<<<                 resy(nplanes-ip+1)=rymm !<<<
3224  c              dedxtrk(nplanes-ip+1) = dedxmm !<<<  !(1)                 dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3225                 dedxtrk_x(nplanes-ip+1) = dedxmmx    !(1)                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
                dedxtrk_y(nplanes-ip+1) = dedxmmy    !(1)  
3226  *              -----------------------------------  *              -----------------------------------
3227                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
3228                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG)print*,'%%%% included couple ',idm
3229       $              ,' (norm.dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clinc,' )'
3230                 goto 133         !next plane                 goto 133         !next plane
3231              endif              endif
3232  *     ================================================  *     ================================================
# Line 3500  c            if(DEBUG)print*,'>>>> try t Line 3259  c            if(DEBUG)print*,'>>>> try t
3259  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
3260                 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)
3261  *                                              !jump to the Y cluster  *                                              !jump to the Y cluster
3262    c               call xyz_PAM(icx,0,ist,
3263    c     $              PFA,PFA,
3264    c     $              AXV_STORE(nplanes-ip+1,ibest),0.)              
3265                 call xyz_PAM(icx,0,ist,                 call xyz_PAM(icx,0,ist,
 c     $              'ETA2','ETA2',  
3266       $              PFA,PFA,       $              PFA,PFA,
3267       $              AXV_STORE(nplanes-ip+1,ibest),0.)                     $              AXV_STORE(nplanes-ip+1,ibest),0.,
3268         $              bxyz(1),
3269         $              bxyz(2)
3270         $              )              
3271                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3272  c     if(DEBUG)print*,'normalized distance ',distance  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3273                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG)print*,'( cl-X ',icx
3274       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3275                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3276                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3277                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3519  c     if(DEBUG)print*,'normalized distan Line 3283  c     if(DEBUG)print*,'normalized distan
3283                    rymm = resyPAM                    rymm = resyPAM
3284                    distmin = distance                    distmin = distance
3285                    iclm = icx                    iclm = icx
3286  c                  dedxmm = dedx(icx) !(1)  c                  dedxmm = sgnl(icx) !(1)
3287                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3288                    dedxmmy = 0.        !(1)                    dedxmmy = 0.        !(1)
3289                 endif                                   endif                  
3290  11881          continue  11881          continue
# Line 3528  c                  dedxmm = dedx(icx) !( Line 3292  c                  dedxmm = dedx(icx) !(
3292  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
3293                 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)
3294  *                                              !jump to the next couple  *                                              !jump to the next couple
3295    c               call xyz_PAM(0,icy,ist,
3296    c     $              PFA,PFA,
3297    c     $              0.,AYV_STORE(nplanes-ip+1,ibest))
3298                 call xyz_PAM(0,icy,ist,                 call xyz_PAM(0,icy,ist,
 c     $              'ETA2','ETA2',  
3299       $              PFA,PFA,       $              PFA,PFA,
3300       $              0.,AYV_STORE(nplanes-ip+1,ibest))       $              0.,AYV_STORE(nplanes-ip+1,ibest),
3301         $              bxyz(1),
3302         $              bxyz(2)
3303         $              )
3304                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3305    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3306                 if(DEBUG)print*,'( cl-Y ',icy                 if(DEBUG)print*,'( cl-Y ',icy
3307       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3308                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3309                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3310                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3546  c     $              'ETA2','ETA2', Line 3316  c     $              'ETA2','ETA2',
3316                    rymm = resyPAM                    rymm = resyPAM
3317                    distmin = distance                    distmin = distance
3318                    iclm = icy                    iclm = icy
3319  c                 dedxmm = dedx(icy)  !(1)  c                 dedxmm = sgnl(icy)  !(1)
3320                    dedxmmx = 0.        !(1)                    dedxmmx = 0.        !(1)
3321                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3322                 endif                                   endif                  
3323  11882          continue  11882          continue
3324              enddo               !end loop on cluster inside couples              enddo               !end loop on cluster inside couples
3325  *----- single clusters -----------------------------------------------      *----- single clusters -----------------------------------------------  
3326    c            print*,'## ncls(',ip,') ',ncls(ip)
3327              do ic=1,ncls(ip)    !loop on single clusters              do ic=1,ncls(ip)    !loop on single clusters
3328                 icl=cls(ip,ic)                 icl=cls(ip,ic)
3329  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 3332  c               if(cl_used(icl).eq.1.or.
3332       $              .false.)goto 18882      !jump to the next singlet       $              .false.)goto 18882      !jump to the next singlet
3333                 if(mod(VIEW(icl),2).eq.0)then!<---- X view                 if(mod(VIEW(icl),2).eq.0)then!<---- X view
3334                    call xyz_PAM(icl,0,ist,                    call xyz_PAM(icl,0,ist,
 c     $                 'ETA2','ETA2',  
3335       $                 PFA,PFA,       $                 PFA,PFA,
3336       $                 AXV_STORE(nplanes-ip+1,ibest),0.)       $                 AXV_STORE(nplanes-ip+1,ibest),0.,
3337         $                 bxyz(1),
3338         $                 bxyz(2)
3339         $                 )
3340                 else                         !<---- Y view                 else                         !<---- Y view
3341                    call xyz_PAM(0,icl,ist,                    call xyz_PAM(0,icl,ist,
 c     $                 'ETA2','ETA2',  
3342       $                 PFA,PFA,       $                 PFA,PFA,
3343       $                 0.,AYV_STORE(nplanes-ip+1,ibest))       $                 0.,AYV_STORE(nplanes-ip+1,ibest),
3344         $                 bxyz(1),
3345         $                 bxyz(2)
3346         $                 )
3347                 endif                 endif
3348    
3349                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3350    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3351                 if(DEBUG)print*,'( cl-s ',icl                 if(DEBUG)print*,'( cl-s ',icl
3352       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance,'<',distmin,' ?'
3353                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3354                      if(DEBUG)print*,'YES'
3355                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3356                    ymm_A = yPAM_A                    ymm_A = yPAM_A
3357                    zmm_A = zPAM_A                    zmm_A = zPAM_A
# Line 3585  c     $                 'ETA2','ETA2', Line 3362  c     $                 'ETA2','ETA2',
3362                    rymm = resyPAM                    rymm = resyPAM
3363                    distmin = distance                      distmin = distance  
3364                    iclm = icl                    iclm = icl
 c                  dedxmm = dedx(icl)                   !(1)  
3365                    if(mod(VIEW(icl),2).eq.0)then !<---- X view                    if(mod(VIEW(icl),2).eq.0)then !<---- X view
3366                       dedxmmx = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3367                       dedxmmy = 0.                       !(1)                       dedxmmy = 0.                  
3368                    else          !<---- Y view                    else          !<---- Y view
3369                       dedxmmx = 0.                       !(1)                       dedxmmx = 0.                  
3370                       dedxmmy = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3371                    endif                    endif
3372                 endif                                   endif                  
3373  18882          continue  18882          continue
3374              enddo               !end loop on single clusters              enddo               !end loop on single clusters
3375    c            print*,'## distmin ', distmin,' clinc ',clinc
3376    
3377              if(distmin.le.clinc)then                    c     QUIQUI------------
3378                  c     anche qui: non ci vuole clinc???
3379                 CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<                  if(iclm.ne.0)then
 *              ----------------------------  
3380                 if(mod(VIEW(iclm),2).eq.0)then                 if(mod(VIEW(iclm),2).eq.0)then
3381                    XGOOD(nplanes-ip+1)=1.                    clincnew=
3382                    resx(nplanes-ip+1)=rxmm       $                 20*
3383                    if(DEBUG)print*,'%%%% included X-cl ',iclm       $                 sqrt(rxmm**2+RCHI2_STORE(ibest)*k(ip)*cov(1,1))
3384       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'                 else if(mod(VIEW(iclm),2).ne.0)then
3385                 else                    clincnew=
3386                    YGOOD(nplanes-ip+1)=1.       $                 10*
3387                    resy(nplanes-ip+1)=rymm       $                 sqrt(rymm**2+RCHI2_STORE(ibest)*k(ip)*cov(2,2))
3388                    if(DEBUG)print*,'%%%% included Y-cl ',iclm                 endif
3389       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'  c     QUIQUI------------
3390                  
3391                   if(distmin.le.clincnew)then   !QUIQUI
3392    c     if(distmin.le.clinc)then          !QUIQUI          
3393                      
3394                      CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<    
3395    *     ----------------------------
3396    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3397                      if(mod(VIEW(iclm),2).eq.0)then
3398                         XGOOD(nplanes-ip+1)=1.
3399                         resx(nplanes-ip+1)=rxmm
3400                         if(DEBUG)print*,'%%%% included X-cl ',iclm
3401         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3402         $                    ,', dist.= ',distmin
3403         $                    ,', cut ',clinc,' )'
3404                      else
3405                         YGOOD(nplanes-ip+1)=1.
3406                         resy(nplanes-ip+1)=rymm
3407                         if(DEBUG)print*,'%%%% included Y-cl ',iclm
3408         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3409         $                    ,', dist.= ', distmin
3410         $                    ,', cut ',clinc,' )'
3411                      endif
3412    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3413    *     ----------------------------
3414                      xm_A(nplanes-ip+1) = xmm_A
3415                      ym_A(nplanes-ip+1) = ymm_A
3416                      xm_B(nplanes-ip+1) = xmm_B
3417                      ym_B(nplanes-ip+1) = ymm_B
3418                      zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3419                      dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3420                      dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3421    *     ----------------------------
3422                 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)  
 *              ----------------------------  
3423              endif              endif
3424           endif           endif
3425   133     continue   133     continue
# Line 3640  c              dedxtrk(nplanes-ip+1) = d Line 3438  c              dedxtrk(nplanes-ip+1) = d
3438  *                                                 *  *                                                 *
3439  *                                                 *  *                                                 *
3440  **************************************************  **************************************************
 cccccc 12/08/2006 modified by elena ---> (1)  
3441  *  *
3442        subroutine clean_XYclouds(ibest,iflag)        subroutine clean_XYclouds(ibest,iflag)
3443    
3444        include 'commontracker.f'        include 'commontracker.f'
3445          include 'level1.f'
3446        include 'common_momanhough.f'        include 'common_momanhough.f'
3447        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  
   
3448    
3449        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3450    
# Line 3663  c      common/dbg/DEBUG Line 3454  c      common/dbg/DEBUG
3454              if(id.ne.0)then              if(id.ne.0)then
3455                 iclx=clx(ip,icp_cp(id))                 iclx=clx(ip,icp_cp(id))
3456                 icly=cly(ip,icp_cp(id))                 icly=cly(ip,icp_cp(id))
3457  c               cl_used(iclx)=1  !tag used clusters                 cl_used(iclx)=ntrk  !tag used clusters
3458  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)  
3459              elseif(icl.ne.0)then              elseif(icl.ne.0)then
3460  c               cl_used(icl)=1   !tag used clusters                 cl_used(icl)=ntrk   !tag used clusters
                cl_used(icl)=ntrk   !tag used clusters !1)  
3461              endif              endif
3462                            
 c               if(DEBUG)then  
 c                  print*,ip,' <<< ',id  
 c               endif  
3463  *     -----------------------------  *     -----------------------------
3464  *     remove the couple from clouds  *     remove the couple from clouds
3465  *     remove also vitual couples containing the  *     remove also vitual couples containing the
# Line 3725  c               endif Line 3510  c               endif
3510    
3511    
3512    
 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$$$  
   
3513    
3514    
3515  *     ****************************************************  *     ****************************************************
3516    
3517        subroutine init_level2        subroutine init_level2
3518    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c*****************************************************  
   
3519        include 'commontracker.f'        include 'commontracker.f'
3520          include 'level1.f'
3521        include 'common_momanhough.f'        include 'common_momanhough.f'
3522        include 'level2.f'        include 'level2.f'
       include 'level1.f'  
3523    
3524    *     ---------------------------------
3525    *     variables initialized from level1
3526    *     ---------------------------------
3527        do i=1,nviews        do i=1,nviews
3528           good2(i)=good1(i)           good2(i)=good1(i)
3529             do j=1,nva1_view
3530                vkflag(i,j)=1
3531                if(cnnev(i,j).le.0)then
3532                   vkflag(i,j)=cnnev(i,j)
3533                endif
3534             enddo
3535        enddo        enddo
3536    *     ----------------
3537  c      good2 = 0!.false.  *     level2 variables
3538  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*****************************************************  
   
3539        NTRK = 0        NTRK = 0
3540        do it=1,NTRKMAX!NTRACKSMAX        do it=1,NTRKMAX
3541           IMAGE(IT)=0           IMAGE(IT)=0
3542           CHI2_nt(IT) = -100000.           CHI2_nt(IT) = -100000.
 c         BdL(IT) = 0.  
3543           do ip=1,nplanes           do ip=1,nplanes
3544              XM_nt(IP,IT) = 0              XM_nt(IP,IT) = 0
3545              YM_nt(IP,IT) = 0              YM_nt(IP,IT) = 0
3546              ZM_nt(IP,IT) = 0              ZM_nt(IP,IT) = 0
3547              RESX_nt(IP,IT) = 0              RESX_nt(IP,IT) = 0
3548              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3549                TAILX_nt(IP,IT) = 0
3550                TAILY_nt(IP,IT) = 0
3551                XBAD(IP,IT) = 0
3552                YBAD(IP,IT) = 0
3553              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3554              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
3555  c*****************************************************              LS(IP,IT) = 0
 cccccc 11/9/2005 modified by david fedele  
3556              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3557              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
 c******************************************************  
 cccccc 17/8/2006 modified by elena  
3558              CLTRX(IP,IT) = 0              CLTRX(IP,IT) = 0
3559              CLTRY(IP,IT) = 0              CLTRY(IP,IT) = 0
3560           enddo           enddo
# Line 3893  cccccc 17/8/2006 modified by elena Line 3565  cccccc 17/8/2006 modified by elena
3565              enddo                                enddo                  
3566           enddo                             enddo                  
3567        enddo        enddo
         
         
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3568        nclsx=0        nclsx=0
3569        nclsy=0              nclsy=0      
3570        do ip=1,NSINGMAX        do ip=1,NSINGMAX
3571          planex(ip)=0          planex(ip)=0
 c        xs(ip)=0  
3572          xs(1,ip)=0          xs(1,ip)=0
3573          xs(2,ip)=0          xs(2,ip)=0
3574          sgnlxs(ip)=0          sgnlxs(ip)=0
3575          planey(ip)=0          planey(ip)=0
 c        ys(ip)=0  
3576          ys(1,ip)=0          ys(1,ip)=0
3577          ys(2,ip)=0          ys(2,ip)=0
3578          sgnlys(ip)=0          sgnlys(ip)=0
3579        enddo        enddo
 c*******************************************************  
3580        end        end
3581    
3582    
# Line 3926  c*************************************** Line 3591  c***************************************
3591  ************************************************************  ************************************************************
3592    
3593    
3594          subroutine init_hough
3595    
3596          include 'commontracker.f'
3597          include 'level1.f'
3598          include 'common_momanhough.f'
3599          include 'common_hough.f'
3600          include 'level2.f'
3601    
3602          ntrpt_nt=0
3603          ndblt_nt=0
3604          NCLOUDS_XZ_nt=0
3605          NCLOUDS_YZ_nt=0
3606          do idb=1,ndblt_max_nt
3607             db_cloud_nt(idb)=0
3608             alfayz1_nt(idb)=0      
3609             alfayz2_nt(idb)=0      
3610          enddo
3611          do itr=1,ntrpt_max_nt
3612             tr_cloud_nt(itr)=0
3613             alfaxz1_nt(itr)=0      
3614             alfaxz2_nt(itr)=0      
3615             alfaxz3_nt(itr)=0      
3616          enddo
3617          do idb=1,ncloyz_max      
3618            ptcloud_yz_nt(idb)=0    
3619            alfayz1_av_nt(idb)=0    
3620            alfayz2_av_nt(idb)=0    
3621          enddo                    
3622          do itr=1,ncloxz_max      
3623            ptcloud_xz_nt(itr)=0    
3624            alfaxz1_av_nt(itr)=0    
3625            alfaxz2_av_nt(itr)=0    
3626            alfaxz3_av_nt(itr)=0    
3627          enddo                    
3628    
3629          ntrpt=0                  
3630          ndblt=0                  
3631          NCLOUDS_XZ=0              
3632          NCLOUDS_YZ=0              
3633          do idb=1,ndblt_max        
3634            db_cloud(idb)=0        
3635            cpyz1(idb)=0            
3636            cpyz2(idb)=0            
3637            alfayz1(idb)=0          
3638            alfayz2(idb)=0          
3639          enddo                    
3640          do itr=1,ntrpt_max        
3641            tr_cloud(itr)=0        
3642            cpxz1(itr)=0            
3643            cpxz2(itr)=0            
3644            cpxz3(itr)=0            
3645            alfaxz1(itr)=0          
3646            alfaxz2(itr)=0          
3647            alfaxz3(itr)=0          
3648          enddo                    
3649          do idb=1,ncloyz_max      
3650            ptcloud_yz(idb)=0      
3651            alfayz1_av(idb)=0      
3652            alfayz2_av(idb)=0      
3653            do idbb=1,ncouplemaxtot
3654              cpcloud_yz(idb,idbb)=0
3655            enddo                  
3656          enddo                    
3657          do itr=1,ncloxz_max      
3658            ptcloud_xz(itr)=0      
3659            alfaxz1_av(itr)=0      
3660            alfaxz2_av(itr)=0      
3661            alfaxz3_av(itr)=0      
3662            do itrr=1,ncouplemaxtot
3663              cpcloud_xz(itr,itrr)=0
3664            enddo                  
3665          enddo                    
3666          end
3667    ************************************************************
3668    *
3669    *
3670    *
3671    *
3672    *
3673    *
3674    *
3675    ************************************************************
3676    
3677    
3678        subroutine fill_level2_tracks(ntr)        subroutine fill_level2_tracks(ntr)
3679    
3680  *     -------------------------------------------------------  *     -------------------------------------------------------
# Line 3937  c*************************************** Line 3686  c***************************************
3686            
3687        include 'commontracker.f'        include 'commontracker.f'
3688        include 'level1.f'        include 'level1.f'
3689          include 'common_momanhough.f'
3690        include 'level2.f'        include 'level2.f'
3691        include 'common_mini_2.f'        include 'common_mini_2.f'
3692        include 'common_momanhough.f'        include 'calib.f'
3693        real sinth,phi,pig        !(4)  
3694          character*10 PFA
3695          common/FINALPFA/PFA
3696    
3697          real sinth,phi,pig
3698          integer ssensor,sladder
3699        pig=acos(-1.)        pig=acos(-1.)
3700    
3701  c      good2=1!.true.  *     -------------------------------------
3702        chi2_nt(ntr)        = sngl(chi2)        chi2_nt(ntr)        = sngl(chi2)
3703        nstep_nt(ntr)       = 0!nstep        nstep_nt(ntr)       = nstep
3704    *     -------------------------------------
3705        phi   = al(4)             !(4)        phi   = al(4)          
3706        sinth = al(3)             !(4)        sinth = al(3)            
3707        if(sinth.lt.0)then        !(4)        if(sinth.lt.0)then      
3708           sinth = -sinth         !(4)           sinth = -sinth        
3709           phi = phi + pig        !(4)           phi = phi + pig      
3710        endif                     !(4)        endif                    
3711        npig = aint(phi/(2*pig))  !(4)        npig = aint(phi/(2*pig))
3712        phi = phi - npig*2*pig    !(4)        phi = phi - npig*2*pig  
3713        if(phi.lt.0)              !(4)        if(phi.lt.0)            
3714       $     phi = phi + 2*pig    !(4)       $     phi = phi + 2*pig  
3715        al(4) = phi               !(4)        al(4) = phi              
3716        al(3) = sinth             !(4)        al(3) = sinth            
 *****************************************************  
3717        do i=1,5        do i=1,5
3718           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3719           do j=1,5           do j=1,5
3720              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3721           enddo           enddo
 c     print*,al_nt(i,ntr)  
3722        enddo        enddo
3723          *     -------------------------------------      
3724        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
3725           xgood_nt(ip,ntr) = int(xgood(ip))           xgood_nt(ip,ntr) = int(xgood(ip))
3726           ygood_nt(ip,ntr) = int(ygood(ip))           ygood_nt(ip,ntr) = int(ygood(ip))
# Line 3976  c     print*,al_nt(i,ntr) Line 3729  c     print*,al_nt(i,ntr)
3729           zm_nt(ip,ntr)    = sngl(zm(ip))           zm_nt(ip,ntr)    = sngl(zm(ip))
3730           RESX_nt(IP,ntr)  = sngl(resx(ip))           RESX_nt(IP,ntr)  = sngl(resx(ip))
3731           RESY_nt(IP,ntr)  = sngl(resy(ip))           RESY_nt(IP,ntr)  = sngl(resy(ip))
3732             TAILX_nt(IP,ntr) = 0.
3733             TAILY_nt(IP,ntr) = 0.
3734           xv_nt(ip,ntr)    = sngl(xv(ip))           xv_nt(ip,ntr)    = sngl(xv(ip))
3735           yv_nt(ip,ntr)    = sngl(yv(ip))           yv_nt(ip,ntr)    = sngl(yv(ip))
3736           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3737           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3738           ayv_nt(ip,ntr)   = sngl(ayv(ip))           ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3739  c        dedxp(ip,ntr)    = sngl(dedxtrk(ip))   !(1)  c     l'avevo dimenticato!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3740           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)           factor = sqrt(
3741           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)         $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3742         $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3743         $        1. )
3744    c     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3745             dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3746             dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3747        
3748           id  = CP_STORE(ip,IDCAND)           ax   = axv_nt(ip,ntr)
3749             ay   = ayv_nt(ip,ntr)
3750             bfx  = BX_STORE(ip,IDCAND)
3751             bfy  = BY_STORE(ip,IDCAND)
3752             if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3753             if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3754             tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3755             angx     = 180.*atan(tgtemp)/acos(-1.)
3756             tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3757             angy    = 180.*atan(tgtemp)/acos(-1.)
3758            
3759    c         print*,'* ',ip,bfx,bfy,angx,angy
3760    
3761             id  = CP_STORE(ip,IDCAND) ! couple id
3762           icl = CLS_STORE(ip,IDCAND)           icl = CLS_STORE(ip,IDCAND)
3763             ssensor = -1
3764             sladder = -1
3765             ssensor = SENSOR_STORE(ip,IDCAND)
3766             sladder = LADDER_STORE(ip,IDCAND)
3767             if(ip.eq.6.and.ssensor.ne.0)ssensor = 3 - ssensor !notazione paolo x align
3768             LS(IP,ntr)      = ssensor+10*sladder
3769    
3770           if(id.ne.0)then           if(id.ne.0)then
3771    c           >>> is a couple
3772              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3773              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3774  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)              
3775    c$$$            nnnnx = npfastrips(clx(nplanes-ip+1,icp_cp(id)),PFA,angx)
3776    c$$$            nnnny = npfastrips(cly(nplanes-ip+1,icp_cp(id)),PFA,angy)            
3777    c$$$            xbad(ip,ntr)= nbadstrips(nnnnx,clx(nplanes-ip+1,icp_cp(id)))
3778    c$$$            ybad(ip,ntr)= nbadstrips(nnnny,cly(nplanes-ip+1,icp_cp(id)))
3779                xbad(ip,ntr)= nbadstrips(4,clx(nplanes-ip+1,icp_cp(id)))
3780                ybad(ip,ntr)= nbadstrips(4,cly(nplanes-ip+1,icp_cp(id)))
3781    
3782    
3783                if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3784         $           dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3785                if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3786         $           dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3787    
3788           elseif(icl.ne.0)then           elseif(icl.ne.0)then
3789              if(mod(VIEW(icl),2).eq.0)cltrx(ip,ntr)=icl  
3790              if(mod(VIEW(icl),2).eq.1)cltry(ip,ntr)=icl              if(mod(VIEW(icl),2).eq.0)then
3791  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)                 cltrx(ip,ntr)=icl
3792    c$$$               nnnnn = npfastrips(icl,PFA,angx)
3793    c$$$               xbad(ip,ntr) = nbadstrips(nnnnn,icl)
3794                   xbad(ip,ntr) = nbadstrips(4,icl)
3795    
3796                   if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3797                elseif(mod(VIEW(icl),2).eq.1)then
3798                   cltry(ip,ntr)=icl
3799    c$$$               nnnnn = npfastrips(icl,PFA,angy)
3800    c$$$               ybad(ip,ntr) = nbadstrips(nnnnn,icl)
3801                   ybad(ip,ntr) = nbadstrips(4,icl)
3802                   if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3803                endif
3804    
3805           endif                     endif          
3806    
3807        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)  
3808    
3809    
3810    c$$$      print*,(xgood(i),i=1,6)
3811    c$$$      print*,(ygood(i),i=1,6)
3812    c$$$      print*,(ls(i,ntr),i=1,6)
3813    c$$$      print*,(dedx_x(i,ntr),i=1,6)
3814    c$$$      print*,(dedx_y(i,ntr),i=1,6)
3815    c$$$      print*,'-----------------------'
3816    
3817        end        end
3818    
3819        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*****************************************************  
3820    
3821  *     -------------------------------------------------------  *     -------------------------------------------------------
3822  *     This routine fills the  elements of the variables  *     This routine fills the  elements of the variables
# Line 4022  c*************************************** Line 3825  c***************************************
3825  *     -------------------------------------------------------  *     -------------------------------------------------------
3826    
3827        include 'commontracker.f'        include 'commontracker.f'
       include 'level1.f'  
       include 'level2.f'  
3828        include 'calib.f'        include 'calib.f'
3829          include 'level1.f'
3830        include 'common_momanhough.f'        include 'common_momanhough.f'
3831          include 'level2.f'
3832        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3833    
3834  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
 c      good2=1!.true.  
3835        nclsx = 0        nclsx = 0
3836        nclsy = 0        nclsy = 0
3837    
3838          do iv = 1,nviews
3839    c         if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
3840             good2(iv) = good2(iv) + mask_view(iv)*2**8
3841          enddo
3842    
3843        do icl=1,nclstr1        do icl=1,nclstr1
3844           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
3845              ip=nplanes-npl(VIEW(icl))+1                          ip=nplanes-npl(VIEW(icl))+1            
3846              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
3847                 nclsx = nclsx + 1                 nclsx = nclsx + 1
3848                 planex(nclsx) = ip                 planex(nclsx) = ip
3849                 sgnlxs(nclsx) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3850                   if(nsatstrips(icl).gt.0)sgnlxs(nclsx)=-sgnlxs(nclsx)
3851                 clsx(nclsx)   = icl                 clsx(nclsx)   = icl
3852                 do is=1,2                 do is=1,2
3853  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
3854                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
3855                      call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
3856                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2
3857                 enddo                 enddo
3858  c$$$               print*,'nclsx         ',nclsx  c$$$               print*,'nclsx         ',nclsx
# Line 4054  c$$$               print*,'xs(2,nclsx)   Line 3863  c$$$               print*,'xs(2,nclsx)  
3863              else                          !=== Y views              else                          !=== Y views
3864                 nclsy = nclsy + 1                 nclsy = nclsy + 1
3865                 planey(nclsy) = ip                 planey(nclsy) = ip
3866                 sgnlys(nclsy) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3867                   if(nsatstrips(icl).gt.0)sgnlys(nclsy)=-sgnlys(nclsy)
3868                 clsy(nclsy)   = icl                 clsy(nclsy)   = icl
3869                 do is=1,2                 do is=1,2
3870  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
3871                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
3872                      call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
3873                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2
3874                 enddo                 enddo
3875  c$$$               print*,'nclsy         ',nclsy  c$$$               print*,'nclsy         ',nclsy
# Line 4068  c$$$               print*,'ys(1,nclsy)   Line 3879  c$$$               print*,'ys(1,nclsy)  
3879  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)
3880              endif              endif
3881           endif           endif
 c      print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)  
3882    
3883  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
3884           whichtrack(icl) = cl_used(icl)           whichtrack(icl) = cl_used(icl)
# Line 4076  c      print*,icl,cl_used(icl),cl_good(i Line 3886  c      print*,icl,cl_used(icl),cl_good(i
3886        enddo        enddo
3887        end        end
3888    
3889    ***************************************************
3890    *                                                 *
3891    *                                                 *
3892    *                                                 *
3893    *                                                 *
3894    *                                                 *
3895    *                                                 *
3896    **************************************************
3897    
3898          subroutine fill_hough
3899    
3900    *     -------------------------------------------------------
3901    *     This routine fills the  variables related to the hough
3902    *     transform, for the debig n-tuple
3903    *     -------------------------------------------------------
3904    
3905          include 'commontracker.f'
3906          include 'level1.f'
3907          include 'common_momanhough.f'
3908          include 'common_hough.f'
3909          include 'level2.f'
3910    
3911          if(.false.
3912         $     .or.ntrpt.gt.ntrpt_max_nt
3913         $     .or.ndblt.gt.ndblt_max_nt
3914         $     .or.NCLOUDS_XZ.gt.ncloxz_max
3915         $     .or.NCLOUDS_yZ.gt.ncloyz_max
3916         $     )then
3917             ntrpt_nt=0
3918             ndblt_nt=0
3919             NCLOUDS_XZ_nt=0
3920             NCLOUDS_YZ_nt=0
3921          else
3922             ndblt_nt=ndblt
3923             ntrpt_nt=ntrpt
3924             if(ndblt.ne.0)then
3925                do id=1,ndblt
3926                   alfayz1_nt(id)=alfayz1(id) !Y0
3927                   alfayz2_nt(id)=alfayz2(id) !tg theta-yz
3928                enddo
3929             endif
3930             if(ndblt.ne.0)then
3931                do it=1,ntrpt
3932                   alfaxz1_nt(it)=alfaxz1(it) !X0
3933                   alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
3934                   alfaxz3_nt(it)=alfaxz3(it) !1/r
3935                enddo
3936             endif
3937             nclouds_yz_nt=nclouds_yz
3938             nclouds_xz_nt=nclouds_xz
3939             if(nclouds_yz.ne.0)then
3940                nnn=0
3941                do iyz=1,nclouds_yz
3942                   ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
3943                   alfayz1_av_nt(iyz)=alfayz1_av(iyz)
3944                   alfayz2_av_nt(iyz)=alfayz2_av(iyz)
3945                   nnn=nnn+ptcloud_yz(iyz)
3946                enddo
3947                do ipt=1,nnn
3948                   db_cloud_nt(ipt)=db_cloud(ipt)
3949                 enddo
3950             endif
3951             if(nclouds_xz.ne.0)then
3952                nnn=0
3953                do ixz=1,nclouds_xz
3954                   ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
3955                   alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
3956                   alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
3957                   alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
3958                   nnn=nnn+ptcloud_xz(ixz)              
3959                enddo
3960                do ipt=1,nnn
3961                  tr_cloud_nt(ipt)=tr_cloud(ipt)
3962                 enddo
3963             endif
3964          endif
3965          end
3966          

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

  ViewVC Help
Powered by ViewVC 1.1.23