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