/[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.3 - (hide annotations) (download)
Tue Sep 5 12:52:21 2006 UTC (18 years, 3 months ago) by pam-fi
Branch: MAIN
CVS Tags: v2r00BETA
Changes since 1.2: +4 -1 lines
implemented class TrkLevel1

1 mocchiut 1.1 subroutine filladc(iflag) !??? AGGIUSTARE TUTTO
2    
3    
4     include 'commontracker.f'
5     include 'level0.f'
6 pam-fi 1.3 include 'level1.f'
7 mocchiut 1.1 include 'calib.f'
8    
9    
10 pam-fi 1.3 include 'common_reduction.f'
11    
12    
13 mocchiut 1.1 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 pam-fi 1.2 if(debug)print*,'filladc --> ERROR on compdecode'
70 mocchiut 1.1 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 pam-fi 1.2 if(debug)print*,
78 mocchiut 1.1 $ 'filladc --> wrong end-of-ladder '
79     $ //'in COMPRESSED mode'
80 pam-fi 1.2 if(debug)print*,
81 mocchiut 1.1 $ ' 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 pam-fi 1.2 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 mocchiut 1.1 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 pam-fi 1.2 if(debug)print*,'filladc --> address '//
123 mocchiut 1.1 $ '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 pam-fi 1.2 if(debug)print*,
133 mocchiut 1.1 $ '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 pam-fi 1.2 if(debug)
146     $ print*,'filladc --> datum out of range - info',info
147 mocchiut 1.1 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 pam-fi 1.2 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 mocchiut 1.1 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 pam-fi 1.2 c print*,'compdecode --> error on uncompression: flag=',flag
226 mocchiut 1.1 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 pam-fi 1.2 c print*,'compdecode --> error on decompression: tipo=',tipo
237 mocchiut 1.1 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