/[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.1 by kusanagi, Wed Apr 5 07:23:52 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,  Mar. 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 ++++++++++++++++'
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         print *,'tdcnum(j),boardnum(j)'
75    c         print *, tdcnum(j),boardnum(j)
76  c  c
77        ic=ic+2        ic=ic+2
78        tdcmask(j) = 0        tdcmask(j) = 0
# Line 65  c Line 86  c
86        ic=ic+2        ic=ic+2
87  c  c
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           do i=1,16
124           do iword=0,17
125              vectof(ic+iword,i)=0
126           enddo
127           enddo
128    c
129           do iword=0,17 ! le parole successive sono copiate in vectof
130              vectof(ic+iword,1)=vecta(ic+iword)
131           enddo
132    c
133           if (dspcold.eq.1) then
134           if (boardnum(j).eq.4)then
135           if((tdcnum(j).eq.1).or.(tdcnum(j).eq.2))then
136             do iword=0,17
137                vectof(ic+iword,1)= 255 - vecta(ic+iword)
138             enddo
139           endif
140           endif
141           endif
142    
143    c
144    c -----fine cura inversione cavo FE to DSP cold
145    c
146    c
147           ind=1               !  all'inizio parto da vecta(ic)==vectof(ic,1)
148           tdc_ch1=0
149           adc_ch2=0
150           icorr=0
151    c
152            
153           do i=1,4                 !  loop on TDC 4 channels
154    c        print *,'====================='
155    c        print *,'TDC =',J,'  CANALE =',I
156    
157    C
158    C   -------------- inizio correzione per le coppie di zeri  ------------
159    C
160    c   if first 3 bits of the word RAWADC(TDC) are not equal to
161    c                              tdcadd(iadd)
162    c   the data storage has to be shifted by 2 bit (are spurious zeroes
163    c   introduced by the F.E.board)
164    c
165    c
166    c   Check only on the MSB (bit 13,14 e 15 of 2(+2) word RAWADC(TDC):
167    c         vecta(ic) and vecta(ic+2))
168    c
169           iadd = 2*(i-1)+1   ! = 1,3,5,7
170           ii=i
171    C
172    C ----------------- Controllo sulla parola ADC
173    C
174    11     continue
175           tdccodeq = 0  
176    C
177           do bit = 5,7
178             bi = ibits(vectof(ic,ind),bit,1)
179             if (bi.eq.1) tdccodeq = ibset(tdccodeq,bit-5)
180           enddo    
181    C  
182           if (tdccodeq.ne.tdcadd(iadd)) then
183    c
184    c------------- controllo che la colpa dei 2 zeri non sia di TDC(ch1)
185    c
186            if ((iadd.eq.3).and.(tdc_ch1.eq.0))then
187              if (tdccodeq.ne.0) then
188    c            print *,'2 zeri in ADC, ma la colpa forse e` del TDC'
189                ic=ic-4
190                iadd=1
191                ii=1
192                adc_ch2=99
193                goto 12
194                endif
195            endif
196    c--------------- fine controllo
197    c                    
198    c         PRINT *, '---------shift di 2 zeri sui dati ADC ! '
199    c         print *,'numero di tdc = ',j,', ind = ',ind
200    c         print *,'vectof(ic,ind),tdccodeq,tdcadd(iadd),iadd'
201    c         print *,vectof(ic,ind),tdccodeq,tdcadd(iadd),iadd
202    c
203             iup = 17-4*(ii-1)
204             idw = 0
205             do iw=idw,iup
206               do bit = 0, 7
207                 if(bit.le.5)then
208                   bi = ibits(vectof(ic+iw,ind),bit,1)
209                   if (bi.eq.1) vectof(ic+iw,ind+1) =
210         +                      ibset(vectof(ic+iw,ind+1),bit+2)
211                 else
212                   bi = ibits(vectof(ic+1+iw,ind),bit,1)
213                   if (bi.eq.1) vectof(ic+iw,ind+1) =
214         +                      ibset(vectof(ic+iw,ind+1),bit-6)
215                 endif
216               enddo ! loop sui bit
217             enddo ! loop sulle parole
218    c
219    c----+---1---------2---------3---------4---------5---------6---------7---------8
220    c
221               if(iadd.eq.3)adc_ch2=adc_ch2+1
222               ind = (ind + 1)   !  aggiorno l' indice
223               if (ind.le.14)then
224                  go to 11           !  rifaccio il check
225               else
226    c             print *,'exit ADC senza soluzione',ind
227               endif
228           endif
229    
230    c ------- se e' l'ADC channel 2 bisogna ricontrollare il TDC precedente
231    
232           if ((iadd.eq.3).and.(adc_ch2.ge.2).and.(tdc_ch1.eq.0))then
233    c         print *,'ci sono!!!!!!!!!!!!!!!!!!'
234    c         print *,'adc_ch2 = ',adc_ch2
235    c         print *,'ind = ',ind
236              ind=ind-adc_ch2
237    c         print *,'ind - adc_ch2 = ',ind
238                do ik=1,adc_ch2
239                do iword=0,17
240                   vectof(ic+iword,ind+ik)=0
241                enddo
242                enddo
243             ic=ic-4
244             iadd=1
245             ii=1
246             goto 12
247           endif
248    c
249    c ---  registro RAWADC
250    c
251           rawadc(i,j) = 0           rawadc(i,j) = 0
          rawtdc(i,j) = 0  
          grayadc(i,j) = 0  
          graytdc(i,j) = 0  
252           do bit = 0, 7           do bit = 0, 7
253             bi = ibits(vecta(ic),bit,1)             bi = ibits(vectof(ic,ind),bit,1)
254             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)
255             bi = ibits(vecta(ic+1),bit,1)             bi = ibits(vectof(ic+1,ind),bit,1)
256             if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit)             if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit)
257             bi = ibits(vecta(ic+2),bit,1)           enddo
258             if (bi.eq.1) rawtdc(i,j) = ibset(rawtdc(i,j),bit+8)  C
259             bi = ibits(vecta(ic+3),bit,1)  C
260             if (bi.eq.1) rawtdc(i,j) = ibset(rawtdc(i,j),bit)  C ----------------- Controllo sulla parola TDC
261    C    
262    12    continue
263           tdccodet = 0  
264           do bit = 5,7
265             bi = ibits(vectof(ic+2,ind),bit,1)
266             if (bi.eq.1) tdccodet = ibset(tdccodet,bit-5)
267           enddo    
268           if ((tdccodet.ne.tdcadd(iadd+1)).or.
269         +     ((adc_ch2.ge.2).and.(iadd.eq.1)))then
270    c----+---1---------2---------3---------4---------5---------6---------7---------8
271    c
272              if(adc_ch2.ge.2)then
273                 adc_ch2=0
274                 icorr=1
275              endif
276    c          PRINT *, '---------shift di 2 zeri sui dati TDC  ! '
277    c          print *,'vectof(ic+2,ind),tdccodet,tdcadd(iadd+1),(iadd+1)'
278    c          print *,vectof(ic+2,ind),tdccodet,tdcadd(iadd+1),(iadd+1)
279    c
280              iup = 17-4*(ii-1)
281              idw =2
282              do iw=idw,iup
283               do bit = 0, 7
284                 if(bit.le.5)then
285                   bi = ibits(vectof(ic+iw,ind),bit,1)
286                   if (bi.eq.1) vectof(ic+iw,ind+1) =
287         +                      ibset(vectof(ic+iw,ind+1),bit+2)
288                 else
289                   bi = ibits(vectof(ic+1+iw,ind),bit,1)
290                   if (bi.eq.1) vectof(ic+iw,ind+1) =
291         +                      ibset(vectof(ic+iw,ind+1),bit-6)
292                 endif
293               enddo ! loop sui bit
294              enddo ! loop sulle parole
295    c----+---1---------2---------3---------4---------5---------6---------7---------8
296    c
297                if(iadd.eq.1)tdc_ch1=tdc_ch1+1
298                ind = (ind + 1)   !  aggiorno l' indice
299                if (ind.le.15) then
300                   go to 12         !  rifaccio il check
301                else
302    c               print *,'exit TDC senza successo ',ind
303                endif        
304           endif
305    c
306    c --- registro RAWTDC
307    c
308            rawtdc(ii,j) = 0
309            do bit = 0, 7
310               bi = ibits(vectof(ic+2,ind),bit,1)
311               if (bi.eq.1) rawtdc(ii,j) = ibset(rawtdc(ii,j),bit+8)
312               bi = ibits(vectof(ic+3,ind),bit,1)
313               if (bi.eq.1) rawtdc(ii,j) = ibset(rawtdc(ii,j),bit)
314          enddo          enddo
315  c  c
316    c
317    c ------- se e' il TDC channel 1 e' il risultato dell'iterazione prodotta
318    c          dall' ADC channel 2 bisogna ripassare all' ADC successivo
319    
320           if ((iadd.eq.1).and.(icorr.eq.1).and.(tdc_ch1.gt.0))then
321             iadd=3
322             ii=2
323             ic=ic+4
324    c         print *,'sto tornando all ADC dopo aver corr. il TDC',ind
325             goto 11
326           endif
327    C
328    C   -------------- fine correzione per le coppie di zeri  ------------
329    C
330    
331            ic=ic+4
332          enddo   !  fine loop sui 4 TDC channel
333    
334    c
335  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)
336  c    bit 12 is added after conversion  (control bit)  c    bit 12 is added after conversion  (control bit)
337  c    bit 13 is 1(0) for charge(time) information  c    bit 13 is 1(0) for charge(time) information
338  c    bits 14-15 give the channel 1-4 on the board.  c    bits 14-15 give the channel 1-4 on the board.
339  c  c
340           do i=1,4                 !  loop on TDC 4 channels
341    c        print *,'=========== graytobin e registro =========='
342    c        print *,'TDC =',J,'  CANALE =',I
343            grayadc(i,j) = 0
344            graytdc(i,j) = 0
345    
346          grayadc(i,j)=ibits(rawadc(i,j),0,12)          grayadc(i,j)=ibits(rawadc(i,j),0,12)
347          graytdc(i,j)=ibits(rawtdc(i,j),0,12)          graytdc(i,j)=ibits(rawtdc(i,j),0,12)
348  c  c    
349         call graytobin(grayadc(i,j),adc(i,j),12)          call graytobin(grayadc(i,j),adc(i,j),12)
350         call graytobin(graytdc(i,j),tdc(i,j),12)          call graytobin(graytdc(i,j),tdc(i,j),12)
351  c  c    
352         bi = ibits(rawtdc(i,j),12,1)          bi = ibits(rawtdc(i,j),12,1)
353         if (bi.eq.1) tdc(i,j) = ibset(tdc(i,j),12)          if (bi.eq.1) tdc(i,j) = ibset(tdc(i,j),12)
354         bi = ibits(rawadc(i,j),12,1)          bi = ibits(rawadc(i,j),12,1)
355         if (bi.eq.1) adc(i,j) = ibset(adc(i,j),12)          if (bi.eq.1) adc(i,j) = ibset(adc(i,j),12)
356  c  c
357          ic=ic+4  c        PRINT *,'i, j, RAWadc(i,j) ,RAWtdc(i,j)'
358    c        PRINT *, i, j, rawadc(i,j) ,rawtdc(i,j)
359    c        PRINT *,'i, j, ADC(i,j), TDC(i,j)'
360    c        PRINT *, i, j, adc(i,j), tdc(i,j)
361    c    
362        enddo        enddo
363  c  
364    
365    c    
366        temp1(j) = 0        temp1(j) = 0
367        temp2(j) = 0        temp2(j) = 0
368        do bit = 0, 7        do bit = 0, 7
369           bi = ibits(vecta(ic),bit,1)           bi = ibits(vectof(ic,ind),bit,1)
370           if (bi.eq.1) temp1(j) = ibset(temp1(j),bit)           if (bi.eq.1) temp1(j) = ibset(temp1(j),bit)
371        enddo        enddo
372        ic=ic+1        ic=ic+1
373  c  c
374        if (flag2.eqv..true.) then            if (flag2.eqv..true.) then    
375          do bit = 0, 7                   do bit = 0, 7        
376             bi = ibits(vecta(ic),bit,1)              bi = ibits(vectof(ic,ind),bit,1)
377             if (bi.eq.1) temp2(j) = ibset(temp2(j),bit)              if (bi.eq.1) temp2(j) = ibset(temp2(j),bit)
378          enddo           enddo
379          ic=ic+1           ic=ic+1
380        else        else
381          temp2(j) = 99           temp2(j) = 99
382        endif        endif
383  c  c    
384  c    vecta(ic) is the CRC  c    vecta(ic) is the CRC
385  c Check consistency of CRC.  c Check consistency of CRC.
386  c  c
# Line 151  c Line 400  c
400        enddo        enddo
401  c      if (check.ne.vecta(ic)) then  c      if (check.ne.vecta(ic)) then
402        if (check.ne.ibuf) then        if (check.ne.ibuf) then
403  c         print *,'crc wrong ',ibuf, check           print *,'crc wrong ',ibuf, check
404           me = 1           me = 1
405        endif        endif
406    

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

  ViewVC Help
Powered by ViewVC 1.1.23