/[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.2 by pam-fi, Tue May 30 16:30:37 2006 UTC revision 1.13 by pam-fi, Thu Nov 23 18:51:45 2006 UTC
# Line 18  Line 18 
18        include 'common_reduction.f'        include 'common_reduction.f'
19        include 'calib.f'        include 'calib.f'
20                
21          data eventn_old/nviews*0/
22    
23        integer ierror        integer ierror
24        ierror = 0        ierror = 0
25    
 *     -------------------------------------------------------  
 *     STRIP MASK  
 *     -------------------------------------------------------  
   
       call stripmask  
26        call init_level1        call init_level1
27    
28        good1=good0  c      good1 = good0
29    c--------------------------------------------------
30    c     check the LEVEL0 event status for missing
31    c     sections or DSP alarms
32    c     ==> set the variable GOOD1(12)
33    c--------------------------------------------------
34          do iv=1,nviews
35             if(DSPnumber(iv).gt.0.and.DSPnumber(iv).le.12)then
36    c           ------------------------
37    c           GOOD
38    c           ------------------------
39                GOOD1(DSPnumber(iv))=0 !OK
40    c           ------------------------
41    c           CRC error
42    c           ------------------------
43                if(crc(iv).eq.1) then
44                   GOOD1(DSPnumber(iv)) = 2
45                   goto 18 !next view
46                endif
47    c           ------------------------
48    c           online-software alarm
49    c           ------------------------
50                if(
51         $           fl1(iv).ne.0.or.
52         $           fl2(iv).ne.0.or.
53         $           fl3(iv).ne.0.or.
54         $           fl4(iv).ne.0.or.
55         $           fl5(iv).ne.0.or.
56         $           fl6(iv).ne.0.or.
57         $           fc(iv).ne.0.or.
58         $           DATAlength(iv).eq.0.or.
59         $           .false.)then
60                   GOOD1(DSPnumber(iv))=3
61                   goto 18
62                endif
63    c           ------------------------
64    c           DSP-counter jump
65    c           ------------------------
66                if(
67         $           eventn_old(iv).ne.0.and. !first event in this file
68         $           eventn(iv).ne.1.and.     !first event in run
69         $           good_old(DSPnumber(iv)).ne.0.and. !previous event corrupted
70         $           .true.)then
71    
72                   if(eventn(iv).ne.(eventn_old(iv)+1))then
73                      GOOD1(DSPnumber(iv))=4
74                      goto 18
75                   endif
76    
77                endif
78    c           ------------------------
79     18         continue
80             endif
81          enddo
82    
83          ngood = 0
84          do iv = 1,nviews
85             eventn_old(iv) = eventn(iv)
86             good_old(iv)   = good1(iv)
87             ngood = ngood + good1(iv)
88          enddo
89    c      if(ngood.ne.0)print*,'* WARNING * LEVEL0 event status: '
90    c     $     ,(good1(i),i=1,nviews)
91  c--------------------------------------------------  c--------------------------------------------------
92  c     read the variable DATATRACKER from LEVEL0  c     read the variable DATATRACKER from LEVEL0
93  c     and fill the variable ADC (inverting view 11)  c     and fill the variable ADC (invertin view 11)
94  c--------------------------------------------------  c--------------------------------------------------
95        call filladc(iflag)        call filladc(iflag)
96        if(iflag.ne.0)then        if(iflag.ne.0)then
97          good1=0           ierror = 220
 c       if(DEBUG)print*,'event ',eventn(1),' >>>>>  decode ERROR'  
         ierror = -220  
         goto 200  
98        endif        endif
99    
100  c--------------------------------------------------  c--------------------------------------------------
101  c     computes common noise for each VA1  c     computes common noise for each VA1
102  c     (excluding strips affected by signal,  c     (excluding strips with signal,
103  c     tagged with the flag CLSTR)  c     tagged with the flag CLSTR)
104  c--------------------------------------------------  c--------------------------------------------------
105        do iv=1,nviews        do iv=1,nviews
106          do ik=1,nva1_view           ima=0
107            cn(iv,ik)=0           !initializes cn variable           do ik=1,nva1_view
108            iflag=0              cn(iv,ik)  = 0
109            if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik,iflag)              cnrms(iv,ik)  = 0
110            if(iflag.ne.0)good1=0              cnn(iv,ik) = -1
111          enddo              iflag=0
112                mask_vk_ev(iv,ik)=1
113                call stripmask(iv,ik)      !compute mask(i,j,k), combining VA1-masks
114    c     NBNBNBNBNB mask per la striscia 1 !!!!!!!!
115                if(mask(iv,ik,1).eq.1)call cncomp(iv,ik,iflag)
116                if(iflag.ne.0)then
117                   ima=ima+1
118                   mask_vk_ev(iv,ik)=0
119                   ierror = 220
120                endif
121                call stripmask(iv,ik)      !compute mask(i,j,k), combining VA1-masks
122                
123             enddo
124     100     format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
125             if(ima.ne.0.and.debug)write(*,100)eventn(1),iv
126         $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
127        enddo        enddo
128        if(good1.eq.0)then  
129           ierror = 220  cc      call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
 c         if(WARNING)  
 c     $     print*,' WARNING - cncomp: CN computation failure '  
       endif  
130    
131  c---------------------------------------------  c---------------------------------------------
132  c     loops on views, VA1 and strips,  c     loops on views, VA1 and strips,
# Line 66  c     and computes strips signals using Line 134  c     and computes strips signals using
134  c     badstrip, pedestals, and  c     badstrip, pedestals, and
135  c     sigma informations from histograms  c     sigma informations from histograms
136  c---------------------------------------------  c---------------------------------------------
       flag_shower = .false.  
137        ind=1                     !clsignal array index        ind=1                     !clsignal array index
138    
139        do iv=1,nviews            !loop on views        do iv=1,nviews            !loop on views
140          do is=1,nstrips_view    !loop on strips (1)          do is=1,nstrips_view    !loop on strips (1)
141            if(mod(iv,2).eq.1) then            if(mod(iv,2).eq.1) then
# Line 79  C===  > Y view Line 147  C===  > Y view
147       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
148              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
149       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
150  ccc            print*,"value(",is,")(reduction)= ",value(is)              sat(is)=0
151                if( adc(iv,nvk(is),nst(is)).lt.adc_saty )sat(is)=1
152            else                        else            
153  C===  > X view  C===  > X view
154              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
# Line 89  C===  > X view Line 158  C===  > X view
158       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
159              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
160       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
161                sat(is)=0
162                if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1
163            endif            endif
164          enddo                   !end loop on strips (1)          enddo                   !end loop on strips (1)
165          call search_cluster(iv)          call search_cluster(iv)
166          if(flag_shower.eqv..true.)then  
167            call init_level1                        if(.not.flag_shower)then
168            good1=0             call save_cluster(iv)
169            goto 200              !jump to next event          else
170               fshower(iv) = 1
171               GOOD1(DSPnumber(iv)) = 11
172          endif          endif
173        enddo                     ! end loop on views        enddo                     ! end loop on views
174        do iv=1,nviews        do iv=1,nviews
175          do ik=1,nva1_view          do ik=1,nva1_view
176            cnev(iv,ik)=cn(iv,ik) !assigns computed CN to ntuple variables            cnev(iv,ik)    = cn(iv,ik) !assigns computed CN to ntuple variables
177  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)            cnrmsev(iv,ik) = cnrms(iv,ik) !assigns computed CN to ntuple variables
178              cnnev(iv,ik)   = cnn(iv,ik) !assigns computed CN to ntuple variables
179          enddo          enddo
180        enddo        enddo
181  C---------------------------------------------  C---------------------------------------------
# Line 109  C     come here if GOOD1=0 Line 183  C     come here if GOOD1=0
183  C     or the event has too many clusters  C     or the event has too many clusters
184  C---------------------------------------------  C---------------------------------------------
185   200  continue   200  continue
186    
187          ngood = 0
188          do iv = 1,nviews
189             ngood = ngood + good1(iv)
190          enddo
191    c$$$      if(ngood.ne.0)print*,'* WARNING * Event ',eventn(1)
192    c$$$     $     ,':LEVEL1 event status: '
193    c$$$     $     ,(good1(i),i=1,nviews)
194  c------------------------------------------------------------------------  c------------------------------------------------------------------------
195  c  c
196  c     closes files and exits  c     closes files and exits
# Line 136  c--------------------------------------- Line 218  c---------------------------------------
218        include 'level1.f'        include 'level1.f'
219        include 'level0.f'        include 'level0.f'
220    
221        good1=0  c      good1 = 0
222        nclstr1=0        do iv=1,12
223        totCLlength=0           good1(iv) = 1 !missing packet
224          enddo
225          nclstr1 = 0
226          totCLlength = 0
227        do ic=1,nclstrmax        do ic=1,nclstrmax
228           view(ic)=0           view(ic) = 0
229           ladder(ic)=0           ladder(ic) = 0
230           indstart(ic)=0           indstart(ic) = 0
231           indmax(ic)=0           indmax(ic) = 0
232           maxs(ic)=0           maxs(ic) = 0
233           mult(ic)=0                     mult(ic) = 0          
234           dedx(ic)=0           dedx(ic) = 0
235             whichtrack(ic) = 0
236    
237        enddo        enddo
238        do id=1,maxlength         !???        do id=1,maxlength         !???
239           clsignal(id)=0.           clsignal(id) = 0.
240             clsigma(id)  = 0.
241             cladc(id)    = 0.
242             clbad(id)    = 0.
243        enddo        enddo
244        do iv=1,nviews        do iv=1,nviews
245  c        crc1(iv)=0  c        crc1(iv)=0
246          do ik=1,nva1_view          do ik=1,nva1_view
247            cnev(iv,ik)=0            cnev(iv,ik) = 0
248              cnnev(iv,ik) = 0
249          enddo          enddo
250            fshower(iv) = 0
251        enddo        enddo
252                
253        return        return
254        end        end
255    
256  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
257  *  *
258  *  *
# Line 171  c        crc1(iv)=0 Line 264  c        crc1(iv)=0
264        subroutine search_cluster(iv)        subroutine search_cluster(iv)
265    
266        include 'commontracker.f'        include 'commontracker.f'
       include 'common_reduction.f'  
267        include 'level0.f'        include 'level0.f'
268        include 'level1.f'        include 'level1.f'
269        include 'calib.f'        include 'calib.f'
270    
271          include 'common_reduction.f'
272            
273    
274  c     local variables  c     local variables
275        integer rmax,lmax         !estremi del cluster        integer rmax,lmax         !estremi del cluster
276        integer rstop,lstop       !per decidere quali strip includere nel cluster        integer rstop,lstop      
277                                  ! oltre il seed        integer first,last
278        integer first,last,diff   !per includere le strip giuste... !???        integer fsat,lsat
279    
280        integer multtemp          !temporary multiplicity variable        external nst
281    
282        integer CLlength          !lunghezza in strip del cluster        iseed=-999                !cluster seed index initialization
283    
284        external nst        inext=-999                !index where to start new cluster search
285    
286  c------------------------------------------------------------------------        flag_shower = .false.
287  c     looks for clusters on each view        nclstr_view=0
 C     : CERCO STRIP SOPRA CLSEEDCUT, POI SCORRO A DX FINCHE'  
 c     NON TROVO  
 C     STRIP PIU' BASSA (in segnale/rumore)  
 C     => L'ULTIMA DELLA SERIE CRESCENTE  
 C     (LA PIU' ALTA) E' IL  
 C     CLUSTER SEED. POI SCORRO A SX E DX INCLUDENDO TUTTE  
 C     LE STRIP (FINO A 17 AL  
 C     MAX) CHE SUPERANO CLINCLCUT.  
 C     QUANDO CERCO IL CLUSTER SEED SUCCESSIVO SALTO LA STRIP  
 C     ADIACENTE A DESTRA  
 C     DELL'ULTIMO CLUSTER SEED (CHE SARA' NECESSARIAMENTE  
 C     PIU' BASSA) E PRENDO  
 C     COME SEED UNA STRIP SOLO SE IL SUO SEGNALE E'  
 C     MAGGIORE DI QUELLO DELLA STRIP  
 C     PRECEDENTE (PRATICAMENTE PER EVITARE CHE L'ULTIMA  
 C     STRIP DI UN GRUPPO DI STRIP  
 C     TUTTE SOPRA IL CLSEEDCUT VENGA AUTOMATICAMENTE PRESA  
 C     COME SEED... DEVE ESSERE  
 C     PRESA SOLO SE IL CLUSTER E' DOUBLE PEAKED...)  
 c------------------------------------------------------------------------  
 c     6 ottobre 2003  
 c     Elena: CLSEEDCUT = 7 (old value 10)  
 c     Elena: CLINCLCUT = 4 (old value 5)  
288    
289        iseed=-999                !cluster seed index initialization        do jl=1,nladders_view              !1..3 !loops on ladders
290    
291             first = 1+nstrips_ladder*(jl-1) !1,1025,2049
292             last  = nstrips_ladder*jl       !1024,2048,3072
293    
294        do jl=1,nladders_view     !1..3 !loops on ladders  *        X views have 1018 strips instead of 1024
          first=1+nstrips_ladder*(jl-1) !1,1025,2049  
          last=nstrips_ladder*jl !1024,2048,3072  
 c     X views have 1018 strips instead of 1024  
295           if(mod(iv,2).eq.0) then           if(mod(iv,2).eq.0) then
296              first=first+3              first=first+3
297              last=last-3              last=last-3
298           endif           endif
299    
300           do is=first,last       !loop on strips in each ladder           do is=first,last       !loop on strips in each ladder
301              if(is.le.iseed+1) goto 220  
302  c-----------------------------------------  c---------------------------------------------
303  c     after a cluster seed as been found,  c     new-cluster search starts at index inext
304  c     look for next one skipping one strip on the right  c---------------------------------------------
305  c     (i.e. look for double peak cluster)              if(is.lt.inext) goto 220 ! next strip
306  c-----------------------------------------  
             if(is.ne.first) then  
                if(value(is).le.value(is-1)) goto 220  
             endif  
 c-----------------------------------------  
 c     skips cluster seed  
 c     finding if strips values are descreasing (a strip  
 c     can be a cluster seed only if previous strip value  
 c     is lower)  
 c-----------------------------------------  
307              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)  
308  c-----------------------------------------  c-----------------------------------------
309  c     possible SEED...  c     possible SEED...
310  c-----------------------------------------  c-----------------------------------------
311                 itemp=is                 itemp = is
312                   fsat = 0         ! first saturated strip
313                   lsat = 0         ! last saturated strip
314                 if(itemp.eq.last) goto 230 !estremo...                 if(itemp.eq.last) goto 230 !estremo...
315                 do while(value(itemp)  c              ------------------------                
316       $              /sigma(iv,nvk(itemp),nst(itemp))  c              search for first maximum
317       $              .le.value(itemp+1)  c              ------------------------
318       $              /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???                 do while(
319                    itemp=itemp+1       $                   value(itemp).le.value(itemp+1)
320                    if(itemp.eq.last) goto 230 !stops if reaches last strip       $              .and.value(itemp+1).gt.clseedcut(itemp+1))
321                      itemp = itemp+1
322                      if(itemp.eq.last)   goto 230 !stops if reaches last strip
323                      if(sat(itemp).eq.1) goto 230 !stop if reaches a saturated strip
324                 enddo            ! of the ladder                 enddo            ! of the ladder
325   230           continue   230           continue
326  c-----------------------------------------  c              -----------------------------
327    c              check if strips are saturated
328    c              -----------------------------    
329                   if( sat(itemp).eq.1 )then
330                      fsat = itemp
331                      lsat = itemp
332                      if(itemp.eq.last) goto 231 !estremo...
333                      do while( sat(itemp+1).eq.1 )
334                         itemp = itemp+1
335                         lsat = itemp
336                         if(itemp.eq.last)   goto 231 !stops if reaches last strip
337                      enddo                  
338                   endif
339     231           continue
340    c---------------------------------------------------------------------------
341  c     fownd SEED!!!  c     fownd SEED!!!
342  c-----------------------------------------  c     (if there are saturated strips, the cluster is centered in the middle)
343                 iseed=itemp      c---------------------------------------------------------------------------
344  c----------------------------------------------------------                 if(fsat.eq.0.and.lsat.eq.0)then
345                      iseed = itemp ! <<< SEED
346                   else
347                      iseed = int((lsat+fsat)/2) ! <<< SEED
348    c$$$                  print*,'saturated strips ',fsat,lsat,iseed
349    c$$$                  print*,'--> ',(value(ii),ii=fsat,lsat)
350                   endif    
351    c---------------------------------------------------------------
352  c     after finding a cluster seed, checks also adjacent strips,  c     after finding a cluster seed, checks also adjacent strips,
353  C     and marks the ones exceeding clinclcut  C     and tags the ones exceeding clinclcut
354  c----------------------------------------------------------  c---------------------------------------------------------------
355                 ir=iseed         !indici destro                 ir=iseed         !indici destro
356                 il=iseed         ! e sinistro                 il=iseed         ! e sinistro
357                                
# Line 276  c--------------------------------------- Line 362  c---------------------------------------
362                 lstop=0          ! inclusion loop                 lstop=0          ! inclusion loop
363    
364                 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
365                    ir=ir+1       !position index for strips on right side of  
366                                  ! cluster seed  
367                    il=il-1       !and for left side                    ir=ir+1       !index for right side
368                      il=il-1       !index for left side
369  c------------------------------------------------------------------------  c------------------------------------------------------------------------
370  c     checks for last or first strip of the ladder  c     checks for last or first strip of the ladder
371  c------------------------------------------------------------------------  c------------------------------------------------------------------------
372                    if(ir.gt.last) then !when index goes beyond last strip                    if( ir.gt.last  ) rstop = 1                      
373                       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  
374                                        
375  c------------------------------------------------------------------------  c------------------------------------------------------------------------
376  c     check for clusters including more than nclstrp strips  c     add strips exceeding inclusion cut
 c------------------------------------------------------------------------  
                   if((rmax-lmax+1).ge.nclstrp) then  
                      goto 210   !exits inclusion loop:  
                                 ! lmax and rmax maintain last value  
                                 ! NB .ge.!???  
                   endif  
377  c------------------------------------------------------------------------  c------------------------------------------------------------------------
378  c     marks strips exceeding inclusion cut                    if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
379  c------------------------------------------------------------------------  
380                    if(rstop.eq.0) then !if last strip of the ladder or last                    if(rstop.eq.0) then !if right cluster morder has not been reached
381                                  ! over-cut strip has not been reached                       if(value(ir).gt.clinclcut(ir)) then
382                       if(value(ir).gt.clinclcut(ir)) then !puts in rmax the                          rmax=ir !include a strip on the right
                         rmax=ir ! last right over-cut strip  
383                       else                       else
384                          rstop=1 !otherwise cluster ends on right and rstop                          rstop=1 !cluster right end
385                       endif      ! flag=1 signals it                       endif    
386                    endif                    endif
387                    if(lstop.eq.0) then  
388                      if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
389    
390                      if(lstop.eq.0) then !if left cluster morder has not been reached
391                       if(value(il).gt.clinclcut(il)) then                       if(value(il).gt.clinclcut(il)) then
392                          lmax=il                          lmax=il !include a strip on the left
393                       else                       else
394                          lstop=1                          lstop=1 !cluster left end
395                       endif                       endif
396                    endif                    endif
397    
398                 enddo            !ends strip inclusion loop                 enddo            !ends strip inclusion loop
399                   goto 211
400   210           continue         !jumps here if more than nclstrp have been included   210           continue         !jumps here if more than nclstrp have been included
401                        c               print*,'>>> nclstrp! '
402                 multtemp=rmax-lmax+1 !stores multiplicity in temp   211           continue
403                                  ! variable. NB rmax and lmax can change later in  c-----------------------------------------
404                                  ! order to include enough strips to calculate eta3  c     end of inclusion loop!
405                                  ! and eta4. so mult is not always equal to cllength  c-----------------------------------------
406  c------------------------------------------------------------------------                
407  c     NB per essere sicuro di poter calcolare eta3 e eta4 devo includere  c------------------------------------------------------------------------
408  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
409  c     adiacente ulteriore dalla parte della piu' alta fra queste due  c------------------------------------------------------------------------
410  c     (vedi oltre...)!???                 if(iseed.eq.lmax.and.lmax.ne.first)then
411  c------------------------------------------------------------------------                    lmax = lmax-1
412                      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                    
413                 endif                 endif
414                   if(iseed.eq.rmax.and.rmax.ne.last )then
415                      rmax = rmax+1
416                      if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
417                   endif
418    
419  c------------------------------------------------------------------------  c------------------------------------------------------------------------
420  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
421  c     strips, and the one adjacent to the greatest between this two strip, as the  c------------------------------------------------------------------------
422  c     fourth one. if the strips have the same value (!) the fourth one is chosen                 do while( (rmax-lmax+1).lt.nclstrpmin )
423  c     as the one having the greatest value between the second neighbors  
424  c------------------------------------------------------------------------                    vl = -99999
425                 if(value(iseed+1).eq.value(iseed-1)) then                    vr = -99999
426                    if(value(iseed+2).ge.value(iseed-2)) then !??? qui cmq c'e'                    if(lmax-1.ge.first) vl = value(lmax-1)
427                       diff=(iseed+2)-rmax                    if(rmax+1.le.last ) vr = value(rmax+1)
428                       if(diff.gt.0) then                    if(vr.ge.vl) then
429                          rmax=rmax+diff                       rmax = rmax+1
430                          if((rmax-lmax+1).gt.nclstrp) then                    else  
431                             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  
432                    endif                    endif
433                 endif                    
434   250           continue                 enddo
435    
436  c--------------------------------------------------------  c--------------------------------------------------------
437  c     fills ntuple variables  c     store cluster info
438  c--------------------------------------------------------  c--------------------------------------------------------
439                 nclstr1=nclstr1+1 !cluster number                 nclstr_view = nclstr_view + 1 !cluster number
440  ccc               print*,nclstr1,multtemp  
441                 if(nclstr1.gt.nclstrmax) then !too many clusters for the event:                 if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view:
442                    good1=0       ! event  c$$$                  if(verbose) print*,'Event ',eventn(1),
443                    nclstr1=0  c$$$     $                 ': more than ',nclstrmax_view
444                    totCLlength=0  c$$$     $                 ,' clusters on view ',iv
445                    flag_shower = .true.                    flag_shower = .true.
                   if(verbose)print*,'Event ',eventn(1),  
      $                 ': more than ',nclstrmax,' clusters'  
446                    goto 2000                    goto 2000
447                 endif                 endif
448                 view(nclstr1)=iv !vista del cluster  
449                 ladder(nclstr1)=nld(iseed,iv) !ladder a cui appartiene il cluster seed                 ladder_view(nclstr_view) = nld(iseed,iv)
450                 maxs(nclstr1)=iseed !strip del cluster seed                 maxs_view(nclstr_view)   = iseed
451                 mult(nclstr1)=multtemp !molteplicita'                 mult_view(nclstr_view)   = rmax-lmax+1
452                                 rmax_view(nclstr_view)   = rmax
453                 indstart(nclstr1)=ind !posizione dell'inizio del cluster nell'                 lmax_view(nclstr_view)   = lmax
454                                  ! array clsignal  
455                 indmax(nclstr1)=indstart(nclstr1)+(iseed-lmax) !posizione del  c$$$               if(rmax-lmax+1.gt.25)
456                                  ! cluster seed nell'array clsignal  c$$$     $              print*,'view ',iv
457    c$$$     $              ,' cl ',nclstr_view,' mult ',rmax-lmax+1
458    c------------------------------------------------------------------------
459    c     search for a double peak inside the cluster                                                                                                            
460    c------------------------------------------------------------------------
461                   inext = rmax+1   !<< index where to start new-cluster search
462                                
463                 CLlength=rmax-lmax+1 !numero di strip del cluster                 vmax = 0
464                 totCLlength=totCLlength+CLlength                 vmin = value(iseed)
465                 dedx(nclstr1)=0                 imax = iseed
466                 do j=lmax,rmax   !stores sequentially cluter strip values in                 imin = iseed
467                    clsignal(ind)=value(j) ! clsignal array                 do iss = max(iseed+1,lsat+1),rmax
468                    ind=ind+1                    if( value(iss).lt.vmin )then
469  c                  if(value(j).gt.0)                       if( imax.ne.iseed )goto 221 !found dowble peek
470                    if(value(j).gt.clinclcut(j))                       imin = iss
471       $                 dedx(nclstr1)=dedx(nclstr1)+value(j) !cluster charge                       vmin = value(iss)
472                      else
473                         delta = value(iss) - value(imin)
474                         cut = sqrt(clinclcut(iss)**2 + clinclcut(imin)**2)
475                         if(
476         $                    delta.gt.cut .and.
477         $                    value(iss).gt.clseedcut(iss).and.
478         $                    .true.)then
479                            if( value(iss).gt.vmax )then                        
480                               imax = iss
481                               vmax = value(iss)
482                            else
483                               goto 221 !found dowble peek
484                            endif
485                         endif
486                      endif
487                 enddo                 enddo
488     221           continue
489                  
490                   if(imax.gt.iseed)then
491                      inext = imax    !<< index where to start new-cluster search
492    c$$$                  print*,'--- double peek ---'
493    c$$$                  print*,(value(ii),ii=lmax,rmax)
494    c$$$                  print*,'seed ',iseed,' imin ',imin,' imax ',imax
495                   endif
496  c--------------------------------------------------------  c--------------------------------------------------------
497  c  c
498  c--------------------------------------------------------  c--------------------------------------------------------
# Line 515  c--------------------------------------- Line 514  c---------------------------------------
514  *  *
515  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
516    
517          subroutine save_cluster(iv)
518    *
519    *     (080/2006 Elena Vannuccini)
520    *     Save the clusters view by view
521    
522          include 'commontracker.f'
523          include 'level1.f'
524          include 'calib.f'
525          include 'common_reduction.f'
526    
527          integer CLlength          !lunghezza in strip del cluster
528    
529        subroutine stripmask        do ic=1,nclstr_view
530    
531             nclstr1 = nclstr1+1
532             view(nclstr1)   = iv
533             ladder(nclstr1) = ladder_view(ic)
534             maxs(nclstr1)   = maxs_view(ic)
535             mult(nclstr1)   = mult_view(ic)
536                  
537    c        posizione dell'inizio del cluster nell' array clsignal
538             indstart(nclstr1) = ind
539    c        posizione del cluster seed nell'array clsignal
540             indmax(nclstr1)   = indstart(nclstr1)
541         $        +( maxs_view(ic) - lmax_view(ic) )
542            
543             CLlength      = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate
544             totCLlength   = totCLlength + CLlength
545             dedx(nclstr1) = 0
546             do j=lmax_view(ic),rmax_view(ic)         !stores sequentially cluter strip values in
547    
548                clsignal(ind) = value(j) ! clsignal array
549    
550                ivk=nvk(j)
551                ist=nst(j)
552    
553                clsigma(ind) = sigma(iv,ivk,ist)
554                cladc(ind)   = adc(iv,ivk,ist)
555                clbad(ind)   = bad(iv,ivk,ist)
556    c            clped(ind)   = pedestal(iv,ivk,ist)
557    
558                ind=ind+1
559    c     if(value(j).gt.0)
560                if(value(j).gt.clinclcut(j))
561         $           dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge
562             enddo
563    
564    c         print*,'view ',iv,' -- save_cluster -- nclstr1: '
565    c     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),dedx(nclstr1)
566            
567          enddo
568          
569          return
570          end
571    *---***---***---***---***---***---***---***---***
572    *
573    *
574    *
575    *
576    *
577    *---***---***---***---***---***---***---***---***
578    
579    
580    c$$$      subroutine stripmask
581    c$$$
582    c$$$*     this routine set va1 and single-strip masks,
583    c$$$*     on the basis of the VA1 mask saved in the DB
584    c$$$*
585    c$$$*     mask(nviews,nva1_view,nstrips_va1) !strip mask
586    c$$$*     mask_vk(nviews,nva1_view)          !VA1 mask
587    c$$$*
588    c$$$      include 'commontracker.f'
589    c$$$      include 'level1.f'
590    c$$$      include 'common_reduction.f'
591    c$$$      include 'calib.f'
592    c$$$
593    c$$$*     init mask
594    c$$$      do iv=1,nviews
595    c$$$         do ivk=1,nva1_view
596    c$$$            do is=1,nstrips_va1
597    c$$$c               mask(iv,ivk,is) = mask_vk(iv,ivk)
598    c$$$               if( mask_vk(iv,ivk) .ne. -1)then
599    c$$$                  mask(iv,ivk,is) = 1
600    c$$$     $                 * mask_vk(iv,ivk)     !from DB
601    c$$$     $                 * mask_vk_ev(iv,ivk)  !from <SIG>
602    c$$$     $                 * mask_vk_run(iv,ivk) !from CN
603    c$$$               else
604    c$$$                  mask(iv,ivk,is) = -1
605    c$$$     $                 * mask_vk(iv,ivk)     !from DB
606    c$$$     $                 * mask_vk_ev(iv,ivk)  !from CN
607    c$$$               endif
608    c$$$            enddo
609    c$$$         enddo
610    c$$$      enddo
611    c$$$
612    c$$$
613    c$$$      return
614    c$$$      end
615    
616          subroutine stripmask(iv,ivk)
617    
618  *     this routine set va1 and single-strip masks,  *     this routine set va1 and single-strip masks,
619  *     on the basis of the VA1 mask saved in the DB  *     on the basis of the VA1 mask saved in the DB
# Line 526  c--------------------------------------- Line 623  c---------------------------------------
623  *  *
624        include 'commontracker.f'        include 'commontracker.f'
625        include 'level1.f'        include 'level1.f'
626          include 'common_reduction.f'
627        include 'calib.f'        include 'calib.f'
628    
629  *     init mask  *     init mask
630        do iv=1,nviews        do is=1,nstrips_va1
631           do ivk=1,nva1_view           if( mask_vk(iv,ivk) .ne. -1)then            
632              do is=1,nstrips_va1              mask(iv,ivk,is) = 1
633                 mask(iv,ivk,is) = mask_vk(iv,ivk)       $           * mask_vk(iv,ivk) !from DB
634              enddo       $           * mask_vk_ev(iv,ivk) !from <SIG>
635           enddo       $           * mask_vk_run(iv,ivk) !from CN
636             else
637                mask(iv,ivk,is) = -1
638         $           * mask_vk(iv,ivk) !from DB
639         $           * mask_vk_ev(iv,ivk) !from CN
640             endif
641        enddo        enddo
642          
643          
644        return        return
645        end        end
   

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.13

  ViewVC Help
Powered by ViewVC 1.1.23