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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (show annotations) (download)
Tue Aug 7 13:56:29 2007 UTC (17 years, 4 months ago) by pam-fi
Branch: MAIN
Changes since 1.8: +3 -3 lines
cog modified

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

  ViewVC Help
Powered by ViewVC 1.1.23