INTEGER*4 FUNCTION unp3377() C Alexander Kushnirenko C This is a modified routine just to test RS TDC modules, regardless of C detector subsystems that are plugged in. C---------------------------------------------------------------------- C unp3377 : unpack raw 3377 format TDC data into **CT format banks C author : Morgan Burke (TRIUMF) 2001-Mar-5 C C - puts RD and BL data together into RDCT bank C - they are separated by the rd_tdcunp and bl_tdcunp routines C C The **CT TDC bank format stores the module/coordinate information C in a separate word than the time/width information. This is done C to accomodate high-range (16-bit) TDCs that cannot fit all this C information into a 32-bit word. C C Example: C 8001020A header word identifying a channel C 003832F6 tdc hit from that channel (width, time) C 80010314 header word for new channel C 0039F877 tdc hit from that channel (width, time) C 0069B496 another tdc hit from that channel C 8001050E new header C ...etc C C The 3377 banks need to be unpacked into the **CT banks because C tdcunp expects a subsystem to be completely contained in a single C bank, and that is not the case for the raw 3377 banks. C C return codes: 0 = success C 1 = bank not found C 2 = bank length not found C 3 = unsupported 3377 data format C 4 = unsupported subsystem C 5 = map file error C 6 = failed to create **CT bank C 7 = new bank overflowed C---------------------------------------------------------------------- IMPLICIT NONE #include #include #include #include #include #include #include INTEGER Nmodule, Nchanpermod, maxaddr, Nbanks, maxblen PARAMETER (Nbanks = 2, maxblen = 10000, & Nmodule = 36, Nchanpermod = 32, & maxaddr = Nmodule * Nchanpermod) CHARACTER*4 bankname, banks(Nbanks) CHARACTER*80 line, mapfile, message INTEGER*4 ind, inddat, istat, Blocat, Bdlen, in, enddat, lendat INTEGER*4 mod_id, res, chan, nhits, slot, crate, bank, & data, time, ttime, i, evsnum, dyc_count, dyc_total, & status INTEGER*4 mod, address, c1, c2, c3, tdcmap(MAXADDR,3), hitnum LOGICAL*4 dword, bothedge, mostsig, mostsig_last, first, & tedge, tedge_last, go, debug, header_last INTEGER*2 bit15, bit14, bit10, bit09, bit08 INTEGER*4 tbank(maxblen), tptr, last_address integer $ id_tuple, ! ntuple ID number $ ltuple, ! length of ntuple $ hstat ! status of HBOOK I/O oper parameter( $ id_tuple = 1, $ ltuple = 10) character*8 $ tags_tuple(ltuple) ! ntuple varable names real $ tuple(ltuple) ! storage for ntuple entries data tags_tuple $ /'event', 'module', 'channel', 'status', 'start', 'stop', $ 'res1','res2', 'res3', 'res4'/ PARAMETER ( bit15 = '8000'X, & bit14 = '4000'X, & bit10 = '0400'X, & bit09 = '0200'X, & bit08 = '0100'X ) DATA debug / .false. /, first /.true./ DATA banks / 'CAR1', 'CAR2' / save first if (first) then first = .false. call hropen(66,'RSTDC','rs_test.hbk','N',1024,hstat) call hbookn(id_tuple, 'RS TDC pulser test', ltuple, $ 'RSTDC', 30000, tags_tuple) call hcdir('//RSTDC',' ') end if status = 0 ! readou hit status nhits = 0 bank = 1 tptr = 1 unp3377 = 0 ! loop over all 3377 banks 1 CONTINUE bankname = banks(bank) ! find 3377 bank istat = Blocat(ibank,bankname,1,ind,inddat) IF (istat .NE. yesucc) THEN unp3377 = 1 RETURN ENDIF istat = Bdlen(ibank,ind,lendat) IF (istat .NE. yesucc) THEN CALL kerror(-4,10,'UNP3377','bad length in bank '//bankname) unp3377 = 2 RETURN ENDIF IF (ibank(inddat) .NE. nevt) THEN CALL kerror(-2,5,'UNP3377','event mismatch in bank '//bankname) ENDIF IF (debug) THEN WRITE(lout,100) ibank(inddat + 1) WRITE(llog,100) ibank(inddat + 1) 100 FORMAT('DC2 header: ',Z8) ENDIF ! expected data tedge_last = .FALSE. mostsig_last = .FALSE. dyc_total = -1 ! use irec to access 16-bit data words in = inddat * 2 - 1 enddat = in + lendat * 2 - 1 ! skip event #, DC2 hdr in = in + 4 DO WHILE (in .LE. enddat) IF (IAND(ISHFT(irec(in),-4),mask(12)) .EQ. mask(12)) THEN ! DYC header ! move bit 1 to bit 12 of dyc_count dyc_total = ISHFT(IAND(ISHFT(irec(in),-1),1),12) in = in + 1 ! copy bits 0:11 to dyc_count dyc_total = IOR(dyc_total,IAND(irec(in),mask(12))) header_last = .FALSE. IF (debug) THEN WRITE(lout,104) ibank(in/2),dyc_total WRITE(llog,104) ibank(in/2),dyc_total 104 FORMAT('DYC header: ',Z8,' FERA word count =',I4) ENDIF dyc_count = 0 ELSE IF (dyc_count .GT. dyc_total) THEN ! pad word - do nothing until the next DYC header header_last = .FALSE. IF (debug) THEN WRITE(lout,*) 'ignoring DYC pad word' WRITE(llog,*) 'ignoring DYC pad word' ENDIF ELSE IF (IAND(irec(in),bit15) .NE. 0) THEN ! TDC header dword = (IAND(irec(in),bit14) .NE. 0) mod_id = IAND(irec(in),mask(8)) slot = IAND(mod_id,mask(5)) crate = IAND(ISHFT(mod_id,-5),mask(2)) res = IAND(ISHFT(irec(in),-8),mask(2)) bothedge = (IAND(irec(in),bit15) .NE. 0) evsnum = IAND(ISHFT(irec(in),-11),mask(3)) IF (.NOT. dword .OR. .NOT. bothedge) THEN CALL kerror(4,5,'UNP3377','unsupported 3377 data format') unp3377 = 3 RETURN ENDIF IF (debug) THEN WRITE(lout,101) irec(in),mod_id,bank,res,evsnum WRITE(llog,101) irec(in),mod_id,bank,res,evsnum 101 FORMAT('TDC header (0x',Z4.4,'): mod-id=0x',Z2.2, $ ' bank=', I2, & ' res=', I1,' ser#=',I1) ENDIF header_last = .TRUE. ELSE ! data word chan = IAND(ISHFT(irec(in),-10),mask(5)) ! assume double word format data = IAND(irec(in),mask(8)) mostsig = (IAND(irec(in),bit08) .NE. 0) tedge = (IAND(irec(in),bit09) .NE. 0) IF (debug) THEN WRITE(lout,102) chan, data, mostsig, tedge WRITE(llog,102) chan, data, mostsig, tedge 102 FORMAT('data: chan=',I02,' data=',Z02,' highbyte=',L1, & ' trailing edge=',L1) ENDIF IF (mostsig) THEN IF (mostsig_last) THEN CALL kerror(2,5,'UNP3377', & 'missing least significant byte') status = IOR(status,'0001'x) ! note missing least sig byte ENDIF IF (tedge .EQ. tedge_last) THEN IF (tedge) THEN CALL kerror(2,5,'UNP3377','missing leading edge') status = IOR(status,'0004'x) ! note missing lead edge ELSE CALL kerror(2,5,'UNP3377','missing trailing edge') status = IOR(status,'0008'x) ! note missing trail edge ENDIF ENDIF time = ISHFT(data,8) ELSE IF (.NOT.mostsig_last) THEN CALL kerror(2,5,'UNP3377', & 'missing most significant byte') status = IOR(status,'0002'x) ! note missing most sig byte ELSE time = time .OR. data IF (.NOT. tedge) THEN go = .TRUE. nhits = nhits + 1 ELSE ! remember trailing edge time to calculate width later ! NOTE: trailing times are SMALLER than leading times ttime = time ENDIF ENDIF ENDIF tedge_last = tedge mostsig_last = mostsig header_last = .FALSE. ENDIF ! ! now process complete TDC hits ! IF (go) THEN call vzero(tuple, ltuple) ! clear array first tuple(1) = nevt ! event number tuple(2) = mod_id ! module number tuple(3) = chan ! channel number tuple(4) = status ! status tuple(5) = time ! start time tuple(6) = ttime ! stop time call HFN(id_tuple, tuple) ! fill Ntuple IF (debug) THEN WRITE(lout,103) chan, c1, c2, c3, time, time-ttime WRITE(llog,103) chan, c1, c2, c3, time, time-ttime 103 FORMAT('HIT>> chan=',I02,' (E',I1,' S',I2.2,' L',I2.2, & ') time=',I5,' width=',I5) ENDIF 105 go = .FALSE. ENDIF dyc_count = dyc_count + 1 in = in + 1 ENDDO ! get next bank bank = bank + 1 IF (bank .LE. Nbanks) GOTO 1 IF (debug) THEN WRITE(lout,*) 'total hits in this event:',nhits,bank WRITE(llog,*) 'total hits in this event:',nhits,bank ENDIF RETURN END c----------------------------------------------------------------------------- subroutine dplot #include implicit none integer i, unp3377 external unp3377 call batch_log i = unp3377() return end c------------------------------------------------------------------------ subroutine define implicit none #include integer*4 nwpawc parameter (nwpawc=1000000) integer iquest common /quest/ iquest(100) real*4 hmemor common /pawc/ hmemor(nwpawc) c hbook stuff call hlimit(nwpawc) return end c------------------------------------------------------------------------ subroutine exec_on_exit implicit none #include #include integer $ icycle ! HBOOK cycle variable c ----- now save the ntuple ----- call hcdir('//RSTDC',' ') ! go to ntuple directory call hrout(1, icycle, 'NT') ! write ntuple out call hrend('RSTDC') ! close directory close(66) ! close file return end