/[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.9 - (hide 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 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.7 if(debug)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.8 if( debug )print*,'filladc --> missing end-of-ladder',
68 pam-fi 1.6 $ ' in COMPRESSED mode - DSP ',DSPn
69 pam-fi 1.8 if(debug)print*,'datalength = ',datalength(iv)
70 pam-fi 1.6 iflag=1
71 pam-fi 1.8 c GOOD1(DSPn) = 10
72     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
73     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
74 pam-fi 1.6 goto 334 !next view
75     endif
76     word = datatracker(idata)
77 mocchiut 1.1 C------------------------------------------------------
78     C call routine to uncompress data
79     C------------------------------------------------------
80 pam-fi 1.4 call compdecode(word,flag,tipo,info,errflag)
81    
82     if(errflag.ne.0.) then
83 pam-fi 1.8 if(debug)print*,'filladc --> ERROR on compdecode'
84 pam-fi 1.4 iflag=1
85 pam-fi 1.8 c GOOD1(DSPn) = 10
86     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
87     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
88 pam-fi 1.4 c return
89     goto 221
90 mocchiut 1.1 endif
91    
92 pam-fi 1.4 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 pam-fi 1.8 if(debug)print*,
96 pam-fi 1.4 $ 'filladc --> wrong end-of-ladder '
97     $ //'in COMPRESSED mode'
98 pam-fi 1.8 if(debug)print*,
99 pam-fi 1.4 $ ' info(=ladder) ',info,' type ',tipo
100     iflag=1
101 pam-fi 1.8 c GOOD1(DSPn) = 10
102     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
103     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
104 pam-fi 1.4 c return
105     goto 221
106     endif
107    
108     il = info
109     do js=is+1,1024*il
110    
111 pam-fi 1.6 if( DSPn.le.nviews
112     $ .and.nvk(js).gt.0
113 pam-fi 1.4 $ .and.nvk(js).le.nva1_view
114 pam-fi 1.6 $ .and.nst(js).gt.0
115 pam-fi 1.4 $ .and.nst(js).le.nstrips_va1
116     $ )then
117    
118 pam-fi 1.6 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 pam-fi 1.4 adc(DSPn,nvk(js),nst(js))=newVAL
131 pam-fi 1.6 else
132 pam-fi 1.4 print*,'filladc -->'
133 pam-fi 1.6 $ ,' attempt to access array element (1)'
134     c $ ,'(',DSPn,nvk(is),nst(is),')'
135     $ ,'pedestal_t(',DSPn,nvk(js),nst(js),')'
136 pam-fi 1.4 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 mocchiut 1.1
148 pam-fi 1.4 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 pam-fi 1.6
153     if(is.eq.0.or.is.eq.1024.or.is.eq.2048)then
154 pam-fi 1.8 if(debug)print*,'filladc -->'
155 pam-fi 1.6 $ ,' previous transmitted strip ',is
156     $ ,' - missing first ADC value'
157     iflag=1
158 pam-fi 1.8 c GOOD1(DSPn) = 10
159     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
160     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
161 pam-fi 1.6 endif
162 pam-fi 1.4 do js = is+1,iaddr-1
163    
164 pam-fi 1.6 if( DSPn.le.nviews
165     $ .and.nvk(js).gt.0
166 pam-fi 1.4 $ .and.nvk(js).le.nva1_view
167 pam-fi 1.6 $ .and.nst(js).gt.0
168 pam-fi 1.4 $ .and.nst(js).le.nstrips_va1
169     $ )then
170 pam-fi 1.6
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 pam-fi 1.4 adc(DSPn,nvk(js),nst(js))=newVAL
185     else
186     print*,'filladc -->'
187 pam-fi 1.6 $ ,' 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 pam-fi 1.4 endif
193 mocchiut 1.1 c print*,DSPn,nvk(js),nst(js),newval
194 pam-fi 1.4
195     enddo
196    
197     is = iaddr
198     prec_ind = 1
199     else
200 pam-fi 1.8 if(debug)print*,'filladc --> address '//
201 pam-fi 1.4 $ 'out of range - iaddr,is',iaddr,is
202     iflag=1
203 pam-fi 1.8 c GOOD1(DSPn) = 10
204     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
205     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
206 pam-fi 1.4 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 pam-fi 1.8 if(debug)print*,
215 pam-fi 1.4 $ 'filladc --> strip out of range - DSPn,is'
216     $ ,DSPn,is
217     iflag=1
218 pam-fi 1.8 c GOOD1(DSPn) = 10
219     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
220     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
221 pam-fi 1.4 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 mocchiut 1.1 ccc print*,DSPn,nvk(is),nst(is),newval
236 pam-fi 1.4
237     oldVAL=newVAL
238     else
239 pam-fi 1.8 if(debug)
240 pam-fi 1.4 $ print*,'filladc --> datum out of range - info'
241     $ ,info
242     iflag=1
243 pam-fi 1.8 c GOOD1(DSPn) = 10
244     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
245     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
246 pam-fi 1.4 c return
247     goto 221
248     endif
249     prec_ind=0
250     endif
251 mocchiut 1.1 endif
252 pam-fi 1.4 221 continue
253     goto 222
254     endif
255    
256     1000 continue
257    
258 mocchiut 1.1
259     C++++++++++++++++++++++++++++++++++++++++++++++++++++++
260     c if(iand(DAQmode(iv),z'0001').eq.z'0001') then
261 pam-fi 1.4 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 mocchiut 1.1 C++++++++++++++++++++++++++++++++++++++++++++++++++++++
267     C--------------------------------------------full mode
268 pam-fi 1.4
269 pam-fi 1.7 if(debug)print*,'DSP #',DSPn,' --> full '
270 mocchiut 1.1
271 pam-fi 1.4 do i=1,3 !loop over ladder
272     do j=1,1024 !loop over strips
273     idata = idata+1
274 pam-fi 1.6 if( idata.gt.NWORDMAX )goto 335 !go to end
275     nword_DSP = nword_DSP +1
276     if( nword_DSP.gt.datalength(iv) )then
277 pam-fi 1.8 if( debug )
278 pam-fi 1.6 $ print*,'filladc --> missing end-of-ladder',
279     $ ' in FULL mode - DSP ',DSPn
280 pam-fi 1.8 if(debug)print*,'datalength = ',datalength
281 pam-fi 1.6 goto 334 !next view
282     endif
283 pam-fi 1.4 is=j+1024*(i-1)
284 mocchiut 1.1 c adcadc=adc(DSPn,nvk(is),nst(is))
285 pam-fi 1.4 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 mocchiut 1.1 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 pam-fi 1.4 enddo !loop over strips
301     idata = idata+1
302 pam-fi 1.6 if( idata.gt.NWORDMAX )goto 335 !go to end
303     nword_DSP = nword_DSP +1
304     if( nword_DSP.gt.datalength(iv) )then
305 pam-fi 1.8 if( debug )
306 pam-fi 1.6 $ print*,'filladc --> missing end-of-ladder',
307     $ ' in FULL mode - DSP ',DSPn
308 pam-fi 1.8 if(debug)print*,'datalength = ',datalength
309 pam-fi 1.6 goto 334 !next view
310     endif
311 pam-fi 1.4 if(datatracker(idata).ne.ior(z'1800',i+3)) then
312 pam-fi 1.8 if(debug)
313 pam-fi 1.4 $ print*,'filladc --> ',
314     $ 'wrong end-of-ladder in FULL mode'
315 pam-fi 1.8 if(debug)
316 pam-fi 1.4 $ print*,' word ',datatracker(idata)
317 pam-fi 1.8 if(debug)
318 pam-fi 1.4 $ print*,' should be ',ior(z'1800',i+3)
319     iflag=1
320 pam-fi 1.8 c GOOD1(DSPn) = 10
321     c GOOD1(DSPn) = GOOD1(DSPn) + 2**4
322     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
323 pam-fi 1.4 c return
324     endif
325     enddo!endl loop over ladder
326     endif
327     goto 334
328 pam-fi 1.6 333 continue
329 pam-fi 1.8 if(debug)print*,'filladc --> ',iv
330 pam-fi 1.6 $ ,'^ DSP packet missing or corrupted: '
331     $ ,'DSPn, datalength(iv) => '
332     $ ,DSPn,datalength(iv)
333     334 continue
334 mocchiut 1.1 enddo
335 pam-fi 1.6 goto 336
336     335 continue
337 pam-fi 1.8 if(debug)print*,'filladc --> reached end of buffer:',
338 pam-fi 1.6 $ ' datatracker(',NWORDMAX,')'
339    
340     336 continue
341 mocchiut 1.1 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 pam-fi 1.2 c print*,'compdecode --> error on uncompression: flag=',flag
366 pam-fi 1.9 errflag=1.
367 mocchiut 1.1 endif
368     if(flag.eq.0) then ! valore ADC
369 pam-fi 1.9 tipo=0
370     info=iand(word,z'0fff')
371 mocchiut 1.1 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 pam-fi 1.2 c print*,'compdecode --> error on decompression: tipo=',tipo
377 mocchiut 1.1 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