/[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.10 by pam-fi, Thu Oct 26 16:22:38 2006 UTC
# Line 99  c     and fill the variable ADC (inverti Line 99  c     and fill the variable ADC (inverti
99  c--------------------------------------------------  c--------------------------------------------------
100        call filladc(iflag)        call filladc(iflag)
101        if(iflag.ne.0)then        if(iflag.ne.0)then
 c        good1=0!<<<<<<<<<<<<<<<  
 c       if(DEBUG)print*,'event ',eventn(1),' >>>>>  decode ERROR'  
102           ierror = 220           ierror = 220
 c        goto 200  
 c         print*,'filladc error'  
103        endif        endif
104    
105  c--------------------------------------------------  c--------------------------------------------------
106  c     computes common noise for each VA1  c     computes common noise for each VA1
107  c     (excluding strips affected by signal,  c     (excluding strips with signal,
108  c     tagged with the flag CLSTR)  c     tagged with the flag CLSTR)
109  c--------------------------------------------------  c--------------------------------------------------
110        do iv=1,nviews        do iv=1,nviews
111           ima=0           ima=0
112           do ik=1,nva1_view           do ik=1,nva1_view
113              cn(iv,ik)  = 0              cn(iv,ik)  = 0
114                cnrms(iv,ik)  = 0
115              cnn(iv,ik) = -1              cnn(iv,ik) = -1
116              mask_vk_ev(iv,ik)=1              mask_vk_ev(iv,ik)=1
117              iflag=0              iflag=0
118              if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik,iflag)              if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik,iflag)
 c     if(iflag.ne.0)good1=0  
119              if(iflag.ne.0)then              if(iflag.ne.0)then
120                 ima=ima+1                 ima=ima+1
121                 mask_vk_ev(iv,ik)=0                 mask_vk_ev(iv,ik)=0
122                 ierror = 220                 ierror = 220
 c$$$               if(verbose)  
 c$$$     $              print*,' * WARNING * Event ',eventn(1)  
 c$$$     $              ,': masked vk ',ik,' on view',iv  
123              endif              endif
124           enddo           enddo
125   100     format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)   100     format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
126  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  
127       $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)       $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
128        enddo        enddo
 c      if(good1.eq.0)then  
 c         ierror = 220  
 c      endif  
129    
130        call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk        call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
131    
132  c---------------------------------------------  c---------------------------------------------
133  c     loops on views, VA1 and strips,  c     loops on views, VA1 and strips,
134  c     and computes strips signals using  c     and computes strips signals using
135  c     badstrip, pedestals, and  c     badstrip, pedestals, and
136  c     sigma informations from histograms  c     sigma informations from histograms
137  c---------------------------------------------  c---------------------------------------------
       flag_shower = .false.  
138        ind=1                     !clsignal array index        ind=1                     !clsignal array index
139    
140        do iv=1,nviews            !loop on views        do iv=1,nviews            !loop on views
# Line 161  C===  > Y view Line 148  C===  > Y view
148       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
149              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
150       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
151  ccc            print*,"value(",is,")(reduction)= ",value(is)              sat(is)=0
152                if( adc(iv,nvk(is),nst(is)).lt.adc_saty )sat(is)=1
153            else                        else            
154  C===  > X view  C===  > X view
155              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
# Line 171  C===  > X view Line 159  C===  > X view
159       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
160              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
161       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
162                sat(is)=0
163                if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1
164            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)  
165          enddo                   !end loop on strips (1)          enddo                   !end loop on strips (1)
166          call search_cluster(iv)          call search_cluster(iv)
167  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  
168          if(.not.flag_shower)then          if(.not.flag_shower)then
169             call save_cluster(iv)             call save_cluster(iv)
170          else          else
171             fshower(iv) = 1             fshower(iv) = 1
172             GOOD1(DSPn) = 11             GOOD1(DSPnumber(iv)) = 11
173          endif          endif
174        enddo                     ! end loop on views        enddo                     ! end loop on views
175        do iv=1,nviews        do iv=1,nviews
176          do ik=1,nva1_view          do ik=1,nva1_view
177            cnev(iv,ik)  = cn(iv,ik) !assigns computed CN to ntuple variables            cnev(iv,ik)    = cn(iv,ik) !assigns computed CN to ntuple variables
178            cnnev(iv,ik) = cnn(iv,ik) !assigns computed CN to ntuple variables            cnrmsev(iv,ik) = cnrms(iv,ik) !assigns computed CN to ntuple variables
179  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)            cnnev(iv,ik)   = cnn(iv,ik) !assigns computed CN to ntuple variables
180          enddo          enddo
181        enddo        enddo
182  C---------------------------------------------  C---------------------------------------------
# Line 275  c        crc1(iv)=0 Line 253  c        crc1(iv)=0
253                
254        return        return
255        end        end
256    
257  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
258  *  *
259  *  *
# Line 295  c        crc1(iv)=0 Line 274  c        crc1(iv)=0
274    
275  c     local variables  c     local variables
276        integer rmax,lmax         !estremi del cluster        integer rmax,lmax         !estremi del cluster
277        integer rstop,lstop       !per decidere quali strip includere nel cluster        integer rstop,lstop      
278                                  ! oltre il seed        integer first,last
279        integer first,last,diff   !per includere le strip giuste... !???        integer fsat,lsat
   
       integer multtemp          !temporary multiplicity variable  
280    
281        external nst        external nst
282    
 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)  
   
283        iseed=-999                !cluster seed index initialization        iseed=-999                !cluster seed index initialization
284    
285          inext=-999                !index where to start new cluster search
286    
287          flag_shower = .false.
288        nclstr_view=0        nclstr_view=0
289    
290        do jl=1,nladders_view     !1..3 !loops on ladders        do jl=1,nladders_view              !1..3 !loops on ladders
291           first=1+nstrips_ladder*(jl-1) !1,1025,2049  
292           last=nstrips_ladder*jl !1024,2048,3072           first = 1+nstrips_ladder*(jl-1) !1,1025,2049
293  c     X views have 1018 strips instead of 1024           last  = nstrips_ladder*jl       !1024,2048,3072
294    
295    *        X views have 1018 strips instead of 1024
296           if(mod(iv,2).eq.0) then           if(mod(iv,2).eq.0) then
297              first=first+3              first=first+3
298              last=last-3              last=last-3
# Line 344  c     X views have 1018 strips instead o Line 300  c     X views have 1018 strips instead o
300    
301           do is=first,last       !loop on strips in each ladder           do is=first,last       !loop on strips in each ladder
302    
303              if(is.le.iseed+1) goto 220  c---------------------------------------------
304  *******************************************************  c     new-cluster search starts at index inext
305  *     Elena 08/2006  c---------------------------------------------
306  * 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  
 *******************************************************  
307    
308              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)  
309  c-----------------------------------------  c-----------------------------------------
310  c     possible SEED...  c     possible SEED...
311  c-----------------------------------------  c-----------------------------------------
312                 itemp=is                 itemp = is
313                   fsat = 0         ! first saturated strip
314                   lsat = 0         ! last saturated strip
315                 if(itemp.eq.last) goto 230 !estremo...                 if(itemp.eq.last) goto 230 !estremo...
316  ****************************************************  c              ------------------------                
317  *     modificato da Elena (08/2006) per salvare  c              search for first maximum
318  *     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  
319                 do while(                 do while(
320       $                   value(itemp).le.value(itemp+1)       $                   value(itemp).le.value(itemp+1)
321       $              .and.value(itemp+1).gt.clseedcut(itemp+1))       $              .and.value(itemp+1).gt.clseedcut(itemp+1))
322                    itemp=itemp+1                    itemp = itemp+1
323                    if(itemp.eq.last) goto 230 !stops if reaches last strip                    if(itemp.eq.last)   goto 230 !stops if reaches last strip
324                      if(sat(itemp).eq.1) goto 230 !stop if reaches a saturated strip
325                 enddo            ! of the ladder                 enddo            ! of the ladder
326   230           continue   230           continue
327  c-----------------------------------------  c              -----------------------------
328    c              check if strips are saturated
329    c              -----------------------------    
330                   if( sat(itemp).eq.1 )then
331                      fsat = itemp
332                      lsat = itemp
333                      if(itemp.eq.last) goto 231 !estremo...
334                      do while( sat(itemp+1).eq.1 )
335                         itemp = itemp+1
336                         lsat = itemp
337                         if(itemp.eq.last)   goto 231 !stops if reaches last strip
338                      enddo                  
339                   endif
340     231           continue
341    c---------------------------------------------------------------------------
342  c     fownd SEED!!!  c     fownd SEED!!!
343  c-----------------------------------------  c     (if there are saturated strips, the cluster is centered in the middle)
344                 iseed=itemp      c---------------------------------------------------------------------------
345  c----------------------------------------------------------                 if(fsat.eq.0.and.lsat.eq.0)then
346                      iseed = itemp ! <<< SEED
347                   else
348                      iseed = int((lsat+fsat)/2) ! <<< SEED
349    c$$$                  print*,'saturated strips ',fsat,lsat,iseed
350    c$$$                  print*,'--> ',(value(ii),ii=fsat,lsat)
351                   endif    
352    c---------------------------------------------------------------
353  c     after finding a cluster seed, checks also adjacent strips,  c     after finding a cluster seed, checks also adjacent strips,
354  C     and marks the ones exceeding clinclcut  C     and tags the ones exceeding clinclcut
355  c----------------------------------------------------------  c---------------------------------------------------------------
356                 ir=iseed         !indici destro                 ir=iseed         !indici destro
357                 il=iseed         ! e sinistro                 il=iseed         ! e sinistro
358                                
# Line 415  c--------------------------------------- Line 363  c---------------------------------------
363                 lstop=0          ! inclusion loop                 lstop=0          ! inclusion loop
364    
365                 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
366                    ir=ir+1       !position index for strips on right side of  
367                                  ! cluster seed  
368                    il=il-1       !and for left side                    ir=ir+1       !index for right side
369                      il=il-1       !index for left side
370  c------------------------------------------------------------------------  c------------------------------------------------------------------------
371  c     checks for last or first strip of the ladder  c     checks for last or first strip of the ladder
372  c------------------------------------------------------------------------  c------------------------------------------------------------------------
373                    if(ir.gt.last) then !when index goes beyond last strip                    if( ir.gt.last  ) rstop = 1                      
374                       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  
375                                        
376  c------------------------------------------------------------------------  c------------------------------------------------------------------------
377  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  
378  c------------------------------------------------------------------------  c------------------------------------------------------------------------
379  c     marks strips exceeding inclusion cut                    if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
380  c------------------------------------------------------------------------  
381                    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
382                                  ! over-cut strip has not been reached                       if(value(ir).gt.clinclcut(ir)) then
383                       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  
384                       else                       else
385                          rstop=1 !otherwise cluster ends on right and rstop                          rstop=1 !cluster right end
386                       endif      ! flag=1 signals it                       endif    
387                    endif                    endif
388                    if(lstop.eq.0) then  
389                      if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
390    
391                      if(lstop.eq.0) then !if left cluster morder has not been reached
392                       if(value(il).gt.clinclcut(il)) then                       if(value(il).gt.clinclcut(il)) then
393                          lmax=il                          lmax=il !include a strip on the left
394                       else                       else
395                          lstop=1                          lstop=1 !cluster left end
396                       endif                       endif
397                    endif                    endif
398    
399                 enddo            !ends strip inclusion loop                 enddo            !ends strip inclusion loop
400                   goto 211
401   210           continue         !jumps here if more than nclstrp have been included   210           continue         !jumps here if more than nclstrp have been included
402                        c               print*,'>>> nclstrp! '
403                 multtemp=rmax-lmax+1 !stores multiplicity in temp   211           continue
404                                  ! variable. NB rmax and lmax can change later in  c-----------------------------------------
405                                  ! order to include enough strips to calculate eta3  c     end of inclusion loop!
406                                  ! and eta4. so mult is not always equal to cllength  c-----------------------------------------
407  c------------------------------------------------------------------------                
408  c     NB per essere sicuro di poter calcolare eta3 e eta4 devo includere  c------------------------------------------------------------------------
409  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
410  c     adiacente ulteriore dalla parte della piu' alta fra queste due  c------------------------------------------------------------------------
411  c     (vedi oltre...)!???                 if(iseed.eq.lmax.and.lmax.ne.first)then
412  c------------------------------------------------------------------------                    lmax = lmax-1
413                      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                    
414                 endif                 endif
415                   if(iseed.eq.rmax.and.rmax.ne.last )then
416                      rmax = rmax+1
417                      if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
418                   endif
419    
420  c------------------------------------------------------------------------  c------------------------------------------------------------------------
421  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
422  c     strips, and the one adjacent to the greatest between this two strip, as the  c------------------------------------------------------------------------
423  c     fourth one. if the strips have the same value (!) the fourth one is chosen                 do while( (rmax-lmax+1).lt.nclstrpmin )
424  c     as the one having the greatest value between the second neighbors  
425  c------------------------------------------------------------------------                    vl = -99999
426                 if(value(iseed+1).eq.value(iseed-1)) then                    vr = -99999
427                    if(value(iseed+2).ge.value(iseed-2)) then !??? qui cmq c'e'                    if(lmax-1.ge.first) vl = value(lmax-1)
428                       diff=(iseed+2)-rmax                    if(rmax+1.le.last ) vr = value(rmax+1)
429                       if(diff.gt.0) then                    if(vr.ge.vl) then
430                          rmax=rmax+diff                       rmax = rmax+1
431                          if((rmax-lmax+1).gt.nclstrp) then                    else  
432                             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  
433                    endif                    endif
434                 endif                    
435   250           continue                 enddo
436    
437  c--------------------------------------------------------  c--------------------------------------------------------
438  c     fills cluster variables  c     store cluster info
439  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  
440                 nclstr_view = nclstr_view + 1 !cluster number                 nclstr_view = nclstr_view + 1 !cluster number
441  c               print*,'view ',iv,' -- search_cluster -- nclstr_view: '  
 c     $              ,nclstr_view  
442                 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:
443                    if(verbose) print*,'Event ',eventn(1),  c$$$                  if(verbose) print*,'Event ',eventn(1),
444       $                 ': more than ',nclstrmax_view  c$$$     $                 ': more than ',nclstrmax_view
445       $                 ,' clusters on view ',iv  c$$$     $                 ,' clusters on view ',iv
 c                  good1=0       ! event  
 c                  nclstr1=0  
 c                  totCLlength=0  
446                    flag_shower = .true.                    flag_shower = .true.
447                    goto 2000                    goto 2000
448                 endif                 endif
449    
450  c               view(nclstr1)   = iv !vista del cluster                 ladder_view(nclstr_view) = nld(iseed,iv)
451                 ladder_view(nclstr_view) = nld(iseed,iv) !ladder a cui appartiene il cluster seed                 maxs_view(nclstr_view)   = iseed
452                 maxs_view(nclstr_view)   = iseed !strip del cluster seed                 mult_view(nclstr_view)   = rmax-lmax+1
                mult_view(nclstr_view)   = multtemp !molteplicita'  
453                 rmax_view(nclstr_view)   = rmax                 rmax_view(nclstr_view)   = rmax
454                 lmax_view(nclstr_view)   = lmax                 lmax_view(nclstr_view)   = lmax
455    
456    c$$$               if(rmax-lmax+1.gt.25)
457    c$$$     $              print*,'view ',iv
458    c$$$     $              ,' cl ',nclstr_view,' mult ',rmax-lmax+1
459    c------------------------------------------------------------------------
460    c     search for a dowble peak inside the cluster                                                                                                            
461    c------------------------------------------------------------------------
462                   inext = rmax+1   !<< index where to start new-cluster search
463                  
464                   vmax = 0
465                   vmin = value(iseed)
466                   imax = iseed
467                   imin = iseed
468                   do iss = max(iseed+1,lsat+1),rmax
469                      if( value(iss).lt.vmin )then
470                         if( imax.ne.iseed )goto 221 !found dowble peek
471                         imin = iss
472                         vmin = value(iss)
473                      else
474                         delta = value(iss) - value(imin)
475                         cut = sqrt(clinclcut(iss)**2 + clinclcut(imin)**2)
476                         if(
477         $                    delta.gt.cut .and.
478         $                    value(iss).gt.clseedcut(iss).and.
479         $                    .true.)then
480                            if( value(iss).gt.vmax )then                        
481                               imax = iss
482                               vmax = value(iss)
483                            else
484                               goto 221 !found dowble peek
485                            endif
486                         endif
487                      endif
488                   enddo
489     221           continue
490                  
491                   if(imax.gt.iseed)then
492                      inext = imax    !<< index where to start new-cluster search
493    c$$$                  print*,'--- double peek ---'
494    c$$$                  print*,(value(ii),ii=lmax,rmax)
495    c$$$                  print*,'seed ',iseed,' imin ',imin,' imax ',imax
496                   endif
497  c--------------------------------------------------------  c--------------------------------------------------------
498  c  c
499  c--------------------------------------------------------  c--------------------------------------------------------

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

  ViewVC Help
Powered by ViewVC 1.1.23