/[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.7 by pam-fi, Fri Sep 29 08:13:04 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 55  c     tagged with the flag CLSTR) Line 113  c     tagged with the flag CLSTR)
113  c--------------------------------------------------  c--------------------------------------------------
114        do iv=1,nviews        do iv=1,nviews
115          do ik=1,nva1_view          do ik=1,nva1_view
116            cn(iv,ik)=0           !initializes cn variable            cn(iv,ik)  = 0
117            if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik)            cnn(iv,ik) = -1
118              mask_vk_ev(iv,ik)=1
119              iflag=0
120              if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik,iflag)
121    c          if(iflag.ne.0)good1=0
122              if(iflag.ne.0)then
123                 mask_vk_ev(iv,ik)=0
124                 ierror = 220
125                 if(verbose)
126         $            print*,' * WARNING * Event ',eventn(1)
127         $            ,': masked vk ',ik,' on view',iv
128              endif
129          enddo          enddo
130        enddo        enddo
131    c      if(good1.eq.0)then
132    c         ierror = 220
133    c      endif
134    
135          call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
136  c---------------------------------------------  c---------------------------------------------
137  c     loops on views, VA1 and strips,  c     loops on views, VA1 and strips,
138  c     and computes strips signals using  c     and computes strips signals using
# Line 69  c     sigma informations from histograms Line 141  c     sigma informations from histograms
141  c---------------------------------------------  c---------------------------------------------
142        flag_shower = .false.        flag_shower = .false.
143        ind=1                     !clsignal array index        ind=1                     !clsignal array index
144    
145        do iv=1,nviews            !loop on views        do iv=1,nviews            !loop on views
146          do is=1,nstrips_view    !loop on strips (1)          do is=1,nstrips_view    !loop on strips (1)
147            if(mod(iv,2).eq.1) then            if(mod(iv,2).eq.1) then
# Line 91  C===  > X view Line 164  C===  > X view
164              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
165       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
166            endif            endif
167    c$$$          print*,iv,is,' --- ',adc(iv,nvk(is),nst(is)),cn(iv,nvk(is))
168    c$$$     $         ,pedestal(iv,nvk(is),nst(is)),value(is)
169    c$$$     $         ,sigma(iv,nvk(is),nst(is))
170    c          if(value(is).gt.clseedcut(is))
171    c     $         print*,iv,is,' --- (ADC_PED_CN) ',value(is),clseedcut(is)
172          enddo                   !end loop on strips (1)          enddo                   !end loop on strips (1)
173          call search_cluster(iv)          call search_cluster(iv)
174          if(flag_shower.eqv..true.)then  c$$$        if(flag_shower.eqv..true.)then
175            call init_level1                c$$$          call init_level1              
176            good1=0  c$$$          good1=0
177            goto 200              !jump to next event  c$$$          goto 200              !jump to next event
178    c$$$        endif
179    ccc
180    ccc    modified by Elena (08/2006)
181    ccc
182            if(.not.flag_shower)then
183               call save_cluster(iv)
184            else
185               fshower(iv) = 1
186               GOOD1(DSPn) = 11
187          endif          endif
188        enddo                     ! end loop on views        enddo                     ! end loop on views
189        do iv=1,nviews        do iv=1,nviews
190          do ik=1,nva1_view          do ik=1,nva1_view
191            cnev(iv,ik)=cn(iv,ik) !assigns computed CN to ntuple variables            cnev(iv,ik)  = cn(iv,ik) !assigns computed CN to ntuple variables
192              cnnev(iv,ik) = cnn(iv,ik) !assigns computed CN to ntuple variables
193  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)
194          enddo          enddo
195        enddo        enddo
 c$$$      nevent_good = nevent_good + 1  
         
196  C---------------------------------------------  C---------------------------------------------
197  C     come here if GOOD1=0  C     come here if GOOD1=0
198  C     or the event has too many clusters  C     or the event has too many clusters
199  C---------------------------------------------  C---------------------------------------------
   
200   200  continue   200  continue
201  ccc      print*,'nclstr1(reduction)=',nclstr1  
202          ngood = 0
203          do iv = 1,nviews
204             ngood = ngood + good1(iv)
205          enddo
206          if(ngood.ne.0)print*,'* WARNING * Event ',eventn(1)
207         $     ,':LEVEL1 event status: '
208         $     ,(good1(i),i=1,nviews)
209  c------------------------------------------------------------------------  c------------------------------------------------------------------------
210  c      c
211  c     closes files and exits  c     closes files and exits
212  c      c
213  c------------------------------------------------------------------------  c------------------------------------------------------------------------
214                      RETURN
215        RETURN                          END
       END                        
216    
217  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
218  *  *
# Line 142  c--------------------------------------- Line 233  c---------------------------------------
233        include 'level1.f'        include 'level1.f'
234        include 'level0.f'        include 'level0.f'
235    
236        good1=0  c      good1 = 0
237        nclstr1=0        do iv=1,12
238        totCLlength=0           good1(iv) = 1 !missing packet
239          enddo
240          nclstr1 = 0
241          totCLlength = 0
242        do ic=1,nclstrmax        do ic=1,nclstrmax
243           view(ic)=0           view(ic) = 0
244           ladder(ic)=0           ladder(ic) = 0
245           indstart(ic)=0           indstart(ic) = 0
246           indmax(ic)=0           indmax(ic) = 0
247           maxs(ic)=0           maxs(ic) = 0
248           mult(ic)=0                     mult(ic) = 0          
249           dedx(ic)=0           dedx(ic) = 0
250             whichtrack(ic) = 0
251    
252        enddo        enddo
253        do id=1,maxlength         !???        do id=1,maxlength         !???
254           clsignal(id)=0.           clsignal(id) = 0.
255             clsigma(id)  = 0.
256             cladc(id)    = 0.
257             clbad(id)    = 0.
258        enddo        enddo
259        do iv=1,nviews        do iv=1,nviews
260  c        crc1(iv)=0  c        crc1(iv)=0
261          do ik=1,nva1_view          do ik=1,nva1_view
262            cnev(iv,ik)=0            cnev(iv,ik) = 0
263              cnnev(iv,ik) = 0
264          enddo          enddo
265            fshower(iv) = 0
266        enddo        enddo
267                
268        return        return
# Line 177  c        crc1(iv)=0 Line 278  c        crc1(iv)=0
278        subroutine search_cluster(iv)        subroutine search_cluster(iv)
279    
280        include 'commontracker.f'        include 'commontracker.f'
       include 'common_reduction.f'  
281        include 'level0.f'        include 'level0.f'
282        include 'level1.f'        include 'level1.f'
283        include 'calib.f'        include 'calib.f'
284    
285          include 'common_reduction.f'
286            
287    
288  c     local variables  c     local variables
# Line 192  c     local variables Line 293  c     local variables
293    
294        integer multtemp          !temporary multiplicity variable        integer multtemp          !temporary multiplicity variable
295    
       integer CLlength          !lunghezza in strip del cluster  
   
296        external nst        external nst
297    
298  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 224  c     Elena: CLINCLCUT = 4 (old value 5) Line 323  c     Elena: CLINCLCUT = 4 (old value 5)
323    
324        iseed=-999                !cluster seed index initialization        iseed=-999                !cluster seed index initialization
325    
326          nclstr_view=0
327    
328        do jl=1,nladders_view     !1..3 !loops on ladders        do jl=1,nladders_view     !1..3 !loops on ladders
329           first=1+nstrips_ladder*(jl-1) !1,1025,2049           first=1+nstrips_ladder*(jl-1) !1,1025,2049
330           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 333  c     X views have 1018 strips instead o
333              first=first+3              first=first+3
334              last=last-3              last=last-3
335           endif           endif
336    
337           do is=first,last       !loop on strips in each ladder           do is=first,last       !loop on strips in each ladder
338    
339              if(is.le.iseed+1) goto 220              if(is.le.iseed+1) goto 220
340  c-----------------------------------------  *******************************************************
341  c     after a cluster seed as been found,  *     Elena 08/2006
342  c     look for next one skipping one strip on the right  * QUESTA PARTE NON E` ADEGUATA per cluster con grossi rilasci di carica
343  c     (i.e. look for double peak cluster)  * perche` salva molte volte lo stesso cluster
344  c-----------------------------------------  * (salvo il cluster rispetto al primo massimo e basta...)
345              if(is.ne.first) then  *******************************************************
346                 if(value(is).le.value(is-1)) goto 220  c$$$c-----------------------------------------
347              endif  c$$$c     after a cluster seed as been found,
348  c-----------------------------------------  c$$$c     look for next one skipping one strip on the right
349  c     skips cluster seed  c$$$c     (i.e. look for double peak cluster)
350  c     finding if strips values are descreasing (a strip  c$$$c-----------------------------------------
351  c     can be a cluster seed only if previous strip value  c$$$            if(is.ne.first) then
352  c     is lower)  c$$$               if(value(is).le.value(is-1)) goto 220
353  c-----------------------------------------  c$$$            endif
354    c$$$c-----------------------------------------
355    c$$$c     skips cluster seed
356    c$$$c     finding if strips values are descreasing (a strip
357    c$$$c     can be a cluster seed only if previous strip value
358    c$$$c     is lower)
359    c$$$c-----------------------------------------
360    *******************************************************
361    * LA RICERCA PARTE DALL'ULTIMA STRIP SALVATA (***TEMPORANEO****)
362    *******************************************************
363                if(is.le.iseed+rmax+1) goto 220
364    *******************************************************
365    
366              if(value(is).gt.clseedcut(is)) then              if(value(is).gt.clseedcut(is)) then
367  ccc              print*,"value(",is,")=",value(is),  ccc              print*,"value(",is,")=",value(is),
368  ccc     $             " .gt.clseedcut(",is,")=",clseedcut(is)  ccc     $             " .gt.clseedcut(",is,")=",clseedcut(is)
# Line 256  c     possible SEED... Line 371  c     possible SEED...
371  c-----------------------------------------  c-----------------------------------------
372                 itemp=is                 itemp=is
373                 if(itemp.eq.last) goto 230 !estremo...                 if(itemp.eq.last) goto 230 !estremo...
374                 do while(value(itemp)  ****************************************************
375       $              /sigma(iv,nvk(itemp),nst(itemp))  *     modificato da Elena (08/2006) per salvare
376       $              .le.value(itemp+1)  *     il cluster intorno al massimo assoluto
377       $              /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???  ****************************************************
378    c$$$               do while(value(itemp)
379    c$$$     $              /sigma(iv,nvk(itemp),nst(itemp))
380    c$$$     $              .le.value(itemp+1)
381    c$$$     $              /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???
382    c$$$                  itemp=itemp+1
383    c$$$                  if(itemp.eq.last) goto 230 !stops if reaches last strip
384    c$$$               enddo            ! of the ladder
385                   do while(
386         $                   value(itemp).le.value(itemp+1)
387         $              .and.value(itemp+1).gt.clseedcut(itemp+1))
388                    itemp=itemp+1                    itemp=itemp+1
389                    if(itemp.eq.last) goto 230 !stops if reaches last strip                    if(itemp.eq.last) goto 230 !stops if reaches last strip
390                 enddo            ! of the ladder                 enddo            ! of the ladder
# Line 423  c--------------------------------------- Line 548  c---------------------------------------
548                             lmax=rmax-nclstrp+1                             lmax=rmax-nclstrp+1
549                          endif                          endif
550                       endif                       endif
                       
551                    endif                    endif
552                 elseif(value(iseed+1).gt.value(iseed-1)) then                 elseif(value(iseed+1).gt.value(iseed-1)) then
553  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 592  c     goto 250 !inutile!???
592   250           continue   250           continue
593    
594  c--------------------------------------------------------  c--------------------------------------------------------
595  c     fills ntuple variables  c     fills cluster variables
596  c--------------------------------------------------------  c--------------------------------------------------------
597                 nclstr1=nclstr1+1 !cluster number  c$$$               nclstr1=nclstr1+1 !cluster number
598  ccc               print*,nclstr1,multtemp  c$$$ccc               print*,nclstr1,multtemp
599                 if(nclstr1.gt.nclstrmax) then !too many clusters for the event:  c$$$               if(nclstr1.gt.nclstrmax) then !too many clusters for the event:
600                    good1=0       ! event  c$$$                  if(verbose)print*,'Event ',eventn(1),
601                    nclstr1=0  c$$$     $                 ': more than ',nclstrmax,' clusters'
602                    totCLlength=0  c$$$                  good1=0       ! event
603    c$$$                  nclstr1=0
604    c$$$                  totCLlength=0
605    c$$$                  flag_shower = .true.
606    c$$$                  goto 2000
607    c$$$               endif
608    c$$$               view(nclstr1)   = iv !vista del cluster
609    c$$$               ladder(nclstr1) = nld(iseed,iv) !ladder a cui appartiene il cluster seed
610    c$$$               maxs(nclstr1)   = iseed !strip del cluster seed
611    c$$$               mult(nclstr1)   = multtemp !molteplicita'
612    c$$$              
613    c$$$               indstart(nclstr1) = ind !posizione dell'inizio del cluster nell'
614    c$$$c                                      ! array clsignal
615    c$$$               indmax(nclstr1)   = indstart(nclstr1)+(iseed-lmax) !posizione del
616    c$$$c                                      ! cluster seed nell'array clsignal
617    c$$$              
618    c$$$               CLlength      = rmax-lmax+1 !numero di strip del cluster
619    c$$$               totCLlength   = totCLlength+CLlength
620    c$$$               dedx(nclstr1) = 0
621    c$$$               do j=lmax,rmax   !stores sequentially cluter strip values in
622    c$$$                  clsignal(ind) = value(j) ! clsignal array
623    c$$$                  ind=ind+1
624    c$$$c                  if(value(j).gt.0)
625    c$$$                  if(value(j).gt.clinclcut(j))
626    c$$$     $                 dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge
627    c$$$               enddo
628    ccc
629    ccc            *** Modified by Elena (08/2006) ***
630    ccc
631                   nclstr_view = nclstr_view + 1 !cluster number
632    c               print*,'view ',iv,' -- search_cluster -- nclstr_view: '
633    c     $              ,nclstr_view
634                   if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view:
635                      if(verbose) print*,'Event ',eventn(1),
636         $                 ': more than ',nclstrmax_view
637         $                 ,' clusters on view ',iv
638    c                  good1=0       ! event
639    c                  nclstr1=0
640    c                  totCLlength=0
641                    flag_shower = .true.                    flag_shower = .true.
                   print*,'Event ',eventn(1),  
      $                 ': more than ',nclstrmax,' clusters'  
642                    goto 2000                    goto 2000
643                 endif                 endif
644                 view(nclstr1)=iv !vista del cluster  
645                 ladder(nclstr1)=nld(iseed,iv) !ladder a cui appartiene il cluster seed  c               view(nclstr1)   = iv !vista del cluster
646                 maxs(nclstr1)=iseed !strip del cluster seed                 ladder_view(nclstr_view) = nld(iseed,iv) !ladder a cui appartiene il cluster seed
647                 mult(nclstr1)=multtemp !molteplicita'                 maxs_view(nclstr_view)   = iseed !strip del cluster seed
648                                 mult_view(nclstr_view)   = multtemp !molteplicita'
649                 indstart(nclstr1)=ind !posizione dell'inizio del cluster nell'                 rmax_view(nclstr_view)   = rmax
650                                  ! array clsignal                 lmax_view(nclstr_view)   = lmax
651                 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  
652  c--------------------------------------------------------  c--------------------------------------------------------
653  c      c
654  c--------------------------------------------------------  c--------------------------------------------------------
655              endif               !end possible seed conditio              endif               !end possible seed conditio
656   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 670  c---------------------------------------
670  *  *
671  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
672    
673          subroutine save_cluster(iv)
674    *
675    *     (080/2006 Elena Vannuccini)
676    *     Save the clusters view by view
677    
678          include 'commontracker.f'
679          include 'level1.f'
680          include 'calib.f'
681          include 'common_reduction.f'
682    
683          integer CLlength          !lunghezza in strip del cluster
684    
685          do ic=1,nclstr_view
686    
687             nclstr1 = nclstr1+1
688             view(nclstr1)   = iv
689             ladder(nclstr1) = ladder_view(ic)
690             maxs(nclstr1)   = maxs_view(ic)
691             mult(nclstr1)   = mult_view(ic)
692                  
693    c        posizione dell'inizio del cluster nell' array clsignal
694             indstart(nclstr1) = ind
695    c        posizione del cluster seed nell'array clsignal
696             indmax(nclstr1)   = indstart(nclstr1)
697         $        +( maxs_view(ic) - lmax_view(ic) )
698            
699             CLlength      = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate
700             totCLlength   = totCLlength + CLlength
701             dedx(nclstr1) = 0
702             do j=lmax_view(ic),rmax_view(ic)         !stores sequentially cluter strip values in
703    
704                clsignal(ind) = value(j) ! clsignal array
705    
706                ivk=nvk(j)
707                ist=nst(j)
708    
709                clsigma(ind) = sigma(iv,ivk,ist)
710                cladc(ind)   = adc(iv,ivk,ist)
711                clbad(ind)   = bad(iv,ivk,ist)
712    c            clped(ind)   = pedestal(iv,ivk,ist)
713    
714                ind=ind+1
715    c     if(value(j).gt.0)
716                if(value(j).gt.clinclcut(j))
717         $           dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge
718             enddo
719    
720    c         print*,'view ',iv,' -- save_cluster -- nclstr1: '
721    c     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),dedx(nclstr1)
722            
723          enddo
724          
725          return
726          end
727    *---***---***---***---***---***---***---***---***
728    *
729    *
730    *
731    *
732    *
733    *---***---***---***---***---***---***---***---***
734    
735    
736        subroutine stripmask        subroutine stripmask
737    
# Line 533  c--------------------------------------- Line 743  c---------------------------------------
743  *  *
744        include 'commontracker.f'        include 'commontracker.f'
745        include 'level1.f'        include 'level1.f'
746          include 'common_reduction.f'
747        include 'calib.f'        include 'calib.f'
748    
 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$$$*     ----------------------  
     
749  *     init mask  *     init mask
750        do iv=1,nviews        do iv=1,nviews
751           do ivk=1,nva1_view           do ivk=1,nva1_view
752              do is=1,nstrips_va1              do is=1,nstrips_va1
753                 mask(iv,ivk,is) = mask_vk(iv,ivk)  c               mask(iv,ivk,is) = mask_vk(iv,ivk)
754                   mask(iv,ivk,is) = mask_vk(iv,ivk) * mask_vk_ev(iv,ivk)              
755              enddo              enddo
756           enddo           enddo
757        enddo        enddo
758    
 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  
759    
760        return        return
761        end        end

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

  ViewVC Help
Powered by ViewVC 1.1.23