/[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.10 - (show annotations) (download)
Mon Aug 20 16:07:16 2007 UTC (17 years, 3 months ago) by pam-fi
Branch: MAIN
CVS Tags: v5r00, v4r00, v9r00, v9r01, v6r01, v6r00
Changes since 1.9: +22 -20 lines
missing-image bug fixed + other changes

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

  ViewVC Help
Powered by ViewVC 1.1.23