/[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.23 by pam-fi, Mon May 14 11:03:06 2007 UTC revision 1.31 by pam-fi, Fri Aug 31 14:56:52 2007 UTC
# Line 215  c$$$      enddo Line 215  c$$$      enddo
215  c      include 'momanhough_init.f'  c      include 'momanhough_init.f'
216                
217        logical FIMAGE            !        logical FIMAGE            !
218          real trackimage(NTRACKSMAX)
219        real*8 AL_GUESS(5)        real*8 AL_GUESS(5)
220    
221  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
# Line 331  c$$$         enddo Line 332  c$$$         enddo
332              iimage=0              iimage=0
333           endif           endif
334           if(icand.eq.0)then           if(icand.eq.0)then
335              if(VERBOSE)then              if(VERBOSE.EQ.1)then
336                 print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand                 print*,'HAI FATTO UN CASINO!!!!!! icand = ',icand
337       $              ,ibest,iimage       $              ,ibest,iimage
338              endif              endif
# Line 360  c         print*,'## guess: ',al Line 361  c         print*,'## guess: ',al
361           jstep=0                !# minimization steps           jstep=0                !# minimization steps
362    
363           iprint=0           iprint=0
364  c         if(DEBUG)iprint=1  c         if(DEBUG.EQ.1)iprint=1
365           if(VERBOSE)iprint=1           if(VERBOSE.EQ.1)iprint=1
366           if(DEBUG)iprint=2           if(DEBUG.EQ.1)iprint=2
367           call mini2(jstep,ifail,iprint)           call mini2(jstep,ifail,iprint)
368           if(ifail.ne.0) then           if(ifail.ne.0) then
369              if(VERBOSE)then              if(VERBOSE.EQ.1)then
370                 print *,                 print *,
371       $              '*** MINIMIZATION FAILURE *** (after refinement) '       $              '*** MINIMIZATION FAILURE *** (after refinement) '
372       $              ,iev       $              ,iev
# Line 380  c$$$               print*,'------------- Line 381  c$$$               print*,'-------------
381  c            chi2=-chi2  c            chi2=-chi2
382           endif           endif
383                    
384           if(DEBUG)then           if(DEBUG.EQ.1)then
385              print*,'----------------------------- improved track coord'              print*,'----------------------------- improved track coord'
386  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)  22222       format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
387              do ip=1,6              do ip=1,6
# Line 391  c            chi2=-chi2 Line 392  c            chi2=-chi2
392           endif           endif
393    
394  c         rchi2=chi2/dble(ndof)  c         rchi2=chi2/dble(ndof)
395           if(DEBUG)then           if(DEBUG.EQ.1)then
396              print*,' '              print*,' '
397              print*,'****** SELECTED TRACK *************'              print*,'****** SELECTED TRACK *************'
398              print*,'#         R. chi2        RIG'              print*,'#         R. chi2        RIG'
# Line 407  c         rchi2=chi2/dble(ndof) Line 408  c         rchi2=chi2/dble(ndof)
408  *     ------------- search if the track has an IMAGE -------------  *     ------------- search if the track has an IMAGE -------------
409  *     ------------- (also this is stored )           -------------  *     ------------- (also this is stored )           -------------
410           if(FIMAGE)goto 122     !>>> jump! (this is already an image)           if(FIMAGE)goto 122     !>>> jump! (this is already an image)
411  *     now search for track-image, by comparing couples IDs  
412    *     -----------------------------------------------------
413    *     first check if the track is ambiguous
414    *     -----------------------------------------------------
415    *     (modified on august 2007 by ElenaV)
416             is1=0
417             do ip=1,NPLANES
418                if(SENSOR_STORE(ip,icand).ne.0)then
419                   is1=SENSOR_STORE(ip,icand)
420                   if(ip.eq.6)is1=3-is1 !last plane inverted
421                endif
422             enddo
423             if(is1.eq.0)then
424                if(WARNING.EQ.1)print*,'** WARNING ** sensor=0'
425                goto 122            !jump
426             endif
427    c         print*,'is1 ',is1
428             do ip=1,NPLANES
429                is2 = SENSOR_STORE(ip,icand) !sensor
430    c            print*,'is2 ',is2,' ip ',ip
431                if(ip.eq.6.and.is2.ne.0)is2=3-is2 !last plane inverted
432                if(
433         $           (is1.ne.is2.and.is2.ne.0)
434         $           )goto 122      !jump (this track cannot have an image)
435             enddo
436             if(DEBUG.eq.1)print*,' >>> ambiguous track! '
437    *     now search for track-image among track candidates
438    c$$$         do i=1,ntracks
439    c$$$            iimage=i
440    c$$$            do ip=1,nplanes
441    c$$$               if(     CP_STORE(nplanes-ip+1,icand).ne.
442    c$$$     $              -1*CP_STORE(nplanes-ip+1,i).and.
443    c$$$     $              CP_STORE(nplanes-ip+1,i).ne.0.and.
444    c$$$     $              CP_STORE(nplanes-ip+1,icand).ne.0 )iimage=0
445    c$$$               print*,' track ',i,' CP ',CP_STORE(nplanes-ip+1,i)
446    c$$$     $              ,CP_STORE(nplanes-ip+1,icand),iimage
447    c$$$            enddo
448    c$$$            if(  iimage.ne.0.and.
449    c$$$c     $           RCHI2_STORE(i).le.CHI2MAX.and.
450    c$$$c     $           RCHI2_STORE(i).gt.0.and.
451    c$$$     $           .true.)then
452    c$$$               if(DEBUG.EQ.1)print*,'Track candidate ',iimage
453    c$$$     $              ,' >>> TRACK IMAGE >>> of'
454    c$$$     $              ,ibest
455    c$$$               goto 122         !image track found
456    c$$$            endif
457    c$$$         enddo
458    *     ---------------------------------------------------------------
459    *     take the candidate with the greatest number of matching couples
460    *     if more than one satisfies the requirement,
461    *     choose the one with more points and lower chi2
462    *     ---------------------------------------------------------------
463    *     count the number of matching couples
464             ncpmax = 0
465             iimage   = 0           !id of candidate with better matching
466           do i=1,ntracks           do i=1,ntracks
467              iimage=i              ncp=0
468              do ip=1,nplanes              do ip=1,nplanes
469                 if(     CP_STORE(nplanes-ip+1,icand).ne.                 if(CP_STORE(nplanes-ip+1,icand).ne.0)then
470       $              -1*CP_STORE(nplanes-ip+1,i) )iimage=0                    if(
471         $                 CP_STORE(nplanes-ip+1,i).ne.0
472         $                 .and.
473         $                 CP_STORE(nplanes-ip+1,icand).eq.
474         $                 -1*CP_STORE(nplanes-ip+1,i)
475         $                 )then
476                         ncp=ncp+1  !ok
477                      elseif(
478         $                    CP_STORE(nplanes-ip+1,i).ne.0
479         $                    .and.
480         $                    CP_STORE(nplanes-ip+1,icand).ne.
481         $                    -1*CP_STORE(nplanes-ip+1,i)
482         $                    )then
483                         ncp = 0
484                         goto 117   !it is not an image candidate
485                      else
486                        
487                      endif
488                   endif
489    c$$$               print*,' track ',i,' CP ',CP_STORE(nplanes-ip+1,i)
490    c$$$     $              ,CP_STORE(nplanes-ip+1,icand),ncp
491              enddo              enddo
492              if(  iimage.ne.0.and.   117        continue
493  c     $           RCHI2_STORE(i).le.CHI2MAX.and.              trackimage(i)=ncp   !number of matching couples
494  c     $           RCHI2_STORE(i).gt.0.and.              if(ncp>ncpmax)then
495       $           .true.)then                 ncpmax=ncp
496                 if(DEBUG)print*,'Track candidate ',iimage                 iimage=i
      $              ,' >>> TRACK IMAGE >>> of'  
      $              ,ibest  
                goto 122         !image track found  
497              endif              endif
498           enddo           enddo
499    *     check if there are more than one image candidates
500             ngood=0
501             do i=1,ntracks
502                if( ncpmax.ne.0.and.trackimage(i).eq.ncpmax )ngood=ngood+1
503             enddo
504    *     if there are, choose the best one
505             if(ngood.gt.1)then
506    *     -------------------------------------------------------
507    *     order track-candidates according to:
508    *     1st) decreasing n.points
509    *     2nd) increasing chi**2
510    *     -------------------------------------------------------
511                rchi2best=1000000000.
512                ndofbest=0            
513                do i=1,ntracks
514                   if( trackimage(i).eq.ncpmax )then
515                      ndof=0              
516                      do ii=1,nplanes    
517                         ndof=ndof        
518         $                    +int(xgood_store(ii,i))
519         $                    +int(ygood_store(ii,i))
520                      enddo              
521                      if(ndof.gt.ndofbest)then
522                         iimage=i
523                         rchi2best=RCHI2_STORE(i)
524                         ndofbest=ndof    
525                      elseif(ndof.eq.ndofbest)then
526                         if(RCHI2_STORE(i).lt.rchi2best.and.
527         $                    RCHI2_STORE(i).gt.0)then
528                            iimage=i
529                            rchi2best=RCHI2_STORE(i)
530                            ndofbest=ndof  
531                         endif            
532                      endif
533                   endif
534                enddo
535                
536             endif
537    
538             if(DEBUG.EQ.1)print*,'Track candidate ',iimage
539         $        ,' >>> TRACK IMAGE >>> of'
540         $        ,ibest
541    
542   122     continue   122     continue
543    
544    
545  *     --- and store the results --------------------------------  *     --- and store the results --------------------------------
546           ntrk = ntrk + 1                   !counter of found tracks           ntrk = ntrk + 1                   !counter of found tracks
547           if(.not.FIMAGE           if(.not.FIMAGE
# Line 438  c         print*,'++++++++++ iimage,fima Line 554  c         print*,'++++++++++ iimage,fima
554  c     $        ,iimage,fimage,ntrk,image(ntrk)  c     $        ,iimage,fimage,ntrk,image(ntrk)
555    
556           if(ntrk.eq.NTRKMAX)then           if(ntrk.eq.NTRKMAX)then
557              if(verbose)              if(verbose.eq.1)
558       $           print*,       $           print*,
559       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
560       $           'tracks exceeds vector dimension '       $           'tracks exceeds vector dimension '
# Line 474  cc            good2=.false. Line 590  cc            good2=.false.
590       $        rchi2best.le.CHI2MAX.and.       $        rchi2best.le.CHI2MAX.and.
591  c     $        rchi2best.lt.15..and.  c     $        rchi2best.lt.15..and.
592       $        .true.)then       $        .true.)then
593              if(DEBUG)then              if(DEBUG.EQ.1)then
594                 print*,'***** NEW SEARCH ****'                 print*,'***** NEW SEARCH ****'
595              endif              endif
596              goto 11111          !try new search              goto 11111          !try new search
# Line 596  c$$$      print*,icx,icy,sensor,PFAx,PFA Line 712  c$$$      print*,icx,icy,sensor,PFAx,PFA
712        zPAM_B = 0.        zPAM_B = 0.
713  c      print*,'## xyz_PAM: ',icx,icy,sensor,PFAx,PFAy,angx,angy  c      print*,'## xyz_PAM: ',icx,icy,sensor,PFAx,PFAy,angx,angy
714    
715          if(sensor.lt.1.or.sensor.gt.2)then
716             print*,'xyz_PAM   ***ERROR*** wrong input '
717             print*,'sensor ',sensor
718             icx=0
719             icy=0
720          endif
721    
722  *     -----------------  *     -----------------
723  *     CLUSTER X  *     CLUSTER X
724  *     -----------------  *     -----------------      
   
725        if(icx.ne.0)then        if(icx.ne.0)then
726    
727           viewx   = VIEW(icx)           viewx   = VIEW(icx)
728           nldx    = nld(MAXS(icx),VIEW(icx))           nldx    = nld(MAXS(icx),VIEW(icx))
729           nplx    = npl(VIEW(icx))           nplx    = npl(VIEW(icx))
730           resxPAM = RESXAV  c         resxPAM = RESXAV
731           stripx  = float(MAXS(icx))           stripx  = float(MAXS(icx))
732    
733             if(
734         $        viewx.lt.1.or.        
735         $        viewx.gt.12.or.
736         $        nldx.lt.1.or.
737         $        nldx.gt.3.or.
738         $        stripx.lt.1.or.
739         $        stripx.gt.3072.or.
740         $        .false.)then
741                print*,'xyz_PAM   ***ERROR*** wrong input '
742                print*,'icx ',icx,'view ',viewx,'nld ',nldx,'strip ',stripx
743                icx = 0
744                goto 10
745             endif
746    
747  *        --------------------------  *        --------------------------
748  *        magnetic-field corrections  *        magnetic-field corrections
749  *        --------------------------  *        --------------------------
750           angtemp  = ax           stripx  = stripx +  fieldcorr(viewx,bfy)      
751           bfytemp  = bfy           angx    = effectiveangle(ax,viewx,bfy)
 *        /////////////////////////////////  
 *        AAAAHHHHHHHH!!!!!!!!!!!!!!!!!!!!!  
 *        *grvzkkjsdgjhhhgngbn###>:(  
 *        /////////////////////////////////  
 c         if(nplx.eq.6) angtemp = -1. * ax  
 c         if(nplx.eq.6) bfytemp = -1. * bfy  
          if(viewx.eq.12) angtemp = -1. * ax  
          if(viewx.eq.12) bfytemp = -1. * bfy  
          tgtemp   = tan(angtemp*acos(-1.)/180.) + pmuH_h*bfytemp*0.00001  
          angx     = 180.*atan(tgtemp)/acos(-1.)  
          stripx   = stripx - 0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX  
 c$$$         print*,nplx,ax,bfy/10.  
 c$$$         print*,angx,0.5*pmuH_h*bfytemp*0.00001*SiDimZ/pitchX  
 c$$$         print*,'========================'  
 c$$$         if(bfy.ne.0.)print*,viewx,'-x- '  
 c$$$     $        ,bfy,-1*0.5*pmuH_h*bfytemp*0.00001*SiDimZ  
 *        --------------------------  
   
 c$$$         print*,'--- x-cl ---'  
 c$$$         istart = INDSTART(ICX)  
 c$$$         istop  = TOTCLLENGTH  
 c$$$         if(icx.lt.NCLSTR1)istop=INDSTART(ICX+1)-1  
 c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)  
 c$$$         print*,(CLSIGNAL(i),i=istart,istop)  
 c$$$         print*,INDMAX(icx)  
 c$$$         print*,cog(4,icx)  
 c$$$         print*,fbad_cog(4,icx)  
752                    
753             call applypfa(PFAx,icx,angx,corr,res)
754             stripx  = stripx + corr
755             resxPAM = res
756    
757           if(PFAx.eq.'COG1')then   10   endif
758        
             stripx  = stripx  
             resxPAM = 1e-4*pitchX/sqrt(12.)!!resxPAM  
   
          elseif(PFAx.eq.'COG2')then  
   
             stripx  = stripx + cog(2,icx)              
             resxPAM = risx_cog(abs(angx))!TEMPORANEO                
             resxPAM = resxPAM*fbad_cog(2,icx)  
   
          elseif(PFAx.eq.'COG3')then  
   
             stripx  = stripx + cog(3,icx)              
             resxPAM = risx_cog(abs(angx))!TEMPORANEO                        
             resxPAM = resxPAM*fbad_cog(3,icx)  
   
          elseif(PFAx.eq.'COG4')then  
   
             stripx  = stripx + cog(4,icx)              
             resxPAM = risx_cog(abs(angx))!TEMPORANEO                        
             resxPAM = resxPAM*fbad_cog(4,icx)  
   
          elseif(PFAx.eq.'ETA2')then  
   
             stripx  = stripx + pfaeta2(icx,angx)            
             resxPAM = risx_eta2(abs(angx))  
             resxPAM = resxPAM*fbad_cog(2,icx)  
             if(DEBUG.and.fbad_cog(2,icx).ne.1)  
      $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)  
   
          elseif(PFAx.eq.'ETA3')then                          
   
             stripx  = stripx + pfaeta3(icx,angx)            
             resxPAM = risx_eta3(abs(angx))                        
             resxPAM = resxPAM*fbad_cog(3,icx)                
             if(DEBUG.and.fbad_cog(3,icx).ne.1)              
      $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)  
   
          elseif(PFAx.eq.'ETA4')then                          
   
             stripx  = stripx + pfaeta4(icx,angx)              
             resxPAM = risx_eta4(abs(angx))                        
             resxPAM = resxPAM*fbad_cog(4,icx)                
             if(DEBUG.and.fbad_cog(4,icx).ne.1)                
      $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)  
   
          elseif(PFAx.eq.'ETA')then    
   
             stripx  = stripx + pfaeta(icx,angx)              
             resxPAM = ris_eta(icx,angx)                      
             resxPAM = resxPAM*fbad_eta(icx,angx)              
             if(DEBUG.and.fbad_cog(2,icx).ne.1)                
      $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)  
   
          elseif(PFAx.eq.'COG')then            
   
             stripx  = stripx + cog(0,icx)              
             resxPAM = risx_cog(abs(angx))                      
             resxPAM = resxPAM*fbad_cog(0,icx)  
   
          else  
             if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx  
          endif  
   
   
 *     ======================================  
 *     temporary patch for saturated clusters  
 *     ======================================  
          if( nsatstrips(icx).gt.0 )then  
             stripx  = stripx + cog(4,icx)              
             resxPAM = pitchX*1e-4/sqrt(12.)  
             cc=cog(4,icx)  
 c$$$            print*,icx,' *** ',cc  
 c$$$            print*,icx,' *** ',resxPAM  
          endif  
   
       endif  
         
759  *     -----------------  *     -----------------
760  *     CLUSTER Y  *     CLUSTER Y
761  *     -----------------  *     -----------------
# Line 729  c$$$            print*,icx,' *** ',resxP Line 765  c$$$            print*,icx,' *** ',resxP
765           viewy = VIEW(icy)           viewy = VIEW(icy)
766           nldy = nld(MAXS(icy),VIEW(icy))           nldy = nld(MAXS(icy),VIEW(icy))
767           nply = npl(VIEW(icy))           nply = npl(VIEW(icy))
768           resyPAM = RESYAV  c         resyPAM = RESYAV
769           stripy = float(MAXS(icy))           stripy = float(MAXS(icy))
770    
771             if(
772         $        viewy.lt.1.or.        
773         $        viewy.gt.12.or.
774         $        nldy.lt.1.or.
775         $        nldy.gt.3.or.
776         $        stripy.lt.1.or.
777         $        stripy.gt.3072.or.
778         $        .false.)then
779                print*,'xyz_PAM   ***ERROR*** wrong input '
780                print*,'icy ',icy,'view ',viewy,'nld ',nldy,'strip ',stripy
781                icy = 0
782                goto 20
783             endif
784    
785           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
786              if(DEBUG) then              if(DEBUG.EQ.1) then
787                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '                 print*,'xyz_PAM   ***ERROR*** invalid cluster couple!!! '
788       $              ,icx,icy       $              ,icx,icy
789              endif              endif
790              goto 100              goto 100
791           endif           endif
792    
793  *        --------------------------  *        --------------------------
794  *        magnetic-field corrections  *        magnetic-field corrections
795  *        --------------------------  *        --------------------------
796           tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001                   stripy  = stripy +  fieldcorr(viewy,bfx)      
797           angy    = 180.*atan(tgtemp)/acos(-1.)           angy    = effectiveangle(ay,viewy,bfx)
          stripy = stripy + 0.5*pmuH_e*bfx*0.00001*SiDimZ/pitchY  
 c$$$         if(bfx.ne.0.)print*,viewy,'-y- '  
 c$$$     $        ,bfx,0.5*pmuH_e*bfx*0.00001*SiDimZ  
 *        --------------------------  
798                    
799  c$$$         print*,'--- y-cl ---'           call applypfa(PFAy,icy,angy,corr,res)
800  c$$$         istart = INDSTART(ICY)           stripy  = stripy + corr
801  c$$$         istop  = TOTCLLENGTH           resyPAM = res
 c$$$         if(icy.lt.NCLSTR1)istop=INDSTART(ICY+1)-1  
 c$$$         print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)  
 c$$$         print*,(CLSIGNAL(i),i=istart,istop)  
 c$$$         print*,INDMAX(icy)  
 c$$$         print*,cog(4,icy)  
 c$$$         print*,fbad_cog(4,icy)  
   
          if(PFAy.eq.'COG1')then  
   
             stripy  = stripy      
             resyPAM = 1e-4*pitchY/sqrt(12.)!resyPAM    
   
          elseif(PFAy.eq.'COG2')then  
   
             stripy  = stripy + cog(2,icy)  
             resyPAM = risy_cog(abs(angy))!TEMPORANEO  
             resyPAM = resyPAM*fbad_cog(2,icy)  
   
          elseif(PFAy.eq.'COG3')then  
   
             stripy  = stripy + cog(3,icy)  
             resyPAM = risy_cog(abs(angy))!TEMPORANEO  
             resyPAM = resyPAM*fbad_cog(3,icy)  
   
          elseif(PFAy.eq.'COG4')then  
   
             stripy  = stripy + cog(4,icy)  
             resyPAM = risy_cog(abs(angy))!TEMPORANEO  
             resyPAM = resyPAM*fbad_cog(4,icy)  
   
          elseif(PFAy.eq.'ETA2')then  
   
             stripy  = stripy + pfaeta2(icy,angy)            
             resyPAM = risy_eta2(abs(angy))                
             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                        
   
             stripy  = stripy + pfaeta3(icy,angy)  
             resyPAM = resyPAM*fbad_cog(3,icy)    
             if(DEBUG.and.fbad_cog(3,icy).ne.1)  
      $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)  
802    
803           elseif(PFAy.eq.'ETA4')then     20   endif
   
             stripy  = stripy + pfaeta4(icy,angy)  
             resyPAM = resyPAM*fbad_cog(4,icy)  
             if(DEBUG.and.fbad_cog(4,icy).ne.1)  
      $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)  
   
          elseif(PFAy.eq.'ETA')then  
   
             stripy  = stripy + pfaeta(icy,angy)  
             resyPAM = ris_eta(icy,angy)    
             resyPAM = resyPAM*fbad_eta(icy,angy)  
             if(DEBUG.and.fbad_cog(2,icy).ne.1)  
      $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)  
   
          elseif(PFAy.eq.'COG')then  
   
             stripy  = stripy + cog(0,icy)              
             resyPAM = risy_cog(abs(angy))  
             resyPAM = resyPAM*fbad_cog(0,icy)  
   
          else  
             if(DEBUG) print*,'*** Non valid p.f.a. (x) --> ',PFAx  
          endif  
   
   
 *     ======================================  
 *     temporary patch for saturated clusters  
 *     ======================================  
          if( nsatstrips(icy).gt.0 )then  
             stripy  = stripy + cog(4,icy)              
             resyPAM = pitchY*1e-4/sqrt(12.)  
             cc=cog(4,icy)  
 c$$$            print*,icy,' *** ',cc  
 c$$$            print*,icy,' *** ',resyPAM  
          endif  
   
   
       endif  
804    
805  c$$$      print*,'## stripx,stripy ',stripx,stripy  c$$$      print*,'## stripx,stripy ',stripx,stripy
806    
# Line 849  c     (xi,yi,zi) = mechanical coordinate Line 814  c     (xi,yi,zi) = mechanical coordinate
814  c------------------------------------------------------------------------  c------------------------------------------------------------------------
815           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)           if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
816       $        .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...
817              if(DEBUG) then              if(DEBUG.EQ.1) then
818                 print*,'xyz_PAM (couple):',                 print*,'xyz_PAM (couple):',
819       $              ' WARNING: false X strip: strip ',stripx       $              ' WARNING: false X strip: strip ',stripx
820              endif              endif
# Line 858  c--------------------------------------- Line 823  c---------------------------------------
823           yi = acoordsi(stripy,viewy)           yi = acoordsi(stripy,viewy)
824           zi = 0.           zi = 0.
825                    
   
826  c------------------------------------------------------------------------  c------------------------------------------------------------------------
827  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame  c     (xrt,yrt,zrt) = rototranslated coordinates in the silicon sensor frame
828  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 944  c            print*,'X-singlet ',icx,npl Line 908  c            print*,'X-singlet ',icx,npl
908  c            if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...  c            if((stripx.le.3).or.(stripx.ge.1022)) then !X has 1018 strips...
909              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)              if(((mod(int(stripx+0.5)-1,1024)+1).le.3)
910       $           .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...
911                 if(DEBUG) then                 if(DEBUG.EQ.1) then
912                    print*,'xyz_PAM (X-singlet):',                    print*,'xyz_PAM (X-singlet):',
913       $                 ' WARNING: false X strip: strip ',stripx       $                 ' WARNING: false X strip: strip ',stripx
914                 endif                 endif
# Line 969  c            print*,'X-cl ',icx,stripx,' Line 933  c            print*,'X-cl ',icx,stripx,'
933  c            print*,yi_A,' <--> ',yi_B  c            print*,yi_A,' <--> ',yi_B
934    
935           else           else
936              if(DEBUG) then              if(DEBUG.EQ.1) then
937                 print *,'routine xyz_PAM ---> not properly used !!!'                 print *,'routine xyz_PAM ---> not properly used !!!'
938                 print *,'icx = ',icx                 print *,'icx = ',icx
939                 print *,'icy = ',icy                 print *,'icy = ',icy
# Line 1038  c--------------------------------------- Line 1002  c---------------------------------------
1002  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'  c         print*,'A-(',xPAM_A,yPAM_A,') B-(',xPAM_B,yPAM_B,')'
1003    
1004        else        else
1005           if(DEBUG) then           if(DEBUG.EQ.1) then
1006              print *,'routine xyz_PAM ---> not properly used !!!'              print *,'routine xyz_PAM ---> not properly used !!!'
1007              print *,'icx = ',icx              print *,'icx = ',icx
1008              print *,'icy = ',icy              print *,'icy = ',icy
# Line 1082  c$$$      common/FINALPFA/PFA Line 1046  c$$$      common/FINALPFA/PFA
1046                
1047  c$$$      PFAx = 'COG4'!PFA  c$$$      PFAx = 'COG4'!PFA
1048  c$$$      PFAy = 'COG4'!PFA  c$$$      PFAy = 'COG4'!PFA
1049    
1050    
1051          if(icx.gt.nclstr1.or.icy.gt.nclstr1)then
1052                print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1053         $           ,' does not exists (nclstr1=',nclstr1,')'
1054                icx = -1*icx
1055                icy = -1*icy
1056                return
1057            
1058          endif
1059                
1060        call idtoc(pfaid,PFAx)        call idtoc(pfaid,PFAx)
1061        call idtoc(pfaid,PFAy)        call idtoc(pfaid,PFAy)
1062    
1063        call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)  cc      print*,PFAx,PFAy
1064    
1065    c$$$      call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1066    
1067  c$$$      print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy  c$$$      print*,icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy
1068                
# Line 1094  c$$$      print*,icx,icy,sensor,PFAx,PFA Line 1070  c$$$      print*,icx,icy,sensor,PFAx,PFA
1070    
1071           ipx=npl(VIEW(icx))           ipx=npl(VIEW(icx))
1072           ipy=npl(VIEW(icy))           ipy=npl(VIEW(icy))
1073           if( (nplanes-ipx+1).ne.ip.or.(nplanes-ipy+1).ne.ip )  c$$$         if( (nplanes-ipx+1).ne.ip.or.(nplanes-ipy+1).ne.ip )
1074       $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy  c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1075       $        ,' does not belong to the correct plane: ',ip,ipx,ipy  c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1076            
1077             if( (nplanes-ipx+1).ne.ip )then
1078                print*,'xyzpam: ***WARNING*** cluster ',icx
1079         $           ,' does not belong to plane: ',ip
1080                icx = -1*icx
1081                return
1082             endif
1083             if( (nplanes-ipy+1).ne.ip )then
1084                print*,'xyzpam: ***WARNING*** cluster ',icy
1085         $           ,' does not belong to plane: ',ip
1086                icy = -1*icy
1087                return
1088             endif
1089    
1090             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1091    
1092           xgood(ip) = 1.           xgood(ip) = 1.
1093           ygood(ip) = 1.           ygood(ip) = 1.
# Line 1116  c         zv(ip) = zPAM Line 1107  c         zv(ip) = zPAM
1107        elseif(icx.eq.0.and.icy.ne.0)then        elseif(icx.eq.0.and.icy.ne.0)then
1108    
1109           ipy=npl(VIEW(icy))           ipy=npl(VIEW(icy))
1110           if((nplanes-ipy+1).ne.ip)  c$$$         if((nplanes-ipy+1).ne.ip)
1111       $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy  c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1112       $        ,' does not belong to the correct plane: ',ip,ipx,ipy  c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1113             if( (nplanes-ipy+1).ne.ip )then
1114                print*,'xyzpam: ***WARNING*** cluster ',icy
1115         $           ,' does not belong to plane: ',ip
1116                icy = -1*icy
1117                return
1118             endif
1119    
1120             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1121            
1122           xgood(ip) = 0.           xgood(ip) = 0.
1123           ygood(ip) = 1.           ygood(ip) = 1.
1124           resx(ip)  = 1000.           resx(ip)  = 1000.
# Line 1138  c         zv(ip) = (zPAM_A+zPAM_B)/2. Line 1137  c         zv(ip) = (zPAM_A+zPAM_B)/2.
1137        elseif(icx.ne.0.and.icy.eq.0)then        elseif(icx.ne.0.and.icy.eq.0)then
1138    
1139           ipx=npl(VIEW(icx))           ipx=npl(VIEW(icx))
1140           if((nplanes-ipx+1).ne.ip)  c$$$         if((nplanes-ipx+1).ne.ip)
1141       $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy  c$$$     $        print*,'xyzpam: ***WARNING*** clusters ',icx,icy
1142       $        ,' does not belong to the correct plane: ',ip,ipx,ipy  c$$$     $        ,' does not belong to the correct plane: ',ip,ipx,ipy
1143    
1144             if( (nplanes-ipx+1).ne.ip )then
1145                print*,'xyzpam: ***WARNING*** cluster ',icx
1146         $           ,' does not belong to plane: ',ip
1147                icx = -1*icx
1148                return
1149             endif
1150    
1151             call xyz_PAM(icx,icy,sensor,PFAx,PFAy,ax,ay,bfx,bfy)
1152          
1153           xgood(ip) = 1.           xgood(ip) = 1.
1154           ygood(ip) = 0.           ygood(ip) = 0.
1155           resx(ip)  = resxPAM           resx(ip)  = resxPAM
# Line 1182  c         zv(ip) = z_mech_sensor(nplanes Line 1190  c         zv(ip) = z_mech_sensor(nplanes
1190    
1191        endif        endif
1192    
1193        if(DEBUG)then        if(DEBUG.EQ.1)then
1194  c         print*,'----------------------------- track coord'  c         print*,'----------------------------- track coord'
1195  22222    format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)  22222    format(i2,' * ',3f10.4,' --- ',4f10.4,' --- ',2f4.0,2f10.5)
1196           write(*,22222)ip,zm(ip),xm(ip),ym(ip)           write(*,22222)ip,zm(ip),xm(ip),ym(ip)
# Line 1633  c      include 'level1.f' Line 1641  c      include 'level1.f'
1641        integer iflag        integer iflag
1642    
1643        integer badseed,badclx,badcly        integer badseed,badclx,badcly
1644        
1645          if(DEBUG.EQ.1)print*,'cl_to_couples:'
1646    
1647  *     init variables  *     init variables
1648        ncp_tot=0        ncp_tot=0
# Line 1663  c      include 'level1.f' Line 1673  c      include 'level1.f'
1673  *     mask views with too many clusters  *     mask views with too many clusters
1674        do iv=1,nviews        do iv=1,nviews
1675           if( ncl_view(iv).gt. nclusterlimit)then           if( ncl_view(iv).gt. nclusterlimit)then
1676              mask_view(iv) = 1  c            mask_view(iv) = 1
1677              if(DEBUG)print*,' * WARNING * cl_to_couple: n.clusters > '              mask_view(iv) = mask_view(iv) + 2**0
1678       $           ,nclusterlimit,' on view ', iv,' --> masked!'              if(DEBUG.EQ.1)
1679         $        print*,' * WARNING * cl_to_couple: n.clusters > '
1680         $        ,nclusterlimit,' on view ', iv,' --> masked!'
1681           endif           endif
1682        enddo        enddo
1683    
# Line 1803  c                  cut = chcut * sch(npl Line 1815  c                  cut = chcut * sch(npl
1815                 endif                 endif
1816    
1817                 if(ncp_plane(nplx).gt.ncouplemax)then                 if(ncp_plane(nplx).gt.ncouplemax)then
1818                    if(verbose)print*,                    if(verbose.eq.1)print*,
1819       $                 '** warning ** number of identified '//       $                 '** warning ** number of identified '//
1820       $                 'couples on plane ',nplx,       $                 'couples on plane ',nplx,
1821       $                 'exceeds vector dimention '       $                 'exceeds vector dimention '
1822       $                 ,'( ',ncouplemax,' ) --> masked!'       $                 ,'( ',ncouplemax,' ) --> masked!'
1823                    mask_view(nviewx(nplx)) = 2  c                  mask_view(nviewx(nplx)) = 2
1824                    mask_view(nviewy(nply)) = 2  c                  mask_view(nviewy(nply)) = 2
1825                      mask_view(nviewx(nplx))= mask_view(nviewx(nplx))+ 2**1
1826                      mask_view(nviewy(nply))= mask_view(nviewy(nply))+ 2**1
1827                    goto 10                    goto 10
1828                 endif                 endif
1829                                
# Line 1839  c                  cut = chcut * sch(npl Line 1853  c                  cut = chcut * sch(npl
1853        enddo        enddo
1854                
1855                
1856        if(DEBUG)then        if(DEBUG.EQ.1)then
1857           print*,'clusters  ',nclstr1           print*,'clusters  ',nclstr1
1858           print*,'good    ',(cl_good(i),i=1,nclstr1)           print*,'good    ',(cl_good(i),i=1,nclstr1)
1859           print*,'singles ',(cl_single(i),i=1,nclstr1)           print*,'singlets',(cl_single(i),i=1,nclstr1)
1860           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
1861        endif        endif
1862                
# Line 1902  c      double precision xm3,ym3,zm3 Line 1916  c      double precision xm3,ym3,zm3
1916        real xc,zc,radius        real xc,zc,radius
1917  *     -----------------------------  *     -----------------------------
1918    
1919          if(DEBUG.EQ.1)print*,'cp_to_doubtrip:'
1920    
1921  *     --------------------------------------------  *     --------------------------------------------
1922  *     put a limit to the maximum number of couples  *     put a limit to the maximum number of couples
# Line 1910  c      double precision xm3,ym3,zm3 Line 1925  c      double precision xm3,ym3,zm3
1925  *     --------------------------------------------  *     --------------------------------------------
1926        do ip=1,nplanes        do ip=1,nplanes
1927           if(ncp_plane(ip).gt.ncouplelimit)then           if(ncp_plane(ip).gt.ncouplelimit)then
1928              mask_view(nviewx(ip)) = 8  c            mask_view(nviewx(ip)) = 8
1929              mask_view(nviewy(ip)) = 8  c            mask_view(nviewy(ip)) = 8
1930                mask_view(nviewx(ip)) = mask_view(nviewx(ip)) + 2**7
1931                mask_view(nviewy(ip)) = mask_view(nviewy(ip)) + 2**7
1932           endif           endif
1933        enddo        enddo
1934    
# Line 1937  c     print*,'***',is1,xm1,ym1,zm1 Line 1954  c     print*,'***',is1,xm1,ym1,zm1
1954                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2                 do ip2=(ip1+1),nplanes !loop on planes - COPPIA 2
1955                    if(  mask_view(nviewx(ip2)).ne.0 .or.                    if(  mask_view(nviewx(ip2)).ne.0 .or.
1956       $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane       $                 mask_view(nviewy(ip2)).ne.0 )goto 20 !skip plane
1957                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    do is2=1,2    !loop on sensors -ndblt COPPIA 2                    
                       
1958                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2                       do icp2=1,ncp_plane(ip2) !loop on COPPIA 2
1959                          icx2=clx(ip2,icp2)                          icx2=clx(ip2,icp2)
1960                          icy2=cly(ip2,icp2)                          icy2=cly(ip2,icp2)
# Line 1957  c     $                       (icx2,icy2 Line 1973  c     $                       (icx2,icy2
1973  *     (2 couples needed)  *     (2 couples needed)
1974  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1975                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
1976                             if(verbose)print*,                             if(verbose.eq.1)print*,
1977       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
1978       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
1979       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
1980  c                           good2=.false.  c                           good2=.false.
1981  c                           goto 880 !fill ntp and go to next event  c                           goto 880 !fill ntp and go to next event
1982                             do iv=1,12                             do iv=1,12
1983                                mask_view(iv) = 3  c                              mask_view(iv) = 3
1984                                  mask_view(iv) = mask_view(iv)+ 2**2
1985                             enddo                             enddo
1986                             iflag=1                             iflag=1
1987                             return                             return
# Line 2020  c     $                               (i Line 2037  c     $                               (i
2037                                   ym3=yPAM                                   ym3=yPAM
2038                                   zm3=zPAM                                   zm3=zPAM
2039  *     find the circle passing through the three points  *     find the circle passing through the three points
2040    c$$$                                 call tricircle(3,xp,zp,angp,resp,chi
2041    c$$$     $                                ,xc,zc,radius,iflag)
2042                                     iflag = DEBUG
2043                                   call tricircle(3,xp,zp,angp,resp,chi                                   call tricircle(3,xp,zp,angp,resp,chi
2044       $                                ,xc,zc,radius,iflag)       $                                ,xc,zc,radius,iflag)
2045  c     print*,xc,zc,radius  c     print*,xc,zc,radius
# Line 2036  c     $                                 Line 2056  c     $                                
2056  *     (3 couples needed)  *     (3 couples needed)
2057  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2058                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
2059                                      if(verbose)print*,                                      if(verbose.eq.1)print*,
2060       $                     '** warning ** number of identified '//       $                     '** warning ** number of identified '//
2061       $                     'triplets exceeds vector dimention '       $                     'triplets exceeds vector dimention '
2062       $                    ,'( ',ntrpt_max,' )'       $                    ,'( ',ntrpt_max,' )'
2063  c                                    good2=.false.  c                                    good2=.false.
2064  c                                    goto 880 !fill ntp and go to next event  c                                    goto 880 !fill ntp and go to next event
2065                                      do iv=1,nviews                                      do iv=1,nviews
2066                                         mask_view(iv) = 4  c                                       mask_view(iv) = 4
2067                                           mask_view(iv)=mask_view(iv)+ 2**3
2068                                      enddo                                      enddo
2069                                      iflag=1                                      iflag=1
2070                                      return                                      return
# Line 2097  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp Line 2118  c     print*,alfaxz1(ntrpt),alfaxz2(ntrp
2118   10   continue   10   continue
2119        enddo                     !end loop on planes  - COPPIA 1        enddo                     !end loop on planes  - COPPIA 1
2120                
2121        if(DEBUG)then        if(DEBUG.EQ.1)then
2122           print*,'--- doublets ',ndblt           print*,'--- doublets ',ndblt
2123           print*,'--- triplets ',ntrpt           print*,'--- triplets ',ntrpt
2124        endif        endif
# Line 2144  c      include 'momanhough_init.f' Line 2165  c      include 'momanhough_init.f'
2165        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2166        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2167    
2168          if(DEBUG.EQ.1)print*,'doub_to_YZcloud:'
2169    
2170  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2171  *     classification of DOUBLETS  *     classification of DOUBLETS
# Line 2270  c         if(ncpused.lt.ncpyz_min)goto 2 Line 2292  c         if(ncpused.lt.ncpyz_min)goto 2
2292  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2293    
2294           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2295              if(verbose)print*,              if(verbose.eq.1)print*,
2296       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2297       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2298       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2299  c               good2=.false.  c               good2=.false.
2300  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2301              do iv=1,nviews              do iv=1,nviews
2302                 mask_view(iv) = 5  c               mask_view(iv) = 5
2303                   mask_view(iv) = mask_view(iv) + 2**4
2304              enddo              enddo
2305              iflag=1              iflag=1
2306              return              return
# Line 2297  c     ptcloud_yz_nt(nclouds_yz)=npt Line 2320  c     ptcloud_yz_nt(nclouds_yz)=npt
2320  c     print*,'>> ',ipt,db_all(ipt)  c     print*,'>> ',ipt,db_all(ipt)
2321           enddo             enddo  
2322           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2323           if(DEBUG)then           if(DEBUG.EQ.1)then
2324              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'
2325              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'              print*,'>>>> cloud ',nclouds_yz,' --- ',npt,' points'
2326              print*,'- alfayz1 ',alfayz1_av(nclouds_yz)              print*,'- alfayz1  ',alfayz1_av(nclouds_yz)
2327              print*,'- alfayz2 ',alfayz2_av(nclouds_yz)              print*,'- alfayz2  ',alfayz2_av(nclouds_yz)
2328              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2329              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2330              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'cpcloud_yz '
2331         $           ,(cpcloud_yz(nclouds_yz,icp),icp=1,ncp_tot)
2332                print*,'hit_plane  ',(hit_plane(ip),ip=1,nplanes)
2333  c$$$            print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '  c$$$            print*,'nt-uple: ptcloud_yz(',nclouds_yz,') = '
2334  c$$$     $           ,ptcloud_yz(nclouds_yz)  c$$$     $           ,ptcloud_yz(nclouds_yz)
2335  c$$$            print*,'nt-uple: db_cloud(...) = '  c$$$            print*,'nt-uple: db_cloud(...) = '
# Line 2322  c$$$     $           ,(db_cloud(iii),iii Line 2347  c$$$     $           ,(db_cloud(iii),iii
2347          goto 90                          goto 90                
2348        endif                            endif                    
2349                
2350        if(DEBUG)then        if(DEBUG.EQ.1)then
2351           print*,'---------------------- '           print*,'---------------------- '
2352           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
2353           print*,' '           print*,' '
# Line 2371  c      include 'momanhough_init.f' Line 2396  c      include 'momanhough_init.f'
2396        integer cp_useds1(ncouplemaxtot) ! sensor 1        integer cp_useds1(ncouplemaxtot) ! sensor 1
2397        integer cp_useds2(ncouplemaxtot) ! sensor 2        integer cp_useds2(ncouplemaxtot) ! sensor 2
2398    
2399          if(DEBUG.EQ.1)print*,'trip_to_XZcloud:'
2400    
2401  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2402  *     classification of TRIPLETS  *     classification of TRIPLETS
2403  *     according to distance in parameter space  *     according to distance in parameter space
# Line 2428  c         tr_temp(1)=itr1 Line 2455  c         tr_temp(1)=itr1
2455       $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2                     $              +((alfaxz2(itrref)-alfaxz2(itr2))/Dalfaxz2)**2              
2456                 distance = sqrt(distance)                 distance = sqrt(distance)
2457                                
2458                 if(distance.lt.cutdistxz)then  *     ------------------------------------------------------------------------
2459    *     FORCE INCLUSION OF TRIPLETS COMPOSED BY SAME COUPLES, IGNORING THE IMAGE
2460    *     ------------------------------------------------------------------------
2461    *     (added in august 2007)
2462                   istrimage=0
2463                   if(
2464         $              abs(cpxz1(itrref)).eq.abs(cpxz1(itr2)).and.
2465         $              abs(cpxz2(itrref)).eq.abs(cpxz2(itr2)).and.
2466         $              abs(cpxz3(itrref)).eq.abs(cpxz3(itr2)).and.
2467         $              .true.)istrimage=1
2468    
2469                   if(distance.lt.cutdistxz.or.istrimage.eq.1)then
2470  c     print*,idb1,idb2,distance,' cloud ',nclouds_yz  c     print*,idb1,idb2,distance,' cloud ',nclouds_yz
2471                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1                    if(cpxz1(itr2).gt.0)cp_useds2(cpxz1(itr2))=1
2472                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1                    if(cpxz1(itr2).lt.0)cp_useds1(-cpxz1(itr2))=1
# Line 2492  c         if(ncpused.lt.ncpxz_min)goto 2 Line 2530  c         if(ncpused.lt.ncpxz_min)goto 2
2530  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2531  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2532           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2533              if(verbose)print*,              if(verbose.eq.1)print*,
2534       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2535       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2536       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2537  c     good2=.false.  c     good2=.false.
2538  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2539              do iv=1,nviews              do iv=1,nviews
2540                 mask_view(iv) = 6  c               mask_view(iv) = 6
2541                   mask_view(iv) =  mask_view(iv) + 2**5
2542              enddo              enddo
2543              iflag=1              iflag=1
2544              return              return
# Line 2518  c     goto 880         !fill ntp and go Line 2557  c     goto 880         !fill ntp and go
2557           enddo           enddo
2558           npt_tot=npt_tot+npt           npt_tot=npt_tot+npt
2559                    
2560           if(DEBUG)then           if(DEBUG.EQ.1)then
2561              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'              print*,'-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~'
2562              print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'                            print*,'>>>> cloud ',nclouds_xz,' --- ',npt,' points'              
2563              print*,'- alfaxz1 ',alfaxz1_av(nclouds_xz)              print*,'- alfaxz1  ',alfaxz1_av(nclouds_xz)
2564              print*,'- alfaxz2 ',alfaxz2_av(nclouds_xz)              print*,'- alfaxz2  ',alfaxz2_av(nclouds_xz)
2565              print*,'- alfaxz3 ',alfaxz3_av(nclouds_xz)              print*,'- alfaxz3  ',alfaxz3_av(nclouds_xz)
2566              print*,'cp_useds1 ',(cp_useds1(icp),icp=1,ncp_tot)              print*,'cp_useds1  ',(cp_useds1(icp),icp=1,ncp_tot)
2567              print*,'cp_useds2 ',(cp_useds2(icp),icp=1,ncp_tot)              print*,'cp_useds2  ',(cp_useds2(icp),icp=1,ncp_tot)
2568                print*,'cpcloud_xz '
2569         $           ,(cpcloud_xz(nclouds_xz,icp),icp=1,ncp_tot)
2570              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)              print*,'hit_plane ',(hit_plane(ip),ip=1,nplanes)
2571  c$$$            print*,'nt-uple: ptcloud_xz(',nclouds_xz,') = '  c$$$            print*,'nt-uple: ptcloud_xz(',nclouds_xz,') = '
2572  c$$$     $           ,ptcloud_xz(nclouds_xz)  c$$$     $           ,ptcloud_xz(nclouds_xz)
# Line 2543  c$$$     $           ,(tr_cloud(iii),iii Line 2584  c$$$     $           ,(tr_cloud(iii),iii
2584           goto 91                           goto 91                
2585         endif                             endif                    
2586                
2587        if(DEBUG)then        if(DEBUG.EQ.1)then
2588           print*,'---------------------- '           print*,'---------------------- '
2589           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
2590           print*,' '           print*,' '
# Line 2595  c$$$     $           ,(tr_cloud(iii),iii Line 2636  c$$$     $           ,(tr_cloud(iii),iii
2636  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2637  *     variables for track fitting  *     variables for track fitting
2638        double precision AL_INI(5)        double precision AL_INI(5)
 c      double precision tath  
2639  *     -----------------------------------------------------------  *     -----------------------------------------------------------
 c      real fitz(nplanes)        !z coordinates of the planes in cm  
2640    
2641          if(DEBUG.EQ.1)print*,'clouds_to_ctrack:'
2642    
2643    
2644        ntracks=0                 !counter of track candidates        ntracks=0                 !counter of track candidates
# Line 2620  c      real fitz(nplanes)        !z coor Line 2660  c      real fitz(nplanes)        !z coor
2660                 enddo                 enddo
2661              enddo              enddo
2662              ncp_ok=0              ncp_ok=0
2663              do icp=1,ncp_tot    !loop on couples              do icp=1,ncp_tot    !loop over couples
2664  *     get info on  *     get info on
2665                 cpintersec(icp)=min(                 cpintersec(icp)=min(
2666       $              cpcloud_yz(iyz,icp),       $              cpcloud_yz(iyz,icp),
# Line 2629  c      real fitz(nplanes)        !z coor Line 2669  c      real fitz(nplanes)        !z coor
2669       $    (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.       $    (cpcloud_yz(iyz,icp).eq.1.and.cpcloud_xz(ixz,icp).eq.2).or.
2670       $    (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.       $    (cpcloud_yz(iyz,icp).eq.2.and.cpcloud_xz(ixz,icp).eq.1).or.
2671       $              .false.)cpintersec(icp)=0       $              .false.)cpintersec(icp)=0
2672    *     cpintersec is >0 if yz and xz clouds contain the same image of couple icp
2673                 if(cpintersec(icp).ne.0)then                 if(cpintersec(icp).ne.0)then
2674                    ncp_ok=ncp_ok+1                      ncp_ok=ncp_ok+1  
2675                                        
# Line 2661  c      real fitz(nplanes)        !z coor Line 2702  c      real fitz(nplanes)        !z coor
2702                 nplused=nplused+ hit_plane(ip)                 nplused=nplused+ hit_plane(ip)
2703              enddo              enddo
2704                            
 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  
2705                            
2706              if(DEBUG)then              if(DEBUG.EQ.1)then
2707                 print*,'Combination ',iyz,ixz                 print*,'Combination ',iyz,ixz
2708       $              ,' db ',ptcloud_yz(iyz)       $              ,' db ',ptcloud_yz(iyz)
2709       $              ,' tr ',ptcloud_xz(ixz)       $              ,' tr ',ptcloud_xz(ixz)
2710       $              ,'  -----> # matching couples ',ncp_ok       $              ,'  -----> # matching couples ',ncp_ok
2711              endif              endif
2712    
2713    c            if(nplused.lt.nplxz_min)goto 888 !next combination
2714                if(nplused.lt.nplyz_min)goto 888 !next combination
2715                if(ncp_ok.lt.ncpok)goto 888 !next combination
2716    
2717  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2718  c$$$  print*,'Configurazione cluster XZ'  c$$$  print*,'Configurazione cluster XZ'
2719  c$$$  print*,'1 -- ',(clx(1,i),i=1,ncp_plane(1))  c$$$  print*,'1 -- ',(clx(1,i),i=1,ncp_plane(1))
# Line 2716  c$$$            AL_INI(5) = (1.e2*alfaxz Line 2759  c$$$            AL_INI(5) = (1.e2*alfaxz
2759  c$$$              c$$$            
2760  c$$$            if(AL_INI(5).gt.defmax)goto 888 !next cloud  c$$$            if(AL_INI(5).gt.defmax)goto 888 !next cloud
2761                                                    
2762              if(DEBUG)then              if(DEBUG.EQ.1)then
2763                   print*,'track candidate', ntracks+1
2764                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))                 print*,'1 >>> ',(cp_match(6,i),i=1,ncp_match(6))
2765                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))                 print*,'2 >>> ',(cp_match(5,i),i=1,ncp_match(5))
2766                 print*,'3 >>> ',(cp_match(4,i),i=1,ncp_match(4))                 print*,'3 >>> ',(cp_match(4,i),i=1,ncp_match(4))
# Line 2749  c$$$            if(AL_INI(5).gt.defmax)g Line 2793  c$$$            if(AL_INI(5).gt.defmax)g
2793                                hit_plane(6)=icp6                                hit_plane(6)=icp6
2794                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6                                if(ncp_match(6).eq.0)hit_plane(6)=0 !-icp6
2795                                                                
2796                                  *                             ---------------------------------------
2797    *                             check if this group of couples has been
2798    *                             already fitted    
2799    *                             ---------------------------------------
2800                                  do ica=1,ntracks
2801                                     isthesame=1
2802                                     do ip=1,NPLANES
2803                                        if(hit_plane(ip).ne.0)then
2804                                           if(  CP_STORE(nplanes-ip+1,ica)
2805         $                                      .ne.
2806         $                                      cp_match(ip,hit_plane(ip)) )
2807         $                                      isthesame=0
2808                                        else
2809                                           if(  CP_STORE(nplanes-ip+1,ica)
2810         $                                      .ne.
2811         $                                      0 )
2812         $                                      isthesame=0
2813                                        endif
2814                                     enddo
2815                                     if(isthesame.eq.1)then
2816                                        if(DEBUG.eq.1)
2817         $                                   print*,'(already fitted)'
2818                                        goto 666 !jump to next combination
2819                                     endif
2820                                  enddo
2821    
2822                                call track_init !init TRACK common                                call track_init !init TRACK common
2823    
2824                                do ip=1,nplanes !loop on planes                                do ip=1,nplanes !loop on planes (bottom to top)
2825                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2826                                      id=cp_match(ip,hit_plane(ip))                                      id=cp_match(ip,hit_plane(ip))
2827                                      is=is_cp(id)                                      is=is_cp(id)
# Line 2796  c$$$                              enddo Line 2865  c$$$                              enddo
2865                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
2866                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
2867                                iprint=0                                iprint=0
2868  c                              if(DEBUG)iprint=1  c                              if(DEBUG.EQ.1)iprint=1
2869                                if(DEBUG)iprint=2                                if(DEBUG.EQ.1)iprint=2
2870                                call mini2(jstep,ifail,iprint)                                call mini2(jstep,ifail,iprint)
2871                                if(ifail.ne.0) then                                if(ifail.ne.0) then
2872                                   if(DEBUG)then                                   if(DEBUG.EQ.1)then
2873                                      print *,                                      print *,
2874       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
2875       $                              //'(clouds_to_ctrack)'       $                              //'(clouds_to_ctrack)'
# Line 2825  c                                 chi2=- Line 2894  c                                 chi2=-
2894  *     --------------------------  *     --------------------------
2895                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
2896                                                                    
2897                                   if(verbose)print*,                                   if(verbose.eq.1)print*,
2898       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
2899       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
2900       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
2901  c                                 good2=.false.  c                                 good2=.false.
2902  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
2903                                   do iv=1,nviews                                   do iv=1,nviews
2904                                      mask_view(iv) = 7  c                                    mask_view(iv) = 7
2905                                        mask_view(iv) = mask_view(iv) + 2**6
2906                                   enddo                                   enddo
2907                                   iflag=1                                   iflag=1
2908                                   return                                   return
# Line 2840  c                                 goto 8 Line 2910  c                                 goto 8
2910                                                                
2911                                ntracks = ntracks + 1                                ntracks = ntracks + 1
2912                                                                
2913                                do ip=1,nplanes                                do ip=1,nplanes !top to bottom
2914    
2915                                   XV_STORE(ip,ntracks)=sngl(xv(ip))                                   XV_STORE(ip,ntracks)=sngl(xv(ip))
2916                                   YV_STORE(ip,ntracks)=sngl(yv(ip))                                   YV_STORE(ip,ntracks)=sngl(yv(ip))
# Line 2857  c                                 goto 8 Line 2927  c                                 goto 8
2927                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))                                   AYV_STORE(ip,ntracks)=sngl(ayv(ip))
2928                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))                                   XGOOD_STORE(ip,ntracks)=sngl(xgood(ip))
2929                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))                                   YGOOD_STORE(ip,ntracks)=sngl(ygood(ip))
2930    *                                NB! hit_plane is defined from bottom to top
2931                                   if(hit_plane(ip).ne.0)then                                   if(hit_plane(ip).ne.0)then
2932                                      CP_STORE(nplanes-ip+1,ntracks)=                                      CP_STORE(nplanes-ip+1,ntracks)=
2933       $                                   cp_match(ip,hit_plane(ip))       $                                   cp_match(ip,hit_plane(ip))
# Line 2872  c                                 goto 8 Line 2943  c                                 goto 8
2943                                      SENSOR_STORE(nplanes-ip+1,ntracks)=0                                      SENSOR_STORE(nplanes-ip+1,ntracks)=0
2944                                      LADDER_STORE(nplanes-ip+1,ntracks)=0                                      LADDER_STORE(nplanes-ip+1,ntracks)=0
2945                                   endif                                   endif
2946                                   BX_STORE(nplanes-ip+1,ntracks)=0!I dont need it now                                   BX_STORE(ip,ntracks)=0!I dont need it now
2947                                   BY_STORE(nplanes-ip+1,ntracks)=0!I dont need it now                                   BY_STORE(ip,ntracks)=0!I dont need it now
2948                                   CLS_STORE(nplanes-ip+1,ntracks)=0                                   CLS_STORE(ip,ntracks)=0
2949                                   do i=1,5                                   do i=1,5
2950                                      AL_STORE(i,ntracks)=sngl(AL(i))                                      AL_STORE(i,ntracks)=sngl(AL(i))
2951                                   enddo                                   enddo
# Line 2903  c                                 goto 8 Line 2974  c                                 goto 8
2974           return           return
2975        endif        endif
2976                
2977  c$$$      if(DEBUG)then  c$$$      if(DEBUG.EQ.1)then
2978  c$$$         print*,'****** TRACK CANDIDATES ***********'  c$$$         print*,'****** TRACK CANDIDATES ***********'
2979  c$$$         print*,'#         R. chi2        RIG'  c$$$         print*,'#         R. chi2        RIG'
2980  c$$$         do i=1,ntracks  c$$$         do i=1,ntracks
# Line 2912  c$$$     $           ,1./abs(AL_STORE(5, Line 2983  c$$$     $           ,1./abs(AL_STORE(5,
2983  c$$$         enddo  c$$$         enddo
2984  c$$$         print*,'***********************************'  c$$$         print*,'***********************************'
2985  c$$$      endif  c$$$      endif
2986        if(DEBUG)then        if(DEBUG.EQ.1)then
2987          print*,'****** TRACK CANDIDATES *****************'          print*,'****** TRACK CANDIDATES *****************'
2988          print*,'#         R. chi2        RIG         ndof'          print*,'#         R. chi2        RIG         ndof'
2989          do i=1,ntracks          do i=1,ntracks
# Line 2964  c$$$      endif Line 3035  c$$$      endif
3035        real xyzp(3),bxyz(3)        real xyzp(3),bxyz(3)
3036        equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))        equivalence (xp,xyzp(1)),(yp,xyzp(2)),(zp,xyzp(3))
3037    
3038          if(DEBUG.EQ.1)print*,'refine_track:'
3039  *     =================================================  *     =================================================
3040  *     new estimate of positions using ETA algorithm  *     new estimate of positions using ETA algorithm
3041  *                          and  *                          and
# Line 3045  c     $           AYV_STORE(nplanes-ip+1 Line 3117  c     $           AYV_STORE(nplanes-ip+1
3117              LADDER_STORE(nplanes-ip+1,IBEST)=nldt              LADDER_STORE(nplanes-ip+1,IBEST)=nldt
3118  *     --------------------------------------------------------------  *     --------------------------------------------------------------
3119    
3120              if(DEBUG)then              if(DEBUG.EQ.1)then
3121                 print*,                 print*,
3122       $              '------ Plane ',ip,' intersected on LADDER ',nldt       $              '------ Plane ',ip,' intersected on LADDER ',nldt
3123       $              ,' SENSOR ',ist       $              ,' SENSOR ',ist
# Line 3056  c     $           AYV_STORE(nplanes-ip+1 Line 3128  c     $           AYV_STORE(nplanes-ip+1
3128  *     ===========================================  *     ===========================================
3129  *     STEP 1 >>>>>>>  try to include a new couple  *     STEP 1 >>>>>>>  try to include a new couple
3130  *     ===========================================  *     ===========================================
3131  c            if(DEBUG)print*,'>>>> try to include a new couple'  c            if(DEBUG.EQ.1)print*,'>>>> try to include a new couple'
3132              distmin=1000000.              distmin=1000000.
3133              xmm = 0.              xmm = 0.
3134              ymm = 0.              ymm = 0.
# Line 3088  c     $              cl_used(icy).eq.1.o Line 3160  c     $              cl_used(icy).eq.1.o
3160                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3161  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3162                 id=id_cp(ip,icp,ist)                 id=id_cp(ip,icp,ist)
3163                 if(DEBUG)print*,'( couple ',id                 if(DEBUG.EQ.1)print*,'( couple ',id
3164       $              ,' ) distance ',distance       $              ,' ) distance ',distance
3165                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3166                    xmm = xPAM                    xmm = xPAM
# Line 3120  c            if(distmin.le.clinc)then   Line 3192  c            if(distmin.le.clinc)then  
3192                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<                 dedxtrk_y(nplanes-ip+1) = dedxmmy !<<<
3193  *              -----------------------------------  *              -----------------------------------
3194                 CP_STORE(nplanes-ip+1,ibest)=idm                       CP_STORE(nplanes-ip+1,ibest)=idm      
3195                 if(DEBUG)print*,'%%%% included couple ',idm                 if(DEBUG.EQ.1)print*,'%%%% included couple ',idm
3196       $              ,' (dist.= ',distmin,', cut ',clinc,' )'       $              ,' (dist.= ',distmin,', cut ',clinc,' )'
3197                 goto 133         !next plane                 goto 133         !next plane
3198              endif              endif
# Line 3128  c            if(distmin.le.clinc)then   Line 3200  c            if(distmin.le.clinc)then  
3200  *     STEP 2 >>>>>>>  try to include a single cluster  *     STEP 2 >>>>>>>  try to include a single cluster
3201  *                     either from a couple or single  *                     either from a couple or single
3202  *     ================================================  *     ================================================
3203  c            if(DEBUG)print*,'>>>> try to include a new cluster'  c            if(DEBUG.EQ.1)print*,'>>>> try to include a new cluster'
3204              distmin=1000000.              distmin=1000000.
3205              xmm_A = 0.          !---------------------------              xmm_A = 0.          !---------------------------
3206              ymm_A = 0.          ! init variables that              ymm_A = 0.          ! init variables that
# Line 3165  c     $              AXV_STORE(nplanes-i Line 3237  c     $              AXV_STORE(nplanes-i
3237       $              )                     $              )              
3238                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3239  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3240                 if(DEBUG)print*,'( cl-X ',icx                 if(DEBUG.EQ.1)print*,'( cl-X ',icx
3241       $              ,' in cp ',id,' ) distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3242                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3243                    xmm_A = xPAM_A                    xmm_A = xPAM_A
# Line 3198  c     $              0.,AYV_STORE(nplane Line 3270  c     $              0.,AYV_STORE(nplane
3270       $              )       $              )
3271                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3272  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3273                 if(DEBUG)print*,'( cl-Y ',icy                 if(DEBUG.EQ.1)print*,'( cl-Y ',icy
3274       $              ,' in cp ',id,' ) distance ',distance       $              ,' in cp ',id,' ) distance ',distance
3275                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3276                    xmm_A = xPAM_A                    xmm_A = xPAM_A
# Line 3243  c               if(cl_used(icl).eq.1.or. Line 3315  c               if(cl_used(icl).eq.1.or.
3315    
3316                 distance = distance_to(XP,YP)                 distance = distance_to(XP,YP)
3317  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI  c               distance = distance / RCHI2_STORE(ibest)!<<< MS !QUIQUI
3318                 if(DEBUG)print*,'( cl-s ',icl                 if(DEBUG.EQ.1)print*,'( cl-s ',icl
3319       $              ,' ) distance ',distance,'<',distmin,' ?'       $              ,' ) distance ',distance
3320                 if(distance.lt.distmin)then                 if(distance.lt.distmin)then
3321                    if(DEBUG)print*,'YES'  c                  if(DEBUG.EQ.1)print*,'YES'
3322                    xmm_A = xPAM_A                    xmm_A = xPAM_A
3323                    ymm_A = yPAM_A                    ymm_A = yPAM_A
3324                    zmm_A = zPAM_A                    zmm_A = zPAM_A
# Line 3292  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~ Line 3364  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~
3364                    if(mod(VIEW(iclm),2).eq.0)then                    if(mod(VIEW(iclm),2).eq.0)then
3365                       XGOOD(nplanes-ip+1)=1.                       XGOOD(nplanes-ip+1)=1.
3366                       resx(nplanes-ip+1)=rxmm                       resx(nplanes-ip+1)=rxmm
3367                       if(DEBUG)print*,'%%%% included X-cl ',iclm                       if(DEBUG.EQ.1)print*,'%%%% included X-cl ',iclm
3368       $                    ,'( chi^2, ',RCHI2_STORE(ibest)       $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3369       $                    ,', dist.= ',distmin       $                    ,', dist.= ',distmin
3370       $                    ,', cut ',clinc,' )'       $                    ,', cut ',clinc,' )'
3371                    else                    else
3372                       YGOOD(nplanes-ip+1)=1.                       YGOOD(nplanes-ip+1)=1.
3373                       resy(nplanes-ip+1)=rymm                       resy(nplanes-ip+1)=rymm
3374                       if(DEBUG)print*,'%%%% included Y-cl ',iclm                       if(DEBUG.EQ.1)print*,'%%%% included Y-cl ',iclm
3375       $                    ,'( chi^2, ',RCHI2_STORE(ibest)       $                    ,'( chi^2, ',RCHI2_STORE(ibest)
3376       $                    ,', dist.= ', distmin       $                    ,', dist.= ', distmin
3377       $                    ,', cut ',clinc,' )'       $                    ,', cut ',clinc,' )'
# Line 3341  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~ Line 3413  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~
3413        include 'common_momanhough.f'        include 'common_momanhough.f'
3414        include 'level2.f'              include 'level2.f'      
3415    
3416          if(DEBUG.EQ.1)print*,'clean_XYclouds:'
3417    
3418        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
3419    
3420           id=CP_STORE(nplanes-ip+1,ibest)           id=CP_STORE(nplanes-ip+1,ibest)
# Line 3349  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~ Line 3423  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~
3423              if(id.ne.0)then              if(id.ne.0)then
3424                 iclx=clx(ip,icp_cp(id))                 iclx=clx(ip,icp_cp(id))
3425                 icly=cly(ip,icp_cp(id))                 icly=cly(ip,icp_cp(id))
3426                 cl_used(iclx)=ntrk  !tag used clusters  c$$$               cl_used(iclx)=ntrk  !tag used clusters
3427                 cl_used(icly)=ntrk  !tag used clusters  c$$$               cl_used(icly)=ntrk  !tag used clusters
3428              elseif(icl.ne.0)then              elseif(icl.ne.0)then
3429                 cl_used(icl)=ntrk   !tag used clusters  c$$$               cl_used(icl)=ntrk   !tag used clusters
3430              endif              endif
3431                            
3432  *     -----------------------------  *     -----------------------------
# Line 3371  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~ Line 3445  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~
3445       $              cly(ip,icp).eq.icl       $              cly(ip,icp).eq.icl
3446       $              )then       $              )then
3447                    id=id_cp(ip,icp,1)                    id=id_cp(ip,icp,1)
3448                    if(DEBUG)then                    if(DEBUG.EQ.1)then
3449                       print*,ip,' <<< cp ',id                       print*,ip,' <<< cp ',id
3450       $                    ,' ( cl-x '       $                    ,' ( cl-x '
3451       $                    ,clx(ip,icp)       $                    ,clx(ip,icp)
# Line 3452  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~ Line 3526  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~
3526              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
3527              CLTRX(IP,IT) = 0              CLTRX(IP,IT) = 0
3528              CLTRY(IP,IT) = 0              CLTRY(IP,IT) = 0
3529                multmaxx(ip,it) = 0
3530                seedx(ip,it)    = 0
3531                xpu(ip,it)      = 0
3532                multmaxy(ip,it) = 0
3533                seedy(ip,it)    = 0
3534                ypu(ip,it)      = 0
3535           enddo           enddo
3536           do ipa=1,5           do ipa=1,5
3537              AL_nt(IPA,IT) = 0              AL_nt(IPA,IT) = 0
# Line 3631  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~ Line 3711  c     print*,'~~~~~~~~~~~~~~~~~~~~~~~~~~
3711           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3712           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3713           ayv_nt(ip,ntr)   = sngl(ayv(ip))             ayv_nt(ip,ntr)   = sngl(ayv(ip))  
3714  c     l'avevo dimenticato!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  
3715           factor = sqrt(           factor = sqrt(
3716       $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +       $        tan( acos(-1.) * sngl(axv(ip)) /180. )**2 +
3717       $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +       $        tan( acos(-1.) * sngl(ayv(ip)) /180. )**2 +
3718       $        1. )       $        1. )
3719  c     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  
3720           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)/factor)
3721           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)             dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)/factor)  
3722        
# Line 3644  c     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Line 3724  c     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3724           ay   = ayv_nt(ip,ntr)           ay   = ayv_nt(ip,ntr)
3725           bfx  = BX_STORE(ip,IDCAND)           bfx  = BX_STORE(ip,IDCAND)
3726           bfy  = BY_STORE(ip,IDCAND)           bfy  = BY_STORE(ip,IDCAND)
3727           if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)  c$$$         if(ip.eq.6) ax = -1. * axv_nt(ip,ntr)
3728           if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)  c$$$         if(ip.eq.6) bfy = -1. * BY_STORE(ip,IDCAND)
3729           tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001  c$$$         tgtemp   = tan(ax*acos(-1.)/180.) + pmuH_h*bfy*0.00001
3730           angx     = 180.*atan(tgtemp)/acos(-1.)  c$$$         angx     = 180.*atan(tgtemp)/acos(-1.)
3731           tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001          c$$$         tgtemp = tan(ay*acos(-1.)/180.)+pmuH_e*bfx*0.00001        
3732           angy    = 180.*atan(tgtemp)/acos(-1.)  c$$$         angy    = 180.*atan(tgtemp)/acos(-1.)
3733    
3734             angx = effectiveangle(ax,2*ip,bfy)
3735             angy = effectiveangle(ay,2*ip-1,bfx)
3736            
3737                    
3738  c         print*,'* ',ip,bfx,bfy,angx,angy  c         print*,'* ',ip,bfx,bfy,angx,angy
3739    
# Line 3667  c           >>> is a couple Line 3751  c           >>> is a couple
3751              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))              cltrx(ip,ntr)   = clx(nplanes-ip+1,icp_cp(id))
3752              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))              cltry(ip,ntr)   = cly(nplanes-ip+1,icp_cp(id))
3753    
3754  c$$$            if(is_cp(id).ne.ssensor)              cl_used(cltrx(ip,ntr)) = 1     !tag used clusters          
3755  c$$$     $           print*,'ERROR is sensor assignment (couple)'              cl_used(cltry(ip,ntr)) = 1     !tag used clusters          
3756  c$$$     $           ,is_cp(id),ssensor  
3757  c$$$            if(LADDER(clx(nplanes-ip+1,icp_cp(id))).ne.sladder)              xbad(ip,ntr)= nbadstrips(4,clx(nplanes-ip+1,icp_cp(id)))
3758  c$$$     $           print*,'ERROR is ladder assignment (couple)'              ybad(ip,ntr)= nbadstrips(4,cly(nplanes-ip+1,icp_cp(id)))
3759  c$$$     $           ,LADDER(clx(nplanes-ip+1,icp_cp(id))),sladder  
               
             nnnnx = npfastrips(clx(nplanes-ip+1,icp_cp(id)),PFA,angx)  
             nnnny = npfastrips(cly(nplanes-ip+1,icp_cp(id)),PFA,angy)              
             xbad(ip,ntr)= nbadstrips(nnnnx,clx(nplanes-ip+1,icp_cp(id)))  
             ybad(ip,ntr)= nbadstrips(nnnny,cly(nplanes-ip+1,icp_cp(id)))  
3760    
3761              if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)              if(nsatstrips(clx(nplanes-ip+1,icp_cp(id))).gt.0)
3762       $           dedx_x(ip,ntr)=-dedx_x(ip,ntr)       $           dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3763              if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)              if(nsatstrips(cly(nplanes-ip+1,icp_cp(id))).gt.0)
3764       $           dedx_y(ip,ntr)=-dedx_y(ip,ntr)       $           dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3765    
3766                multmaxx(ip,ntr) = maxs(cltrx(ip,ntr))
3767         $                         +10000*mult(cltrx(ip,ntr))
3768                seedx(ip,ntr)    = clsignal(indmax(cltrx(ip,ntr)))
3769         $           /clsigma(indmax(cltrx(ip,ntr)))
3770                call applypfa(PFA,cltrx(ip,ntr),angx,corr,res)
3771                xpu(ip,ntr)      = corr
3772    
3773                multmaxy(ip,ntr) = maxs(cltry(ip,ntr))
3774         $                         +10000*mult(cltry(ip,ntr))
3775                seedy(ip,ntr)    = clsignal(indmax(cltry(ip,ntr)))
3776         $           /clsigma(indmax(cltry(ip,ntr)))
3777                call applypfa(PFA,cltry(ip,ntr),angy,corr,res)
3778                ypu(ip,ntr)      = corr
3779    
3780           elseif(icl.ne.0)then           elseif(icl.ne.0)then
3781  c           >>> is a singlet  
3782  c$$$            if(LADDER(icl).ne.sladder)              cl_used(icl) = 1    !tag used clusters          
3783  c$$$     $           print*,'ERROR is ladder assignment (single)'  
 c$$$     $           ,LADDER(icl),sladder  
3784              if(mod(VIEW(icl),2).eq.0)then              if(mod(VIEW(icl),2).eq.0)then
3785                 cltrx(ip,ntr)=icl                 cltrx(ip,ntr)=icl
3786                 nnnnn = npfastrips(icl,PFA,angx)  
3787                 xbad(ip,ntr) = nbadstrips(nnnnn,icl)                 xbad(ip,ntr) = nbadstrips(4,icl)
3788    
3789                 if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)                 if(nsatstrips(icl).gt.0)dedx_x(ip,ntr)=-dedx_x(ip,ntr)
3790    
3791                   multmaxx(ip,ntr) = maxs(cltrx(ip,ntr))
3792         $                         +10000*mult(cltrx(ip,ntr))
3793                   seedx(ip,ntr)    = clsignal(indmax(cltrx(ip,ntr)))
3794         $           /clsigma(indmax(cltrx(ip,ntr)))
3795                   call applypfa(PFA,cltrx(ip,ntr),angx,corr,res)
3796                   xpu(ip,ntr)      = corr
3797    
3798              elseif(mod(VIEW(icl),2).eq.1)then              elseif(mod(VIEW(icl),2).eq.1)then
3799                 cltry(ip,ntr)=icl                 cltry(ip,ntr)=icl
3800                 nnnnn = npfastrips(icl,PFA,angy)  
3801                 ybad(ip,ntr) = nbadstrips(nnnnn,icl)                 ybad(ip,ntr) = nbadstrips(4,icl)
3802    
3803                 if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)                 if(nsatstrips(icl).gt.0)dedx_y(ip,ntr)=-dedx_y(ip,ntr)
3804    
3805                   multmaxy(ip,ntr) = maxs(cltry(ip,ntr))
3806         $                         +10000*mult(cltry(ip,ntr))
3807                   seedy(ip,ntr)    = clsignal(indmax(cltry(ip,ntr)))
3808         $           /clsigma(indmax(cltry(ip,ntr)))
3809                   call applypfa(PFA,cltry(ip,ntr),angy,corr,res)
3810                   ypu(ip,ntr)      = corr
3811                  
3812              endif              endif
3813    
3814           endif                     endif          
3815    
3816        enddo        enddo
3817    
3818          if(DEBUG.eq.1)then
3819             print*,'> STORING TRACK ',ntr
3820             print*,'clusters: '
3821             do ip=1,6
3822                print*,'> ',ip,' -- ',cltrx(ip,ntr),cltry(ip,ntr)
3823             enddo
3824          endif
3825    
3826  c$$$      print*,(xgood(i),i=1,6)  c$$$      print*,(xgood(i),i=1,6)
3827  c$$$      print*,(ygood(i),i=1,6)  c$$$      print*,(ygood(i),i=1,6)
# Line 3734  c$$$      print*,'---------------------- Line 3852  c$$$      print*,'----------------------
3852        nclsy = 0        nclsy = 0
3853    
3854        do iv = 1,nviews        do iv = 1,nviews
3855           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)
3856             good2(iv) = good2(iv) + mask_view(iv)*2**8
3857        enddo        enddo
3858    
3859          if(DEBUG.eq.1)then
3860             print*,'> STORING SINGLETS '
3861          endif
3862    
3863        do icl=1,nclstr1        do icl=1,nclstr1
3864    
3865             ip=nplanes-npl(VIEW(icl))+1            
3866            
3867           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
             ip=nplanes-npl(VIEW(icl))+1              
3868              if(mod(VIEW(icl),2).eq.0)then !=== X views              if(mod(VIEW(icl),2).eq.0)then !=== X views
3869                 nclsx = nclsx + 1                 nclsx = nclsx + 1
3870                 planex(nclsx) = ip                 planex(nclsx) = ip
# Line 3779  c$$$               print*,'ys(2,nclsy)   Line 3904  c$$$               print*,'ys(2,nclsy)  
3904    
3905  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO  ***** LO METTO QUI PERCHE` NON SO DOVE METTERLO
3906           whichtrack(icl) = cl_used(icl)           whichtrack(icl) = cl_used(icl)
3907    *     --------------------------------------------------
3908    *     per non perdere la testa...
3909    *     whichtrack(icl) e` una variabile del common level1
3910    *     che serve solo per sapere quali cluster sono stati
3911    *     associati ad una traccia, e permettere di salvare
3912    *     solo questi nell'albero di uscita
3913    *     --------------------------------------------------
3914            
3915    
3916    c$$$         print*,' cl ',icl,' --> ',cl_used(icl)
3917    c$$$
3918    c$$$         if( cl_used(icl).ne.0 )then
3919    c$$$            if(
3920    c$$$     $           mod(VIEW(icl),2).eq.0.and.
3921    c$$$     $           cltrx(ip,whichtrack(icl)).ne.icl )
3922    c$$$     $           print*,'**WARNING** cltrx(',ip,',',whichtrack(icl)
3923    c$$$     $           ,')=',cltrx(ip,whichtrack(icl)),'.ne.',icl
3924    c$$$            if(
3925    c$$$     $           mod(VIEW(icl),2).eq.1.and.
3926    c$$$     $           cltry(ip,whichtrack(icl)).ne.icl )
3927    c$$$     $           print*,'**WARNING** cltry(',ip,',',whichtrack(icl)
3928    c$$$     $           ,')=',cltry(ip,whichtrack(icl)),'.ne.',icl
3929    c$$$         endif
3930            
3931    
3932        enddo        enddo
3933        end        end
Legend:
Removed from v.1.23  
changed lines
  Added in v.1.31
  ViewVC Help
Powered by ViewVC 1.1.23