/[PAMELA software]/calo/unpacking/calpedestal.for
ViewVC logotype

Contents of /calo/unpacking/calpedestal.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations) (download)
Thu Jun 29 12:50:42 2006 UTC (18 years, 5 months ago) by mocchiut
Branch: MAIN
Changes since 1.2: +7 -5 lines
Bug fixed in reading the y planes

1 C
2 C Written by Mirko Boezio and Emiliano Mocchiutti
3 C
4 C * Version: 3.1.4 *
5 C
6 C 3.1.3 - 3.1.4: (2006-06-29) XO is rotated, not XE!! fixed.
7 C
8 C 3.1.2 - 3.1.3: (2006-06-29) save in calped(section,1,1) and calped(section,1,2) the CRC values (transmitted and calculated) in case of CRC errors
9 C
10 C 3.1.1 - 3.1.2: (2005-12-02) recognize RAW mode command and exit with error 130.
11 C
12 C 3.1.0 - 3.1.1: (2004-12-21) changed common varie.
13 C
14 C 3.0.01 - 3.1.0: (2004-12-10) cleanup of the code and changes in the
15 C sections order.
16 C
17 C 3.0.00 - 3.0.01: (2004-11-08) changes in the commons (one more common for
18 C calpulse and from calstripshit to calstriphit).
19 C
20 C previous - 3.0.00: (2004-10-25) cleanup, some small bugs fixed
21 C
22 C - fixed compilation error
23 C
24 C------------------------------------------------
25 SUBROUTINE CALPEDESTAL(vecta,lung,me)
26 C------------------------------------------------
27
28 IMPLICIT NONE
29 C
30 C Normal variables definition
31 C
32 integer lung
33 INTEGER NPLA, NCHA, LENSEV
34 PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
35 C
36 INTEGER*1 VECTA(lung)
37 INTEGER*2 VECT(60000)
38 C
39 integer*2 check, crc, e2(4)
40 INTEGER*2 length, length2
41 integer*4 chksum, chksum2
42 C
43 integer me, lleng
44 INTEGER i, j
45 INTEGER ERROR(4), merror(4)
46 INTEGER ic, k, ke, ic0, l
47 INTEGER contr, m
48 INTEGER inf, sup,iev
49 INTEGER XO, YO, XE, YE
50 integer st1b, st2b, bit, bi, icb
51 INTEGER lunga, pari
52 integer stwerr(4),dump, cstwerr(4)
53 C
54 REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
55 REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
56 real perror(4), cperror(4)
57 C
58 DATA YE/182/ ! CODE_DSP_R YE = 101 10110
59 DATA YO/173/ ! CODE_DSP_R YO = 101 01101
60 DATA XE/170/ ! CODE_DSP_R XE = 101 01010
61 DATA XO/177/ ! CODE_DSP_R XO = 101 10001
62
63 COMMON / calib / iev, cstwerr, cperror,
64 & calped, calgood, calthr, calrms,
65 & calbase, calvar
66
67 save / calib /
68 c
69 COMMON /VARIE/ dump, contr, merror
70 SAVE /VARIE/
71
72 C
73 C Begin !
74 C
75 if (dump.eq.0) dump = -1
76 C
77 C DEBUG: PRINT OUT THE INPUT VECTOR
78 C
79 if (iev.eq.dump) then
80 do l=1,lung
81 write(*,17)l,vecta(l)
82 enddo
83 endif
84 17 FORMAT(2X,'Elemento:',2X,I6,2X,' word:',2X,Z8)
85 C
86 if (iev.lt.0.or.iev.gt.9000000) iev = 0
87 C
88 call clearall
89 do i = 1, 4
90 cstwerr(i) = 0
91 cperror(i) = 0.
92 error(i) = 0
93 e2(i) = 0
94 stwerr(i) = 0
95 enddo
96 contr = 1
97 me = 0
98 lleng = 0
99 ic = 0
100 pari = 0
101 length = 0
102 C
103 C input length must be > 0, if not go out with error code 142
104 C
105 if (lung.le.0) then
106 if (dump.eq.iev) print *,'lung = ',lung
107 do i=1,4
108 error(i)=142
109 enddo
110 goto 200
111 endif
112 C
113 C
114 IF (MOD(LUNG,2).EQ.0) THEN
115 lunga = lung / 2
116 pari = 1
117 else
118 lunga = int(lung/2) + 1
119 endif
120 c
121 if (lunga.gt.60000.and.dump.gt.0) then
122 print *,'Calorimeter WARNING: more than 60000 words!'
123 lunga = 60000
124 endif
125 c
126 C
127 C the fafede18 packet can also contain the answer to the force RAW mode command
128 C in that case the lenght is 4 and the answer is known.
129 C
130 IF (LUNG.LE.20) THEN
131 if (dump.eq.iev) print *,' RAW MODE COMMAND? '
132 print *,'vecta(1) ',vecta(1),' ',vecta(3)
133 IF ((VECTA(1).EQ.10.AND.VECTA(3).eq.74).or.
134 & (VECTA(1).EQ.17.AND.VECTA(3).eq.81).or.
135 & (VECTA(1).EQ.22.AND.VECTA(3).eq.86).or.
136 & (VECTA(1).EQ.13.AND.VECTA(3).eq.77)) THEN
137 if (dump.eq.iev) print *,' YES! '
138 call fillin(1,lunga,lleng,lung,pari,vect,vecta)
139 if (VECTA(1).EQ.10) contr = 1
140 if (VECTA(1).EQ.17) contr = 2
141 if (VECTA(1).EQ.22) contr = 3
142 if (VECTA(1).EQ.13) contr = 4
143 E2(contr) = vect(2)
144 do i=1,4
145 error(i)=130
146 enddo
147 goto 200
148 ENDIF
149 ENDIF
150 C
151 C
152 C
153 c
154 20 CONTINUE
155 ic = ic + length + 1
156 32 continue
157 ke = 0
158 do while (ke.eq.0)
159 C
160 C Check consistency of header.
161 C it is composed by CODE+D# (8 bits) and by SATUS WORD (8 bits)
162 c so we must split vect into the two components:
163 C
164 C ST1 is CODE + D#
165 c
166 st1b = 0
167 st2b = 0
168 do bit = 0, 7
169 bi = ibits(vecta(ic),bit,1)
170 if (bi.eq.1) st1b = ibset(st1b,bit)
171 bi = ibits(vecta(ic+1),bit,1)
172 if (bi.eq.1) st2b = ibset(st2b,bit)
173 enddo
174 c
175 C ST2 is the STATUS WORD
176 c
177 length2 = 0
178 do bit=0, 7
179 bi = ibits(vecta(ic+3),bit,1)
180 if (bi.eq.1) length2 = ibset(length2,bit)
181 bi = ibits(vecta(ic+2),bit,1)
182 if (bi.eq.1) length2 = ibset(length2,bit+8)
183 enddo
184 c the crc should be at vect(length) with
185 length = length2 + 1
186 C
187 c some checks to be sure we have found the calorimeter data:
188 c
189 c status word is always less then 129
190 c
191 if (st2b.gt.128) then
192 length = 0
193 goto 100
194 endif
195 c
196 c length of the packet must be less then 20000 if no errors
197 c are found
198 c
199 if (st2b.eq.0.and.length2.gt.lunga) then
200 length = 0
201 goto 100
202 endif
203 c
204 if (length2.le.0) then
205 length = 0
206 goto 100
207 endif
208 c
209 c is it the first section?
210 c
211 if (st1b.eq.XE.and.length2.eq.4629) then
212 c if so go out of this loop and go on recording data
213 ke = 1
214 m = ic
215 contr = 1
216 call fillin(m,lunga,lleng,lung,pari,vect,vecta)
217 icb = 1
218 E2(contr) = vect(icb)
219 goto 9
220 endif
221 C
222 c the same for the second section, ...
223 c
224 if (st1b.eq.XO.and.length2.eq.4629) then
225 ke = 1
226 contr = 2
227 m = ic
228 call fillin(m,lunga,lleng,lung,pari,vect,vecta)
229 icb = 1
230 E2(contr) = vect(icb)
231 goto 9
232 endif
233 c
234 C ... for the third,...
235 c
236 if (st1b.eq.YE.and.length2.eq.4629) then
237 ke = 1
238 m = ic
239 contr = 3
240 call fillin(m,lunga,lleng,lung,pari,vect,vecta)
241 icb = 1
242 E2(contr) = vect(icb)
243 goto 9
244 endif
245 C
246 c ...and for the last section.
247 c
248 if (st1b.eq.YO.and.length2.eq.4629) then
249 contr = 4
250 ke = 1
251 m = ic
252 call fillin(m,lunga,lleng,lung,pari,vect,vecta)
253 icb = 1
254 E2(contr) = vect(icb)
255 endif
256 C
257 100 CONTINUE
258 c
259 c increment vector of one searching for the next section
260 c
261 9 continue
262 ic = ic + 1
263 c
264 c if we run out of vector give an error and exit the subroutine
265 c
266 if (ic.gt.(lung-1)) then
267 me = 1
268 call clearall
269 do i = 1, 4
270 error(i) = 129
271 e2(i) = 0
272 stwerr(i) = 0
273 enddo
274 goto 200
275 endif
276 enddo
277 C
278 10 FORMAT(2X,'Error for view:',2X,I1,2X,'Status word:',2X,Z4)
279 11 FORMAT(2X,'View or command not recognized for view:',2X,I1,2X,
280 & 'Status word:',2X,Z4)
281 12 FORMAT(2X,'Error - did NOT find view:',2X,I1)
282 13 FORMAT(2X,'Error - eov reached, exiting')
283 21 FORMAT(2X,'CRC: ',2X,Z8)
284 101 FORMAT(2X,'Status word 1:',2X,Z8)
285 102 FORMAT(2X,'CHKSUM: ',2X,Z16)
286 201 FORMAT(2X,'Status word 2:',2X,Z8)
287 C
288 K = CONTR
289 ic0 = icb
290 ic = ic - 1
291 icb = icb + 1
292 length = vect(icb) + 2
293 length2 = vect(icb)
294 lleng = (length * 2) - 1
295 C
296 C Check consistency of CRC.
297 C
298 check = 0.
299 inf = ic0
300 sup = length - 1
301 do i = inf,sup
302 check=crc(check,vect(i))
303 enddo
304 if (check.ne.vect(length)) then
305 ERROR(contr) = 132
306 calped(k,1,1) = check
307 calped(k,1,2) = vect(length)
308 goto 200
309 endif
310 C
311 if (iev.eq.dump) write(*,21)vect(length)
312 if (iev.eq.dump) write(*,21)check
313 C
314 C Process data.
315 C
316 if (k.eq.1) then
317 k = 1
318 goto 49
319 endif
320 if (k.eq.2) then
321 k = 3
322 goto 49
323 endif
324 if (k.eq.3) then
325 k = 4
326 goto 49
327 endif
328 if (k.eq.4) k = 2
329 c
330 49 continue
331 c
332 chksum = 0
333 do i = 1,11
334 do j = 1,96
335 icb = icb + 1
336 if (k.eq.2) then
337 calped(k,i,97-j) = vect(icb)
338 calgood(k,i,97-j) = vect(icb+1)
339 else
340 calped(k,i,j) = vect(icb)
341 calgood(k,i,j) = vect(icb+1)
342 endif
343 chksum = chksum + vect(icb)
344 icb = icb + 1
345 enddo
346 enddo
347 C
348 chksum2 = 0
349 do bit=0, 15
350 bi = ibits(vect(icb+1),bit,1)
351 if (bi.eq.1) chksum2 = ibset(chksum2,bit)
352 bi = ibits(vect(icb+3),bit,1)
353 if (bi.eq.1) chksum2 = ibset(chksum2,bit+16)
354 enddo
355 C
356 if (chksum.ne.chksum2) then
357 error(contr) = 140
358 endif
359 C
360 icb = icb + 4
361 chksum = 0
362 do i = 1,11
363 do j = 1,6
364 icb = icb + 1
365 if (k.eq.2) then
366 calthr(k,i,7-j) = vect(icb)
367 else
368 calthr(k,i,j) = vect(icb)
369 endif
370 chksum = chksum + vect(icb)
371 icb = icb + 1
372 enddo
373 enddo
374 c
375 chksum2 = 0
376 do bit=0, 15
377 bi = ibits(vect(icb+1),bit,1)
378 if (bi.eq.1) chksum2 = ibset(chksum2,bit)
379 bi = ibits(vect(icb+3),bit,1)
380 if (bi.eq.1) chksum2 = ibset(chksum2,bit+16)
381 enddo
382 C
383 if (chksum.ne.chksum2) then
384 error(contr) = 141
385 endif
386 C
387 icb = icb + 4
388 do i = 1,11
389 do j = 1,96
390 icb = icb + 1
391 if (k.eq.2) then
392 calrms(k,i,97-j) = vect(icb)
393 else
394 calrms(k,i,j) = vect(icb)
395 endif
396 icb = icb + 1
397 enddo
398 enddo
399 c
400 do i = 1,11
401 do j = 1,6
402 icb = icb + 1
403 if (k.eq.2) then
404 calbase(k,i,7-j) = vect(icb)
405 icb = icb + 1
406 icb = icb + 1
407 calvar(k,i,7-j) = vect(icb)
408 icb = icb + 1
409 else
410 calbase(k,i,j) = vect(icb)
411 icb = icb + 1
412 icb = icb + 1
413 calvar(k,i,j) = vect(icb)
414 icb = icb + 1
415 endif
416 enddo
417 enddo
418 me = 0
419 c
420 c
421 50 continue
422 C
423 200 continue
424 C
425 do l = 1, 4
426 do bit=0, 31
427 if (bit.lt.16) then
428 bi = ibits(E2(L),bit,1)
429 else
430 bi = 0
431 endif
432 if (bi.eq.1) then
433 stwerr(l) = ibset(stwerr(l),bit)
434 else
435 stwerr(l) = ibclr(stwerr(l),bit)
436 endif
437 enddo
438 perror(l) = float(error(l))
439 cstwerr(l) = stwerr(l)
440 cperror(l) = perror(l)
441 enddo
442 C
443 iev = iev + 1
444 C
445 RETURN
446 END
447

  ViewVC Help
Powered by ViewVC 1.1.23