/[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.1 by mocchiut, Fri May 19 13:15:54 2006 UTC revision 1.34 by pam-fi, Wed Mar 5 17:00:20 2008 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'  
         
       logical DEBUG  
       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  Line 74 
74  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
75  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
76    
77  c      iflag=0  
78        call cl_to_couples(iflag)        call cl_to_couples(iflag)
79        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
80           goto 880               !fill ntp and go to next event                       goto 880               !go to next event
81        endif        endif
82                
 *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  
 *     selezione di tracce pulite per diagnostica  
 *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  
 c$$$         if(DEBUG)then  
 c$$$            do ip=1,nplanes  
 c$$$               if(ncp_plane(ip).ne.1)good2=.false.  
 c$$$            enddo  
 c$$$c            if(good2.eq.0)goto 100!next event  
 c$$$c            if(good2.eq.0)goto 880!fill ntp and go to next event  
 c$$$         endif  
           
   
   
83  *-----------------------------------------------------  *-----------------------------------------------------
84  *-----------------------------------------------------  *-----------------------------------------------------
85  *     HOUGH TRASFORM  *     HOUGH TRASFORM
# Line 91  c$$$         endif Line 108  c$$$         endif
108  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
109  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
110    
111  c      iflag=0  
112        call cp_to_doubtrip(iflag)        call cp_to_doubtrip(iflag)
113        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
114           goto 880               !fill ntp and go to next event                       goto 880               !go to next event            
115        endif        endif
116                
117                
# Line 123  c      iflag=0 Line 140  c      iflag=0
140  *     $     ,ptcloud_xz,tr_cloud,cpcloud_xz            *     $     ,ptcloud_xz,tr_cloud,cpcloud_xz          
141  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
142  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
143    *     count number of hit planes
144          planehit=0                
145          do np=1,nplanes          
146            if(ncp_plane(np).ne.0)then  
147              planehit=planehit+1  
148            endif                  
149          enddo                    
150          if(planehit.lt.3) goto 880 ! exit              
151          
152          nptxz_min=x_min_start              
153          nplxz_min=x_min_start              
154                
155          nptyz_min=y_min_start              
156          nplyz_min=y_min_start              
157    
158  c      iflag=0        cutdistyz=cutystart      
159          cutdistxz=cutxstart      
160    
161     878  continue
162        call doub_to_YZcloud(iflag)        call doub_to_YZcloud(iflag)
163        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
164           goto 880               !fill ntp and go to next event                       goto 880               !fill ntp and go to next event            
165        endif        endif
166  c      iflag=0        if(nclouds_yz.eq.0.and.cutdistyz.lt.maxcuty)then
167            if(cutdistyz.lt.maxcuty/2)then
168              cutdistyz=cutdistyz+cutystep
169            else
170              cutdistyz=cutdistyz+(3*cutystep)
171            endif
172            goto 878                
173          endif                    
174    
175          if(planehit.eq.3) goto 881          
176          
177     879  continue  
178        call trip_to_XZcloud(iflag)        call trip_to_XZcloud(iflag)
179        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
180           goto 880               !fill ntp and go to next event                       goto 880               !fill ntp and go to next event            
181        endif        endif
182                                    
183          if(nclouds_xz.eq.0.and.cutdistxz.lt.maxcutx)then
184            cutdistxz=cutdistxz+cutxstep
185            goto 879                
186          endif                    
187    
188        
189     881  continue  
190    *     if there is at least three planes on the Y view decreases cuts on X view
191          if(nclouds_xz.eq.0.and.nclouds_yz.gt.0.and.
192         $     nplxz_min.ne.y_min_start)then
193            nptxz_min=x_min_step    
194            nplxz_min=x_min_start-x_min_step              
195            goto 879                
196          endif                    
197            
198   880  return   880  return
199        end        end
200    
# Line 144  c      iflag=0 Line 204  c      iflag=0
204        subroutine track_fitting(iflag)        subroutine track_fitting(iflag)
205    
206        include 'commontracker.f'        include 'commontracker.f'
207          include 'level1.f'
208        include 'common_momanhough.f'        include 'common_momanhough.f'
209        include 'common_mech.f'        include 'common_mech.f'
210        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
211        include 'common_mini_2.f'        include 'common_mini_2.f'
212        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
213        include 'level2.f'        include 'level2.f'
214    
215        include 'momanhough_init.f'  c      include 'momanhough_init.f'
216                
       logical DEBUG  
       common/dbg/DEBUG  
   
217        logical FIMAGE            !        logical FIMAGE            !
218          real trackimage(NTRACKSMAX)
219          real*8 AL_GUESS(5)
220    
221  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
222  *     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 257  c         iflag=0
257           ibest=0                !best track among candidates           ibest=0                !best track among candidates
258           iimage=0               !track image           iimage=0               !track image
259  *     ------------- select the best track -------------  *     ------------- select the best track -------------
260           rchi2best=1000000000.  c$$$         rchi2best=1000000000.
261    c$$$         do i=1,ntracks
262    c$$$            if(RCHI2_STORE(i).lt.rchi2best.and.
263    c$$$     $         RCHI2_STORE(i).gt.0)then
264    c$$$               ibest=i
265    c$$$               rchi2best=RCHI2_STORE(i)
266    c$$$            endif
267    c$$$         enddo
268    c$$$         if(ibest.eq.0)goto 880 !>> no good candidates
269    
270    *     -------------------------------------------------------
271    *     order track-candidates according to:
272    *     1st) decreasing n.points
273    *     2nd) increasing chi**2
274    *     -------------------------------------------------------
275             rchi2best=1000000000.
276             ndofbest=0            
277           do i=1,ntracks           do i=1,ntracks
278              if(RCHI2_STORE(i).lt.rchi2best.and.             ndof=0              
279       $         RCHI2_STORE(i).gt.0)then             do ii=1,nplanes    
280                 ndof=ndof        
281         $            +int(xgood_store(ii,i))
282         $            +int(ygood_store(ii,i))
283               enddo              
284               if(ndof.gt.ndofbest)then
285                 ibest=i
286                 rchi2best=RCHI2_STORE(i)
287                 ndofbest=ndof    
288               elseif(ndof.eq.ndofbest)then
289                 if(RCHI2_STORE(i).lt.rchi2best.and.
290         $            RCHI2_STORE(i).gt.0)then
291                 ibest=i                 ibest=i
292                 rchi2best=RCHI2_STORE(i)                 rchi2best=RCHI2_STORE(i)
293              endif                 ndofbest=ndof  
294           enddo               endif            
295               endif
296             enddo
297    
298    c$$$         rchi2best=1000000000.
299    c$$$         ndofbest=0             !(1)
300    c$$$         do i=1,ntracks
301    c$$$           if(RCHI2_STORE(i).lt.rchi2best.and.
302    c$$$     $          RCHI2_STORE(i).gt.0)then
303    c$$$             ndof=0             !(1)
304    c$$$             do ii=1,nplanes    !(1)
305    c$$$               ndof=ndof        !(1)
306    c$$$     $              +int(xgood_store(ii,i)) !(1)
307    c$$$     $              +int(ygood_store(ii,i)) !(1)
308    c$$$             enddo              !(1)
309    c$$$             if(ndof.ge.ndofbest)then !(1)
310    c$$$               ibest=i
311    c$$$               rchi2best=RCHI2_STORE(i)
312    c$$$               ndofbest=ndof    !(1)
313    c$$$             endif              !(1)
314    c$$$           endif
315    c$$$         enddo
316    
317           if(ibest.eq.0)goto 880 !>> no good candidates           if(ibest.eq.0)goto 880 !>> no good candidates
318  *-------------------------------------------------------------------------------      *-------------------------------------------------------------------------------    
319  *     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 332  c         iflag=0
332              iimage=0              iimage=0
333           endif           endif
334           if(icand.eq.0)then           if(icand.eq.0)then
335              print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand              if(VERBOSE.EQ.1)then
336       $           ,ibest,iimage                 print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand
337         $              ,ibest,iimage
338                endif
339              return              return
340           endif           endif
341    
# Line 236  c         iflag=0 Line 346  c         iflag=0
346  *     **********************************************************  *     **********************************************************
347  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
348  *     **********************************************************  *     **********************************************************
349             call guess()
350             do i=1,5
351                AL_GUESS(i)=AL(i)
352             enddo
353    c         print*,'## guess: ',al
354    
355           do i=1,5           do i=1,5
356              AL(i)=dble(AL_STORE(i,icand))              AL(i)=dble(AL_STORE(i,icand))            
357           enddo           enddo
358            
359             IDCAND = icand         !fitted track-candidate
360           ifail=0                !error flag in chi2 computation           ifail=0                !error flag in chi2 computation
361           jstep=0                !# minimization steps           jstep=0                !# minimization steps
362    
363           call mini_2(jstep,ifail)           iprint=0
364    c         if(DEBUG.EQ.1)iprint=1
365             if(VERBOSE.EQ.1)iprint=1
366             if(DEBUG.EQ.1)iprint=2
367             call mini2(jstep,ifail,iprint)
368           if(ifail.ne.0) then           if(ifail.ne.0) then
369              if(DEBUG)then              if(VERBOSE.EQ.1)then
370                 print *,                 print *,
371       $              '*** MINIMIZATION FAILURE *** (mini_2) '       $              '*** MINIMIZATION FAILURE *** (after refinement) '
372       $              ,iev       $              ,iev
373    
374    c$$$               print*,'guess:   ',(al_guess(i),i=1,5)
375    c$$$               print*,'previous: ',(al_store(i,icand),i=1,5)
376    c$$$               print*,'result:   ',(al(i),i=1,5)
377    c$$$               print*,'xgood ',xgood
378    c$$$               print*,'ygood ',ygood
379    c$$$               print*,'----------------------------------------------'
380              endif              endif
381              chi2=-chi2  c            chi2=-chi2
382           endif           endif
383                    
384           if(DEBUG)then           if(DEBUG.EQ.1)then
385              print*,'----------------------------- improved track coord'              print*,'----------------------------- improved track coord'
386  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
387              do ip=1,6              do ip=1,6
# Line 263  c         iflag=0 Line 392  c         iflag=0
392           endif           endif
393    
394  c         rchi2=chi2/dble(ndof)  c         rchi2=chi2/dble(ndof)
395           if(DEBUG)then           if(DEBUG.EQ.1)then
396              print*,' '              print*,' '
397              print*,'****** SELECTED TRACK *************'              print*,'****** SELECTED TRACK *************'
398              print*,'#         R. chi2        RIG'              print*,'#         R. chi2        RIG'
# Line 279  c         rchi2=chi2/dble(ndof) Line 408  c         rchi2=chi2/dble(ndof)
408  *     ------------- search if the track has an IMAGE -------------  *     ------------- search if the track has an IMAGE -------------
409  *     ------------- (also this is stored )           -------------  *     ------------- (also this is stored )           -------------
410           if(FIMAGE)goto 122     !>>> jump! (this is already an image)           if(FIMAGE)goto 122     !>>> jump! (this is already an image)
411  *     now search for track-image, by comparing couples IDs  
412    *     -----------------------------------------------------
413    *     first check if the track is ambiguous
414    *     -----------------------------------------------------
415    *     (modified on august 2007 by ElenaV)
416             is1=0
417             do ip=1,NPLANES
418                if(SENSOR_STORE(ip,icand).ne.0)then
419                   is1=SENSOR_STORE(ip,icand)
420                   if(ip.eq.6)is1=3-is1 !last plane inverted
421                endif
422             enddo
423             if(is1.eq.0)then
424                if(WARNING.EQ.1)print*,'** WARNING ** sensor=0'
425                goto 122            !jump
426             endif
427    c         print*,'is1 ',is1
428             do ip=1,NPLANES
429                is2 = SENSOR_STORE(ip,icand) !sensor
430    c            print*,'is2 ',is2,' ip ',ip
431                if(ip.eq.6.and.is2.ne.0)is2=3-is2 !last plane inverted
432                if(
433         $           (is1.ne.is2.and.is2.ne.0)
434         $           )goto 122      !jump (this track cannot have an image)
435             enddo
436             if(DEBUG.eq.1)print*,' >>> ambiguous track! '
437    *     now search for track-image among track candidates
438    c$$$         do i=1,ntracks
439    c$$$            iimage=i
440    c$$$            do ip=1,nplanes
441    c$$$               if(     CP_STORE(nplanes-ip+1,icand).ne.
442    c$$$     $              -1*CP_STORE(nplanes-ip+1,i).and.
443    c$$$     $              CP_STORE(nplanes-ip+1,i).ne.0.and.
444    c$$$     $              CP_STORE(nplanes-ip+1,icand).ne.0 )iimage=0
445    c$$$               print*,' track ',i,' CP ',CP_STORE(nplanes-ip+1,i)
446    c$$$     $              ,CP_STORE(nplanes-ip+1,icand),iimage
447    c$$$            enddo
448    c$$$            if(  iimage.ne.0.and.
449    c$$$c     $           RCHI2_STORE(i).le.CHI2MAX.and.
450    c$$$c     $           RCHI2_STORE(i).gt.0.and.
451    c$$$     $           .true.)then
452    c$$$               if(DEBUG.EQ.1)print*,'Track candidate ',iimage
453    c$$$     $              ,' >>> TRACK IMAGE >>> of'
454    c$$$     $              ,ibest
455    c$$$               goto 122         !image track found
456    c$$$            endif
457    c$$$         enddo
458    *     ---------------------------------------------------------------
459    *     take the candidate with the greatest number of matching couples
460    *     if more than one satisfies the requirement,
461    *     choose the one with more points and lower chi2
462    *     ---------------------------------------------------------------
463    *     count the number of matching couples
464             ncpmax = 0
465             iimage   = 0           !id of candidate with better matching
466           do i=1,ntracks           do i=1,ntracks
467              iimage=i              ncp=0
468              do ip=1,nplanes              do ip=1,nplanes
469                 if(     CP_STORE(nplanes-ip+1,icand).ne.                 if(CP_STORE(nplanes-ip+1,icand).ne.0)then
470       $              -1*CP_STORE(nplanes-ip+1,i) )iimage=0                    if(
471         $                 CP_STORE(nplanes-ip+1,i).ne.0
472         $                 .and.
473         $                 CP_STORE(nplanes-ip+1,icand).eq.
474         $                 -1*CP_STORE(nplanes-ip+1,i)
475         $                 )then
476                         ncp=ncp+1  !ok
477                      elseif(
478         $                    CP_STORE(nplanes-ip+1,i).ne.0
479         $                    .and.
480         $                    CP_STORE(nplanes-ip+1,icand).ne.
481         $                    -1*CP_STORE(nplanes-ip+1,i)
482         $                    )then
483                         ncp = 0
484                         goto 117   !it is not an image candidate
485                      else
486                        
487                      endif
488                   endif
489    c$$$               print*,' track ',i,' CP ',CP_STORE(nplanes-ip+1,i)
490    c$$$     $              ,CP_STORE(nplanes-ip+1,icand),ncp
491              enddo              enddo
492              if(  iimage.ne.0.and.   117        continue
493  c     $           RCHI2_STORE(i).le.CHI2MAX.and.              trackimage(i)=ncp   !number of matching couples
494  c     $           RCHI2_STORE(i).gt.0.and.              if(ncp>ncpmax)then
495       $           .true.)then                 ncpmax=ncp
496                 if(DEBUG)print*,'Track candidate ',iimage                 iimage=i
      $              ,' >>> TRACK IMAGE >>> of'  
      $              ,ibest  
                goto 122         !image track found  
497              endif              endif
498           enddo           enddo
499    *     check if there are more than one image candidates
500             ngood=0
501             do i=1,ntracks
502                if( ncpmax.ne.0.and.trackimage(i).eq.ncpmax )ngood=ngood+1
503             enddo
504    *     if there are, choose the best one
505             if(ngood.gt.1)then
506    *     -------------------------------------------------------
507    *     order track-candidates according to:
508    *     1st) decreasing n.points
509    *     2nd) increasing chi**2
510    *     -------------------------------------------------------
511                rchi2best=1000000000.
512                ndofbest=0            
513                do i=1,ntracks
514                   if( trackimage(i).eq.ncpmax )then
515                      ndof=0              
516                      do ii=1,nplanes    
517                         ndof=ndof        
518         $                    +int(xgood_store(ii,i))
519         $                    +int(ygood_store(ii,i))
520                      enddo              
521                      if(ndof.gt.ndofbest)then
522                         iimage=i
523                         rchi2best=RCHI2_STORE(i)
524                         ndofbest=ndof    
525                      elseif(ndof.eq.ndofbest)then
526                         if(RCHI2_STORE(i).lt.rchi2best.and.
527         $                    RCHI2_STORE(i).gt.0)then
528                            iimage=i
529                            rchi2best=RCHI2_STORE(i)
530                            ndofbest=ndof  
531                         endif            
532                      endif
533                   endif
534                enddo
535                
536             endif
537    
538             if(DEBUG.EQ.1)print*,'Track candidate ',iimage
539         $        ,' >>> TRACK IMAGE >>> of'
540         $        ,ibest
541    
542   122     continue   122     continue
543    
544    
545  *     --- and store the results --------------------------------  *     --- and store the results --------------------------------
546           ntrk = ntrk + 1                   !counter of found tracks           ntrk = ntrk + 1                   !counter of found tracks
547           if(.not.FIMAGE           if(.not.FIMAGE
# Line 310  c         print*,'++++++++++ iimage,fima Line 554  c         print*,'++++++++++ iimage,fima
554  c     $        ,iimage,fimage,ntrk,image(ntrk)  c     $        ,iimage,fimage,ntrk,image(ntrk)
555    
556           if(ntrk.eq.NTRKMAX)then           if(ntrk.eq.NTRKMAX)then
557              if(DEBUG)              if(verbose.eq.1)
558       $           print*,       $           print*,
559       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
560       $           'tracks exceeds vector dimension '       $           'tracks exceeds vector dimension '
# Line 346  cc            good2=.false. Line 590  cc            good2=.false.
590       $        rchi2best.le.CHI2MAX.and.       $        rchi2best.le.CHI2MAX.and.
591  c     $        rchi2best.lt.15..and.  c     $        rchi2best.lt.15..and.
592       $        .true.)then       $        .true.)then
593              if(DEBUG)then              if(DEBUG.EQ.1)then
594                 print*,'***** NEW SEARCH ****'                 print*,'***** NEW SEARCH ****'
595              endif              endif
596              goto 11111          !try new search              goto 11111          !try new search
# Line 360  c     $        rchi2best.lt.15..and. Line 604  c     $        rchi2best.lt.15..and.
604        end        end
605    
606    
   
   
 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$$$  
   
607                
608  ************************************************************  ************************************************************
609  ************************************************************  ************************************************************
# Line 556  c$$$ Line 628  c$$$
628  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)  *     PFAy   - Position Finding Algorithm in y (COG2,ETA2,...)
629  *     angx   - Projected angle in x  *     angx   - Projected angle in x
630  *     angy   - Projected angle in y  *     angy   - Projected angle in y
631    *     bfx    - x-component of magnetci field
632    *     bfy    - y-component of magnetic field
633  *  *
634  *     --------- COUPLES -------------------------------------------------------  *     --------- COUPLES -------------------------------------------------------
635  *     The couple defines a point in the space.  *     The couple defines a point in the space.
# Line 594  c$$$ Line 668  c$$$
668  *  *
669  *  *
670    
671        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,angx,angy)        subroutine xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
672    
 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*****************************************************  
673                
674        include 'commontracker.f'        include 'commontracker.f'
       include 'calib.f'  
675        include 'level1.f'        include 'level1.f'
676          include 'calib.f'
677        include 'common_align.f'        include 'common_align.f'
678        include 'common_mech.f'        include 'common_mech.f'
679        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
       include 'common_resxy.f'  
   
       logical DEBUG  
       common/dbg/DEBUG  
680    
681        integer icx,icy           !X-Y cluster ID        integer icx,icy           !X-Y cluster ID
682        integer sensor        integer sensor
683        integer viewx,viewy        integer viewx,viewy
684        character*4 PFAx,PFAy     !PFA to be used        character*4 PFAx,PFAy     !PFA to be used
685        real angx,angy            !X-Y angle        real ax,ay                !X-Y geometric angle
686          real angx,angy            !X-Y effective angle
687          real bfx,bfy              !X-Y b-field components
688    
689        real stripx,stripy        real stripx,stripy
690    
691          double precision xi,yi,zi
692          double precision xi_A,yi_A,zi_A
693          double precision xi_B,yi_B,zi_B
694        double precision xrt,yrt,zrt        double precision xrt,yrt,zrt
695        double precision xrt_A,yrt_A,zrt_A        double precision xrt_A,yrt_A,zrt_A
696        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  
697                
698    
699        parameter (ndivx=30)        parameter (ndivx=30)
700    
701    
702    c$$$      print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy
703                
704        resxPAM = 0        resxPAM = 0
705        resyPAM = 0        resyPAM = 0
706    
707        xPAM = 0.        xPAM = 0.D0
708        yPAM = 0.        yPAM = 0.D0
709        zPAM = 0.        zPAM = 0.D0
710        xPAM_A = 0.        xPAM_A = 0.D0
711        yPAM_A = 0.        yPAM_A = 0.D0
712        zPAM_A = 0.        zPAM_A = 0.D0
713        xPAM_B = 0.        xPAM_B = 0.D0
714        yPAM_B = 0.        yPAM_B = 0.D0
715        zPAM_B = 0.        zPAM_B = 0.D0
716    cc      print*,'## xyz_PAM: ',icx,icy,sensor,PFAx,PFAy,angx,angy
717    
718          if(sensor.lt.1.or.sensor.gt.2)then
719             print*,'xyz_PAM   ***ERROR*** wrong input '
720             print*,'sensor ',sensor
721             icx=0
722             icy=0
723          endif
724    
725  *     -----------------  *     -----------------
726  *     CLUSTER X  *     CLUSTER X
727  *     -----------------  *     -----------------      
   
728        if(icx.ne.0)then        if(icx.ne.0)then
729           viewx = VIEW(icx)  
730           nldx = nld(MAXS(icx),VIEW(icx))           viewx   = VIEW(icx)
731           nplx = npl(VIEW(icx))           nldx    = nld(MAXS(icx),VIEW(icx))
732           resxPAM = RESXAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!           nplx    = npl(VIEW(icx))
733            c         resxPAM = RESXAV
734           stripx = float(MAXS(icx))           stripx  = float(MAXS(icx))
735           if(PFAx.eq.'COG1')then  !(1)  
736              stripx = stripx      !(1)           if(
737              resxPAM = resxPAM    !(1)       $        viewx.lt.1.or.        
738           elseif(PFAx.eq.'COG2')then       $        viewx.gt.12.or.
739              stripx = stripx + cog(2,icx)                   $        nldx.lt.1.or.
740              resxPAM = resxPAM*fbad_cog(2,icx)       $        nldx.gt.3.or.
741           elseif(PFAx.eq.'ETA2')then       $        stripx.lt.1.or.
742  c            cog2 = cog(2,icx)       $        stripx.gt.3072.or.
743  c            etacorr = pfa_eta2(cog2,viewx,nldx,angx)                   $        .false.)then
744  c            stripx = stripx + etacorr              print*,'xyz_PAM   ***ERROR*** wrong input '
745              stripx = stripx + pfa_eta2(icx,angx)            !(3)              print*,'icx ',icx,'view ',viewx,'nld ',nldx,'strip ',stripx
746              resxPAM = risx_eta2(angx)                       !   (4)              icx = 0
747              if(DEBUG.and.fbad_cog(2,icx).ne.1)              goto 10
      $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)  
             resxPAM = resxPAM*fbad_cog(2,icx)  
          elseif(PFAx.eq.'ETA3')then                         !(3)  
             stripx = stripx + pfa_eta3(icx,angx)            !(3)  
             resxPAM = risx_eta3(angx)                       !   (4)  
             if(DEBUG.and.fbad_cog(3,icx).ne.1)              !(3)  
      $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)!(3)  
             resxPAM = resxPAM*fbad_cog(3,icx)               !(3)  
          elseif(PFAx.eq.'ETA4')then                         !(3)  
             stripx = stripx + pfa_eta4(icx,angx)            !(3)  
             resxPAM = risx_eta4(angx)                       !   (4)  
             if(DEBUG.and.fbad_cog(4,icx).ne.1)              !(3)  
      $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)!(3)  
             resxPAM = resxPAM*fbad_cog(4,icx)               !(3)  
          elseif(PFAx.eq.'ETA')then                          !(3)  
             stripx = stripx + pfa_eta(icx,angx)             !(3)  
             resxPAM = ris_eta(icx,angx)                     !   (4)  
             if(DEBUG.and.fbad_cog(2,icx).ne.1)              !(3)  
      $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)!(3)  
 c            resxPAM = resxPAM*fbad_cog(2,icx)               !(3)TEMPORANEO  
             resxPAM = resxPAM*fbad_eta(icx,angx)             !(3)(4)  
          elseif(PFAx.eq.'COG')then           !(2)  
             stripx = stripx + cog(0,icx)     !(2)          
             resxPAM = risx_cog(angx)                        !   (4)  
             resxPAM = resxPAM*fbad_cog(0,icx)!(2)  
          else  
             print*,'*** Non valid p.f.a. (x) --> ',PFAx  
748           endif           endif
749    
750        endif  *        --------------------------
751          *        magnetic-field corrections
752    *        --------------------------
753             stripx  = stripx +  fieldcorr(viewx,bfy)      
754             angx    = effectiveangle(ax,viewx,bfy)
755            
756             call applypfa(PFAx,icx,angx,corr,res)
757             stripx  = stripx + corr
758             resxPAM = res
759    
760     10   endif
761        
762  *     -----------------  *     -----------------
763  *     CLUSTER Y  *     CLUSTER Y
764  *     -----------------  *     -----------------
765    
766        if(icy.ne.0)then        if(icy.ne.0)then
767    
768           viewy = VIEW(icy)           viewy = VIEW(icy)
769           nldy = nld(MAXS(icy),VIEW(icy))           nldy = nld(MAXS(icy),VIEW(icy))
770           nply = npl(VIEW(icy))           nply = npl(VIEW(icy))
771           resyPAM = RESYAV !!!!!!!TEMPORANEO!!!!!!!!!!!!!!!!  c         resyPAM = RESYAV
772             stripy = float(MAXS(icy))
773    
774             if(
775         $        viewy.lt.1.or.        
776         $        viewy.gt.12.or.
777         $        nldy.lt.1.or.
778         $        nldy.gt.3.or.
779         $        stripy.lt.1.or.
780         $        stripy.gt.3072.or.
781         $        .false.)then
782                print*,'xyz_PAM   ***ERROR*** wrong input '
783                print*,'icy ',icy,'view ',viewy,'nld ',nldy,'strip ',stripy
784                icy = 0
785                goto 20
786             endif
787    
788           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
789              print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '              if(DEBUG.EQ.1) then
790       $           ,icx,icy                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '
791         $              ,icx,icy
792                endif
793              goto 100              goto 100
794           endif           endif
           
          stripy = float(MAXS(icy))  
          if(PFAy.eq.'COG1')then !(1)  
             stripy = stripy     !(1)  
             resyPAM = resyPAM   !(1)  
          elseif(PFAy.eq.'COG2')then  
             stripy = stripy + cog(2,icy)  
             resyPAM = resyPAM*fbad_cog(2,icy)  
          elseif(PFAy.eq.'ETA2')then  
 c            cog2 = cog(2,icy)  
 c            etacorr = pfa_eta2(cog2,viewy,nldy,angy)  
 c            stripy = stripy + etacorr  
             stripy = stripy + pfa_eta2(icy,angy)            !(3)  
             resyPAM = risy_eta2(angy)                       !   (4)  
             resyPAM = resyPAM*fbad_cog(2,icy)  
             if(DEBUG.and.fbad_cog(2,icy).ne.1)  
      $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)  
          elseif(PFAy.eq.'ETA3')then                         !(3)  
             stripy = stripy + pfa_eta3(icy,angy)            !(3)  
             resyPAM = resyPAM*fbad_cog(3,icy)               !(3)  
             if(DEBUG.and.fbad_cog(3,icy).ne.1)              !(3)  
      $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)!(3)  
          elseif(PFAy.eq.'ETA4')then                         !(3)  
             stripy = stripy + pfa_eta4(icy,angy)            !(3)  
             resyPAM = resyPAM*fbad_cog(4,icy)               !(3)  
             if(DEBUG.and.fbad_cog(4,icy).ne.1)              !(3)  
      $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)!(3)  
          elseif(PFAy.eq.'ETA')then                          !(3)  
             stripy = stripy + pfa_eta(icy,angy)             !(3)  
             resyPAM = ris_eta(icy,angy)                     !   (4)  
 c            resyPAM = resyPAM*fbad_cog(2,icy)              !(3)TEMPORANEO  
             resyPAM = resyPAM*fbad_eta(icy,angy)            !   (4)  
             if(DEBUG.and.fbad_cog(2,icy).ne.1)              !(3)  
      $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)!(3)  
          elseif(PFAy.eq.'COG')then  
             stripy = stripy + cog(0,icy)              
             resyPAM = risy_cog(angy)                        !   (4)  
 c            resyPAM = ris_eta(icy,angy)                    !   (4)  
             resyPAM = resyPAM*fbad_cog(0,icy)  
          else  
             print*,'*** Non valid p.f.a. (x) --> ',PFAx  
          endif  
795    
796        endif  *        --------------------------
797    *        magnetic-field corrections
798    *        --------------------------
799             stripy  = stripy +  fieldcorr(viewy,bfx)      
800             angy    = effectiveangle(ay,viewy,bfx)
801            
802             call applypfa(PFAy,icy,angy,corr,res)
803             stripy  = stripy + corr
804             resyPAM = res
805    
806     20   endif
807    
808    cc      print*,'## stripx,stripy ',stripx,stripy
809    
         
810  c===========================================================  c===========================================================
811  C     COUPLE  C     COUPLE
812  C===========================================================  C===========================================================
# Line 772  C======================================= Line 815  C=======================================
815  c------------------------------------------------------------------------  c------------------------------------------------------------------------
816  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame
817  c------------------------------------------------------------------------  c------------------------------------------------------------------------
818           xi = acoordsi(stripx,viewx)           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
819           yi = acoordsi(stripy,viewy)       $        .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
820           zi = 0.              if(DEBUG.EQ.1) then
821                   print*,'xyz_PAM (couple):',
822         $              ' WARNING: false X strip: strip ',stripx
823                endif
824             endif
825             xi = dcoordsi(stripx,viewx)
826             yi = dcoordsi(stripy,viewy)
827             zi = 0.D0
828                    
   
829  c------------------------------------------------------------------------  c------------------------------------------------------------------------
830  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
831  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 810  c--------------------------------------- Line 859  c---------------------------------------
859           yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4           yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4
860           zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4           zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4
861    
862           xPAM_A = 0.           xPAM_A = 0.D0
863           yPAM_A = 0.           yPAM_A = 0.D0
864           zPAM_A = 0.           zPAM_A = 0.D0
865    
866           xPAM_B = 0.           xPAM_B = 0.D0
867           yPAM_B = 0.           yPAM_B = 0.D0
868           zPAM_B = 0.           zPAM_B = 0.D0
869    
870        elseif(        elseif(
871       $        (icx.ne.0.and.icy.eq.0).or.       $        (icx.ne.0.and.icy.eq.0).or.
# Line 836  C======================================= Line 885  C=======================================
885              nldx = nldy              nldx = nldy
886              viewx = viewy + 1              viewx = viewy + 1
887    
888              yi   = acoordsi(stripy,viewy)              yi   = dcoordsi(stripy,viewy)
889    
890              xi_A = edgeY_d - SiDimX/2              xi_A = edgeY_d - SiDimX/2
891              yi_A = yi              yi_A = yi
# Line 858  C======================================= Line 907  C=======================================
907              nldy = nldx              nldy = nldx
908              viewy = viewx - 1              viewy = viewx - 1
909    
910              xi   = acoordsi(stripx,viewx)  c            print*,'X-singlet ',icx,nplx,nldx,viewx,stripx
911    c            if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...
912                if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
913         $           .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
914                   if(DEBUG.EQ.1) then
915                      print*,'xyz_PAM (X-singlet):',
916         $                 ' WARNING: false X strip: strip ',stripx
917                   endif
918                endif
919                xi   = dcoordsi(stripx,viewx)
920    
921              xi_A = xi              xi_A = xi
922              yi_A = edgeX_d - SiDimY/2              yi_A = edgeX_d - SiDimY/2
# Line 878  c            print*,'X-cl ',icx,stripx,' Line 936  c            print*,'X-cl ',icx,stripx,'
936  c            print*,yi_A,' <--> ',yi_B  c            print*,yi_A,' <--> ',yi_B
937    
938           else           else
939                if(DEBUG.EQ.1) then
940              print *,'routine xyz_PAM ---> not properly used !!!'                 print *,'routine xyz_PAM ---> not properly used !!!'
941              print *,'icx = ',icx                 print *,'icx = ',icx
942              print *,'icy = ',icy                 print *,'icy = ',icy
943                endif
944              goto 100              goto 100
945                            
946           endif           endif
# Line 930  c     (xPAM,yPAM,zPAM) = measured coordi Line 989  c     (xPAM,yPAM,zPAM) = measured coordi
989  c                        in PAMELA reference system  c                        in PAMELA reference system
990  c------------------------------------------------------------------------  c------------------------------------------------------------------------
991    
992           xPAM = 0.           xPAM = 0.D0
993           yPAM = 0.           yPAM = 0.D0
994           zPAM = 0.           zPAM = 0.D0
995    
996           xPAM_A = dcoord(xrt_A,viewx,nldx,sensor) / 1.d4           xPAM_A = dcoord(xrt_A,viewx,nldx,sensor) / 1.d4
997           yPAM_A = dcoord(yrt_A,viewy,nldy,sensor) / 1.d4           yPAM_A = dcoord(yrt_A,viewy,nldy,sensor) / 1.d4
# Line 946  c--------------------------------------- Line 1005  c---------------------------------------
1005  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'
1006    
1007        else        else
1008                       if(DEBUG.EQ.1) then
1009           print *,'routine xyz_PAM ---> not properly used !!!'              print *,'routine xyz_PAM ---> not properly used !!!'
1010           print *,'icx = ',icx              print *,'icx = ',icx
1011           print *,'icy = ',icy              print *,'icy = ',icy
1012                         endif
1013        endif        endif
1014                    
1015    
1016    c      print*,'## xPAM,yPAM,zPAM       ',xPAM,yPAM,zPAM
1017    c      print*,'## xPAM_A,yPAM_A,zPAM_A ',xPAM_A,yPAM_A,zPAM_A
1018    c      print*,'## xPAM_B,yPAM_B,zPAM_B ',xPAM_B,yPAM_B,zPAM_B
1019    
1020   100  continue   100  continue
1021        end        end
1022    
1023    ************************************************************************
1024    *     Call xyz_PAM subroutine with default PFA and fill the mini2 common.
1025    *     (done to be called from c/c++)
1026    ************************************************************************
1027    
1028          subroutine xyzpam(ip,icx,icy,lad,sensor,ax,ay,bfx,bfy)
1029    
1030          include 'commontracker.f'
1031          include 'level1.f'
1032          include 'common_mini_2.f'
1033          include 'common_xyzPAM.f'
1034          include 'common_mech.f'
1035          include 'calib.f'
1036          
1037    *     flag to chose PFA
1038    c$$$      character*10 PFA
1039    c$$$      common/FINALPFA/PFA
1040    
1041          integer icx,icy           !X-Y cluster ID
1042          integer sensor
1043          character*4 PFAx,PFAy     !PFA to be used
1044          real ax,ay                !X-Y geometric angle
1045          real bfx,bfy              !X-Y b-field components
1046    
1047          ipx=0
1048          ipy=0      
1049          
1050    c$$$      PFAx = 'COG4'!PFA
1051    c$$$      PFAy = 'COG4'!PFA
1052    
1053    
1054          if(icx.gt.nclstr1.or.icy.gt.nclstr1)then
1055                print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1056         $           ,' do not exists (n.clusters=',nclstr1,')'
1057                icx = -1*icx
1058                icy = -1*icy
1059                return
1060            
1061          endif
1062          
1063          call idtoc(pfaid,PFAx)
1064          call idtoc(pfaid,PFAy)
1065    
1066    cc      print*,PFAx,PFAy
1067    
1068    c$$$      call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1069    
1070    c$$$      print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy
1071          
1072          if(icx.ne.0.and.icy.ne.0)then
1073    
1074             ipx=npl(VIEW(icx))
1075             ipy=npl(VIEW(icy))
1076    c$$$         if( (nplanes-ipx+1).ne.ip.or.(nplanes-ipy+1).ne.ip )
1077    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1078    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1079            
1080             if( (nplanes-ipx+1).ne.ip )then
1081                print*,'xyzpam: ***WARNING*** cluster ',icx
1082         $           ,' does not belong to plane: ',ip
1083                icx = -1*icx
1084                return
1085             endif
1086             if( (nplanes-ipy+1).ne.ip )then
1087                print*,'xyzpam: ***WARNING*** cluster ',icy
1088         $           ,' does not belong to plane: ',ip
1089                icy = -1*icy
1090                return
1091             endif
1092    
1093             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1094    
1095             xgood(ip) = 1.
1096             ygood(ip) = 1.
1097             resx(ip)  = resxPAM
1098             resy(ip)  = resyPAM
1099    
1100             xm(ip) = xPAM
1101             ym(ip) = yPAM
1102             zm(ip) = zPAM
1103             xm_A(ip) = 0.D0
1104             ym_A(ip) = 0.D0
1105             xm_B(ip) = 0.D0
1106             ym_B(ip) = 0.D0
1107    
1108    c         zv(ip) = zPAM
1109    
1110          elseif(icx.eq.0.and.icy.ne.0)then
1111    
1112             ipy=npl(VIEW(icy))
1113    c$$$         if((nplanes-ipy+1).ne.ip)
1114    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1115    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1116             if( (nplanes-ipy+1).ne.ip )then
1117                print*,'xyzpam: ***WARNING*** cluster ',icy
1118         $           ,' does not belong to plane: ',ip
1119                icy = -1*icy
1120                return
1121             endif
1122    
1123             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1124            
1125             xgood(ip) = 0.
1126             ygood(ip) = 1.
1127             resx(ip)  = 1000.
1128             resy(ip)  = resyPAM
1129    
1130             xm(ip) = -100.
1131             ym(ip) = -100.
1132             zm(ip) = (zPAM_A+zPAM_B)/2.
1133             xm_A(ip) = xPAM_A
1134             ym_A(ip) = yPAM_A
1135             xm_B(ip) = xPAM_B
1136             ym_B(ip) = yPAM_B
1137    
1138    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1139            
1140          elseif(icx.ne.0.and.icy.eq.0)then
1141    
1142             ipx=npl(VIEW(icx))
1143    c$$$         if((nplanes-ipx+1).ne.ip)
1144    c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1145    c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1146    
1147             if( (nplanes-ipx+1).ne.ip )then
1148                print*,'xyzpam: ***WARNING*** cluster ',icx
1149         $           ,' does not belong to plane: ',ip
1150                icx = -1*icx
1151                return
1152             endif
1153    
1154             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1155          
1156             xgood(ip) = 1.
1157             ygood(ip) = 0.
1158             resx(ip)  = resxPAM
1159             resy(ip)  = 1000.
1160    
1161             xm(ip) = -100.
1162             ym(ip) = -100.
1163             zm(ip) = (zPAM_A+zPAM_B)/2.
1164             xm_A(ip) = xPAM_A
1165             ym_A(ip) = yPAM_A
1166             xm_B(ip) = xPAM_B
1167             ym_B(ip) = yPAM_B
1168            
1169    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1170    
1171          else
1172    
1173             il = 2
1174             if(lad.ne.0)il=lad
1175             is = 1
1176             if(sensor.ne.0)is=sensor
1177    c         print*,nplanes-ip+1,il,is
1178    
1179             xgood(ip) = 0.
1180             ygood(ip) = 0.
1181             resx(ip)  = 1000.
1182             resy(ip)  = 1000.
1183    
1184             xm(ip) = -100.
1185             ym(ip) = -100.          
1186             zm(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1187             xm_A(ip) = 0.
1188             ym_A(ip) = 0.
1189             xm_B(ip) = 0.
1190             ym_B(ip) = 0.
1191    
1192    c         zv(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1193    
1194          endif
1195    
1196          if(DEBUG.EQ.1)then
1197    c         print*,'----------------------------- track coord'
1198    22222    format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
1199             write(*,22222)ip,zm(ip),xm(ip),ym(ip)
1200         $        ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip)
1201         $        ,xgood(ip),ygood(ip),resx(ip),resy(ip)
1202    c$$$         print*,'-----------------------------'
1203          endif
1204          end
1205    
1206  ********************************************************************************  ********************************************************************************
1207  ********************************************************************************  ********************************************************************************
# Line 977  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1223  c         print*,'A-(',xPAM_A,yPAM_A,')
1223  *      *    
1224  ********************************************************************************  ********************************************************************************
1225    
1226        real function distance_to(XPP,YPP)        real function distance_to(rXPP,rYPP)
1227    
1228        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1229    
# Line 986  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1232  c         print*,'A-(',xPAM_A,yPAM_A,')
1232  *     ( i.e. distance/resolution )  *     ( i.e. distance/resolution )
1233  *     -----------------------------------  *     -----------------------------------
1234    
1235          real rXPP,rYPP
1236          double precision XPP,YPP
1237        double precision distance,RE        double precision distance,RE
1238        double precision BETA,ALFA,xmi,ymi        double precision BETA,ALFA,xmi,ymi
1239    
1240          XPP=DBLE(rXPP)
1241          YPP=DBLE(rYPP)
1242    
1243  *     ----------------------  *     ----------------------
1244        if (        if (
1245       +     xPAM.eq.0.and.       +     xPAM.eq.0.and.
# Line 1031  c         print*,'A-(',xPAM_A,yPAM_A,') Line 1282  c         print*,'A-(',xPAM_A,yPAM_A,')
1282           endif                   endif        
1283    
1284           distance=           distance=
1285       $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2       $       ((xmi-XPP)**2+(ymi-YPP)**2)!QUIQUI
1286    cc     $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1287           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1288    
1289  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 1056  c$$$         print*,' resolution ',re Line 1308  c$$$         print*,' resolution ',re
1308  *     ----------------------  *     ----------------------
1309                    
1310           distance=           distance=
1311       $        ((xPAM-XPP)/resxPAM)**2       $       ((xPAM-XPP))**2 !QUIQUI
1312       $        +       $       +
1313       $        ((yPAM-YPP)/resyPAM)**2       $       ((yPAM-YPP))**2
1314    c$$$     $        ((xPAM-XPP)/resxPAM)**2
1315    c$$$     $        +
1316    c$$$     $        ((yPAM-YPP)/resyPAM)**2
1317           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1318    
1319  c$$$         print*,xPAM,yPAM,zPAM  c$$$         print*,xPAM,yPAM,zPAM
# Line 1067  c$$$         print*,' resolution ',resxP Line 1322  c$$$         print*,' resolution ',resxP
1322                    
1323        else        else
1324                    
1325           print*  c         print*
1326       $        ,' function distance_to ---> wrong usage!!!'  c     $        ,' function distance_to ---> wrong usage!!!'
1327           print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM  c         print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM
1328           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 '
1329       $        ,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
1330        endif          endif  
1331    
1332        distance_to = sngl(distance)        distance_to = sngl(distance)
# Line 1111  c$$$         print*,' resolution ',resxP Line 1366  c$$$         print*,' resolution ',resxP
1366        data c1/1.,0.,0.,1./        data c1/1.,0.,0.,1./
1367        data c2/1.,-1.,-1.,1./        data c2/1.,-1.,-1.,1./
1368        data c3/1.,1.,0.,0./        data c3/1.,1.,0.,0./
1369        real*8 yvvv,xvvv        double precision yvvv,xvvv
1370        double precision xi,yi,zi        double precision xi,yi,zi
1371        double precision xrt,yrt,zrt        double precision xrt,yrt,zrt
1372        real AA,BB        real AA,BB
1373        real yvv(4),xvv(4)        double precision yvv(4),xvv(4)
1374    
1375  *     tollerance to consider the track inside the sensitive area  *     tollerance to consider the track inside the sensitive area
1376        real ptoll        real ptoll
1377        data ptoll/150./          !um        data ptoll/150./          !um
1378    
1379        external nviewx,nviewy,acoordsi,dcoord        external nviewx,nviewy,dcoordsi,dcoord
1380    
1381        nplpt = nplPAM            !plane        nplpt = nplPAM            !plane
1382        viewx = nviewx(nplpt)        viewx = nviewx(nplpt)
# Line 1136  c$$$         print*,' resolution ',resxP Line 1391  c$$$         print*,' resolution ',resxP
1391  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1392  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame
1393  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1394                 xi = acoordsi(stripx,viewx)  c               if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
1395                 yi = acoordsi(stripy,viewy)  c     $              .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
1396                 zi = 0.  c     if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...
1397    c                  print*,'whichsensor: ',
1398    c     $                ' WARNING: false X strip: strip ',stripx
1399    c               endif
1400                   xi = dcoordsi(stripx,viewx)
1401                   yi = dcoordsi(stripy,viewy)
1402                   zi = 0.D0
1403  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1404  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
1405  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 1263  c     $              ,iv,xvv(iv),yvv(iv) Line 1524  c     $              ,iv,xvv(iv),yvv(iv)
1524  *     it returns the plane number  *     it returns the plane number
1525  *      *    
1526        include 'commontracker.f'        include 'commontracker.f'
1527          include 'level1.f'
1528  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1529        include 'common_momanhough.f'        include 'common_momanhough.f'
1530                
# Line 1288  c      include 'common_analysis.f' Line 1550  c      include 'common_analysis.f'
1550        is_cp=0        is_cp=0
1551        if(id.lt.0)is_cp=1        if(id.lt.0)is_cp=1
1552        if(id.gt.0)is_cp=2        if(id.gt.0)is_cp=2
1553        if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'  c      if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'
1554    
1555        return        return
1556        end        end
# Line 1300  c      include 'common_analysis.f' Line 1562  c      include 'common_analysis.f'
1562  *     it returns the id number ON THE PLANE  *     it returns the id number ON THE PLANE
1563  *      *    
1564        include 'commontracker.f'        include 'commontracker.f'
1565          include 'level1.f'
1566  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1567        include 'common_momanhough.f'        include 'common_momanhough.f'
1568                
# Line 1328  c      include 'common_analysis.f' Line 1591  c      include 'common_analysis.f'
1591  *     positive if sensor =2  *     positive if sensor =2
1592  *  *
1593        include 'commontracker.f'        include 'commontracker.f'
1594          include 'level1.f'
1595  c      include 'calib.f'  c      include 'calib.f'
1596  c      include 'level1.f'  c      include 'level1.f'
1597  c      include 'common_analysis.f'  c      include 'common_analysis.f'
# Line 1357  c      include 'common_analysis.f' Line 1621  c      include 'common_analysis.f'
1621  *************************************************************************  *************************************************************************
1622  *************************************************************************  *************************************************************************
1623  *************************************************************************  *************************************************************************
 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  
1624                
1625    
1626  ***************************************************  ***************************************************
# Line 1639  c$$$      end Line 1635  c$$$      end
1635        subroutine cl_to_couples(iflag)        subroutine cl_to_couples(iflag)
1636    
1637        include 'commontracker.f'        include 'commontracker.f'
1638          include 'level1.f'
1639        include 'common_momanhough.f'        include 'common_momanhough.f'
1640        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1641        include 'calib.f'        include 'calib.f'
1642        include 'level1.f'  c      include 'level1.f'
   
       logical DEBUG  
       common/dbg/DEBUG  
1643    
1644  *     output flag  *     output flag
1645  *     --------------  *     --------------
# Line 1654  c$$$      end Line 1648  c$$$      end
1648  *     --------------  *     --------------
1649        integer iflag        integer iflag
1650    
1651        integer badseed,badcl        integer badseed,badclx,badcly
1652        
1653          if(DEBUG.EQ.1)print*,'cl_to_couples:'
1654    
1655  *     init variables  *     init variables
1656        ncp_tot=0        ncp_tot=0
# Line 1670  c$$$      end Line 1666  c$$$      end
1666           ncls(ip)=0           ncls(ip)=0
1667        enddo        enddo
1668        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1669           cl_single(icl)=1           cl_single(icl) = 1
1670           cl_good(icl)=0           cl_good(icl)   = 0
1671          enddo
1672          do iv=1,nviews
1673             ncl_view(iv)  = 0
1674             mask_view(iv) = 0      !all included
1675        enddo        enddo
1676                
1677  *     start association  *     count number of cluster per view
       ncouples=0  
       do icx=1,nclstr1          !loop on cluster (X)  
          if(mod(VIEW(icx),2).eq.1)goto 10  
           
 *     ----------------------------------------------------  
 *     cut on charge (X VIEW)  
          if(dedx(icx).lt.dedx_x_min)then  
             cl_single(icx)=0  
             goto 10  
          endif  
 *     cut BAD (X VIEW)              
          badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))  
          ifirst=INDSTART(icx)  
          if(icx.ne.nclstr1) then  
             ilast=INDSTART(icx+1)-1  
          else  
             ilast=TOTCLLENGTH  
          endif  
          badcl=badseed  
          do igood=-ngoodstr,ngoodstr  
             ibad=1  
             if((INDMAX(icx)+igood).gt.ifirst.and.  
      $           (INDMAX(icx)+igood).lt.ilast.and.  
      $           .true.)then  
                ibad=BAD(VIEW(icx),  
      $              nvk(MAXS(icx)+igood),  
      $              nst(MAXS(icx)+igood))  
             endif  
             badcl=badcl*ibad  
          enddo  
 c     if(badcl.eq.0)then  
 c     cl_single(icx)=0  
 c     goto 10  
 c     endif  
 *     ----------------------------------------------------  
           
          cl_good(icx)=1  
          nplx=npl(VIEW(icx))  
          nldx=nld(MAXS(icx),VIEW(icx))  
           
          do icy=1,nclstr1       !loop on cluster (Y)  
             if(mod(VIEW(icy),2).eq.0)goto 20  
               
 *     ----------------------------------------------------  
 *     cut on charge (Y VIEW)  
             if(dedx(icy).lt.dedx_y_min)then  
                cl_single(icy)=0  
                goto 20  
             endif  
 *     cut BAD (Y VIEW)              
             badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))  
             ifirst=INDSTART(icy)  
             if(icy.ne.nclstr1) then  
                ilast=INDSTART(icy+1)-1  
             else  
                ilast=TOTCLLENGTH  
             endif  
             badcl=badseed  
             do igood=-ngoodstr,ngoodstr  
                ibad=1  
                if((INDMAX(icy)+igood).gt.ifirst.and.  
      $              (INDMAX(icy)+igood).lt.ilast.and.  
      $              .true.)  
      $              ibad=BAD(VIEW(icy),  
      $              nvk(MAXS(icy)+igood),  
      $              nst(MAXS(icy)+igood))  
                badcl=badcl*ibad  
             enddo  
 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  
                ddd=(dedx(icy)  
      $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  
                ddd=ddd/sqrt(kch(nplx,nldx)**2+1)  
                cut=chcut*sch(nplx,nldx)  
                if(abs(ddd).gt.cut)goto 20 !charge not consistent  
                 
                 
 *     ------------------> COUPLE <------------------  
 *     check to do not overflow vector dimentions  
                if(ncp_plane(nplx).gt.ncouplemax)then  
                   if(DEBUG)print*,  
      $                    ' ** warning ** number of identified'//  
      $                    ' couples on plane ',nplx,  
      $                    ' exceeds vector dimention'//  
      $                    ' ( ',ncouplemax,' )'  
 c     good2=.false.  
 c     goto 880   !fill ntp and go to next event  
                   iflag=1  
                   return  
                endif  
                 
                if(ncp_plane(nplx).eq.ncouplemax)then  
                   if(DEBUG)print*,  
      $                 '** warning ** number of identified '//  
      $                 'couples on plane ',nplx,  
      $                 'exceeds vector dimention '  
      $                 ,'( ',ncouplemax,' )'  
 c     good2=.false.  
 c     goto 880   !fill ntp and go to next event                      
                   iflag=1  
                   return  
                endif  
                 
                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)  
         
         
1678        do icl=1,nclstr1        do icl=1,nclstr1
1679           if(cl_single(icl).eq.1)then           ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1        
             ip=npl(VIEW(icl))  
             ncls(ip)=ncls(ip)+1  
             cls(ip,ncls(ip))=icl  
          endif  
1680        enddo        enddo
1681          *     mask views with too many clusters
1682                do iv=1,nviews
1683        if(DEBUG)then           if( ncl_view(iv).gt. nclusterlimit)then
1684           print*,'clusters  ',nclstr1  c            mask_view(iv) = 1
1685           print*,'good    ',(cl_good(i),i=1,nclstr1)              mask_view(iv) = mask_view(iv) + 2**0
1686           print*,'singles ',(cl_single(i),i=1,nclstr1)              if(DEBUG.EQ.1)
1687           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)       $        print*,' * WARNING * cl_to_couple: n.clusters > '
1688        endif       $        ,nclusterlimit,' on view ', iv,' --> masked!'
1689                   endif
       do ip=1,6  
          ncp_tot=ncp_tot+ncp_plane(ip)  
1690        enddo        enddo
 c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
         
       if(ncp_tot.gt.ncp_max)then  
          if(DEBUG)print*,  
      $           '** warning ** number of identified '//  
      $           'couples exceeds upper limit for Hough tr. '  
      $           ,'( ',ncp_max,' )'              
 c            good2=.false.  
 c     goto 880       !fill ntp and go to next event  
          iflag=1  
          return  
       endif  
         
       return  
       end  
         
 ***************************************************  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 *                                                 *  
 **************************************************  
       subroutine cl_to_couples_nocharge(iflag)  
1691    
       include 'commontracker.f'  
       include 'common_momanhough.f'  
       include 'momanhough_init.f'  
       include 'calib.f'  
       include 'level1.f'  
   
       logical DEBUG  
       common/dbg/DEBUG  
1692    
 *     output flag  
 *     --------------  
 *     0 = good event  
 *     1 = bad event  
 *     --------------  
       integer iflag  
   
       integer badseed,badcl  
   
 *     init variables  
       ncp_tot=0  
       do ip=1,nplanes  
          do ico=1,ncouplemax  
             clx(ip,ico)=0  
             cly(ip,ico)=0  
          enddo  
          ncp_plane(ip)=0  
          do icl=1,nclstrmax_level2  
             cls(ip,icl)=1  
          enddo  
          ncls(ip)=0  
       enddo  
       do icl=1,nclstrmax_level2  
          cl_single(icl)=1  
          cl_good(icl)=0  
       enddo  
         
1693  *     start association  *     start association
1694        ncouples=0        ncouples=0
1695        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1696           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1697                    
1698  *     ----------------------------------------------------  *     ----------------------------------------------------
1699    *     jump masked views (X VIEW)
1700    *     ----------------------------------------------------
1701             if( mask_view(VIEW(icx)).ne.0 ) goto 10
1702    *     ----------------------------------------------------
1703  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1704           if(dedx(icx).lt.dedx_x_min)then  *     ----------------------------------------------------
1705             if(sgnl(icx).lt.dedx_x_min)then
1706              cl_single(icx)=0              cl_single(icx)=0
1707              goto 10              goto 10
1708           endif           endif
1709    *     ----------------------------------------------------
1710  *     cut BAD (X VIEW)              *     cut BAD (X VIEW)            
1711    *     ----------------------------------------------------
1712           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
1713           ifirst=INDSTART(icx)           ifirst=INDSTART(icx)
1714           if(icx.ne.nclstr1) then           if(icx.ne.nclstr1) then
# Line 1908  c     goto 880       !fill ntp and go to Line 1716  c     goto 880       !fill ntp and go to
1716           else           else
1717              ilast=TOTCLLENGTH              ilast=TOTCLLENGTH
1718           endif           endif
1719           badcl=badseed           badclx=badseed
1720           do igood=-ngoodstr,ngoodstr           do igood=-ngoodstr,ngoodstr
1721              ibad=1              ibad=1
1722              if((INDMAX(icx)+igood).gt.ifirst.and.              if((INDMAX(icx)+igood).gt.ifirst.and.
# Line 1918  c     goto 880       !fill ntp and go to Line 1726  c     goto 880       !fill ntp and go to
1726       $              nvk(MAXS(icx)+igood),       $              nvk(MAXS(icx)+igood),
1727       $              nst(MAXS(icx)+igood))       $              nst(MAXS(icx)+igood))
1728              endif              endif
1729              badcl=badcl*ibad              badclx=badclx*ibad
1730           enddo           enddo
1731           if(badcl.eq.0)then     !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1732              cl_single(icx)=0    !<<<<<<<<<<<<<< BAD cut  *     >>> eliminato il taglio sulle BAD <<<
1733              goto 10             !<<<<<<<<<<<<<< BAD cut  *     ----------------------------------------------------
1734           endif                  !<<<<<<<<<<<<<< BAD cut  c     if(badcl.eq.0)then
1735    c     cl_single(icx)=0
1736    c     goto 10
1737    c     endif
1738  *     ----------------------------------------------------  *     ----------------------------------------------------
1739                    
1740           cl_good(icx)=1           cl_good(icx)=1
# Line 1934  c     goto 880       !fill ntp and go to Line 1745  c     goto 880       !fill ntp and go to
1745              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1746                            
1747  *     ----------------------------------------------------  *     ----------------------------------------------------
1748    *     jump masked views (Y VIEW)
1749    *     ----------------------------------------------------
1750                if( mask_view(VIEW(icy)).ne.0 ) goto 20
1751    
1752    *     ----------------------------------------------------
1753  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1754              if(dedx(icy).lt.dedx_y_min)then  *     ----------------------------------------------------
1755                if(sgnl(icy).lt.dedx_y_min)then
1756                 cl_single(icy)=0                 cl_single(icy)=0
1757                 goto 20                 goto 20
1758              endif              endif
1759    *     ----------------------------------------------------
1760  *     cut BAD (Y VIEW)              *     cut BAD (Y VIEW)            
1761    *     ----------------------------------------------------
1762              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
1763              ifirst=INDSTART(icy)              ifirst=INDSTART(icy)
1764              if(icy.ne.nclstr1) then              if(icy.ne.nclstr1) then
# Line 1947  c     goto 880       !fill ntp and go to Line 1766  c     goto 880       !fill ntp and go to
1766              else              else
1767                 ilast=TOTCLLENGTH                 ilast=TOTCLLENGTH
1768              endif              endif
1769              badcl=badseed              badcly=badseed
1770              do igood=-ngoodstr,ngoodstr              do igood=-ngoodstr,ngoodstr
1771                 ibad=1                 ibad=1
1772                 if((INDMAX(icy)+igood).gt.ifirst.and.                 if((INDMAX(icy)+igood).gt.ifirst.and.
# Line 1956  c     goto 880       !fill ntp and go to Line 1775  c     goto 880       !fill ntp and go to
1775       $              ibad=BAD(VIEW(icy),       $              ibad=BAD(VIEW(icy),
1776       $              nvk(MAXS(icy)+igood),       $              nvk(MAXS(icy)+igood),
1777       $              nst(MAXS(icy)+igood))       $              nst(MAXS(icy)+igood))
1778                 badcl=badcl*ibad                 badcly=badcly*ibad
1779              enddo              enddo
             if(badcl.eq.0)then  !<<<<<<<<<<<<<< BAD cut  
                cl_single(icy)=0 !<<<<<<<<<<<<<< BAD cut  
                goto 20          !<<<<<<<<<<<<<< BAD cut  
             endif               !<<<<<<<<<<<<<< BAD cut  
1780  *     ----------------------------------------------------  *     ----------------------------------------------------
1781                *     >>> eliminato il taglio sulle BAD <<<
1782    *     ----------------------------------------------------
1783    c     if(badcl.eq.0)then
1784    c     cl_single(icy)=0
1785    c     goto 20
1786    c     endif
1787    *     ----------------------------------------------------
1788                            
1789              cl_good(icy)=1                                cl_good(icy)=1                  
1790              nply=npl(VIEW(icy))              nply=npl(VIEW(icy))
# Line 1974  c     goto 880       !fill ntp and go to Line 1795  c     goto 880       !fill ntp and go to
1795  *     ----------------------------------------------  *     ----------------------------------------------
1796  *     geometrical consistency (same plane and ladder)  *     geometrical consistency (same plane and ladder)
1797              if(nply.eq.nplx.and.nldy.eq.nldx)then              if(nply.eq.nplx.and.nldy.eq.nldx)then
1798  *     charge correlation  *     charge correlation
1799  *     ===========================================================  *     (modified to be applied only below saturation... obviously)
1800  *     this version of the subroutine is used for the calibration  
1801  *     thus charge-correlation selection is obviously removed                 if(  .not.(sgnl(icy).gt.chsaty.and.sgnl(icx).gt.chsatx)
1802  *     ===========================================================       $              .and.
1803  c$$$               ddd=(dedx(icy)       $              .not.(sgnl(icy).lt.chmipy.and.sgnl(icx).lt.chmipx)
1804  c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))       $              .and.
1805  c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)       $              (badclx.eq.1.and.badcly.eq.1)
1806  c$$$               cut=chcut*sch(nplx,nldx)       $              .and.
1807  c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent       $              .true.)then
1808  *     ===========================================================  
1809                                    ddd=(sgnl(icy)
1810                       $                 -kch(nplx,nldx)*sgnl(icx)-cch(nplx,nldx))
1811  *     ------------------> COUPLE <------------------                    ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
1812  *     check to do not overflow vector dimentions  
1813                 if(ncp_plane(nplx).gt.ncouplemax)then  c                  cut = chcut * sch(nplx,nldx)
1814                    if(DEBUG)print*,  
1815       $                    ' ** warning ** number of identified'//                    sss=(kch(nplx,nldx)*sgnl(icy)+sgnl(icx)
1816       $                    ' couples on plane ',nplx,       $                 -kch(nplx,nldx)*cch(nplx,nldx))
1817       $                    ' exceeds vector dimention'//                    sss=sss/sqrt(kch(nplx,nldx)**2+1)
1818       $                    ' ( ',ncouplemax,' )'                    cut = chcut * (16 + sss/50.)
1819  c     good2=.false.  
1820  c     goto 880   !fill ntp and go to next event                    if(abs(ddd).gt.cut)then
1821                    iflag=1                       goto 20    !charge not consistent
1822                    return                    endif
1823                 endif                 endif
1824                  
1825                 if(ncp_plane(nplx).eq.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
1826                    if(DEBUG)print*,                    if(verbose.eq.1)print*,
1827       $                 '** warning ** number of identified '//       $                 '** warning ** number of identified '//
1828       $                 'couples on plane ',nplx,       $                 'couples on plane ',nplx,
1829       $                 'exceeds vector dimention '       $                 'exceeds vector dimention '
1830       $                 ,'( ',ncouplemax,' )'       $                 ,'( ',ncouplemax,' ) --> masked!'
1831  c     good2=.false.  c                  mask_view(nviewx(nplx)) = 2
1832  c     goto 880   !fill ntp and go to next event                      c                  mask_view(nviewy(nply)) = 2
1833                    iflag=1                    mask_view(nviewx(nplx))= mask_view(nviewx(nplx))+ 2**1
1834                    return                    mask_view(nviewy(nply))= mask_view(nviewy(nply))+ 2**1
1835                      goto 10
1836                 endif                 endif
1837                                
1838    *     ------------------> COUPLE <------------------
1839                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
1840                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
1841                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
1842                 cl_single(icx)=0                 cl_single(icx)=0
1843                 cl_single(icy)=0                 cl_single(icy)=0
             endif                                
1844  *     ----------------------------------------------  *     ----------------------------------------------
1845    
1846                endif                              
1847    
1848   20         continue   20         continue
1849           enddo                  !end loop on clusters(Y)           enddo                  !end loop on clusters(Y)
1850                    
# Line 2037  c     goto 880   !fill ntp and go to nex Line 1861  c     goto 880   !fill ntp and go to nex
1861        enddo        enddo
1862                
1863                
1864        if(DEBUG)then        if(DEBUG.EQ.1)then
1865           print*,'clusters  ',nclstr1           print*,'clusters  ',nclstr1
1866           print*,'good    ',(cl_good(i),i=1,nclstr1)           print*,'good    ',(cl_good(i),i=1,nclstr1)
1867           print*,'singles ',(cl_single(i),i=1,nclstr1)           print*,'singlets',(cl_single(i),i=1,nclstr1)
1868           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
1869        endif        endif
1870                
1871        do ip=1,6        do ip=1,6
1872           ncp_tot=ncp_tot+ncp_plane(ip)           ncp_tot = ncp_tot + ncp_plane(ip)
1873        enddo        enddo
 c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
         
       if(ncp_tot.gt.ncp_max)then  
          if(DEBUG)print*,  
      $           '** warning ** number of identified '//  
      $           'couples exceeds upper limit for Hough tr. '  
      $           ,'( ',ncp_max,' )'              
 c            good2=.false.  
 c     goto 880       !fill ntp and go to next event  
          iflag=1  
          return  
       endif  
1874                
1875        return        return
1876        end        end
   
 c$$$      subroutine cl_to_couples_2(iflag)  
 c$$$  
 c$$$      include 'commontracker.f'  
 c$$$      include 'common_momanhough.f'  
 c$$$      include 'momanhough_init.f'  
 c$$$      include 'calib.f'  
 c$$$      include 'level1.f'  
 c$$$  
 c$$$      logical DEBUG  
 c$$$      common/dbg/DEBUG  
 c$$$  
 c$$$*     output flag  
 c$$$*     --------------  
 c$$$*     0 = good event  
 c$$$*     1 = bad event  
 c$$$*     --------------  
 c$$$      integer iflag  
 c$$$  
 c$$$      integer badseed,badcl  
 c$$$  
 c$$$*     init variables  
 c$$$      ncp_tot=0  
 c$$$      do ip=1,nplanes  
 c$$$         do ico=1,ncouplemax  
 c$$$            clx(ip,ico)=0  
 c$$$            cly(ip,ico)=0  
 c$$$         enddo  
 c$$$         ncp_plane(ip)=0  
 c$$$         do icl=1,nclstrmax_level2  
 c$$$            cls(ip,icl)=1  
 c$$$         enddo  
 c$$$         ncls(ip)=0  
 c$$$      enddo  
 c$$$      do icl=1,nclstrmax_level2  
 c$$$         cl_single(icl)=1  
 c$$$         cl_good(icl)=0  
 c$$$      enddo  
 c$$$        
 c$$$*     start association  
 c$$$      ncouples=0  
 c$$$      do icx=1,nclstr1          !loop on cluster (X)  
 c$$$         if(mod(VIEW(icx),2).eq.1)goto 10  
 c$$$          
 c$$$*     ----------------------------------------------------  
 c$$$*     cut on charge (X VIEW)  
 c$$$         if(dedx(icx).lt.dedx_x_min)then  
 c$$$            cl_single(icx)=0  
 c$$$            goto 10  
 c$$$         endif  
 c$$$*     cut BAD (X VIEW)              
 c$$$         badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))  
 c$$$         ifirst=INDSTART(icx)  
 c$$$         if(icx.ne.nclstr1) then  
 c$$$            ilast=INDSTART(icx+1)-1  
 c$$$         else  
 c$$$            ilast=TOTCLLENGTH  
 c$$$         endif  
 c$$$         badcl=badseed  
 c$$$         do igood=-ngoodstr,ngoodstr  
 c$$$            ibad=1  
 c$$$            if((INDMAX(icx)+igood).gt.ifirst.and.  
 c$$$     $           (INDMAX(icx)+igood).lt.ilast.and.  
 c$$$     $           .true.)then  
 c$$$               ibad=BAD(VIEW(icx),  
 c$$$     $              nvk(MAXS(icx)+igood),  
 c$$$     $              nst(MAXS(icx)+igood))  
 c$$$            endif  
 c$$$            badcl=badcl*ibad  
 c$$$         enddo  
 c$$$*         print*,'icx ',icx,badcl  
 c$$$         if(badcl.eq.0)then  
 c$$$            cl_single(icx)=0  
 c$$$            goto 10  
 c$$$         endif  
 c$$$*     ----------------------------------------------------  
 c$$$          
 c$$$         cl_good(icx)=1  
 c$$$         nplx=npl(VIEW(icx))  
 c$$$         nldx=nld(MAXS(icx),VIEW(icx))  
 c$$$          
 c$$$         do icy=1,nclstr1       !loop on cluster (Y)  
 c$$$            if(mod(VIEW(icy),2).eq.0)goto 20  
 c$$$              
 c$$$*     ----------------------------------------------------  
 c$$$*     cut on charge (Y VIEW)  
 c$$$            if(dedx(icy).lt.dedx_y_min)then  
 c$$$               cl_single(icy)=0  
 c$$$               goto 20  
 c$$$            endif  
 c$$$*     cut BAD (Y VIEW)              
 c$$$            badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))  
 c$$$            ifirst=INDSTART(icy)  
 c$$$            if(icy.ne.nclstr1) then  
 c$$$               ilast=INDSTART(icy+1)-1  
 c$$$            else  
 c$$$               ilast=TOTCLLENGTH  
 c$$$            endif  
 c$$$            badcl=badseed  
 c$$$            do igood=-ngoodstr,ngoodstr  
 c$$$               ibad=1  
 c$$$               if((INDMAX(icy)+igood).gt.ifirst.and.  
 c$$$     $              (INDMAX(icy)+igood).lt.ilast.and.  
 c$$$     $              .true.)  
 c$$$     $              ibad=BAD(VIEW(icy),  
 c$$$     $              nvk(MAXS(icy)+igood),  
 c$$$     $              nst(MAXS(icy)+igood))  
 c$$$               badcl=badcl*ibad  
 c$$$            enddo  
 c$$$*            print*,'icy ',icy,badcl  
 c$$$            if(badcl.eq.0)then  
 c$$$               cl_single(icy)=0  
 c$$$               goto 20  
 c$$$            endif  
 c$$$*     ----------------------------------------------------  
 c$$$              
 c$$$              
 c$$$            cl_good(icy)=1                    
 c$$$            nply=npl(VIEW(icy))  
 c$$$            nldy=nld(MAXS(icy),VIEW(icy))  
 c$$$              
 c$$$*     ----------------------------------------------  
 c$$$*     CONDITION TO FORM A COUPLE  
 c$$$*     ----------------------------------------------  
 c$$$*     geometrical consistency (same plane and ladder)  
 c$$$            if(nply.eq.nplx.and.nldy.eq.nldx)then  
 c$$$  
 c$$$c$$$*     charge correlation  
 c$$$c$$$               ddd=(dedx(icy)  
 c$$$c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  
 c$$$c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)  
 c$$$c$$$               cut=chcut*sch(nplx,nldx)  
 c$$$c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent  
 c$$$                
 c$$$*     ------------------> COUPLE <------------------  
 c$$$*     check to do not overflow vector dimentions  
 c$$$               if(ncp_plane(nplx).gt.ncouplemax)then  
 c$$$                  if(DEBUG)print*,  
 c$$$     $                    ' ** warning ** number of identified'//  
 c$$$     $                    ' couples on plane ',nplx,  
 c$$$     $                    ' exceeds vector dimention'//  
 c$$$     $                    ' ( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event  
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
 c$$$                
 c$$$               if(ncp_plane(nplx).eq.ncouplemax)then  
 c$$$                  if(DEBUG)print*,  
 c$$$     $                 '** warning ** number of identified '//  
 c$$$     $                 'couples on plane ',nplx,  
 c$$$     $                 'exceeds vector dimention '  
 c$$$     $                 ,'( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event                      
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
 c$$$                
 c$$$               ncp_plane(nplx) = ncp_plane(nplx) + 1  
 c$$$               clx(nplx,ncp_plane(nplx))=icx  
 c$$$               cly(nply,ncp_plane(nplx))=icy  
 c$$$               cl_single(icx)=0  
 c$$$               cl_single(icy)=0  
 c$$$c               print*,'couple ',nplx,ncp_plane(nplx),' --- ',icx,icy  
 c$$$            endif                                
 c$$$*     ----------------------------------------------  
 c$$$  
 c$$$ 20         continue  
 c$$$         enddo                  !end loop on clusters(Y)  
 c$$$          
 c$$$ 10      continue  
 c$$$      enddo                     !end loop on clusters(X)  
 c$$$        
 c$$$        
 c$$$      do icl=1,nclstr1  
 c$$$         if(cl_single(icl).eq.1)then  
 c$$$            ip=npl(VIEW(icl))  
 c$$$            ncls(ip)=ncls(ip)+1  
 c$$$            cls(ip,ncls(ip))=icl  
 c$$$         endif  
 c$$$      enddo  
 c$$$        
 c$$$        
 c$$$      if(DEBUG)then  
 c$$$         print*,'clusters  ',nclstr1  
 c$$$         print*,'good    ',(cl_good(i),i=1,nclstr1)  
 c$$$         print*,'singles ',(cl_single(i),i=1,nclstr1)  
 c$$$         print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)  
 c$$$      endif  
 c$$$        
 c$$$      do ip=1,6  
 c$$$         ncp_tot=ncp_tot+ncp_plane(ip)  
 c$$$      enddo  
 c$$$c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
 c$$$        
 c$$$      if(ncp_tot.gt.ncp_max)then  
 c$$$         if(DEBUG)print*,  
 c$$$     $           '** warning ** number of identified '//  
 c$$$     $           'couples exceeds upper limit for Hough tr. '  
 c$$$     $           ,'( ',ncp_max,' )'              
 c$$$c            good2=.false.  
 c$$$c     goto 880       !fill ntp and go to next event  
 c$$$         iflag=1  
 c$$$         return  
 c$$$      endif  
 c$$$        
 c$$$      return  
 c$$$      end  
1877                
1878  ***************************************************  ***************************************************
1879  *                                                 *  *                                                 *
# Line 2283  c$$$      end Line 1885  c$$$      end
1885  **************************************************  **************************************************
1886    
1887        subroutine cp_to_doubtrip(iflag)        subroutine cp_to_doubtrip(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
1888    
1889        include 'commontracker.f'        include 'commontracker.f'
1890          include 'level1.f'
1891        include 'common_momanhough.f'        include 'common_momanhough.f'
       include 'momanhough_init.f'  
1892        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1893        include 'common_mini_2.f'        include 'common_mini_2.f'
1894        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
1895    
       logical DEBUG  
       common/dbg/DEBUG  
1896    
1897  *     output flag  *     output flag
1898  *     --------------  *     --------------
# Line 2328  c      double precision xm3,ym3,zm3 Line 1924  c      double precision xm3,ym3,zm3
1924        real xc,zc,radius        real xc,zc,radius
1925  *     -----------------------------  *     -----------------------------
1926    
1927          if(DEBUG.EQ.1)print*,'cp_to_doubtrip:'
1928    
1929    *     --------------------------------------------
1930    *     put a limit to the maximum number of couples
1931    *     per plane, in order to apply hough transform
1932    *     (couples recovered during track refinement)
1933    *     --------------------------------------------
1934          do ip=1,nplanes
1935             if(ncp_plane(ip).gt.ncouplelimit)then
1936    c            mask_view(nviewx(ip)) = 8
1937    c            mask_view(nviewy(ip)) = 8
1938                mask_view(nviewx(ip)) = mask_view(nviewx(ip)) + 2**7
1939                mask_view(nviewy(ip)) = mask_view(nviewy(ip)) + 2**7
1940             endif
1941          enddo
1942    
1943    
1944        ndblt=0                   !number of doublets        ndblt=0                   !number of doublets
1945        ntrpt=0                   !number of triplets        ntrpt=0                   !number of triplets
1946                
1947        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1
1948           do is1=1,2             !loop on sensors - COPPIA 1           if(  mask_view(nviewx(ip1)).ne.0 .or.
1949                     $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
1950             do is1=1,2             !loop on sensors - COPPIA 1            
1951              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
1952                 icx1=clx(ip1,icp1)                 icx1=clx(ip1,icp1)
1953                 icy1=cly(ip1,icp1)                 icy1=cly(ip1,icp1)
1954  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
1955                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
1956                   call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
1957                 xm1=xPAM                 xm1=xPAM
1958                 ym1=yPAM                 ym1=yPAM
1959                 zm1=zPAM                                   zm1=zPAM                  
1960  c     print*,'***',is1,xm1,ym1,zm1  c     print*,'***',is1,xm1,ym1,zm1
1961    
1962                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
1963                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    if(  mask_view(nviewx(ip2)).ne.0 .or.
1964                             $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
1965                      do is2=1,2    !loop on sensors -ndblt COPPIA 2                    
1966                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2
1967                          icx2=clx(ip2,icp2)                          icx2=clx(ip2,icp2)
1968                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
1969  c                        call xyz_PAM  c                        call xyz_PAM
1970  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
1971    c                        call xyz_PAM
1972    c     $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)
1973                          call xyz_PAM                          call xyz_PAM
1974       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.) !(1)       $                       (icx2,icy2,is2,PFAdef,PFAdef,0.,0.,0.,0.)
1975                          xm2=xPAM                          xm2=xPAM
1976                          ym2=yPAM                          ym2=yPAM
1977                          zm2=zPAM                          zm2=zPAM
# Line 2364  c     $                       (icx2,icy2 Line 1981  c     $                       (icx2,icy2
1981  *     (2 couples needed)  *     (2 couples needed)
1982  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1983                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
1984                             if(DEBUG)print*,                             if(verbose.eq.1)print*,
1985       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
1986       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
1987       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
1988  c                           good2=.false.  c                           good2=.false.
1989  c                           goto 880 !fill ntp and go to next event  c                           goto 880 !fill ntp and go to next event
1990                               do iv=1,12
1991    c                              mask_view(iv) = 3
1992                                  mask_view(iv) = mask_view(iv)+ 2**2
1993                               enddo
1994                             iflag=1                             iflag=1
1995                             return                             return
1996                          endif                          endif
# Line 2403  c$$$ Line 2024  c$$$
2024  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2025    
2026    
2027                          if(ip2.eq.nplanes)goto 30 !no possible combination with 3 couples                          if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
2028    
2029                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
2030                               if(  mask_view(nviewx(ip3)).ne.0 .or.
2031         $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
2032                             do is3=1,2 !loop on sensors - COPPIA 3                             do is3=1,2 !loop on sensors - COPPIA 3
2033                                                                
2034                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
# Line 2412  c$$$ Line 2036  c$$$
2036                                   icy3=cly(ip3,icp3)                                   icy3=cly(ip3,icp3)
2037  c                                 call xyz_PAM  c                                 call xyz_PAM
2038  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
2039    c                                 call xyz_PAM
2040    c     $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)
2041                                   call xyz_PAM                                   call xyz_PAM
2042       $                               (icx3,icy3,is3,PFAdef,PFAdef,0.,0.) !(1)       $                                (icx3,icy3,is3,PFAdef,PFAdef
2043         $                                ,0.,0.,0.,0.)
2044                                   xm3=xPAM                                   xm3=xPAM
2045                                   ym3=yPAM                                   ym3=yPAM
2046                                   zm3=zPAM                                   zm3=zPAM
2047  *     find the circle passing through the three points  *     find the circle passing through the three points
2048    c$$$                                 call tricircle(3,xp,zp,angp,resp,chi
2049    c$$$     $                                ,xc,zc,radius,iflag)
2050                                     iflag = DEBUG
2051                                   call tricircle(3,xp,zp,angp,resp,chi                                   call tricircle(3,xp,zp,angp,resp,chi
2052       $                                ,xc,zc,radius,iflag)       $                                ,xc,zc,radius,iflag)
2053  c     print*,xc,zc,radius  c     print*,xc,zc,radius
# Line 2434  c     $                                 Line 2064  c     $                                
2064  *     (3 couples needed)  *     (3 couples needed)
2065  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2066                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
2067                                      if(DEBUG)print*,                                      if(verbose.eq.1)print*,
2068       $                     '** warning ** number of identified '//       $                     '** warning ** number of identified '//
2069       $                     'triplets exceeds vector dimention '       $                     'triplets exceeds vector dimention '
2070       $                    ,'( ',ntrpt_max,' )'       $                    ,'( ',ntrpt_max,' )'
2071  c                                    good2=.false.  c                                    good2=.false.
2072  c                                    goto 880 !fill ntp and go to next event  c                                    goto 880 !fill ntp and go to next event
2073                                        do iv=1,nviews
2074    c                                       mask_view(iv) = 4
2075                                           mask_view(iv)=mask_view(iv)+ 2**3
2076                                        enddo
2077                                      iflag=1                                      iflag=1
2078                                      return                                      return
2079                                   endif                                   endif
# Line 2478  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp Line 2112  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp
2112                                endif                                endif
2113                             enddo !end loop on COPPIA 3                             enddo !end loop on COPPIA 3
2114                          enddo   !end loop on sensors - COPPIA 3                          enddo   !end loop on sensors - COPPIA 3
2115     30                     continue
2116                       enddo      !end loop on planes  - COPPIA 3                       enddo      !end loop on planes  - COPPIA 3
2117   30                  continue   31                  continue
2118                                            
2119   1                enddo         !end loop on COPPIA 2   1                enddo         !end loop on COPPIA 2
2120                 enddo            !end loop on sensors - COPPIA 2                 enddo            !end loop on sensors - COPPIA 2
2121     20            continue
2122              enddo               !end loop on planes  - COPPIA 2              enddo               !end loop on planes  - COPPIA 2
2123                            
2124           enddo                  !end loop on COPPIA1           enddo                  !end loop on COPPIA1
2125        enddo                     !end loop on sensors - COPPIA 1        enddo                     !end loop on sensors - COPPIA 1
2126     10   continue
2127        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
2128                
2129        if(DEBUG)then        if(DEBUG.EQ.1)then
2130           print*,'--- doublets ',ndblt           print*,'--- doublets ',ndblt
2131           print*,'--- triplets ',ntrpt           print*,'--- triplets ',ntrpt
2132        endif        endif
# Line 2514  c     goto 880               !ntp fill Line 2151  c     goto 880               !ntp fill
2151        subroutine doub_to_YZcloud(iflag)        subroutine doub_to_YZcloud(iflag)
2152    
2153        include 'commontracker.f'        include 'commontracker.f'
2154          include 'level1.f'
2155        include 'common_momanhough.f'        include 'common_momanhough.f'
2156        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2157    
       logical DEBUG  
       common/dbg/DEBUG  
2158    
2159  *     output flag  *     output flag
2160  *     --------------  *     --------------
# Line 2537  c     goto 880               !ntp fill Line 2173  c     goto 880               !ntp fill
2173        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2174        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2175    
2176          if(DEBUG.EQ.1)print*,'doub_to_YZcloud:'
2177    
2178  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2179  *     classification of DOUBLETS  *     classification of DOUBLETS
# Line 2550  c     goto 880               !ntp fill Line 2187  c     goto 880               !ntp fill
2187        distance=0        distance=0
2188        nclouds_yz=0              !number of clouds        nclouds_yz=0              !number of clouds
2189        npt_tot=0        npt_tot=0
2190          nloop=0                  
2191     90   continue                  
2192        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2193           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
2194                            
# Line 2653  c     print*,'*   idbref,idb2 ',idbref,i Line 2292  c     print*,'*   idbref,idb2 ',idbref,i
2292              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2293           enddo           enddo
2294  c     print*,'>>>> ',ncpused,npt,nplused  c     print*,'>>>> ',ncpused,npt,nplused
2295           if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  c         if(ncpused.lt.ncpyz_min)goto 2228 !next doublet
2296           if(npt.lt.nptyz_min)goto 2228 !next doublet           if(npt.lt.nptyz_min)goto 2228 !next doublet
2297           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2298                    
# Line 2661  c     print*,'>>>> ',ncpused,npt,nplused Line 2300  c     print*,'>>>> ',ncpused,npt,nplused
2300  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2301    
2302           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2303              if(DEBUG)print*,              if(verbose.eq.1)print*,
2304       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2305       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2306       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2307  c               good2=.false.  c               good2=.false.
2308  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2309                do iv=1,nviews
2310    c               mask_view(iv) = 5
2311                   mask_view(iv) = mask_view(iv) + 2**4
2312                enddo
2313              iflag=1              iflag=1
2314              return              return
2315           endif           endif
# Line 2685  c     ptcloud_yz_nt(nclouds_yz)=npt Line 2328  c     ptcloud_yz_nt(nclouds_yz)=npt
2328  c     print*,'>> ',ipt,db_all(ipt)  c     print*,'>> ',ipt,db_all(ipt)
2329           enddo             enddo  
2330           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2331           if(DEBUG)then           if(DEBUG.EQ.1)then
2332              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'
2333              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'
2334              print*,'- alfayz1 ',alfayz1_av(nclouds_yz)              print*,'- alfayz1  ',alfayz1_av(nclouds_yz)
2335              print*,'- alfayz2 ',alfayz2_av(nclouds_yz)              print*,'- alfayz2  ',alfayz2_av(nclouds_yz)
2336              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2337              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2338              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'cpcloud_yz '
2339         $           ,(cpcloud_yz(nclouds_yz,icp),icp=1,ncp_tot)
2340                print*,'hit_plane  ',(hit_plane(ip),ip=1,nplanes)
2341  c$$$            print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '  c$$$            print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '
2342  c$$$     $           ,ptcloud_yz(nclouds_yz)  c$$$     $           ,ptcloud_yz(nclouds_yz)
2343  c$$$            print*,'nt-uple: db_cloud(...) = '  c$$$            print*,'nt-uple: db_cloud(...) = '
# Line 2704  c$$$     $           ,(db_cloud(iii),iii Line 2349  c$$$     $           ,(db_cloud(iii),iii
2349        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2350                
2351                
2352        if(DEBUG)then        if(nloop.lt.nstepy)then      
2353            cutdistyz = cutdistyz+cutystep
2354            nloop     = nloop+1          
2355            goto 90                
2356          endif                    
2357          
2358          if(DEBUG.EQ.1)then
2359           print*,'---------------------- '           print*,'---------------------- '
2360           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
2361           print*,' '           print*,' '
# Line 2730  c$$$     $           ,(db_cloud(iii),iii Line 2381  c$$$     $           ,(db_cloud(iii),iii
2381        subroutine trip_to_XZcloud(iflag)        subroutine trip_to_XZcloud(iflag)
2382    
2383        include 'commontracker.f'        include 'commontracker.f'
2384          include 'level1.f'
2385        include 'common_momanhough.f'        include 'common_momanhough.f'
2386        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2387    
       logical DEBUG  
       common/dbg/DEBUG  
2388    
2389  *     output flag  *     output flag
2390  *     --------------  *     --------------
# Line 2754  c$$$     $           ,(db_cloud(iii),iii Line 2404  c$$$     $           ,(db_cloud(iii),iii
2404        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2405        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2406    
2407          if(DEBUG.EQ.1)print*,'trip_to_XZcloud:'
2408    
2409  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2410  *     classification of TRIPLETS  *     classification of TRIPLETS
2411  *     according to distance in parameter space  *     according to distance in parameter space
# Line 2765  c$$$     $           ,(db_cloud(iii),iii Line 2417  c$$$     $           ,(db_cloud(iii),iii
2417        distance=0        distance=0
2418        nclouds_xz=0              !number of clouds                nclouds_xz=0              !number of clouds        
2419        npt_tot=0                 !total number of selected triplets        npt_tot=0                 !total number of selected triplets
2420          nloop=0                  
2421     91   continue                  
2422        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2423           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
2424  c     print*,'--------------'  c     print*,'--------------'
# Line 2809  c         tr_temp(1)=itr1 Line 2463  c         tr_temp(1)=itr1
2463       $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2                     $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2              
2464                 distance = sqrt(distance)                 distance = sqrt(distance)
2465                                
2466                 if(distance.lt.cutdistxz)then  *     ------------------------------------------------------------------------
2467    *     FORCE INCLUSION OF TRIPLETS COMPOSED BY SAME COUPLES, IGNORING THE IMAGE
2468    *     ------------------------------------------------------------------------
2469    *     (added in august 2007)
2470                   istrimage=0
2471                   if(
2472         $              abs(cpxz1(itrref)).eq.abs(cpxz1(itr2)).and.
2473         $              abs(cpxz2(itrref)).eq.abs(cpxz2(itr2)).and.
2474         $              abs(cpxz3(itrref)).eq.abs(cpxz3(itr2)).and.
2475         $              .true.)istrimage=1
2476    
2477                   if(distance.lt.cutdistxz.or.istrimage.eq.1)then
2478  c     print*,idb1,idb2,distance,' cloud ',nclouds_yz  c     print*,idb1,idb2,distance,' cloud ',nclouds_yz
2479                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1
2480                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1
# Line 2866  c     print*,'check cp_used' Line 2531  c     print*,'check cp_used'
2531           do ip=1,nplanes           do ip=1,nplanes
2532              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2533           enddo           enddo
2534           if(ncpused.lt.ncpxz_min)goto 22288 !next triplet  c         if(ncpused.lt.ncpxz_min)goto 22288 !next triplet
2535           if(npt.lt.nptxz_min)goto 22288     !next triplet           if(npt.lt.nptxz_min)goto 22288     !next triplet
2536           if(nplused.lt.nplxz_min)goto 22288 !next doublet           if(nplused.lt.nplxz_min)goto 22288 !next triplet
2537                    
2538  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2539  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2540           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2541              if(DEBUG)print*,              if(verbose.eq.1)print*,
2542       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2543       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2544       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2545  c     good2=.false.  c     good2=.false.
2546  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2547                do iv=1,nviews
2548    c               mask_view(iv) = 6
2549                   mask_view(iv) =  mask_view(iv) + 2**5
2550                enddo
2551              iflag=1              iflag=1
2552              return              return
2553           endif           endif
# Line 2896  c     goto 880         !fill ntp and go Line 2565  c     goto 880         !fill ntp and go
2565           enddo           enddo
2566           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2567                    
2568           if(DEBUG)then           if(DEBUG.EQ.1)then
2569              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'
2570              print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'                            print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'              
2571              print*,'- alfaxz1 ',alfaxz1_av(nclouds_xz)              print*,'- alfaxz1  ',alfaxz1_av(nclouds_xz)
2572              print*,'- alfaxz2 ',alfaxz2_av(nclouds_xz)              print*,'- alfaxz2  ',alfaxz2_av(nclouds_xz)
2573              print*,'- alfaxz3 ',alfaxz3_av(nclouds_xz)              print*,'- alfaxz3  ',alfaxz3_av(nclouds_xz)
2574              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2575              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2576                print*,'cpcloud_xz '
2577         $           ,(cpcloud_xz(nclouds_xz,icp),icp=1,ncp_tot)
2578              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)
2579  c$$$            print*,'nt-uple: ptcloud_xz(',nclouds_xz,') = '  c$$$            print*,'nt-uple: ptcloud_xz(',nclouds_xz,') = '
2580  c$$$     $           ,ptcloud_xz(nclouds_xz)  c$$$     $           ,ptcloud_xz(nclouds_xz)
# Line 2914  c$$$     $           ,(tr_cloud(iii),iii Line 2585  c$$$     $           ,(tr_cloud(iii),iii
2585  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2586  22288    continue  22288    continue
2587        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2588          
2589        if(DEBUG)then         if(nloop.lt.nstepx)then      
2590             cutdistxz=cutdistxz+cutxstep
2591             nloop=nloop+1          
2592             goto 91                
2593           endif                    
2594          
2595          if(DEBUG.EQ.1)then
2596           print*,'---------------------- '           print*,'---------------------- '
2597           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
2598           print*,' '           print*,' '
# Line 2936  c$$$     $           ,(tr_cloud(iii),iii Line 2613  c$$$     $           ,(tr_cloud(iii),iii
2613  **************************************************  **************************************************
2614    
2615        subroutine clouds_to_ctrack(iflag)        subroutine clouds_to_ctrack(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2616    
2617        include 'commontracker.f'        include 'commontracker.f'
2618          include 'level1.f'
2619        include 'common_momanhough.f'        include 'common_momanhough.f'
2620        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2621        include 'common_mini_2.f'        include 'common_mini_2.f'
2622        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
2623    
2624        logical DEBUG  
       common/dbg/DEBUG  
2625    
2626  *     output flag  *     output flag
2627  *     --------------  *     --------------
# Line 2964  c*************************************** Line 2637  c***************************************
2637  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2638  *     list of matching couples in the combination  *     list of matching couples in the combination
2639  *     between a XZ and YZ cloud  *     between a XZ and YZ cloud
2640        integer cp_match(nplanes,ncouplemax)        integer cp_match(nplanes,2*ncouplemax)
2641        integer ncp_match(nplanes)        integer ncp_match(nplanes)
2642  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2643        integer hit_plane(nplanes)        integer hit_plane(nplanes)
2644  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2645  *     variables for track fitting  *     variables for track fitting
2646        double precision AL_INI(5)        double precision AL_INI(5)
       double precision tath  
2647  *     -----------------------------------------------------------  *     -----------------------------------------------------------
 c      real fitz(nplanes)        !z coordinates of the planes in cm  
2648    
2649          if(DEBUG.EQ.1)print*,'clouds_to_ctrack:'
2650    
2651    
2652        ntracks=0                 !counter of track candidates        ntracks=0                 !counter of track candidates
# Line 2996  c      real fitz(nplanes)        !z coor Line 2668  c      real fitz(nplanes)        !z coor
2668                 enddo                 enddo
2669              enddo              enddo
2670              ncp_ok=0              ncp_ok=0
2671              do icp=1,ncp_tot    !loop on couples              do icp=1,ncp_tot    !loop over couples
2672  *     get info on  *     get info on
2673                 cpintersec(icp)=min(                 cpintersec(icp)=min(
2674       $              cpcloud_yz(iyz,icp),       $              cpcloud_yz(iyz,icp),
# Line 3005  c      real fitz(nplanes)        !z coor Line 2677  c      real fitz(nplanes)        !z coor
2677       $    (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.       $    (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.
2678       $    (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.       $    (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.
2679       $              .false.)cpintersec(icp)=0       $              .false.)cpintersec(icp)=0
2680    *     cpintersec is >0 if yz and xz clouds contain the same image of couple icp
2681                 if(cpintersec(icp).ne.0)then                 if(cpintersec(icp).ne.0)then
2682                    ncp_ok=ncp_ok+1                      ncp_ok=ncp_ok+1  
2683                                        
# Line 3037  c      real fitz(nplanes)        !z coor Line 2710  c      real fitz(nplanes)        !z coor
2710                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2711              enddo              enddo
2712                            
             if(nplused.lt.nplxz_min)goto 888 !next doublet  
             if(ncp_ok.lt.ncpok)goto 888 !next cloud  
2713                            
2714              if(DEBUG)then              if(DEBUG.EQ.1)then
2715                 print*,'Combination ',iyz,ixz                 print*,'Combination ',iyz,ixz
2716       $              ,' db ',ptcloud_yz(iyz)       $              ,' db ',ptcloud_yz(iyz)
2717       $              ,' tr ',ptcloud_xz(ixz)       $              ,' tr ',ptcloud_xz(ixz)
2718       $              ,'  -----> # matching couples ',ncp_ok       $              ,'  -----> # matching couples ',ncp_ok
2719              endif              endif
2720    
2721    c            if(nplused.lt.nplxz_min)goto 888 !next combination
2722                if(nplused.lt.nplyz_min)goto 888 !next combination
2723                if(ncp_ok.lt.ncpok)goto 888 !next combination
2724    
2725  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2726  c$$$  print*,'Configurazione cluster XZ'  c$$$  print*,'Configurazione cluster XZ'
2727  c$$$  print*,'1 -- ',(clx(1,i),i=1,ncp_plane(1))  c$$$  print*,'1 -- ',(clx(1,i),i=1,ncp_plane(1))
# Line 3064  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p Line 2740  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p
2740  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2741                            
2742  *     -------> INITIAL GUESS <-------  *     -------> INITIAL GUESS <-------
2743              AL_INI(1)=dreal(alfaxz1_av(ixz))  cccc       SBAGLIATO
2744              AL_INI(2)=dreal(alfayz1_av(iyz))  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2745              AL_INI(4)=datan(dreal(alfayz2_av(iyz))  c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2746       $           /dreal(alfaxz2_av(ixz)))  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2747              tath=-dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))  c$$$     $           /dreal(alfaxz2_av(ixz)))
2748              AL_INI(3)=tath/sqrt(1+tath**2)  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2749              AL_INI(5)=(1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2750                c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2751  c     print*,'*******',AL_INI(5)  cccc       GIUSTO (ma si sua guess())
2752              if(AL_INI(5).gt.defmax)goto 888 !next cloud  c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))
2753                c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))
2754  c     print*,'alfaxz2, alfayz2 '  c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
2755  c     $              ,alfaxz2_av(ixz),alfayz2_av(iyz)  c$$$            AL_INI(3) = tath/sqrt(1+tath**2)
2756                c$$$            IF(alfaxz2_av(ixz).NE.0)THEN
2757  *     -------> INITIAL GUESS <-------  c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2758  c     print*,'AL_INI ',(al_ini(i),i=1,5)  c$$$     $           /dreal(alfaxz2_av(ixz)))
2759                c$$$            ELSE
2760              if(DEBUG)then  c$$$               AL_INI(4) = acos(-1.)/2
2761    c$$$               IF(alfayz2_av(iyz).LT.0)AL_INI(4) = AL_INI(4)+acos(-1.)
2762    c$$$            ENDIF
2763    c$$$            IF(alfaxz2_av(ixz).LT.0)AL_INI(4)= acos(-1.)+ AL_INI(4)
2764    c$$$            AL_INI(4) = -acos(-1.) + AL_INI(4) !from incidence direction to tracking rs
2765    c$$$            
2766    c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
2767    c$$$            
2768    c$$$            if(AL_INI(5).gt.defmax)goto 888 !next cloud
2769                            
2770                if(DEBUG.EQ.1)then
2771                   print*,'track candidate', ntracks+1
2772                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2773                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))
2774                 print*,'3 >>> ',(cp_match(4,i),i=1,ncp_match(4))                 print*,'3 >>> ',(cp_match(4,i),i=1,ncp_match(4))
# Line 3114  c     print*,'AL_INI ',(al_ini(i),i=1,5) Line 2801  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2801                                hit_plane(6)=icp6                                hit_plane(6)=icp6
2802                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6
2803                                                                
2804                                  *                             ---------------------------------------
2805    *                             check if this group of couples has been
2806    *                             already fitted    
2807    *                             ---------------------------------------
2808                                  do ica=1,ntracks
2809                                     isthesame=1
2810                                     do ip=1,NPLANES
2811                                        if(hit_plane(ip).ne.0)then
2812                                           if(  CP_STORE(nplanes-ip+1,ica)
2813         $                                      .ne.
2814         $                                      cp_match(ip,hit_plane(ip)) )
2815         $                                      isthesame=0
2816                                        else
2817                                           if(  CP_STORE(nplanes-ip+1,ica)
2818         $                                      .ne.
2819         $                                      0 )
2820         $                                      isthesame=0
2821                                        endif
2822                                     enddo
2823                                     if(isthesame.eq.1)then
2824                                        if(DEBUG.eq.1)
2825         $                                   print*,'(already fitted)'
2826                                        goto 666 !jump to next combination
2827                                     endif
2828                                  enddo
2829    
2830                                call track_init !init TRACK common                                call track_init !init TRACK common
2831    
2832                                do ip=1,nplanes !loop on planes                                do ip=1,nplanes !loop on planes (bottom to top)
2833                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2834                                      id=cp_match(ip,hit_plane(ip))                                      id=cp_match(ip,hit_plane(ip))
2835                                      is=is_cp(id)                                      is=is_cp(id)
# Line 3131  c     print*,'AL_INI ',(al_ini(i),i=1,5) Line 2843  c     print*,'AL_INI ',(al_ini(i),i=1,5)
2843  *                                   *************************  *                                   *************************
2844  c                                    call xyz_PAM(icx,icy,is,  c                                    call xyz_PAM(icx,icy,is,
2845  c     $                                   'COG2','COG2',0.,0.)  c     $                                   'COG2','COG2',0.,0.)
2846    c                                    call xyz_PAM(icx,icy,is, !(1)
2847    c     $                                   PFAdef,PFAdef,0.,0.) !(1)
2848                                      call xyz_PAM(icx,icy,is, !(1)                                      call xyz_PAM(icx,icy,is, !(1)
2849       $                                   PFAdef,PFAdef,0.,0.) !(1)       $                                   PFAdef,PFAdef,0.,0.,0.,0.)
2850  *                                   *************************  *                                   *************************
2851  *                                   -----------------------------  *                                   -----------------------------
2852                                      xgood(nplanes-ip+1)=1.                                      xgood(nplanes-ip+1)=1.
# Line 3148  c     $                                 Line 2862  c     $                                
2862  *     **********************************************************  *     **********************************************************
2863  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
2864  *     **********************************************************  *     **********************************************************
2865    cccc  scommentare se si usa al_ini della nuvola
2866    c$$$                              do i=1,5
2867    c$$$                                 AL(i)=AL_INI(i)
2868    c$$$                              enddo
2869                                  call guess()
2870                                do i=1,5                                do i=1,5
2871                                   AL(i)=AL_INI(i)                                   AL_INI(i)=AL(i)
2872                                enddo                                enddo
2873                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
2874                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
2875                                call mini_2(jstep,ifail)                                iprint=0
2876    c                              if(DEBUG.EQ.1)iprint=1
2877                                  if(DEBUG.EQ.1)iprint=2
2878                                  call mini2(jstep,ifail,iprint)
2879                                if(ifail.ne.0) then                                if(ifail.ne.0) then
2880                                   if(DEBUG)then                                   if(DEBUG.EQ.1)then
2881                                      print *,                                      print *,
2882       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
2883       $                              //'(mini_2 in clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
2884                                        print*,'initial guess: '
2885    
2886                                        print*,'AL_INI(1) = ',AL_INI(1)
2887                                        print*,'AL_INI(2) = ',AL_INI(2)
2888                                        print*,'AL_INI(3) = ',AL_INI(3)
2889                                        print*,'AL_INI(4) = ',AL_INI(4)
2890                                        print*,'AL_INI(5) = ',AL_INI(5)
2891                                   endif                                   endif
2892                                   chi2=-chi2  c                                 chi2=-chi2
2893                                endif                                endif
2894  *     **********************************************************  *     **********************************************************
2895  *     ************************** FIT *** FIT *** FIT *** FIT ***  *     ************************** FIT *** FIT *** FIT *** FIT ***
# Line 3173  c     $                                 Line 2902  c     $                                
2902  *     --------------------------  *     --------------------------
2903                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
2904                                                                    
2905                                   if(DEBUG)print*,                                   if(verbose.eq.1)print*,
2906       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
2907       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
2908       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
2909  c                                 good2=.false.  c                                 good2=.false.
2910  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
2911                                     do iv=1,nviews
2912    c                                    mask_view(iv) = 7
2913                                        mask_view(iv) = mask_view(iv) + 2**6
2914                                     enddo
2915                                   iflag=1                                   iflag=1
2916                                   return                                   return
2917                                endif                                endif
2918                                                                
2919                                ntracks = ntracks + 1                                ntracks = ntracks + 1
2920                                                                
2921  c$$$                              ndof=0                                                                do ip=1,nplanes !top to bottom
2922                                do ip=1,nplanes  
 c$$$                                 ndof=ndof  
 c$$$     $                                +int(xgood(ip))  
 c$$$     $                                +int(ygood(ip))  
2923                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
2924                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
2925                                   ZV_STORE(ip,ntracks)=sngl(zv(ip))                                                                       ZV_STORE(ip,ntracks)=sngl(zv(ip))                                    
# Line 3205  c$$$     $                               Line 2935  c$$$     $                              
2935                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))
2936                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))
2937                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))
2938    *                                NB! hit_plane is defined from bottom to top
2939                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2940                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
2941       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
2942                                        SENSOR_STORE(nplanes-ip+1,ntracks)
2943         $                              = is_cp(cp_match(ip,hit_plane(ip)))
2944                                        LADDER_STORE(nplanes-ip+1,ntracks)
2945         $                                   = LADDER(
2946         $                                   clx(ip,icp_cp(
2947         $                                   cp_match(ip,hit_plane(ip)
2948         $                                   ))));
2949                                   else                                   else
2950                                      CP_STORE(nplanes-ip+1,ntracks)=0                                      CP_STORE(nplanes-ip+1,ntracks)=0
2951                                        SENSOR_STORE(nplanes-ip+1,ntracks)=0
2952                                        LADDER_STORE(nplanes-ip+1,ntracks)=0
2953                                   endif                                   endif
2954                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   BX_STORE(ip,ntracks)=0!I dont need it now
2955                                     BY_STORE(ip,ntracks)=0!I dont need it now
2956                                     CLS_STORE(ip,ntracks)=0
2957                                   do i=1,5                                   do i=1,5
2958                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
2959                                   enddo                                   enddo
2960                                enddo                                enddo
2961                                                                
 c$$$  *                             Number of Degree Of Freedom  
 c$$$  ndof=ndof-5                            
 c$$$  *                             reduced chi^2  
 c$$$  rchi2=chi2/dble(ndof)  
2962                                RCHI2_STORE(ntracks)=chi2                                RCHI2_STORE(ntracks)=chi2
2963                                                                
2964  *     --------------------------------  *     --------------------------------
# Line 3244  c$$$  rchi2=chi2/dble(ndof) Line 2982  c$$$  rchi2=chi2/dble(ndof)
2982           return           return
2983        endif        endif
2984                
2985        if(DEBUG)then  c$$$      if(DEBUG.EQ.1)then
2986           print*,'****** TRACK CANDIDATES ***********'  c$$$         print*,'****** TRACK CANDIDATES ***********'
2987           print*,'#         R. chi2        RIG'  c$$$         print*,'#         R. chi2        RIG'
2988           do i=1,ntracks  c$$$         do i=1,ntracks
2989              print*,i,' --- ',rchi2_store(i),' --- '  c$$$            print*,i,' --- ',rchi2_store(i),' --- '
2990       $           ,1./abs(AL_STORE(5,i))  c$$$     $           ,1./abs(AL_STORE(5,i))
2991           enddo  c$$$         enddo
2992           print*,'***********************************'  c$$$         print*,'***********************************'
2993    c$$$      endif
2994          if(DEBUG.EQ.1)then
2995            print*,'****** TRACK CANDIDATES *****************'
2996            print*,'#         R. chi2        RIG         ndof'
2997            do i=1,ntracks
2998              ndof=0                !(1)
2999              do ii=1,nplanes       !(1)
3000                ndof=ndof           !(1)
3001         $           +int(xgood_store(ii,i)) !(1)
3002         $           +int(ygood_store(ii,i)) !(1)
3003              enddo                 !(1)
3004              print*,i,' --- ',rchi2_store(i),' --- '
3005         $         ,1./abs(AL_STORE(5,i)),' --- ',ndof
3006            enddo
3007            print*,'*****************************************'
3008        endif        endif
3009                
3010                
# Line 3270  c$$$  rchi2=chi2/dble(ndof) Line 3023  c$$$  rchi2=chi2/dble(ndof)
3023    
3024        subroutine refine_track(ibest)        subroutine refine_track(ibest)
3025    
 c******************************************************  
 cccccc 06/10/2005 modified by elena vannuccini ---> (1)  
 cccccc 31/01/2006 modified by elena vannuccini ---> (2)  
 c******************************************************  
3026    
3027        include 'commontracker.f'        include 'commontracker.f'
3028          include 'level1.f'
3029        include 'common_momanhough.f'        include 'common_momanhough.f'
3030        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3031        include 'common_mini_2.f'        include 'common_mini_2.f'
3032        include 'common_mech.f'        include 'common_mech.f'
       include 'momanhough_init.f'  
       include 'level1.f'  
3033        include 'calib.f'        include 'calib.f'
3034    
       logical DEBUG  
       common/dbg/DEBUG  
   
3035  *     flag to chose PFA  *     flag to chose PFA
3036        character*10 PFA        character*10 PFA
3037        common/FINALPFA/PFA        common/FINALPFA/PFA
3038    
3039          real k(6)
3040          DATA k/1.099730,0.418900,0.220939,0.220907,0.418771,1.100674/
3041    
3042          real xp,yp,zp
3043          real xyzp(3),bxyz(3)
3044          equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
3045    
3046          if(DEBUG.EQ.1)print*,'refine_track:'
3047  *     =================================================  *     =================================================
3048  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
3049  *                          and  *                          and
# Line 3299  c*************************************** Line 3052  c***************************************
3052        call track_init        call track_init
3053        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3054    
3055             if(DEBUG.EQ.1)print*,' ........... plane ',ip,' ........... '
3056    
3057             xP=XV_STORE(nplanes-ip+1,ibest)
3058             yP=YV_STORE(nplanes-ip+1,ibest)
3059             zP=ZV_STORE(nplanes-ip+1,ibest)
3060             call gufld(xyzp,bxyz)
3061             BX_STORE(nplanes-ip+1,ibest)=bxyz(1)
3062             BY_STORE(nplanes-ip+1,ibest)=bxyz(2)
3063    c$$$  bxyz(1)=0
3064    c$$$         bxyz(2)=0
3065    c$$$         bxyz(3)=0
3066    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3067  *     -------------------------------------------------  *     -------------------------------------------------
3068  *     If the plane has been already included, it just  *     If the plane has been already included, it just
3069  *     computes again the coordinates of the x-y couple  *     computes again the coordinates of the x-y couple
3070  *     using improved PFAs  *     using improved PFAs
3071  *     -------------------------------------------------  *     -------------------------------------------------
3072    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3073           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
3074       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
3075                            
# Line 3317  c*************************************** Line 3083  c***************************************
3083       $           ,ip_cp(id),ip       $           ,ip_cp(id),ip
3084              icx=clx(ip,icp)              icx=clx(ip,icp)
3085              icy=cly(ip,icp)              icy=cly(ip,icp)
3086    c            call xyz_PAM(icx,icy,is,
3087    c     $           PFA,PFA,
3088    c     $           AXV_STORE(nplanes-ip+1,ibest),
3089    c     $           AYV_STORE(nplanes-ip+1,ibest))
3090              call xyz_PAM(icx,icy,is,              call xyz_PAM(icx,icy,is,
 c     $           'ETA2','ETA2',  
3091       $           PFA,PFA,       $           PFA,PFA,
3092       $           AXV_STORE(nplanes-ip+1,ibest),       $           AXV_STORE(nplanes-ip+1,ibest),
3093       $           AYV_STORE(nplanes-ip+1,ibest))       $           AYV_STORE(nplanes-ip+1,ibest),
3094  c$$$  call xyz_PAM(icx,icy,is,       $           bxyz(1),
3095  c$$$  $              'COG2','COG2',       $           bxyz(2)
3096  c$$$  $              0.,       $           )
3097  c$$$  $              0.)  
3098              xm(nplanes-ip+1) = xPAM              xm(nplanes-ip+1) = xPAM
3099              ym(nplanes-ip+1) = yPAM              ym(nplanes-ip+1) = yPAM
3100              zm(nplanes-ip+1) = zPAM              zm(nplanes-ip+1) = zPAM
# Line 3334  c$$$  $              0.) Line 3103  c$$$  $              0.)
3103              resx(nplanes-ip+1) = resxPAM              resx(nplanes-ip+1) = resxPAM
3104              resy(nplanes-ip+1) = resyPAM              resy(nplanes-ip+1) = resyPAM
3105    
3106  c            dedxtrk(nplanes-ip+1) = (dedx(icx)+dedx(icy))/2. !(1)              dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3107              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)  
3108                            
3109    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3110  *     -------------------------------------------------  *     -------------------------------------------------
3111  *     If the plane has NOT  been already included,  *     If the plane has NOT  been already included,
3112  *     it tries to include a COUPLE or a single cluster  *     it tries to include a COUPLE or a single cluster
3113  *     -------------------------------------------------  *     -------------------------------------------------
3114    *     |||||||||||||||||||||||||||||||||||||||||||||||||
3115           else                             else                  
3116                                
3117              xgood(nplanes-ip+1)=0              xgood(nplanes-ip+1)=0
# Line 3349  c            dedxtrk(nplanes-ip+1) = (de Line 3119  c            dedxtrk(nplanes-ip+1) = (de
3119                                
3120  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3121  *     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)  
3122              call whichsensor(ip,xP,yP,nldt,ist)              call whichsensor(ip,xP,yP,nldt,ist)
3123  *     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
3124              if(nldt.eq.0.or.ist.eq.0)goto 133              if(nldt.eq.0.or.ist.eq.0)goto 133
3125    
3126                SENSOR_STORE(nplanes-ip+1,IBEST)=ist
3127                LADDER_STORE(nplanes-ip+1,IBEST)=nldt
3128  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3129    
3130              if(DEBUG)then              if(DEBUG.EQ.1)then
3131                 print*,                 print*,
3132       $              '------ Plane ',ip,' intersected on LADDER ',nldt       $              '------ Plane ',ip,' intersected on LADDER ',nldt
3133       $              ,' SENSOR ',ist       $              ,' SENSOR ',ist
# Line 3368  c            dedxtrk(nplanes-ip+1) = (de Line 3138  c            dedxtrk(nplanes-ip+1) = (de
3138  *     ===========================================  *     ===========================================
3139  *     STEP 1 >>>>>>>  try to include a new couple  *     STEP 1 >>>>>>>  try to include a new couple
3140  *     ===========================================  *     ===========================================
3141  c            if(DEBUG)print*,'>>>> try to include a new couple'  c            if(DEBUG.EQ.1)print*,'>>>> try to include a new couple'
3142              distmin=1000000.              distmin=1000000.
3143              xmm = 0.              xmm = 0.
3144              ymm = 0.              ymm = 0.
# Line 3383  c            if(DEBUG)print*,'>>>> try t Line 3153  c            if(DEBUG)print*,'>>>> try t
3153                 icx=clx(ip,icp)                 icx=clx(ip,icp)
3154                 icy=cly(ip,icp)                 icy=cly(ip,icp)
3155                 if(LADDER(icx).ne.nldt.or. !If the ladder number does not match                 if(LADDER(icx).ne.nldt.or. !If the ladder number does not match
3156       $              cl_used(icx).eq.1.or. !or the X cluster is already used  c     $              cl_used(icx).eq.1.or. !or the X cluster is already used
3157       $              cl_used(icy).eq.1.or. !or the Y cluster is already used  c     $              cl_used(icy).eq.1.or. !or the Y cluster is already used
3158         $              cl_used(icx).ne.0.or. !or the X cluster is already used
3159         $              cl_used(icy).ne.0.or. !or the Y cluster is already used
3160       $              .false.)goto 1188 !then jump to next couple.       $              .false.)goto 1188 !then jump to next couple.
3161  *            *          
3162                 call xyz_PAM(icx,icy,ist,                 call xyz_PAM(icx,icy,ist,
3163       $              PFA,PFA,       $              PFA,PFA,
 c     $              'ETA2','ETA2',  
3164       $              AXV_STORE(nplanes-ip+1,ibest),       $              AXV_STORE(nplanes-ip+1,ibest),
3165       $              AYV_STORE(nplanes-ip+1,ibest))       $              AYV_STORE(nplanes-ip+1,ibest),
3166         $              bxyz(1),
3167         $              bxyz(2)
3168         $              )
3169                                
3170                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3171    c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3172                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3173                 if(DEBUG)print*,'( couple ',id                 if(DEBUG.EQ.1)print*,'( couple ',id
3174       $              ,' ) normalized distance ',distance       $              ,' ) distance ',distance
3175                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3176                    xmm = xPAM                    xmm = xPAM
3177                    ymm = yPAM                    ymm = yPAM
# Line 3405  c     $              'ETA2','ETA2', Line 3180  c     $              'ETA2','ETA2',
3180                    rymm = resyPAM                    rymm = resyPAM
3181                    distmin = distance                    distmin = distance
3182                    idm = id                                      idm = id                  
3183  c                 dedxmm = (dedx(icx)+dedx(icy))/2. !(1)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3184                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3185                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)  c     QUIQUI --> non devo moltiplicare per clinc?!?!?!
3186                      clincnewc=10*sqrt(rymm**2+rxmm**2 !QUIQUI
3187         $                 +RCHI2_STORE(ibest)*k(ip)*(cov(1,1)+cov(2,2))) !QUIQUI
3188                 endif                 endif
3189   1188          continue   1188          continue
3190              enddo               !end loop on couples on plane icp              enddo               !end loop on couples on plane icp
3191              if(distmin.le.clinc)then                    c            if(distmin.le.clinc)then     !QUIQUI              
3192                if(distmin.le.clincnewc)then     !QUIQUI              
3193  *              -----------------------------------  *              -----------------------------------
3194                 xm(nplanes-ip+1) = xmm         !<<<                 xm(nplanes-ip+1) = xmm !<<<
3195                 ym(nplanes-ip+1) = ymm         !<<<                 ym(nplanes-ip+1) = ymm !<<<
3196                 zm(nplanes-ip+1) = zmm         !<<<                 zm(nplanes-ip+1) = zmm !<<<
3197                 xgood(nplanes-ip+1) = 1        !<<<                 xgood(nplanes-ip+1) = 1 !<<<
3198                 ygood(nplanes-ip+1) = 1        !<<<                 ygood(nplanes-ip+1) = 1 !<<<
3199                 resx(nplanes-ip+1)=rxmm        !<<<                 resx(nplanes-ip+1)=rxmm !<<<
3200                 resy(nplanes-ip+1)=rymm        !<<<                 resy(nplanes-ip+1)=rymm !<<<
3201  c              dedxtrk(nplanes-ip+1) = dedxmm !<<<  !(1)                 dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3202                 dedxtrk_x(nplanes-ip+1) = dedxmmx    !(1)                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
                dedxtrk_y(nplanes-ip+1) = dedxmmy    !(1)  
3203  *              -----------------------------------  *              -----------------------------------
3204                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
3205                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG.EQ.1)print*,'%%%% included couple ',idm
3206       $              ,' (norm.dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clinc,' )'
3207                 goto 133         !next plane                 goto 133         !next plane
3208              endif              endif
3209  *     ================================================  *     ================================================
3210  *     STEP 2 >>>>>>>  try to include a single cluster  *     STEP 2 >>>>>>>  try to include a single cluster
3211  *                     either from a couple or single  *                     either from a couple or single
3212  *     ================================================  *     ================================================
3213  c            if(DEBUG)print*,'>>>> try to include a new cluster'  c            if(DEBUG.EQ.1)print*,'>>>> try to include a new cluster'
3214              distmin=1000000.              distmin=1000000.
3215              xmm_A = 0.          !---------------------------              xmm_A = 0.          !---------------------------
3216              ymm_A = 0.          ! init variables that              ymm_A = 0.          ! init variables that
# Line 3456  c            if(DEBUG)print*,'>>>> try t Line 3233  c            if(DEBUG)print*,'>>>> try t
3233                 if(LADDER(icx).ne.nldt)goto 11882 !if the ladder number does not match                 if(LADDER(icx).ne.nldt)goto 11882 !if the ladder number does not match
3234  *                                                !jump to the next couple  *                                                !jump to the next couple
3235  *----- try cluster x -----------------------------------------------  *----- try cluster x -----------------------------------------------
3236                 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
3237                   if(cl_used(icx).ne.0)goto 11881 !if the X cluster is already used  !(3)
3238  *                                              !jump to the Y cluster  *                                              !jump to the Y cluster
3239    c               call xyz_PAM(icx,0,ist,
3240    c     $              PFA,PFA,
3241    c     $              AXV_STORE(nplanes-ip+1,ibest),0.)              
3242                 call xyz_PAM(icx,0,ist,                 call xyz_PAM(icx,0,ist,
 c     $              'ETA2','ETA2',  
3243       $              PFA,PFA,       $              PFA,PFA,
3244       $              AXV_STORE(nplanes-ip+1,ibest),0.)                     $              AXV_STORE(nplanes-ip+1,ibest),0.,
3245         $              bxyz(1),
3246         $              bxyz(2)
3247         $              )              
3248                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3249  c     if(DEBUG)print*,'normalized distance ',distance  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3250                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG.EQ.1)print*,'( cl-X ',icx
3251       $              ,' in cp ',id,' ) normalized distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3252                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3253                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3254                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3477  c     if(DEBUG)print*,'normalized distan Line 3260  c     if(DEBUG)print*,'normalized distan
3260                    rymm = resyPAM                    rymm = resyPAM
3261                    distmin = distance                    distmin = distance
3262                    iclm = icx                    iclm = icx
3263  c                  dedxmm = dedx(icx) !(1)  c                  dedxmm = sgnl(icx) !(1)
3264                    dedxmmx = dedx(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3265                    dedxmmy = 0.        !(1)                    dedxmmy = 0.        !(1)
3266                 endif                                   endif                  
3267  11881          continue  11881          continue
3268  *----- try cluster y -----------------------------------------------  *----- try cluster y -----------------------------------------------
3269                 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
3270                   if(cl_used(icy).ne.0)goto 11882 !if the Y cluster is already used !(3)
3271  *                                              !jump to the next couple  *                                              !jump to the next couple
3272    c               call xyz_PAM(0,icy,ist,
3273    c     $              PFA,PFA,
3274    c     $              0.,AYV_STORE(nplanes-ip+1,ibest))
3275                 call xyz_PAM(0,icy,ist,                 call xyz_PAM(0,icy,ist,
 c     $              'ETA2','ETA2',  
3276       $              PFA,PFA,       $              PFA,PFA,
3277       $              0.,AYV_STORE(nplanes-ip+1,ibest))       $              0.,AYV_STORE(nplanes-ip+1,ibest),
3278         $              bxyz(1),
3279         $              bxyz(2)
3280         $              )
3281                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3282                 if(DEBUG)print*,'( cl-Y ',icy  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3283       $              ,' in cp ',id,' ) normalized distance ',distance                 if(DEBUG.EQ.1)print*,'( cl-Y ',icy
3284         $              ,' in cp ',id,' ) distance ',distance
3285                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3286                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3287                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 3503  c     $              'ETA2','ETA2', Line 3293  c     $              'ETA2','ETA2',
3293                    rymm = resyPAM                    rymm = resyPAM
3294                    distmin = distance                    distmin = distance
3295                    iclm = icy                    iclm = icy
3296  c                 dedxmm = dedx(icy)  !(1)  c                 dedxmm = sgnl(icy)  !(1)
3297                    dedxmmx = 0.        !(1)                    dedxmmx = 0.        !(1)
3298                    dedxmmy = dedx(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3299                 endif                                   endif                  
3300  11882          continue  11882          continue
3301              enddo               !end loop on cluster inside couples              enddo               !end loop on cluster inside couples
3302  *----- single clusters -----------------------------------------------      *----- single clusters -----------------------------------------------  
3303    c            print*,'## ncls(',ip,') ',ncls(ip)
3304              do ic=1,ncls(ip)    !loop on single clusters              do ic=1,ncls(ip)    !loop on single clusters
3305    c               print*,'-',ic,'-'
3306                 icl=cls(ip,ic)                 icl=cls(ip,ic)
3307                 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
3308                   if(cl_used(icl).ne.0.or.     !if the cluster is already used !(3)
3309       $              LADDER(icl).ne.nldt.or. !or the ladder number does not match       $              LADDER(icl).ne.nldt.or. !or the ladder number does not match
3310       $              .false.)goto 18882      !jump to the next singlet       $              .false.)goto 18882      !jump to the next singlet
3311                 if(mod(VIEW(icl),2).eq.0)then!<---- X view                 if(mod(VIEW(icl),2).eq.0)then!<---- X view
3312                    call xyz_PAM(icl,0,ist,                    call xyz_PAM(icl,0,ist,
 c     $                 'ETA2','ETA2',  
3313       $                 PFA,PFA,       $                 PFA,PFA,
3314       $                 AXV_STORE(nplanes-ip+1,ibest),0.)       $                 AXV_STORE(nplanes-ip+1,ibest),0.,
3315         $                 bxyz(1),
3316         $                 bxyz(2)
3317         $                 )
3318                 else                         !<---- Y view                 else                         !<---- Y view
3319                    call xyz_PAM(0,icl,ist,                    call xyz_PAM(0,icl,ist,
 c     $                 'ETA2','ETA2',  
3320       $                 PFA,PFA,       $                 PFA,PFA,
3321       $                 0.,AYV_STORE(nplanes-ip+1,ibest))       $                 0.,AYV_STORE(nplanes-ip+1,ibest),
3322         $                 bxyz(1),
3323         $                 bxyz(2)
3324         $                 )
3325                 endif                 endif
3326    
3327                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3328                 if(DEBUG)print*,'( cl-s ',icl  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3329       $              ,' ) normalized distance ',distance                 if(DEBUG.EQ.1)print*,'( cl-s ',icl
3330         $              ,' ) distance ',distance
3331                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3332    c                  if(DEBUG.EQ.1)print*,'YES'
3333                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3334                    ymm_A = yPAM_A                    ymm_A = yPAM_A
3335                    zmm_A = zPAM_A                    zmm_A = zPAM_A
# Line 3541  c     $                 'ETA2','ETA2', Line 3340  c     $                 'ETA2','ETA2',
3340                    rymm = resyPAM                    rymm = resyPAM
3341                    distmin = distance                      distmin = distance  
3342                    iclm = icl                    iclm = icl
 c                  dedxmm = dedx(icl)                   !(1)  
3343                    if(mod(VIEW(icl),2).eq.0)then !<---- X view                    if(mod(VIEW(icl),2).eq.0)then !<---- X view
3344                       dedxmmx = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3345                       dedxmmy = 0.                       !(1)                       dedxmmy = 0.                  
3346                    else          !<---- Y view                    else          !<---- Y view
3347                       dedxmmx = 0.                       !(1)                       dedxmmx = 0.                  
3348                       dedxmmy = dedx(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3349                    endif                    endif
3350                 endif                                   endif                  
3351  18882          continue  18882          continue
3352              enddo               !end loop on single clusters              enddo               !end loop on single clusters
3353    c            print*,'## distmin ', distmin,' clinc ',clinc
3354    
3355              if(distmin.le.clinc)then                    c     QUIQUI------------
3356                  c     anche qui: non ci vuole clinc???
3357                 CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<                  if(iclm.ne.0)then
 *              ----------------------------  
3358                 if(mod(VIEW(iclm),2).eq.0)then                 if(mod(VIEW(iclm),2).eq.0)then
3359                    XGOOD(nplanes-ip+1)=1.                    clincnew=
3360                    resx(nplanes-ip+1)=rxmm       $                 20*
3361                    if(DEBUG)print*,'%%%% included X-cl ',iclm       $                 sqrt(rxmm**2+RCHI2_STORE(ibest)*k(ip)*cov(1,1))
3362       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'                 else if(mod(VIEW(iclm),2).ne.0)then
3363                 else                    clincnew=
3364                    YGOOD(nplanes-ip+1)=1.       $                 10*
3365                    resy(nplanes-ip+1)=rymm       $                 sqrt(rymm**2+RCHI2_STORE(ibest)*k(ip)*cov(2,2))
3366                    if(DEBUG)print*,'%%%% included Y-cl ',iclm                 endif
3367       $                 ,' ( norm.dist.= ',distmin,', cut ',clinc,' )'  c     QUIQUI------------
3368                  
3369                   if(distmin.le.clincnew)then   !QUIQUI
3370    c     if(distmin.le.clinc)then          !QUIQUI          
3371                      
3372                      CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<    
3373    *     ----------------------------
3374    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3375                      if(mod(VIEW(iclm),2).eq.0)then
3376                         XGOOD(nplanes-ip+1)=1.
3377                         resx(nplanes-ip+1)=rxmm
3378                         if(DEBUG.EQ.1)print*,'%%%% included X-cl ',iclm
3379         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3380         $                    ,', dist.= ',distmin
3381         $                    ,', cut ',clinc,' )'
3382                      else
3383                         YGOOD(nplanes-ip+1)=1.
3384                         resy(nplanes-ip+1)=rymm
3385                         if(DEBUG.EQ.1)print*,'%%%% included Y-cl ',iclm
3386         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3387         $                    ,', dist.= ', distmin
3388         $                    ,', cut ',clinc,' )'
3389                      endif
3390    c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
3391    *     ----------------------------
3392                      xm_A(nplanes-ip+1) = xmm_A
3393                      ym_A(nplanes-ip+1) = ymm_A
3394                      xm_B(nplanes-ip+1) = xmm_B
3395                      ym_B(nplanes-ip+1) = ymm_B
3396                      zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3397                      dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3398                      dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3399    *     ----------------------------
3400                 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)  
 *              ----------------------------  
3401              endif              endif
3402           endif           endif
3403   133     continue   133     continue
# Line 3596  c              dedxtrk(nplanes-ip+1) = d Line 3416  c              dedxtrk(nplanes-ip+1) = d
3416  *                                                 *  *                                                 *
3417  *                                                 *  *                                                 *
3418  **************************************************  **************************************************
3419    *
3420        subroutine clean_XYclouds(ibest,iflag)        subroutine clean_XYclouds(ibest,iflag)
3421    
3422        include 'commontracker.f'        include 'commontracker.f'
3423          include 'level1.f'
3424        include 'common_momanhough.f'        include 'common_momanhough.f'
3425        include 'momanhough_init.f'        include 'level2.f'      
 c      include 'calib.f'  
 c      include 'level1.f'  
   
       logical DEBUG  
       common/dbg/DEBUG  
3426    
3427          if(DEBUG.EQ.1)print*,'clean_XYclouds:'
3428    
3429        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3430    
# Line 3617  c      include 'level1.f' Line 3434  c      include 'level1.f'
3434              if(id.ne.0)then              if(id.ne.0)then
3435                 iclx=clx(ip,icp_cp(id))                 iclx=clx(ip,icp_cp(id))
3436                 icly=cly(ip,icp_cp(id))                 icly=cly(ip,icp_cp(id))
3437                 cl_used(iclx)=1  !tag used clusters  c$$$               cl_used(iclx)=ntrk  !tag used clusters
3438                 cl_used(icly)=1  !tag used clusters  c$$$               cl_used(icly)=ntrk  !tag used clusters
3439              elseif(icl.ne.0)then              elseif(icl.ne.0)then
3440                 cl_used(icl)=1   !tag used clusters  c$$$               cl_used(icl)=ntrk   !tag used clusters
3441              endif              endif
3442                            
 c               if(DEBUG)then  
 c                  print*,ip,' <<< ',id  
 c               endif  
3443  *     -----------------------------  *     -----------------------------
3444  *     remove the couple from clouds  *     remove the couple from clouds
3445  *     remove also vitual couples containing the  *     remove also vitual couples containing the
# Line 3642  c               endif Line 3456  c               endif
3456       $              cly(ip,icp).eq.icl       $              cly(ip,icp).eq.icl
3457       $              )then       $              )then
3458                    id=id_cp(ip,icp,1)                    id=id_cp(ip,icp,1)
3459                    if(DEBUG)then                    if(DEBUG.EQ.1)then
3460                       print*,ip,' <<< cp ',id                       print*,ip,' <<< cp ',id
3461       $                    ,' ( cl-x '       $                    ,' ( cl-x '
3462       $                    ,clx(ip,icp)       $                    ,clx(ip,icp)
# Line 3676  c               endif Line 3490  c               endif
3490    
3491    
3492    
 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$$$  
   
3493    
3494    
3495  *     ****************************************************  *     ****************************************************
3496    
3497        subroutine init_level2        subroutine init_level2
3498    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c*****************************************************  
   
3499        include 'commontracker.f'        include 'commontracker.f'
3500          include 'level1.f'
3501        include 'common_momanhough.f'        include 'common_momanhough.f'
3502        include 'level2.f'        include 'level2.f'
       include 'level1.f'  
   
   
   
       good2 = 0!.false.  
 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*****************************************************  
3503    
3504    *     ---------------------------------
3505    *     variables initialized from level1
3506    *     ---------------------------------
3507          do i=1,nviews
3508             good2(i)=good1(i)
3509             do j=1,nva1_view
3510                vkflag(i,j)=1
3511                if(cnnev(i,j).le.0)then
3512                   vkflag(i,j)=cnnev(i,j)
3513                endif
3514             enddo
3515          enddo
3516    *     ----------------
3517    *     level2 variables
3518    *     ----------------
3519        NTRK = 0        NTRK = 0
3520        do it=1,NTRKMAX!NTRACKSMAX        do it=1,NTRKMAX
3521           IMAGE(IT)=0           IMAGE(IT)=0
3522           CHI2_nt(IT) = -100000.           CHI2_nt(IT) = -100000.
          BdL(IT) = 0.  
3523           do ip=1,nplanes           do ip=1,nplanes
3524              XM_nt(IP,IT) = 0              XM_nt(IP,IT) = 0
3525              YM_nt(IP,IT) = 0              YM_nt(IP,IT) = 0
3526              ZM_nt(IP,IT) = 0              ZM_nt(IP,IT) = 0
3527              RESX_nt(IP,IT) = 0              RESX_nt(IP,IT) = 0
3528              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3529                TAILX_nt(IP,IT) = 0
3530                TAILY_nt(IP,IT) = 0
3531                XBAD(IP,IT) = 0
3532                YBAD(IP,IT) = 0
3533              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3534              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
3535  c*****************************************************              LS(IP,IT) = 0
 cccccc 11/9/2005 modified by david fedele  
3536              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3537              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
3538  c******************************************************              CLTRX(IP,IT) = 0
3539                CLTRY(IP,IT) = 0
3540                multmaxx(ip,it) = 0
3541                seedx(ip,it)    = 0
3542                xpu(ip,it)      = 0
3543                multmaxy(ip,it) = 0
3544                seedy(ip,it)    = 0
3545                ypu(ip,it)      = 0
3546           enddo           enddo
3547           do ipa=1,5           do ipa=1,5
3548              AL_nt(IPA,IT) = 0              AL_nt(IPA,IT) = 0
# Line 3839  c*************************************** Line 3551  c***************************************
3551              enddo                                enddo                  
3552           enddo                             enddo                  
3553        enddo        enddo
         
         
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3554        nclsx=0        nclsx=0
3555        nclsy=0              nclsy=0      
3556        do ip=1,NSINGMAX        do ip=1,NSINGMAX
3557          planex(ip)=0          planex(ip)=0
 c        xs(ip)=0  
3558          xs(1,ip)=0          xs(1,ip)=0
3559          xs(2,ip)=0          xs(2,ip)=0
3560          sgnlxs(ip)=0          sgnlxs(ip)=0
3561          planey(ip)=0          planey(ip)=0
 c        ys(ip)=0  
3562          ys(1,ip)=0          ys(1,ip)=0
3563          ys(2,ip)=0          ys(2,ip)=0
3564          sgnlys(ip)=0          sgnlys(ip)=0
3565            sxbad(ip)=0
3566            sybad(ip)=0
3567            multmaxsx(ip)=0
3568            multmaxsy(ip)=0
3569        enddo        enddo
 c*******************************************************  
3570        end        end
3571    
3572    
# Line 3872  c*************************************** Line 3581  c***************************************
3581  ************************************************************  ************************************************************
3582    
3583    
3584          subroutine init_hough
3585    
3586          include 'commontracker.f'
3587          include 'level1.f'
3588          include 'common_momanhough.f'
3589          include 'common_hough.f'
3590          include 'level2.f'
3591    
3592          ntrpt_nt=0
3593          ndblt_nt=0
3594          NCLOUDS_XZ_nt=0
3595          NCLOUDS_YZ_nt=0
3596          do idb=1,ndblt_max_nt
3597             db_cloud_nt(idb)=0
3598             alfayz1_nt(idb)=0      
3599             alfayz2_nt(idb)=0      
3600          enddo
3601          do itr=1,ntrpt_max_nt
3602             tr_cloud_nt(itr)=0
3603             alfaxz1_nt(itr)=0      
3604             alfaxz2_nt(itr)=0      
3605             alfaxz3_nt(itr)=0      
3606          enddo
3607          do idb=1,ncloyz_max      
3608            ptcloud_yz_nt(idb)=0    
3609            alfayz1_av_nt(idb)=0    
3610            alfayz2_av_nt(idb)=0    
3611          enddo                    
3612          do itr=1,ncloxz_max      
3613            ptcloud_xz_nt(itr)=0    
3614            alfaxz1_av_nt(itr)=0    
3615            alfaxz2_av_nt(itr)=0    
3616            alfaxz3_av_nt(itr)=0    
3617          enddo                    
3618    
3619          ntrpt=0                  
3620          ndblt=0                  
3621          NCLOUDS_XZ=0              
3622          NCLOUDS_YZ=0              
3623          do idb=1,ndblt_max        
3624            db_cloud(idb)=0        
3625            cpyz1(idb)=0            
3626            cpyz2(idb)=0            
3627            alfayz1(idb)=0          
3628            alfayz2(idb)=0          
3629          enddo                    
3630          do itr=1,ntrpt_max        
3631            tr_cloud(itr)=0        
3632            cpxz1(itr)=0            
3633            cpxz2(itr)=0            
3634            cpxz3(itr)=0            
3635            alfaxz1(itr)=0          
3636            alfaxz2(itr)=0          
3637            alfaxz3(itr)=0          
3638          enddo                    
3639          do idb=1,ncloyz_max      
3640            ptcloud_yz(idb)=0      
3641            alfayz1_av(idb)=0      
3642            alfayz2_av(idb)=0      
3643            do idbb=1,ncouplemaxtot
3644              cpcloud_yz(idb,idbb)=0
3645            enddo                  
3646          enddo                    
3647          do itr=1,ncloxz_max      
3648            ptcloud_xz(itr)=0      
3649            alfaxz1_av(itr)=0      
3650            alfaxz2_av(itr)=0      
3651            alfaxz3_av(itr)=0      
3652            do itrr=1,ncouplemaxtot
3653              cpcloud_xz(itr,itrr)=0
3654            enddo                  
3655          enddo                    
3656          end
3657    ************************************************************
3658    *
3659    *
3660    *
3661    *
3662    *
3663    *
3664    *
3665    ************************************************************
3666    
3667    
3668        subroutine fill_level2_tracks(ntr)        subroutine fill_level2_tracks(ntr)
3669    
3670  *     -------------------------------------------------------  *     -------------------------------------------------------
# Line 3882  c*************************************** Line 3675  c***************************************
3675    
3676            
3677        include 'commontracker.f'        include 'commontracker.f'
3678          include 'level1.f'
3679          include 'common_momanhough.f'
3680        include 'level2.f'        include 'level2.f'
3681        include 'common_mini_2.f'        include 'common_mini_2.f'
3682        real sinth,phi,pig        !(4)        include 'calib.f'
3683    
3684          character*10 PFA
3685          common/FINALPFA/PFA
3686    
3687          real sinth,phi,pig
3688          integer ssensor,sladder
3689        pig=acos(-1.)        pig=acos(-1.)
3690    
3691        good2=1!.true.  *     -------------------------------------
3692        chi2_nt(ntr)        = sngl(chi2)        chi2_nt(ntr)        = sngl(chi2)
3693          nstep_nt(ntr)       = nstep
3694        phi   = al(4)             !(4)  *     -------------------------------------
3695        sinth = al(3)             !(4)        phi   = al(4)          
3696        if(sinth.lt.0)then        !(4)        sinth = al(3)            
3697           sinth = -sinth         !(4)        if(sinth.lt.0)then      
3698           phi = phi + pig        !(4)           sinth = -sinth        
3699        endif                     !(4)           phi = phi + pig      
3700        npig = aint(phi/(2*pig))  !(4)        endif                    
3701        phi = phi - npig*2*pig    !(4)        npig = aint(phi/(2*pig))
3702        if(phi.lt.0)              !(4)        phi = phi - npig*2*pig  
3703       $     phi = phi + 2*pig    !(4)        if(phi.lt.0)            
3704        al(4) = phi               !(4)       $     phi = phi + 2*pig  
3705        al(3) = sinth             !(4)        al(4) = phi              
3706  *****************************************************        al(3) = sinth            
3707        do i=1,5        do i=1,5
3708           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3709           do j=1,5           do j=1,5
3710              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3711           enddo           enddo
 c     print*,al_nt(i,ntr)  
3712        enddo        enddo
3713          *     -------------------------------------      
3714        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
3715           xgood_nt(ip,ntr) = int(xgood(ip))           xgood_nt(ip,ntr) = int(xgood(ip))
3716           ygood_nt(ip,ntr) = int(ygood(ip))           ygood_nt(ip,ntr) = int(ygood(ip))
# Line 3919  c     print*,al_nt(i,ntr) Line 3719  c     print*,al_nt(i,ntr)
3719           zm_nt(ip,ntr)    = sngl(zm(ip))           zm_nt(ip,ntr)    = sngl(zm(ip))
3720           RESX_nt(IP,ntr)  = sngl(resx(ip))           RESX_nt(IP,ntr)  = sngl(resx(ip))
3721           RESY_nt(IP,ntr)  = sngl(resy(ip))           RESY_nt(IP,ntr)  = sngl(resy(ip))
3722             TAILX_nt(IP,ntr) = 0.
3723             TAILY_nt(IP,ntr) = 0.
3724           xv_nt(ip,ntr)    = sngl(xv(ip))           xv_nt(ip,ntr)    = sngl(xv(ip))
3725           yv_nt(ip,ntr)    = sngl(yv(ip))           yv_nt(ip,ntr)    = sngl(yv(ip))
3726           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3727           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3728           ayv_nt(ip,ntr)   = sngl(ayv(ip))           ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3729  c        dedxp(ip,ntr)    = sngl(dedxtrk(ip))   !(1)  
3730           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)           factor = sqrt(
3731           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)                 $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3732        enddo       $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3733  c      call CalcBdL(100,xxxx,IFAIL)       $        1. )
3734  c      if(ifps(xxxx).eq.1)BdL(ntr) = xxxx  
3735  c$$$      print*,'xgood(ip,ntr) ',(xgood_nt(ip,ntr),ip=1,6)           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3736  c$$$      print*,'ygood(ip,ntr) ',(ygood_nt(ip,ntr),ip=1,6)           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3737  c$$$      print*,'dedx_x(ip,ntr) ',(dedx_x(ip,ntr),ip=1,6)    
3738  c$$$      print*,'dedx_y(ip,ntr) ',(dedx_y(ip,ntr),ip=1,6)           ax   = axv_nt(ip,ntr)
3739             ay   = ayv_nt(ip,ntr)
3740             bfx  = BX_STORE(ip,IDCAND)
3741             bfy  = BY_STORE(ip,IDCAND)
3742    c$$$         if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3743    c$$$         if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3744    c$$$         tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3745    c$$$         angx     = 180.*atan(tgtemp)/acos(-1.)
3746    c$$$         tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3747    c$$$         angy    = 180.*atan(tgtemp)/acos(-1.)
3748    
3749             angx = effectiveangle(ax,2*ip,bfy)
3750             angy = effectiveangle(ay,2*ip-1,bfx)
3751            
3752            
3753    c         print*,'* ',ip,bfx,bfy,angx,angy
3754    
3755             id  = CP_STORE(ip,IDCAND) ! couple id
3756             icl = CLS_STORE(ip,IDCAND)
3757             ssensor = -1
3758             sladder = -1
3759             ssensor = SENSOR_STORE(ip,IDCAND)
3760             sladder = LADDER_STORE(ip,IDCAND)
3761             if(ip.eq.6.and.ssensor.ne.0)ssensor = 3 - ssensor !notazione paolo x align
3762             LS(IP,ntr)      = ssensor+10*sladder
3763    
3764             if(id.ne.0)then
3765    c           >>> is a couple
3766                cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3767                cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3768    
3769                cl_used(cltrx(ip,ntr)) = 1     !tag used clusters          
3770                cl_used(cltry(ip,ntr)) = 1     !tag used clusters          
3771    
3772                xbad(ip,ntr)= nbadstrips(4,clx(nplanes-ip+1,icp_cp(id)))
3773                ybad(ip,ntr)= nbadstrips(4,cly(nplanes-ip+1,icp_cp(id)))
3774    
3775    
3776                if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3777         $           dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3778                if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3779         $           dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3780    
3781                multmaxx(ip,ntr) = maxs(cltrx(ip,ntr))
3782         $                         +10000*mult(cltrx(ip,ntr))
3783                seedx(ip,ntr)    = clsignal(indmax(cltrx(ip,ntr)))
3784         $           /clsigma(indmax(cltrx(ip,ntr)))
3785                call applypfa(PFA,cltrx(ip,ntr),angx,corr,res)
3786                xpu(ip,ntr)      = corr
3787    
3788                multmaxy(ip,ntr) = maxs(cltry(ip,ntr))
3789         $                         +10000*mult(cltry(ip,ntr))
3790                seedy(ip,ntr)    = clsignal(indmax(cltry(ip,ntr)))
3791         $           /clsigma(indmax(cltry(ip,ntr)))
3792                call applypfa(PFA,cltry(ip,ntr),angy,corr,res)
3793                ypu(ip,ntr)      = corr
3794    
3795             elseif(icl.ne.0)then
3796    
3797    
3798                cl_used(icl) = 1    !tag used clusters          
3799    
3800                if(mod(VIEW(icl),2).eq.0)then
3801                   cltrx(ip,ntr)=icl
3802                   xbad(ip,ntr) = nbadstrips(4,icl)
3803    
3804                   if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3805    
3806                   multmaxx(ip,ntr) = maxs(cltrx(ip,ntr))
3807         $                         +10000*mult(cltrx(ip,ntr))
3808                   seedx(ip,ntr)    = clsignal(indmax(cltrx(ip,ntr)))
3809         $           /clsigma(indmax(cltrx(ip,ntr)))
3810                   call applypfa(PFA,cltrx(ip,ntr),angx,corr,res)
3811                   xpu(ip,ntr)      = corr
3812    
3813                elseif(mod(VIEW(icl),2).eq.1)then
3814                   cltry(ip,ntr)=icl
3815                   ybad(ip,ntr) = nbadstrips(4,icl)
3816    
3817                   if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3818    
3819                   multmaxy(ip,ntr) = maxs(cltry(ip,ntr))
3820         $                         +10000*mult(cltry(ip,ntr))
3821                   seedy(ip,ntr)    = clsignal(indmax(cltry(ip,ntr)))
3822         $           /clsigma(indmax(cltry(ip,ntr)))
3823                   call applypfa(PFA,cltry(ip,ntr),angy,corr,res)
3824                   ypu(ip,ntr)      = corr
3825                  
3826                endif
3827    
3828             endif          
3829    
3830          enddo
3831    
3832          if(DEBUG.eq.1)then
3833             print*,'> STORING TRACK ',ntr
3834             print*,'clusters: '
3835             do ip=1,6
3836                print*,'> ',ip,' -- ',cltrx(ip,ntr),cltry(ip,ntr)
3837             enddo
3838          endif
3839    
3840    c$$$      print*,(xgood(i),i=1,6)
3841    c$$$      print*,(ygood(i),i=1,6)
3842    c$$$      print*,(ls(i,ntr),i=1,6)
3843    c$$$      print*,(dedx_x(i,ntr),i=1,6)
3844    c$$$      print*,(dedx_y(i,ntr),i=1,6)
3845    c$$$      print*,'-----------------------'
3846    
3847        end        end
3848    
3849        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*****************************************************  
3850    
3851  *     -------------------------------------------------------  *     -------------------------------------------------------
3852  *     This routine fills the  elements of the variables  *     This routine fills the  elements of the variables
# Line 3952  c*************************************** Line 3855  c***************************************
3855  *     -------------------------------------------------------  *     -------------------------------------------------------
3856    
3857        include 'commontracker.f'        include 'commontracker.f'
       include 'level1.f'  
       include 'level2.f'  
3858        include 'calib.f'        include 'calib.f'
3859          include 'level1.f'
3860        include 'common_momanhough.f'        include 'common_momanhough.f'
3861          include 'level2.f'
3862        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3863    
3864  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
       good2=1!.true.  
3865        nclsx = 0        nclsx = 0
3866        nclsy = 0        nclsy = 0
3867    
3868          do iv = 1,nviews
3869    c         if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
3870             good2(iv) = good2(iv) + mask_view(iv)*2**8
3871          enddo
3872    
3873          if(DEBUG.eq.1)then
3874             print*,'> STORING SINGLETS '
3875          endif
3876    
3877        do icl=1,nclstr1        do icl=1,nclstr1
3878    
3879             ip=nplanes-npl(VIEW(icl))+1            
3880            
3881           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
3882              ip=nplanes-npl(VIEW(icl))+1              
3883              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
3884    
3885                 nclsx = nclsx + 1                 nclsx = nclsx + 1
3886                 planex(nclsx) = ip                 planex(nclsx) = ip
3887                 sgnlxs(nclsx) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3888                   if(nsatstrips(icl).gt.0)sgnlxs(nclsx)=-sgnlxs(nclsx)
3889                   clsx(nclsx)   = icl
3890                   sxbad(nclsx)  = nbadstrips(1,icl)
3891                   multmaxsx(nclsx) = maxs(icl)+10000*mult(icl)
3892                  
3893    cc               print*,icl,' >>>> ',sxbad(nclsx)
3894    
3895                 do is=1,2                 do is=1,2
3896  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
3897                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
3898                      call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
3899                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2
3900                 enddo                 enddo
3901  c$$$               print*,'nclsx         ',nclsx  c$$$               print*,'nclsx         ',nclsx
# Line 3983  c$$$               print*,'xs(2,nclsx)   Line 3906  c$$$               print*,'xs(2,nclsx)  
3906              else                          !=== Y views              else                          !=== Y views
3907                 nclsy = nclsy + 1                 nclsy = nclsy + 1
3908                 planey(nclsy) = ip                 planey(nclsy) = ip
3909                 sgnlys(nclsy) = dedx(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3910                   if(nsatstrips(icl).gt.0)sgnlys(nclsy)=-sgnlys(nclsy)
3911                   clsy(nclsy)   = icl
3912                   sybad(nclsy)  = nbadstrips(1,icl)
3913                   multmaxsy(nclsy) = maxs(icl)+10000*mult(icl)
3914    
3915    cc               print*,icl,' >>>> ',sybad(nclsy)
3916    
3917                 do is=1,2                 do is=1,2
3918  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
3919                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
3920                      call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
3921                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2
3922                 enddo                 enddo
3923  c$$$               print*,'nclsy         ',nclsy  c$$$               print*,'nclsy         ',nclsy
# Line 3996  c$$$               print*,'ys(1,nclsy)   Line 3927  c$$$               print*,'ys(1,nclsy)  
3927  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)  c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)
3928              endif              endif
3929           endif           endif
3930  c      print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)  
3931    ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
3932             whichtrack(icl) = cl_used(icl)
3933    *     --------------------------------------------------
3934    *     per non perdere la testa...
3935    *     whichtrack(icl) e` una variabile del common level1
3936    *     che serve solo per sapere quali cluster sono stati
3937    *     associati ad una traccia, e permettere di salvare
3938    *     solo questi nell'albero di uscita
3939    *     --------------------------------------------------
3940                    
3941        enddo        enddo
3942        end        end
3943    
3944    ***************************************************
3945    *                                                 *
3946    *                                                 *
3947    *                                                 *
3948    *                                                 *
3949    *                                                 *
3950    *                                                 *
3951    **************************************************
3952    
3953          subroutine fill_hough
3954    
3955    *     -------------------------------------------------------
3956    *     This routine fills the  variables related to the hough
3957    *     transform, for the debig n-tuple
3958    *     -------------------------------------------------------
3959    
3960          include 'commontracker.f'
3961          include 'level1.f'
3962          include 'common_momanhough.f'
3963          include 'common_hough.f'
3964          include 'level2.f'
3965    
3966          if(.false.
3967         $     .or.ntrpt.gt.ntrpt_max_nt
3968         $     .or.ndblt.gt.ndblt_max_nt
3969         $     .or.NCLOUDS_XZ.gt.ncloxz_max
3970         $     .or.NCLOUDS_yZ.gt.ncloyz_max
3971         $     )then
3972             ntrpt_nt=0
3973             ndblt_nt=0
3974             NCLOUDS_XZ_nt=0
3975             NCLOUDS_YZ_nt=0
3976          else
3977             ndblt_nt=ndblt
3978             ntrpt_nt=ntrpt
3979             if(ndblt.ne.0)then
3980                do id=1,ndblt
3981                   alfayz1_nt(id)=alfayz1(id) !Y0
3982                   alfayz2_nt(id)=alfayz2(id) !tg theta-yz
3983                enddo
3984             endif
3985             if(ndblt.ne.0)then
3986                do it=1,ntrpt
3987                   alfaxz1_nt(it)=alfaxz1(it) !X0
3988                   alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
3989                   alfaxz3_nt(it)=alfaxz3(it) !1/r
3990                enddo
3991             endif
3992             nclouds_yz_nt=nclouds_yz
3993             nclouds_xz_nt=nclouds_xz
3994             if(nclouds_yz.ne.0)then
3995                nnn=0
3996                do iyz=1,nclouds_yz
3997                   ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
3998                   alfayz1_av_nt(iyz)=alfayz1_av(iyz)
3999                   alfayz2_av_nt(iyz)=alfayz2_av(iyz)
4000                   nnn=nnn+ptcloud_yz(iyz)
4001                enddo
4002                do ipt=1,nnn
4003                   db_cloud_nt(ipt)=db_cloud(ipt)
4004                 enddo
4005             endif
4006             if(nclouds_xz.ne.0)then
4007                nnn=0
4008                do ixz=1,nclouds_xz
4009                   ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
4010                   alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
4011                   alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
4012                   alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
4013                   nnn=nnn+ptcloud_xz(ixz)              
4014                enddo
4015                do ipt=1,nnn
4016                  tr_cloud_nt(ipt)=tr_cloud(ipt)
4017                 enddo
4018             endif
4019          endif
4020          end
4021          

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.34

  ViewVC Help
Powered by ViewVC 1.1.23