       SUBROUTINE SAX_ACC_B3S5(INCREMENT_ROUTINE)
       EXTERNAL INCREMENT_ROUTINE
C
C----------------------------------------------------------------------
C
C.IDENTIFICATION: Subroutine SAX_ACC_B3S5
C.LIBRARY:        FOTLIB
C.AUTHOR:         L.Chiappetti - IFCTR Milano
C.VERSIONS:       0.0 - 09 Jul 96- based on SAX_ACC_B3S4 0.3
C                 0.5 - 25 Nov 96 - times in double precision
C                 0.6 - 28 Feb 97 - fixed bug in time recycle
C.PURPOSE:        read FOT VC1 NFI HK packets
C.METHOD:         loop on packets and samples and call INCREMENT_ROUTINE
C.SYNTAX:         CALL  SAX_ACC_B3S5(INCREMENT_ROUTINE)
C.PARAMETERS:     EXTERNAL increment_routine : real accumulation routine
C.RESTRICTIONS:   
C.NOTES:          new st#5 defined for spacecrafdt data
C.FILES:
C.REFERENCES
C
C----------------------------------------------------------------------
C
C+++++
C      accumulation for FOT s/c HKD data (bt#3:st#5:du=any)
C+++++ 
       INTEGER    ITYPE,J1,J2,I
       INTEGER PACKET_POINTER,EVENT_POINTER,IERR,NEV,NEVENT,NW,NS
       INTEGER    ITL,ITS,ITOT,ITP,ISBIT
       DOUBLE PRECISION    TIME1,TCYCLE,OLDTIME,UDOUBLE,DELTA
       INTEGER    NVALID
       INTEGER LUTMP,IOBS
       LOGICAL Z_BREAK
       CHARACTER  DUMMY,TEMP
       LOGICAL    FOUND,ENDOFDATA,CONVERT,QUIET,MASKED,FIRST
C      this is an internal buffer to hold the largest "telemetry" packet buffer
C-->   provisionally size to 2500 bytes; should accomodate any HK easily
       CHARACTER RECORD*2500  
       INTEGER   IRECORD(1250)
       EQUIVALENCE (RECORD,IRECORD)
C
C      equivalences to hold a single subfield of one event
       CHARACTER CX*4,C2(2)*2,C1(4)*1
       INTEGER*4 I4
       INTEGER*2 I2(2)
       EQUIVALENCE (CX,C2,C1),(CX,I4),(C2(1),I2)  
       INCLUDE  'hcommon.inc'
       INCLUDE  'bincommon.inc'
       INCLUDE  'accumcommon.inc'
       INCLUDE  'syscommon.inc' 
       INCLUDE  'hkcommon.inc' 
       INCLUDE  'wcommon.inc'
       INCLUDE  'timecommon.inc'
C
C      Time cycling constant definition
C
*      TCYCLE=2.D0**32*TIMECOMMON_CONVERSION   was wrong !
       TCYCLE=2.D0**32*TIMECOMMON_SCCONVERSION
       OLDTIME=0.D0
       DELTA=DELTAT/ACCUMCOMMON_IXZOOM(1)
C
C      get some basic packet info : header length, no.of samples in packet
C-->   all these should check if FOUND
*      CALL PKTCAP_LOOKUP('hl',ITYPE,IHL,DUMMY,FOUND)
       CALL PKTCAP_LOOKUP('ni',ITYPE,NEVENT,DUMMY,FOUND)
C      NB these packets have NO invalid data pointer, hence ex-officio set
       NVALID=NEVENT
C
C-->   following code is provisional
C      start byte of time and its width (2 for ground 4 for FOT)
C      (for FOT take into account each original block has its own time)
C      (therefore the offset to the start of the first block shall be found)
       CALL PKTCAP_LOOKUP ('tl',ITYPE,ITL,DUMMY,FOUND)
       CALL PKTCAP_LOOKUP ('ts',ITYPE,ITS,DUMMY,FOUND)
C      number of significant bits
       CALL SAX_PCF_LOOKUP('sb',I,ISBIT,DUMMY,FOUND)
       IF(.NOT.FOUND)ISBIT=HKLENGTH
       IF(ISBIT.NE.HKLENGTH)THEN
          MASKED=.TRUE.
          ISBIT=2**ISBIT
       ENDIF
C
C      set record counter to zero 
       PACKET_POINTER =0
       ACCUMCOMMON_TOTPKT =0
C-->   telemetry file is opened in main ....   
       ENDOFDATA=.FALSE.
C-->   is byte swap conversion needed (same for I2 and I4 provisionally)    
       CONVERT=SYSCOMMON_ICONV.EQ.1   
       IF(CONVERT)
     . WRITE(*,*)' packet data will be read and byte-swapped ',
     .           'as needed'
       NW=ACCUMCOMMON_RECL/2
C       default is not QUIET mode (echo each record copied)
        CALL GET_GLOBAL_DEFAULT('QUIET','N',TEMP)
        CALL UPCASE(TEMP(1:1))
        QUIET=TEMP(1:1).NE.'N'
C
C      loop on packets
C
 1     CONTINUE
          IF (Z_BREAK())GOTO 99
          OLDTIME=TIME1
          PACKET_POINTER=PACKET_POINTER+1
*         write(*,*)' before read ',packet_pointer
C-->      error policy to be implemented
          READ(ACCUMCOMMON_LU,REC=PACKET_POINTER,IOSTAT=IERR) 
     .    RECORD(1:ACCUMCOMMON_RECL)
          ACCUMCOMMON_TOTPKT=ACCUMCOMMON_TOTPKT+1
*         write(*,*)' after read '
          EVENT_POINTER=HKPOSIT
          IF(.NOT.QUIET)
     .    write(*,*)'read HK packet ',packet_pointer    ,
     .    CHAR(27)//'[A'
          ITOT=(NVALID-1)*DELTA
C
C         extraction of start time is done separately for each sample
C         at a given location ITP
          ITP=ITL+HKTIMOFF
C
C         loop on samples
C
          DO 10 NEV=1,COMMUTATION 
C
C           compute time of this sample
C           for all samples read time directly from file in appropriate location !
C-->        to speed up one might ignore ITS and freeze it to 4 bytes
C-->        but s/c HKD use 2 bytes !
            CX=RECORD(ITP:ITP+ITS-1)
            IF(ITS.EQ.2)THEN
              IF(CONVERT)CALL SWAPI2(I2,1)
              i2(2)=0
            ELSEIF(ITS.EQ.4)THEN
              IF(CONVERT)CALL SWAPI4(I4,1)
            ENDIF
            ACCUMCOMMON_J(1) = I4
*           write(*,*)' debug time this sample',nev,ACCUMCOMMON_J(1)
C-->        temporary ? protection
C-->        it appears in test FOTs there are data with time=0 value=0
C-->        they confuse the new timewindow arrangement
C-->        therefore they are screened out here
            IF (ACCUMCOMMON_J(1).EQ.0) THEN
               WRITE(*,*)' WARNING : zero time at ',packet_pointer,nev
               GOTO 9
            ENDIF
            TIME1=UDOUBLE(ACCUMCOMMON_J(1))*TIMECOMMON_CONVERSION+
     .            ACCUMCOMMON_TRECYCL
*           write(*,*)' debug R8 time this sample',nev,TIME1
            IF(TIME1.LT.OLDTIME)THEN
              TIME1=TIME1+TCYCLE
              ACCUMCOMMON_TRECYCL=ACCUMCOMMON_TRECYCL+TCYCLE
	    ENDIF
            ACCUMCOMMON_T=TIME1
*           write(*,*)' debug ** time this sample',nev,TIME1
C
C           verify time is in wished range
*           IF (ACCUMCOMMON_J(1).LT.ACCUMCOMMON_IEL(1)) GOTO 9
*           IF (ACCUMCOMMON_J(1).GT.ACCUMCOMMON_IEH(1)) GOTO 9
            IF (ACCUMCOMMON_T.LT.TIMELO) GOTO 9
            IF (ACCUMCOMMON_T.GT.TIMEHI) GOTO 9
C
C           Start time
C
            IF(FIRST)THEN
              FIRST=.FALSE.
              TIMECOMMON_START=ACCUMCOMMON_T
            ENDIF
C
C           introduce further loop for pseudo-supercommutated case
            DO 8 NS=1,HKSUPER
            ACCUMCOMMON_T=ACCUMCOMMON_T+(NS-1)*DELTA
*           write(*,*)' debug time this subsample',ACCUMCOMMON_T
C
C           take one sample of the relevant parameter in a character buffer
C-->        by preliminary convention value is second element of array J
C
C           extract the relevant fields
C           byte swap done once forever above ....
C-->        so far does not support bit fields ... HKLENGTH is 8/16/32 only
            J1=EVENT_POINTER
            J2=J1+HKLENGTH/16
*           write (*,*)nev,' extracting bytes ',j1,j2
            I4=0
            CX=RECORD(j1:j2) 
            IF(HKLENGTH.EQ.8)THEN
C-->           to be verified
               ACCUMCOMMON_J(2)=ICHAR(C1(1))
            ELSEIF(HKLENGTH.EQ.16)THEN
               IF(CONVERT)CALL SWAPI2(I2(1),1)
               IF(MASKED)then
                  ACCUMCOMMON_J(2)=MOD(I4,ISBIT)
*                 write(*,*)i2,ACCUMCOMMON_J(2)
               else
                  ACCUMCOMMON_J(2)=I2(1)
               endif
            ELSEIF(HKLENGTH.EQ.32)THEN
               IF(CONVERT)CALL SWAPI4(I4,1)
               IF(MASKED)then
                  ACCUMCOMMON_J(2)=MOD(I4,ISBIT)
               else
                  ACCUMCOMMON_J(2)=I4
               endif
            ELSE
C              it is a bit field
C-->           not supported so far, set to zero ????
               ACCUMCOMMON_J(2)=0
            ENDIF
C
C           now process accepted events 
C-->        optional counters 
C-->        NTAKEN=NTAKEN+1
*           write(*,*)' debug valu this sample',ACCUMCOMMON_J(2)
            CALL INCREMENT_ROUTINE
            EVENT_POINTER=EVENT_POINTER+HKSECOFF
  8         CONTINUE
C           in case of transit thru the supercommutation loop
C           re-establish event pointer of first in packet
            EVENT_POINTER=EVENT_POINTER-HKSUPER*HKSECOFF
  9        CONTINUE
           EVENT_POINTER=EVENT_POINTER+HKOFFSET
           ITP          =ITP          +HKOFFSET
C
C          in case of time windows verify advance to next window needed
*          IF(WINDOWS)THEN
             IF (ACCUMCOMMON_T.GT.TIMEHI) THEN
                WCOMMON_WPTR=WCOMMON_WPTR+1
                IF(WCOMMON_WPTR.LE.WCOMMON_N)THEN
C                if not after last time window
C                set time range to next window
                 TIMELO=
     .           WCOMMON_START(WCOMMON_WPTR+WCOMMON_SOFF)
                 TIMEHI=
     .           WCOMMON_END(WCOMMON_WPTR+WCOMMON_EOFF)
                write(*,*)' window advance ',TIMELO,TIMEHI
                ELSE
C                 if after last time window terminate
*                 WRITE(*,*)' terminating after last time window'  
                  GOTO 99
                ENDIF
             ENDIF
*          ENDIF
*          read(*,*,end=99)
 10      CONTINUE
C        IF event is last of last packet of last observation 
C        set end-of-data condition
C        it is NEVER necessary to consider partially full packets as end-of-data
C        since NVALID and NEVENT are set equal by definition (no check possible)
C        this means it is the last packet
         IF(PACKET_POINTER.GE.ACCUMCOMMON_NREC)ENDOFDATA=.TRUE.
         IF(.NOT.ENDOFDATA) GOTO 1
C        these data are organized by observing period
C        not by observations, hence terminate at EOF of the only file
 99      continue
C
C       End time is the time of last sample
C
         TIMECOMMON_END=ACCUMCOMMON_T
       RETURN
       END       
