1 saw 1.1 INTEGER*4 FUNCTION g_decode_fb_detector(oslot,roc,evfrag,length,did,
2 $ maxhits,hitcount,planelist,counterlist,signalcount,signal0,
3 $ signal1,signal2,signal3)
4 *----------------------------------------------------------------------
5 *- Created ? Steve Wood, CEBAF
6 *- Corrected 3-Dec-1993 Kevin Beard, Hampton U.
7 * $Log: g_decode_fb_detector.f,v $
8 * Revision 1.18 1997/04/03 10:56:05 saw
9 * (SAW) Better report of DCFE code words. Prints out roc, slot, event
10 * number and how many extra events are in the module.
11 *
12 * Revision 1.17 96/09/04 14:34:19 14:34:19 saw (Stephen A. Wood)
13 * (JRA) More error reporting of error codes in FB data stream
14 *
15 * Revision 1.16 1996/04/29 19:46:19 saw
16 * (JRA) Tweak diagnostic messages
17 *
18 * Revision 1.15 1996/01/16 20:51:55 cdaq
19 * (SAW) Fixes: Forgot why
20 *
21 * Revision 1.14 1995/11/28 18:59:24 cdaq
22 saw 1.1 * (SAW) Change arrays that use roc as index to start with zero.
23 *
24 * Revision 1.13 1995/10/09 18:23:29 cdaq
25 * (JRA) Comment out some debugging statements
26 *
27 * Revision 1.12 1995/07/27 19:10:02 cdaq
28 * (SAW) Use specific bit manipulation routines for f2c compatibility
29 *
30 * Revision 1.11 1995/01/31 15:55:52 cdaq
31 * (SAW) Make sure mappointer and subaddbit are set on program entry.
32 *
33 * Revision 1.10 1995/01/27 20:14:04 cdaq
34 * (SAW) Add assorted diagnostic printouts. Add hack to look for the headers
35 * on new 1881M/1877 modules while maintaining backward compatibility.
36 *
37 * Revision 1.9 1994/10/20 12:34:55 cdaq
38 * (SAW) Only print out "Max exceeded, did=" meesage once
39 *
40 * Revision 1.8 1994/06/27 02:14:18 cdaq
41 * (SAW) Ignore all words that start with DC
42 *
43 saw 1.1 * Revision 1.7 1994/06/22 20:21:24 cdaq
44 * (SAW) Put -1 in hodoscope signals that don't get any data
45 *
46 * Revision 1.6 1994/06/22 20:07:37 cdaq
47 * (SAW) Fix problems with filling of hodoscope type hit lists (multiple signal)
48 *
49 * Revision 1.5 1994/06/21 16:02:54 cdaq
50 * (SAW) Ignore DCFF0000 headers from Arrington's CRL's
51 *
52 * Revision 1.4 1994/06/18 02:48:04 cdaq
53 * (SAW) Add code for miscleaneous data and uninstrumented channels
54 *
55 * Revision 1.3 1994/04/06 18:03:38 cdaq
56 * (SAW) # of bits to get channel number is now configurable (g_decode_subaddbit).
57 * Changed range of signal types from 1:4 to 0:3 to agree with documentation.
58 *
59 * Revision 1.2 1994/03/24 22:00:15 cdaq
60 * Temporarily change shift to get subaddress from 17 to 16
61 *
62 * Revision 1.1 1994/02/04 21:50:03 cdaq
63 * Initial revision
64 saw 1.1 *
65 *----------------------------------------------------------------------
66 implicit none
67 SAVE
68 *
69 * The following arguments don't get modified.
70 integer*4 roc,evfrag(*),length,did,maxhits,signalcount
71
72 * The following arguments get modified.
73 integer*4 oslot
74 integer*4 buffer
75 integer*4 hitcount,planelist(*),counterlist(*)
76 integer*4 signal0(*),signal1(*),signal2(*),signal3(*)
77 integer pointer,newdid,subadd,slot,mappointer,plane
78 integer counter,signal,sigtyp
79 *
80 include 'gen_decode_common.cmn'
81 include 'gen_detectorids.par'
82 include 'gen_scalers.cmn'
83 include 'gen_event_info.cmn'
84 integer iscaler,nscalers
85 saw 1.1 *
86 integer h,hshift
87 integer subaddbit
88 logical printerr !flag to turn off printing of error after 1 time.
89 logical firsttime
90 *
91 integer*4 jishft, jiand
92 *
93 printerr = .true.
94 pointer = 1
95 newdid = did
96
97 firsttime = .true.
98 do while(pointer.le.length .and. did.eq.newdid)
99 *
100 if(jiand(evfrag(pointer),'FFFFFFFF'x).eq.'DCAA0000'x) then ! VME/FB event length mismatch
101 write(6,'(a,i10)') 'ERROR: VME/Fastbus event length mismatch for event #',gen_event_id_number
102 write(6,'(a,z9,a,z9,a)') ' Fastbus event length:',evfrag(pointer+1),
103 & ' VME event length:',evfrag(pointer+2),' (or vice-versa).'
104 pointer = pointer + 3
105 goto 987
106 saw 1.1 ! Check for extra events in FB modules on sync events
107 else if(jiand(evfrag(pointer),'FFFF0000'x).eq.'DCFE0000'x) then
108 write(6,'(a,i2,a,i3,a,i3,a,i10)') 'ROC',roc,': Slot'
109 $ ,jiand(jishft(evfrag(pointer),-11),'1F'x),': '
110 $ ,jiand(evfrag(pointer),'7FF'x),' extra events, event=',
111 & gen_event_id_number
112 pointer = pointer + 1
113 goto 987
114 else if(jiand(evfrag(pointer),'FF000000'x).eq.'DC000000'x) then ! Catch arrington's headers
115 write(6,'(a,i2,a,i10,a,z10)') 'ROC',roc,': no gate or too much data, event=',
116 & gen_event_id_number,' error dataword=',evfrag(pointer)
117 pointer = pointer + 1
118 goto 987
119 endif
120
121 *
122 * Check for event by event scalers thrown in by the scaler hack.
123 *
124 * if(jiand(evfrag(pointer),'FF000000'x).eq.'DA000000'x) then ! Magic header
125 * nscalers = jiand(evfrag(pointer),'FF'x)
126 * do iscaler=1,nscalers
127 saw 1.1 * evscalers(iscaler) = evfrag(pointer+iscaler)
128 * enddo
129 * pointer = pointer + nscalers + 1
130 * goto 987
131 * endif
132
133 if(evfrag(pointer).le.1.and.evfrag(pointer).ge.0) then
134
135 ! on sync events, get zeros at end of event.
136 if (gen_event_id_number .eq. 1000*int(gen_event_id_number/1000)) then
137 if (evfrag(pointer).ne.0) then
138
139 write(6,'(" ERROR: BAD FB value evfrag(",i4,")=",z10," ROC=",i2,"event=",i7)')
140 $ pointer,evfrag(pointer),roc,gen_event_id_number
141 endif
142 endif
143 pointer = pointer + 1
144 goto 987
145 endif
146 slot = jiand(JISHFT(evfrag(pointer),-27),'1F'X)
147 if(slot.ne.oslot.or.firsttime) then
148 saw 1.1 if (slot.le.0 .or. slot.ge.26 .or. roc.le.0 .or. roc.ge.9) then
149 write (6,'(a,i2,i3,z10,a,i5,a,i8)') 'roc,slot,evfrag=',roc,
150 & slot,evfrag(pointer),
151 $ '(p=',pointer,') for event #',gen_event_id_number
152 write (6,'(a,i3)') ' Probably after slot',jiand(JISHFT(evfrag(pointer-1),-27),'1F'X)
153 pointer = pointer + 1
154 goto 987
155 else
156 mappointer = g_decode_slotpointer(roc,slot)
157 subaddbit = g_decode_subaddbit(roc,slot) ! Usually 16 or 17
158 endif
159 endif
160 if(slot.ne.oslot) then
161 oslot = slot
162
163 c
164 c On 1881M's and 1877, a subaddress of zero could be a header word, so
165 c we need to put in some hackery to catch these. We need to make sure
166 c that 1881's and 1876's will still work.
167 c
168 c A real ugly hack that looks to see if the first word of an 1881M or
169 saw 1.1 c 1877 has a subaddress of zero, in which case it is the header word and must
170 c be discarded. If it is an 1881 or 1876, then the the first word of a
171 c new slot will have a subaddress of '7F' and later be discarded.
172 c
173 if(subaddbit.eq.17) then ! Is not an 1872A (which has not headers)
174 if(jiand(evfrag(pointer),'00FE0000'X).eq.0) then ! probably a header
175 if(jiand(evfrag(pointer),'07FF0000'X).ne.0) then
176 print *,"SHIT:misidentified real data word as a header"
177 print *,"DID=",did,", SLOT=",slot,", POINTER=",pointer
178 else
179 pointer = pointer + 1
180 goto 987
181 endif
182 endif
183 endif
184 endif
185 *
186 ***********************
187 cc write(6,*) buffer
188 c buffer = jiand(JISHFT(evfrag(pointer),-24),'03'X)
189 c if (g_decode_bufnum .ne. buffer) then
190 saw 1.1 c if (g_decode_bufnum.eq.-1) then
191 c g_decode_bufnum=buffer
192 c else
193 c write (6,*) 'g_decode_fb_detector: roc,slot,buffer='
194 c & ,roc,slot,buffer,'but previous data was buffer=',
195 c & g_decode_bufnum
196 c write (6,*) 'gen_event_id_number=',gen_event_id_number
197 cc stop
198 c endif
199 c endif
200 *************************
201 subadd = jiand(JISHFT(evfrag(pointer),-subaddbit),'7F'X)
202 *
203 * If a module that uses a shift of 17 for the subaddress is in a slot
204 * that we havn't told the map file about, it's data will end up in the
205 * unstrimented channel "detector" hit list. However, the decoder will
206 * think that the subaddress starts in channel 16 (since some Lecroy
207 * modules do so), The next statement will mean that only the first 64
208 * channels will end up in the uninstrumented hit list. The rest will
209 * be lost. If you don't want to put this module in the map file, put
210 * in a single entry for it with a detector id of UNINST_ID (zero) and
211 saw 1.1 * the proper BSUB value.
212 *
213 if (subadd .lt. '7F'X) then ! Only valid subaddresses
214 ! Skips headers for 1881 and 1876
215 if(mappointer.gt.0) then
216 newdid = g_decode_didmap(mappointer+subadd)
217 else
218 newdid = UNINST_ID
219 endif
220 if(newdid.eq.did) then
221 if(did.ne.UNINST_ID) then
222 plane = g_decode_planemap(mappointer+subadd)
223 counter = g_decode_countermap(mappointer+subadd)
224 signal =jiand(evfrag(pointer),g_decode_slotmask(roc,slot))
225 else
226 plane = jishft(roc,16) + slot
227 counter = subadd
228 signal = evfrag(pointer)
229 endif
230 if(hitcount .lt. maxhits) then ! Don't overwrite arrays
231 if(signalcount .eq. 1) then ! single signal counter
232 saw 1.1 *
233 * Starting at end of hit list, search back until a hit earlier in
234 * the sort order is found.
235 *
236 h = hitcount
237 do while(h .gt. 0 .and. (plane .lt. planelist(h)
238 $ .or.(plane .eq. planelist(h).and. counter .lt.
239 $ counterlist(h))))
240 *
241 * Shift hit to next place in list
242 *
243 planelist(h+1) = planelist(h)
244 counterlist(h+1) = counterlist(h)
245 signal0(h+1) = signal0(h)
246 h = h - 1
247 enddo
248 h = h + 1 ! Put hit pointer to blank
249 planelist(h) = plane
250 counterlist(h) = counter
251 signal0(h) = signal
252 hitcount = hitcount + 1
253 saw 1.1 else if(signalcount.eq.4) then ! Multiple signal counter
254 *
255 * Starting at the end of the hist list, search back until a hit on
256 * the same counter or earlier in the sort order is found.
257 *
258 h = hitcount
259 do while(h .gt. 0 .and. (plane .lt. planelist(h)
260 $ .or.(plane .eq. planelist(h).and. counter .lt.
261 $ counterlist(h))))
262 h = h - 1
263 enddo
264 *
265 * If plane/counter match is not found, then need to shift up the array
266 * to make room for the new hit.
267 *
268 if(h.le.0.or.plane.ne.planelist(h) ! Plane and counter
269 $ .or.counter.ne.counterlist(h)) then ! not found
270 h = h + 1
271 do hshift=hitcount,h,-1 ! Shift up to make room
272 planelist(hshift+1) = planelist(hshift)
273 counterlist(hshift+1) = counterlist(hshift)
274 saw 1.1 signal0(hshift+1) = signal0(hshift)
275 signal1(hshift+1) = signal1(hshift)
276 signal2(hshift+1) = signal2(hshift)
277 signal3(hshift+1) = signal3(hshift)
278 enddo
279 planelist(h) = plane
280 counterlist(h) = counter
281 signal0(h) = -1
282 signal1(h) = -1
283 signal2(h) = -1
284 signal3(h) = -1
285 hitcount = hitcount + 1
286 endif
287 *
288 sigtyp = g_decode_sigtypmap(mappointer+subadd)
289 *
290 if(sigtyp.eq.0) then
291 signal0(h) = signal
292 else if (sigtyp.eq.1) then
293 signal1(h) = signal
294 else if (sigtyp.eq.2) then
295 saw 1.1 signal2(h) = signal
296 else if (sigtyp.eq.3) then
297 signal3(h) = signal
298 endif
299 endif
300 else if(hitcount.eq.maxhits .and. printerr) then ! Only print this message once
301 c print *,'g_decode_fb_detector: Max exceeded, did=',
302 c $ did,', max=',maxhits,': event',gen_event_id_number
303 c print *,' roc,slot,cntr=',roc,slot,counter
304 printerr = .false.
305 *
306 * Print/generate some kind of error that the hit array has been
307 * exceeded.
308 *
309 endif
310 pointer = pointer + 1
311 * else
312 * exit and get called back with the correct arrays for the new did
313 endif
314 else
315 pointer = pointer + 1
316 saw 1.1 endif
317 987 continue
318 enddo
319
320 g_decode_fb_detector = pointer - 1 ! Number of words processed
321
322 return
323 end
324 **************
325 * Local Variables:
326 * mode: fortran
327 * fortran-if-indent: 2
328 * fortran-do-indent: 2
329 * End:
|
Return to
g_decode_fb_detector.f
CVS log
Up to [HallC] / Analyzer / T20