/[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.4 by pam-fi, Thu Sep 28 14:04:40 2006 UTC revision 1.9 by pam-fi, Fri Oct 27 16:08:19 2006 UTC
# Line 12  Line 12 
12        subroutine track_finding(iflag)        subroutine track_finding(iflag)
13    
14        include 'commontracker.f'        include 'commontracker.f'
15          include 'level1.f'
16        include 'common_momanhough.f'        include 'common_momanhough.f'
17        include 'common_mech.f'        include 'common_mech.f'
18        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
19        include 'common_mini_2.f'        include 'common_mini_2.f'
20        include 'calib.f'        include 'calib.f'
21        include 'level1.f'  c      include 'level1.f'
22        include 'level2.f'        include 'level2.f'
23    
24        include 'momanhough_init.f'  c      include 'momanhough_init.f'
25                
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
26  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
27  *     STEP 1  *     STEP 1
28  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
# Line 47  c      common/dbg/DEBUG Line 45  c      common/dbg/DEBUG
45  c      iflag=0  c      iflag=0
46        call cl_to_couples(iflag)        call cl_to_couples(iflag)
47        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
48           goto 880               !fill ntp and go to next event                       goto 880               !go to next event
49        endif        endif
50                
 *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  
 *     selezione di tracce pulite per diagnostica  
 *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  
 c$$$         if(DEBUG)then  
 c$$$            do ip=1,nplanes  
 c$$$               if(ncp_plane(ip).ne.1)good2=.false.  
 c$$$            enddo  
 c$$$c            if(good2.eq.0)goto 100!next event  
 c$$$c            if(good2.eq.0)goto 880!fill ntp and go to next event  
 c$$$         endif  
           
   
   
51  *-----------------------------------------------------  *-----------------------------------------------------
52  *-----------------------------------------------------  *-----------------------------------------------------
53  *     HOUGH TRASFORM  *     HOUGH TRASFORM
# Line 94  c$$$         endif Line 79  c$$$         endif
79  c      iflag=0  c      iflag=0
80        call cp_to_doubtrip(iflag)        call cp_to_doubtrip(iflag)
81        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
82           goto 880               !fill ntp and go to next event                       goto 880               !go to next event            
83        endif        endif
84                
85                
# Line 123  c      iflag=0 Line 108  c      iflag=0
108  *     $     ,ptcloud_xz,tr_cloud,cpcloud_xz            *     $     ,ptcloud_xz,tr_cloud,cpcloud_xz          
109  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
110  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
111    *     count number of hit planes
112          planehit=0                
113          do np=1,nplanes          
114            if(ncp_plane(np).ne.0)then  
115              planehit=planehit+1  
116            endif                  
117          enddo                    
118          if(planehit.lt.3) goto 880 ! exit              
119          
120          nptxz_min=x_min_start              
121          nplxz_min=x_min_start              
122                
123          nptyz_min=y_min_start              
124          nplyz_min=y_min_start              
125    
126  c      iflag=0        cutdistyz=cutystart      
127          cutdistxz=cutxstart      
128    
129     878  continue
130        call doub_to_YZcloud(iflag)        call doub_to_YZcloud(iflag)
131        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
132           goto 880               !fill ntp and go to next event                       goto 880               !fill ntp and go to next event            
133        endif        endif
134  c      iflag=0        if(nclouds_yz.eq.0.and.cutdistyz.lt.maxcuty)then
135            if(cutdistyz.lt.maxcuty/2)then
136              cutdistyz=cutdistyz+cutystep
137            else
138              cutdistyz=cutdistyz+(3*cutystep)
139            endif
140            goto 878                
141          endif                    
142    
143          if(planehit.eq.3) goto 881          
144          
145     879  continue  
146        call trip_to_XZcloud(iflag)        call trip_to_XZcloud(iflag)
147        if(iflag.eq.1)then        !bad event        if(iflag.eq.1)then        !bad event
148           goto 880               !fill ntp and go to next event                       goto 880               !fill ntp and go to next event            
149        endif        endif
150                                    
151          if(nclouds_xz.eq.0.and.cutdistxz.lt.maxcutx)then
152            cutdistxz=cutdistxz+cutxstep
153            goto 879                
154          endif                    
155    
156        
157     881  continue  
158    *     if there is at least three planes on the Y view decreases cuts on X view
159          if(nclouds_xz.eq.0.and.nclouds_yz.gt.0.and.
160         $     nplxz_min.ne.y_min_start)then
161            nptxz_min=x_min_step    
162            nplxz_min=x_min_start-x_min_step              
163            goto 879                
164          endif                    
165            
166   880  return   880  return
167        end        end
168    
# Line 144  c      iflag=0 Line 172  c      iflag=0
172        subroutine track_fitting(iflag)        subroutine track_fitting(iflag)
173    
174        include 'commontracker.f'        include 'commontracker.f'
175          include 'level1.f'
176        include 'common_momanhough.f'        include 'common_momanhough.f'
177        include 'common_mech.f'        include 'common_mech.f'
178        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
179        include 'common_mini_2.f'        include 'common_mini_2.f'
180        include 'calib.f'        include 'calib.f'
       include 'level1.f'  
181        include 'level2.f'        include 'level2.f'
182    
183        include 'momanhough_init.f'  c      include 'momanhough_init.f'
184                
 c      logical DEBUG  
 c      common/dbg/DEBUG  
   
185        logical FIMAGE            !        logical FIMAGE            !
186    
187  *-------------------------------------------------------------------------------  *-------------------------------------------------------------------------------
# Line 198  c         iflag=0 Line 223  c         iflag=0
223           ibest=0                !best track among candidates           ibest=0                !best track among candidates
224           iimage=0               !track image           iimage=0               !track image
225  *     ------------- select the best track -------------  *     ------------- select the best track -------------
226    c$$$         rchi2best=1000000000.
227    c$$$         do i=1,ntracks
228    c$$$            if(RCHI2_STORE(i).lt.rchi2best.and.
229    c$$$     $         RCHI2_STORE(i).gt.0)then
230    c$$$               ibest=i
231    c$$$               rchi2best=RCHI2_STORE(i)
232    c$$$            endif
233    c$$$         enddo
234    c$$$         if(ibest.eq.0)goto 880 !>> no good candidates
235    
236           rchi2best=1000000000.           rchi2best=1000000000.
237             ndofbest=0             !(1)
238           do i=1,ntracks           do i=1,ntracks
239              if(RCHI2_STORE(i).lt.rchi2best.and.             if(RCHI2_STORE(i).lt.rchi2best.and.
240       $         RCHI2_STORE(i).gt.0)then       $          RCHI2_STORE(i).gt.0)then
241                 ndof=0             !(1)
242                 do ii=1,nplanes    !(1)
243                   ndof=ndof        !(1)
244         $              +int(xgood_store(ii,i)) !(1)
245         $              +int(ygood_store(ii,i)) !(1)
246                 enddo              !(1)
247                 if(ndof.ge.ndofbest)then !(1)
248                 ibest=i                 ibest=i
249                 rchi2best=RCHI2_STORE(i)                 rchi2best=RCHI2_STORE(i)
250              endif                 ndofbest=ndof    !(1)
251                 endif              !(1)
252               endif
253           enddo           enddo
254           if(ibest.eq.0)goto 880 !>> no good candidates           if(ibest.eq.0)goto 880 !>> no good candidates
255  *-------------------------------------------------------------------------------      *-------------------------------------------------------------------------------    
# Line 243  c         iflag=0 Line 288  c         iflag=0
288           ifail=0                !error flag in chi2 computation           ifail=0                !error flag in chi2 computation
289           jstep=0                !# minimization steps           jstep=0                !# minimization steps
290    
291           call mini_2(jstep,ifail)           iprint=0
292             if(DEBUG)iprint=1
293             call mini2(jstep,ifail,iprint)
294           if(ifail.ne.0) then           if(ifail.ne.0) then
295              if(DEBUG)then              if(DEBUG)then
296                 print *,                 print *,
297       $              '*** MINIMIZATION FAILURE *** (mini_2) '       $              '*** MINIMIZATION FAILURE *** (mini2) '
298       $              ,iev       $              ,iev
299              endif              endif
300              chi2=-chi2              chi2=-chi2
# Line 311  c         print*,'++++++++++ iimage,fima Line 358  c         print*,'++++++++++ iimage,fima
358  c     $        ,iimage,fimage,ntrk,image(ntrk)  c     $        ,iimage,fimage,ntrk,image(ntrk)
359    
360           if(ntrk.eq.NTRKMAX)then           if(ntrk.eq.NTRKMAX)then
361              if(DEBUG)              if(verbose)
362       $           print*,       $           print*,
363       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
364       $           'tracks exceeds vector dimension '       $           'tracks exceeds vector dimension '
# Line 607  c                (implemented variable r Line 654  c                (implemented variable r
654  c*****************************************************  c*****************************************************
655                
656        include 'commontracker.f'        include 'commontracker.f'
       include 'calib.f'  
657        include 'level1.f'        include 'level1.f'
658          include 'calib.f'
659    c      include 'level1.f'
660        include 'common_align.f'        include 'common_align.f'
661        include 'common_mech.f'        include 'common_mech.f'
662        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
# Line 667  c      double precision xi_B,yi_B,zi_B Line 715  c      double precision xi_B,yi_B,zi_B
715              resxPAM = resxPAM*fbad_cog(2,icx)              resxPAM = resxPAM*fbad_cog(2,icx)
716           elseif(PFAx.eq.'ETA2')then           elseif(PFAx.eq.'ETA2')then
717  c            cog2 = cog(2,icx)  c            cog2 = cog(2,icx)
718  c            etacorr = pfa_eta2(cog2,viewx,nldx,angx)              c            etacorr = pfaeta2(cog2,viewx,nldx,angx)            
719  c            stripx = stripx + etacorr  c            stripx = stripx + etacorr
720              stripx = stripx + pfa_eta2(icx,angx)            !(3)              stripx = stripx + pfaeta2(icx,angx)            !(3)
721              resxPAM = risx_eta2(angx)                       !   (4)              resxPAM = risx_eta2(angx)                       !   (4)
722              if(DEBUG.and.fbad_cog(2,icx).ne.1)              if(DEBUG.and.fbad_cog(2,icx).ne.1)
723       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)
724              resxPAM = resxPAM*fbad_cog(2,icx)              resxPAM = resxPAM*fbad_cog(2,icx)
725           elseif(PFAx.eq.'ETA3')then                         !(3)           elseif(PFAx.eq.'ETA3')then                         !(3)
726              stripx = stripx + pfa_eta3(icx,angx)            !(3)              stripx = stripx + pfaeta3(icx,angx)            !(3)
727              resxPAM = risx_eta3(angx)                       !   (4)              resxPAM = risx_eta3(angx)                       !   (4)
728              if(DEBUG.and.fbad_cog(3,icx).ne.1)              !(3)              if(DEBUG.and.fbad_cog(3,icx).ne.1)              !(3)
729       $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)!(3)       $           print*,'BAD icx >>> ',viewx,fbad_cog(3,icx)!(3)
730              resxPAM = resxPAM*fbad_cog(3,icx)               !(3)              resxPAM = resxPAM*fbad_cog(3,icx)               !(3)
731           elseif(PFAx.eq.'ETA4')then                         !(3)           elseif(PFAx.eq.'ETA4')then                         !(3)
732              stripx = stripx + pfa_eta4(icx,angx)            !(3)              stripx = stripx + pfaeta4(icx,angx)            !(3)
733              resxPAM = risx_eta4(angx)                       !   (4)              resxPAM = risx_eta4(angx)                       !   (4)
734              if(DEBUG.and.fbad_cog(4,icx).ne.1)              !(3)              if(DEBUG.and.fbad_cog(4,icx).ne.1)              !(3)
735       $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)!(3)       $           print*,'BAD icx >>> ',viewx,fbad_cog(4,icx)!(3)
736              resxPAM = resxPAM*fbad_cog(4,icx)               !(3)              resxPAM = resxPAM*fbad_cog(4,icx)               !(3)
737           elseif(PFAx.eq.'ETA')then                          !(3)           elseif(PFAx.eq.'ETA')then                          !(3)
738              stripx = stripx + pfa_eta(icx,angx)             !(3)              stripx = stripx + pfaeta(icx,angx)             !(3)
739              resxPAM = ris_eta(icx,angx)                     !   (4)              resxPAM = ris_eta(icx,angx)                     !   (4)
740              if(DEBUG.and.fbad_cog(2,icx).ne.1)              !(3)              if(DEBUG.and.fbad_cog(2,icx).ne.1)              !(3)
741       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)!(3)       $           print*,'BAD icx >>> ',viewx,fbad_cog(2,icx)!(3)
# Line 731  c     $     print*,PFAx,icx,angx,stripx, Line 779  c     $     print*,PFAx,icx,angx,stripx,
779              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
780           elseif(PFAy.eq.'ETA2')then           elseif(PFAy.eq.'ETA2')then
781  c            cog2 = cog(2,icy)  c            cog2 = cog(2,icy)
782  c            etacorr = pfa_eta2(cog2,viewy,nldy,angy)  c            etacorr = pfaeta2(cog2,viewy,nldy,angy)
783  c            stripy = stripy + etacorr  c            stripy = stripy + etacorr
784              stripy = stripy + pfa_eta2(icy,angy)            !(3)              stripy = stripy + pfaeta2(icy,angy)            !(3)
785              resyPAM = risy_eta2(angy)                       !   (4)              resyPAM = risy_eta2(angy)                       !   (4)
786              resyPAM = resyPAM*fbad_cog(2,icy)              resyPAM = resyPAM*fbad_cog(2,icy)
787              if(DEBUG.and.fbad_cog(2,icy).ne.1)              if(DEBUG.and.fbad_cog(2,icy).ne.1)
788       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)       $           print*,'BAD icy >>> ',viewy,fbad_cog(2,icy)
789           elseif(PFAy.eq.'ETA3')then                         !(3)           elseif(PFAy.eq.'ETA3')then                         !(3)
790              stripy = stripy + pfa_eta3(icy,angy)            !(3)              stripy = stripy + pfaeta3(icy,angy)            !(3)
791              resyPAM = resyPAM*fbad_cog(3,icy)               !(3)              resyPAM = resyPAM*fbad_cog(3,icy)               !(3)
792              if(DEBUG.and.fbad_cog(3,icy).ne.1)              !(3)              if(DEBUG.and.fbad_cog(3,icy).ne.1)              !(3)
793       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)!(3)       $           print*,'BAD icy >>> ',viewy,fbad_cog(3,icy)!(3)
794           elseif(PFAy.eq.'ETA4')then                         !(3)           elseif(PFAy.eq.'ETA4')then                         !(3)
795              stripy = stripy + pfa_eta4(icy,angy)            !(3)              stripy = stripy + pfaeta4(icy,angy)            !(3)
796              resyPAM = resyPAM*fbad_cog(4,icy)               !(3)              resyPAM = resyPAM*fbad_cog(4,icy)               !(3)
797              if(DEBUG.and.fbad_cog(4,icy).ne.1)              !(3)              if(DEBUG.and.fbad_cog(4,icy).ne.1)              !(3)
798       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)!(3)       $           print*,'BAD icy >>> ',viewy,fbad_cog(4,icy)!(3)
799           elseif(PFAy.eq.'ETA')then                          !(3)           elseif(PFAy.eq.'ETA')then                          !(3)
800              stripy = stripy + pfa_eta(icy,angy)             !(3)              stripy = stripy + pfaeta(icy,angy)             !(3)
801              resyPAM = ris_eta(icy,angy)                     !   (4)              resyPAM = ris_eta(icy,angy)                     !   (4)
802  c            resyPAM = resyPAM*fbad_cog(2,icy)              !(3)TEMPORANEO  c            resyPAM = resyPAM*fbad_cog(2,icy)              !(3)TEMPORANEO
803              resyPAM = resyPAM*fbad_eta(icy,angy)            !   (4)              resyPAM = resyPAM*fbad_eta(icy,angy)            !   (4)
# Line 1284  c     $              ,iv,xvv(iv),yvv(iv) Line 1332  c     $              ,iv,xvv(iv),yvv(iv)
1332  *     it returns the plane number  *     it returns the plane number
1333  *      *    
1334        include 'commontracker.f'        include 'commontracker.f'
1335          include 'level1.f'
1336  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1337        include 'common_momanhough.f'        include 'common_momanhough.f'
1338                
# Line 1321  c      include 'common_analysis.f' Line 1370  c      include 'common_analysis.f'
1370  *     it returns the id number ON THE PLANE  *     it returns the id number ON THE PLANE
1371  *      *    
1372        include 'commontracker.f'        include 'commontracker.f'
1373          include 'level1.f'
1374  c      include 'common_analysis.f'  c      include 'common_analysis.f'
1375        include 'common_momanhough.f'        include 'common_momanhough.f'
1376                
# Line 1349  c      include 'common_analysis.f' Line 1399  c      include 'common_analysis.f'
1399  *     positive if sensor =2  *     positive if sensor =2
1400  *  *
1401        include 'commontracker.f'        include 'commontracker.f'
1402          include 'level1.f'
1403  c      include 'calib.f'  c      include 'calib.f'
1404  c      include 'level1.f'  c      include 'level1.f'
1405  c      include 'common_analysis.f'  c      include 'common_analysis.f'
# Line 1660  c$$$      end Line 1711  c$$$      end
1711        subroutine cl_to_couples(iflag)        subroutine cl_to_couples(iflag)
1712    
1713        include 'commontracker.f'        include 'commontracker.f'
1714          include 'level1.f'
1715        include 'common_momanhough.f'        include 'common_momanhough.f'
1716        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1717        include 'calib.f'        include 'calib.f'
1718        include 'level1.f'  c      include 'level1.f'
   
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1719    
1720  *     output flag  *     output flag
1721  *     --------------  *     --------------
# Line 1675  c      common/dbg/DEBUG Line 1724  c      common/dbg/DEBUG
1724  *     --------------  *     --------------
1725        integer iflag        integer iflag
1726    
1727        integer badseed,badcl        integer badseed,badclx,badcly
1728    
1729  *     init variables  *     init variables
1730        ncp_tot=0        ncp_tot=0
# Line 1691  c      common/dbg/DEBUG Line 1740  c      common/dbg/DEBUG
1740           ncls(ip)=0           ncls(ip)=0
1741        enddo        enddo
1742        do icl=1,nclstrmax_level2        do icl=1,nclstrmax_level2
1743           cl_single(icl)=1           cl_single(icl) = 1
1744           cl_good(icl)=0           cl_good(icl)   = 0
1745          enddo
1746          do iv=1,nviews
1747             ncl_view(iv)  = 0
1748             mask_view(iv) = 0      !all included
1749        enddo        enddo
1750                
1751    *     count number of cluster per view
1752          do icl=1,nclstr1
1753             ncl_view(VIEW(icl)) = ncl_view(VIEW(icl)) + 1        
1754          enddo
1755    *     mask views with too many clusters
1756          do iv=1,nviews
1757             if( ncl_view(iv).gt. nclustermax)then
1758                mask_view(iv) = 1
1759                print*,' * WARNING * cl_to_couple: n.clusters > '
1760         $           ,nclustermax,' on view ', iv,' --> masked!'
1761             endif
1762          enddo
1763    
1764    
1765  *     start association  *     start association
1766        ncouples=0        ncouples=0
1767        do icx=1,nclstr1          !loop on cluster (X)        do icx=1,nclstr1          !loop on cluster (X)
1768           if(mod(VIEW(icx),2).eq.1)goto 10           if(mod(VIEW(icx),2).eq.1)goto 10
1769                    
1770  *     ----------------------------------------------------  *     ----------------------------------------------------
1771    *     jump masked views (X VIEW)
1772    *     ----------------------------------------------------
1773             if( mask_view(VIEW(icx)).ne.0 ) goto 10
1774    *     ----------------------------------------------------
1775  *     cut on charge (X VIEW)  *     cut on charge (X VIEW)
1776  *     ----------------------------------------------------  *     ----------------------------------------------------
1777           if(dedx(icx).lt.dedx_x_min)then           if(dedx(icx).lt.dedx_x_min)then
# Line 1717  c      common/dbg/DEBUG Line 1788  c      common/dbg/DEBUG
1788           else           else
1789              ilast=TOTCLLENGTH              ilast=TOTCLLENGTH
1790           endif           endif
1791           badcl=badseed           badclx=badseed
1792           do igood=-ngoodstr,ngoodstr           do igood=-ngoodstr,ngoodstr
1793              ibad=1              ibad=1
1794              if((INDMAX(icx)+igood).gt.ifirst.and.              if((INDMAX(icx)+igood).gt.ifirst.and.
# Line 1727  c      common/dbg/DEBUG Line 1798  c      common/dbg/DEBUG
1798       $              nvk(MAXS(icx)+igood),       $              nvk(MAXS(icx)+igood),
1799       $              nst(MAXS(icx)+igood))       $              nst(MAXS(icx)+igood))
1800              endif              endif
1801              badcl=badcl*ibad              badclx=badclx*ibad
1802           enddo           enddo
1803  *     ----------------------------------------------------  *     ----------------------------------------------------
1804  *     >>> eliminato il taglio sulle BAD <<<  *     >>> eliminato il taglio sulle BAD <<<
# Line 1746  c     endif Line 1817  c     endif
1817              if(mod(VIEW(icy),2).eq.0)goto 20              if(mod(VIEW(icy),2).eq.0)goto 20
1818                            
1819  *     ----------------------------------------------------  *     ----------------------------------------------------
1820    *     jump masked views (Y VIEW)
1821    *     ----------------------------------------------------
1822                if( mask_view(VIEW(icy)).ne.0 ) goto 20
1823    
1824    *     ----------------------------------------------------
1825  *     cut on charge (Y VIEW)  *     cut on charge (Y VIEW)
1826  *     ----------------------------------------------------  *     ----------------------------------------------------
1827              if(dedx(icy).lt.dedx_y_min)then              if(dedx(icy).lt.dedx_y_min)then
# Line 1762  c     endif Line 1838  c     endif
1838              else              else
1839                 ilast=TOTCLLENGTH                 ilast=TOTCLLENGTH
1840              endif              endif
1841              badcl=badseed              badcly=badseed
1842              do igood=-ngoodstr,ngoodstr              do igood=-ngoodstr,ngoodstr
1843                 ibad=1                 ibad=1
1844                 if((INDMAX(icy)+igood).gt.ifirst.and.                 if((INDMAX(icy)+igood).gt.ifirst.and.
# Line 1771  c     endif Line 1847  c     endif
1847       $              ibad=BAD(VIEW(icy),       $              ibad=BAD(VIEW(icy),
1848       $              nvk(MAXS(icy)+igood),       $              nvk(MAXS(icy)+igood),
1849       $              nst(MAXS(icy)+igood))       $              nst(MAXS(icy)+igood))
1850                 badcl=badcl*ibad                 badcly=badcly*ibad
1851              enddo              enddo
1852  *     ----------------------------------------------------  *     ----------------------------------------------------
1853  *     >>> eliminato il taglio sulle BAD <<<  *     >>> eliminato il taglio sulle BAD <<<
# Line 1794  c     endif Line 1870  c     endif
1870  *     charge correlation  *     charge correlation
1871  *     (modified to be applied only below saturation... obviously)  *     (modified to be applied only below saturation... obviously)
1872    
1873  *     -------------------------------------------------------------                 if(  .not.(dedx(icy).gt.chsaty.and.dedx(icx).gt.chsatx)
1874  *     >>> eliminata (TEMPORANEAMENTE) la correlazione di carica <<<       $              .and.
1875  *     -------------------------------------------------------------       $              .not.(dedx(icy).lt.chmipy.and.dedx(icx).lt.chmipx)
1876  c$$$               if(dedx(icy).lt.chsaty.or.dedx(icx).lt.chsatx)then       $              .and.
1877  c$$$                  ddd=(dedx(icy)       $              (badclx.eq.1.and.badcly.eq.1)
1878  c$$$     $                 -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))       $              .and.
1879  c$$$                  ddd=ddd/sqrt(kch(nplx,nldx)**2+1)       $              .true.)then
1880  c$$$                  cut=chcut*sch(nplx,nldx)  
1881  c$$$                  if(abs(ddd).gt.cut)goto 20 !charge not consistent                    ddd=(dedx(icy)
1882  c$$$               endif       $                 -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))
1883                      ddd=ddd/sqrt(kch(nplx,nldx)**2+1)
1884    
1885    c                  cut = chcut * sch(nplx,nldx)
1886    
1887                      sss=(kch(nplx,nldx)*dedx(icy)+dedx(icx)
1888         $                 -kch(nplx,nldx)*cch(nplx,nldx))
1889                      sss=sss/sqrt(kch(nplx,nldx)**2+1)
1890                      cut = chcut * (16 + sss/50.)
1891    
1892                      if(abs(ddd).gt.cut)then
1893                         goto 20    !charge not consistent
1894                      endif
1895                   endif
1896                                
1897  *     ------------------> COUPLE <------------------  *     ------------------> COUPLE <------------------
1898  *     check to do not overflow vector dimentions  *     check to do not overflow vector dimentions
1899                 if(ncp_plane(nplx).gt.ncouplemax)then  c$$$               if(ncp_plane(nplx).gt.ncouplemax)then
                   if(DEBUG)print*,  
      $                    ' ** warning ** number of identified'//  
      $                    ' couples on plane ',nplx,  
      $                    ' exceeds vector dimention'//  
      $                    ' ( ',ncouplemax,' )'  
 c     good2=.false.  
 c     goto 880   !fill ntp and go to next event  
                   iflag=1  
                   return  
                endif  
                 
 c$$$               if(ncp_plane(nplx).eq.ncouplemax)then  
1900  c$$$                  if(DEBUG)print*,  c$$$                  if(DEBUG)print*,
1901  c$$$     $                 '** warning ** number of identified '//  c$$$     $                    ' ** warning ** number of identified'//
1902  c$$$     $                 'couples on plane ',nplx,  c$$$     $                    ' couples on plane ',nplx,
1903  c$$$     $                 'exceeds vector dimention '  c$$$     $                    ' exceeds vector dimention'//
1904  c$$$     $                 ,'( ',ncouplemax,' )'  c$$$     $                    ' ( ',ncouplemax,' )'
1905  c$$$c     good2=.false.  c$$$c     good2=.false.
1906  c$$$c     goto 880   !fill ntp and go to next event                      c$$$c     goto 880   !fill ntp and go to next event
1907  c$$$                  iflag=1  c$$$                  iflag=1
1908  c$$$                  return  c$$$                  return
1909  c$$$               endif  c$$$               endif
1910                                
1911                   if(ncp_plane(nplx).eq.ncouplemax)then
1912                      if(verbose)print*,
1913         $                 '** warning ** number of identified '//
1914         $                 'couples on plane ',nplx,
1915         $                 'exceeds vector dimention '
1916         $                 ,'( ',ncouplemax,' ) NB - THIS SHOULD NOT HAPPEN'
1917    c     good2=.false.
1918    c     goto 880   !fill ntp and go to next event                    
1919                      iflag=1
1920                      return
1921                   endif
1922                  
1923                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
1924                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
1925                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
# Line 1868  c$$$               endif Line 1957  c$$$               endif
1957  c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)
1958                
1959        if(ncp_tot.gt.ncp_max)then        if(ncp_tot.gt.ncp_max)then
1960           if(DEBUG)print*,           if(verbose)print*,
1961       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
1962       $           'couples exceeds upper limit for Hough tr. '       $           'couples exceeds upper limit for Hough tr. '
1963       $           ,'( ',ncp_max,' )'                   $           ,'( ',ncp_max,' )'            
# Line 1892  c     goto 880       !fill ntp and go to Line 1981  c     goto 880       !fill ntp and go to
1981        subroutine cl_to_couples_nocharge(iflag)        subroutine cl_to_couples_nocharge(iflag)
1982    
1983        include 'commontracker.f'        include 'commontracker.f'
1984          include 'level1.f'
1985        include 'common_momanhough.f'        include 'common_momanhough.f'
1986        include 'momanhough_init.f'  c      include 'momanhough_init.f'
1987        include 'calib.f'        include 'calib.f'
1988        include 'level1.f'  c      include 'level1.f'
1989    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
1990    
1991  *     output flag  *     output flag
1992  *     --------------  *     --------------
# Line 2027  c$$$               if(abs(ddd).gt.cut)go Line 2115  c$$$               if(abs(ddd).gt.cut)go
2115                                
2116  *     ------------------> COUPLE <------------------  *     ------------------> COUPLE <------------------
2117  *     check to do not overflow vector dimentions  *     check to do not overflow vector dimentions
2118                 if(ncp_plane(nplx).gt.ncouplemax)then  c$$$               if(ncp_plane(nplx).gt.ncouplemax)then
                   if(DEBUG)print*,  
      $                    ' ** warning ** number of identified'//  
      $                    ' couples on plane ',nplx,  
      $                    ' exceeds vector dimention'//  
      $                    ' ( ',ncouplemax,' )'  
 c     good2=.false.  
 c     goto 880   !fill ntp and go to next event  
                   iflag=1  
                   return  
                endif  
                 
 c$$$               if(ncp_plane(nplx).eq.ncouplemax)then  
2119  c$$$                  if(DEBUG)print*,  c$$$                  if(DEBUG)print*,
2120  c$$$     $                 '** warning ** number of identified '//  c$$$     $                    ' ** warning ** number of identified'//
2121  c$$$     $                 'couples on plane ',nplx,  c$$$     $                    ' couples on plane ',nplx,
2122  c$$$     $                 'exceeds vector dimention '  c$$$     $                    ' exceeds vector dimention'//
2123  c$$$     $                 ,'( ',ncouplemax,' )'  c$$$     $                    ' ( ',ncouplemax,' )'
2124  c$$$c     good2=.false.  c$$$c     good2=.false.
2125  c$$$c     goto 880   !fill ntp and go to next event                      c$$$c     goto 880   !fill ntp and go to next event
2126  c$$$                  iflag=1  c$$$                  iflag=1
2127  c$$$                  return  c$$$                  return
2128  c$$$               endif  c$$$               endif
2129                                
2130                   if(ncp_plane(nplx).eq.ncouplemax)then
2131                      if(verbose)print*,
2132         $                 '** warning ** number of identified '//
2133         $                 'couples on plane ',nplx,
2134         $                 'exceeds vector dimention '
2135         $                 ,'( ',ncouplemax,' )'
2136    c     good2=.false.
2137    c     goto 880   !fill ntp and go to next event                    
2138                      iflag=1
2139                      return
2140                   endif
2141                  
2142                 ncp_plane(nplx) = ncp_plane(nplx) + 1                 ncp_plane(nplx) = ncp_plane(nplx) + 1
2143                 clx(nplx,ncp_plane(nplx))=icx                 clx(nplx,ncp_plane(nplx))=icx
2144                 cly(nply,ncp_plane(nplx))=icy                 cly(nply,ncp_plane(nplx))=icy
# Line 2088  c$$$               endif Line 2176  c$$$               endif
2176  c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)
2177                
2178        if(ncp_tot.gt.ncp_max)then        if(ncp_tot.gt.ncp_max)then
2179           if(DEBUG)print*,           if(verbose)print*,
2180       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2181       $           'couples exceeds upper limit for Hough tr. '       $           'couples exceeds upper limit for Hough tr. '
2182       $           ,'( ',ncp_max,' )'                   $           ,'( ',ncp_max,' )'            
# Line 2101  c     goto 880       !fill ntp and go to Line 2189  c     goto 880       !fill ntp and go to
2189        return        return
2190        end        end
2191    
 c$$$      subroutine cl_to_couples_2(iflag)  
 c$$$  
 c$$$      include 'commontracker.f'  
 c$$$      include 'common_momanhough.f'  
 c$$$      include 'momanhough_init.f'  
 c$$$      include 'calib.f'  
 c$$$      include 'level1.f'  
 c$$$  
 c$$$      logical DEBUG  
 c$$$      common/dbg/DEBUG  
 c$$$  
 c$$$*     output flag  
 c$$$*     --------------  
 c$$$*     0 = good event  
 c$$$*     1 = bad event  
 c$$$*     --------------  
 c$$$      integer iflag  
 c$$$  
 c$$$      integer badseed,badcl  
 c$$$  
 c$$$*     init variables  
 c$$$      ncp_tot=0  
 c$$$      do ip=1,nplanes  
 c$$$         do ico=1,ncouplemax  
 c$$$            clx(ip,ico)=0  
 c$$$            cly(ip,ico)=0  
 c$$$         enddo  
 c$$$         ncp_plane(ip)=0  
 c$$$         do icl=1,nclstrmax_level2  
 c$$$            cls(ip,icl)=1  
 c$$$         enddo  
 c$$$         ncls(ip)=0  
 c$$$      enddo  
 c$$$      do icl=1,nclstrmax_level2  
 c$$$         cl_single(icl)=1  
 c$$$         cl_good(icl)=0  
 c$$$      enddo  
 c$$$        
 c$$$*     start association  
 c$$$      ncouples=0  
 c$$$      do icx=1,nclstr1          !loop on cluster (X)  
 c$$$         if(mod(VIEW(icx),2).eq.1)goto 10  
 c$$$          
 c$$$*     ----------------------------------------------------  
 c$$$*     cut on charge (X VIEW)  
 c$$$         if(dedx(icx).lt.dedx_x_min)then  
 c$$$            cl_single(icx)=0  
 c$$$            goto 10  
 c$$$         endif  
 c$$$*     cut BAD (X VIEW)              
 c$$$         badseed=BAD(VIEW(icx),nvk(MAXS(icx)),nst(MAXS(icx)))  
 c$$$         ifirst=INDSTART(icx)  
 c$$$         if(icx.ne.nclstr1) then  
 c$$$            ilast=INDSTART(icx+1)-1  
 c$$$         else  
 c$$$            ilast=TOTCLLENGTH  
 c$$$         endif  
 c$$$         badcl=badseed  
 c$$$         do igood=-ngoodstr,ngoodstr  
 c$$$            ibad=1  
 c$$$            if((INDMAX(icx)+igood).gt.ifirst.and.  
 c$$$     $           (INDMAX(icx)+igood).lt.ilast.and.  
 c$$$     $           .true.)then  
 c$$$               ibad=BAD(VIEW(icx),  
 c$$$     $              nvk(MAXS(icx)+igood),  
 c$$$     $              nst(MAXS(icx)+igood))  
 c$$$            endif  
 c$$$            badcl=badcl*ibad  
 c$$$         enddo  
 c$$$*         print*,'icx ',icx,badcl  
 c$$$         if(badcl.eq.0)then  
 c$$$            cl_single(icx)=0  
 c$$$            goto 10  
 c$$$         endif  
 c$$$*     ----------------------------------------------------  
 c$$$          
 c$$$         cl_good(icx)=1  
 c$$$         nplx=npl(VIEW(icx))  
 c$$$         nldx=nld(MAXS(icx),VIEW(icx))  
 c$$$          
 c$$$         do icy=1,nclstr1       !loop on cluster (Y)  
 c$$$            if(mod(VIEW(icy),2).eq.0)goto 20  
 c$$$              
 c$$$*     ----------------------------------------------------  
 c$$$*     cut on charge (Y VIEW)  
 c$$$            if(dedx(icy).lt.dedx_y_min)then  
 c$$$               cl_single(icy)=0  
 c$$$               goto 20  
 c$$$            endif  
 c$$$*     cut BAD (Y VIEW)              
 c$$$            badseed=BAD(VIEW(icy),nvk(MAXS(icy)),nst(MAXS(icy)))  
 c$$$            ifirst=INDSTART(icy)  
 c$$$            if(icy.ne.nclstr1) then  
 c$$$               ilast=INDSTART(icy+1)-1  
 c$$$            else  
 c$$$               ilast=TOTCLLENGTH  
 c$$$            endif  
 c$$$            badcl=badseed  
 c$$$            do igood=-ngoodstr,ngoodstr  
 c$$$               ibad=1  
 c$$$               if((INDMAX(icy)+igood).gt.ifirst.and.  
 c$$$     $              (INDMAX(icy)+igood).lt.ilast.and.  
 c$$$     $              .true.)  
 c$$$     $              ibad=BAD(VIEW(icy),  
 c$$$     $              nvk(MAXS(icy)+igood),  
 c$$$     $              nst(MAXS(icy)+igood))  
 c$$$               badcl=badcl*ibad  
 c$$$            enddo  
 c$$$*            print*,'icy ',icy,badcl  
 c$$$            if(badcl.eq.0)then  
 c$$$               cl_single(icy)=0  
 c$$$               goto 20  
 c$$$            endif  
 c$$$*     ----------------------------------------------------  
 c$$$              
 c$$$              
 c$$$            cl_good(icy)=1                    
 c$$$            nply=npl(VIEW(icy))  
 c$$$            nldy=nld(MAXS(icy),VIEW(icy))  
 c$$$              
 c$$$*     ----------------------------------------------  
 c$$$*     CONDITION TO FORM A COUPLE  
 c$$$*     ----------------------------------------------  
 c$$$*     geometrical consistency (same plane and ladder)  
 c$$$            if(nply.eq.nplx.and.nldy.eq.nldx)then  
 c$$$  
 c$$$c$$$*     charge correlation  
 c$$$c$$$               ddd=(dedx(icy)  
 c$$$c$$$     $              -kch(nplx,nldx)*dedx(icx)-cch(nplx,nldx))  
 c$$$c$$$               ddd=ddd/sqrt(kch(nplx,nldx)**2+1)  
 c$$$c$$$               cut=chcut*sch(nplx,nldx)  
 c$$$c$$$               if(abs(ddd).gt.cut)goto 20 !charge not consistent  
 c$$$                
 c$$$*     ------------------> COUPLE <------------------  
 c$$$*     check to do not overflow vector dimentions  
 c$$$               if(ncp_plane(nplx).gt.ncouplemax)then  
 c$$$                  if(DEBUG)print*,  
 c$$$     $                    ' ** warning ** number of identified'//  
 c$$$     $                    ' couples on plane ',nplx,  
 c$$$     $                    ' exceeds vector dimention'//  
 c$$$     $                    ' ( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event  
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
 c$$$                
 c$$$               if(ncp_plane(nplx).eq.ncouplemax)then  
 c$$$                  if(DEBUG)print*,  
 c$$$     $                 '** warning ** number of identified '//  
 c$$$     $                 'couples on plane ',nplx,  
 c$$$     $                 'exceeds vector dimention '  
 c$$$     $                 ,'( ',ncouplemax,' )'  
 c$$$c     good2=.false.  
 c$$$c     goto 880   !fill ntp and go to next event                      
 c$$$                  iflag=1  
 c$$$                  return  
 c$$$               endif  
 c$$$                
 c$$$               ncp_plane(nplx) = ncp_plane(nplx) + 1  
 c$$$               clx(nplx,ncp_plane(nplx))=icx  
 c$$$               cly(nply,ncp_plane(nplx))=icy  
 c$$$               cl_single(icx)=0  
 c$$$               cl_single(icy)=0  
 c$$$c               print*,'couple ',nplx,ncp_plane(nplx),' --- ',icx,icy  
 c$$$            endif                                
 c$$$*     ----------------------------------------------  
 c$$$  
 c$$$ 20         continue  
 c$$$         enddo                  !end loop on clusters(Y)  
 c$$$          
 c$$$ 10      continue  
 c$$$      enddo                     !end loop on clusters(X)  
 c$$$        
 c$$$        
 c$$$      do icl=1,nclstr1  
 c$$$         if(cl_single(icl).eq.1)then  
 c$$$            ip=npl(VIEW(icl))  
 c$$$            ncls(ip)=ncls(ip)+1  
 c$$$            cls(ip,ncls(ip))=icl  
 c$$$         endif  
 c$$$      enddo  
 c$$$        
 c$$$        
 c$$$      if(DEBUG)then  
 c$$$         print*,'clusters  ',nclstr1  
 c$$$         print*,'good    ',(cl_good(i),i=1,nclstr1)  
 c$$$         print*,'singles ',(cl_single(i),i=1,nclstr1)  
 c$$$         print*,'couples per plane: ',(ncp_plane(ip),ip=1,nplanes)  
 c$$$      endif  
 c$$$        
 c$$$      do ip=1,6  
 c$$$         ncp_tot=ncp_tot+ncp_plane(ip)  
 c$$$      enddo  
 c$$$c     if(ncp_tot.gt.ncp_max)goto 100!next event (TEMPORANEO!!!)  
 c$$$        
 c$$$      if(ncp_tot.gt.ncp_max)then  
 c$$$         if(DEBUG)print*,  
 c$$$     $           '** warning ** number of identified '//  
 c$$$     $           'couples exceeds upper limit for Hough tr. '  
 c$$$     $           ,'( ',ncp_max,' )'              
 c$$$c            good2=.false.  
 c$$$c     goto 880       !fill ntp and go to next event  
 c$$$         iflag=1  
 c$$$         return  
 c$$$      endif  
 c$$$        
 c$$$      return  
 c$$$      end  
2192                
2193  ***************************************************  ***************************************************
2194  *                                                 *  *                                                 *
# Line 2326  c     02/02/2006 modified by Elena Vannu Line 2205  c     02/02/2006 modified by Elena Vannu
2205  c*****************************************************  c*****************************************************
2206    
2207        include 'commontracker.f'        include 'commontracker.f'
2208          include 'level1.f'
2209        include 'common_momanhough.f'        include 'common_momanhough.f'
2210        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2211        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2212        include 'common_mini_2.f'        include 'common_mini_2.f'
2213        include 'calib.f'        include 'calib.f'
2214        include 'level1.f'  c      include 'level1.f'
2215    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2216    
2217  *     output flag  *     output flag
2218  *     --------------  *     --------------
# Line 2402  c     $                       (icx2,icy2 Line 2280  c     $                       (icx2,icy2
2280  *     (2 couples needed)  *     (2 couples needed)
2281  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2282                          if(ndblt.eq.ndblt_max)then                          if(ndblt.eq.ndblt_max)then
2283                             if(DEBUG)print*,                             if(verbose)print*,
2284       $                          '** warning ** number of identified '//       $                          '** warning ** number of identified '//
2285       $                          'doublets exceeds vector dimention '       $                          'doublets exceeds vector dimention '
2286       $                          ,'( ',ndblt_max,' )'       $                          ,'( ',ndblt_max,' )'
# Line 2472  c     $                                 Line 2350  c     $                                
2350  *     (3 couples needed)  *     (3 couples needed)
2351  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -  *     - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2352                                   if(ntrpt.eq.ntrpt_max)then                                   if(ntrpt.eq.ntrpt_max)then
2353                                      if(DEBUG)print*,                                      if(verbose)print*,
2354       $                     '** warning ** number of identified '//       $                     '** warning ** number of identified '//
2355       $                     'triplets exceeds vector dimention '       $                     'triplets exceeds vector dimention '
2356       $                    ,'( ',ntrpt_max,' )'       $                    ,'( ',ntrpt_max,' )'
# Line 2552  c     goto 880               !ntp fill Line 2430  c     goto 880               !ntp fill
2430        subroutine doub_to_YZcloud(iflag)        subroutine doub_to_YZcloud(iflag)
2431    
2432        include 'commontracker.f'        include 'commontracker.f'
2433          include 'level1.f'
2434        include 'common_momanhough.f'        include 'common_momanhough.f'
2435        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2436    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2437    
2438  *     output flag  *     output flag
2439  *     --------------  *     --------------
# Line 2588  c      common/dbg/DEBUG Line 2465  c      common/dbg/DEBUG
2465        distance=0        distance=0
2466        nclouds_yz=0              !number of clouds        nclouds_yz=0              !number of clouds
2467        npt_tot=0        npt_tot=0
2468          nloop=0                  
2469     90   continue                  
2470        do idb1=1,ndblt           !loop (1) on DOUBLETS        do idb1=1,ndblt           !loop (1) on DOUBLETS
2471           if(db_used(idb1).eq.1)goto 2228 !db already included in a cloud           if(db_used(idb1).eq.1)goto 2228 !db already included in a cloud
2472                            
# Line 2691  c     print*,'*   idbref,idb2 ',idbref,i Line 2570  c     print*,'*   idbref,idb2 ',idbref,i
2570              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2571           enddo           enddo
2572  c     print*,'>>>> ',ncpused,npt,nplused  c     print*,'>>>> ',ncpused,npt,nplused
2573           if(ncpused.lt.ncpyz_min)goto 2228 !next doublet  c         if(ncpused.lt.ncpyz_min)goto 2228 !next doublet
2574           if(npt.lt.nptyz_min)goto 2228 !next doublet           if(npt.lt.nptyz_min)goto 2228 !next doublet
2575           if(nplused.lt.nplyz_min)goto 2228 !next doublet           if(nplused.lt.nplyz_min)goto 2228 !next doublet
2576                    
# Line 2699  c     print*,'>>>> ',ncpused,npt,nplused Line 2578  c     print*,'>>>> ',ncpused,npt,nplused
2578  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2579    
2580           if(nclouds_yz.ge.ncloyz_max)then           if(nclouds_yz.ge.ncloyz_max)then
2581              if(DEBUG)print*,              if(verbose)print*,
2582       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2583       $           'YZ clouds exceeds vector dimention '       $           'YZ clouds exceeds vector dimention '
2584       $           ,'( ',ncloyz_max,' )'       $           ,'( ',ncloyz_max,' )'
# Line 2742  c$$$     $           ,(db_cloud(iii),iii Line 2621  c$$$     $           ,(db_cloud(iii),iii
2621        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2622                
2623                
2624          if(nloop.lt.nstepy)then      
2625            cutdistyz = cutdistyz+cutystep
2626            nloop     = nloop+1          
2627            goto 90                
2628          endif                    
2629          
2630        if(DEBUG)then        if(DEBUG)then
2631           print*,'---------------------- '           print*,'---------------------- '
2632           print*,'Y-Z total clouds ',nclouds_yz           print*,'Y-Z total clouds ',nclouds_yz
# Line 2768  c$$$     $           ,(db_cloud(iii),iii Line 2653  c$$$     $           ,(db_cloud(iii),iii
2653        subroutine trip_to_XZcloud(iflag)        subroutine trip_to_XZcloud(iflag)
2654    
2655        include 'commontracker.f'        include 'commontracker.f'
2656          include 'level1.f'
2657        include 'common_momanhough.f'        include 'common_momanhough.f'
2658        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2659    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2660    
2661  *     output flag  *     output flag
2662  *     --------------  *     --------------
# Line 2803  c      common/dbg/DEBUG Line 2687  c      common/dbg/DEBUG
2687        distance=0        distance=0
2688        nclouds_xz=0              !number of clouds                nclouds_xz=0              !number of clouds        
2689        npt_tot=0                 !total number of selected triplets        npt_tot=0                 !total number of selected triplets
2690          nloop=0                  
2691     91   continue                  
2692        do itr1=1,ntrpt           !loop (1) on TRIPLETS        do itr1=1,ntrpt           !loop (1) on TRIPLETS
2693           if(tr_used(itr1).eq.1)goto 22288 !already included in a cloud           if(tr_used(itr1).eq.1)goto 22288 !already included in a cloud
2694  c     print*,'--------------'  c     print*,'--------------'
# Line 2904  c     print*,'check cp_used' Line 2790  c     print*,'check cp_used'
2790           do ip=1,nplanes           do ip=1,nplanes
2791              nplused=nplused+ hit_plane(ip)              nplused=nplused+ hit_plane(ip)
2792           enddo           enddo
2793           if(ncpused.lt.ncpxz_min)goto 22288 !next triplet  c         if(ncpused.lt.ncpxz_min)goto 22288 !next triplet
2794           if(npt.lt.nptxz_min)goto 22288     !next triplet           if(npt.lt.nptxz_min)goto 22288     !next triplet
2795           if(nplused.lt.nplxz_min)goto 22288 !next doublet           if(nplused.lt.nplxz_min)goto 22288 !next doublet
2796                    
2797  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2798  *     >>> NEW CLOUD <<<  *     >>> NEW CLOUD <<<
2799           if(nclouds_xz.ge.ncloxz_max)then           if(nclouds_xz.ge.ncloxz_max)then
2800              if(DEBUG)print*,              if(verbose)print*,
2801       $           '** warning ** number of identified '//       $           '** warning ** number of identified '//
2802       $           'XZ clouds exceeds vector dimention '       $           'XZ clouds exceeds vector dimention '
2803       $           ,'( ',ncloxz_max,' )'       $           ,'( ',ncloxz_max,' )'
# Line 2952  c$$$     $           ,(tr_cloud(iii),iii Line 2838  c$$$     $           ,(tr_cloud(iii),iii
2838  *     ~~~~~~~~~~~~~~~~~  *     ~~~~~~~~~~~~~~~~~
2839  22288    continue  22288    continue
2840        enddo                     !end loop (1) on DOUBLETS        enddo                     !end loop (1) on DOUBLETS
2841          
2842           if(nloop.lt.nstepx)then      
2843             cutdistxz=cutdistxz+cutxstep
2844             nloop=nloop+1          
2845             goto 91                
2846           endif                    
2847          
2848        if(DEBUG)then        if(DEBUG)then
2849           print*,'---------------------- '           print*,'---------------------- '
2850           print*,'X-Z total clouds ',nclouds_xz           print*,'X-Z total clouds ',nclouds_xz
# Line 2979  c     02/02/2006 modified by Elena Vannu Line 2871  c     02/02/2006 modified by Elena Vannu
2871  c*****************************************************  c*****************************************************
2872    
2873        include 'commontracker.f'        include 'commontracker.f'
2874          include 'level1.f'
2875        include 'common_momanhough.f'        include 'common_momanhough.f'
2876        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
2877        include 'common_mini_2.f'        include 'common_mini_2.f'
2878        include 'common_mech.f'        include 'common_mech.f'
2879        include 'momanhough_init.f'  c      include 'momanhough_init.f'
2880    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
2881    
2882  *     output flag  *     output flag
2883  *     --------------  *     --------------
# Line 3002  c      common/dbg/DEBUG Line 2893  c      common/dbg/DEBUG
2893  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2894  *     list of matching couples in the combination  *     list of matching couples in the combination
2895  *     between a XZ and YZ cloud  *     between a XZ and YZ cloud
2896        integer cp_match(nplanes,ncouplemax)        integer cp_match(nplanes,2*ncouplemax)
2897        integer ncp_match(nplanes)        integer ncp_match(nplanes)
2898  *     -----------------------------------------------------------  *     -----------------------------------------------------------
2899        integer hit_plane(nplanes)        integer hit_plane(nplanes)
# Line 3102  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p Line 2993  c$$$  print*,'6 -- ',(cly(6,i),i=1,ncp_p
2993  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'  c$$$  print*,'~~~~~~~~~~~~~~~~~~~~~~~~~'
2994                            
2995  *     -------> INITIAL GUESS <-------  *     -------> INITIAL GUESS <-------
2996              AL_INI(1)=dreal(alfaxz1_av(ixz))              AL_INI(1) = dreal(alfaxz1_av(ixz))
2997              AL_INI(2)=dreal(alfayz1_av(iyz))              AL_INI(2) = dreal(alfayz1_av(iyz))
2998              AL_INI(4)=datan(dreal(alfayz2_av(iyz))              AL_INI(4) = PIGR + datan(dreal(alfayz2_av(iyz))
2999       $           /dreal(alfaxz2_av(ixz)))       $           /dreal(alfaxz2_av(ixz)))
3000              tath=-dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))              tath      = -dreal(alfaxz2_av(ixz))/dcos(AL_INI(4))
3001              AL_INI(3)=tath/sqrt(1+tath**2)              AL_INI(3) = tath/sqrt(1+tath**2)
3002              AL_INI(5)=(1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.              AL_INI(5) = (1.e2*alfaxz3_av(ixz))/(0.3*0.43) !0.
3003                            
3004  c     print*,'*******',AL_INI(5)  c     print*,'*******',AL_INI(5)
3005              if(AL_INI(5).gt.defmax)goto 888 !next cloud              if(AL_INI(5).gt.defmax)goto 888 !next cloud
# Line 3191  c     $                                 Line 3082  c     $                                
3082                                enddo                                enddo
3083                                ifail=0 !error flag in chi^2 computation                                ifail=0 !error flag in chi^2 computation
3084                                jstep=0 !number of  minimization steps                                jstep=0 !number of  minimization steps
3085                                call mini_2(jstep,ifail)                                iprint=0
3086                                  if(DEBUG)iprint=1
3087                                  call mini2(jstep,ifail,iprint)
3088                                if(ifail.ne.0) then                                if(ifail.ne.0) then
3089                                   if(DEBUG)then                                   if(DEBUG)then
3090                                      print *,                                      print *,
3091       $                              '*** MINIMIZATION FAILURE *** '       $                              '*** MINIMIZATION FAILURE *** '
3092       $                              //'(mini_2 in clouds_to_ctrack)'       $                              //'(mini2 in clouds_to_ctrack)'
3093                                   endif                                   endif
3094                                   chi2=-chi2                                   chi2=-chi2
3095                                endif                                endif
# Line 3211  c     $                                 Line 3104  c     $                                
3104  *     --------------------------  *     --------------------------
3105                                if(ntracks.eq.NTRACKSMAX)then                                if(ntracks.eq.NTRACKSMAX)then
3106                                                                    
3107                                   if(DEBUG)print*,                                   if(verbose)print*,
3108       $                 '** warning ** number of candidate tracks '//       $                 '** warning ** number of candidate tracks '//
3109       $                 ' exceeds vector dimension '       $                 ' exceeds vector dimension '
3110       $                ,'( ',NTRACKSMAX,' )'       $                ,'( ',NTRACKSMAX,' )'
# Line 3315  cccccc 12/08/2006 modified by elena vann Line 3208  cccccc 12/08/2006 modified by elena vann
3208  c******************************************************  c******************************************************
3209    
3210        include 'commontracker.f'        include 'commontracker.f'
3211          include 'level1.f'
3212        include 'common_momanhough.f'        include 'common_momanhough.f'
3213        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3214        include 'common_mini_2.f'        include 'common_mini_2.f'
3215        include 'common_mech.f'        include 'common_mech.f'
3216        include 'momanhough_init.f'  c      include 'momanhough_init.f'
3217        include 'level1.f'  c      include 'level1.f'
3218        include 'calib.f'        include 'calib.f'
3219    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
3220    
3221  *     flag to chose PFA  *     flag to chose PFA
3222        character*10 PFA        character*10 PFA
# Line 3645  cccccc 12/08/2006 modified by elena ---> Line 3537  cccccc 12/08/2006 modified by elena --->
3537        subroutine clean_XYclouds(ibest,iflag)        subroutine clean_XYclouds(ibest,iflag)
3538    
3539        include 'commontracker.f'        include 'commontracker.f'
3540          include 'level1.f'
3541        include 'common_momanhough.f'        include 'common_momanhough.f'
3542        include 'momanhough_init.f'  c      include 'momanhough_init.f'
3543        include 'level2.f'        !(1)        include 'level2.f'        !(1)
3544  c      include 'calib.f'  c      include 'calib.f'
3545  c      include 'level1.f'  c      include 'level1.f'
3546    
 c      logical DEBUG  
 c      common/dbg/DEBUG  
3547    
3548    
3549        do ip=1,nplanes           !loop on planes        do ip=1,nplanes           !loop on planes
# Line 3828  c$$$ Line 3719  c$$$
3719    
3720        subroutine init_level2        subroutine init_level2
3721    
 c*****************************************************  
 c     07/10/2005 modified by elena vannuccini --> (1)  
 c*****************************************************  
   
3722        include 'commontracker.f'        include 'commontracker.f'
3723          include 'level1.f'
3724        include 'common_momanhough.f'        include 'common_momanhough.f'
3725        include 'level2.f'        include 'level2.f'
3726        include 'level1.f'  c      include 'level1.f'
3727    
3728        do i=1,nviews        do i=1,nviews
3729           good2(i)=good1(i)           good2(i)=good1(i)
3730        enddo        enddo
3731    
 c      good2 = 0!.false.  
 c$$$      nev2 = nev1  
   
 c$$$# ifndef TEST2003  
 c$$$c*****************************************************  
 c$$$cccccc 11/9/2005 modified by david fedele  
 c$$$c      pkt_type = pkt_type1  
 c$$$c      pkt_num = pkt_num1  
 c$$$c      obt = obt1  
 c$$$c      which_calib = which_calib1  
 c$$$      swcode = 302  
 c$$$  
 c$$$      which_calib = which_calib1  
 c$$$      pkt_type = pkt_type1  
 c$$$      pkt_num = pkt_num1  
 c$$$      obt = obt1  
 c$$$      cpu_crc = cpu_crc1  
 c$$$      do iv=1,12  
 c$$$         crc(iv)=crc1(iv)  
 c$$$      enddo  
 c$$$# endif  
 c*****************************************************  
3732    
3733        NTRK = 0        NTRK = 0
3734        do it=1,NTRKMAX!NTRACKSMAX        do it=1,NTRKMAX
3735           IMAGE(IT)=0           IMAGE(IT)=0
3736           CHI2_nt(IT) = -100000.           CHI2_nt(IT) = -100000.
 c         BdL(IT) = 0.  
3737           do ip=1,nplanes           do ip=1,nplanes
3738              XM_nt(IP,IT) = 0              XM_nt(IP,IT) = 0
3739              YM_nt(IP,IT) = 0              YM_nt(IP,IT) = 0
# Line 3877  c         BdL(IT) = 0. Line 3742  c         BdL(IT) = 0.
3742              RESY_nt(IP,IT) = 0              RESY_nt(IP,IT) = 0
3743              XGOOD_nt(IP,IT) = 0              XGOOD_nt(IP,IT) = 0
3744              YGOOD_nt(IP,IT) = 0              YGOOD_nt(IP,IT) = 0
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3745              DEDX_X(IP,IT) = 0              DEDX_X(IP,IT) = 0
3746              DEDX_Y(IP,IT) = 0              DEDX_Y(IP,IT) = 0
 c******************************************************  
 cccccc 17/8/2006 modified by elena  
3747              CLTRX(IP,IT) = 0              CLTRX(IP,IT) = 0
3748              CLTRY(IP,IT) = 0              CLTRY(IP,IT) = 0
3749           enddo           enddo
# Line 3893  cccccc 17/8/2006 modified by elena Line 3754  cccccc 17/8/2006 modified by elena
3754              enddo                                enddo                  
3755           enddo                             enddo                  
3756        enddo        enddo
         
         
 c*****************************************************  
 cccccc 11/9/2005 modified by david fedele  
3757        nclsx=0        nclsx=0
3758        nclsy=0              nclsy=0      
3759        do ip=1,NSINGMAX        do ip=1,NSINGMAX
3760          planex(ip)=0          planex(ip)=0
 c        xs(ip)=0  
3761          xs(1,ip)=0          xs(1,ip)=0
3762          xs(2,ip)=0          xs(2,ip)=0
3763          sgnlxs(ip)=0          sgnlxs(ip)=0
3764          planey(ip)=0          planey(ip)=0
 c        ys(ip)=0  
3765          ys(1,ip)=0          ys(1,ip)=0
3766          ys(2,ip)=0          ys(2,ip)=0
3767          sgnlys(ip)=0          sgnlys(ip)=0
3768        enddo        enddo
 c*******************************************************  
3769        end        end
3770    
3771    
# Line 3926  c*************************************** Line 3780  c***************************************
3780  ************************************************************  ************************************************************
3781    
3782    
3783          subroutine init_hough
3784    
3785          include 'commontracker.f'
3786          include 'level1.f'
3787          include 'common_momanhough.f'
3788          include 'common_hough.f'
3789          include 'level2.f'
3790    
3791          ntrpt_nt=0
3792          ndblt_nt=0
3793          NCLOUDS_XZ_nt=0
3794          NCLOUDS_YZ_nt=0
3795          do idb=1,ndblt_max_nt
3796             db_cloud_nt(idb)=0
3797             alfayz1_nt(idb)=0      
3798             alfayz2_nt(idb)=0      
3799          enddo
3800          do itr=1,ntrpl_max_nt
3801             tr_cloud_nt(itr)=0
3802             alfaxz1_nt(itr)=0      
3803             alfaxz2_nt(itr)=0      
3804             alfaxz3_nt(itr)=0      
3805          enddo
3806          do idb=1,ncloyz_max      
3807            ptcloud_yz_nt(idb)=0    
3808            alfayz1_av_nt(idb)=0    
3809            alfayz2_av_nt(idb)=0    
3810          enddo                    
3811          do itr=1,ncloxz_max      
3812            ptcloud_xz_nt(itr)=0    
3813            alfaxz1_av_nt(itr)=0    
3814            alfaxz2_av_nt(itr)=0    
3815            alfaxz3_av_nt(itr)=0    
3816          enddo                    
3817    
3818          ntrpt=0                  
3819          ndblt=0                  
3820          NCLOUDS_XZ=0              
3821          NCLOUDS_YZ=0              
3822          do idb=1,ndblt_max        
3823            db_cloud(idb)=0        
3824            cpyz1(idb)=0            
3825            cpyz2(idb)=0            
3826            alfayz1(idb)=0          
3827            alfayz2(idb)=0          
3828          enddo                    
3829          do itr=1,ntrpl_max        
3830            tr_cloud(itr)=0        
3831            cpxz1(itr)=0            
3832            cpxz2(itr)=0            
3833            cpxz3(itr)=0            
3834            alfaxz1(itr)=0          
3835            alfaxz2(itr)=0          
3836            alfaxz3(itr)=0          
3837          enddo                    
3838          do idb=1,ncloyz_max      
3839            ptcloud_yz(idb)=0      
3840            alfayz1_av(idb)=0      
3841            alfayz2_av(idb)=0      
3842            do idbb=1,ncouplemaxtot
3843              cpcloud_yz(idb,idbb)=0
3844            enddo                  
3845          enddo                    
3846          do itr=1,ncloxz_max      
3847            ptcloud_xz(itr)=0      
3848            alfaxz1_av(itr)=0      
3849            alfaxz2_av(itr)=0      
3850            alfaxz3_av(itr)=0      
3851            do itrr=1,ncouplemaxtot
3852              cpcloud_xz(itr,itrr)=0
3853            enddo                  
3854          enddo                    
3855          end
3856    ************************************************************
3857    *
3858    *
3859    *
3860    *
3861    *
3862    *
3863    *
3864    ************************************************************
3865    
3866    
3867        subroutine fill_level2_tracks(ntr)        subroutine fill_level2_tracks(ntr)
3868    
3869  *     -------------------------------------------------------  *     -------------------------------------------------------
# Line 3936  c*************************************** Line 3874  c***************************************
3874    
3875            
3876        include 'commontracker.f'        include 'commontracker.f'
3877    c      include 'level1.f'
3878        include 'level1.f'        include 'level1.f'
3879          include 'common_momanhough.f'
3880        include 'level2.f'        include 'level2.f'
3881        include 'common_mini_2.f'        include 'common_mini_2.f'
3882        include 'common_momanhough.f'        real sinth,phi,pig      
       real sinth,phi,pig        !(4)  
3883        pig=acos(-1.)        pig=acos(-1.)
3884    
 c      good2=1!.true.  
3885        chi2_nt(ntr)        = sngl(chi2)        chi2_nt(ntr)        = sngl(chi2)
3886        nstep_nt(ntr)       = 0!nstep        nstep_nt(ntr)       = nstep
3887    
3888          phi   = al(4)          
3889          sinth = al(3)            
3890          if(sinth.lt.0)then      
3891             sinth = -sinth        
3892             phi = phi + pig      
3893          endif                    
3894          npig = aint(phi/(2*pig))
3895          phi = phi - npig*2*pig  
3896          if(phi.lt.0)            
3897         $     phi = phi + 2*pig  
3898          al(4) = phi              
3899          al(3) = sinth            
3900    
       phi   = al(4)             !(4)  
       sinth = al(3)             !(4)  
       if(sinth.lt.0)then        !(4)  
          sinth = -sinth         !(4)  
          phi = phi + pig        !(4)  
       endif                     !(4)  
       npig = aint(phi/(2*pig))  !(4)  
       phi = phi - npig*2*pig    !(4)  
       if(phi.lt.0)              !(4)  
      $     phi = phi + 2*pig    !(4)  
       al(4) = phi               !(4)  
       al(3) = sinth             !(4)  
 *****************************************************  
3901        do i=1,5        do i=1,5
3902           al_nt(i,ntr)     = sngl(al(i))           al_nt(i,ntr)     = sngl(al(i))
3903           do j=1,5           do j=1,5
3904              coval(i,j,ntr) = sngl(cov(i,j))              coval(i,j,ntr) = sngl(cov(i,j))
3905           enddo           enddo
 c     print*,al_nt(i,ntr)  
3906        enddo        enddo
3907                
3908        do ip=1,nplanes           ! loop on planes        do ip=1,nplanes           ! loop on planes
# Line 3981  c     print*,al_nt(i,ntr) Line 3918  c     print*,al_nt(i,ntr)
3918           zv_nt(ip,ntr)    = sngl(zv(ip))           zv_nt(ip,ntr)    = sngl(zv(ip))
3919           axv_nt(ip,ntr)   = sngl(axv(ip))           axv_nt(ip,ntr)   = sngl(axv(ip))
3920           ayv_nt(ip,ntr)   = sngl(ayv(ip))           ayv_nt(ip,ntr)   = sngl(ayv(ip))
 c        dedxp(ip,ntr)    = sngl(dedxtrk(ip))   !(1)  
3921           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)           dedx_x(ip,ntr)   = sngl(dedxtrk_x(ip)) !(2)
3922           dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)             dedx_y(ip,ntr)   = sngl(dedxtrk_y(ip)) !(2)  
3923        
# Line 3998  c            print*,ip,' ',cltrx(ip,ntr) Line 3934  c            print*,ip,' ',cltrx(ip,ntr)
3934           endif                     endif          
3935    
3936        enddo        enddo
 c      call CalcBdL(100,xxxx,IFAIL)  
 c      if(ifps(xxxx).eq.1)BdL(ntr) = xxxx  
 c$$$      print*,'xgood(ip,ntr) ',(xgood_nt(ip,ntr),ip=1,6)  
 c$$$      print*,'ygood(ip,ntr) ',(ygood_nt(ip,ntr),ip=1,6)  
 c$$$      print*,'dedx_x(ip,ntr) ',(dedx_x(ip,ntr),ip=1,6)  
 c$$$      print*,'dedx_y(ip,ntr) ',(dedx_y(ip,ntr),ip=1,6)  
3937    
3938    
3939        end        end
3940    
3941        subroutine fill_level2_siglets        subroutine fill_level2_siglets
 c*****************************************************  
 c     07/10/2005 created by elena vannuccini  
 c     31/01/2006 modified by elena vannuccini  
 *     to convert adc to mip  --> (2)  
 c*****************************************************  
3942    
3943  *     -------------------------------------------------------  *     -------------------------------------------------------
3944  *     This routine fills the  elements of the variables  *     This routine fills the  elements of the variables
# Line 4022  c*************************************** Line 3947  c***************************************
3947  *     -------------------------------------------------------  *     -------------------------------------------------------
3948    
3949        include 'commontracker.f'        include 'commontracker.f'
3950        include 'level1.f'  c      include 'level1.f'
       include 'level2.f'  
3951        include 'calib.f'        include 'calib.f'
3952          include 'level1.f'
3953        include 'common_momanhough.f'        include 'common_momanhough.f'
3954          include 'level2.f'
3955        include 'common_xyzPAM.f'        include 'common_xyzPAM.f'
3956    
3957  *     count #cluster per plane not associated to any track  *     count #cluster per plane not associated to any track
# Line 4033  c      good2=1!.true. Line 3959  c      good2=1!.true.
3959        nclsx = 0        nclsx = 0
3960        nclsy = 0        nclsy = 0
3961    
3962          do iv = 1,nviews
3963             if( mask_view(iv).ne.0 )good2(iv) = 20+mask_view(iv)
3964          enddo
3965    
3966        do icl=1,nclstr1        do icl=1,nclstr1
3967           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
3968              ip=nplanes-npl(VIEW(icl))+1                          ip=nplanes-npl(VIEW(icl))+1            
# Line 4076  c      print*,icl,cl_used(icl),cl_good(i Line 4006  c      print*,icl,cl_used(icl),cl_good(i
4006        enddo        enddo
4007        end        end
4008    
4009    ***************************************************
4010    *                                                 *
4011    *                                                 *
4012    *                                                 *
4013    *                                                 *
4014    *                                                 *
4015    *                                                 *
4016    **************************************************
4017    
4018          subroutine fill_hough
4019    
4020    *     -------------------------------------------------------
4021    *     This routine fills the  variables related to the hough
4022    *     transform, for the debig n-tuple
4023    *     -------------------------------------------------------
4024    
4025          include 'commontracker.f'
4026          include 'level1.f'
4027          include 'common_momanhough.f'
4028          include 'common_hough.f'
4029          include 'level2.f'
4030    
4031          if(.false.
4032         $     .or.ntrpt.gt.ntrpt_max_nt
4033         $     .or.ndblt.gt.ndblt_max_nt
4034         $     .or.NCLOUDS_XZ.gt.ncloxz_max
4035         $     .or.NCLOUDS_yZ.gt.ncloyz_max
4036         $     )then
4037             ntrpt_nt=0
4038             ndblt_nt=0
4039             NCLOUDS_XZ_nt=0
4040             NCLOUDS_YZ_nt=0
4041          else
4042             ndblt_nt=ndblt
4043             ntrpt_nt=ntrpt
4044             if(ndblt.ne.0)then
4045                do id=1,ndblt
4046                   alfayz1_nt(id)=alfayz1(id) !Y0
4047                   alfayz2_nt(id)=alfayz2(id) !tg theta-yz
4048                enddo
4049             endif
4050             if(ndblt.ne.0)then
4051                do it=1,ntrpt
4052                   alfaxz1_nt(it)=alfaxz1(it) !X0
4053                   alfaxz2_nt(it)=alfaxz2(it) !tg theta-xz
4054                   alfaxz3_nt(it)=alfaxz3(it) !1/r
4055                enddo
4056             endif
4057             nclouds_yz_nt=nclouds_yz
4058             nclouds_xz_nt=nclouds_xz
4059             if(nclouds_yz.ne.0)then
4060                nnn=0
4061                do iyz=1,nclouds_yz
4062                   ptcloud_yz_nt(iyz)=ptcloud_yz(iyz)
4063                   alfayz1_av_nt(iyz)=alfayz1_av(iyz)
4064                   alfayz2_av_nt(iyz)=alfayz2_av(iyz)
4065                   nnn=nnn+ptcloud_yz(iyz)
4066                enddo
4067                do ipt=1,nnn
4068                   db_cloud_nt(ipt)=db_cloud(ipt)
4069                 enddo
4070             endif
4071             if(nclouds_xz.ne.0)then
4072                nnn=0
4073                do ixz=1,nclouds_xz
4074                   ptcloud_xz_nt(ixz)=ptcloud_xz(ixz)
4075                   alfaxz1_av_nt(ixz)=alfaxz1_av(ixz)
4076                   alfaxz2_av_nt(ixz)=alfaxz2_av(ixz)
4077                   alfaxz3_av_nt(ixz)=alfaxz3_av(ixz)
4078                   nnn=nnn+ptcloud_xz(ixz)              
4079                enddo
4080                do ipt=1,nnn
4081                  tr_cloud_nt(ipt)=tr_cloud(ipt)
4082                 enddo
4083             endif
4084          endif
4085          end
4086          
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.23