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