--- DarthVader/TrackerLevel2/src/F77/filladc.f 2006/10/16 12:36:52 1.6 +++ DarthVader/TrackerLevel2/src/F77/filladc.f 2014/01/17 12:56:50 1.12 @@ -55,6 +55,7 @@ $ .false.) then C++++++++++++++++++++++++++++++++++++++++++++++++++++++ C--------------------------------------compressed mode + if(debug.eq.1)print*,'DSP #',DSPn,' --> compressed ' is = 0 il = 0 prec_ind = 0 @@ -63,23 +64,31 @@ if( idata.gt.NWORDMAX )goto 335 !end to end nword_DSP = nword_DSP +1 if( nword_DSP.gt.datalength(iv) )then - if( verbose )print*,'filladc --> missing end-of-ladder', + if( debug.eq.1 ) + $ print*,'filladc --> missing end-of-ladder', $ ' in COMPRESSED mode - DSP ',DSPn - if(verbose)print*,'datalength = ',datalength(iv) + if(debug.eq.1) + $ print*,'datalength = ',datalength(iv) iflag=1 - GOOD1(DSPn) = 10 +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 word = datatracker(idata) + word = INT(IBITS(datatracker(idata),0,16),2) ! EM GCC4.2, I checked that this line works +c print *,word,' datatracker(idata) ',datatracker(idata) ! EM C------------------------------------------------------ C call routine to uncompress data C------------------------------------------------------ call compdecode(word,flag,tipo,info,errflag) if(errflag.ne.0.) then - if(verbose)print*,'filladc --> ERROR on compdecode' + if(debug.eq.1)print*,'filladc --> ERROR on compdecode' iflag=1 - GOOD1(DSPn) = 10 +c GOOD1(DSPn) = 10 +c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 + GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) c return goto 221 endif @@ -87,13 +96,15 @@ if(flag.eq.1) then ! flag: fine messaggio (ladder) if(info.ne.1.and.info.ne.2.and.info.ne.3) then - if(verbose)print*, + if(debug.eq.1)print*, $ 'filladc --> wrong end-of-ladder ' $ //'in COMPRESSED mode' - if(verbose)print*, + if(debug.eq.1)print*, $ ' info(=ladder) ',info,' type ',tipo iflag=1 - GOOD1(DSPn) = 10 +c GOOD1(DSPn) = 10 +c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 + GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) c return goto 221 endif @@ -115,10 +126,11 @@ $ 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) + newVAL=oldVAL+nint( + $ -pedestal_t(DSPn,nvk(is),nst(is)) ! EM GCC4.7 + $ +pedestal_t(DSPn,nvk(js),nst(js)),2) ! EM GCC4.7 + newVAL=max(int(0,2),newVAL) ! EM GCC4.7 + newVAL=min(int(4095,2),newVAL) endif adc(DSPn,nvk(js),nst(js))=newVAL else @@ -144,11 +156,13 @@ if(iaddr.ge.is+1.and.iaddr.le.3072) then if(is.eq.0.or.is.eq.1024.or.is.eq.2048)then - if(verbose)print*,'filladc -->' + if(debug.eq.1)print*,'filladc -->' $ ,' previous transmitted strip ',is $ ,' - missing first ADC value' iflag=1 - GOOD1(DSPn) = 10 +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 @@ -166,11 +180,11 @@ $ nst(is).gt.0.and. $ nst(is).le.nstrips_va1.and. $ .true.)then - newVAL=oldVAL + newVAL=oldVAL+nint( ! EM GCC4.7 $ -pedestal_t(DSPn,nvk(is),nst(is)) - $ +pedestal_t(DSPn,nvk(js),nst(js)) - newVAL=max(0,newVAL) - newVAL=min(4095,newVAL) + $ +pedestal_t(DSPn,nvk(js),nst(js)),2)! EM GCC4.7 + newVAL=max(int(0,2),newVAL)! EM GCC4.7 + newVAL=min(int(4095,2),newVAL)! EM GCC4.7 endif adc(DSPn,nvk(js),nst(js))=newVAL else @@ -188,10 +202,12 @@ is = iaddr prec_ind = 1 else - if(verbose)print*,'filladc --> address '// + if(debug.eq.1)print*,'filladc --> address '// $ 'out of range - iaddr,is',iaddr,is iflag=1 - GOOD1(DSPn) = 10 +c GOOD1(DSPn) = 10 +c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 + GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) c return goto 221 endif @@ -200,11 +216,13 @@ if(prec_ind.eq.0) is=is+1 if(info.ge.0.and.info.le.4095) then if(is.gt.3072)then - if(verbose)print*, + if(debug.eq.1)print*, $ 'filladc --> strip out of range - DSPn,is' $ ,DSPn,is iflag=1 - GOOD1(DSPn) = 10 +c GOOD1(DSPn) = 10 +c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 + GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) c return goto 221 @@ -223,11 +241,13 @@ oldVAL=newVAL else - if(verbose) + if(debug.eq.1) $ print*,'filladc --> datum out of range - info' $ ,info iflag=1 - GOOD1(DSPn) = 10 +c GOOD1(DSPn) = 10 +c GOOD1(DSPn) = GOOD1(DSPn) + 2**4 + GOOD1(DSPn) = ior(GOOD1(DSPn),2**4) c return goto 221 endif @@ -251,6 +271,7 @@ 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 @@ -258,10 +279,10 @@ if( idata.gt.NWORDMAX )goto 335 !go to end nword_DSP = nword_DSP +1 if( nword_DSP.gt.datalength(iv) )then - if( verbose ) + if( debug.eq.1 ) $ print*,'filladc --> missing end-of-ladder', $ ' in FULL mode - DSP ',DSPn - if(verbose)print*,'datalength = ',datalength + if(debug.eq.1)print*,'datalength = ',datalength goto 334 !next view endif is=j+1024*(i-1) @@ -286,29 +307,31 @@ if( idata.gt.NWORDMAX )goto 335 !go to end nword_DSP = nword_DSP +1 if( nword_DSP.gt.datalength(iv) )then - if( verbose ) + if( debug.eq.1 ) $ print*,'filladc --> missing end-of-ladder', $ ' in FULL mode - DSP ',DSPn - if(verbose)print*,'datalength = ',datalength + if(debug.eq.1)print*,'datalength = ',datalength goto 334 !next view endif if(datatracker(idata).ne.ior(z'1800',i+3)) then - if(verbose) + if(debug.eq.1) $ print*,'filladc --> ', $ 'wrong end-of-ladder in FULL mode' - if(verbose) + if(debug.eq.1) $ print*,' word ',datatracker(idata) - if(verbose) + if(debug.eq.1) $ print*,' should be ',ior(z'1800',i+3) iflag=1 - GOOD1(DSPn) = 10 +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(verbose)print*,'filladc --> ',iv + if(debug.eq.1)print*,'filladc --> ',iv $ ,'^ DSP packet missing or corrupted: ' $ ,'DSPn, datalength(iv) => ' $ ,DSPn,datalength(iv) @@ -316,7 +339,7 @@ enddo goto 336 335 continue - if(verbose)print*,'filladc --> reached end of buffer:', + if(debug.eq.1)print*,'filladc --> reached end of buffer:', $ ' datatracker(',NWORDMAX,')' 336 continue @@ -329,6 +352,7 @@ SUBROUTINE COMPDECODE(word,flag,tipo,info,errflag) INTEGER*2 word,flag,tipo,info + INTEGER*2 hexmask !EM GCC4.7 C------------------------------------------------------- C Decode tracker words: C @@ -340,28 +364,47 @@ C 1 1(end of ladder 3) 3 or 6 C------------------------------------------------------- errflag=0. - flag=iand(word,z'f000') +C EM: by default z'XXXX' returns a INTEGER*8, we want to have just a INTEGER*2 so we need a trick +C Bitwise is like this: +C WORD = 16 bit +C 1111111111111111 FFFF 32767 + sign +C +C flag=iand(word,z'f000') + hexmask=z'7000' + hexmask=IBSET(hexmask,15) ! it is not possible to set the sign bit with F000, we must set the sign bit with ibset +c print *,' hexmask ',hexmask +c write(*,22)hexmask +c 22 FORMAT(2X,'hexmask: ',2X,Z8) + flag=iand(word,hexmask) +C END EM flag=ishft(flag,-12) if(flag.ne.0.and.flag.ne.1) then c print*,'compdecode --> error on uncompression: flag=',flag - errflag=1. + errflag=1. endif if(flag.eq.0) then ! valore ADC - tipo=0 - info=iand(word,z'0fff') + tipo=0 + hexmask=z'0FFF' !EM GCC4.7 + info=iand(word,hexmask) !EM GCC4.7 +c info=iand(word,z'0fff') !EM GCC4.7 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 + hexmask=z'03FF' !EM GCC4.7 + info=iand(word,hexmask) !EM GCC4.7 +c info=iand(word,z'03ff') !EM GCC4.7 + hexmask=z'0C00' !EM GCC4.7 + tipo=iand(word,hexmask)!EM GCC4.7 +c tipo=iand(word,z'0c00') !EM GCC4.7 + hexmask=z'0800' !EM GCC4.7 + if(tipo.ne.0.and.tipo.ne.hexmask) then !EM GCC4.7 c print*,'compdecode --> error on decompression: tipo=',tipo errflag=1. endif if(tipo.eq.0) then ! indirizzo flag=0 tipo=1 - info=info+1 + info=info+INT(1,2) !EM GCC4.7 endif if(tipo.eq.z'0800') then ! fine vista flag=1