/[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.7 - (show annotations) (download)
Thu Mar 15 12:17:10 2007 UTC (17 years, 9 months ago) by pam-fi
Branch: MAIN
CVS Tags: v3r04, v3r05, v3r06, v3r03
Changes since 1.6: +2 -0 lines
workaround to retrieve clusters + other minor adjustments

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

  ViewVC Help
Powered by ViewVC 1.1.23