/[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.26 by pam-fi, Tue Nov 25 14:41:38 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  c$$$            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 391  c--------------------------------------- Line 393  c---------------------------------------
393  c-----------------------------------------  c-----------------------------------------
394  c     possible SEED...  c     possible SEED...
395  c-----------------------------------------  c-----------------------------------------
396    c$$$               if(debug.eq.1)print*,'|||| ',value(is),' @',is
397    c$$$     $              ,' cut ',clseedcut(is)
398    
399                 itemp = is                 itemp = is
400                 fsat = 0         ! first saturated strip                 fsat = 0         ! first saturated strip
401                 lsat = 0         ! last saturated strip                 lsat = 0         ! last saturated strip
# Line 402  c              ------------------------ Line 407  c              ------------------------
407       $                   value(itemp).le.value(itemp+1)       $                   value(itemp).le.value(itemp+1)
408       $              .and.value(itemp+1).gt.clseedcut(itemp+1))       $              .and.value(itemp+1).gt.clseedcut(itemp+1))
409                    itemp = itemp+1                    itemp = itemp+1
410    c$$$                  if(debug.eq.1)print*,'|||| ',value(itemp),' @',is
411    c$$$     $                 ,' cut ',clseedcut(itemp)
412                    if(itemp.eq.last)   goto 230 !stops if reaches last strip                    if(itemp.eq.last)   goto 230 !stops if reaches last strip
413                    if(sat(itemp).eq.1) goto 230 !stop if reaches a saturated strip                    if(sat(itemp).eq.1) goto 230 !stop if reaches a saturated strip
414                 enddo            ! of the ladder                 enddo            ! of the ladder
# Line 413  c              ------------------------- Line 420  c              -------------------------
420                    fsat = itemp                    fsat = itemp
421                    lsat = itemp                    lsat = itemp
422                    if(itemp.eq.last) goto 231 !estremo...                    if(itemp.eq.last) goto 231 !estremo...
423                    do while( sat(itemp+1).eq.1 )                    do while(
424         $                 sat(itemp+1).eq.1 .and.
425         $                 value(itemp+1).gt.clseedcut(itemp+1) .and.
426         $                 .true.)
427                       itemp = itemp+1                       itemp = itemp+1
428                       lsat = itemp                       lsat = itemp
429                       if(itemp.eq.last)   goto 231 !stops if reaches last strip                       if(itemp.eq.last)   goto 231 !stops if reaches last strip
# Line 428  c--------------------------------------- Line 438  c---------------------------------------
438                    iseed = itemp ! <<< SEED                    iseed = itemp ! <<< SEED
439                 else                 else
440                    iseed = int((lsat+fsat)/2) ! <<< SEED                    iseed = int((lsat+fsat)/2) ! <<< SEED
441  c$$$                  print*,'saturated strips ',fsat,lsat,iseed                    if(debug.eq.1)
442         $                 print*,'saturated strips (first,last) ',fsat,lsat
443  c$$$                  print*,'--> ',(value(ii),ii=fsat,lsat)  c$$$                  print*,'--> ',(value(ii),ii=fsat,lsat)
444                 endif                     endif    
445  c---------------------------------------------------------------  c---------------------------------------------------------------
446  c     after finding a cluster seed, checks also adjacent strips,  c     after finding a cluster seed, checks also adjacent strips,
447  C     and tags the ones exceeding clinclcut  C     and tags the ones exceeding clinclcut
448  c---------------------------------------------------------------  c---------------------------------------------------------------
449                  
450                   if(debug.eq.1)print*,'SEED ',value(iseed),' @',iseed
451         $              ,' cut ',clseedcut(iseed)
452    
453                 ir=iseed         !indici destro                 ir=iseed         !indici destro
454                 il=iseed         ! e sinistro                 il=iseed         ! e sinistro
455                                
# Line 503  c--------------------------------------- Line 518  c---------------------------------------
518  c-------------------------------------------------------------------------------  c-------------------------------------------------------------------------------
519  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
520  c-------------------------------------------------------------------------------  c-------------------------------------------------------------------------------
521  c$$$               if(iseed-1.eq.lmax.and.lmax.ne.first)then                 if(iseed-1.eq.lmax.and.lmax.ne.first)then
522  c$$$                  lmax = lmax-1                    lmax = lmax-1
523  c$$$                  if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1                    if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
524  c$$$               endif                 endif
525  c$$$               if(iseed+1.eq.rmax.and.rmax.ne.last )then                 if(iseed+1.eq.rmax.and.rmax.ne.last )then
526  c$$$                  rmax = rmax+1                    rmax = rmax+1
527  c$$$                  if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1                    if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
528  c$$$               endif                 endif
529  c---------------------------------------------------  c---------------------------------------------------
530  c     now we have 5 stored-strips around the maximum  c     now we have 5 stored-strips around the maximum
531  c---------------------------------------------------  c---------------------------------------------------
# Line 547  c$$$     $                 ,' clusters o Line 562  c$$$     $                 ,' clusters o
562    
563                 ladder_view(nclstr_view) = nld(iseed,iv)                 ladder_view(nclstr_view) = nld(iseed,iv)
564                 maxs_view(nclstr_view)   = iseed                 maxs_view(nclstr_view)   = iseed
                mult_view(nclstr_view)   = rmax-lmax+1  
565                 rmax_view(nclstr_view)   = rmax                 rmax_view(nclstr_view)   = rmax
566                 lmax_view(nclstr_view)   = lmax                 lmax_view(nclstr_view)   = lmax
567    c               mult_view(nclstr_view)   = rmax-lmax+1
568                   mult_view(nclstr_view)   = 0
569                   do ii=lmax,rmax
570                      if(value(ii).gt.clinclcut(ii))  
571         $                 mult_view(nclstr_view) = mult_view(nclstr_view)+1
572                   enddo
573    
574    c$$$               print*,(value(ii),ii=lmax,rmax)
575    c$$$               print*,(clinclcut(ii),ii=lmax,rmax)
576    c$$$               print*,(clseedcut(ii),ii=lmax,rmax)
577    
578  c$$$               if(rmax-lmax+1.gt.25)  c$$$               if(rmax-lmax+1.gt.25)
579  c$$$     $              print*,'view ',iv  c$$$     $              print*,'view ',iv
# Line 613  c--------------------------------------- Line 637  c---------------------------------------
637  *  *
638  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
639    
640        subroutine save_cluster(iv)        subroutine savecluster(iv)
641  *  *
642  *     (080/2006 Elena Vannuccini)  *     (080/2006 Elena Vannuccini)
643  *     Save the clusters view by view  *     Save the clusters view by view
# Line 660  c     if(value(j).gt.0) Line 684  c     if(value(j).gt.0)
684       $           sgnl(nclstr1) = sgnl(nclstr1) + value(j) !cluster charge       $           sgnl(nclstr1) = sgnl(nclstr1) + value(j) !cluster charge
685           enddo           enddo
686    
687  c$$$         print*,'view ',iv,' -- save_cluster -- nclstr1: '           if(debug.eq.1)then
688  c$$$     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),sgnl(nclstr1)              print*,'view ',iv,' -- '
689  c$$$         print*,'----------------------'       $           ,' n.cl: ',nclstr1
690         $           ,' maxs: ',maxs(nclstr1)
691         $           ,' mult: ',mult(nclstr1)
692         $           ,' sign: ',sgnl(nclstr1)
693                print*,'----------------------'
694             endif
695        enddo        enddo
696                
697        return        return
# Line 676  c$$$         print*,'------------------- Line 704  c$$$         print*,'-------------------
704  *  *
705  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
706    
707          subroutine evaluatecn(iv)
708          
709          include 'commontracker.f'
710          include 'level0.f'
711          include 'level1.f'
712          include 'common_reduction.f'
713          include 'calib.f'
714          
715          ima=0
716          do ik=1,nva1_view
717             cn(iv,ik)    = 0
718             cnrms(iv,ik) = 0
719             cnn(iv,ik)   = -1
720             iflag = 0
721             mask_vk_ev(iv,ik) = 1
722             call stripmask(iv,ik)  !compute mask(i,j,k), combining VA1-masks
723    *     --------------------------------------
724    *     if chip is not masked ---> evaluate CN
725    *     --------------------------------------
726             if( mask(iv,ik,1).eq.1 ) then !!!NBNB mask per la striscia 1 !!!!!!!!
727                call cncomp(iv,ik,iflag)
728                if(iflag.ne.0)then
729                   ima=ima+1
730                   mask_vk_ev(iv,ik)=0
731                   ierror = 220
732                endif
733                call stripmask(iv,ik) !compute mask(i,j,k), combining VA1-masks
734             endif
735          enddo
736     100  format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
737          if(ima.ne.0.and.verbose.eq.1)write(*,100)eventn(1),iv
738         $     ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
739          
740          return
741          end
742    
743    *---***---***---***---***---***---***---***---***
744    *
745    *
746    *
747    *
748    *
749    *---***---***---***---***---***---***---***---***
750          subroutine subtractped(iv)
751          
752          include 'commontracker.f'
753          include 'level1.f'
754          include 'calib.f'
755          include 'common_reduction.f'
756    
757          do is=1,nstrips_view      !loop on strips (1)
758             if(mod(iv,2).eq.1) then
759    C===  > Y view
760    c     print*,iv,nvk(is),nst(is),adc(iv,nvk(is),nst(is))
761    c     $            ,cn(iv,nvk(is))
762    c     $            ,pedestal(iv,nvk(is),nst(is))
763                value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))
764         $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
765         $           *mask(iv,nvk(is),nst(is))
766                clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is))
767         $           *mask(iv,nvk(is),nst(is))
768                clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
769         $           *mask(iv,nvk(is),nst(is))
770                sat(is)=0
771                if( adc(iv,nvk(is),nst(is)).lt.adc_saty )
772         $           sat(is)=mask(iv,nvk(is),nst(is))
773             else            
774    C===  > X view
775                value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
776         $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
777         $           *mask(iv,nvk(is),nst(is))
778                clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is))
779         $           *mask(iv,nvk(is),nst(is))
780                clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
781         $           *mask(iv,nvk(is),nst(is))
782                sat(is)=0
783                if( adc(iv,nvk(is),nst(is)).gt.adc_satx )
784         $           sat(is)=mask(iv,nvk(is),nst(is))
785             endif
786          enddo                     !end loop on strips (1)
787          
788          
789          return
790          end
791    *---***---***---***---***---***---***---***---***
792    *
793    *
794    *
795    *
796    *
797    *---***---***---***---***---***---***---***---***
798  c$$$      subroutine stripmask  c$$$      subroutine stripmask
799  c$$$  c$$$
800  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.26
  ViewVC Help
Powered by ViewVC 1.1.23