/[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.22 by pam-fi, Mon Aug 20 16:07:16 2007 UTC revision 1.29 by mocchiut, Thu Jan 16 15:29:58 2014 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
267  C     or the event has too many clusters  C     or the event has too many clusters
268  C---------------------------------------------  C---------------------------------------------
269   200  continue  c 200  continue
270    
271        ngood = 0        ngood = 0
272        do iv = 1,nviews        do iv = 1,nviews
# Line 321  c      good1 = 0 Line 323  c      good1 = 0
323        do id=1,maxlength         !???        do id=1,maxlength         !???
324           clsignal(id) = 0.           clsignal(id) = 0.
325           clsigma(id)  = 0.           clsigma(id)  = 0.
326           cladc(id)    = 0.           cladc(id)    = 0  ! EM GCC4.7 is integer
327           clbad(id)    = 0.           clbad(id)    = 0  ! EM GCC4.7 is integer
328        enddo        enddo
329        do iv=1,nviews        do iv=1,nviews
330  c        crc1(iv)=0  c        crc1(iv)=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 503  c--------------------------------------- Line 505  c---------------------------------------
505  c-------------------------------------------------------------------------------  c-------------------------------------------------------------------------------
506  c     adjust the cluster in order to have at least ANOTHER strip around the seed  c     adjust the cluster in order to have at least ANOTHER strip around the seed
507  c-------------------------------------------------------------------------------  c-------------------------------------------------------------------------------
508  c$$$               if(iseed-1.eq.lmax.and.lmax.ne.first)then                 if(iseed-1.eq.lmax.and.lmax.ne.first)then
509  c$$$                  lmax = lmax-1                    lmax = lmax-1
510  c$$$                  if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1                    if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
511  c$$$               endif                 endif
512  c$$$               if(iseed+1.eq.rmax.and.rmax.ne.last )then                 if(iseed+1.eq.rmax.and.rmax.ne.last )then
513  c$$$                  rmax = rmax+1                    rmax = rmax+1
514  c$$$                  if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1                    if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
515  c$$$               endif                 endif
516  c---------------------------------------------------  c---------------------------------------------------
517  c     now we have 5 stored-strips around the maximum  c     now we have 5 stored-strips around the maximum
518  c---------------------------------------------------  c---------------------------------------------------
# Line 547  c$$$     $                 ,' clusters o Line 549  c$$$     $                 ,' clusters o
549    
550                 ladder_view(nclstr_view) = nld(iseed,iv)                 ladder_view(nclstr_view) = nld(iseed,iv)
551                 maxs_view(nclstr_view)   = iseed                 maxs_view(nclstr_view)   = iseed
                mult_view(nclstr_view)   = rmax-lmax+1  
552                 rmax_view(nclstr_view)   = rmax                 rmax_view(nclstr_view)   = rmax
553                 lmax_view(nclstr_view)   = lmax                 lmax_view(nclstr_view)   = lmax
554    c               mult_view(nclstr_view)   = rmax-lmax+1
555                   mult_view(nclstr_view)   = 0
556                   do ii=lmax,rmax
557                      if(value(ii).gt.clinclcut(ii))  
558         $                 mult_view(nclstr_view) = mult_view(nclstr_view)+1
559                   enddo
560    
561    
562  c$$$               if(rmax-lmax+1.gt.25)  c$$$               if(rmax-lmax+1.gt.25)
563  c$$$     $              print*,'view ',iv  c$$$     $              print*,'view ',iv
# Line 575  c--------------------------------------- Line 583  c---------------------------------------
583       $                    delta.gt.cut .and.       $                    delta.gt.cut .and.
584       $                    value(iss).gt.clseedcut(iss).and.       $                    value(iss).gt.clseedcut(iss).and.
585       $                    .true.)then       $                    .true.)then
586                          if( value(iss).gt.vmax )then                                                  if( value(iss).gt.vmax )then
587                             imax = iss                             imax = iss
588                             vmax = value(iss)                             vmax = value(iss)
589                          else                          else
# Line 613  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 650  c$$$            print*,ind,clsignal(ind) Line 658  c$$$            print*,ind,clsignal(ind)
658              ist=nst(j)              ist=nst(j)
659    
660              clsigma(ind) = sigma(iv,ivk,ist)              clsigma(ind) = sigma(iv,ivk,ist)
661              cladc(ind)   = adc(iv,ivk,ist)              cladc(ind)   = int(adc(iv,ivk,ist))   ! EM GCC4.7 is integer
662              clbad(ind)   = bad(iv,ivk,ist)              clbad(ind)   = bad(iv,ivk,ist)
663  c            clped(ind)   = pedestal(iv,ivk,ist)  c            clped(ind)   = pedestal(iv,ivk,ist)
664    
# Line 660  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 676  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)= -(REAL(adc(iv,nvk(is),nst(is)))  ! EM GCC4.7 value(nstrips_view) is real not double
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)= (REAL(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.22  
changed lines
  Added in v.1.29
  ViewVC Help
Powered by ViewVC 1.1.23