/[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.5 by pam-fi, Fri Sep 29 08:13:04 2006 UTC revision 1.9 by pam-fi, Tue Aug 7 13:56:29 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 44  C     or the data buffer is empty Line 43  C     or the data buffer is empty
43  C     jump to next view  C     jump to next view
44  C     ---------------------------  C     ---------------------------
45    
46             nword_DSP = 0
47           if(DSPn.eq.0           if(DSPn.eq.0
48         $        .or.DSPn.gt.nviews
49       $        .or.datalength(iv).eq.0)goto 333       $        .or.datalength(iv).eq.0)goto 333
50            
51  C++++++++++++++++++++++++++++++++++++++++++++++++++++++  C++++++++++++++++++++++++++++++++++++++++++++++++++++++
52           if(  iand(DAQmode(iv),z'0003').eq.z'0002'.or.           if(  iand(DAQmode(iv),z'0003').eq.z'0002'.or.
53       $        iand(DAQmode(iv),z'0003').eq.z'0003'.or.       $        iand(DAQmode(iv),z'0003').eq.z'0003'.or.
# Line 54  C+++++++++++++++++++++++++++++++++++++++ Line 55  C+++++++++++++++++++++++++++++++++++++++
55       $        .false.) then       $        .false.) then
56  C++++++++++++++++++++++++++++++++++++++++++++++++++++++  C++++++++++++++++++++++++++++++++++++++++++++++++++++++
57  C--------------------------------------compressed mode  C--------------------------------------compressed mode
58                if(debug)print*,'DSP #',DSPn,' --> compressed '
59              is = 0              is = 0
60              il = 0              il = 0
61              prec_ind = 0              prec_ind = 0
62   222        continue   222        continue
63              idata = idata+1              idata = idata+1
64              word=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)
81                            
82              if(errflag.ne.0.) then              if(errflag.ne.0.) then
83                 if(verbose)print*,'filladc --> ERROR on compdecode'                 if(debug)print*,'filladc --> ERROR on compdecode'
84                 iflag=1                 iflag=1
85                 GOOD1(DSPn) = 10  c               GOOD1(DSPn) = 10
86    c               GOOD1(DSPn) = GOOD1(DSPn) + 2**4
87                   GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
88  c               return  c               return
89                 goto 221                 goto 221
90              endif              endif
# Line 76  c               return Line 92  c               return
92              if(flag.eq.1) then  !   flag: fine messaggio (ladder)              if(flag.eq.1) then  !   flag: fine messaggio (ladder)
93                                
94                 if(info.ne.1.and.info.ne.2.and.info.ne.3) then                 if(info.ne.1.and.info.ne.2.and.info.ne.3) then
95                    if(verbose)print*,                    if(debug)print*,
96       $                 'filladc --> wrong end-of-ladder '       $                 'filladc --> wrong end-of-ladder '
97       $                 //'in COMPRESSED mode'       $                 //'in COMPRESSED mode'
98                    if(verbose)print*,                    if(debug)print*,
99       $                 '            info(=ladder) ',info,'  type ',tipo       $                 '            info(=ladder) ',info,'  type ',tipo
100                    iflag=1                    iflag=1
101                    GOOD1(DSPn) = 10  c                  GOOD1(DSPn) = 10
102    c               GOOD1(DSPn) = GOOD1(DSPn) + 2**4
103                   GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
104  c                  return  c                  return
105                    goto 221                    goto 221
106                 endif                 endif
# Line 90  c                  return Line 108  c                  return
108                 il = info                 il = info
109                 do js=is+1,1024*il                 do js=is+1,1024*il
110                                        
111                    if(       DSPn.le.nviews                    if( DSPn.le.nviews
112         $                 .and.nvk(js).gt.0
113       $                 .and.nvk(js).le.nva1_view       $                 .and.nvk(js).le.nva1_view
114         $                 .and.nst(js).gt.0
115       $                 .and.nst(js).le.nstrips_va1       $                 .and.nst(js).le.nstrips_va1
      $                 .and.nvk(is).le.nva1_view  
      $                 .and.nst(is).le.nstrips_va1  
116       $                 )then       $                 )then
117    
118                       newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is))                       newVAL = 0
119       $                    +pedestal_t(DSPn,nvk(js),nst(js))                       if(  
120                       newVAL=max(0,newVAL)       $                    nvk(is).gt.0.and.
121                       newVAL=min(4095,newVAL)       $                    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                       adc(DSPn,nvk(js),nst(js))=newVAL
131                    else                    else                    
132                       print*,'filladc -->'                       print*,'filladc -->'
133       $                    ,' attempt to access array elements (1)'       $                    ,' attempt to access array element (1)'
134       $                    ,'(',DSPn,nvk(is),nst(is),')'  c     $                    ,'(',DSPn,nvk(is),nst(is),')'
135       $                    ,'(',DSPn,nvk(js),nst(js),')'       $                    ,'pedestal_t(',DSPn,nvk(js),nst(js),')'
136                    endif                    endif
137  c$$$  print*,DSPn,nvk(js),nst(js)  c$$$  print*,DSPn,nvk(js),nst(js)
138  c$$$  $             ,pedestal_t(DSPn,nvk(js),nst(js)),newval  c$$$  $             ,pedestal_t(DSPn,nvk(js),nst(js)),newval
# Line 123  c$$$  $             ,pedestal(DSPn,nvk(j Line 149  c$$$  $             ,pedestal(DSPn,nvk(j
149                 if(tipo.eq.1) then ! tipo: indirizzo                 if(tipo.eq.1) then ! tipo: indirizzo
150                    iaddr = info + il*1024                    iaddr = info + il*1024
151                    if(iaddr.ge.is+1.and.iaddr.le.3072) then                    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                       do js = is+1,iaddr-1
163    
164                          if(       DSPn.le.nviews                          if( DSPn.le.nviews
165         $                       .and.nvk(js).gt.0
166       $                       .and.nvk(js).le.nva1_view       $                       .and.nvk(js).le.nva1_view
167         $                       .and.nst(js).gt.0
168       $                       .and.nst(js).le.nstrips_va1       $                       .and.nst(js).le.nstrips_va1
      $                       .and.nvk(is).le.nva1_view  
      $                       .and.nst(is).le.nstrips_va1  
169       $                       )then       $                       )then
170                              
171                             newVAL=oldVAL                             newVAL = 0
172       $                          -pedestal_t(DSPn,nvk(is),nst(is))                             if(
173       $                          +pedestal_t(DSPn,nvk(js),nst(js))       $                          nvk(is).gt.0.and.
174                             newVAL=max(0,newVAL)       $                          nvk(is).le.nva1_view.and.
175                             newVAL=min(4095,newVAL)       $                          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                             adc(DSPn,nvk(js),nst(js))=newVAL
185                          else                          else
186                             print*,'filladc -->'                             print*,'filladc -->'
187       $                          ,' attempt to access array elements (2)'       $                          ,' attempt to access array element (2) '
188       $                          ,'(',DSPn,nvk(is),nst(is),')'  c     $                          ,'(',DSPn,nvk(is),nst(is),')'
189       $                          ,'(',DSPn,nvk(js),nst(js),')'       $                          ,'pedestal_t(',DSPn,nvk(js),nst(js),')'
190    c                           iflag=1
191    c                           if(DSPn.le.nviews)GOOD1(DSPn) = 10
192                          endif                          endif
193  c     print*,DSPn,nvk(js),nst(js),newval  c     print*,DSPn,nvk(js),nst(js),newval
194                                                    
# Line 151  c     print*,DSPn,nvk(js),nst(js),newval Line 197  c     print*,DSPn,nvk(js),nst(js),newval
197                       is = iaddr                       is = iaddr
198                       prec_ind = 1                       prec_ind = 1
199                    else                    else
200                       if(verbose)print*,'filladc --> address '//                       if(debug)print*,'filladc --> address '//
201       $                    'out of range - iaddr,is',iaddr,is       $                    'out of range - iaddr,is',iaddr,is
202                       iflag=1                       iflag=1
203                       GOOD1(DSPn) = 10  c                     GOOD1(DSPn) = 10
204    c                     GOOD1(DSPn) = GOOD1(DSPn) + 2**4
205                         GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
206  c                     return  c                     return
207                       goto 221                       goto 221
208                    endif                    endif
# Line 163  c                     return Line 211  c                     return
211                    if(prec_ind.eq.0) is=is+1                    if(prec_ind.eq.0) is=is+1
212                    if(info.ge.0.and.info.le.4095) then                    if(info.ge.0.and.info.le.4095) then
213                       if(is.gt.3072)then                       if(is.gt.3072)then
214                          if(verbose)print*,                          if(debug)print*,
215       $                       'filladc --> strip out of range - DSPn,is'       $                       'filladc --> strip out of range - DSPn,is'
216       $                       ,DSPn,is       $                       ,DSPn,is
217                          iflag=1                          iflag=1
218                          GOOD1(DSPn) = 10  c                        GOOD1(DSPn) = 10
219    c                        GOOD1(DSPn) = GOOD1(DSPn) + 2**4
220                            GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
221  c                        return  c                        return
222                          goto 221                          goto 221
223    
# Line 186  ccc   print*,DSPn,nvk(is),nst(is),newval Line 236  ccc   print*,DSPn,nvk(is),nst(is),newval
236                                            
237                       oldVAL=newVAL                       oldVAL=newVAL
238                    else                    else
239                       if(verbose)                       if(debug)
240       $                    print*,'filladc --> datum out of range - info'       $                    print*,'filladc --> datum out of range - info'
241       $                    ,info       $                    ,info
242                       iflag=1                       iflag=1
243                       GOOD1(DSPn) = 10  c                     GOOD1(DSPn) = 10
244    c                     GOOD1(DSPn) = GOOD1(DSPn) + 2**4
245                         GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
246  c                     return  c                     return
247                       goto 221                       goto 221
248                    endif                    endif
# Line 214  c     if(iand(DAQmode(iv),z'0001').eq.z' Line 266  c     if(iand(DAQmode(iv),z'0001').eq.z'
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              do i=1,3            !loop over ladder
272                 do j=1,1024      !loop over strips                 do j=1,1024      !loop over strips
273                    idata = idata+1                    idata = idata+1
274                      if( idata.gt.NWORDMAX )goto 335 !go to end
275                      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)                    is=j+1024*(i-1)
284  c     adcadc=adc(DSPn,nvk(is),nst(is))  c     adcadc=adc(DSPn,nvk(is),nst(is))
285                    if(       DSPn.le.nviews                    if(       DSPn.le.nviews
# Line 237  c     $                    ' ---- ',adc( Line 299  c     $                    ' ---- ',adc(
299  c     endif  c     endif
300                 enddo            !loop over strips                 enddo            !loop over strips
301                 idata = idata+1                 idata = idata+1
302                   if( idata.gt.NWORDMAX )goto 335 !go to end
303                   nword_DSP = nword_DSP +1
304                   if(  nword_DSP.gt.datalength(iv) )then
305                      if( debug )
306         $                 print*,'filladc --> missing end-of-ladder',
307         $                 ' in FULL mode - DSP ',DSPn
308                      if(debug)print*,'datalength = ',datalength
309                      goto 334      !next view
310                   endif
311                 if(datatracker(idata).ne.ior(z'1800',i+3)) then                 if(datatracker(idata).ne.ior(z'1800',i+3)) then
312                    if(verbose)                    if(debug)
313       $                 print*,'filladc --> ',       $                 print*,'filladc --> ',
314       $                 'wrong end-of-ladder in FULL mode'       $                 'wrong end-of-ladder in FULL mode'
315                    if(verbose)                    if(debug)
316       $                 print*,'            word ',datatracker(idata)       $                 print*,'            word ',datatracker(idata)
317                    if(verbose)                    if(debug)
318       $                 print*,'            should be ',ior(z'1800',i+3)       $                 print*,'            should be ',ior(z'1800',i+3)
319                    iflag=1                    iflag=1
320                    GOOD1(DSPn) = 10  c                  GOOD1(DSPn) = 10
321    c                  GOOD1(DSPn) = GOOD1(DSPn) + 2**4
322                      GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
323  c                  return                    c                  return                  
324                 endif                 endif
325              enddo!endl loop over ladder              enddo!endl loop over ladder
326           endif           endif
327           goto 334           goto 334
328   333  continue   333     continue
329        if(verbose)print*,'filladc --> ',iv           if(debug)print*,'filladc --> ',iv
330       $     ,'^ DSP packet missing or corrupted: '       $        ,'^ DSP packet missing or corrupted: '
331       $     ,'DSPn, datalength(iv) => '       $        ,'DSPn, datalength(iv) => '
332       $     ,DSPn,datalength(iv)       $        ,DSPn,datalength(iv)
333   334  continue   334     continue
334        enddo        enddo
335                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    
# Line 285  C--------------------------------------- Line 363  C---------------------------------------
363    
364        if(flag.ne.0.and.flag.ne.1) then        if(flag.ne.0.and.flag.ne.1) then
365  c        print*,'compdecode --> error on uncompression: flag=',flag  c        print*,'compdecode --> error on uncompression: flag=',flag
366          errflag=1.           errflag=1.
367        endif        endif
368        if(flag.eq.0) then        ! valore ADC        if(flag.eq.0) then        ! valore ADC
369          tipo=0           tipo=0
370          info=iand(word,z'0fff')           info=iand(word,z'0fff')
371        endif        endif
372        if(flag.eq.1) then        ! indirizzo OR fine vista        if(flag.eq.1) then        ! indirizzo OR fine vista
373          info=iand(word,z'03ff')          info=iand(word,z'03ff')
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.23