/[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.10 by pam-fi, Mon Aug 20 16:07:16 2007 UTC revision 1.11 by mocchiut, Thu Jan 16 15:29:53 2014 UTC
# Line 75  c               GOOD1(DSPn) = GOOD1(DSPn Line 75  c               GOOD1(DSPn) = GOOD1(DSPn
75                 GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)                 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------------------------------------------------------
# Line 124  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 177  c                        GOOD1(DSPn) = G Line 180  c                        GOOD1(DSPn) = G
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 349  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 360  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
# Line 369  c        print*,'compdecode --> error on Line 382  c        print*,'compdecode --> error on
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.10  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.23