/[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.7 by pam-fi, Thu Mar 15 12:17:10 2007 UTC revision 1.11 by mocchiut, Thu Jan 16 15:29:53 2014 UTC
# Line 55  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 '              if(debug.eq.1)print*,'DSP #',DSPn,' --> compressed '
59              is = 0              is = 0
60              il = 0              il = 0
61              prec_ind = 0              prec_ind = 0
# Line 64  C--------------------------------------c Line 64  C--------------------------------------c
64              if( idata.gt.NWORDMAX )goto 335 !end to end              if( idata.gt.NWORDMAX )goto 335 !end to end
65              nword_DSP = nword_DSP +1              nword_DSP = nword_DSP +1
66              if(  nword_DSP.gt.datalength(iv) )then              if(  nword_DSP.gt.datalength(iv) )then
67                 if( verbose )print*,'filladc --> missing end-of-ladder',                 if( debug.eq.1 )
68         $              print*,'filladc --> missing end-of-ladder',
69       $              ' in COMPRESSED mode - DSP ',DSPn       $              ' in COMPRESSED mode - DSP ',DSPn
70                 if(verbose)print*,'datalength = ',datalength(iv)                 if(debug.eq.1)
71         $              print*,'datalength = ',datalength(iv)
72                 iflag=1                 iflag=1
73                 GOOD1(DSPn) = 10  c               GOOD1(DSPn) = 10
74    c               GOOD1(DSPn) = GOOD1(DSPn) + 2**4
75                   GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
76                 goto 334         !next view                 goto 334         !next view
77              endif              endif
78              word = datatracker(idata)  c            word = datatracker(idata)
79                word = INT(IBITS(datatracker(idata),0,16),2) ! EM GCC4.2, I checked that this line works
80    c            print *,word,' datatracker(idata) ',datatracker(idata) ! EM
81  C------------------------------------------------------  C------------------------------------------------------
82  C     call routine to uncompress data  C     call routine to uncompress data
83  C------------------------------------------------------  C------------------------------------------------------
84              call compdecode(word,flag,tipo,info,errflag)              call compdecode(word,flag,tipo,info,errflag)
85                            
86              if(errflag.ne.0.) then              if(errflag.ne.0.) then
87                 if(verbose)print*,'filladc --> ERROR on compdecode'                 if(debug.eq.1)print*,'filladc --> ERROR on compdecode'
88                 iflag=1                 iflag=1
89                 GOOD1(DSPn) = 10  c               GOOD1(DSPn) = 10
90    c               GOOD1(DSPn) = GOOD1(DSPn) + 2**4
91                   GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
92  c               return  c               return
93                 goto 221                 goto 221
94              endif              endif
# Line 88  c               return Line 96  c               return
96              if(flag.eq.1) then  !   flag: fine messaggio (ladder)              if(flag.eq.1) then  !   flag: fine messaggio (ladder)
97                                
98                 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
99                    if(verbose)print*,                    if(debug.eq.1)print*,
100       $                 'filladc --> wrong end-of-ladder '       $                 'filladc --> wrong end-of-ladder '
101       $                 //'in COMPRESSED mode'       $                 //'in COMPRESSED mode'
102                    if(verbose)print*,                    if(debug.eq.1)print*,
103       $                 '            info(=ladder) ',info,'  type ',tipo       $                 '            info(=ladder) ',info,'  type ',tipo
104                    iflag=1                    iflag=1
105                    GOOD1(DSPn) = 10  c                  GOOD1(DSPn) = 10
106    c               GOOD1(DSPn) = GOOD1(DSPn) + 2**4
107                   GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
108  c                  return  c                  return
109                    goto 221                    goto 221
110                 endif                 endif
# Line 116  c                  return Line 126  c                  return
126       $                    nst(is).gt.0.and.       $                    nst(is).gt.0.and.
127       $                    nst(is).le.nstrips_va1.and.       $                    nst(is).le.nstrips_va1.and.
128       $                    .true.)then       $                    .true.)then
129                          newVAL=oldVAL-pedestal_t(DSPn,nvk(is),nst(is))                          newVAL=oldVAL-
130       $                       +pedestal_t(DSPn,nvk(js),nst(js))       $                       nint(pedestal_t(DSPn,nvk(is),nst(is)) ! EM GCC4.7
131                          newVAL=max(0,newVAL)       $                       +pedestal_t(DSPn,nvk(js),nst(js)),2) ! EM GCC4.7
132                          newVAL=min(4095,newVAL)                          newVAL=max(int(0,2),newVAL) ! EM GCC4.7
133                            newVAL=min(int(4095,2),newVAL)
134                       endif                       endif
135                       adc(DSPn,nvk(js),nst(js))=newVAL                       adc(DSPn,nvk(js),nst(js))=newVAL
136                    else                                        else                    
# Line 145  c$$$  $             ,pedestal(DSPn,nvk(j Line 156  c$$$  $             ,pedestal(DSPn,nvk(j
156                    if(iaddr.ge.is+1.and.iaddr.le.3072) then                    if(iaddr.ge.is+1.and.iaddr.le.3072) then
157                                            
158                       if(is.eq.0.or.is.eq.1024.or.is.eq.2048)then                       if(is.eq.0.or.is.eq.1024.or.is.eq.2048)then
159                          if(verbose)print*,'filladc -->'                          if(debug.eq.1)print*,'filladc -->'
160       $                       ,' previous transmitted strip ',is       $                       ,' previous transmitted strip ',is
161       $                       ,' - missing first ADC value'       $                       ,' - missing first ADC value'
162                          iflag=1                          iflag=1
163                          GOOD1(DSPn) = 10  c                        GOOD1(DSPn) = 10
164    c                        GOOD1(DSPn) = GOOD1(DSPn) + 2**4
165                            GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
166                       endif                       endif
167                       do js = is+1,iaddr-1                       do js = is+1,iaddr-1
168    
# Line 167  c$$$  $             ,pedestal(DSPn,nvk(j Line 180  c$$$  $             ,pedestal(DSPn,nvk(j
180       $                          nst(is).gt.0.and.       $                          nst(is).gt.0.and.
181       $                          nst(is).le.nstrips_va1.and.       $                          nst(is).le.nstrips_va1.and.
182       $                          .true.)then       $                          .true.)then
183                                newVAL=oldVAL                                newVAL=oldVAL-nint( ! EM GCC4.7
184       $                             -pedestal_t(DSPn,nvk(is),nst(is))       $                             -pedestal_t(DSPn,nvk(is),nst(is))
185       $                             +pedestal_t(DSPn,nvk(js),nst(js))       $                             +pedestal_t(DSPn,nvk(js),nst(js)),2)! EM GCC4.7
186                                newVAL=max(0,newVAL)                                newVAL=max(int(0,2),newVAL)! EM GCC4.7
187                                newVAL=min(4095,newVAL)                                newVAL=min(int(4095,2),newVAL)! EM GCC4.7
188                             endif                             endif
189                             adc(DSPn,nvk(js),nst(js))=newVAL                             adc(DSPn,nvk(js),nst(js))=newVAL
190                          else                          else
# Line 189  c     print*,DSPn,nvk(js),nst(js),newval Line 202  c     print*,DSPn,nvk(js),nst(js),newval
202                       is = iaddr                       is = iaddr
203                       prec_ind = 1                       prec_ind = 1
204                    else                    else
205                       if(verbose)print*,'filladc --> address '//                       if(debug.eq.1)print*,'filladc --> address '//
206       $                    'out of range - iaddr,is',iaddr,is       $                    'out of range - iaddr,is',iaddr,is
207                       iflag=1                       iflag=1
208                       GOOD1(DSPn) = 10  c                     GOOD1(DSPn) = 10
209    c                     GOOD1(DSPn) = GOOD1(DSPn) + 2**4
210                         GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
211  c                     return  c                     return
212                       goto 221                       goto 221
213                    endif                    endif
# Line 201  c                     return Line 216  c                     return
216                    if(prec_ind.eq.0) is=is+1                    if(prec_ind.eq.0) is=is+1
217                    if(info.ge.0.and.info.le.4095) then                    if(info.ge.0.and.info.le.4095) then
218                       if(is.gt.3072)then                       if(is.gt.3072)then
219                          if(verbose)print*,                          if(debug.eq.1)print*,
220       $                       'filladc --> strip out of range - DSPn,is'       $                       'filladc --> strip out of range - DSPn,is'
221       $                       ,DSPn,is       $                       ,DSPn,is
222                          iflag=1                          iflag=1
223                          GOOD1(DSPn) = 10  c                        GOOD1(DSPn) = 10
224    c                        GOOD1(DSPn) = GOOD1(DSPn) + 2**4
225                            GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
226  c                        return  c                        return
227                          goto 221                          goto 221
228    
# Line 224  ccc   print*,DSPn,nvk(is),nst(is),newval Line 241  ccc   print*,DSPn,nvk(is),nst(is),newval
241                                            
242                       oldVAL=newVAL                       oldVAL=newVAL
243                    else                    else
244                       if(verbose)                       if(debug.eq.1)
245       $                    print*,'filladc --> datum out of range - info'       $                    print*,'filladc --> datum out of range - info'
246       $                    ,info       $                    ,info
247                       iflag=1                       iflag=1
248                       GOOD1(DSPn) = 10  c                     GOOD1(DSPn) = 10
249    c                     GOOD1(DSPn) = GOOD1(DSPn) + 2**4
250                         GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
251  c                     return  c                     return
252                       goto 221                       goto 221
253                    endif                    endif
# Line 252  c     if(iand(DAQmode(iv),z'0001').eq.z' Line 271  c     if(iand(DAQmode(iv),z'0001').eq.z'
271  C++++++++++++++++++++++++++++++++++++++++++++++++++++++  C++++++++++++++++++++++++++++++++++++++++++++++++++++++
272  C--------------------------------------------full mode  C--------------------------------------------full mode
273                            
274              if(debug)print*,'DSP #',DSPn,' --> full '              if(debug.eq.1)print*,'DSP #',DSPn,' --> full '
275    
276              do i=1,3            !loop over ladder              do i=1,3            !loop over ladder
277                 do j=1,1024      !loop over strips                 do j=1,1024      !loop over strips
# Line 260  C--------------------------------------- Line 279  C---------------------------------------
279                    if( idata.gt.NWORDMAX )goto 335 !go to end                    if( idata.gt.NWORDMAX )goto 335 !go to end
280                    nword_DSP = nword_DSP +1                    nword_DSP = nword_DSP +1
281                    if(  nword_DSP.gt.datalength(iv) )then                    if(  nword_DSP.gt.datalength(iv) )then
282                       if( verbose )                       if( debug.eq.1 )
283       $                    print*,'filladc --> missing end-of-ladder',       $                    print*,'filladc --> missing end-of-ladder',
284       $                    ' in FULL mode - DSP ',DSPn       $                    ' in FULL mode - DSP ',DSPn
285                       if(verbose)print*,'datalength = ',datalength                       if(debug.eq.1)print*,'datalength = ',datalength
286                       goto 334   !next view                       goto 334   !next view
287                    endif                    endif
288                    is=j+1024*(i-1)                    is=j+1024*(i-1)
# Line 288  c     endif Line 307  c     endif
307                 if( idata.gt.NWORDMAX )goto 335 !go to end                 if( idata.gt.NWORDMAX )goto 335 !go to end
308                 nword_DSP = nword_DSP +1                 nword_DSP = nword_DSP +1
309                 if(  nword_DSP.gt.datalength(iv) )then                 if(  nword_DSP.gt.datalength(iv) )then
310                    if( verbose )                    if( debug.eq.1 )
311       $                 print*,'filladc --> missing end-of-ladder',       $                 print*,'filladc --> missing end-of-ladder',
312       $                 ' in FULL mode - DSP ',DSPn       $                 ' in FULL mode - DSP ',DSPn
313                    if(verbose)print*,'datalength = ',datalength                    if(debug.eq.1)print*,'datalength = ',datalength
314                    goto 334      !next view                    goto 334      !next view
315                 endif                 endif
316                 if(datatracker(idata).ne.ior(z'1800',i+3)) then                 if(datatracker(idata).ne.ior(z'1800',i+3)) then
317                    if(verbose)                    if(debug.eq.1)
318       $                 print*,'filladc --> ',       $                 print*,'filladc --> ',
319       $                 'wrong end-of-ladder in FULL mode'       $                 'wrong end-of-ladder in FULL mode'
320                    if(verbose)                    if(debug.eq.1)
321       $                 print*,'            word ',datatracker(idata)       $                 print*,'            word ',datatracker(idata)
322                    if(verbose)                    if(debug.eq.1)
323       $                 print*,'            should be ',ior(z'1800',i+3)       $                 print*,'            should be ',ior(z'1800',i+3)
324                    iflag=1                    iflag=1
325                    GOOD1(DSPn) = 10  c                  GOOD1(DSPn) = 10
326    c                  GOOD1(DSPn) = GOOD1(DSPn) + 2**4
327                      GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
328  c                  return                    c                  return                  
329                 endif                 endif
330              enddo!endl loop over ladder              enddo!endl loop over ladder
331           endif           endif
332           goto 334           goto 334
333   333     continue   333     continue
334           if(verbose)print*,'filladc --> ',iv           if(debug.eq.1)print*,'filladc --> ',iv
335       $        ,'^ DSP packet missing or corrupted: '       $        ,'^ DSP packet missing or corrupted: '
336       $        ,'DSPn, datalength(iv) => '       $        ,'DSPn, datalength(iv) => '
337       $        ,DSPn,datalength(iv)       $        ,DSPn,datalength(iv)
# Line 318  c                  return               Line 339  c                  return              
339        enddo        enddo
340        goto 336        goto 336
341   335  continue   335  continue
342        if(verbose)print*,'filladc --> reached end of buffer:',        if(debug.eq.1)print*,'filladc --> reached end of buffer:',
343       $     ' datatracker(',NWORDMAX,')'       $     ' datatracker(',NWORDMAX,')'
344    
345   336  continue   336  continue
# Line 331  c     qui o nelle functions.f??? Line 352  c     qui o nelle functions.f???
352                
353        SUBROUTINE COMPDECODE(word,flag,tipo,info,errflag)        SUBROUTINE COMPDECODE(word,flag,tipo,info,errflag)
354        INTEGER*2 word,flag,tipo,info        INTEGER*2 word,flag,tipo,info
355          INTEGER*2 hexmask !EM GCC4.7
356  C-------------------------------------------------------  C-------------------------------------------------------
357  C     Decode tracker words:  C     Decode tracker words:
358  C      C    
# Line 342  C     1       0(end of ladders 1 2  1,2 Line 364  C     1       0(end of ladders 1 2  1,2
364  C     1       1(end of ladder 3)    3 or 6  C     1       1(end of ladder 3)    3 or 6
365  C-------------------------------------------------------  C-------------------------------------------------------
366        errflag=0.        errflag=0.
367        flag=iand(word,z'f000')  C EM: by default z'XXXX' returns a INTEGER*8, we want to have just a INTEGER*2 so we need a trick
368    C Bitwise is like this:
369    C WORD =  16 bit
370    C         1111111111111111  FFFF  32767 + sign
371    C
372    C      flag=iand(word,z'f000')
373          hexmask=z'7000'
374          hexmask=IBSET(hexmask,15) ! it is not possible to set the sign bit with F000, we must set the sign bit with ibset
375          flag=iand(word,hexmask)
376    C END EM
377        flag=ishft(flag,-12)        flag=ishft(flag,-12)
378    
379        if(flag.ne.0.and.flag.ne.1) then        if(flag.ne.0.and.flag.ne.1) then
380  c        print*,'compdecode --> error on uncompression: flag=',flag  c        print*,'compdecode --> error on uncompression: flag=',flag
381          errflag=1.           errflag=1.
382        endif        endif
383        if(flag.eq.0) then        ! valore ADC        if(flag.eq.0) then        ! valore ADC
384          tipo=0           tipo=0
385          info=iand(word,z'0fff')           hexmask=z'0FFF' !EM GCC4.7
386             info=iand(word,hexmask) !EM GCC4.7
387    c         info=iand(word,z'0fff') !EM GCC4.7
388        endif        endif
389        if(flag.eq.1) then        ! indirizzo OR fine vista        if(flag.eq.1) then        ! indirizzo OR fine vista
390          info=iand(word,z'03ff')          hexmask=z'03FF' !EM GCC4.7
391          tipo=iand(word,z'0c00')          info=iand(word,hexmask) !EM GCC4.7
392          if(tipo.ne.0.and.tipo.ne.z'0800') then  c        info=iand(word,z'03ff') !EM GCC4.7
393            hexmask=z'0C00' !EM GCC4.7
394            tipo=iand(word,hexmask)!EM GCC4.7
395    c        tipo=iand(word,z'0c00') !EM GCC4.7
396            hexmask=z'0800' !EM GCC4.7
397            if(tipo.ne.0.and.tipo.ne.hexmask) then !EM GCC4.7
398  c          print*,'compdecode --> error on decompression: tipo=',tipo  c          print*,'compdecode --> error on decompression: tipo=',tipo
399            errflag=1.            errflag=1.
400          endif          endif
401          if(tipo.eq.0) then      ! indirizzo          if(tipo.eq.0) then      ! indirizzo
402            flag=0            flag=0
403            tipo=1            tipo=1
404            info=info+1            info=info+INT(1,2) !EM GCC4.7
405          endif          endif
406          if(tipo.eq.z'0800') then ! fine vista          if(tipo.eq.z'0800') then ! fine vista
407            flag=1            flag=1
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.23