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)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
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(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
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
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
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
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)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 )
$ 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))
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 )
$ 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
goto 336
335 continue
if(debug)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