      subroutine filladc(iflag) !??? AGGIUSTARE TUTTO


      include 'commontracker.f'
      include 'level0.f'
      include 'level1.f'
      include 'calib.f'


      include 'common_reduction.f'

      external nvk
      external nst

      real errflag
      integer*2 flag,tipo,info,prec_ind,word
      integer*2 newVAL,oldVAL
      data oldval/0/
      integer DSPn

      iflag = 0

C---------------------------------------------------------
C     check DAQmode to see if data are 
C     - b#1001 = 9 full
C     - b#1010 =10 compressed
C     - b#1011 =11 compressed + full 
C     - b#1000 = 8 special --> (compressed+full) / compressed
C     (even/odd views compressed/full, alternately)
C     in the third case ADC is filled with full data
C---------------------------------------------------------

      idata=0                   !datatracker array index

      do iv=1,nviews

         DSPn   = DSPnumber(iv)
         ievent = eventn(iv)
        
C     ---------------------------
C     if the iv view is missing 
C     or the data buffer is empty
C     jump to next view
C     ---------------------------

         nword_DSP = 0
         if(DSPn.eq.0
     $        .or.DSPn.gt.nviews
     $        .or.datalength(iv).eq.0)goto 333

C++++++++++++++++++++++++++++++++++++++++++++++++++++++
         if(  iand(DAQmode(iv),z'0003').eq.z'0002'.or.
     $        iand(DAQmode(iv),z'0003').eq.z'0003'.or.
     $        iand(DAQmode(iv),z'0003').eq.z'0000'.or.
     $        .false.) then 
C++++++++++++++++++++++++++++++++++++++++++++++++++++++
C--------------------------------------compressed mode
            if(debug.eq.1)print*,'DSP #',DSPn,' --> compressed '
            is = 0
            il = 0 
            prec_ind = 0
 222        continue
            idata = idata+1
            if( idata.gt.NWORDMAX )goto 335 !end to end
            nword_DSP = nword_DSP +1
            if(  nword_DSP.gt.datalength(iv) )then
               if( debug.eq.1 )
     $              print*,'filladc --> missing end-of-ladder',
     $              ' in COMPRESSED mode - DSP ',DSPn
               if(debug.eq.1)
     $              print*,'datalength = ',datalength(iv)
               iflag=1
c               GOOD1(DSPn) = 10
c               GOOD1(DSPn) = GOOD1(DSPn) + 2**4
               GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
               goto 334         !next view
            endif
c            word = datatracker(idata)
            word = INT(IBITS(datatracker(idata),0,16),2) ! EM GCC4.2, I checked that this line works
c            print *,word,' datatracker(idata) ',datatracker(idata) ! EM
C------------------------------------------------------
C     call routine to uncompress data
C------------------------------------------------------
            call compdecode(word,flag,tipo,info,errflag)
            
            if(errflag.ne.0.) then
               if(debug.eq.1)print*,'filladc --> ERROR on compdecode'
               iflag=1
c               GOOD1(DSPn) = 10
c               GOOD1(DSPn) = GOOD1(DSPn) + 2**4
               GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
c               return
               goto 221
            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.eq.1)print*,
     $                 'filladc --> wrong end-of-ladder '
     $                 //'in COMPRESSED mode'
                  if(debug.eq.1)print*,
     $                 '            info(=ladder) ',info,'  type ',tipo
                  iflag=1
c                  GOOD1(DSPn) = 10
c               GOOD1(DSPn) = GOOD1(DSPn) + 2**4
               GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
c                  return
                  goto 221
               endif
               
               il = info
               do js=is+1,1024*il
                  
                  if( DSPn.le.nviews
     $                 .and.nvk(js).gt.0
     $                 .and.nvk(js).le.nva1_view
     $                 .and.nst(js).gt.0
     $                 .and.nst(js).le.nstrips_va1
     $                 )then

                     newVAL = 0 
                     if(  
     $                    nvk(is).gt.0.and.
     $                    nvk(is).le.nva1_view.and.
     $                    nst(is).gt.0.and.
     $                    nst(is).le.nstrips_va1.and.
     $                    .true.)then
                        newVAL=oldVAL+nint(
     $                       -pedestal_t(DSPn,nvk(is),nst(is)) ! EM GCC4.7
     $                       +pedestal_t(DSPn,nvk(js),nst(js)),2) ! EM GCC4.7
                        newVAL=max(int(0,2),newVAL) ! EM GCC4.7
                        newVAL=min(int(4095,2),newVAL)
                     endif
                     adc(DSPn,nvk(js),nst(js))=newVAL 
                  else                     
                     print*,'filladc -->'
     $                    ,' attempt to access array element (1)'
c     $                    ,'(',DSPn,nvk(is),nst(is),')'
     $                    ,'pedestal_t(',DSPn,nvk(js),nst(js),')'
                  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
               
               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
                     
                     if(is.eq.0.or.is.eq.1024.or.is.eq.2048)then
                        if(debug.eq.1)print*,'filladc -->'
     $                       ,' previous transmitted strip ',is 
     $                       ,' - missing first ADC value'
                        iflag=1
c                        GOOD1(DSPn) = 10
c                        GOOD1(DSPn) = GOOD1(DSPn) + 2**4
                        GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
                     endif
                     do js = is+1,iaddr-1

                        if( DSPn.le.nviews
     $                       .and.nvk(js).gt.0
     $                       .and.nvk(js).le.nva1_view
     $                       .and.nst(js).gt.0
     $                       .and.nst(js).le.nstrips_va1
     $                       )then
                           
                           newVAL = 0 
                           if(
     $                          nvk(is).gt.0.and.
     $                          nvk(is).le.nva1_view.and.
     $                          nst(is).gt.0.and.
     $                          nst(is).le.nstrips_va1.and.
     $                          .true.)then
                              newVAL=oldVAL+nint( ! EM GCC4.7
     $                             -pedestal_t(DSPn,nvk(is),nst(is))
     $                             +pedestal_t(DSPn,nvk(js),nst(js)),2)! EM GCC4.7
                              newVAL=max(int(0,2),newVAL)! EM GCC4.7
                              newVAL=min(int(4095,2),newVAL)! EM GCC4.7
                           endif
                           adc(DSPn,nvk(js),nst(js))=newVAL 
                        else
                           print*,'filladc -->'
     $                          ,' attempt to access array element (2) '
c     $                          ,'(',DSPn,nvk(is),nst(is),')'
     $                          ,'pedestal_t(',DSPn,nvk(js),nst(js),')'
c                           iflag=1
c                           if(DSPn.le.nviews)GOOD1(DSPn) = 10
                        endif
c     print*,DSPn,nvk(js),nst(js),newval
                        
                     enddo
                     
                     is = iaddr
                     prec_ind = 1
                  else
                     if(debug.eq.1)print*,'filladc --> address '// 
     $                    'out of range - iaddr,is',iaddr,is
                     iflag=1
c                     GOOD1(DSPn) = 10
c                     GOOD1(DSPn) = GOOD1(DSPn) + 2**4
                     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
c                     return
                     goto 221
                  endif
               endif
               if(tipo.eq.0) then ! tipo: dato   
                  if(prec_ind.eq.0) is=is+1
                  if(info.ge.0.and.info.le.4095) then
                     if(is.gt.3072)then 
                        if(debug.eq.1)print*,
     $                       'filladc --> strip out of range - DSPn,is'
     $                       ,DSPn,is
                        iflag=1
c                        GOOD1(DSPn) = 10
c                        GOOD1(DSPn) = GOOD1(DSPn) + 2**4
                        GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
c                        return
                        goto 221

                     endif
                     newVAL=info
                     
                     if(       DSPn.le.nviews
     $                    .and.nvk(is).le.nva1_view
     $                    .and.nst(is).le.nstrips_va1)then
                        adc(DSPn,nvk(is),nst(is))=newVAL 
                     else
                        print*,'filladc --> attempt to access ADC('
     $                       ,DSPn,nvk(is),nst(is),')'
                     endif
ccc   print*,DSPn,nvk(is),nst(is),newval
                     
                     oldVAL=newVAL
                  else
                     if(debug.eq.1)
     $                    print*,'filladc --> datum out of range - info'
     $                    ,info
                     iflag=1
c                     GOOD1(DSPn) = 10
c                     GOOD1(DSPn) = GOOD1(DSPn) + 2**4
                     GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
c                     return
                     goto 221
                  endif
                  prec_ind=0
               endif
            endif
 221        continue
            goto 222
         endif
         
 1000    continue
         

C++++++++++++++++++++++++++++++++++++++++++++++++++++++
c     if(iand(DAQmode(iv),z'0001').eq.z'0001') then 
         if(iand(DAQmode(iv),z'0003').eq.z'0001'.or. !full
     $        iand(DAQmode(iv),z'0003').eq.z'0003'.or. !comp+full
     $        (iand(DAQmode(iv),z'0003').eq.z'0000' !special
     $        .and.mod(DSPn+ievent,2).eq.1).or.
     $        .false.) then 
C++++++++++++++++++++++++++++++++++++++++++++++++++++++
C--------------------------------------------full mode
            
            if(debug.eq.1)print*,'DSP #',DSPn,' --> full '

            do i=1,3            !loop over ladder
               do j=1,1024      !loop over strips
                  idata = idata+1
                  if( idata.gt.NWORDMAX )goto 335 !go to end
                  nword_DSP = nword_DSP +1
                  if(  nword_DSP.gt.datalength(iv) )then
                     if( debug.eq.1 )
     $                    print*,'filladc --> missing end-of-ladder',
     $                    ' in FULL mode - DSP ',DSPn
                     if(debug.eq.1)print*,'datalength = ',datalength
                     goto 334   !next view
                  endif
                  is=j+1024*(i-1)
c     adcadc=adc(DSPn,nvk(is),nst(is))
                  if(       DSPn.le.nviews
     $                 .and.nvk(is).le.nva1_view
     $                 .and.nst(is).le.nstrips_va1)then
                     adc(DSPn,nvk(is),nst(is))= datatracker(idata)
                  else
                     print*,'filladc --> attempt to access ADC['
     $                    ,DSPn,nvk(is),nst(is),']'
                  endif
                  
c     if(iand(DAQmode(iv),z'0002').eq.z'0002') then
c     diff=adc(DSPn,nvk(is),nst(is))-adcadc
c     if(abs(diff).gt.0)
c     $                    print*,DSPn,is,adcadc,
c     $                    ' ---- ',adc(DSPn,nvk(is),nst(is)),diff
c     endif
               enddo            !loop over strips
               idata = idata+1
               if( idata.gt.NWORDMAX )goto 335 !go to end
               nword_DSP = nword_DSP +1
               if(  nword_DSP.gt.datalength(iv) )then
                  if( debug.eq.1 )
     $                 print*,'filladc --> missing end-of-ladder',
     $                 ' in FULL mode - DSP ',DSPn
                  if(debug.eq.1)print*,'datalength = ',datalength
                  goto 334      !next view
               endif
               if(datatracker(idata).ne.ior(z'1800',i+3)) then
                  if(debug.eq.1)
     $                 print*,'filladc --> ',
     $                 'wrong end-of-ladder in FULL mode'
                  if(debug.eq.1)
     $                 print*,'            word ',datatracker(idata)
                  if(debug.eq.1)
     $                 print*,'            should be ',ior(z'1800',i+3)
                  iflag=1
c                  GOOD1(DSPn) = 10
c                  GOOD1(DSPn) = GOOD1(DSPn) + 2**4
                  GOOD1(DSPn) = ior(GOOD1(DSPn),2**4)
c                  return                  
               endif
            enddo!endl loop over ladder
         endif
         goto 334
 333     continue
         if(debug.eq.1)print*,'filladc --> ',iv
     $        ,'^ DSP packet missing or corrupted: '
     $        ,'DSPn, datalength(iv) => '
     $        ,DSPn,datalength(iv)
 334     continue
      enddo
      goto 336
 335  continue
      if(debug.eq.1)print*,'filladc --> reached end of buffer:',
     $     ' datatracker(',NWORDMAX,')'

 336  continue
      return
      end



c     qui o nelle functions.f???
      
      SUBROUTINE COMPDECODE(word,flag,tipo,info,errflag)
      INTEGER*2 word,flag,tipo,info
      INTEGER*2 hexmask !EM GCC4.7
C-------------------------------------------------------
C     Decode tracker words:
C     
C     flag    tipo                  info
C     --------------------------------------------------
C     0       0                     ADC value
C     0       1                     strip address 1-1024
C     1       0(end of ladders 1 2  1,2 or 4,5 
C     1       1(end of ladder 3)    3 or 6
C-------------------------------------------------------
      errflag=0.
C EM: by default z'XXXX' returns a INTEGER*8, we want to have just a INTEGER*2 so we need a trick
C Bitwise is like this:
C WORD =  16 bit
C         1111111111111111  FFFF  32767 + sign
C
C      flag=iand(word,z'f000')
      hexmask=z'7000'
      hexmask=IBSET(hexmask,15) ! it is not possible to set the sign bit with F000, we must set the sign bit with ibset
c      print *,' hexmask ',hexmask
c      write(*,22)hexmask
c 22   FORMAT(2X,'hexmask: ',2X,Z8)
      flag=iand(word,hexmask)
C END EM
      flag=ishft(flag,-12)

      if(flag.ne.0.and.flag.ne.1) then
c        print*,'compdecode --> error on uncompression: flag=',flag
         errflag=1.
      endif
      if(flag.eq.0) then        ! valore ADC
         tipo=0
         hexmask=z'0FFF' !EM GCC4.7
         info=iand(word,hexmask) !EM GCC4.7
c         info=iand(word,z'0fff') !EM GCC4.7
      endif
      if(flag.eq.1) then        ! indirizzo OR fine vista
        hexmask=z'03FF' !EM GCC4.7
        info=iand(word,hexmask) !EM GCC4.7
c        info=iand(word,z'03ff') !EM GCC4.7
        hexmask=z'0C00' !EM GCC4.7
        tipo=iand(word,hexmask)!EM GCC4.7
c        tipo=iand(word,z'0c00') !EM GCC4.7
        hexmask=z'0800' !EM GCC4.7
        if(tipo.ne.0.and.tipo.ne.hexmask) then !EM GCC4.7
c          print*,'compdecode --> error on decompression: tipo=',tipo
          errflag=1.
        endif
        if(tipo.eq.0) then      ! indirizzo
          flag=0
          tipo=1
          info=info+INT(1,2) !EM GCC4.7
        endif
        if(tipo.eq.z'0800') then ! fine vista
          flag=1
          if(info.eq.3.or.info.eq.6) then 
            tipo=1
          else
            tipo=0
          endif
        endif
      endif
      return
      end
