/[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.4 by pam-fi, Thu Sep 28 14:04:40 2006 UTC
# Line 32  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(debug)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
               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  
               
             is=1024*il  
             prec_ind=0          !il precedente non e' un indirizzo  
           endif  
             
           if(flag.eq.0) then    !  flag: dato o indirizzo  
             if(tipo.eq.1) then  ! tipo: indirizzo  
               iaddr = info + il*1024  
               if(iaddr.ge.is+1.and.iaddr.le.3072) then  
                 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  
74              endif              endif
75              if(tipo.eq.0) then  ! tipo: dato                
76                if(prec_ind.eq.0) is=is+1              if(flag.eq.1) then  !   flag: fine messaggio (ladder)
77                if(info.ge.0.and.info.le.4095) then                
78                  if(is.gt.3072)then                 if(info.ne.1.and.info.ne.2.and.info.ne.3) then
79                    if(debug)print*,                    if(debug)print*,
80       $                 'filladc --> strip out of range - DSPn,is'       $                 'filladc --> wrong end-of-ladder '
81       $                 ,DSPn,is       $                 //'in COMPRESSED mode'
82                      if(debug)print*,
83         $                 '            info(=ladder) ',info,'  type ',tipo
84                    iflag=1                    iflag=1
85                    return                    GOOD1(DSPn) = 10
86                  endif  c                  return
87                  newVAL=info                    goto 221
88                                   endif
89                  adc(DSPn,nvk(is),nst(is))=newVAL                
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                if(flag.eq.0) then  !  flag: dato o indirizzo
123                   if(tipo.eq.1) then ! tipo: indirizzo
124                      iaddr = info + il*1024
125                      if(iaddr.ge.is+1.and.iaddr.le.3072) then
126                         do js = is+1,iaddr-1
127    
128                            if(       DSPn.le.nviews
129         $                       .and.nvk(js).le.nva1_view
130         $                       .and.nst(js).le.nstrips_va1
131         $                       .and.nvk(is).le.nva1_view
132         $                       .and.nst(is).le.nstrips_va1
133         $                       )then
134    
135                               newVAL=oldVAL
136         $                          -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
148                            
149                         enddo
150                        
151                         is = iaddr
152                         prec_ind = 1
153                      else
154                         if(debug)print*,'filladc --> address '//
155         $                    'out of range - iaddr,is',iaddr,is
156                         iflag=1
157                         GOOD1(DSPn) = 10
158    c                     return
159                         goto 221
160                      endif
161                   endif
162                   if(tipo.eq.0) then ! tipo: dato  
163                      if(prec_ind.eq.0) is=is+1
164                      if(info.ge.0.and.info.le.4095) then
165                         if(is.gt.3072)then
166                            if(debug)print*,
167         $                       'filladc --> strip out of range - DSPn,is'
168         $                       ,DSPn,is
169                            iflag=1
170                            GOOD1(DSPn) = 10
171    c                        return
172                            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(debug)
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(debug)
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(debug)
245                if(debug)       $                 print*,'            word ',datatracker(idata)
246       $           print*,'            should be ',ior(z'1800',i+3)                    if(debug)
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(debug)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.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.23