C-------------------------------------------------------------------- SUBROUTINE TRIGGERUNPACK(vecta,lung,me) C D.Campana, Feb. 06 C--------------------------------------------------------------------- IMPLICIT NONE C integer lung integer*1 vecta(lung) integer*2 ibuf integer me integer*2 check, crctrig integer ic0,sup,inf integer i, ic, bit, bi integer pmtpl(3), trigrate(6), dltime(2), s4calcount(2) integer pmtcount1(24), pmtcount2(24) integer*4 patternbusy(3) integer patterntrig(6), trigconf integer*4 evcount real ratepmt(3),ratetrig(6),dltimems(2) C C COMMON / trig / evcount, pmtpl, trigrate, dltime, & s4calcount, pmtcount1, pmtcount2, & patternbusy, patterntrig, trigconf save / trig / C C Begin ! C me = 0 ic = 1 c print *,'************* Trigger Unpack ******************' ic0 = ic do i = 1, 3 pmtpl(i) = 0 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) pmtpl(i) = ibset(pmtpl(i),7-bit) if (bit.ge.4) then bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) pmtpl(i) = ibset(pmtpl(i),15-bit) endif enddo ratepmt(i) = pmtpl(i)/0.06 ! rate di piano in Hz ic = ic + 2 enddo c print *,'----------> 1crc: ',ic c print *,'pmtpl(i,(i=1,3))' c print *,pmtpl(1),pmtpl(2),pmtpl(3) c print *,'ratepmt(i,(i=1,3))' c print *,ratepmt(1),ratepmt(2),ratepmt(3) c c vecta(ic) is the CRC c Check consistency of CRC. c 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=crctrig(check,vecta(i)) enddo if (check.ne.ibuf) then c print *,'crc wrong ',ibuf, check me = 1 endif c ic = ic + 1 ic0 = ic evcount = 0 do bit=0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) evcount = ibset(evcount,7-bit) bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) evcount = ibset(evcount,15-bit) bi = ibits(vecta(ic+2),bit,1) if (bi.eq.1) evcount = ibset(evcount,23-bit) enddo ic = ic + 3 c print *,'----------> 2crc: ',ic c print *,'evcount',evcount c c vecta(ic) is the CRC c Check consistency of CRC. c 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=crctrig(check,vecta(i)) enddo if (check.ne.ibuf) then c print *,'crc wrong ',ibuf, check me = 1 endif c c ic = ic + 1 ic0 = ic do i = 1, 6 trigrate(i) = 0 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) trigrate(i) = ibset(trigrate(i),7-bit) if (bit.ge.4) then bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) trigrate(i) = ibset(trigrate(i),15-bit) endif enddo c ratetrig(i) = trigrate(i)/0.06 ! rate di trigger in Hz ratetrig(i) = trigrate(i)/4.0 ! rate di trigger in Hz ic = ic + 2 enddo c print *,'----------> 3crc: ',ic c print *,'trigrate(i,(i=1,6))' c print *,trigrate(1),trigrate(2),trigrate(3) c print *,trigrate(4),trigrate(5),trigrate(6) c print *,'ratetrig(i,(i=1,6))' c print *,ratetrig(1),ratetrig(2),ratetrig(3) c print *,ratetrig(4),ratetrig(5),ratetrig(6) c c vecta(ic) is the CRC c Check consistency of CRC. c 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=crctrig(check,vecta(i)) enddo if (check.ne.ibuf) then c print *,'crc wrong ',ibuf, check me = 1 endif c c ic = ic + 1 ic0 = ic do i = 1, 2 dltime(i) = 0 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) dltime(i) = ibset(dltime(i),7-bit) bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) dltime(i) = ibset(dltime(i),15-bit) enddo ic = ic + 2 enddo dltimems(1) = dltime(1) * 0.16 ! dltime in msec dltimems(2) = dltime(2) * 0.01 ! dltime in msec c print *,'----------> 4crc: ',ic c print *,'dltime(i,(i=1,2))' c print *,dltime(1),dltime(2) c print *,'dltimems(i,(i=1,2))' c print *,dltimems(1),dltimems(2) c c vecta(ic) is the CRC c Check consistency of CRC. c 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=crctrig(check,vecta(i)) enddo if (check.ne.ibuf) then c print *,'crc wrong ',ibuf, check me = 1 endif c c ic = ic + 1 ic0 = ic do i = 1, 2 s4calcount(i) = 0 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) s4calcount(i) = ibset(s4calcount(i),7-bit) if (bit.ge.4) then bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) s4calcount(i) = ibset(s4calcount(i),15-bit) endif enddo ic = ic + 2 enddo c print *,'----------> 5crc: ',ic c print *,'s4calcount(i,(i=1,2))' c print *,s4calcount(1),s4calcount(2) c c c vecta(ic) is the CRC c Check consistency of CRC. c 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=crctrig(check,vecta(i)) enddo if (check.ne.ibuf) then c print *,'crc wrong ',ibuf, check me = 1 endif C ic = ic + 1 ic0 = ic do i = 1, 24 pmtcount1(i) = 0 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) pmtcount1(i) = ibset(pmtcount1(i),7-bit) if (bit.ge.4) then bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) pmtcount1(i) = ibset(pmtcount1(i),15-bit) endif enddo ic = ic + 2 enddo c print *,'----------> 6crc: ',ic c print *,'pmtcount1(i,(i=1,24))' c print *,pmtcount1(1) ,pmtcount1(2) ,pmtcount1(3) ,pmtcount1(4) c print *,pmtcount1(5) ,pmtcount1(6) ,pmtcount1(7) ,pmtcount1(8) c print *,pmtcount1(9) ,pmtcount1(10),pmtcount1(11),pmtcount1(12) c print *,pmtcount1(13),pmtcount1(14),pmtcount1(15),pmtcount1(16) c print *,pmtcount1(17),pmtcount1(18),pmtcount1(19),pmtcount1(20) c print *,pmtcount1(21),pmtcount1(22),pmtcount1(23),pmtcount1(24) c c c vecta(ic) is the CRC c Check consistency of CRC. c 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=crctrig(check,vecta(i)) enddo if (check.ne.ibuf) then c print *,'crc wrong ',ibuf, check me = 1 endif c c ic = ic + 1 ic0 = ic do i = 1, 24 pmtcount2(i) = 0 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) pmtcount2(i) = ibset(pmtcount2(i),7-bit) if (bit.ge.4) then bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) pmtcount2(i) = ibset(pmtcount2(i),15-bit) endif enddo ic = ic + 2 enddo c print *,'----------> 7crc: ',ic c print *,'pmtcount2(i,(i=1,24))' c print *,pmtcount2(1) ,pmtcount2(2) ,pmtcount2(3) ,pmtcount2(4) c print *,pmtcount2(5) ,pmtcount2(6) ,pmtcount2(7) ,pmtcount2(8) c print *,pmtcount2(9) ,pmtcount2(10),pmtcount2(11),pmtcount2(12) c print *,pmtcount2(13),pmtcount2(14),pmtcount2(15),pmtcount2(16) c print *,pmtcount2(17),pmtcount2(18),pmtcount2(19),pmtcount2(20) c print *,pmtcount2(21),pmtcount2(22),pmtcount2(23),pmtcount2(24) c c vecta(ic) is the CRC c Check consistency of CRC. c 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=crctrig(check,vecta(i)) enddo if (check.ne.ibuf) then c print *,'crc wrong ',ibuf, check me = 1 endif c ic = ic + 1 ic0 = ic do i = 1, 3 patternbusy(i) = 0 if(i.eq.1)then do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),11+bit) bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),3+bit) if (bit.ge.5) then bi = ibits(vecta(ic+2),bit,1) if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),bit-5) endif enddo endif if(i.eq.2)then do bit = 0, 7 if (bit.lt.5) then bi = ibits(vecta(ic),bit,1) if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),14+bit) endif bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),6+bit) if (bit.ge.2) then bi = ibits(vecta(ic+2),bit,1) if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),bit-2) endif enddo endif if(i.eq.3)then do bit = 0, 7 if (bit.lt.2) then bi = ibits(vecta(ic),bit,1) if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),17+bit) endif bi = ibits(vecta(ic+1),bit,1) if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),9+bit) bi = ibits(vecta(ic+2),bit,1) if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),bit+1) if (bit.eq.7) then bi = ibits(vecta(ic+3),bit,1) if (bi.eq.1) patternbusy(i) = ibset(patternbusy(i),0) endif enddo endif ic = ic + 2 enddo ic = ic + 2 c print *,'----------> 8crc: ',ic c print *,'patternbusy(i,(i=1,3))' c print *, patternbusy(1) ,patternbusy(2) ,patternbusy(3) c c vecta(ic) is the CRC c Check consistency of CRC. c 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=crctrig(check,vecta(i)) enddo if (check.ne.ibuf) then c print *,'crc wrong ',ibuf, check me = 1 endif c c ic = ic + 1 ic0 = ic do i = 1, 6 patterntrig(i) = 0 enddo do i = 1, 7 if(i.eq.1)then do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1)then if(bit.ge.4)patterntrig(i) = ibset(patterntrig(i),bit-4) if(bit.lt.4.and.bit.gt.0) + patterntrig(i+1) = ibset(patterntrig(i+1),bit-1) if(bit.eq.0)patterntrig(i+2)=ibset(patterntrig(i+2),11) endif enddo endif if(i.eq.2)then do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) + patterntrig(i+1) = ibset(patterntrig(i+1),bit+3) enddo endif if(i.eq.3)then do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1)then if(bit.ge.5)then patterntrig(i)=ibset(patterntrig(i),bit-5) else patterntrig(i+1)=ibset(patterntrig(i+1),bit+3) endif endif enddo endif if(i.eq.4)then do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1)then if(bit.ge.5)then patterntrig(i)=ibset(patterntrig(i),bit-5) else patterntrig(i+1)=ibset(patterntrig(i+1),bit+7) endif endif enddo endif if(i.eq.5)then do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1)then if(bit.gt.0)then patterntrig(i)=ibset(patterntrig(i),bit-1) else patterntrig(i+1)=ibset(patterntrig(i+1),bit+15) endif endif enddo endif if(i.eq.6)then do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1)patterntrig(i)=ibset(patterntrig(i),bit+7) enddo endif if(i.eq.7)then do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1)then if(bit.gt.0)patterntrig(i-1)=ibset(patterntrig(i-1),bit-1) endif enddo endif ic = ic + 1 enddo c print *,'----------> 9crc: ',ic c print *,'patterntrig(i,(i=1,6))' c print *, patterntrig(1) ,patterntrig(2) ,patterntrig(3) c print *, patterntrig(4) ,patterntrig(5) ,patterntrig(6) c c c vecta(ic) is the CRC c Check consistency of CRC. c 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=crctrig(check,vecta(i)) enddo if (check.ne.ibuf) then c print *,'crc wrong ',ibuf, check me = 1 endif c c ic = ic + 1 ic0 = ic trigconf = 0 do i = 1, 2 do bit = 0, 7 bi = ibits(vecta(ic),bit,1) if (bi.eq.1) then if(i.eq.1) trigconf = ibset(trigconf,bit+2) if(i.eq.2) then if(bit.ge.6)trigconf = ibset(trigconf,bit-6) endif endif enddo ic = ic + 1 enddo c print *,'----------> 10crc: ',ic c print *,'ic here is ',ic c print *,'trigconf' c print *, trigconf c c vecta(ic) is the CRC c Check consistency of CRC. c 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=crctrig(check,vecta(i)) enddo if (check.ne.ibuf) then c print *,'crc wrong ',ibuf, check me = 1 endif c RETURN END