/[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.18 by pam-fi, Fri Apr 27 10:39:58 2007 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    
 c      call stripmask   !called later, after CN computation  
30        call init_level1        call init_level1
31    
32          if(debug)print*,'-- check LEVEL0 status'
33    
34  c      good1 = good0  c      good1 = good0
35  c--------------------------------------------------  c--------------------------------------------------
36  c     check the LEVEL0 event status for missing  c     check the LEVEL0 event status for missing
# Line 91  c           ------------------------ Line 92  c           ------------------------
92           good_old(iv)   = good1(iv)           good_old(iv)   = good1(iv)
93           ngood = ngood + good1(iv)           ngood = ngood + good1(iv)
94        enddo        enddo
95  c      if(ngood.ne.0)print*,'* WARNING * LEVEL0 event status: '        if(debug.and.ngood.ne.0)print*,'* WARNING * LEVEL0 event status: '
96  c     $     ,(good1(i),i=1,nviews)       $     ,(good1(i),i=1,nviews)
97  c--------------------------------------------------  c--------------------------------------------------
98  c     read the variable DATATRACKER from LEVEL0  c     read the variable DATATRACKER from LEVEL0
99  c     and fill the variable ADC (invertin view 11)  c     and fill the variable ADC (invertin view 11)
100  c--------------------------------------------------  c--------------------------------------------------
101          
102          if(debug)print*,'-- fill ADC vectors'
103    
104        call filladc(iflag)        call filladc(iflag)
105        if(iflag.ne.0)then        if(iflag.ne.0)then
 c        good1=0!<<<<<<<<<<<<<<<  
 c       if(DEBUG)print*,'event ',eventn(1),' >>>>>  decode ERROR'  
106           ierror = 220           ierror = 220
 c        goto 200  
 c         print*,'filladc error'  
107        endif        endif
108    
109  c--------------------------------------------------  c--------------------------------------------------
110  c     computes common noise for each VA1  c     computes common noise for each VA1
111  c     (excluding strips affected by signal,  c     (excluding strips with signal,
112  c     tagged with the flag CLSTR)  c     tagged with the flag CLSTR)
113  c--------------------------------------------------  c--------------------------------------------------
114          if(debug)print*,'-- compute CN'
115    
116        do iv=1,nviews        do iv=1,nviews
117           ima=0           ima=0
118           do ik=1,nva1_view           do ik=1,nva1_view
119              cn(iv,ik)  = 0              cn(iv,ik)    = 0
120              cnn(iv,ik) = -1              cnrms(iv,ik) = 0
121              mask_vk_ev(iv,ik)=1              cnn(iv,ik)   = -1
122              iflag=0              iflag = 0
123              if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik,iflag)              mask_vk_ev(iv,ik) = 1
124  c     if(iflag.ne.0)good1=0              call stripmask(iv,ik)      !compute mask(i,j,k), combining VA1-masks
125              if(iflag.ne.0)then  *           --------------------------------------
126                 ima=ima+1  *           if chip is not masked ---> evaluate CN
127                 mask_vk_ev(iv,ik)=0  *           --------------------------------------
128                 ierror = 220              if( mask(iv,ik,1).eq.1 ) then !!!NBNB mask per la striscia 1 !!!!!!!!
129  c$$$               if(verbose)                 call cncomp(iv,ik,iflag)
130  c$$$     $              print*,' * WARNING * Event ',eventn(1)                 if(iflag.ne.0)then
131  c$$$     $              ,': masked vk ',ik,' on view',iv                    ima=ima+1
132                      mask_vk_ev(iv,ik)=0
133                      ierror = 220
134                   endif
135                   call stripmask(iv,ik) !compute mask(i,j,k), combining VA1-masks
136              endif              endif
137           enddo           enddo
138   100     format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)   100     format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
139  c         if(ima.ne.0.and.verbose)print*,' * WARNING * Event ',eventn(1)           if(ima.ne.0.and.debug)write(*,100)eventn(1),iv
 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  
140       $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)       $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
141    c         if(ima.ne.0)write(*,100)eventn(1),iv
142    c     $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)  
143        enddo        enddo
 c      if(good1.eq.0)then  
 c         ierror = 220  
 c      endif  
144    
145        call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk  cc      call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
146    
147  c---------------------------------------------  c---------------------------------------------
148  c     loops on views, VA1 and strips,  c     loops on views, VA1 and strips,
149  c     and computes strips signals using  c     and computes strips signals using
150  c     badstrip, pedestals, and  c     badstrip, pedestals, and
151  c     sigma informations from histograms  c     sigma informations from histograms
152  c---------------------------------------------  c---------------------------------------------
       flag_shower = .false.  
153        ind=1                     !clsignal array index        ind=1                     !clsignal array index
154    
155          if(debug)print*,'-- search clusters'
156        do iv=1,nviews            !loop on views        do iv=1,nviews            !loop on views
157          do is=1,nstrips_view    !loop on strips (1)          do is=1,nstrips_view    !loop on strips (1)
158            if(mod(iv,2).eq.1) then            if(mod(iv,2).eq.1) then
# Line 161  C===  > Y view Line 164  C===  > Y view
164       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
165              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
166       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
167  ccc            print*,"value(",is,")(reduction)= ",value(is)              sat(is)=0
168                if( adc(iv,nvk(is),nst(is)).lt.adc_saty )sat(is)=1
169            else                        else            
170  C===  > X view  C===  > X view
171              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
# Line 171  C===  > X view Line 175  C===  > X view
175       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
176              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
177       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
178                sat(is)=0
179                if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1
180            endif            endif
 c$$$          print*,iv,is,' --- ',adc(iv,nvk(is),nst(is)),cn(iv,nvk(is))  
 c$$$     $         ,pedestal(iv,nvk(is),nst(is)),value(is)  
 c$$$     $         ,sigma(iv,nvk(is),nst(is))  
 c          if(value(is).gt.clseedcut(is))  
 c     $         print*,iv,is,' --- (ADC_PED_CN) ',value(is),clseedcut(is)  
181          enddo                   !end loop on strips (1)          enddo                   !end loop on strips (1)
182          call search_cluster(iv)          call search_cluster(iv)
183  c$$$        if(flag_shower.eqv..true.)then  
 c$$$          call init_level1                
 c$$$          good1=0  
 c$$$          goto 200              !jump to next event  
 c$$$        endif  
 ccc  
 ccc    modified by Elena (08/2006)  
 ccc  
184          if(.not.flag_shower)then          if(.not.flag_shower)then
185             call save_cluster(iv)             call save_cluster(iv)
186               if(debug)print*,'view ',iv,' #clusters ', nclstr_view
187          else          else
188             fshower(iv) = 1             fshower(iv) = 1
189             GOOD1(DSPn) = 11  c           GOOD1(DSPnumber(iv)) = 11 !AHAHAHAHA ORRORE!!
190               GOOD1(iv) = 11
191     101       format(' * WARNING * Event ',i7,' view',i3
192         $          ,' #clusters > ',i5,' --> MASKED')
193               if(debug)write(*,101)eventn(1),iv,nclstrmax_view
194          endif          endif
195        enddo                     ! end loop on views        enddo                     ! end loop on views
196        do iv=1,nviews        do iv=1,nviews
197          do ik=1,nva1_view          do ik=1,nva1_view
198            cnev(iv,ik)  = cn(iv,ik) !assigns computed CN to ntuple variables            cnev(iv,ik)    = cn(iv,ik) !assigns computed CN to ntuple variables
199            cnnev(iv,ik) = cnn(iv,ik) !assigns computed CN to ntuple variables            cnrmsev(iv,ik) = cnrms(iv,ik) !assigns computed CN to ntuple variables
200  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)            cnnev(iv,ik)   = cnn(iv,ik) !assigns computed CN to ntuple variables
201          enddo          enddo
202        enddo        enddo
203  C---------------------------------------------  C---------------------------------------------
# Line 211  C--------------------------------------- Line 210  C---------------------------------------
210        do iv = 1,nviews        do iv = 1,nviews
211           ngood = ngood + good1(iv)           ngood = ngood + good1(iv)
212        enddo        enddo
213        if(ngood.ne.0)print*,'* WARNING * Event ',eventn(1)        if(debug.and.ngood.ne.0)print*,'* WARNING * Event ',eventn(1)
214       $     ,':LEVEL1 event status: '       $     ,':LEVEL1 event status: '
215       $     ,(good1(i),i=1,nviews)       $     ,(good1(i),i=1,nviews)
216  c------------------------------------------------------------------------  c------------------------------------------------------------------------
# Line 254  c      good1 = 0 Line 253  c      good1 = 0
253           indmax(ic) = 0           indmax(ic) = 0
254           maxs(ic) = 0           maxs(ic) = 0
255           mult(ic) = 0                     mult(ic) = 0          
256           dedx(ic) = 0           sgnl(ic) = 0
257           whichtrack(ic) = 0           whichtrack(ic) = 0     !assigned @ level2
258    
259        enddo        enddo
260        do id=1,maxlength         !???        do id=1,maxlength         !???
# Line 275  c        crc1(iv)=0 Line 274  c        crc1(iv)=0
274                
275        return        return
276        end        end
277    
278  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
279  *  *
280  *  *
# Line 295  c        crc1(iv)=0 Line 295  c        crc1(iv)=0
295    
296  c     local variables  c     local variables
297        integer rmax,lmax         !estremi del cluster        integer rmax,lmax         !estremi del cluster
298        integer rstop,lstop       !per decidere quali strip includere nel cluster        integer rstop,lstop      
299                                  ! oltre il seed        integer first,last
300        integer first,last,diff   !per includere le strip giuste... !???        integer fsat,lsat
   
       integer multtemp          !temporary multiplicity variable  
301    
302        external nst        external nst
303    
 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)  
   
304        iseed=-999                !cluster seed index initialization        iseed=-999                !cluster seed index initialization
305    
306          inext=-999                !index where to start new cluster search
307    
308          flag_shower = .false.
309        nclstr_view=0        nclstr_view=0
310    
311        do jl=1,nladders_view     !1..3 !loops on ladders        do jl=1,nladders_view              !1..3 !loops on ladders
312           first=1+nstrips_ladder*(jl-1) !1,1025,2049  
313           last=nstrips_ladder*jl !1024,2048,3072           first = 1+nstrips_ladder*(jl-1) !1,1025,2049
314  c     X views have 1018 strips instead of 1024           last  = nstrips_ladder*jl       !1024,2048,3072
315    
316    *        X views have 1018 strips instead of 1024
317           if(mod(iv,2).eq.0) then           if(mod(iv,2).eq.0) then
318              first=first+3              first=first+3
319              last=last-3              last=last-3
# Line 344  c     X views have 1018 strips instead o Line 321  c     X views have 1018 strips instead o
321    
322           do is=first,last       !loop on strips in each ladder           do is=first,last       !loop on strips in each ladder
323    
324              if(is.le.iseed+1) goto 220  c---------------------------------------------
325  *******************************************************  c     new-cluster search starts at index inext
326  *     Elena 08/2006  c---------------------------------------------
327  * 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  
 *******************************************************  
328    
329              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)  
330  c-----------------------------------------  c-----------------------------------------
331  c     possible SEED...  c     possible SEED...
332  c-----------------------------------------  c-----------------------------------------
333                 itemp=is                 itemp = is
334                   fsat = 0         ! first saturated strip
335                   lsat = 0         ! last saturated strip
336                 if(itemp.eq.last) goto 230 !estremo...                 if(itemp.eq.last) goto 230 !estremo...
337  ****************************************************  c              ------------------------                
338  *     modificato da Elena (08/2006) per salvare  c              search for first maximum
339  *     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  
340                 do while(                 do while(
341       $                   value(itemp).le.value(itemp+1)       $                   value(itemp).le.value(itemp+1)
342       $              .and.value(itemp+1).gt.clseedcut(itemp+1))       $              .and.value(itemp+1).gt.clseedcut(itemp+1))
343                    itemp=itemp+1                    itemp = itemp+1
344                    if(itemp.eq.last) goto 230 !stops if reaches last strip                    if(itemp.eq.last)   goto 230 !stops if reaches last strip
345                      if(sat(itemp).eq.1) goto 230 !stop if reaches a saturated strip
346                 enddo            ! of the ladder                 enddo            ! of the ladder
347   230           continue   230           continue
348  c-----------------------------------------  c              -----------------------------
349    c              check if strips are saturated
350    c              -----------------------------    
351                   if( sat(itemp).eq.1 )then
352                      fsat = itemp
353                      lsat = itemp
354                      if(itemp.eq.last) goto 231 !estremo...
355                      do while( sat(itemp+1).eq.1 )
356                         itemp = itemp+1
357                         lsat = itemp
358                         if(itemp.eq.last)   goto 231 !stops if reaches last strip
359                      enddo                  
360                   endif
361     231           continue
362    c---------------------------------------------------------------------------
363  c     fownd SEED!!!  c     fownd SEED!!!
364  c-----------------------------------------  c     (if there are saturated strips, the cluster is centered in the middle)
365                 iseed=itemp      c---------------------------------------------------------------------------
366  c----------------------------------------------------------                 if(fsat.eq.0.and.lsat.eq.0)then
367                      iseed = itemp ! <<< SEED
368                   else
369                      iseed = int((lsat+fsat)/2) ! <<< SEED
370    c$$$                  print*,'saturated strips ',fsat,lsat,iseed
371    c$$$                  print*,'--> ',(value(ii),ii=fsat,lsat)
372                   endif    
373    c---------------------------------------------------------------
374  c     after finding a cluster seed, checks also adjacent strips,  c     after finding a cluster seed, checks also adjacent strips,
375  C     and marks the ones exceeding clinclcut  C     and tags the ones exceeding clinclcut
376  c----------------------------------------------------------  c---------------------------------------------------------------
377                 ir=iseed         !indici destro                 ir=iseed         !indici destro
378                 il=iseed         ! e sinistro                 il=iseed         ! e sinistro
379                                
# Line 415  c--------------------------------------- Line 384  c---------------------------------------
384                 lstop=0          ! inclusion loop                 lstop=0          ! inclusion loop
385    
386                 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
387                    ir=ir+1       !position index for strips on right side of  
388                                  ! cluster seed  
389                    il=il-1       !and for left side                    ir=ir+1       !index for right side
390                      il=il-1       !index for left side
391  c------------------------------------------------------------------------  c------------------------------------------------------------------------
392  c     checks for last or first strip of the ladder  c     checks for last or first strip of the ladder
393  c------------------------------------------------------------------------  c------------------------------------------------------------------------
394                    if(ir.gt.last) then !when index goes beyond last strip                    if( ir.gt.last  ) rstop = 1                      
395                       rstop=1    ! of the ladder, change rstop flag in order                    if( il.lt.first ) lstop = 1
                                 ! to "help" exiting from loop  
                   endif  
396                                        
                   if(il.lt.first) then !idem when index goes beyond  
                      lstop=1    ! first strip of the ladder  
                   endif  
                     
 c------------------------------------------------------------------------  
 c     check for clusters including more than nclstrp strips  
397  c------------------------------------------------------------------------  c------------------------------------------------------------------------
398                    if((rmax-lmax+1).ge.nclstrp) then  c     add strips exceeding inclusion cut
                      goto 210   !exits inclusion loop:  
                                 ! lmax and rmax maintain last value  
                                 ! NB .ge.!???  
                   endif  
 c------------------------------------------------------------------------  
 c     marks strips exceeding inclusion cut  
399  c------------------------------------------------------------------------  c------------------------------------------------------------------------
400                    if(rstop.eq.0) then !if last strip of the ladder or last                    if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
401                                  ! over-cut strip has not been reached  
402                       if(value(ir).gt.clinclcut(ir)) then !puts in rmax the                    if(rstop.eq.0) then !if right cluster morder has not been reached
403                          rmax=ir ! last right over-cut strip                       if(value(ir).gt.clinclcut(ir)) then
404                            rmax=ir !include a strip on the right
405                       else                       else
406                          rstop=1 !otherwise cluster ends on right and rstop                          rstop=1 !cluster right end
407                       endif      ! flag=1 signals it                       endif    
408                    endif                    endif
409                    if(lstop.eq.0) then  
410                      if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
411    
412                      if(lstop.eq.0) then !if left cluster morder has not been reached
413                       if(value(il).gt.clinclcut(il)) then                       if(value(il).gt.clinclcut(il)) then
414                          lmax=il                          lmax=il !include a strip on the left
415                       else                       else
416                          lstop=1                          lstop=1 !cluster left end
417                       endif                       endif
418                    endif                    endif
419    
420                 enddo            !ends strip inclusion loop                 enddo            !ends strip inclusion loop
421                   goto 211
422   210           continue         !jumps here if more than nclstrp have been included   210           continue         !jumps here if more than nclstrp have been included
423                        c               print*,'>>> nclstrp! '
424                 multtemp=rmax-lmax+1 !stores multiplicity in temp   211           continue
425                                  ! variable. NB rmax and lmax can change later in  c-----------------------------------------
426                                  ! order to include enough strips to calculate eta3  c     end of inclusion loop!
427                                  ! and eta4. so mult is not always equal to cllength  c-----------------------------------------
428  c------------------------------------------------------------------------                
429  c     NB per essere sicuro di poter calcolare eta3 e eta4 devo includere  c------------------------------------------------------------------------
430  c     sempre e comunque le 2 strip adiacenti al cluster seed e quella  c     adjust the cluster in order to have at least a strip around the seed
431  c     adiacente ulteriore dalla parte della piu' alta fra queste due  c------------------------------------------------------------------------
432  c     (vedi oltre...)!???                 if(iseed.eq.lmax.and.lmax.ne.first)then
433  c------------------------------------------------------------------------                    lmax = lmax-1
434                      if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
 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                    
435                 endif                 endif
436                   if(iseed.eq.rmax.and.rmax.ne.last )then
437                      rmax = rmax+1
438                      if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
439                   endif
440    
441  c------------------------------------------------------------------------  c------------------------------------------------------------------------
442  c     be sure to include in the cluster the cluster seed with its 2 adjacent  c     adjust the cluster in order to store a minimum number of strips
443  c     strips, and the one adjacent to the greatest between this two strip, as the  c------------------------------------------------------------------------
444  c     fourth one. if the strips have the same value (!) the fourth one is chosen                 do while( (rmax-lmax+1).lt.nclstrpmin )
445  c     as the one having the greatest value between the second neighbors  
446  c------------------------------------------------------------------------                    vl = -99999
447                 if(value(iseed+1).eq.value(iseed-1)) then                    vr = -99999
448                    if(value(iseed+2).ge.value(iseed-2)) then !??? qui cmq c'e'                    if(lmax-1.ge.first) vl = value(lmax-1)
449                       diff=(iseed+2)-rmax                    if(rmax+1.le.last ) vr = value(rmax+1)
450                       if(diff.gt.0) then                    if(vr.ge.vl) then
451                          rmax=rmax+diff                       rmax = rmax+1
452                          if((rmax-lmax+1).gt.nclstrp) then                    else  
453                             lmax=rmax-nclstrp+1                       lmax = lmax-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  
454                    endif                    endif
455                 endif                    
456   250           continue                 enddo
457    
458  c--------------------------------------------------------  c--------------------------------------------------------
459  c     fills cluster variables  c     store cluster info
460  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  
461                 nclstr_view = nclstr_view + 1 !cluster number                 nclstr_view = nclstr_view + 1 !cluster number
462  c               print*,'view ',iv,' -- search_cluster -- nclstr_view: '  
 c     $              ,nclstr_view  
463                 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:
464                    if(verbose) print*,'Event ',eventn(1),  c$$$                  if(verbose) print*,'Event ',eventn(1),
465       $                 ': more than ',nclstrmax_view  c$$$     $                 ': more than ',nclstrmax_view
466       $                 ,' clusters on view ',iv  c$$$     $                 ,' clusters on view ',iv
 c                  good1=0       ! event  
 c                  nclstr1=0  
 c                  totCLlength=0  
467                    flag_shower = .true.                    flag_shower = .true.
468                    goto 2000                    goto 2000
469                 endif                 endif
470    
471  c               view(nclstr1)   = iv !vista del cluster                 ladder_view(nclstr_view) = nld(iseed,iv)
472                 ladder_view(nclstr_view) = nld(iseed,iv) !ladder a cui appartiene il cluster seed                 maxs_view(nclstr_view)   = iseed
473                 maxs_view(nclstr_view)   = iseed !strip del cluster seed                 mult_view(nclstr_view)   = rmax-lmax+1
                mult_view(nclstr_view)   = multtemp !molteplicita'  
474                 rmax_view(nclstr_view)   = rmax                 rmax_view(nclstr_view)   = rmax
475                 lmax_view(nclstr_view)   = lmax                 lmax_view(nclstr_view)   = lmax
476    
477    c$$$               if(rmax-lmax+1.gt.25)
478    c$$$     $              print*,'view ',iv
479    c$$$     $              ,' cl ',nclstr_view,' mult ',rmax-lmax+1
480    c------------------------------------------------------------------------
481    c     search for a double peak inside the cluster                                                                                                            
482    c------------------------------------------------------------------------
483                   inext = rmax+1   !<< index where to start new-cluster search
484                  
485                   vmax = 0
486                   vmin = value(iseed)
487                   imax = iseed
488                   imin = iseed
489                   do iss = max(iseed+1,lsat+1),rmax
490                      if( value(iss).lt.vmin )then
491                         if( imax.ne.iseed )goto 221 !found dowble peek
492                         imin = iss
493                         vmin = value(iss)
494                      else
495                         delta = value(iss) - value(imin)
496                         cut = sqrt(clinclcut(iss)**2 + clinclcut(imin)**2)
497                         if(
498         $                    delta.gt.cut .and.
499         $                    value(iss).gt.clseedcut(iss).and.
500         $                    .true.)then
501                            if( value(iss).gt.vmax )then                        
502                               imax = iss
503                               vmax = value(iss)
504                            else
505                               goto 221 !found dowble peek
506                            endif
507                         endif
508                      endif
509                   enddo
510     221           continue
511                  
512                   if(imax.gt.iseed)then
513                      inext = imax    !<< index where to start new-cluster search
514    c$$$                  print*,'--- double peek ---'
515    c$$$                  print*,(value(ii),ii=lmax,rmax)
516    c$$$                  print*,'seed ',iseed,' imin ',imin,' imax ',imax
517                   endif
518  c--------------------------------------------------------  c--------------------------------------------------------
519  c  c
520  c--------------------------------------------------------  c--------------------------------------------------------
# Line 706  c        posizione del cluster seed nell Line 564  c        posizione del cluster seed nell
564                    
565           CLlength      = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate           CLlength      = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate
566           totCLlength   = totCLlength + CLlength           totCLlength   = totCLlength + CLlength
567           dedx(nclstr1) = 0           sgnl(nclstr1) = 0
568           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
569    
570              clsignal(ind) = value(j) ! clsignal array              clsignal(ind) = value(j) ! clsignal array
# Line 722  c            clped(ind)   = pedestal(iv, Line 580  c            clped(ind)   = pedestal(iv,
580              ind=ind+1              ind=ind+1
581  c     if(value(j).gt.0)  c     if(value(j).gt.0)
582              if(value(j).gt.clinclcut(j))              if(value(j).gt.clinclcut(j))
583       $           dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge       $           sgnl(nclstr1) = sgnl(nclstr1) + value(j) !cluster charge
584           enddo           enddo
585    
586  c         print*,'view ',iv,' -- save_cluster -- nclstr1: '  c         print*,'view ',iv,' -- save_cluster -- nclstr1: '
587  c     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),dedx(nclstr1)  c     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),sgnl(nclstr1)
588                    
589        enddo        enddo
590                
# Line 741  c     $        ,nclstr1,maxs(nclstr1),mu Line 599  c     $        ,nclstr1,maxs(nclstr1),mu
599  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
600    
601    
602        subroutine stripmask  c$$$      subroutine stripmask
603    c$$$
604    c$$$*     this routine set va1 and single-strip masks,
605    c$$$*     on the basis of the VA1 mask saved in the DB
606    c$$$*
607    c$$$*     mask(nviews,nva1_view,nstrips_va1) !strip mask
608    c$$$*     mask_vk(nviews,nva1_view)          !VA1 mask
609    c$$$*
610    c$$$      include 'commontracker.f'
611    c$$$      include 'level1.f'
612    c$$$      include 'common_reduction.f'
613    c$$$      include 'calib.f'
614    c$$$
615    c$$$*     init mask
616    c$$$      do iv=1,nviews
617    c$$$         do ivk=1,nva1_view
618    c$$$            do is=1,nstrips_va1
619    c$$$c               mask(iv,ivk,is) = mask_vk(iv,ivk)
620    c$$$               if( mask_vk(iv,ivk) .ne. -1)then
621    c$$$                  mask(iv,ivk,is) = 1
622    c$$$     $                 * mask_vk(iv,ivk)     !from DB
623    c$$$     $                 * mask_vk_ev(iv,ivk)  !from <SIG>
624    c$$$     $                 * mask_vk_run(iv,ivk) !from CN
625    c$$$               else
626    c$$$                  mask(iv,ivk,is) = -1
627    c$$$     $                 * mask_vk(iv,ivk)     !from DB
628    c$$$     $                 * mask_vk_ev(iv,ivk)  !from CN
629    c$$$               endif
630    c$$$            enddo
631    c$$$         enddo
632    c$$$      enddo
633    c$$$
634    c$$$
635    c$$$      return
636    c$$$      end
637    
638          subroutine stripmask(iv,ivk)
639    
640    *     -----------------------------------------------
641  *     this routine set va1 and single-strip masks,  *     this routine set va1 and single-strip masks,
642  *     on the basis of the VA1 mask saved in the DB  *     on the basis of the VA1 mask saved in the DB
643  *  *
644  *     mask(nviews,nva1_view,nstrips_va1) !strip mask  *     mask(nviews,nva1_view,nstrips_va1) !strip mask
645  *     mask_vk(nviews,nva1_view)          !VA1 mask  *     mask_vk(nviews,nva1_view)          !VA1 mask
646  *  *     -----------------------------------------------
647        include 'commontracker.f'        include 'commontracker.f'
648        include 'level1.f'        include 'level1.f'
649        include 'common_reduction.f'        include 'common_reduction.f'
650        include 'calib.f'        include 'calib.f'
651    
652  *     init mask  *     init mask
653        do iv=1,nviews        do is=1,nstrips_va1
654           do ivk=1,nva1_view  *        --------------------------------------------------------
655              do is=1,nstrips_va1  *        if VA1-mask from DB is 0 or 1, three masks are combined:
656  c               mask(iv,ivk,is) = mask_vk(iv,ivk)  *        - from DB (a-priori mask)
657                 mask(iv,ivk,is) = mask_vk(iv,ivk) * mask_vk_ev(iv,ivk)                *        - run-based (chip declared bad on the basis of <SIG>)
658              enddo  *        - event-based (failure in CN computation)
659           enddo  *        --------------------------------------------------------
660             if( mask_vk(iv,ivk) .ne. -1)then            
661                mask(iv,ivk,is) = 1
662         $           * mask_vk(iv,ivk)     !from DB
663         $           * mask_vk_ev(iv,ivk)  !from <SIG>
664         $           * mask_vk_run(iv,ivk) !from CN
665    *        -----------------------------------------------------------
666    *        if VA1-mask from DB is -1 only event-based mask is applied
667    *        -----------------------------------------------------------
668             else
669                mask(iv,ivk,is) = -1
670         $           * mask_vk(iv,ivk)     !from DB
671         $           * mask_vk_ev(iv,ivk)  !from CN
672             endif
673        enddo        enddo
674          
675          
676        return        return
677        end        end
   

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

  ViewVC Help
Powered by ViewVC 1.1.23