/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/reductionflight.f
ViewVC logotype

Diff of /DarthVader/TrackerLevel2/src/F77/reductionflight.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by mocchiut, Fri May 19 13:15:56 2006 UTC revision 1.17 by pam-fi, Thu Mar 15 12:17:10 2007 UTC
# Line 10  Line 10 
10  *    *  
11  *************************************************************************  *************************************************************************
12    
13        subroutine reductionflight()        subroutine reductionflight(ierror)
14    
15        include 'commontracker.f'        include 'commontracker.f'
16        include 'level0.f'        include 'level0.f'
# Line 18  Line 18 
18        include 'common_reduction.f'        include 'common_reduction.f'
19        include 'calib.f'        include 'calib.f'
20                
21          data eventn_old/nviews*0/
22    
23  *     -------------------------------------------------------        integer ierror
24  *     STRIP MASK        ierror = 0
25  *     -------------------------------------------------------  
26    c$$$      debug = .true.
27    c$$$      verbose = .true.
28    c$$$      warning = .true.
29    
       call stripmask  
30        call init_level1        call init_level1
31    
32  C---------------------------------------------------        if(debug)print*,'-- check LEVEL0 status'
33  C     variables in blocks GENERAL and CPU are anyway filled  
34  C     in order to mantain sincronization among  c      good1 = good0
35  C     events at different levels  c--------------------------------------------------
36  C---------------------------------------------------  c     check the LEVEL0 event status for missing
37        good1=good0  c     sections or DSP alarms
38  c$$$      do iv=1,12  c     ==> set the variable GOOD1(12)
39  c$$$        crc1(iv)=crc(iv)  c--------------------------------------------------
40  c$$$      enddo        do iv=1,nviews
41  ccc      print*,'totdatalength(reduction)=',TOTDATAlength           if(DSPnumber(iv).gt.0.and.DSPnumber(iv).le.12)then
42  ccc      print*,''  c           ------------------------
43    c           GOOD
44    c           ------------------------
45                GOOD1(DSPnumber(iv))=0 !OK
46    c           ------------------------
47    c           CRC error
48    c           ------------------------
49                if(crc(iv).eq.1) then
50                   GOOD1(DSPnumber(iv)) = 2
51                   goto 18 !next view
52                endif
53    c           ------------------------
54    c           online-software alarm
55    c           ------------------------
56                if(
57         $           fl1(iv).ne.0.or.
58         $           fl2(iv).ne.0.or.
59         $           fl3(iv).ne.0.or.
60         $           fl4(iv).ne.0.or.
61         $           fl5(iv).ne.0.or.
62         $           fl6(iv).ne.0.or.
63         $           fc(iv).ne.0.or.
64         $           DATAlength(iv).eq.0.or.
65         $           .false.)then
66                   GOOD1(DSPnumber(iv))=3
67                   goto 18
68                endif
69    c           ------------------------
70    c           DSP-counter jump
71    c           ------------------------
72                if(
73         $           eventn_old(iv).ne.0.and. !first event in this file
74         $           eventn(iv).ne.1.and.     !first event in run
75         $           good_old(DSPnumber(iv)).ne.0.and. !previous event corrupted
76         $           .true.)then
77    
78                   if(eventn(iv).ne.(eventn_old(iv)+1))then
79                      GOOD1(DSPnumber(iv))=4
80                      goto 18
81                   endif
82    
83                endif
84    c           ------------------------
85     18         continue
86             endif
87          enddo
88    
89          ngood = 0
90          do iv = 1,nviews
91             eventn_old(iv) = eventn(iv)
92             good_old(iv)   = good1(iv)
93             ngood = ngood + good1(iv)
94          enddo
95          if(debug.and.ngood.ne.0)print*,'* WARNING * LEVEL0 event status: '
96         $     ,(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 (inverting 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
106          good1=0           ierror = 220
         print*,'event ',eventn(1),' >>>>>  decode ERROR'  
         goto 200  
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          do ik=1,nva1_view           ima=0
118            cn(iv,ik)=0           !initializes cn variable           do ik=1,nva1_view
119            if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik)              cn(iv,ik)  = 0
120          enddo              cnrms(iv,ik)  = 0
121                cnn(iv,ik) = -1
122                iflag=0
123                mask_vk_ev(iv,ik)=1
124                call stripmask(iv,ik)      !compute mask(i,j,k), combining VA1-masks
125    c     NBNBNBNBNB mask per la striscia 1 !!!!!!!!
126                if(mask(iv,ik,1).eq.1)call cncomp(iv,ik,iflag)
127                if(iflag.ne.0)then
128                   ima=ima+1
129                   mask_vk_ev(iv,ik)=0
130                   ierror = 220
131                endif
132                call stripmask(iv,ik)      !compute mask(i,j,k), combining VA1-masks
133                
134             enddo
135     100     format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1)
136             if(ima.ne.0.and.debug)write(*,100)eventn(1),iv
137         $        ,(mask_vk_ev(iv,ik),ik=1,nva1_view)
138        enddo        enddo
139    
140    cc      call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk
141    
142  c---------------------------------------------  c---------------------------------------------
143  c     loops on views, VA1 and strips,  c     loops on views, VA1 and strips,
# Line 67  c     and computes strips signals using Line 145  c     and computes strips signals using
145  c     badstrip, pedestals, and  c     badstrip, pedestals, and
146  c     sigma informations from histograms  c     sigma informations from histograms
147  c---------------------------------------------  c---------------------------------------------
       flag_shower = .false.  
148        ind=1                     !clsignal array index        ind=1                     !clsignal array index
149    
150          if(debug)print*,'-- search clusters'
151        do iv=1,nviews            !loop on views        do iv=1,nviews            !loop on views
152          do is=1,nstrips_view    !loop on strips (1)          do is=1,nstrips_view    !loop on strips (1)
153            if(mod(iv,2).eq.1) then            if(mod(iv,2).eq.1) then
# Line 80  C===  > Y view Line 159  C===  > Y view
159       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
160              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is))
161       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
162  ccc            print*,"value(",is,")(reduction)= ",value(is)              sat(is)=0
163                if( adc(iv,nvk(is),nst(is)).lt.adc_saty )sat(is)=1
164            else                        else            
165  C===  > X view  C===  > X view
166              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))              value(is)= (DBLE(adc(iv,nvk(is),nst(is)))
# Line 90  C===  > X view Line 170  C===  > X view
170       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
171              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))              clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is))
172       $           *mask(iv,nvk(is),nst(is))       $           *mask(iv,nvk(is),nst(is))
173                sat(is)=0
174                if( adc(iv,nvk(is),nst(is)).gt.adc_satx )sat(is)=1
175            endif            endif
176          enddo                   !end loop on strips (1)          enddo                   !end loop on strips (1)
177          call search_cluster(iv)          call search_cluster(iv)
178          if(flag_shower.eqv..true.)then  
179            call init_level1                        if(.not.flag_shower)then
180            good1=0             call save_cluster(iv)
181            goto 200              !jump to next event             if(debug)print*,'view ',iv,' #clusters ', nclstr_view
182            else
183               fshower(iv) = 1
184    c           GOOD1(DSPnumber(iv)) = 11 !AHAHAHAHA ORRORE!!
185               GOOD1(iv) = 11
186     101       format(' * WARNING * Event ',i7,' view',i3
187         $          ,' #clusters > ',i5,' --> MASKED')
188               if(debug)write(*,101)eventn(1),iv,nclstrmax_view
189          endif          endif
190        enddo                     ! end loop on views        enddo                     ! end loop on views
191        do iv=1,nviews        do iv=1,nviews
192          do ik=1,nva1_view          do ik=1,nva1_view
193            cnev(iv,ik)=cn(iv,ik) !assigns computed CN to ntuple variables            cnev(iv,ik)    = cn(iv,ik) !assigns computed CN to ntuple variables
194  ccc          print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik)            cnrmsev(iv,ik) = cnrms(iv,ik) !assigns computed CN to ntuple variables
195              cnnev(iv,ik)   = cnn(iv,ik) !assigns computed CN to ntuple variables
196          enddo          enddo
197        enddo        enddo
 c$$$      nevent_good = nevent_good + 1  
         
198  C---------------------------------------------  C---------------------------------------------
199  C     come here if GOOD1=0  C     come here if GOOD1=0
200  C     or the event has too many clusters  C     or the event has too many clusters
201  C---------------------------------------------  C---------------------------------------------
   
202   200  continue   200  continue
203  ccc      print*,'nclstr1(reduction)=',nclstr1  
204          ngood = 0
205          do iv = 1,nviews
206             ngood = ngood + good1(iv)
207          enddo
208          if(debug.and.ngood.ne.0)print*,'* WARNING * Event ',eventn(1)
209         $     ,':LEVEL1 event status: '
210         $     ,(good1(i),i=1,nviews)
211  c------------------------------------------------------------------------  c------------------------------------------------------------------------
212  c      c
213  c     closes files and exits  c     closes files and exits
214  c      c
215  c------------------------------------------------------------------------  c------------------------------------------------------------------------
216                      RETURN
217        RETURN                          END
       END                        
218    
219  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***  ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...***
220  *  *
# Line 142  c--------------------------------------- Line 235  c---------------------------------------
235        include 'level1.f'        include 'level1.f'
236        include 'level0.f'        include 'level0.f'
237    
238        good1=0  c      good1 = 0
239        nclstr1=0        do iv=1,12
240        totCLlength=0           good1(iv) = 1 !missing packet
241          enddo
242          nclstr1 = 0
243          totCLlength = 0
244        do ic=1,nclstrmax        do ic=1,nclstrmax
245           view(ic)=0           view(ic) = 0
246           ladder(ic)=0           ladder(ic) = 0
247           indstart(ic)=0           indstart(ic) = 0
248           indmax(ic)=0           indmax(ic) = 0
249           maxs(ic)=0           maxs(ic) = 0
250           mult(ic)=0                     mult(ic) = 0          
251           dedx(ic)=0           sgnl(ic) = 0
252             whichtrack(ic) = 0     !assigned @ level2
253    
254        enddo        enddo
255        do id=1,maxlength         !???        do id=1,maxlength         !???
256           clsignal(id)=0.           clsignal(id) = 0.
257             clsigma(id)  = 0.
258             cladc(id)    = 0.
259             clbad(id)    = 0.
260        enddo        enddo
261        do iv=1,nviews        do iv=1,nviews
262  c        crc1(iv)=0  c        crc1(iv)=0
263          do ik=1,nva1_view          do ik=1,nva1_view
264            cnev(iv,ik)=0            cnev(iv,ik) = 0
265              cnnev(iv,ik) = 0
266          enddo          enddo
267            fshower(iv) = 0
268        enddo        enddo
269                
270        return        return
271        end        end
272    
273  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
274  *  *
275  *  *
# Line 177  c        crc1(iv)=0 Line 281  c        crc1(iv)=0
281        subroutine search_cluster(iv)        subroutine search_cluster(iv)
282    
283        include 'commontracker.f'        include 'commontracker.f'
       include 'common_reduction.f'  
284        include 'level0.f'        include 'level0.f'
285        include 'level1.f'        include 'level1.f'
286        include 'calib.f'        include 'calib.f'
287    
288          include 'common_reduction.f'
289            
290    
291  c     local variables  c     local variables
292        integer rmax,lmax         !estremi del cluster        integer rmax,lmax         !estremi del cluster
293        integer rstop,lstop       !per decidere quali strip includere nel cluster        integer rstop,lstop      
294                                  ! oltre il seed        integer first,last
295        integer first,last,diff   !per includere le strip giuste... !???        integer fsat,lsat
296    
297        integer multtemp          !temporary multiplicity variable        external nst
298    
299        integer CLlength          !lunghezza in strip del cluster        iseed=-999                !cluster seed index initialization
300    
301        external nst        inext=-999                !index where to start new cluster search
302    
303  c------------------------------------------------------------------------        flag_shower = .false.
304  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)  
305    
306        iseed=-999                !cluster seed index initialization        do jl=1,nladders_view              !1..3 !loops on ladders
307    
308        do jl=1,nladders_view     !1..3 !loops on ladders           first = 1+nstrips_ladder*(jl-1) !1,1025,2049
309           first=1+nstrips_ladder*(jl-1) !1,1025,2049           last  = nstrips_ladder*jl       !1024,2048,3072
310           last=nstrips_ladder*jl !1024,2048,3072  
311  c     X views have 1018 strips instead of 1024  *        X views have 1018 strips instead of 1024
312           if(mod(iv,2).eq.0) then           if(mod(iv,2).eq.0) then
313              first=first+3              first=first+3
314              last=last-3              last=last-3
315           endif           endif
316    
317           do is=first,last       !loop on strips in each ladder           do is=first,last       !loop on strips in each ladder
318              if(is.le.iseed+1) goto 220  
319  c-----------------------------------------  c---------------------------------------------
320  c     after a cluster seed as been found,  c     new-cluster search starts at index inext
321  c     look for next one skipping one strip on the right  c---------------------------------------------
322  c     (i.e. look for double peak cluster)              if(is.lt.inext) goto 220 ! next strip
323  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-----------------------------------------  
324              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)  
325  c-----------------------------------------  c-----------------------------------------
326  c     possible SEED...  c     possible SEED...
327  c-----------------------------------------  c-----------------------------------------
328                 itemp=is                 itemp = is
329                   fsat = 0         ! first saturated strip
330                   lsat = 0         ! last saturated strip
331                 if(itemp.eq.last) goto 230 !estremo...                 if(itemp.eq.last) goto 230 !estremo...
332                 do while(value(itemp)  c              ------------------------                
333       $              /sigma(iv,nvk(itemp),nst(itemp))  c              search for first maximum
334       $              .le.value(itemp+1)  c              ------------------------
335       $              /sigma(iv,nvk(itemp+1),nst(itemp+1))) !BIAS: aggiustare il caso uguale!???                 do while(
336                    itemp=itemp+1       $                   value(itemp).le.value(itemp+1)
337                    if(itemp.eq.last) goto 230 !stops if reaches last strip       $              .and.value(itemp+1).gt.clseedcut(itemp+1))
338                      itemp = itemp+1
339                      if(itemp.eq.last)   goto 230 !stops if reaches last strip
340                      if(sat(itemp).eq.1) goto 230 !stop if reaches a saturated strip
341                 enddo            ! of the ladder                 enddo            ! of the ladder
342   230           continue   230           continue
343  c-----------------------------------------  c              -----------------------------
344    c              check if strips are saturated
345    c              -----------------------------    
346                   if( sat(itemp).eq.1 )then
347                      fsat = itemp
348                      lsat = itemp
349                      if(itemp.eq.last) goto 231 !estremo...
350                      do while( sat(itemp+1).eq.1 )
351                         itemp = itemp+1
352                         lsat = itemp
353                         if(itemp.eq.last)   goto 231 !stops if reaches last strip
354                      enddo                  
355                   endif
356     231           continue
357    c---------------------------------------------------------------------------
358  c     fownd SEED!!!  c     fownd SEED!!!
359  c-----------------------------------------  c     (if there are saturated strips, the cluster is centered in the middle)
360                 iseed=itemp      c---------------------------------------------------------------------------
361  c----------------------------------------------------------                 if(fsat.eq.0.and.lsat.eq.0)then
362                      iseed = itemp ! <<< SEED
363                   else
364                      iseed = int((lsat+fsat)/2) ! <<< SEED
365    c$$$                  print*,'saturated strips ',fsat,lsat,iseed
366    c$$$                  print*,'--> ',(value(ii),ii=fsat,lsat)
367                   endif    
368    c---------------------------------------------------------------
369  c     after finding a cluster seed, checks also adjacent strips,  c     after finding a cluster seed, checks also adjacent strips,
370  C     and marks the ones exceeding clinclcut  C     and tags the ones exceeding clinclcut
371  c----------------------------------------------------------  c---------------------------------------------------------------
372                 ir=iseed         !indici destro                 ir=iseed         !indici destro
373                 il=iseed         ! e sinistro                 il=iseed         ! e sinistro
374                                
# Line 282  c--------------------------------------- Line 379  c---------------------------------------
379                 lstop=0          ! inclusion loop                 lstop=0          ! inclusion loop
380    
381                 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
382                    ir=ir+1       !position index for strips on right side of  
383                                  ! cluster seed  
384                    il=il-1       !and for left side                    ir=ir+1       !index for right side
385                      il=il-1       !index for left side
386  c------------------------------------------------------------------------  c------------------------------------------------------------------------
387  c     checks for last or first strip of the ladder  c     checks for last or first strip of the ladder
388  c------------------------------------------------------------------------  c------------------------------------------------------------------------
389                    if(ir.gt.last) then !when index goes beyond last strip                    if( ir.gt.last  ) rstop = 1                      
390                       rstop=1    ! of the ladder, change rstop flag in order                    if( il.lt.first ) lstop = 1
                                 ! to "help" exiting from loop  
                   endif  
391                                        
                   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  
392  c------------------------------------------------------------------------  c------------------------------------------------------------------------
393                    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  
394  c------------------------------------------------------------------------  c------------------------------------------------------------------------
395                    if(rstop.eq.0) then !if last strip of the ladder or last                    if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
396                                  ! over-cut strip has not been reached  
397                       if(value(ir).gt.clinclcut(ir)) then !puts in rmax the                    if(rstop.eq.0) then !if right cluster morder has not been reached
398                          rmax=ir ! last right over-cut strip                       if(value(ir).gt.clinclcut(ir)) then
399                            rmax=ir !include a strip on the right
400                       else                       else
401                          rstop=1 !otherwise cluster ends on right and rstop                          rstop=1 !cluster right end
402                       endif      ! flag=1 signals it                       endif    
403                    endif                    endif
404                    if(lstop.eq.0) then  
405                      if( (rmax-lmax+1).ge.nclstrp )goto 210   !exits inclusion loop
406    
407                      if(lstop.eq.0) then !if left cluster morder has not been reached
408                       if(value(il).gt.clinclcut(il)) then                       if(value(il).gt.clinclcut(il)) then
409                          lmax=il                          lmax=il !include a strip on the left
410                       else                       else
411                          lstop=1                          lstop=1 !cluster left end
412                       endif                       endif
413                    endif                    endif
414    
415                 enddo            !ends strip inclusion loop                 enddo            !ends strip inclusion loop
416                   goto 211
417   210           continue         !jumps here if more than nclstrp have been included   210           continue         !jumps here if more than nclstrp have been included
418                        c               print*,'>>> nclstrp! '
419                 multtemp=rmax-lmax+1 !stores multiplicity in temp   211           continue
420                                  ! variable. NB rmax and lmax can change later in  c-----------------------------------------
421                                  ! order to include enough strips to calculate eta3  c     end of inclusion loop!
422                                  ! and eta4. so mult is not always equal to cllength  c-----------------------------------------
423  c------------------------------------------------------------------------                
424  c     NB per essere sicuro di poter calcolare eta3 e eta4 devo includere  c------------------------------------------------------------------------
425  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
426  c     adiacente ulteriore dalla parte della piu' alta fra queste due  c------------------------------------------------------------------------
427  c     (vedi oltre...)!???                 if(iseed.eq.lmax.and.lmax.ne.first)then
428  c------------------------------------------------------------------------                    lmax = lmax-1
429                      if( (rmax-lmax+1).gt.nclstrp )rmax=rmax-1
430  c     nel caso di estremi del ladder...!???                 endif
431                   if(iseed.eq.rmax.and.rmax.ne.last )then
432  c     ho meno di 4 strip nel cluster --> se sono sui bordi o quasi del ladder                    rmax = rmax+1
433  c     costruisco il cluster ad hoc e poi esco, se non sono sui bordi o quasi                    if( (rmax-lmax+1).gt.nclstrp )lmax=lmax+1
 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                    
434                 endif                 endif
435    
436  c------------------------------------------------------------------------  c------------------------------------------------------------------------
437  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
438  c     strips, and the one adjacent to the greatest between this two strip, as the  c------------------------------------------------------------------------
439  c     fourth one. if the strips have the same value (!) the fourth one is chosen                 do while( (rmax-lmax+1).lt.nclstrpmin )
440  c     as the one having the greatest value between the second neighbors  
441  c------------------------------------------------------------------------                    vl = -99999
442                 if(value(iseed+1).eq.value(iseed-1)) then                    vr = -99999
443                    if(value(iseed+2).ge.value(iseed-2)) then !??? qui cmq c'e'                    if(lmax-1.ge.first) vl = value(lmax-1)
444                       diff=(iseed+2)-rmax                    if(rmax+1.le.last ) vr = value(rmax+1)
445                       if(diff.gt.0) then                    if(vr.ge.vl) then
446                          rmax=rmax+diff                       rmax = rmax+1
447                          if((rmax-lmax+1).gt.nclstrp) then                    else  
448                             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  
449                    endif                    endif
450                 endif                    
451   250           continue                 enddo
452    
453  c--------------------------------------------------------  c--------------------------------------------------------
454  c     fills ntuple variables  c     store cluster info
455  c--------------------------------------------------------  c--------------------------------------------------------
456                 nclstr1=nclstr1+1 !cluster number                 nclstr_view = nclstr_view + 1 !cluster number
457  ccc               print*,nclstr1,multtemp  
458                 if(nclstr1.gt.nclstrmax) then !too many clusters for the event:                 if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view:
459                    good1=0       ! event  c$$$                  if(verbose) print*,'Event ',eventn(1),
460                    nclstr1=0  c$$$     $                 ': more than ',nclstrmax_view
461                    totCLlength=0  c$$$     $                 ,' clusters on view ',iv
462                    flag_shower = .true.                    flag_shower = .true.
                   print*,'Event ',eventn(1),  
      $                 ': more than ',nclstrmax,' clusters'  
463                    goto 2000                    goto 2000
464                 endif                 endif
465                 view(nclstr1)=iv !vista del cluster  
466                 ladder(nclstr1)=nld(iseed,iv) !ladder a cui appartiene il cluster seed                 ladder_view(nclstr_view) = nld(iseed,iv)
467                 maxs(nclstr1)=iseed !strip del cluster seed                 maxs_view(nclstr_view)   = iseed
468                 mult(nclstr1)=multtemp !molteplicita'                 mult_view(nclstr_view)   = rmax-lmax+1
469                                 rmax_view(nclstr_view)   = rmax
470                 indstart(nclstr1)=ind !posizione dell'inizio del cluster nell'                 lmax_view(nclstr_view)   = lmax
471                                  ! array clsignal  
472                 indmax(nclstr1)=indstart(nclstr1)+(iseed-lmax) !posizione del  c$$$               if(rmax-lmax+1.gt.25)
473                                  ! cluster seed nell'array clsignal  c$$$     $              print*,'view ',iv
474    c$$$     $              ,' cl ',nclstr_view,' mult ',rmax-lmax+1
475    c------------------------------------------------------------------------
476    c     search for a double peak inside the cluster                                                                                                            
477    c------------------------------------------------------------------------
478                   inext = rmax+1   !<< index where to start new-cluster search
479                                
480                 CLlength=rmax-lmax+1 !numero di strip del cluster                 vmax = 0
481                 totCLlength=totCLlength+CLlength                 vmin = value(iseed)
482                 dedx(nclstr1)=0                 imax = iseed
483                 do j=lmax,rmax   !stores sequentially cluter strip values in                 imin = iseed
484                    clsignal(ind)=value(j) ! clsignal array                 do iss = max(iseed+1,lsat+1),rmax
485                    ind=ind+1                    if( value(iss).lt.vmin )then
486  c                  if(value(j).gt.0)                       if( imax.ne.iseed )goto 221 !found dowble peek
487                    if(value(j).gt.clinclcut(j))                       imin = iss
488       $                 dedx(nclstr1)=dedx(nclstr1)+value(j) !cluster charge                       vmin = value(iss)
489                      else
490                         delta = value(iss) - value(imin)
491                         cut = sqrt(clinclcut(iss)**2 + clinclcut(imin)**2)
492                         if(
493         $                    delta.gt.cut .and.
494         $                    value(iss).gt.clseedcut(iss).and.
495         $                    .true.)then
496                            if( value(iss).gt.vmax )then                        
497                               imax = iss
498                               vmax = value(iss)
499                            else
500                               goto 221 !found dowble peek
501                            endif
502                         endif
503                      endif
504                 enddo                 enddo
505     221           continue
506                  
507                   if(imax.gt.iseed)then
508                      inext = imax    !<< index where to start new-cluster search
509    c$$$                  print*,'--- double peek ---'
510    c$$$                  print*,(value(ii),ii=lmax,rmax)
511    c$$$                  print*,'seed ',iseed,' imin ',imin,' imax ',imax
512                   endif
513  c--------------------------------------------------------  c--------------------------------------------------------
514  c      c
515  c--------------------------------------------------------  c--------------------------------------------------------
516              endif               !end possible seed conditio              endif               !end possible seed conditio
517   220        continue            !jumps here to skip strips left of last seed   220        continue            !jumps here to skip strips left of last seed
# Line 522  c--------------------------------------- Line 531  c---------------------------------------
531  *  *
532  *---***---***---***---***---***---***---***---***  *---***---***---***---***---***---***---***---***
533    
534          subroutine save_cluster(iv)
535    *
536    *     (080/2006 Elena Vannuccini)
537    *     Save the clusters view by view
538    
539        subroutine stripmask        include 'commontracker.f'
540          include 'level1.f'
541          include 'calib.f'
542          include 'common_reduction.f'
543    
544          integer CLlength          !lunghezza in strip del cluster
545    
546          do ic=1,nclstr_view
547    
548             nclstr1 = nclstr1+1
549             view(nclstr1)   = iv
550             ladder(nclstr1) = ladder_view(ic)
551             maxs(nclstr1)   = maxs_view(ic)
552             mult(nclstr1)   = mult_view(ic)
553                  
554    c        posizione dell'inizio del cluster nell' array clsignal
555             indstart(nclstr1) = ind
556    c        posizione del cluster seed nell'array clsignal
557             indmax(nclstr1)   = indstart(nclstr1)
558         $        +( maxs_view(ic) - lmax_view(ic) )
559            
560             CLlength      = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate
561             totCLlength   = totCLlength + CLlength
562             sgnl(nclstr1) = 0
563             do j=lmax_view(ic),rmax_view(ic)         !stores sequentially cluter strip values in
564    
565                clsignal(ind) = value(j) ! clsignal array
566    
567                ivk=nvk(j)
568                ist=nst(j)
569    
570                clsigma(ind) = sigma(iv,ivk,ist)
571                cladc(ind)   = adc(iv,ivk,ist)
572                clbad(ind)   = bad(iv,ivk,ist)
573    c            clped(ind)   = pedestal(iv,ivk,ist)
574    
575                ind=ind+1
576    c     if(value(j).gt.0)
577                if(value(j).gt.clinclcut(j))
578         $           sgnl(nclstr1) = sgnl(nclstr1) + value(j) !cluster charge
579             enddo
580    
581    c         print*,'view ',iv,' -- save_cluster -- nclstr1: '
582    c     $        ,nclstr1,maxs(nclstr1),mult(nclstr1),sgnl(nclstr1)
583            
584          enddo
585          
586          return
587          end
588    *---***---***---***---***---***---***---***---***
589    *
590    *
591    *
592    *
593    *
594    *---***---***---***---***---***---***---***---***
595    
596    
597    c$$$      subroutine stripmask
598    c$$$
599    c$$$*     this routine set va1 and single-strip masks,
600    c$$$*     on the basis of the VA1 mask saved in the DB
601    c$$$*
602    c$$$*     mask(nviews,nva1_view,nstrips_va1) !strip mask
603    c$$$*     mask_vk(nviews,nva1_view)          !VA1 mask
604    c$$$*
605    c$$$      include 'commontracker.f'
606    c$$$      include 'level1.f'
607    c$$$      include 'common_reduction.f'
608    c$$$      include 'calib.f'
609    c$$$
610    c$$$*     init mask
611    c$$$      do iv=1,nviews
612    c$$$         do ivk=1,nva1_view
613    c$$$            do is=1,nstrips_va1
614    c$$$c               mask(iv,ivk,is) = mask_vk(iv,ivk)
615    c$$$               if( mask_vk(iv,ivk) .ne. -1)then
616    c$$$                  mask(iv,ivk,is) = 1
617    c$$$     $                 * mask_vk(iv,ivk)     !from DB
618    c$$$     $                 * mask_vk_ev(iv,ivk)  !from <SIG>
619    c$$$     $                 * mask_vk_run(iv,ivk) !from CN
620    c$$$               else
621    c$$$                  mask(iv,ivk,is) = -1
622    c$$$     $                 * mask_vk(iv,ivk)     !from DB
623    c$$$     $                 * mask_vk_ev(iv,ivk)  !from CN
624    c$$$               endif
625    c$$$            enddo
626    c$$$         enddo
627    c$$$      enddo
628    c$$$
629    c$$$
630    c$$$      return
631    c$$$      end
632    
633          subroutine stripmask(iv,ivk)
634    
635  *     this routine set va1 and single-strip masks,  *     this routine set va1 and single-strip masks,
636  *     on the basis of the VA1 mask saved in the DB  *     on the basis of the VA1 mask saved in the DB
# Line 533  c--------------------------------------- Line 640  c---------------------------------------
640  *  *
641        include 'commontracker.f'        include 'commontracker.f'
642        include 'level1.f'        include 'level1.f'
643          include 'common_reduction.f'
644        include 'calib.f'        include 'calib.f'
645    
 c$$$      character*20 data_file  
 c$$$  
 c$$$      character*3 aid  
 c$$$      character*6 adate  
 c$$$      integer id  
 c$$$      integer date  
 c$$$  
 c$$$*     ----------------------  
 c$$$*     retrieve date and id  
 c$$$      aid=data_file(8:10)  
 c$$$      adate=data_file(2:6)  
 c$$$      READ (aid, '(I3)'), id  
 c$$$      READ (adate, '(I6)'), date  
 c$$$*     ----------------------  
     
646  *     init mask  *     init mask
647        do iv=1,nviews        do is=1,nstrips_va1
648           do ivk=1,nva1_view           if( mask_vk(iv,ivk) .ne. -1)then            
649              do is=1,nstrips_va1              mask(iv,ivk,is) = 1
650                 mask(iv,ivk,is) = mask_vk(iv,ivk)       $           * mask_vk(iv,ivk) !from DB
651              enddo       $           * mask_vk_ev(iv,ivk) !from <SIG>
652           enddo       $           * mask_vk_run(iv,ivk) !from CN
653             else
654                mask(iv,ivk,is) = -1
655         $           * mask_vk(iv,ivk) !from DB
656         $           * mask_vk_ev(iv,ivk) !from CN
657             endif
658        enddo        enddo
659          
660  c$$$*     ---------------------        
 c$$$*     VIEW 2 - VK 23-24  
 c$$$*     couple of vk damaged during integration  
 c$$$      if(date.ge.50208)then  
 c$$$cc         print*,'MASK: view 2 - vk 23/24'  
 c$$$         mask_vk(2,23)=0  
 c$$$         mask_vk(2,24)=0  
 c$$$         do is=1,nstrips_va1  
 c$$$            mask(2,23,is)=0  
 c$$$            mask(2,24,is)=0  
 c$$$         enddo  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 11-12  
 c$$$      if(date.ge.50209)then  
 c$$$        if(.not.(date.eq.50209.and.id.le.6)) then  
 c$$$cc          print*,'MASK: view 7 - vk 11/12'  
 c$$$          mask_vk(7,11)=0  
 c$$$          mask_vk(7,12)=0  
 c$$$          do is=1,nstrips_va1  
 c$$$            mask(7,11,is)=0  
 c$$$            mask(7,12,is)=0  
 c$$$          enddo  
 c$$$        endif  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 21-22  
 c$$$      if(date.ge.50316)then  
 c$$$cc         print*,'MASK: view 7 - vk 21/22'  
 c$$$         mask_vk(7,21)=0  
 c$$$         mask_vk(7,22)=0  
 c$$$         do is=1,nstrips_va1  
 c$$$            mask(7,21,is)=0  
 c$$$            mask(7,22,is)=0  
 c$$$         enddo  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 12 - VK 1-2-3-4  
 c$$$      if((date.eq.50317).and.(id.le.3))then  
 c$$$cc        print*,'MASK: view 12 - vk 1/2/3/4'  
 c$$$        mask_vk(12,1)=0  
 c$$$        mask_vk(12,2)=0  
 c$$$        mask_vk(12,3)=0  
 c$$$        mask_vk(12,4)=0  
 c$$$        do is=1,nstrips_va1  
 c$$$          mask(12,1,is)=0  
 c$$$          mask(12,2,is)=0  
 c$$$          mask(12,3,is)=0  
 c$$$          mask(12,4,is)=0  
 c$$$        enddo  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 5-6  
 c$$$      if(date.ge.50320)then  
 c$$$        if(.not.(date.eq.50320.and.id.le.3)) then  
 c$$$cc          print*,'MASK: view 7 - vk 5/6'  
 c$$$          mask_vk(7,5)=0  
 c$$$          mask_vk(7,6)=0  
 c$$$          do is=1,nstrips_va1  
 c$$$            mask(7,5,is)=0  
 c$$$            mask(7,6,is)=0  
 c$$$          enddo  
 c$$$        endif  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 13-14  
 c$$$      if(date.ge.50320)then  
 c$$$        if(.not.(date.eq.50320.and.id.le.5)) then  
 c$$$cc          print*,'MASK: view 7 - vk 13/14'  
 c$$$          mask_vk(7,13)=0  
 c$$$          mask_vk(7,14)=0  
 c$$$          do is=1,nstrips_va1  
 c$$$            mask(7,13,is)=0  
 c$$$            mask(7,14,is)=0  
 c$$$          enddo  
 c$$$        endif  
 c$$$      endif  
 c$$$  
 c$$$***   SAMARA  
 c$$$***   SAMARA  
 c$$$***   SAMARA  
 c$$$*     it needs further checks...  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 9-10  
 c$$$*     VIEW 12 - VK 1-2-3-4  
 c$$$      if((date.eq.50516).and.(id.le.8))then  
 c$$$cc        print*,'MASK: view 7 - vk 9/10'  
 c$$$cc        print*,'MASK: view 12 - vk 1/2/3/4'  
 c$$$        mask_vk(7,9)=0  
 c$$$        mask_vk(7,10)=0  
 c$$$        mask_vk(12,1)=0  
 c$$$        mask_vk(12,2)=0  
 c$$$        mask_vk(12,3)=0  
 c$$$        mask_vk(12,4)=0  
 c$$$        do is=1,nstrips_va1  
 c$$$          mask(7,9,is)=0  
 c$$$          mask(7,10,is)=0  
 c$$$          mask(12,1,is)=0  
 c$$$          mask(12,2,is)=0  
 c$$$          mask(12,3,is)=0  
 c$$$          mask(12,4,is)=0  
 c$$$        enddo  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 7 - VK 9-10  
 c$$$      if(date.ge.50516)then  
 c$$$        if(.not.(date.eq.50516.and.id.le.8)) then  
 c$$$cc          print*,'MASK: view 7 - vk 9/10'  
 c$$$          mask_vk(7,9)=0  
 c$$$          mask_vk(7,10)=0  
 c$$$          do is=1,nstrips_va1  
 c$$$            mask(7,9,is)=0  
 c$$$            mask(7,10,is)=0  
 c$$$          enddo  
 c$$$        endif  
 c$$$      endif  
 c$$$  
 c$$$*     ---------------------  
 c$$$*     VIEW 12 - VK 7-8  
 c$$$      if(date.ge.50523)then  
 c$$$        if(.not.(date.eq.50523.and.id.le.3)) then  
 c$$$cc          print*,'MASK: view 12 - vk 7/8'  
 c$$$          mask_vk(12,7)=0  
 c$$$          mask_vk(12,8)=0  
 c$$$          do is=1,nstrips_va1  
 c$$$            mask(12,7,is)=0  
 c$$$            mask(12,8,is)=0  
 c$$$          enddo  
 c$$$        endif  
 c$$$      endif  
   
661        return        return
662        end        end
   

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

  ViewVC Help
Powered by ViewVC 1.1.23