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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6.2 - (hide 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 kusanagi 1.1 C--------------------------------------------------------------------
2     SUBROUTINE TOFUNPACK(vecta,lung,me)
3 kusanagi 6.1
4 kusanagi 6.2 C modified D.Campana, May. 06
5 kusanagi 1.1 C D.Campana, Dec. 04
6 kusanagi 6.1 C--------------------------------------------------------------------
7 kusanagi 1.1
8     IMPLICIT NONE
9    
10     C
11     C Normal variables definition
12     C
13     integer lung
14     integer*1 vecta(lung)
15 kusanagi 6.1 integer*1 vectof(lung,16)
16 kusanagi 4.1 integer*2 ibuf
17 kusanagi 1.1 integer me
18     integer check, crctof
19     integer ic0,sup,inf
20 kusanagi 6.1 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 kusanagi 1.1 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 kusanagi 4.1 logical flag2
29 kusanagi 6.1 integer ii,ik,adc_ch2,tdc_ch1,icorr
30     integer dsphot,dspcold,code
31 kusanagi 1.1 C
32     c data start,ntdc /150,12/ ! to read data before Christmas 2004
33 kusanagi 6.1 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 kusanagi 1.1
37     COMMON / tofvar /tdcid,evcount,tdcmask,adc,tdc,temp1,temp2
38     save / tofvar /
39 kusanagi 6.1
40 kusanagi 1.1 C
41 kusanagi 6.1 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 kusanagi 1.1
46     C
47     ic = start
48     C
49 kusanagi 6.2 c print *,'++++++++++ Tof Unpack entro ++++++++++++++++'
50 kusanagi 1.1
51 kusanagi 6.1 dspcold = 0
52     dsphot = 0
53    
54 kusanagi 1.1 do j = 1,ntdc
55 kusanagi 4.1 flag2=.true.
56     ic0 = ic ! first index for the CRC computation
57 kusanagi 1.1 tdcid(j) = 0
58     evcount(j) = 0
59 kusanagi 6.1 tdcnum(j) = 0 ! the 4 MSBs in TDCid
60     boardnum(j) = 0 ! the 4 LSBs in TDCid
61 kusanagi 1.1 do bit = 0, 7
62     bi = ibits(vecta(ic),bit,1)
63 kusanagi 6.1 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 kusanagi 1.1 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 kusanagi 6.2 c print *,'++++++++++ Tof Unpack 2 ++++++++++++++++'
77 kusanagi 1.1 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 kusanagi 4.1 c
85 kusanagi 1.1 ic=ic+2
86 kusanagi 4.1 c
87 kusanagi 6.2 c print *,'++++++++++ Tof Unpack 3 ++++++++++++++++'
88 kusanagi 4.1 c
89 kusanagi 6.1 c if the first word RAWADC are equal to 0
90 kusanagi 4.1 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 kusanagi 6.1 do bit = 0,7
95 kusanagi 4.1 bi = ibits(vecta(ic),bit,1)
96 kusanagi 6.1 if (bi.eq.1) tdcfirst = ibset(tdcfirst,bit)
97 kusanagi 4.1 enddo
98     if (tdcfirst.eq.0) then
99     ic=ic+1
100     flag2=.false.
101     endif
102     c
103 kusanagi 6.1 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 kusanagi 6.2 c
123     c print *,'++++++++++ Tof Unpack 4 ++++++++++++++++'
124     c
125    
126 kusanagi 6.1 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 kusanagi 6.2 c print *,'++++++++++ Tof Unpack 5 ++++++++++++++++'
147    
148 kusanagi 6.1 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 kusanagi 6.2 if (ind.lt.15)then
181 kusanagi 6.1 tdccodeq = 0
182 kusanagi 6.2 c print *,'++++++++++ Tof Unpack 6 (11 continue) ++++++++++++'
183 kusanagi 6.1 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 kusanagi 6.2 if ((iadd.eq.3).and.(tdc_ch1.eq.0))then
194 kusanagi 6.1 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 kusanagi 6.2 endif
203 kusanagi 6.1 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 kusanagi 6.2 if (ind.lt.15)then
231 kusanagi 6.1 go to 11 ! rifaccio il check
232     else
233     c print *,'exit ADC senza soluzione',ind
234 kusanagi 6.2 continue
235 kusanagi 6.1 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 kusanagi 6.2 c print *,'ci sono!!ADC ch 2 torno al TDC!!!'
242 kusanagi 6.1 c print *,'adc_ch2 = ',adc_ch2
243     c print *,'ind = ',ind
244 kusanagi 6.2
245 kusanagi 6.1 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 kusanagi 6.2
258     endif ! fine controllo su ind < 15
259    
260     c print *,'++++++++++ Tof Unpack 6,5 registro ADC ++++++++++++++'
261 kusanagi 6.1 c
262     c --- registro RAWADC
263     c
264 kusanagi 1.1 rawadc(i,j) = 0
265     do bit = 0, 7
266 kusanagi 6.1 bi = ibits(vectof(ic,ind),bit,1)
267 kusanagi 1.1 if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit+8)
268 kusanagi 6.1 bi = ibits(vectof(ic+1,ind),bit,1)
269 kusanagi 1.1 if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit)
270 kusanagi 6.1 enddo
271     C
272     C
273     C ----------------- Controllo sulla parola TDC
274     C
275     12 continue
276 kusanagi 6.2 if (ind.lt.16)then
277     tdccodet = 0
278     c print *,'++++++++++ Tof Unpack 7 (12 continue) ++++++++++++++++'
279 kusanagi 6.1 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 kusanagi 6.2 if (ind.lt.16) then
315 kusanagi 6.1 go to 12 ! rifaccio il check
316     else
317     c print *,'exit TDC senza successo ',ind
318 kusanagi 6.2 continue
319 kusanagi 6.1 endif
320     endif
321 kusanagi 6.2
322     endif ! fine controllo su ind < 16
323    
324     c print *,'++++++++++ Tof Unpack 8 registro TDC +++++++++++++'
325 kusanagi 6.1 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 kusanagi 1.1 enddo
335     c
336 kusanagi 6.1 c
337     c ------- se e' il TDC channel 1 e' il risultato dell'iterazione prodotta
338 kusanagi 6.2 c dall' ADC channel 2 bisogna ripassare all' ADC successivo
339 kusanagi 6.1
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 kusanagi 6.2 c print *,'++++++ Tof Unpack 9 fine primo loop sui ch +++++++++'
355    
356 kusanagi 6.1 c
357 kusanagi 1.1 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 kusanagi 6.1 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 kusanagi 1.1 grayadc(i,j)=ibits(rawadc(i,j),0,12)
369     graytdc(i,j)=ibits(rawtdc(i,j),0,12)
370 kusanagi 6.1 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 kusanagi 1.1 enddo
385 kusanagi 6.1
386 kusanagi 6.2 c----+---1---------2---------3---------4---------5---------6---------7---------8
387    
388     c print *,'+++++++ Tof Unpack 10 fine secondo loop sui ch +++++++'
389 kusanagi 6.1
390     c
391 kusanagi 1.1 temp1(j) = 0
392     temp2(j) = 0
393     do bit = 0, 7
394 kusanagi 6.1 bi = ibits(vectof(ic,ind),bit,1)
395 kusanagi 1.1 if (bi.eq.1) temp1(j) = ibset(temp1(j),bit)
396 kusanagi 4.1 enddo
397     ic=ic+1
398     c
399     if (flag2.eqv..true.) then
400 kusanagi 6.1 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 kusanagi 4.1 else
406 kusanagi 6.1 temp2(j) = 99
407 kusanagi 4.1 endif
408 kusanagi 6.2 c print *,'++++++++++ Tof Unpack 11 fine temperatura ++++++++'
409 kusanagi 6.1 c
410 kusanagi 1.1 c vecta(ic) is the CRC
411     c Check consistency of CRC.
412     c
413 kusanagi 4.1 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 kusanagi 1.1 check = 0
422     inf = ic0
423     sup = ic - 1
424     do i = inf,sup
425     check=crctof(check,vecta(i))
426     enddo
427 kusanagi 4.1 c if (check.ne.vecta(ic)) then
428     if (check.ne.ibuf) then
429 kusanagi 6.1 print *,'crc wrong ',ibuf, check
430 kusanagi 1.1 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 kusanagi 6.2 c print *,'++++++++++ Tof Unpack escooo ! ++++++++++++++++'
440    
441 kusanagi 1.1
442     RETURN
443     END

  ViewVC Help
Powered by ViewVC 1.1.23