/[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.22 by pam-fi, Mon Aug 20 16:07:16 2007 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  *     STRIP MASK        ierror = 0
25  *     -------------------------------------------------------  
26    c$$$      debug = .true.
27    c$$$      verbose = .true.
28    c$$$      warning = .true.
29    
30    c$$$      print*,debug,verbose,warning
31    c$$$      debug=1
32    c$$$      verbose=1
33    c$$$      warning=1
34    
35    *     //////////////////////////
36    *     initialize some parameters
37    *     //////////////////////////
38    
       call stripmask  
39        call init_level1        call init_level1
40    
41  C---------------------------------------------------  c      debug=.true.
42  C     variables in blocks GENERAL and CPU are anyway filled  
43  C     in order to mantain sincronization among        if(debug.eq.1)print*,'-- check LEVEL0 status'
44  C     events at different levels  
45  C---------------------------------------------------        ievco=-1
46        good1=good0        mismatch=0
47  c$$$      do iv=1,12  c      good1 = good0
48  c$$$        crc1(iv)=crc(iv)  c--------------------------------------------------
49  c$$$      enddo  c     check the LEVEL0 event status for missing
50  ccc      print*,'totdatalength(reduction)=',TOTDATAlength  c     sections or DSP alarms
51  ccc      print*,''  c     ==> set the variable GOOD1(12)
52    c--------------------------------------------------
53          do iv=1,nviews
54             if(DSPnumber(iv).gt.0.and.DSPnumber(iv).le.12)then
55    c           ------------------------
56    c           GOOD
57    c           ------------------------
58                GOOD1(DSPnumber(iv))=0 !OK
59    c           ------------------------
60    c           CRC error
61    c           ------------------------
62                if(crc(iv).eq.1) then
63    c               GOOD1(DSPnumber(iv)) = 2
64    c               GOOD1(DSPnumber(iv)) = GOOD1(DSPnumber(iv)) + 2**1
65                   GOOD1(DSPnumber(iv)) = ior(GOOD1(DSPnumber(iv)),2**1)
66     102           format(' * WARNING * Event ',i7,' view',i3
67         $          ,' CRC error')
68                   if(debug.eq.1)write(*,102)eventn(1),DSPnumber(iv)
69    c               goto 18 !next view
70                endif
71    c           ------------------------
72    c           online-software alarm
73    c           ------------------------
74                if(
75         $           fl1(iv).ne.0.or.
76         $           fl2(iv).ne.0.or.
77         $           fl3(iv).ne.0.or.
78         $           fl4(iv).ne.0.or.
79         $           fl5(iv).ne.0.or.
80         $           fl6(iv).ne.0.or.
81         $           fc(iv).ne.0.or.
82         $           DATAlength(iv).eq.0.or.
83         $           .false.)then
84    c               GOOD1(DSPnumber(iv))=3
85    c               GOOD1(DSPnumber(iv)) = GOOD1(DSPnumber(iv)) + 2**2
86                   GOOD1(DSPnumber(iv)) = ior(GOOD1(DSPnumber(iv)),2**2)
87     103           format(' * WARNING * Event ',i7,' view',i3
88         $          ,' software alarm')
89                   if(debug.eq.1)write(*,103)eventn(1),DSPnumber(iv)
90    c               goto 18
91                endif
92    c           ------------------------
93    c           DSP-counter jump
94    c           ------------------------
95    c     commentato perche` non e` un controllo significativo nel caso in cui
96    c     la subroutine venga chiamata per riprocessare l'evento
97    c     sostituito con un check dei contatori dei vari dsp
98    c$$$            if(
99    c$$$     $           eventn_old(iv).ne.0.and. !first event in this file
100    c$$$     $           eventn(iv).ne.1.and.     !first event in run
101    c$$$     $           good_old(DSPnumber(iv)).ne.0.and. !previous event corrupted
102    c$$$     $           .true.)then
103    c$$$
104    c$$$               if(eventn(iv).ne.(eventn_old(iv)+1))then
105    c$$$c                  GOOD1(DSPnumber(iv))=4
106    c$$$c                  GOOD1(DSPnumber(iv)) = GOOD1(DSPnumber(iv)) + 2**3
107    c$$$                  GOOD1(DSPnumber(iv)) = ior(GOOD1(DSPnumber(iv)),2**3)
108    c$$$ 104              format(' * WARNING * Event ',i7,' view',i3
109    c$$$     $          ,' counter jump ',i10,i10)
110    c$$$                  if(debug.eq.1)write(*,104)eventn(1),DSPnumber(iv)
111    c$$$     $                 ,eventn_old(iv),eventn(iv))
112    c$$$                  goto 18
113    c$$$               endif
114    c$$$
115    c$$$            endif
116    c           ------------------------
117    c 18         continue
118    c           ------------------------
119    c           DSP-counter
120    c           ------------------------
121                if( DSPnumber(iv).ne.0.and.GOOD1(DSPnumber(iv)).ne.1)then
122                   if(iv.ne.1.and.ievco.ne.-1)then
123                      if( eventn(iv).ne.ievco )then
124                         mismatch=1
125                      endif
126                   endif
127                   ievco = eventn(iv)
128                endif
129             endif
130          enddo
131    
132    c      print*,'*** ',(eventn(iv),iv=1,12)
133          
134          if(mismatch.eq.1.and.debug.eq.1)
135         $     print*,' * WARNING * DSP counter mismatch: '
136         $     ,(eventn(iv),iv=1,12)
137    
138          ngood = 0
139          do iv = 1,nviews
140            
141             if(mismatch.eq.1.and.GOOD1(iv).ne.1)
142         $        GOOD1(iv)=ior(GOOD1(iv),2**3)
143    
144             eventn_old(iv) = eventn(iv)
145             good_old(iv)   = good1(iv)
146             ngood = ngood + good1(iv)
147    
148          enddo
149    c$$$      if(verbose.and.ngood.ne.0)print*,'* WARNING * Event ',eventn(1)
150    c$$$     $     ,':LEVEL0 event status: '
151    c$$$     $     ,(good1(i),i=1,nviews)
152  c--------------------------------------------------  c--------------------------------------------------
153  c     read the variable DATATRACKER from LEVEL0  c     read the variable DATATRACKER from LEVEL0
154  c     and fill the variable ADC (inverting view 11)  c     and fill the variable ADC (invertin view 11)
155  c--------------------------------------------------  c--------------------------------------------------
156          
157          if(debug.eq.1)print*,'-- fill ADC vectors'
158    
159        call filladc(iflag)        call filladc(iflag)
160        if(iflag.ne.0)then        if(iflag.ne.0)then
161          good1=0           ierror = 220
         print*,'event ',eventn(1),' >>>>>  decode ERROR'  
         goto 200  
162        endif        endif
163    
164  c--------------------------------------------------  c--------------------------------------------------
165  c     computes common noise for each VA1  c     computes common noise for each VA1
166  c     (excluding strips affected by signal,  c     (excluding strips with signal,
167  c     tagged with the flag CLSTR)  c     tagged with the flag CLSTR)
168  c--------------------------------------------------  c--------------------------------------------------
169          if(debug.eq.1)print*,'-- compute CN'
170    
171        do iv=1,nviews        do iv=1,nviews
172          do ik=1,nva1_view           ima=0
173            cn(iv,ik)=0           !initializes cn variable           do ik=1,nva1_view
174            if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik)              cn(iv,ik)    = 0
175          enddo              cnrms(iv,ik) = 0
176                cnn(iv,ik)   = -1
177                iflag = 0
178                mask_vk_ev(iv,ik) = 1
179                call stripmask(iv,ik)      !compute mask(i,j,k), combining VA1-masks
180    *           --------------------------------------
181    *           if chip is not masked ---> evaluate CN
182    *           --------------------------------------
183                if( mask(iv,ik,1).eq.1 ) then !!!NBNB mask per la striscia 1 !!!!!!!!
184                   call cncomp(iv,ik,iflag)
185                   if(iflag.ne.0)then
186                      ima=ima+1
187                      mask_vk_ev(iv,ik)=0
188                      ierror = 220
189                   endif
190                   call stripmask(iv,ik) !compute mask(i,j,k), combining VA1-masks
191                endif
192             enddo
193     100     format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
194             if(ima.ne.0.and.verbose.eq.1)write(*,100)eventn(1),iv
195         $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
196    c         if(ima.ne.0)write(*,100)eventn(1),iv
197    c     $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)  
198        enddo        enddo
199    
200    cc      call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
201    
202  c---------------------------------------------  c---------------------------------------------
203  c     loops on views, VA1 and strips,  c     loops on views, VA1 and strips,
# Line 67  c     and computes strips signals using Line 205  c     and computes strips signals using
205  c     badstrip, pedestals, and  c     badstrip, pedestals, and
206  c     sigma informations from histograms  c     sigma informations from histograms
207  c---------------------------------------------  c---------------------------------------------
       flag_shower = .false.  
208        ind=1                     !clsignal array index        ind=1                     !clsignal array index
209    
210          if(debug.eq.1)print*,'-- search clusters'
211        do iv=1,nviews            !loop on views        do iv=1,nviews            !loop on views
212          do is=1,nstrips_view    !loop on strips (1)          do is=1,nstrips_view    !loop on strips (1)
213            if(mod(iv,2).eq.1) then            if(mod(iv,2).eq.1) then
214  C===  > Y view  C===  > Y view
215    c             print*,iv,nvk(is),nst(is),adc(iv,nvk(is),nst(is))
216    c     $            ,cn(iv,nvk(is))
217    c     $            ,pedestal(iv,nvk(is),nst(is))
218              value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))              value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))
219       $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))       $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
220       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
# Line 80  C===  > Y view Line 222  C===  > Y view
222       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
223              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
224       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
225  ccc            print*,"value(",is,")(reduction)= ",value(is)              sat(is)=0
226                if( adc(iv,nvk(is),nst(is)).lt.adc_saty )sat(is)=1
227            else                        else            
228  C===  > X view  C===  > X view
229              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
# Line 90  C===  > X view Line 233  C===  > X view
233       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
234              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
235       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
236                sat(is)=0
237                if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1
238            endif            endif
239          enddo                   !end loop on strips (1)          enddo                   !end loop on strips (1)
240          call search_cluster(iv)          call search_cluster(iv)
241          if(flag_shower.eqv..true.)then  
242            call init_level1                        if(.not.flag_shower)then
243            good1=0             call save_cluster(iv)
244            goto 200              !jump to next event             if(debug.eq.1)print*,'view ',iv,' #clusters ', nclstr_view
245            else
246               fshower(iv) = 1
247    c           GOOD1(DSPnumber(iv)) = 11 !AHAHAHAHA ORRORE!!
248    c           GOOD1(iv) = 11
249    c           GOOD1(iv) = GOOD1(iv) + 2**5
250               GOOD1(iv) = ior(GOOD1(iv),2**5)
251     101       format(' * WARNING * Event ',i7,' view',i3
252         $          ,' #clusters > ',i5,' --> MASKED')
253               if(verbose.eq.1)write(*,101)eventn(1),iv,nclstrmax_view
254          endif          endif
255        enddo                     ! end loop on views        enddo                     ! end loop on views
256        do iv=1,nviews        do iv=1,nviews
257          do ik=1,nva1_view          do ik=1,nva1_view
258            cnev(iv,ik)=cn(iv,ik) !assigns computed CN to ntuple variables            cnev(iv,ik)    = cn(iv,ik) !assigns computed CN to ntuple variables
259  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)            cnrmsev(iv,ik) = cnrms(iv,ik) !assigns computed CN to ntuple variables
260              cnnev(iv,ik)   = cnn(iv,ik) !assigns computed CN to ntuple variables
261          enddo          enddo
262        enddo        enddo
 c$$$      nevent_good = nevent_good + 1  
         
263  C---------------------------------------------  C---------------------------------------------
264  C     come here if GOOD1=0  C     come here if GOOD1=0
265  C     or the event has too many clusters  C     or the event has too many clusters
266  C---------------------------------------------  C---------------------------------------------
   
267   200  continue   200  continue
268  ccc      print*,'nclstr1(reduction)=',nclstr1  
269          ngood = 0
270          do iv = 1,nviews
271             ngood = ngood + good1(iv)
272          enddo
273          if(verbose.eq.1.and.ngood.ne.0)
274         $     print*,'* WARNING * Event ',eventn(1)
275         $     ,':LEVEL1 event status: '
276         $     ,(good1(i),i=1,nviews)
277  c------------------------------------------------------------------------  c------------------------------------------------------------------------
278  c      c
279  c     closes files and exits  c     closes files and exits
280  c      c
281  c------------------------------------------------------------------------  c------------------------------------------------------------------------
282                      RETURN
283        RETURN                          END
       END                        
284    
285  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
286  *  *
# Line 142  c--------------------------------------- Line 301  c---------------------------------------
301        include 'level1.f'        include 'level1.f'
302        include 'level0.f'        include 'level0.f'
303    
304        good1=0  c      good1 = 0
305        nclstr1=0        do iv=1,12
306        totCLlength=0           good1(iv) = 1 !missing packet
307          enddo
308          nclstr1 = 0
309          totCLlength = 0
310        do ic=1,nclstrmax        do ic=1,nclstrmax
311           view(ic)=0           view(ic) = 0
312           ladder(ic)=0           ladder(ic) = 0
313           indstart(ic)=0           indstart(ic) = 0
314           indmax(ic)=0           indmax(ic) = 0
315           maxs(ic)=0           maxs(ic) = 0
316           mult(ic)=0                     mult(ic) = 0          
317           dedx(ic)=0           sgnl(ic) = 0
318             whichtrack(ic) = 0     !assigned @ level2
319    
320        enddo        enddo
321        do id=1,maxlength         !???        do id=1,maxlength         !???
322           clsignal(id)=0.           clsignal(id) = 0.
323             clsigma(id)  = 0.
324             cladc(id)    = 0.
325             clbad(id)    = 0.
326        enddo        enddo
327        do iv=1,nviews        do iv=1,nviews
328  c        crc1(iv)=0  c        crc1(iv)=0
329          do ik=1,nva1_view          do ik=1,nva1_view
330            cnev(iv,ik)=0            cnev(iv,ik) = 0
331              cnnev(iv,ik) = 0
332          enddo          enddo
333            fshower(iv) = 0
334        enddo        enddo
335                
336        return        return
337        end        end
338    
339  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
340  *  *
341  *  *
# Line 177  c        crc1(iv)=0 Line 347  c        crc1(iv)=0
347        subroutine search_cluster(iv)        subroutine search_cluster(iv)
348    
349        include 'commontracker.f'        include 'commontracker.f'
       include 'common_reduction.f'  
350        include 'level0.f'        include 'level0.f'
351        include 'level1.f'        include 'level1.f'
352        include 'calib.f'        include 'calib.f'
353    
354          include 'common_reduction.f'
355            
356    
357  c     local variables  c     local variables
358        integer rmax,lmax         !estremi del cluster        integer rmax,lmax         !estremi del cluster
359        integer rstop,lstop       !per decidere quali strip includere nel cluster        integer rstop,lstop      
360                                  ! oltre il seed        integer first,last
361        integer first,last,diff   !per includere le strip giuste... !???        integer fsat,lsat
362    
363        integer multtemp          !temporary multiplicity variable        external nst
364    
365        integer CLlength          !lunghezza in strip del cluster        iseed=-999                !cluster seed index initialization
366    
367        external nst        inext=-999                !index where to start new cluster search
368    
369  c------------------------------------------------------------------------        flag_shower = .false.
370  c     looks for clusters on each view        nclstr_view=0
 C     : CERCO STRIP SOPRA CLSEEDCUT, POI SCORRO A DX FINCHE'  
 c     NON TROVO  
 C     STRIP PIU' BASSA (in segnale/rumore)  
 C     => L'ULTIMA DELLA SERIE CRESCENTE  
 C     (LA PIU' ALTA) E' IL  
 C     CLUSTER SEED. POI SCORRO A SX E DX INCLUDENDO TUTTE  
 C     LE STRIP (FINO A 17 AL  
 C     MAX) CHE SUPERANO CLINCLCUT.  
 C     QUANDO CERCO IL CLUSTER SEED SUCCESSIVO SALTO LA STRIP  
 C     ADIACENTE A DESTRA  
 C     DELL'ULTIMO CLUSTER SEED (CHE SARA' NECESSARIAMENTE  
 C     PIU' BASSA) E PRENDO  
 C     COME SEED UNA STRIP SOLO SE IL SUO SEGNALE E'  
 C     MAGGIORE DI QUELLO DELLA STRIP  
 C     PRECEDENTE (PRATICAMENTE PER EVITARE CHE L'ULTIMA  
 C     STRIP DI UN GRUPPO DI STRIP  
 C     TUTTE SOPRA IL CLSEEDCUT VENGA AUTOMATICAMENTE PRESA  
 C     COME SEED... DEVE ESSERE  
 C     PRESA SOLO SE IL CLUSTER E' DOUBLE PEAKED...)  
 c------------------------------------------------------------------------  
 c     6 ottobre 2003  
 c     Elena: CLSEEDCUT = 7 (old value 10)  
 c     Elena: CLINCLCUT = 4 (old value 5)  
371    
372        iseed=-999                !cluster seed index initialization        do jl=1,nladders_view              !1..3 !loops on ladders
373    
374             first = 1+nstrips_ladder*(jl-1) !1,1025,2049
375             last  = nstrips_ladder*jl       !1024,2048,3072
376    
377        do jl=1,nladders_view     !1..3 !loops on ladders  *        X views have 1018 strips instead of 1024
          first=1+nstrips_ladder*(jl-1) !1,1025,2049  
          last=nstrips_ladder*jl !1024,2048,3072  
 c     X views have 1018 strips instead of 1024  
378           if(mod(iv,2).eq.0) then           if(mod(iv,2).eq.0) then
379              first=first+3              first=first+3
380              last=last-3              last=last-3
381           endif           endif
382    
383           do is=first,last       !loop on strips in each ladder           do is=first,last       !loop on strips in each ladder
384              if(is.le.iseed+1) goto 220  
385  c-----------------------------------------  c---------------------------------------------
386  c     after a cluster seed as been found,  c     new-cluster search starts at index inext
387  c     look for next one skipping one strip on the right  c---------------------------------------------
388  c     (i.e. look for double peak cluster)              if(is.lt.inext) goto 220 ! next strip
389  c-----------------------------------------  
             if(is.ne.first) then  
                if(value(is).le.value(is-1)) goto 220  
             endif  
 c-----------------------------------------  
 c     skips cluster seed  
 c     finding if strips values are descreasing (a strip  
 c     can be a cluster seed only if previous strip value  
 c     is lower)  
 c-----------------------------------------  
390              if(value(is).gt.clseedcut(is)) then              if(value(is).gt.clseedcut(is)) then
 ccc              print*,"value(",is,")=",value(is),  
 ccc     $             " .gt.clseedcut(",is,")=",clseedcut(is)  
391  c-----------------------------------------  c-----------------------------------------
392  c     possible SEED...  c     possible SEED...
393  c-----------------------------------------  c-----------------------------------------
394                 itemp=is                 itemp = is
395                   fsat = 0         ! first saturated strip
396                   lsat = 0         ! last saturated strip
397                 if(itemp.eq.last) goto 230 !estremo...                 if(itemp.eq.last) goto 230 !estremo...
398                 do while(value(itemp)  c              ------------------------                
399       $              /sigma(iv,nvk(itemp),nst(itemp))  c              search for first maximum
400       $              .le.value(itemp+1)  c              ------------------------
401       $              /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???                 do while(
402                    itemp=itemp+1       $                   value(itemp).le.value(itemp+1)
403                    if(itemp.eq.last) goto 230 !stops if reaches last strip       $              .and.value(itemp+1).gt.clseedcut(itemp+1))
404                      itemp = itemp+1
405                      if(itemp.eq.last)   goto 230 !stops if reaches last strip
406                      if(sat(itemp).eq.1) goto 230 !stop if reaches a saturated strip
407                 enddo            ! of the ladder                 enddo            ! of the ladder
408   230           continue   230           continue
409  c-----------------------------------------  c              -----------------------------
410    c              check if strips are saturated
411    c              -----------------------------    
412                   if( sat(itemp).eq.1 )then
413                      fsat = itemp
414                      lsat = itemp
415                      if(itemp.eq.last) goto 231 !estremo...
416                      do while( sat(itemp+1).eq.1 )
417                         itemp = itemp+1
418                         lsat = itemp
419                         if(itemp.eq.last)   goto 231 !stops if reaches last strip
420                      enddo                  
421                   endif
422     231           continue
423    c---------------------------------------------------------------------------
424  c     fownd SEED!!!  c     fownd SEED!!!
425  c-----------------------------------------  c     (if there are saturated strips, the cluster is centered in the middle)
426                 iseed=itemp      c---------------------------------------------------------------------------
427  c----------------------------------------------------------                 if(fsat.eq.0.and.lsat.eq.0)then
428                      iseed = itemp ! <<< SEED
429                   else
430                      iseed = int((lsat+fsat)/2) ! <<< SEED
431    c$$$                  print*,'saturated strips ',fsat,lsat,iseed
432    c$$$                  print*,'--> ',(value(ii),ii=fsat,lsat)
433                   endif    
434    c---------------------------------------------------------------
435  c     after finding a cluster seed, checks also adjacent strips,  c     after finding a cluster seed, checks also adjacent strips,
436  C     and marks the ones exceeding clinclcut  C     and tags the ones exceeding clinclcut
437  c----------------------------------------------------------  c---------------------------------------------------------------
438                 ir=iseed         !indici destro                 ir=iseed         !indici destro
439                 il=iseed         ! e sinistro                 il=iseed         ! e sinistro
440                                
# Line 282  c--------------------------------------- Line 445  c---------------------------------------
445                 lstop=0          ! inclusion loop                 lstop=0          ! inclusion loop
446    
447                 do while(lstop.eq.0.or.rstop.eq.0) !shifts left and right from                 do while(lstop.eq.0.or.rstop.eq.0) !shifts left and right from
448                    ir=ir+1       !position index for strips on right side of  
449                                  ! cluster seed  
450                    il=il-1       !and for left side                    ir=ir+1       !index for right side
451                      il=il-1       !index for left side
452  c------------------------------------------------------------------------  c------------------------------------------------------------------------
453  c     checks for last or first strip of the ladder  c     checks for last or first strip of the ladder
454  c------------------------------------------------------------------------  c------------------------------------------------------------------------
455                    if(ir.gt.last) then !when index goes beyond last strip                    if( ir.gt.last  ) rstop = 1                      
456                       rstop=1    ! of the ladder, change rstop flag in order                    if( il.lt.first ) lstop = 1
                                 ! to "help" exiting from loop  
                   endif  
                     
                   if(il.lt.first) then !idem when index goes beyond  
                      lstop=1    ! first strip of the ladder  
                   endif  
457                                        
458  c------------------------------------------------------------------------  c------------------------------------------------------------------------
459  c     check for clusters including more than nclstrp strips  c     add strips exceeding inclusion cut
460  c------------------------------------------------------------------------  c------------------------------------------------------------------------
461                    if((rmax-lmax+1).ge.nclstrp) then                    if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
462                       goto 210   !exits inclusion loop:  
463                                  ! lmax and rmax maintain last value                    if(rstop.eq.0) then !if right cluster border has not been reached
464                                  ! NB .ge.!???                       if(value(ir).gt.clinclcut(ir)) then
465                    endif                          rmax=ir !include a strip on the right
 c------------------------------------------------------------------------  
 c     marks strips exceeding inclusion cut  
 c------------------------------------------------------------------------  
                   if(rstop.eq.0) then !if last strip of the ladder or last  
                                 ! over-cut strip has not been reached  
                      if(value(ir).gt.clinclcut(ir)) then !puts in rmax the  
                         rmax=ir ! last right over-cut strip  
466                       else                       else
467                          rstop=1 !otherwise cluster ends on right and rstop                          rstop=1 !cluster right end
468                       endif      ! flag=1 signals it                       endif    
469                    endif                    endif
470                    if(lstop.eq.0) then  
471                      if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
472    
473                      if(lstop.eq.0) then !if left cluster border has not been reached
474                       if(value(il).gt.clinclcut(il)) then                       if(value(il).gt.clinclcut(il)) then
475                          lmax=il                          lmax=il !include a strip on the left
476                       else                       else
477                          lstop=1                          lstop=1 !cluster left end
478                       endif                       endif
479                    endif                    endif
480    
481    c                  if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
482    
483                 enddo            !ends strip inclusion loop                 enddo            !ends strip inclusion loop
484                   goto 211
485   210           continue         !jumps here if more than nclstrp have been included   210           continue         !jumps here if more than nclstrp have been included
486                        c               print*,'>>> nclstrp! '
487                 multtemp=rmax-lmax+1 !stores multiplicity in temp   211           continue
488                                  ! variable. NB rmax and lmax can change later in  c-----------------------------------------
489                                  ! order to include enough strips to calculate eta3  c     end of inclusion loop!
490                                  ! and eta4. so mult is not always equal to cllength  c-----------------------------------------
491  c------------------------------------------------------------------------                
 c     NB per essere sicuro di poter calcolare eta3 e eta4 devo includere  
 c     sempre e comunque le 2 strip adiacenti al cluster seed e quella  
 c     adiacente ulteriore dalla parte della piu' alta fra queste due  
 c     (vedi oltre...)!???  
 c------------------------------------------------------------------------  
   
 c     nel caso di estremi del ladder...!???  
   
 c     ho meno di 4 strip nel cluster --> se sono sui bordi o quasi del ladder  
 c     costruisco il cluster ad hoc e poi esco, se non sono sui bordi o quasi  
 c     vado oltre (aggiungero' quindi strip a sx e dx in modo da poter calcolare  
 c     eta3e4)  
                if((rmax-lmax+1).lt.4) then  
   
                   if(iseed.eq.first) then !estremi...  
                      rmax=iseed+2 !NB in questo modo puo' anche capitare di  
                      lmax=iseed ! includere strip sotto taglio di inclusione  
                      goto 250   ! che non serviranno per eta3e4!???  
                   endif  
                     
                   if(iseed.eq.last) then !estremi...  
                      rmax=iseed  
                      lmax=iseed-2 !NB 2 e non 3, perche' altrimenti sarei in  
                      goto 250   ! ((rmax-lmax+1).lt.4).eq.false. !???  
                   endif         !NMB questo e' l'unico caso di cllength=3!???  
                     
                   if(iseed.eq.first+1) then !quasi estremi...  
                      rmax=iseed+2  
                      lmax=iseed-1  
                      goto 250  
                   endif  
                   if(iseed.eq.last-1) then  
                      rmax=iseed+1  
                      lmax=iseed-2  
                      goto 250  
                   endif  
 c     se ho 4 o piu' strip --> se sono sui bordi esco, se sono sui quasi bordi  
 c     includo la strip del bordo  
                else  
                     
                   if(iseed.eq.first) goto 250 !estremi... non includo altro                    
                   if(iseed.eq.last) goto 250  
                   if(iseed.eq.first+1) then !quasi estremi... mi assicuro di  
                      lmax=first ! avere le strip adiacenti al seed  
                      if((rmax-lmax+1).gt.nclstrp) rmax=rmax-1 !NB effetto  
                      goto 250   ! coperta: se la lunghezza del cluster era gia'  
                   endif         ! al limite (nclstrp), per poter aggiungere questa  
                                 ! strip a sinistra devo toglierne una a destra...!???  
                   if(iseed.eq.last-1) then  
                      rmax=last  
                      if((rmax-lmax+1).gt.nclstrp) lmax=lmax+1  
                      goto 250  
                   endif                    
                endif  
492  c------------------------------------------------------------------------  c------------------------------------------------------------------------
493  c     be sure to include in the cluster the cluster seed with its 2 adjacent  c     adjust the cluster in order to have at least a strip around the seed
494  c     strips, and the one adjacent to the greatest between this two strip, as the  c------------------------------------------------------------------------
495  c     fourth one. if the strips have the same value (!) the fourth one is chosen                 if(iseed.eq.lmax.and.lmax.ne.first)then
496  c     as the one having the greatest value between the second neighbors                    lmax = lmax-1
497  c------------------------------------------------------------------------                    if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
498                 if(value(iseed+1).eq.value(iseed-1)) then                 endif
499                    if(value(iseed+2).ge.value(iseed-2)) then !??? qui cmq c'e'                 if(iseed.eq.rmax.and.rmax.ne.last )then
500                       diff=(iseed+2)-rmax                    rmax = rmax+1
501                       if(diff.gt.0) then                    if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
                         rmax=rmax+diff  
                         if((rmax-lmax+1).gt.nclstrp) then  
                            lmax=rmax-nclstrp+1  
                         endif  
                      endif  
                      diff=(iseed-1)-lmax  
                      if(diff.lt.0) then  
                         lmax=lmax+diff  
                         if((rmax-lmax+1).gt.nclstrp) then  
                            rmax=lmax+nclstrp-1  
                         endif  
                      endif  
                   else  
                      diff=(iseed-2)-lmax  
                      if(diff.lt.0) then  
                         lmax=lmax+diff  
                         if((rmax-lmax+1).gt.nclstrp) then  
                            rmax=lmax+nclstrp-1  
                         endif  
                      endif  
                      diff=(iseed+1)-rmax  
                      if(diff.gt.0) then  
                         rmax=rmax+diff  
                         if((rmax-lmax+1).gt.nclstrp) then  
                            lmax=rmax-nclstrp+1  
                         endif  
                      endif  
                       
                   endif  
                elseif(value(iseed+1).gt.value(iseed-1)) then  
 c     !??? sposto il limite del cluster a destra per includere sempre le strip  
 c     necessarie al calcolo di eta-i  
 c     se il cluster diventa  troppo lungo lo accorcio a sinistra per avere non piu'  
 c     di nclstrp (in questo caso sono sicuro di aver gia' incluso le strip  
 c     necessarie al calcolo di eta-i a sinistra, quindi se voglio posso uscire)  
                   diff=(iseed+2)-rmax  
                   if(diff.gt.0) then  
                      rmax=rmax+diff  
                      if((rmax-lmax+1).gt.nclstrp) then  
                         lmax=rmax-nclstrp+1  
 c     goto 250  
                      endif  
                   endif  
                   diff=(iseed-1)-lmax  
                   if(diff.lt.0) then  
                      lmax=lmax+diff  
                      if((rmax-lmax+1).gt.nclstrp) then  
                         rmax=lmax+nclstrp-1  
 c     goto 250 !inutile!???  
                      endif  
                   endif  
                else  
                   diff=(iseed-2)-lmax  
                   if(diff.lt.0) then  
                      lmax=lmax+diff  
                      if((rmax-lmax+1).gt.nclstrp) then  
                         rmax=lmax+nclstrp-1  
 c     goto 250  
                      endif  
                   endif  
                   diff=(iseed+1)-rmax  
                   if(diff.gt.0) then  
                      rmax=rmax+diff  
                      if((rmax-lmax+1).gt.nclstrp) then  
                         lmax=rmax-nclstrp+1  
 c     goto 250 !inutile!???  
                      endif  
                   endif  
502                 endif                 endif
503   250           continue  c-------------------------------------------------------------------------------
504    c     adjust the cluster in order to have at least ANOTHER strip around the seed
505    c-------------------------------------------------------------------------------
506    c$$$               if(iseed-1.eq.lmax.and.lmax.ne.first)then
507    c$$$                  lmax = lmax-1
508    c$$$                  if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
509    c$$$               endif
510    c$$$               if(iseed+1.eq.rmax.and.rmax.ne.last )then
511    c$$$                  rmax = rmax+1
512    c$$$                  if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
513    c$$$               endif
514    c---------------------------------------------------
515    c     now we have 5 stored-strips around the maximum
516    c---------------------------------------------------
517    
518    c------------------------------------------------------------------------
519    c     adjust the cluster in order to store a minimum number of strips
520    c------------------------------------------------------------------------
521                   do while( (rmax-lmax+1).lt.nclstrpmin )
522    
523                      vl = -99999
524                      vr = -99999
525                      if(lmax-1.ge.first) vl = value(lmax-1)
526                      if(rmax+1.le.last ) vr = value(rmax+1)
527                      if(vr.ge.vl) then
528                         rmax = rmax+1
529                      else  
530                         lmax = lmax-1
531                      endif
532                      
533                   enddo
534    
535  c--------------------------------------------------------  c--------------------------------------------------------
536  c     fills ntuple variables  c     store cluster info
537  c--------------------------------------------------------  c--------------------------------------------------------
538                 nclstr1=nclstr1+1 !cluster number                 nclstr_view = nclstr_view + 1 !cluster number
539  ccc               print*,nclstr1,multtemp  
540                 if(nclstr1.gt.nclstrmax) then !too many clusters for the event:                 if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view:
541                    good1=0       ! event  c$$$                  if(verbose) print*,'Event ',eventn(1),
542                    nclstr1=0  c$$$     $                 ': more than ',nclstrmax_view
543                    totCLlength=0  c$$$     $                 ,' clusters on view ',iv
544                    flag_shower = .true.                    flag_shower = .true.
                   print*,'Event ',eventn(1),  
      $                 ': more than ',nclstrmax,' clusters'  
545                    goto 2000                    goto 2000
546                 endif                 endif
547                 view(nclstr1)=iv !vista del cluster  
548                 ladder(nclstr1)=nld(iseed,iv) !ladder a cui appartiene il cluster seed                 ladder_view(nclstr_view) = nld(iseed,iv)
549                 maxs(nclstr1)=iseed !strip del cluster seed                 maxs_view(nclstr_view)   = iseed
550                 mult(nclstr1)=multtemp !molteplicita'                 mult_view(nclstr_view)   = rmax-lmax+1
551                                 rmax_view(nclstr_view)   = rmax
552                 indstart(nclstr1)=ind !posizione dell'inizio del cluster nell'                 lmax_view(nclstr_view)   = lmax
553                                  ! array clsignal  
554                 indmax(nclstr1)=indstart(nclstr1)+(iseed-lmax) !posizione del  c$$$               if(rmax-lmax+1.gt.25)
555                                  ! cluster seed nell'array clsignal  c$$$     $              print*,'view ',iv
556    c$$$     $              ,' cl ',nclstr_view,' mult ',rmax-lmax+1
557    c------------------------------------------------------------------------
558    c     search for a double peak inside the cluster                                                                                                            
559    c------------------------------------------------------------------------
560                   inext = rmax+1   !<< index where to start new-cluster search
561                                
562                 CLlength=rmax-lmax+1 !numero di strip del cluster                 vmax = 0
563                 totCLlength=totCLlength+CLlength                 vmin = value(iseed)
564                 dedx(nclstr1)=0                 imax = iseed
565                 do j=lmax,rmax   !stores sequentially cluter strip values in                 imin = iseed
566                    clsignal(ind)=value(j) ! clsignal array                 do iss = max(iseed+1,lsat+1),rmax
567                    ind=ind+1                    if( value(iss).lt.vmin )then
568  c                  if(value(j).gt.0)                       if( imax.ne.iseed )goto 221 !found dowble peek
569                    if(value(j).gt.clinclcut(j))                       imin = iss
570       $                 dedx(nclstr1)=dedx(nclstr1)+value(j) !cluster charge                       vmin = value(iss)
571                      else
572                         delta = value(iss) - value(imin)
573                         cut = sqrt(clinclcut(iss)**2 + clinclcut(imin)**2)
574                         if(
575         $                    delta.gt.cut .and.
576         $                    value(iss).gt.clseedcut(iss).and.
577         $                    .true.)then
578                            if( value(iss).gt.vmax )then                        
579                               imax = iss
580                               vmax = value(iss)
581                            else
582                               goto 221 !found dowble peek
583                            endif
584                         endif
585                      endif
586                 enddo                 enddo
587     221           continue
588                  
589                   if(imax.gt.iseed)then
590                      inext = imax    !<< index where to start new-cluster search
591    c$$$                  print*,'--- double peek ---'
592    c$$$                  print*,(value(ii),ii=lmax,rmax)
593    c$$$                  print*,'seed ',iseed,' imin ',imin,' imax ',imax
594                   endif
595  c--------------------------------------------------------  c--------------------------------------------------------
596  c      c
597  c--------------------------------------------------------  c--------------------------------------------------------
598              endif               !end possible seed conditio              endif               !end possible seed conditio
599   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 613  c---------------------------------------
613  *  *
614  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
615    
616          subroutine save_cluster(iv)
       subroutine stripmask  
   
 *     this routine set va1 and single-strip masks,  
 *     on the basis of the VA1 mask saved in the DB  
 *  
 *     mask(nviews,nva1_view,nstrips_va1) !strip mask  
 *     mask_vk(nviews,nva1_view)          !VA1 mask  
617  *  *
618    *     (080/2006 Elena Vannuccini)
619    *     Save the clusters view by view
620    
621        include 'commontracker.f'        include 'commontracker.f'
622        include 'level1.f'        include 'level1.f'
623        include 'calib.f'        include 'calib.f'
624          include 'common_reduction.f'
625    
626  c$$$      character*20 data_file        integer CLlength          !lunghezza in strip del cluster
627  c$$$  
628  c$$$      character*3 aid        do ic=1,nclstr_view
629  c$$$      character*6 adate  
630  c$$$      integer id           nclstr1 = nclstr1+1
631  c$$$      integer date           view(nclstr1)   = iv
632  c$$$           ladder(nclstr1) = ladder_view(ic)
633  c$$$*     ----------------------           maxs(nclstr1)   = maxs_view(ic)
634  c$$$*     retrieve date and id           mult(nclstr1)   = mult_view(ic)
635  c$$$      aid=data_file(8:10)                
636  c$$$      adate=data_file(2:6)  c        posizione dell'inizio del cluster nell' array clsignal
637  c$$$      READ (aid, '(I3)'), id           indstart(nclstr1) = ind
638  c$$$      READ (adate, '(I6)'), date  c        posizione del cluster seed nell'array clsignal
639  c$$$*     ----------------------           indmax(nclstr1)   = indstart(nclstr1)
640           $        +( maxs_view(ic) - lmax_view(ic) )
641  *     init mask          
642        do iv=1,nviews           CLlength      = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate
643           do ivk=1,nva1_view           totCLlength   = totCLlength + CLlength
644              do is=1,nstrips_va1           sgnl(nclstr1) = 0
645                 mask(iv,ivk,is) = mask_vk(iv,ivk)           do j=lmax_view(ic),rmax_view(ic)         !stores sequentially cluter strip values in
646              enddo  
647                clsignal(ind) = value(j) ! clsignal array
648    c$$$            print*,ind,clsignal(ind)
649                ivk=nvk(j)
650                ist=nst(j)
651    
652                clsigma(ind) = sigma(iv,ivk,ist)
653                cladc(ind)   = adc(iv,ivk,ist)
654                clbad(ind)   = bad(iv,ivk,ist)
655    c            clped(ind)   = pedestal(iv,ivk,ist)
656    
657                ind=ind+1
658    c     if(value(j).gt.0)
659                if(value(j).gt.clinclcut(j))
660         $           sgnl(nclstr1) = sgnl(nclstr1) + value(j) !cluster charge
661           enddo           enddo
662    
663    c$$$         print*,'view ',iv,' -- save_cluster -- nclstr1: '
664    c$$$     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),sgnl(nclstr1)
665    c$$$         print*,'----------------------'
666    
667        enddo        enddo
668          
669          return
670          end
671    *---***---***---***---***---***---***---***---***
672    *
673    *
674    *
675    *
676    *
677    *---***---***---***---***---***---***---***---***
678    
679  c$$$*     ---------------------  
680  c$$$*     VIEW 2 - VK 23-24  c$$$      subroutine stripmask
 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  
681  c$$$  c$$$
682  c$$$*     ---------------------  c$$$*     this routine set va1 and single-strip masks,
683  c$$$*     VIEW 7 - VK 21-22  c$$$*     on the basis of the VA1 mask saved in the DB
684  c$$$      if(date.ge.50316)then  c$$$*
685  c$$$cc         print*,'MASK: view 7 - vk 21/22'  c$$$*     mask(nviews,nva1_view,nstrips_va1) !strip mask
686  c$$$         mask_vk(7,21)=0  c$$$*     mask_vk(nviews,nva1_view)          !VA1 mask
687  c$$$         mask_vk(7,22)=0  c$$$*
688  c$$$         do is=1,nstrips_va1  c$$$      include 'commontracker.f'
689  c$$$            mask(7,21,is)=0  c$$$      include 'level1.f'
690  c$$$            mask(7,22,is)=0  c$$$      include 'common_reduction.f'
691    c$$$      include 'calib.f'
692    c$$$
693    c$$$*     init mask
694    c$$$      do iv=1,nviews
695    c$$$         do ivk=1,nva1_view
696    c$$$            do is=1,nstrips_va1
697    c$$$c               mask(iv,ivk,is) = mask_vk(iv,ivk)
698    c$$$               if( mask_vk(iv,ivk) .ne. -1)then
699    c$$$                  mask(iv,ivk,is) = 1
700    c$$$     $                 * mask_vk(iv,ivk)     !from DB
701    c$$$     $                 * mask_vk_ev(iv,ivk)  !from <SIG>
702    c$$$     $                 * mask_vk_run(iv,ivk) !from CN
703    c$$$               else
704    c$$$                  mask(iv,ivk,is) = -1
705    c$$$     $                 * mask_vk(iv,ivk)     !from DB
706    c$$$     $                 * mask_vk_ev(iv,ivk)  !from CN
707    c$$$               endif
708    c$$$            enddo
709  c$$$         enddo  c$$$         enddo
710  c$$$      endif  c$$$      enddo
 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  
711  c$$$  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  
712  c$$$  c$$$
713  c$$$*     ---------------------  c$$$      return
714  c$$$*     VIEW 12 - VK 7-8  c$$$      end
715  c$$$      if(date.ge.50523)then  
716  c$$$        if(.not.(date.eq.50523.and.id.le.3)) then        subroutine stripmask(iv,ivk)
 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  
717    
718    *     -----------------------------------------------
719    *     this routine set va1 and single-strip masks,
720    *     on the basis of the VA1 mask saved in the DB
721    *
722    *     mask(nviews,nva1_view,nstrips_va1) !strip mask
723    *     mask_vk(nviews,nva1_view)          !VA1 mask
724    *     -----------------------------------------------
725          include 'commontracker.f'
726          include 'level1.f'
727          include 'common_reduction.f'
728          include 'calib.f'
729    
730    *     init mask
731          do is=1,nstrips_va1
732    *        --------------------------------------------------------
733    *        if VA1-mask from DB is 0 or 1, three masks are combined:
734    *        - from DB (a-priori mask)
735    *        - run-based (chip declared bad on the basis of <SIG>)
736    *        - event-based (failure in CN computation)
737    *        --------------------------------------------------------
738    c         print*,iv,ivk
739    c     $        ,mask_vk(iv,ivk),mask_vk_ev(iv,ivk),mask_vk_run(iv,ivk)
740             if( mask_vk(iv,ivk) .ne. -1)then            
741                mask(iv,ivk,is) = 1
742         $           * mask_vk(iv,ivk)     !from DB
743         $           * mask_vk_ev(iv,ivk)  !from <SIG>
744         $           * mask_vk_run(iv,ivk) !from CN
745    *        -----------------------------------------------------------
746    *        if VA1-mask from DB is -1 only event-based mask is applied
747    *        -----------------------------------------------------------
748             else
749                mask(iv,ivk,is) = -1
750         $           * mask_vk(iv,ivk)     !from DB
751         $           * mask_vk_ev(iv,ivk)  !from CN
752             endif
753          enddo
754          
755          
756        return        return
757        end        end
   

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

  ViewVC Help
Powered by ViewVC 1.1.23