/[PAMELA software]/chewbacca/PamOffLineSW/forroutines/tof/tofunpack.for
ViewVC logotype

Contents of /chewbacca/PamOffLineSW/forroutines/tof/tofunpack.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (download) (vendor branch)
Tue Sep 23 07:20:15 2008 UTC (16 years, 2 months ago) by mocchiut
Branch: v0r00
CVS Tags: v1r02, v1r00, v1r01, start, v9r00, v9r01
Changes since 1.1: +0 -0 lines
Error occurred while calculating annotation data.
Imported sources, 23/09/2008

1 C--------------------------------------------------------------------
2 SUBROUTINE TOFUNPACK(vecta,lung,me)
3
4 C modified D.Campana, May. 06
5 C D.Campana, Dec. 04
6 C--------------------------------------------------------------------
7
8 IMPLICIT NONE
9
10 C
11 C Normal variables definition
12 C
13 integer lung
14 integer*1 vecta(lung)
15 integer*1 vectof(lung,16)
16 integer*2 ibuf
17 integer me
18 integer check, crctof
19 integer ic0,sup,inf
20 integer i, ic, bit, bi,j ,iadd, iword,iw,idw,iup,ind
21 integer start,ntdc,tdcfirst,tdccodeq,tdccodet
22 integer tdcnum(12), boardnum(12)
23 integer tdcadd(8),coldadd(8)
24 integer tdcid(12),evcount(12)
25 integer tdcmask(12),adc(4,12),tdc(4,12)
26 integer rawadc(4,12),rawtdc(4,12),grayadc(4,12),graytdc(4,12)
27 integer temp1(12),temp2(12)
28 logical flag2
29 integer ii,ik,adc_ch2,tdc_ch1,icorr
30 integer dsphot,dspcold,code
31 C
32 c data start,ntdc /150,12/ ! to read data before Christmas 2004
33 data start,ntdc /153,12/ ! to read data after Christmas 2004
34 data tdcadd /1,0,3,2,5,4,7,6/
35 data coldadd /6,7,4,5,2,3,0,1/
36
37 COMMON / tofvar /tdcid,evcount,tdcmask,adc,tdc,temp1,temp2
38 save / tofvar /
39
40 C
41 c----+---1---------2---------3---------4---------5---------6---------7---------8
42 C Begin !
43 C 'start' is a pointer to the ToF data
44 c----+---1---------2---------3---------4---------5---------6---------7---------8
45
46 C
47 ic = start
48 C
49 c print *,'++++++++++ Tof Unpack entro ++++++++++++++++'
50
51 dspcold = 0
52 dsphot = 0
53
54 do j = 1,ntdc
55 flag2=.true.
56 ic0 = ic ! first index for the CRC computation
57 tdcid(j) = 0
58 evcount(j) = 0
59 tdcnum(j) = 0 ! the 4 MSBs in TDCid
60 boardnum(j) = 0 ! the 4 LSBs in TDCid
61 do bit = 0, 7
62 bi = ibits(vecta(ic),bit,1)
63 if (bi.eq.1)then
64 tdcid(j) = ibset(tdcid(j),bit)
65 if (bit.le.3)then
66 boardnum(j) = ibset(boardnum(j),bit)
67 else
68 tdcnum(j) = ibset(tdcnum(j),bit-4)
69 endif
70 endif
71 bi = ibits(vecta(ic+1),bit,1)
72 if (bi.eq.1) evcount(j) = ibset(evcount(j),bit)
73 enddo
74 c
75 ic=ic+2
76
77 if ((ic+1).gt.lung) then
78 me=1
79 return
80 endif
81
82 c print *,'++++++++++ Tof Unpack 2 ++++++++++++++++'
83 tdcmask(j) = 0
84 do bit = 0, 7
85 bi = ibits(vecta(ic),bit,1)
86 if (bi.eq.1) tdcmask(j) = ibset(tdcmask(j),bit+8)
87 bi = ibits(vecta(ic+1),bit,1)
88 if (bi.eq.1) tdcmask(j) = ibset(tdcmask(j),bit)
89 enddo
90 c
91 ic=ic+2
92 if (ic.gt.lung) then
93 me=1
94 return
95 endif
96 c
97 c print *,'++++++++++ Tof Unpack 3 ++++++++++++++++'
98 c
99 c if the first word RAWADC are equal to 0
100 c the data storage is shifted by a word --> ic = ic+1
101 c and TEMP2 is overwritten by the CRC --> flag2=.false.
102 c
103 tdcfirst = 0
104 do bit = 0,7
105 bi = ibits(vecta(ic),bit,1)
106 if (bi.eq.1) tdcfirst = ibset(tdcfirst,bit)
107 enddo
108 if (tdcfirst.eq.0) then
109 ic=ic+1
110 flag2=.false.
111 endif
112 if (ic.gt.lung) then
113 me=1
114 return
115 endif
116 c
117 c ----- se stiamo acquisendo con il DSP cold, bisogna tener conto
118 c ----- che c'e' un' inversione nel cavo che va alla scheda 5
119 c ----- quindi per TDCnum =1,2 e Boardnum=4 (va da 0 a 5)
120 c ----- le parole che seguono sono invertite bit a bit
121 c ----- cioe' si fa il complemento a 2**8-1 =255
122 c
123 if (dspcold.eq.0 .and. dsphot.eq.0) then
124 if (boardnum(j).eq.4)then
125 if((tdcnum(j).eq.1).or.(tdcnum(j).eq.2))then
126 code = 0
127 do bit = 5,7
128 bi = ibits(vecta(ic),bit,1)
129 if (bi.eq.1) code = ibset(code,bit-5)
130 enddo
131 if (code.eq.coldadd(1)) dspcold = 1
132 if (code.eq.tdcadd(1)) dsphot = 1
133 endif
134 endif
135 endif
136 c
137 c print *,'++++++++++ Tof Unpack 4 ++++++++++++++++'
138 c
139
140 do i=1,16
141 do iword=0,17
142 vectof(ic+iword,i)=0
143 enddo
144 enddo
145 c
146 do iword=0,17 ! le parole successive sono copiate in vectof
147
148 if ((ic+iword).gt.lung) then
149 me=1
150 return
151 endif
152
153 vectof(ic+iword,1)=vecta(ic+iword)
154 enddo
155 c
156 if (dspcold.eq.1) then
157 if (boardnum(j).eq.4)then
158 if((tdcnum(j).eq.1).or.(tdcnum(j).eq.2))then
159 do iword=0,17
160 if ((ic+iword).gt.lung) then
161 me=1
162 return
163 endif
164 vectof(ic+iword,1)= 255 - vecta(ic+iword)
165 enddo
166 endif
167 endif
168 endif
169
170 c print *,'++++++++++ Tof Unpack 5 ++++++++++++++++'
171
172 c
173 c -----fine cura inversione cavo FE to DSP cold
174 c
175 c
176 ind=1 ! all'inizio parto da vecta(ic)==vectof(ic,1)
177 tdc_ch1=0
178 adc_ch2=0
179 icorr=0
180 c
181
182 do i=1,4 ! loop on TDC 4 channels
183 c print *,'====================='
184 c print *,'TDC =',J,' CANALE =',I
185
186 C
187 C -------------- inizio correzione per le coppie di zeri ------------
188 C
189 c if first 3 bits of the word RAWADC(TDC) are not equal to
190 c tdcadd(iadd)
191 c the data storage has to be shifted by 2 bit (are spurious zeroes
192 c introduced by the F.E.board)
193 c
194 c
195 c Check only on the MSB (bit 13,14 e 15 of 2(+2) word RAWADC(TDC):
196 c vecta(ic) and vecta(ic+2))
197 c
198 iadd = 2*(i-1)+1 ! = 1,3,5,7
199 ii=i
200 C
201 C ----------------- Controllo sulla parola ADC
202 C
203 11 continue
204 if (ind.lt.15)then
205 tdccodeq = 0
206 c print *,'++++++++++ Tof Unpack 6 (11 continue) ++++++++++++'
207 C
208 do bit = 5,7
209 bi = ibits(vectof(ic,ind),bit,1)
210 if (bi.eq.1) tdccodeq = ibset(tdccodeq,bit-5)
211 enddo
212 C
213 if (tdccodeq.ne.tdcadd(iadd)) then
214 c
215 c------------- controllo che la colpa dei 2 zeri non sia di TDC(ch1)
216 c
217 if ((iadd.eq.3).and.(tdc_ch1.eq.0))then
218 if (tdccodeq.ne.0) then
219 c print *,'2 zeri in ADC, ma la colpa forse e` del TDC'
220 ic=ic-4
221 iadd=1
222 ii=1
223 adc_ch2=99
224 goto 12
225 endif
226 endif
227 c--------------- fine controllo
228 c
229 c PRINT *, '---------shift di 2 zeri sui dati ADC ! '
230 c print *,'numero di tdc = ',j,', ind = ',ind
231 c print *,'vectof(ic,ind),tdccodeq,tdcadd(iadd),iadd'
232 c print *,vectof(ic,ind),tdccodeq,tdcadd(iadd),iadd
233 c
234 iup = 17-4*(ii-1)
235 idw = 0
236 do iw=idw,iup
237 do bit = 0, 7
238 if(bit.le.5)then
239 bi = ibits(vectof(ic+iw,ind),bit,1)
240 if (bi.eq.1) vectof(ic+iw,ind+1) =
241 + ibset(vectof(ic+iw,ind+1),bit+2)
242 else
243 bi = ibits(vectof(ic+1+iw,ind),bit,1)
244 if (bi.eq.1) vectof(ic+iw,ind+1) =
245 + ibset(vectof(ic+iw,ind+1),bit-6)
246 endif
247 enddo ! loop sui bit
248 enddo ! loop sulle parole
249 c
250 c----+---1---------2---------3---------4---------5---------6---------7---------8
251 c
252 if(iadd.eq.3)adc_ch2=adc_ch2+1
253 ind = (ind + 1) ! aggiorno l' indice
254 if (ind.lt.15)then
255 go to 11 ! rifaccio il check
256 else
257 c print *,'exit ADC senza soluzione',ind
258 continue
259 endif
260 endif
261
262 c ------- se e' l'ADC channel 2 bisogna ricontrollare il TDC precedente
263
264 if ((iadd.eq.3).and.(adc_ch2.ge.2).and.(tdc_ch1.eq.0))then
265 c print *,'ci sono!!ADC ch 2 torno al TDC!!!'
266 c print *,'adc_ch2 = ',adc_ch2
267 c print *,'ind = ',ind
268
269 ind=ind-adc_ch2
270 c print *,'ind - adc_ch2 = ',ind
271 do ik=1,adc_ch2
272 do iword=0,17
273 vectof(ic+iword,ind+ik)=0
274 enddo
275 enddo
276 ic=ic-4
277 iadd=1
278 ii=1
279 goto 12
280 endif
281
282 endif ! fine controllo su ind < 15
283
284 c print *,'++++++++++ Tof Unpack 6,5 registro ADC ++++++++++++++'
285 c
286 c --- registro RAWADC
287 c
288 rawadc(i,j) = 0
289 do bit = 0, 7
290 bi = ibits(vectof(ic,ind),bit,1)
291 if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit+8)
292 bi = ibits(vectof(ic+1,ind),bit,1)
293 if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit)
294 enddo
295 C
296 C
297 C ----------------- Controllo sulla parola TDC
298 C
299 12 continue
300 if (ind.lt.16)then
301 tdccodet = 0
302 c print *,'++++++++++ Tof Unpack 7 (12 continue) ++++++++++++++++'
303 do bit = 5,7
304 bi = ibits(vectof(ic+2,ind),bit,1)
305 if (bi.eq.1) tdccodet = ibset(tdccodet,bit-5)
306 enddo
307 if ((tdccodet.ne.tdcadd(iadd+1)).or.
308 + ((adc_ch2.ge.2).and.(iadd.eq.1)))then
309 c----+---1---------2---------3---------4---------5---------6---------7---------8
310 c
311 if(adc_ch2.ge.2)then
312 adc_ch2=0
313 icorr=1
314 endif
315 c PRINT *, '---------shift di 2 zeri sui dati TDC ! '
316 c print *,'vectof(ic+2,ind),tdccodet,tdcadd(iadd+1),(iadd+1)'
317 c print *,vectof(ic+2,ind),tdccodet,tdcadd(iadd+1),(iadd+1)
318 c
319 iup = 17-4*(ii-1)
320 idw =2
321 do iw=idw,iup
322 do bit = 0, 7
323 if(bit.le.5)then
324 bi = ibits(vectof(ic+iw,ind),bit,1)
325 if (bi.eq.1) vectof(ic+iw,ind+1) =
326 + ibset(vectof(ic+iw,ind+1),bit+2)
327 else
328 bi = ibits(vectof(ic+1+iw,ind),bit,1)
329 if (bi.eq.1) vectof(ic+iw,ind+1) =
330 + ibset(vectof(ic+iw,ind+1),bit-6)
331 endif
332 enddo ! loop sui bit
333 enddo ! loop sulle parole
334 c----+---1---------2---------3---------4---------5---------6---------7---------8
335 c
336 if(iadd.eq.1)tdc_ch1=tdc_ch1+1
337 ind = (ind + 1) ! aggiorno l' indice
338 if (ind.lt.16) then
339 go to 12 ! rifaccio il check
340 else
341 c print *,'exit TDC senza successo ',ind
342 continue
343 endif
344 endif
345
346 endif ! fine controllo su ind < 16
347
348 c print *,'++++++++++ Tof Unpack 8 registro TDC +++++++++++++'
349 c
350 c --- registro RAWTDC
351 c
352 rawtdc(ii,j) = 0
353 do bit = 0, 7
354 bi = ibits(vectof(ic+2,ind),bit,1)
355 if (bi.eq.1) rawtdc(ii,j) = ibset(rawtdc(ii,j),bit+8)
356 bi = ibits(vectof(ic+3,ind),bit,1)
357 if (bi.eq.1) rawtdc(ii,j) = ibset(rawtdc(ii,j),bit)
358 enddo
359 c
360 c
361 c ------- se e' il TDC channel 1 e' il risultato dell'iterazione prodotta
362 c dall' ADC channel 2 bisogna ripassare all' ADC successivo
363
364 if ((iadd.eq.1).and.(icorr.eq.1).and.(tdc_ch1.gt.0))then
365 iadd=3
366 ii=2
367 ic=ic+4
368 c print *,'sto tornando all ADC dopo aver corr. il TDC',ind
369 goto 11
370 endif
371 C
372 C -------------- fine correzione per le coppie di zeri ------------
373 C
374
375 ic=ic+4
376 enddo ! fine loop sui 4 TDC channel
377
378 c print *,'++++++ Tof Unpack 9 fine primo loop sui ch +++++++++'
379
380 c
381 c adc e tdc data have to be translated from Gray code to binary (bit 0-11)
382 c bit 12 is added after conversion (control bit)
383 c bit 13 is 1(0) for charge(time) information
384 c bits 14-15 give the channel 1-4 on the board.
385 c
386 do i=1,4 ! loop on TDC 4 channels
387 c print *,'=========== graytobin e registro =========='
388 c print *,'TDC =',J,' CANALE =',I
389 grayadc(i,j) = 0
390 graytdc(i,j) = 0
391
392 grayadc(i,j)=ibits(rawadc(i,j),0,12)
393 graytdc(i,j)=ibits(rawtdc(i,j),0,12)
394 c
395 call graytobin(grayadc(i,j),adc(i,j),12)
396 call graytobin(graytdc(i,j),tdc(i,j),12)
397 c
398 bi = ibits(rawtdc(i,j),12,1)
399 if (bi.eq.1) tdc(i,j) = ibset(tdc(i,j),12)
400 bi = ibits(rawadc(i,j),12,1)
401 if (bi.eq.1) adc(i,j) = ibset(adc(i,j),12)
402 c
403 c PRINT *,'i, j, RAWadc(i,j) ,RAWtdc(i,j)'
404 c PRINT *, i, j, rawadc(i,j) ,rawtdc(i,j)
405 c PRINT *,'i, j, ADC(i,j), TDC(i,j)'
406 c PRINT *, i, j, adc(i,j), tdc(i,j)
407 c
408 enddo
409
410 c----+---1---------2---------3---------4---------5---------6---------7---------8
411
412 c print *,'+++++++ Tof Unpack 10 fine secondo loop sui ch +++++++'
413
414 c
415 temp1(j) = 0
416 temp2(j) = 0
417 do bit = 0, 7
418 bi = ibits(vectof(ic,ind),bit,1)
419 if (bi.eq.1) temp1(j) = ibset(temp1(j),bit)
420 enddo
421 ic=ic+1
422 c
423 if (flag2.eqv..true.) then
424 do bit = 0, 7
425 bi = ibits(vectof(ic,ind),bit,1)
426 if (bi.eq.1) temp2(j) = ibset(temp2(j),bit)
427 enddo
428 ic=ic+1
429 else
430 temp2(j) = 99
431 endif
432 c print *,'++++++++++ Tof Unpack 11 fine temperatura ++++++++'
433 c
434 c vecta(ic) is the CRC
435 c Check consistency of CRC.
436 c
437 ccc if(vecta(ic).lt.0)vecta(ic)=vecta(ic)+256
438 if (ic.gt.lung) then
439 me=1
440 return
441 endif
442
443 ibuf=0
444 do bit = 0, 7
445 bi = ibits(vecta(ic),bit,1)
446 if (bi.eq.1) ibuf = ibset(ibuf,bit)
447 enddo
448 c
449 check = 0
450 inf = ic0
451 sup = ic - 1
452 do i = inf,sup
453 if ((i.gt.lung).or.(i.lt.1)) then
454 me=1
455 return
456 endif
457 check=crctof(check,vecta(i))
458 enddo
459 c if (check.ne.vecta(ic)) then
460 me = 0
461 if (check.ne.ibuf) then
462 c print *,'crc wrong ',ibuf, check
463 me = 1
464 endif
465
466 c
467 c print *,'---------> ic, j' ,ic,j
468 ic=ic+1
469 if (ic.gt.lung) then
470 me=1
471 return
472 endif
473
474 enddo ! j = 1,ntdc
475
476 c print *,'++++++++++ Tof Unpack escooo ! ++++++++++++++++'
477
478
479 RETURN
480 END

  ViewVC Help
Powered by ViewVC 1.1.23