C------------------------------------------------
      PROGRAM DATA2NTP
C------------------------------------------------

      IMPLICIT NONE
C
      CHARACTER*40 file
      CHARACTER*9 cho
      CHARACTER*1 ANSW
      CHARACTER*40 file_name3

C      
      INTEGER NPLA, NCHA, LENSEV
      PARAMETER (NPLA=22,NCHA=96,LENSEV=NPLA*NCHA)
 
      integer vai, inizio, kl
      integer numev, lung, me
      integer*1 mah
      integer*4 evnum, systime, len
      integer RUNERROR, PERR(4), NERROR, merror(4)
C
C Normal variables definition
C
      INTEGER FFD, est1, est2, lu1, lu,lu2,lu3
C
      INTEGER i, j, kk, ival, silofa, p,ik
      INTEGER istat, ierr, icycle, bi, bit
C      
      INTEGER*2 VECT(20000), estatus
      INTEGER*4 st3, word1
c
      integer*1 vecta(40000), vectb(40000),word(3), savewo(3)
C
      integer*8 buffer(2), obt1,obt2,obt3,obt4,obt,obtold
      integer calcrc, vet,vec
C
      integer*2 check, crc, stwer(4)
C
      INTEGER ic, k, l, fake
      INTEGER status, CONTR
      INTEGER inf, sup
      
      integer dst1, dst2
      integer*1 dstatus

      INTEGER*2 length, length2

      INTEGER lundata, iosop
      INTEGER*2 st1, st2, st4

      INTEGER lrec
      PARAMETER (lrec=8190)

      integer irec,iev,iev2, iev3

      real RVECT(50)
      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 calselftrig(4,7), calIItrig(4), calstriphit(4)
      real calDSPtaberr(4), calevnum(4)
      REAL DEXY(2,NPLA,NCHA), dexyc(2,npla,ncha), base(2,npla,6)
      real perror(4), cperror(4)
      real pperror(4)
      integer pstwerr(4)
      integer cstwerr(4)
      integer stwerr(4)
      integer dump, fat

      integer calev0, oldcalev0, calev1,oldcalev1,calevv2,
     &     oldcalev2,calev3,oldcalev3

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

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

      save / calib /

      COMMON / calpul / IEV3, pstwerr, pperror,
     &     calpuls

      save / calpul /

c
      COMMON / VARIE / dump, CONTR, merror
      SAVE / VARIE /

      COMMON / HEADER / buffer
      SAVE / HEADER /
      
      REAL hmemor(9000000)
      integer Iquest(100)    
      COMMON /pawc/hmemor
      Common /QUEST/ Iquest

      CALL HLIMIT(9000000)

      Iquest(10) = 256000
c      Iquest(10) = 128000

      calev0=0;
      calev1=0;
      calevv2=0;
      calev3=0;
C         
C Begin !
C
C
      PRINT *,'File to save? '
      READ(*,904)file_name3
      print *,file_name3
C
C   Histos creation
C
      CALL HROPEN(59,'Event','/wizard3/pamela/integr/'//
     +                  file_name3,'nqe',lrec,istat)
      CALL HBNT(1,'Pamela Calo',' ')
      CALL HBNT(2,'Pamela data',' ')
      CALL HBNT(3,'Pamela puls',' ')
      CALL HBSET('BSIZE',lrec,ierr)

***     /* Book ntuple variables */
      CALL HBNAME(1,'calib',iev2,'iev2:I,cstwerr(4):I,cperror(4):R,'//
     &     'calped(4,11,96):R,'//
     &     'calgood(4,11,96):R,calthr(4,11,6):R,'//
     &     'calrms(4,11,96):R,calbase(4,11,6):R,calvar(4,11,6)')
      CALL HBNAME(2,'evento',iev,'iev:I,stwerr(4):I,perror(4):R,'//
     &     'dexy(2,22,96):R,'//
     &     'dexyc(2,22,96):R,base(2,22,6):R,'//
     &     'calselftrig(4,7):R,'//
     &     'calIItrig(4):R,'//
     &     'calstriphit(4):R,calDSPtaberr(4):R,calevnum(4):R')
      CALL HBNAME(3,'calpul',iev3,'iev3:I,pstwerr(4):I,pperror(4):R,'//
     &     'calpuls(4,11,96):R')
C
      iev = 0
      iev2 = 0
      iev3 = 0
c      
 7    continue
      RUNERROR=0                ! error variable

      PRINT *,'File to read? '
      READ(*,905)file
      print *,file

      numev = 0
      PRINT *,'Number of fafede? '
      READ(*,906)numev
      print *,numev
      numev = numev + 1

      inizio = 1
      PRINT *,'Where to start? '
      READ(*,906)inizio
      print *,inizio
      
 906  FORMAT(I6)
 905  FORMAT(A40)
c
      lundata = 44
c
      OPEN(UNIT=lundata,FILE='/wizard3/pamela/integr/'//file
     &     ,STATUS='OLD', FORM='UNFORMATTED',ACCESS='DIRECT',ERR=50
     &     ,recl=4)
C
      PRINT *,'Data, pedestal, pulse or all? '
      READ(*,903)cho
      print *,cho
C
      dump = -1
      PRINT *,'Any iev to be dumped out (number/[-1])? '
      READ(*,906)dump
      print *,dump
      if (dump.ne.-1) dump = dump - 1
c
      fat = 39312
      PRINT *,'Any fafede type (i.e. 10,07,18,..) to be dumped'//
     &     ' out (number/[-1])? '
      READ(*,29)fat
      write(*,29)fat
 29   format(Z4)
C
 903  FORMAT(A9)
 904  FORMAT(A40)
C
      ffd=FNum(lundata)          ! take the file descriptor number
C
      contr = 1
      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(calstriphit,4)
      call azero(calDSPtaberr,4)
      call azero(calevnum,4)
c
      obt = 0
      obtold = 0
      do l = 1,4
         stwer(l) = 0
         perr(l) = 0
         cstwerr(l) = 0
         cperror(l) = 0.
         pstwerr(l) = 0
         pperror(l) = 0.
         stwerr(l) = 0
         perror(l) = 0.
      enddo
C
C Read event: use C readevent routine, it reads words of 32 bits
C search the first FAFEDE of the file:
C
      do p=1,20000
         vect(p) = 0
      enddo
      silofa = 0
      word(1) = 0
      word(2) = 0
      word(3) = 0
c
      vai = 0
      do while (vai.lt.inizio)
         do i = 1, 3
            fake = 0
            runerror = 0
            call reads(fake,runerror,ffd)
            if (runerror.eq.-1.or.runerror.eq.1) then
               print *,'Error reading file - no FAFEDE found!' 
               goto 50
            endif
            word(i) = fake
         enddo
c
         silofa = 0
         do while (silofa.eq.0)
            call fafede(word,silofa)
            if (silofa.eq.1) then
               savewo(1)=word(1)
               savewo(2)=word(2)
               savewo(3)=word(3)
               vai = vai + 1
            else
               runerror = 0
               fake = 0            
               call reads(fake,runerror,ffd)
               word(1) = word(2)
               word(2) = word(3)           
               word(3) = fake
            endif
         enddo
      enddo
c
C ok, now for all the events search the next FAFEDE
c
      do j = (inizio+1), numev
         i = 0
         lu = 39999
         silofa = 0
c
         i = i + 1
         vecta(i) = savewo(1)
         i = i + 1
         vecta(i) = savewo(2)
         i = i + 1
         vecta(i) = savewo(3)
         runerror = 0
         fake = 0
         word(1) = 0
         word(2) = 0
         word(3) = 0
         do ik = 1, 3
            call reads(fake,runerror,ffd)
            if (runerror.eq.-1.or.runerror.eq.1) then
               print *,'Error reading file - no FAFEDE found!' 
               goto 50
            endif
            word(ik) = fake
         enddo
         do while (silofa.eq.0)
c
c     go out before running out of file!
c
            if (j.ge.numev.and.i.ge.lu) then               
               silofa = 2
               goto 77
            endif
c
            call fafede(word,silofa)
 77         CONTINUE
            if (silofa.eq.1) then
               savewo(1)=word(1)
               savewo(2)=word(2)
               savewo(3)=word(3)
            elseif (silofa.eq.0) then
               call reads(fake,runerror,ffd)
               i = i + 1
               vecta(i) = word(1)
               word(1) = word(2)
               word(2) = word(3)           
               word(3) = fake
c
c     extract length of the packet (first two bytes)
c
               if (i.eq.13) then
                  lu1 = 0
                  do bit=0, 7
                     bi = ibits(vecta(i),bit,1)
                     if (bi.eq.1) then
                        lu1 = lu1 + 2**(bit+16)
                     endif
                  enddo
               endif
               if (i.eq.14) then
                  lu2 = 0
                  do bit=0, 7
                     bi = ibits(vecta(i),bit,1)
                     if (bi.eq.1) then
                        lu2 = lu2 + 2**(bit+8)
                     endif
                  enddo
               endif
               if (i.eq.15) then
 108              format(2X,'numero   ',2x,i5,2x,' valore ',2x,Z8)
 109              format(2X,'i13-15   ',Z8)
                  lu3 = 0
                  do bit=0, 7
                     bi = ibits(vecta(i),bit,1)
                     if (bi.eq.1) then
                        lu3 = lu3 + 2**(bit)
                     endif
                  enddo
                  lu =  (lu1 + lu2 + lu3) + 16 
                  if (lu.lt.16) then
                     print *,'Warning: length ',lu
                     goto 9
                  endif
               endif                            
c
c     extract the OBT 
c
               if (i.eq.9) then
                  obt1 = 0
                  do bit=0, 7
                     bi = ibits(vecta(i),bit,1)
                     if (bi.eq.1) then
                        obt1 = obt1 + 2**(bit+32)
                     endif
                  enddo
               endif
               if (i.eq.10) then
                  obt2 = 0
                  do bit=0, 7
                     bi = ibits(vecta(i),bit,1)
                     if (bi.eq.1) then
                        obt2 = obt2 + 2**(bit+16)
                     endif
                  enddo
               endif
               if (i.eq.11) then
                  obt3 = 0
                  do bit=0, 7
                     bi = ibits(vecta(i),bit,1)
                     if (bi.eq.1) then
                        obt3 = obt3 + 2**(bit+8)
                     endif
                  enddo
               endif
               if (i.eq.12) then
                  obt4 = 0
                  do bit=0, 7
                     bi = ibits(vecta(i),bit,1)
                     if (bi.eq.1) then
                        obt4 = obt4 + 2**(bit)
                     endif
                  enddo
                  obtold = obt
                  obt =  obt1 + obt2 + obt3 + obt4
               endif                
            endif
         enddo
C
c         print *,'lunghezza i ',i
c         print *,'lunghezza lu ',lu
c         write(*,13)vecta(16)
         if ( abs(obt-obtold).le.5 ) then
            print *,''
            print *,'WARNING1 OBT = ',obt,' OBT OLD = ',obtold
            print *,''
         endif
         if ( (obt-obtold).lt.0 ) then
            print *,''
            print *,'WARNING2 OBT = ',obt,' OBT OLD = ',obtold
            print *,''
         endif
         calcrc = 1 
         vec=-1
         buffer(1) = 0
         buffer(2) = 0
         do vet=16,1,-1
            vec = vec+1
            if (vec.gt.7) then
               do bit=0, 7
                  bi = 0
                  bi = ibits(vecta(vet),bit,1)
                  if (bi.eq.1) then
                     buffer(1)=ibset(buffer(1),bit+8*vec)
                  else
                     buffer(1)=ibclr(buffer(1),bit+8*vec)
                  endif
               enddo
            else
               do bit=0, 7
                  bi = 0
                  bi = ibits(vecta(vet),bit,1)
                  if (bi.eq.1) then
                     buffer(2)=ibset(buffer(2),bit+8*vec)
                  else
                     buffer(2)=ibclr(buffer(2),bit+8*vec)
                  endif
               enddo
            endif
         enddo
c         write(*,14)buffer(1)
c         write(*,14)buffer(2)
         calcrc = 1
         call testcrc(vecta(16),calcrc)
c         print *,'calcrc ',calcrc
c
         if (vecta(4).ne.vecta(5).or.calcrc.ne.0) then
            print *,'Packet header corrupted!'
            iev = iev + 1
            goto 666
         endif
         if (i.lt.lu) 
     &print *,'WARNING packet length shorter than expected, CRC errors?'
c
         if (lu.gt.40000) then
            print *,'WARNING packet length problems, CRC errors?'
c
c            goto 666
c
            lu = i
         endif         
         if (lu.gt.40000) then
c            if (vecta(4).eq.24) iev=iev+1
c            goto 666
            lu = 40000
         endif
c
         do p = 1, 40000           
            vectb(p) = 0
            if (p.gt.lu) then      
               vecta(p) = 0
               continue
            endif
            if (p.gt.16) vectb(p-16)=vecta(p)
         enddo
C
c         write(*,28)fat,lu
c         print *,' fat ',fat,' vecta(4) ',vecta(4)
         if (vecta(4).eq.fat.or.fat.eq.39321.or.vecta(4).eq.-127) then
c         if (vecta(4).eq.fat.or.fat.eq.153) then
c         if (vecta(4).eq.fat.or.fat.eq.153.or.fat.eq.129) then
            do l=1,lu
               write(*,17)l,vecta(l)
 17            FORMAT(2X,'Elemento:',2X,I6,2X,' word:',2X,Z8)
            enddo
 	 endif
c     
        
         print *,'############'
         write(*,28)vecta(4),j-1,obt
         print *,'############'
 28      format(' # FAFEDE',Z2,' #   pkt no ',I6,' OBT ',I16)
C
c
c            do l=1,lu-18
c               if ( vectb(l).ne.0 ) then
c                  if ( vectb(l).le.15.and.vectb(l).gt.0 ) then
c                     if ( vectb(l).eq.1 ) write(*,179)
c                     if ( vectb(l).eq.2 ) write(*,180)
c                     if ( vectb(l).eq.3 ) write(*,181)
c                     if ( vectb(l).eq.4 ) write(*,182)
c                     if ( vectb(l).eq.5 ) write(*,183)
c                     if ( vectb(l).eq.6 ) write(*,184)
c                     if ( vectb(l).eq.7 ) write(*,185)
c                     if ( vectb(l).eq.8 ) write(*,186)
c                     if ( vectb(l).eq.9 ) write(*,187)
c                     if ( vectb(l).eq.10 ) write(*,188)
c                     if ( vectb(l).eq.11 ) write(*,189)
c                     if ( vectb(l).eq.12 ) write(*,190)
c                     if ( vectb(l).eq.13 ) write(*,191)
c                     if ( vectb(l).eq.14 ) write(*,192)
c                     if ( vectb(l).eq.15 ) write(*,193)
c                  else
c                     write(*,177) vectb(l)
c                  endif
c               else
c                  write(*,178)
c               endif
c 177           FORMAT(Z2)
c 178           FORMAT('00')
c 179           FORMAT('01')
c 180           FORMAT('02')
c 181           FORMAT('03')
c 182           FORMAT('04')
c 183           FORMAT('05')
c 184           FORMAT('06')
c 185           FORMAT('07')
c 186           FORMAT('08')
c 187           FORMAT('09')
c 188           FORMAT('0A')
c 189           FORMAT('0B')
c 190           FORMAT('0C')
c 191           FORMAT('0D')
c 192           FORMAT('0E')
c 193           FORMAT('0F')
c            enddo 
c         endif
c
         if (cho.eq.'pulse'.or.cho.eq.'all') then
            if (vecta(4).eq.8.or.vecta(4).eq.9) then
               call calpulse(vectb,lu,me)
               print *,'me = ',me
               me = 0
               do i = 1, 4
                  stwerr(i) = pstwerr(i)
                  perror(i) = pperror(i)
               enddo
               iev = iev3
            else
               me = 1
            endif
         endif
c
         if (cho.eq.'pedestal'.or.cho.eq.'all') then
            if (vecta(4).eq.24) then
               call calpedestal(vectb,lu,me)
               me = 0
               do i = 1, 4
                  stwerr(i) = cstwerr(i)
                  perror(i) = cperror(i)
               enddo
               iev = iev2
            else
               me = 1
            endif
         endif
c
         if (cho.eq.'data'.or.cho.eq.'all'.or.cho.eq.'debug') then
            if (vecta(4).eq.16) then
               call calunpack(vectb,lu,me)
               me = 0
            else
               me = 1
               call clearall
            endif
         endif     
c
         if (cho.eq.'house'.or.cho.eq.'all') then
            if (vecta(4).eq.7) then
               print *,'End of run!'
               me = 0
             endif
         endif     
c
         if (me.eq.0) then
         print *,'*****************************************************'
            print *,'           FAFEDE number: ',j-1
         print *,'*****************************************************'
C
c            iev = iev + 1
c            iev2 = iev
            do l = 1, 4                                 
               st4 = 0
               st4 = IAND(stwerr(l),'00FF'x)
c               if (st4.ne.0) then
                  write(*,112) l,stwerr(l)
                  do bit=0, 17
c                     bi = ibits(st4,bit,1)
                     bi = ibits(stwerr(l),bit,1)
                     if (bit.eq.0.and.bi.ne.0) 
     &                    print *,' ---> CRC error'
                     if (bit.eq.1.and.bi.ne.0) 
     &                    print *,' ---> Execution error'
                     if (bit.eq.2.and.bi.ne.0) 
     &                    print *,' ---> CMD length error'
                     if (bit.eq.3.and.bi.ne.0) 
     &                    print *,' ---> RAW mode'
                     if (bit.eq.4.and.bi.ne.0) 
     &                    print *,' ---> Latch up alarm'
                     if (bit.eq.5.and.bi.ne.0) 
     &                    print *,' ---> Temp. alarm'
                     if (bit.eq.6.and.bi.ne.0) 
     &                    print *,' ---> DSP ack error'          
C
                     if (bit.eq.16.and.bi.ne.0) 
     &                    print *,' Acq. in compress mode, view: ',l          
                     if (bit.eq.17.and.bi.ne.0) 
     &                    print *,' Acq. in full mode, view: ',l          
C
                  enddo
 112              format(1X,'View ',I1,' header: ',Z8)
c               endif
               if (perror(l).eq.128.) 
     &     print *,'View or command not recognized, searching section',l
               if (perror(l).eq.129.) 
     &              print *,'Missing section ',l,' !'
               if (perror(l).eq.130.) 
     &              print *,'RAW MODE COMMAND! ',l
               if (perror(l).eq.131.) 
     &              print *,'--- Length problems! --- section ',l
               if (perror(l).eq.132.)  
     &              print *,'--- CRC errors! --- section ',l
               if (perror(l).eq.133.)
     &          print *,'Problems with length of view: ',l,
     &              ' in raw mode length'
               if (perror(l).eq.134.)
     &          print *,'Problems with length of view: ',l,
     &              ' in compress mode length'
               if (perror(l).eq.135.)
     &          print *,'Problems with length of view: ',l,
     &              ' in full mode length'
               if (perror(l).eq.136.)
     &              print *,'Acq mode problems with view: ',l
c               if (perror(l).eq.137.)
c     &              print *,'Acq in compress mode, view: ',l
c               if (perror(l).eq.138.)
c     &              print *,'Acq in full mode, view: ',l
               if (perror(l).eq.139.)
     &              print *,'Problems with coding, view: ',l
               if (perror(l).eq.140.)
     &              print *,'CHKSUM wrong, pedestal view: ',l
               if (perror(l).eq.141.)
     &              print *,'CHKSUM wrong, thresholds view: ',l
               if (perror(l).eq.142.)
     &              print *,'Packet length is zero! skipped: ',l
            enddo
C  
            print *,'                                                  '    
c            if (iev.eq.0) then
c               print *,'               +++ RECORDED +++ iev = ',iev2
c            else
               print *,'               +++ RECORDED +++ iev = ',iev     
c            endif
               if (calevnum(1).eq.0..or.
     &              calevnum(2).eq.0..or.
     &              calevnum(3).eq.0..or.
     &              calevnum(4).eq.0.) then
                  print *,'-| ZERO COUNTER |- '
                  print *,'   1 ',calevnum(1)
                  print *,'   2 ',calevnum(2)
                  print *,'   3 ',calevnum(3)
                  print *,'   4 ',calevnum(4)
               endif
        print *,'                                                     '
        print *,'*****************************************************'
c            if (cho.eq.'debug') then
c               call prevento
c               goto 50
c            endif
        


       oldcalev0 = calev0
       calev0 = calevnum(1)
       oldcalev1 = calev1
       calev1 = calevnum(2)
       oldcalev2 = calevv2
       calevv2 = calevnum(3)
       oldcalev3 = calev3
       calev3 = calevnum(4)
       if ( (calev0+calev3-calevv2-calev1).ne.0 ) then
	   print *,'0 Event 0: ',calev0	   
	   print *,'1 Event 0: ',calev1	   
	   print *,'2 Event 0: ',calevv2	   
	   print *,'3 Event 0: ',calev3
        endif
       if ( (calev0 - oldcalev0 - 1).ne.0.or.
     &       (calev1 - oldcalev1 - 1).ne.0.or. 
     &       (calevv2 - oldcalev2 - 1).ne.0.or.
     &       (calev3 - oldcalev3 - 1).ne.0 ) then
          print *,'0 Event -1: ',oldcalev0
          print *,'0 Event 0: ',calev0	   
          print *,'1 Event -1: ',oldcalev1
          print *,'1 Event 0: ',calev1	   
          print *,'2 Event -1: ',oldcalev2
          print *,'2 Event 0: ',calevv2   
          print *,'3 Event -1: ',oldcalev3
          print *,'3 Event 0: ',calev3
       endif


            if (cho.eq.'pedestal') then
               call hfnt(1)
            elseif (cho.eq.'data') then
               call hfnt(2)
            elseif (cho.eq.'pulse') then
               call hfnt(3)
            elseif (cho.eq.'all') then
               call hfnt(1)
               call hfnt(2)
               call hfnt(3)
            endif
         contr = 1
c
         endif
C
 666     continue
c       
         do p=1,40000
            vecta(p) = 0
         enddo
         do l = 1,4
            perror(l) = 0.
            stwerr(l) = 0
            stwer(l) = 0
            perr(l) = 0
            stwerr(l) = 0
            perror(l) = 0.
         enddo
         call clearall
C            
         if (silofa.eq.2) goto 50
c     
 9       continue
c
      enddo
 10   FORMAT(2X,'Numero ',2X,I4,2X,' valore: ',Z8)
 13   FORMAT(2X,'CRC dai dati  ',Z8)
 14   FORMAT(2X,'CRC calcolato ',Z128)
 50   continue
C    
      CLOSE (44)
c   
      print *,'Any other data file (Y/N)?'
      READ(*,51)answ
      print *,answ
 51   format(A1)
      IF (ANSW.EQ.'Y'.or.answ.eq.'y') GOTO 7
c     
c     /* Save histograms */

c
      CALL HROUT(0,icycle,' ')
      CALL HREND('Event')
      CLOSE (59)
C
C     end
C
 52   continue
      RETURN
      END


