/[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.9 by pam-fi, Fri Oct 27 16:08:19 2006 UTC revision 1.10 by pam-fi, Thu Nov 2 11:19:47 2006 UTC
# Line 1756  c      include 'level1.f' Line 1756  c      include 'level1.f'
1756        do iv=1,nviews        do iv=1,nviews
1757           if( ncl_view(iv).gt. nclustermax)then           if( ncl_view(iv).gt. nclustermax)then
1758              mask_view(iv) = 1              mask_view(iv) = 1
1759              print*,' * WARNING * cl_to_couple: n.clusters > '              if(VERBOSE)print*,' * WARNING * cl_to_couple: n.clusters > '
1760       $           ,nclustermax,' on view ', iv,' --> masked!'       $           ,nclustermax,' on view ', iv,' --> masked!'
1761           endif           endif
1762        enddo        enddo
# Line 1913  c$$$               endif Line 1913  c$$$               endif
1913       $                 '** warning ** number of identified '//       $                 '** warning ** number of identified '//
1914       $                 'couples on plane ',nplx,       $                 'couples on plane ',nplx,
1915       $                 'exceeds vector dimention '       $                 'exceeds vector dimention '
1916       $                 ,'( ',ncouplemax,' ) NB - THIS SHOULD NOT HAPPEN'       $                 ,'( ',ncouplemax,' )'
1917  c     good2=.false.  c     good2=.false.
1918  c     goto 880   !fill ntp and go to next event                      c     goto 880   !fill ntp and go to next event
1919                    iflag=1                    mask_view(nviewx(nplx)) = 2
1920                    return                    mask_view(nviewy(nply)) = 2
1921    c                  iflag=1
1922    c                  return
1923                 endif                 endif
1924                                
1925                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
# Line 1952  c     goto 880   !fill ntp and go to nex Line 1954  c     goto 880   !fill ntp and go to nex
1954        endif        endif
1955                
1956        do ip=1,6        do ip=1,6
1957           ncp_tot=ncp_tot+ncp_plane(ip)           ncp_tot = ncp_tot + ncp_plane(ip)
1958        enddo        enddo
1959  c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)
1960                
1961        if(ncp_tot.gt.ncp_max)then  c$$$      if(ncp_tot.gt.ncp_max)then
1962           if(verbose)print*,  c$$$         if(verbose)print*,
1963       $           '** warning ** number of identified '//  c$$$     $           '** warning ** number of identified '//
1964       $           'couples exceeds upper limit for Hough tr. '  c$$$     $           'couples exceeds upper limit for Hough tr. '
1965       $           ,'( ',ncp_max,' )'              c$$$     $           ,'( ',ncp_max,' )'            
1966  c            good2=.false.  c$$$         iflag=1
1967  c     goto 880       !fill ntp and go to next event  c$$$         return
1968           iflag=1  c$$$      endif
          return  
       endif  
1969                
1970        return        return
1971        end        end
# Line 1978  c     goto 880       !fill ntp and go to Line 1978  c     goto 880       !fill ntp and go to
1978  *                                                 *  *                                                 *
1979  *                                                 *  *                                                 *
1980  **************************************************  **************************************************
1981        subroutine cl_to_couples_nocharge(iflag)  c$$$      subroutine cl_to_couples_nocharge(iflag)
1982    c$$$
1983        include 'commontracker.f'  c$$$      include 'commontracker.f'
1984        include 'level1.f'  c$$$      include 'level1.f'
1985        include 'common_momanhough.f'  c$$$      include 'common_momanhough.f'
1986  c      include 'momanhough_init.f'  c$$$c      include 'momanhough_init.f'
1987        include 'calib.f'  c$$$      include 'calib.f'
1988  c      include 'level1.f'  c$$$c      include 'level1.f'
1989    c$$$
1990    c$$$
1991  *     output flag  c$$$*     output flag
1992  *     --------------  c$$$*     --------------
1993  *     0 = good event  c$$$*     0 = good event
1994  *     1 = bad event  c$$$*     1 = bad event
1995  *     --------------  c$$$*     --------------
1996        integer iflag  c$$$      integer iflag
1997    c$$$
1998        integer badseed,badcl  c$$$      integer badseed,badcl
1999    c$$$
2000  *     init variables  c$$$*     init variables
2001        ncp_tot=0  c$$$      ncp_tot=0
2002        do ip=1,nplanes  c$$$      do ip=1,nplanes
2003           do ico=1,ncouplemax  c$$$         do ico=1,ncouplemax
2004              clx(ip,ico)=0  c$$$            clx(ip,ico)=0
2005              cly(ip,ico)=0  c$$$            cly(ip,ico)=0
2006           enddo  c$$$         enddo
2007           ncp_plane(ip)=0  c$$$         ncp_plane(ip)=0
2008           do icl=1,nclstrmax_level2  c$$$         do icl=1,nclstrmax_level2
2009              cls(ip,icl)=1  c$$$            cls(ip,icl)=1
2010           enddo  c$$$         enddo
2011           ncls(ip)=0  c$$$         ncls(ip)=0
2012        enddo  c$$$      enddo
2013        do icl=1,nclstrmax_level2  c$$$      do icl=1,nclstrmax_level2
2014           cl_single(icl)=1  c$$$         cl_single(icl)=1
2015           cl_good(icl)=0  c$$$         cl_good(icl)=0
2016        enddo  c$$$      enddo
2017          c$$$      
2018  *     start association  c$$$*     start association
2019        ncouples=0  c$$$      ncouples=0
2020        do icx=1,nclstr1          !loop on cluster (X)  c$$$      do icx=1,nclstr1          !loop on cluster (X)
2021           if(mod(VIEW(icx),2).eq.1)goto 10  c$$$         if(mod(VIEW(icx),2).eq.1)goto 10
2022            c$$$        
2023  *     ----------------------------------------------------  c$$$*     ----------------------------------------------------
2024  *     cut on charge (X VIEW)  c$$$*     cut on charge (X VIEW)
2025           if(dedx(icx).lt.dedx_x_min)then  c$$$         if(dedx(icx).lt.dedx_x_min)then
2026              cl_single(icx)=0  c$$$            cl_single(icx)=0
2027              goto 10  c$$$            goto 10
2028           endif  c$$$         endif
2029  *     cut BAD (X VIEW)              c$$$*     cut BAD (X VIEW)            
2030           badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))  c$$$         badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))
2031           ifirst=INDSTART(icx)  c$$$         ifirst=INDSTART(icx)
2032           if(icx.ne.nclstr1) then  c$$$         if(icx.ne.nclstr1) then
2033              ilast=INDSTART(icx+1)-1  c$$$            ilast=INDSTART(icx+1)-1
2034           else  c$$$         else
2035              ilast=TOTCLLENGTH  c$$$            ilast=TOTCLLENGTH
2036           endif  c$$$         endif
2037           badcl=badseed  c$$$         badcl=badseed
2038           do igood=-ngoodstr,ngoodstr  c$$$         do igood=-ngoodstr,ngoodstr
2039              ibad=1  c$$$            ibad=1
2040              if((INDMAX(icx)+igood).gt.ifirst.and.  c$$$            if((INDMAX(icx)+igood).gt.ifirst.and.
2041       $           (INDMAX(icx)+igood).lt.ilast.and.  c$$$     $           (INDMAX(icx)+igood).lt.ilast.and.
2042       $           .true.)then  c$$$     $           .true.)then
2043                 ibad=BAD(VIEW(icx),  c$$$               ibad=BAD(VIEW(icx),
2044       $              nvk(MAXS(icx)+igood),  c$$$     $              nvk(MAXS(icx)+igood),
2045       $              nst(MAXS(icx)+igood))  c$$$     $              nst(MAXS(icx)+igood))
2046              endif  c$$$            endif
2047              badcl=badcl*ibad  c$$$            badcl=badcl*ibad
2048           enddo  c$$$         enddo
2049           if(badcl.eq.0)then     !<<<<<<<<<<<<<< BAD cut  c$$$         if(badcl.eq.0)then     !<<<<<<<<<<<<<< BAD cut
2050              cl_single(icx)=0    !<<<<<<<<<<<<<< BAD cut  c$$$            cl_single(icx)=0    !<<<<<<<<<<<<<< BAD cut
2051              goto 10             !<<<<<<<<<<<<<< BAD cut  c$$$            goto 10             !<<<<<<<<<<<<<< BAD cut
2052           endif                  !<<<<<<<<<<<<<< BAD cut  c$$$         endif                  !<<<<<<<<<<<<<< BAD cut
2053  *     ----------------------------------------------------  c$$$*     ----------------------------------------------------
2054            c$$$        
2055           cl_good(icx)=1  c$$$         cl_good(icx)=1
2056           nplx=npl(VIEW(icx))  c$$$         nplx=npl(VIEW(icx))
2057           nldx=nld(MAXS(icx),VIEW(icx))  c$$$         nldx=nld(MAXS(icx),VIEW(icx))
2058            c$$$        
2059           do icy=1,nclstr1       !loop on cluster (Y)  c$$$         do icy=1,nclstr1       !loop on cluster (Y)
2060              if(mod(VIEW(icy),2).eq.0)goto 20  c$$$            if(mod(VIEW(icy),2).eq.0)goto 20
2061                c$$$            
2062  *     ----------------------------------------------------  c$$$*     ----------------------------------------------------
2063  *     cut on charge (Y VIEW)  c$$$*     cut on charge (Y VIEW)
2064              if(dedx(icy).lt.dedx_y_min)then  c$$$            if(dedx(icy).lt.dedx_y_min)then
2065                 cl_single(icy)=0  c$$$               cl_single(icy)=0
2066                 goto 20  c$$$               goto 20
2067              endif  c$$$            endif
2068  *     cut BAD (Y VIEW)              c$$$*     cut BAD (Y VIEW)            
2069              badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))  c$$$            badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))
2070              ifirst=INDSTART(icy)  c$$$            ifirst=INDSTART(icy)
2071              if(icy.ne.nclstr1) then  c$$$            if(icy.ne.nclstr1) then
2072                 ilast=INDSTART(icy+1)-1  c$$$               ilast=INDSTART(icy+1)-1
2073              else  c$$$            else
2074                 ilast=TOTCLLENGTH  c$$$               ilast=TOTCLLENGTH
2075              endif  c$$$            endif
2076              badcl=badseed  c$$$            badcl=badseed
2077              do igood=-ngoodstr,ngoodstr  c$$$            do igood=-ngoodstr,ngoodstr
2078                 ibad=1  c$$$               ibad=1
2079                 if((INDMAX(icy)+igood).gt.ifirst.and.  c$$$               if((INDMAX(icy)+igood).gt.ifirst.and.
2080       $              (INDMAX(icy)+igood).lt.ilast.and.  c$$$     $              (INDMAX(icy)+igood).lt.ilast.and.
2081       $              .true.)  c$$$     $              .true.)
2082       $              ibad=BAD(VIEW(icy),  c$$$     $              ibad=BAD(VIEW(icy),
2083       $              nvk(MAXS(icy)+igood),  c$$$     $              nvk(MAXS(icy)+igood),
2084       $              nst(MAXS(icy)+igood))  c$$$     $              nst(MAXS(icy)+igood))
2085                 badcl=badcl*ibad  c$$$               badcl=badcl*ibad
2086              enddo  c$$$            enddo
2087              if(badcl.eq.0)then  !<<<<<<<<<<<<<< BAD cut  c$$$            if(badcl.eq.0)then  !<<<<<<<<<<<<<< BAD cut
2088                 cl_single(icy)=0 !<<<<<<<<<<<<<< BAD cut  c$$$               cl_single(icy)=0 !<<<<<<<<<<<<<< BAD cut
2089                 goto 20          !<<<<<<<<<<<<<< BAD cut  c$$$               goto 20          !<<<<<<<<<<<<<< BAD cut
2090              endif               !<<<<<<<<<<<<<< BAD cut  c$$$            endif               !<<<<<<<<<<<<<< BAD cut
2091  *     ----------------------------------------------------  c$$$*     ----------------------------------------------------
2092                c$$$            
2093                c$$$            
2094              cl_good(icy)=1                    c$$$            cl_good(icy)=1                  
2095              nply=npl(VIEW(icy))  c$$$            nply=npl(VIEW(icy))
2096              nldy=nld(MAXS(icy),VIEW(icy))  c$$$            nldy=nld(MAXS(icy),VIEW(icy))
2097                c$$$            
2098  *     ----------------------------------------------  c$$$*     ----------------------------------------------
2099  *     CONDITION TO FORM A COUPLE  c$$$*     CONDITION TO FORM A COUPLE
2100  *     ----------------------------------------------  c$$$*     ----------------------------------------------
2101  *     geometrical consistency (same plane and ladder)  c$$$*     geometrical consistency (same plane and ladder)
2102              if(nply.eq.nplx.and.nldy.eq.nldx)then  c$$$            if(nply.eq.nplx.and.nldy.eq.nldx)then
2103  *     charge correlation  c$$$*     charge correlation
2104  *     ===========================================================  c$$$*     ===========================================================
2105  *     this version of the subroutine is used for the calibration  c$$$*     this version of the subroutine is used for the calibration
2106  *     thus charge-correlation selection is obviously removed  c$$$*     thus charge-correlation selection is obviously removed
2107  *     ===========================================================  c$$$*     ===========================================================
2108  c$$$               ddd=(dedx(icy)  c$$$c$$$               ddd=(dedx(icy)
2109  c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  c$$$c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))
2110  c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)  c$$$c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
2111  c$$$               cut=chcut*sch(nplx,nldx)  c$$$c$$$               cut=chcut*sch(nplx,nldx)
2112  c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent  c$$$c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent
2113  *     ===========================================================  c$$$*     ===========================================================
2114                  c$$$              
2115                  c$$$              
2116  *     ------------------> COUPLE <------------------  c$$$*     ------------------> COUPLE <------------------
2117  *     check to do not overflow vector dimentions  c$$$*     check to do not overflow vector dimentions
2118  c$$$               if(ncp_plane(nplx).gt.ncouplemax)then  c$$$c$$$               if(ncp_plane(nplx).gt.ncouplemax)then
2119  c$$$                  if(DEBUG)print*,  c$$$c$$$                  if(DEBUG)print*,
2120  c$$$     $                    ' ** warning ** number of identified'//  c$$$c$$$     $                    ' ** warning ** number of identified'//
2121  c$$$     $                    ' couples on plane ',nplx,  c$$$c$$$     $                    ' couples on plane ',nplx,
2122  c$$$     $                    ' exceeds vector dimention'//  c$$$c$$$     $                    ' exceeds vector dimention'//
2123  c$$$     $                    ' ( ',ncouplemax,' )'  c$$$c$$$     $                    ' ( ',ncouplemax,' )'
2124    c$$$c$$$c     good2=.false.
2125    c$$$c$$$c     goto 880   !fill ntp and go to next event
2126    c$$$c$$$                  iflag=1
2127    c$$$c$$$                  return
2128    c$$$c$$$               endif
2129    c$$$              
2130    c$$$               if(ncp_plane(nplx).eq.ncouplemax)then
2131    c$$$                  if(verbose)print*,
2132    c$$$     $                 '** warning ** number of identified '//
2133    c$$$     $                 'couples on plane ',nplx,
2134    c$$$     $                 'exceeds vector dimention '
2135    c$$$     $                 ,'( ',ncouplemax,' )'
2136  c$$$c     good2=.false.  c$$$c     good2=.false.
2137  c$$$c     goto 880   !fill ntp and go to next event  c$$$c     goto 880   !fill ntp and go to next event                    
2138  c$$$                  iflag=1  c$$$                  iflag=1
2139  c$$$                  return  c$$$                  return
2140  c$$$               endif  c$$$               endif
2141                  c$$$              
2142                 if(ncp_plane(nplx).eq.ncouplemax)then  c$$$               ncp_plane(nplx) = ncp_plane(nplx) + 1
2143                    if(verbose)print*,  c$$$               clx(nplx,ncp_plane(nplx))=icx
2144       $                 '** warning ** number of identified '//  c$$$               cly(nply,ncp_plane(nplx))=icy
2145       $                 'couples on plane ',nplx,  c$$$               cl_single(icx)=0
2146       $                 'exceeds vector dimention '  c$$$               cl_single(icy)=0
2147       $                 ,'( ',ncouplemax,' )'  c$$$            endif                              
2148  c     good2=.false.  c$$$*     ----------------------------------------------
2149  c     goto 880   !fill ntp and go to next event                      c$$$
2150                    iflag=1  c$$$ 20         continue
2151                    return  c$$$         enddo                  !end loop on clusters(Y)
2152                 endif  c$$$        
2153                  c$$$ 10      continue
2154                 ncp_plane(nplx) = ncp_plane(nplx) + 1  c$$$      enddo                     !end loop on clusters(X)
2155                 clx(nplx,ncp_plane(nplx))=icx  c$$$      
2156                 cly(nply,ncp_plane(nplx))=icy  c$$$      
2157                 cl_single(icx)=0  c$$$      do icl=1,nclstr1
2158                 cl_single(icy)=0  c$$$         if(cl_single(icl).eq.1)then
2159              endif                                c$$$            ip=npl(VIEW(icl))
2160  *     ----------------------------------------------  c$$$            ncls(ip)=ncls(ip)+1
2161    c$$$            cls(ip,ncls(ip))=icl
2162   20         continue  c$$$         endif
2163           enddo                  !end loop on clusters(Y)  c$$$      enddo
2164            c$$$      
2165   10      continue  c$$$      
2166        enddo                     !end loop on clusters(X)  c$$$      if(DEBUG)then
2167          c$$$         print*,'clusters  ',nclstr1
2168          c$$$         print*,'good    ',(cl_good(i),i=1,nclstr1)
2169        do icl=1,nclstr1  c$$$         print*,'singles ',(cl_single(i),i=1,nclstr1)
2170           if(cl_single(icl).eq.1)then  c$$$         print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)
2171              ip=npl(VIEW(icl))  c$$$      endif
2172              ncls(ip)=ncls(ip)+1  c$$$      
2173              cls(ip,ncls(ip))=icl  c$$$      do ip=1,6
2174           endif  c$$$         ncp_tot=ncp_tot+ncp_plane(ip)
2175        enddo  c$$$      enddo
2176          c$$$c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)
2177          c$$$      
2178        if(DEBUG)then  c$$$      if(ncp_tot.gt.ncp_max)then
2179           print*,'clusters  ',nclstr1  c$$$         if(verbose)print*,
2180           print*,'good    ',(cl_good(i),i=1,nclstr1)  c$$$     $           '** warning ** number of identified '//
2181           print*,'singles ',(cl_single(i),i=1,nclstr1)  c$$$     $           'couples exceeds upper limit for Hough tr. '
2182           print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)  c$$$     $           ,'( ',ncp_max,' )'            
2183        endif  c$$$c            good2=.false.
2184          c$$$c     goto 880       !fill ntp and go to next event
2185        do ip=1,6  c$$$         iflag=1
2186           ncp_tot=ncp_tot+ncp_plane(ip)  c$$$         return
2187        enddo  c$$$      endif
2188  c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  c$$$      
2189          c$$$      return
2190        if(ncp_tot.gt.ncp_max)then  c$$$      end
2191           if(verbose)print*,  c$$$
      $           '** warning ** number of identified '//  
      $           'couples exceeds upper limit for Hough tr. '  
      $           ,'( ',ncp_max,' )'              
 c            good2=.false.  
 c     goto 880       !fill ntp and go to next event  
          iflag=1  
          return  
       endif  
         
       return  
       end  
   
2192                
2193  ***************************************************  ***************************************************
2194  *                                                 *  *                                                 *
# Line 2286  c     $                       (icx2,icy2 Line 2286  c     $                       (icx2,icy2
2286       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
2287  c                           good2=.false.  c                           good2=.false.
2288  c                           goto 880 !fill ntp and go to next event  c                           goto 880 !fill ntp and go to next event
2289                               do iv=1,12
2290                                  mask_view(iv) = 3
2291                               enddo
2292                             iflag=1                             iflag=1
2293                             return                             return
2294                          endif                          endif
# Line 2356  c     $                                 Line 2359  c     $                                
2359       $                    ,'( ',ntrpt_max,' )'       $                    ,'( ',ntrpt_max,' )'
2360  c                                    good2=.false.  c                                    good2=.false.
2361  c                                    goto 880 !fill ntp and go to next event  c                                    goto 880 !fill ntp and go to next event
2362                                        do iv=1,nviews
2363                                           mask_view(iv) = 4
2364                                        enddo
2365                                      iflag=1                                      iflag=1
2366                                      return                                      return
2367                                   endif                                   endif
# Line 2584  c         if(ncpused.lt.ncpyz_min)goto 2 Line 2590  c         if(ncpused.lt.ncpyz_min)goto 2
2590       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
2591  c               good2=.false.  c               good2=.false.
2592  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2593                do iv=1,nviews
2594                   mask_view(iv) = 5
2595                enddo
2596              iflag=1              iflag=1
2597              return              return
2598           endif           endif
# Line 2803  c         if(ncpused.lt.ncpxz_min)goto 2 Line 2812  c         if(ncpused.lt.ncpxz_min)goto 2
2812       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
2813  c     good2=.false.  c     good2=.false.
2814  c     goto 880         !fill ntp and go to next event  c     goto 880         !fill ntp and go to next event
2815                do iv=1,nviews
2816                   mask_view(iv) = 6
2817                enddo
2818              iflag=1              iflag=1
2819              return              return
2820           endif           endif
# Line 3110  c     $                                 Line 3122  c     $                                
3122       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
3123  c                                 good2=.false.  c                                 good2=.false.
3124  c                                 goto 880 !fill ntp and go to next event                      c                                 goto 880 !fill ntp and go to next event                    
3125                                     do iv=1,nviews
3126                                        mask_view(iv) = 7
3127                                     enddo
3128                                   iflag=1                                   iflag=1
3129                                   return                                   return
3130                                endif                                endif
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.23