/[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.2 by pam-fi, Tue May 30 16:30:37 2006 UTC revision 1.8 by pam-fi, Fri Sep 29 08:45:16 2006 UTC
# Line 18  Line 18 
18        include 'common_reduction.f'        include 'common_reduction.f'
19        include 'calib.f'        include 'calib.f'
20                
21          data eventn_old/nviews*0/
22    
23        integer ierror        integer ierror
24        ierror = 0        ierror = 0
25    
# Line 25  Line 27 
27  *     STRIP MASK  *     STRIP MASK
28  *     -------------------------------------------------------  *     -------------------------------------------------------
29    
30        call stripmask  c      call stripmask   !called later, after CN computation
31        call init_level1        call init_level1
32    
33        good1=good0  c      good1 = good0
34    c--------------------------------------------------
35    c     check the LEVEL0 event status for missing
36    c     sections or DSP alarms
37    c     ==> set the variable GOOD1(12)
38    c--------------------------------------------------
39          do iv=1,nviews
40             if(DSPnumber(iv).gt.0.and.DSPnumber(iv).le.12)then
41    c           ------------------------
42    c           GOOD
43    c           ------------------------
44                GOOD1(DSPnumber(iv))=0                  !OK
45    c           ------------------------
46    c           CRC error
47    c           ------------------------
48                if(crc(iv).eq.1) then
49                   GOOD1(DSPnumber(iv)) = 2
50                   goto 18 !next view
51                endif
52    c           ------------------------
53    c           online-software alarm
54    c           ------------------------
55                if(
56         $           fl1(iv).ne.0.or.
57         $           fl2(iv).ne.0.or.
58         $           fl3(iv).ne.0.or.
59         $           fl4(iv).ne.0.or.
60         $           fl5(iv).ne.0.or.
61         $           fl6(iv).ne.0.or.
62         $           fc(iv).ne.0.or.
63         $           DATAlength(iv).eq.0.or.
64         $           .false.)then
65                   GOOD1(DSPnumber(iv))=3
66                   goto 18
67                endif
68    c           ------------------------
69    c           DSP-counter jump
70    c           ------------------------
71                if(
72         $           eventn_old(iv).ne.0.and. !first event in this file
73         $           eventn(iv).ne.1.and.     !first event in run
74         $           good_old(DSPnumber(iv)).ne.0.and. !previous event corrupted
75         $           .true.)then
76    
77                   if(eventn(iv).ne.(eventn_old(iv)+1))then
78                      GOOD1(DSPnumber(iv))=4
79                      goto 18
80                   endif
81    
82                endif
83    c           ------------------------
84     18         continue
85             endif
86          enddo
87    
88          ngood = 0
89          do iv = 1,nviews
90             eventn_old(iv) = eventn(iv)
91             good_old(iv)   = good1(iv)
92             ngood = ngood + good1(iv)
93          enddo
94    c      if(ngood.ne.0)print*,'* WARNING * LEVEL0 event status: '
95    c     $     ,(good1(i),i=1,nviews)
96  c--------------------------------------------------  c--------------------------------------------------
97  c     read the variable DATATRACKER from LEVEL0  c     read the variable DATATRACKER from LEVEL0
98  c     and fill the variable ADC (inverting view 11)  c     and fill the variable ADC (invertin view 11)
99  c--------------------------------------------------  c--------------------------------------------------
100        call filladc(iflag)        call filladc(iflag)
101        if(iflag.ne.0)then        if(iflag.ne.0)then
102          good1=0  c        good1=0!<<<<<<<<<<<<<<<
103  c       if(DEBUG)print*,'event ',eventn(1),' >>>>>  decode ERROR'  c       if(DEBUG)print*,'event ',eventn(1),' >>>>>  decode ERROR'
104          ierror = -220           ierror = 220
105          goto 200  c        goto 200
106    c         print*,'filladc error'
107        endif        endif
108    
109  c--------------------------------------------------  c--------------------------------------------------
# Line 47  c     (excluding strips affected by sign Line 112  c     (excluding strips affected by sign
112  c     tagged with the flag CLSTR)  c     tagged with the flag CLSTR)
113  c--------------------------------------------------  c--------------------------------------------------
114        do iv=1,nviews        do iv=1,nviews
115          do ik=1,nva1_view           ima=0
116            cn(iv,ik)=0           !initializes cn variable           do ik=1,nva1_view
117            iflag=0              cn(iv,ik)  = 0
118            if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik,iflag)              cnn(iv,ik) = -1
119            if(iflag.ne.0)good1=0              mask_vk_ev(iv,ik)=1
120          enddo              iflag=0
121                if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik,iflag)
122    c     if(iflag.ne.0)good1=0
123                if(iflag.ne.0)then
124                   ima=ima+1
125                   mask_vk_ev(iv,ik)=0
126                   ierror = 220
127    c$$$               if(verbose)
128    c$$$     $              print*,' * WARNING * Event ',eventn(1)
129    c$$$     $              ,': masked vk ',ik,' on view',iv
130                endif
131             enddo
132             if(ima.ne.0.and.verbose)print*,' * WARNING * Event ',eventn(1)
133         $              ,' view',iv,': VK MASK '
134         $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
135        enddo        enddo
136        if(good1.eq.0)then  c      if(good1.eq.0)then
137           ierror = 220  c         ierror = 220
138  c         if(WARNING)  c      endif
 c     $     print*,' WARNING - cncomp: CN computation failure '  
       endif  
139    
140          call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
141  c---------------------------------------------  c---------------------------------------------
142  c     loops on views, VA1 and strips,  c     loops on views, VA1 and strips,
143  c     and computes strips signals using  c     and computes strips signals using
# Line 68  c     sigma informations from histograms Line 146  c     sigma informations from histograms
146  c---------------------------------------------  c---------------------------------------------
147        flag_shower = .false.        flag_shower = .false.
148        ind=1                     !clsignal array index        ind=1                     !clsignal array index
149    
150        do iv=1,nviews            !loop on views        do iv=1,nviews            !loop on views
151          do is=1,nstrips_view    !loop on strips (1)          do is=1,nstrips_view    !loop on strips (1)
152            if(mod(iv,2).eq.1) then            if(mod(iv,2).eq.1) then
# Line 90  C===  > X view Line 169  C===  > X view
169              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
170       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
171            endif            endif
172    c$$$          print*,iv,is,' --- ',adc(iv,nvk(is),nst(is)),cn(iv,nvk(is))
173    c$$$     $         ,pedestal(iv,nvk(is),nst(is)),value(is)
174    c$$$     $         ,sigma(iv,nvk(is),nst(is))
175    c          if(value(is).gt.clseedcut(is))
176    c     $         print*,iv,is,' --- (ADC_PED_CN) ',value(is),clseedcut(is)
177          enddo                   !end loop on strips (1)          enddo                   !end loop on strips (1)
178          call search_cluster(iv)          call search_cluster(iv)
179          if(flag_shower.eqv..true.)then  c$$$        if(flag_shower.eqv..true.)then
180            call init_level1                c$$$          call init_level1              
181            good1=0  c$$$          good1=0
182            goto 200              !jump to next event  c$$$          goto 200              !jump to next event
183    c$$$        endif
184    ccc
185    ccc    modified by Elena (08/2006)
186    ccc
187            if(.not.flag_shower)then
188               call save_cluster(iv)
189            else
190               fshower(iv) = 1
191               GOOD1(DSPn) = 11
192          endif          endif
193        enddo                     ! end loop on views        enddo                     ! end loop on views
194        do iv=1,nviews        do iv=1,nviews
195          do ik=1,nva1_view          do ik=1,nva1_view
196            cnev(iv,ik)=cn(iv,ik) !assigns computed CN to ntuple variables            cnev(iv,ik)  = cn(iv,ik) !assigns computed CN to ntuple variables
197              cnnev(iv,ik) = cnn(iv,ik) !assigns computed CN to ntuple variables
198  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)
199          enddo          enddo
200        enddo        enddo
# Line 109  C     come here if GOOD1=0 Line 203  C     come here if GOOD1=0
203  C     or the event has too many clusters  C     or the event has too many clusters
204  C---------------------------------------------  C---------------------------------------------
205   200  continue   200  continue
206    
207          ngood = 0
208          do iv = 1,nviews
209             ngood = ngood + good1(iv)
210          enddo
211          if(ngood.ne.0)print*,'* WARNING * Event ',eventn(1)
212         $     ,':LEVEL1 event status: '
213         $     ,(good1(i),i=1,nviews)
214  c------------------------------------------------------------------------  c------------------------------------------------------------------------
215  c  c
216  c     closes files and exits  c     closes files and exits
# Line 136  c--------------------------------------- Line 238  c---------------------------------------
238        include 'level1.f'        include 'level1.f'
239        include 'level0.f'        include 'level0.f'
240    
241        good1=0  c      good1 = 0
242        nclstr1=0        do iv=1,12
243        totCLlength=0           good1(iv) = 1 !missing packet
244          enddo
245          nclstr1 = 0
246          totCLlength = 0
247        do ic=1,nclstrmax        do ic=1,nclstrmax
248           view(ic)=0           view(ic) = 0
249           ladder(ic)=0           ladder(ic) = 0
250           indstart(ic)=0           indstart(ic) = 0
251           indmax(ic)=0           indmax(ic) = 0
252           maxs(ic)=0           maxs(ic) = 0
253           mult(ic)=0                     mult(ic) = 0          
254           dedx(ic)=0           dedx(ic) = 0
255             whichtrack(ic) = 0
256    
257        enddo        enddo
258        do id=1,maxlength         !???        do id=1,maxlength         !???
259           clsignal(id)=0.           clsignal(id) = 0.
260             clsigma(id)  = 0.
261             cladc(id)    = 0.
262             clbad(id)    = 0.
263        enddo        enddo
264        do iv=1,nviews        do iv=1,nviews
265  c        crc1(iv)=0  c        crc1(iv)=0
266          do ik=1,nva1_view          do ik=1,nva1_view
267            cnev(iv,ik)=0            cnev(iv,ik) = 0
268              cnnev(iv,ik) = 0
269          enddo          enddo
270            fshower(iv) = 0
271        enddo        enddo
272                
273        return        return
# Line 171  c        crc1(iv)=0 Line 283  c        crc1(iv)=0
283        subroutine search_cluster(iv)        subroutine search_cluster(iv)
284    
285        include 'commontracker.f'        include 'commontracker.f'
       include 'common_reduction.f'  
286        include 'level0.f'        include 'level0.f'
287        include 'level1.f'        include 'level1.f'
288        include 'calib.f'        include 'calib.f'
289    
290          include 'common_reduction.f'
291            
292    
293  c     local variables  c     local variables
# Line 186  c     local variables Line 298  c     local variables
298    
299        integer multtemp          !temporary multiplicity variable        integer multtemp          !temporary multiplicity variable
300    
       integer CLlength          !lunghezza in strip del cluster  
   
301        external nst        external nst
302    
303  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 218  c     Elena: CLINCLCUT = 4 (old value 5) Line 328  c     Elena: CLINCLCUT = 4 (old value 5)
328    
329        iseed=-999                !cluster seed index initialization        iseed=-999                !cluster seed index initialization
330    
331          nclstr_view=0
332    
333        do jl=1,nladders_view     !1..3 !loops on ladders        do jl=1,nladders_view     !1..3 !loops on ladders
334           first=1+nstrips_ladder*(jl-1) !1,1025,2049           first=1+nstrips_ladder*(jl-1) !1,1025,2049
335           last=nstrips_ladder*jl !1024,2048,3072           last=nstrips_ladder*jl !1024,2048,3072
# Line 226  c     X views have 1018 strips instead o Line 338  c     X views have 1018 strips instead o
338              first=first+3              first=first+3
339              last=last-3              last=last-3
340           endif           endif
341    
342           do is=first,last       !loop on strips in each ladder           do is=first,last       !loop on strips in each ladder
343    
344              if(is.le.iseed+1) goto 220              if(is.le.iseed+1) goto 220
345  c-----------------------------------------  *******************************************************
346  c     after a cluster seed as been found,  *     Elena 08/2006
347  c     look for next one skipping one strip on the right  * QUESTA PARTE NON E` ADEGUATA per cluster con grossi rilasci di carica
348  c     (i.e. look for double peak cluster)  * perche` salva molte volte lo stesso cluster
349  c-----------------------------------------  * (salvo il cluster rispetto al primo massimo e basta...)
350              if(is.ne.first) then  *******************************************************
351                 if(value(is).le.value(is-1)) goto 220  c$$$c-----------------------------------------
352              endif  c$$$c     after a cluster seed as been found,
353  c-----------------------------------------  c$$$c     look for next one skipping one strip on the right
354  c     skips cluster seed  c$$$c     (i.e. look for double peak cluster)
355  c     finding if strips values are descreasing (a strip  c$$$c-----------------------------------------
356  c     can be a cluster seed only if previous strip value  c$$$            if(is.ne.first) then
357  c     is lower)  c$$$               if(value(is).le.value(is-1)) goto 220
358  c-----------------------------------------  c$$$            endif
359    c$$$c-----------------------------------------
360    c$$$c     skips cluster seed
361    c$$$c     finding if strips values are descreasing (a strip
362    c$$$c     can be a cluster seed only if previous strip value
363    c$$$c     is lower)
364    c$$$c-----------------------------------------
365    *******************************************************
366    * LA RICERCA PARTE DALL'ULTIMA STRIP SALVATA (***TEMPORANEO****)
367    *******************************************************
368                if(is.le.iseed+rmax+1) goto 220
369    *******************************************************
370    
371              if(value(is).gt.clseedcut(is)) then              if(value(is).gt.clseedcut(is)) then
372  ccc              print*,"value(",is,")=",value(is),  ccc              print*,"value(",is,")=",value(is),
373  ccc     $             " .gt.clseedcut(",is,")=",clseedcut(is)  ccc     $             " .gt.clseedcut(",is,")=",clseedcut(is)
# Line 250  c     possible SEED... Line 376  c     possible SEED...
376  c-----------------------------------------  c-----------------------------------------
377                 itemp=is                 itemp=is
378                 if(itemp.eq.last) goto 230 !estremo...                 if(itemp.eq.last) goto 230 !estremo...
379                 do while(value(itemp)  ****************************************************
380       $              /sigma(iv,nvk(itemp),nst(itemp))  *     modificato da Elena (08/2006) per salvare
381       $              .le.value(itemp+1)  *     il cluster intorno al massimo assoluto
382       $              /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???  ****************************************************
383    c$$$               do while(value(itemp)
384    c$$$     $              /sigma(iv,nvk(itemp),nst(itemp))
385    c$$$     $              .le.value(itemp+1)
386    c$$$     $              /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???
387    c$$$                  itemp=itemp+1
388    c$$$                  if(itemp.eq.last) goto 230 !stops if reaches last strip
389    c$$$               enddo            ! of the ladder
390                   do while(
391         $                   value(itemp).le.value(itemp+1)
392         $              .and.value(itemp+1).gt.clseedcut(itemp+1))
393                    itemp=itemp+1                    itemp=itemp+1
394                    if(itemp.eq.last) goto 230 !stops if reaches last strip                    if(itemp.eq.last) goto 230 !stops if reaches last strip
395                 enddo            ! of the ladder                 enddo            ! of the ladder
# Line 461  c     goto 250 !inutile!??? Line 597  c     goto 250 !inutile!???
597   250           continue   250           continue
598    
599  c--------------------------------------------------------  c--------------------------------------------------------
600  c     fills ntuple variables  c     fills cluster variables
601  c--------------------------------------------------------  c--------------------------------------------------------
602                 nclstr1=nclstr1+1 !cluster number  c$$$               nclstr1=nclstr1+1 !cluster number
603  ccc               print*,nclstr1,multtemp  c$$$ccc               print*,nclstr1,multtemp
604                 if(nclstr1.gt.nclstrmax) then !too many clusters for the event:  c$$$               if(nclstr1.gt.nclstrmax) then !too many clusters for the event:
605                    good1=0       ! event  c$$$                  if(verbose)print*,'Event ',eventn(1),
606                    nclstr1=0  c$$$     $                 ': more than ',nclstrmax,' clusters'
607                    totCLlength=0  c$$$                  good1=0       ! event
608    c$$$                  nclstr1=0
609    c$$$                  totCLlength=0
610    c$$$                  flag_shower = .true.
611    c$$$                  goto 2000
612    c$$$               endif
613    c$$$               view(nclstr1)   = iv !vista del cluster
614    c$$$               ladder(nclstr1) = nld(iseed,iv) !ladder a cui appartiene il cluster seed
615    c$$$               maxs(nclstr1)   = iseed !strip del cluster seed
616    c$$$               mult(nclstr1)   = multtemp !molteplicita'
617    c$$$              
618    c$$$               indstart(nclstr1) = ind !posizione dell'inizio del cluster nell'
619    c$$$c                                      ! array clsignal
620    c$$$               indmax(nclstr1)   = indstart(nclstr1)+(iseed-lmax) !posizione del
621    c$$$c                                      ! cluster seed nell'array clsignal
622    c$$$              
623    c$$$               CLlength      = rmax-lmax+1 !numero di strip del cluster
624    c$$$               totCLlength   = totCLlength+CLlength
625    c$$$               dedx(nclstr1) = 0
626    c$$$               do j=lmax,rmax   !stores sequentially cluter strip values in
627    c$$$                  clsignal(ind) = value(j) ! clsignal array
628    c$$$                  ind=ind+1
629    c$$$c                  if(value(j).gt.0)
630    c$$$                  if(value(j).gt.clinclcut(j))
631    c$$$     $                 dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge
632    c$$$               enddo
633    ccc
634    ccc            *** Modified by Elena (08/2006) ***
635    ccc
636                   nclstr_view = nclstr_view + 1 !cluster number
637    c               print*,'view ',iv,' -- search_cluster -- nclstr_view: '
638    c     $              ,nclstr_view
639                   if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view:
640                      if(verbose) print*,'Event ',eventn(1),
641         $                 ': more than ',nclstrmax_view
642         $                 ,' clusters on view ',iv
643    c                  good1=0       ! event
644    c                  nclstr1=0
645    c                  totCLlength=0
646                    flag_shower = .true.                    flag_shower = .true.
                   if(verbose)print*,'Event ',eventn(1),  
      $                 ': more than ',nclstrmax,' clusters'  
647                    goto 2000                    goto 2000
648                 endif                 endif
649                 view(nclstr1)=iv !vista del cluster  
650                 ladder(nclstr1)=nld(iseed,iv) !ladder a cui appartiene il cluster seed  c               view(nclstr1)   = iv !vista del cluster
651                 maxs(nclstr1)=iseed !strip del cluster seed                 ladder_view(nclstr_view) = nld(iseed,iv) !ladder a cui appartiene il cluster seed
652                 mult(nclstr1)=multtemp !molteplicita'                 maxs_view(nclstr_view)   = iseed !strip del cluster seed
653                                 mult_view(nclstr_view)   = multtemp !molteplicita'
654                 indstart(nclstr1)=ind !posizione dell'inizio del cluster nell'                 rmax_view(nclstr_view)   = rmax
655                                  ! array clsignal                 lmax_view(nclstr_view)   = lmax
656                 indmax(nclstr1)=indstart(nclstr1)+(iseed-lmax) !posizione del  
                                 ! cluster seed nell'array clsignal  
                 
                CLlength=rmax-lmax+1 !numero di strip del cluster  
                totCLlength=totCLlength+CLlength  
                dedx(nclstr1)=0  
                do j=lmax,rmax   !stores sequentially cluter strip values in  
                   clsignal(ind)=value(j) ! clsignal array  
                   ind=ind+1  
 c                  if(value(j).gt.0)  
                   if(value(j).gt.clinclcut(j))  
      $                 dedx(nclstr1)=dedx(nclstr1)+value(j) !cluster charge  
                enddo  
657  c--------------------------------------------------------  c--------------------------------------------------------
658  c  c
659  c--------------------------------------------------------  c--------------------------------------------------------
# Line 515  c--------------------------------------- Line 675  c---------------------------------------
675  *  *
676  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
677    
678          subroutine save_cluster(iv)
679    *
680    *     (080/2006 Elena Vannuccini)
681    *     Save the clusters view by view
682    
683          include 'commontracker.f'
684          include 'level1.f'
685          include 'calib.f'
686          include 'common_reduction.f'
687    
688          integer CLlength          !lunghezza in strip del cluster
689    
690          do ic=1,nclstr_view
691    
692             nclstr1 = nclstr1+1
693             view(nclstr1)   = iv
694             ladder(nclstr1) = ladder_view(ic)
695             maxs(nclstr1)   = maxs_view(ic)
696             mult(nclstr1)   = mult_view(ic)
697                  
698    c        posizione dell'inizio del cluster nell' array clsignal
699             indstart(nclstr1) = ind
700    c        posizione del cluster seed nell'array clsignal
701             indmax(nclstr1)   = indstart(nclstr1)
702         $        +( maxs_view(ic) - lmax_view(ic) )
703            
704             CLlength      = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate
705             totCLlength   = totCLlength + CLlength
706             dedx(nclstr1) = 0
707             do j=lmax_view(ic),rmax_view(ic)         !stores sequentially cluter strip values in
708    
709                clsignal(ind) = value(j) ! clsignal array
710    
711                ivk=nvk(j)
712                ist=nst(j)
713    
714                clsigma(ind) = sigma(iv,ivk,ist)
715                cladc(ind)   = adc(iv,ivk,ist)
716                clbad(ind)   = bad(iv,ivk,ist)
717    c            clped(ind)   = pedestal(iv,ivk,ist)
718    
719                ind=ind+1
720    c     if(value(j).gt.0)
721                if(value(j).gt.clinclcut(j))
722         $           dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge
723             enddo
724    
725    c         print*,'view ',iv,' -- save_cluster -- nclstr1: '
726    c     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),dedx(nclstr1)
727            
728          enddo
729          
730          return
731          end
732    *---***---***---***---***---***---***---***---***
733    *
734    *
735    *
736    *
737    *
738    *---***---***---***---***---***---***---***---***
739    
740    
741        subroutine stripmask        subroutine stripmask
742    
# Line 526  c--------------------------------------- Line 748  c---------------------------------------
748  *  *
749        include 'commontracker.f'        include 'commontracker.f'
750        include 'level1.f'        include 'level1.f'
751          include 'common_reduction.f'
752        include 'calib.f'        include 'calib.f'
753    
754  *     init mask  *     init mask
755        do iv=1,nviews        do iv=1,nviews
756           do ivk=1,nva1_view           do ivk=1,nva1_view
757              do is=1,nstrips_va1              do is=1,nstrips_va1
758                 mask(iv,ivk,is) = mask_vk(iv,ivk)  c               mask(iv,ivk,is) = mask_vk(iv,ivk)
759                   mask(iv,ivk,is) = mask_vk(iv,ivk) * mask_vk_ev(iv,ivk)              
760              enddo              enddo
761           enddo           enddo
762        enddo        enddo
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.23