subroutine filladc(iflag) !??? AGGIUSTARE TUTTO include '../common/commontracker.f' include '../common/common_reduction.f' include '../common/level0.f' include '../common/calib.f' external nvk external nst real errflag integer*2 flag,tipo,info,prec_ind,word integer*2 newVAL,oldVAL data oldval/0/ integer DSPn iflag = 0 C--------------------------------------------------------- C check DAQmode to see if data are C - b#1001 = 9 full C - b#1010 =10 compressed C - b#1011 =11 compressed + full C - b#1000 = 8 special --> (compressed+full) / compressed C (even/odd views compressed/full, alternately) C in the third case ADC is filled with full data C--------------------------------------------------------- idata=0 !datatracker array index do iv=1,nviews DSPn=DSPnumber(iv) ievent=eventn(iv) C --------------------------- C if the iv view is missing C or the data buffer is empty C jump to end C --------------------------- if(DSPn.eq.0 $ .or.datalength(iv).eq.0)goto 333 C++++++++++++++++++++++++++++++++++++++++++++++++++++++ c if(iand(DAQmode(iv),z'0002').eq.z'0002') then if(iand(DAQmode(iv),z'0003').eq.z'0002'.or. $ iand(DAQmode(iv),z'0003').eq.z'0003'.or. $ iand(DAQmode(iv),z'0003').eq.z'0000'.or. $ .false.) then C++++++++++++++++++++++++++++++++++++++++++++++++++++++ C-------------------------------------- compressed mode is = 0 il = 0 prec_ind = 0 222 continue idata = idata+1 word=datatracker(idata) C------------------------------------------------------ C call routine to uncompress data C------------------------------------------------------ call compdecode(word,flag,tipo,info,errflag) if(errflag.ne.0.) then print*,'filladc --> ERROR on compdecode' iflag=1 return endif if(flag.eq.1) then ! flag: fine messaggio (ladder) if(info.ne.1.and.info.ne.2.and.info.ne.3) then print*, $ 'filladc --> wrong end-of-ladder ' $ //'in COMPRESSED mode' print*, $ ' info(=ladder) ',info,' type ',tipo iflag=1 return endif il = info do js=is+1,1024*il newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is)) $ +pedestal_t(DSPn,nvk(js),nst(js)) newVAL=max(0,newVAL) newVAL=min(4095,newVAL) adc(DSPn,nvk(js),nst(js))=newVAL c print*,DSPn,nvk(js),nst(js),newval enddo if(info.eq.3) goto 1000 is=1024*il prec_ind=0 !il precedente non e' un indirizzo endif if(flag.eq.0) then ! flag: dato o indirizzo if(tipo.eq.1) then ! tipo: indirizzo iaddr = info + il*1024 if(iaddr.ge.is+1.and.iaddr.le.3072) then do js = is+1,iaddr-1 newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is)) $ +pedestal_t(DSPn,nvk(js),nst(js)) newVAL=max(0,newVAL) newVAL=min(4095,newVAL) adc(DSPn,nvk(js),nst(js))=newVAL c print*,DSPn,nvk(js),nst(js),newval enddo is = iaddr prec_ind = 1 else print*,'filladc --> address '// $ 'out of range - iaddr,is',iaddr,is iflag=1 return endif endif if(tipo.eq.0) then ! tipo: dato if(prec_ind.eq.0) is=is+1 if(info.ge.0.and.info.le.4095) then if(is.gt.3072)then print*, $ 'filladc --> strip out of range - DSPn,is' $ ,DSPn,is iflag=1 return endif newVAL=info adc(DSPn,nvk(is),nst(is))=newVAL c print*,DSPn,nvk(is),nst(is),newval oldVAL=newVAL else print*,'filladc --> datum out of range - info',info iflag=1 return endif prec_ind=0 endif endif goto 222 endif 1000 continue C++++++++++++++++++++++++++++++++++++++++++++++++++++++ c if(iand(DAQmode(iv),z'0001').eq.z'0001') then if(iand(DAQmode(iv),z'0003').eq.z'0001'.or. !full $ iand(DAQmode(iv),z'0003').eq.z'0003'.or. !comp+full $ (iand(DAQmode(iv),z'0003').eq.z'0000' !special $ .and.mod(DSPn+ievent,2).eq.1).or. $ .false.) then C++++++++++++++++++++++++++++++++++++++++++++++++++++++ C-------------------------------------------- full mode do i=1,3 do j=1,1024 idata = idata+1 is=j+1024*(i-1) c adcadc=adc(DSPn,nvk(is),nst(is)) adc(DSPn,nvk(is),nst(is)) = datatracker(idata) c if(iand(DAQmode(iv),z'0002').eq.z'0002') then c diff=adc(DSPn,nvk(is),nst(is))-adcadc c if(abs(diff).gt.0) c $ print*,DSPn,is,adcadc, c $ ' ---- ',adc(DSPn,nvk(is),nst(is)),diff c endif enddo idata = idata+1 if(datatracker(idata).ne.ior(z'1800',i+3)) then print*,'filladc --> wrong end-of-ladder in FULL mode' print*,' word ',datatracker(idata) print*,' should be ',ior(z'1800',i+3) iflag=1 return endif enddo endif enddo 333 continue return end c qui o nelle functions.f??? SUBROUTINE COMPDECODE(word,flag,tipo,info,errflag) INTEGER*2 word,flag,tipo,info C------------------------------------------------------- C Decode tracker words: C C flag tipo info C -------------------------------------------------- C 0 0 ADC value C 0 1 strip address 1-1024 C 1 0(end of ladders 1 2 1,2 or 4,5 C 1 1(end of ladder 3) 3 or 6 C------------------------------------------------------- errflag=0. flag=iand(word,z'f000') flag=ishft(flag,-12) if(flag.ne.0.and.flag.ne.1) then print*,'compdecode --> error on uncompression: flag=',flag errflag=1. endif if(flag.eq.0) then ! valore ADC tipo=0 info=iand(word,z'0fff') endif if(flag.eq.1) then ! indirizzo OR fine vista info=iand(word,z'03ff') tipo=iand(word,z'0c00') if(tipo.ne.0.and.tipo.ne.z'0800') then print*,'compdecode --> error on decompression: tipo=',tipo errflag=1. endif if(tipo.eq.0) then ! indirizzo flag=0 tipo=1 info=info+1 endif if(tipo.eq.z'0800') then ! fine vista flag=1 if(info.eq.3.or.info.eq.6) then tipo=1 else tipo=0 endif endif endif return end