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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 6.0 by kusanagi, Tue Feb 7 17:11:10 2006 UTC revision 6.3 by mocchiut, Tue Sep 12 08:56:29 2006 UTC
# Line 1  Line 1 
1  C--------------------------------------------------------------------  C--------------------------------------------------------------------
2        SUBROUTINE TOFUNPACK(vecta,lung,me)        SUBROUTINE TOFUNPACK(vecta,lung,me)
3    
4    C                                  modified  D.Campana,  May. 06
5  C                                            D.Campana,  Dec. 04  C                                            D.Campana,  Dec. 04
6  C---------------------------------------------------------------------  C--------------------------------------------------------------------
7    
8        IMPLICIT NONE        IMPLICIT NONE
9    
# Line 10  C Normal variables definition Line 12  C Normal variables definition
12  C  C
13        integer lung        integer lung
14        integer*1 vecta(lung)        integer*1 vecta(lung)
15          integer*1 vectof(lung,16)
16        integer*2 ibuf        integer*2 ibuf
17        integer me        integer me
18        integer check, crctof        integer check, crctof
19        integer ic0,sup,inf        integer ic0,sup,inf
20        integer i, ic, bit, bi,j        integer i, ic, bit, bi,j ,iadd, iword,iw,idw,iup,ind
21        integer start,ntdc,tdcfirst        integer start,ntdc,tdcfirst,tdccodeq,tdccodet
22          integer tdcnum(12), boardnum(12)
23          integer tdcadd(8),coldadd(8)
24        integer tdcid(12),evcount(12)        integer tdcid(12),evcount(12)
25        integer tdcmask(12),adc(4,12),tdc(4,12)        integer tdcmask(12),adc(4,12),tdc(4,12)
26        integer rawadc(4,12),rawtdc(4,12),grayadc(4,12),graytdc(4,12)        integer rawadc(4,12),rawtdc(4,12),grayadc(4,12),graytdc(4,12)
27        integer temp1(12),temp2(12)        integer temp1(12),temp2(12)
28        logical flag2        logical flag2
29          integer ii,ik,adc_ch2,tdc_ch1,icorr
30          integer dsphot,dspcold,code
31  C  C
32  c      data start,ntdc /150,12/ ! to read data before Christmas 2004  c      data start,ntdc /150,12/ ! to read data before Christmas 2004
33         data start,ntdc /153,12/ ! to read data after Christmas 2004        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        COMMON / tofvar /tdcid,evcount,tdcmask,adc,tdc,temp1,temp2
38        save / tofvar /        save / tofvar /
39    
40  C          C        
41  C Begin !  c----+---1---------2---------3---------4---------5---------6---------7---------8
42  C  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  C
 C AAA : would be better to have a pattern for the tof!  
 C       at this moment we have just a pointer (start)  
 C  
   
47        ic = start        ic = start
48  C  C
49  c      print *,'++++++++++ Tof Unpack ++++++++++++++++'  c      print *,'++++++++++ Tof Unpack entro ++++++++++++++++'
50    
51          dspcold = 0
52          dsphot = 0
53    
54        do j = 1,ntdc        do j = 1,ntdc
55        flag2=.true.        flag2=.true.
56        ic0 = ic      ! first index for the CRC computation        ic0 = ic      ! first index for the CRC computation
57        tdcid(j) = 0        tdcid(j) = 0
58        evcount(j) = 0        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        do bit = 0, 7
62           bi = ibits(vecta(ic),bit,1)           bi = ibits(vecta(ic),bit,1)
63           if (bi.eq.1) tdcid(j) = ibset(tdcid(j),bit)           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)           bi = ibits(vecta(ic+1),bit,1)
72           if (bi.eq.1) evcount(j) = ibset(evcount(j),bit)           if (bi.eq.1) evcount(j) = ibset(evcount(j),bit)
73        enddo        enddo
74  c  c
75        ic=ic+2        ic=ic+2
76    c      print *,'++++++++++ Tof Unpack 2 ++++++++++++++++'
77        tdcmask(j) = 0        tdcmask(j) = 0
78        do bit = 0, 7        do bit = 0, 7
79           bi = ibits(vecta(ic),bit,1)           bi = ibits(vecta(ic),bit,1)
# Line 64  c Line 84  c
84  c  c
85        ic=ic+2        ic=ic+2
86  c  c
87    c      print *,'++++++++++ Tof Unpack 3 ++++++++++++++++'
88  c  c
89  c   if first 3 bit of the word RAWADC are equal to 0  c   if the first word RAWADC are equal to 0
90  c   the data storage is shifted by a word --> ic = ic+1  c   the data storage is shifted by a word --> ic = ic+1
91  c   and TEMP2 is overwritten by the CRC --> flag2=.false.  c   and TEMP2 is overwritten by the CRC --> flag2=.false.
92  c  c
93         tdcfirst = 0           tdcfirst = 0  
94         do bit = 5,7         do bit = 0,7
95           bi = ibits(vecta(ic),bit,1)           bi = ibits(vecta(ic),bit,1)
96           if (bi.eq.1) tdcfirst = ibset(tdcfirst,bit-5)           if (bi.eq.1) tdcfirst = ibset(tdcfirst,bit)
97         enddo               enddo      
98         if (tdcfirst.eq.0) then         if (tdcfirst.eq.0) then
99           ic=ic+1           ic=ic+1
100           flag2=.false.           flag2=.false.
101         endif         endif
102  c  c
103        do i=1,4  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           rawadc(i,j) = 0
          rawtdc(i,j) = 0  
          grayadc(i,j) = 0  
          graytdc(i,j) = 0  
265           do bit = 0, 7           do bit = 0, 7
266             bi = ibits(vecta(ic),bit,1)             bi = ibits(vectof(ic,ind),bit,1)
267             if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit+8)             if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit+8)
268             bi = ibits(vecta(ic+1),bit,1)             bi = ibits(vectof(ic+1,ind),bit,1)
269             if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit)             if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit)
270             bi = ibits(vecta(ic+2),bit,1)           enddo
271             if (bi.eq.1) rawtdc(i,j) = ibset(rawtdc(i,j),bit+8)  C
272             bi = ibits(vecta(ic+3),bit,1)  C
273             if (bi.eq.1) rawtdc(i,j) = ibset(rawtdc(i,j),bit)  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          enddo
335  c  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)  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)  c    bit 12 is added after conversion  (control bit)
359  c    bit 13 is 1(0) for charge(time) information  c    bit 13 is 1(0) for charge(time) information
360  c    bits 14-15 give the channel 1-4 on the board.  c    bits 14-15 give the channel 1-4 on the board.
361  c  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)          grayadc(i,j)=ibits(rawadc(i,j),0,12)
369          graytdc(i,j)=ibits(rawtdc(i,j),0,12)          graytdc(i,j)=ibits(rawtdc(i,j),0,12)
370  c  c    
371         call graytobin(grayadc(i,j),adc(i,j),12)          call graytobin(grayadc(i,j),adc(i,j),12)
372         call graytobin(graytdc(i,j),tdc(i,j),12)          call graytobin(graytdc(i,j),tdc(i,j),12)
373  c  c    
374         bi = ibits(rawtdc(i,j),12,1)          bi = ibits(rawtdc(i,j),12,1)
375         if (bi.eq.1) tdc(i,j) = ibset(tdc(i,j),12)          if (bi.eq.1) tdc(i,j) = ibset(tdc(i,j),12)
376         bi = ibits(rawadc(i,j),12,1)          bi = ibits(rawadc(i,j),12,1)
377         if (bi.eq.1) adc(i,j) = ibset(adc(i,j),12)          if (bi.eq.1) adc(i,j) = ibset(adc(i,j),12)
378  c  c
379          ic=ic+4  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        enddo
385  c  
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        temp1(j) = 0
392        temp2(j) = 0        temp2(j) = 0
393        do bit = 0, 7        do bit = 0, 7
394           bi = ibits(vecta(ic),bit,1)           bi = ibits(vectof(ic,ind),bit,1)
395           if (bi.eq.1) temp1(j) = ibset(temp1(j),bit)           if (bi.eq.1) temp1(j) = ibset(temp1(j),bit)
396        enddo        enddo
397        ic=ic+1        ic=ic+1
398  c  c
399        if (flag2.eqv..true.) then            if (flag2.eqv..true.) then    
400          do bit = 0, 7                   do bit = 0, 7        
401             bi = ibits(vecta(ic),bit,1)              bi = ibits(vectof(ic,ind),bit,1)
402             if (bi.eq.1) temp2(j) = ibset(temp2(j),bit)              if (bi.eq.1) temp2(j) = ibset(temp2(j),bit)
403          enddo           enddo
404          ic=ic+1           ic=ic+1
405        else        else
406          temp2(j) = 99           temp2(j) = 99
407        endif        endif
408  c  c      print *,'++++++++++ Tof Unpack 11 fine temperatura ++++++++'
409    c    
410  c    vecta(ic) is the CRC  c    vecta(ic) is the CRC
411  c Check consistency of CRC.  c Check consistency of CRC.
412  c  c
# Line 150  c Line 425  c
425           check=crctof(check,vecta(i))           check=crctof(check,vecta(i))
426        enddo        enddo
427  c      if (check.ne.vecta(ic)) then  c      if (check.ne.vecta(ic)) then
428          me = 0
429        if (check.ne.ibuf) then        if (check.ne.ibuf) then
430  c         print *,'crc wrong ',ibuf, check           print *,'crc wrong ',ibuf, check
431           me = 1           me = 1
432        endif        endif
433    
# Line 161  c        print *,'---------> ic, j' ,ic, Line 437  c        print *,'---------> ic, j' ,ic,
437    
438        enddo       !  j = 1,ntdc        enddo       !  j = 1,ntdc
439    
440    c      print *,'++++++++++ Tof Unpack escooo ! ++++++++++++++++'
441    
442        
443        RETURN        RETURN
444        END        END

Legend:
Removed from v.6.0  
changed lines
  Added in v.6.3

  ViewVC Help
Powered by ViewVC 1.1.23