/[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.5 - (hide annotations) (download)
Fri Sep 29 08:13:04 2006 UTC (18 years, 2 months ago) by pam-fi
Branch: MAIN
Changes since 1.4: +10 -10 lines
bug fixed

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    
13 mocchiut 1.1 external nvk
14     external nst
15    
16     real errflag
17     integer*2 flag,tipo,info,prec_ind,word
18     integer*2 newVAL,oldVAL
19     data oldval/0/
20     integer DSPn
21    
22     iflag = 0
23    
24     C---------------------------------------------------------
25     C check DAQmode to see if data are
26     C - b#1001 = 9 full
27     C - b#1010 =10 compressed
28     C - b#1011 =11 compressed + full
29     C - b#1000 = 8 special --> (compressed+full) / compressed
30     C (even/odd views compressed/full, alternately)
31     C in the third case ADC is filled with full data
32     C---------------------------------------------------------
33    
34     idata=0 !datatracker array index
35 pam-fi 1.4
36 mocchiut 1.1 do iv=1,nviews
37 pam-fi 1.4
38     DSPn = DSPnumber(iv)
39     ievent = eventn(iv)
40 mocchiut 1.1
41     C ---------------------------
42     C if the iv view is missing
43     C or the data buffer is empty
44 pam-fi 1.4 C jump to next view
45 mocchiut 1.1 C ---------------------------
46    
47 pam-fi 1.4 if(DSPn.eq.0
48     $ .or.datalength(iv).eq.0)goto 333
49    
50 mocchiut 1.1 C++++++++++++++++++++++++++++++++++++++++++++++++++++++
51 pam-fi 1.4 if( iand(DAQmode(iv),z'0003').eq.z'0002'.or.
52     $ iand(DAQmode(iv),z'0003').eq.z'0003'.or.
53     $ iand(DAQmode(iv),z'0003').eq.z'0000'.or.
54     $ .false.) then
55 mocchiut 1.1 C++++++++++++++++++++++++++++++++++++++++++++++++++++++
56     C--------------------------------------compressed mode
57 pam-fi 1.4 is = 0
58     il = 0
59     prec_ind = 0
60     222 continue
61     idata = idata+1
62     word=datatracker(idata)
63 mocchiut 1.1 C------------------------------------------------------
64     C call routine to uncompress data
65     C------------------------------------------------------
66 pam-fi 1.4 call compdecode(word,flag,tipo,info,errflag)
67    
68     if(errflag.ne.0.) then
69 pam-fi 1.5 if(verbose)print*,'filladc --> ERROR on compdecode'
70 pam-fi 1.4 iflag=1
71     GOOD1(DSPn) = 10
72     c return
73     goto 221
74 mocchiut 1.1 endif
75    
76 pam-fi 1.4 if(flag.eq.1) then ! flag: fine messaggio (ladder)
77    
78     if(info.ne.1.and.info.ne.2.and.info.ne.3) then
79 pam-fi 1.5 if(verbose)print*,
80 pam-fi 1.4 $ 'filladc --> wrong end-of-ladder '
81     $ //'in COMPRESSED mode'
82 pam-fi 1.5 if(verbose)print*,
83 pam-fi 1.4 $ ' info(=ladder) ',info,' type ',tipo
84     iflag=1
85     GOOD1(DSPn) = 10
86     c return
87     goto 221
88     endif
89    
90     il = info
91     do js=is+1,1024*il
92    
93     if( DSPn.le.nviews
94     $ .and.nvk(js).le.nva1_view
95     $ .and.nst(js).le.nstrips_va1
96     $ .and.nvk(is).le.nva1_view
97     $ .and.nst(is).le.nstrips_va1
98     $ )then
99    
100     newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is))
101     $ +pedestal_t(DSPn,nvk(js),nst(js))
102     newVAL=max(0,newVAL)
103     newVAL=min(4095,newVAL)
104     adc(DSPn,nvk(js),nst(js))=newVAL
105     else
106     print*,'filladc -->'
107     $ ,' attempt to access array elements (1)'
108     $ ,'(',DSPn,nvk(is),nst(is),')'
109     $ ,'(',DSPn,nvk(js),nst(js),')'
110     endif
111     c$$$ print*,DSPn,nvk(js),nst(js)
112     c$$$ $ ,pedestal_t(DSPn,nvk(js),nst(js)),newval
113     c$$$ $ ,pedestal(DSPn,nvk(js),nst(js))
114     enddo
115    
116     if(info.eq.3) goto 1000
117    
118     is=1024*il
119     prec_ind=0 !il precedente non e' un indirizzo
120     endif
121 mocchiut 1.1
122 pam-fi 1.4 if(flag.eq.0) then ! flag: dato o indirizzo
123     if(tipo.eq.1) then ! tipo: indirizzo
124     iaddr = info + il*1024
125     if(iaddr.ge.is+1.and.iaddr.le.3072) then
126     do js = is+1,iaddr-1
127    
128     if( DSPn.le.nviews
129     $ .and.nvk(js).le.nva1_view
130     $ .and.nst(js).le.nstrips_va1
131     $ .and.nvk(is).le.nva1_view
132     $ .and.nst(is).le.nstrips_va1
133     $ )then
134    
135     newVAL=oldVAL
136     $ -pedestal_t(DSPn,nvk(is),nst(is))
137     $ +pedestal_t(DSPn,nvk(js),nst(js))
138     newVAL=max(0,newVAL)
139     newVAL=min(4095,newVAL)
140     adc(DSPn,nvk(js),nst(js))=newVAL
141     else
142     print*,'filladc -->'
143     $ ,' attempt to access array elements (2)'
144     $ ,'(',DSPn,nvk(is),nst(is),')'
145     $ ,'(',DSPn,nvk(js),nst(js),')'
146     endif
147 mocchiut 1.1 c print*,DSPn,nvk(js),nst(js),newval
148 pam-fi 1.4
149     enddo
150    
151     is = iaddr
152     prec_ind = 1
153     else
154 pam-fi 1.5 if(verbose)print*,'filladc --> address '//
155 pam-fi 1.4 $ 'out of range - iaddr,is',iaddr,is
156     iflag=1
157     GOOD1(DSPn) = 10
158     c return
159     goto 221
160     endif
161     endif
162     if(tipo.eq.0) then ! tipo: dato
163     if(prec_ind.eq.0) is=is+1
164     if(info.ge.0.and.info.le.4095) then
165     if(is.gt.3072)then
166 pam-fi 1.5 if(verbose)print*,
167 pam-fi 1.4 $ 'filladc --> strip out of range - DSPn,is'
168     $ ,DSPn,is
169     iflag=1
170     GOOD1(DSPn) = 10
171     c return
172     goto 221
173    
174     endif
175     newVAL=info
176    
177     if( DSPn.le.nviews
178     $ .and.nvk(is).le.nva1_view
179     $ .and.nst(is).le.nstrips_va1)then
180     adc(DSPn,nvk(is),nst(is))=newVAL
181     else
182     print*,'filladc --> attempt to access ADC('
183     $ ,DSPn,nvk(is),nst(is),')'
184     endif
185 mocchiut 1.1 ccc print*,DSPn,nvk(is),nst(is),newval
186 pam-fi 1.4
187     oldVAL=newVAL
188     else
189 pam-fi 1.5 if(verbose)
190 pam-fi 1.4 $ print*,'filladc --> datum out of range - info'
191     $ ,info
192     iflag=1
193     GOOD1(DSPn) = 10
194     c return
195     goto 221
196     endif
197     prec_ind=0
198     endif
199 mocchiut 1.1 endif
200 pam-fi 1.4 221 continue
201     goto 222
202     endif
203    
204     1000 continue
205    
206 mocchiut 1.1
207     C++++++++++++++++++++++++++++++++++++++++++++++++++++++
208     c if(iand(DAQmode(iv),z'0001').eq.z'0001') then
209 pam-fi 1.4 if(iand(DAQmode(iv),z'0003').eq.z'0001'.or. !full
210     $ iand(DAQmode(iv),z'0003').eq.z'0003'.or. !comp+full
211     $ (iand(DAQmode(iv),z'0003').eq.z'0000' !special
212     $ .and.mod(DSPn+ievent,2).eq.1).or.
213     $ .false.) then
214 mocchiut 1.1 C++++++++++++++++++++++++++++++++++++++++++++++++++++++
215     C--------------------------------------------full mode
216 pam-fi 1.4
217 mocchiut 1.1
218 pam-fi 1.4 do i=1,3 !loop over ladder
219     do j=1,1024 !loop over strips
220     idata = idata+1
221     is=j+1024*(i-1)
222 mocchiut 1.1 c adcadc=adc(DSPn,nvk(is),nst(is))
223 pam-fi 1.4 if( DSPn.le.nviews
224     $ .and.nvk(is).le.nva1_view
225     $ .and.nst(is).le.nstrips_va1)then
226     adc(DSPn,nvk(is),nst(is))= datatracker(idata)
227     else
228     print*,'filladc --> attempt to access ADC['
229     $ ,DSPn,nvk(is),nst(is),']'
230     endif
231    
232 mocchiut 1.1 c if(iand(DAQmode(iv),z'0002').eq.z'0002') then
233     c diff=adc(DSPn,nvk(is),nst(is))-adcadc
234     c if(abs(diff).gt.0)
235     c $ print*,DSPn,is,adcadc,
236     c $ ' ---- ',adc(DSPn,nvk(is),nst(is)),diff
237     c endif
238 pam-fi 1.4 enddo !loop over strips
239     idata = idata+1
240     if(datatracker(idata).ne.ior(z'1800',i+3)) then
241 pam-fi 1.5 if(verbose)
242 pam-fi 1.4 $ print*,'filladc --> ',
243     $ 'wrong end-of-ladder in FULL mode'
244 pam-fi 1.5 if(verbose)
245 pam-fi 1.4 $ print*,' word ',datatracker(idata)
246 pam-fi 1.5 if(verbose)
247 pam-fi 1.4 $ print*,' should be ',ior(z'1800',i+3)
248     iflag=1
249     GOOD1(DSPn) = 10
250     c return
251     endif
252     enddo!endl loop over ladder
253     endif
254     goto 334
255     333 continue
256 pam-fi 1.5 if(verbose)print*,'filladc --> ',iv
257 pam-fi 1.4 $ ,'^ DSP packet missing or corrupted: '
258     $ ,'DSPn, datalength(iv) => '
259     $ ,DSPn,datalength(iv)
260     334 continue
261 mocchiut 1.1 enddo
262    
263     return
264     end
265    
266    
267    
268     c qui o nelle functions.f???
269    
270     SUBROUTINE COMPDECODE(word,flag,tipo,info,errflag)
271     INTEGER*2 word,flag,tipo,info
272     C-------------------------------------------------------
273     C Decode tracker words:
274     C
275     C flag tipo info
276     C --------------------------------------------------
277     C 0 0 ADC value
278     C 0 1 strip address 1-1024
279     C 1 0(end of ladders 1 2 1,2 or 4,5
280     C 1 1(end of ladder 3) 3 or 6
281     C-------------------------------------------------------
282     errflag=0.
283     flag=iand(word,z'f000')
284     flag=ishft(flag,-12)
285    
286     if(flag.ne.0.and.flag.ne.1) then
287 pam-fi 1.2 c print*,'compdecode --> error on uncompression: flag=',flag
288 mocchiut 1.1 errflag=1.
289     endif
290     if(flag.eq.0) then ! valore ADC
291     tipo=0
292     info=iand(word,z'0fff')
293     endif
294     if(flag.eq.1) then ! indirizzo OR fine vista
295     info=iand(word,z'03ff')
296     tipo=iand(word,z'0c00')
297     if(tipo.ne.0.and.tipo.ne.z'0800') then
298 pam-fi 1.2 c print*,'compdecode --> error on decompression: tipo=',tipo
299 mocchiut 1.1 errflag=1.
300     endif
301     if(tipo.eq.0) then ! indirizzo
302     flag=0
303     tipo=1
304     info=info+1
305     endif
306     if(tipo.eq.z'0800') then ! fine vista
307     flag=1
308     if(info.eq.3.or.info.eq.6) then
309     tipo=1
310     else
311     tipo=0
312     endif
313     endif
314     endif
315     return
316     end

  ViewVC Help
Powered by ViewVC 1.1.23