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

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

  ViewVC Help
Powered by ViewVC 1.1.23