/[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.5 by pam-fi, Tue Sep 5 12:52:21 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          integer ierror
22          ierror = 0
23    
24  *     -------------------------------------------------------  *     -------------------------------------------------------
25  *     STRIP MASK  *     STRIP MASK
26  *     -------------------------------------------------------  *     -------------------------------------------------------
27    
28        call stripmask  c      call stripmask   !called later, after CN computation
29        call init_level1        call init_level1
30    
31  C---------------------------------------------------        good1 = good0
 C     variables in blocks GENERAL and CPU are anyway filled  
 C     in order to mantain sincronization among  
 C     events at different levels  
 C---------------------------------------------------  
       good1=good0  
 c$$$      do iv=1,12  
 c$$$        crc1(iv)=crc(iv)  
 c$$$      enddo  
 ccc      print*,'totdatalength(reduction)=',TOTDATAlength  
 ccc      print*,''  
32  c--------------------------------------------------  c--------------------------------------------------
33  c     read the variable DATATRACKER from LEVEL0  c     read the variable DATATRACKER from LEVEL0
34  c     and fill the variable ADC (inverting view 11)  c     and fill the variable ADC (inverting view 11)
# Line 44  c--------------------------------------- Line 36  c---------------------------------------
36        call filladc(iflag)        call filladc(iflag)
37        if(iflag.ne.0)then        if(iflag.ne.0)then
38          good1=0          good1=0
39          print*,'event ',eventn(1),' >>>>>  decode ERROR'  c       if(DEBUG)print*,'event ',eventn(1),' >>>>>  decode ERROR'
40                ierror = 220
41          goto 200          goto 200
42        endif        endif
43    
# Line 55  c     tagged with the flag CLSTR) Line 48  c     tagged with the flag CLSTR)
48  c--------------------------------------------------  c--------------------------------------------------
49        do iv=1,nviews        do iv=1,nviews
50          do ik=1,nva1_view          do ik=1,nva1_view
51            cn(iv,ik)=0           !initializes cn variable            cn(iv,ik)  = 0
52            if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik)            cnn(iv,ik) = -1
53              mask_vk_ev(iv,ik)=1
54              iflag=0
55              if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik,iflag)
56    c          if(iflag.ne.0)good1=0
57              if(iflag.ne.0)then
58                 mask_vk_ev(iv,ik)=0
59                 ierror = 220
60              endif
61          enddo          enddo
62        enddo        enddo
63    c      if(good1.eq.0)then
64    c         ierror = 220
65    c      endif
66    
67          call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
68  c---------------------------------------------  c---------------------------------------------
69  c     loops on views, VA1 and strips,  c     loops on views, VA1 and strips,
70  c     and computes strips signals using  c     and computes strips signals using
# Line 69  c     sigma informations from histograms Line 73  c     sigma informations from histograms
73  c---------------------------------------------  c---------------------------------------------
74        flag_shower = .false.        flag_shower = .false.
75        ind=1                     !clsignal array index        ind=1                     !clsignal array index
76    
77        do iv=1,nviews            !loop on views        do iv=1,nviews            !loop on views
78          do is=1,nstrips_view    !loop on strips (1)          do is=1,nstrips_view    !loop on strips (1)
79            if(mod(iv,2).eq.1) then            if(mod(iv,2).eq.1) then
# Line 91  C===  > X view Line 96  C===  > X view
96              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
97       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
98            endif            endif
99    c$$$          print*,iv,is,' --- ',adc(iv,nvk(is),nst(is)),cn(iv,nvk(is))
100    c$$$     $         ,pedestal(iv,nvk(is),nst(is)),value(is)
101    c$$$     $         ,sigma(iv,nvk(is),nst(is))
102    c          if(value(is).gt.clseedcut(is))
103    c     $         print*,iv,is,' --- (ADC_PED_CN) ',value(is),clseedcut(is)
104          enddo                   !end loop on strips (1)          enddo                   !end loop on strips (1)
105          call search_cluster(iv)          call search_cluster(iv)
106          if(flag_shower.eqv..true.)then  c$$$        if(flag_shower.eqv..true.)then
107            call init_level1                c$$$          call init_level1              
108            good1=0  c$$$          good1=0
109            goto 200              !jump to next event  c$$$          goto 200              !jump to next event
110    c$$$        endif
111    ccc
112    ccc    modified by Elena (08/2006)
113    ccc
114            if(.not.flag_shower)then
115               call save_cluster(iv)
116            else
117               fshower(iv) = 1
118          endif          endif
119        enddo                     ! end loop on views        enddo                     ! end loop on views
120        do iv=1,nviews        do iv=1,nviews
121          do ik=1,nva1_view          do ik=1,nva1_view
122            cnev(iv,ik)=cn(iv,ik) !assigns computed CN to ntuple variables            cnev(iv,ik)  = cn(iv,ik) !assigns computed CN to ntuple variables
123              cnnev(iv,ik) = cnn(iv,ik) !assigns computed CN to ntuple variables
124  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)
125          enddo          enddo
126        enddo        enddo
 c$$$      nevent_good = nevent_good + 1  
         
127  C---------------------------------------------  C---------------------------------------------
128  C     come here if GOOD1=0  C     come here if GOOD1=0
129  C     or the event has too many clusters  C     or the event has too many clusters
130  C---------------------------------------------  C---------------------------------------------
   
131   200  continue   200  continue
 ccc      print*,'nclstr1(reduction)=',nclstr1  
132  c------------------------------------------------------------------------  c------------------------------------------------------------------------
133  c      c
134  c     closes files and exits  c     closes files and exits
135  c      c
136  c------------------------------------------------------------------------  c------------------------------------------------------------------------
137                      RETURN
138        RETURN                          END
       END                        
139    
140  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
141  *  *
# Line 142  c--------------------------------------- Line 156  c---------------------------------------
156        include 'level1.f'        include 'level1.f'
157        include 'level0.f'        include 'level0.f'
158    
159        good1=0        good1 = 0
160        nclstr1=0        nclstr1 = 0
161        totCLlength=0        totCLlength = 0
162        do ic=1,nclstrmax        do ic=1,nclstrmax
163           view(ic)=0           view(ic) = 0
164           ladder(ic)=0           ladder(ic) = 0
165           indstart(ic)=0           indstart(ic) = 0
166           indmax(ic)=0           indmax(ic) = 0
167           maxs(ic)=0           maxs(ic) = 0
168           mult(ic)=0                     mult(ic) = 0          
169           dedx(ic)=0           dedx(ic) = 0
170             whichtrack(ic) = 0
171    
172        enddo        enddo
173        do id=1,maxlength         !???        do id=1,maxlength         !???
174           clsignal(id)=0.           clsignal(id) = 0.
175             clsigma(id)  = 0.
176             cladc(id)    = 0.
177             clbad(id)    = 0.
178        enddo        enddo
179        do iv=1,nviews        do iv=1,nviews
180  c        crc1(iv)=0  c        crc1(iv)=0
181          do ik=1,nva1_view          do ik=1,nva1_view
182            cnev(iv,ik)=0            cnev(iv,ik) = 0
183              cnnev(iv,ik) = 0
184          enddo          enddo
185            fshower(iv) = 0
186        enddo        enddo
187                
188        return        return
# Line 177  c        crc1(iv)=0 Line 198  c        crc1(iv)=0
198        subroutine search_cluster(iv)        subroutine search_cluster(iv)
199    
200        include 'commontracker.f'        include 'commontracker.f'
       include 'common_reduction.f'  
201        include 'level0.f'        include 'level0.f'
202        include 'level1.f'        include 'level1.f'
203        include 'calib.f'        include 'calib.f'
204    
205          include 'common_reduction.f'
206            
207    
208  c     local variables  c     local variables
# Line 192  c     local variables Line 213  c     local variables
213    
214        integer multtemp          !temporary multiplicity variable        integer multtemp          !temporary multiplicity variable
215    
       integer CLlength          !lunghezza in strip del cluster  
   
216        external nst        external nst
217    
218  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 224  c     Elena: CLINCLCUT = 4 (old value 5) Line 243  c     Elena: CLINCLCUT = 4 (old value 5)
243    
244        iseed=-999                !cluster seed index initialization        iseed=-999                !cluster seed index initialization
245    
246          nclstr_view=0
247    
248        do jl=1,nladders_view     !1..3 !loops on ladders        do jl=1,nladders_view     !1..3 !loops on ladders
249           first=1+nstrips_ladder*(jl-1) !1,1025,2049           first=1+nstrips_ladder*(jl-1) !1,1025,2049
250           last=nstrips_ladder*jl !1024,2048,3072           last=nstrips_ladder*jl !1024,2048,3072
# Line 234  c     X views have 1018 strips instead o Line 255  c     X views have 1018 strips instead o
255           endif           endif
256           do is=first,last       !loop on strips in each ladder           do is=first,last       !loop on strips in each ladder
257              if(is.le.iseed+1) goto 220              if(is.le.iseed+1) goto 220
258  c-----------------------------------------  *******************************************************
259  c     after a cluster seed as been found,  *     Elena 08/2006
260  c     look for next one skipping one strip on the right  * QUESTA PARTE NON E` ADEGUATA per cluster con grossi rilasci di carica
261  c     (i.e. look for double peak cluster)  * perche` salva molte volte lo stesso cluster
262  c-----------------------------------------  * (salvo il cluster rispetto al massimo e basta...)
263              if(is.ne.first) then  *******************************************************
264                 if(value(is).le.value(is-1)) goto 220  c$$$c-----------------------------------------
265              endif  c$$$c     after a cluster seed as been found,
266  c-----------------------------------------  c$$$c     look for next one skipping one strip on the right
267  c     skips cluster seed  c$$$c     (i.e. look for double peak cluster)
268  c     finding if strips values are descreasing (a strip  c$$$c-----------------------------------------
269  c     can be a cluster seed only if previous strip value  c$$$            if(is.ne.first) then
270  c     is lower)  c$$$               if(value(is).le.value(is-1)) goto 220
271  c-----------------------------------------  c$$$            endif
272    c$$$c-----------------------------------------
273    c$$$c     skips cluster seed
274    c$$$c     finding if strips values are descreasing (a strip
275    c$$$c     can be a cluster seed only if previous strip value
276    c$$$c     is lower)
277    c$$$c-----------------------------------------
278    *******************************************************
279    * LA RICERCA PARTE DALL'ULTIMA STRIP SALVATA (***TEMPORANEO****)
280    *******************************************************
281                if(is.le.iseed+rmax+1) goto 220
282    *******************************************************
283    
284              if(value(is).gt.clseedcut(is)) then              if(value(is).gt.clseedcut(is)) then
285  ccc              print*,"value(",is,")=",value(is),  ccc              print*,"value(",is,")=",value(is),
286  ccc     $             " .gt.clseedcut(",is,")=",clseedcut(is)  ccc     $             " .gt.clseedcut(",is,")=",clseedcut(is)
# Line 256  c     possible SEED... Line 289  c     possible SEED...
289  c-----------------------------------------  c-----------------------------------------
290                 itemp=is                 itemp=is
291                 if(itemp.eq.last) goto 230 !estremo...                 if(itemp.eq.last) goto 230 !estremo...
292                 do while(value(itemp)  ****************************************************
293       $              /sigma(iv,nvk(itemp),nst(itemp))  *     modificato da Elena (08/2006) per salvare
294       $              .le.value(itemp+1)  *     il cluster intorno al massimo assoluto
295       $              /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???  ****************************************************
296    c$$$               do while(value(itemp)
297    c$$$     $              /sigma(iv,nvk(itemp),nst(itemp))
298    c$$$     $              .le.value(itemp+1)
299    c$$$     $              /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???
300    c$$$                  itemp=itemp+1
301    c$$$                  if(itemp.eq.last) goto 230 !stops if reaches last strip
302    c$$$               enddo            ! of the ladder
303                   do while(value(itemp).le.value(itemp+1))
304                    itemp=itemp+1                    itemp=itemp+1
305                    if(itemp.eq.last) goto 230 !stops if reaches last strip                    if(itemp.eq.last) goto 230 !stops if reaches last strip
306                 enddo            ! of the ladder                 enddo            ! of the ladder
# Line 423  c--------------------------------------- Line 464  c---------------------------------------
464                             lmax=rmax-nclstrp+1                             lmax=rmax-nclstrp+1
465                          endif                          endif
466                       endif                       endif
                       
467                    endif                    endif
468                 elseif(value(iseed+1).gt.value(iseed-1)) then                 elseif(value(iseed+1).gt.value(iseed-1)) then
469  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 508  c     goto 250 !inutile!???
508   250           continue   250           continue
509    
510  c--------------------------------------------------------  c--------------------------------------------------------
511  c     fills ntuple variables  c     fills cluster variables
512  c--------------------------------------------------------  c--------------------------------------------------------
513                 nclstr1=nclstr1+1 !cluster number  c$$$               nclstr1=nclstr1+1 !cluster number
514  ccc               print*,nclstr1,multtemp  c$$$ccc               print*,nclstr1,multtemp
515                 if(nclstr1.gt.nclstrmax) then !too many clusters for the event:  c$$$               if(nclstr1.gt.nclstrmax) then !too many clusters for the event:
516                    good1=0       ! event  c$$$                  if(verbose)print*,'Event ',eventn(1),
517                    nclstr1=0  c$$$     $                 ': more than ',nclstrmax,' clusters'
518                    totCLlength=0  c$$$                  good1=0       ! event
519    c$$$                  nclstr1=0
520    c$$$                  totCLlength=0
521    c$$$                  flag_shower = .true.
522    c$$$                  goto 2000
523    c$$$               endif
524    c$$$               view(nclstr1)   = iv !vista del cluster
525    c$$$               ladder(nclstr1) = nld(iseed,iv) !ladder a cui appartiene il cluster seed
526    c$$$               maxs(nclstr1)   = iseed !strip del cluster seed
527    c$$$               mult(nclstr1)   = multtemp !molteplicita'
528    c$$$              
529    c$$$               indstart(nclstr1) = ind !posizione dell'inizio del cluster nell'
530    c$$$c                                      ! array clsignal
531    c$$$               indmax(nclstr1)   = indstart(nclstr1)+(iseed-lmax) !posizione del
532    c$$$c                                      ! cluster seed nell'array clsignal
533    c$$$              
534    c$$$               CLlength      = rmax-lmax+1 !numero di strip del cluster
535    c$$$               totCLlength   = totCLlength+CLlength
536    c$$$               dedx(nclstr1) = 0
537    c$$$               do j=lmax,rmax   !stores sequentially cluter strip values in
538    c$$$                  clsignal(ind) = value(j) ! clsignal array
539    c$$$                  ind=ind+1
540    c$$$c                  if(value(j).gt.0)
541    c$$$                  if(value(j).gt.clinclcut(j))
542    c$$$     $                 dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge
543    c$$$               enddo
544    ccc
545    ccc            *** Modified by Elena (08/2006) ***
546    ccc
547                   nclstr_view = nclstr_view + 1 !cluster number
548    c               print*,'view ',iv,' -- search_cluster -- nclstr_view: '
549    c     $              ,nclstr_view
550                   if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view:
551                      if(verbose) print*,'Event ',eventn(1),
552         $                 ': more than ',nclstrmax_view
553         $                 ,' clusters on view ',iv
554    c                  good1=0       ! event
555    c                  nclstr1=0
556    c                  totCLlength=0
557                    flag_shower = .true.                    flag_shower = .true.
                   print*,'Event ',eventn(1),  
      $                 ': more than ',nclstrmax,' clusters'  
558                    goto 2000                    goto 2000
559                 endif                 endif
560                 view(nclstr1)=iv !vista del cluster  
561                 ladder(nclstr1)=nld(iseed,iv) !ladder a cui appartiene il cluster seed  c               view(nclstr1)   = iv !vista del cluster
562                 maxs(nclstr1)=iseed !strip del cluster seed                 ladder_view(nclstr_view) = nld(iseed,iv) !ladder a cui appartiene il cluster seed
563                 mult(nclstr1)=multtemp !molteplicita'                 maxs_view(nclstr_view)   = iseed !strip del cluster seed
564                                 mult_view(nclstr_view)   = multtemp !molteplicita'
565                 indstart(nclstr1)=ind !posizione dell'inizio del cluster nell'                 rmax_view(nclstr_view)   = rmax
566                                  ! array clsignal                 lmax_view(nclstr_view)   = lmax
567                 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  
568  c--------------------------------------------------------  c--------------------------------------------------------
569  c      c
570  c--------------------------------------------------------  c--------------------------------------------------------
571              endif               !end possible seed conditio              endif               !end possible seed conditio
572   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 586  c---------------------------------------
586  *  *
587  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
588    
589          subroutine save_cluster(iv)
590    *
591    *     (080/2006 Elena Vannuccini)
592    *     Save the clusters view by view
593    
594          include 'commontracker.f'
595          include 'level1.f'
596          include 'calib.f'
597          include 'common_reduction.f'
598    
599          integer CLlength          !lunghezza in strip del cluster
600    
601          do ic=1,nclstr_view
602    
603             nclstr1 = nclstr1+1
604             view(nclstr1)   = iv
605             ladder(nclstr1) = ladder_view(ic)
606             maxs(nclstr1)   = maxs_view(ic)
607             mult(nclstr1)   = mult_view(ic)
608                  
609    c        posizione dell'inizio del cluster nell' array clsignal
610             indstart(nclstr1) = ind
611    c        posizione del cluster seed nell'array clsignal
612             indmax(nclstr1)   = indstart(nclstr1)
613         $        +( maxs_view(ic) - lmax_view(ic) )
614            
615             CLlength      = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate
616             totCLlength   = totCLlength + CLlength
617             dedx(nclstr1) = 0
618             do j=lmax_view(ic),rmax_view(ic)         !stores sequentially cluter strip values in
619    
620                clsignal(ind) = value(j) ! clsignal array
621    
622                ivk=nvk(j)
623                ist=nst(j)
624    
625                clsigma(ind) = sigma(iv,ivk,ist)
626                cladc(ind)   = adc(iv,ivk,ist)
627                clbad(ind)   = bad(iv,ivk,ist)
628    c            clped(ind)   = pedestal(iv,ivk,ist)
629    
630                ind=ind+1
631    c     if(value(j).gt.0)
632                if(value(j).gt.clinclcut(j))
633         $           dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge
634             enddo
635    
636    c         print*,'view ',iv,' -- save_cluster -- nclstr1: '
637    c     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),dedx(nclstr1)
638            
639          enddo
640          
641          return
642          end
643    *---***---***---***---***---***---***---***---***
644    *
645    *
646    *
647    *
648    *
649    *---***---***---***---***---***---***---***---***
650    
651    
652        subroutine stripmask        subroutine stripmask
653    
# Line 533  c--------------------------------------- Line 659  c---------------------------------------
659  *  *
660        include 'commontracker.f'        include 'commontracker.f'
661        include 'level1.f'        include 'level1.f'
662          include 'common_reduction.f'
663        include 'calib.f'        include 'calib.f'
664    
 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$$$*     ----------------------  
     
665  *     init mask  *     init mask
666        do iv=1,nviews        do iv=1,nviews
667           do ivk=1,nva1_view           do ivk=1,nva1_view
668              do is=1,nstrips_va1              do is=1,nstrips_va1
669                 mask(iv,ivk,is) = mask_vk(iv,ivk)  c               mask(iv,ivk,is) = mask_vk(iv,ivk)
670                   mask(iv,ivk,is) = mask_vk(iv,ivk) * mask_vk_ev(iv,ivk)              
671              enddo              enddo
672           enddo           enddo
673        enddo        enddo
674    
 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  
675    
676        return        return
677        end        end
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.23