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