/[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.1 by mocchiut, Fri May 19 13:15:56 2006 UTC revision 1.8 by pam-fi, Fri Sep 29 08:45:16 2006 UTC
# Line 10  Line 10 
10  *    *  
11  *************************************************************************  *************************************************************************
12    
13        subroutine reductionflight()        subroutine reductionflight(ierror)
14    
15        include 'commontracker.f'        include 'commontracker.f'
16        include 'level0.f'        include 'level0.f'
# 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
24          ierror = 0
25    
26  *     -------------------------------------------------------  *     -------------------------------------------------------
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  C---------------------------------------------------  c      good1 = good0
34  C     variables in blocks GENERAL and CPU are anyway filled  c--------------------------------------------------
35  C     in order to mantain sincronization among  c     check the LEVEL0 event status for missing
36  C     events at different levels  c     sections or DSP alarms
37  C---------------------------------------------------  c     ==> set the variable GOOD1(12)
38        good1=good0  c--------------------------------------------------
39  c$$$      do iv=1,12        do iv=1,nviews
40  c$$$        crc1(iv)=crc(iv)           if(DSPnumber(iv).gt.0.and.DSPnumber(iv).le.12)then
41  c$$$      enddo  c           ------------------------
42  ccc      print*,'totdatalength(reduction)=',TOTDATAlength  c           GOOD
43  ccc      print*,''  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          print*,'event ',eventn(1),' >>>>>  decode ERROR'  c       if(DEBUG)print*,'event ',eventn(1),' >>>>>  decode ERROR'
104          goto 200           ierror = 220
105    c        goto 200
106    c         print*,'filladc error'
107        endif        endif
108    
109  c--------------------------------------------------  c--------------------------------------------------
# Line 54  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            if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik)              cn(iv,ik)  = 0
118          enddo              cnn(iv,ik) = -1
119                mask_vk_ev(iv,ik)=1
120                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    c      if(good1.eq.0)then
137    c         ierror = 220
138    c      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 69  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 91  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
 c$$$      nevent_good = nevent_good + 1  
         
201  C---------------------------------------------  C---------------------------------------------
202  C     come here if GOOD1=0  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  ccc      print*,'nclstr1(reduction)=',nclstr1  
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
217  c      c
218  c------------------------------------------------------------------------  c------------------------------------------------------------------------
219                      RETURN
220        RETURN                          END
       END                        
221    
222  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
223  *  *
# Line 142  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 177  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 192  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 224  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 232  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 256  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 423  c--------------------------------------- Line 553  c---------------------------------------
553                             lmax=rmax-nclstrp+1                             lmax=rmax-nclstrp+1
554                          endif                          endif
555                       endif                       endif
                       
556                    endif                    endif
557                 elseif(value(iseed+1).gt.value(iseed-1)) then                 elseif(value(iseed+1).gt.value(iseed-1)) then
558  c     !??? sposto il limite del cluster a destra per includere sempre le strip  c     !??? sposto il limite del cluster a destra per includere sempre le strip
# Line 468  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.
                   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--------------------------------------------------------
660              endif               !end possible seed conditio              endif               !end possible seed conditio
661   220        continue            !jumps here to skip strips left of last seed   220        continue            !jumps here to skip strips left of last seed
# Line 522  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 533  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    
 c$$$      character*20 data_file  
 c$$$  
 c$$$      character*3 aid  
 c$$$      character*6 adate  
 c$$$      integer id  
 c$$$      integer date  
 c$$$  
 c$$$*     ----------------------  
 c$$$*     retrieve date and id  
 c$$$      aid=data_file(8:10)  
 c$$$      adate=data_file(2:6)  
 c$$$      READ (aid, '(I3)'), id  
 c$$$      READ (adate, '(I6)'), date  
 c$$$*     ----------------------  
     
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
763    
 c$$$*     ---------------------  
 c$$$*     VIEW 2 - VK 23-24  
 c$$$*     couple of vk damaged during integration  
 c$$$      if(date.ge.50208)then  
 c$$$cc         print*,'MASK: view 2 - vk 23/24'  
 c$$$         mask_vk(2,23)=0  
 c$$$         mask_vk(2,24)=0  
 c$$$         do is=1,nstrips_va1  
 c$$$            mask(2,23,is)=0  
 c$$$            mask(2,24,is)=0  
 c$$$         enddo  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 11-12  
 c$$$      if(date.ge.50209)then  
 c$$$        if(.not.(date.eq.50209.and.id.le.6)) then  
 c$$$cc          print*,'MASK: view 7 - vk 11/12'  
 c$$$          mask_vk(7,11)=0  
 c$$$          mask_vk(7,12)=0  
 c$$$          do is=1,nstrips_va1  
 c$$$            mask(7,11,is)=0  
 c$$$            mask(7,12,is)=0  
 c$$$          enddo  
 c$$$        endif  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 21-22  
 c$$$      if(date.ge.50316)then  
 c$$$cc         print*,'MASK: view 7 - vk 21/22'  
 c$$$         mask_vk(7,21)=0  
 c$$$         mask_vk(7,22)=0  
 c$$$         do is=1,nstrips_va1  
 c$$$            mask(7,21,is)=0  
 c$$$            mask(7,22,is)=0  
 c$$$         enddo  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 12 - VK 1-2-3-4  
 c$$$      if((date.eq.50317).and.(id.le.3))then  
 c$$$cc        print*,'MASK: view 12 - vk 1/2/3/4'  
 c$$$        mask_vk(12,1)=0  
 c$$$        mask_vk(12,2)=0  
 c$$$        mask_vk(12,3)=0  
 c$$$        mask_vk(12,4)=0  
 c$$$        do is=1,nstrips_va1  
 c$$$          mask(12,1,is)=0  
 c$$$          mask(12,2,is)=0  
 c$$$          mask(12,3,is)=0  
 c$$$          mask(12,4,is)=0  
 c$$$        enddo  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 5-6  
 c$$$      if(date.ge.50320)then  
 c$$$        if(.not.(date.eq.50320.and.id.le.3)) then  
 c$$$cc          print*,'MASK: view 7 - vk 5/6'  
 c$$$          mask_vk(7,5)=0  
 c$$$          mask_vk(7,6)=0  
 c$$$          do is=1,nstrips_va1  
 c$$$            mask(7,5,is)=0  
 c$$$            mask(7,6,is)=0  
 c$$$          enddo  
 c$$$        endif  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 13-14  
 c$$$      if(date.ge.50320)then  
 c$$$        if(.not.(date.eq.50320.and.id.le.5)) then  
 c$$$cc          print*,'MASK: view 7 - vk 13/14'  
 c$$$          mask_vk(7,13)=0  
 c$$$          mask_vk(7,14)=0  
 c$$$          do is=1,nstrips_va1  
 c$$$            mask(7,13,is)=0  
 c$$$            mask(7,14,is)=0  
 c$$$          enddo  
 c$$$        endif  
 c$$$      endif  
 c$$$  
 c$$$***   SAMARA  
 c$$$***   SAMARA  
 c$$$***   SAMARA  
 c$$$*     it needs further checks...  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 9-10  
 c$$$*     VIEW 12 - VK 1-2-3-4  
 c$$$      if((date.eq.50516).and.(id.le.8))then  
 c$$$cc        print*,'MASK: view 7 - vk 9/10'  
 c$$$cc        print*,'MASK: view 12 - vk 1/2/3/4'  
 c$$$        mask_vk(7,9)=0  
 c$$$        mask_vk(7,10)=0  
 c$$$        mask_vk(12,1)=0  
 c$$$        mask_vk(12,2)=0  
 c$$$        mask_vk(12,3)=0  
 c$$$        mask_vk(12,4)=0  
 c$$$        do is=1,nstrips_va1  
 c$$$          mask(7,9,is)=0  
 c$$$          mask(7,10,is)=0  
 c$$$          mask(12,1,is)=0  
 c$$$          mask(12,2,is)=0  
 c$$$          mask(12,3,is)=0  
 c$$$          mask(12,4,is)=0  
 c$$$        enddo  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 9-10  
 c$$$      if(date.ge.50516)then  
 c$$$        if(.not.(date.eq.50516.and.id.le.8)) then  
 c$$$cc          print*,'MASK: view 7 - vk 9/10'  
 c$$$          mask_vk(7,9)=0  
 c$$$          mask_vk(7,10)=0  
 c$$$          do is=1,nstrips_va1  
 c$$$            mask(7,9,is)=0  
 c$$$            mask(7,10,is)=0  
 c$$$          enddo  
 c$$$        endif  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 12 - VK 7-8  
 c$$$      if(date.ge.50523)then  
 c$$$        if(.not.(date.eq.50523.and.id.le.3)) then  
 c$$$cc          print*,'MASK: view 12 - vk 7/8'  
 c$$$          mask_vk(12,7)=0  
 c$$$          mask_vk(12,8)=0  
 c$$$          do is=1,nstrips_va1  
 c$$$            mask(12,7,is)=0  
 c$$$            mask(12,8,is)=0  
 c$$$          enddo  
 c$$$        endif  
 c$$$      endif  
764    
765        return        return
766        end        end

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.8

  ViewVC Help
Powered by ViewVC 1.1.23