/[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.9 by pam-fi, Mon Oct 16 12:36:52 2006 UTC revision 1.26 by pam-fi, Tue Nov 25 14:41:38 2008 UTC
# Line 23  Line 23 
23        integer ierror        integer ierror
24        ierror = 0        ierror = 0
25    
26  *     -------------------------------------------------------  c$$$      debug = .true.
27  *     STRIP MASK  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    
 c      call stripmask   !called later, after CN computation  
39        call init_level1        call init_level1
40    
41    c      debug=.true.
42    
43          if(debug.eq.1)print*,'-- check LEVEL0 status'
44    
45          ievco=-1
46          mismatch=0
47  c      good1 = good0  c      good1 = good0
48  c--------------------------------------------------  c--------------------------------------------------
49  c     check the LEVEL0 event status for missing  c     check the LEVEL0 event status for missing
# Line 46  c           ------------------------ Line 60  c           ------------------------
60  c           CRC error  c           CRC error
61  c           ------------------------  c           ------------------------
62              if(crc(iv).eq.1) then              if(crc(iv).eq.1) then
63                 GOOD1(DSPnumber(iv)) = 2  c               GOOD1(DSPnumber(iv)) = 2
64                 goto 18 !next view  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              endif
71  c           ------------------------  c           ------------------------
72  c           online-software alarm  c           online-software alarm
# Line 62  c           ------------------------ Line 81  c           ------------------------
81       $           fc(iv).ne.0.or.       $           fc(iv).ne.0.or.
82       $           DATAlength(iv).eq.0.or.       $           DATAlength(iv).eq.0.or.
83       $           .false.)then       $           .false.)then
84                 GOOD1(DSPnumber(iv))=3  c               GOOD1(DSPnumber(iv))=3
85                 goto 18  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              endif
92  c           ------------------------  c           ------------------------
93  c           DSP-counter jump  c           DSP-counter jump
94  c           ------------------------  c           ------------------------
95              if(  c     commentato perche` non e` un controllo significativo nel caso in cui
96       $           eventn_old(iv).ne.0.and. !first event in this file  c     la subroutine venga chiamata per riprocessare l'evento
97       $           eventn(iv).ne.1.and.     !first event in run  c     sostituito con un check dei contatori dei vari dsp
98       $           good_old(DSPnumber(iv)).ne.0.and. !previous event corrupted  c$$$            if(
99       $           .true.)then  c$$$     $           eventn_old(iv).ne.0.and. !first event in this file
100    c$$$     $           eventn(iv).ne.1.and.     !first event in run
101                 if(eventn(iv).ne.(eventn_old(iv)+1))then  c$$$     $           good_old(DSPnumber(iv)).ne.0.and. !previous event corrupted
102                    GOOD1(DSPnumber(iv))=4  c$$$     $           .true.)then
103                    goto 18  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                 endif
127                   ievco = eventn(iv)
128              endif              endif
 c           ------------------------  
  18         continue  
129           endif           endif
130        enddo        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        ngood = 0
139        do iv = 1,nviews        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)           eventn_old(iv) = eventn(iv)
145           good_old(iv)   = good1(iv)           good_old(iv)   = good1(iv)
146           ngood = ngood + good1(iv)           ngood = ngood + good1(iv)
147    
148        enddo        enddo
149  c      if(ngood.ne.0)print*,'* WARNING * LEVEL0 event status: '  c$$$      if(verbose.and.ngood.ne.0)print*,'* WARNING * Event ',eventn(1)
150  c     $     ,(good1(i),i=1,nviews)  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 (invertin 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
 c        good1=0!<<<<<<<<<<<<<<<  
 c       if(DEBUG)print*,'event ',eventn(1),' >>>>>  decode ERROR'  
161           ierror = 220           ierror = 220
 c        goto 200  
 c         print*,'filladc error'  
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
          ima=0  
          do ik=1,nva1_view  
             cn(iv,ik)  = 0  
             cnn(iv,ik) = -1  
             mask_vk_ev(iv,ik)=1  
             iflag=0  
             if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik,iflag)  
 c     if(iflag.ne.0)good1=0  
             if(iflag.ne.0)then  
                ima=ima+1  
                mask_vk_ev(iv,ik)=0  
                ierror = 220  
 c$$$               if(verbose)  
 c$$$     $              print*,' * WARNING * Event ',eventn(1)  
 c$$$     $              ,': masked vk ',ik,' on view',iv  
             endif  
          enddo  
  100     format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)  
 c         if(ima.ne.0.and.verbose)print*,' * WARNING * Event ',eventn(1)  
 c     $              ,' view',iv,': VK MASK '  
 c     $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)  
          if(ima.ne.0.and.verbose)write(*,100)eventn(1),iv  
      $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)  
       enddo  
 c      if(good1.eq.0)then  
 c         ierror = 220  
 c      endif  
172    
173        call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk           call evaluatecn(iv)
174    c$$$         ima=0
175    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
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,
205  c     and computes strips signals using  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  c$$$          print*,iv,is,' --- ',adc(iv,nvk(is),nst(is)),cn(iv,nvk(is))  c$$$     $           *mask(iv,nvk(is),nst(is))
235  c$$$     $         ,pedestal(iv,nvk(is),nst(is)),value(is)  c$$$            clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
236  c$$$     $         ,sigma(iv,nvk(is),nst(is))  c$$$     $           *mask(iv,nvk(is),nst(is))
237  c          if(value(is).gt.clseedcut(is))  c$$$            sat(is)=0
238  c     $         print*,iv,is,' --- (ADC_PED_CN) ',value(is),clseedcut(is)  c$$$            if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1
239          enddo                   !end loop on strips (1)  c$$$          endif
240          call search_cluster(iv)  c$$$        enddo                   !end loop on strips (1)
241  c$$$        if(flag_shower.eqv..true.)then           call subtractped(iv)
242  c$$$          call init_level1                         call searchcluster(iv)
243  c$$$          good1=0  
244  c$$$          goto 200              !jump to next event           if(.not.flag_shower)then
245  c$$$        endif              call savecluster(iv)
246  ccc  c$$$            if(debug.eq.1)print*,' view ',iv,' #clusters ', nclstr_view
247  ccc    modified by Elena (08/2006)           else
248  ccc              fshower(iv) = 1
249          if(.not.flag_shower)then  c     GOOD1(DSPnumber(iv)) = 11 !AHAHAHAHA ORRORE!!
250             call save_cluster(iv)  c     GOOD1(iv) = 11
251          else  c     GOOD1(iv) = GOOD1(iv) + 2**5
252             fshower(iv) = 1              GOOD1(iv) = ior(GOOD1(iv),2**5)
253             GOOD1(DSPn) = 11   101        format(' * WARNING * Event ',i7,' view',i3
254          endif       $           ,' #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            cnnev(iv,ik) = cnn(iv,ik) !assigns computed CN to ntuple variables              cnrmsev(iv,ik) = cnrms(iv,ik) !assigns computed CN to ntuple variables
262  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)              cnnev(iv,ik)   = cnn(iv,ik) !assigns computed CN to ntuple variables
263          enddo           enddo
264        enddo        enddo
265  C---------------------------------------------  C---------------------------------------------
266  C     come here if GOOD1=0  C     come here if GOOD1=0
# Line 211  C--------------------------------------- Line 272  C---------------------------------------
272        do iv = 1,nviews        do iv = 1,nviews
273           ngood = ngood + good1(iv)           ngood = ngood + good1(iv)
274        enddo        enddo
275        if(ngood.ne.0)print*,'* WARNING * Event ',eventn(1)        if(verbose.eq.1.and.ngood.ne.0)
276         $     print*,'* WARNING * Event ',eventn(1)
277       $     ,':LEVEL1 event status: '       $     ,':LEVEL1 event status: '
278       $     ,(good1(i),i=1,nviews)       $     ,(good1(i),i=1,nviews)
279  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 254  c      good1 = 0 Line 316  c      good1 = 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           whichtrack(ic) = 0     !assigned @ level2
321    
322        enddo        enddo
323        do id=1,maxlength         !???        do id=1,maxlength         !???
# Line 275  c        crc1(iv)=0 Line 337  c        crc1(iv)=0
337                
338        return        return
339        end        end
340    
341  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
342  *  *
343  *  *
# Line 283  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'
352        include 'level0.f'        include 'level0.f'
# Line 295  c        crc1(iv)=0 Line 358  c        crc1(iv)=0
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
   
       integer multtemp          !temporary multiplicity variable  
364    
365        external nst        external nst
366    
 c------------------------------------------------------------------------  
 c     looks for clusters on each view  
 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)  
   
367        iseed=-999                !cluster seed index initialization        iseed=-999                !cluster seed index initialization
368    
369          inext=-999                !index where to start new cluster search
370    
371          flag_shower = .false.
372        nclstr_view=0        nclstr_view=0
373    
374        do jl=1,nladders_view     !1..3 !loops on ladders        do jl=1,nladders_view              !1..3 !loops on ladders
375           first=1+nstrips_ladder*(jl-1) !1,1025,2049  
376           last=nstrips_ladder*jl !1024,2048,3072           first = 1+nstrips_ladder*(jl-1) !1,1025,2049
377  c     X views have 1018 strips instead of 1024           last  = nstrips_ladder*jl       !1024,2048,3072
378    
379    *        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
# Line 344  c     X views have 1018 strips instead o Line 384  c     X views have 1018 strips instead o
384    
385           do is=first,last       !loop on strips in each ladder           do is=first,last       !loop on strips in each ladder
386    
387              if(is.le.iseed+1) goto 220  c---------------------------------------------
388  *******************************************************  c     new-cluster search starts at index inext
389  *     Elena 08/2006  c---------------------------------------------
390  * QUESTA PARTE NON E` ADEGUATA per cluster con grossi rilasci di carica              if(is.lt.inext) goto 220 ! next strip
 * perche` salva molte volte lo stesso cluster  
 * (salvo il cluster rispetto al primo massimo e basta...)  
 *******************************************************  
 c$$$c-----------------------------------------  
 c$$$c     after a cluster seed as been found,  
 c$$$c     look for next one skipping one strip on the right  
 c$$$c     (i.e. look for double peak cluster)  
 c$$$c-----------------------------------------  
 c$$$            if(is.ne.first) then  
 c$$$               if(value(is).le.value(is-1)) goto 220  
 c$$$            endif  
 c$$$c-----------------------------------------  
 c$$$c     skips cluster seed  
 c$$$c     finding if strips values are descreasing (a strip  
 c$$$c     can be a cluster seed only if previous strip value  
 c$$$c     is lower)  
 c$$$c-----------------------------------------  
 *******************************************************  
 * LA RICERCA PARTE DALL'ULTIMA STRIP SALVATA (***TEMPORANEO****)  
 *******************************************************  
             if(is.le.iseed+rmax+1) goto 220  
 *******************************************************  
391    
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  c$$$               if(debug.eq.1)print*,'|||| ',value(is),' @',is
397    c$$$     $              ,' cut ',clseedcut(is)
398    
399                   itemp = is
400                   fsat = 0         ! first saturated strip
401                   lsat = 0         ! last saturated strip
402                 if(itemp.eq.last) goto 230 !estremo...                 if(itemp.eq.last) goto 230 !estremo...
403  ****************************************************  c              ------------------------                
404  *     modificato da Elena (08/2006) per salvare  c              search for first maximum
405  *     il cluster intorno al massimo assoluto  c              ------------------------
 ****************************************************  
 c$$$               do while(value(itemp)  
 c$$$     $              /sigma(iv,nvk(itemp),nst(itemp))  
 c$$$     $              .le.value(itemp+1)  
 c$$$     $              /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???  
 c$$$                  itemp=itemp+1  
 c$$$                  if(itemp.eq.last) goto 230 !stops if reaches last strip  
 c$$$               enddo            ! of the ladder  
406                 do while(                 do while(
407       $                   value(itemp).le.value(itemp+1)       $                   value(itemp).le.value(itemp+1)
408       $              .and.value(itemp+1).gt.clseedcut(itemp+1))       $              .and.value(itemp+1).gt.clseedcut(itemp+1))
409                    itemp=itemp+1                    itemp = itemp+1
410                    if(itemp.eq.last) goto 230 !stops if reaches last strip  c$$$                  if(debug.eq.1)print*,'|||| ',value(itemp),' @',is
411    c$$$     $                 ,' cut ',clseedcut(itemp)
412                      if(itemp.eq.last)   goto 230 !stops if reaches last strip
413                      if(sat(itemp).eq.1) goto 230 !stop if reaches a saturated strip
414                 enddo            ! of the ladder                 enddo            ! of the ladder
415   230           continue   230           continue
416  c-----------------------------------------  c              -----------------------------
417    c              check if strips are saturated
418    c              -----------------------------    
419                   if( sat(itemp).eq.1 )then
420                      fsat = itemp
421                      lsat = itemp
422                      if(itemp.eq.last) goto 231 !estremo...
423                      do while(
424         $                 sat(itemp+1).eq.1 .and.
425         $                 value(itemp+1).gt.clseedcut(itemp+1) .and.
426         $                 .true.)
427                         itemp = itemp+1
428                         lsat = itemp
429                         if(itemp.eq.last)   goto 231 !stops if reaches last strip
430                      enddo                  
431                   endif
432     231           continue
433    c---------------------------------------------------------------------------
434  c     fownd SEED!!!  c     fownd SEED!!!
435  c-----------------------------------------  c     (if there are saturated strips, the cluster is centered in the middle)
436                 iseed=itemp      c---------------------------------------------------------------------------
437  c----------------------------------------------------------                 if(fsat.eq.0.and.lsat.eq.0)then
438                      iseed = itemp ! <<< SEED
439                   else
440                      iseed = int((lsat+fsat)/2) ! <<< SEED
441                      if(debug.eq.1)
442         $                 print*,'saturated strips (first,last) ',fsat,lsat
443    c$$$                  print*,'--> ',(value(ii),ii=fsat,lsat)
444                   endif    
445    c---------------------------------------------------------------
446  c     after finding a cluster seed, checks also adjacent strips,  c     after finding a cluster seed, checks also adjacent strips,
447  C     and marks the ones exceeding clinclcut  C     and tags the ones exceeding clinclcut
448  c----------------------------------------------------------  c---------------------------------------------------------------
449                  
450                   if(debug.eq.1)print*,'SEED ',value(iseed),' @',iseed
451         $              ,' cut ',clseedcut(iseed)
452    
453                 ir=iseed         !indici destro                 ir=iseed         !indici destro
454                 il=iseed         ! e sinistro                 il=iseed         ! e sinistro
455                                
# Line 415  c--------------------------------------- Line 460  c---------------------------------------
460                 lstop=0          ! inclusion loop                 lstop=0          ! inclusion loop
461    
462                 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
463                    ir=ir+1       !position index for strips on right side of  
464                                  ! cluster seed  
465                    il=il-1       !and for left side                    ir=ir+1       !index for right side
466                      il=il-1       !index for left side
467  c------------------------------------------------------------------------  c------------------------------------------------------------------------
468  c     checks for last or first strip of the ladder  c     checks for last or first strip of the ladder
469  c------------------------------------------------------------------------  c------------------------------------------------------------------------
470                    if(ir.gt.last) then !when index goes beyond last strip                    if( ir.gt.last  ) rstop = 1                      
471                       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  
472                                        
473  c------------------------------------------------------------------------  c------------------------------------------------------------------------
474  c     check for clusters including more than nclstrp strips  c     add strips exceeding inclusion cut
475  c------------------------------------------------------------------------  c------------------------------------------------------------------------
476                    if((rmax-lmax+1).ge.nclstrp) then                    if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
477                       goto 210   !exits inclusion loop:  
478                                  ! lmax and rmax maintain last value                    if(rstop.eq.0) then !if right cluster border has not been reached
479                                  ! NB .ge.!???                       if(value(ir).gt.clinclcut(ir)) then
480                    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  
481                       else                       else
482                          rstop=1 !otherwise cluster ends on right and rstop                          rstop=1 !cluster right end
483                       endif      ! flag=1 signals it                       endif    
484                    endif                    endif
485                    if(lstop.eq.0) then  
486                      if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
487    
488                      if(lstop.eq.0) then !if left cluster border has not been reached
489                       if(value(il).gt.clinclcut(il)) then                       if(value(il).gt.clinclcut(il)) then
490                          lmax=il                          lmax=il !include a strip on the left
491                       else                       else
492                          lstop=1                          lstop=1 !cluster left end
493                       endif                       endif
494                    endif                    endif
495    
496    c                  if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
497    
498                 enddo            !ends strip inclusion loop                 enddo            !ends strip inclusion loop
499                   goto 211
500   210           continue         !jumps here if more than nclstrp have been included   210           continue         !jumps here if more than nclstrp have been included
501                        c               print*,'>>> nclstrp! '
502                 multtemp=rmax-lmax+1 !stores multiplicity in temp   211           continue
503                                  ! variable. NB rmax and lmax can change later in  c-----------------------------------------
504                                  ! order to include enough strips to calculate eta3  c     end of inclusion loop!
505                                  ! and eta4. so mult is not always equal to cllength  c-----------------------------------------
506  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  
507  c------------------------------------------------------------------------  c------------------------------------------------------------------------
508  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
509  c     strips, and the one adjacent to the greatest between this two strip, as the  c------------------------------------------------------------------------
510  c     fourth one. if the strips have the same value (!) the fourth one is chosen                 if(iseed.eq.lmax.and.lmax.ne.first)then
511  c     as the one having the greatest value between the second neighbors                    lmax = lmax-1
512  c------------------------------------------------------------------------                    if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
                if(value(iseed+1).eq.value(iseed-1)) then  
                   if(value(iseed+2).ge.value(iseed-2)) then !??? qui cmq c'e'  
                      diff=(iseed+2)-rmax  
                      if(diff.gt.0) then  
                         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  
513                 endif                 endif
514   250           continue                 if(iseed.eq.rmax.and.rmax.ne.last )then
515                      rmax = rmax+1
516                      if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
517                   endif
518    c-------------------------------------------------------------------------------
519    c     adjust the cluster in order to have at least ANOTHER strip around the seed
520    c-------------------------------------------------------------------------------
521                   if(iseed-1.eq.lmax.and.lmax.ne.first)then
522                      lmax = lmax-1
523                      if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
524                   endif
525                   if(iseed+1.eq.rmax.and.rmax.ne.last )then
526                      rmax = rmax+1
527                      if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
528                   endif
529    c---------------------------------------------------
530    c     now we have 5 stored-strips around the maximum
531    c---------------------------------------------------
532    
533    c------------------------------------------------------------------------
534    c     adjust the cluster in order to store a minimum number of strips
535    c------------------------------------------------------------------------
536                   do while( (rmax-lmax+1).lt.nclstrpmin )
537    
538                      vl = -99999
539                      vr = -99999
540                      if(lmax-1.ge.first) vl = value(lmax-1)
541                      if(rmax+1.le.last ) vr = value(rmax+1)
542                      if(vr.ge.vl) then
543                         rmax = rmax+1
544                      else  
545                         lmax = lmax-1
546                      endif
547                      
548                   enddo
549    
550  c--------------------------------------------------------  c--------------------------------------------------------
551  c     fills cluster variables  c     store cluster info
552  c--------------------------------------------------------  c--------------------------------------------------------
 c$$$               nclstr1=nclstr1+1 !cluster number  
 c$$$ccc               print*,nclstr1,multtemp  
 c$$$               if(nclstr1.gt.nclstrmax) then !too many clusters for the event:  
 c$$$                  if(verbose)print*,'Event ',eventn(1),  
 c$$$     $                 ': more than ',nclstrmax,' clusters'  
 c$$$                  good1=0       ! event  
 c$$$                  nclstr1=0  
 c$$$                  totCLlength=0  
 c$$$                  flag_shower = .true.  
 c$$$                  goto 2000  
 c$$$               endif  
 c$$$               view(nclstr1)   = iv !vista del cluster  
 c$$$               ladder(nclstr1) = nld(iseed,iv) !ladder a cui appartiene il cluster seed  
 c$$$               maxs(nclstr1)   = iseed !strip del cluster seed  
 c$$$               mult(nclstr1)   = multtemp !molteplicita'  
 c$$$                
 c$$$               indstart(nclstr1) = ind !posizione dell'inizio del cluster nell'  
 c$$$c                                      ! array clsignal  
 c$$$               indmax(nclstr1)   = indstart(nclstr1)+(iseed-lmax) !posizione del  
 c$$$c                                      ! cluster seed nell'array clsignal  
 c$$$                
 c$$$               CLlength      = rmax-lmax+1 !numero di strip del cluster  
 c$$$               totCLlength   = totCLlength+CLlength  
 c$$$               dedx(nclstr1) = 0  
 c$$$               do j=lmax,rmax   !stores sequentially cluter strip values in  
 c$$$                  clsignal(ind) = value(j) ! clsignal array  
 c$$$                  ind=ind+1  
 c$$$c                  if(value(j).gt.0)  
 c$$$                  if(value(j).gt.clinclcut(j))  
 c$$$     $                 dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge  
 c$$$               enddo  
 ccc  
 ccc            *** Modified by Elena (08/2006) ***  
 ccc  
553                 nclstr_view = nclstr_view + 1 !cluster number                 nclstr_view = nclstr_view + 1 !cluster number
554  c               print*,'view ',iv,' -- search_cluster -- nclstr_view: '  
 c     $              ,nclstr_view  
555                 if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view:                 if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view:
556                    if(verbose) print*,'Event ',eventn(1),  c$$$                  if(verbose) print*,'Event ',eventn(1),
557       $                 ': more than ',nclstrmax_view  c$$$     $                 ': more than ',nclstrmax_view
558       $                 ,' clusters on view ',iv  c$$$     $                 ,' clusters on view ',iv
 c                  good1=0       ! event  
 c                  nclstr1=0  
 c                  totCLlength=0  
559                    flag_shower = .true.                    flag_shower = .true.
560                    goto 2000                    goto 2000
561                 endif                 endif
562    
563  c               view(nclstr1)   = iv !vista del cluster                 ladder_view(nclstr_view) = nld(iseed,iv)
564                 ladder_view(nclstr_view) = nld(iseed,iv) !ladder a cui appartiene il cluster seed                 maxs_view(nclstr_view)   = iseed
                maxs_view(nclstr_view)   = iseed !strip del cluster seed  
                mult_view(nclstr_view)   = multtemp !molteplicita'  
565                 rmax_view(nclstr_view)   = rmax                 rmax_view(nclstr_view)   = rmax
566                 lmax_view(nclstr_view)   = lmax                 lmax_view(nclstr_view)   = lmax
567    c               mult_view(nclstr_view)   = rmax-lmax+1
568                   mult_view(nclstr_view)   = 0
569                   do ii=lmax,rmax
570                      if(value(ii).gt.clinclcut(ii))  
571         $                 mult_view(nclstr_view) = mult_view(nclstr_view)+1
572                   enddo
573    
574    c$$$               print*,(value(ii),ii=lmax,rmax)
575    c$$$               print*,(clinclcut(ii),ii=lmax,rmax)
576    c$$$               print*,(clseedcut(ii),ii=lmax,rmax)
577    
578    c$$$               if(rmax-lmax+1.gt.25)
579    c$$$     $              print*,'view ',iv
580    c$$$     $              ,' cl ',nclstr_view,' mult ',rmax-lmax+1
581    c------------------------------------------------------------------------
582    c     search for a double peak inside the cluster                                                                                                            
583    c------------------------------------------------------------------------
584                   inext = rmax+1   !<< index where to start new-cluster search
585                  
586                   vmax = 0
587                   vmin = value(iseed)
588                   imax = iseed
589                   imin = iseed
590                   do iss = max(iseed+1,lsat+1),rmax
591                      if( value(iss).lt.vmin )then
592                         if( imax.ne.iseed )goto 221 !found dowble peek
593                         imin = iss
594                         vmin = value(iss)
595                      else
596                         delta = value(iss) - value(imin)
597                         cut = sqrt(clinclcut(iss)**2 + clinclcut(imin)**2)
598                         if(
599         $                    delta.gt.cut .and.
600         $                    value(iss).gt.clseedcut(iss).and.
601         $                    .true.)then
602                            if( value(iss).gt.vmax )then                        
603                               imax = iss
604                               vmax = value(iss)
605                            else
606                               goto 221 !found dowble peek
607                            endif
608                         endif
609                      endif
610                   enddo
611     221           continue
612                  
613                   if(imax.gt.iseed)then
614                      inext = imax    !<< index where to start new-cluster search
615    c$$$                  print*,'--- double peek ---'
616    c$$$                  print*,(value(ii),ii=lmax,rmax)
617    c$$$                  print*,'seed ',iseed,' imin ',imin,' imax ',imax
618                   endif
619  c--------------------------------------------------------  c--------------------------------------------------------
620  c  c
621  c--------------------------------------------------------  c--------------------------------------------------------
# Line 678  c--------------------------------------- Line 637  c---------------------------------------
637  *  *
638  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
639    
640        subroutine save_cluster(iv)        subroutine savecluster(iv)
641  *  *
642  *     (080/2006 Elena Vannuccini)  *     (080/2006 Elena Vannuccini)
643  *     Save the clusters view by view  *     Save the clusters view by view
# Line 706  c        posizione del cluster seed nell Line 665  c        posizione del cluster seed nell
665                    
666           CLlength      = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate           CLlength      = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate
667           totCLlength   = totCLlength + CLlength           totCLlength   = totCLlength + CLlength
668           dedx(nclstr1) = 0           sgnl(nclstr1) = 0
669           do j=lmax_view(ic),rmax_view(ic)         !stores sequentially cluter strip values in           do j=lmax_view(ic),rmax_view(ic)         !stores sequentially cluter strip values in
670    
671              clsignal(ind) = value(j) ! clsignal array              clsignal(ind) = value(j) ! clsignal array
672    c$$$            print*,ind,clsignal(ind)
673              ivk=nvk(j)              ivk=nvk(j)
674              ist=nst(j)              ist=nst(j)
675    
# Line 722  c            clped(ind)   = pedestal(iv, Line 681  c            clped(ind)   = pedestal(iv,
681              ind=ind+1              ind=ind+1
682  c     if(value(j).gt.0)  c     if(value(j).gt.0)
683              if(value(j).gt.clinclcut(j))              if(value(j).gt.clinclcut(j))
684       $           dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge       $           sgnl(nclstr1) = sgnl(nclstr1) + value(j) !cluster charge
685           enddo           enddo
686    
687  c         print*,'view ',iv,' -- save_cluster -- nclstr1: '           if(debug.eq.1)then
688  c     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),dedx(nclstr1)              print*,'view ',iv,' -- '
689                 $           ,' n.cl: ',nclstr1
690         $           ,' maxs: ',maxs(nclstr1)
691         $           ,' mult: ',mult(nclstr1)
692         $           ,' sign: ',sgnl(nclstr1)
693                print*,'----------------------'
694             endif
695          enddo
696          
697          return
698          end
699    *---***---***---***---***---***---***---***---***
700    *
701    *
702    *
703    *
704    *
705    *---***---***---***---***---***---***---***---***
706    
707          subroutine evaluatecn(iv)
708          
709          include 'commontracker.f'
710          include 'level0.f'
711          include 'level1.f'
712          include 'common_reduction.f'
713          include 'calib.f'
714          
715          ima=0
716          do ik=1,nva1_view
717             cn(iv,ik)    = 0
718             cnrms(iv,ik) = 0
719             cnn(iv,ik)   = -1
720             iflag = 0
721             mask_vk_ev(iv,ik) = 1
722             call stripmask(iv,ik)  !compute mask(i,j,k), combining VA1-masks
723    *     --------------------------------------
724    *     if chip is not masked ---> evaluate CN
725    *     --------------------------------------
726             if( mask(iv,ik,1).eq.1 ) then !!!NBNB mask per la striscia 1 !!!!!!!!
727                call cncomp(iv,ik,iflag)
728                if(iflag.ne.0)then
729                   ima=ima+1
730                   mask_vk_ev(iv,ik)=0
731                   ierror = 220
732                endif
733                call stripmask(iv,ik) !compute mask(i,j,k), combining VA1-masks
734             endif
735        enddo        enddo
736     100  format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
737          if(ima.ne.0.and.verbose.eq.1)write(*,100)eventn(1),iv
738         $     ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
739                
740        return        return
741        end        end
742    
743  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
744  *  *
745  *  *
# Line 739  c     $        ,nclstr1,maxs(nclstr1),mu Line 747  c     $        ,nclstr1,maxs(nclstr1),mu
747  *  *
748  *  *
749  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
750          subroutine subtractped(iv)
751          
752          include 'commontracker.f'
753          include 'level1.f'
754          include 'calib.f'
755          include 'common_reduction.f'
756    
757          do is=1,nstrips_view      !loop on strips (1)
758             if(mod(iv,2).eq.1) then
759    C===  > Y view
760    c     print*,iv,nvk(is),nst(is),adc(iv,nvk(is),nst(is))
761    c     $            ,cn(iv,nvk(is))
762    c     $            ,pedestal(iv,nvk(is),nst(is))
763                value(is)= -(DBLE(adc(iv,nvk(is),nst(is)))
764         $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
765         $           *mask(iv,nvk(is),nst(is))
766                clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is))
767         $           *mask(iv,nvk(is),nst(is))
768                clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
769         $           *mask(iv,nvk(is),nst(is))
770                sat(is)=0
771                if( adc(iv,nvk(is),nst(is)).lt.adc_saty )
772         $           sat(is)=mask(iv,nvk(is),nst(is))
773             else            
774    C===  > X view
775                value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
776         $           -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is)))
777         $           *mask(iv,nvk(is),nst(is))
778                clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is))
779         $           *mask(iv,nvk(is),nst(is))
780                clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
781         $           *mask(iv,nvk(is),nst(is))
782                sat(is)=0
783                if( adc(iv,nvk(is),nst(is)).gt.adc_satx )
784         $           sat(is)=mask(iv,nvk(is),nst(is))
785             endif
786          enddo                     !end loop on strips (1)
787          
788          
789          return
790          end
791    *---***---***---***---***---***---***---***---***
792    *
793    *
794    *
795    *
796    *
797    *---***---***---***---***---***---***---***---***
798    c$$$      subroutine stripmask
799    c$$$
800    c$$$*     this routine set va1 and single-strip masks,
801    c$$$*     on the basis of the VA1 mask saved in the DB
802    c$$$*
803    c$$$*     mask(nviews,nva1_view,nstrips_va1) !strip mask
804    c$$$*     mask_vk(nviews,nva1_view)          !VA1 mask
805    c$$$*
806    c$$$      include 'commontracker.f'
807    c$$$      include 'level1.f'
808    c$$$      include 'common_reduction.f'
809    c$$$      include 'calib.f'
810    c$$$
811    c$$$*     init mask
812    c$$$      do iv=1,nviews
813    c$$$         do ivk=1,nva1_view
814    c$$$            do is=1,nstrips_va1
815    c$$$c               mask(iv,ivk,is) = mask_vk(iv,ivk)
816    c$$$               if( mask_vk(iv,ivk) .ne. -1)then
817    c$$$                  mask(iv,ivk,is) = 1
818    c$$$     $                 * mask_vk(iv,ivk)     !from DB
819    c$$$     $                 * mask_vk_ev(iv,ivk)  !from <SIG>
820    c$$$     $                 * mask_vk_run(iv,ivk) !from CN
821    c$$$               else
822    c$$$                  mask(iv,ivk,is) = -1
823    c$$$     $                 * mask_vk(iv,ivk)     !from DB
824    c$$$     $                 * mask_vk_ev(iv,ivk)  !from CN
825    c$$$               endif
826    c$$$            enddo
827    c$$$         enddo
828    c$$$      enddo
829    c$$$
830    c$$$
831    c$$$      return
832    c$$$      end
833    
834        subroutine stripmask        subroutine stripmask(iv,ivk)
835    
836    *     -----------------------------------------------
837  *     this routine set va1 and single-strip masks,  *     this routine set va1 and single-strip masks,
838  *     on the basis of the VA1 mask saved in the DB  *     on the basis of the VA1 mask saved in the DB
839  *  *
840  *     mask(nviews,nva1_view,nstrips_va1) !strip mask  *     mask(nviews,nva1_view,nstrips_va1) !strip mask
841  *     mask_vk(nviews,nva1_view)          !VA1 mask  *     mask_vk(nviews,nva1_view)          !VA1 mask
842  *  *     -----------------------------------------------
843        include 'commontracker.f'        include 'commontracker.f'
844        include 'level1.f'        include 'level1.f'
845        include 'common_reduction.f'        include 'common_reduction.f'
846        include 'calib.f'        include 'calib.f'
847    
848  *     init mask  *     init mask
849        do iv=1,nviews        do is=1,nstrips_va1
850           do ivk=1,nva1_view  *        --------------------------------------------------------
851              do is=1,nstrips_va1  *        if VA1-mask from DB is 0 or 1, three masks are combined:
852  c               mask(iv,ivk,is) = mask_vk(iv,ivk)  *        - from DB (a-priori mask)
853                 mask(iv,ivk,is) = mask_vk(iv,ivk) * mask_vk_ev(iv,ivk)                *        - run-based (chip declared bad on the basis of <SIG>)
854              enddo  *        - event-based (failure in CN computation)
855           enddo  *        --------------------------------------------------------
856    c         print*,iv,ivk
857    c     $        ,mask_vk(iv,ivk),mask_vk_ev(iv,ivk),mask_vk_run(iv,ivk)
858             if( mask_vk(iv,ivk) .ne. -1)then            
859                mask(iv,ivk,is) = 1
860         $           * mask_vk(iv,ivk)     !from DB
861         $           * mask_vk_ev(iv,ivk)  !from <SIG>
862         $           * mask_vk_run(iv,ivk) !from CN
863    *        -----------------------------------------------------------
864    *        if VA1-mask from DB is -1 only event-based mask is applied
865    *        -----------------------------------------------------------
866             else
867                mask(iv,ivk,is) = -1
868         $           * mask_vk(iv,ivk)     !from DB
869         $           * mask_vk_ev(iv,ivk)  !from CN
870             endif
871        enddo        enddo
872          
873          
874        return        return
875        end        end
   

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.26

  ViewVC Help
Powered by ViewVC 1.1.23