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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide annotations) (download) (vendor branch)
Fri May 19 13:15:55 2006 UTC (18 years, 6 months ago) by mocchiut
Branch: DarthVader
CVS Tags: v0r01, start
Changes since 1.1: +0 -0 lines
Imported sources

1 mocchiut 1.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     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     print*,
75     $ 'filladc --> wrong end-of-ladder '
76     $ //'in COMPRESSED mode'
77     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     ccc print*,DSPn,nvk(js),nst(js),newval
91     enddo
92    
93     if(info.eq.3) goto 1000
94    
95     is=1024*il
96     prec_ind=0 !il precedente non e' un indirizzo
97     endif
98    
99     if(flag.eq.0) then ! flag: dato o indirizzo
100     if(tipo.eq.1) then ! tipo: indirizzo
101     iaddr = info + il*1024
102     if(iaddr.ge.is+1.and.iaddr.le.3072) then
103     do js = is+1,iaddr-1
104     newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is))
105     $ +pedestal_t(DSPn,nvk(js),nst(js))
106     newVAL=max(0,newVAL)
107     newVAL=min(4095,newVAL)
108    
109     adc(DSPn,nvk(js),nst(js))=newVAL
110     c print*,DSPn,nvk(js),nst(js),newval
111    
112     enddo
113    
114     is = iaddr
115     prec_ind = 1
116     else
117     print*,'filladc --> address '//
118     $ 'out of range - iaddr,is',iaddr,is
119     iflag=1
120     return
121     endif
122     endif
123     if(tipo.eq.0) then ! tipo: dato
124     if(prec_ind.eq.0) is=is+1
125     if(info.ge.0.and.info.le.4095) then
126     if(is.gt.3072)then
127     print*,
128     $ 'filladc --> strip out of range - DSPn,is'
129     $ ,DSPn,is
130     iflag=1
131     return
132     endif
133     newVAL=info
134    
135     adc(DSPn,nvk(is),nst(is))=newVAL
136     ccc print*,DSPn,nvk(is),nst(is),newval
137    
138     oldVAL=newVAL
139     else
140     print*,'filladc --> datum out of range - info',info
141     iflag=1
142     return
143     endif
144     prec_ind=0
145     endif
146     endif
147     goto 222
148     endif
149    
150     1000 continue
151    
152    
153     C++++++++++++++++++++++++++++++++++++++++++++++++++++++
154     c if(iand(DAQmode(iv),z'0001').eq.z'0001') then
155     if(iand(DAQmode(iv),z'0003').eq.z'0001'.or. !full
156     $ iand(DAQmode(iv),z'0003').eq.z'0003'.or. !comp+full
157     $ (iand(DAQmode(iv),z'0003').eq.z'0000' !special
158     $ .and.mod(DSPn+ievent,2).eq.1).or.
159     $ .false.) then
160     C++++++++++++++++++++++++++++++++++++++++++++++++++++++
161     C--------------------------------------------full mode
162    
163    
164     do i=1,3
165     do j=1,1024
166     idata = idata+1
167     is=j+1024*(i-1)
168     c adcadc=adc(DSPn,nvk(is),nst(is))
169     adc(DSPn,nvk(is),nst(is)) = datatracker(idata)
170    
171     c if(iand(DAQmode(iv),z'0002').eq.z'0002') then
172     c diff=adc(DSPn,nvk(is),nst(is))-adcadc
173     c if(abs(diff).gt.0)
174     c $ print*,DSPn,is,adcadc,
175     c $ ' ---- ',adc(DSPn,nvk(is),nst(is)),diff
176     c endif
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