/[PAMELA software]/tracker/ground/source/reduction/filladc_orig.f
ViewVC logotype

Contents of /tracker/ground/source/reduction/filladc_orig.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations) (download)
Wed Mar 8 15:00:39 2006 UTC (18 years, 11 months ago) by pam-fi
Branch point for: MAIN, trk-ground
Initial revision

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

  ViewVC Help
Powered by ViewVC 1.1.23