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 |
|
13 |
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 |
|
36 |
do iv=1,nviews |
37 |
|
38 |
DSPn = DSPnumber(iv) |
39 |
ievent = eventn(iv) |
40 |
|
41 |
C --------------------------- |
42 |
C if the iv view is missing |
43 |
C or the data buffer is empty |
44 |
C jump to next view |
45 |
C --------------------------- |
46 |
|
47 |
if(DSPn.eq.0 |
48 |
$ .or.datalength(iv).eq.0)goto 333 |
49 |
|
50 |
C++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
51 |
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 |
C++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
56 |
C--------------------------------------compressed mode |
57 |
is = 0 |
58 |
il = 0 |
59 |
prec_ind = 0 |
60 |
222 continue |
61 |
idata = idata+1 |
62 |
word=datatracker(idata) |
63 |
C------------------------------------------------------ |
64 |
C call routine to uncompress data |
65 |
C------------------------------------------------------ |
66 |
call compdecode(word,flag,tipo,info,errflag) |
67 |
|
68 |
if(errflag.ne.0.) then |
69 |
if(verbose)print*,'filladc --> ERROR on compdecode' |
70 |
iflag=1 |
71 |
GOOD1(DSPn) = 10 |
72 |
c return |
73 |
goto 221 |
74 |
endif |
75 |
|
76 |
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 |
if(verbose)print*, |
80 |
$ 'filladc --> wrong end-of-ladder ' |
81 |
$ //'in COMPRESSED mode' |
82 |
if(verbose)print*, |
83 |
$ ' 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 |
|
122 |
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 |
c print*,DSPn,nvk(js),nst(js),newval |
148 |
|
149 |
enddo |
150 |
|
151 |
is = iaddr |
152 |
prec_ind = 1 |
153 |
else |
154 |
if(verbose)print*,'filladc --> address '// |
155 |
$ '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 |
if(verbose)print*, |
167 |
$ '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 |
ccc print*,DSPn,nvk(is),nst(is),newval |
186 |
|
187 |
oldVAL=newVAL |
188 |
else |
189 |
if(verbose) |
190 |
$ 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 |
endif |
200 |
221 continue |
201 |
goto 222 |
202 |
endif |
203 |
|
204 |
1000 continue |
205 |
|
206 |
|
207 |
C++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
208 |
c if(iand(DAQmode(iv),z'0001').eq.z'0001') then |
209 |
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 |
C++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
215 |
C--------------------------------------------full mode |
216 |
|
217 |
|
218 |
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 |
c adcadc=adc(DSPn,nvk(is),nst(is)) |
223 |
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 |
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 |
enddo !loop over strips |
239 |
idata = idata+1 |
240 |
if(datatracker(idata).ne.ior(z'1800',i+3)) then |
241 |
if(verbose) |
242 |
$ print*,'filladc --> ', |
243 |
$ 'wrong end-of-ladder in FULL mode' |
244 |
if(verbose) |
245 |
$ print*,' word ',datatracker(idata) |
246 |
if(verbose) |
247 |
$ 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 |
if(verbose)print*,'filladc --> ',iv |
257 |
$ ,'^ DSP packet missing or corrupted: ' |
258 |
$ ,'DSPn, datalength(iv) => ' |
259 |
$ ,DSPn,datalength(iv) |
260 |
334 continue |
261 |
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 |
c print*,'compdecode --> error on uncompression: flag=',flag |
288 |
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 |
c print*,'compdecode --> error on decompression: tipo=',tipo |
299 |
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 |