--- DarthVader/TrackerLevel2/src/F77/filladc.f 2006/05/19 13:15:55 1.1.1.1 +++ DarthVader/TrackerLevel2/src/F77/filladc.f 2007/05/24 16:45:48 1.8 @@ -2,11 +2,13 @@ include 'commontracker.f' - include 'common_reduction.f' include 'level0.f' + include 'level1.f' include 'calib.f' + include 'common_reduction.f' + external nvk external nst @@ -29,166 +31,313 @@ C--------------------------------------------------------- idata=0 !datatracker array index + do iv=1,nviews - DSPn=DSPnumber(iv) - ievent=eventn(iv) + + 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 jump to next view C --------------------------- - if(DSPn.eq.0 - $ .or.datalength(iv).eq.0)goto 333 + nword_DSP = 0 + if(DSPn.eq.0 + $ .or.DSPn.gt.nviews + $ .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 + 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$$$ print*,'word(',idata,')= ',datatracker(idata) + if(debug)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 )print*,'filladc --> missing end-of-ladder', + $ ' in COMPRESSED mode - DSP ',DSPn + if(debug)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 - 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 + call compdecode(word,flag,tipo,info,errflag) - 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 -ccc print*,DSPn,nvk(js),nst(js),newval - enddo + if(errflag.ne.0.) then + if(debug)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(info.eq.3) goto 1000 + if(flag.eq.1) then ! flag: fine messaggio (ladder) + + if(info.ne.1.and.info.ne.2.and.info.ne.3) then + if(debug)print*, + $ 'filladc --> wrong end-of-ladder ' + $ //'in COMPRESSED mode' + if(debug)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 - 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 + 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)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 - 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 + + enddo + + is = iaddr + prec_ind = 1 + else + if(debug)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)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 - print*,'filladc --> datum out of range - info',info - iflag=1 - return - endif - prec_ind=0 + + oldVAL=newVAL + else + if(debug) + $ 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 - endif - goto 222 - endif - - 1000 continue - + 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 + 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)print*,'DSP #',DSPn,' --> full ' - - do i=1,3 - do j=1,1024 - idata = idata+1 - is=j+1024*(i-1) + 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 ) + $ print*,'filladc --> missing end-of-ladder', + $ ' in FULL mode - DSP ',DSPn + if(debug)print*,'datalength = ',datalength + goto 334 !next view + endif + is=j+1024*(i-1) c adcadc=adc(DSPn,nvk(is),nst(is)) - adc(DSPn,nvk(is),nst(is)) = datatracker(idata) - + 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 - 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 !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 ) + $ print*,'filladc --> missing end-of-ladder', + $ ' in FULL mode - DSP ',DSPn + if(debug)print*,'datalength = ',datalength + goto 334 !next view + endif + if(datatracker(idata).ne.ior(z'1800',i+3)) then + if(debug) + $ print*,'filladc --> ', + $ 'wrong end-of-ladder in FULL mode' + if(debug) + $ print*,' word ',datatracker(idata) + if(debug) + $ 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)print*,'filladc --> ',iv + $ ,'^ DSP packet missing or corrupted: ' + $ ,'DSPn, datalength(iv) => ' + $ ,DSPn,datalength(iv) + 334 continue enddo - 333 continue - + goto 336 + 335 continue + if(debug)print*,'filladc --> reached end of buffer:', + $ ' datatracker(',NWORDMAX,')' + + 336 continue return end @@ -213,7 +362,7 @@ flag=ishft(flag,-12) if(flag.ne.0.and.flag.ne.1) then - print*,'compdecode --> error on uncompression: flag=',flag +c print*,'compdecode --> error on uncompression: flag=',flag errflag=1. endif if(flag.eq.0) then ! valore ADC @@ -224,7 +373,7 @@ 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 +c print*,'compdecode --> error on decompression: tipo=',tipo errflag=1. endif if(tipo.eq.0) then ! indirizzo