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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by pam-fi, Tue Sep 5 12:52:21 2006 UTC revision 1.7 by pam-fi, Thu Mar 15 12:17:10 2007 UTC
# Line 9  Line 9 
9    
10        include 'common_reduction.f'        include 'common_reduction.f'
11    
   
12        external nvk        external nvk
13        external nst        external nst
14    
# Line 32  C     in the third case ADC is filled wi Line 31  C     in the third case ADC is filled wi
31  C---------------------------------------------------------  C---------------------------------------------------------
32    
33        idata=0                   !datatracker array index        idata=0                   !datatracker array index
34    
35        do iv=1,nviews        do iv=1,nviews
36          DSPn=DSPnumber(iv)  
37          ievent=eventn(iv)           DSPn   = DSPnumber(iv)
38             ievent = eventn(iv)
39                    
40  C     ---------------------------  C     ---------------------------
41  C     if the iv view is missing  C     if the iv view is missing
42  C     or the data buffer is empty  C     or the data buffer is empty
43  C     jump to end  C     jump to next view
44  C     ---------------------------  C     ---------------------------
         if(DSPn.eq.0  
      $       .or.datalength(iv).eq.0)goto 333  
45    
46             nword_DSP = 0
47             if(DSPn.eq.0
48         $        .or.DSPn.gt.nviews
49         $        .or.datalength(iv).eq.0)goto 333
50    
51  C++++++++++++++++++++++++++++++++++++++++++++++++++++++  C++++++++++++++++++++++++++++++++++++++++++++++++++++++
52  c     if(iand(DAQmode(iv),z'0002').eq.z'0002') then           if(  iand(DAQmode(iv),z'0003').eq.z'0002'.or.
53          if(iand(DAQmode(iv),z'0003').eq.z'0002'.or.       $        iand(DAQmode(iv),z'0003').eq.z'0003'.or.
54       $       iand(DAQmode(iv),z'0003').eq.z'0003'.or.       $        iand(DAQmode(iv),z'0003').eq.z'0000'.or.
55       $       iand(DAQmode(iv),z'0003').eq.z'0000'.or.       $        .false.) then
      $       .false.) then  
56  C++++++++++++++++++++++++++++++++++++++++++++++++++++++  C++++++++++++++++++++++++++++++++++++++++++++++++++++++
57  C--------------------------------------compressed mode  C--------------------------------------compressed mode
58            is = 0              if(debug)print*,'DSP #',DSPn,' --> compressed '
59            il = 0              is = 0
60            prec_ind = 0              il = 0
61   222      continue              prec_ind = 0
62            idata = idata+1   222        continue
63            word=datatracker(idata)              idata = idata+1
64  c$$$          print*,'word(',idata,')= ',datatracker(idata)              if( idata.gt.NWORDMAX )goto 335 !end to end
65                nword_DSP = nword_DSP +1
66                if(  nword_DSP.gt.datalength(iv) )then
67                   if( verbose )print*,'filladc --> missing end-of-ladder',
68         $              ' in COMPRESSED mode - DSP ',DSPn
69                   if(verbose)print*,'datalength = ',datalength(iv)
70                   iflag=1
71                   GOOD1(DSPn) = 10
72                   goto 334         !next view
73                endif
74                word = datatracker(idata)
75  C------------------------------------------------------  C------------------------------------------------------
76  C     call routine to uncompress data  C     call routine to uncompress data
77  C------------------------------------------------------  C------------------------------------------------------
78            call compdecode(word,flag,tipo,info,errflag)              call compdecode(word,flag,tipo,info,errflag)
   
           if(errflag.ne.0.) then  
             if(debug)print*,'filladc --> ERROR on compdecode'  
             iflag=1  
             return  
           endif  
   
           if(flag.eq.1) then    !   flag: fine messaggio (ladder)  
   
             if(info.ne.1.and.info.ne.2.and.info.ne.3) then  
               if(debug)print*,  
      $             'filladc --> wrong end-of-ladder '  
      $             //'in COMPRESSED mode'  
               if(debug)print*,  
      $             '            info(=ladder) ',info,'  type ',tipo  
               iflag=1  
               return  
             endif  
79                            
80              il = info              if(errflag.ne.0.) then
81              do js=is+1,1024*il                 if(verbose)print*,'filladc --> ERROR on compdecode'
82                newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is))                 iflag=1
83       $             +pedestal_t(DSPn,nvk(js),nst(js))                 GOOD1(DSPn) = 10
84                newVAL=max(0,newVAL)  c               return
85                newVAL=min(4095,newVAL)                 goto 221
86                adc(DSPn,nvk(js),nst(js))=newVAL              endif
 c$$$              print*,DSPn,nvk(js),nst(js)  
 c$$$     $             ,pedestal_t(DSPn,nvk(js),nst(js)),newval  
 c$$$     $             ,pedestal(DSPn,nvk(js),nst(js))  
             enddo  
87                            
88              if(info.eq.3) goto 1000              if(flag.eq.1) then  !   flag: fine messaggio (ladder)
89                  
90                   if(info.ne.1.and.info.ne.2.and.info.ne.3) then
91                      if(verbose)print*,
92         $                 'filladc --> wrong end-of-ladder '
93         $                 //'in COMPRESSED mode'
94                      if(verbose)print*,
95         $                 '            info(=ladder) ',info,'  type ',tipo
96                      iflag=1
97                      GOOD1(DSPn) = 10
98    c                  return
99                      goto 221
100                   endif
101                  
102                   il = info
103                   do js=is+1,1024*il
104                      
105                      if( DSPn.le.nviews
106         $                 .and.nvk(js).gt.0
107         $                 .and.nvk(js).le.nva1_view
108         $                 .and.nst(js).gt.0
109         $                 .and.nst(js).le.nstrips_va1
110         $                 )then
111    
112                         newVAL = 0
113                         if(  
114         $                    nvk(is).gt.0.and.
115         $                    nvk(is).le.nva1_view.and.
116         $                    nst(is).gt.0.and.
117         $                    nst(is).le.nstrips_va1.and.
118         $                    .true.)then
119                            newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is))
120         $                       +pedestal_t(DSPn,nvk(js),nst(js))
121                            newVAL=max(0,newVAL)
122                            newVAL=min(4095,newVAL)
123                         endif
124                         adc(DSPn,nvk(js),nst(js))=newVAL
125                      else                    
126                         print*,'filladc -->'
127         $                    ,' attempt to access array element (1)'
128    c     $                    ,'(',DSPn,nvk(is),nst(is),')'
129         $                    ,'pedestal_t(',DSPn,nvk(js),nst(js),')'
130                      endif
131    c$$$  print*,DSPn,nvk(js),nst(js)
132    c$$$  $             ,pedestal_t(DSPn,nvk(js),nst(js)),newval
133    c$$$  $             ,pedestal(DSPn,nvk(js),nst(js))
134                   enddo
135                  
136                   if(info.eq.3) goto 1000
137                  
138                   is=1024*il
139                   prec_ind=0       !il precedente non e' un indirizzo
140                endif
141                            
142              is=1024*il              if(flag.eq.0) then  !  flag: dato o indirizzo
143              prec_ind=0          !il precedente non e' un indirizzo                 if(tipo.eq.1) then ! tipo: indirizzo
144            endif                    iaddr = info + il*1024
145                                if(iaddr.ge.is+1.and.iaddr.le.3072) then
146            if(flag.eq.0) then    !  flag: dato o indirizzo                      
147              if(tipo.eq.1) then  ! tipo: indirizzo                       if(is.eq.0.or.is.eq.1024.or.is.eq.2048)then
148                iaddr = info + il*1024                          if(verbose)print*,'filladc -->'
149                if(iaddr.ge.is+1.and.iaddr.le.3072) then       $                       ,' previous transmitted strip ',is
150                  do js = is+1,iaddr-1       $                       ,' - missing first ADC value'
151                    newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is))                          iflag=1
152       $                 +pedestal_t(DSPn,nvk(js),nst(js))                          GOOD1(DSPn) = 10
153                    newVAL=max(0,newVAL)                       endif
154                    newVAL=min(4095,newVAL)                       do js = is+1,iaddr-1
155    
156                    adc(DSPn,nvk(js),nst(js))=newVAL                          if( DSPn.le.nviews
157         $                       .and.nvk(js).gt.0
158         $                       .and.nvk(js).le.nva1_view
159         $                       .and.nst(js).gt.0
160         $                       .and.nst(js).le.nstrips_va1
161         $                       )then
162                              
163                               newVAL = 0
164                               if(
165         $                          nvk(is).gt.0.and.
166         $                          nvk(is).le.nva1_view.and.
167         $                          nst(is).gt.0.and.
168         $                          nst(is).le.nstrips_va1.and.
169         $                          .true.)then
170                                  newVAL=oldVAL
171         $                             -pedestal_t(DSPn,nvk(is),nst(is))
172         $                             +pedestal_t(DSPn,nvk(js),nst(js))
173                                  newVAL=max(0,newVAL)
174                                  newVAL=min(4095,newVAL)
175                               endif
176                               adc(DSPn,nvk(js),nst(js))=newVAL
177                            else
178                               print*,'filladc -->'
179         $                          ,' attempt to access array element (2) '
180    c     $                          ,'(',DSPn,nvk(is),nst(is),')'
181         $                          ,'pedestal_t(',DSPn,nvk(js),nst(js),')'
182    c                           iflag=1
183    c                           if(DSPn.le.nviews)GOOD1(DSPn) = 10
184                            endif
185  c     print*,DSPn,nvk(js),nst(js),newval  c     print*,DSPn,nvk(js),nst(js),newval
186                            
187                  enddo                       enddo
188                        
189                  is = iaddr                       is = iaddr
190                  prec_ind = 1                       prec_ind = 1
191                else                    else
192                  if(debug)print*,'filladc --> address '//                       if(verbose)print*,'filladc --> address '//
193       $               'out of range - iaddr,is',iaddr,is       $                    'out of range - iaddr,is',iaddr,is
194                  iflag=1                       iflag=1
195                  return                       GOOD1(DSPn) = 10
196                endif  c                     return
197              endif                       goto 221
198              if(tipo.eq.0) then  ! tipo: dato                      endif
199                if(prec_ind.eq.0) is=is+1                 endif
200                if(info.ge.0.and.info.le.4095) then                 if(tipo.eq.0) then ! tipo: dato  
201                  if(is.gt.3072)then                    if(prec_ind.eq.0) is=is+1
202                    if(debug)print*,                    if(info.ge.0.and.info.le.4095) then
203       $                 'filladc --> strip out of range - DSPn,is'                       if(is.gt.3072)then
204       $                 ,DSPn,is                          if(verbose)print*,
205                    iflag=1       $                       'filladc --> strip out of range - DSPn,is'
206                    return       $                       ,DSPn,is
207                  endif                          iflag=1
208                  newVAL=info                          GOOD1(DSPn) = 10
209                    c                        return
210                  adc(DSPn,nvk(is),nst(is))=newVAL                          goto 221
211    
212                         endif
213                         newVAL=info
214                        
215                         if(       DSPn.le.nviews
216         $                    .and.nvk(is).le.nva1_view
217         $                    .and.nst(is).le.nstrips_va1)then
218                            adc(DSPn,nvk(is),nst(is))=newVAL
219                         else
220                            print*,'filladc --> attempt to access ADC('
221         $                       ,DSPn,nvk(is),nst(is),')'
222                         endif
223  ccc   print*,DSPn,nvk(is),nst(is),newval  ccc   print*,DSPn,nvk(is),nst(is),newval
224                                        
225                  oldVAL=newVAL                       oldVAL=newVAL
226                else                    else
227                  if(debug)                       if(verbose)
228       $               print*,'filladc --> datum out of range - info',info       $                    print*,'filladc --> datum out of range - info'
229                  iflag=1       $                    ,info
230                  return                       iflag=1
231                endif                       GOOD1(DSPn) = 10
232                prec_ind=0  c                     return
233                         goto 221
234                      endif
235                      prec_ind=0
236                   endif
237              endif              endif
238            endif   221        continue
239            goto 222              goto 222
240          endif           endif
241            
242   1000   continue   1000    continue
243            
244    
245  C++++++++++++++++++++++++++++++++++++++++++++++++++++++  C++++++++++++++++++++++++++++++++++++++++++++++++++++++
246  c     if(iand(DAQmode(iv),z'0001').eq.z'0001') then  c     if(iand(DAQmode(iv),z'0001').eq.z'0001') then
247          if(iand(DAQmode(iv),z'0003').eq.z'0001'.or. !full           if(iand(DAQmode(iv),z'0003').eq.z'0001'.or. !full
248       $       iand(DAQmode(iv),z'0003').eq.z'0003'.or. !comp+full       $        iand(DAQmode(iv),z'0003').eq.z'0003'.or. !comp+full
249       $       (iand(DAQmode(iv),z'0003').eq.z'0000' !special       $        (iand(DAQmode(iv),z'0003').eq.z'0000' !special
250       $       .and.mod(DSPn+ievent,2).eq.1).or.       $        .and.mod(DSPn+ievent,2).eq.1).or.
251       $       .false.) then       $        .false.) then
252  C++++++++++++++++++++++++++++++++++++++++++++++++++++++  C++++++++++++++++++++++++++++++++++++++++++++++++++++++
253  C--------------------------------------------full mode  C--------------------------------------------full mode
254                
255                if(debug)print*,'DSP #',DSPn,' --> full '
256    
257                do i=1,3            !loop over ladder
258            do i=1,3                 do j=1,1024      !loop over strips
259              do j=1,1024                    idata = idata+1
260                idata = idata+1                    if( idata.gt.NWORDMAX )goto 335 !go to end
261                is=j+1024*(i-1)                    nword_DSP = nword_DSP +1
262                      if(  nword_DSP.gt.datalength(iv) )then
263                         if( verbose )
264         $                    print*,'filladc --> missing end-of-ladder',
265         $                    ' in FULL mode - DSP ',DSPn
266                         if(verbose)print*,'datalength = ',datalength
267                         goto 334   !next view
268                      endif
269                      is=j+1024*(i-1)
270  c     adcadc=adc(DSPn,nvk(is),nst(is))  c     adcadc=adc(DSPn,nvk(is),nst(is))
271                adc(DSPn,nvk(is),nst(is)) = datatracker(idata)                    if(       DSPn.le.nviews
272                       $                 .and.nvk(is).le.nva1_view
273         $                 .and.nst(is).le.nstrips_va1)then
274                         adc(DSPn,nvk(is),nst(is))= datatracker(idata)
275                      else
276                         print*,'filladc --> attempt to access ADC['
277         $                    ,DSPn,nvk(is),nst(is),']'
278                      endif
279                      
280  c     if(iand(DAQmode(iv),z'0002').eq.z'0002') then  c     if(iand(DAQmode(iv),z'0002').eq.z'0002') then
281  c     diff=adc(DSPn,nvk(is),nst(is))-adcadc  c     diff=adc(DSPn,nvk(is),nst(is))-adcadc
282  c     if(abs(diff).gt.0)  c     if(abs(diff).gt.0)
283  c     $                    print*,DSPn,is,adcadc,  c     $                    print*,DSPn,is,adcadc,
284  c     $                    ' ---- ',adc(DSPn,nvk(is),nst(is)),diff  c     $                    ' ---- ',adc(DSPn,nvk(is),nst(is)),diff
285  c     endif  c     endif
286              enddo                 enddo            !loop over strips
287              idata = idata+1                 idata = idata+1
288              if(datatracker(idata).ne.ior(z'1800',i+3)) then                 if( idata.gt.NWORDMAX )goto 335 !go to end
289                if(debug)                 nword_DSP = nword_DSP +1
290       $           print*,'filladc --> wrong end-of-ladder in FULL mode'                 if(  nword_DSP.gt.datalength(iv) )then
291                if(debug)                    if( verbose )
292       $           print*,'            word ',datatracker(idata)       $                 print*,'filladc --> missing end-of-ladder',
293                if(debug)       $                 ' in FULL mode - DSP ',DSPn
294       $           print*,'            should be ',ior(z'1800',i+3)                    if(verbose)print*,'datalength = ',datalength
295                iflag=1                    goto 334      !next view
296                return                                   endif
297              endif                 if(datatracker(idata).ne.ior(z'1800',i+3)) then
298            enddo                    if(verbose)
299          endif       $                 print*,'filladc --> ',
300         $                 'wrong end-of-ladder in FULL mode'
301                      if(verbose)
302         $                 print*,'            word ',datatracker(idata)
303                      if(verbose)
304         $                 print*,'            should be ',ior(z'1800',i+3)
305                      iflag=1
306                      GOOD1(DSPn) = 10
307    c                  return                  
308                   endif
309                enddo!endl loop over ladder
310             endif
311             goto 334
312     333     continue
313             if(verbose)print*,'filladc --> ',iv
314         $        ,'^ DSP packet missing or corrupted: '
315         $        ,'DSPn, datalength(iv) => '
316         $        ,DSPn,datalength(iv)
317     334     continue
318        enddo        enddo
319   333  continue        goto 336
320           335  continue
321          if(verbose)print*,'filladc --> reached end of buffer:',
322         $     ' datatracker(',NWORDMAX,')'
323    
324     336  continue
325        return        return
326        end        end
327    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.23