C-------------------------------------------------------------------- SUBROUTINE TOFUNPACK(vecta,lung,me) C D.Campana, Dec. 04 C--------------------------------------------------------------------- IMPLICIT NONE C C Normal variables definition C integer lung integer*1 vecta(lung) integer*2 ibuf integer me integer check, crctof integer ic0,sup,inf integer i, ic, bit, bi,j integer start,ntdc,tdcfirst integer tdcid(12),evcount(12) integer tdcmask(12),adc(4,12),tdc(4,12) integer rawadc(4,12),rawtdc(4,12),grayadc(4,12),graytdc(4,12) integer temp1(12),temp2(12) logical flag2 C c data start,ntdc /150,12/ ! to read data before Christmas 2004 data start,ntdc /153,12/ ! to read data after Christmas 2004 COMMON / tofvar /tdcid,evcount,tdcmask,adc,tdc,temp1,temp2 save / tofvar / C C Begin ! C C C AAA : would be better to have a pattern for the tof! C at this moment we have just a pointer (start) C ic = start C c print *,'++++++++++ Tof Unpack ++++++++++++++++' do j = 1,ntdc flag2=.true. ic0 = ic ! first index for the CRC computation tdcid(j) = 0 evcount(j) = 0 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) tdcid(j) = ibset(tdcid(j),bit) bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) evcount(j) = ibset(evcount(j),bit) enddo c ic=ic+2 tdcmask(j) = 0 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) tdcmask(j) = ibset(tdcmask(j),bit+8) bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) tdcmask(j) = ibset(tdcmask(j),bit) enddo c ic=ic+2 c c c if first 3 bit of the word RAWADC are equal to 0 c the data storage is shifted by a word --> ic = ic+1 c and TEMP2 is overwritten by the CRC --> flag2=.false. c tdcfirst = 0 do bit = 5,7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) tdcfirst = ibset(tdcfirst,bit-5) enddo if (tdcfirst.eq.0) then ic=ic+1 flag2=.false. endif c do i=1,4 rawadc(i,j) = 0 rawtdc(i,j) = 0 grayadc(i,j) = 0 graytdc(i,j) = 0 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit+8) bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit) bi = ibits(vecta(ic+2),bit,1) if (bi.eq.1) rawtdc(i,j) = ibset(rawtdc(i,j),bit+8) bi = ibits(vecta(ic+3),bit,1) if (bi.eq.1) rawtdc(i,j) = ibset(rawtdc(i,j),bit) enddo c c adc e tdc data have to be translated from Gray code to binary (bit 0-11) c bit 12 is added after conversion (control bit) c bit 13 is 1(0) for charge(time) information c bits 14-15 give the channel 1-4 on the board. c grayadc(i,j)=ibits(rawadc(i,j),0,12) graytdc(i,j)=ibits(rawtdc(i,j),0,12) c call graytobin(grayadc(i,j),adc(i,j),12) call graytobin(graytdc(i,j),tdc(i,j),12) c bi = ibits(rawtdc(i,j),12,1) if (bi.eq.1) tdc(i,j) = ibset(tdc(i,j),12) bi = ibits(rawadc(i,j),12,1) if (bi.eq.1) adc(i,j) = ibset(adc(i,j),12) c ic=ic+4 enddo c temp1(j) = 0 temp2(j) = 0 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) temp1(j) = ibset(temp1(j),bit) enddo ic=ic+1 c if (flag2.eqv..true.) then do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) temp2(j) = ibset(temp2(j),bit) enddo ic=ic+1 else temp2(j) = 99 endif c c vecta(ic) is the CRC c Check consistency of CRC. c ccc if(vecta(ic).lt.0)vecta(ic)=vecta(ic)+256 ibuf=0 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) ibuf = ibset(ibuf,bit) enddo c check = 0 inf = ic0 sup = ic - 1 do i = inf,sup check=crctof(check,vecta(i)) enddo c if (check.ne.vecta(ic)) then if (check.ne.ibuf) then c print *,'crc wrong ',ibuf, check me = 1 endif c c print *,'---------> ic, j' ,ic,j ic=ic+1 enddo ! j = 1,ntdc RETURN END