/[PAMELA software]/yoda/techmodel/forroutines/tof/tofunpack.for
ViewVC logotype

Contents of /yoda/techmodel/forroutines/tof/tofunpack.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6.2 - (show annotations) (download)
Thu May 25 11:06:43 2006 UTC (18 years, 6 months ago) by kusanagi
Branch: MAIN
CVS Tags: YODA6_3/06, YODA6_3/04, YODA6_3/05, YODA6_3/07, YODA6_3/00, YODA6_3/01, YODA6_3/02, YODA6_3/03
Changes since 6.1: +40 -12 lines
Update from D.Campana still about "double zero" problem

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

  ViewVC Help
Powered by ViewVC 1.1.23