PROGRAM CALDUMP C C EDR HEADER UNPACKING PROGRAM WRITTEN TO BE IMPLEMENTED UNDER VMS C ARCHITECTURE. EDR DATA IS WRITTEN FOR THE IBM 360 ARCHITECTURE. C LOGICAL*1 REC(11280) CHARACTER*4 TFLAG CHARACTER*50 DSN INTEGER*2 RECLEN,EDRTIME(6),SCETIME(6),SERTIME(6),EERTIME(6) INTEGER*4 SCMODE,MODECNT(-1:13)/15*0/ C INCLUDE 'UNPACK.INC' C TFLAG = 'SCET' C C CREATE BIT FLIP TRANSLATION TABLE FOR LOGICAL*1 WORDS. C ASSIGN FLIP(0:255) THE BIT FLIP INVERSE OF VALUES 0 TO 255. C DO J=0,255 DO I=0,7 CALL MOVBIT(J, I, 1, FLIP(J), 7-I) END DO END DO C C OPEN BINARY EDR INPUT DATASET C WRITE(6,*) WRITE(6,*) 'ENTER EDR INPUT DSN ' READ(5,'(Q,A)') LEN,DSN WRITE(6,*) WRITE(6,*) DSN WRITE(6,*) OPEN(50,FILE=DSN,STATUS='OLD',FORM='FORMATTED', & RECORDTYPE='VARIABLE',RECL=8191,READONLY) NCNT = 0 10 CONTINUE READ(50,'(Q,A1)',END=100) RECLEN,(REC(I),I=1,RECLEN) NCNT = NCNT + 1 CALL UNHEAD(REC) C C GET SUMMARY TELEMETRY MODE IDENTIFIER C SCMODE = MODE(NCNT) C C ASSIGN SELECTED TIME TYPE TO EDRTIME C CALL GETTIME(TFLAG,SERTIME,EERTIME,SCETIME,EDRTIME) CALL DISPLAY(RECLEN,NCNT,TFLAG,EDRTIME) C C UNPACK DECOMMUTATION MAP C IF ( RECID.EQ.15 .AND. SYS2(3) ) THEN MODECNT(SCMODE) = MODECNT(SCMODE) + 1 CALL UNPACKDEC(REC) GOTO 10 C C UNPACK ENGINEERING RECORD C ELSE IF ( RECID.EQ.11 .AND. SYS2(3) ) THEN MODECNT(SCMODE) = MODECNT(SCMODE) + 1 CALL UNPACKENG(REC) GOTO 10 END IF C C PROCESS MAG RECORDS FOR SELECTED TIME INTERVAL C IF ( RECID.EQ.4.AND.SCID.LE.1 ) THEN C C CALL UNPACKING PROCEDURE APPROPRIATE TO MODE AND RECORD TYPE C MODECNT(SCMODE) = MODECNT(SCMODE) + 1 IF ( SCMODE.EQ.13 ) THEN CALL UNPACKVIM5(REC) ELSE IF ( SCMODE.EQ.6 ) THEN CALL UNPACKCR6(REC) ELSE IF ( SCMODE.EQ.5 ) THEN CALL UNPACKCR5(REC) ELSE IF ( SCMODE.EQ.4 ) THEN CALL UNPACKCR4(REC) ELSE IF ( SCMODE.EQ.3 ) THEN CALL UNPACKCR3(REC) ELSE IF ( SCMODE.EQ.2 ) THEN CALL UNPACKCR2(REC) ELSE IF ( SCMODE.EQ.1 ) THEN CALL UNPACKCR1(REC) ELSE IF ( SCMODE.EQ.0 ) THEN CALL UNPACKGS3(REC) ELSE GOTO 10 END IF END IF GOTO 10 100 CONTINUE WRITE(6,*) WRITE(6,*) NCNT,' TOTAL EDR''S' WRITE(6,*) C STOP END ****************************************************************** C C DISPLAY KEY VALUES FROM UNPACKED EDR C SUBROUTINE DISPLAY(RECLEN,NCNT,TFLAG,TIME) INTEGER*2 RECLEN,TIME(6) CHARACTER*4 TFLAG,EX(0:15) CHARACTER*6 DM(0:31) CHARACTER*7 DDT(32:48) C INCLUDE 'UNPACK.INC' C DATA EX/'***','CRS','IRIS','LECP','MAG','PLS','PPS','PRA','PWS', & 'UVS','RSS','ENG','***','ISR','MR','DMR'/ DATA DM/'ENG','CR-2','CR-3','CR-4','CR-5','CR-6','CR-7','CR-1', & 'GS-10A','***','GS-3','***','GS-7','***','GS-6','GS-4', & '***','GS-2','***','***','***','***','OC-2','OC-1', & 'CR-5A','GS-10','GS-8','***','***','UV-5A','***','***'/ DATA DDT/'IRIS','CRS','LECP','MAG','PLS','PPS','PRA','PWS','UVS', & 'ISR','DCOM','MON 5-8','ENGS','ENGE','DCMS','ENGC', & 'MON 5-9'/ C WRITE(6,900) NCNT,RECNUM,RECLEN,PROJID,EX(RECID),SCID, & TFLAG,TIME,DM(DATMOD),DDT(DRSDAT) RETURN 900 FORMAT(1X,I6,1X,I6,1X,I5,' BYTES',1X,A3,1X,A4,1X,I2,1X,A4, & 1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,A6,1X,A7) END ****************************************************************** SUBROUTINE CONSEC(SOH,TIME) C C CONVERT I*2 SECONDS OF HOUR INTO MINUTES AND SECONDS. C INTEGER*2 SOH,TIME(6) TIME(4) = INT(SOH/60.0) TIME(5) = NINT(((SOH/60.0)-TIME(4))*60.0) RETURN END ****************************************************************** SUBROUTINE CONHOUR(HOY,TIME) C C CONVERT I*2 HOUR OF YEAR INTO DAYS AND HOURS. C INTEGER*2 HOY,TIME(6) TIME(2) = INT(HOY/24.0) TIME(3) = NINT(((HOY/24.0)-TIME(2))*24.0) RETURN END ****************************************************************** SUBROUTINE GETTIME(TFLAG,SERTIME,EERTIME,SCETIME,EDRTIME) C C CONVERT EDR TIME TAGS TO CALENDAR UNITS C CHARACTER*4 TFLAG INTEGER*2 SERTIME(6),EERTIME(6),SCETIME(6),EDRTIME(6) C INCLUDE 'UNPACK.INC' C SERTIME(1) = YEAR1 CALL CONHOUR(ERTSHR,SERTIME) CALL CONSEC(ERTSSC,SERTIME) SERTIME(6) = ERTSML C EERTIME(1) = YEAR2 CALL CONHOUR(ERTEHR,EERTIME) CALL CONSEC(ERTESC,EERTIME) EERTIME(6) = ERTEML C SCETIME(1) = YEAR3 CALL CONHOUR(SCETHR,SCETIME) CALL CONSEC(SCETSC,SCETIME) SCETIME(6) = SCETML C C SELECT TIME TYPE FOR EDR TIME C IF (TFLAG.EQ.'ERTS') THEN DO I = 1,6 EDRTIME(I) = SERTIME(I) END DO ELSE IF (TFLAG.EQ.'ERTE') THEN DO I = 1,6 EDRTIME(I) = EERTIME(I) END DO ELSE IF (TFLAG.EQ.'SCET') THEN DO I = 1,6 EDRTIME(I) = SCETIME(I) END DO END IF C RETURN END ****************************************************************** C C ROUTINE TO EXTRACT N BITS FROM ARRAY DATA STARTING AT BIT POSITION IOFF C AND PLACE THESE BITS INTO WORD VAL STARTING AT BIT POSITION IBEG. C SUBROUTINE MOVBIT(DATA,POS,NBITS,VAL,IBEG) C C DATA INPUT DATA ARRAY C POS STARTING BIT POSISTION WITHIN ARRAY DATA (0 = FIRST BIT) C NBITS NUMBER OF BITS TO BE MOVED C VAL OUTPUT WORD C IBEG STARTING BIT FOR INSERTION OF COPIED BITS C INTEGER*4 VAL INTEGER*4 DATA(1),POS LOGICAL*4 IVAL C IWORD = INT(POS/32) + 1 IOFF = MOD(POS,32) DO I=0,NBITS-1 IVAL = BTEST(DATA(IWORD),IOFF+I) IF (IVAL) VAL = (IBSET(VAL,IBEG+I)) IF (.NOT.IVAL) VAL = (IBCLR(VAL,IBEG+I)) END DO C RETURN END INTEGER FUNCTION MODE(ISTAT) C C THIS FUNCTION IDENTIFIES THE APPROPRIATE TELEMETRY MODE FOR PROCESSING C C CR-1 = 1 C CR-2 = 2 C CR-3 = 3 C CR-4 = 4 C CR-5 = 5 C CR-6 = 6 C CR-7 = 9 C GS = 0 C ENG = 8 C VIM-5 = 13 C N/A = -1 C INCLUDE 'UNPACK.INC' C ISTAT = 0 C IF (DATMOD.EQ.0) MODE = 8 IF (DATMOD.EQ.1) MODE = 2 IF (DATMOD.EQ.2) MODE = 3 IF (DATMOD.EQ.3) MODE = 4 IF (DATMOD.EQ.4) MODE = 5 IF (DATMOD.EQ.5) MODE = 6 IF (DATMOD.EQ.6) MODE = 9 IF (DATMOD.EQ.7) MODE = 1 IF (DATMOD.EQ.8) MODE = -1 IF (DATMOD.EQ.9) MODE = -1 IF (DATMOD.EQ.10) MODE = 0 IF (DATMOD.EQ.11) MODE = -1 IF (DATMOD.EQ.12) MODE = 0 IF (DATMOD.EQ.13) MODE = -1 IF (DATMOD.EQ.14) MODE = 0 IF (DATMOD.EQ.15) MODE = 0 IF (DATMOD.EQ.16) MODE = -1 IF (DATMOD.EQ.17) MODE = -1 IF (DATMOD.EQ.18) MODE = -1 IF (DATMOD.EQ.19) MODE = -1 IF (DATMOD.EQ.20) MODE = -1 IF (DATMOD.EQ.21) MODE = -1 IF (DATMOD.EQ.22) MODE = 0 IF (DATMOD.EQ.23) MODE = 0 IF (DATMOD.EQ.24) MODE = 13 IF (DATMOD.EQ.25) MODE = -1 IF (DATMOD.EQ.26) MODE = 0 IF (DATMOD.EQ.27) MODE = -1 IF (DATMOD.EQ.28) MODE = -1 IF (DATMOD.EQ.29) MODE = 13 IF (DATMOD.EQ.30) MODE = -1 IF (DATMOD.EQ.31) MODE = -1 C IF (DATMOD.LT.0.OR.DATMOD.GT.31) THEN WRITE(6,*) WRITE(6,*) '***INVALID DATMOD VALUE***' ISTAT = 1 MODE = -1 END IF C C WRITE(6,*) 'DATMOD,MODE ',DATMOD,MODE C RETURN END ****************************************************************** * * TITLE: UNPACK VOYAGER 60 WORD EDR HEADER * * FILE NAME: UNHEAD.FOR * * PURPOSE: TO UNPACK THE HEADER BLOCK * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------ * S. J. KEMPLER 8/12/85 ORIGINAL CODE * S. B. KRAMER 9/27/92 MODIFIED FOR VIM-5 MODE * S. B. KRAMER 10/26/93 MODIFIED FOR ALL MODES * * CALLING SEQUENCE: SUBROUTINE UNHEAD(INBUF) * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * GET HEADER BLOCK FROM EDR RECORD * CALL MOVBIT TO LOAD DATMOD WITH DATA MODE * CALL MOVBIT TO LOAD MOD60 WITH MOD 60 COUNT WORD * LOAD PROJID WITH THE 3 CHARACTER PROJECT ID * CALL MOVBIT TO LOAD ALL OTHER ITEMS OF THE HEADER FIELD * INTO INDIVIDUAL I*2 VARIABLES * RETURN * ******************************************************************* C SUBROUTINE UNHEAD(INBUF) C LOGICAL*1 INBUF(11280),LPROJ(3) C INCLUDE 'UNPACK.INC' C EQUIVALENCE (PROJID,LPROJ(1)) C C ASSIGN FIRST 240 BYTES OF EDR RECORD TO HEADER ARRAY (ALL MODES) C DO I = 1,240 HEAD(I) = INBUF(I) END DO C LPROJ(1) = HEAD(1) LPROJ(2) = HEAD(2) LPROJ(3) = HEAD(3) C ISTAT = LIB$TRA_EBC_ASC(PROJID,PROJID) C C IDENTIFY MARINER JUPITER SATURN (MJS) PROJECT ID C IF (PROJID.NE.'MJS') RETURN C C ERROR IN KEMPLER'S DECOMMUTATION REVERSES RECID AND SCID C CORRECTED FOR VIM-5 PROCESSING (SBK - 10/8/92) C HEAD(4) = FLIP(ZEXT(HEAD(4))) RECID = 0 CALL MOVBIT( HEAD, 24, 1, RECID, 3) CALL MOVBIT( HEAD, 25, 1, RECID, 2) CALL MOVBIT( HEAD, 26, 1, RECID, 1) CALL MOVBIT( HEAD, 27, 1, RECID, 0) SCID = 0 CALL MOVBIT( HEAD, 28, 1, SCID, 3) CALL MOVBIT( HEAD, 29, 1, SCID, 2) CALL MOVBIT( HEAD, 30, 1, SCID, 1) CALL MOVBIT( HEAD, 31, 1, SCID, 0) C RECNUM = 0 CALL MOVBIT( HEAD, 40, 8, RECNUM, 0) CALL MOVBIT( HEAD, 32, 8, RECNUM, 8) DATMOD = 0 CALL MOVBIT( HEAD, 48, 8, DATMOD, 0) C HEAD(8) = FLIP(ZEXT(HEAD(8))) EEXTFL = 0 CALL MOVBIT( HEAD, 56, 1, EEXTFL, 1) CALL MOVBIT( HEAD, 57, 1, EEXTFL, 0) SCPLAB = 0 CALL MOVBIT( HEAD, 58, 1, SCPLAB, 0) RECTIM = 0 CALL MOVBIT( HEAD, 59, 1, RECTIM, 4) CALL MOVBIT( HEAD, 60, 1, RECTIM, 3) CALL MOVBIT( HEAD, 61, 1, RECTIM, 2) CALL MOVBIT( HEAD, 62, 1, RECTIM, 1) CALL MOVBIT( HEAD, 63, 1, RECTIM, 0) C ERTSHR = 0 CALL MOVBIT( HEAD, 72, 8, ERTSHR, 0) CALL MOVBIT( HEAD, 64, 8, ERTSHR, 8) ERTSSC = 0 CALL MOVBIT( HEAD, 88, 8, ERTSSC, 0) CALL MOVBIT( HEAD, 80, 8, ERTSSC, 8) ERTSML = 0 CALL MOVBIT( HEAD, 104, 8, ERTSML, 0) CALL MOVBIT( HEAD, 96, 8, ERTSML, 8) YEAR1 = 0 CALL MOVBIT( HEAD, 112, 8, YEAR1, 0) C HEAD(16) = FLIP(ZEXT(HEAD(16))) DATSRC = 0 CALL MOVBIT( HEAD, 120, 1, DATSRC, 1) CALL MOVBIT( HEAD, 121, 1, DATSRC, 0) GOLAY = 0 CALL MOVBIT( HEAD, 122, 1, GOLAY, 1) CALL MOVBIT( HEAD, 123, 1, GOLAY, 0) SEGNUM = 0 CALL MOVBIT( HEAD, 124, 1, SEGNUM, 3) CALL MOVBIT( HEAD, 125, 1, SEGNUM, 2) CALL MOVBIT( HEAD, 126, 1, SEGNUM, 1) CALL MOVBIT( HEAD, 127, 1, SEGNUM, 0) C ERTEHR = 0 CALL MOVBIT( HEAD, 136, 8, ERTEHR, 0) CALL MOVBIT( HEAD, 128, 8, ERTEHR, 8) ERTESC = 0 CALL MOVBIT( HEAD, 152, 8, ERTESC, 0) CALL MOVBIT( HEAD, 144, 8, ERTESC, 8) ERTEML = 0 CALL MOVBIT( HEAD, 168, 8, ERTEML, 0) CALL MOVBIT( HEAD, 160, 8, ERTEML, 8) YEAR2 = 0 CALL MOVBIT( HEAD, 176, 8, YEAR2, 0) SWVERS = 0 CALL MOVBIT( HEAD, 184, 8, SWVERS, 0) SCETHR = 0 CALL MOVBIT( HEAD, 200, 8, SCETHR, 0) CALL MOVBIT( HEAD, 192, 8, SCETHR, 8) SCETSC = 0 CALL MOVBIT( HEAD, 216, 8, SCETSC, 0) CALL MOVBIT( HEAD, 208, 8, SCETSC, 8) SCETML = 0 CALL MOVBIT( HEAD, 232, 8, SCETML, 0) CALL MOVBIT( HEAD, 224, 8, SCETML, 8) YEAR3 = 0 CALL MOVBIT( HEAD, 240, 8, YEAR3, 0) C HEAD(32) = FLIP(ZEXT(HEAD(32))) SCEVFL = 0 CALL MOVBIT( HEAD, 248, 1, SCEVFL, 3) CALL MOVBIT( HEAD, 249, 1, SCEVFL, 2) CALL MOVBIT( HEAD, 250, 1, SCEVFL, 1) CALL MOVBIT( HEAD, 251, 1, SCEVFL, 0) CORRFL = 0 CALL MOVBIT( HEAD, 252, 1, CORRFL, 3) CALL MOVBIT( HEAD, 253, 1, CORRFL, 2) CALL MOVBIT( HEAD, 254, 1, CORRFL, 1) CALL MOVBIT( HEAD, 255, 1, CORRFL, 0) C MOD216 = 0 CALL MOVBIT( HEAD, 264, 8, MOD216, 0) CALL MOVBIT( HEAD, 256, 8, MOD216, 8) MOD60 = 0 CALL MOVBIT( HEAD, 272, 8, MOD60, 0) LINCNT = 0 CALL MOVBIT( HEAD, 288, 8, LINCNT, 0) CALL MOVBIT( HEAD, 280, 8, LINCNT, 8) TELRAT = 0 CALL MOVBIT( HEAD, 296, 8, TELRAT, 0) EFFRAT = 0 CALL MOVBIT( HEAD, 304, 8, EFFRAT, 0) FORMID = 0 CALL MOVBIT( HEAD, 312, 8, FORMID, 0) BERTOL = 0 CALL MOVBIT( HEAD, 320, 8, BERTOL, 0) DSNCON = 0 CALL MOVBIT( HEAD, 328, 8, DSNCON, 0) RECAGC = 0 CALL MOVBIT( HEAD, 344, 8, RECAGC, 0) CALL MOVBIT( HEAD, 336, 8, RECAGC, 8) DSNNUM = 0 CALL MOVBIT( HEAD, 352, 8, DSNNUM, 0) EBEC = 0 CALL MOVBIT( HEAD, 376, 8, EBEC, 0) CALL MOVBIT( HEAD, 368, 8, EBEC, 8) SYMSNR = 0 CALL MOVBIT( HEAD, 392, 8, SYMSNR, 0) CALL MOVBIT( HEAD, 384, 8, SYMSNR, 8) DECSNR = 0 CALL MOVBIT( HEAD, 408, 8, DECSNR, 0) CALL MOVBIT( HEAD, 400, 8, DECSNR, 8) PHYSRN = 0 CALL MOVBIT( HEAD, 424, 8, PHYSRN, 0) CALL MOVBIT( HEAD, 416, 8, PHYSRN, 8) C C 8 BIT DATA QUALITY STATUS WORD//8 BIT DATA QUALITY INDICATOR C DO 10 I=1,10 J = (I-1) * 16 DQSW(I) = 0 CALL MOVBIT( HEAD, 432+J, 8, DQSW(I), 0) DQI(I) = 0 CALL MOVBIT( HEAD, 440+J, 8, DQI(I), 0) 10 CONTINUE C C UNPACK 4 BIT DATA PRESENCE INDICATORS (80 MF MAX) C CR-7 AND VIM-5 MODES C IF ( DATMOD.EQ.6 .OR. DATMOD.EQ.24 .OR. DATMOD.EQ.29 ) THEN DO 20 I=1,40 J = (I-1) * 8 K = I*2 - 1 L = I*2 DPI(K) = 0 DPI(L) = 0 CALL MOVBIT( HEAD, 592+J, 4, DPI(L), 0) CALL MOVBIT( HEAD, 596+J, 4, DPI(K), 0) 20 CONTINUE C C UNPACK 8 BIT DATA PRESENCE INDICATORS (150 MF MAX) C CR-1 THROUGH CR-6 MODES C ELSE IF ( DATMOD.GE.1 .AND. DATMOD.LE.7 .AND. DATMOD.NE.6 ) THEN DO 30 I=1,150 J = (I-1)*8 DPI(I) = 0 CALL MOVBIT( HEAD, 592+J, 8, DPI(I), 0) 30 CONTINUE C C UNPACK 8 BIT DATA PRESENCE INDICATORS AND 8 BIT GOLAY CORRECTION C INDICATORS (80 MF MAX) C GS-X MODES C ELSE IF ( DATMOD.LE.31 ) THEN DO 40 I=1,80 J = (I-1)*16 DPI(I) = 0 CALL MOVBIT( HEAD, 592+J, 8, DPI(I), 0) GCI(I) = 0 CALL MOVBIT( HEAD, 600+J, 8, GCI(I), 0) 40 CONTINUE ELSE C INVALID DATMOD VALUE END IF C C FIELDS GCI, DPIRIS, GPIRIS ARE NOT USED IN VIM-5 MODE. C THEREFORE BITS 892 - 1887 ARE SPARES. C DRSDAT = 0 CALL MOVBIT( HEAD, 1888, 8, DRSDAT, 0) GCBEC = 0 CALL MOVBIT( HEAD, 1896, 8, GCBEC, 0) GBITES = 0 CALL MOVBIT( HEAD, 1912, 8, GBITES, 0) CALL MOVBIT( HEAD, 1904, 8, GBITES, 8) C RETURN END ****************************************************************** * * TITLE: DRIVER FOR UNPACKING VOYAGER CR-1 MAG (PLS) EDR * * FILE NAME: UNPACKCR1.FOR * * PURPOSE: TO CALL THE ROUTINES UNPACK THE SUBHEADER (PLS DATA) * AND UNPACK THE MAG DATA. * * HISTORY: * * AUTHOR DATE CHANGE * ------ ---- ------ * S. B. KRAMER 10/03/95 ORIGINAL CODE * * CALLING SEQUENCE: SUBROUTINE UNPACKCR1 (INBUF) * * MODULES REFERENCED: * * PLSCR1, MAGCR1 * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * CALL PLSCR1 TO UNPACK THE 360 SUBHEADER PLS DATA WORDS * CALL MAGCR1 TO UNPACK THE 2400 MAG DATA WORDS * RETURN * ******************************************************************* SUBROUTINE UNPACKCR1(INBUF) C LOGICAL*1 INBUF(11280) C INCLUDE 'UNPACK.INC' C C SEPARATE SUB-HEADER (PLASMA) DATA (1440 BYTES) C DO 2 I=241,1680 J=I-240 PLS(J) = INBUF(I) 2 CONTINUE C C SEPARATE MAG SCIENCE BLOCK (9600 BYTES) C DO 3 I=1681,11280 J=I-1680 MAG(J) = INBUF(I) 3 CONTINUE C CALL PLSCR1() CALL MAGCR1() C RETURN END ****************************************************************** * * TITLE: DRIVER FOR UNPACKING VOYAGER CR-2 MAG (PLS) EDR * * FILE NAME: UNPACKCR2.FOR * * PURPOSE: TO CALL THE ROUTINES UNPACK THE SUBHEADER (PLS DATA) * AND UNPACK THE MAG DATA. * * HISTORY: * * AUTHOR DATE CHANGE * ------ ---- ------ * S. B. KRAMER 02/01/96 ORIGINAL CODE * * CALLING SEQUENCE: SUBROUTINE UNPACKCR2 (INBUF) * * MODULES REFERENCED: * * PLSCR2, MAGCR2 * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * CALL PLSCR2 TO UNPACK THE 66 SUBHEADER PLS DATA WORDS * CALL MAGCR2 TO UNPACK THE 1508 MAG DATA WORDS * RETURN * ******************************************************************* SUBROUTINE UNPACKCR2(INBUF) C LOGICAL*1 INBUF(11280) C INCLUDE 'UNPACK.INC' C C SEPARATE SUB-HEADER (PLASMA) DATA (264 BYTES) C DO 2 I=241,504 J=I-240 PLS(J) = INBUF(I) 2 CONTINUE C C SEPARATE MAG SCIENCE BLOCK ( BYTES) C DO 3 I=505,6536 J=I-504 MAG(J) = INBUF(I) 3 CONTINUE C CALL PLSCR2() CALL MAGCR2() C RETURN END ****************************************************************** * * TITLE: DRIVER FOR UNPACKING VOYAGER CR-3 MAG (PLS) EDR * * FILE NAME: UNPACKCR3.FOR * * PURPOSE: TO CALL THE ROUTINES UNPACK THE SUBHEADER (PLS DATA) * AND UNPACK THE MAG DATA. * * HISTORY: * * AUTHOR DATE CHANGE * ------ ---- ------ * S. B. KRAMER 02/05/96 ORIGINAL CODE * * CALLING SEQUENCE: SUBROUTINE UNPACKCR3 (INBUF) * * MODULES REFERENCED: * * PLSCR3, MAGCR3 * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * CALL PLSCR3 TO UNPACK THE 116 SUBHEADER PLS DATA WORDS * CALL MAGCR3 TO UNPACK THE 750 MAG DATA WORDS * RETURN * ******************************************************************* SUBROUTINE UNPACKCR3(INBUF) C LOGICAL*1 INBUF(11280) C INCLUDE 'UNPACK.INC' C C SEPARATE SUB-HEADER (PLASMA) DATA (464 BYTES) C DO 2 I=241,704 J=I-240 PLS(J) = INBUF(I) 2 CONTINUE C C SEPARATE MAG SCIENCE BLOCK (3000 BYTES) C DO 3 I=705,3704 J=I-704 MAG(J) = INBUF(I) 3 CONTINUE C CALL PLSCR3() CALL MAGCR3() C RETURN END ****************************************************************** * * TITLE: DRIVER FOR UNPACKING VOYAGER CR-4 MAG (PLS) EDR * * FILE NAME: UNPACKCR4.FOR * * PURPOSE: TO CALL THE ROUTINES UNPACK THE SUBHEADER (PLS DATA) * AND UNPACK THE MAG DATA. * * HISTORY: * * AUTHOR DATE CHANGE * ------ ---- ------ * S. B. KRAMER 01/30/96 ORIGINAL CODE * * CALLING SEQUENCE: SUBROUTINE UNPACKCR4 (INBUF) * * MODULES REFERENCED: * * PLSCR4, MAGCR4 * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * CALL PLSCR4 TO UNPACK THE 218 SUBHEADER PLS DATA WORDS * CALL MAGCR4 TO UNPACK THE 720 MAG DATA WORDS * RETURN * ******************************************************************* SUBROUTINE UNPACKCR4(INBUF) C LOGICAL*1 INBUF(11280) C INCLUDE 'UNPACK.INC' C C SEPARATE SUB-HEADER (PLASMA) DATA (872 BYTES) C DO 2 I=241,1112 J=I-240 PLS(J) = INBUF(I) 2 CONTINUE C C SEPARATE MAG SCIENCE BLOCK (2880 BYTES) C DO 3 I=1113,3992 J=I-1112 MAG(J) = INBUF(I) 3 CONTINUE C CALL PLSCR4() CALL MAGCR4() C RETURN END ****************************************************************** * * TITLE: DRIVER FOR UNPACKING VOYAGER CR-5 MAG (PLS) EDR * * FILE NAME: UNPACKCR5.FOR * * PURPOSE: TO CALL THE ROUTINES UNPACK THE SUBHEADER (PLS DATA) * AND UNPACK THE MAG DATA. * * HISTORY: * * AUTHOR DATE CHANGE * ------ ---- ------ * S. B. KRAMER 09/26/94 ORIGINAL CODE * * CALLING SEQUENCE: SUBROUTINE UNPACKCR5 (INBUF) * * MODULES REFERENCED: * * UNPLS, UNMAG * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * CALL UNPLS TO UNPACK THE 322 SUBHEADER PLS DATA WORDS * CALL UNMAG TO UNPACK THE 1080 MAG DATA WORDS * RETURN * ******************************************************************* SUBROUTINE UNPACKCR5(INBUF) C LOGICAL*1 INBUF(11280) C INCLUDE 'UNPACK.INC' C C SEPARATE SUB-HEADER (PLASMA) DATA (1288 BYTES) C DO 2 I=241,1528 J=I-240 PLS(J) = INBUF(I) 2 CONTINUE C C SEPARATE MAG SCIENCE BLOCK (4320 BYTES) C DO 3 I=1529,5848 J=I-1528 MAG(J) = INBUF(I) 3 CONTINUE C CALL PLSCR5() CALL MAGCR5() C RETURN END ****************************************************************** * * TITLE: DRIVER FOR UNPACKING VOYAGER CR-6 MAG (PLS) EDR * * FILE NAME: UNPACKCR6.FOR * * PURPOSE: TO CALL THE ROUTINES UNPACK THE SUBHEADER (PLS DATA) * AND UNPACK THE MAG DATA. * * HISTORY: * * AUTHOR DATE CHANGE * ------ ---- ------ * S. B. KRAMER 03/19/96 ORIGINAL CODE * * CALLING SEQUENCE: SUBROUTINE UNPACKCR6 (INBUF) * * MODULES REFERENCED: * * UNPLS, UNMAG * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * CALL UNPLS TO UNPACK THE 754 SUBHEADER PLS DATA WORDS * CALL UNMAG TO UNPACK THE 814 MAG DATA WORDS * RETURN * ******************************************************************* SUBROUTINE UNPACKCR6(INBUF) C LOGICAL*1 INBUF(11280) C INCLUDE 'UNPACK.INC' C C SEPARATE SUB-HEADER (PLASMA) DATA (3016 BYTES) C DO 2 I=241,3256 J=I-240 PLS(J) = INBUF(I) 2 CONTINUE C C SEPARATE MAG SCIENCE BLOCK (3256 BYTES) C DO 3 I=3257,6512 J=I-3256 MAG(J) = INBUF(I) 3 CONTINUE C CALL PLSCR6() CALL MAGCR6() C RETURN END SUBROUTINE UNPACKDEC(INBUF) C C DRIVER TO UNPACK VOYAGER DECOMMUTATION RECORD C C 240 BYTE HEADER (60 WORDS) C 28 BYTE SUBHEADER (7 WORDS) C 448 BYTE DECOMMUTATION MAP DATA (112 WORDS) C ---- C 716 BYTE DECOMMUTATION EDR C C WRITTEN BY S. KRAMER, CODE 692, 06/07/94 C C LOGICAL*1 INBUF(11280),SUB(28),DEC(448) C INCLUDE 'UNPACK.INC' C C SEPARATE SUBHEADER SPARES (28 BYTES) C DO I = 241,268 J = I - 240 SUB(J) = INBUF(I) END DO C C SEPARATE DECOMMUTATION DATA (448 BYTES) C DO I = 269,716 J = I - 268 DEC(J) = INBUF(I) C WRITE(6,'(1X,I4,1X,Z2,1X,I3)') J,DEC(J),ZEXT(DEC(J)) END DO C CALL DECOMM(DEC) C RETURN END SUBROUTINE UNPACKENG(INBUF) C C DRIVER TO UNPACK VOYAGER ENGINEERING RECORD C C 240 BYTE HEADER C 20 BYTE SUBHEADER C 3600 BYTE ENGINEERING DATA C ---- C 3860 BYTE ENG EDR C C WRITTEN BY S. KRAMER, CODE 692, 06/07/94 C LOGICAL*1 INBUF(11280),SUB(20),ENG(3600) C INCLUDE 'UNPACK.INC' C C SEPARATE SUBHEADER SPARES (20 BYTES) C DO I = 241,260 J = I - 240 SUB(J) = INBUF(I) END DO C C SEPARATE ENGINEERING DATA (3600 BYTES = 60 MF) C DO I = 261,3860 J = I - 260 ENG(J) = INBUF(I) C WRITE(6,'(1X,I4,1X,Z2)') J,ENG(J) END DO C CALL ENGOUT(ENG) C RETURN END ****************************************************************** * * TITLE: DRIVER FOR UNPACKING VOYAGER GS & OC MAG (PLS) EDR * * FILE NAME: UNPACKGS3.FOR * * PURPOSE: TO CALL THE ROUTINES UNPACK THE SUBHEADER (PLS DATA) * AND UNPACK THE MAG DATA. * * HISTORY: * * AUTHOR DATE CHANGE * ------ ---- ------ * S. J. KEMPLER 8/12/85 ORIGINAL CODE * S. B. KRAMER 10/26/93 MODIFIED FOR VOYAGER PRODUCTION * * CALLING SEQUENCE: SUBROUTINE UNPACKGS3 (INBUF) * * MODULES REFERENCED: * * PLSGS3, MAGGS3 * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * CALL UNPLS TO UNPACK THE 68 SUBHEADER PLS DATA WORDS * CALL UNMAG TO UNPACK THE 1500 MAG DATA WORDS * RETURN * ******************************************************************* SUBROUTINE UNPACKGS3(INBUF) C LOGICAL*1 INBUF(11280) C INCLUDE 'UNPACK.INC' C C SEPARATE SUB-HEADER (PLASMA) DATA (272 BYTES) C DO 2 I=241,512 J=I-240 PLS(J) = INBUF(I) 2 CONTINUE C C SEPARATE MAG SCIENCE BLOCK (6000 BYTES) C DO 3 I=513,6512 J=I-512 MAG(J) = INBUF(I) 3 CONTINUE C CALL PLSGS3() CALL MAGGS3() C RETURN END ****************************************************************** * * TITLE: DRIVER FOR UNPACKING VOYAGER VIM-5 MAG (PLS) EDR * * FILE NAME: UNPACKVIM5.FOR * * PURPOSE: TO CALL THE ROUTINES UNPACK THE SUBHEADER (PLS DATA) * AND UNPACK THE MAG DATA. * * HISTORY: * * AUTHOR DATE CHANGE * ------ ---- ------ * S. J. KEMPLER 8/12/85 ORIGINAL CODE * S. B. KRAMER 10/09/92 MODIFIED FOR VIM-5 MODE * * CALLING SEQUENCE: SUBROUTINE UNPACKVIM5 (INBUF) * * MODULES REFERENCED: * * PLSVIM5, MAGVIM5 * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * CALL PLSVIM5 TO UNPACK THE 108 SUBHEADER PLS DATA WORDS * CALL MAGVIM5 TO UNPACK THE 260 MAG DATA WORDS * RETURN * ******************************************************************* SUBROUTINE UNPACKVIM5(INBUF) C LOGICAL*1 INBUF(11280) C INCLUDE 'UNPACK.INC' C C SEPARATE SUB-HEADER (PLASMA) DATA (432 BYTES) C DO 2 I=241,672 J=I-240 PLS(J) = INBUF(I) 2 CONTINUE C C SEPARATE MAG SCIENCE BLOCK (1040 BYTES) C DO 3 I=673,1712 J=I-672 MAG(J) = INBUF(I) 3 CONTINUE C CALL PLSVIM5() CALL MAGVIM5() C RETURN END ****************************************************************** * * TITLE: UNPACK VOYAGER 2400 WORD CR-1 EDR MAG SCIENCE BLOCK * * FILE NAME: MAGCR1.FOR * * PURPOSE: TO UNPACK THE MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 10/03/95 ORIGINAL CODE * (MODE CR-1) * * CALLING SEQUENCE: SUBROUTINE MAGCR1() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * SCIENCE DATA IS RECONSTRUCTED INTO I*2 VARIABLES FROM THE * FOLLOWING: * P ref 12 bits each * S ref 12 bits each * * PDL: * * CALL MOVBIT TO RECONSTRUCT THE MAG SCIENCE DATA INTO * I*2 VARIABLES * RETURN * ******************************************************************* SUBROUTINE MAGCR1() C C CR-1 MAG DATA REPRESENTS A DIRECT READOUT OF THE MAG INSTRUMENTS. C BOTH INSTRUMENTS ARE SAMPLED AT A .06 SEC/SAMPLE RATE. THE CR-1 C SCIENCE BLOCK IS DIVIDED INTO 80 MINOR FRAMES (MF). EACH MF C CONTAINS 10 PRIMARY MAG FULL WORD (12 BIT) TRIPLETS (X,Y,Z) AND C 10 SECONDARY MAG FULL WORD (12 BIT) TRIPLETS (X,Y,Z). NOTE THAT C EACH BYTE OF THE SCIENCE BLOCK CONTAINS TWO FILL BITS AT THE MSB'S. C INTEGER*2 TIME(6) INTEGER*4 PRXIND(10),PRYIND(10),PRZIND(10) INTEGER*4 SRXIND(10),SRYIND(10),SRZIND(10) LOGICAL*1 DQFLAG,DPFLAG,RECTEST C C BIT OFFSET OF PRIMARY REFERENCE WORD OCCURANCES WITHIN 1 MF CYCLE C DATA PRXIND/ 0, 96,192,288,384,480,576,672,768,864/ DATA PRYIND/ 16,112,208,304,400,496,592,688,784,880/ DATA PRZIND/ 32,128,224,320,416,512,608,704,800,896/ C C BIT OFFSET OF SECONDARY REFERENCE WORD OCCURANCES WITHIN 1 MF CYCLE C DATA SRXIND/ 48,144,240,336,432,528,624,720,816,912/ DATA SRYIND/ 64,160,256,352,448,544,640,736,832,928/ DATA SRZIND/ 80,176,272,368,464,560,656,752,848,944/ C C DATA PRESENCE SWITCH FLAG C DATA DPFLAG/.FALSE./ C C DATA QUALITY SWITCH FLAG C DATA DQFLAG/.FALSE./ C C DATA OUTPUT FLAG C DATA RECTEST/.FALSE./ C DATA ICALL/0/ C INCLUDE 'UNPACK.INC' C IF ( DRSDAT.NE.35) RETURN C ICALL = ICALL + 1 IF (.NOT.SYS2(10)) DPFLAG = .TRUE. IF (.NOT.SYS2(11)) DQFLAG = .TRUE. IF ( SYS2(31) ) RECTEST = .TRUE. C C READ 80 MINOR FRAMES (120 BYTE EACH) OF CR-1 RECORD C SCIENCE BLOCK (9600 BYTES). C IPR = 0 ISR = 0 IPRX = 0 IPRY = 0 IPRZ = 0 ISRX = 0 ISRY = 0 ISRZ = 0 IMAG = -960 DO 200 J = 1,80 C C BIT OFFSET ( 960 BITS PER CR-1 MF) C IMAG = IMAG + 960 C DO 100 K = 1,10 C C STATUS CYCLE COUNTER (ONE STATUS CYCLE = 10 MF) C ICYC = INT((J-1)/10) + 1 C C DATA QUALITY STATUS WORD/INDICATOR COUNTER (ONE DQI PER 8 CR-1 MF) C IDQ = INT((J-1)/8) + 1 C C EXTRACT PRIMARY REFERENCE WORDS (12 BIT) USING A PREDETERMINED OFFSET C TABLE. C C PRIMARY X LFM REFERENCE WORD C IF ( PRXIND(K).NE.-1 ) THEN IPRX = IPRX + 1 PREF(1,IPRX) = 0 CALL MOVBIT(MAG, IMAG+PRXIND(K) , 6, PREF(1,IPRX), 6) CALL MOVBIT(MAG, IMAG+PRXIND(K)+8, 6, PREF(1,IPRX), 0 ) IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(1,IPRX) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(1,IPRX) = 0 END IF C C PRIMARY Y LFM REFERENCE WORD C IF ( PRYIND(K).NE.-1 ) THEN IPRY = IPRY + 1 PREF(2,IPRY) = 0 CALL MOVBIT(MAG, IMAG+PRYIND(K) , 6, PREF(2,IPRY), 6) CALL MOVBIT(MAG, IMAG+PRYIND(K)+8, 6, PREF(2,IPRY), 0 ) IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(2,IPRY) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(2,IPRY) = 0 END IF C C PRIMARY Z LFM REFERENCE WORD C IF ( PRZIND(K).NE.-1 ) THEN IPRZ = IPRZ + 1 PREF(3,IPRZ) = 0 CALL MOVBIT(MAG, IMAG+PRZIND(K) , 6, PREF(3,IPRZ), 6) CALL MOVBIT(MAG, IMAG+PRZIND(K)+8, 6, PREF(3,IPRZ), 0 ) IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(3,IPRZ) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(3,IPRZ) = 0 END IF C C EXTRACT SECONDARY REFERENCE WORDS (12 BIT) USING A PREDETERMINED OFFSET C TABLE AND ASSIGN TO I*2 WORD. C C SECONDARY X LFM REFERENCE WORD C IF ( SRXIND(K).NE.-1 ) THEN ISRX = ISRX + 1 SREF(1,ISRX) = 0 CALL MOVBIT(MAG, IMAG+SRXIND(K) , 6, SREF(1,ISRX), 6) CALL MOVBIT(MAG, IMAG+SRXIND(K)+8, 6, SREF(1,ISRX), 0 ) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(1,ISRX) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(1,ISRX) = 0 END IF C C SECONDARY Y LFM REFERENCE WORD C IF ( SRYIND(K).NE.-1 ) THEN ISRY = ISRY + 1 SREF(2,ISRY) = 0 CALL MOVBIT(MAG, IMAG+SRYIND(K) , 6, SREF(2,ISRY), 6) CALL MOVBIT(MAG, IMAG+SRYIND(K)+8, 6, SREF(2,ISRY), 0 ) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(2,ISRY) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(2,ISRY) = 0 END IF C C SECONDARY Z LFM REFERENCE WORD C IF ( SRZIND(K).NE.-1 ) THEN ISRZ = ISRZ + 1 SREF(3,ISRZ) = 0 CALL MOVBIT(MAG, IMAG+SRZIND(K) , 6, SREF(3,ISRZ), 6) CALL MOVBIT(MAG, IMAG+SRZIND(K)+8, 6, SREF(3,ISRZ), 0 ) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(3,ISRZ) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(3,ISRZ) = 0 END IF C 100 CONTINUE C 200 CONTINUE C C OUTPUT COUNTS AND STATUS VALUES C IF ( RECTEST ) THEN DO IP = 1,800 IS = IP ICYC = (IP-1)/100 + 1 IF ( IP.EQ.1 ) THEN TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML WRITE(80,'('' RECORD NUMBER: '',I5.5,'' TIME: '', & I2,1X,I3,3(1X,I2.2),1X,I3.3)') RECNUM,TIME END IF WRITE(80,'(9(1X,I4),2(1X,Z4.4))') & IP, PREF(1,IP), PREF(2,IP), PREF(3,IP), & IS, SREF(1,IS), SREF(2,IS), SREF(3,IS), & ICYC, STAT1(ICYC), STAT2(ICYC) END DO END IF C RETURN END ****************************************************************** * * TITLE: UNPACK VOYAGER 1508 WORD CR-2 EDR MAG SCIENCE BLOCK * * FILE NAME: MAGCR2.FOR * * PURPOSE: TO UNPACK THE MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 01/22/96 ORIGINAL CODE * (MODE CR-2) * * CALLING SEQUENCE: SUBROUTINE MAGCR2() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * SCIENCE DATA IS RECONSTRUCTED INTO I*2 VARIABLES FROM THE * FOLLOWING: * P ref 12 bits each * S ref 12 bits each * * PDL: * * CALL MOVBIT TO RECONSTRUCT THE MAG SCIENCE DATA INTO * I*2 VARIABLES * RETURN * ******************************************************************* SUBROUTINE MAGCR2() C C CR-2 MAG DATA REPRESENTS AN AVERAGED READOUT OF THE MAG INSTRUMENTS. C BOTH INSTRUMENTS ARE SAMPLED AT A .06 SEC/SAMPLE RATE. THE CR-2 C PRIMARY DATA STREAM CONSISTS OF .12 SECOND AVERAGES. THE CR-2 SECONDARY C DATA STREAM CONSISTS OF .24 SECOND AVERAGES. THE CR-2 SCIENCE BLOCK C IS DIVIDED INTO 40 MINOR FRAMES (MF). EACH MF CONTAINS 10 PRIMARY MAG C FULL WORD (12 BIT) TRIPLETS (X,Y,Z) AND 5 SECONDARY MAG FULL WORD (12 BIT) C TRIPLETS (X,Y,Z). NOTE THAT EACH BYTE OF THE SCIENCE BLOCK CONTAINS TWO C FILL BITS AT THE MSB'S. THE CR-2 EDR CONTAINS 5 STATUS WORDS. C INTEGER*2 TIME(6) INTEGER*4 PRXIND(10),PRYIND(10),PRZIND(10) INTEGER*4 SRXIND(10),SRYIND(10),SRZIND(10) LOGICAL*1 DQFLAG,DPFLAG,RECTEST C C BIT OFFSET OF PRIMARY REFERENCE WORD OCCURANCES WITHIN 1 MF CYCLE C DATA PRXIND/ 0, 48,144,192,288,336,432,480,576,624/ DATA PRYIND/ 16, 64,160,208,304,352,448,496,592,640/ DATA PRZIND/ 32, 80,176,224,320,368,464,512,608,656/ C C BIT OFFSET OF SECONDARY REFERENCE WORD OCCURANCES WITHIN 1 MF CYCLE C DATA SRXIND/ 96,240,384,528,672, -1, -1, -1, -1, -1/ DATA SRYIND/112,256,400,544,688, -1, -1, -1, -1, -1/ DATA SRZIND/128,272,416,560,704, -1, -1, -1, -1, -1/ C C DATA PRESENCE SWITCH FLAG C DATA DPFLAG/.FALSE./ C C DATA QUALITY SWITCH FLAG C DATA DQFLAG/.FALSE./ C C DATA OUTPUT FLAG C DATA RECTEST/.FALSE./ C DATA ICALL/0/ C INCLUDE 'UNPACK.INC' C IF ( DRSDAT.NE.35 ) RETURN C ICALL = ICALL + 1 IF ( .NOT.SYS2(10) ) DPFLAG = .TRUE. IF ( .NOT.SYS2(11) ) DQFLAG = .TRUE. IF ( SYS2(31) ) RECTEST = .TRUE. C C READ 40 MINOR FRAMES (90 BYTE EACH) OF CR-2 RECORD C SCIENCE BLOCK (6032 BYTES). C IPR = 0 ISR = 0 IPRX = 0 IPRY = 0 IPRZ = 0 ISRX = 0 ISRY = 0 ISRZ = 0 IMAG = -720 DO 200 J = 1,40 C C BIT OFFSET (720 BITS PER CR-2 MF) C IMAG = IMAG + 720 C DO 100 K = 1,10 C C STATUS CYCLE COUNTER (ONE STATUS CYCLE = 8 MF) C ICYC = INT((J-1)/8) + 1 C C DATA QUALITY STATUS WORD/INDICATOR COUNTER (10 - ONE DQI PER 4 CR-1 MF) C IDQ = INT((J-1)/4) + 1 C C EXTRACT PRIMARY REFERENCE WORDS (12 BIT) USING A PREDETERMINED OFFSET C TABLE. C C PRIMARY X LFM REFERENCE WORD C IF ( PRXIND(K).NE.-1 ) THEN IPRX = IPRX + 1 PREF(1,IPRX) = 0 CALL MOVBIT(MAG, IMAG+PRXIND(K) , 6, PREF(1,IPRX), 6) CALL MOVBIT(MAG, IMAG+PRXIND(K)+8, 6, PREF(1,IPRX), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(1,IPRX) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(1,IPRX) = 0 END IF C C PRIMARY Y LFM REFERENCE WORD C IF ( PRYIND(K).NE.-1 ) THEN IPRY = IPRY + 1 PREF(2,IPRY) = 0 CALL MOVBIT(MAG, IMAG+PRYIND(K) , 6, PREF(2,IPRY), 6) CALL MOVBIT(MAG, IMAG+PRYIND(K)+8, 6, PREF(2,IPRY), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(2,IPRY) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(2,IPRY) = 0 END IF C C PRIMARY Z LFM REFERENCE WORD C IF ( PRZIND(K).NE.-1 ) THEN IPRZ = IPRZ + 1 PREF(3,IPRZ) = 0 CALL MOVBIT(MAG, IMAG+PRZIND(K) , 6, PREF(3,IPRZ), 6) CALL MOVBIT(MAG, IMAG+PRZIND(K)+8, 6, PREF(3,IPRZ), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(3,IPRZ) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(3,IPRZ) = 0 END IF C C EXTRACT SECONDARY REFERENCE WORDS (12 BIT) USING A PREDETERMINED OFFSET C TABLE AND ASSIGN TO I*2 WORD. C C SECONDARY X LFM REFERENCE WORD C IF ( SRXIND(K).NE.-1 ) THEN ISRX = ISRX + 1 SREF(1,ISRX) = 0 CALL MOVBIT(MAG, IMAG+SRXIND(K) , 6, SREF(1,ISRX), 6) CALL MOVBIT(MAG, IMAG+SRXIND(K)+8, 6, SREF(1,ISRX), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(1,ISRX) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(1,ISRX) = 0 END IF C C SECONDARY Y LFM REFERENCE WORD C IF ( SRYIND(K).NE.-1 ) THEN ISRY = ISRY + 1 SREF(2,ISRY) = 0 CALL MOVBIT(MAG, IMAG+SRYIND(K) , 6, SREF(2,ISRY), 6) CALL MOVBIT(MAG, IMAG+SRYIND(K)+8, 6, SREF(2,ISRY), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(2,ISRY) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(2,ISRY) = 0 END IF C C SECONDARY Z LFM REFERENCE WORD C IF ( SRZIND(K).NE.-1 ) THEN ISRZ = ISRZ + 1 SREF(3,ISRZ) = 0 CALL MOVBIT(MAG, IMAG+SRZIND(K) , 6, SREF(3,ISRZ), 6) CALL MOVBIT(MAG, IMAG+SRZIND(K)+8, 6, SREF(3,ISRZ), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(3,ISRZ) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(3,ISRZ) = 0 END IF C C THE FIRST SECONDARY Z AXIS COUNT OF EVERY EIGHTH MINOR FRAME IS C ACTUALLY A MAG STAT1 WORD. REMOVE C IF ( K.EQ.1 .AND. MOD(J-1,8).EQ.0 ) SREF(3,ISRZ) = 0 C 100 CONTINUE C 200 CONTINUE C C OUTPUT COUNTS AND STATUS VALUES C IF ( RECTEST ) THEN DO IP = 1,400 IS = (IP-1)/2 + 1 ICYC = (IP-1)/80 + 1 IF ( IP.EQ.1 ) THEN TIME(1) = YEAR3 CALL CONHOUR( SCETHR,TIME) CALL CONSEC( SCETSC,TIME) TIME(6) = SCETML WRITE(80,'('' RECORD NUMBER: '',I5.5,'' TIME: '', & I2,1X,I3,3(1X,I2.2),1X,I3.3)') RECNUM,TIME END IF WRITE(80,'(9(1X,I4),2(1X,Z4.4))') & IP, PREF(1,IP), PREF(2,IP), PREF(3,IP), & IS, SREF(1,IS), SREF(2,IS), SREF(3,IS), & ICYC, STAT1(ICYC), STAT2(ICYC) END DO END IF C RETURN END ****************************************************************** * * TITLE: UNPACK VOYAGER 750 WORD CR-3 EDR MAG SCIENCE BLOCK * * FILE NAME: MAGCR3.FOR * * PURPOSE: TO UNPACK THE MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 02/05/96 ORIGINAL CODE * (MODE CR-3) * * CALLING SEQUENCE: SUBROUTINE MAGCR3() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * SCIENCE DATA IS RECONSTRUCTED INTO I*2 VARIABLES FROM THE * FOLLOWING: * P ref 12 bits each * S ref 12 bits each * * PDL: * * CALL MOVBIT TO RECONSTRUCT THE MAG SCIENCE DATA INTO * I*2 VARIABLES * RETURN * ******************************************************************* SUBROUTINE MAGCR3() C C CR-3 MAG DATA REPRESENTS AN AVERAGED READOUT OF THE MAG INSTRUMENTS. C BOTH INSTRUMENTS ARE SAMPLED AT A .06 SEC/SAMPLE RATE. THE CR-3 C PRIMARY DATA STREAM CONSISTS OF .24 SECOND AVERAGES. THE CR-3 SECONDARY C DATA STREAM CONSISTS OF .96 SECOND AVERAGES. THE CR-3 SCIENCE BLOCK IS C DIVIDED INTO 40 MINOR FRAMES (MF) COVERING A 96 SECOND PERIOD. ODD C NUMBERED MF'S CONTAIN 10 PRIMARY MAG FULL WORD (12 BIT) TRIPLETS (X,Y,Z) C AND 2 SECONDARY MAG FULL WORD (12 BIT) TRIPLETS (X,Y,Z). EVEN NUMBERED C MF'S CONTAIN 10 PRIMARY MAG FULL WORD (12 BIT) TRIPLETS (X,Y,Z) AND C 3 SECONDARY MAG FULL WORD (12 BIT) TRIPLETS (X,Y,Z). C C MAG REFERENCE WORD FORMAT C C BIT 15 0 C |______________| C | | C +--------------+ C C BITS 15-12 ARE FILL C UNSIGNED INTEGER C C READ 40 MINOR FRAMES OF CR-3 RECORD SCIENCE BLOCK. C INTEGER*2 TIME(6) INTEGER*4 PRXINDO(10),PRYINDO(10),PRZINDO(10), & PRXINDE(10),PRYINDE(10),PRZINDE(10), & SRXINDO(10),SRYINDO(10),SRZINDO(10), & SRXINDE(10),SRYINDE(10),SRZINDE(10), & IMAG(40) LOGICAL*1 DQFLAG,DPFLAG,RECTEST C C BIT OFFSET OF MF'S C DATA IMAG/ 0, 576, 1200, 1776, 2400, 2976, 3600, 4176, 4800, & 5376, 6000, 6576, 7200, 7776, 8400, 8976, 9600,10176, & 10800,11376,12000,12576,13200,13776,14400,14976,15600, & 16176,16800,17376,18000,18576,19200,19776,20400,17376, & 21600,22176,22800,23376 / C C BIT OFFSET OF PRIMARY REFERENCE WORD OCCURANCES WITHIN ODD MF'S C DATA PRXINDO/ 0,48, 96,144,240,288,336,384,480,528/ DATA PRYINDO/16,64,112,160,256,304,352,400,496,544/ DATA PRZINDO/32,80,128,176,272,320,368,416,512,560/ C C BIT OFFSET OF PRIMARY REFERENCE WORD OCCURANCES WITHIN EVEN MF'S C DATA PRXINDE/ 0,48,144,192,240,288,384,432,480,528/ DATA PRYINDE/16,64,160,208,256,304,400,448,496,544/ DATA PRZINDE/32,80,176,224,272,320,416,464,512,560/ C C BIT OFFSET OF SECONDARY REFERENCE WORD OCCURANCES WITHIN ODD MF'S C DATA SRXINDO/192,432, -1, -1, -1, -1, -1, -1, -1, -1/ DATA SRYINDO/208,448, -1, -1, -1, -1, -1, -1, -1, -1/ DATA SRZINDO/224,464, -1, -1, -1, -1, -1, -1, -1, -1/ C C BIT OFFSET OF SECONDARY REFERENCE WORD OCCURANCES WITHIN EVEN MF'S C DATA SRXINDE/ 96,336,576, -1, -1, -1, -1, -1, -1, -1/ DATA SRYINDE/112,352,592, -1, -1, -1, -1, -1, -1, -1/ DATA SRZINDE/128,368,608, -1, -1, -1, -1, -1, -1, -1/ C C DATA PRESENCE SWITCH FLAG C DATA DPFLAG/.FALSE./ C C DATA QUALITY SWITCH FLAG C DATA DQFLAG/.FALSE./ C C DATA OUTPUT FLAG C DATA RECTEST/.FALSE./ C DATA ICALL/0/ C INCLUDE 'UNPACK.INC' C IF ( DRSDAT.NE.35 ) RETURN C ICALL = ICALL + 1 IF ( .NOT.SYS2(10) ) DPFLAG = .TRUE. IF ( .NOT.SYS2(11) ) DQFLAG = .TRUE. IF ( SYS2(31) ) RECTEST = .TRUE. C C READ 40 MINOR FRAMES OF CR-3 RECORD SCIENCE BLOCK (3000 BYTES). C IPRX = 0 IPRY = 0 IPRZ = 0 ISRX = 0 ISRY = 0 ISRZ = 0 DO 200 J = 1,40 C C STATUS CYCLE COUNTER (ONE STATUS CYCLE = 4 MF) C ICYC = INT((J-1)/4) + 1 C C DATA QUALITY STATUS WORD/INDICATOR COUNTER (ONE DQI PER 4 CR-3 MF) C IDQ = INT((J-1)/4) + 1 C DO 100 K = 1,10 C C EXTRACT PRIMARY REFERENCE WORDS (12 BIT) USING A PREDETERMINED OFFSET C TABLE. C C PRIMARY X LFM REFERENCE WORD C IPRX = IPRX + 1 PREF(1,IPRX) = 0 IF ( MOD(J,2).NE.0 ) THEN CALL MOVBIT(MAG, IMAG(J)+PRXINDO(K) , 8, PREF(1,IPRX), 8) CALL MOVBIT(MAG, IMAG(J)+PRXINDO(K)+8, 8, PREF(1,IPRX), 0) ELSE CALL MOVBIT(MAG, IMAG(J)+PRXINDE(K) , 8, PREF(1,IPRX), 8) CALL MOVBIT(MAG, IMAG(J)+PRXINDE(K)+8, 8, PREF(1,IPRX), 0) END IF IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(1,IPRX) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(1,IPRX) = 0 C C PRIMARY Y LFM REFERENCE WORD C IPRY = IPRY + 1 PREF(2,IPRY) = 0 IF ( MOD(J,2).NE.0 ) THEN CALL MOVBIT(MAG, IMAG(J)+PRYINDO(K) , 8, PREF(2,IPRY), 8) CALL MOVBIT(MAG, IMAG(J)+PRYINDO(K)+8, 8, PREF(2,IPRY), 0) ELSE CALL MOVBIT(MAG, IMAG(J)+PRYINDE(K) , 8, PREF(2,IPRY), 8) CALL MOVBIT(MAG, IMAG(J)+PRYINDE(K)+8, 8, PREF(2,IPRY), 0) END IF IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(2,IPRY) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(2,IPRY) = 0 C C PRIMARY Z LFM REFERENCE WORD C IPRZ = IPRZ + 1 PREF(3,IPRZ) = 0 IF ( MOD(J,2).NE.0 ) THEN CALL MOVBIT(MAG, IMAG(J)+PRZINDO(K) , 8, PREF(3,IPRZ), 8) CALL MOVBIT(MAG, IMAG(J)+PRZINDO(K)+8, 8, PREF(3,IPRZ), 0) ELSE CALL MOVBIT(MAG, IMAG(J)+PRZINDE(K) , 8, PREF(3,IPRZ), 8) CALL MOVBIT(MAG, IMAG(J)+PRZINDE(K)+8, 8, PREF(3,IPRZ), 0) END IF IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(3,IPRZ) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(3,IPRZ) = 0 C C EXTRACT SECONDARY REFERENCE WORDS (12 BIT) USING A PREDETERMINED OFFSET C TABLE AND ASSIGN TO I*2 WORD. C C SECONDARY X LFM REFERENCE WORD C IF ( MOD(J,2).NE.0 .AND. SRXINDO(K).NE.-1 ) THEN ISRX = ISRX + 1 SREF(1,ISRX) = 0 CALL MOVBIT(MAG, IMAG(J)+SRXINDO(K) , 8, SREF(1,ISRX), 8) CALL MOVBIT(MAG, IMAG(J)+SRXINDO(K)+8, 8, SREF(1,ISRX), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(1,ISRX) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(1,ISRX) = 0 ELSE IF ( MOD(J,2).EQ.0 .AND. SRXINDE(K).NE.-1 ) THEN ISRX = ISRX + 1 SREF(1,ISRX) = 0 CALL MOVBIT(MAG, IMAG(J)+SRXINDE(K) , 8, SREF(1,ISRX), 8) CALL MOVBIT(MAG, IMAG(J)+SRXINDE(K)+8, 8, SREF(1,ISRX), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(1,ISRX) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(1,ISRX) = 0 END IF C C SECONDARY Y LFM REFERENCE WORD C IF ( MOD(J,2).NE.0 .AND. SRYINDO(K).NE.-1 ) THEN ISRY = ISRY + 1 SREF(2,ISRY) = 0 CALL MOVBIT(MAG, IMAG(J)+SRYINDO(K) , 8, SREF(2,ISRY), 8) CALL MOVBIT(MAG, IMAG(J)+SRYINDO(K)+8, 8, SREF(2,ISRY), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(2,ISRY) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(2,ISRY) = 0 ELSE IF ( MOD(J,2).EQ.0 .AND. SRYINDE(K).NE.-1 ) THEN ISRY = ISRY + 1 SREF(2,ISRY) = 0 CALL MOVBIT(MAG, IMAG(J)+SRYINDE(K) , 8, SREF(2,ISRY), 8) CALL MOVBIT(MAG, IMAG(J)+SRYINDE(K)+8, 8, SREF(2,ISRY), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(2,ISRY) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(2,ISRY) = 0 END IF C C SECONDARY Z LFM REFERENCE WORD C IF ( MOD(J,2).NE.0 .AND. SRZINDO(K).NE.-1 ) THEN ISRZ = ISRZ + 1 SREF(3,ISRZ) = 0 CALL MOVBIT(MAG, IMAG(J)+SRZINDO(K) , 8, SREF(3,ISRZ), 8) CALL MOVBIT(MAG, IMAG(J)+SRZINDO(K)+8, 8, SREF(3,ISRZ), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(3,ISRZ) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(3,ISRZ) = 0 ELSE IF ( MOD(J,2).EQ.0 .AND. SRZINDE(K).NE.-1 ) THEN ISRZ = ISRZ + 1 SREF(3,ISRZ) = 0 CALL MOVBIT(MAG, IMAG(J)+SRZINDE(K) , 8, SREF(3,ISRZ), 8) CALL MOVBIT(MAG, IMAG(J)+SRZINDE(K)+8, 8, SREF(3,ISRZ), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(3,ISRZ) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(3,ISRZ) = 0 END IF C 100 CONTINUE C 200 CONTINUE C C OUTPUT COUNTS AND STATUS VALUES C IF ( RECTEST ) THEN DO I = 1,400 IP = I IS = (I-1)/4 + 1 ICYC = (I-1)/40 + 1 IF ( I.EQ.1 ) THEN TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML WRITE(80,'('' RECORD NUMBER: '',I5.5,'' TIME: '', & I2,1X,I3,3(1X,I2.2),1X,I3.3)') RECNUM,TIME END IF WRITE(80,'(9(1X,I4),2(1X,Z4.4))') & IP, PREF(1,IP), PREF(2,IP), PREF(3,IP), & IS, SREF(1,IS), SREF(2,IS), SREF(3,IS), & ICYC, STAT1(ICYC), STAT2(ICYC) END DO END IF C RETURN END ****************************************************************** * * TITLE: UNPACK VOYAGER 720 WORD CR-4 EDR MAG SCIENCE BLOCK * * FILE NAME: MAGCR4.FOR * * PURPOSE: TO UNPACK THE MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 01/25/96 ORIGINAL CODE * (MODE CR-4) * * CALLING SEQUENCE: SUBROUTINE MAGCR4() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * SCIENCE DATA IS RECONSTRUCTED INTO I*2 VARIABLES FROM THE * FOLLOWING: * P ref 12 bits each * S ref 12 bits each * P diff 6 bits each * S diff 6 bits each * * PDL: * * CALL MOVBIT TO RECONSTRUCT THE MAG SCIENCE DATA INTO * I*2 VARIABLES * RETURN * ******************************************************************* SUBROUTINE MAGCR4() C C CR-4 MAG DATA REPRESENTS AN AVERAGED READOUT OF THE MAG INSTRUMENTS. C BOTH INSTRUMENTS ARE SAMPLED AT A .06 SEC/SAMPLE RATE. THE CR-4 C PRIMARY DATA STREAM CONSISTS OF .30 SECOND AVERAGES. THE CR-4 SECONDARY C DATA STREAM CONSISTS OF 2.4 SECOND AVERAGES. THE CR-4 SCIENCE BLOCK C IS DIVIDED INTO 40 MINOR FRAMES (MF). THE FIRST 2 MF'S CONSTITUTE A C CYCLE THAT OCCURS 20 TIMES. NOTE THAT EACH BYTE OF THE SCIENCE C BLOCK CONTAINS TWO FILL BITS AT THE MSB'S. THE CR-4 EDR CONTAINS 20 C STATUS WORDS. C INTEGER*2 TIME(6) C INTEGER*4 PRXIND(32),PRYIND(32),PRZIND(32), & SRXIND(32),SRYIND(32),SRZIND(32), & PDXIND(32),PDYIND(32),PDZIND(32), & SDXIND(32),SDYIND(32),SDZIND(32) C LOGICAL*1 DQFLAG,DPFLAG,RECTEST C C BIT OFFSET OF PRIMARY REFERENCE WORD OCCURANCES WITHIN A 2 MF CYCLE C DATA PRXIND/ 40,616, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1 / DATA PRYIND/ 64,640, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1 / DATA PRZIND/ 96,672, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1 / C C BIT OFFSET OF PRIMARY REFERENCE WORD OCCURANCES WITHIN A 2 MF CYCLE C DATA SRXIND/ 288, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1 / DATA SRYIND/ 320, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1 / DATA SRZIND/ 352, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1 / C C BIT OFFSET OF PRIMARY DIFFERENCE WORD OCCURANCES WITHIN A 2 MF CYCLE C DATA PDXIND/ 32, 112, 136, 160, 184, 208, 232, 256, 368, 392, & 416, 440, 464, 488, 512, 536, 608, 688, 712, 736, & 760, 784, 808, 832, 880, 904, 928, 952, 976,1000, & 1024,1048 / DATA PDYIND/ 56, 120, 144, 168, 192, 216, 240, 264, 376, 400, & 424, 448, 472, 496, 520, 544, 632, 696, 720, 744, & 768, 792, 816, 840, 888, 912, 936, 960, 984,1008, & 1032,1056 / DATA PDZIND/ 80, 128, 152, 176, 200, 224, 248, 272, 384, 408, & 432, 456, 480, 504, 528, 576, 656, 704, 728, 752, & 776, 800, 824, 848, 896, 920, 944, 968, 992,1016, & 1040,1064 / C C BIT OFFSET OF SECONDARY DIFFERENCE WORD OCCURANCES WITHIN A 2 MF CYCLE C DATA SDXIND/ 280,584,856,1072,-1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1 / DATA SDYIND/ 304,592,864,1080,-1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1 / DATA SDZIND/ 336,600,872,1088,-1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, & -1, -1 / C C DATA PRESENCE SWITCH FLAG C DATA DPFLAG/.FALSE./ C C DATA QUALITY SWITCH FLAG C DATA DQFLAG/.FALSE./ C C DATA OUTPUT FLAG C DATA RECTEST/.FALSE./ ! for development testing only C DATA ICALL/0/ C INCLUDE 'UNPACK.INC' C IF ( DRSDAT.NE.35 ) RETURN C ICALL = ICALL + 1 IF ( .NOT.SYS2(10) ) DPFLAG = .TRUE. IF ( .NOT.SYS2(11) ) DQFLAG = .TRUE. C C MAG REFERENCE WORD FORMAT MAG DIFFERENCE WORD FORMAT C C BIT 15 0 BIT 7 0 C |______________| |_______| C | | | | C +--------------+ +-------+ C C BITS 15-12 ARE FILL BITS 7 AND 6 ARE FILL C UNSIGNED INTEGER BIT 5 IS SIGN BIT C C READ 40 MINOR FRAMES OF CR-4 RECORD SCIENCE BLOCK. C IPRX = 0 IPRY = 0 IPRZ = 0 IPDX = 0 IPDY = 0 IPDZ = 0 ISRX = 0 ISRY = 0 ISRZ = 0 ISDX = 0 ISDY = 0 ISDZ = 0 IMAG = -1152 C C READ 2 MF CYCLE FOR 20 OCCURANCES C DO 200 J = 1,20 C C BIT OFFSET ( 1152 BITS PER CR-4 MF) C IMAG = IMAG + 1152 C C EXTRACT VALUES FROM 1152 BIT 2 MF CYCLE C DO 100 K = 1,32 C C STATUS CYCLE COUNTER (20 TOTAL - ONE STATUS CYCLE = 2 MF) C ICYC = J C C DATA QUALITY STATUS WORD/INDICATOR COUNTER (10 - ONE DQI PER 4 CR-1 MF) C IDQ = (J-1)/2 + 1 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C PRIMARY X LFM REFERENCE WORD C IF ( PRXIND(K).NE.-1 ) THEN IPRX = IPRX + 1 PREF(1,IPRX) = 0 CALL MOVBIT(MAG, IMAG+PRXIND(K) , 8, PREF(1,IPRX), 8) CALL MOVBIT(MAG, IMAG+PRXIND(K)+8, 8, PREF(1,IPRX), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(1,IPRX) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(1,IPRX) = 0 END IF C C PRIMARY Y LFM REFERENCE WORD C IF ( PRYIND(K).NE.-1 ) THEN IPRY = IPRY + 1 PREF(2,IPRY) = 0 CALL MOVBIT(MAG, IMAG+PRYIND(K) , 8, PREF(2,IPRY), 8) CALL MOVBIT(MAG, IMAG+PRYIND(K)+8, 8, PREF(2,IPRY), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(2,IPRY) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(2,IPRY) = 0 END IF C C PRIMARY Z LFM REFERENCE WORD C IF ( PRZIND(K).NE.-1 ) THEN IPRZ = IPRZ + 1 PREF(3,IPRZ) = 0 CALL MOVBIT(MAG, IMAG+PRZIND(K) , 8, PREF(3,IPRZ), 8) CALL MOVBIT(MAG, IMAG+PRZIND(K)+8, 8, PREF(3,IPRZ), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) PREF(3,IPRZ) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(3,IPRZ) = 0 END IF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C PRIMARY X LFM DIFFERENCE C IF ( PDXIND(K).NE.-1 ) THEN IPDX = IPDX + 1 PDIFF(1,IPDX) = 0 CALL MOVBIT(MAG, IMAG+PDXIND(K), 6, PDIFF(1,IPDX), 0) IF ( PDIFF(1,IPDX).GE.32 ) PDIFF(1,IPDX) = PDIFF(1,IPDX) - 64 IF ( DPFLAG .AND. DPI(J).NE.0 ) PDIFF(1,IPDX) = 255 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PDIFF(1,IPDX) = 255 END IF C C PRIMARY Y LFM DIFFERENCE WORD C IF ( PDYIND(K).NE.-1 ) THEN IPDY = IPDY + 1 PDIFF(2,IPDY) = 0 CALL MOVBIT(MAG, IMAG+PDYIND(K), 6, PDIFF(2,IPDY), 0) IF ( PDIFF(2,IPDY).GE.32 ) PDIFF(2,IPDY) = PDIFF(2,IPDY) - 64 IF ( DPFLAG .AND. DPI(J).NE.0 ) PDIFF(2,IPDY) = 255 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PDIFF(2,IPDY) = 255 END IF C C PRIMARY Z LFM DIFFERENCE WORD C IF ( PDZIND(K).NE.-1 ) THEN IPDZ = IPDZ + 1 PDIFF(3,IPDZ) = 0 CALL MOVBIT(MAG, IMAG+PDZIND(K), 6, PDIFF(3,IPDZ), 0) IF ( PDIFF(3,IPDZ).GE.32 ) PDIFF(3,IPDZ) = PDIFF(3,IPDZ) - 64 IF ( DPFLAG .AND. DPI(J).NE.0 ) PDIFF(3,IPDZ) = 255 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PDIFF(3,IPDZ) = 255 END IF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C SECONDARY X LFM REFERENCE WORD C IF ( SRXIND(K).NE.-1 ) THEN ISRX = ISRX + 1 SREF(1,ISRX) = 0 CALL MOVBIT(MAG, IMAG+SRXIND(K) , 8, SREF(1,ISRX), 8) CALL MOVBIT(MAG, IMAG+SRXIND(K)+8, 8, SREF(1,ISRX), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(1,ISRX) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(1,ISRX) = 0 END IF C C SECONDARY Y LFM REFERENCE WORD C IF ( SRYIND(K).NE.-1 ) THEN ISRY = ISRY + 1 SREF(2,ISRY) = 0 CALL MOVBIT(MAG, IMAG+SRYIND(K) , 8, SREF(2,ISRY), 8) CALL MOVBIT(MAG, IMAG+SRYIND(K)+8, 8, SREF(2,ISRY), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(2,ISRY) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(2,ISRY) = 0 END IF C C SECONDARY Z LFM REFERENCE WORD C IF ( SRZIND(K).NE.-1 ) THEN ISRZ = ISRZ + 1 SREF(3,ISRZ) = 0 CALL MOVBIT(MAG, IMAG+SRZIND(K) , 8, SREF(3,ISRZ), 8) CALL MOVBIT(MAG, IMAG+SRZIND(K)+8, 8, SREF(3,ISRZ), 0) IF ( DPFLAG .AND. DPI(J).NE.0 ) SREF(3,ISRZ) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(3,ISRZ) = 0 END IF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C SECONDARY X LFM DIFFERENCE C IF ( SDXIND(K).NE.-1 ) THEN ISDX = ISDX + 1 SDIFF(1,ISDX) = 0 CALL MOVBIT(MAG, IMAG+SDXIND(K), 6, SDIFF(1,ISDX), 0) IF ( SDIFF(1,ISDX).GE.32 ) SDIFF(1,ISDX) = SDIFF(1,ISDX) - 64 IF ( DPFLAG .AND. DPI(J).NE.0 ) SDIFF(1,ISDX) = 255 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SDIFF(1,ISDX) = 255 END IF C C SECONDARY Y LFM DIFFERENCE WORD C IF ( SDYIND(K).NE.-1 ) THEN ISDY = ISDY + 1 SDIFF(2,ISDY) = 0 CALL MOVBIT(MAG, IMAG+SDYIND(K), 6, SDIFF(2,ISDY), 0) IF ( SDIFF(2,ISDY).GE.32 ) SDIFF(2,ISDY) = SDIFF(2,ISDY) - 64 IF ( DPFLAG .AND. DPI(J).NE.0 ) SDIFF(2,ISDY) = 255 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SDIFF(2,ISDY) = 255 END IF C C SECONDARY Z LFM DIFFERENCE WORD C IF ( SDZIND(K).NE.-1 ) THEN ISDZ = ISDZ + 1 SDIFF(3,ISDZ) = 0 CALL MOVBIT(MAG, IMAG+SDZIND(K), 6, SDIFF(3,ISDZ), 0) IF ( SDIFF(3,ISDZ).GE.32 ) SDIFF(3,ISDZ) = SDIFF(3,ISDZ) - 64 IF ( DPFLAG .AND. DPI(J).NE.0 ) SDIFF(3,ISDZ) = 255 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SDIFF(3,ISDZ) = 255 END IF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C 100 CONTINUE C 200 CONTINUE C C OUTPUT COUNTS AND STATUS VALUES C IF ( RECTEST ) THEN IF ( ICALL.EQ.1 ) OPEN(80,FILE='COUNTS.DAT',STATUS='NEW', & FORM='FORMATTED',CARRIAGECONTROL='LIST') DO I = 1,640 IF ( I.EQ.1 ) THEN TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML WRITE(80,'(''RECORD NUMBER: '',I5.5,'' TIME: '', & I2,1X,I3,3(1X,I2.2),1X,I3.3)') RECNUM,TIME END IF IPR = (I-1)/16 + 1 ISR = (I-1)/32 + 1 ISD = (I-1)/8 + 1 ICYC = ISR WRITE(80,'(16(1X,I4),2(1X,Z4.4))') & I, PDIFF(1,I), PDIFF(2,I), PDIFF(3,I), & IPR, PREF(1,IPR), PREF(2,IPR), PREF(3,IPR), & ISD, SDIFF(1,ISD),SDIFF(2,ISD),SDIFF(3,ISD), & ISR, SREF(1,ISR), SREF(2,ISR), SREF(3,ISR), & STAT1(ICYC),STAT2(ICYC) END DO END IF C RETURN END ****************************************************************** * * TITLE: UNPACK VOYAGER 1080 WORD CR-5 EDR MAG SCIENCE BLOCK * * FILE NAME: MAGCR5.FOR * * PURPOSE: TO UNPACK THE MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 09/26/92 ORIGINAL CODE * (MODE CR-5) * S. B. KRAMER 11/17/95 ADD DELTA MODULATION PROCESSING * * CALLING SEQUENCE: SUBROUTINE MAGCR5() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * SCIENCE DATA IS RECONSTRUCTED INTO I*2 VARIABLES FROM THE * FOLLOWING: * P ref 12 bits each * S ref 12 bits each * P dm 6 bits each * S dm 6 bits each * * PDL: * * CALL MOVBIT TO RECONSTRUCT THE MAG SCIENCE DATA INTO * I*2 VARIABLES * RETURN * ******************************************************************* SUBROUTINE MAGCR5() C INTEGER*2 TIME(6) INTEGER*4 PDXIND(125),PDYIND(125),PDZIND(125), & PRXIND(5),PRYIND(5),PRZIND(5), & SRXIND(5),SRYIND(5),SRZIND(5), & PDMIND(40),SDMIND(40) LOGICAL*1 DQFLAG,DPFLAG,RECTEST C C BIT OFFSET OF PRIMARY REFERENCE WORD OCCURANCES WITHIN 5 MF CYCLE C DATA PRXIND/ 0,304, -1, -1, -1/ DATA PRYIND/ 16,320, -1, -1, -1/ DATA PRZIND/ 32,336, -1, -1, -1/ C C BIT OFFSET OF SECONDARY REFERENCE WORD OCCURANCES WITHIN 5 MF CYCLE C DATA SRXIND/ 80, -1, -1, -1, -1/ DATA SRYIND/ 96, -1, -1, -1, -1/ DATA SRZIND/112, -1, -1, -1, -1/ C C BIT OFFSET OF PRIMARY DELTA MODULATED WORD OCCURANCES WITHIN 5 MF CYCLE C DATA PDMIND/ 48, 56, 64, 72,136, & 144,152,160,176,184, & 192,200,216,224,232, & 240,256,264,272,280, & 352,360,368,376,392, & 400,408,416,432,440, & 448,456,472,480,488, & 496,512,520,528,536/ C C BIT OFFSET OF PRIMARY DELTA MODULATED WORD OCCURANCES WITHIN 5 MF CYCLE C DATA SDMIND/128,168,208,248,288, & 384,424,464,504,544, & -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1, & -1, -1, -1, -1, -1/ C C DATA PRESENCE SWITCH FLAG C DATA DPFLAG/.FALSE./ C C DATA QUALITY SWITCH FLAG C DATA DQFLAG/.FALSE./ C C DATA OUTPUT FLAG C DATA RECTEST/.FALSE./ ! for development testing only C DATA ICALL/0/ C INCLUDE 'UNPACK.INC' C IF ( DRSDAT.NE.35 ) RETURN C ICALL = ICALL + 1 IF ( .NOT.SYS2(10) ) DPFLAG = .TRUE. IF ( .NOT.SYS2(11) ) DQFLAG = .TRUE. C C MAG REFERENCE WORD FORMAT MAG DELTA WORD FORMAT C C BIT 15 0 BIT 7 0 C |______________| |_______| C | | | | C +--------------+ +-------+ C C BITS 15-12 ARE FILL BITS 5-4 = X DM C UNSIGNED INTEGER BITS 3-2 = Y DM C BITS 1-0 = Z DM C C C READ 60 MINOR FRAMES (72 BYTE EACH) OF CR-5 RECORD (4320 BYTES). C IPR = 0 ISR = 0 IPRX = 0 IPRY = 0 IPRZ = 0 ISRX = 0 ISRY = 0 ISRZ = 0 IPDM = 0 ISDM = 0 IMAG = -576 IFRM = 0 DO 200 J = 1,60 C C BIT OFFSET (576 BITS PER CR-5 MF) C IMAG = IMAG + 576 C C MINOR FRAME COUNTER (60 MF PER CR-5 SCIENCE BLOCK) C IFRM = IFRM + 1 C C STATUS CYCLE COUNTER (12 TOTAL - ONE STATUS CYCLE = 5 MF) C ICYC = (IFRM-1)/5 + 1 C C DATA QUALITY STATUS WORD/INDICATOR COUNTER (ONE DQI PER 30 CR-5 MF) C IDQ = INT((IFRM-1)/30) + 1 C C GET 12 BIT REFERENCE WORDS C DO 100 K = 1,2 C C EXTRACT PRIMARY REFERENCE WORDS (12 BIT) USING A PREDETERMINED OFFSET C TABLE. C C PRIMARY X LFM REFERENCE WORD C IF ( PRXIND(K).NE.-1 ) THEN IPRX = IPRX + 1 PREF(1,IPRX) = 0 CALL MOVBIT(MAG, IMAG+PRXIND(K) , 8, PREF(1,IPRX), 8) CALL MOVBIT(MAG, IMAG+PRXIND(K)+8, 8, PREF(1,IPRX), 0) IF ( DPFLAG.AND.DPI(IFRM).NE.0 ) PREF(1,IPRX) = 0 IF ( DQFLAG.AND.DQI(IDQ).NE.0 ) PREF(1,IPRX) = 0 END IF C C PRIMARY Y LFM REFERENCE WORD C IF ( PRYIND(K).NE.-1 ) THEN IPRY = IPRY + 1 PREF(2,IPRY) = 0 CALL MOVBIT(MAG, IMAG+PRYIND(K) , 8, PREF(2,IPRY), 8) CALL MOVBIT(MAG, IMAG+PRYIND(K)+8, 8, PREF(2,IPRY), 0) IF ( DPFLAG.AND.DPI(IFRM).NE.0 ) PREF(2,IPRY) = 0 IF ( DQFLAG.AND.DQI(IDQ).NE.0 ) PREF(2,IPRY) = 0 END IF C C PRIMARY Z LFM REFERENCE WORD C IF ( PRZIND(K).NE.-1 ) THEN IPRZ = IPRZ + 1 PREF(3,IPRZ) = 0 CALL MOVBIT(MAG, IMAG+PRZIND(K) , 8, PREF(3,IPRZ), 8) CALL MOVBIT(MAG, IMAG+PRZIND(K)+8, 8, PREF(3,IPRZ), 0) IF ( DPFLAG.AND.DPI(IFRM).NE.0 ) PREF(3,IPRZ) = 0 IF ( DQFLAG.AND.DQI(IDQ).NE.0 ) PREF(3,IPRZ) = 0 c write(6,'(1x,''primary x,y,z ref : '',3(i4,3x))') c & pref(1,iprx),pref(2,ipry),pref(3,iprz) END IF C C EXTRACT SECONDARY REFERENCE WORDS (12 BIT) USING A PREDETERMINED OFFSET C TABLE AND ASSIGN TO I*2 WORD. C C SECONDARY X LFM REFERENCE WORD C IF ( SRXIND(K).NE.-1 ) THEN ISRX = ISRX + 1 SREF(1,ISRX) = 0 CALL MOVBIT(MAG, IMAG+SRXIND(K) , 8, SREF(1,ISRX), 8) CALL MOVBIT(MAG, IMAG+SRXIND(K)+8, 8, SREF(1,ISRX), 0) IF ( DPFLAG.AND.DPI(IFRM).NE.0 ) SREF(1,ISRX) = 0 IF ( DQFLAG.AND.DQI(IDQ).NE.0 ) SREF(1,ISRX) = 0 END IF C C SECONDARY Y LFM REFERENCE WORD C IF ( SRYIND(K).NE.-1 ) THEN ISRY = ISRY + 1 SREF(2,ISRY) = 0 CALL MOVBIT(MAG, IMAG+SRYIND(K) , 8, SREF(2,ISRY), 8) CALL MOVBIT(MAG, IMAG+SRYIND(K)+8, 8, SREF(2,ISRY), 0) IF ( DPFLAG.AND.DPI(IFRM).NE.0 ) SREF(2,ISRY) = 0 IF ( DQFLAG.AND.DQI(IDQ).NE.0 ) SREF(2,ISRY) = 0 END IF C C SECONDARY Z LFM REFERENCE WORD C IF ( SRZIND(K).NE.-1 ) THEN ISRZ = ISRZ + 1 SREF(3,ISRZ) = 0 CALL MOVBIT(MAG, IMAG+SRZIND(K) , 8, SREF(3,ISRZ), 8) CALL MOVBIT(MAG, IMAG+SRZIND(K)+8, 8, SREF(3,ISRZ), 0) IF ( DPFLAG.AND.DPI(IFRM).NE.0 ) SREF(3,ISRZ) = 0 IF ( DQFLAG.AND.DQI(IDQ).NE.0 ) SREF(3,ISRZ) = 0 c write(6,'(1x,''secondary x,y,z ref: '',3(i4,3x))') c & sref(1,isrx),sref(2,isry),sref(3,isrz) END IF C 100 CONTINUE C C GET 2 BIT DELTA MODULATED WORDS C DO 150 L = 1,40 C C EXTRACT PRIMARY DELTA MODULATED WORDS (2 BIT) USING A PREDETERMINED C OFFSET TABLE. C C PRIMARY LFM DELTA MODULATED WORDS C IF ( PDMIND(L).NE.-1 ) THEN IPDM = IPDM + 1 PDELTA(1,IPDM) = 0 PDELTA(2,IPDM) = 0 PDELTA(3,IPDM) = 0 CALL MOVBIT(MAG, IMAG+PDMIND(L)+4, 2, PDELTA(1,IPDM), 0) CALL MOVBIT(MAG, IMAG+PDMIND(L)+2, 2, PDELTA(2,IPDM), 0) CALL MOVBIT(MAG, IMAG+PDMIND(L) , 2, PDELTA(3,IPDM), 0) c write(6,'(1x,''primary x,y,z DM: '',3(i2,3x))') c & pdelta(1,ipdm),pdelta(2,ipdm),pdelta(3,ipdm) END IF C C SECONDARY LFM DELTA MODULATED WORDS C IF ( SDMIND(L).NE.-1 ) THEN ISDM = ISDM + 1 SDELTA(1,ISDM) = 0 SDELTA(2,ISDM) = 0 SDELTA(3,ISDM) = 0 CALL MOVBIT(MAG, IMAG+SDMIND(L)+4, 2, SDELTA(1,ISDM), 0) CALL MOVBIT(MAG, IMAG+SDMIND(L)+2, 2, SDELTA(2,ISDM), 0) CALL MOVBIT(MAG, IMAG+SDMIND(L) , 2, SDELTA(3,ISDM), 0) c write(6,'(1x,''secondary x,y,z DM: '',3(i2,3x))') c & sdelta(1,isdm),sdelta(2,isdm),sdelta(3,isdm) END IF C 150 CONTINUE C 200 CONTINUE C C OUTPUT COUNTS AND STATUS VALUES C IF ( RECTEST ) THEN IF ( ICALL.EQ.1 ) OPEN(80,FILE='COUNTS.DAT',STATUS='NEW', & FORM='FORMATTED',CARRIAGECONTROL='LIST') DO IPDM = 1,2400 ISDM = (IPDM-1)/4 + 1 IP = (IPDM-1)/20 + 1 IS = (IPDM-1)/40 + 1 ICYC = (IPDM-1)/200 + 1 IF ( IPDM.EQ.1 ) THEN TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML WRITE(80,'(''RECORD NUMBER: '',I5.5,'' TIME: '', & I2,1X,I3,3(1X,I2.2),1X,I3.3)') RECNUM,TIME END IF WRITE(80,'(17(1X,I4),2(1X,Z4.4))') & IPDM, PDELTA(1,IPDM),PDELTA(2,IPDM),PDELTA(3,IPDM), & IP, PREF(1,IP), PREF(2,IP), PREF(3,IP), & ISDM,SDELTA(1,ISDM),SDELTA(2,ISDM),SDELTA(3,ISDM), & IS, SREF(1,IS), SREF(2,IS), SREF(3,IS), & ICYC,STAT1(ICYC),STAT2(ICYC) END DO END IF C RETURN END ****************************************************************** * * TITLE: UNPACK VOYAGER 814 WORD CR-6 EDR MAG SCIENCE BLOCK * * FILE NAME: MAGCR6.FOR * * PURPOSE: TO UNPACK THE MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 03/20/95 ORIGINAL CODE * (MODE CR-6) * * CALLING SEQUENCE: SUBROUTINE MAGCR6() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * SCIENCE DATA IS RECONSTRUCTED INTO I*2 VARIABLES FROM THE * FOLLOWING: * P ref 12 bits each * S ref 12 bits each * P dm 2 bits each * S dm 2 bits each * * PDL: * * CALL MOVBIT TO RECONSTRUCT THE MAG SCIENCE DATA INTO * I*2 VARIABLES * RETURN * ******************************************************************* SUBROUTINE MAGCR6() C C EACH CR-6 SCIENCE BLOCK CONTAINS 75 MINOR FRAMES (MF'S) EACH OF 152 C BIT SIZE. THERE IS ONE PRIMARY AND ONE SECONDARY REFERENCE WORD FROM C ONE MAG AXIS PER MF. THREE MINOR FRAMES ARE NEEDED TO ACQUIRE ONE C SET OF X,Y,Z MAG VALUES. C INTEGER*2 PDMIND(10),SDMIND(10),TIME(6) LOGICAL*1 DQFLAG,DPFLAG,RECTEST C C BIT OFFSET OF PRIMARY DELTA MODULATED WORD OCCURANCES C DATA PDMIND/ 32, 40, 56, 64, 80, 88,104,112,128,136/ C C BIT OFFSET OF PRIMARY DELTA MODULATED WORD OCCURANCES C DATA SDMIND/ 48, 72, 96,120,144, -1, -1, -1, -1, -1/ C C DATA PRESENCE SWITCH FLAG C DATA DPFLAG/.FALSE./ C C DATA QUALITY SWITCH FLAG C DATA DQFLAG/.FALSE./ C C DATA OUTPUT FLAG C DATA RECTEST/.FALSE./ ! for development testing only C DATA ICALL/0/ C INCLUDE 'UNPACK.INC' C IF ( DRSDAT.NE.35 ) RETURN C ICALL = ICALL + 1 IF ( .NOT.SYS2(10) ) DPFLAG = .TRUE. IF ( .NOT.SYS2(11) ) DQFLAG = .TRUE. C C MAG WORD FORMAT MAG DELTA WORD FORMAT C C BIT 7 0 BIT 7 0 C |_______| |_______| C | | | | C +-------+ +-------+ C C BITS 7-6 ARE FILL BITS 5-4 = X DM C BITS 5-0 CONTAIN BITS 3-2 = Y DM C EITHER HALF OF BITS 1-0 = Z DM C REFERENCE WORD C OR X,Y,Z DM WORD C C 12 BIT REFERENCE WORDS SPLIT INTO TWO 8 BIT MAG WORDS. C C READ 75 MINOR FRAMES (19 BYTES EACH) OF CR-6 MAG BLOCK (3256 BYTES). C IGNORE TRAILING SPARE BYTES (1831). C IPRX = 0 IPRY = 0 IPRZ = 0 ISRX = 0 ISRY = 0 ISRZ = 0 IPDM = 0 ISDM = 0 IMAG = -152 DO 200 J = 1,75,3 C C NEED 3 MF TO GET X,Y,Z AXIS (PRIMARY AND SECONDARY REFS) C DO 100 K = 1,3 C C BIT OFFSET (152 BITS PER CR-6 MF) C IMAG = IMAG + 152 C C MINOR FRAME COUNTER (75 MF PER CR-6 SCIENCE BLOCK) C IFRM = J + K - 1 C C DATA QUALITY STATUS WORD/INDICATOR COUNTER (ONE DQI PER 15 CR-6 MF) C IDQ = (IFRM-1)/15 + 1 C C PRIMARY X LFM REFERENCE WORD C IF ( K.EQ.1 ) THEN IPRX = IPRX + 1 PREF(1,IPRX) = 0 CALL MOVBIT(MAG, IMAG , 6, PREF(1,IPRX), 6) CALL MOVBIT(MAG, IMAG+8, 6, PREF(1,IPRX), 0) IF ( DPFLAG .AND. DPI(IFRM).NE.0 ) PREF(1,IPRX) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(1,IPRX) = 0 END IF C C PRIMARY Y LFM REFERENCE WORD C IF ( K.EQ.2 ) THEN IPRY = IPRY + 1 PREF(2,IPRY) = 0 CALL MOVBIT(MAG, IMAG , 6, PREF(2,IPRY), 6) CALL MOVBIT(MAG, IMAG+8, 6, PREF(2,IPRY), 0) IF ( DPFLAG .AND. DPI(IFRM).NE.0 ) PREF(2,IPRY) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(2,IPRY) = 0 END IF C C PRIMARY Z LFM REFERENCE WORD C IF ( K.EQ.3 ) THEN IPRZ = IPRZ + 1 PREF(3,IPRZ) = 0 CALL MOVBIT(MAG, IMAG , 6, PREF(3,IPRZ), 6) CALL MOVBIT(MAG, IMAG+8, 6, PREF(3,IPRZ), 0) c write(6,'(1x,''primary x,y,z ref : '',3(i4,3x))') c & pref(1,iprx),pref(2,ipry),pref(3,iprz) IF ( DPFLAG .AND. DPI(IFRM).NE.0 ) PREF(3,IPRZ) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) PREF(3,IPRZ) = 0 END IF C C SECONDARY X LFM REFERENCE WORD C IF ( K.EQ.1 ) THEN ISRX = ISRX + 1 SREF(1,ISRX) = 0 CALL MOVBIT(MAG, IMAG+16, 6, SREF(1,ISRX), 6) CALL MOVBIT(MAG, IMAG+24, 6, SREF(1,ISRX), 0) IF ( DPFLAG .AND. DPI(IFRM).NE.0 ) SREF(1,ISRX) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(1,ISRX) = 0 END IF C C SECONDARY Y LFM REFERENCE WORD C IF ( K.EQ.2 ) THEN ISRY = ISRY + 1 SREF(2,ISRY) = 0 CALL MOVBIT(MAG, IMAG+16, 6, SREF(2,ISRY), 6) CALL MOVBIT(MAG, IMAG+24, 6, SREF(2,ISRY), 0) IF ( DPFLAG .AND. DPI(IFRM).NE.0 ) SREF(2,ISRY) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(2,ISRY) = 0 END IF C C SECONDARY Z LFM REFERENCE WORD C IF ( K.EQ.3 ) THEN ISRZ = ISRZ + 1 SREF(3,ISRZ) = 0 CALL MOVBIT(MAG, IMAG+16, 6, SREF(3,ISRZ), 6) CALL MOVBIT(MAG, IMAG+24, 6, SREF(3,ISRZ), 0) c write(6,'(1x,''secondary x,y,z ref: '',3(i4,3x))') c & sref(1,isrx),sref(2,isry),sref(3,isrz) IF ( DPFLAG .AND. DPI(IFRM).NE.0 ) SREF(3,ISRZ) = 0 IF ( DQFLAG .AND. DQI(IDQ).NE.0 ) SREF(3,ISRZ) = 0 END IF C C UNPACK DELTA MODULATED WORDS C DO L = 1,10 C C PRIMARY LFM DELTA MODULATED WORDS C IF ( PDMIND(L).NE.-1 ) THEN IPDM = IPDM + 1 PDELTA(1,IPDM) = 0 PDELTA(2,IPDM) = 0 PDELTA(3,IPDM) = 0 CALL MOVBIT(MAG, IMAG+PDMIND(L)+4, 2, PDELTA(1,IPDM), 0) CALL MOVBIT(MAG, IMAG+PDMIND(L)+2, 2, PDELTA(2,IPDM), 0) CALL MOVBIT(MAG, IMAG+PDMIND(L) , 2, PDELTA(3,IPDM), 0) c write(6,'(1x,''primary x,y,z DM: '',3(i2,3x))') c & pdelta(1,ipdm),pdelta(2,ipdm),pdelta(3,ipdm) END IF C C SECONDARY LFM DELTA MODULATED WORDS C IF ( SDMIND(L).NE.-1 ) THEN ISDM = ISDM + 1 SDELTA(1,ISDM) = 0 SDELTA(2,ISDM) = 0 SDELTA(3,ISDM) = 0 CALL MOVBIT(MAG, IMAG+SDMIND(L)+4, 2, SDELTA(1,ISDM), 0) CALL MOVBIT(MAG, IMAG+SDMIND(L)+2, 2, SDELTA(2,ISDM), 0) CALL MOVBIT(MAG, IMAG+SDMIND(L) , 2, SDELTA(3,ISDM), 0) c write(6,'(1x,''secondary x,y,z DM: '',3(i2,3x))') c & sdelta(1,isdm),sdelta(2,isdm),sdelta(3,isdm) END IF C END DO C 100 CONTINUE C 200 CONTINUE C C OUTPUT COUNTS AND STATUS VALUES C IF ( RECTEST ) THEN IF ( ICALL.EQ.1 ) OPEN(80,FILE='COUNTS.DAT',STATUS='NEW', & FORM='FORMATTED',CARRIAGECONTROL='LIST') DO IPDM = 1,750 ISDM = (IPDM-1)/2 + 1 IP = (IPDM-1)/30 + 1 IS = (IPDM-1)/30 + 1 ICYC = (IPDM-1)/75 + 1 IF ( IPDM.EQ.1 ) THEN TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML WRITE(80,'(''RECORD NUMBER: '',I5.5,'' TIME: '', & I2,1X,I3,3(1X,I2.2),1X,I3.3)') RECNUM,TIME END IF WRITE(80,'(17(1X,I4),2(1X,Z4.4))') & IPDM, PDELTA(1,IPDM),PDELTA(2,IPDM),PDELTA(3,IPDM), & IP, PREF(1,IP), PREF(2,IP), PREF(3,IP), & ISDM,SDELTA(1,ISDM),SDELTA(2,ISDM),SDELTA(3,ISDM), & IS, SREF(1,IS), SREF(2,IS), SREF(3,IS), & ICYC,STAT1(ICYC),STAT2(ICYC) END DO END IF C RETURN END ****************************************************************** * * TITLE: UNPACK VOYAGER 1500 WORD EDR MAG DATA * * FILE NAME: MAGGS3.FOR * * PURPOSE: TO UNPACK THE MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. J. KEMPLER 8/12/85 ORIGINAL CODE * S. B. KRAMER 01/06/93 MODIFIED FOR NEW VOY PROD PGM * * CALLING SEQUENCE: SUBROUTINE MAGGS3() * * ARGUMENT LIST: * * NAME TYPE USED PURPOSE * ----- ----- ----- -------- * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * SCIENCE DATA IS RECONSTRUCTED INTO I*2 VARIABLES FROM THE * FOLLOWING: * P diff 6 bits each * P ref 12 bits each * S diff 6 bits each * S ref 12 bits each * OB HFM 12 bits each * IB HFM 12 bits each * * PDL: * * CALL MOVBIT TO RECONSTRUCT THE MAG SCIENCE DATA INTO I*2 VARIABLES * RETURN * ******************************************************************* SUBROUTINE MAGGS3() C INTEGER*4 PDXIND(10), PDYIND(10), PDZIND(10), I PRXIND(2), PRYIND(2), PRZIND(2), I SDXIND(5), SDYIND(5), SDZIND(5) C LOGICAL*1 DPFLAG,DQFLAG,RECTEST/.FALSE./ C INCLUDE 'UNPACK.INC' C C BIT OFFSET OF PRIMARY DIIFERENCE WORDS C DATA PDXIND/ 0,168,264,288,336,360,456,480,528,552/ DATA PDYIND/24,176,272,296,344,384,464,488,536,560/ DATA PDZIND/48,184,280,304,352,408,472,496,544,568/ C C BIT OFFSET OF PRIMARY REFERENCE WORDS C DATA PRXIND/ 8,368/ DATA PRYIND/32,392/ DATA PRZIND/56,416/ C C BIT OFFSET OF SECONDARY REFERENCE WORDS C DATA SDXIND/192,312,432,504,576/ DATA SDYIND/216,320,440,512,584/ DATA SDZIND/240,328,448,520,592/ C C DATA PRESENCE SWITCH FLAG C DATA DPFLAG/.FALSE./ C C DATA QUALITY SWITCH FLAG C DATA DQFLAG/.FALSE./ C IF (DRSDAT.NE.35) RETURN C IF (.NOT.SYS2(10)) DPFLAG = .TRUE. IF (.NOT.SYS2(11)) DQFLAG = .TRUE. C IPD = 0 IPR = 0 ISD = 0 ISR = 0 IB = 0 IMAG=-600 IFRM = 0 C DO 90 I=1,80 C C BIT OFFSET (600 BITS PER GS-3 FRAME) C IMAG=IMAG+600 C C MINOR FRAME COUNTER (80 MF PER GS-3 SCIENCE BLOCK) C IFRM = I C C DATA QUALITY STATUS WORD/INDICATOR COUNTER (ONE DQI PER 8 GS-3 MF) C IDQ = INT((IFRM-1)/8) + 1 C DO 10 J=1,10 C C EXTRACT PRIMARY DIFFERENCE WORDS C IPD=IPD+1 C PDIFF(1,IPD) = 0 CALL MOVBIT( MAG, PDXIND(J)+IMAG , 6, PDIFF(1,IPD), 0) IF ( PDIFF(1,IPD).GE.32 ) PDIFF(1,IPD) = PDIFF(1,IPD) - 64 IF (DPFLAG.AND.DPI(IFRM).NE.0) PDIFF(1,IPD) = 255 IF (DQFLAG.AND.DQI(IDQ).NE.0) PDIFF(1,IPD) = 255 C PDIFF(2,IPD) = 0 CALL MOVBIT( MAG, PDYIND(J)+IMAG , 6, PDIFF(2,IPD), 0) IF ( PDIFF(2,IPD).GE.32 ) PDIFF(2,IPD) = PDIFF(2,IPD) - 64 IF (DPFLAG.AND.DPI(IFRM).NE.0) PDIFF(2,IPD) = 255 IF (DQFLAG.AND.DQI(IDQ).NE.0) PDIFF(2,IPD) = 255 C PDIFF(3,IPD) = 0 CALL MOVBIT( MAG, PDZIND(J)+IMAG , 6, PDIFF(3,IPD), 0) IF ( PDIFF(3,IPD).GE.32 ) PDIFF(3,IPD) = PDIFF(3,IPD) - 64 IF (DPFLAG.AND.DPI(IFRM).NE.0) PDIFF(3,IPD) = 255 IF (DQFLAG.AND.DQI(IDQ).NE.0) PDIFF(3,IPD) = 255 C 10 CONTINUE C DO 20 J=1,2 C C EXTRACT PRIMARY REFERENCE WORDS C IPR=IPR+1 C CALL MOVBIT( MAG, PRXIND(J)+IMAG , 6, PREF(1,IPR), 6) CALL MOVBIT( MAG, PRXIND(J)+IMAG+8, 6, PREF(1,IPR), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) PREF(1,IPR) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) PREF(1,IPR) = 0 C CALL MOVBIT( MAG, PRYIND(J)+IMAG , 6, PREF(2,IPR), 6) CALL MOVBIT( MAG, PRYIND(J)+IMAG+8, 6, PREF(2,IPR), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) PREF(2,IPR) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) PREF(2,IPR) = 0 C CALL MOVBIT( MAG, PRZIND(J)+IMAG , 6, PREF(3,IPR), 6) CALL MOVBIT( MAG, PRZIND(J)+IMAG+8, 6, PREF(3,IPR), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) PREF(3,IPR) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) PREF(3,IPR) = 0 C 20 CONTINUE C DO 30 J=1,5 C C EXTRACT SECONDARY DIFFERENCE WORDS C ISD=ISD+1 C SDIFF(1,ISD) = 0 CALL MOVBIT( MAG, SDXIND(J)+IMAG , 6, SDIFF(1,ISD), 0) IF ( SDIFF(1,ISD).GE.32 ) SDIFF(1,ISD) = SDIFF(1,ISD) - 64 IF (DPFLAG.AND.DPI(IFRM).NE.0) SDIFF(1,ISD) = 255 IF (DQFLAG.AND.DQI(IDQ).NE.0) SDIFF(1,ISD) = 255 C SDIFF(2,ISD) = 0 CALL MOVBIT( MAG, SDYIND(J)+IMAG , 6, SDIFF(2,ISD), 0) IF ( SDIFF(2,ISD).GE.32 ) SDIFF(2,ISD) = SDIFF(2,ISD) - 64 IF (DPFLAG.AND.DPI(IFRM).NE.0) SDIFF(2,ISD) = 255 IF (DQFLAG.AND.DQI(IDQ).NE.0) SDIFF(2,ISD) = 255 C SDIFF(3,ISD) = 0 CALL MOVBIT( MAG, SDZIND(J)+IMAG , 6, SDIFF(3,ISD), 0) IF ( SDIFF(3,ISD).GE.32 ) SDIFF(3,ISD) = SDIFF(3,ISD) - 64 IF (DPFLAG.AND.DPI(IFRM).NE.0) SDIFF(3,ISD) = 255 IF (DQFLAG.AND.DQI(IDQ).NE.0) SDIFF(3,ISD) = 255 C 30 CONTINUE C C EXTRACT SECONDARY REFERENCE WORDS C ISR=ISR+1 C CALL MOVBIT( MAG, 200+IMAG , 6, SREF(1,ISR), 6) CALL MOVBIT( MAG, 200+IMAG+8, 6, SREF(1,ISR), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) SREF(1,ISR) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) SREF(1,ISR) = 0 C CALL MOVBIT( MAG, 224+IMAG , 6, SREF(2,ISR), 6) CALL MOVBIT( MAG, 224+IMAG+8, 6, SREF(2,ISR), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) SREF(2,ISR) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) SREF(2,ISR) = 0 C CALL MOVBIT( MAG, 248+IMAG , 6, SREF(3,ISR), 6) CALL MOVBIT( MAG, 248+IMAG+8, 6, SREF(3,ISR), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) SREF(3,ISR) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) SREF(3,ISR) = 0 C C EXTRACT HIGH FIELD MAG WORDS C IB=IB+1 C C OUTBOARD HIGH FIELD MAG C CALL MOVBIT( MAG, 72 +IMAG , 6, OBHFM(1,IB), 6) CALL MOVBIT( MAG, 72 +IMAG+8, 6, OBHFM(1,IB), 0) C CALL MOVBIT( MAG, 88 +IMAG , 6, OBHFM(2,IB), 6) CALL MOVBIT( MAG, 88 +IMAG+8, 6, OBHFM(2,IB), 0) C CALL MOVBIT( MAG, 104+IMAG , 6, OBHFM(3,IB), 6) CALL MOVBIT( MAG, 104+IMAG+8, 6, OBHFM(3,IB), 0) C C INBOARD HIGH FIELD MAG C CALL MOVBIT( MAG, 120+IMAG , 6, IBHFM(1,IB), 6) CALL MOVBIT( MAG, 120+IMAG+8, 6, IBHFM(1,IB), 0) C CALL MOVBIT( MAG, 136+IMAG , 6, IBHFM(2,IB), 6) CALL MOVBIT( MAG, 136+IMAG+8, 6, IBHFM(2,IB), 0) C CALL MOVBIT( MAG, 152+IMAG , 6, IBHFM(3,IB), 6) CALL MOVBIT( MAG, 152+IMAG+8, 6, IBHFM(3,IB), 0) C 90 CONTINUE C C OUTPUT COUNTS C IF (RECTEST) THEN DO I = 1,800 K = (I-1)/2 + 1 L = (I-1)/5 + 1 MM = (I-1)/10 + 1 WRITE(99,800) RECNUM,L,(PREF(J,L),J=1,3),I,(PDIFF(J,I),J=1,3), & MM,(SREF(J,MM),J=1,3),K,(SDIFF(J,K),J=1,3) END DO END IF C RETURN 800 FORMAT(1X,I5,4(1X,I3,3(1X,I5))) END ****************************************************************** * * TITLE: UNPACK VOYAGER 260 WORD VIM-5 EDR MAG SCIENCE BLOCK * * FILE NAME: MAGVIM5.FOR * * PURPOSE: TO UNPACK THE MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 10/26/92 ORIGINAL CODE * (MODE VIM-5) * * CALLING SEQUENCE: SUBROUTINE MAGVIM5() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * SCIENCE DATA IS RECONSTRUCTED INTO I*2 VARIABLES FROM THE * FOLLOWING: * P diff 6 bits each * P ref 12 bits each * S ref 12 bits each * * PDL: * * CALL MOVBIT TO RECONSTRUCT THE MAG SCIENCE DATA INTO * I*2 VARIABLES * RETURN * ******************************************************************* SUBROUTINE MAGVIM5() C INTEGER*4 PDXIND(125),PDYIND(125),PDZIND(125) INTEGER*4 PRXIND(5),PRYIND(5),PRZIND(5) INTEGER*4 SRXIND(5),SRYIND(5),SRZIND(5) LOGICAL*1 DQFLAG,DPFLAG C C BIT OFFSET OF PRIMARY REFERENCE WORD OCCURANCES WITHIN 5 MF CYCLE C DATA PRXIND/ 6,120,198,312, -1/ DATA PRYIND/ 24,138,216,330, -1/ DATA PRZIND/ 42,156,234,348, -1/ C C BIT OFFSET OF SECONDARY REFERENCE WORD OCCURANCES WITHIN 5 MF CYCLE C DATA SRXIND/ 54, -1,246, -1, -1/ DATA SRYIND/ 66, -1,258, -1, -1/ DATA SRZIND/ 78, -1,270, -1, -1/ C C BIT OFFSET OF DIFFERENCE WORD OCCURANCES WITHIN 5 MF CYCLE C DATA PDXIND/ 0, 90,108,126,144,162,180,198,216,234, & 252,270,288,306,324,342,360,378,396, -1, & -1, -1, -1, -1 ,-1, C & 6, 24, 42, 60, 78, 96,114,168,186,204, & 222,240,258,276,294,312,330,348,366,384, & 402, -1, -1, -1, -1, C & 12, 30, 48, 66, 84,102,120,138,156,174, & 192,282,300,318,336,354,372,390, -1, -1, & -1, -1, -1, -1, -1, C & 0, 18, 36, 54, 72, 90,108,126,144,162, & 180,198,216,234,252,270,288,306,360,378, & 396, -1 ,-1, -1, -1, C & 6, 24, 42, 60, 78, 96,114,132,150,168, & 186,204,222,240,258,276,294,312,330,348, & 366, -1, -1, -1, -1/ C DATA PDYIND/ 18, 96,114,132,150,168,186,204,222,240, & 258,276,294,312,330,348,366,384,402, -1, & -1, -1, -1, -1, -1, C & 12, 30, 48, 66, 84,102,132,174,192,210, & 228,246,264,282,300,318,336,354,372,390, & -1, -1, -1, -1, -1, C & 0, 18, 36, 54, 72, 90,108,126,144,162, & 180,210,288,306,324,342,360,378,396, -1, & -1, -1, -1, -1, -1, C & 6, 24, 42, 60, 78, 96,114,132,150,168, & 186,204,222,240,258,276,294,324,366,384, & 402, -1, -1, -1, -1, C & 12, 30, 48, 66, 84,102,120,138,156,174, & 192,210,228,246,264,282,300,318,336,354, & 372, -1, -1, -1, -1/ C DATA PDZIND/ 36,102,120,138,156,174,192,210,228,246, & 264,282,300,318,336,354,372,390, -1, -1, & -1, -1, -1, -1, -1, C & 0, 18, 36, 54, 72, 90,108,150,180,198, & 216,234,252,270,288,306,324,342,360,378, & 396, -1, -1, -1, -1, C & 6, 24, 42, 60, 78, 96,114,132,150,168, & 186,228,294,312,330,348,366,384,402, -1, & -1, -1, -1, -1, -1, C & 12, 30, 48, 66, 84,102,120,138,156,174, & 192,210,228,246,264,282,300,342,372,390, & -1, -1, -1, -1, -1, C & 0, 18, 36, 54, 72, 90,108,126,144,162, & 180,198,216,234,252,270,288,306,324,342, & 360,378, -1, -1, -1/ C C DATA PRESENCE SWITCH FLAG C DATA DPFLAG/.FALSE./ C C DATA QUALITY SWITCH FLAG C DATA DQFLAG/.FALSE./ C INCLUDE 'UNPACK.INC' C IF (DRSDAT.NE.35) RETURN C IF (.NOT.SYS2(10)) DPFLAG = .TRUE. IF (.NOT.SYS2(11)) DQFLAG = .TRUE. C C CONVERT IBM ARCHITECTURE BYTE INTO VAX BYTE ARCHITECTURE BY C REVERSING BIT ORDER IN EACH BYTE, IE 0-7 -> 7-0 C DO J=1,1040 MAG(J) = FLIP(ZEXT(MAG(J))) END DO C C READ 20 MINOR FRAMES (52 BYTE EACH) OF VIM-5 RECORD (1040 BYTES). DATA C CYCLES EVERY 5 MINOR FRAMES. C IPR = 0 ISR = 0 IPRX = 0 IPRY = 0 IPRZ = 0 ISRX = 0 ISRY = 0 ISRZ = 0 IPDX = 0 IPDY = 0 IPDZ = 0 IMAG = -416 DO 200 J = 1,4 C DO 100 K = 1,5 C C BIT OFFSET (416 BITS PER VIM-5 MF) C IMAG = IMAG + 416 C C MINOR FRAME COUNTER (20 MF PER VIM-5 SCIENCE BLOCK) C IFRM = (J-1)*5 + K C C DATA QUALITY STATUS WORD/INDICATOR COUNTER (ONE DQI PER 8 VIM-5 MF) C IDQ = INT((IFRM-1)/8) + 1 C C EXTRACT PRIMARY REFERENCE WORDS (12 BIT) USING A PREDETERMINED OFFSET C TABLE. C IF (PRXIND(K).NE.-1) THEN IPRX = IPRX + 1 PREF(1,IPRX) = 0 CALL MOVBIT(MAG, IMAG+PRXIND(K) , 1, PREF(1,IPRX), 11) CALL MOVBIT(MAG, IMAG+PRXIND(K)+1 , 1, PREF(1,IPRX), 10) CALL MOVBIT(MAG, IMAG+PRXIND(K)+2 , 1, PREF(1,IPRX), 9) CALL MOVBIT(MAG, IMAG+PRXIND(K)+3 , 1, PREF(1,IPRX), 8) CALL MOVBIT(MAG, IMAG+PRXIND(K)+4 , 1, PREF(1,IPRX), 7) CALL MOVBIT(MAG, IMAG+PRXIND(K)+5 , 1, PREF(1,IPRX), 6) CALL MOVBIT(MAG, IMAG+PRXIND(K)+6 , 1, PREF(1,IPRX), 5) CALL MOVBIT(MAG, IMAG+PRXIND(K)+7 , 1, PREF(1,IPRX), 4) CALL MOVBIT(MAG, IMAG+PRXIND(K)+8 , 1, PREF(1,IPRX), 3) CALL MOVBIT(MAG, IMAG+PRXIND(K)+9 , 1, PREF(1,IPRX), 2) CALL MOVBIT(MAG, IMAG+PRXIND(K)+10, 1, PREF(1,IPRX), 1) CALL MOVBIT(MAG, IMAG+PRXIND(K)+11, 1, PREF(1,IPRX), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) PREF(1,IPRX) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) PREF(1,IPRX) = 0 END IF C IF (PRYIND(K).NE.-1) THEN IPRY = IPRY + 1 PREF(2,IPRY) = 0 CALL MOVBIT(MAG, IMAG+PRYIND(K) , 1, PREF(2,IPRY), 11) CALL MOVBIT(MAG, IMAG+PRYIND(K)+1 , 1, PREF(2,IPRY), 10) CALL MOVBIT(MAG, IMAG+PRYIND(K)+2 , 1, PREF(2,IPRY), 9) CALL MOVBIT(MAG, IMAG+PRYIND(K)+3 , 1, PREF(2,IPRY), 8) CALL MOVBIT(MAG, IMAG+PRYIND(K)+4 , 1, PREF(2,IPRY), 7) CALL MOVBIT(MAG, IMAG+PRYIND(K)+5 , 1, PREF(2,IPRY), 6) CALL MOVBIT(MAG, IMAG+PRYIND(K)+6 , 1, PREF(2,IPRY), 5) CALL MOVBIT(MAG, IMAG+PRYIND(K)+7 , 1, PREF(2,IPRY), 4) CALL MOVBIT(MAG, IMAG+PRYIND(K)+8 , 1, PREF(2,IPRY), 3) CALL MOVBIT(MAG, IMAG+PRYIND(K)+9 , 1, PREF(2,IPRY), 2) CALL MOVBIT(MAG, IMAG+PRYIND(K)+10, 1, PREF(2,IPRY), 1) CALL MOVBIT(MAG, IMAG+PRYIND(K)+11, 1, PREF(2,IPRY), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) PREF(2,IPRY) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) PREF(2,IPRY) = 0 END IF C IF (PRZIND(K).NE.-1) THEN IPRZ = IPRZ + 1 PREF(3,IPRZ) = 0 CALL MOVBIT(MAG, IMAG+PRZIND(K) , 1, PREF(3,IPRZ), 11) CALL MOVBIT(MAG, IMAG+PRZIND(K)+1 , 1, PREF(3,IPRZ), 10) CALL MOVBIT(MAG, IMAG+PRZIND(K)+2 , 1, PREF(3,IPRZ), 9) CALL MOVBIT(MAG, IMAG+PRZIND(K)+3 , 1, PREF(3,IPRZ), 8) CALL MOVBIT(MAG, IMAG+PRZIND(K)+4 , 1, PREF(3,IPRZ), 7) CALL MOVBIT(MAG, IMAG+PRZIND(K)+5 , 1, PREF(3,IPRZ), 6) CALL MOVBIT(MAG, IMAG+PRZIND(K)+6 , 1, PREF(3,IPRZ), 5) CALL MOVBIT(MAG, IMAG+PRZIND(K)+7 , 1, PREF(3,IPRZ), 4) CALL MOVBIT(MAG, IMAG+PRZIND(K)+8 , 1, PREF(3,IPRZ), 3) CALL MOVBIT(MAG, IMAG+PRZIND(K)+9 , 1, PREF(3,IPRZ), 2) CALL MOVBIT(MAG, IMAG+PRZIND(K)+10, 1, PREF(3,IPRZ), 1) CALL MOVBIT(MAG, IMAG+PRZIND(K)+11, 1, PREF(3,IPRZ), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) PREF(3,IPRZ) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) PREF(3,IPRZ) = 0 END IF C C EXTRACT SECONDARY REFERENCE WORDS (12 BIT) USING A PREDETERMINED OFFSET C TABLE AND ASSIGN TO I*2 WORD. C IF (SRXIND(K).NE.-1) THEN ISRX = ISRX + 1 SREF(1,ISRX) = 0 CALL MOVBIT(MAG, IMAG+SRXIND(K) , 1, SREF(1,ISRX), 11) CALL MOVBIT(MAG, IMAG+SRXIND(K)+1 , 1, SREF(1,ISRX), 10) CALL MOVBIT(MAG, IMAG+SRXIND(K)+2 , 1, SREF(1,ISRX), 9) CALL MOVBIT(MAG, IMAG+SRXIND(K)+3 , 1, SREF(1,ISRX), 8) CALL MOVBIT(MAG, IMAG+SRXIND(K)+4 , 1, SREF(1,ISRX), 7) CALL MOVBIT(MAG, IMAG+SRXIND(K)+5 , 1, SREF(1,ISRX), 6) CALL MOVBIT(MAG, IMAG+SRXIND(K)+6 , 1, SREF(1,ISRX), 5) CALL MOVBIT(MAG, IMAG+SRXIND(K)+7 , 1, SREF(1,ISRX), 4) CALL MOVBIT(MAG, IMAG+SRXIND(K)+8 , 1, SREF(1,ISRX), 3) CALL MOVBIT(MAG, IMAG+SRXIND(K)+9 , 1, SREF(1,ISRX), 2) CALL MOVBIT(MAG, IMAG+SRXIND(K)+10, 1, SREF(1,ISRX), 1) CALL MOVBIT(MAG, IMAG+SRXIND(K)+11, 1, SREF(1,ISRX), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) SREF(1,ISRX) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) SREF(1,ISRX) = 0 END IF C IF (SRYIND(K).NE.-1) THEN ISRY = ISRY + 1 SREF(2,ISRY) = 0 CALL MOVBIT(MAG, IMAG+SRYIND(K) , 1, SREF(2,ISRY), 11) CALL MOVBIT(MAG, IMAG+SRYIND(K)+1 , 1, SREF(2,ISRY), 10) CALL MOVBIT(MAG, IMAG+SRYIND(K)+2 , 1, SREF(2,ISRY), 9) CALL MOVBIT(MAG, IMAG+SRYIND(K)+3 , 1, SREF(2,ISRY), 8) CALL MOVBIT(MAG, IMAG+SRYIND(K)+4 , 1, SREF(2,ISRY), 7) CALL MOVBIT(MAG, IMAG+SRYIND(K)+5 , 1, SREF(2,ISRY), 6) CALL MOVBIT(MAG, IMAG+SRYIND(K)+6 , 1, SREF(2,ISRY), 5) CALL MOVBIT(MAG, IMAG+SRYIND(K)+7 , 1, SREF(2,ISRY), 4) CALL MOVBIT(MAG, IMAG+SRYIND(K)+8 , 1, SREF(2,ISRY), 3) CALL MOVBIT(MAG, IMAG+SRYIND(K)+9 , 1, SREF(2,ISRY), 2) CALL MOVBIT(MAG, IMAG+SRYIND(K)+10, 1, SREF(2,ISRY), 1) CALL MOVBIT(MAG, IMAG+SRYIND(K)+11, 1, SREF(2,ISRY), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) SREF(2,ISRY) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) SREF(2,ISRY) = 0 END IF C IF (SRZIND(K).NE.-1) THEN ISRZ = ISRZ + 1 SREF(3,ISRZ) = 0 CALL MOVBIT(MAG, IMAG+SRZIND(K) , 1, SREF(3,ISRZ), 11) CALL MOVBIT(MAG, IMAG+SRZIND(K)+1 , 1, SREF(3,ISRZ), 10) CALL MOVBIT(MAG, IMAG+SRZIND(K)+2 , 1, SREF(3,ISRZ), 9) CALL MOVBIT(MAG, IMAG+SRZIND(K)+3 , 1, SREF(3,ISRZ), 8) CALL MOVBIT(MAG, IMAG+SRZIND(K)+4 , 1, SREF(3,ISRZ), 7) CALL MOVBIT(MAG, IMAG+SRZIND(K)+5 , 1, SREF(3,ISRZ), 6) CALL MOVBIT(MAG, IMAG+SRZIND(K)+6 , 1, SREF(3,ISRZ), 5) CALL MOVBIT(MAG, IMAG+SRZIND(K)+7 , 1, SREF(3,ISRZ), 4) CALL MOVBIT(MAG, IMAG+SRZIND(K)+8 , 1, SREF(3,ISRZ), 3) CALL MOVBIT(MAG, IMAG+SRZIND(K)+9 , 1, SREF(3,ISRZ), 2) CALL MOVBIT(MAG, IMAG+SRZIND(K)+10, 1, SREF(3,ISRZ), 1) CALL MOVBIT(MAG, IMAG+SRZIND(K)+11, 1, SREF(3,ISRZ), 0) IF (DPFLAG.AND.DPI(IFRM).NE.0) SREF(3,ISRZ) = 0 IF (DQFLAG.AND.DQI(IDQ).NE.0) SREF(3,ISRZ) = 0 END IF C C EXTRACT 6 BIT DIFFERENCE WORDS FROM MINOR FRAME ACCORDING TO PREDETERMINED C INDEX IN DATA STATEMENT AND ASSIGN TO I*2 WORD. C DO LL = 1,25 IOFF = LL + (K-1)*25 IF (PDXIND(IOFF).NE.-1) THEN IPDX = IPDX + 1 PDIFF(1,IPDX) = 0 CALL MOVBIT(MAG, IMAG+PDXIND(IOFF) , 1, PDIFF(1,IPDX), 5) CALL MOVBIT(MAG, IMAG+PDXIND(IOFF)+1, 1, PDIFF(1,IPDX), 4) CALL MOVBIT(MAG, IMAG+PDXIND(IOFF)+2, 1, PDIFF(1,IPDX), 3) CALL MOVBIT(MAG, IMAG+PDXIND(IOFF)+3, 1, PDIFF(1,IPDX), 2) CALL MOVBIT(MAG, IMAG+PDXIND(IOFF)+4, 1, PDIFF(1,IPDX), 1) CALL MOVBIT(MAG, IMAG+PDXIND(IOFF)+5, 1, PDIFF(1,IPDX), 0) IF (PDIFF(1,IPDX).GT.31) PDIFF(1,IPDX) = PDIFF(1,IPDX) - 64 IF (DPFLAG.AND.DPI(IFRM).NE.0) PDIFF(1,IPDX) = 255 IF (DQFLAG.AND.DQI(IDQ).NE.0) PDIFF(1,IPDX) = 255 END IF C IF (PDYIND(IOFF).NE.-1) THEN IPDY = IPDY + 1 PDIFF(2,IPDY) = 0 CALL MOVBIT(MAG, IMAG+PDYIND(IOFF) , 1, PDIFF(2,IPDY), 5) CALL MOVBIT(MAG, IMAG+PDYIND(IOFF)+1, 1, PDIFF(2,IPDY), 4) CALL MOVBIT(MAG, IMAG+PDYIND(IOFF)+2, 1, PDIFF(2,IPDY), 3) CALL MOVBIT(MAG, IMAG+PDYIND(IOFF)+3, 1, PDIFF(2,IPDY), 2) CALL MOVBIT(MAG, IMAG+PDYIND(IOFF)+4, 1, PDIFF(2,IPDY), 1) CALL MOVBIT(MAG, IMAG+PDYIND(IOFF)+5, 1, PDIFF(2,IPDY), 0) IF (PDIFF(2,IPDY).GT.31) PDIFF(2,IPDY) = PDIFF(2,IPDY) - 64 IF (DPFLAG.AND.DPI(IFRM).NE.0) PDIFF(2,IPDY) = 255 IF (DQFLAG.AND.DQI(IDQ).NE.0) PDIFF(2,IPDY) = 255 END IF C IF (PDZIND(IOFF).NE.-1) THEN IPDZ = IPDZ + 1 PDIFF(3,IPDZ) = 0 CALL MOVBIT(MAG, IMAG+PDZIND(IOFF) , 1, PDIFF(3,IPDZ), 5) CALL MOVBIT(MAG, IMAG+PDZIND(IOFF)+1, 1, PDIFF(3,IPDZ), 4) CALL MOVBIT(MAG, IMAG+PDZIND(IOFF)+2, 1, PDIFF(3,IPDZ), 3) CALL MOVBIT(MAG, IMAG+PDZIND(IOFF)+3, 1, PDIFF(3,IPDZ), 2) CALL MOVBIT(MAG, IMAG+PDZIND(IOFF)+4, 1, PDIFF(3,IPDZ), 1) CALL MOVBIT(MAG, IMAG+PDZIND(IOFF)+5, 1, PDIFF(3,IPDZ), 0) IF (PDIFF(3,IPDZ).GT.31) PDIFF(3,IPDZ) = PDIFF(3,IPDZ) - 64 IF (DPFLAG.AND.DPI(IFRM).NE.0) PDIFF(3,IPDZ) = 255 IF (DQFLAG.AND.DQI(IDQ).NE.0) PDIFF(3,IPDZ) = 255 END IF END DO C 100 CONTINUE C 200 CONTINUE C RETURN END