/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/filladc.f
ViewVC logotype

Annotation of /DarthVader/TrackerLevel2/src/F77/filladc.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (hide annotations) (download)
Thu Jan 16 15:29:53 2014 UTC (10 years, 10 months ago) by mocchiut
Branch: MAIN
Changes since 1.10: +35 -15 lines
Compilation warnings using GCC4.7 fixed

1 mocchiut 1.1 subroutine filladc(iflag) !??? AGGIUSTARE TUTTO
2    
3    
4     include 'commontracker.f'
5     include 'level0.f'
6 pam-fi 1.3 include 'level1.f'
7 mocchiut 1.1 include 'calib.f'
8    
9    
10 pam-fi 1.3 include 'common_reduction.f'
11    
12 mocchiut 1.1 external nvk
13     external nst
14    
15     real errflag
16     integer*2 flag,tipo,info,prec_ind,word
17     integer*2 newVAL,oldVAL
18     data oldval/0/
19     integer DSPn
20    
21     iflag = 0
22    
23     C---------------------------------------------------------
24     C check DAQmode to see if data are
25     C - b#1001 = 9 full
26     C - b#1010 =10 compressed
27     C - b#1011 =11 compressed + full
28     C - b#1000 = 8 special --> (compressed+full) / compressed
29     C (even/odd views compressed/full, alternately)
30     C in the third case ADC is filled with full data
31     C---------------------------------------------------------
32    
33     idata=0 !datatracker array index
34 pam-fi 1.4
35 mocchiut 1.1 do iv=1,nviews
36 pam-fi 1.4
37     DSPn = DSPnumber(iv)
38     ievent = eventn(iv)
39 mocchiut 1.1
40     C ---------------------------
41     C if the iv view is missing
42     C or the data buffer is empty
43 pam-fi 1.4 C jump to next view
44 mocchiut 1.1 C ---------------------------
45    
46 pam-fi 1.6 nword_DSP = 0
47 pam-fi 1.4 if(DSPn.eq.0
48 pam-fi 1.6 $ .or.DSPn.gt.nviews
49 pam-fi 1.4 $ .or.datalength(iv).eq.0)goto 333
50 pam-fi 1.6
51 mocchiut 1.1 C++++++++++++++++++++++++++++++++++++++++++++++++++++++
52 pam-fi 1.4 if( iand(DAQmode(iv),z'0003').eq.z'0002'.or.
53     $ iand(DAQmode(iv),z'0003').eq.z'0003'.or.
54     $ iand(DAQmode(iv),z'0003').eq.z'0000'.or.
55     $ .false.) then
56 mocchiut 1.1 C++++++++++++++++++++++++++++++++++++++++++++++++++++++
57     C--------------------------------------compressed mode
58 pam-fi 1.10 if(debug.eq.1)print*,'DSP #',DSPn,' --> compressed '
59 pam-fi 1.4 is = 0
60     il = 0
61     prec_ind = 0
62     222 continue
63     idata = idata+1
64 pam-fi 1.6 if( idata.gt.NWORDMAX )goto 335 !end to end
65     nword_DSP = nword_DSP +1
66     if( nword_DSP.gt.datalength(iv) )then
67 pam-fi 1.10 if( debug.eq.1 )
68     $ print*,'filladc --> missing end-of-ladder',
69 pam-fi 1.6 $ ' in COMPRESSED mode - DSP ',DSPn
70 pam-fi 1.10 if(debug.eq.1)
71     $ print*,'datalength = ',datalength(iv)
72 pam-fi 1.6 iflag=1
73 pam-fi 1.8 c GOOD1(DSPn) = 10
74     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
75     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
76 pam-fi 1.6 goto 334 !next view
77     endif
78 mocchiut 1.11 c word = datatracker(idata)
79     word = INT(IBITS(datatracker(idata),0,16),2) ! EM GCC4.2, I checked that this line works
80     c print *,word,' datatracker(idata) ',datatracker(idata) ! EM
81 mocchiut 1.1 C------------------------------------------------------
82     C call routine to uncompress data
83     C------------------------------------------------------
84 pam-fi 1.4 call compdecode(word,flag,tipo,info,errflag)
85    
86     if(errflag.ne.0.) then
87 pam-fi 1.10 if(debug.eq.1)print*,'filladc --> ERROR on compdecode'
88 pam-fi 1.4 iflag=1
89 pam-fi 1.8 c GOOD1(DSPn) = 10
90     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
91     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
92 pam-fi 1.4 c return
93     goto 221
94 mocchiut 1.1 endif
95    
96 pam-fi 1.4 if(flag.eq.1) then ! flag: fine messaggio (ladder)
97    
98     if(info.ne.1.and.info.ne.2.and.info.ne.3) then
99 pam-fi 1.10 if(debug.eq.1)print*,
100 pam-fi 1.4 $ 'filladc --> wrong end-of-ladder '
101     $ //'in COMPRESSED mode'
102 pam-fi 1.10 if(debug.eq.1)print*,
103 pam-fi 1.4 $ ' info(=ladder) ',info,' type ',tipo
104     iflag=1
105 pam-fi 1.8 c GOOD1(DSPn) = 10
106     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
107     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
108 pam-fi 1.4 c return
109     goto 221
110     endif
111    
112     il = info
113     do js=is+1,1024*il
114    
115 pam-fi 1.6 if( DSPn.le.nviews
116     $ .and.nvk(js).gt.0
117 pam-fi 1.4 $ .and.nvk(js).le.nva1_view
118 pam-fi 1.6 $ .and.nst(js).gt.0
119 pam-fi 1.4 $ .and.nst(js).le.nstrips_va1
120     $ )then
121    
122 pam-fi 1.6 newVAL = 0
123     if(
124     $ nvk(is).gt.0.and.
125     $ nvk(is).le.nva1_view.and.
126     $ nst(is).gt.0.and.
127     $ nst(is).le.nstrips_va1.and.
128     $ .true.)then
129 mocchiut 1.11 newVAL=oldVAL-
130     $ nint(pedestal_t(DSPn,nvk(is),nst(is)) ! EM GCC4.7
131     $ +pedestal_t(DSPn,nvk(js),nst(js)),2) ! EM GCC4.7
132     newVAL=max(int(0,2),newVAL) ! EM GCC4.7
133     newVAL=min(int(4095,2),newVAL)
134 pam-fi 1.6 endif
135 pam-fi 1.4 adc(DSPn,nvk(js),nst(js))=newVAL
136 pam-fi 1.6 else
137 pam-fi 1.4 print*,'filladc -->'
138 pam-fi 1.6 $ ,' attempt to access array element (1)'
139     c $ ,'(',DSPn,nvk(is),nst(is),')'
140     $ ,'pedestal_t(',DSPn,nvk(js),nst(js),')'
141 pam-fi 1.4 endif
142     c$$$ print*,DSPn,nvk(js),nst(js)
143     c$$$ $ ,pedestal_t(DSPn,nvk(js),nst(js)),newval
144     c$$$ $ ,pedestal(DSPn,nvk(js),nst(js))
145     enddo
146    
147     if(info.eq.3) goto 1000
148    
149     is=1024*il
150     prec_ind=0 !il precedente non e' un indirizzo
151     endif
152 mocchiut 1.1
153 pam-fi 1.4 if(flag.eq.0) then ! flag: dato o indirizzo
154     if(tipo.eq.1) then ! tipo: indirizzo
155     iaddr = info + il*1024
156     if(iaddr.ge.is+1.and.iaddr.le.3072) then
157 pam-fi 1.6
158     if(is.eq.0.or.is.eq.1024.or.is.eq.2048)then
159 pam-fi 1.10 if(debug.eq.1)print*,'filladc -->'
160 pam-fi 1.6 $ ,' previous transmitted strip ',is
161     $ ,' - missing first ADC value'
162     iflag=1
163 pam-fi 1.8 c GOOD1(DSPn) = 10
164     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
165     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
166 pam-fi 1.6 endif
167 pam-fi 1.4 do js = is+1,iaddr-1
168    
169 pam-fi 1.6 if( DSPn.le.nviews
170     $ .and.nvk(js).gt.0
171 pam-fi 1.4 $ .and.nvk(js).le.nva1_view
172 pam-fi 1.6 $ .and.nst(js).gt.0
173 pam-fi 1.4 $ .and.nst(js).le.nstrips_va1
174     $ )then
175 pam-fi 1.6
176     newVAL = 0
177     if(
178     $ nvk(is).gt.0.and.
179     $ nvk(is).le.nva1_view.and.
180     $ nst(is).gt.0.and.
181     $ nst(is).le.nstrips_va1.and.
182     $ .true.)then
183 mocchiut 1.11 newVAL=oldVAL-nint( ! EM GCC4.7
184 pam-fi 1.6 $ -pedestal_t(DSPn,nvk(is),nst(is))
185 mocchiut 1.11 $ +pedestal_t(DSPn,nvk(js),nst(js)),2)! EM GCC4.7
186     newVAL=max(int(0,2),newVAL)! EM GCC4.7
187     newVAL=min(int(4095,2),newVAL)! EM GCC4.7
188 pam-fi 1.6 endif
189 pam-fi 1.4 adc(DSPn,nvk(js),nst(js))=newVAL
190     else
191     print*,'filladc -->'
192 pam-fi 1.6 $ ,' attempt to access array element (2) '
193     c $ ,'(',DSPn,nvk(is),nst(is),')'
194     $ ,'pedestal_t(',DSPn,nvk(js),nst(js),')'
195     c iflag=1
196     c if(DSPn.le.nviews)GOOD1(DSPn) = 10
197 pam-fi 1.4 endif
198 mocchiut 1.1 c print*,DSPn,nvk(js),nst(js),newval
199 pam-fi 1.4
200     enddo
201    
202     is = iaddr
203     prec_ind = 1
204     else
205 pam-fi 1.10 if(debug.eq.1)print*,'filladc --> address '//
206 pam-fi 1.4 $ 'out of range - iaddr,is',iaddr,is
207     iflag=1
208 pam-fi 1.8 c GOOD1(DSPn) = 10
209     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
210     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
211 pam-fi 1.4 c return
212     goto 221
213     endif
214     endif
215     if(tipo.eq.0) then ! tipo: dato
216     if(prec_ind.eq.0) is=is+1
217     if(info.ge.0.and.info.le.4095) then
218     if(is.gt.3072)then
219 pam-fi 1.10 if(debug.eq.1)print*,
220 pam-fi 1.4 $ 'filladc --> strip out of range - DSPn,is'
221     $ ,DSPn,is
222     iflag=1
223 pam-fi 1.8 c GOOD1(DSPn) = 10
224     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
225     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
226 pam-fi 1.4 c return
227     goto 221
228    
229     endif
230     newVAL=info
231    
232     if( DSPn.le.nviews
233     $ .and.nvk(is).le.nva1_view
234     $ .and.nst(is).le.nstrips_va1)then
235     adc(DSPn,nvk(is),nst(is))=newVAL
236     else
237     print*,'filladc --> attempt to access ADC('
238     $ ,DSPn,nvk(is),nst(is),')'
239     endif
240 mocchiut 1.1 ccc print*,DSPn,nvk(is),nst(is),newval
241 pam-fi 1.4
242     oldVAL=newVAL
243     else
244 pam-fi 1.10 if(debug.eq.1)
245 pam-fi 1.4 $ print*,'filladc --> datum out of range - info'
246     $ ,info
247     iflag=1
248 pam-fi 1.8 c GOOD1(DSPn) = 10
249     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
250     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
251 pam-fi 1.4 c return
252     goto 221
253     endif
254     prec_ind=0
255     endif
256 mocchiut 1.1 endif
257 pam-fi 1.4 221 continue
258     goto 222
259     endif
260    
261     1000 continue
262    
263 mocchiut 1.1
264     C++++++++++++++++++++++++++++++++++++++++++++++++++++++
265     c if(iand(DAQmode(iv),z'0001').eq.z'0001') then
266 pam-fi 1.4 if(iand(DAQmode(iv),z'0003').eq.z'0001'.or. !full
267     $ iand(DAQmode(iv),z'0003').eq.z'0003'.or. !comp+full
268     $ (iand(DAQmode(iv),z'0003').eq.z'0000' !special
269     $ .and.mod(DSPn+ievent,2).eq.1).or.
270     $ .false.) then
271 mocchiut 1.1 C++++++++++++++++++++++++++++++++++++++++++++++++++++++
272     C--------------------------------------------full mode
273 pam-fi 1.4
274 pam-fi 1.10 if(debug.eq.1)print*,'DSP #',DSPn,' --> full '
275 mocchiut 1.1
276 pam-fi 1.4 do i=1,3 !loop over ladder
277     do j=1,1024 !loop over strips
278     idata = idata+1
279 pam-fi 1.6 if( idata.gt.NWORDMAX )goto 335 !go to end
280     nword_DSP = nword_DSP +1
281     if( nword_DSP.gt.datalength(iv) )then
282 pam-fi 1.10 if( debug.eq.1 )
283 pam-fi 1.6 $ print*,'filladc --> missing end-of-ladder',
284     $ ' in FULL mode - DSP ',DSPn
285 pam-fi 1.10 if(debug.eq.1)print*,'datalength = ',datalength
286 pam-fi 1.6 goto 334 !next view
287     endif
288 pam-fi 1.4 is=j+1024*(i-1)
289 mocchiut 1.1 c adcadc=adc(DSPn,nvk(is),nst(is))
290 pam-fi 1.4 if( DSPn.le.nviews
291     $ .and.nvk(is).le.nva1_view
292     $ .and.nst(is).le.nstrips_va1)then
293     adc(DSPn,nvk(is),nst(is))= datatracker(idata)
294     else
295     print*,'filladc --> attempt to access ADC['
296     $ ,DSPn,nvk(is),nst(is),']'
297     endif
298    
299 mocchiut 1.1 c if(iand(DAQmode(iv),z'0002').eq.z'0002') then
300     c diff=adc(DSPn,nvk(is),nst(is))-adcadc
301     c if(abs(diff).gt.0)
302     c $ print*,DSPn,is,adcadc,
303     c $ ' ---- ',adc(DSPn,nvk(is),nst(is)),diff
304     c endif
305 pam-fi 1.4 enddo !loop over strips
306     idata = idata+1
307 pam-fi 1.6 if( idata.gt.NWORDMAX )goto 335 !go to end
308     nword_DSP = nword_DSP +1
309     if( nword_DSP.gt.datalength(iv) )then
310 pam-fi 1.10 if( debug.eq.1 )
311 pam-fi 1.6 $ print*,'filladc --> missing end-of-ladder',
312     $ ' in FULL mode - DSP ',DSPn
313 pam-fi 1.10 if(debug.eq.1)print*,'datalength = ',datalength
314 pam-fi 1.6 goto 334 !next view
315     endif
316 pam-fi 1.4 if(datatracker(idata).ne.ior(z'1800',i+3)) then
317 pam-fi 1.10 if(debug.eq.1)
318 pam-fi 1.4 $ print*,'filladc --> ',
319     $ 'wrong end-of-ladder in FULL mode'
320 pam-fi 1.10 if(debug.eq.1)
321 pam-fi 1.4 $ print*,' word ',datatracker(idata)
322 pam-fi 1.10 if(debug.eq.1)
323 pam-fi 1.4 $ print*,' should be ',ior(z'1800',i+3)
324     iflag=1
325 pam-fi 1.8 c GOOD1(DSPn) = 10
326     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
327     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
328 pam-fi 1.4 c return
329     endif
330     enddo!endl loop over ladder
331     endif
332     goto 334
333 pam-fi 1.6 333 continue
334 pam-fi 1.10 if(debug.eq.1)print*,'filladc --> ',iv
335 pam-fi 1.6 $ ,'^ DSP packet missing or corrupted: '
336     $ ,'DSPn, datalength(iv) => '
337     $ ,DSPn,datalength(iv)
338     334 continue
339 mocchiut 1.1 enddo
340 pam-fi 1.6 goto 336
341     335 continue
342 pam-fi 1.10 if(debug.eq.1)print*,'filladc --> reached end of buffer:',
343 pam-fi 1.6 $ ' datatracker(',NWORDMAX,')'
344    
345     336 continue
346 mocchiut 1.1 return
347     end
348    
349    
350    
351     c qui o nelle functions.f???
352    
353     SUBROUTINE COMPDECODE(word,flag,tipo,info,errflag)
354     INTEGER*2 word,flag,tipo,info
355 mocchiut 1.11 INTEGER*2 hexmask !EM GCC4.7
356 mocchiut 1.1 C-------------------------------------------------------
357     C Decode tracker words:
358     C
359     C flag tipo info
360     C --------------------------------------------------
361     C 0 0 ADC value
362     C 0 1 strip address 1-1024
363     C 1 0(end of ladders 1 2 1,2 or 4,5
364     C 1 1(end of ladder 3) 3 or 6
365     C-------------------------------------------------------
366     errflag=0.
367 mocchiut 1.11 C EM: by default z'XXXX' returns a INTEGER*8, we want to have just a INTEGER*2 so we need a trick
368     C Bitwise is like this:
369     C WORD = 16 bit
370     C 1111111111111111 FFFF 32767 + sign
371     C
372     C flag=iand(word,z'f000')
373     hexmask=z'7000'
374     hexmask=IBSET(hexmask,15) ! it is not possible to set the sign bit with F000, we must set the sign bit with ibset
375     flag=iand(word,hexmask)
376     C END EM
377 mocchiut 1.1 flag=ishft(flag,-12)
378    
379     if(flag.ne.0.and.flag.ne.1) then
380 pam-fi 1.2 c print*,'compdecode --> error on uncompression: flag=',flag
381 pam-fi 1.9 errflag=1.
382 mocchiut 1.1 endif
383     if(flag.eq.0) then ! valore ADC
384 pam-fi 1.9 tipo=0
385 mocchiut 1.11 hexmask=z'0FFF' !EM GCC4.7
386     info=iand(word,hexmask) !EM GCC4.7
387     c info=iand(word,z'0fff') !EM GCC4.7
388 mocchiut 1.1 endif
389     if(flag.eq.1) then ! indirizzo OR fine vista
390 mocchiut 1.11 hexmask=z'03FF' !EM GCC4.7
391     info=iand(word,hexmask) !EM GCC4.7
392     c info=iand(word,z'03ff') !EM GCC4.7
393     hexmask=z'0C00' !EM GCC4.7
394     tipo=iand(word,hexmask)!EM GCC4.7
395     c tipo=iand(word,z'0c00') !EM GCC4.7
396     hexmask=z'0800' !EM GCC4.7
397     if(tipo.ne.0.and.tipo.ne.hexmask) then !EM GCC4.7
398 pam-fi 1.2 c print*,'compdecode --> error on decompression: tipo=',tipo
399 mocchiut 1.1 errflag=1.
400     endif
401     if(tipo.eq.0) then ! indirizzo
402     flag=0
403     tipo=1
404 mocchiut 1.11 info=info+INT(1,2) !EM GCC4.7
405 mocchiut 1.1 endif
406     if(tipo.eq.z'0800') then ! fine vista
407     flag=1
408     if(info.eq.3.or.info.eq.6) then
409     tipo=1
410     else
411     tipo=0
412     endif
413     endif
414     endif
415     return
416     end

  ViewVC Help
Powered by ViewVC 1.1.23