9 |
|
|
10 |
include 'common_reduction.f' |
include 'common_reduction.f' |
11 |
|
|
|
|
|
12 |
external nvk |
external nvk |
13 |
external nst |
external nst |
14 |
|
|
43 |
C jump to next view |
C jump to next view |
44 |
C --------------------------- |
C --------------------------- |
45 |
|
|
46 |
|
nword_DSP = 0 |
47 |
if(DSPn.eq.0 |
if(DSPn.eq.0 |
48 |
|
$ .or.DSPn.gt.nviews |
49 |
$ .or.datalength(iv).eq.0)goto 333 |
$ .or.datalength(iv).eq.0)goto 333 |
50 |
|
|
51 |
C++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
C++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
52 |
if( iand(DAQmode(iv),z'0003').eq.z'0002'.or. |
if( iand(DAQmode(iv),z'0003').eq.z'0002'.or. |
53 |
$ iand(DAQmode(iv),z'0003').eq.z'0003'.or. |
$ iand(DAQmode(iv),z'0003').eq.z'0003'.or. |
55 |
$ .false.) then |
$ .false.) then |
56 |
C++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
C++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
57 |
C--------------------------------------compressed mode |
C--------------------------------------compressed mode |
58 |
|
if(debug)print*,'DSP #',DSPn,' --> compressed ' |
59 |
is = 0 |
is = 0 |
60 |
il = 0 |
il = 0 |
61 |
prec_ind = 0 |
prec_ind = 0 |
62 |
222 continue |
222 continue |
63 |
idata = idata+1 |
idata = idata+1 |
64 |
word=datatracker(idata) |
if( idata.gt.NWORDMAX )goto 335 !end to end |
65 |
|
nword_DSP = nword_DSP +1 |
66 |
|
if( nword_DSP.gt.datalength(iv) )then |
67 |
|
if( verbose )print*,'filladc --> missing end-of-ladder', |
68 |
|
$ ' in COMPRESSED mode - DSP ',DSPn |
69 |
|
if(verbose)print*,'datalength = ',datalength(iv) |
70 |
|
iflag=1 |
71 |
|
GOOD1(DSPn) = 10 |
72 |
|
goto 334 !next view |
73 |
|
endif |
74 |
|
word = datatracker(idata) |
75 |
C------------------------------------------------------ |
C------------------------------------------------------ |
76 |
C call routine to uncompress data |
C call routine to uncompress data |
77 |
C------------------------------------------------------ |
C------------------------------------------------------ |
78 |
call compdecode(word,flag,tipo,info,errflag) |
call compdecode(word,flag,tipo,info,errflag) |
79 |
|
|
80 |
if(errflag.ne.0.) then |
if(errflag.ne.0.) then |
81 |
if(debug)print*,'filladc --> ERROR on compdecode' |
if(verbose)print*,'filladc --> ERROR on compdecode' |
82 |
iflag=1 |
iflag=1 |
83 |
GOOD1(DSPn) = 10 |
GOOD1(DSPn) = 10 |
84 |
c return |
c return |
88 |
if(flag.eq.1) then ! flag: fine messaggio (ladder) |
if(flag.eq.1) then ! flag: fine messaggio (ladder) |
89 |
|
|
90 |
if(info.ne.1.and.info.ne.2.and.info.ne.3) then |
if(info.ne.1.and.info.ne.2.and.info.ne.3) then |
91 |
if(debug)print*, |
if(verbose)print*, |
92 |
$ 'filladc --> wrong end-of-ladder ' |
$ 'filladc --> wrong end-of-ladder ' |
93 |
$ //'in COMPRESSED mode' |
$ //'in COMPRESSED mode' |
94 |
if(debug)print*, |
if(verbose)print*, |
95 |
$ ' info(=ladder) ',info,' type ',tipo |
$ ' info(=ladder) ',info,' type ',tipo |
96 |
iflag=1 |
iflag=1 |
97 |
GOOD1(DSPn) = 10 |
GOOD1(DSPn) = 10 |
102 |
il = info |
il = info |
103 |
do js=is+1,1024*il |
do js=is+1,1024*il |
104 |
|
|
105 |
if( DSPn.le.nviews |
if( DSPn.le.nviews |
106 |
|
$ .and.nvk(js).gt.0 |
107 |
$ .and.nvk(js).le.nva1_view |
$ .and.nvk(js).le.nva1_view |
108 |
|
$ .and.nst(js).gt.0 |
109 |
$ .and.nst(js).le.nstrips_va1 |
$ .and.nst(js).le.nstrips_va1 |
|
$ .and.nvk(is).le.nva1_view |
|
|
$ .and.nst(is).le.nstrips_va1 |
|
110 |
$ )then |
$ )then |
111 |
|
|
112 |
newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is)) |
newVAL = 0 |
113 |
$ +pedestal_t(DSPn,nvk(js),nst(js)) |
if( |
114 |
newVAL=max(0,newVAL) |
$ nvk(is).gt.0.and. |
115 |
newVAL=min(4095,newVAL) |
$ nvk(is).le.nva1_view.and. |
116 |
|
$ nst(is).gt.0.and. |
117 |
|
$ nst(is).le.nstrips_va1.and. |
118 |
|
$ .true.)then |
119 |
|
newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is)) |
120 |
|
$ +pedestal_t(DSPn,nvk(js),nst(js)) |
121 |
|
newVAL=max(0,newVAL) |
122 |
|
newVAL=min(4095,newVAL) |
123 |
|
endif |
124 |
adc(DSPn,nvk(js),nst(js))=newVAL |
adc(DSPn,nvk(js),nst(js))=newVAL |
125 |
else |
else |
126 |
print*,'filladc -->' |
print*,'filladc -->' |
127 |
$ ,' attempt to access array elements (1)' |
$ ,' attempt to access array element (1)' |
128 |
$ ,'(',DSPn,nvk(is),nst(is),')' |
c $ ,'(',DSPn,nvk(is),nst(is),')' |
129 |
$ ,'(',DSPn,nvk(js),nst(js),')' |
$ ,'pedestal_t(',DSPn,nvk(js),nst(js),')' |
130 |
endif |
endif |
131 |
c$$$ print*,DSPn,nvk(js),nst(js) |
c$$$ print*,DSPn,nvk(js),nst(js) |
132 |
c$$$ $ ,pedestal_t(DSPn,nvk(js),nst(js)),newval |
c$$$ $ ,pedestal_t(DSPn,nvk(js),nst(js)),newval |
143 |
if(tipo.eq.1) then ! tipo: indirizzo |
if(tipo.eq.1) then ! tipo: indirizzo |
144 |
iaddr = info + il*1024 |
iaddr = info + il*1024 |
145 |
if(iaddr.ge.is+1.and.iaddr.le.3072) then |
if(iaddr.ge.is+1.and.iaddr.le.3072) then |
146 |
|
|
147 |
|
if(is.eq.0.or.is.eq.1024.or.is.eq.2048)then |
148 |
|
if(verbose)print*,'filladc -->' |
149 |
|
$ ,' previous transmitted strip ',is |
150 |
|
$ ,' - missing first ADC value' |
151 |
|
iflag=1 |
152 |
|
GOOD1(DSPn) = 10 |
153 |
|
endif |
154 |
do js = is+1,iaddr-1 |
do js = is+1,iaddr-1 |
155 |
|
|
156 |
if( DSPn.le.nviews |
if( DSPn.le.nviews |
157 |
|
$ .and.nvk(js).gt.0 |
158 |
$ .and.nvk(js).le.nva1_view |
$ .and.nvk(js).le.nva1_view |
159 |
|
$ .and.nst(js).gt.0 |
160 |
$ .and.nst(js).le.nstrips_va1 |
$ .and.nst(js).le.nstrips_va1 |
|
$ .and.nvk(is).le.nva1_view |
|
|
$ .and.nst(is).le.nstrips_va1 |
|
161 |
$ )then |
$ )then |
162 |
|
|
163 |
newVAL=oldVAL |
newVAL = 0 |
164 |
$ -pedestal_t(DSPn,nvk(is),nst(is)) |
if( |
165 |
$ +pedestal_t(DSPn,nvk(js),nst(js)) |
$ nvk(is).gt.0.and. |
166 |
newVAL=max(0,newVAL) |
$ nvk(is).le.nva1_view.and. |
167 |
newVAL=min(4095,newVAL) |
$ nst(is).gt.0.and. |
168 |
|
$ nst(is).le.nstrips_va1.and. |
169 |
|
$ .true.)then |
170 |
|
newVAL=oldVAL |
171 |
|
$ -pedestal_t(DSPn,nvk(is),nst(is)) |
172 |
|
$ +pedestal_t(DSPn,nvk(js),nst(js)) |
173 |
|
newVAL=max(0,newVAL) |
174 |
|
newVAL=min(4095,newVAL) |
175 |
|
endif |
176 |
adc(DSPn,nvk(js),nst(js))=newVAL |
adc(DSPn,nvk(js),nst(js))=newVAL |
177 |
else |
else |
178 |
print*,'filladc -->' |
print*,'filladc -->' |
179 |
$ ,' attempt to access array elements (2)' |
$ ,' attempt to access array element (2) ' |
180 |
$ ,'(',DSPn,nvk(is),nst(is),')' |
c $ ,'(',DSPn,nvk(is),nst(is),')' |
181 |
$ ,'(',DSPn,nvk(js),nst(js),')' |
$ ,'pedestal_t(',DSPn,nvk(js),nst(js),')' |
182 |
|
c iflag=1 |
183 |
|
c if(DSPn.le.nviews)GOOD1(DSPn) = 10 |
184 |
endif |
endif |
185 |
c print*,DSPn,nvk(js),nst(js),newval |
c print*,DSPn,nvk(js),nst(js),newval |
186 |
|
|
189 |
is = iaddr |
is = iaddr |
190 |
prec_ind = 1 |
prec_ind = 1 |
191 |
else |
else |
192 |
if(debug)print*,'filladc --> address '// |
if(verbose)print*,'filladc --> address '// |
193 |
$ 'out of range - iaddr,is',iaddr,is |
$ 'out of range - iaddr,is',iaddr,is |
194 |
iflag=1 |
iflag=1 |
195 |
GOOD1(DSPn) = 10 |
GOOD1(DSPn) = 10 |
201 |
if(prec_ind.eq.0) is=is+1 |
if(prec_ind.eq.0) is=is+1 |
202 |
if(info.ge.0.and.info.le.4095) then |
if(info.ge.0.and.info.le.4095) then |
203 |
if(is.gt.3072)then |
if(is.gt.3072)then |
204 |
if(debug)print*, |
if(verbose)print*, |
205 |
$ 'filladc --> strip out of range - DSPn,is' |
$ 'filladc --> strip out of range - DSPn,is' |
206 |
$ ,DSPn,is |
$ ,DSPn,is |
207 |
iflag=1 |
iflag=1 |
224 |
|
|
225 |
oldVAL=newVAL |
oldVAL=newVAL |
226 |
else |
else |
227 |
if(debug) |
if(verbose) |
228 |
$ print*,'filladc --> datum out of range - info' |
$ print*,'filladc --> datum out of range - info' |
229 |
$ ,info |
$ ,info |
230 |
iflag=1 |
iflag=1 |
252 |
C++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
C++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
253 |
C--------------------------------------------full mode |
C--------------------------------------------full mode |
254 |
|
|
255 |
|
if(debug)print*,'DSP #',DSPn,' --> full ' |
256 |
|
|
257 |
do i=1,3 !loop over ladder |
do i=1,3 !loop over ladder |
258 |
do j=1,1024 !loop over strips |
do j=1,1024 !loop over strips |
259 |
idata = idata+1 |
idata = idata+1 |
260 |
|
if( idata.gt.NWORDMAX )goto 335 !go to end |
261 |
|
nword_DSP = nword_DSP +1 |
262 |
|
if( nword_DSP.gt.datalength(iv) )then |
263 |
|
if( verbose ) |
264 |
|
$ print*,'filladc --> missing end-of-ladder', |
265 |
|
$ ' in FULL mode - DSP ',DSPn |
266 |
|
if(verbose)print*,'datalength = ',datalength |
267 |
|
goto 334 !next view |
268 |
|
endif |
269 |
is=j+1024*(i-1) |
is=j+1024*(i-1) |
270 |
c adcadc=adc(DSPn,nvk(is),nst(is)) |
c adcadc=adc(DSPn,nvk(is),nst(is)) |
271 |
if( DSPn.le.nviews |
if( DSPn.le.nviews |
285 |
c endif |
c endif |
286 |
enddo !loop over strips |
enddo !loop over strips |
287 |
idata = idata+1 |
idata = idata+1 |
288 |
|
if( idata.gt.NWORDMAX )goto 335 !go to end |
289 |
|
nword_DSP = nword_DSP +1 |
290 |
|
if( nword_DSP.gt.datalength(iv) )then |
291 |
|
if( verbose ) |
292 |
|
$ print*,'filladc --> missing end-of-ladder', |
293 |
|
$ ' in FULL mode - DSP ',DSPn |
294 |
|
if(verbose)print*,'datalength = ',datalength |
295 |
|
goto 334 !next view |
296 |
|
endif |
297 |
if(datatracker(idata).ne.ior(z'1800',i+3)) then |
if(datatracker(idata).ne.ior(z'1800',i+3)) then |
298 |
if(debug) |
if(verbose) |
299 |
$ print*,'filladc --> ', |
$ print*,'filladc --> ', |
300 |
$ 'wrong end-of-ladder in FULL mode' |
$ 'wrong end-of-ladder in FULL mode' |
301 |
if(debug) |
if(verbose) |
302 |
$ print*,' word ',datatracker(idata) |
$ print*,' word ',datatracker(idata) |
303 |
if(debug) |
if(verbose) |
304 |
$ print*,' should be ',ior(z'1800',i+3) |
$ print*,' should be ',ior(z'1800',i+3) |
305 |
iflag=1 |
iflag=1 |
306 |
GOOD1(DSPn) = 10 |
GOOD1(DSPn) = 10 |
309 |
enddo!endl loop over ladder |
enddo!endl loop over ladder |
310 |
endif |
endif |
311 |
goto 334 |
goto 334 |
312 |
333 continue |
333 continue |
313 |
if(debug)print*,'filladc --> ',iv |
if(verbose)print*,'filladc --> ',iv |
314 |
$ ,'^ DSP packet missing or corrupted: ' |
$ ,'^ DSP packet missing or corrupted: ' |
315 |
$ ,'DSPn, datalength(iv) => ' |
$ ,'DSPn, datalength(iv) => ' |
316 |
$ ,DSPn,datalength(iv) |
$ ,DSPn,datalength(iv) |
317 |
334 continue |
334 continue |
318 |
enddo |
enddo |
319 |
|
goto 336 |
320 |
|
335 continue |
321 |
|
if(verbose)print*,'filladc --> reached end of buffer:', |
322 |
|
$ ' datatracker(',NWORDMAX,')' |
323 |
|
|
324 |
|
336 continue |
325 |
return |
return |
326 |
end |
end |
327 |
|
|