/[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.27 by pam-fi, Fri Dec 5 08:26:48 2008 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  
173            cn(iv,ik)=0           !initializes cn variable           call evaluatecn(iv)
174            if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik)  c$$$         ima=0
175          enddo  c$$$         do ik=1,nva1_view
176    c$$$            cn(iv,ik)    = 0
177    c$$$            cnrms(iv,ik) = 0
178    c$$$            cnn(iv,ik)   = -1
179    c$$$            iflag = 0
180    c$$$            mask_vk_ev(iv,ik) = 1
181    c$$$            call stripmask(iv,ik)      !compute mask(i,j,k), combining VA1-masks
182    c$$$*           --------------------------------------
183    c$$$*           if chip is not masked ---> evaluate CN
184    c$$$*           --------------------------------------
185    c$$$            if( mask(iv,ik,1).eq.1 ) then !!!NBNB mask per la striscia 1 !!!!!!!!
186    c$$$               call cncomp(iv,ik,iflag)
187    c$$$               if(iflag.ne.0)then
188    c$$$                  ima=ima+1
189    c$$$                  mask_vk_ev(iv,ik)=0
190    c$$$                  ierror = 220
191    c$$$               endif
192    c$$$               call stripmask(iv,ik) !compute mask(i,j,k), combining VA1-masks
193    c$$$            endif
194    c$$$         enddo
195    c$$$ 100     format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
196    c$$$         if(ima.ne.0.and.verbose.eq.1)write(*,100)eventn(1),iv
197    c$$$     $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
198    
199        enddo        enddo
200    
201    cc      call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
202    
203  c---------------------------------------------  c---------------------------------------------
204  c     loops on views, VA1 and strips,  c     loops on views, VA1 and strips,
# Line 67  c     and computes strips signals using Line 206  c     and computes strips signals using
206  c     badstrip, pedestals, and  c     badstrip, pedestals, and
207  c     sigma informations from histograms  c     sigma informations from histograms
208  c---------------------------------------------  c---------------------------------------------
       flag_shower = .false.  
209        ind=1                     !clsignal array index        ind=1                     !clsignal array index
210    
211          if(debug.eq.1)print*,'-- search clusters'
212        do iv=1,nviews            !loop on views        do iv=1,nviews            !loop on views
213          do is=1,nstrips_view    !loop on strips (1)  c$$$        do is=1,nstrips_view    !loop on strips (1)
214            if(mod(iv,2).eq.1) then  c$$$          if(mod(iv,2).eq.1) then
215  C===  > Y view  c$$$C===  > Y view
216              value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))  c$$$c             print*,iv,nvk(is),nst(is),adc(iv,nvk(is),nst(is))
217       $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))  c$$$c     $            ,cn(iv,nvk(is))
218       $           *mask(iv,nvk(is),nst(is))  c$$$c     $            ,pedestal(iv,nvk(is),nst(is))
219              clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is))  c$$$            value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))
220       $           *mask(iv,nvk(is),nst(is))  c$$$     $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
221              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))  c$$$     $           *mask(iv,nvk(is),nst(is))
222       $           *mask(iv,nvk(is),nst(is))  c$$$            clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is))
223  ccc            print*,"value(",is,")(reduction)= ",value(is)  c$$$     $           *mask(iv,nvk(is),nst(is))
224            else              c$$$            clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
225  C===  > X view  c$$$     $           *mask(iv,nvk(is),nst(is))
226              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))  c$$$            sat(is)=0
227       $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))  c$$$            if( adc(iv,nvk(is),nst(is)).lt.adc_saty )sat(is)=1
228       $           *mask(iv,nvk(is),nst(is))  c$$$          else            
229              clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is))  c$$$C===  > X view
230       $           *mask(iv,nvk(is),nst(is))  c$$$            value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
231              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))  c$$$     $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
232       $           *mask(iv,nvk(is),nst(is))  c$$$     $           *mask(iv,nvk(is),nst(is))
233            endif  c$$$            clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is))
234          enddo                   !end loop on strips (1)  c$$$     $           *mask(iv,nvk(is),nst(is))
235          call search_cluster(iv)  c$$$            clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
236          if(flag_shower.eqv..true.)then  c$$$     $           *mask(iv,nvk(is),nst(is))
237            call init_level1                c$$$            sat(is)=0
238            good1=0  c$$$            if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1
239            goto 200              !jump to next event  c$$$          endif
240          endif  c$$$        enddo                   !end loop on strips (1)
241             call subtractped(iv)
242             call searchcluster(iv)
243    
244             if(.not.flag_shower)then
245                call savecluster(iv)
246                if(debug.eq.1)print*,'view ',iv,' #clusters ', nclstr_view
247             else
248                fshower(iv) = 1
249    c     GOOD1(DSPnumber(iv)) = 11 !AHAHAHAHA ORRORE!!
250    c     GOOD1(iv) = 11
251    c     GOOD1(iv) = GOOD1(iv) + 2**5
252                GOOD1(iv) = ior(GOOD1(iv),2**5)
253     101        format(' * WARNING * Event ',i7,' view',i3
254         $           ,' #clusters > ',i5,' --> MASKED')
255                if(verbose.eq.1)write(*,101)eventn(1),iv,nclstrmax_view
256             endif
257        enddo                     ! end loop on views        enddo                     ! end loop on views
258        do iv=1,nviews        do iv=1,nviews
259          do ik=1,nva1_view           do ik=1,nva1_view
260            cnev(iv,ik)=cn(iv,ik) !assigns computed CN to ntuple variables              cnev(iv,ik)    = cn(iv,ik) !assigns computed CN to ntuple variables
261  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)              cnrmsev(iv,ik) = cnrms(iv,ik) !assigns computed CN to ntuple variables
262          enddo              cnnev(iv,ik)   = cnn(iv,ik) !assigns computed CN to ntuple variables
263             enddo
264        enddo        enddo
 c$$$      nevent_good = nevent_good + 1  
         
265  C---------------------------------------------  C---------------------------------------------
266  C     come here if GOOD1=0  C     come here if GOOD1=0
267  C     or the event has too many clusters  C     or the event has too many clusters
268  C---------------------------------------------  C---------------------------------------------
   
269   200  continue   200  continue
270  ccc      print*,'nclstr1(reduction)=',nclstr1  
271          ngood = 0
272          do iv = 1,nviews
273             ngood = ngood + good1(iv)
274          enddo
275          if(verbose.eq.1.and.ngood.ne.0)
276         $     print*,'* WARNING * Event ',eventn(1)
277         $     ,':LEVEL1 event status: '
278         $     ,(good1(i),i=1,nviews)
279  c------------------------------------------------------------------------  c------------------------------------------------------------------------
280  c      c
281  c     closes files and exits  c     closes files and exits
282  c      c
283  c------------------------------------------------------------------------  c------------------------------------------------------------------------
284                      RETURN
285        RETURN                          END
       END                        
286    
287  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
288  *  *
# Line 142  c--------------------------------------- Line 303  c---------------------------------------
303        include 'level1.f'        include 'level1.f'
304        include 'level0.f'        include 'level0.f'
305    
306        good1=0  c      good1 = 0
307        nclstr1=0        do iv=1,12
308        totCLlength=0           good1(iv) = 1 !missing packet
309          enddo
310          nclstr1 = 0
311          totCLlength = 0
312        do ic=1,nclstrmax        do ic=1,nclstrmax
313           view(ic)=0           view(ic) = 0
314           ladder(ic)=0           ladder(ic) = 0
315           indstart(ic)=0           indstart(ic) = 0
316           indmax(ic)=0           indmax(ic) = 0
317           maxs(ic)=0           maxs(ic) = 0
318           mult(ic)=0                     mult(ic) = 0          
319           dedx(ic)=0           sgnl(ic) = 0
320             whichtrack(ic) = 0     !assigned @ level2
321    
322        enddo        enddo
323        do id=1,maxlength         !???        do id=1,maxlength         !???
324           clsignal(id)=0.           clsignal(id) = 0.
325             clsigma(id)  = 0.
326             cladc(id)    = 0.
327             clbad(id)    = 0.
328        enddo        enddo
329        do iv=1,nviews        do iv=1,nviews
330  c        crc1(iv)=0  c        crc1(iv)=0
331          do ik=1,nva1_view          do ik=1,nva1_view
332            cnev(iv,ik)=0            cnev(iv,ik) = 0
333              cnnev(iv,ik) = 0
334          enddo          enddo
335            fshower(iv) = 0
336        enddo        enddo
337                
338        return        return
339        end        end
340    
341  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
342  *  *
343  *  *
# Line 174  c        crc1(iv)=0 Line 346  c        crc1(iv)=0
346  *  *
347  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
348    
349        subroutine search_cluster(iv)        subroutine searchcluster(iv)
350    
351        include 'commontracker.f'        include 'commontracker.f'
       include 'common_reduction.f'  
352        include 'level0.f'        include 'level0.f'
353        include 'level1.f'        include 'level1.f'
354        include 'calib.f'        include 'calib.f'
355    
356          include 'common_reduction.f'
357            
358    
359  c     local variables  c     local variables
360        integer rmax,lmax         !estremi del cluster        integer rmax,lmax         !estremi del cluster
361        integer rstop,lstop       !per decidere quali strip includere nel cluster        integer rstop,lstop      
362                                  ! oltre il seed        integer first,last
363        integer first,last,diff   !per includere le strip giuste... !???        integer fsat,lsat
364    
365        integer multtemp          !temporary multiplicity variable        external nst
366    
367        integer CLlength          !lunghezza in strip del cluster        iseed=-999                !cluster seed index initialization
368    
369        external nst        inext=-999                !index where to start new cluster search
370    
371  c------------------------------------------------------------------------        flag_shower = .false.
372  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)  
373    
374        iseed=-999                !cluster seed index initialization        do jl=1,nladders_view              !1..3 !loops on ladders
375    
376             first = 1+nstrips_ladder*(jl-1) !1,1025,2049
377             last  = nstrips_ladder*jl       !1024,2048,3072
378    
379        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  
380           if(mod(iv,2).eq.0) then           if(mod(iv,2).eq.0) then
381              first=first+3              first=first+3
382              last=last-3              last=last-3
383           endif           endif
384    
385           do is=first,last       !loop on strips in each ladder           do is=first,last       !loop on strips in each ladder
386              if(is.le.iseed+1) goto 220  
387  c-----------------------------------------  c---------------------------------------------
388  c     after a cluster seed as been found,  c     new-cluster search starts at index inext
389  c     look for next one skipping one strip on the right  c---------------------------------------------
390  c     (i.e. look for double peak cluster)              if(is.lt.inext) goto 220 ! next strip
391  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-----------------------------------------  
392              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)  
393  c-----------------------------------------  c-----------------------------------------
394  c     possible SEED...  c     possible SEED...
395  c-----------------------------------------  c-----------------------------------------
396                 itemp=is                 itemp = is
397                   fsat = 0         ! first saturated strip
398                   lsat = 0         ! last saturated strip
399                 if(itemp.eq.last) goto 230 !estremo...                 if(itemp.eq.last) goto 230 !estremo...
400                 do while(value(itemp)  c              ------------------------                
401       $              /sigma(iv,nvk(itemp),nst(itemp))  c              search for first maximum
402       $              .le.value(itemp+1)  c              ------------------------
403       $              /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???                 do while(
404                    itemp=itemp+1       $                   value(itemp).le.value(itemp+1)
405                    if(itemp.eq.last) goto 230 !stops if reaches last strip       $              .and.value(itemp+1).gt.clseedcut(itemp+1))
406                      itemp = itemp+1
407                      if(itemp.eq.last)   goto 230 !stops if reaches last strip
408                      if(sat(itemp).eq.1) goto 230 !stop if reaches a saturated strip
409                 enddo            ! of the ladder                 enddo            ! of the ladder
410   230           continue   230           continue
411  c-----------------------------------------  c              -----------------------------
412    c              check if strips are saturated
413    c              -----------------------------    
414                   if( sat(itemp).eq.1 )then
415                      fsat = itemp
416                      lsat = itemp
417                      if(itemp.eq.last) goto 231 !estremo...
418                      do while( sat(itemp+1).eq.1 )
419                         itemp = itemp+1
420                         lsat = itemp
421                         if(itemp.eq.last)   goto 231 !stops if reaches last strip
422                      enddo                  
423                   endif
424     231           continue
425    c---------------------------------------------------------------------------
426  c     fownd SEED!!!  c     fownd SEED!!!
427  c-----------------------------------------  c     (if there are saturated strips, the cluster is centered in the middle)
428                 iseed=itemp      c---------------------------------------------------------------------------
429  c----------------------------------------------------------                 if(fsat.eq.0.and.lsat.eq.0)then
430                      iseed = itemp ! <<< SEED
431                   else
432                      iseed = int((lsat+fsat)/2) ! <<< SEED
433    c$$$                  print*,'saturated strips ',fsat,lsat,iseed
434    c$$$                  print*,'--> ',(value(ii),ii=fsat,lsat)
435                   endif    
436    c---------------------------------------------------------------
437  c     after finding a cluster seed, checks also adjacent strips,  c     after finding a cluster seed, checks also adjacent strips,
438  C     and marks the ones exceeding clinclcut  C     and tags the ones exceeding clinclcut
439  c----------------------------------------------------------  c---------------------------------------------------------------
440                 ir=iseed         !indici destro                 ir=iseed         !indici destro
441                 il=iseed         ! e sinistro                 il=iseed         ! e sinistro
442                                
# Line 282  c--------------------------------------- Line 447  c---------------------------------------
447                 lstop=0          ! inclusion loop                 lstop=0          ! inclusion loop
448    
449                 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
450                    ir=ir+1       !position index for strips on right side of  
451                                  ! cluster seed  
452                    il=il-1       !and for left side                    ir=ir+1       !index for right side
453                      il=il-1       !index for left side
454  c------------------------------------------------------------------------  c------------------------------------------------------------------------
455  c     checks for last or first strip of the ladder  c     checks for last or first strip of the ladder
456  c------------------------------------------------------------------------  c------------------------------------------------------------------------
457                    if(ir.gt.last) then !when index goes beyond last strip                    if( ir.gt.last  ) rstop = 1                      
458                       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  
459                                        
460  c------------------------------------------------------------------------  c------------------------------------------------------------------------
461  c     check for clusters including more than nclstrp strips  c     add strips exceeding inclusion cut
 c------------------------------------------------------------------------  
                   if((rmax-lmax+1).ge.nclstrp) then  
                      goto 210   !exits inclusion loop:  
                                 ! lmax and rmax maintain last value  
                                 ! NB .ge.!???  
                   endif  
 c------------------------------------------------------------------------  
 c     marks strips exceeding inclusion cut  
462  c------------------------------------------------------------------------  c------------------------------------------------------------------------
463                    if(rstop.eq.0) then !if last strip of the ladder or last                    if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
464                                  ! over-cut strip has not been reached  
465                       if(value(ir).gt.clinclcut(ir)) then !puts in rmax the                    if(rstop.eq.0) then !if right cluster border has not been reached
466                          rmax=ir ! last right over-cut strip                       if(value(ir).gt.clinclcut(ir)) then
467                            rmax=ir !include a strip on the right
468                       else                       else
469                          rstop=1 !otherwise cluster ends on right and rstop                          rstop=1 !cluster right end
470                       endif      ! flag=1 signals it                       endif    
471                    endif                    endif
472                    if(lstop.eq.0) then  
473                      if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
474    
475                      if(lstop.eq.0) then !if left cluster border has not been reached
476                       if(value(il).gt.clinclcut(il)) then                       if(value(il).gt.clinclcut(il)) then
477                          lmax=il                          lmax=il !include a strip on the left
478                       else                       else
479                          lstop=1                          lstop=1 !cluster left end
480                       endif                       endif
481                    endif                    endif
482    
483    c                  if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
484    
485                 enddo            !ends strip inclusion loop                 enddo            !ends strip inclusion loop
486                   goto 211
487   210           continue         !jumps here if more than nclstrp have been included   210           continue         !jumps here if more than nclstrp have been included
488                        c               print*,'>>> nclstrp! '
489                 multtemp=rmax-lmax+1 !stores multiplicity in temp   211           continue
490                                  ! variable. NB rmax and lmax can change later in  c-----------------------------------------
491                                  ! order to include enough strips to calculate eta3  c     end of inclusion loop!
492                                  ! and eta4. so mult is not always equal to cllength  c-----------------------------------------
493  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  
494  c------------------------------------------------------------------------  c------------------------------------------------------------------------
495  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
496  c     strips, and the one adjacent to the greatest between this two strip, as the  c------------------------------------------------------------------------
497  c     fourth one. if the strips have the same value (!) the fourth one is chosen                 if(iseed.eq.lmax.and.lmax.ne.first)then
498  c     as the one having the greatest value between the second neighbors                    lmax = lmax-1
499  c------------------------------------------------------------------------                    if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
500                 if(value(iseed+1).eq.value(iseed-1)) then                 endif
501                    if(value(iseed+2).ge.value(iseed-2)) then !??? qui cmq c'e'                 if(iseed.eq.rmax.and.rmax.ne.last )then
502                       diff=(iseed+2)-rmax                    rmax = rmax+1
503                       if(diff.gt.0) then                    if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
504                          rmax=rmax+diff                 endif
505                          if((rmax-lmax+1).gt.nclstrp) then  c-------------------------------------------------------------------------------
506                             lmax=rmax-nclstrp+1  c     adjust the cluster in order to have at least ANOTHER strip around the seed
507                          endif  c-------------------------------------------------------------------------------
508                       endif                 if(iseed-1.eq.lmax.and.lmax.ne.first)then
509                       diff=(iseed-1)-lmax                    lmax = lmax-1
510                       if(diff.lt.0) then                    if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
511                          lmax=lmax+diff                 endif
512                          if((rmax-lmax+1).gt.nclstrp) then                 if(iseed+1.eq.rmax.and.rmax.ne.last )then
513                             rmax=lmax+nclstrp-1                    rmax = rmax+1
514                          endif                    if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
                      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  
515                 endif                 endif
516   250           continue  c---------------------------------------------------
517    c     now we have 5 stored-strips around the maximum
518    c---------------------------------------------------
519    
520    c------------------------------------------------------------------------
521    c     adjust the cluster in order to store a minimum number of strips
522    c------------------------------------------------------------------------
523                   do while( (rmax-lmax+1).lt.nclstrpmin )
524    
525                      vl = -99999
526                      vr = -99999
527                      if(lmax-1.ge.first) vl = value(lmax-1)
528                      if(rmax+1.le.last ) vr = value(rmax+1)
529                      if(vr.ge.vl) then
530                         rmax = rmax+1
531                      else  
532                         lmax = lmax-1
533                      endif
534                      
535                   enddo
536    
537  c--------------------------------------------------------  c--------------------------------------------------------
538  c     fills ntuple variables  c     store cluster info
539  c--------------------------------------------------------  c--------------------------------------------------------
540                 nclstr1=nclstr1+1 !cluster number                 nclstr_view = nclstr_view + 1 !cluster number
541  ccc               print*,nclstr1,multtemp  
542                 if(nclstr1.gt.nclstrmax) then !too many clusters for the event:                 if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view:
543                    good1=0       ! event  c$$$                  if(verbose) print*,'Event ',eventn(1),
544                    nclstr1=0  c$$$     $                 ': more than ',nclstrmax_view
545                    totCLlength=0  c$$$     $                 ,' clusters on view ',iv
546                    flag_shower = .true.                    flag_shower = .true.
                   print*,'Event ',eventn(1),  
      $                 ': more than ',nclstrmax,' clusters'  
547                    goto 2000                    goto 2000
548                 endif                 endif
549                 view(nclstr1)=iv !vista del cluster  
550                 ladder(nclstr1)=nld(iseed,iv) !ladder a cui appartiene il cluster seed                 ladder_view(nclstr_view) = nld(iseed,iv)
551                 maxs(nclstr1)=iseed !strip del cluster seed                 maxs_view(nclstr_view)   = iseed
552                 mult(nclstr1)=multtemp !molteplicita'                 rmax_view(nclstr_view)   = rmax
553                                 lmax_view(nclstr_view)   = lmax
554                 indstart(nclstr1)=ind !posizione dell'inizio del cluster nell'  c               mult_view(nclstr_view)   = rmax-lmax+1
555                                  ! array clsignal                 mult_view(nclstr_view)   = 0
556                 indmax(nclstr1)=indstart(nclstr1)+(iseed-lmax) !posizione del                 do ii=lmax,rmax
557                                  ! cluster seed nell'array clsignal                    if(value(ii).gt.clinclcut(ii))  
558         $                 mult_view(nclstr_view) = mult_view(nclstr_view)+1
559                   enddo
560    
561    
562    c$$$               if(rmax-lmax+1.gt.25)
563    c$$$     $              print*,'view ',iv
564    c$$$     $              ,' cl ',nclstr_view,' mult ',rmax-lmax+1
565    c------------------------------------------------------------------------
566    c     search for a double peak inside the cluster                                                                                                            
567    c------------------------------------------------------------------------
568                   inext = rmax+1   !<< index where to start new-cluster search
569                                
570                 CLlength=rmax-lmax+1 !numero di strip del cluster                 vmax = 0
571                 totCLlength=totCLlength+CLlength                 vmin = value(iseed)
572                 dedx(nclstr1)=0                 imax = iseed
573                 do j=lmax,rmax   !stores sequentially cluter strip values in                 imin = iseed
574                    clsignal(ind)=value(j) ! clsignal array                 do iss = max(iseed+1,lsat+1),rmax
575                    ind=ind+1                    if( value(iss).lt.vmin )then
576  c                  if(value(j).gt.0)                       if( imax.ne.iseed )goto 221 !found dowble peek
577                    if(value(j).gt.clinclcut(j))                       imin = iss
578       $                 dedx(nclstr1)=dedx(nclstr1)+value(j) !cluster charge                       vmin = value(iss)
579                      else
580                         delta = value(iss) - value(imin)
581                         cut = sqrt(clinclcut(iss)**2 + clinclcut(imin)**2)
582                         if(
583         $                    delta.gt.cut .and.
584         $                    value(iss).gt.clseedcut(iss).and.
585         $                    .true.)then
586                            if( value(iss).gt.vmax )then                        
587                               imax = iss
588                               vmax = value(iss)
589                            else
590                               goto 221 !found dowble peek
591                            endif
592                         endif
593                      endif
594                 enddo                 enddo
595     221           continue
596                  
597                   if(imax.gt.iseed)then
598                      inext = imax    !<< index where to start new-cluster search
599    c$$$                  print*,'--- double peek ---'
600    c$$$                  print*,(value(ii),ii=lmax,rmax)
601    c$$$                  print*,'seed ',iseed,' imin ',imin,' imax ',imax
602                   endif
603  c--------------------------------------------------------  c--------------------------------------------------------
604  c      c
605  c--------------------------------------------------------  c--------------------------------------------------------
606              endif               !end possible seed conditio              endif               !end possible seed conditio
607   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 621  c---------------------------------------
621  *  *
622  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
623    
624          subroutine savecluster(iv)
625    *
626    *     (080/2006 Elena Vannuccini)
627    *     Save the clusters view by view
628    
629        subroutine stripmask        include 'commontracker.f'
630          include 'level1.f'
631          include 'calib.f'
632          include 'common_reduction.f'
633    
634  *     this routine set va1 and single-strip masks,        integer CLlength          !lunghezza in strip del cluster
635  *     on the basis of the VA1 mask saved in the DB  
636          do ic=1,nclstr_view
637    
638             nclstr1 = nclstr1+1
639             view(nclstr1)   = iv
640             ladder(nclstr1) = ladder_view(ic)
641             maxs(nclstr1)   = maxs_view(ic)
642             mult(nclstr1)   = mult_view(ic)
643                  
644    c        posizione dell'inizio del cluster nell' array clsignal
645             indstart(nclstr1) = ind
646    c        posizione del cluster seed nell'array clsignal
647             indmax(nclstr1)   = indstart(nclstr1)
648         $        +( maxs_view(ic) - lmax_view(ic) )
649            
650             CLlength      = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate
651             totCLlength   = totCLlength + CLlength
652             sgnl(nclstr1) = 0
653             do j=lmax_view(ic),rmax_view(ic)         !stores sequentially cluter strip values in
654    
655                clsignal(ind) = value(j) ! clsignal array
656    c$$$            print*,ind,clsignal(ind)
657                ivk=nvk(j)
658                ist=nst(j)
659    
660                clsigma(ind) = sigma(iv,ivk,ist)
661                cladc(ind)   = adc(iv,ivk,ist)
662                clbad(ind)   = bad(iv,ivk,ist)
663    c            clped(ind)   = pedestal(iv,ivk,ist)
664    
665                ind=ind+1
666    c     if(value(j).gt.0)
667                if(value(j).gt.clinclcut(j))
668         $           sgnl(nclstr1) = sgnl(nclstr1) + value(j) !cluster charge
669             enddo
670    
671    c$$$         print*,'view ',iv,' -- savecluster -- nclstr1: '
672    c$$$     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),sgnl(nclstr1)
673    c$$$         print*,'----------------------'
674    
675          enddo
676          
677          return
678          end
679    *---***---***---***---***---***---***---***---***
680    *
681  *  *
 *     mask(nviews,nva1_view,nstrips_va1) !strip mask  
 *     mask_vk(nviews,nva1_view)          !VA1 mask  
682  *  *
683    *
684    *
685    *---***---***---***---***---***---***---***---***
686    
687          subroutine evaluatecn(iv)
688          
689        include 'commontracker.f'        include 'commontracker.f'
690          include 'level0.f'
691        include 'level1.f'        include 'level1.f'
692          include 'common_reduction.f'
693        include 'calib.f'        include 'calib.f'
694          
695  c$$$      character*20 data_file        ima=0
696  c$$$        do ik=1,nva1_view
697  c$$$      character*3 aid           cn(iv,ik)    = 0
698  c$$$      character*6 adate           cnrms(iv,ik) = 0
699  c$$$      integer id           cnn(iv,ik)   = -1
700  c$$$      integer date           iflag = 0
701  c$$$           mask_vk_ev(iv,ik) = 1
702  c$$$*     ----------------------           call stripmask(iv,ik)  !compute mask(i,j,k), combining VA1-masks
703  c$$$*     retrieve date and id  *     --------------------------------------
704  c$$$      aid=data_file(8:10)  *     if chip is not masked ---> evaluate CN
705  c$$$      adate=data_file(2:6)  *     --------------------------------------
706  c$$$      READ (aid, '(I3)'), id           if( mask(iv,ik,1).eq.1 ) then !!!NBNB mask per la striscia 1 !!!!!!!!
707  c$$$      READ (adate, '(I6)'), date              call cncomp(iv,ik,iflag)
708  c$$$*     ----------------------              if(iflag.ne.0)then
709                     ima=ima+1
710  *     init mask                 mask_vk_ev(iv,ik)=0
711        do iv=1,nviews                 ierror = 220
712           do ivk=1,nva1_view              endif
713              do is=1,nstrips_va1              call stripmask(iv,ik) !compute mask(i,j,k), combining VA1-masks
714                 mask(iv,ivk,is) = mask_vk(iv,ivk)           endif
             enddo  
          enddo  
715        enddo        enddo
716     100  format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
717          if(ima.ne.0.and.verbose.eq.1)write(*,100)eventn(1),iv
718         $     ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
719          
720          return
721          end
722    
723  c$$$*     ---------------------  *---***---***---***---***---***---***---***---***
724  c$$$*     VIEW 2 - VK 23-24  *
725  c$$$*     couple of vk damaged during integration  *
726  c$$$      if(date.ge.50208)then  *
727  c$$$cc         print*,'MASK: view 2 - vk 23/24'  *
728  c$$$         mask_vk(2,23)=0  *
729  c$$$         mask_vk(2,24)=0  *---***---***---***---***---***---***---***---***
730  c$$$         do is=1,nstrips_va1        subroutine subtractped(iv)
731  c$$$            mask(2,23,is)=0        
732  c$$$            mask(2,24,is)=0        include 'commontracker.f'
733  c$$$         enddo        include 'level1.f'
734  c$$$      endif        include 'calib.f'
735  c$$$        include 'common_reduction.f'
736  c$$$*     ---------------------  
737  c$$$*     VIEW 7 - VK 11-12        do is=1,nstrips_view      !loop on strips (1)
738  c$$$      if(date.ge.50209)then           if(mod(iv,2).eq.1) then
739  c$$$        if(.not.(date.eq.50209.and.id.le.6)) then  C===  > Y view
740  c$$$cc          print*,'MASK: view 7 - vk 11/12'  c     print*,iv,nvk(is),nst(is),adc(iv,nvk(is),nst(is))
741  c$$$          mask_vk(7,11)=0  c     $            ,cn(iv,nvk(is))
742  c$$$          mask_vk(7,12)=0  c     $            ,pedestal(iv,nvk(is),nst(is))
743  c$$$          do is=1,nstrips_va1              value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))
744  c$$$            mask(7,11,is)=0       $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
745  c$$$            mask(7,12,is)=0       $           *mask(iv,nvk(is),nst(is))
746  c$$$          enddo              clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is))
747  c$$$        endif       $           *mask(iv,nvk(is),nst(is))
748  c$$$      endif              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
749         $           *mask(iv,nvk(is),nst(is))
750                sat(is)=0
751                if( adc(iv,nvk(is),nst(is)).lt.adc_saty )sat(is)=1
752             else            
753    C===  > X view
754                value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
755         $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
756         $           *mask(iv,nvk(is),nst(is))
757                clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is))
758         $           *mask(iv,nvk(is),nst(is))
759                clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
760         $           *mask(iv,nvk(is),nst(is))
761                sat(is)=0
762                if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1
763             endif
764          enddo                     !end loop on strips (1)
765          
766          
767          return
768          end
769    *---***---***---***---***---***---***---***---***
770    *
771    *
772    *
773    *
774    *
775    *---***---***---***---***---***---***---***---***
776    c$$$      subroutine stripmask
777  c$$$  c$$$
778  c$$$*     ---------------------  c$$$*     this routine set va1 and single-strip masks,
779  c$$$*     VIEW 7 - VK 21-22  c$$$*     on the basis of the VA1 mask saved in the DB
780  c$$$      if(date.ge.50316)then  c$$$*
781  c$$$cc         print*,'MASK: view 7 - vk 21/22'  c$$$*     mask(nviews,nva1_view,nstrips_va1) !strip mask
782  c$$$         mask_vk(7,21)=0  c$$$*     mask_vk(nviews,nva1_view)          !VA1 mask
783  c$$$         mask_vk(7,22)=0  c$$$*
784  c$$$         do is=1,nstrips_va1  c$$$      include 'commontracker.f'
785  c$$$            mask(7,21,is)=0  c$$$      include 'level1.f'
786  c$$$            mask(7,22,is)=0  c$$$      include 'common_reduction.f'
787    c$$$      include 'calib.f'
788    c$$$
789    c$$$*     init mask
790    c$$$      do iv=1,nviews
791    c$$$         do ivk=1,nva1_view
792    c$$$            do is=1,nstrips_va1
793    c$$$c               mask(iv,ivk,is) = mask_vk(iv,ivk)
794    c$$$               if( mask_vk(iv,ivk) .ne. -1)then
795    c$$$                  mask(iv,ivk,is) = 1
796    c$$$     $                 * mask_vk(iv,ivk)     !from DB
797    c$$$     $                 * mask_vk_ev(iv,ivk)  !from <SIG>
798    c$$$     $                 * mask_vk_run(iv,ivk) !from CN
799    c$$$               else
800    c$$$                  mask(iv,ivk,is) = -1
801    c$$$     $                 * mask_vk(iv,ivk)     !from DB
802    c$$$     $                 * mask_vk_ev(iv,ivk)  !from CN
803    c$$$               endif
804    c$$$            enddo
805  c$$$         enddo  c$$$         enddo
806  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  
807  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  
808  c$$$  c$$$
809  c$$$*     ---------------------  c$$$      return
810  c$$$*     VIEW 12 - VK 7-8  c$$$      end
 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  
811    
812          subroutine stripmask(iv,ivk)
813    
814    *     -----------------------------------------------
815    *     this routine set va1 and single-strip masks,
816    *     on the basis of the VA1 mask saved in the DB
817    *
818    *     mask(nviews,nva1_view,nstrips_va1) !strip mask
819    *     mask_vk(nviews,nva1_view)          !VA1 mask
820    *     -----------------------------------------------
821          include 'commontracker.f'
822          include 'level1.f'
823          include 'common_reduction.f'
824          include 'calib.f'
825    
826    *     init mask
827          do is=1,nstrips_va1
828    *        --------------------------------------------------------
829    *        if VA1-mask from DB is 0 or 1, three masks are combined:
830    *        - from DB (a-priori mask)
831    *        - run-based (chip declared bad on the basis of <SIG>)
832    *        - event-based (failure in CN computation)
833    *        --------------------------------------------------------
834    c         print*,iv,ivk
835    c     $        ,mask_vk(iv,ivk),mask_vk_ev(iv,ivk),mask_vk_run(iv,ivk)
836             if( mask_vk(iv,ivk) .ne. -1)then            
837                mask(iv,ivk,is) = 1
838         $           * mask_vk(iv,ivk)     !from DB
839         $           * mask_vk_ev(iv,ivk)  !from <SIG>
840         $           * mask_vk_run(iv,ivk) !from CN
841    *        -----------------------------------------------------------
842    *        if VA1-mask from DB is -1 only event-based mask is applied
843    *        -----------------------------------------------------------
844             else
845                mask(iv,ivk,is) = -1
846         $           * mask_vk(iv,ivk)     !from DB
847         $           * mask_vk_ev(iv,ivk)  !from CN
848             endif
849          enddo
850          
851          
852        return        return
853        end        end
   

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

  ViewVC Help
Powered by ViewVC 1.1.23