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

Annotation of /tracker/ground/source/reduction/filladc.f

Parent Directory Parent Directory | Revision Log Revision Log


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

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

  ViewVC Help
Powered by ViewVC 1.1.23