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