/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/reductionflight.f
ViewVC logotype

Diff of /DarthVader/TrackerLevel2/src/F77/reductionflight.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24 by pam-fi, Tue Nov 27 15:28:58 2007 UTC revision 1.25 by pam-fi, Wed Oct 22 15:17:40 2008 UTC
# Line 169  c--------------------------------------- Line 169  c---------------------------------------
169        if(debug.eq.1)print*,'-- compute CN'        if(debug.eq.1)print*,'-- compute CN'
170    
171        do iv=1,nviews        do iv=1,nviews
172           ima=0  
173           do ik=1,nva1_view           call evaluatecn(iv)
174              cn(iv,ik)    = 0  c$$$         ima=0
175              cnrms(iv,ik) = 0  c$$$         do ik=1,nva1_view
176              cnn(iv,ik)   = -1  c$$$            cn(iv,ik)    = 0
177              iflag = 0  c$$$            cnrms(iv,ik) = 0
178              mask_vk_ev(iv,ik) = 1  c$$$            cnn(iv,ik)   = -1
179              call stripmask(iv,ik)      !compute mask(i,j,k), combining VA1-masks  c$$$            iflag = 0
180  *           --------------------------------------  c$$$            mask_vk_ev(iv,ik) = 1
181  *           if chip is not masked ---> evaluate CN  c$$$            call stripmask(iv,ik)      !compute mask(i,j,k), combining VA1-masks
182  *           --------------------------------------  c$$$*           --------------------------------------
183              if( mask(iv,ik,1).eq.1 ) then !!!NBNB mask per la striscia 1 !!!!!!!!  c$$$*           if chip is not masked ---> evaluate CN
184                 call cncomp(iv,ik,iflag)  c$$$*           --------------------------------------
185                 if(iflag.ne.0)then  c$$$            if( mask(iv,ik,1).eq.1 ) then !!!NBNB mask per la striscia 1 !!!!!!!!
186                    ima=ima+1  c$$$               call cncomp(iv,ik,iflag)
187                    mask_vk_ev(iv,ik)=0  c$$$               if(iflag.ne.0)then
188                    ierror = 220  c$$$                  ima=ima+1
189                 endif  c$$$                  mask_vk_ev(iv,ik)=0
190                 call stripmask(iv,ik) !compute mask(i,j,k), combining VA1-masks  c$$$                  ierror = 220
191              endif  c$$$               endif
192           enddo  c$$$               call stripmask(iv,ik) !compute mask(i,j,k), combining VA1-masks
193   100     format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)  c$$$            endif
194           if(ima.ne.0.and.verbose.eq.1)write(*,100)eventn(1),iv  c$$$         enddo
195       $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)  c$$$ 100     format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
196  c         if(ima.ne.0)write(*,100)eventn(1),iv  c$$$         if(ima.ne.0.and.verbose.eq.1)write(*,100)eventn(1),iv
197  c     $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)    c$$$     $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
198    
199        enddo        enddo
200    
201  cc      call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk  cc      call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
# Line 209  c--------------------------------------- Line 210  c---------------------------------------
210    
211        if(debug.eq.1)print*,'-- search clusters'        if(debug.eq.1)print*,'-- search clusters'
212        do iv=1,nviews            !loop on views        do iv=1,nviews            !loop on views
213          do is=1,nstrips_view    !loop on strips (1)  c$$$        do is=1,nstrips_view    !loop on strips (1)
214            if(mod(iv,2).eq.1) then  c$$$          if(mod(iv,2).eq.1) then
215  C===  > Y view  c$$$C===  > Y view
216  c             print*,iv,nvk(is),nst(is),adc(iv,nvk(is),nst(is))  c$$$c             print*,iv,nvk(is),nst(is),adc(iv,nvk(is),nst(is))
217  c     $            ,cn(iv,nvk(is))  c$$$c     $            ,cn(iv,nvk(is))
218  c     $            ,pedestal(iv,nvk(is),nst(is))  c$$$c     $            ,pedestal(iv,nvk(is),nst(is))
219              value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))  c$$$            value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))
220       $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))  c$$$     $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
221       $           *mask(iv,nvk(is),nst(is))  c$$$     $           *mask(iv,nvk(is),nst(is))
222              clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is))  c$$$            clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is))
223       $           *mask(iv,nvk(is),nst(is))  c$$$     $           *mask(iv,nvk(is),nst(is))
224              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))  c$$$            clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
225       $           *mask(iv,nvk(is),nst(is))  c$$$     $           *mask(iv,nvk(is),nst(is))
226              sat(is)=0  c$$$            sat(is)=0
227              if( adc(iv,nvk(is),nst(is)).lt.adc_saty )sat(is)=1  c$$$            if( adc(iv,nvk(is),nst(is)).lt.adc_saty )sat(is)=1
228            else              c$$$          else            
229  C===  > X view  c$$$C===  > X view
230              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))  c$$$            value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
231       $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))  c$$$     $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
232       $           *mask(iv,nvk(is),nst(is))  c$$$     $           *mask(iv,nvk(is),nst(is))
233              clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is))  c$$$            clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is))
234       $           *mask(iv,nvk(is),nst(is))  c$$$     $           *mask(iv,nvk(is),nst(is))
235              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))  c$$$            clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
236       $           *mask(iv,nvk(is),nst(is))  c$$$     $           *mask(iv,nvk(is),nst(is))
237              sat(is)=0  c$$$            sat(is)=0
238              if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1  c$$$            if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1
239            endif  c$$$          endif
240          enddo                   !end loop on strips (1)  c$$$        enddo                   !end loop on strips (1)
241          call search_cluster(iv)           call subtractped(iv)
242             call searchcluster(iv)
243          if(.not.flag_shower)then  
244             call save_cluster(iv)           if(.not.flag_shower)then
245             if(debug.eq.1)print*,'view ',iv,' #clusters ', nclstr_view              call savecluster(iv)
246          else              if(debug.eq.1)print*,'view ',iv,' #clusters ', nclstr_view
247             fshower(iv) = 1           else
248  c           GOOD1(DSPnumber(iv)) = 11 !AHAHAHAHA ORRORE!!              fshower(iv) = 1
249  c           GOOD1(iv) = 11  c     GOOD1(DSPnumber(iv)) = 11 !AHAHAHAHA ORRORE!!
250  c           GOOD1(iv) = GOOD1(iv) + 2**5  c     GOOD1(iv) = 11
251             GOOD1(iv) = ior(GOOD1(iv),2**5)  c     GOOD1(iv) = GOOD1(iv) + 2**5
252   101       format(' * WARNING * Event ',i7,' view',i3              GOOD1(iv) = ior(GOOD1(iv),2**5)
253       $          ,' #clusters > ',i5,' --> MASKED')   101        format(' * WARNING * Event ',i7,' view',i3
254             if(verbose.eq.1)write(*,101)eventn(1),iv,nclstrmax_view       $           ,' #clusters > ',i5,' --> MASKED')
255          endif              if(verbose.eq.1)write(*,101)eventn(1),iv,nclstrmax_view
256             endif
257        enddo                     ! end loop on views        enddo                     ! end loop on views
258        do iv=1,nviews        do iv=1,nviews
259          do ik=1,nva1_view           do ik=1,nva1_view
260            cnev(iv,ik)    = cn(iv,ik) !assigns computed CN to ntuple variables              cnev(iv,ik)    = cn(iv,ik) !assigns computed CN to ntuple variables
261            cnrmsev(iv,ik) = cnrms(iv,ik) !assigns computed CN to ntuple variables              cnrmsev(iv,ik) = cnrms(iv,ik) !assigns computed CN to ntuple variables
262            cnnev(iv,ik)   = cnn(iv,ik) !assigns computed CN to ntuple variables              cnnev(iv,ik)   = cnn(iv,ik) !assigns computed CN to ntuple variables
263          enddo           enddo
264        enddo        enddo
265  C---------------------------------------------  C---------------------------------------------
266  C     come here if GOOD1=0  C     come here if GOOD1=0
# Line 344  c        crc1(iv)=0 Line 346  c        crc1(iv)=0
346  *  *
347  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
348    
349        subroutine search_cluster(iv)        subroutine searchcluster(iv)
350    
351        include 'commontracker.f'        include 'commontracker.f'
352        include 'level0.f'        include 'level0.f'
# Line 619  c--------------------------------------- Line 621  c---------------------------------------
621  *  *
622  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
623    
624        subroutine save_cluster(iv)        subroutine savecluster(iv)
625  *  *
626  *     (080/2006 Elena Vannuccini)  *     (080/2006 Elena Vannuccini)
627  *     Save the clusters view by view  *     Save the clusters view by view
# Line 666  c     if(value(j).gt.0) Line 668  c     if(value(j).gt.0)
668       $           sgnl(nclstr1) = sgnl(nclstr1) + value(j) !cluster charge       $           sgnl(nclstr1) = sgnl(nclstr1) + value(j) !cluster charge
669           enddo           enddo
670    
671  c$$$         print*,'view ',iv,' -- save_cluster -- nclstr1: '  c$$$         print*,'view ',iv,' -- savecluster -- nclstr1: '
672  c$$$     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),sgnl(nclstr1)  c$$$     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),sgnl(nclstr1)
673  c$$$         print*,'----------------------'  c$$$         print*,'----------------------'
674    
# Line 682  c$$$         print*,'------------------- Line 684  c$$$         print*,'-------------------
684  *  *
685  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
686    
687          subroutine evaluatecn(iv)
688          
689          include 'commontracker.f'
690          include 'level0.f'
691          include 'level1.f'
692          include 'common_reduction.f'
693          include 'calib.f'
694          
695          ima=0
696          do ik=1,nva1_view
697             cn(iv,ik)    = 0
698             cnrms(iv,ik) = 0
699             cnn(iv,ik)   = -1
700             iflag = 0
701             mask_vk_ev(iv,ik) = 1
702             call stripmask(iv,ik)  !compute mask(i,j,k), combining VA1-masks
703    *     --------------------------------------
704    *     if chip is not masked ---> evaluate CN
705    *     --------------------------------------
706             if( mask(iv,ik,1).eq.1 ) then !!!NBNB mask per la striscia 1 !!!!!!!!
707                call cncomp(iv,ik,iflag)
708                if(iflag.ne.0)then
709                   ima=ima+1
710                   mask_vk_ev(iv,ik)=0
711                   ierror = 220
712                endif
713                call stripmask(iv,ik) !compute mask(i,j,k), combining VA1-masks
714             endif
715          enddo
716     100  format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
717          if(ima.ne.0.and.verbose.eq.1)write(*,100)eventn(1),iv
718         $     ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
719          
720          return
721          end
722    
723    *---***---***---***---***---***---***---***---***
724    *
725    *
726    *
727    *
728    *
729    *---***---***---***---***---***---***---***---***
730          subroutine subtractped(iv)
731          
732          include 'commontracker.f'
733          include 'level1.f'
734          include 'calib.f'
735          include 'common_reduction.f'
736    
737          do is=1,nstrips_view      !loop on strips (1)
738             if(mod(iv,2).eq.1) then
739    C===  > Y view
740    c     print*,iv,nvk(is),nst(is),adc(iv,nvk(is),nst(is))
741    c     $            ,cn(iv,nvk(is))
742    c     $            ,pedestal(iv,nvk(is),nst(is))
743                value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))
744         $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
745         $           *mask(iv,nvk(is),nst(is))
746                clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is))
747         $           *mask(iv,nvk(is),nst(is))
748                clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
749         $           *mask(iv,nvk(is),nst(is))
750                sat(is)=0
751                if( adc(iv,nvk(is),nst(is)).lt.adc_saty )sat(is)=1
752             else            
753    C===  > X view
754                value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
755         $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
756         $           *mask(iv,nvk(is),nst(is))
757                clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is))
758         $           *mask(iv,nvk(is),nst(is))
759                clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
760         $           *mask(iv,nvk(is),nst(is))
761                sat(is)=0
762                if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1
763             endif
764          enddo                     !end loop on strips (1)
765          
766          
767          return
768          end
769    *---***---***---***---***---***---***---***---***
770    *
771    *
772    *
773    *
774    *
775    *---***---***---***---***---***---***---***---***
776  c$$$      subroutine stripmask  c$$$      subroutine stripmask
777  c$$$  c$$$
778  c$$$*     this routine set va1 and single-strip masks,  c$$$*     this routine set va1 and single-strip masks,
Legend:
Removed from v.1.24  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.23