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