************************************************************************* * * Program reductionflight.f * * - reads readraw.f output files: LEVEL0 ntuple, and ped, sig and bad histograms * - decodes raw data (DATATRACKER) using DSP ped, sig and bad values * - looks for clusters information using ped, sig and bad values from * DSP histograms * - fills LEVEL1 ntuple * ************************************************************************* subroutine reductionflight(ierror) include 'commontracker.f' include 'level0.f' include 'level1.f' include 'common_reduction.f' include 'calib.f' data eventn_old/nviews*0/ integer ierror ierror = 0 * ------------------------------------------------------- * STRIP MASK * ------------------------------------------------------- c call stripmask !called later, after CN computation call init_level1 c good1 = good0 c-------------------------------------------------- c check the LEVEL0 event status for missing c sections or DSP alarms c ==> set the variable GOOD1(12) c-------------------------------------------------- do iv=1,nviews if(DSPnumber(iv).gt.0.and.DSPnumber(iv).le.12)then c ------------------------ c GOOD c ------------------------ GOOD1(DSPnumber(iv))=0 !OK c ------------------------ c CRC error c ------------------------ if(crc(iv).eq.1) then GOOD1(DSPnumber(iv)) = 2 goto 18 !next view endif c ------------------------ c online-software alarm c ------------------------ if( $ fl1(iv).ne.0.or. $ fl2(iv).ne.0.or. $ fl3(iv).ne.0.or. $ fl4(iv).ne.0.or. $ fl5(iv).ne.0.or. $ fl6(iv).ne.0.or. $ fc(iv).ne.0.or. $ DATAlength(iv).eq.0.or. $ .false.)then GOOD1(DSPnumber(iv))=3 goto 18 endif c ------------------------ c DSP-counter jump c ------------------------ if( $ eventn_old(iv).ne.0.and. !first event in this file $ eventn(iv).ne.1.and. !first event in run $ good_old(DSPnumber(iv)).ne.0.and. !previous event corrupted $ .true.)then if(eventn(iv).ne.(eventn_old(iv)+1))then GOOD1(DSPnumber(iv))=4 goto 18 endif endif c ------------------------ 18 continue endif enddo ngood = 0 do iv = 1,nviews eventn_old(iv) = eventn(iv) good_old(iv) = good1(iv) ngood = ngood + good1(iv) enddo c if(ngood.ne.0)print*,'* WARNING * LEVEL0 event status: ' c $ ,(good1(i),i=1,nviews) c-------------------------------------------------- c read the variable DATATRACKER from LEVEL0 c and fill the variable ADC (invertin view 11) c-------------------------------------------------- call filladc(iflag) if(iflag.ne.0)then c good1=0!<<<<<<<<<<<<<<< c if(DEBUG)print*,'event ',eventn(1),' >>>>> decode ERROR' ierror = 220 c goto 200 c print*,'filladc error' endif c-------------------------------------------------- c computes common noise for each VA1 c (excluding strips affected by signal, c tagged with the flag CLSTR) c-------------------------------------------------- do iv=1,nviews ima=0 do ik=1,nva1_view cn(iv,ik) = 0 cnn(iv,ik) = -1 mask_vk_ev(iv,ik)=1 iflag=0 if(mask_vk(iv,ik).eq.1)call cncomp(iv,ik,iflag) c if(iflag.ne.0)good1=0 if(iflag.ne.0)then ima=ima+1 mask_vk_ev(iv,ik)=0 ierror = 220 c$$$ if(verbose) c$$$ $ print*,' * WARNING * Event ',eventn(1) c$$$ $ ,': masked vk ',ik,' on view',iv endif enddo 100 format(' * WARNING * Event ',i7,' view',i3,': VK MASK ',24i1) c if(ima.ne.0.and.verbose)print*,' * WARNING * Event ',eventn(1) c $ ,' view',iv,': VK MASK ' c $ ,(mask_vk_ev(iv,ik),ik=1,nva1_view) if(ima.ne.0.and.verbose)write(*,100)eventn(1),iv $ ,(mask_vk_ev(iv,ik),ik=1,nva1_view) enddo c if(good1.eq.0)then c ierror = 220 c endif call stripmask !compute mask(i,j,k), combining mask_vk_ev and mask_vk c--------------------------------------------- c loops on views, VA1 and strips, c and computes strips signals using c badstrip, pedestals, and c sigma informations from histograms c--------------------------------------------- flag_shower = .false. ind=1 !clsignal array index do iv=1,nviews !loop on views do is=1,nstrips_view !loop on strips (1) if(mod(iv,2).eq.1) then C=== > Y view value(is)= -(DBLE(adc(iv,nvk(is),nst(is))) $ -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is))) $ *mask(iv,nvk(is),nst(is)) clseedcut(is)=clcuty*sigma(iv,nvk(is),nst(is)) $ *mask(iv,nvk(is),nst(is)) clinclcut(is)=incuty*sigma(iv,nvk(is),nst(is)) $ *mask(iv,nvk(is),nst(is)) ccc print*,"value(",is,")(reduction)= ",value(is) else C=== > X view value(is)= (DBLE(adc(iv,nvk(is),nst(is))) $ -cn(iv,nvk(is))-pedestal(iv,nvk(is),nst(is))) $ *mask(iv,nvk(is),nst(is)) clseedcut(is)=clcutx*sigma(iv,nvk(is),nst(is)) $ *mask(iv,nvk(is),nst(is)) clinclcut(is)=incutx*sigma(iv,nvk(is),nst(is)) $ *mask(iv,nvk(is),nst(is)) 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) enddo !end loop on strips (1) call search_cluster(iv) 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 if(.not.flag_shower)then call save_cluster(iv) else fshower(iv) = 1 GOOD1(DSPn) = 11 endif enddo ! end loop on views do iv=1,nviews do ik=1,nva1_view cnev(iv,ik) = cn(iv,ik) !assigns computed CN to ntuple variables cnnev(iv,ik) = cnn(iv,ik) !assigns computed CN to ntuple variables ccc print*,"cnev(",iv,",",ik,")(reduction)= ",cnev(iv,ik) enddo enddo C--------------------------------------------- C come here if GOOD1=0 C or the event has too many clusters C--------------------------------------------- 200 continue ngood = 0 do iv = 1,nviews ngood = ngood + good1(iv) enddo if(ngood.ne.0)print*,'* WARNING * Event ',eventn(1) $ ,':LEVEL1 event status: ' $ ,(good1(i),i=1,nviews) c------------------------------------------------------------------------ c c closes files and exits c c------------------------------------------------------------------------ RETURN END ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...*** * * * * * * * * * ***...***...***...***...***...***...***...***...***...***...***...***...***...***...***...*** subroutine init_level1 include 'commontracker.f' include 'level1.f' include 'level0.f' c good1 = 0 do iv=1,12 good1(iv) = 1 !missing packet enddo nclstr1 = 0 totCLlength = 0 do ic=1,nclstrmax view(ic) = 0 ladder(ic) = 0 indstart(ic) = 0 indmax(ic) = 0 maxs(ic) = 0 mult(ic) = 0 dedx(ic) = 0 whichtrack(ic) = 0 enddo do id=1,maxlength !??? clsignal(id) = 0. clsigma(id) = 0. cladc(id) = 0. clbad(id) = 0. enddo do iv=1,nviews c crc1(iv)=0 do ik=1,nva1_view cnev(iv,ik) = 0 cnnev(iv,ik) = 0 enddo fshower(iv) = 0 enddo return end *---***---***---***---***---***---***---***---*** * * * * * *---***---***---***---***---***---***---***---*** subroutine search_cluster(iv) include 'commontracker.f' include 'level0.f' include 'level1.f' include 'calib.f' include 'common_reduction.f' c local variables integer rmax,lmax !estremi del cluster integer rstop,lstop !per decidere quali strip includere nel cluster ! oltre il seed integer first,last,diff !per includere le strip giuste... !??? integer multtemp !temporary multiplicity variable external nst 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) iseed=-999 !cluster seed index initialization nclstr_view=0 do jl=1,nladders_view !1..3 !loops on ladders 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 if(mod(iv,2).eq.0) then first=first+3 last=last-3 endif do is=first,last !loop on strips in each ladder if(is.le.iseed+1) goto 220 ******************************************************* * Elena 08/2006 * QUESTA PARTE NON E` ADEGUATA per cluster con grossi rilasci di carica * 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 ******************************************************* if(value(is).gt.clseedcut(is)) then ccc print*,"value(",is,")=",value(is), ccc $ " .gt.clseedcut(",is,")=",clseedcut(is) c----------------------------------------- c possible SEED... c----------------------------------------- itemp=is if(itemp.eq.last) goto 230 !estremo... **************************************************** * modificato da Elena (08/2006) per salvare * il cluster intorno al massimo assoluto **************************************************** 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 do while( $ value(itemp).le.value(itemp+1) $ .and.value(itemp+1).gt.clseedcut(itemp+1)) itemp=itemp+1 if(itemp.eq.last) goto 230 !stops if reaches last strip enddo ! of the ladder 230 continue c----------------------------------------- c fownd SEED!!! c----------------------------------------- iseed=itemp c---------------------------------------------------------- c after finding a cluster seed, checks also adjacent strips, C and marks the ones exceeding clinclcut c---------------------------------------------------------- ir=iseed !indici destro il=iseed ! e sinistro rmax=ir !estremo destro del cluster lmax=il ! e sinistro rstop=0 !initialize flags used to exit from lstop=0 ! inclusion loop do while(lstop.eq.0.or.rstop.eq.0) !shifts left and right from ir=ir+1 !position index for strips on right side of ! cluster seed il=il-1 !and for left side c------------------------------------------------------------------------ c checks for last or first strip of the ladder c------------------------------------------------------------------------ if(ir.gt.last) then !when index goes beyond last strip rstop=1 ! of the ladder, change rstop flag in order ! to "help" exiting from loop endif 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 c------------------------------------------------------------------------ if((rmax-lmax+1).ge.nclstrp) then goto 210 !exits inclusion loop: ! lmax and rmax maintain last value ! NB .ge.!??? endif c------------------------------------------------------------------------ c marks strips exceeding inclusion cut c------------------------------------------------------------------------ if(rstop.eq.0) then !if last strip of the ladder or last ! over-cut strip has not been reached if(value(ir).gt.clinclcut(ir)) then !puts in rmax the rmax=ir ! last right over-cut strip else rstop=1 !otherwise cluster ends on right and rstop endif ! flag=1 signals it endif if(lstop.eq.0) then if(value(il).gt.clinclcut(il)) then lmax=il else lstop=1 endif endif enddo !ends strip inclusion loop 210 continue !jumps here if more than nclstrp have been included multtemp=rmax-lmax+1 !stores multiplicity in temp ! variable. NB rmax and lmax can change later in ! order to include enough strips to calculate eta3 ! and eta4. so mult is not always equal to cllength c------------------------------------------------------------------------ c NB per essere sicuro di poter calcolare eta3 e eta4 devo includere c sempre e comunque le 2 strip adiacenti al cluster seed e quella c adiacente ulteriore dalla parte della piu' alta fra queste due c (vedi oltre...)!??? c------------------------------------------------------------------------ c nel caso di estremi del ladder...!??? c ho meno di 4 strip nel cluster --> se sono sui bordi o quasi del ladder c costruisco il cluster ad hoc e poi esco, se non sono sui bordi o quasi c vado oltre (aggiungero' quindi strip a sx e dx in modo da poter calcolare c eta3e4) if((rmax-lmax+1).lt.4) then if(iseed.eq.first) then !estremi... rmax=iseed+2 !NB in questo modo puo' anche capitare di lmax=iseed ! includere strip sotto taglio di inclusione goto 250 ! che non serviranno per eta3e4!??? endif if(iseed.eq.last) then !estremi... rmax=iseed lmax=iseed-2 !NB 2 e non 3, perche' altrimenti sarei in goto 250 ! ((rmax-lmax+1).lt.4).eq.false. !??? endif !NMB questo e' l'unico caso di cllength=3!??? if(iseed.eq.first+1) then !quasi estremi... rmax=iseed+2 lmax=iseed-1 goto 250 endif if(iseed.eq.last-1) then rmax=iseed+1 lmax=iseed-2 goto 250 endif c se ho 4 o piu' strip --> se sono sui bordi esco, se sono sui quasi bordi c includo la strip del bordo else if(iseed.eq.first) goto 250 !estremi... non includo altro if(iseed.eq.last) goto 250 if(iseed.eq.first+1) then !quasi estremi... mi assicuro di lmax=first ! avere le strip adiacenti al seed if((rmax-lmax+1).gt.nclstrp) rmax=rmax-1 !NB effetto goto 250 ! coperta: se la lunghezza del cluster era gia' endif ! al limite (nclstrp), per poter aggiungere questa ! strip a sinistra devo toglierne una a destra...!??? if(iseed.eq.last-1) then rmax=last if((rmax-lmax+1).gt.nclstrp) lmax=lmax+1 goto 250 endif endif c------------------------------------------------------------------------ c be sure to include in the cluster the cluster seed with its 2 adjacent c strips, and the one adjacent to the greatest between this two strip, as the c fourth one. if the strips have the same value (!) the fourth one is chosen c as the one having the greatest value between the second neighbors c------------------------------------------------------------------------ if(value(iseed+1).eq.value(iseed-1)) then if(value(iseed+2).ge.value(iseed-2)) then !??? qui cmq c'e' diff=(iseed+2)-rmax if(diff.gt.0) then rmax=rmax+diff if((rmax-lmax+1).gt.nclstrp) then lmax=rmax-nclstrp+1 endif endif diff=(iseed-1)-lmax if(diff.lt.0) then lmax=lmax+diff if((rmax-lmax+1).gt.nclstrp) then rmax=lmax+nclstrp-1 endif endif else diff=(iseed-2)-lmax if(diff.lt.0) then lmax=lmax+diff if((rmax-lmax+1).gt.nclstrp) then rmax=lmax+nclstrp-1 endif endif diff=(iseed+1)-rmax if(diff.gt.0) then rmax=rmax+diff if((rmax-lmax+1).gt.nclstrp) then lmax=rmax-nclstrp+1 endif endif endif elseif(value(iseed+1).gt.value(iseed-1)) then c !??? sposto il limite del cluster a destra per includere sempre le strip c necessarie al calcolo di eta-i c se il cluster diventa troppo lungo lo accorcio a sinistra per avere non piu' c di nclstrp (in questo caso sono sicuro di aver gia' incluso le strip c necessarie al calcolo di eta-i a sinistra, quindi se voglio posso uscire) diff=(iseed+2)-rmax if(diff.gt.0) then rmax=rmax+diff if((rmax-lmax+1).gt.nclstrp) then lmax=rmax-nclstrp+1 c goto 250 endif endif diff=(iseed-1)-lmax if(diff.lt.0) then lmax=lmax+diff if((rmax-lmax+1).gt.nclstrp) then rmax=lmax+nclstrp-1 c goto 250 !inutile!??? endif endif else diff=(iseed-2)-lmax if(diff.lt.0) then lmax=lmax+diff if((rmax-lmax+1).gt.nclstrp) then rmax=lmax+nclstrp-1 c goto 250 endif endif diff=(iseed+1)-rmax if(diff.gt.0) then rmax=rmax+diff if((rmax-lmax+1).gt.nclstrp) then lmax=rmax-nclstrp+1 c goto 250 !inutile!??? endif endif endif 250 continue c-------------------------------------------------------- c fills cluster variables 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 nclstr_view = nclstr_view + 1 !cluster number c print*,'view ',iv,' -- search_cluster -- nclstr_view: ' c $ ,nclstr_view if(nclstr_view.gt.nclstrmax_view) then !too many clusters for the view: if(verbose) print*,'Event ',eventn(1), $ ': more than ',nclstrmax_view $ ,' clusters on view ',iv c good1=0 ! event c nclstr1=0 c totCLlength=0 flag_shower = .true. goto 2000 endif c view(nclstr1) = iv !vista del cluster ladder_view(nclstr_view) = nld(iseed,iv) !ladder a cui appartiene il cluster seed maxs_view(nclstr_view) = iseed !strip del cluster seed mult_view(nclstr_view) = multtemp !molteplicita' rmax_view(nclstr_view) = rmax lmax_view(nclstr_view) = lmax c-------------------------------------------------------- c c-------------------------------------------------------- endif !end possible seed conditio 220 continue !jumps here to skip strips left of last seed enddo ! end loop on strips enddo !end loop on ladders 2000 continue return end *---***---***---***---***---***---***---***---*** * * * * * *---***---***---***---***---***---***---***---*** subroutine save_cluster(iv) * * (080/2006 Elena Vannuccini) * Save the clusters view by view include 'commontracker.f' include 'level1.f' include 'calib.f' include 'common_reduction.f' integer CLlength !lunghezza in strip del cluster do ic=1,nclstr_view nclstr1 = nclstr1+1 view(nclstr1) = iv ladder(nclstr1) = ladder_view(ic) maxs(nclstr1) = maxs_view(ic) mult(nclstr1) = mult_view(ic) c posizione dell'inizio del cluster nell' array clsignal indstart(nclstr1) = ind c posizione del cluster seed nell'array clsignal indmax(nclstr1) = indstart(nclstr1) $ +( maxs_view(ic) - lmax_view(ic) ) CLlength = rmax_view(ic) - lmax_view(ic) + 1 !numero di strip salvate totCLlength = totCLlength + CLlength dedx(nclstr1) = 0 do j=lmax_view(ic),rmax_view(ic) !stores sequentially cluter strip values in clsignal(ind) = value(j) ! clsignal array ivk=nvk(j) ist=nst(j) clsigma(ind) = sigma(iv,ivk,ist) cladc(ind) = adc(iv,ivk,ist) clbad(ind) = bad(iv,ivk,ist) c clped(ind) = pedestal(iv,ivk,ist) ind=ind+1 c if(value(j).gt.0) if(value(j).gt.clinclcut(j)) $ dedx(nclstr1) = dedx(nclstr1) + value(j) !cluster charge enddo c print*,'view ',iv,' -- save_cluster -- nclstr1: ' c $ ,nclstr1,maxs(nclstr1),mult(nclstr1),dedx(nclstr1) enddo return end *---***---***---***---***---***---***---***---*** * * * * * *---***---***---***---***---***---***---***---*** subroutine stripmask * this routine set va1 and single-strip masks, * on the basis of the VA1 mask saved in the DB * * mask(nviews,nva1_view,nstrips_va1) !strip mask * mask_vk(nviews,nva1_view) !VA1 mask * include 'commontracker.f' include 'level1.f' include 'common_reduction.f' include 'calib.f' * init mask do iv=1,nviews do ivk=1,nva1_view do is=1,nstrips_va1 c mask(iv,ivk,is) = mask_vk(iv,ivk) mask(iv,ivk,is) = mask_vk(iv,ivk) * mask_vk_ev(iv,ivk) enddo enddo enddo return end