/[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.5 by pam-fi, Fri Sep 29 08:13:04 2006 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    
13        external nvk        external nvk
14        external nst        external nst
15    
# Line 29  C     in the third case ADC is filled wi Line 32  C     in the third case ADC is filled wi
32  C---------------------------------------------------------  C---------------------------------------------------------
33    
34        idata=0                   !datatracker array index        idata=0                   !datatracker array index
35    
36        do iv=1,nviews        do iv=1,nviews
37          DSPn=DSPnumber(iv)  
38          ievent=eventn(iv)           DSPn   = DSPnumber(iv)
39             ievent = eventn(iv)
40                    
41  C     ---------------------------  C     ---------------------------
42  C     if the iv view is missing  C     if the iv view is missing
43  C     or the data buffer is empty  C     or the data buffer is empty
44  C     jump to end  C     jump to next view
45  C     ---------------------------  C     ---------------------------
         if(DSPn.eq.0  
      $       .or.datalength(iv).eq.0)goto 333  
   
46    
47             if(DSPn.eq.0
48         $        .or.datalength(iv).eq.0)goto 333
49            
50  C++++++++++++++++++++++++++++++++++++++++++++++++++++++  C++++++++++++++++++++++++++++++++++++++++++++++++++++++
51  c     if(iand(DAQmode(iv),z'0002').eq.z'0002') then           if(  iand(DAQmode(iv),z'0003').eq.z'0002'.or.
52          if(iand(DAQmode(iv),z'0003').eq.z'0002'.or.       $        iand(DAQmode(iv),z'0003').eq.z'0003'.or.
53       $       iand(DAQmode(iv),z'0003').eq.z'0003'.or.       $        iand(DAQmode(iv),z'0003').eq.z'0000'.or.
54       $       iand(DAQmode(iv),z'0003').eq.z'0000'.or.       $        .false.) then
      $       .false.) then  
55  C++++++++++++++++++++++++++++++++++++++++++++++++++++++  C++++++++++++++++++++++++++++++++++++++++++++++++++++++
56  C--------------------------------------compressed mode  C--------------------------------------compressed mode
57            is = 0              is = 0
58            il = 0              il = 0
59            prec_ind = 0              prec_ind = 0
60   222      continue   222        continue
61            idata = idata+1              idata = idata+1
62            word=datatracker(idata)              word=datatracker(idata)
 c$$$          print*,'word(',idata,')= ',datatracker(idata)  
63  C------------------------------------------------------  C------------------------------------------------------
64  C     call routine to uncompress data  C     call routine to uncompress data
65  C------------------------------------------------------  C------------------------------------------------------
66            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  
67                            
68              il = info              if(errflag.ne.0.) then
69              do js=is+1,1024*il                 if(verbose)print*,'filladc --> ERROR on compdecode'
70                newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is))                 iflag=1
71       $             +pedestal_t(DSPn,nvk(js),nst(js))                 GOOD1(DSPn) = 10
72                newVAL=max(0,newVAL)  c               return
73                newVAL=min(4095,newVAL)                 goto 221
74                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  
75                            
76              if(info.eq.3) goto 1000              if(flag.eq.1) then  !   flag: fine messaggio (ladder)
77                  
78                   if(info.ne.1.and.info.ne.2.and.info.ne.3) then
79                      if(verbose)print*,
80         $                 'filladc --> wrong end-of-ladder '
81         $                 //'in COMPRESSED mode'
82                      if(verbose)print*,
83         $                 '            info(=ladder) ',info,'  type ',tipo
84                      iflag=1
85                      GOOD1(DSPn) = 10
86    c                  return
87                      goto 221
88                   endif
89                  
90                   il = info
91                   do js=is+1,1024*il
92                      
93                      if(       DSPn.le.nviews
94         $                 .and.nvk(js).le.nva1_view
95         $                 .and.nst(js).le.nstrips_va1
96         $                 .and.nvk(is).le.nva1_view
97         $                 .and.nst(is).le.nstrips_va1
98         $                 )then
99    
100                         newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is))
101         $                    +pedestal_t(DSPn,nvk(js),nst(js))
102                         newVAL=max(0,newVAL)
103                         newVAL=min(4095,newVAL)
104                         adc(DSPn,nvk(js),nst(js))=newVAL
105                      else
106                         print*,'filladc -->'
107         $                    ,' attempt to access array elements (1)'
108         $                    ,'(',DSPn,nvk(is),nst(is),')'
109         $                    ,'(',DSPn,nvk(js),nst(js),')'
110                      endif
111    c$$$  print*,DSPn,nvk(js),nst(js)
112    c$$$  $             ,pedestal_t(DSPn,nvk(js),nst(js)),newval
113    c$$$  $             ,pedestal(DSPn,nvk(js),nst(js))
114                   enddo
115                  
116                   if(info.eq.3) goto 1000
117                  
118                   is=1024*il
119                   prec_ind=0       !il precedente non e' un indirizzo
120                endif
121                            
122              is=1024*il              if(flag.eq.0) then  !  flag: dato o indirizzo
123              prec_ind=0          !il precedente non e' un indirizzo                 if(tipo.eq.1) then ! tipo: indirizzo
124            endif                    iaddr = info + il*1024
125                                if(iaddr.ge.is+1.and.iaddr.le.3072) then
126            if(flag.eq.0) then    !  flag: dato o indirizzo                       do js = is+1,iaddr-1
127              if(tipo.eq.1) then  ! tipo: indirizzo  
128                iaddr = info + il*1024                          if(       DSPn.le.nviews
129                if(iaddr.ge.is+1.and.iaddr.le.3072) then       $                       .and.nvk(js).le.nva1_view
130                  do js = is+1,iaddr-1       $                       .and.nst(js).le.nstrips_va1
131                    newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is))       $                       .and.nvk(is).le.nva1_view
132       $                 +pedestal_t(DSPn,nvk(js),nst(js))       $                       .and.nst(is).le.nstrips_va1
133                    newVAL=max(0,newVAL)       $                       )then
134                    newVAL=min(4095,newVAL)  
135                               newVAL=oldVAL
136                    adc(DSPn,nvk(js),nst(js))=newVAL       $                          -pedestal_t(DSPn,nvk(is),nst(is))
137         $                          +pedestal_t(DSPn,nvk(js),nst(js))
138                               newVAL=max(0,newVAL)
139                               newVAL=min(4095,newVAL)
140                               adc(DSPn,nvk(js),nst(js))=newVAL
141                            else
142                               print*,'filladc -->'
143         $                          ,' attempt to access array elements (2)'
144         $                          ,'(',DSPn,nvk(is),nst(is),')'
145         $                          ,'(',DSPn,nvk(js),nst(js),')'
146                            endif
147  c     print*,DSPn,nvk(js),nst(js),newval  c     print*,DSPn,nvk(js),nst(js),newval
148                            
149                  enddo                       enddo
150                        
151                  is = iaddr                       is = iaddr
152                  prec_ind = 1                       prec_ind = 1
153                else                    else
154                  if(debug)print*,'filladc --> address '//                       if(verbose)print*,'filladc --> address '//
155       $               'out of range - iaddr,is',iaddr,is       $                    'out of range - iaddr,is',iaddr,is
156                  iflag=1                       iflag=1
157                  return                       GOOD1(DSPn) = 10
158                endif  c                     return
159              endif                       goto 221
160              if(tipo.eq.0) then  ! tipo: dato                      endif
161                if(prec_ind.eq.0) is=is+1                 endif
162                if(info.ge.0.and.info.le.4095) then                 if(tipo.eq.0) then ! tipo: dato  
163                  if(is.gt.3072)then                    if(prec_ind.eq.0) is=is+1
164                    if(debug)print*,                    if(info.ge.0.and.info.le.4095) then
165       $                 'filladc --> strip out of range - DSPn,is'                       if(is.gt.3072)then
166       $                 ,DSPn,is                          if(verbose)print*,
167                    iflag=1       $                       'filladc --> strip out of range - DSPn,is'
168                    return       $                       ,DSPn,is
169                  endif                          iflag=1
170                  newVAL=info                          GOOD1(DSPn) = 10
171                    c                        return
172                  adc(DSPn,nvk(is),nst(is))=newVAL                          goto 221
173    
174                         endif
175                         newVAL=info
176                        
177                         if(       DSPn.le.nviews
178         $                    .and.nvk(is).le.nva1_view
179         $                    .and.nst(is).le.nstrips_va1)then
180                            adc(DSPn,nvk(is),nst(is))=newVAL
181                         else
182                            print*,'filladc --> attempt to access ADC('
183         $                       ,DSPn,nvk(is),nst(is),')'
184                         endif
185  ccc   print*,DSPn,nvk(is),nst(is),newval  ccc   print*,DSPn,nvk(is),nst(is),newval
186                                        
187                  oldVAL=newVAL                       oldVAL=newVAL
188                else                    else
189                  if(debug)                       if(verbose)
190       $               print*,'filladc --> datum out of range - info',info       $                    print*,'filladc --> datum out of range - info'
191                  iflag=1       $                    ,info
192                  return                       iflag=1
193                endif                       GOOD1(DSPn) = 10
194                prec_ind=0  c                     return
195                         goto 221
196                      endif
197                      prec_ind=0
198                   endif
199              endif              endif
200            endif   221        continue
201            goto 222              goto 222
202          endif           endif
203            
204   1000   continue   1000    continue
205            
206    
207  C++++++++++++++++++++++++++++++++++++++++++++++++++++++  C++++++++++++++++++++++++++++++++++++++++++++++++++++++
208  c     if(iand(DAQmode(iv),z'0001').eq.z'0001') then  c     if(iand(DAQmode(iv),z'0001').eq.z'0001') then
209          if(iand(DAQmode(iv),z'0003').eq.z'0001'.or. !full           if(iand(DAQmode(iv),z'0003').eq.z'0001'.or. !full
210       $       iand(DAQmode(iv),z'0003').eq.z'0003'.or. !comp+full       $        iand(DAQmode(iv),z'0003').eq.z'0003'.or. !comp+full
211       $       (iand(DAQmode(iv),z'0003').eq.z'0000' !special       $        (iand(DAQmode(iv),z'0003').eq.z'0000' !special
212       $       .and.mod(DSPn+ievent,2).eq.1).or.       $        .and.mod(DSPn+ievent,2).eq.1).or.
213       $       .false.) then       $        .false.) then
214  C++++++++++++++++++++++++++++++++++++++++++++++++++++++  C++++++++++++++++++++++++++++++++++++++++++++++++++++++
215  C--------------------------------------------full mode  C--------------------------------------------full mode
216                
217    
218                do i=1,3            !loop over ladder
219            do i=1,3                 do j=1,1024      !loop over strips
220              do j=1,1024                    idata = idata+1
221                idata = idata+1                    is=j+1024*(i-1)
               is=j+1024*(i-1)  
222  c     adcadc=adc(DSPn,nvk(is),nst(is))  c     adcadc=adc(DSPn,nvk(is),nst(is))
223                adc(DSPn,nvk(is),nst(is)) = datatracker(idata)                    if(       DSPn.le.nviews
224                       $                 .and.nvk(is).le.nva1_view
225         $                 .and.nst(is).le.nstrips_va1)then
226                         adc(DSPn,nvk(is),nst(is))= datatracker(idata)
227                      else
228                         print*,'filladc --> attempt to access ADC['
229         $                    ,DSPn,nvk(is),nst(is),']'
230                      endif
231                      
232  c     if(iand(DAQmode(iv),z'0002').eq.z'0002') then  c     if(iand(DAQmode(iv),z'0002').eq.z'0002') then
233  c     diff=adc(DSPn,nvk(is),nst(is))-adcadc  c     diff=adc(DSPn,nvk(is),nst(is))-adcadc
234  c     if(abs(diff).gt.0)  c     if(abs(diff).gt.0)
235  c     $                    print*,DSPn,is,adcadc,  c     $                    print*,DSPn,is,adcadc,
236  c     $                    ' ---- ',adc(DSPn,nvk(is),nst(is)),diff  c     $                    ' ---- ',adc(DSPn,nvk(is),nst(is)),diff
237  c     endif  c     endif
238              enddo                 enddo            !loop over strips
239              idata = idata+1                 idata = idata+1
240              if(datatracker(idata).ne.ior(z'1800',i+3)) then                 if(datatracker(idata).ne.ior(z'1800',i+3)) then
241                if(debug)                    if(verbose)
242       $           print*,'filladc --> wrong end-of-ladder in FULL mode'       $                 print*,'filladc --> ',
243                if(debug)       $                 'wrong end-of-ladder in FULL mode'
244       $           print*,'            word ',datatracker(idata)                    if(verbose)
245                if(debug)       $                 print*,'            word ',datatracker(idata)
246       $           print*,'            should be ',ior(z'1800',i+3)                    if(verbose)
247                iflag=1       $                 print*,'            should be ',ior(z'1800',i+3)
248                return                                      iflag=1
249              endif                    GOOD1(DSPn) = 10
250            enddo  c                  return                  
251          endif                 endif
252                enddo!endl loop over ladder
253        enddo           endif
254             goto 334
255   333  continue   333  continue
256          if(verbose)print*,'filladc --> ',iv
257         $     ,'^ DSP packet missing or corrupted: '
258         $     ,'DSPn, datalength(iv) => '
259         $     ,DSPn,datalength(iv)
260     334  continue
261          enddo
262                
263        return        return
264        end        end
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.23