/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/filladc.f
ViewVC logotype

Contents of /DarthVader/TrackerLevel2/src/F77/filladc.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations) (download)
Tue Sep 5 12:52:21 2006 UTC (18 years, 4 months ago) by pam-fi
Branch: MAIN
CVS Tags: v2r00BETA
Changes since 1.2: +4 -1 lines
implemented class TrkLevel1

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

  ViewVC Help
Powered by ViewVC 1.1.23