subroutine filladc(iflag) !??? AGGIUSTARE TUTTO include 'commontracker.f' include 'level0.f' include 'level1.f' include 'calib.f' include 'common_reduction.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 next view C --------------------------- nword_DSP = 0 if(DSPn.eq.0 $ .or.DSPn.gt.nviews $ .or.datalength(iv).eq.0)goto 333 C++++++++++++++++++++++++++++++++++++++++++++++++++++++ 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 if(debug.eq.1)print*,'DSP #',DSPn,' --> compressed ' is = 0 il = 0 prec_ind = 0 222 continue idata = idata+1 if( idata.gt.NWORDMAX )goto 335 !end to end nword_DSP = nword_DSP +1 if( nword_DSP.gt.datalength(iv) )then if( debug.eq.1 ) $ print*,'filladc --> missing end-of-ladder', $ ' in COMPRESSED mode - DSP ',DSPn if(debug.eq.1) $ print*,'datalength = ',datalength(iv) iflag=1 c GOOD1(DSPn) = 10 c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) goto 334 !next view endif word = datatracker(idata) C------------------------------------------------------ C call routine to uncompress data C------------------------------------------------------ call compdecode(word,flag,tipo,info,errflag) if(errflag.ne.0.) then if(debug.eq.1)print*,'filladc --> ERROR on compdecode' iflag=1 c GOOD1(DSPn) = 10 c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) c return goto 221 endif if(flag.eq.1) then ! flag: fine messaggio (ladder) if(info.ne.1.and.info.ne.2.and.info.ne.3) then if(debug.eq.1)print*, $ 'filladc --> wrong end-of-ladder ' $ //'in COMPRESSED mode' if(debug.eq.1)print*, $ ' info(=ladder) ',info,' type ',tipo iflag=1 c GOOD1(DSPn) = 10 c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) c return goto 221 endif il = info do js=is+1,1024*il if( DSPn.le.nviews $ .and.nvk(js).gt.0 $ .and.nvk(js).le.nva1_view $ .and.nst(js).gt.0 $ .and.nst(js).le.nstrips_va1 $ )then newVAL = 0 if( $ nvk(is).gt.0.and. $ nvk(is).le.nva1_view.and. $ nst(is).gt.0.and. $ nst(is).le.nstrips_va1.and. $ .true.)then newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is)) $ +pedestal_t(DSPn,nvk(js),nst(js)) newVAL=max(0,newVAL) newVAL=min(4095,newVAL) endif adc(DSPn,nvk(js),nst(js))=newVAL else print*,'filladc -->' $ ,' attempt to access array element (1)' c $ ,'(',DSPn,nvk(is),nst(is),')' $ ,'pedestal_t(',DSPn,nvk(js),nst(js),')' endif c$$$ print*,DSPn,nvk(js),nst(js) c$$$ $ ,pedestal_t(DSPn,nvk(js),nst(js)),newval c$$$ $ ,pedestal(DSPn,nvk(js),nst(js)) 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 if(is.eq.0.or.is.eq.1024.or.is.eq.2048)then if(debug.eq.1)print*,'filladc -->' $ ,' previous transmitted strip ',is $ ,' - missing first ADC value' iflag=1 c GOOD1(DSPn) = 10 c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) endif do js = is+1,iaddr-1 if( DSPn.le.nviews $ .and.nvk(js).gt.0 $ .and.nvk(js).le.nva1_view $ .and.nst(js).gt.0 $ .and.nst(js).le.nstrips_va1 $ )then newVAL = 0 if( $ nvk(is).gt.0.and. $ nvk(is).le.nva1_view.and. $ nst(is).gt.0.and. $ nst(is).le.nstrips_va1.and. $ .true.)then newVAL=oldVAL $ -pedestal_t(DSPn,nvk(is),nst(is)) $ +pedestal_t(DSPn,nvk(js),nst(js)) newVAL=max(0,newVAL) newVAL=min(4095,newVAL) endif adc(DSPn,nvk(js),nst(js))=newVAL else print*,'filladc -->' $ ,' attempt to access array element (2) ' c $ ,'(',DSPn,nvk(is),nst(is),')' $ ,'pedestal_t(',DSPn,nvk(js),nst(js),')' c iflag=1 c if(DSPn.le.nviews)GOOD1(DSPn) = 10 endif c print*,DSPn,nvk(js),nst(js),newval enddo is = iaddr prec_ind = 1 else if(debug.eq.1)print*,'filladc --> address '// $ 'out of range - iaddr,is',iaddr,is iflag=1 c GOOD1(DSPn) = 10 c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) c return goto 221 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 if(debug.eq.1)print*, $ 'filladc --> strip out of range - DSPn,is' $ ,DSPn,is iflag=1 c GOOD1(DSPn) = 10 c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) c return goto 221 endif newVAL=info if( DSPn.le.nviews $ .and.nvk(is).le.nva1_view $ .and.nst(is).le.nstrips_va1)then adc(DSPn,nvk(is),nst(is))=newVAL else print*,'filladc --> attempt to access ADC(' $ ,DSPn,nvk(is),nst(is),')' endif ccc print*,DSPn,nvk(is),nst(is),newval oldVAL=newVAL else if(debug.eq.1) $ print*,'filladc --> datum out of range - info' $ ,info iflag=1 c GOOD1(DSPn) = 10 c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) c return goto 221 endif prec_ind=0 endif endif 221 continue 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 if(debug.eq.1)print*,'DSP #',DSPn,' --> full ' do i=1,3 !loop over ladder do j=1,1024 !loop over strips idata = idata+1 if( idata.gt.NWORDMAX )goto 335 !go to end nword_DSP = nword_DSP +1 if( nword_DSP.gt.datalength(iv) )then if( debug.eq.1 ) $ print*,'filladc --> missing end-of-ladder', $ ' in FULL mode - DSP ',DSPn if(debug.eq.1)print*,'datalength = ',datalength goto 334 !next view endif is=j+1024*(i-1) c adcadc=adc(DSPn,nvk(is),nst(is)) if( DSPn.le.nviews $ .and.nvk(is).le.nva1_view $ .and.nst(is).le.nstrips_va1)then adc(DSPn,nvk(is),nst(is))= datatracker(idata) else print*,'filladc --> attempt to access ADC[' $ ,DSPn,nvk(is),nst(is),']' endif 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 !loop over strips idata = idata+1 if( idata.gt.NWORDMAX )goto 335 !go to end nword_DSP = nword_DSP +1 if( nword_DSP.gt.datalength(iv) )then if( debug.eq.1 ) $ print*,'filladc --> missing end-of-ladder', $ ' in FULL mode - DSP ',DSPn if(debug.eq.1)print*,'datalength = ',datalength goto 334 !next view endif if(datatracker(idata).ne.ior(z'1800',i+3)) then if(debug.eq.1) $ print*,'filladc --> ', $ 'wrong end-of-ladder in FULL mode' if(debug.eq.1) $ print*,' word ',datatracker(idata) if(debug.eq.1) $ print*,' should be ',ior(z'1800',i+3) iflag=1 c GOOD1(DSPn) = 10 c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) c return endif enddo!endl loop over ladder endif goto 334 333 continue if(debug.eq.1)print*,'filladc --> ',iv $ ,'^ DSP packet missing or corrupted: ' $ ,'DSPn, datalength(iv) => ' $ ,DSPn,datalength(iv) 334 continue enddo goto 336 335 continue if(debug.eq.1)print*,'filladc --> reached end of buffer:', $ ' datatracker(',NWORDMAX,')' 336 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 c 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 c 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