1 |
subroutine filladc !??? AGGIUSTARE TUTTO |
2 |
|
3 |
|
4 |
include '../common/commontracker.f' |
5 |
include '../common/level0.f' |
6 |
|
7 |
|
8 |
external nvk |
9 |
external nst |
10 |
|
11 |
real errflag |
12 |
|
13 |
integer*2 flag,tipo,info,prec_ind,word |
14 |
|
15 |
integer*2 newVAL,oldVAL |
16 |
data oldval/0/ |
17 |
|
18 |
integer DSPn |
19 |
|
20 |
c real tempadc(nstrips_view) !??? per inversione vista 11 |
21 |
|
22 |
|
23 |
c controllo DAQmode per capire se i dati sono compressi (=2) o full (=1) |
24 |
c se sono sia full che compressi (=3) prima vengono riempite le variabili |
25 |
c adc con la versione compressa, poi con quella full, che quindi e' |
26 |
c quella che viene poi effettivamente usata |
27 |
|
28 |
idata=0 !indice dell'array datatracker!??? |
29 |
|
30 |
do iv=1,nviews |
31 |
|
32 |
DSPn=DSPnumber(iv) |
33 |
|
34 |
|
35 |
if(iand(DAQmode(DSPn),z'0002').eq.z'0002') then ! compressed mode |
36 |
|
37 |
is = 0 |
38 |
il = 0 |
39 |
prec_ind = 0 |
40 |
222 continue |
41 |
idata = idata+1 |
42 |
word=datatracker(idata) |
43 |
|
44 |
call compdecode(word,flag,tipo,info,errflag) !routine per scomprimere |
45 |
|
46 |
if(errflag.ne.0.) then |
47 |
print*,'ERROR on compdecode' |
48 |
return |
49 |
endif |
50 |
if(flag.eq.1) then ! flag: fine messaggio |
51 |
if(info.ne.1.and.info.ne.2.and.info.ne.3) then |
52 |
print*,'ERROR on end of ladder',info,tipo |
53 |
endif |
54 |
il = info |
55 |
do js=is+1,1024*il |
56 |
newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is)) |
57 |
$ +pedestal_t(DSPn,nvk(js),nst(js)) |
58 |
newVAL=max(0,newVAL) |
59 |
newVAL=min(4095,newVAL) |
60 |
|
61 |
|
62 |
c print*,'comp1',nev0,iv,jss,idata !??? |
63 |
adc(DSPn,nvk(js),nst(js))=newVAL |
64 |
|
65 |
enddo |
66 |
|
67 |
if(info.eq.3) goto 1000 |
68 |
is=1024*il |
69 |
prec_ind=0 !il precedente non e' un indirizzo |
70 |
endif |
71 |
|
72 |
if(flag.eq.0) then ! flag: dato o indirizzo |
73 |
if(tipo.eq.1) then ! tipo: indirizzo |
74 |
iaddr = info + il*1024 |
75 |
if(iaddr.ge.is+1.and.iaddr.le.3072) then |
76 |
do js = is+1,iaddr-1 |
77 |
newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is)) |
78 |
$ +pedestal_t(DSPn,nvk(js),nst(js)) |
79 |
newVAL=max(0,newVAL) |
80 |
newVAL=min(4095,newVAL) |
81 |
|
82 |
|
83 |
|
84 |
c print*,'comp2',nev0,iv,jss,idata !??? |
85 |
adc(DSPn,nvk(js),nst(js))=newVAL |
86 |
|
87 |
enddo |
88 |
|
89 |
is = iaddr |
90 |
prec_ind = 1 |
91 |
else |
92 |
print*,'ERROR address |
93 |
$ out of range - iaddr,is',iaddr,is |
94 |
endif |
95 |
endif |
96 |
if(tipo.eq.0) then ! tipo: dato |
97 |
if(prec_ind.eq.0) is=is+1 |
98 |
if(info.ge.0.and.info.le.4095) then |
99 |
if(is.gt.3072) |
100 |
$ print*, |
101 |
$ 'ERROR strip out of range - DSPn,is',DSPn,is |
102 |
newVAL=info |
103 |
|
104 |
c print*,'comp3',nev0,iv,iss,idata !??? |
105 |
adc(DSPn,nvk(is),nst(is))=newVAL |
106 |
|
107 |
oldVAL=newVAL |
108 |
else |
109 |
print*,'ERROR datum out of range - info',info |
110 |
endif |
111 |
prec_ind=0 |
112 |
endif |
113 |
endif |
114 |
goto 222 |
115 |
endif |
116 |
|
117 |
1000 continue |
118 |
|
119 |
|
120 |
c$$$ print*,' ' |
121 |
c$$$ do ik=1,nva1_view |
122 |
c$$$ do is=1,nstrips_va1 |
123 |
c$$$ print*,iv,adc(iv,ik,is) !??? |
124 |
c$$$ enddo |
125 |
c$$$ enddo |
126 |
c$$$ |
127 |
|
128 |
|
129 |
if(iand(DAQmode(DSPn),z'0001').eq.z'0001') then ! full mode |
130 |
do i=1,3 |
131 |
do j=1,1024 |
132 |
idata = idata+1 |
133 |
is=j+1024*(i-1) |
134 |
|
135 |
|
136 |
|
137 |
c print*,'full',nev0,iv,is,idata !??? |
138 |
|
139 |
adc(DSPn,nvk(is),nst(is)) = datatracker(idata) |
140 |
|
141 |
c print*,iv,DSPn,nvk(is),nst(is),is,datatracker(idata) !??? |
142 |
|
143 |
enddo |
144 |
idata = idata+1 |
145 |
if(datatracker(idata).ne.ior(z'1800',i+3)) then |
146 |
print*,'ERROR on ladder label end',datatracker(idata), |
147 |
$ ior(z'1800',i+3) |
148 |
endif |
149 |
enddo |
150 |
endif |
151 |
|
152 |
|
153 |
|
154 |
c$$$ print*,' ' !??? |
155 |
c$$$ do ik=1,nva1_view |
156 |
c$$$ do is=1,nstrips_va1 |
157 |
c$$$ c print*,iv,ik,is,adc(iv,ik,is),adc1(iv,ik,is) !??? |
158 |
c$$$ print*,iv,ik,is,adc(iv,ik,is),adc1(iv,ik,is) |
159 |
c$$$ $ ,(adc(iv,ik,is)-adc1(iv,ik,is))/sigma_t !??? |
160 |
c$$$ enddo |
161 |
c$$$ enddo |
162 |
|
163 |
|
164 |
enddo |
165 |
|
166 |
c$$$C |
167 |
c$$$C inversione vista 11 !??? |
168 |
c$$$C |
169 |
c$$$ do is=1,nstrips_view |
170 |
c$$$ tempadc(is) = adc(11,nvk(is),nst(is)) |
171 |
c$$$ enddo |
172 |
c$$$ |
173 |
c$$$ |
174 |
c$$$ do is=1,nstrips_view |
175 |
c$$$ offset=5121 |
176 |
c$$$ if(is.le.2048) offset=3073 |
177 |
c$$$ if(is.le.1024) offset=1025 |
178 |
c$$$ iss=offset-is |
179 |
c$$$ |
180 |
c$$$ adc(11,nvk(iss),nst(iss)) = tempadc(is) |
181 |
c$$$ enddo |
182 |
C |
183 |
C fine inversione vista 11 !??? |
184 |
C |
185 |
|
186 |
|
187 |
return |
188 |
end |
189 |
|
190 |
|
191 |
|
192 |
c qui o nelle functions.f??? |
193 |
|
194 |
SUBROUTINE COMPDECODE(word,flag,tipo,info,errflag) |
195 |
INTEGER*2 word,flag,tipo,info |
196 |
|
197 |
errflag=0. |
198 |
flag=iand(word,z'f000') |
199 |
flag=ishft(flag,-12) |
200 |
|
201 |
if(flag.ne.0.and.flag.ne.1) then |
202 |
print*,'error on decompression: flag=',flag |
203 |
errflag=1. |
204 |
endif |
205 |
if(flag.eq.0) then ! valore ADC |
206 |
tipo=0 |
207 |
info=iand(word,z'0fff') |
208 |
endif |
209 |
if(flag.eq.1) then ! indirizzo OR fine vista |
210 |
info=iand(word,z'03ff') |
211 |
tipo=iand(word,z'0c00') |
212 |
if(tipo.ne.0.and.tipo.ne.z'0800') then |
213 |
print*,'error on decompression: tipo=',tipo |
214 |
errflag=1. |
215 |
endif |
216 |
if(tipo.eq.0) then ! indirizzo |
217 |
flag=0 |
218 |
tipo=1 |
219 |
info=info+1 |
220 |
endif |
221 |
if(tipo.eq.z'0800') then ! fine vista |
222 |
flag=1 |
223 |
if(info.eq.3.or.info.eq.6) then |
224 |
tipo=1 |
225 |
else |
226 |
tipo=0 |
227 |
endif |
228 |
endif |
229 |
endif |
230 |
return |
231 |
end |