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

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.23

  ViewVC Help
Powered by ViewVC 1.1.23