/[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.2 - (hide 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 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 pam-fi 1.2 if(debug)print*,'filladc --> ERROR on compdecode'
67 mocchiut 1.1 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 pam-fi 1.2 if(debug)print*,
75 mocchiut 1.1 $ 'filladc --> wrong end-of-ladder '
76     $ //'in COMPRESSED mode'
77 pam-fi 1.2 if(debug)print*,
78 mocchiut 1.1 $ ' 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 pam-fi 1.2 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 mocchiut 1.1 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 pam-fi 1.2 if(debug)print*,'filladc --> address '//
120 mocchiut 1.1 $ '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 pam-fi 1.2 if(debug)print*,
130 mocchiut 1.1 $ '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 pam-fi 1.2 if(debug)
143     $ print*,'filladc --> datum out of range - info',info
144 mocchiut 1.1 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 pam-fi 1.2 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 mocchiut 1.1 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 pam-fi 1.2 c print*,'compdecode --> error on uncompression: flag=',flag
223 mocchiut 1.1 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 pam-fi 1.2 c print*,'compdecode --> error on decompression: tipo=',tipo
234 mocchiut 1.1 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