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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations) (download)
Tue Mar 27 08:34:02 2012 UTC (12 years, 8 months ago) by mocchiut
Branch: MAIN
CVS Tags: v10RED, HEAD
Changes since 1.1: +11 -1 lines
YodaProfiler v10r00, new retrieve_TLE.sh script

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

  ViewVC Help
Powered by ViewVC 1.1.23