C
C  Written by Mirko Boezio and Emiliano Mocchiutti
C
C     * Version: 2.18.4 *
C
C     Changelog:
C
C 2.18.3 - 2.18.4: consider a bad thing if you find a section in the wrong
C                  position of the vector and try again to 
C                  find the real data (if they exist).
C
C 2.18.2 - 2.18.3: vectors belonging to common must be cleared if the calo
C                  isn't found. Fixed.
C 
C 2.18.1 - 2.18.2: fixed unclearing error codes if the program doesn't find
C                  the calorimeter where it should be but shifted somewhere 
C                  else
C                  forgotten to clear st2c variable: fixed
C                  exit error code wrong in some cases: fixed
C                  self trigger data not saved: fixed 
C
C 2.18.0 - 2.18.1: small changes in the common varie to fix a memory leak;
C                  fixed an error in reporting error codes (stwerr,pwerror)
C
C 2.17 - 2.18.0: corrected bug which made unable the program to find CRC
C                errors in the last section of the calorimeter;
C                added a "debugging" option to dump to standard output
C                the whole packet in hexadecimal format and other 
C                useful informations. To activate it the dump variable
C                in the common varie must be passed with the value
C                of iev you want to check. Do nothing if you don't want
C                any output.
C
C------------------------------------------------
      SUBROUTINE CALUNPACK(vecta,lung,me)
C------------------------------------------------

      IMPLICIT NONE
C
C Normal variables definition
C
      INTEGER SOGLIA, SOGLIA0, START
      PARAMETER (SOGLIA0=7)
      PARAMETER (SOGLIA=27)
c      PARAMETER (START=274)
      PARAMETER (START=80)
      integer lung, me, pro, m, dumpo
c
      INTEGER NPLA, NCHA, LENSEV
      PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)

      INTEGER merror(4),mi
C
      INTEGER i, j, iev, min, st2c, bit, bi, lleng, salta
C
      INTEGER*1 VECTA(lung)
      INTEGER*2 vect(60000), test
C
      integer*2 check, crc, e2(4)
C
      INTEGER ic, k,l, ke, ic0, icsave(1000), chi(1000)
      INTEGER status, contr, cstatus, co, nta, conte
      INTEGER inf, sup, em, esci, icb
      INTEGER XO, YO, XE, YE,iev2, icold

      INTEGER*2 length, length2

      INTEGER*2 st1, st2, cst1, st4

      integer st1b, st2b,p, lunga, pari

      integer icsez(4), mioic
      
      INTEGER*2 ival
      PARAMETER (ival='FFFF'x)

      real dedx1(11,96),dedx2(11,96),dedx3(11,96),dedx4(11,96)
      real dedx1c(11,96),dedx2c(11,96),dedx3c(11,96),dedx4c(11,96)
      real base1(11,6),base2(11,6),base3(11,6),base4(11,6)
      REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)

  
      real auto(7)
      real calselftrig(4,7), calIItrig(4), calstripshit(4),
     &     calDSPtaberr(4), calevnum(4)

      DATA XO/241/ ! CODE_EV_R XO = 111 10001
      DATA YO/237/ ! CODE_EV_R YO = 111 01101
      DATA XE/234/ ! CODE_EV_R XE = 111 01010
      DATA YE/246/ ! CODE_EV_R YE = 111 10110

      REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
      REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
      REAL calpuls(4,11,96)
      real perror(4)
      integer stwerr(4)

      COMMON / evento / IEV, stwerr, perror,
     &     dexy,dexyc,base,
     &     calselftrig,calIItrig,
     &     calstripshit,calDSPtaberr,calevnum
      
      save / evento /

      COMMON / calib / IEV2, calped, calgood, calthr, calrms, 
     &     calbase,
     &     calvar,
     &     calpuls

      save / calib /

c
      COMMON / VARIE / dumpo, CONTR
      SAVE / VARIE /
    
C         
C Begin !
C
      if (dumpo.eq.0) dumpo=-1
      if (iev.eq.dumpo) then
c         do l=1,lung,2
c            write(*,18)l,vecta(l),vecta(l+1)
c         enddo
         do l=1,lung
            write(*,17)l,vecta(l)
         enddo 
      endif
c
      if (iev.lt.0.or.iev.gt.9000000) iev = 0
      min = 0
      lleng = 0
      salta = 0
      m = 0
      pari = 0
      IF (MOD(LUNG,2).EQ.0) THEN
         lunga = lung / 2
         pari = 1
      else
         lunga = int(lung/2) + 1
      endif
c
      if (lunga.gt.60000.and.dumpo.gt.0) then
         print *,'Calorimeter WARNING: more than 60000 words!'
         lunga = 60000
      endif
c    
      call canctutto
      call azero(dedx1,11*96)
      call azero(dedx2,11*96)
      call azero(dedx3,11*96)
      call azero(dedx4,11*96)
      call azero(dedx1c,11*96)
      call azero(dedx2c,11*96)
      call azero(dedx3c,11*96)
      call azero(dedx4c,11*96)
      call azero(base1,11*6)
      call azero(base2,11*6)
      call azero(base3,11*6)
      call azero(base4,11*6)
C
      do l = 1,4
         e2(l) = 0
         perror(l) = 0.
         stwerr(l) = 0
         merror(l) = 0
      enddo
c
      do l = 1,1000
         icsave(l) = 0
         chi(l) = 0
      enddo
      em = 0
      co = 0
      esci = 0
      me = 1
c
      contr = 1
c
      ic = 1
      icb = 0
      nta = 0
c 
CX      length2 = ic - 2
      length2 = start
c
      if (length2.ge.-2) then
         ic = ic + (2 * (length2 + 2)) 
      else
         if (dumpo.gt.0)
     &    print *,'Calorimeter WARNING: length errors ',ic,length2,nta
      endif
c
      contr=1
 10   continue
C     
      if (ic.gt.(lung-1)) then
         goto 105
      endif
C     
      st1b = 0
      st2b = 0
      if ((ic+3).gt.lung) then 
c         if (co.eq.0) co = 1
c         chi(co) = chi(co) + 8 * (5 - contr)
c         merror(contr) = 130
c         if (contr.ne.1) contr=5
         goto 105
      endif
      do bit = 0, 7
         bi = ibits(vecta(ic),bit,1)
         if (bi.eq.1) st1b = ibset(st1b,bit)
         bi = ibits(vecta(ic+1),bit,1)
         if (bi.eq.1) st2b = ibset(st2b,bit)
      enddo
c     
C     ST2 is the STATUS WORD
c     
      length2 = 0
      do bit=0, 7
         bi = ibits(vecta(ic+3),bit,1)
         if (bi.eq.1) length2 = ibset(length2,bit)
         bi = ibits(vecta(ic+2),bit,1)
         if (bi.eq.1) length2 = ibset(length2,bit+8)
      enddo   
c     the crc should be at vect(length) with
      length = length2 + 1 
C     
c     some checks to be sure we have found the calorimeter data:
c     
c     status word is always less then 129
c     
      if (st2b.gt.128) then
         length = 0
         goto 100
      endif
c     
c     length of the packet must be less then 20000 if no errors
c     are found
c     
      if (st2b.eq.0.and.length2.gt.lunga) then
         length = 0
         goto 100
      endif
c     
      if (length2.le.0) then
         length = 0
         goto 100
      endif
c     
      e2(contr) = 0
C     
      if (contr.eq.1) then
         if (st1b.eq.YE) then
            call riempi(ic,lunga,lleng,lung,pari,vect,vecta)
            if (st2b.ne.0) then
               E2(contr) = vect(icb)
            else
               e2(contr) = 0
            endif
            goto 20
         else
            ic = ic + 1
            goto 10
         endif
      ENDIF
      if (contr.eq.2) then
         if (st1b.eq.YO) then
            call riempi(ic,lunga,lleng,lung,pari,vect,vecta)
            if (st2b.ne.0) then
               E2(contr) = vect(icb)
            else
               e2(contr) = 0
            endif
            goto 20
         else
            ic = ic + 1
            goto 10
         endif
      ENDIF
      if (contr.eq.3) then
         if (st1b.eq.XE) then
            call riempi(ic,lunga,lleng,lung,pari,vect,vecta)
            if (st2b.ne.0) then
               E2(contr) = vect(icb)
            else
               e2(contr) = 0
            endif
            goto 20
         else
            ic = ic + 1
            goto 10
         endif
      ENDIF
      if (contr.eq.4) then
         if (st1b.eq.XO) then
            call riempi(ic,lunga,lleng,lung,pari,vect,vecta)
            if (st2b.ne.0) then
               E2(contr) = vect(icb)
            else
               e2(contr) = 0
            endif
            goto 20
         else
            ic = ic + 1
            goto 10
         endif
      ENDIF
 100  continue
      ic = ic + 1
      goto 10
 20   continue
C              
c     format not used
c     
c 10   FORMAT(2X,'Error for view:',2X,I1,2X,'Status word:',2X,Z4)
 11   FORMAT(2X,'View or command not recognized for view:',2X,I1,2X,
     &     'Status word:',2X,Z4)
 12   FORMAT(2X,'Error - did NOT find view:',2X,I1)
 13   FORMAT(2X,'Error - eof reached, exiting')
 14   FORMAT(2X,I8,2X,I10)
 15   FORMAT(2X,I8,2X,Z8)
 17   FORMAT(2X,'Elemento:',2X,I6,2X,' word:',2X,Z8)
 18   FORMAT(2X,'Elemento:',2X,I6,2X,' word:',2X,Z2,Z2)
 21   FORMAT(2X,'CRC: ',2X,Z8)
C
c     go on recording data
      mioic = ic
      ic = ic - 1
c     
      K = CONTR
      ic0 = icb
      icb = icb + 1
      length = vect(icb) + 2 
      length2 = vect(icb)    
      lleng = (length*2) - 1
C
C Check consistency of CRC.
C
      check = 0
      inf = ic0
      sup = length - 1
      do i = inf,sup
         check=crc(check,vect(i))
      enddo

      if (iev.eq.dumpo) write(*,21)vect(length)
      if (iev.eq.dumpo) write(*,21)check      
c
      if (check.eq.vect(length).and.ibits(e2(contr),0,1).eq.0) then
         icsez(contr)=mioic
         contr = contr + 1         
      else
         ic = ic + 1 
      endif
      if (contr.lt.5) goto 10
 105  continue
      if (contr.eq.4) then
         lleng = 0
         do mi=1, 4            
            ic = icsez(mi)
            call riempi(ic,lunga,lleng,lung,pari,vect,vecta)
            ic = ic - 1
c     
            K = CONTR
            ic0 = icb
            icb = icb + 1
            length = vect(icb) + 2 
            length2 = vect(icb)    
            lleng = (length*2) - 1
C
C     Check consistency of CRC.
C     
            check = 0
            inf = ic0
            sup = length - 1
            do i = 1, 7 
               icb = icb + 1
               auto(i) = vect(icb)
            enddo
C     
            st2c = 0
            if (st2b.ne.0) then
               do bit=0, 6
                  bi = ibits(st2b,bit,1)
                  if (bit.eq.3.and.bi.ne.0) st2c = 8
               enddo
            endif
C     
            if (st2c.eq.8) then
               if (length2.ne.1064) then
                  merror(contr) = 133
                  chi(co) = chi(co) + 4
                  lleng = 0
                  goto 150
               else               
                  if (k.eq.1) then
                     call azero(dedx1,11*96)
                     call azero(dedx2,11*96)
                     call azero(dedx3,11*96)
                     call azero(dedx4,11*96)
                     call azero(dedx1c,11*96)
                     call azero(dedx2c,11*96)
                     call azero(dedx3c,11*96)
                     call azero(dedx4c,11*96)
                     call azero(base1,11*6)
                     call azero(base2,11*6)
                     call azero(base3,11*6)
                     call azero(base4,11*6)
                     call CALRAW(vect,icb+1,length-1,dedx1)
                  endif
                  if (k.eq.2) call CALRAW(vect,icb+1,length-1,dedx2)
                  if (k.eq.3) call CALRAW(vect,icb+1,length-1,dedx3)
                  if (k.eq.4) call CALRAW(vect,icb+1,length-1,dedx4)
               endif
               goto 50
            endif
C     
 41         FORMAT(2X,I2,2X,'word :',1x,z4)
            test = vect(icb+3)
c     
            if (test.eq.ival) then
               if (length2.gt.1201) then
                  merror(contr) = 134
                  chi(co) = chi(co) + 4
                  lleng = 0
                  goto 150
               else
                  icb = icb + 1
                  calIItrig(k) = vect(icb)
                  icb = icb + 1
                  calstripshit(k) = vect(icb)
                  icb = icb + 1
C     qui c'e` test!
                  icb = icb + 1
                  calDSPtaberr(k) = vect(icb)
                  icb = icb + 1
                  calevnum(k) = vect(icb)
                  merror(contr) = 137
                  if (k.eq.1) then
                     call azero(dedx1,11*96)
                     call azero(dedx2,11*96)
                     call azero(dedx3,11*96)
                     call azero(dedx4,11*96)
                     call azero(dedx1c,11*96)
                     call azero(dedx2c,11*96)
                     call azero(dedx3c,11*96)
                     call azero(dedx4c,11*96)
                     call azero(base1,11*6)
                     call azero(base2,11*6)
                     call azero(base3,11*6)
                     call azero(base4,11*6)
                     call CALCOMPRESS(vect,icb+1,length-1,dedx1c,
     &                    base1)
                  endif
                if (k.eq.2) call CALCOMPRESS(vect,icb+1,length-1,dedx2c,
     &                 base2)
                if (k.eq.3) call CALCOMPRESS(vect,icb+1,length-1,dedx3c,
     &                 base3)
                if (k.eq.4) call CALCOMPRESS(vect,icb+1,length-1,dedx4c,
     &                 base4)
                  goto 50
               endif
            else if (test.eq.0) then
               if (length2.gt.2257) then
                  merror(contr) = 135
                  chi(co) = chi(co) + 4
                  lleng = 0
                  goto 150
               else
                  icb = icb + 1
                  calIItrig(k) = vect(icb)
                  icb = icb + 1
                  calstripshit(k) = vect(icb)
                  icb = icb + 1
C     qui c'e` test
                  icb = icb + 1
                  calDSPtaberr(k) = vect(icb)
                  icb = icb + 1
                  calevnum(k) = vect(icb)
                  merror(contr) = 138
                  if (k.eq.1) then 
                     call azero(dedx1,11*96)
                     call azero(dedx2,11*96)
                     call azero(dedx3,11*96)
                     call azero(dedx4,11*96)
                     call azero(dedx1c,11*96)
                     call azero(dedx2c,11*96)
                     call azero(dedx3c,11*96)
                     call azero(dedx4c,11*96)
                     call azero(base1,11*6)
                     call azero(base2,11*6)
                     call azero(base3,11*6)
                     call azero(base4,11*6)
                     call CALFULL(vect,icb+1,length-1,dedx1,
     &                    dedx1c,base1)
                  endif
                  if (k.eq.2) call CALFULL(vect,icb+1,length-1,dedx2,
     &                 dedx2c,base2)
                  if (k.eq.3) call CALFULL(vect,icb+1,length-1,dedx3,
     &                 dedx3c,base3)
                  if (k.eq.4) call CALFULL(vect,icb+1,length-1,dedx4,
     &                 dedx4c,base4)
                  goto 50
               endif
            else
               merror(contr) = 136
               chi(co) = chi(co) + 4
               lleng = 0
               goto 150
            endif
c     
 50         continue
c     
C     
            do i = 1,7
               calselftrig(k,i) = auto(i) 
            enddo
C     
            DO I = 1,11
               DO J = 1,96
                  DEXY(2,2*I-1,97-J) = DEDX3(I,J)
                  DEXY(1,2*I-1,J) = DEDX2(I,J)
                  DEXY(2,2*I,J) = DEDX4(I,J)
                  DEXY(1,2*I,J) = DEDX1(I,J)
                  DEXYC(2,2*I-1,97-J) = DEDX3C(I,J)
                  DEXYC(1,2*I-1,J) = DEDX2C(I,J)
                  DEXYC(2,2*I,J) = DEDX4C(I,J)
                  DEXYC(1,2*I,J) = DEDX1C(I,J)
               enddo
               do j = 1,6
                  base(2,2*i-1,7-j) = base3(i,j)
                  base(1,2*i-1,j) = base2(i,j)
                  base(2,2*i,j) = base4(i,j)
                  base(1,2*i,j) = base1(i,j)
               enddo
            enddo
C     
         enddo
      else
c     soncazzi
      endif
C
 150  continue
C
c     
      do l = 1, 4
         do bit=0, 31
            if (bit.lt.16) then
               bi = ibits(E2(L),bit,1)
            else
               bi = 0
            endif
            if (bi.eq.1) then
               stwerr(l) = ibset(stwerr(l),bit)
            else
               stwerr(l) = ibclr(stwerr(l),bit)
            endif
         enddo
         perror(l) = float(merror(l))
      enddo
c
      iev = iev + 1
      RETURN
      END


C------------------------------------------------
      SUBROUTINE CALRAW(vect,inf,sup,dedx)
C------------------------------------------------

      IMPLICIT NONE

      INTEGER*2 VECT(30000) 
      INTEGER inf, sup
      INTEGER i,j,k, iev,iev2

C
      INTEGER NPLA, NCHA, LENSEV
      PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
      INTEGER merror(4)
      integer*2 e2(4)
      INTEGER contr
      REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)

  
      real calselftrig(4,7), calIItrig(4), calstripshit(4),
     &     calDSPtaberr(4), calevnum(4)
      

      REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
      REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
      REAL calpuls(4,11,96)
      REAL dedx(11,96)
      real perror(4)
      integer stwerr(4), dumpo

      COMMON / evento / IEV, stwerr, perror,
     &     dexy,dexyc,base,
     &     calselftrig,calIItrig,
     &     calstripshit,calDSPtaberr,calevnum
      
      save / evento /

      COMMON / calib / IEV2, calped, calgood, calthr, calrms, 
     &     calbase,
     &     calvar,
     &     calpuls

      save / calib /
c
      COMMON / VARIE / dumpo, CONTR
      SAVE / VARIE /
    
C
      DO I = 1,11
         DO J = 1,96
            DEDX(I,J) = 0.
         ENDDO
      ENDDO
C
      k = inf
      do j = 1,96
         do i = 1,11
            dedx(i,j) = vect(k)
            k = k + 1
         enddo
      enddo
c
      RETURN
      END

C------------------------------------------------
      SUBROUTINE CALCOMPRESS(vect,inf,sup,dedx,basse)
C------------------------------------------------

      IMPLICIT NONE

      INTEGER*2 VECT(30000) , st3
C
      INTEGER inf, sup
      INTEGER i,j, iev,iev2,h
      INTEGER*2 st, st1, st2
C
      INTEGER ib
      INTEGER ipl, ipr, ist
C
C
      INTEGER NPLA, NCHA, LENSEV
      PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
      INTEGER merror(4)
      integer*2 e2(4)
      INTEGER contr
      REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)

  
      real calselftrig(4,7), calIItrig(4), calstripshit(4),
     &     calDSPtaberr(4), calevnum(4)
      

      REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
      REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
      REAL calpuls(4,11,96)
      REAL dedx(11,96), basse(11,6)
      real perror(4)
      integer stwerr(4),dumpo
C
      COMMON / evento / IEV, stwerr,perror,
     &     dexy,dexyc,base,
     &     calselftrig,calIItrig,
     &     calstripshit,calDSPtaberr,calevnum
      
      save / evento /

      COMMON / calib / IEV2, calped, calgood, calthr, calrms, 
     &     calbase,
     &     calvar,
     &     calpuls

      save / calib /
c
      COMMON / VARIE / dumpo, CONTR
      SAVE / VARIE /
    
C
      DO I = 1,11
         DO J = 1,96
            DEDX(I,J) = 0.
         ENDDO
         do j = 1,6
            basse(i,j) = 0.
         enddo
      ENDDO
C
      i = inf
c
 10   continue
      if (i.gt.sup) then
         RETURN
      endif
C
 40   format(2x,i5,2x,'status :',1x,Z4)
C
c
      st1 = 0
      st1 = IAND(vect(i),'0800'x)
      st1 = ISHFT(st1,-11)
cc 41      format(2x,'st1 = ',Z8)
cc 42      format(2x,'st2 = ',Z8)
 43      format(2x,'vect(i)  = ',Z8)
cc 44      format(2x,'vect(i) dopo = ',Z8)
cc 45      format(2x,'vect(i) ib = 1 : ',Z8)
cc 46   format(2x,'vect(i) < 0 : ',Z8)
      if (st1.eq.1) then
         ib = 1
      else
         st2 = IAND(vect(i),'1000'x) 
         st2 = ISHFT(st2,-12) 
         if (st2.eq.1) then 
            ib = 0
         else
            if (iev.eq.dumpo) then
               print *,'i ',i
               write(*,43)vect(i)
            endif
            merror(contr) = 139
            RETURN
         endif
      endif
C
      if (ib.eq.1) then
C     
         st = IAND(vect(i),'00FF'x)
c
         ipl = int(st/6) + 1
         ipr = st - (ipl - 1) * 6 + 1
         i = i + 1
         if (i.gt.sup) RETURN
         basse(ipl,ipr) = vect(i)
c         
 20      continue
         if (i.gt.sup) RETURN
C
         i = i + 1
         if (i.gt.sup) RETURN
         if ((vect(i)+1).gt.16.or.(vect(i)+1).lt.1) then
            goto 10
         endif
         ist = vect(i) + 1 + 16 * (ipr - 1)
         i = i + 1
         if (i.gt.sup) RETURN
         dedx(ipl,ist) = vect(i)
         goto 20
      else
C
         st = IAND(vect(i),'00FF'x)
         ipl = int(st/6) + 1 
         ipr = st - (ipl - 1) * 6 + 1
         do j = 1,16
            i = i + 1
            if (i.gt.sup) RETURN
            ist = j + 16 * (ipr - 1)
            dedx(ipl,ist) = vect(i)
         enddo
         i = i + 1
         if (i.gt.sup) RETURN
         goto 10
C         
      endif


      RETURN
      END


C----------------------------------------------------------
      SUBROUTINE CALFULL(vect,inf,sup,dedx,dedxc,basse)
C--------------------------------------------------------------

      IMPLICIT NONE

      INTEGER*2 VECT(30000) 
C
      INTEGER inf, sup
      INTEGER i,j,k, iev,iev2
C
      INTEGER NPLA, NCHA, LENSEV
      PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
      INTEGER merror(4)
      integer*2 e2(4)
      INTEGER contr
      REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)

  
      real calselftrig(4,7), calIItrig(4), calstripshit(4),
     &     calDSPtaberr(4), calevnum(4)
      

      REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
      REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
      REAL calpuls(4,11,96)
      REAL dedx(11,96), basse(11,6), dedxc(11,96)
      real perror(4)
      integer stwerr(4),dumpo

      COMMON / evento / IEV, stwerr,perror,
     &     dexy,dexyc,base,
     &     calselftrig,calIItrig,
     &     calstripshit,calDSPtaberr,calevnum
      
      save / evento /

      COMMON / calib / IEV2, calped, calgood, calthr, calrms, 
     &     calbase,
     &     calvar,
     &     calpuls

      save / calib /

c
      COMMON / VARIE / dumpo, CONTR
      SAVE / VARIE /
    
C
C
C
      DO I = 1,11
         DO J = 1,96
            DEDX(I,J) = 0.
         ENDDO
      ENDDO
C
      k = inf     
      do i = 1,11
         do j = 1,96
            dedx(i,j) = vect(k)
            k = k + 1
         enddo
      enddo
C
      call CALCOMPRESS(vect,k,sup,dedxc,basse)
C
 10   FORMAT(2X,'Status word:',2X,Z8)      

      RETURN
      END


C------------------------------------------------
      SUBROUTINE CONTAER(ve,er)
C------------------------------------------------

      IMPLICIT NONE

      INTEGER*2 VE, st4
C
      INTEGER*2 VECT(30000) 
C
      INTEGER er, l, bit, bi, iev,iev2
C
      INTEGER NPLA, NCHA, LENSEV
      PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
      INTEGER merror(4)
      integer*2 e2(4)
      INTEGER contr
      REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)

  
      real calselftrig(4,7), calIItrig(4), calstripshit(4),
     &     calDSPtaberr(4), calevnum(4)
      

      REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
      REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
      REAL calpuls(4,11,96)
      real perror(4)
      integer stwerr(4),dumpo

      COMMON / evento / IEV, stwerr,perror,
     &     dexy,dexyc,base,
     &     calselftrig,calIItrig,
     &     calstripshit,calDSPtaberr,calevnum
      
      save / evento /

      COMMON / calib / IEV2, calped, calgood, calthr, calrms, 
     &     calbase,
     &     calvar,
     &     calpuls

      save / calib /

      COMMON / VARIE / dumpo, CONTR
      SAVE / VARIE /
    
                 
      st4 = 0
      st4 = IAND(ve,'00FF'x)
      if (st4.ne.0) then
         do bit=0, 6
            bi = ibits(st4,bit,1)
            if (bi.ne.0) then
               er = er + 1
            endif
         enddo
      endif
      
 10   FORMAT(2X,'Status word:',2X,Z4)      
      return
      end


C------------------------------------------------
      SUBROUTINE MINERR(ic,icsave,chi,min,co)
C------------------------------------------------

      IMPLICIT NONE
C
      INTEGER ic, icsave(1000), chi(1000)
      integer l, st, min,co
      INTEGER*2 VECT(30000) 
C
      INTEGER iev,iev2
C
      INTEGER NPLA, NCHA, LENSEV
      PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
      INTEGER merror(4)
      integer*2 e2(4)
      INTEGER contr
      REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)

  
      real calselftrig(4,7), calIItrig(4), calstripshit(4),
     &     calDSPtaberr(4), calevnum(4)
      

      REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
      REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
      REAL calpuls(4,11,96)
      real perror(4)
      integer stwerr(4),dumpo

      COMMON / evento / IEV, stwerr,perror,
     &     dexy,dexyc,base,
     &     calselftrig,calIItrig,
     &     calstripshit,calDSPtaberr,calevnum
      
      save / evento /

      COMMON / calib / IEV2, calped, calgood, calthr, calrms, 
     &     calbase,
     &     calvar,
     &     calpuls

      save / calib /
c
      COMMON / VARIE / dumpo, CONTR
      SAVE / VARIE /
                   
      st = chi(1)
      min = 1
      if (co.gt.1) then
         do l = 2, co 
            if (chi(l).lt.st) then             
               st = chi(l)
               min = l
            endif
         enddo
      endif
      ic = icsave(min)

      return
      end

C-----------------------------------------------------
      SUBROUTINE CANCTUTTO
C-----------------------------------------------------

      IMPLICIT NONE
C
      INTEGER iev,iev2
C
      INTEGER NPLA, NCHA, LENSEV
      PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
      INTEGER merror(4)
      integer*2 e2(4)
      INTEGER contr
      REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)

  
      real calselftrig(4,7), calIItrig(4), calstripshit(4),
     &     calDSPtaberr(4), calevnum(4)
      

      REAL calped(4,11,96), calgood(4,11,96), calthr(4,11,6)
      REAL calrms(4,11,96), calbase(4,11,6), calvar(4,11,6)
      REAL calpuls(4,11,96)
      real perror(4)
      integer stwerr(4),dumpo

      COMMON / evento / IEV, stwerr,perror,
     &     dexy,dexyc,base,
     &     calselftrig,calIItrig,
     &     calstripshit,calDSPtaberr,calevnum
      
      save / evento /

      COMMON / calib / IEV2, calped, calgood, calthr, calrms, 
     &     calbase,
     &     calvar,
     &     calpuls

      save / calib /
c
      COMMON / VARIE / dumpo, CONTR
      SAVE / VARIE /
C
      call azero(calped,4*11*96)
      call azero(calgood,4*11*96)
      call azero(calthr,4*11*96)
      call azero(calrms,4*11*96)
      call azero(calbase,4*11*6)
      call azero(calvar,4*11*6)
      call azero(calpuls,4*11*96)
      call azero(dexy,4*11*96)
      call azero(dexyc,4*11*96)
      call azero(base,4*11*6)
      call azero(calselftrig,4*7)
      call azero(calIItrig,4)
      call azero(calstripshit,4)
      call azero(calDSPtaberr,4)
      call azero(calevnum,4)
c
      return 
      end
