/[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.2 - (show annotations) (download)
Tue May 30 16:30:37 2006 UTC (18 years, 6 months ago) by pam-fi
Branch: MAIN
CVS Tags: v0r02, v1r01beta, v1r00, v1r01
Changes since 1.1: +18 -12 lines
Error handling from F77 routine / Fixed some bugs with default calibration

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

  ViewVC Help
Powered by ViewVC 1.1.23