/[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.18 by pam-fi, Fri Feb 16 14:56:02 2007 UTC revision 1.41 by mocchiut, Tue Aug 11 12:58:24 2009 UTC
# Line 20  Line 20 
20        include 'calib.f'        include 'calib.f'
21        include 'level2.f'        include 'level2.f'
22    
23  c      include 'momanhough_init.f'  c      print*,'======================================================'
24    c$$$      do ic=1,NCLSTR1
25    c$$$         if(.false.
26    c$$$     $        .or.nsatstrips(ic).gt.0
27    c$$$c     $        .or.nbadstrips(0,ic).gt.0
28    c$$$c     $        .or.nbadstrips(4,ic).gt.0
29    c$$$c     $        .or.nbadstrips(3,ic).gt.0
30    c$$$     $        .or..false.)then
31    c$$$            print*,'--- cl-',ic,' ------------------------'
32    c$$$            istart = INDSTART(IC)
33    c$$$            istop  = TOTCLLENGTH
34    c$$$            if(ic.lt.NCLSTR1)istop=INDSTART(IC+1)-1
35    c$$$            print*,'ADC   ',(CLADC(i),i=istart,istop)
36    c$$$            print*,'s/n   ',(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
37    c$$$            print*,'sgnl  ',(CLSIGNAL(i),i=istart,istop)
38    c$$$            print*,'strip ',(i-INDMAX(ic),i=istart,istop)
39    c$$$            print*,'view ',VIEW(ic)
40    c$$$            print*,'maxs ',MAXS(ic)
41    c$$$            print*,'COG4 ',cog(4,ic)
42    c$$$            ff = fbad_cog(4,ic)
43    c$$$            print*,'fbad ',ff
44    c$$$            print*,(CLBAD(i),i=istart,istop)
45    c$$$            bb=nbadstrips(0,ic)
46    c$$$            print*,'#BAD (tot)',bb
47    c$$$            bb=nbadstrips(4,ic)
48    c$$$            print*,'#BAD (4)',bb
49    c$$$            bb=nbadstrips(3,ic)
50    c$$$            print*,'#BAD (3)',bb
51    c$$$            ss=nsatstrips(ic)
52    c$$$            print*,'#saturated ',ss
53    c$$$         endif
54    c$$$      enddo
55                
56  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
57  *     STEP 1  *     STEP 1
# Line 41  c      include 'momanhough_init.f' Line 72  c      include 'momanhough_init.f'
72  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
73  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
74    
 c      iflag=0  
75        call cl_to_couples(iflag)        call cl_to_couples(iflag)
76        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
77           goto 880               !go to next event           goto 880               !go to next event
78        endif        endif
79                if(ncp_tot.eq.0)goto 880  !go to next event    
80  *-----------------------------------------------------  *-----------------------------------------------------
81  *-----------------------------------------------------  *-----------------------------------------------------
82  *     HOUGH TRASFORM  *     HOUGH TRASFORM
# Line 75  c      iflag=0 Line 105  c      iflag=0
105  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
106  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
107    
108  c      iflag=0  
109        call cp_to_doubtrip(iflag)        call cp_to_doubtrip(iflag)
110        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
111           goto 880               !go to next event                       goto 880               !go to next event            
112        endif        endif
113          if(ndblt.eq.0.or.ntrpt.eq.0)goto 880 !go to next event    
114                
115                
116  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
# Line 130  c      iflag=0 Line 161  c      iflag=0
161        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
162           goto 880               !fill ntp and go to next event                       goto 880               !fill ntp and go to next event            
163        endif        endif
164    *     ------------------------------------------------
165    *     first try to release the tolerance
166    *     ------------------------------------------------
167        if(nclouds_yz.eq.0.and.cutdistyz.lt.maxcuty)then        if(nclouds_yz.eq.0.and.cutdistyz.lt.maxcuty)then
168          if(cutdistyz.lt.maxcuty/2)then           if(cutdistyz.lt.maxcuty/2)then
169            cutdistyz=cutdistyz+cutystep              cutdistyz=cutdistyz+cutystep
170          else           else
171            cutdistyz=cutdistyz+(3*cutystep)              cutdistyz=cutdistyz+(3*cutystep)
172          endif           endif
173          goto 878                           if(DEBUG.EQ.1)print*,'try again - cutdistyz ',cutdistyz
174        endif                               goto 878                
175          endif    
176    *     ------------------------------------------------
177    *     hence reduce the minimum number of plane
178    *     ------------------------------------------------
179          if(nclouds_yz.eq.0.and.nplyz_min.gt.3)then
180             nplyz_min=nplyz_min-1
181             if(DEBUG.EQ.1)print*,'try again - nplyz_min ',nplyz_min
182             goto 878
183          endif
184    
185        if(planehit.eq.3) goto 881                  if(nclouds_yz.eq.0)goto 880 !go to next event    
186    
187    
188    ccc   if(planehit.eq.3) goto 881    
189                
190   879  continue     879  continue  
191        call trip_to_XZcloud(iflag)        call trip_to_XZcloud(iflag)
192        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
193           goto 880               !fill ntp and go to next event                       goto 880               !fill ntp and go to next event            
194        endif        endif
195                              *     ------------------------------------------------
196    *     first try to release the tolerance
197    *     ------------------------------------------------                          
198        if(nclouds_xz.eq.0.and.cutdistxz.lt.maxcutx)then        if(nclouds_xz.eq.0.and.cutdistxz.lt.maxcutx)then
199          cutdistxz=cutdistxz+cutxstep          cutdistxz=cutdistxz+cutxstep
200             if(DEBUG.EQ.1)print*,'try again - cutdistxz ',cutdistxz
201          goto 879                          goto 879                
202        endif                            endif                    
203    *     ------------------------------------------------
204    *     hence reduce the minimum number of plane
205    *     ------------------------------------------------
206          if(nclouds_xz.eq.0.and.nplxz_min.gt.3)then
207             nplxz_min=nplxz_min-1
208             if(DEBUG.EQ.1)print*,'try again - nplxz_min ',nplxz_min
209             goto 879
210          endif
211    
212          if(nclouds_xz.eq.0)goto 880 !go to next event    
213    
214            
215   881  continue    c$$$ 881  continue  
216  *     if there is at least three planes on the Y view decreases cuts on X view  c$$$*     if there is at least three planes on the Y view decreases cuts on X view
217        if(nclouds_xz.eq.0.and.nclouds_yz.gt.0.and.  c$$$      if(nclouds_xz.eq.0.and.nclouds_yz.gt.0.and.
218       $     nplxz_min.ne.y_min_start)then  c$$$     $     nplxz_min.ne.y_min_start)then
219          nptxz_min=x_min_step      c$$$        nptxz_min=x_min_step    
220          nplxz_min=x_min_start-x_min_step                c$$$        nplxz_min=x_min_start-x_min_step              
221          goto 879                  c$$$        goto 879                
222        endif                      c$$$      endif                    
223                    
224   880  return   880  return
225        end        end
# Line 182  c      iflag=0 Line 241  c      iflag=0
241  c      include 'momanhough_init.f'  c      include 'momanhough_init.f'
242                
243        logical FIMAGE            !        logical FIMAGE            !
244          real trackimage(NTRACKSMAX)
245        real*8 AL_GUESS(5)        real*8 AL_GUESS(5)
246    
247  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
# Line 209  c      include 'momanhough_init.f' Line 269  c      include 'momanhough_init.f'
269  *  *
270  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
271  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
272           ntrk=0                 !counter of identified physical tracks  ccc         ntrk=0                 !counter of identified physical tracks
273    
274  11111    continue               !<<<<<<< come here when performing a new search  c11111    continue               !<<<<<<< come here when performing a new search
275             continue                  !<<<<<<< come here when performing a new search
276    
277             if(nclouds_xz.eq.0)goto 880 !go to next event    
278             if(nclouds_yz.eq.0)goto 880 !go to next event    
279    
280  c         iflag=0  c         iflag=0
281           call clouds_to_ctrack(iflag)           call clouds_to_ctrack(iflag)
282           if(iflag.eq.1)then     !no candidate tracks found           if(iflag.eq.1)then     !no candidate tracks found
283              goto 880            !fill ntp and go to next event                goto 880            !fill ntp and go to next event  
284           endif           endif
285             if(ntracks.eq.0)goto 880 !go to next event    
286    
287           FIMAGE=.false.         !processing best track (not track image)           FIMAGE=.false.         !processing best track (not track image)
288           ibest=0                !best track among candidates           ibest=0                !best track among candidates
# Line 238  c$$$         if(ibest.eq.0)goto 880 !>> Line 303  c$$$         if(ibest.eq.0)goto 880 !>>
303  *     1st) decreasing n.points  *     1st) decreasing n.points
304  *     2nd) increasing chi**2  *     2nd) increasing chi**2
305  *     -------------------------------------------------------  *     -------------------------------------------------------
306           rchi2best=1000000000.           rchi2best=1000000000.
307           ndofbest=0             !(1)           ndofbest=0            
308           do i=1,ntracks           do i=1,ntracks
309             ndof=0               !(1)             ndof=0              
310             do ii=1,nplanes      !(1)             do ii=1,nplanes    
311               ndof=ndof          !(1)               ndof=ndof        
312       $            +int(xgood_store(ii,i)) !(1)       $            +int(xgood_store(ii,i))
313       $            +int(ygood_store(ii,i)) !(1)       $            +int(ygood_store(ii,i))
314             enddo                !(1)             enddo              
315             if(ndof.gt.ndofbest)then !(1)             if(ndof.gt.ndofbest)then
316               ibest=i               ibest=i
317               rchi2best=RCHI2_STORE(i)               rchi2best=RCHI2_STORE(i)
318               ndofbest=ndof      !(1)               ndofbest=ndof    
319             elseif(ndof.eq.ndofbest)then !(1)             elseif(ndof.eq.ndofbest)then
320               if(RCHI2_STORE(i).lt.rchi2best.and.               if(RCHI2_STORE(i).lt.rchi2best.and.
321       $            RCHI2_STORE(i).gt.0)then       $            RCHI2_STORE(i).gt.0)then
322                 ibest=i                 ibest=i
323                 rchi2best=RCHI2_STORE(i)                 rchi2best=RCHI2_STORE(i)
324                 ndofbest=ndof    !(1)                 ndofbest=ndof  
325               endif              !(1)               endif            
326             endif             endif
327           enddo           enddo
328    
 c$$$         rchi2best=1000000000.  
 c$$$         ndofbest=0             !(1)  
 c$$$         do i=1,ntracks  
 c$$$           if(RCHI2_STORE(i).lt.rchi2best.and.  
 c$$$     $          RCHI2_STORE(i).gt.0)then  
 c$$$             ndof=0             !(1)  
 c$$$             do ii=1,nplanes    !(1)  
 c$$$               ndof=ndof        !(1)  
 c$$$     $              +int(xgood_store(ii,i)) !(1)  
 c$$$     $              +int(ygood_store(ii,i)) !(1)  
 c$$$             enddo              !(1)  
 c$$$             if(ndof.ge.ndofbest)then !(1)  
 c$$$               ibest=i  
 c$$$               rchi2best=RCHI2_STORE(i)  
 c$$$               ndofbest=ndof    !(1)  
 c$$$             endif              !(1)  
 c$$$           endif  
 c$$$         enddo  
329    
330           if(ibest.eq.0)goto 880 !>> no good candidates           if(ibest.eq.0)goto 880 !>> no good candidates
331  *-------------------------------------------------------------------------------      *-------------------------------------------------------------------------------    
# Line 298  c$$$         enddo Line 345  c$$$         enddo
345              iimage=0              iimage=0
346           endif           endif
347           if(icand.eq.0)then           if(icand.eq.0)then
348              print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand              if(VERBOSE.EQ.1)then
349       $           ,ibest,iimage                 print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand
350         $              ,ibest,iimage
351                endif
352              return              return
353           endif           endif
354    
# Line 314  c$$$         enddo Line 363  c$$$         enddo
363           do i=1,5           do i=1,5
364              AL_GUESS(i)=AL(i)              AL_GUESS(i)=AL(i)
365           enddo           enddo
 c         print*,'## guess: ',al  
366    
367           do i=1,5           do i=1,5
368              AL(i)=dble(AL_STORE(i,icand))                          AL(i)=dble(AL_STORE(i,icand))            
# Line 325  c         print*,'## guess: ',al Line 373  c         print*,'## guess: ',al
373           jstep=0                !# minimization steps           jstep=0                !# minimization steps
374    
375           iprint=0           iprint=0
376  c         if(DEBUG)iprint=1  c         if(DEBUG.EQ.1)iprint=1
377           if(VERBOSE)iprint=1           if(VERBOSE.EQ.1)iprint=1
378           if(DEBUG)iprint=2           if(DEBUG.EQ.1)iprint=2
379           call mini2(jstep,ifail,iprint)           call mini2(jstep,ifail,iprint)
380           if(ifail.ne.0) then  cc         if(ifail.ne.0) then
381              if(VERBOSE)then           if(ifail.ne.0.or.CHI2.ne.CHI2) then !new
382                if(CHI2.ne.CHI2)CHI2=-9999. !new
383                if(VERBOSE.EQ.1)then
384                 print *,                 print *,
385       $              '*** MINIMIZATION FAILURE *** (after refinement) '       $              '*** MINIMIZATION FAILURE *** (after refinement) '
386       $              ,iev       $              ,iev
   
 c$$$               print*,'guess:   ',(al_guess(i),i=1,5)  
 c$$$               print*,'previous: ',(al_store(i,icand),i=1,5)  
 c$$$               print*,'result:   ',(al(i),i=1,5)  
 c$$$               print*,'xgood ',xgood  
 c$$$               print*,'ygood ',ygood  
 c$$$               print*,'----------------------------------------------'  
387              endif              endif
 c            chi2=-chi2  
388           endif           endif
389                    
390           if(DEBUG)then           if(DEBUG.EQ.1)then
391              print*,'----------------------------- improved track coord'              print*,'----------------------------- improved track coord'
392  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
393              do ip=1,6              do ip=1,6
# Line 356  c            chi2=-chi2 Line 398  c            chi2=-chi2
398           endif           endif
399    
400  c         rchi2=chi2/dble(ndof)  c         rchi2=chi2/dble(ndof)
401           if(DEBUG)then           if(DEBUG.EQ.1)then
402              print*,' '              print*,' '
403              print*,'****** SELECTED TRACK *************'              print*,'****** SELECTED TRACK *************'
404              print*,'#         R. chi2        RIG'              print*,'#         R. chi2        RIG'
# Line 372  c         rchi2=chi2/dble(ndof) Line 414  c         rchi2=chi2/dble(ndof)
414  *     ------------- search if the track has an IMAGE -------------  *     ------------- search if the track has an IMAGE -------------
415  *     ------------- (also this is stored )           -------------  *     ------------- (also this is stored )           -------------
416           if(FIMAGE)goto 122     !>>> jump! (this is already an image)           if(FIMAGE)goto 122     !>>> jump! (this is already an image)
417  *     now search for track-image, by comparing couples IDs  
418    *     -----------------------------------------------------
419    *     first check if the track is ambiguous
420    *     -----------------------------------------------------
421    *     (modified on august 2007 by ElenaV)
422             is1=0
423             do ip=1,NPLANES
424                if(SENSOR_STORE(ip,icand).ne.0)then
425                   is1=SENSOR_STORE(ip,icand)
426                   if(ip.eq.6)is1=3-is1 !last plane inverted
427                endif
428             enddo
429             if(is1.eq.0)then
430                if(WARNING.EQ.1)print*,'** WARNING ** sensor=0'
431                goto 122            !jump
432             endif
433             do ip=1,NPLANES
434                is2 = SENSOR_STORE(ip,icand) !sensor
435                if(ip.eq.6.and.is2.ne.0)is2=3-is2 !last plane inverted
436                if(
437         $           (is1.ne.is2.and.is2.ne.0)
438         $           )goto 122      !jump (this track cannot have an image)
439             enddo
440             if(DEBUG.eq.1)print*,' >>> ambiguous track! '
441    *     ---------------------------------------------------------------
442    *     take the candidate with the greatest number of matching couples
443    *     if more than one satisfies the requirement,
444    *     choose the one with more points and lower chi2
445    *     ---------------------------------------------------------------
446    *     count the number of matching couples
447             ncpmax = 0
448             iimage   = 0           !id of candidate with better matching
449           do i=1,ntracks           do i=1,ntracks
450              iimage=i              ncp=0
451              do ip=1,nplanes              do ip=1,nplanes
452                 if(     CP_STORE(nplanes-ip+1,icand).ne.                 if(CP_STORE(nplanes-ip+1,icand).ne.0)then
453       $              -1*CP_STORE(nplanes-ip+1,i) )iimage=0                    if(
454         $                 CP_STORE(nplanes-ip+1,i).ne.0
455         $                 .and.
456         $                 CP_STORE(nplanes-ip+1,icand).eq.
457         $                 -1*CP_STORE(nplanes-ip+1,i)
458         $                 )then
459                         ncp=ncp+1  !ok
460                      elseif(
461         $                    CP_STORE(nplanes-ip+1,i).ne.0
462         $                    .and.
463         $                    CP_STORE(nplanes-ip+1,icand).ne.
464         $                    -1*CP_STORE(nplanes-ip+1,i)
465         $                    )then
466                         ncp = 0
467                         goto 117   !it is not an image candidate
468                      else
469                        
470                      endif
471                   endif
472              enddo              enddo
473              if(  iimage.ne.0.and.   117        continue
474  c     $           RCHI2_STORE(i).le.CHI2MAX.and.              trackimage(i)=ncp   !number of matching couples
475  c     $           RCHI2_STORE(i).gt.0.and.              if(ncp>ncpmax)then
476       $           .true.)then                 ncpmax=ncp
477                 if(DEBUG)print*,'Track candidate ',iimage                 iimage=i
478                endif
479             enddo
480    *     check if there are more than one image candidates
481             ngood=0
482             do i=1,ntracks
483                if( ncpmax.ne.0.and.trackimage(i).eq.ncpmax )ngood=ngood+1
484             enddo
485             if(DEBUG.eq.1)print*,' n.image-candidates : ',ngood
486    *     if there are, choose the best one
487             if(ngood.gt.0)then
488    *     -------------------------------------------------------
489    *     order track-candidates according to:
490    *     1st) decreasing n.points
491    *     2nd) increasing chi**2
492    *     -------------------------------------------------------
493                rchi2best=1000000000.
494                ndofbest=0            
495                do i=1,ntracks
496                   if( trackimage(i).eq.ncpmax )then
497                      ndof=0              
498                      do ii=1,nplanes    
499                         ndof=ndof        
500         $                    +int(xgood_store(ii,i))
501         $                    +int(ygood_store(ii,i))
502                      enddo              
503                      if(ndof.gt.ndofbest)then
504                         iimage=i
505                         rchi2best=RCHI2_STORE(i)
506                         ndofbest=ndof    
507                      elseif(ndof.eq.ndofbest)then
508                         if(RCHI2_STORE(i).lt.rchi2best.and.
509         $                    RCHI2_STORE(i).gt.0)then
510                            iimage=i
511                            rchi2best=RCHI2_STORE(i)
512                            ndofbest=ndof  
513                         endif            
514                      endif
515                   endif
516                enddo
517    
518                if(DEBUG.EQ.1)then
519                   print*,'Track candidate ',iimage
520       $              ,' >>> TRACK IMAGE >>> of'       $              ,' >>> TRACK IMAGE >>> of'
521       $              ,ibest       $              ,ibest
                goto 122         !image track found  
522              endif              endif
523           enddo              
524             endif
525    
526    
527   122     continue   122     continue
528    
529    
530  *     --- and store the results --------------------------------  *     --- and store the results --------------------------------
531           ntrk = ntrk + 1                   !counter of found tracks           ntrk = ntrk + 1                   !counter of found tracks
532           if(.not.FIMAGE           if(.not.FIMAGE
# Line 399  c     $           RCHI2_STORE(i).gt.0.an Line 535  c     $           RCHI2_STORE(i).gt.0.an
535       $        .and.iimage.ne.0)image(ntrk)=ntrk+1 !this is the image of the next       $        .and.iimage.ne.0)image(ntrk)=ntrk+1 !this is the image of the next
536           if(FIMAGE)     image(ntrk)=ntrk-1 !this is the image of the previous           if(FIMAGE)     image(ntrk)=ntrk-1 !this is the image of the previous
537           call fill_level2_tracks(ntrk)     !==> good2=.true.           call fill_level2_tracks(ntrk)     !==> good2=.true.
 c         print*,'++++++++++ iimage,fimage,ntrk,image '  
 c     $        ,iimage,fimage,ntrk,image(ntrk)  
538    
539           if(ntrk.eq.NTRKMAX)then           if(ntrk.eq.NTRKMAX)then
540              if(verbose)              if(verbose.eq.1)
541       $           print*,       $           print*,
542       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
543       $           'tracks exceeds vector dimension '       $           'tracks exceeds vector dimension '
# Line 416  cc            good2=.false. Line 550  cc            good2=.false.
550              goto 1212           !>>> fit image-track              goto 1212           !>>> fit image-track
551           endif           endif
552    
 *     --- then remove selected clusters (ibest+iimage) from clouds ----  
          call clean_XYclouds(ibest,iflag)  
          if(iflag.eq.1)then     !bad event  
             goto 880            !fill ntp and go to next event              
          endif  
   
 *     **********************************************************  
 *     condition to start a new search  
 *     **********************************************************  
          ixznew=0  
          do ixz=1,nclouds_xz  
             if(ptcloud_xz(ixz).ge.nptxz_min)ixznew=1  
          enddo  
          iyznew=0  
          do iyz=1,nclouds_yz  
             if(ptcloud_yz(iyz).ge.nptyz_min)iyznew=1  
          enddo  
           
          if(ixznew.ne.0.and.  
      $      iyznew.ne.0.and.  
      $        rchi2best.le.CHI2MAX.and.  
 c     $        rchi2best.lt.15..and.  
      $        .true.)then  
             if(DEBUG)then  
                print*,'***** NEW SEARCH ****'  
             endif  
             goto 11111          !try new search  
               
          endif  
 *     **********************************************  
   
   
553    
554   880     return   880     return
555        end        end
# Line 523  c     $        rchi2best.lt.15..and. Line 625  c     $        rchi2best.lt.15..and.
625        include 'commontracker.f'        include 'commontracker.f'
626        include 'level1.f'        include 'level1.f'
627        include 'calib.f'        include 'calib.f'
 c      include 'level1.f'  
628        include 'common_align.f'        include 'common_align.f'
629        include 'common_mech.f'        include 'common_mech.f'
630        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
 c      include 'common_resxy.f'  
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
631    
632        integer icx,icy           !X-Y cluster ID        integer icx,icy           !X-Y cluster ID
633        integer sensor        integer sensor
# Line 542  c      common/dbg/DEBUG Line 639  c      common/dbg/DEBUG
639    
640        real stripx,stripy        real stripx,stripy
641    
642          double precision xi,yi,zi
643          double precision xi_A,yi_A,zi_A
644          double precision xi_B,yi_B,zi_B
645        double precision xrt,yrt,zrt        double precision xrt,yrt,zrt
646        double precision xrt_A,yrt_A,zrt_A        double precision xrt_A,yrt_A,zrt_A
647        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  
648                
649    
650        parameter (ndivx=30)        parameter (ndivx=30)
651    
652    
653                
654        resxPAM = 0        resxPAM = 0
655        resyPAM = 0        resyPAM = 0
656    
657        xPAM = 0.        xPAM = 0.D0
658        yPAM = 0.        yPAM = 0.D0
659        zPAM = 0.        zPAM = 0.D0
660        xPAM_A = 0.        xPAM_A = 0.D0
661        yPAM_A = 0.        yPAM_A = 0.D0
662        zPAM_A = 0.        zPAM_A = 0.D0
663        xPAM_B = 0.        xPAM_B = 0.D0
664        yPAM_B = 0.        yPAM_B = 0.D0
665        zPAM_B = 0.        zPAM_B = 0.D0
666  c      print*,'## xyz_PAM: ',icx,icy,sensor,PFAx,PFAy,angx,angy  
667          if(sensor.lt.1.or.sensor.gt.2)then
668             print*,'xyz_PAM   ***ERROR*** wrong input '
669             print*,'sensor ',sensor
670             icx=0
671             icy=0
672          endif
673    
674  *     -----------------  *     -----------------
675  *     CLUSTER X  *     CLUSTER X
676  *     -----------------  *     -----------------      
   
677        if(icx.ne.0)then        if(icx.ne.0)then
678    
679           viewx = VIEW(icx)           viewx   = VIEW(icx)
680           nldx = nld(MAXS(icx),VIEW(icx))           nldx    = nld(MAXS(icx),VIEW(icx))
681           nplx = npl(VIEW(icx))           nplx    = npl(VIEW(icx))
682           resxPAM = RESXAV  c         resxPAM = RESXAV
683           stripx = float(MAXS(icx))           stripx  = float(MAXS(icx))
684    
685             if(
686         $        viewx.lt.1.or.        
687         $        viewx.gt.12.or.
688         $        nldx.lt.1.or.
689         $        nldx.gt.3.or.
690         $        stripx.lt.1.or.
691         $        stripx.gt.3072.or.
692         $        .false.)then
693                print*,'xyz_PAM   ***ERROR*** wrong input '
694                print*,'icx ',icx,'view ',viewx,'nld ',nldx,'strip ',stripx
695                icx = 0
696                goto 10
697             endif
698    
699  *        --------------------------  *        --------------------------
700  *        magnetic-field corrections  *        magnetic-field corrections
701  *        --------------------------  *        --------------------------
702  c$$$         print*,nplx,ax,bfy/10.           stripx  = stripx +  fieldcorr(viewx,bfy)      
703           angtemp  = ax           angx    = effectiveangle(ax,viewx,bfy)
704           bfytemp  = bfy          
705           if(nplx.eq.6) angtemp = -1. * ax           call applypfa(PFAx,icx,angx,corr,res)
706           if(nplx.eq.6) bfytemp = -1. * bfy           stripx  = stripx + corr
707           tgtemp = tan(angtemp*acos(-1.)/180.) + pmuH_h*bfytemp*0.00001           resxPAM = res
          angx = 180.*atan(tgtemp)/acos(-1.)  
          stripx = stripx - 0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX  
 c$$$         print*,angx,0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX  
 c$$$         print*,'========================'  
 *        --------------------------  
   
          if(PFAx.eq.'COG1')then  
             stripx = stripx      
             resxPAM = resxPAM    
          elseif(PFAx.eq.'COG2')then  
             stripx = stripx + cog(2,icx)              
             resxPAM = resxPAM*fbad_cog(2,icx)  
          elseif(PFAx.eq.'COG3')then  
             stripx = stripx + cog(3,icx)              
             resxPAM = resxPAM*fbad_cog(3,icx)  
          elseif(PFAx.eq.'COG4')then  
 c            print*,'COG4'  
             stripx = stripx + cog(4,icx)              
             resxPAM = resxPAM*fbad_cog(4,icx)  
          elseif(PFAx.eq.'ETA2')then  
             stripx = stripx + pfaeta2(icx,angx)            
             resxPAM = risx_eta2(abs(angx))                      
             if(DEBUG.and.fbad_cog(2,icx).ne.1)  
      $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)  
             resxPAM = resxPAM*fbad_cog(2,icx)  
          elseif(PFAx.eq.'ETA3')then                          
             stripx = stripx + pfaeta3(icx,angx)            
             resxPAM = risx_eta3(abs(angx))                        
             if(DEBUG.and.fbad_cog(3,icx).ne.1)              
      $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)  
             resxPAM = resxPAM*fbad_cog(3,icx)                
          elseif(PFAx.eq.'ETA4')then                          
             stripx = stripx + pfaeta4(icx,angx)              
             resxPAM = risx_eta4(abs(angx))                        
             if(DEBUG.and.fbad_cog(4,icx).ne.1)                
      $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)  
             resxPAM = resxPAM*fbad_cog(4,icx)                
          elseif(PFAx.eq.'ETA')then    
 c            print*,'ETA'  
             stripx = stripx + pfaeta(icx,angx)              
             resxPAM = ris_eta(icx,angx)                      
             if(DEBUG.and.fbad_cog(2,icx).ne.1)                
      $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)  
             resxPAM = resxPAM*fbad_eta(icx,angx)              
          elseif(PFAx.eq.'COG')then            
             stripx = stripx + cog(0,icx)              
             resxPAM = risx_cog(abs(angx))                      
             resxPAM = resxPAM*fbad_cog(0,icx)  
          else  
             print*,'*** Non valid p.f.a. (x) --> ',PFAx  
          endif  
   
 c         print*,'%%%%%%%%%%%%'  
708    
709     10   continue
710        endif        endif
711              
712  *     -----------------  *     -----------------
713  *     CLUSTER Y  *     CLUSTER Y
714  *     -----------------  *     -----------------
# Line 650  c         print*,'%%%%%%%%%%%%' Line 718  c         print*,'%%%%%%%%%%%%'
718           viewy = VIEW(icy)           viewy = VIEW(icy)
719           nldy = nld(MAXS(icy),VIEW(icy))           nldy = nld(MAXS(icy),VIEW(icy))
720           nply = npl(VIEW(icy))           nply = npl(VIEW(icy))
721           resyPAM = RESYAV  c         resyPAM = RESYAV
722           stripy = float(MAXS(icy))           stripy = float(MAXS(icy))
723    
724             if(
725         $        viewy.lt.1.or.        
726         $        viewy.gt.12.or.
727         $        nldy.lt.1.or.
728         $        nldy.gt.3.or.
729         $        stripy.lt.1.or.
730         $        stripy.gt.3072.or.
731         $        .false.)then
732                print*,'xyz_PAM   ***ERROR*** wrong input '
733                print*,'icy ',icy,'view ',viewy,'nld ',nldy,'strip ',stripy
734                icy = 0
735                goto 20
736             endif
737    
738           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
739              print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '              if(DEBUG.EQ.1) then
740       $           ,icx,icy                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '
741         $              ,icx,icy
742                endif
743              goto 100              goto 100
744           endif           endif
745    
746  *        --------------------------  *        --------------------------
747  *        magnetic-field corrections  *        magnetic-field corrections
748  *        --------------------------  *        --------------------------
749           tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001                   stripy  = stripy +  fieldcorr(viewy,bfx)      
750           angy    = 180.*atan(tgtemp)/acos(-1.)           angy    = effectiveangle(ay,viewy,bfx)
          stripy = stripy + 0.5*pmuH_e*bfx*0.00001*SiDimZ/pitchY  
 *        --------------------------  
751                    
752           if(PFAy.eq.'COG1')then !(1)           call applypfa(PFAy,icy,angy,corr,res)
753              stripy = stripy     !(1)           stripy  = stripy + corr
754              resyPAM = resyPAM   !(1)           resyPAM = res
          elseif(PFAy.eq.'COG2')then  
             stripy = stripy + cog(2,icy)  
             resyPAM = resyPAM*fbad_cog(2,icy)  
          elseif(PFAy.eq.'COG3')then  
             stripy = stripy + cog(3,icy)  
             resyPAM = resyPAM*fbad_cog(3,icy)  
          elseif(PFAy.eq.'COG4')then  
             stripy = stripy + cog(4,icy)  
             resyPAM = resyPAM*fbad_cog(4,icy)  
          elseif(PFAy.eq.'ETA2')then  
 c            cog2 = cog(2,icy)  
 c            etacorr = pfaeta2(cog2,viewy,nldy,angy)  
 c            stripy = stripy + etacorr  
             stripy = stripy + pfaeta2(icy,angy)            !(3)  
             resyPAM = risy_eta2(abs(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 + pfaeta3(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 + pfaeta4(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 + pfaeta(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(abs(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  
755    
756     20   continue
757        endif        endif
758    
 c      print*,'## stripx,stripy ',stripx,stripy  
759    
760  c===========================================================  c===========================================================
761  C     COUPLE  C     COUPLE
# Line 727  c     (xi,yi,zi) = mechanical coordinate Line 767  c     (xi,yi,zi) = mechanical coordinate
767  c------------------------------------------------------------------------  c------------------------------------------------------------------------
768           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
769       $        .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...       $        .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
770              print*,'xyz_PAM (couple):',              if(DEBUG.EQ.1) then
771       $          ' WARNING: false X strip: strip ',stripx                 print*,'xyz_PAM (couple):',
772         $              ' WARNING: false X strip: strip ',stripx
773                endif
774           endif           endif
775           xi = acoordsi(stripx,viewx)           xi = dcoordsi(stripx,viewx)
776           yi = acoordsi(stripy,viewy)           yi = dcoordsi(stripy,viewy)
777           zi = 0.           zi = 0.D0
778                    
   
779  c------------------------------------------------------------------------  c------------------------------------------------------------------------
780  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
781  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 768  c--------------------------------------- Line 809  c---------------------------------------
809           yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4           yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4
810           zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4           zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4
811    
812           xPAM_A = 0.           xPAM_A = 0.D0
813           yPAM_A = 0.           yPAM_A = 0.D0
814           zPAM_A = 0.           zPAM_A = 0.D0
815    
816           xPAM_B = 0.           xPAM_B = 0.D0
817           yPAM_B = 0.           yPAM_B = 0.D0
818           zPAM_B = 0.           zPAM_B = 0.D0
819    
820        elseif(        elseif(
821       $        (icx.ne.0.and.icy.eq.0).or.       $        (icx.ne.0.and.icy.eq.0).or.
# Line 794  C======================================= Line 835  C=======================================
835              nldx = nldy              nldx = nldy
836              viewx = viewy + 1              viewx = viewy + 1
837    
838              yi   = acoordsi(stripy,viewy)              xi = dcoordsi(0.5*(nstrips+1),viewx) !sensor center
839                yi = dcoordsi(stripy,viewy)
840                zi = 0.D0
841    
842              xi_A = edgeY_d - SiDimX/2              xi_A = edgeY_d - SiDimX/2
843              yi_A = yi              yi_A = yi
# Line 804  C======================================= Line 847  C=======================================
847              yi_B = yi              yi_B = yi
848              zi_B = 0.              zi_B = 0.
849    
 c            print*,'Y-cl ',icy,stripy,' --> ',yi  
 c            print*,xi_A,' <--> ',xi_B  
850                            
851           elseif(icx.ne.0)then           elseif(icx.ne.0)then
852  c===========================================================  c===========================================================
# Line 816  C======================================= Line 857  C=======================================
857              nldy = nldx              nldy = nldx
858              viewy = viewx - 1              viewy = viewx - 1
859    
 c            print*,'X-singlet ',icx,nplx,nldx,viewx,stripx  
 c            if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...  
860              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
861       $           .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...       $           .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...
862                 print*,'xyz_PAM (X-singlet):',                 if(DEBUG.EQ.1) then
863       $             ' WARNING: false X strip: strip ',stripx                    print*,'xyz_PAM (X-singlet):',
864         $                 ' WARNING: false X strip: strip ',stripx
865                   endif
866              endif              endif
867              xi   = acoordsi(stripx,viewx)  
868                xi = dcoordsi(stripx,viewx)
869                yi = dcoordsi(0.5*(nstrips+1),viewy) !sensor center
870                zi = 0.D0
871    
872              xi_A = xi              xi_A = xi
873              yi_A = edgeX_d - SiDimY/2              yi_A = edgeX_d - SiDimY/2
# Line 839  c            if((stripx.le.3).or.(stripx Line 883  c            if((stripx.le.3).or.(stripx
883                 yi_B = yi                 yi_B = yi
884              endif              endif
885    
 c            print*,'X-cl ',icx,stripx,' --> ',xi  
 c            print*,yi_A,' <--> ',yi_B  
886    
887           else           else
888                if(DEBUG.EQ.1) then
889              print *,'routine xyz_PAM ---> not properly used !!!'                 print *,'routine xyz_PAM ---> not properly used !!!'
890              print *,'icx = ',icx                 print *,'icx = ',icx
891              print *,'icy = ',icy                 print *,'icy = ',icy
892                endif
893              goto 100              goto 100
894                            
895           endif           endif
# Line 885  c     N.B. I convert angles from microra Line 928  c     N.B. I convert angles from microra
928       $        + zi_B       $        + zi_B
929       $        + dz(nplx,nldx,sensor)       $        + dz(nplx,nldx,sensor)
930    
931    
932    
933             xrt = xi
934         $        - omega(nplx,nldx,sensor)*yi
935         $        + gamma(nplx,nldx,sensor)*zi
936         $        + dx(nplx,nldx,sensor)
937            
938             yrt = omega(nplx,nldx,sensor)*xi
939         $        + yi
940         $        - beta(nplx,nldx,sensor)*zi
941         $        + dy(nplx,nldx,sensor)
942            
943             zrt = -gamma(nplx,nldx,sensor)*xi
944         $        + beta(nplx,nldx,sensor)*yi
945         $        + zi
946         $        + dz(nplx,nldx,sensor)
947    
948    
949                    
950  c      xrt = xi  c      xrt = xi
951  c      yrt = yi  c      yrt = yi
# Line 895  c     (xPAM,yPAM,zPAM) = measured coordi Line 956  c     (xPAM,yPAM,zPAM) = measured coordi
956  c                        in PAMELA reference system  c                        in PAMELA reference system
957  c------------------------------------------------------------------------  c------------------------------------------------------------------------
958    
959           xPAM = 0.           xPAM = dcoord(xrt,viewx,nldx,sensor) / 1.d4
960           yPAM = 0.           yPAM = dcoord(yrt,viewy,nldy,sensor) / 1.d4
961           zPAM = 0.           zPAM = ( zrt + z_mech_sensor(nplx,nldx,sensor)*1000. ) / 1.d4
962    c$$$         xPAM = 0.D0
963    c$$$         yPAM = 0.D0
964    c$$$         zPAM = 0.D0
965    
966           xPAM_A = dcoord(xrt_A,viewx,nldx,sensor) / 1.d4           xPAM_A = dcoord(xrt_A,viewx,nldx,sensor) / 1.d4
967           yPAM_A = dcoord(yrt_A,viewy,nldy,sensor) / 1.d4           yPAM_A = dcoord(yrt_A,viewy,nldy,sensor) / 1.d4
# Line 908  c--------------------------------------- Line 972  c---------------------------------------
972           zPAM_B = ( zrt_B + z_mech_sensor(nplx,nldx,sensor)*1000.)/ 1.d4           zPAM_B = ( zrt_B + z_mech_sensor(nplx,nldx,sensor)*1000.)/ 1.d4
973                    
974    
 c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'  
975    
976        else        else
977                       if(DEBUG.EQ.1) then
978           print *,'routine xyz_PAM ---> not properly used !!!'              print *,'routine xyz_PAM ---> not properly used !!!'
979           print *,'icx = ',icx              print *,'icx = ',icx
980           print *,'icy = ',icy              print *,'icy = ',icy
981                         endif
982        endif        endif
983                    
984    
 c      print*,'## xPAM,yPAM,zPAM       ',xPAM,yPAM,zPAM  
 c      print*,'## xPAM_A,yPAM_A,zPAM_A ',xPAM_A,yPAM_A,zPAM_A  
 c      print*,'## xPAM_B,yPAM_B,zPAM_B ',xPAM_B,yPAM_B,zPAM_B  
985    
986   100  continue   100  continue
987        end        end
988    
989    ************************************************************************
990    *     Call xyz_PAM subroutine with default PFA and fill the mini2 common.
991    *     (done to be called from c/c++)
992    ************************************************************************
993    
994          subroutine xyzpam(ip,icx,icy,lad,sensor,ax,ay,bfx,bfy)
995    
996          include 'commontracker.f'
997          include 'level1.f'
998          include 'common_mini_2.f'
999          include 'common_xyzPAM.f'
1000          include 'common_mech.f'
1001          include 'calib.f'
1002          
1003    *     flag to chose PFA
1004    c$$$      character*10 PFA
1005    c$$$      common/FINALPFA/PFA
1006    
1007          integer icx,icy           !X-Y cluster ID
1008          integer sensor
1009          character*4 PFAx,PFAy     !PFA to be used
1010          real ax,ay                !X-Y geometric angle
1011          real bfx,bfy              !X-Y b-field components
1012    
1013          ipx=0
1014          ipy=0      
1015          
1016    c$$$      PFAx = 'COG4'!PFA
1017    c$$$      PFAy = 'COG4'!PFA
1018    
1019    
1020          if(icx.gt.nclstr1.or.icy.gt.nclstr1)then
1021                print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1022         $           ,' do not exists (n.clusters=',nclstr1,')'
1023                icx = -1*icx
1024                icy = -1*icy
1025                return
1026            
1027          endif
1028          
1029          call idtoc(pfaid,PFAx)
1030          call idtoc(pfaid,PFAy)
1031    
1032          
1033          if(icx.ne.0.and.icy.ne.0)then
1034    
1035             ipx=npl(VIEW(icx))
1036             ipy=npl(VIEW(icy))
1037            
1038             if( (nplanes-ipx+1).ne.ip )then
1039                print*,'xyzpam: ***WARNING*** cluster ',icx
1040         $           ,' does not belong to plane: ',ip
1041                icx = -1*icx
1042                return
1043             endif
1044             if( (nplanes-ipy+1).ne.ip )then
1045                print*,'xyzpam: ***WARNING*** cluster ',icy
1046         $           ,' does not belong to plane: ',ip
1047                icy = -1*icy
1048                return
1049             endif
1050    
1051             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1052    
1053             xgood(ip) = 1.
1054             ygood(ip) = 1.
1055             resx(ip)  = resxPAM
1056             resy(ip)  = resyPAM
1057    
1058             xm(ip) = xPAM
1059             ym(ip) = yPAM
1060             zm(ip) = zPAM
1061             xm_A(ip) = 0.D0
1062             ym_A(ip) = 0.D0
1063             xm_B(ip) = 0.D0
1064             ym_B(ip) = 0.D0
1065    
1066    c         zv(ip) = zPAM
1067    
1068          elseif(icx.eq.0.and.icy.ne.0)then
1069    
1070             ipy=npl(VIEW(icy))
1071             if( (nplanes-ipy+1).ne.ip )then
1072                print*,'xyzpam: ***WARNING*** cluster ',icy
1073         $           ,' does not belong to plane: ',ip
1074                icy = -1*icy
1075                return
1076             endif
1077    
1078             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1079            
1080             xgood(ip) = 0.
1081             ygood(ip) = 1.
1082             resx(ip)  = 1000.
1083             resy(ip)  = resyPAM
1084    
1085    c$$$         xm(ip) = -100.
1086    c$$$         ym(ip) = -100.
1087    c$$$         zm(ip) = (zPAM_A+zPAM_B)/2.
1088             xm(ip) = xPAM
1089             ym(ip) = yPAM
1090             zm(ip) = zPAM
1091             xm_A(ip) = xPAM_A
1092             ym_A(ip) = yPAM_A
1093             xm_B(ip) = xPAM_B
1094             ym_B(ip) = yPAM_B
1095    
1096    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1097            
1098          elseif(icx.ne.0.and.icy.eq.0)then
1099    
1100             ipx=npl(VIEW(icx))
1101    
1102             if( (nplanes-ipx+1).ne.ip )then
1103                print*,'xyzpam: ***WARNING*** cluster ',icx
1104         $           ,' does not belong to plane: ',ip
1105                icx = -1*icx
1106                return
1107             endif
1108    
1109             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1110          
1111             xgood(ip) = 1.
1112             ygood(ip) = 0.
1113             resx(ip)  = resxPAM
1114             resy(ip)  = 1000.
1115    
1116    c$$$         xm(ip) = -100.
1117    c$$$         ym(ip) = -100.
1118    c$$$         zm(ip) = (zPAM_A+zPAM_B)/2.
1119             xm(ip) = xPAM
1120             ym(ip) = yPAM
1121             zm(ip) = zPAM
1122             xm_A(ip) = xPAM_A
1123             ym_A(ip) = yPAM_A
1124             xm_B(ip) = xPAM_B
1125             ym_B(ip) = yPAM_B
1126            
1127    c         zv(ip) = (zPAM_A+zPAM_B)/2.
1128    
1129          else
1130    
1131             il = 2
1132             if(lad.ne.0)il=lad
1133             is = 1
1134             if(sensor.ne.0)is=sensor
1135    
1136             xgood(ip) = 0.
1137             ygood(ip) = 0.
1138             resx(ip)  = 1000.
1139             resy(ip)  = 1000.
1140    
1141             xm(ip) = -100.
1142             ym(ip) = -100.          
1143             zm(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1144             xm_A(ip) = 0.
1145             ym_A(ip) = 0.
1146             xm_B(ip) = 0.
1147             ym_B(ip) = 0.
1148    
1149    c         zv(ip) = z_mech_sensor(nplanes-ip+1,il,is)*1000./1.d4
1150    
1151          endif
1152    
1153          if(DEBUG.EQ.1)then
1154    22222    format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
1155             write(*,22222)ip,zm(ip),xm(ip),ym(ip)
1156         $        ,xm_A(ip),ym_A(ip),xm_B(ip),ym_B(ip)
1157         $        ,xgood(ip),ygood(ip),resx(ip),resy(ip)
1158          endif
1159          end
1160    
1161  ********************************************************************************  ********************************************************************************
1162  ********************************************************************************  ********************************************************************************
# Line 947  c      print*,'## xPAM_B,yPAM_B,zPAM_B ' Line 1178  c      print*,'## xPAM_B,yPAM_B,zPAM_B '
1178  *      *    
1179  ********************************************************************************  ********************************************************************************
1180    
1181        real function distance_to(XPP,YPP)        real function distance_to(rXPP,rYPP)
1182    
1183        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
1184    
# Line 956  c      print*,'## xPAM_B,yPAM_B,zPAM_B ' Line 1187  c      print*,'## xPAM_B,yPAM_B,zPAM_B '
1187  *     ( i.e. distance/resolution )  *     ( i.e. distance/resolution )
1188  *     -----------------------------------  *     -----------------------------------
1189    
1190          real rXPP,rYPP
1191          double precision XPP,YPP
1192        double precision distance,RE        double precision distance,RE
1193        double precision BETA,ALFA,xmi,ymi        double precision BETA,ALFA,xmi,ymi
1194    
1195          XPP=DBLE(rXPP)
1196          YPP=DBLE(rYPP)
1197    
1198  *     ----------------------  *     ----------------------
1199        if (        if (
1200       +     xPAM.eq.0.and.  c$$$     +     xPAM.eq.0.and.
1201       +     yPAM.eq.0.and.  c$$$     +     yPAM.eq.0.and.
1202       +     zPAM.eq.0.and.  c$$$     +     zPAM.eq.0.and.
1203       +     xPAM_A.ne.0.and.       +     xPAM_A.ne.0.and.
1204       +     yPAM_A.ne.0.and.       +     yPAM_A.ne.0.and.
1205       +     zPAM_A.ne.0.and.       +     zPAM_A.ne.0.and.
# Line 1001  c      print*,'## xPAM_B,yPAM_B,zPAM_B ' Line 1237  c      print*,'## xPAM_B,yPAM_B,zPAM_B '
1237           endif                   endif        
1238    
1239           distance=           distance=
1240       $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2       $       ((xmi-XPP)**2+(ymi-YPP)**2)!QUIQUI
1241    cc     $        ((xmi-XPP)**2+(ymi-YPP)**2)/RE**2
1242           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1243    
 c$$$         print*,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b  
 c$$$     $        ,' --- distance_to --- ',xpp,ypp  
 c$$$         print*,' resolution ',re  
1244    
1245                    
1246  *     ----------------------  *     ----------------------
1247        elseif(        elseif(
1248       +     xPAM.ne.0.and.  c$$$     +     xPAM.ne.0.and.
1249       +     yPAM.ne.0.and.  c$$$     +     yPAM.ne.0.and.
1250       +     zPAM.ne.0.and.  c$$$     +     zPAM.ne.0.and.
1251       +     xPAM_A.eq.0.and.       +     xPAM_A.eq.0.and.
1252       +     yPAM_A.eq.0.and.       +     yPAM_A.eq.0.and.
1253       +     zPAM_A.eq.0.and.       +     zPAM_A.eq.0.and.
# Line 1026  c$$$         print*,' resolution ',re Line 1260  c$$$         print*,' resolution ',re
1260  *     ----------------------  *     ----------------------
1261                    
1262           distance=           distance=
1263       $        ((xPAM-XPP)/resxPAM)**2       $       ((xPAM-XPP))**2 !QUIQUI
1264       $        +       $       +
1265       $        ((yPAM-YPP)/resyPAM)**2       $       ((yPAM-YPP))**2
1266    c$$$     $        ((xPAM-XPP)/resxPAM)**2
1267    c$$$     $        +
1268    c$$$     $        ((yPAM-YPP)/resyPAM)**2
1269           distance=dsqrt(distance)                               distance=dsqrt(distance)                    
1270    
 c$$$         print*,xPAM,yPAM,zPAM  
 c$$$     $        ,' --- distance_to --- ',xpp,ypp  
 c$$$         print*,' resolution ',resxPAM,resyPAM  
1271                    
1272        else        else
1273                    
          print*  
      $        ,' function distance_to ---> wrong usage!!!'  
          print*,' xPAM,yPAM,zPAM ',xPAM,yPAM,zPAM  
          print*,' xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b '  
      $        ,xPAM_A,yPAM_A,zPAM_A,xPAM_b,yPAM_b,zPAM_b  
1274        endif          endif  
1275    
1276        distance_to = sngl(distance)        distance_to = sngl(distance)
# Line 1081  c$$$         print*,' resolution ',resxP Line 1310  c$$$         print*,' resolution ',resxP
1310        data c1/1.,0.,0.,1./        data c1/1.,0.,0.,1./
1311        data c2/1.,-1.,-1.,1./        data c2/1.,-1.,-1.,1./
1312        data c3/1.,1.,0.,0./        data c3/1.,1.,0.,0./
1313        real*8 yvvv,xvvv        double precision yvvv,xvvv
1314        double precision xi,yi,zi        double precision xi,yi,zi
1315        double precision xrt,yrt,zrt        double precision xrt,yrt,zrt
1316        real AA,BB        real AA,BB
1317        real yvv(4),xvv(4)        double precision yvv(4),xvv(4)
1318    
1319  *     tollerance to consider the track inside the sensitive area  *     tollerance to consider the track inside the sensitive area
1320        real ptoll        real ptoll
1321        data ptoll/150./          !um        data ptoll/150./          !um
1322    
1323        external nviewx,nviewy,acoordsi,dcoord        external nviewx,nviewy,dcoordsi,dcoord
1324    
1325        nplpt = nplPAM            !plane        nplpt = nplPAM            !plane
1326        viewx = nviewx(nplpt)        viewx = nviewx(nplpt)
# Line 1106  c$$$         print*,' resolution ',resxP Line 1335  c$$$         print*,' resolution ',resxP
1335  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1336  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame  c     (xi,yi,zi) = mechanical coordinates in the silicon sensor frame
1337  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1338                 if(((mod(int(stripx+0.5)-1,1024)+1).le.3)                 xi = dcoordsi(stripx,viewx)
1339       $              .or.((mod(int(stripx+0.5)-1,1024)+1).ge.1022)) then !X has 1018 strips...                 yi = dcoordsi(stripy,viewy)
1340  c     if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...                 zi = 0.D0
                   print*,'whichsensor: ',  
      $                ' WARNING: false X strip: strip ',stripx  
                endif  
                xi = acoordsi(stripx,viewx)  
                yi = acoordsi(stripy,viewy)  
                zi = 0.  
1341  c------------------------------------------------------------------------  c------------------------------------------------------------------------
1342  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
1343  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 1139  c--------------------------------------- Line 1362  c---------------------------------------
1362    
1363                 yvv(iv)=sngl(yvvv)                 yvv(iv)=sngl(yvvv)
1364                 xvv(iv)=sngl(xvvv)                 xvv(iv)=sngl(xvvv)
 c               print*,'LADDER ',il,' SENSOR ',is,' vertexes >> '  
 c     $              ,iv,xvv(iv),yvv(iv)  
1365              enddo               !end loop on sensor vertexes              enddo               !end loop on sensor vertexes
1366    
1367              dtot=0.              dtot=0.
# Line 1265  c      include 'common_analysis.f' Line 1486  c      include 'common_analysis.f'
1486        is_cp=0        is_cp=0
1487        if(id.lt.0)is_cp=1        if(id.lt.0)is_cp=1
1488        if(id.gt.0)is_cp=2        if(id.gt.0)is_cp=2
       if(id.eq.0)print*,'IS_CP ===> wrong couple id !!!'  
1489    
1490        return        return
1491        end        end
# Line 1365  c      include 'level1.f' Line 1585  c      include 'level1.f'
1585    
1586        integer badseed,badclx,badcly        integer badseed,badclx,badcly
1587    
1588          iflag = iflag
1589          if(DEBUG.EQ.1)print*,'cl_to_couples:'
1590    
1591    cc      if(RECOVER_SINGLETS.and..not.SECOND_SEARCH)goto 80
1592    
1593  *     init variables  *     init variables
       ncp_tot=0  
1594        do ip=1,nplanes        do ip=1,nplanes
1595           do ico=1,ncouplemax           do ico=1,ncouplemax
1596              clx(ip,ico)=0              clx(ip,ico)=0
# Line 1379  c      include 'level1.f' Line 1603  c      include 'level1.f'
1603           ncls(ip)=0           ncls(ip)=0
1604        enddo        enddo
1605        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1606           cl_single(icl) = 1           cl_single(icl) = 1     !all are single
1607           cl_good(icl)   = 0           cl_good(icl)   = 0     !all are bad
1608        enddo        enddo
1609        do iv=1,nviews        do iv=1,nviews
1610           ncl_view(iv)  = 0           ncl_view(iv)  = 0
# Line 1394  c      include 'level1.f' Line 1618  c      include 'level1.f'
1618  *     mask views with too many clusters  *     mask views with too many clusters
1619        do iv=1,nviews        do iv=1,nviews
1620           if( ncl_view(iv).gt. nclusterlimit)then           if( ncl_view(iv).gt. nclusterlimit)then
1621              mask_view(iv) = 1  c            mask_view(iv) = 1
1622              if(DEBUG)print*,' * WARNING * cl_to_couple: n.clusters > '              mask_view(iv) = mask_view(iv) + 2**0
1623       $           ,nclusterlimit,' on view ', iv,' --> masked!'              if(DEBUG.EQ.1)
1624         $        print*,' * WARNING * cl_to_couple: n.clusters > '
1625         $        ,nclusterlimit,' on view ', iv,' --> masked!'
1626           endif           endif
1627        enddo        enddo
1628    
# Line 1406  c      include 'level1.f' Line 1632  c      include 'level1.f'
1632        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1633           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1634                    
1635             if(cl_used(icx).ne.0)goto 10
1636    
1637  *     ----------------------------------------------------  *     ----------------------------------------------------
1638  *     jump masked views (X VIEW)  *     jump masked views (X VIEW)
1639  *     ----------------------------------------------------  *     ----------------------------------------------------
# Line 1413  c      include 'level1.f' Line 1641  c      include 'level1.f'
1641  *     ----------------------------------------------------  *     ----------------------------------------------------
1642  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1643  *     ----------------------------------------------------  *     ----------------------------------------------------
1644           if(sgnl(icx).lt.dedx_x_min)then           if(sgnl(icx)/mip(VIEW(icx),LADDER(icx)).lt.dedx_x_min)then
1645              cl_single(icx)=0              cl_single(icx)=0
1646              goto 10              goto 10
1647           endif           endif
# Line 1454  c     endif Line 1682  c     endif
1682                    
1683           do icy=1,nclstr1       !loop on cluster (Y)           do icy=1,nclstr1       !loop on cluster (Y)
1684              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1685    
1686                if(cl_used(icx).ne.0)goto 20
1687                            
1688  *     ----------------------------------------------------  *     ----------------------------------------------------
1689  *     jump masked views (Y VIEW)  *     jump masked views (Y VIEW)
# Line 1463  c     endif Line 1693  c     endif
1693  *     ----------------------------------------------------  *     ----------------------------------------------------
1694  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1695  *     ----------------------------------------------------  *     ----------------------------------------------------
1696              if(sgnl(icy).lt.dedx_y_min)then              if(sgnl(icy)/mip(VIEW(icy),LADDER(icy)) .lt.dedx_y_min)then
1697                 cl_single(icy)=0                 cl_single(icy)=0
1698                 goto 20                 goto 20
1699              endif              endif
# Line 1534  c                  cut = chcut * sch(npl Line 1764  c                  cut = chcut * sch(npl
1764                 endif                 endif
1765    
1766                 if(ncp_plane(nplx).gt.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
1767                    if(verbose)print*,                    if(verbose.eq.1)print*,
1768       $                 '** warning ** number of identified '//       $                 '** warning ** number of identified '//
1769       $                 'couples on plane ',nplx,       $                 'couples on plane ',nplx,
1770       $                 'exceeds vector dimention '       $                 'exceeds vector dimention '
1771       $                 ,'( ',ncouplemax,' ) --> masked!'       $                 ,'( ',ncouplemax,' ) --> masked!'
1772                    mask_view(nviewx(nplx)) = 2  c                  mask_view(nviewx(nplx)) = 2
1773                    mask_view(nviewy(nply)) = 2  c                  mask_view(nviewy(nply)) = 2
1774                     mask_view(nviewx(nplx))= mask_view(nviewx(nplx))+ 2**1
1775                     mask_view(nviewy(nply))= mask_view(nviewy(nply))+ 2**1
1776                    goto 10                    goto 10
1777                 endif                 endif
1778                                
# Line 1560  c                  cut = chcut * sch(npl Line 1792  c                  cut = chcut * sch(npl
1792   10      continue   10      continue
1793        enddo                     !end loop on clusters(X)        enddo                     !end loop on clusters(X)
1794                
         
1795        do icl=1,nclstr1        do icl=1,nclstr1
1796           if(cl_single(icl).eq.1)then           if(cl_single(icl).eq.1)then
1797              ip=npl(VIEW(icl))              ip=npl(VIEW(icl))
# Line 1568  c                  cut = chcut * sch(npl Line 1799  c                  cut = chcut * sch(npl
1799              cls(ip,ncls(ip))=icl              cls(ip,ncls(ip))=icl
1800           endif           endif
1801        enddo        enddo
1802    
1803    c 80   continue
1804          continue
1805                
1806                
1807        if(DEBUG)then        if(DEBUG.EQ.1)then
1808           print*,'clusters  ',nclstr1           print*,'clusters  ',nclstr1
1809           print*,'good    ',(cl_good(i),i=1,nclstr1)           print*,'good    ',(cl_good(i),i=1,nclstr1)
1810           print*,'singles ',(cl_single(i),i=1,nclstr1)           print*,'used    ',(cl_used(i),i=1,nclstr1)
1811             print*,'singlets',(cl_single(i),i=1,nclstr1)
1812           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
1813        endif        endif
1814    
1815      
1816          if(.not.RECOVER_SINGLETS)goto 81
1817    
1818    *     ////////////////////////////////////////////////
1819    *     PATCH to recover events with less than 3 couples
1820    *     ////////////////////////////////////////////////    
1821    *     loop over singlet and create "fake" couples
1822    *     (with clx=0 or cly=0)
1823    *    
1824    
1825          if(DEBUG.EQ.1)
1826         $     print*,'>>> Recover singlets '
1827         $     ,'(creates fake couples) <<<'
1828          do icl=1,nclstr1
1829             if(
1830         $        cl_single(icl).eq.1.and.
1831         $        cl_used(icl).eq.0.and.
1832         $        .true.)then
1833    *     ----------------------------------------------------
1834    *     jump masked views
1835    *     ----------------------------------------------------
1836                if( mask_view(VIEW(icl)).ne.0 ) goto 21
1837                if(mod(VIEW(icl),2).eq.0)then !=== X views
1838    *     ----------------------------------------------------
1839    *     cut on charge (X VIEW)
1840    *     ----------------------------------------------------
1841                   if(sgnl(icl).lt.dedx_x_min) goto 21
1842                  
1843                   nplx=npl(VIEW(icl))
1844    *     ------------------> (FAKE) COUPLE <-----------------
1845                   ncp_plane(nplx) = ncp_plane(nplx) + 1
1846                   clx(nplx,ncp_plane(nplx))=icl
1847                   cly(nplx,ncp_plane(nplx))=0
1848    c$$$  cl_single(icl)=0! I leave the cluster tagged as singlet!!!
1849    *     ----------------------------------------------------
1850                  
1851                else                !=== Y views
1852    *     ----------------------------------------------------
1853    *     cut on charge (Y VIEW)
1854    *     ----------------------------------------------------
1855                   if(sgnl(icl).lt.dedx_y_min) goto 21
1856                  
1857                   nply=npl(VIEW(icl))
1858    *     ------------------> (FAKE) COUPLE <-----------------
1859                   ncp_plane(nply) = ncp_plane(nply) + 1
1860                   clx(nply,ncp_plane(nply))=0
1861                   cly(nply,ncp_plane(nply))=icl
1862    c$$$  cl_single(icl)=0! I leave the cluster tagged as singlet!!!
1863    *     ----------------------------------------------------
1864                  
1865                endif
1866             endif                  !end "single" condition
1867     21      continue
1868          enddo                     !end loop over clusters
1869    
1870          if(DEBUG.EQ.1)
1871         $     print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
1872    
1873    
1874     81   continue
1875                
1876        do ip=1,6        ncp_tot=0
1877          do ip=1,NPLANES
1878           ncp_tot = ncp_tot + ncp_plane(ip)           ncp_tot = ncp_tot + ncp_plane(ip)
1879        enddo        enddo
1880          if(DEBUG.EQ.1)
1881         $     print*,'n.couple tot:      ',ncp_tot
1882                
1883        return        return
1884        end        end
# Line 1633  c      double precision xm3,ym3,zm3 Line 1932  c      double precision xm3,ym3,zm3
1932        real xc,zc,radius        real xc,zc,radius
1933  *     -----------------------------  *     -----------------------------
1934    
1935          if(DEBUG.EQ.1)print*,'cp_to_doubtrip:'
1936    
1937  *     --------------------------------------------  *     --------------------------------------------
1938  *     put a limit to the maximum number of couples  *     put a limit to the maximum number of couples
# Line 1641  c      double precision xm3,ym3,zm3 Line 1941  c      double precision xm3,ym3,zm3
1941  *     --------------------------------------------  *     --------------------------------------------
1942        do ip=1,nplanes        do ip=1,nplanes
1943           if(ncp_plane(ip).gt.ncouplelimit)then           if(ncp_plane(ip).gt.ncouplelimit)then
1944              mask_view(nviewx(ip)) = 8              mask_view(nviewx(ip)) = mask_view(nviewx(ip)) + 2**7
1945              mask_view(nviewy(ip)) = 8              mask_view(nviewy(ip)) = mask_view(nviewy(ip)) + 2**7
1946           endif           endif
1947        enddo        enddo
1948    
# Line 1651  c      double precision xm3,ym3,zm3 Line 1951  c      double precision xm3,ym3,zm3
1951        ntrpt=0                   !number of triplets        ntrpt=0                   !number of triplets
1952                
1953        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1        do ip1=1,(nplanes-1)      !loop on planes  - COPPIA 1
1954    c$$$         print*,'(1) ip ',ip1
1955    c$$$     $        ,mask_view(nviewx(ip1))
1956    c$$$     $        ,mask_view(nviewy(ip1))        
1957           if(  mask_view(nviewx(ip1)).ne.0 .or.           if(  mask_view(nviewx(ip1)).ne.0 .or.
1958       $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane       $        mask_view(nviewy(ip1)).ne.0 )goto 10 !skip plane
1959           do is1=1,2             !loop on sensors - COPPIA 1                       do is1=1,2             !loop on sensors - COPPIA 1            
1960              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1              do icp1=1,ncp_plane(ip1) !loop on COPPIA 1
1961                 icx1=clx(ip1,icp1)                 icx1=clx(ip1,icp1)
1962                 icy1=cly(ip1,icp1)                 icy1=cly(ip1,icp1)
1963                  
1964    c$$$               print*,'(1) ip ',ip1,' icp ',icp1
1965    
1966  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)  c               call xyz_PAM(icx1,icy1,is1,'COG2','COG2',0.,0.)!(1)
1967  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)  c               call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.) !(1)
1968                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)                 call xyz_PAM(icx1,icy1,is1,PFAdef,PFAdef,0.,0.,0.,0.)
1969                 xm1=xPAM                 xm1=xPAM
1970                 ym1=yPAM                 ym1=yPAM
1971                 zm1=zPAM                                   zm1=zPAM                  
 c     print*,'***',is1,xm1,ym1,zm1  
1972    
1973                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
1974    c$$$                  print*,'(2) ip ',ip2
1975    c$$$     $                 ,mask_view(nviewx(ip2))
1976    c$$$     $                 ,mask_view(nviewy(ip2))
1977                    if(  mask_view(nviewx(ip2)).ne.0 .or.                    if(  mask_view(nviewx(ip2)).ne.0 .or.
1978       $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane       $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
1979                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    
                       
1980                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2
1981                          icx2=clx(ip2,icp2)                          icx2=clx(ip2,icp2)
1982                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
1983    
1984    c$$$                        print*,'(2) ip ',ip2,' icp ',icp2
1985    
1986  c                        call xyz_PAM  c                        call xyz_PAM
1987  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)  c     $                       (icx2,icy2,is2,'COG2','COG2',0.,0.)!(1)
1988  c                        call xyz_PAM  c                        call xyz_PAM
# Line 1682  c     $                       (icx2,icy2 Line 1992  c     $                       (icx2,icy2
1992                          xm2=xPAM                          xm2=xPAM
1993                          ym2=yPAM                          ym2=yPAM
1994                          zm2=zPAM                          zm2=zPAM
1995                                                    
1996    *                       ---------------------------------------------------
1997    *                       both couples must have a y-cluster
1998    *                       (condition necessary when in RECOVER_SINGLETS mode)
1999    *                       ---------------------------------------------------
2000                            if(icy1.eq.0.or.icy2.eq.0)goto 111
2001    
2002                            if(cl_used(icy1).ne.0)goto 111
2003                            if(cl_used(icy2).ne.0)goto 111
2004    
2005                            
2006  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2007  *     track parameters on Y VIEW  *     track parameters on Y VIEW
2008  *     (2 couples needed)  *     (2 couples needed)
2009  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2010                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
2011                             if(verbose)print*,                             if(verbose.eq.1)print*,
2012       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
2013       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
2014       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
2015  c                           good2=.false.  c     good2=.false.
2016  c                           goto 880 !fill ntp and go to next event  c     goto 880 !fill ntp and go to next event
2017                             do iv=1,12                             do iv=1,12
2018                                mask_view(iv) = 3  c     mask_view(iv) = 3
2019                                  mask_view(iv) = mask_view(iv)+ 2**2
2020                             enddo                             enddo
2021                             iflag=1                             iflag=1
2022                             return                             return
2023                          endif                          endif
2024                            
2025                            
2026    ccc                        print*,'<doublet> ',icp1,icp2
2027    
2028                          ndblt = ndblt + 1                          ndblt = ndblt + 1
2029  *     store doublet info  *     store doublet info
2030                          cpyz1(ndblt)=id_cp(ip1,icp1,is1)                          cpyz1(ndblt)=id_cp(ip1,icp1,is1)
# Line 1708  c                           goto 880 !fi Line 2033  c                           goto 880 !fi
2033                          alfayz2(ndblt)=(ym1-ym2)/(zm1-zm2)                          alfayz2(ndblt)=(ym1-ym2)/(zm1-zm2)
2034  *     y0 (cm)  *     y0 (cm)
2035                          alfayz1(ndblt)=alfayz2(ndblt)*(zini-zm1)+ym1                          alfayz1(ndblt)=alfayz2(ndblt)*(zini-zm1)+ym1
2036                                                      
2037  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2038  ****  reject non phisical couples                    ****  ****  reject non phisical couples                    ****
2039  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2040                            if(SECOND_SEARCH)goto 111
2041                          if(                          if(
2042       $                       abs(alfayz2(ndblt)).gt.alfyz2_max       $                       abs(alfayz2(ndblt)).gt.alfyz2_max
2043       $                       .or.       $                       .or.
2044       $                       abs(alfayz1(ndblt)).gt.alfyz1_max       $                       abs(alfayz1(ndblt)).gt.alfyz1_max
2045       $                       )ndblt = ndblt-1       $                       )ndblt = ndblt-1
2046                                                    
2047  c$$$      if(iev.eq.33)then                          
2048  c$$$      print*,'********* ',ndblt,' -- ',icp1,icp2,is1,is2   111                    continue
 c$$$     $        ,' || ',icx1,icy1,icx2,icy2  
 c$$$     $        ,' || ',xm1,ym1,xm2,ym2  
 c$$$     $        ,' || ',alfayz2(ndblt),alfayz1(ndblt)  
 c$$$      endif  
 c$$$  
2049  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2050  *     track parameters on Y VIEW - end  *     track parameters on Y VIEW - end
2051  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2052    
2053    
2054                            if(icx1.ne.0)then
2055                               if(cl_used(icx1).ne.0)goto 31
2056                            endif
2057                            if(icx2.ne.0)then
2058                               if(cl_used(icx2).ne.0)goto 31
2059                            endif
2060    
2061                          if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples                          if(ip2.eq.nplanes)goto 31 !no possible combination with 3 couples
2062    
2063                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3                          do ip3=(ip2+1),nplanes !loop on planes - COPPIA 3
2064    c$$$                           print*,'(3) ip ',ip3
2065    c$$$     $                          ,mask_view(nviewx(ip3))
2066    c$$$     $                          ,mask_view(nviewy(ip3))                          
2067                             if(  mask_view(nviewx(ip3)).ne.0 .or.                             if(  mask_view(nviewx(ip3)).ne.0 .or.
2068       $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane       $                          mask_view(nviewy(ip3)).ne.0 )goto 30 !skip plane
2069                             do is3=1,2 !loop on sensors - COPPIA 3                             do is3=1,2 !loop on sensors - COPPIA 3
# Line 1740  c$$$ Line 2071  c$$$
2071                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3                                do icp3=1,ncp_plane(ip3) !loop on COPPIA 3
2072                                   icx3=clx(ip3,icp3)                                   icx3=clx(ip3,icp3)
2073                                   icy3=cly(ip3,icp3)                                   icy3=cly(ip3,icp3)
2074    
2075    c$$$                                 print*,'(3) ip ',ip3,' icp ',icp3
2076    
2077    *     ---------------------------------------------------
2078    *     all three couples must have a x-cluster
2079    *     (condition necessary when in RECOVER_SINGLETS mode)
2080    *     ---------------------------------------------------
2081                                     if(
2082         $                                icx1.eq.0.or.
2083         $                                icx2.eq.0.or.
2084         $                                icx3.eq.0.or.
2085         $                                .false.)goto 29
2086                                    
2087                                     if(cl_used(icx1).ne.0)goto 29
2088                                     if(cl_used(icx2).ne.0)goto 29
2089                                     if(cl_used(icx3).ne.0)goto 29
2090    
2091  c                                 call xyz_PAM  c                                 call xyz_PAM
2092  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)  c     $                               (icx3,icy3,is3,'COG2','COG2',0.,0.)!(1)
2093  c                                 call xyz_PAM  c                                 call xyz_PAM
# Line 1750  c     $                               (i Line 2098  c     $                               (i
2098                                   xm3=xPAM                                   xm3=xPAM
2099                                   ym3=yPAM                                   ym3=yPAM
2100                                   zm3=zPAM                                   zm3=zPAM
2101    
2102    
2103  *     find the circle passing through the three points  *     find the circle passing through the three points
2104                                     iflag_t = DEBUG
2105                                   call tricircle(3,xp,zp,angp,resp,chi                                   call tricircle(3,xp,zp,angp,resp,chi
2106       $                                ,xc,zc,radius,iflag)       $                                ,xc,zc,radius,iflag_t)
 c     print*,xc,zc,radius  
2107  *     the circle must intersect the reference plane  *     the circle must intersect the reference plane
2108                                   if(  cc                                 if(iflag.ne.0)goto 29
2109  c     $                                 (xc.le.-1.*xclimit.or.                                   if(iflag_t.ne.0)then
2110  c     $                                 xc.ge.xclimit).and.  *     if tricircle fails, evaluate a straight line
2111       $                                radius**2.ge.(ZINI-zc)**2.and.                                      if(DEBUG.eq.1)
2112       $                                iflag.eq.0.and.       $                                   print*,'TRICIRCLE failure'
2113       $                                .true.)then       $                                   ,' >>> straight line'
2114                                                                        radius=0.
2115                                        xc=0.
2116                                        yc=0.
2117                                        
2118                                        SZZ=0.                  
2119                                        SZX=0.
2120                                        SSX=0.
2121                                        SZ=0.
2122                                        S1=0.
2123                                        X0=0.
2124                                        Ax=0.
2125                                        BX=0.
2126                                        DO I=1,3
2127                                           XX = XP(I)
2128                                           SZZ=SZZ+ZP(I)*ZP(I)
2129                                           SZX=SZX+ZP(I)*XX
2130                                           SSX=SSX+XX
2131                                           SZ=SZ+ZP(I)
2132                                           S1=S1+1.
2133                                        ENDDO
2134                                        DET=SZZ*S1-SZ*SZ
2135                                        AX=(SZX*S1-SZ*SSX)/DET
2136                                        BX=(SZZ*SSX-SZX*SZ)/DET
2137                                        X0  = AX*ZINI+BX
2138                                        
2139                                     endif
2140    
2141                                     if(  .not.SECOND_SEARCH.and.
2142         $                                radius**2.lt.(ZINI-zc)**2)goto 29
2143                                                                      
2144  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2145  *     track parameters on X VIEW  *     track parameters on X VIEW
2146  *     (3 couples needed)  *     (3 couples needed)
2147  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2148                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
2149                                      if(verbose)print*,                                      if(verbose.eq.1)print*,
2150       $                     '** warning ** number of identified '//       $                                   '** warning **'//
2151       $                     'triplets exceeds vector dimention '       $                                   ' number of identified '//
2152       $                    ,'( ',ntrpt_max,' )'       $                                   'triplets exceeds'//
2153  c                                    good2=.false.       $                                   ' vector dimention '
2154  c                                    goto 880 !fill ntp and go to next event       $                                   ,'( ',ntrpt_max,' )'
2155    c     good2=.false.
2156    c     goto 880 !fill ntp and go to next event
2157                                      do iv=1,nviews                                      do iv=1,nviews
2158                                         mask_view(iv) = 4  c     mask_view(iv) = 4
2159                                           mask_view(iv) =
2160         $                                      mask_view(iv)+ 2**3
2161                                      enddo                                      enddo
2162                                      iflag=1                                      iflag=1
2163                                      return                                      return
2164                                   endif                                   endif
2165    
2166    ccc                                 print*,'<triplet> ',icp1,icp2,icp3
2167                                    
2168                                   ntrpt = ntrpt +1                                   ntrpt = ntrpt +1
2169  *     store triplet info  *     store triplet info
2170                                   cpxz1(ntrpt)=id_cp(ip1,icp1,is1)                                   cpxz1(ntrpt)=id_cp(ip1,icp1,is1)
2171                                   cpxz2(ntrpt)=id_cp(ip2,icp2,is2)                                   cpxz2(ntrpt)=id_cp(ip2,icp2,is2)
2172                                   cpxz3(ntrpt)=id_cp(ip3,icp3,is3)                                   cpxz3(ntrpt)=id_cp(ip3,icp3,is3)
2173                                                                    
2174                                   if(xc.lt.0)then                                   if(radius.ne.0.and.xc.lt.0)then
2175  *************POSITIVE DEFLECTION  *************POSITIVE DEFLECTION
2176                alfaxz1(ntrpt) = xc+sqrt(radius**2-(ZINI-zc)**2)               alfaxz1(ntrpt) = xc+sqrt(radius**2-(ZINI-zc)**2)
2177                alfaxz2(ntrpt) = (ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)               alfaxz2(ntrpt) = (ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)
2178                alfaxz3(ntrpt) = 1/radius               alfaxz3(ntrpt) = 1/radius
2179                                   else                                  else if(radius.ne.0.and.xc.ge.0)then
2180  *************NEGATIVE DEFLECTION  *************NEGATIVE DEFLECTION
2181                alfaxz1(ntrpt) = xc-sqrt(radius**2-(ZINI-zc)**2)               alfaxz1(ntrpt) = xc-sqrt(radius**2-(ZINI-zc)**2)
2182                alfaxz2(ntrpt) = -(ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)               alfaxz2(ntrpt) = -(ZINI-zc)/sqrt(radius**2-(ZINI-zc)**2)
2183                alfaxz3(ntrpt) = -1/radius               alfaxz3(ntrpt) = -1/radius
2184                                   endif                                  else if(radius.eq.0)then
2185                                    *************straight fit
2186                 alfaxz1(ntrpt) = X0
2187                 alfaxz2(ntrpt) = AX
2188                 alfaxz3(ntrpt) = 0.
2189                                    endif
2190    
2191    c$$$                                print*,'alfaxz1 ', alfaxz1(ntrpt)
2192    c$$$                                print*,'alfaxz2 ', alfaxz2(ntrpt)
2193    c$$$                                print*,'alfaxz3 ', alfaxz3(ntrpt)
2194                                        
2195  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2196  ****  reject non phisical triplets                   ****  ****  reject non phisical triplets                   ****
2197  ****  -----------------------------------------------****  ****  -----------------------------------------------****
2198                                   if(                                  if(SECOND_SEARCH)goto 29
2199       $                                abs(alfaxz2(ntrpt)).gt.alfxz2_max                                  if(
2200       $                                .or.       $                               abs(alfaxz2(ntrpt)).gt.
2201       $                                abs(alfaxz1(ntrpt)).gt.alfxz1_max       $                               alfxz2_max
2202       $                                )ntrpt = ntrpt-1       $                               .or.
2203                                         $                               abs(alfaxz1(ntrpt)).gt.
2204                                         $                               alfxz1_max
2205  c     print*,alfaxz1(ntrpt),alfaxz2(ntrpt),alfaxz3(ntrpt)       $                               )ntrpt = ntrpt-1
2206                                                                    
2207  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2208  *     track parameters on X VIEW - end  *     track parameters on X VIEW - end
2209  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2210                                endif                                
2211     29                           continue
2212                             enddo !end loop on COPPIA 3                             enddo !end loop on COPPIA 3
2213                          enddo   !end loop on sensors - COPPIA 3                          enddo   !end loop on sensors - COPPIA 3
2214   30                     continue   30                     continue
2215                       enddo      !end loop on planes  - COPPIA 3                       enddo      !end loop on planes  - COPPIA 3
2216   31                  continue  
2217                         31                  continue                    
2218   1                enddo         !end loop on COPPIA 2  c 1                enddo         !end loop on COPPIA 2
2219                     enddo         !end loop on COPPIA 2
2220                 enddo            !end loop on sensors - COPPIA 2                 enddo            !end loop on sensors - COPPIA 2
2221   20            continue   20            continue
2222              enddo               !end loop on planes  - COPPIA 2              enddo               !end loop on planes  - COPPIA 2
2223                
2224    c 11         continue
2225              continue
2226           enddo                  !end loop on COPPIA1           enddo                  !end loop on COPPIA1
2227        enddo                     !end loop on sensors - COPPIA 1        enddo                     !end loop on sensors - COPPIA 1
2228   10   continue   10   continue
2229        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
2230                
2231        if(DEBUG)then        if(DEBUG.EQ.1)then
2232           print*,'--- doublets ',ndblt           print*,'--- doublets ',ndblt
2233           print*,'--- triplets ',ntrpt           print*,'--- triplets ',ntrpt
2234        endif        endif
# Line 1875  c      include 'momanhough_init.f' Line 2275  c      include 'momanhough_init.f'
2275        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2276        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2277    
2278          if(DEBUG.EQ.1)print*,'doub_to_YZcloud:'
2279    
2280  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2281  *     classification of DOUBLETS  *     classification of DOUBLETS
# Line 1893  c      include 'momanhough_init.f' Line 2294  c      include 'momanhough_init.f'
2294        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2295           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
2296                            
 c     print*,'--------------'  
 c     print*,'** ',idb1,' **'  
               
2297           do icp=1,ncp_tot           do icp=1,ncp_tot
2298              cp_useds1(icp)=0    !init              cp_useds1(icp)=0    !init
2299              cp_useds2(icp)=0    !init              cp_useds2(icp)=0    !init
# Line 1931  ccccc if(db_used(idbref).eq.1)goto 1188 Line 2329  ccccc if(db_used(idbref).eq.1)goto 1188
2329  *     doublet distance in parameter space  *     doublet distance in parameter space
2330                 distance=                 distance=
2331       $              ((alfayz1(idbref)-alfayz1(idb2))/Dalfayz1)**2       $              ((alfayz1(idbref)-alfayz1(idb2))/Dalfayz1)**2
2332       $              +((alfayz2(idbref)-alfayz2(idb2))/Dalfayz2)**2                     $              +((alfayz2(idbref)-alfayz2(idb2))/Dalfayz2)**2
2333                 distance = sqrt(distance)                 distance = sqrt(distance)
2334                                
 c$$$      if(iev.eq.33)then  
 c$$$      if(distance.lt.100)  
 c$$$     $ print*,'********* ',idb1,idbref,idb2,distance  
 c$$$      if(distance.lt.100)  
 c$$$     $ print*,'********* ',alfayz1(idbref),alfayz1(idb2)  
 c$$$     $                    ,alfayz2(idbref),alfayz2(idb2)  
 c$$$      endif  
2335                 if(distance.lt.cutdistyz)then                 if(distance.lt.cutdistyz)then
2336    
 c     print*,idb1,idb2,distance,' cloud ',nclouds_yz  
2337                    if(cpyz1(idb2).gt.0)cp_useds2(cpyz1(idb2))=1                    if(cpyz1(idb2).gt.0)cp_useds2(cpyz1(idb2))=1
2338                    if(cpyz1(idb2).lt.0)cp_useds1(-cpyz1(idb2))=1                    if(cpyz1(idb2).lt.0)cp_useds1(-cpyz1(idb2))=1
2339                    if(cpyz2(idb2).gt.0)cp_useds2(cpyz2(idb2))=1                    if(cpyz2(idb2).gt.0)cp_useds2(cpyz2(idb2))=1
# Line 1959  c     print*,idb1,idb2,distance,' cloud Line 2349  c     print*,idb1,idb2,distance,' cloud
2349    
2350                    temp1 = temp1 + alfayz1(idb2)                    temp1 = temp1 + alfayz1(idb2)
2351                    temp2 = temp2 + alfayz2(idb2)                    temp2 = temp2 + alfayz2(idb2)
 c     print*,'*   idbref,idb2 ',idbref,idb2  
2352                 endif                               endif              
2353                                
2354   1118          continue   1118          continue
2355              enddo               !end loop (2) on DOUBLETS              enddo               !end loop (2) on DOUBLETS
2356                            
2357   1188       continue  c 1188       continue
2358                continue
2359           enddo                  !end loop on... bo?           enddo                  !end loop on... bo?
2360                    
2361           nptloop=npv           nptloop=npv
# Line 1982  c     print*,'*   idbref,idb2 ',idbref,i Line 2372  c     print*,'*   idbref,idb2 ',idbref,i
2372           enddo           enddo
2373           ncpused=0           ncpused=0
2374           do icp=1,ncp_tot           do icp=1,ncp_tot
2375              if(cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0)then              if(
2376         $           (cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0).and.
2377         $           .true.)then
2378                 ncpused=ncpused+1                 ncpused=ncpused+1
2379                 ip=ip_cp(icp)                 ip=ip_cp(icp)
2380                 hit_plane(ip)=1                 hit_plane(ip)=1
# Line 1992  c     print*,'*   idbref,idb2 ',idbref,i Line 2384  c     print*,'*   idbref,idb2 ',idbref,i
2384           do ip=1,nplanes           do ip=1,nplanes
2385              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2386           enddo           enddo
2387  c     print*,'>>>> ',ncpused,npt,nplused          
 c         if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  
          if(npt.lt.nptyz_min)goto 2228 !next doublet  
2388           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2389                    
2390  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2391  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2392    
2393           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2394              if(verbose)print*,              if(verbose.eq.1)print*,
2395       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2396       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2397       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2398  c               good2=.false.  c               good2=.false.
2399  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2400              do iv=1,nviews              do iv=1,nviews
2401                 mask_view(iv) = 5  c               mask_view(iv) = 5
2402                   mask_view(iv) = mask_view(iv) + 2**4
2403              enddo              enddo
2404              iflag=1              iflag=1
2405              return              return
# Line 2025  c     goto 880         !fill ntp and go Line 2416  c     goto 880         !fill ntp and go
2416  c     ptcloud_yz_nt(nclouds_yz)=npt  c     ptcloud_yz_nt(nclouds_yz)=npt
2417           do ipt=1,npt           do ipt=1,npt
2418              db_cloud(npt_tot+ipt) = db_all(ipt)              db_cloud(npt_tot+ipt) = db_all(ipt)
 c     print*,'>> ',ipt,db_all(ipt)  
2419           enddo             enddo  
2420           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2421           if(DEBUG)then           if(DEBUG.EQ.1)then
             print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'  
2422              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'
2423              print*,'- alfayz1 ',alfayz1_av(nclouds_yz)              print*,'- alfayz1  ',alfayz1_av(nclouds_yz)
2424              print*,'- alfayz2 ',alfayz2_av(nclouds_yz)              print*,'- alfayz2  ',alfayz2_av(nclouds_yz)
2425              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2426              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2427              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'cpcloud_yz '
2428  c$$$            print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '       $           ,(cpcloud_yz(nclouds_yz,icp),icp=1,ncp_tot)
2429  c$$$     $           ,ptcloud_yz(nclouds_yz)              print*,'hit_plane  ',(hit_plane(ip),ip=1,nplanes)
 c$$$            print*,'nt-uple: db_cloud(...) = '  
 c$$$     $           ,(db_cloud(iii),iii=npt_tot-npt+1,npt_tot)  
2430           endif           endif
2431  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2432  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
# Line 2053  c$$$     $           ,(db_cloud(iii),iii Line 2440  c$$$     $           ,(db_cloud(iii),iii
2440          goto 90                          goto 90                
2441        endif                            endif                    
2442                
2443        if(DEBUG)then        if(DEBUG.EQ.1)then
          print*,'---------------------- '  
2444           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
          print*,' '  
2445        endif        endif
2446                
2447                
# Line 2102  c      include 'momanhough_init.f' Line 2487  c      include 'momanhough_init.f'
2487        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2488        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2489    
2490          if(DEBUG.EQ.1)print*,'trip_to_XZcloud:'
2491    
2492  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2493  *     classification of TRIPLETS  *     classification of TRIPLETS
2494  *     according to distance in parameter space  *     according to distance in parameter space
# Line 2117  c      include 'momanhough_init.f' Line 2504  c      include 'momanhough_init.f'
2504   91   continue                     91   continue                  
2505        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2506           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
 c     print*,'--------------'  
 c     print*,'** ',itr1,' **'  
2507                    
2508           do icp=1,ncp_tot           do icp=1,ncp_tot
2509              cp_useds1(icp)=0              cp_useds1(icp)=0
# Line 2152  c         tr_temp(1)=itr1 Line 2537  c         tr_temp(1)=itr1
2537              do itr2=1,ntrpt     !loop (2) on TRIPLETS              do itr2=1,ntrpt     !loop (2) on TRIPLETS
2538                 if(itr2.eq.itr1)goto 11188       !next triplet                 if(itr2.eq.itr1)goto 11188       !next triplet
2539                 if(tr_used(itr2).eq.1)goto 11188 !next triplet                               if(tr_used(itr2).eq.1)goto 11188 !next triplet              
2540    
2541    
2542  *     triplet distance in parameter space  *     triplet distance in parameter space
2543  *     solo i due parametri spaziali per il momemnto  *     solo i due parametri spaziali per il momemnto
2544                 distance=                 distance=
2545       $              ((alfaxz1(itrref)-alfaxz1(itr2))/Dalfaxz1)**2       $              ((alfaxz1(itrref)-alfaxz1(itr2))/Dalfaxz1)**2
2546       $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2                     $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2
2547                 distance = sqrt(distance)                 distance = sqrt(distance)
2548                  
2549                 if(distance.lt.cutdistxz)then  
2550  c     print*,idb1,idb2,distance,' cloud ',nclouds_yz  *     ------------------------------------------------------------------------
2551    *     FORCE INCLUSION OF TRIPLETS COMPOSED BY SAME COUPLES, IGNORING THE IMAGE
2552    *     ------------------------------------------------------------------------
2553    *     (added in august 2007)
2554                   istrimage=0
2555                   if(
2556         $              abs(cpxz1(itrref)).eq.abs(cpxz1(itr2)).and.
2557         $              abs(cpxz2(itrref)).eq.abs(cpxz2(itr2)).and.
2558         $              abs(cpxz3(itrref)).eq.abs(cpxz3(itr2)).and.
2559         $              .true.)istrimage=1
2560    
2561                   if(distance.lt.cutdistxz.or.istrimage.eq.1)then
2562                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1
2563                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1
2564                    if(cpxz2(itr2).gt.0)cp_useds2(cpxz2(itr2))=1                    if(cpxz2(itr2).gt.0)cp_useds2(cpxz2(itr2))=1
# Line 2179  c     print*,idb1,idb2,distance,' cloud Line 2577  c     print*,idb1,idb2,distance,' cloud
2577                    temp1 = temp1 + alfaxz1(itr2)                    temp1 = temp1 + alfaxz1(itr2)
2578                    temp2 = temp2 + alfaxz2(itr2)                    temp2 = temp2 + alfaxz2(itr2)
2579                    temp3 = temp3 + alfaxz3(itr2)                    temp3 = temp3 + alfaxz3(itr2)
 c     print*,'*   itrref,itr2 ',itrref,itr2,distance  
2580                 endif                               endif              
2581                                
2582  11188          continue  11188          continue
2583              enddo               !end loop (2) on TRIPLETS              enddo               !end loop (2) on TRIPLETS
2584                                                
2585  11888       continue  c11888       continue
2586                continue
2587           enddo                  !end loop on... bo?               enddo                  !end loop on... bo?    
2588                    
2589           nptloop=npv           nptloop=npv
# Line 2200  c     print*,'*   itrref,itr2 ',itrref,i Line 2598  c     print*,'*   itrref,itr2 ',itrref,i
2598  *     1bis)  *     1bis)
2599  *     2) it is not already stored  *     2) it is not already stored
2600  *     ------------------------------------------  *     ------------------------------------------
 c     print*,'check cp_used'  
2601           do ip=1,nplanes           do ip=1,nplanes
2602              hit_plane(ip)=0              hit_plane(ip)=0
2603           enddo           enddo
2604           ncpused=0           ncpused=0
2605           do icp=1,ncp_tot           do icp=1,ncp_tot
2606              if(cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0)then              if(
2607         $           (cp_useds1(icp).ne.0.or.cp_useds2(icp).ne.0).and.
2608         $           .true.)then
2609                 ncpused=ncpused+1                 ncpused=ncpused+1
2610                 ip=ip_cp(icp)                 ip=ip_cp(icp)
2611                 hit_plane(ip)=1                 hit_plane(ip)=1
# Line 2216  c     print*,'check cp_used' Line 2615  c     print*,'check cp_used'
2615           do ip=1,nplanes           do ip=1,nplanes
2616              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2617           enddo           enddo
2618  c         if(ncpused.lt.ncpxz_min)goto 22288 !next triplet           if(nplused.lt.nplxz_min)goto 22288 !next triplet
          if(npt.lt.nptxz_min)goto 22288     !next triplet  
          if(nplused.lt.nplxz_min)goto 22288 !next doublet  
2619                    
2620  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2621  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2622           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2623              if(verbose)print*,              if(verbose.eq.1)print*,
2624       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2625       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2626       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2627  c     good2=.false.  c     good2=.false.
2628  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2629              do iv=1,nviews              do iv=1,nviews
2630                 mask_view(iv) = 6  c               mask_view(iv) = 6
2631                   mask_view(iv) =  mask_view(iv) + 2**5
2632              enddo              enddo
2633              iflag=1              iflag=1
2634              return              return
# Line 2249  c     goto 880         !fill ntp and go Line 2647  c     goto 880         !fill ntp and go
2647           enddo           enddo
2648           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2649                    
2650           if(DEBUG)then           if(DEBUG.EQ.1)then
2651              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'              print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'
2652              print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'                            print*,'- alfaxz1  ',alfaxz1_av(nclouds_xz)
2653              print*,'- alfaxz1 ',alfaxz1_av(nclouds_xz)              print*,'- alfaxz2  ',alfaxz2_av(nclouds_xz)
2654              print*,'- alfaxz2 ',alfaxz2_av(nclouds_xz)              print*,'- alfaxz3  ',alfaxz3_av(nclouds_xz)
2655              print*,'- alfaxz3 ',alfaxz3_av(nclouds_xz)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2656              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2657              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cpcloud_xz '
2658         $           ,(cpcloud_xz(nclouds_xz,icp),icp=1,ncp_tot)
2659              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)
 c$$$            print*,'nt-uple: ptcloud_xz(',nclouds_xz,') = '  
 c$$$     $           ,ptcloud_xz(nclouds_xz)  
 c$$$            print*,'nt-uple: tr_cloud(...) = '  
 c$$$     $           ,(tr_cloud(iii),iii=npt_tot-npt+1,npt_tot)  
2660           endif           endif
2661  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2662  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
# Line 2274  c$$$     $           ,(tr_cloud(iii),iii Line 2669  c$$$     $           ,(tr_cloud(iii),iii
2669           goto 91                           goto 91                
2670         endif                             endif                    
2671                
2672        if(DEBUG)then        if(DEBUG.EQ.1)then
          print*,'---------------------- '  
2673           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
          print*,' '  
2674        endif        endif
2675                
2676                
# Line 2295  c$$$     $           ,(tr_cloud(iii),iii Line 2688  c$$$     $           ,(tr_cloud(iii),iii
2688  **************************************************  **************************************************
2689    
2690        subroutine clouds_to_ctrack(iflag)        subroutine clouds_to_ctrack(iflag)
 c*****************************************************  
 c     02/02/2006 modified by Elena Vannuccini --> (1)  
 c*****************************************************  
2691    
2692        include 'commontracker.f'        include 'commontracker.f'
2693        include 'level1.f'        include 'level1.f'
# Line 2305  c*************************************** Line 2695  c***************************************
2695        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2696        include 'common_mini_2.f'        include 'common_mini_2.f'
2697        include 'common_mech.f'        include 'common_mech.f'
2698  c      include 'momanhough_init.f'  
2699    
2700    
2701  *     output flag  *     output flag
# Line 2329  c      include 'momanhough_init.f' Line 2719  c      include 'momanhough_init.f'
2719  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2720  *     variables for track fitting  *     variables for track fitting
2721        double precision AL_INI(5)        double precision AL_INI(5)
 c      double precision tath  
2722  *     -----------------------------------------------------------  *     -----------------------------------------------------------
 c      real fitz(nplanes)        !z coordinates of the planes in cm  
2723    
2724          if(DEBUG.EQ.1)print*,'clouds_to_ctrack:'
2725    
2726    
2727        ntracks=0                 !counter of track candidates        ntracks=0                 !counter of track candidates
2728                
2729        do iyz=1,nclouds_yz       !loop on YZ couds        do iyz=1,nclouds_yz       !loop on YZ clouds
2730           do ixz=1,nclouds_xz    !loop on XZ couds           do ixz=1,nclouds_xz    !loop on XZ clouds
2731                            
2732  *     --------------------------------------------------  *     --------------------------------------------------
2733  *     check of consistency of the clouds  *     check of consistency of the clouds
# Line 2347  c      real fitz(nplanes)        !z coor Line 2736  c      real fitz(nplanes)        !z coor
2736  *     of the two clouds  *     of the two clouds
2737  *     --------------------------------------------------  *     --------------------------------------------------
2738              do ip=1,nplanes              do ip=1,nplanes
2739                 hit_plane(ip)=0                 hit_plane(ip)=0  !n.matching couples (REAL couples, not SINGLETS)
2740                 ncp_match(ip)=0                 ncp_match(ip)=0  !n.matching couples per plane
2741                 do icpp=1,ncouplemax                 do icpp=1,ncouplemax
2742                    cp_match(ip,icpp)=0 !init couple list                    cp_match(ip,icpp)=0 !init couple list
2743                 enddo                 enddo
2744              enddo              enddo
2745              ncp_ok=0              ncp_ok=0            !count n.matching-couples
2746              do icp=1,ncp_tot    !loop on couples              ncpx_ok=0           !count n.matching-couples with x cluster
2747  *     get info on              ncpy_ok=0           !count n.matching-couples with y cluster
2748                 cpintersec(icp)=min(  
2749       $              cpcloud_yz(iyz,icp),  
2750       $              cpcloud_xz(ixz,icp))              do icp=1,ncp_tot    !loop over couples
2751                 if(  
2752       $    (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.                 if(.not.RECOVER_SINGLETS)then
2753       $    (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.  *     ------------------------------------------------------
2754       $              .false.)cpintersec(icp)=0  *     if NOT in RECOVER_SINGLETS mode, take the intersection
2755    *     between xz yz clouds
2756    *     ------------------------------------------------------
2757                      cpintersec(icp)=min(
2758         $                 cpcloud_yz(iyz,icp),
2759         $                 cpcloud_xz(ixz,icp))
2760    *     cpintersec is >0 if yz and xz clouds contain the same image of couple icp
2761    *     ------------------------------------------------------
2762    *     discard the couple if the sensor is in conflict
2763    *     ------------------------------------------------------
2764                      if(
2765         $       (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.
2766         $       (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.
2767         $                 .false.)cpintersec(icp)=0
2768                   else
2769    *     ------------------------------------------------------
2770    *     if RECOVER_SINGLETS take the union
2771    *     (otherwise the fake couples formed by singlets would be
2772    *     discarded)    
2773    *     ------------------------------------------------------
2774                      cpintersec(icp)=max(
2775         $                 cpcloud_yz(iyz,icp),
2776         $                 cpcloud_xz(ixz,icp))
2777    c$$$                  if(cpcloud_yz(iyz,icp).gt.0)
2778    c$$$     $                 cpintersec(icp)=cpcloud_yz(iyz,icp)
2779    *     cpintersec is >0 if either yz or xz cloud contains the couple icp
2780                   endif
2781    
2782    c$$$               print*,icp,ip_cp(icp),' -- ',cpintersec(icp)
2783    
2784                 if(cpintersec(icp).ne.0)then                 if(cpintersec(icp).ne.0)then
                   ncp_ok=ncp_ok+1    
2785                                        
2786                    ip=ip_cp(icp)                    ip=ip_cp(icp)
2787                    hit_plane(ip)=1                    hit_plane(ip)=1
2788    c$$$                  if(clx(ip,icp).gt.0.and.cly(ip,icp).gt.0)
2789    c$$$     $                 ncp_ok=ncp_ok+1  
2790    c$$$                  if(clx(ip,icp).gt.0.and.cly(ip,icp).eq.0)
2791    c$$$     $                 ncpx_ok=ncpx_ok+1
2792    c$$$                  if(clx(ip,icp).eq.0.and.cly(ip,icp).gt.0)
2793    c$$$     $                 ncpy_ok=ncpy_ok+1
2794    
2795                      if(  cpcloud_yz(iyz,icp).gt.0.and.
2796         $                 cpcloud_xz(ixz,icp).gt.0)
2797         $                 ncp_ok=ncp_ok+1  
2798                      if(  cpcloud_yz(iyz,icp).gt.0.and.
2799         $                 cpcloud_xz(ixz,icp).eq.0)
2800         $                 ncpy_ok=ncpy_ok+1  
2801                      if(  cpcloud_yz(iyz,icp).eq.0.and.
2802         $                 cpcloud_xz(ixz,icp).gt.0)
2803         $                 ncpx_ok=ncpx_ok+1  
2804    
2805                    if(cpintersec(icp).eq.1)then                    if(cpintersec(icp).eq.1)then
2806  *     1) only the couple image in sensor 1 matches  *     1) only the couple image in sensor 1 matches
2807                       id=-icp                       id=-icp
# Line 2394  c      real fitz(nplanes)        !z coor Line 2828  c      real fitz(nplanes)        !z coor
2828              do ip=1,nplanes              do ip=1,nplanes
2829                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2830              enddo              enddo
               
 c            if(nplused.lt.nplxz_min)goto 888 !next doublet  
             if(nplused.lt.nplyz_min)goto 888 !next doublet  
             if(ncp_ok.lt.ncpok)goto 888 !next cloud  
               
             if(DEBUG)then  
                print*,'Combination ',iyz,ixz  
      $              ,' db ',ptcloud_yz(iyz)  
      $              ,' tr ',ptcloud_xz(ixz)  
      $              ,'  -----> # matching couples ',ncp_ok  
             endif  
 c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  
 c$$$  print*,'Configurazione cluster XZ'  
 c$$$  print*,'1 -- ',(clx(1,i),i=1,ncp_plane(1))  
 c$$$  print*,'2 -- ',(clx(2,i),i=1,ncp_plane(1))  
 c$$$  print*,'3 -- ',(clx(3,i),i=1,ncp_plane(1))  
 c$$$  print*,'4 -- ',(clx(4,i),i=1,ncp_plane(1))  
 c$$$  print*,'5 -- ',(clx(5,i),i=1,ncp_plane(1))  
 c$$$  print*,'6 -- ',(clx(6,i),i=1,ncp_plane(1))  
 c$$$  print*,'Configurazione cluster YZ'  
 c$$$  print*,'1 -- ',(cly(1,i),i=1,ncp_plane(1))  
 c$$$  print*,'2 -- ',(cly(2,i),i=1,ncp_plane(1))  
 c$$$  print*,'3 -- ',(cly(3,i),i=1,ncp_plane(1))  
 c$$$  print*,'4 -- ',(cly(4,i),i=1,ncp_plane(1))  
 c$$$  print*,'5 -- ',(cly(5,i),i=1,ncp_plane(1))  
 c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_plane(1))  
 c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  
               
 *     -------> INITIAL GUESS <-------  
 cccc       SBAGLIATO  
 c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))  
 c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))  
 c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))  
 c$$$     $           /dreal(alfaxz2_av(ixz)))  
 c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))  
 c$$$            AL_INI(3) = tath/sqrt(1+tath**2)  
 c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.  
 cccc       GIUSTO (ma si sua guess())  
 c$$$            AL_INI(1) = dreal(alfaxz1_av(ixz))  
 c$$$            AL_INI(2) = dreal(alfayz1_av(iyz))  
 c$$$            tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))  
 c$$$            AL_INI(3) = tath/sqrt(1+tath**2)  
 c$$$            IF(alfaxz2_av(ixz).NE.0)THEN  
 c$$$            AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))  
 c$$$     $           /dreal(alfaxz2_av(ixz)))  
 c$$$            ELSE  
 c$$$               AL_INI(4) = acos(-1.)/2  
 c$$$               IF(alfayz2_av(iyz).LT.0)AL_INI(4) = AL_INI(4)+acos(-1.)  
 c$$$            ENDIF  
 c$$$            IF(alfaxz2_av(ixz).LT.0)AL_INI(4)= acos(-1.)+ AL_INI(4)  
 c$$$            AL_INI(4) = -acos(-1.) + AL_INI(4) !from incidence direction to tracking rs  
 c$$$              
 c$$$            AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.  
 c$$$              
 c$$$            if(AL_INI(5).gt.defmax)goto 888 !next cloud  
2831                                                    
2832              if(DEBUG)then              if(nplused.lt.3)goto 888 !next combination
2833    ccc            if(nplused.lt.nplxz_min)goto 888 !next combination
2834    ccc            if(nplused.lt.nplyz_min)goto 888 !next combination
2835    *     -----------------------------------------------------------
2836    *     if in RECOVER_SINGLET mode, the two clouds must have
2837    *     at least ONE intersecting real couple
2838    *     -----------------------------------------------------------
2839                if(ncp_ok.lt.1)goto 888 !next combination
2840    
2841                if(DEBUG.EQ.1)then
2842                   print*,'////////////////////////////'
2843                   print*,'Cloud combination (Y,X): ',iyz,ixz
2844                   print*,' db ',ptcloud_yz(iyz)
2845                   print*,' tr ',ptcloud_xz(ixz)
2846                   print*,'  -----> # matching couples ',ncp_ok
2847                   print*,'  -----> # fake couples (X)',ncpx_ok
2848                   print*,'  -----> # fake couples (Y)',ncpy_ok
2849                   do icp=1,ncp_tot
2850                      print*,'cp ',icp,' >'
2851         $                 ,' x ',cpcloud_xz(ixz,icp)
2852         $                 ,' y ',cpcloud_yz(iyz,icp)
2853         $                 ,' ==> ',cpintersec(icp)
2854                   enddo
2855                endif
2856                            
2857                if(DEBUG.EQ.1)then
2858                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2859                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))
2860                 print*,'3 >>> ',(cp_match(4,i),i=1,ncp_match(4))                 print*,'3 >>> ',(cp_match(4,i),i=1,ncp_match(4))
# Line 2483  c$$$            if(AL_INI(5).gt.defmax)g Line 2887  c$$$            if(AL_INI(5).gt.defmax)g
2887                                hit_plane(6)=icp6                                hit_plane(6)=icp6
2888                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6
2889                                                                
2890                                                                if(DEBUG.eq.1)
2891         $                             print*,'combination: '
2892         $                             ,cp_match(6,icp1)
2893         $                             ,cp_match(5,icp2)
2894         $                             ,cp_match(4,icp3)
2895         $                             ,cp_match(3,icp4)
2896         $                             ,cp_match(2,icp5)
2897         $                             ,cp_match(1,icp6)
2898    
2899    
2900    *                             ---------------------------------------
2901    *                             check if this group of couples has been
2902    *                             already fitted    
2903    *                             ---------------------------------------
2904                                  do ica=1,ntracks
2905                                     isthesame=1
2906                                     do ip=1,NPLANES
2907                                        if(hit_plane(ip).ne.0)then
2908                                           if(  CP_STORE(nplanes-ip+1,ica)
2909         $                                      .ne.
2910         $                                      cp_match(ip,hit_plane(ip)) )
2911         $                                      isthesame=0
2912                                        else
2913                                           if(  CP_STORE(nplanes-ip+1,ica)
2914         $                                      .ne.
2915         $                                      0 )
2916         $                                      isthesame=0
2917                                        endif
2918                                     enddo
2919                                     if(isthesame.eq.1)then
2920                                        if(DEBUG.eq.1)
2921         $                                   print*,'(already fitted)'
2922                                        goto 666 !jump to next combination
2923                                     endif
2924                                  enddo
2925    
2926                                call track_init !init TRACK common                                call track_init !init TRACK common
2927    
2928                                do ip=1,nplanes !loop on planes                                do ip=1,nplanes !loop on planes (bottom to top)
2929                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2930                                      id=cp_match(ip,hit_plane(ip))                                      id=cp_match(ip,hit_plane(ip))
2931                                      is=is_cp(id)                                      is=is_cp(id)
# Line 2506  c     $                                 Line 2945  c     $                                
2945       $                                   PFAdef,PFAdef,0.,0.,0.,0.)       $                                   PFAdef,PFAdef,0.,0.,0.,0.)
2946  *                                   *************************  *                                   *************************
2947  *                                   -----------------------------  *                                   -----------------------------
2948                                      xgood(nplanes-ip+1)=1.                                      if(icx.gt.0.and.icy.gt.0)then
2949                                      ygood(nplanes-ip+1)=1.                                         xgood(nplanes-ip+1)=1.
2950                                      xm(nplanes-ip+1)=xPAM                                         ygood(nplanes-ip+1)=1.
2951                                      ym(nplanes-ip+1)=yPAM                                         xm(nplanes-ip+1)=xPAM
2952                                      zm(nplanes-ip+1)=zPAM                                         ym(nplanes-ip+1)=yPAM
2953                                      resx(nplanes-ip+1)=resxPAM                                         zm(nplanes-ip+1)=zPAM
2954                                      resy(nplanes-ip+1)=resyPAM                                         resx(nplanes-ip+1)=resxPAM
2955                                           resy(nplanes-ip+1)=resyPAM
2956                                           if(DEBUG.EQ.1)print*,'(X,Y)'
2957         $                                      ,nplanes-ip+1,xPAM,yPAM
2958                                        else
2959                                           xm_A(nplanes-ip+1) = xPAM_A
2960                                           ym_A(nplanes-ip+1) = yPAM_A
2961                                           xm_B(nplanes-ip+1) = xPAM_B
2962                                           ym_B(nplanes-ip+1) = yPAM_B
2963                                           zm(nplanes-ip+1)
2964         $                                      = (zPAM_A+zPAM_B)/2.
2965                                           resx(nplanes-ip+1) = resxPAM
2966                                           resy(nplanes-ip+1) = resyPAM
2967                                           if(icx.eq.0.and.icy.gt.0)then
2968                                              xgood(nplanes-ip+1)=0.
2969                                              ygood(nplanes-ip+1)=1.
2970                                              resx(nplanes-ip+1) = 1000.
2971                                              if(DEBUG.EQ.1)print*,'(  Y)'
2972         $                                         ,nplanes-ip+1,xPAM,yPAM
2973                                           elseif(icx.gt.0.and.icy.eq.0)then
2974                                              xgood(nplanes-ip+1)=1.
2975                                              ygood(nplanes-ip+1)=0.
2976                                              if(DEBUG.EQ.1)print*,'(X  )'
2977         $                                         ,nplanes-ip+1,xPAM,yPAM
2978                                              resy(nplanes-ip+1) = 1000.
2979                                           else
2980                                              print*,'both icx=0 and icy=0'
2981         $                                         ,' ==> IMPOSSIBLE!!'
2982                                           endif
2983                                        endif
2984  *                                   -----------------------------  *                                   -----------------------------
2985                                   endif                                   endif
2986                                enddo !end loop on planes                                enddo !end loop on planes
# Line 2530  c$$$                              enddo Line 2998  c$$$                              enddo
2998                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
2999                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
3000                                iprint=0                                iprint=0
3001  c                              if(DEBUG)iprint=1  c                              if(DEBUG.EQ.1)iprint=1
3002                                if(DEBUG)iprint=2                                if(DEBUG.EQ.1)iprint=2
3003                                call mini2(jstep,ifail,iprint)                                call mini2(jstep,ifail,iprint)
3004                                if(ifail.ne.0) then                                if(ifail.ne.0) then
3005                                   if(DEBUG)then                                   if(DEBUG.EQ.1)then
3006                                      print *,                                      print *,
3007       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
3008       $                              //'(clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
# Line 2553  c                                 chi2=- Line 3021  c                                 chi2=-
3021  *     **********************************************************  *     **********************************************************
3022    
3023                                if(chi2.le.0.)goto 666                                              if(chi2.le.0.)goto 666              
3024                                  if(chi2.ge.1.e08)goto 666 !OPTIMIZATION
3025                                  if(chi2.ne.chi2)goto 666  !OPTIMIZATION
3026    
3027  *     --------------------------  *     --------------------------
3028  *     STORE candidate TRACK INFO  *     STORE candidate TRACK INFO
3029  *     --------------------------  *     --------------------------
3030                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
3031                                                                    
3032                                   if(verbose)print*,                                   if(verbose.eq.1)print*,
3033       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
3034       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
3035       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
3036  c                                 good2=.false.  c                                 good2=.false.
3037  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
3038                                   do iv=1,nviews                                   do iv=1,nviews
3039                                      mask_view(iv) = 7  c                                    mask_view(iv) = 7
3040                                        mask_view(iv) = mask_view(iv) + 2**6
3041                                   enddo                                   enddo
3042                                   iflag=1                                   iflag=1
3043                                   return                                   return
# Line 2574  c                                 goto 8 Line 3045  c                                 goto 8
3045                                                                
3046                                ntracks = ntracks + 1                                ntracks = ntracks + 1
3047                                                                
3048  c$$$                              ndof=0                                                                do ip=1,nplanes !top to bottom
3049                                do ip=1,nplanes  
 c$$$                                 ndof=ndof  
 c$$$     $                                +int(xgood(ip))  
 c$$$     $                                +int(ygood(ip))  
3050                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
3051                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
3052                                   ZV_STORE(ip,ntracks)=sngl(zv(ip))                                                                       ZV_STORE(ip,ntracks)=sngl(zv(ip))
3053                                   XM_STORE(ip,ntracks)=sngl(xm(ip))                                   XM_STORE(ip,ntracks)=sngl(xm(ip))
3054                                   YM_STORE(ip,ntracks)=sngl(ym(ip))                                   YM_STORE(ip,ntracks)=sngl(ym(ip))
3055                                   ZM_STORE(ip,ntracks)=sngl(zm(ip))                                   ZM_STORE(ip,ntracks)=sngl(zm(ip))
# Line 2594  c$$$     $                               Line 3062  c$$$     $                              
3062                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))
3063                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))
3064                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))
3065    *                                NB! hit_plane is defined from bottom to top
3066                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
3067                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
3068       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
3069                                        SENSOR_STORE(nplanes-ip+1,ntracks)
3070         $                              = is_cp(cp_match(ip,hit_plane(ip)))
3071                                        
3072                                        icl=
3073         $                                   clx(ip,icp_cp(
3074         $                                   cp_match(ip,hit_plane(ip)
3075         $                                   )));
3076                                        if(icl.eq.0)
3077         $                                   icl=
3078         $                                   cly(ip,icp_cp(
3079         $                                   cp_match(ip,hit_plane(ip)
3080         $                                   )));
3081    
3082                                        LADDER_STORE(nplanes-ip+1,ntracks)
3083         $                                   = LADDER(icl);
3084                                   else                                   else
3085                                      CP_STORE(nplanes-ip+1,ntracks)=0                                      CP_STORE(nplanes-ip+1,ntracks)=0
3086                                        SENSOR_STORE(nplanes-ip+1,ntracks)=0
3087                                        LADDER_STORE(nplanes-ip+1,ntracks)=0
3088                                   endif                                   endif
3089                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   BX_STORE(ip,ntracks)=0!I dont need it now
3090                                     BY_STORE(ip,ntracks)=0!I dont need it now
3091                                     CLS_STORE(ip,ntracks)=0
3092                                   do i=1,5                                   do i=1,5
3093                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
3094                                   enddo                                   enddo
3095                                enddo                                enddo
3096                                                                
 c$$$  *                             Number of Degree Of Freedom  
 c$$$  ndof=ndof-5                            
 c$$$  *                             reduced chi^2  
 c$$$  rchi2=chi2/dble(ndof)  
3097                                RCHI2_STORE(ntracks)=chi2                                RCHI2_STORE(ntracks)=chi2
3098                                                                
3099  *     --------------------------------  *     --------------------------------
# Line 2630  c$$$  rchi2=chi2/dble(ndof) Line 3114  c$$$  rchi2=chi2/dble(ndof)
3114                
3115        if(ntracks.eq.0)then        if(ntracks.eq.0)then
3116           iflag=1           iflag=1
3117           return  cc         return
3118        endif        endif
3119                
3120        if(DEBUG)then        if(DEBUG.EQ.1)then
3121           print*,'****** TRACK CANDIDATES ***********'          print*,'****** TRACK CANDIDATES *****************'
3122           print*,'#         R. chi2        RIG'          print*,'#         R. chi2        RIG         ndof'
3123           do i=1,ntracks          do i=1,ntracks
3124              print*,i,' --- ',rchi2_store(i),' --- '            ndof=0                !(1)
3125       $           ,1./abs(AL_STORE(5,i))            do ii=1,nplanes       !(1)
3126           enddo              ndof=ndof           !(1)
3127           print*,'***********************************'       $           +int(xgood_store(ii,i)) !(1)
3128         $           +int(ygood_store(ii,i)) !(1)
3129              enddo                 !(1)
3130              print*,i,' --- ',rchi2_store(i),' --- '
3131         $         ,1./abs(AL_STORE(5,i)),' --- ',ndof
3132            enddo
3133            print*,'*****************************************'
3134        endif        endif
3135                
3136                
# Line 2659  c$$$  rchi2=chi2/dble(ndof) Line 3149  c$$$  rchi2=chi2/dble(ndof)
3149    
3150        subroutine refine_track(ibest)        subroutine refine_track(ibest)
3151    
 c******************************************************  
 cccccc 06/10/2005 modified by elena vannuccini ---> (1)  
 cccccc 31/01/2006 modified by elena vannuccini ---> (2)  
 cccccc 12/08/2006 modified by elena vannucicni ---> (3)  
 c******************************************************  
3152    
3153        include 'commontracker.f'        include 'commontracker.f'
3154        include 'level1.f'        include 'level1.f'
# Line 2671  c*************************************** Line 3156  c***************************************
3156        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3157        include 'common_mini_2.f'        include 'common_mini_2.f'
3158        include 'common_mech.f'        include 'common_mech.f'
 c      include 'momanhough_init.f'  
 c      include 'level1.f'  
3159        include 'calib.f'        include 'calib.f'
3160    
3161  *     flag to chose PFA  *     flag to chose PFA
3162        character*10 PFA        character*10 PFA
3163        common/FINALPFA/PFA        common/FINALPFA/PFA
3164    
3165          real k(6)
3166          DATA k/1.099730,0.418900,0.220939,0.220907,0.418771,1.100674/
3167    
3168        real xp,yp,zp        real xp,yp,zp
3169        real xyzp(3),bxyz(3)        real xyzp(3),bxyz(3)
3170        equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))        equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
3171    
3172          if(DEBUG.EQ.1)print*,'refine_track:'
3173  *     =================================================  *     =================================================
3174  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
3175  *                          and  *                          and
# Line 2691  c      include 'level1.f' Line 3178  c      include 'level1.f'
3178        call track_init        call track_init
3179        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3180    
3181             if(DEBUG.EQ.1)print*,' ........... plane ',ip,' ........... '
3182    
3183           xP=XV_STORE(nplanes-ip+1,ibest)           xP=XV_STORE(nplanes-ip+1,ibest)
3184           yP=YV_STORE(nplanes-ip+1,ibest)           yP=YV_STORE(nplanes-ip+1,ibest)
3185           zP=ZV_STORE(nplanes-ip+1,ibest)           zP=ZV_STORE(nplanes-ip+1,ibest)
3186           call gufld(xyzp,bxyz)           call gufld(xyzp,bxyz)
3187  c$$$         bxyz(1)=0           BX_STORE(nplanes-ip+1,ibest)=bxyz(1)
3188             BY_STORE(nplanes-ip+1,ibest)=bxyz(2)
3189    c$$$  bxyz(1)=0
3190  c$$$         bxyz(2)=0  c$$$         bxyz(2)=0
3191  c$$$         bxyz(3)=0  c$$$         bxyz(3)=0
3192  *     |||||||||||||||||||||||||||||||||||||||||||||||||  *     |||||||||||||||||||||||||||||||||||||||||||||||||
# Line 2705  c$$$         bxyz(3)=0 Line 3196  c$$$         bxyz(3)=0
3196  *     using improved PFAs  *     using improved PFAs
3197  *     -------------------------------------------------  *     -------------------------------------------------
3198  *     |||||||||||||||||||||||||||||||||||||||||||||||||  *     |||||||||||||||||||||||||||||||||||||||||||||||||
3199           if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.  c$$$         if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..and.
3200    c$$$     $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
3201    c$$$            
3202    c$$$            id=CP_STORE(nplanes-ip+1,ibest)
3203    c$$$            
3204    c$$$            is=is_cp(id)
3205    c$$$            icp=icp_cp(id)
3206    c$$$            if(ip_cp(id).ne.ip)
3207    c$$$     $           print*,'OKKIO!!'
3208    c$$$     $           ,'id ',id,is,icp
3209    c$$$     $           ,ip_cp(id),ip
3210    c$$$            icx=clx(ip,icp)
3211    c$$$            icy=cly(ip,icp)
3212    c$$$c            call xyz_PAM(icx,icy,is,
3213    c$$$c     $           PFA,PFA,
3214    c$$$c     $           AXV_STORE(nplanes-ip+1,ibest),
3215    c$$$c     $           AYV_STORE(nplanes-ip+1,ibest))
3216    c$$$            call xyz_PAM(icx,icy,is,
3217    c$$$     $           PFA,PFA,
3218    c$$$     $           AXV_STORE(nplanes-ip+1,ibest),
3219    c$$$     $           AYV_STORE(nplanes-ip+1,ibest),
3220    c$$$     $           bxyz(1),
3221    c$$$     $           bxyz(2)
3222    c$$$     $           )
3223    c$$$
3224    c$$$            xm(nplanes-ip+1) = xPAM
3225    c$$$            ym(nplanes-ip+1) = yPAM
3226    c$$$            zm(nplanes-ip+1) = zPAM
3227    c$$$            xgood(nplanes-ip+1) = 1
3228    c$$$            ygood(nplanes-ip+1) = 1
3229    c$$$            resx(nplanes-ip+1) = resxPAM
3230    c$$$            resy(nplanes-ip+1) = resyPAM
3231    c$$$
3232    c$$$            dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3233    c$$$            dedxtrk_y(nplanes-ip+1)=sgnl(icy)/mip(VIEW(icy),LADDER(icy))
3234             if(XGOOD_STORE(nplanes-ip+1,ibest).eq.1..or.
3235       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then       $        YGOOD_STORE(nplanes-ip+1,ibest).eq.1. )then
3236                            
3237              id=CP_STORE(nplanes-ip+1,ibest)              id=CP_STORE(nplanes-ip+1,ibest)
# Line 2729  c     $           AYV_STORE(nplanes-ip+1 Line 3255  c     $           AYV_STORE(nplanes-ip+1
3255       $           bxyz(1),       $           bxyz(1),
3256       $           bxyz(2)       $           bxyz(2)
3257       $           )       $           )
3258  c$$$  call xyz_PAM(icx,icy,is,  
3259  c$$$  $              'COG2','COG2',              if(icx.gt.0.and.icy.gt.0)then
3260  c$$$  $              0.,                 xm(nplanes-ip+1) = xPAM
3261  c$$$  $              0.)                 ym(nplanes-ip+1) = yPAM
3262              xm(nplanes-ip+1) = xPAM                 zm(nplanes-ip+1) = zPAM
3263              ym(nplanes-ip+1) = yPAM                 xm_A(nplanes-ip+1) = 0.
3264              zm(nplanes-ip+1) = zPAM                 ym_A(nplanes-ip+1) = 0.
3265              xgood(nplanes-ip+1) = 1                 xm_B(nplanes-ip+1) = 0.
3266              ygood(nplanes-ip+1) = 1                 ym_B(nplanes-ip+1) = 0.
3267              resx(nplanes-ip+1) = resxPAM                 xgood(nplanes-ip+1) = 1
3268              resy(nplanes-ip+1) = resyPAM                 ygood(nplanes-ip+1) = 1
3269                   resx(nplanes-ip+1) = resxPAM
3270  c            dedxtrk(nplanes-ip+1) = (sgnl(icx)+sgnl(icy))/2. !(1)                 resy(nplanes-ip+1) = resyPAM
3271              dedxtrk_x(nplanes-ip+1)=sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                 dedxtrk_x(nplanes-ip+1)=
3272              dedxtrk_y(nplanes-ip+1)=sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)       $              sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3273                   dedxtrk_y(nplanes-ip+1)=
3274         $              sgnl(icy)/mip(VIEW(icy),LADDER(icy))
3275                else
3276                   xm(nplanes-ip+1) = 0.
3277                   ym(nplanes-ip+1) = 0.
3278                   zm(nplanes-ip+1) = (zPAM_A+zPAM_B)/2.
3279                   xm_A(nplanes-ip+1) = xPAM_A
3280                   ym_A(nplanes-ip+1) = yPAM_A
3281                   xm_B(nplanes-ip+1) = xPAM_B
3282                   ym_B(nplanes-ip+1) = yPAM_B
3283                   xgood(nplanes-ip+1) = 0
3284                   ygood(nplanes-ip+1) = 0
3285                   resx(nplanes-ip+1) = 1000.!resxPAM
3286                   resy(nplanes-ip+1) = 1000.!resyPAM
3287                   dedxtrk_x(nplanes-ip+1)= 0
3288                   dedxtrk_y(nplanes-ip+1)= 0
3289                   if(icx.gt.0)then
3290                      xgood(nplanes-ip+1) = 1
3291                      resx(nplanes-ip+1) = resxPAM
3292                      dedxtrk_x(nplanes-ip+1)=
3293         $                 sgnl(icx)/mip(VIEW(icx),LADDER(icx))
3294                   elseif(icy.gt.0)then
3295                      ygood(nplanes-ip+1) = 1
3296                      resy(nplanes-ip+1) = resyPAM
3297                      dedxtrk_y(nplanes-ip+1)=
3298         $                 sgnl(icy)/mip(VIEW(icy),LADDER(icy))
3299                   endif
3300                endif
3301                            
3302  *     |||||||||||||||||||||||||||||||||||||||||||||||||  *     |||||||||||||||||||||||||||||||||||||||||||||||||
3303  *     -------------------------------------------------  *     -------------------------------------------------
# Line 2755  c            dedxtrk(nplanes-ip+1) = (sg Line 3309  c            dedxtrk(nplanes-ip+1) = (sg
3309                                
3310              xgood(nplanes-ip+1)=0              xgood(nplanes-ip+1)=0
3311              ygood(nplanes-ip+1)=0              ygood(nplanes-ip+1)=0
3312    
3313                CP_STORE(nplanes-ip+1,ibest)=0 !re-init
3314                CLS_STORE(nplanes-ip+1,ibest)=0
3315    
3316                                
3317  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3318  *     determine which ladder and sensor are intersected by the track  *     determine which ladder and sensor are intersected by the track
 c$$$            xP=XV_STORE(nplanes-ip+1,ibest)  
 c$$$            yP=YV_STORE(nplanes-ip+1,ibest)  
 c$$$            zP=ZV_STORE(nplanes-ip+1,ibest)  
3319              call whichsensor(ip,xP,yP,nldt,ist)              call whichsensor(ip,xP,yP,nldt,ist)
3320  *     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
3321              if(nldt.eq.0.or.ist.eq.0)goto 133              if(nldt.eq.0.or.ist.eq.0)goto 133
3322    
3323                SENSOR_STORE(nplanes-ip+1,IBEST)=ist
3324                LADDER_STORE(nplanes-ip+1,IBEST)=nldt
3325  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3326    
3327              if(DEBUG)then              if(DEBUG.EQ.1)then
3328                 print*,                 print*,
3329       $              '------ Plane ',ip,' intersected on LADDER ',nldt       $              '------ Plane ',ip,' intersected on LADDER ',nldt
3330       $              ,' SENSOR ',ist       $              ,' SENSOR ',ist
# Line 2777  c$$$            zP=ZV_STORE(nplanes-ip+1 Line 3335  c$$$            zP=ZV_STORE(nplanes-ip+1
3335  *     ===========================================  *     ===========================================
3336  *     STEP 1 >>>>>>>  try to include a new couple  *     STEP 1 >>>>>>>  try to include a new couple
3337  *     ===========================================  *     ===========================================
3338  c            if(DEBUG)print*,'>>>> try to include a new couple'              distmin=100000000.
             distmin=1000000.  
3339              xmm = 0.              xmm = 0.
3340              ymm = 0.              ymm = 0.
3341              zmm = 0.              zmm = 0.
# Line 2791  c            if(DEBUG)print*,'>>>> try t Line 3348  c            if(DEBUG)print*,'>>>> try t
3348              do icp=1,ncp_plane(ip) !loop on couples on plane icp              do icp=1,ncp_plane(ip) !loop on couples on plane icp
3349                 icx=clx(ip,icp)                 icx=clx(ip,icp)
3350                 icy=cly(ip,icp)                 icy=cly(ip,icp)
3351                   if(icx.eq.0.or.icy.eq.0)goto 1188!if fake couple, jump to next
3352                 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
3353  c     $              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
3354  c     $              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
3355       $              cl_used(icx).ne.0.or. !or the X cluster is already used !(3)       $              cl_used(icx).ne.0.or. !or the X cluster is already used
3356       $              cl_used(icy).ne.0.or. !or the Y cluster is already used !(3)       $              cl_used(icy).ne.0.or. !or the Y cluster is already used
3357       $              .false.)goto 1188 !then jump to next couple.       $              .false.)goto 1188 !then jump to next couple.
3358  *            *          
 c               call xyz_PAM(icx,icy,ist,  
 c     $              PFA,PFA,  
 c     $              AXV_STORE(nplanes-ip+1,ibest),  
 c     $              AYV_STORE(nplanes-ip+1,ibest))  
3359                 call xyz_PAM(icx,icy,ist,                 call xyz_PAM(icx,icy,ist,
3360       $              PFA,PFA,       $              PFA,PFA,
3361       $              AXV_STORE(nplanes-ip+1,ibest),       $              AXV_STORE(nplanes-ip+1,ibest),
# Line 2811  c     $              AYV_STORE(nplanes-i Line 3365  c     $              AYV_STORE(nplanes-i
3365       $              )       $              )
3366                                
3367                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3368                 distance = distance / RCHI2_STORE(ibest)!<<< MS  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3369                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3370                 if(DEBUG)print*,'( couple ',id                 if(DEBUG.EQ.1)
3371       $              ,' ) normalized distance ',distance       $              print*,'( couple ',id
3372         $              ,' ) distance ',distance
3373                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3374                    xmm = xPAM                    xmm = xPAM
3375                    ymm = yPAM                    ymm = yPAM
# Line 2823  c     $              AYV_STORE(nplanes-i Line 3378  c     $              AYV_STORE(nplanes-i
3378                    rymm = resyPAM                    rymm = resyPAM
3379                    distmin = distance                    distmin = distance
3380                    idm = id                                      idm = id                  
 c                 dedxmm = (sgnl(icx)+sgnl(icy))/2. !(1)  
3381                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)                    dedxmmx = sgnl(icx)/mip(VIEW(icx),LADDER(icx)) !(1)(2)
3382                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)                    dedxmmy = sgnl(icy)/mip(VIEW(icy),LADDER(icy)) !(1)(2)
3383                      clincnewc=10*sqrt(rymm**2+rxmm**2
3384         $                 +RCHI2_STORE(ibest)*k(ip)*(cov(1,1)+cov(2,2)))
3385                 endif                 endif
3386   1188          continue   1188          continue
3387              enddo               !end loop on couples on plane icp              enddo               !end loop on couples on plane icp
3388              if(distmin.le.clinc)then                                if(distmin.le.clincnewc)then    
3389  *              -----------------------------------  *              -----------------------------------
3390                 xm(nplanes-ip+1) = xmm         !<<<                 xm(nplanes-ip+1) = xmm !<<<
3391                 ym(nplanes-ip+1) = ymm         !<<<                 ym(nplanes-ip+1) = ymm !<<<
3392                 zm(nplanes-ip+1) = zmm         !<<<                 zm(nplanes-ip+1) = zmm !<<<
3393                 xgood(nplanes-ip+1) = 1        !<<<                 xgood(nplanes-ip+1) = 1 !<<<
3394                 ygood(nplanes-ip+1) = 1        !<<<                 ygood(nplanes-ip+1) = 1 !<<<
3395                 resx(nplanes-ip+1)=rxmm        !<<<                 resx(nplanes-ip+1)=rxmm !<<<
3396                 resy(nplanes-ip+1)=rymm        !<<<                 resy(nplanes-ip+1)=rymm !<<<
3397  c              dedxtrk(nplanes-ip+1) = dedxmm !<<<  !(1)                 dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3398                 dedxtrk_x(nplanes-ip+1) = dedxmmx    !(1)                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
                dedxtrk_y(nplanes-ip+1) = dedxmmy    !(1)  
3399  *              -----------------------------------  *              -----------------------------------
3400                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
3401                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG.EQ.1)print*,'%%%% included couple ',idm
3402       $              ,' (norm.dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clincnewc,' )'
3403                 goto 133         !next plane                 goto 133         !next plane
3404              endif              endif
3405  *     ================================================  *     ================================================
3406  *     STEP 2 >>>>>>>  try to include a single cluster  *     STEP 2 >>>>>>>  try to include a single cluster
3407  *                     either from a couple or single  *                     either from a couple or single
3408  *     ================================================  *     ================================================
 c            if(DEBUG)print*,'>>>> try to include a new cluster'  
3409              distmin=1000000.              distmin=1000000.
3410              xmm_A = 0.          !---------------------------              xmm_A = 0.          !---------------------------
3411              ymm_A = 0.          ! init variables that              ymm_A = 0.          ! init variables that
# Line 2870  c            if(DEBUG)print*,'>>>> try t Line 3424  c            if(DEBUG)print*,'>>>> try t
3424              do icp=1,ncp_plane(ip) !loop on cluster inside couples              do icp=1,ncp_plane(ip) !loop on cluster inside couples
3425                 icx=clx(ip,icp)                 icx=clx(ip,icp)
3426                 icy=cly(ip,icp)                 icy=cly(ip,icp)
3427                   if(icx.eq.0.or.icy.eq.0)goto 11882!if fake couple, jump to next
3428                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3429                 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
3430  *                                                !jump to the next couple  *                                                !jump to the next couple
# Line 2887  c     $              AXV_STORE(nplanes-i Line 3442  c     $              AXV_STORE(nplanes-i
3442       $              bxyz(2)       $              bxyz(2)
3443       $              )                     $              )              
3444                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3445                 distance = distance / RCHI2_STORE(ibest)!<<< MS  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3446                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG.EQ.1)
3447       $              ,' in cp ',id,' ) normalized distance ',distance       $              print*,'( cl-X ',icx
3448         $              ,' in cp ',id,' ) distance ',distance
3449                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3450                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3451                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 2920  c     $              0.,AYV_STORE(nplane Line 3476  c     $              0.,AYV_STORE(nplane
3476       $              bxyz(2)       $              bxyz(2)
3477       $              )       $              )
3478                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3479                 distance = distance / RCHI2_STORE(ibest)!<<< MS  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3480                 if(DEBUG)print*,'( cl-Y ',icy                 if(DEBUG.EQ.1)
3481       $              ,' in cp ',id,' ) normalized distance ',distance       $              print*,'( cl-Y ',icy
3482         $              ,' in cp ',id,' ) distance ',distance
3483                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3484                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3485                    ymm_A = yPAM_A                    ymm_A = yPAM_A
# Line 2941  c                 dedxmm = sgnl(icy)  !( Line 3498  c                 dedxmm = sgnl(icy)  !(
3498  11882          continue  11882          continue
3499              enddo               !end loop on cluster inside couples              enddo               !end loop on cluster inside couples
3500  *----- single clusters -----------------------------------------------    *----- single clusters -----------------------------------------------  
 c            print*,'## ncls(',ip,') ',ncls(ip)  
3501              do ic=1,ncls(ip)    !loop on single clusters              do ic=1,ncls(ip)    !loop on single clusters
3502                 icl=cls(ip,ic)                 icl=cls(ip,ic)
 c              print*,'## ic ',ic,' ist ',ist  
 c               if(cl_used(icl).eq.1.or.     !if the cluster is already used  
3503                 if(cl_used(icl).ne.0.or.     !if the cluster is already used !(3)                 if(cl_used(icl).ne.0.or.     !if the cluster is already used !(3)
3504       $              LADDER(icl).ne.nldt.or. !or the ladder number does not match       $              LADDER(icl).ne.nldt.or. !or the ladder number does not match
3505       $              .false.)goto 18882      !jump to the next singlet       $              .false.)goto 18882      !jump to the next singlet
3506                 if(mod(VIEW(icl),2).eq.0)then!<---- X view                 if(mod(VIEW(icl),2).eq.0)then!<---- X view
 c                  call xyz_PAM(icl,0,ist,  
 c     $                 PFA,PFA,  
 c     $                 AXV_STORE(nplanes-ip+1,ibest),0.)  
3507                    call xyz_PAM(icl,0,ist,                    call xyz_PAM(icl,0,ist,
3508       $                 PFA,PFA,       $                 PFA,PFA,
3509       $                 AXV_STORE(nplanes-ip+1,ibest),0.,       $                 AXV_STORE(nplanes-ip+1,ibest),0.,
# Line 2960  c     $                 AXV_STORE(nplane Line 3511  c     $                 AXV_STORE(nplane
3511       $                 bxyz(2)       $                 bxyz(2)
3512       $                 )       $                 )
3513                 else                         !<---- Y view                 else                         !<---- Y view
 c                  call xyz_PAM(0,icl,ist,  
 c     $                 PFA,PFA,  
 c     $                 0.,AYV_STORE(nplanes-ip+1,ibest))  
3514                    call xyz_PAM(0,icl,ist,                    call xyz_PAM(0,icl,ist,
3515       $                 PFA,PFA,       $                 PFA,PFA,
3516       $                 0.,AYV_STORE(nplanes-ip+1,ibest),       $                 0.,AYV_STORE(nplanes-ip+1,ibest),
# Line 2972  c     $                 0.,AYV_STORE(npl Line 3520  c     $                 0.,AYV_STORE(npl
3520                 endif                 endif
3521    
3522                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3523                 distance = distance / RCHI2_STORE(ibest)!<<< MS  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3524                 if(DEBUG)print*,'( cl-s ',icl                 if(DEBUG.EQ.1)
3525       $              ,' ) normalized distance ',distance,'<',distmin,' ?'       $              print*,'( cl-s ',icl
3526         $              ,' ) distance ',distance
3527                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
                   if(DEBUG)print*,'YES'  
3528                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3529                    ymm_A = yPAM_A                    ymm_A = yPAM_A
3530                    zmm_A = zPAM_A                    zmm_A = zPAM_A
# Line 2987  c     $                 0.,AYV_STORE(npl Line 3535  c     $                 0.,AYV_STORE(npl
3535                    rymm = resyPAM                    rymm = resyPAM
3536                    distmin = distance                      distmin = distance  
3537                    iclm = icl                    iclm = icl
 c                  dedxmm = sgnl(icl)                   !(1)  
3538                    if(mod(VIEW(icl),2).eq.0)then !<---- X view                    if(mod(VIEW(icl),2).eq.0)then !<---- X view
3539                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmx = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3540                       dedxmmy = 0.                       !(1)                       dedxmmy = 0.                  
3541                    else          !<---- Y view                    else          !<---- Y view
3542                       dedxmmx = 0.                       !(1)                       dedxmmx = 0.                  
3543                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl)) !(1)(2)                       dedxmmy = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
3544                    endif                    endif
3545                 endif                                   endif                  
3546  18882          continue  18882          continue
3547              enddo               !end loop on single clusters              enddo               !end loop on single clusters
3548  c            print*,'## distmin ', distmin,' clinc ',clinc  
3549              if(distmin.le.clinc)then                                if(iclm.ne.0)then
                 
                CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<      
 *              ----------------------------  
 c               print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'  
3550                 if(mod(VIEW(iclm),2).eq.0)then                 if(mod(VIEW(iclm),2).eq.0)then
3551                    XGOOD(nplanes-ip+1)=1.                    clincnew=
3552                    resx(nplanes-ip+1)=rxmm       $                 20*
3553                    if(DEBUG)print*,'%%%% included X-cl ',iclm       $                 sqrt(rxmm**2+RCHI2_STORE(ibest)*k(ip)*cov(1,1))
3554  c                  if(.true.)print*,'%%%% included X-cl ',iclm                 else if(mod(VIEW(iclm),2).ne.0)then
3555       $                 ,'( chi^2, ',RCHI2_STORE(ibest)                    clincnew=
3556       $                 ,', norm.dist.= ',distmin       $                 10*
3557       $                 ,', cut ',clinc,' )'       $                 sqrt(rymm**2+RCHI2_STORE(ibest)*k(ip)*cov(2,2))
3558                 else                 endif
3559                    YGOOD(nplanes-ip+1)=1.  
3560                    resy(nplanes-ip+1)=rymm                 if(distmin.le.clincnew)then  
3561                    if(DEBUG)print*,'%%%% included Y-cl ',iclm                    
3562  c                  if(.true.)print*,'%%%% included Y-cl ',iclm                    CLS_STORE(nplanes-ip+1,ibest)=iclm !<<<<    
3563       $                 ,'( chi^2, ',RCHI2_STORE(ibest)  *     ----------------------------
3564       $                 ,', norm.dist.= ', distmin                    if(mod(VIEW(iclm),2).eq.0)then
3565       $                 ,', cut ',clinc,' )'                       XGOOD(nplanes-ip+1)=1.
3566                         resx(nplanes-ip+1)=rxmm
3567                         if(DEBUG.EQ.1)
3568         $                    print*,'%%%% included X-cl ',iclm
3569         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3570         $                    ,', dist.= ',distmin
3571         $                    ,', cut ',clincnew,' )'
3572                      else
3573                         YGOOD(nplanes-ip+1)=1.
3574                         resy(nplanes-ip+1)=rymm
3575                         if(DEBUG.EQ.1)
3576         $                    print*,'%%%% included Y-cl ',iclm
3577         $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3578         $                    ,', dist.= ', distmin
3579         $                    ,', cut ',clincnew,' )'
3580                      endif
3581    *     ----------------------------
3582                      xm_A(nplanes-ip+1) = xmm_A
3583                      ym_A(nplanes-ip+1) = ymm_A
3584                      xm_B(nplanes-ip+1) = xmm_B
3585                      ym_B(nplanes-ip+1) = ymm_B
3586                      zm(nplanes-ip+1) = (zmm_A+zmm_B)/2.
3587                      dedxtrk_x(nplanes-ip+1) = dedxmmx !<<<
3588                      dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3589    *     ----------------------------
3590                 endif                 endif
 c               print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'  
 *              ----------------------------  
                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)  
 *              ----------------------------  
3591              endif              endif
3592           endif           endif
3593   133     continue   133     continue
# Line 3042  c              dedxtrk(nplanes-ip+1) = d Line 3598  c              dedxtrk(nplanes-ip+1) = d
3598        return        return
3599        end        end
3600    
3601    
3602  ***************************************************  ***************************************************
3603  *                                                 *  *                                                 *
3604  *                                                 *  *                                                 *
# Line 3050  c              dedxtrk(nplanes-ip+1) = d Line 3607  c              dedxtrk(nplanes-ip+1) = d
3607  *                                                 *  *                                                 *
3608  *                                                 *  *                                                 *
3609  **************************************************  **************************************************
 cccccc 12/08/2006 modified by elena ---> (1)  
3610  *  *
       subroutine clean_XYclouds(ibest,iflag)  
   
       include 'commontracker.f'  
       include 'level1.f'  
       include 'common_momanhough.f'  
 c      include 'momanhough_init.f'  
       include 'level2.f'        !(1)  
 c      include 'calib.f'  
 c      include 'level1.f'  
   
   
   
       do ip=1,nplanes           !loop on planes  
   
          id=CP_STORE(nplanes-ip+1,ibest)  
          icl=CLS_STORE(nplanes-ip+1,ibest)  
          if(id.ne.0.or.icl.ne.0)then                
             if(id.ne.0)then  
                iclx=clx(ip,icp_cp(id))  
                icly=cly(ip,icp_cp(id))  
 c               cl_used(iclx)=1  !tag used clusters  
 c               cl_used(icly)=1  !tag used clusters  
                cl_used(iclx)=ntrk  !tag used clusters !(1)  
                cl_used(icly)=ntrk  !tag used clusters !(1)  
             elseif(icl.ne.0)then  
 c               cl_used(icl)=1   !tag used clusters  
                cl_used(icl)=ntrk   !tag used clusters !1)  
             endif  
               
 c               if(DEBUG)then  
 c                  print*,ip,' <<< ',id  
 c               endif  
 *     -----------------------------  
 *     remove the couple from clouds  
 *     remove also vitual couples containing the  
 *     selected clusters  
 *     -----------------------------  
             do icp=1,ncp_plane(ip)  
                if(  
      $              clx(ip,icp).eq.iclx  
      $              .or.  
      $              clx(ip,icp).eq.icl  
      $              .or.  
      $              cly(ip,icp).eq.icly  
      $              .or.  
      $              cly(ip,icp).eq.icl  
      $              )then  
                   id=id_cp(ip,icp,1)  
                   if(DEBUG)then  
                      print*,ip,' <<< cp ',id  
      $                    ,' ( cl-x '  
      $                    ,clx(ip,icp)  
      $                    ,' cl-y '  
      $                    ,cly(ip,icp),' ) --> removed'  
                   endif  
 *     -----------------------------  
 *     remove the couple from clouds  
                   do iyz=1,nclouds_yz  
                      if(cpcloud_yz(iyz,abs(id)).ne.0)then  
                         ptcloud_yz(iyz)=ptcloud_yz(iyz)-1  
                         cpcloud_yz(iyz,abs(id))=0  
                      endif  
                   enddo  
                   do ixz=1,nclouds_xz  
                      if(cpcloud_xz(ixz,abs(id)).ne.0)then  
                         ptcloud_xz(ixz)=ptcloud_xz(ixz)-1  
                         cpcloud_xz(ixz,abs(id))=0  
                      endif  
                   enddo                      
 *     -----------------------------  
                endif  
             enddo  
               
          endif                
       enddo                     !end loop on planes  
         
       return  
       end  
   
   
   
3611    
3612    
3613    
# Line 3144  c               endif Line 3619  c               endif
3619        include 'level1.f'        include 'level1.f'
3620        include 'common_momanhough.f'        include 'common_momanhough.f'
3621        include 'level2.f'        include 'level2.f'
 c      include 'level1.f'  
3622    
3623    *     ---------------------------------
3624    *     variables initialized from level1
3625    *     ---------------------------------
3626        do i=1,nviews        do i=1,nviews
3627           good2(i)=good1(i)           good2(i)=good1(i)
3628             do j=1,nva1_view
3629                vkflag(i,j)=1
3630                if(cnnev(i,j).le.0)then
3631                   vkflag(i,j)=cnnev(i,j)
3632                endif
3633             enddo
3634        enddo        enddo
3635    *     ----------------
3636    *     level2 variables
3637    *     ----------------
3638        NTRK = 0        NTRK = 0
3639        do it=1,NTRKMAX        do it=1,NTRKMAX
3640           IMAGE(IT)=0           IMAGE(IT)=0
# Line 3161  c      include 'level1.f' Line 3645  c      include 'level1.f'
3645              ZM_nt(IP,IT) = 0              ZM_nt(IP,IT) = 0
3646              RESX_nt(IP,IT) = 0              RESX_nt(IP,IT) = 0
3647              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3648                TAILX_nt(IP,IT) = 0
3649                TAILY_nt(IP,IT) = 0
3650                XBAD(IP,IT) = 0
3651                YBAD(IP,IT) = 0
3652              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3653              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
3654                LS(IP,IT) = 0
3655              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3656              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
3657              CLTRX(IP,IT) = 0              CLTRX(IP,IT) = 0
3658              CLTRY(IP,IT) = 0              CLTRY(IP,IT) = 0
3659                multmaxx(ip,it) = 0
3660                seedx(ip,it)    = 0
3661                xpu(ip,it)      = 0
3662                multmaxy(ip,it) = 0
3663                seedy(ip,it)    = 0
3664                ypu(ip,it)      = 0
3665           enddo           enddo
3666           do ipa=1,5           do ipa=1,5
3667              AL_nt(IPA,IT) = 0              AL_nt(IPA,IT) = 0
# Line 3186  c      include 'level1.f' Line 3681  c      include 'level1.f'
3681          ys(1,ip)=0          ys(1,ip)=0
3682          ys(2,ip)=0          ys(2,ip)=0
3683          sgnlys(ip)=0          sgnlys(ip)=0
3684            sxbad(ip)=0
3685            sybad(ip)=0
3686            multmaxsx(ip)=0
3687            multmaxsy(ip)=0
3688        enddo        enddo
3689        end        end
3690    
# Line 3295  c      include 'level1.f' Line 3794  c      include 'level1.f'
3794    
3795            
3796        include 'commontracker.f'        include 'commontracker.f'
 c      include 'level1.f'  
3797        include 'level1.f'        include 'level1.f'
3798        include 'common_momanhough.f'        include 'common_momanhough.f'
3799        include 'level2.f'        include 'level2.f'
3800        include 'common_mini_2.f'        include 'common_mini_2.f'
3801        real sinth,phi,pig              include 'calib.f'
3802    
3803          character*10 PFA
3804          common/FINALPFA/PFA
3805    
3806          real sinth,phi,pig
3807          integer ssensor,sladder
3808        pig=acos(-1.)        pig=acos(-1.)
3809    
3810    
3811    
3812    *     -------------------------------------
3813        chi2_nt(ntr)        = sngl(chi2)        chi2_nt(ntr)        = sngl(chi2)
3814        nstep_nt(ntr)       = nstep        nstep_nt(ntr)       = nstep
3815    *     -------------------------------------
3816        phi   = al(4)                  phi   = al(4)          
3817        sinth = al(3)                    sinth = al(3)            
3818        if(sinth.lt.0)then              if(sinth.lt.0)then      
# Line 3318  c      include 'level1.f' Line 3825  c      include 'level1.f'
3825       $     phi = phi + 2*pig         $     phi = phi + 2*pig  
3826        al(4) = phi                      al(4) = phi              
3827        al(3) = sinth                    al(3) = sinth            
   
3828        do i=1,5        do i=1,5
3829           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3830           do j=1,5           do j=1,5
3831              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3832           enddo           enddo
3833        enddo        enddo
3834          *     -------------------------------------      
3835        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
3836           xgood_nt(ip,ntr) = int(xgood(ip))           xgood_nt(ip,ntr) = int(xgood(ip))
3837           ygood_nt(ip,ntr) = int(ygood(ip))           ygood_nt(ip,ntr) = int(ygood(ip))
# Line 3334  c      include 'level1.f' Line 3840  c      include 'level1.f'
3840           zm_nt(ip,ntr)    = sngl(zm(ip))           zm_nt(ip,ntr)    = sngl(zm(ip))
3841           RESX_nt(IP,ntr)  = sngl(resx(ip))           RESX_nt(IP,ntr)  = sngl(resx(ip))
3842           RESY_nt(IP,ntr)  = sngl(resy(ip))           RESY_nt(IP,ntr)  = sngl(resy(ip))
3843             TAILX_nt(IP,ntr) = 0.
3844             TAILY_nt(IP,ntr) = 0.
3845           xv_nt(ip,ntr)    = sngl(xv(ip))           xv_nt(ip,ntr)    = sngl(xv(ip))
3846           yv_nt(ip,ntr)    = sngl(yv(ip))           yv_nt(ip,ntr)    = sngl(yv(ip))
3847           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3848           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3849           ayv_nt(ip,ntr)   = sngl(ayv(ip))             ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3850  c     l'avevo dimenticato!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  
3851           factor = sqrt(           factor = sqrt(
3852       $        sin( acos(-1.) * sngl(axv(ip)) /180. )**2 +       $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3853       $        sin( acos(-1.) * sngl(ayv(ip)) /180. )**2 +       $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3854       $        1. )       $        1. )
3855  c     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  
3856           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3857           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)             dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3858        
3859           id  = CP_STORE(ip,IDCAND)  
3860    ccc         print*,ip,'dedx >>> ',dedx_x(ip,ntr),dedx_y(ip,ntr)
3861    
3862             ax   = axv_nt(ip,ntr)
3863             ay   = ayv_nt(ip,ntr)
3864             bfx  = BX_STORE(ip,IDCAND)
3865             bfy  = BY_STORE(ip,IDCAND)
3866    c$$$         if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3867    c$$$         if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3868    c$$$         tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3869    c$$$         angx     = 180.*atan(tgtemp)/acos(-1.)
3870    c$$$         tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3871    c$$$         angy    = 180.*atan(tgtemp)/acos(-1.)
3872    
3873             angx = effectiveangle(ax,2*ip,bfy)
3874             angy = effectiveangle(ay,2*ip-1,bfx)
3875            
3876            
3877    
3878             id  = CP_STORE(ip,IDCAND) ! couple id
3879           icl = CLS_STORE(ip,IDCAND)           icl = CLS_STORE(ip,IDCAND)
3880             ssensor = -1
3881             sladder = -1
3882             ssensor = SENSOR_STORE(ip,IDCAND)
3883             sladder = LADDER_STORE(ip,IDCAND)
3884             if(ip.eq.6.and.ssensor.ne.0)ssensor = 3 - ssensor !notazione paolo x align
3885             LS(IP,ntr)      = ssensor+10*sladder
3886    
3887           if(id.ne.0)then           if(id.ne.0)then
3888    c           >>> is a couple
3889              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3890              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3891  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  
3892                if(clx(nplanes-ip+1,icp_cp(id)).gt.0)then
3893    
3894                   cl_used(cltrx(ip,ntr)) = 1 !tag used clusters          
3895    
3896                   xbad(ip,ntr)= nbadstrips(4,clx(nplanes-ip+1,icp_cp(id)))
3897    
3898                   if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3899         $              dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3900                  
3901                   multmaxx(ip,ntr) = maxs(cltrx(ip,ntr))
3902         $              +10000*mult(cltrx(ip,ntr))
3903                   seedx(ip,ntr)    = clsignal(indmax(cltrx(ip,ntr)))
3904         $              /clsigma(indmax(cltrx(ip,ntr)))
3905                   call applypfa(PFA,cltrx(ip,ntr),angx,corr,res)
3906                   xpu(ip,ntr)      = corr
3907    
3908                endif
3909                if(cly(nplanes-ip+1,icp_cp(id)).gt.0)then
3910    
3911                   cl_used(cltry(ip,ntr)) = 1 !tag used clusters          
3912    
3913                   ybad(ip,ntr)= nbadstrips(4,cly(nplanes-ip+1,icp_cp(id)))
3914    
3915                   if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3916         $              dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3917                  
3918                   multmaxy(ip,ntr) = maxs(cltry(ip,ntr))
3919         $              +10000*mult(cltry(ip,ntr))
3920                   seedy(ip,ntr)    = clsignal(indmax(cltry(ip,ntr)))
3921         $              /clsigma(indmax(cltry(ip,ntr)))
3922                   call applypfa(PFA,cltry(ip,ntr),angy,corr,res)
3923                   ypu(ip,ntr)      = corr
3924                endif
3925    
3926           elseif(icl.ne.0)then           elseif(icl.ne.0)then
3927              if(mod(VIEW(icl),2).eq.0)cltrx(ip,ntr)=icl  
3928              if(mod(VIEW(icl),2).eq.1)cltry(ip,ntr)=icl              cl_used(icl) = 1    !tag used clusters          
3929  c            print*,ip,' ',cltrx(ip,ntr),cltry(ip,ntr)  
3930                if(mod(VIEW(icl),2).eq.0)then
3931                   cltrx(ip,ntr)=icl
3932                   xbad(ip,ntr) = nbadstrips(4,icl)
3933    
3934                   if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3935    
3936                   multmaxx(ip,ntr) = maxs(cltrx(ip,ntr))
3937         $                         +10000*mult(cltrx(ip,ntr))
3938                   seedx(ip,ntr)    = clsignal(indmax(cltrx(ip,ntr)))
3939         $           /clsigma(indmax(cltrx(ip,ntr)))
3940                   call applypfa(PFA,cltrx(ip,ntr),angx,corr,res)
3941                   xpu(ip,ntr)      = corr
3942    
3943                elseif(mod(VIEW(icl),2).eq.1)then
3944                   cltry(ip,ntr)=icl
3945                   ybad(ip,ntr) = nbadstrips(4,icl)
3946    
3947                   if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3948    
3949                   multmaxy(ip,ntr) = maxs(cltry(ip,ntr))
3950         $                         +10000*mult(cltry(ip,ntr))
3951                   seedy(ip,ntr)    = clsignal(indmax(cltry(ip,ntr)))
3952         $           /clsigma(indmax(cltry(ip,ntr)))
3953                   call applypfa(PFA,cltry(ip,ntr),angy,corr,res)
3954                   ypu(ip,ntr)      = corr
3955                  
3956                endif
3957    
3958           endif                     endif          
3959    
3960        enddo        enddo
3961    
3962          if(DEBUG.eq.1)then
3963             print*,'> STORING TRACK ',ntr
3964             print*,'clusters: '
3965             do ip=1,6
3966                print*,'> ',ip,' -- ',cltrx(ip,ntr),cltry(ip,ntr)
3967             enddo
3968             print*,'dedx: '
3969             do ip=1,6
3970                print*,'> ',ip,' -- ',dedx_x(ip,ntr),dedx_y(ip,ntr)
3971             enddo
3972          endif
3973    
3974        end        end
3975    
# Line 3374  c            print*,ip,' ',cltrx(ip,ntr) Line 3982  c            print*,ip,' ',cltrx(ip,ntr)
3982  *     -------------------------------------------------------  *     -------------------------------------------------------
3983    
3984        include 'commontracker.f'        include 'commontracker.f'
 c      include 'level1.f'  
3985        include 'calib.f'        include 'calib.f'
3986        include 'level1.f'        include 'level1.f'
3987        include 'common_momanhough.f'        include 'common_momanhough.f'
# Line 3382  c      include 'level1.f' Line 3989  c      include 'level1.f'
3989        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3990    
3991  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
 c      good2=1!.true.  
3992        nclsx = 0        nclsx = 0
3993        nclsy = 0        nclsy = 0
3994    
3995        do iv = 1,nviews        do iv = 1,nviews
3996           if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)  c         if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
3997             good2(iv) = good2(iv) + mask_view(iv)*2**8
3998        enddo        enddo
3999    
4000          if(DEBUG.eq.1)then
4001             print*,'> STORING SINGLETS '
4002          endif
4003    
4004        do icl=1,nclstr1        do icl=1,nclstr1
4005    
4006             ip=nplanes-npl(VIEW(icl))+1            
4007            
4008           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
4009              ip=nplanes-npl(VIEW(icl))+1              
4010              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
4011    
4012                 nclsx = nclsx + 1                 nclsx = nclsx + 1
4013                 planex(nclsx) = ip                 planex(nclsx) = ip
4014                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlxs(nclsx) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
4015                   if(nsatstrips(icl).gt.0)sgnlxs(nclsx)=-sgnlxs(nclsx)
4016                 clsx(nclsx)   = icl                 clsx(nclsx)   = icl
4017                   sxbad(nclsx)  = nbadstrips(1,icl)
4018                   multmaxsx(nclsx) = maxs(icl)+10000*mult(icl)
4019                  
4020    
4021                 do is=1,2                 do is=1,2
4022  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)  c                  call xyz_PAM(icl,0,is,'COG1',' ',0.,0.)
4023  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)  c                  call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.)
4024                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)                    call xyz_PAM(icl,0,is,PFAdef,' ',0.,0.,0.,0.)
4025                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2                    xs(is,nclsx) = (xPAM_A+xPAM_B)/2
4026                 enddo                 enddo
 c$$$               print*,'nclsx         ',nclsx  
 c$$$               print*,'planex(nclsx) ',planex(nclsx)  
 c$$$               print*,'sgnlxs(nclsx) ',sgnlxs(nclsx)  
 c$$$               print*,'xs(1,nclsx)   ',xs(1,nclsx)  
 c$$$               print*,'xs(2,nclsx)   ',xs(2,nclsx)  
4027              else                          !=== Y views              else                          !=== Y views
4028                 nclsy = nclsy + 1                 nclsy = nclsy + 1
4029                 planey(nclsy) = ip                 planey(nclsy) = ip
4030                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))!(2)                 sgnlys(nclsy) = sgnl(icl)/mip(VIEW(icl),LADDER(icl))
4031                   if(nsatstrips(icl).gt.0)sgnlys(nclsy)=-sgnlys(nclsy)
4032                 clsy(nclsy)   = icl                 clsy(nclsy)   = icl
4033                   sybad(nclsy)  = nbadstrips(1,icl)
4034                   multmaxsy(nclsy) = maxs(icl)+10000*mult(icl)
4035    
4036    
4037                 do is=1,2                 do is=1,2
4038  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)  c                  call xyz_PAM(0,icl,is,' ','COG1',0.,0.)
4039  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)  c                  call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.)
4040                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)                    call xyz_PAM(0,icl,is,' ',PFAdef,0.,0.,0.,0.)
4041                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2                    ys(is,nclsy) = (yPAM_A+yPAM_B)/2
4042                 enddo                 enddo
 c$$$               print*,'nclsy         ',nclsy  
 c$$$               print*,'planey(nclsy) ',planey(nclsy)  
 c$$$               print*,'sgnlys(nclsy) ',sgnlys(nclsy)  
 c$$$               print*,'ys(1,nclsy)   ',ys(1,nclsy)  
 c$$$               print*,'ys(2,nclsy)   ',ys(2,nclsy)  
4043              endif              endif
4044           endif           endif
 c      print*,icl,cl_used(icl),cl_good(icl),ip,VIEW(icl)!nclsx(ip),nclsy(ip)  
4045    
4046  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
4047           whichtrack(icl) = cl_used(icl)           whichtrack(icl) = cl_used(icl)
4048    *     --------------------------------------------------
4049    *     per non perdere la testa...
4050    *     whichtrack(icl) e` una variabile del common level1
4051    *     che serve solo per sapere quali cluster sono stati
4052    *     associati ad una traccia, e permettere di salvare
4053    *     solo questi nell'albero di uscita
4054    *     --------------------------------------------------
4055                    
4056        enddo        enddo
4057        end        end
4058    
# Line 3493  c      print*,icl,cl_used(icl),cl_good(i Line 4114  c      print*,icl,cl_used(icl),cl_good(i
4114                 alfayz2_av_nt(iyz)=alfayz2_av(iyz)                 alfayz2_av_nt(iyz)=alfayz2_av(iyz)
4115                 nnn=nnn+ptcloud_yz(iyz)                 nnn=nnn+ptcloud_yz(iyz)
4116              enddo              enddo
4117              do ipt=1,nnn              do ipt=1,min(ndblt_max_nt,nnn)
4118                 db_cloud_nt(ipt)=db_cloud(ipt)                 db_cloud_nt(ipt)=db_cloud(ipt)
4119               enddo               enddo
4120           endif           endif
# Line 3506  c      print*,icl,cl_used(icl),cl_good(i Line 4127  c      print*,icl,cl_used(icl),cl_good(i
4127                 alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)                 alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
4128                 nnn=nnn+ptcloud_xz(ixz)                               nnn=nnn+ptcloud_xz(ixz)              
4129              enddo              enddo
4130              do ipt=1,nnn              do ipt=1,min(ntrpt_max_nt,nnn)
4131                tr_cloud_nt(ipt)=tr_cloud(ipt)                tr_cloud_nt(ipt)=tr_cloud(ipt)
4132               enddo               enddo
4133           endif           endif

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.41

  ViewVC Help
Powered by ViewVC 1.1.23