/[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.6 - (show annotations) (download)
Mon Oct 16 12:36:52 2006 UTC (18 years, 2 months ago) by pam-fi
Branch: MAIN
CVS Tags: v2r01, v3r00
Changes since 1.5: +93 -33 lines
filladc bug fixed

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

  ViewVC Help
Powered by ViewVC 1.1.23