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