SUBROUTINE ANGLES(B,LEN,FMOD,DEL,LAM,BAD) C C CALCULATE FIELD ANGLES FROM FIELD COMPONENTS AND MODULUS C C INPUT ARRAY OF FIELD COMPONENTS C OUTPUT FIELD MODULUS, LATITUDINAL AND LONGITUDINAL FIELD ANGLES C REAL*4 B(3,LEN),FMOD(LEN),DEL(LEN),LAM(LEN) C DO I = 1,LEN C C CALCULATE FIELD COMPONENT NORM (MODULUS) C IF (B(1,I).NE.BAD.AND. & B(2,I).NE.BAD.AND. & B(3,I).NE.BAD) THEN FMOD(I) = SQRT(B(1,I)**2+B(2,I)**2+B(3,I)**2) ELSE FMOD(I) = BAD END IF C C CALCULATE LATITUDINAL FIELD ANGLE C IF (FMOD(I).NE.BAD.AND. & FMOD(I).NE.0.0.AND. & B(3,I).NE.BAD) THEN DEL(I) = ASIN(B(3,I)/FMOD(I)) * & 57.2957795D0 ELSE DEL(I) = BAD END IF C C CALCULATE LONGITUDINAL FIELD ANGLE C IF (B(1,I).NE.BAD.AND. & B(2,I).NE.BAD.AND. & B(1,I).NE.0.0) THEN LAM(I) = 180.0 - & ATAN2(B(2,I),-B(1,I)) * 57.2957795D0 ELSE IF (B(1,I).NE.BAD.AND. & B(2,I).NE.BAD.AND. & B(1,I).EQ.0.0.AND. & B(2,I).NE.0.0) THEN LAM(I) = 90.0 ELSE IF (B(1,I).NE.BAD.AND. & B(2,I).NE.BAD.AND. & B(1,I).NE.0.0.AND. & B(2,I).EQ.0.0) THEN LAM(I) = 180.0 ELSE LAM(I) = BAD END IF C END DO C RETURN END SUBROUTINE BIGAVE(B192,TIME,BAD) C C PRODUCE 1 48 SECOND AVERAGE AND 5 9.6 SECOND AVERAGES FROM 25 1.92 SECOND C FIELD COMPONENT AVERAGES (48 SEC PERIOD). OUTPUT RECORD WITH TIME TAG C FROM 48 SECOND AVERAGE MARKING THE BEGINNING OF THE AVERAGING PERIOD. C ORIGINAL CODE SBK 12/01/93 C REVISION 1 SBK 05/27/94 C NOTES: C C TO MAINTAIN CONVENTIONS ESTABLISHED WITH THE ORIGINAL C VOYAGER PRODUCTION SYSTEM USED ON THE IBM MVS PLATFORM: C C ALL FIELD AVERAGES WRITTEN IN THE ORDER XXX...,YYY...,ZZZ... C ALL FIELD RMS DATA IS WRITTEN IN THE ORDER X,Y,Z,...,X,Y,Z C SEDR ROTATION MATRICES MTB AND MHG ARE THE TRANSPOSE OF THOSE C DESCRIBED IN THE ORIGINAL VOYAGER SEDR DESCRIPTION. THESE C MATRICES ARE PROPERLY OPERATED UPON WITHIN THE CODE. C CHARACTER DATAID*4 C INTEGER*2 TIME(6),SEDRTIME(6),AVETIME(6), & DUMMTIME(6),CURRYEAR(6), & WORD32(2),DATATYPE(2) C INTEGER*4 IB192(25),IB96(5),IB48 C REAL*4 GAMMA(3,400),FMOD(400),DEL(400),LAM(400), & FMAG192(25),FMOD192(25),DEL192(25), & LAM192(25),B192(3,25),RMS192(3,25), & X192(25),Y192(25),Z192(25), & XRMS192(25),YRMS192(25),ZRMS192(25), & FMAG96(5),FMOD96(5),DEL96(5), & LAM96(5),B96(3,5),RMS96(3,5), & X96(5),Y96(5),Z96(5), & XRMS96(5),YRMS96(5),ZRMS96(5), & FMAG48,FMOD48,DEL48, & LAM48,B48(3),RMS48(3), & X48,Y48,Z48 C REAL*4 HDR(32),DATA(341),SCFLD(155),POSN(13),ATTD(27), & HOLD(27) C REAL*4 SPV(6),RANGE,ANG(2),HG(3,25), & MTB(3,3),MTB5(3,3),MHG(3,3) C REAL*8 DD,TD,TN,TP C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (SUMOUT(33),DATA(1)), & (SUMOUT(342),SCFLD(1)), & (SUMOUT(529),POSN(1)), (SUMOUT(542),ATTD(1)) C EQUIVALENCE (HDR(1),DATAID), (HDR(4),AVETIME(1)), & (HDR(7),DD), (HDR(9),TD), & (HDR(12),TIMEPD), (HDR(17),DATATYPE(1)), & (HDR(32),WORD32(1)) C EQUIVALENCE (DATA(1),FMAG48), (DATA(2),FMOD48), & (DATA(3),DEL48), (DATA(4),LAM48), & (DATA(5),X48), (DATA(6),Y48), & (DATA(7),Z48), (DATA(8),RMS48(1)), & (DATA(11),IB48), (DATA(12),FMAG96(1)), & (DATA(17),FMOD96(1)), (DATA(22),DEL96(1)), & (DATA(27),LAM96(1)), (DATA(32),X96(1)), & (DATA(37),Y96(1)), (DATA(42),Z96(1)), & (DATA(47),RMS96(1,1)), (DATA(62),IB96(1)), & (DATA(67),FMAG192(1)), (DATA(92),FMOD192(1)), & (DATA(117),DEL192(1)), (DATA(142),LAM192(1)), & (DATA(167),X192(1)), (DATA(192),Y192(1)), & (DATA(217),Z192(1)), (DATA(242),RMS192(1,1)), & (DATA(317),IB192(1)) C EQUIVALENCE (POSN(1),TN), (POSN(3),TP), & (POSN(5),SPV(1)), (POSN(11),RANGE), & (POSN(12),ANG(1)) C EQUIVALENCE (ATTD(1), MTB(1,1)), (ATTD(10),MTB5(1,1)), & (ATTD(19), MHG(1,1)) C C COUNT 48 SECOND SUMMARY OUTPUT RECORDS C RECWRITE = RECWRITE + 1 C DATAID = 'LFM ' DO IT = 1,6 AVETIME(IT) = TIME(IT) END DO TIMEPD = 48.0 DATATYPE(1) = 1 WORD32(1) = RECWRITE WORD32(2) = 536 C C COMPUTE DECIMAL DAY OF CURRENT YEAR C CURRYEAR(1) = TIME(1) CURRYEAR(2) = 1 CURRYEAR(3) = 0 CURRYEAR(4) = 0 CURRYEAR(5) = 0 CURRYEAR(6) = 0 CALL ELPSTIME(CURRYEAR,TIME,DD) C C ROTATE 1.92 SECOND AVERAGES C IF ( .NOT.SYS2(9) ) THEN CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) CALL ROTATE(HG,B192,MHG,25,BAD) DO I192 = 1,25 B192(1,I192) = HG(1,I192) B192(2,I192) = HG(2,I192) B192(3,I192) = HG(3,I192) END DO END IF C C GENERIC AVERAGING ROUTINE TO COMPUTE 9.6 AND 48 SECOND AVERAGES C DO I = 1,25,5 C C COMPUTE 1.92 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B192(1,I),5,FMOD192(I),DEL192(I),LAM192(I),BAD) C J = (I-1)/5 + 1 C C COMPUTE 9.6 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B192(1,I),FMOD192(I),5,B96(1,J),FMAG96(J),RMS96(1,J), & IB96(J),BAD) C END DO C C COMPUTE 9.6 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B96,5,FMOD96,DEL96,LAM96,BAD) C C COMPUTE 48 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B96,FMOD96,5,B48,FMAG48,RMS48,IB48,BAD) C C COMPUTE 48 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B48,1,FMOD48,DEL48,LAM48,BAD) C C SEPARATE FIELD AND RMS COMPONENT VECTORS FROM MATRICES C DO I96 = 1,5 X96(I96) = B96(1,I96) Y96(I96) = B96(2,I96) Z96(I96) = B96(3,I96) XRMS96(I96) = RMS96(1,I96) YRMS96(I96) = RMS96(2,I96) ZRMS96(I96) = RMS96(3,I96) DO J = 1,5 I192 = (I96-1)*5 + J X192(I192) = B192(1,I192) Y192(I192) = B192(2,I192) Z192(I192) = B192(3,I192) XRMS192(I192) = RMS192(1,I192) YRMS192(I192) = RMS192(2,I192) ZRMS192(I192) = RMS192(3,I192) END DO END DO X48 = B48(1) Y48 = B48(2) Z48 = B48(3) C C OUTPUT MAG SUMMARY FILE C WRITE(66) SUMOUT C C OUTPUT 1.92 SECOND AVERAGES C IF (SYS2(1)) THEN DO I = 1,25 WRITE(82,888) TIME,FMAG192(I),FMOD192(I),(B192(J,I),J=1,3), & DEL192(I),LAM192(I),(RMS192(J,I),J=1,3),IB192(I) END DO C C OUTPUT 48 SECOND AVERAGES C ELSE IF (SYS2(2)) THEN WRITE(83,888) TIME,FMAG48,FMOD48,B48,DEL48,LAM48,RMS48,IB48 END IF C RETURN C 888 FORMAT(1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,5(1X,F7.3), & 2(1X,F5.1),3(1X,F7.3),1X,I2) C END SUBROUTINE BOOM_ALIGN(GAMMA,GAMMA2,NPRI,NSEC,NSTAT2,BAD) C THIS ROUTINE APPLIES BOOM ALIGNMENT MATRICES TO ROTATE 3 AXIS FIELD DATA. C WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692, 12/30/96 C INPUT VARIABLES C BAD FILL VALUE C GAMMA PRIMARY MAG FIELD STRENGTH C GAMMA2 SECONDARY MAG FIELD STRENGTH C NPRI NUMBER OF PRIMARY WORDS C NSEC NUMBER OF SECONDARY WORDS C NSTAT2 NUMBER OF MAG STATUS 2 WORDS C PRIME PRIMARY MAG FLAG ARRAY (GLOBAL) C VBLIB INBOARD SENSOR ALIGNMENT MATRIX C VBLOB OUTBOARD SENSOR ALIGNMENT MATRIX C OUTPUT VARIABLES C GAMMA PRIMARY MAG FIELD STRENGTH C GAMMA2 SECONDARY MAG FIELD STRENGTH C LOCAL VARIABLES C FIELD TEMPORARY VARIABLE C INBOARD PRIMARY MAG FLAG LOGICAL*1 INBOARD REAL*4 GAMMA(3,NPRI),GAMMA2(3,NSEC),FIELD(3) INCLUDE 'UNPACK.INC' C PRIMARY MAG SENSOR ALIGNMENT DO I = 1,NPRI IF ( NSTAT2.EQ.0 ) THEN INBOARD = .FALSE. ISTAT = 0 IBFLIP(0) = .FALSE. OBFLIP(0) = .FALSE. ELSE IRATIO = NPRI/NSTAT2 ISTAT = (I-1)/IRATIO + 1 INBOARD = PRIME(ISTAT) END IF IF ( GAMMA(1,I).NE.BAD .AND. & GAMMA(2,I).NE.BAD .AND. & GAMMA(3,I).NE.BAD ) THEN C INBOARD MAG IS PRIMARY IF ( INBOARD ) THEN CALL MPRD31(FIELD,VBLIB,GAMMA(1,I)) GAMMA(1,I) = FIELD(1) GAMMA(2,I) = FIELD(2) GAMMA(3,I) = FIELD(3) C OUTBOARD MAG IS PRIMARY ELSE CALL MPRD31(FIELD,VBLOB,GAMMA(1,I)) GAMMA(1,I) = FIELD(1) GAMMA(2,I) = FIELD(2) GAMMA(3,I) = FIELD(3) END IF ELSE GAMMA(1,I) = BAD GAMMA(2,I) = BAD GAMMA(3,I) = BAD END IF C END PRIMARY MAG SENSOR ALIGNMENT END DO C SECONDARY MAG SENSOR ALIGNMENT DO I = 1,NSEC IF ( NSTAT2.EQ.0 ) THEN INBOARD = .FALSE. ISTAT = 0 IBFLIP(0) = .FALSE. OBFLIP(0) = .FALSE. ELSE IRATIO = NSEC/NSTAT2 ISTAT = (I-1)/IRATIO + 1 INBOARD = PRIME(ISTAT) END IF IF ( GAMMA2(1,I).NE.BAD .AND. & GAMMA2(2,I).NE.BAD .AND. & GAMMA2(3,I).NE.BAD ) THEN C OUTBOARD MAG IS SECONDARY IF ( INBOARD ) THEN CALL MPRD31(FIELD,VBLOB,GAMMA2(1,I)) GAMMA2(1,I) = FIELD(1) GAMMA2(2,I) = FIELD(2) GAMMA2(3,I) = FIELD(3) C INBOARD MAG IS SECONDARY ELSE CALL MPRD31(FIELD,VBLIB,GAMMA2(1,I)) GAMMA2(1,I) = FIELD(1) GAMMA2(2,I) = FIELD(2) GAMMA2(3,I) = FIELD(3) END IF ELSE GAMMA2(1,I) = BAD GAMMA2(2,I) = BAD GAMMA2(3,I) = BAD END IF C END SECONDARY MAG SENSOR ALIGNMENT END DO RETURN END SUBROUTINE BOOM_DAT() C C READ BOOM ALIGNMENT MATRICES FOR INBOARD AND OUTBOARD MAGS C SBK 04/07/93 C CHARACTER*72 LINE(100) C INCLUDE 'UNPACK.INC' C I = 1 5 CONTINUE READ(53,'(A72)',END=10,ERR=5) LINE(I) I = I + 1 GOTO 5 10 CONTINUE ILINE = I - 1 C K = 1 DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C INBOARD BOOM MATRIX C DO I = 0,2 READ(LINE(K),*) (VBLIB(I+1,J),J=1,3) K = K + 1 END DO C DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C OUTBOARD BOOM MATRIX C DO I = 0,2 READ(LINE(K),*) (VBLOB(I+1,J),J=1,3) K = K + 1 END DO C RETURN END ****************************************************************** * * TITLE: DATA FILTER ROUTINE * * FILE NAME: CLEAN1.FOR * * PURPOSE: TO REMOVE NOISE SPIKES FROM DATA BY EMPLOYING * GAUSSIAN STATISTICS. * * AUTHOR DATE CHANGE * -------- ---- ------- * A. ROBERTS 12/17/92 ORIGINAL CODE IDL ROUTINE * S. B. KRAMER 12/17/92 ADAPTED FOR EDR PROCESSING * ****************************************************************** SUBROUTINE CLEAN1(DATA1,NPTS,NTOTB,NTOTG,SIGMUL,BAD,AVE,PASS) C C PROGRAM TO AUTOMATICALLY FLAG AND ASSIGN NULL VALUE TO BAD POINTS C IN A DATASET BASED ON STATISTICAL LOCAL CRITERION (E.G. THE C DATA POINT IS MORE THAN K SIGMA AWAY FROM THE MEAN OF ITS NEAR C NEIGHBORS). EACH POINT IS ANALYZED USING A NUMBER OF LOCAL C AVERAGES WITH EACH AVERAGE BEING THE SUM OF 100 POINTS; THE SUM C MOVES PAST THE POINT. FLAGGED POINTS ARE REMOVED FROM THE SERIES C AND NOT USED FOR SUBSEQUENT TESTS OF POINTS; THIS CLEANS "RATTY" C SERIES MUCH BETTER. C INTEGER*4 I100PT(100), IUP(100), IDN(100), PASS REAL*4 DATA1(NPTS) REAL*8 SUM,SUMSQ,SIG,SUMDIFF C C MULTI-PASS LOOP C NBD = 0 DO IPASS = 1,PASS C C LEAVE ROUTINE IF STARTING WITH INSUFFICIENT NUMBER OF POINTS (100) C IF (NPTS.LT.100) GOTO 300 C C INITIALIZATION OF SUMS AND I100PT (INDEX LIST) C ALSO OF IUP,IDN,I100PT,NTOTG,NTOTB C DO IZERO=1, 100 IUP(IZERO)=0 IDN(IZERO)=0 I100PT(IZERO)=0 ENDDO C C REMOVE FILL DATA FROM DATA ARRAY C NTOTG=0 NTOTB = 0 ! NTOTB = TOTAL NUMBER OF POINTS DELETED BY PROGRAM SUM = 0.0D0 ! SUM OF THE 100 DATA POINTS SUMSQ = 0.0D0 ! SUM OF THE SQUARES OF THE 100 POINTS AVE = BAD IPT = 1 DO NPT1 = 1, 100 25 IF (ABS(DATA1(IPT)-BAD).LT.0.01) THEN IPT = IPT + 1 IF (IPT.GT.NPTS) GOTO 300 ! INSUFFICIENT NUMBER OF NON-FILL POINTS GOTO 25 ENDIF SUM = SUM + DATA1(IPT) SUMSQ = SUMSQ + DATA1(IPT)**2 NTOTG = NTOTG + 1 I100PT(NPT1) = IPT IPT = IPT + 1 IF (IPT.GT.NPTS) GOTO 300 ! INSUFFICIENT NUMBER OF NON-FILL POINTS ENDDO AVE = SUM/100.0 SUMDIFF = SUMSQ - SUM**2/100.0 IF (SUMDIFF.GE.0.0) THEN SIG = DSQRT(SUMDIFF/100.0) ! DBLE PREC ELSE SIG = 0.0D0 END IF C C TEST THE POINTS C 50 NLOCB = 0 ! NLOCB = THE NUMBER OF BAD POINTS THIS LOOP DO J = 1, 100 I = I100PT(J) IF (ABS(DATA1(I)-AVE).GT.SIGMUL*SIG) THEN SUM = SUM - DATA1(I) SUMSQ = SUMSQ - DATA1(I)**2 IDN(NLOCB+1) = I DATA1(I) = BAD NLOCB = NLOCB + 1 NTOTB = NTOTB + 1 ENDIF ENDDO IF (IPT.GT.NPTS) GOTO 200 C C UPDATE THE 100 POINT SET SUMS AND I100PT C IPT = I100PT(100) + 1 IF (IPT.GT.NPTS) GOTO 250 IINC = 1 IF (I100PT(1).NE.IDN(1)) THEN SUM = SUM - DATA1(I100PT(1)) SUMSQ = SUMSQ - DATA1(I100PT(1))**2 ENDIF IF (I100PT(1).EQ.IDN(1)) IINC = 0 DO M = 1, NLOCB+IINC 150 IF (IPT.GT.NPTS) GOTO 250 IF (ABS(DATA1(IPT)-BAD).LT.0.01) THEN IPT = IPT + 1 GOTO 150 ENDIF IUP(M) = IPT SUM = SUM + DATA1(IPT) SUMSQ = SUMSQ + DATA1(IPT)**2 IPT = IPT + 1 NTOTG = NTOTG + 1 ENDDO 250 CONTINUE INC = 1 DO N = 1, 100 IF ((N+INC).LE.100) THEN DO LL = 1, NLOCB IF (I100PT(N+INC).EQ.IDN(LL)) INC = INC + 1 ENDDO IF ((N+INC).LE.100) THEN I100PT(N) = I100PT(N+INC) ELSE I100PT(N) = IUP(N+NLOCB-100+IINC) END IF ELSE 175 I100PT(N) = IUP(N+NLOCB-100+IINC) ENDIF ENDDO AVE = SUM/100.0 SUMDIFF = SUMSQ - SUM**2/100.0 IF (SUMDIFF.GE.0.0) THEN SIG = DSQRT(SUMDIFF/100.0) ! DBLE PREC ELSE SIG = 0.0D0 END IF C SIG = DSQRT((SUMSQ - SUM**2/100.0)/100.0) GOTO 50 ! LOOP BACK TO THE TEST FOR THIS SET OF POINTS 300 CONTINUE C C SET ALL POINTS TO FILL IF INSUFFICIENT INPUT ( < 100 NON-FILL POINTS) C DO I = 1,NPTS DATA1(I) = BAD END DO C 200 CONTINUE IF (IPASS.EQ.1) NGD = NTOTG NBD = NBD + NTOTB C C END MULTI-PASS LOOP C END DO C NTOTG = NGD NTOTB = NBD C C UPDATE THE HISTORY AND SAVE C FRACT = REAL(NTOTB)/REAL(NTOTG) C WRITE(6,'(1X,,''FRACTION OF BAD PTS '',E10.4)') FRACT C 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 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 CONVERT(DDATE,NYEAR,NDAY,NHOUR,NMIN,NSEC,MSEC) C C CONVERT DECIMAL YEAR INTO CALENDAR DATE C REAL*8 DDATE,YEAR,DAY,HOUR,MIN,SEC,FSEC,DAYS NYEAR = JIDINT(DDATE) YEAR = DBLE(NYEAR) DAY = (DDATE-YEAR)*DAYS(NYEAR) NDAY = JIDINT(DAY) + 1 HOUR = (DAY-DBLE(NDAY-1))*24.0D0 NHOUR = JIDINT(HOUR) MIN = (HOUR-DBLE(NHOUR))*60.0D0 NMIN = JIDINT(MIN) SEC = (MIN-DBLE(NMIN))*60.0D0 NSEC = JIDINT(SEC) FSEC = (SEC-DBLE(NSEC))*1000.0D0 MSEC = JIDINT(FSEC) IF (MSEC.GE.1000) THEN NSEC = NSEC + 1 MSEC = MSEC - 1000 END IF IF (NSEC.GE.60) THEN NMIN = NMIN + 1 NSEC = NSEC - 60 END IF IF (NMIN.GE.60) THEN NHOUR = NHOUR + 1 NMIN = NMIN - 60 END IF IF (NHOUR.GE.24) THEN NDAY = NDAY + 1 NHOUR = NHOUR - 24 END IF IF (NDAY.GT.JIDINT(DAYS(NYEAR))) THEN NYEAR = NYEAR + 1 NDAY = NDAY - JIDINT(DAYS(NYEAR)) END IF RETURN END SUBROUTINE CR1AVE(GAMMA,GAMMA2,BAD,TIME) C C MASTER CALLING ROUTINE FOR THE PRODUCTION OF CR-1 AVERAGES C C WRITTEN BY S. B. KRAMER 10/04/95 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,800),GAMMA2(3,800),SCF(3,800),AMBIENT(3,800) C DATA SCF /2400*999.0/ C INCLUDE 'UNPACK.INC' C C GET SPACECRAFT FIELD AND AMBIENT FIELD VALUES C CALL CR1FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C DETAIL OUTPUT C IF ( SYS2(4).OR.SYS2(5) ) THEN CALL CR1DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) RETURN END IF C C SINGLE MAG MODE - PRIMARY C IF ( SYS2(21) .AND. (.NOT.SYS2(22)) ) THEN CALL CR1PRI(GAMMA,SCF,TIME,BAD) C C SINGLE MAG MODE - SECONDARY C ELSE IF ( (.NOT.SYS2(21)) .AND. SYS2(22) ) THEN CALL CR1PRI(GAMMA2,SCF,TIME,BAD) C C SINGLE MAG MODE - PRIMARY AND SECONDARY C ELSE IF ( SYS2(21) .AND. SYS2(22) ) THEN CALL CR1PRI(GAMMA,GAMMA2,TIME,BAD) C C DUAL MAG MODE - AMBIENT AND SPACECRAFT FIELDS C ELSE IF ( (.NOT.SYS2(21)) .AND. (.NOT.SYS2(22)) ) THEN C C IF SYS2(27) IS TRUE, USE S/C FIELD AS AMBIENT C IF (SYS2(27)) THEN CALL CR1PRI(SCF,SCF,TIME,BAD) ELSE CALL CR1PRI(AMBIENT,SCF,TIME,BAD) END IF C END IF C RETURN END C C OBSOLETE ROUTINE REPLACED BY MAKEGAMMAS 12/30/1996 SBK C SUBROUTINE CR1CNT(GAMMA,GAMMA2,BAD,TIME,INBOARD) C C CR-1 ROUTINE C C WRITTEN BY S. B. KRAMER 10/03/95 C C THIS SUBROUTINE SUBTRACTS THE ZERO OFFSET FROM EACH COUNT AND MULTIPIES THE C RESULTING DIFFERENCE BY THE SENSITIVITY TO YIELD FIELD STRENGTH IN GAMMAS. C INTEGER*2 TIME(6) INTEGER*4 PRIOFF(3),SECOFF(3) LOGICAL*1 RECTEST,INBOARD REAL*4 GAMMA(3,800),GAMMA2(3,800),PRISEN(3),SECSEN(3) C INCLUDE 'UNPACK.INC' C IF (SYS2(32)) RECTEST = .TRUE. C DO IWRD = 1,800 C C STAT1 WORD COUNTER (8 STAT1 WORDS PER 80 MF CR-1 RECORD) C ICYC = INT((IWRD-1)/100) + 1 C C ASSIGN OFFSETS AND SENSITIVITIES TO LOCAL VARIABLES CHECKING PRIME C LFM STATUS. C DO IAX = 1,3 IF (.NOT.INBOARD) PRIOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) IF (.NOT.INBOARD) SECOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) IF (.NOT.INBOARD) PRISEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) IF (.NOT.INBOARD) SECSEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) IF (INBOARD) PRIOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) IF (INBOARD) SECOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) IF (INBOARD) PRISEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) IF (INBOARD) SECSEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) END DO C C BEGIN 3 AXES GAMMA CONVERSION C DO IAX = 1,3 C C CONVERT PRIMARY MODE CR-1 COUNTS TO GAMMAS C GAMMA(IAX,IWRD) = BAD IF (PREF(IAX,IWRD).NE.0) GAMMA(IAX,IWRD) = & (PREF(IAX,IWRD)-PRIOFF(IAX))*PRISEN(IAX) C C CONVERT SECONDARY MODE CR-1 COUNTS TO GAMMAS C GAMMA2(IAX,IWRD) = BAD IF (SREF(IAX,IWRD).NE.0) GAMMA2(IAX,IWRD) = & (SREF(IAX,IWRD)-SECOFF(IAX))*SECSEN(IAX) C C END 3 AXES GAMMA CONVERSION C END DO C C OUTPUT COUNTS AND GAMMAS C IF (RECTEST) THEN C IF (IWRD.EQ.1) WRITE(81,'(1X,''EDR TIME: '',6(1X,I3))') TIME C WRITE(81,'(4(1X,I5),3(1X,F7.3),4(1X,I5),3(1X,F7.3))') & IWRD,PREF(1,IWRD),PREF(2,IWRD),PREF(3,IWRD), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD), & IWRD,SREF(1,IWRD),SREF(2,IWRD),SREF(3,IWRD), & GAMMA2(1,IWRD),GAMMA2(2,IWRD),GAMMA2(3,IWRD) C END IF C END DO C RETURN END SUBROUTINE CR1COMM(TIME) C C CR1 ROUTINE C C ADAPTED FROM GS3COMM AND VIM5COMM ROUTINES BY S. B. KRAMER 10/03/95 C C THIS ROUTINE EXTRACTS VALUES FROM THE TWO STATUS WORDS, STAT1 AND STAT2, C THAT WERE UNPACKED FROM THE PLASMA SUB-HEADER BLOCK. STAT1 CONTAINS RANGE C AND MODE VALUES. STAT2 CONTAINS SENSOR STATES. C INTEGER*2 TIME(6) INTEGER*4 OBDIFF,IBDIFF C INCLUDE 'UNPACK.INC' C C GET INSTRUMENT STATUS VALUES FROM SECOND STATUS WORD (STAT2) C DO I = 1,8 C C ELECTRICAL FLIPPER STATUS C EFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 0, 1, EFLIP(I), 0) C C EXTRACT PRIME LFM STATUS C PRIME(I) = .FALSE. CALL MOVBIT(STAT2(I), 1, 1, PRIME(I), 0) C C INBOARD LFM FLIP STATUS C IBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 4, 2, IBFLIP(I), 0) C C OUTBOARD LFM FLIP STATUS C OBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 2, 2, OBFLIP(I), 0) C C EXTRACT PROCESSOR STATUS C MPROC(I) = .FALSE. CALL MOVBIT(STAT2(I), 6, 1, MPROC(I), 0) C C EXTRACT POLARITY C POLAR(I) = .FALSE. CALL MOVBIT(STAT2(I), 7, 1, POLAR(I), 0) C C INBOARD LFM FLIGHT CALIBRATION INDICATOR C IBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 10, 1, IBCAL(I), 0) C C OUTBOARD LFM FLIGHT CALIBRATION INDICATOR C OBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 11, 1, OBCAL(I), 0) C END DO C C GET INSTRUMENT STATUS VALUES FROM FIRST STATUS WORD (STAT1) C DO I=1,8 C C CHECK FOR RANGE OVERRIDE C IF ( RNGSET.NE.-1 ) THEN OBRNG(I) = RNGSET IBRNG(I) = RNGSET GOTO 100 END IF C C EXTRACT OUTBOARD AND INBOARD RANGE MODES [0,1] C IF ( MODSET.EQ.-1 ) THEN CALL MOVBIT(STAT1(I), 11, 1, OBMODE(I), 0) CALL MOVBIT(STAT1(I), 7, 1, IBMODE(I), 0) ELSE IF ( MODSET.EQ.0 ) THEN OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. ELSE IF ( MODSET.EQ.1 ) THEN OBMODE(I) = .TRUE. IBMODE(I) = .TRUE. END IF C C EXTRACT OUTBOARD AND INBOARD RANGE SENSITIVITIES [0,7] C DO J = 1,3 CALL MOVBIT(STAT1(I), 11-J, 1, OBRNG(I), J-1) CALL MOVBIT(STAT1(I), 7-J, 1, IBRNG(I), J-1) END DO C C TEST FOR RANGE ERRORS. SENSITIVITY MAY CHANGE ONLY BY ONE C IN AUTO RANGE MODE. C IBDIFF = ABS(IBRNG(I)-IBRNG(I-1)) OBDIFF = ABS(OBRNG(I)-OBRNG(I-1)) C C INBOARD MAG RANGE CHECK C IF ( IBDIFF.GT.1 .AND. (IBMODE(I).AND.IBMODE(I-1)) ) THEN WRITE(68,889) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) IBRNG(I) = IBRNG(I-1) IBMODE(I) = IBMODE(I-1) ELSE IF ( IBDIFF.NE.0 ) THEN WRITE(68,899) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) END IF C C OUTBOARD MAG RANGE CHECK C IF ( OBDIFF.GT.1 .AND. (OBMODE(I).AND.OBMODE(I-1)) ) THEN WRITE(68,888) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) OBRNG(I) = OBRNG(I-1) OBMODE(I) = OBMODE(I-1) ELSE IF ( OBDIFF.NE.0 ) THEN WRITE(68,898) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) END IF C 100 CONTINUE C END DO C C PUT LAST RANGE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBRNG(0) = IBRNG(8) OBRNG(0) = OBRNG(8) C C PUT LAST MODE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBMODE(0) = IBMODE(8) OBMODE(0) = OBMODE(8) C RETURN 888 FORMAT(1X,'*CR1COMM* OUTBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 889 FORMAT(1X,'*CR1COMM* INBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 898 FORMAT(1X,'*CR1COMM* OUTBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 899 FORMAT(1X,'*CR1COMM* INBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) END SUBROUTINE CR1DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C OUTPUT DETAIL DATA FROM CR1 EDR PROCESSING. C C ADAPTED FROM GS3DET ROUTINE BY S. B. KRAMER 10/04/95 C MODIFIED OUTPUT FORMAT FOR UNIFORMITY ACROSS TELEMETRY MODES C SBK 11/28/2006 C CHARACTER DATAID*4,FLTID*4,COORD*2,MODE*4,TELEM*4 INTEGER*2 CR1TIME(6),TIME(6),DELTA(6), & DATATYPE(2),WORD30(2),WORD32(2) REAL*4 HDR(32),TIMEPD REAL*4 GAMMA(3,800),GAMMA2(3,800),SCF(3,800),AMBIENT(3,800), & PRIDAT(3,800),SECDAT(3,800),SCFDAT(3,800),AMBDAT(3,800) REAL*4 SPV(6),RANGE,ANG(2), & MTB(3,3),MTB5(3,3),MHG(3,3) REAL*8 TD,TN,TP C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (DETOUT(1),HDR(1)) C EQUIVALENCE (HDR(1),DATAID), (HDR(12),TIMEPD), & (HDR(17),DATATYPE(1)), (HDR(30),WORD30(1)), & (HDR(32),WORD32(1)) C DATA ICALL/0/, DELTA/5*0,60/, CR1TIME/6*0/, TELEM/'CR1 '/ C IUNIT = 84 RECWRITE = RECWRITE + 1 ICALL = ICALL + 1 IF ( SYS2(9) ) THEN COORD = 'HG' ELSE COORD = 'PL' END IF C C CHECK FOR CONFLICTING PROCESSING FLAGS C IF ( SYS2(4).AND..NOT.SYS2(5) ) THEN MODE = 'SNGL' LEN = 4832 ELSE IF ( SYS2(5).AND..NOT.SYS2(4) ) THEN MODE = 'DUAL' LEN = 4832 ELSE WRITE(6,*) WRITE(6,*) & '*CR1DET* CONFLICTING DETAIL PROCESSING FLAGS' STOP END IF C IF ( SYS2(6).AND.ICALL.EQ.1 ) THEN C C FORTRAN OUTPUT UNIT ASSIGNED TO FILE NAME IN VMS DCL ROUTINE CALLING C THE VOYPROD EXECUTABLE ex. $ ASSIGN FILE.DAT FOR084 C OPEN(IUNIT,STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST',RECL=124) END IF C CR1TIME(1) = TIME(1) CR1TIME(2) = TIME(2) CR1TIME(3) = TIME(3) CR1TIME(4) = TIME(4) CR1TIME(5) = TIME(5) CR1TIME(6) = TIME(6) C IF ( SCID.EQ.0 ) THEN FLTID = "FLT2" ELSE IF ( SCID.EQ.1 ) THEN FLTID = "FLT1" ELSE FLTID = "FLT?" END IF DATAID = 'LFM ' TIMEPD = 48.0 DATATYPE(1) = 1 WORD32(1) = RECWRITE C IF ( SYS2(4) ) THEN C C OUTPUT PRIMARY AND SECONDARY DETAIL FIELD C WORD30(1) = 800 WORD30(2) = 800 WORD32(2) = 4800 C ELSE IF ( SYS2(5) ) THEN C C OUTPUT AMBIENT AND SPACECRAFT DETAIL FIELD C WORD30(1) = 800 WORD30(2) = 800 WORD32(2) = 4800 C END IF C C REASSIGN DETAIL VALUES TO LOCAL VARIABLES C DO I = 1,800 C IF ( SYS2(7) ) & CALL GETSEDR(CR1TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) C IF ( SYS2(4) ) THEN C C GET PRIMARY VALUES C IF ( SYS2(7) ) THEN CALL ROTATE1(PRIDAT(1,I),GAMMA(1,I),MHG,BAD) ELSE PRIDAT(1,I) = GAMMA(1,I) PRIDAT(2,I) = GAMMA(2,I) PRIDAT(3,I) = GAMMA(3,I) END IF C C OUTPUT PRIMARY FIELD X,Y,Z C DETOUT(32+I) = PRIDAT(1,I) DETOUT(32+800+I) = PRIDAT(2,I) DETOUT(32+1600+I) = PRIDAT(3,I) C C GET SECONDARY VALUES C IF ( SYS2(7) ) THEN CALL ROTATE1(SECDAT(1,I),GAMMA2(1,I),MHG,BAD) ELSE SECDAT(1,I) = GAMMA2(1,I) SECDAT(2,I) = GAMMA2(2,I) SECDAT(3,I) = GAMMA2(3,I) END IF C C OUTPUT SECONDARY FIELD X,Y,Z C DETOUT(32+2400+I) = SECDAT(1,I) DETOUT(32+2400+800+I) = SECDAT(2,I) DETOUT(32+2400+1600+I) = SECDAT(3,I) C C OUTPUT 800 PRIMARY SAMPLES AND 800 SECONDARY SAMPLES C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR1TIME,RANGE,ANG(2), & ANG(1),(PRIDAT(J,I),J=1,3),(SECDAT(J,I),J=1,3) END IF C ELSE IF ( SYS2(5) ) THEN C C GET AMBIENT FIELD VALUES C IF ( SYS2(7) ) THEN CALL ROTATE1(AMBDAT(1,I),AMBIENT(1,I),MHG,BAD) ELSE AMBDAT(1,I) = AMBIENT(1,I) AMBDAT(2,I) = AMBIENT(2,I) AMBDAT(3,I) = AMBIENT(3,I) END IF C C GET SPACECRAFT FIELD VALUES C IF ( SYS2(7) ) THEN CALL ROTATE1(SCFDAT(1,I),SCF(1,I),MHG,BAD) ELSE SCFDAT(1,I) = SCF(1,I) SCFDAT(2,I) = SCF(2,I) SCFDAT(3,I) = SCF(3,I) END IF C C OUTPUT AMBIENT FIELD X,Y,Z C DETOUT(32+I) = AMBDAT(1,I) DETOUT(32+800+I) = AMBDAT(2,I) DETOUT(32+1600+I) = AMBDAT(3,I) C C OUTPUT SPACECRAFT FIELD X,Y,Z C DETOUT(32+2400+I) = SCFDAT(1,I) DETOUT(32+3200+I) = SCFDAT(2,I) DETOUT(32+4000+I) = SCFDAT(3,I) C C OUTPUT 800 AMBIENT SAMPLES AND 800 SPACECRAFT FIELD SAMPLES C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR1TIME,RANGE,ANG(2), & ANG(1),(AMBDAT(J,I),J=1,3),(SCFDAT(J,I),J=1,3) END IF C END IF C CALL INC_TIME(CR1TIME,DELTA) C END DO C C WRITE BINARY DETAIL DATA C WRITE(66) (DETOUT(I),I=1,LEN) C RETURN 800 FORMAT(2(A4,1X),A2,1X,A4,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,F8.4, & 2(1X,F8.3),6(1X,F9.3)) END SUBROUTINE CR1FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C USING 48 SECOND CR-1 EDR RECORD, COMPUTE SPACECRAFT AND AMBIENT FIELDS. C C WRITTEN BY S. B. KRAMER 10/04/95 C CHECK FOR PRIME LFM SBK 10/26/95 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,800),GAMMA2(3,800),SCF(3,800),AMBIENT(3,800) C C IMPLEMENT SPACECRAFT FIELD COUPLING COEFFICIENT, ALPHA, C IN COMPUTATION OF S/C FIELD C C COEF = ALPHA/(1.0-ALPHA) WHERE ALPHA = .1846 C = 0.230921 C DATA ALPHA/0.1876/,COEF/0.230921/ C INCLUDE 'UNPACK.INC' C DO I=1,800 ISTAT = (I-1)/100 + 1 DO J = 1,3 C C COMPUTER DIFFERENCE BETWEEN PRIMARY AND SECONDARY MAGNETOMETERS C AND THEN COMPUTE AMBIENT FIELD FOR RETURN AT PRIMARY MAG RATE. C *NOTE: PRIMARY MAG RATE = SECONDARY MAG RATE FOR CR-1 MODE. C IF ( GAMMA(J,I).NE.BAD .AND. & GAMMA2(J,I).NE.BAD ) THEN SCF(J,I) = (GAMMA2(J,I)-GAMMA(J,I))*COEF IF ( PRIME(ISTAT) ) THEN ! INBOARD PRIME SCF(J,I) = -SCF(J,I) AMBIENT(J,I) = GAMMA2(J,I) - SCF(J,I) ELSE ! OUTBOARD PRIME AMBIENT(J,I) = GAMMA(J,I) - SCF(J,I) END IF ELSE SCF(J,I) = BAD AMBIENT(J,I) = BAD END IF C END DO END DO C RETURN END ****************************************************************** * * TITLE: CONVERT RECONSTRUCTED DIGITAL VALUES INTO GAMMAS * * FILE NAME: CR1LFM.FOR * * PURPOSE: TO CONVERT DIGITAL CR-1 MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 10/03/95 ORIGINAL CODE * (MODE CR-1) * * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * * PDL: * * CALL COMMAND AND STATUS WORD EXTRACTION ROUTINE * CALL COUNTS TO GAMMAS CONVERSION ROUTINE * CALL SENSOR ALIGNMENT ROUTINE * CALL BOOM ALIGNMENT ROUTINE * * RETURN * ****************************************************************** SUBROUTINE CR1LFM(GAMMA,GAMMA2,BAD,TIME) C INTEGER*2 TIME(6) LOGICAL*1 SROTATE,BROTATE REAL*4 GAMMA(3,800),GAMMA2(3,800) C INCLUDE 'UNPACK.INC' C DATA SROTATE/.TRUE./, & BROTATE/.TRUE./ C C SENSOR ROTATION SWITCH C IF ( SYS2(13) ) SROTATE = .FALSE. C C BOOM ALIGNMENT ROTATION SWITCH C IF ( SYS2(23) ) BROTATE = .FALSE. C C EXTRACT INSTRUMENT STATUS FROM STAT WORDS C CALL MAGSTATUS(TIME,8,8) C C CONVERT COUNTS INTO GAMMAS (MODE SENSITIVE) C DO I = 1,800 PREC(1,I) = PREF(1,I) PREC(2,I) = PREF(2,I) PREC(3,I) = PREF(3,I) SREC(1,I) = SREF(1,I) SREC(2,I) = SREF(2,I) SREC(3,I) = SREF(3,I) END DO CALL MAKEGAMMAS(GAMMA,800,GAMMA2,800,8,8,BAD,TIME) C C ORTHOGONALIZE DATA WITH SENSOR MATRIX AFTER GAMMAS (MODE SENSITIVE) C IF ( SROTATE ) THEN CALL SENSOR_ALIGN(GAMMA,GAMMA2,800,800,8,BAD) END IF C C ROTATE DATA WITH BOOM ALIGNMENT MATRIX AFTER GAMMAS (MODE SENSITIVE) C IF ( BROTATE ) THEN CALL BOOM_ALIGN(GAMMA,GAMMA2,800,800,8,BAD) END IF C RETURN END SUBROUTINE CR1PRI(GAMMA,SCF,TIME,BAD) C C USING 48 SECOND CR-1 EDR RECORD, PRODUCE 48 SECOND BLOCK OF C 1.92 SEC AVERAGES FROM PRIMARY MAG DETAIL (0.06 SEC) DATA POINTS. C CHARACTER RECTYPE*4,TELFMT*4,FLTID*4 C INTEGER*2 TIME(6),EDRTIME(6),LAUNCH(6), & WORD30(2),WORD31(2),WORD32(2) C INTEGER*4 IB192(25) C REAL*4 SCF(3,800),GAMMA(3,800),FMOD(800),DEL(800),LAM(800), & B192(3,25),DEL192(25),LAM192(25),FMOD192(25), & FMAG192(25),RMS192(3,25),X192(25),Y192(25),Z192(25) C REAL*4 HDR(32),DATA(341) C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (SUMOUT(33),DATA(1)) C EQUIVALENCE (HDR(30),WORD30(1)), (HDR(31),WORD31(1)) C EQUIVALENCE (DATA(67),FMAG192(1)), (DATA(92),FMOD192(1)), & (DATA(117),DEL192(1)), (DATA(142),LAM192(1)), & (DATA(242),RMS192(1,1)),(DATA(317),IB192(1)) C C COMPUTE 25 1.92 SECOND AVERAGES FOR ONE 48 SECOND PERIOD C DO J=1,25 C I = (J-1)*32 + 1 C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(GAMMA(1,I),32,FMOD(I),DEL(I),LAM(I),BAD) C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(GAMMA(1,I),FMOD(I),32,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C WORD30(1) = 800 WORD30(2) = 800 WORD31(1) = 800 WORD31(2) = 800 C C COMPUTE 48 SECOND AVERAGE OF THE SPACECRAFT FIELD C CALL CR1SCF(SCF(1,1),TIME,BAD) C C COMPUTE 9.6 SECOND AVERAGES AND 48 SECOND AVERAGES C CALL BIGAVE(B192,TIME,BAD) C RETURN END SUBROUTINE CR1SCF(SCF,TIME,BAD) C C COMPUTE 48 SECOND AVERAGED SPACECRAFT FIELD FOR CR-1 RECORD C C INPUT 48 SECONDS OF DETAIL SPACECRAFT FIELD - SCF C OUTPUT RMS(SCF)(1,2,3), #DETAIL PTS, SCF(1,2,3), NORM(SCF(1,2,3) C INTEGER*2 TIME(6) C INTEGER*4 IB192(25),IB96(5),IB48 C REAL*4 SCFLD(155),SCF(3,800),FMOD(800),DEL(800),LAM(800), & FMAG192(25),FMOD192(25),DEL192(25), & LAM192(25),B192(3,25),RMS192(3,25), & X192(25),Y192(25),Z192(25), & XRMS192(25),YRMS192(25),ZRMS192(25), & FMAG96(5),FMOD96(5),DEL96(5), & LAM96(5),B96(3,5),RMS96(3,5), & X96(5),Y96(5),Z96(5), & XRMS96(5),YRMS96(5),ZRMS96(5), & FMAG48,FMOD48,DEL48, & LAM48,B48(3),RMS48(3), & X48,Y48,Z48,HG(3,25), & SPV(6),RANGE,ANG(2), & MTB(3,3),MTB5(3,3),MHG(3,3) C REAL*8 TD,TN,TP C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(342),SCFLD(1)) C EQUIVALENCE (SCFLD(148),RMS48(1)), (SCFLD(151),IB48), & (SCFLD(152),X48), (SCFLD(153),Y48), & (SCFLD(154),Z48), (SCFLD(155),FMOD48) C C COMPUTE DETAIL FIELD MODULUS AND ANGLES FOR 48 SECOND PERIOD C CALL ANGLES(SCF,800,FMOD,DEL,LAM,BAD) C C COMPUTE 25 1.92 SECOND AVERAGES FOR 48 SECOND PERIOD C DO J=1,25 C I = (J-1)*32 + 1 C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(SCF(1,I),FMOD(I),32,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C C ROTATE 1.92 SECOND AVERAGES C IF ( .NOT.SYS2(9) ) THEN CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) CALL ROTATE(HG,B192,MHG,25,BAD) DO I192 = 1,25 B192(1,I192) = HG(1,I192) B192(2,I192) = HG(2,I192) B192(3,I192) = HG(3,I192) END DO END IF C C GENERIC AVERAGING ROUTINE TO COMPUTE 9.6 AND 48 SECOND AVERAGES C DO I = 1,25,5 C C COMPUTE 1.92 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B192(1,I),5,FMOD192(I),DEL192(I),LAM192(I),BAD) C J = (I-1)/5 + 1 C C COMPUTE 9.6 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B192(1,I),FMOD192(I),5,B96(1,J),FMAG96(J),RMS96(1,J), & IB96(J),BAD) C END DO C C COMPUTE 9.6 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B96,5,FMOD96,DEL96,LAM96,BAD) C C COMPUTE 48 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B96,FMOD96,5,B48,FMAG48,RMS48,IB48,BAD) C C COMPUTE 48 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B48,1,FMOD48,DEL48,LAM48,BAD) C C SEPARATE FIELD COMPONENT VECTORS FROM MATRICES C DO I96 = 1,5 X96(I96) = B96(1,I96) Y96(I96) = B96(2,I96) Z96(I96) = B96(3,I96) XRMS96(I96) = RMS96(1,I96) YRMS96(I96) = RMS96(2,I96) ZRMS96(I96) = RMS96(3,I96) DO J = 1,5 I192 = (I96-1)*5 + J X192(I192) = B192(1,I192) Y192(I192) = B192(2,I192) Z192(I192) = B192(3,I192) XRMS192(I192) = RMS192(1,I192) YRMS192(I192) = RMS192(2,I192) ZRMS192(I192) = RMS192(3,I192) END DO END DO X48 = B48(1) Y48 = B48(2) Z48 = B48(3) C RETURN END SUBROUTINE CR2AVE(GAMMA,GAMMA2,BAD,TIME) C C MASTER CALLING ROUTINE FOR THE PRODUCTION OF CR-2 AVERAGES C C WRITTEN BY SANDY KRAMER 03/22/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,400),GAMMA2(3,200),SCF(3,400),AMBIENT(3,400) C DATA SCF /1200*999.0/ C INCLUDE 'UNPACK.INC' C C GET SPACECRAFT FIELD AND AMBIENT FIELD VALUES C CALL CR2FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C DETAIL OUTPUT C IF ( SYS2(4).OR.SYS2(5) ) THEN CALL CR2DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) RETURN END IF C C SINGLE MAG MODE - PRIMARY C IF ( SYS2(21) .AND. (.NOT.SYS2(22)) ) THEN CALL CR2PRI(GAMMA,SCF,TIME,BAD) C C SINGLE MAG MODE - SECONDARY C ELSE IF ( (.NOT.SYS2(21)) .AND. SYS2(22) ) THEN CALL CR2SEC(GAMMA2,SCF,TIME,BAD) C C SINGLE MAG MODE - PRIMARY AND SECONDARY C ELSE IF ( SYS2(21) .AND. SYS2(22) ) THEN CALL CR2PNS(GAMMA,GAMMA2,TIME,BAD) C C DUAL MAG MODE - AMBIENT AND SPACECRAFT FIELDS C ELSE IF ( (.NOT.SYS2(21)) .AND. (.NOT.SYS2(22)) ) THEN C C IF SYS2(27) IS TRUE, USE S/C FIELD AS AMBIENT C IF ( SYS2(27) ) THEN CALL CR2PRI(SCF,SCF,TIME,BAD) ELSE CALL CR2PRI(AMBIENT,SCF,TIME,BAD) END IF C END IF C RETURN END C C OBSOLETE ROUTINE REPLACED BY MAKEGAMMAS 12/30/1996 SBK C SUBROUTINE CR2CNT(GAMMA,GAMMA2,BAD,TIME,INBOARD) C C CR-2 ROUTINE C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER 03/22/96 C C THIS SUBROUTINE SUBTRACTS THE ZERO OFFSET FROM EACH COUNT AND MULTIPIES THE C RESULTING DIFFERENCE BY THE SENSITIVITY TO YIELD FIELD STRENGTH IN GAMMAS. C INTEGER*2 TIME(6) INTEGER*4 PRIOFF(3),SECOFF(3) LOGICAL*1 RECTEST,INBOARD REAL*4 GAMMA(3,400),GAMMA2(3,200),PRISEN(3),SECSEN(3) C INCLUDE 'UNPACK.INC' C IF ( SYS2(32) ) RECTEST = .TRUE. C DO IWRD = 1,400 C IWRD2 = (IWRD-1)/2 + 1 C C STAT1 WORD COUNTER (5 STAT1 WORDS PER 40 MF CR-2 RECORD) C ICYC = INT((IWRD-1)/80) + 1 C C ASSIGN OFFSETS AND SENSITIVITIES TO LOCAL VARIABLES CHECKING PRIME C LFM STATUS. C DO IAX = 1,3 IF ( .NOT.INBOARD ) THEN PRIOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) SECOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) PRISEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) SECSEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) ELSE PRIOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) SECOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) PRISEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) SECSEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) END IF END DO C C BEGIN 3 AXES GAMMA CONVERSION C DO IAX = 1,3 C C CONVERT PRIMARY MODE CR-2 COUNTS TO GAMMAS C GAMMA(IAX,IWRD) = BAD IF ( PREF(IAX,IWRD).NE.0 ) GAMMA(IAX,IWRD) = & (PREF(IAX,IWRD)-PRIOFF(IAX))*PRISEN(IAX) C C CONVERT SECONDARY MODE CR-2 COUNTS TO GAMMAS C IF ( MOD(IWRD,2).NE.0 ) THEN GAMMA2(IAX,IWRD2) = BAD IF ( SREF(IAX,IWRD2).NE.0 ) GAMMA2(IAX,IWRD2) = & (SREF(IAX,IWRD2)-SECOFF(IAX))*SECSEN(IAX) END IF C C END 3 AXES GAMMA CONVERSION C END DO C C OUTPUT COUNTS AND GAMMAS C IF ( RECTEST ) THEN C IF ( IWRD.EQ.1 ) WRITE(81,'(1X,''EDR TIME: '',6(1X,I3))') TIME C WRITE(81,'(4(1X,I5),3(1X,F7.3),4(1X,I5),3(1X,F7.3), & 1X,I2,2(1X,Z4.4),4(1X,I1))') & IWRD,PREF(1,IWRD),PREF(2,IWRD),PREF(3,IWRD), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD), & IWRD2,SREF(1,IWRD2),SREF(2,IWRD2),SREF(3,IWRD2), & GAMMA2(1,IWRD2),GAMMA2(2,IWRD2),GAMMA2(3,IWRD2), & ICYC,STAT1(ICYC),STAT2(ICYC), & IBMODE(ICYC),OBMODE(ICYC),IBRNG(ICYC),OBRNG(ICYC) C END IF C END DO C RETURN END SUBROUTINE CR2COMM(TIME) C C CR2 ROUTINE C C ADAPTED FROM CR1COMM ROUTINE BY SANDY KRAMER 03/22/96 C C THIS ROUTINE EXTRACTS VALUES FROM THE TWO STATUS WORDS, STAT1 AND STAT2, C THAT WERE UNPACKED FROM THE PLASMA SUB-HEADER BLOCK. STAT1 CONTAINS RANGE C AND MODE VALUES. STAT2 CONTAINS SENSOR STATES. C INTEGER*2 TIME(6) INTEGER*4 OBDIFF,IBDIFF C INCLUDE 'UNPACK.INC' C C GET INSTRUMENT STATUS VALUES FROM SECOND STATUS WORD (STAT2) C C C ELECTRICAL FLIPPER STATUS C EFLIP(1) = .FALSE. CALL MOVBIT(STAT2(1), 0, 1, EFLIP(1), 0) C C EXTRACT PRIME LFM STATUS C PRIME(1) = .FALSE. CALL MOVBIT(STAT2(1), 1, 1, PRIME(1), 0) C C INBOARD LFM FLIP STATUS C IBFLIP(1) = .FALSE. CALL MOVBIT(STAT2(1), 4, 2, IBFLIP(1), 0) C C OUTBOARD LFM FLIP STATUS C OBFLIP(1) = .FALSE. CALL MOVBIT(STAT2(1), 2, 2, OBFLIP(1), 0) C C EXTRACT PROCESSOR STATUS C MPROC(1) = .FALSE. CALL MOVBIT(STAT2(1), 6, 1, MPROC(1), 0) C C EXTRACT POLARITY C POLAR(1) = .FALSE. CALL MOVBIT(STAT2(1), 7, 1, POLAR(1), 0) C C INBOARD LFM FLIGHT CALIBRATION INDICATOR C IBCAL(1) = .FALSE. CALL MOVBIT(STAT2(1), 10, 1, IBCAL(1), 0) C C OUTBOARD LFM FLIGHT CALIBRATION INDICATOR C OBCAL(1) = .FALSE. CALL MOVBIT(STAT2(1), 11, 1, OBCAL(1), 0) C C GET INSTRUMENT STATUS VALUES FROM FIRST STATUS WORD (STAT1) C DO I=1,5 C C CHECK FOR RANGE OVERRIDE C IF ( RNGSET.NE.-1 ) THEN OBRNG(I) = RNGSET IBRNG(I) = RNGSET GOTO 100 END IF C C EXTRACT OUTBOARD AND INBOARD RANGE MODES [0,1] C IF ( MODSET.EQ.-1 ) THEN CALL MOVBIT(STAT1(I), 11, 1, OBMODE(I), 0) CALL MOVBIT(STAT1(I), 7, 1, IBMODE(I), 0) ELSE IF ( MODSET.EQ.0 ) THEN OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. ELSE IF ( MODSET.EQ.1 ) THEN OBMODE(I) = .TRUE. IBMODE(I) = .TRUE. END IF C C EXTRACT OUTBOARD AND INBOARD RANGE SENSITIVITIES [0,7] C DO J = 1,3 CALL MOVBIT(STAT1(I), 11-J, 1, OBRNG(I), J-1) CALL MOVBIT(STAT1(I), 7-J, 1, IBRNG(I), J-1) END DO C C TEST FOR RANGE ERRORS. SENSITIVITY MAY CHANGE ONLY BY ONE C IN AUTO RANGE MODE. C IBDIFF = ABS(IBRNG(I)-IBRNG(I-1)) OBDIFF = ABS(OBRNG(I)-OBRNG(I-1)) C C INBOARD MAG RANGE CHECK C IF ( IBDIFF.GT.1 .AND. (IBMODE(I).AND.IBMODE(I-1)) ) THEN WRITE(68,889) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) IBRNG(I) = IBRNG(I-1) IBMODE(I) = IBMODE(I-1) ELSE IF ( IBDIFF.NE.0 ) THEN WRITE(68,899) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) END IF C C OUTBOARD MAG RANGE CHECK C IF ( OBDIFF.GT.1 .AND. (OBMODE(I).AND.OBMODE(I-1)) ) THEN WRITE(68,888) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) OBRNG(I) = OBRNG(I-1) OBMODE(I) = OBMODE(I-1) ELSE IF ( OBDIFF.NE.0 ) THEN WRITE(68,898) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) END IF C 100 CONTINUE C END DO C C PUT LAST RANGE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBRNG(0) = IBRNG(5) OBRNG(0) = OBRNG(5) C C PUT LAST MODE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBMODE(0) = IBMODE(5) OBMODE(0) = OBMODE(5) C RETURN 888 FORMAT(1X,'*CR2COMM* OUTBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 889 FORMAT(1X,'*CR2COMM* INBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 898 FORMAT(1X,'*CR2COMM* OUTBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 899 FORMAT(1X,'*CR2COMM* INBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) END SUBROUTINE CR2DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C OUTPUT DETAIL DATA FROM CR-2 EDR PROCESSING. C C ORIGINAL SOURCE - SBK 04/04/96 C MODIFIED OUTPUT FORMAT FOR UNIFORMITY ACROSS TELEMETRY MODES C SBK 02/23/2007 C CHARACTER DATAID*4,FLTID*4,COORD*2,MODE*4,TELEM*4 INTEGER*2 TIME(6),CR2TIME(6),DELTA(6), & DATATYPE(2),WORD30(2),WORD32(2) REAL*4 HDR(32),TIMEPD REAL*4 GAMMA(3,400),GAMMA2(3,200),SCF(3,400),AMBIENT(3,400), & PRIDAT(3,400),SECDAT(3,200),SCFDAT(3,400),AMBDAT(3,400) REAL*4 SPV(6),RANGE,ANG(2),PL(3), & HG(3,400),MTB(3,3),MTB5(3,3),MHG(3,3) REAL*8 TD,TN,TP C DATA ICALL/0/, DELTA/5*0,120/, CR2TIME/6*0/, TELEM/'CR-2'/ C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (DETOUT(1),HDR(1)), & (HDR(1),DATAID), & (HDR(12),TIMEPD), (HDR(17),DATATYPE(1)), & (HDR(30),WORD30(1)), (HDR(32),WORD32(1)) C IUNIT = 84 RECWRITE = RECWRITE + 1 ICALL = ICALL + 1 IF ( SYS2(7) ) THEN COORD = 'HG' ELSE COORD = 'PL' END IF C C CHECK FOR CONFLICTING PROCESSING FLAGS C IF ( SYS2(4).AND..NOT.SYS2(5) ) THEN MODE = 'SNGL' LEN = 1832 ELSE IF ( SYS2(5).AND..NOT.SYS2(4) ) THEN MODE = 'DUAL' LEN = 2432 ELSE WRITE(6,*) WRITE(6,*) & '*CR2DET* CONFLICTING DETAIL PROCESSING FLAGS' STOP END IF C IF ( SYS2(6).AND.ICALL.EQ.1 ) THEN C C FORTRAN OUTPUT UNIT ASSIGNED TO FILE NAME IN VMS DCL ROUTINE CALLING C THE VOYPROD EXECUTABLE ex. $ ASSIGN FILE.DAT FOR084 C OPEN(IUNIT,STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST',RECL=124) END IF C CR2TIME(1) = TIME(1) CR2TIME(2) = TIME(2) CR2TIME(3) = TIME(3) CR2TIME(4) = TIME(4) CR2TIME(5) = TIME(5) CR2TIME(6) = TIME(6) C IF ( SCID.EQ.0 ) THEN FLTID = "FLT2" ELSE IF ( SCID.EQ.1 ) THEN FLTID = "FLT1" ELSE FLTID = "FLT?" END IF DATAID = 'LFM ' TIMEPD = 48.0 DATATYPE(1) = 1 WORD32(1) = RECWRITE C IF ( SYS2(4) ) THEN WORD30(1) = 400 WORD30(2) = 200 WORD32(2) = 1800 ELSE IF ( SYS2(5) ) THEN WORD30(1) = 400 WORD30(2) = 400 WORD32(2) = 2400 END IF C C REASSIGN DETAIL VALUES TO LOCAL VARIABLES C DO I = 1,400 C C SECONDARY MAG SAMPLE COUNTER (1-200) C ISEC = (I-1)/2 + 1 C PRIDAT(1,I) = GAMMA(1,I) PRIDAT(2,I) = GAMMA(2,I) PRIDAT(3,I) = GAMMA(3,I) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,2).EQ.0 ) THEN SECDAT(1,ISEC) = GAMMA2(1,ISEC) SECDAT(2,ISEC) = GAMMA2(2,ISEC) SECDAT(3,ISEC) = GAMMA2(3,ISEC) END IF C AMBDAT(1,I) = AMBIENT(1,I) AMBDAT(2,I) = AMBIENT(2,I) AMBDAT(3,I) = AMBIENT(3,I) C SCFDAT(1,I) = SCF(1,I) SCFDAT(2,I) = SCF(2,I) SCFDAT(3,I) = SCF(3,I) C END DO C IF ( SYS2(7) ) THEN C C GET SEDR DATA C CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) C IF ( SYS2(4) ) THEN C C ROTATE PRIMARY AND SECONDARY DATA INTO HG COORDINATES C CALL ROTATE(HG,PRIDAT,MHG,400,BAD) DO II = 1,400 PRIDAT(1,II) = HG(1,II) PRIDAT(2,II) = HG(2,II) PRIDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SECDAT,MHG,200,BAD) DO II = 1,200 SECDAT(1,II) = HG(1,II) SECDAT(2,II) = HG(2,II) SECDAT(3,II) = HG(3,II) END DO C ELSE IF ( SYS2(5) ) THEN C C ROTATE AMBIENT AND SPACECRAFT FIELD DATA INTO HG COORDINATES C CALL ROTATE(HG,AMBDAT,MHG,400,BAD) DO II = 1,400 AMBDAT(1,II) = HG(1,II) AMBDAT(2,II) = HG(2,II) AMBDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SCFDAT,MHG,400,BAD) DO II = 1,400 SCFDAT(1,II) = HG(1,II) SCFDAT(2,II) = HG(2,II) SCFDAT(3,II) = HG(3,II) END DO C END IF C END IF C C WRITE 48 SECOND CR-2 RECORD C DO I = 1,400 C C SECONDARY MAG SAMPLE COUNTER (1-200) C ISEC = (I-1)/2 + 1 C IF ( SYS2(4) ) THEN C C OUTPUT PRIMARY FIELD X,Y,Z FOLLOWED BY SECONDARY FIELD X,Y,Z C DETOUT(32+I) = PRIDAT(1,I) DETOUT(32+400+I) = PRIDAT(2,I) DETOUT(32+800+I) = PRIDAT(3,I) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,2).EQ.0 ) THEN DETOUT(32+1200+ISEC) = SECDAT(1,ISEC) DETOUT(32+1400+ISEC) = SECDAT(2,ISEC) DETOUT(32+1600+ISEC) = SECDAT(3,ISEC) END IF C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR2TIME,RANGE,ANG(2), & ANG(1),(PRIDAT(J,I),J=1,3),(SECDAT(J,ISEC),J=1,3) END IF C ELSE IF ( SYS2(5) ) THEN C C OUTPUT AMBIENT FIELD X,Y,Z FOLLOWED BY SPACECRAFT FIELD X,Y,Z C DETOUT(32+I) = AMBDAT(1,I) DETOUT(32+400+I) = AMBDAT(2,I) DETOUT(32+800+I) = AMBDAT(3,I) C DETOUT(32+1200+I) = SCFDAT(1,I) DETOUT(32+1600+I) = SCFDAT(2,I) DETOUT(32+2000+I) = SCFDAT(3,I) C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR2TIME,RANGE,ANG(2), & ANG(1),(AMBDAT(J,I),J=1,3),(SCFDAT(J,I),J=1,3) END IF C END IF C CALL INC_TIME(CR2TIME,DELTA) C END DO C C WRITE BINARY DETAIL DATA C WRITE(66) (DETOUT(I),I=1,LEN) C RETURN 800 FORMAT(2(A4,1X),A2,1X,A4,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,F8.4, & 2(1X,F8.3),6(1X,F9.3)) END SUBROUTINE CR2FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C USING 48 SECOND CR-2 EDR RECORD, COMPUTE SPACECRAFT AND AMBIENT FIELDS. C C WRITTEN BY SANDY KRAMER 03/22/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,400),GAMMA2(3,200),SCF(3,400),AMBIENT(3,400) C C IMPLEMENT SPACECRAFT FIELD COUPLING COEFFICIENT, ALPHA, C IN COMPUTATION OF S/C FIELD C C COEF = ALPHA/(1.0-ALPHA) WHERE ALPHA = .1846 C = 0.230921 C DATA ALPHA/0.1876/,COEF/0.230921/ C INCLUDE 'UNPACK.INC' C DO I=1,400 ISEC = (I-1)/2 + 1 ISTAT = (I-1)/80 + 1 DO J = 1,3 C C COMPUTER DIFFERENCE BETWEEN PRIMARY AND SECONDARY MAGNETOMETERS C AND THEN COMPUTE AMBIENT FIELD FOR RETURN AT PRIMARY MAG RATE. C IF ( GAMMA(J,I).NE.BAD .AND. & GAMMA2(J,ISEC).NE.BAD ) THEN SCF(J,I) = (GAMMA2(J,ISEC)-GAMMA(J,I))*COEF IF ( PRIME(ISTAT) ) THEN ! INBOARD PRIME SCF(J,I) = -SCF(J,I) AMBIENT(J,I) = GAMMA2(J,ISEC) - SCF(J,I) ELSE ! OUTBOARD PRIME AMBIENT(J,I) = GAMMA(J,I) - SCF(J,I) END IF ELSE SCF(J,I) = BAD AMBIENT(J,I) = BAD END IF C END DO END DO C RETURN END ****************************************************************** * * TITLE: CONVERT RECONSTRUCTED DIGITAL VALUES INTO GAMMAS * * FILE NAME: CR2LFM.FOR * * PURPOSE: TO CONVERT DIGITAL CR-2 MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 03/22/96 ORIGINAL CODE * (MODE CR-2) * * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * * PDL: * * CALL COMMAND AND STATUS WORD EXTRACTION ROUTINE * CALL COUNTS TO GAMMAS CONVERSION ROUTINE * CALL SENSOR ALIGNMENT ROUTINE * CALL BOOM ALIGNMENT ROUTINE * * RETURN * ****************************************************************** SUBROUTINE CR2LFM(GAMMA,GAMMA2,BAD,TIME) C INTEGER*2 TIME(6) LOGICAL*1 SROTATE,BROTATE REAL*4 GAMMA(3,400),GAMMA2(3,200) C INCLUDE 'UNPACK.INC' C DATA SROTATE/.TRUE./, & BROTATE/.TRUE./ C C SENSOR ROTATION SWITCH C IF ( SYS2(13) ) SROTATE = .FALSE. C C BOOM ALIGNMENT ROTATION SWITCH C IF ( SYS2(23) ) BROTATE = .FALSE. C C EXTRACT INSTRUMENT STATUS FROM STAT WORDS C CALL MAGSTATUS(TIME,5,1) C C CONVERT COUNTS INTO GAMMAS (MODE SENSITIVE) C DO I = 1,400 PREC(1,I) = PREF(1,I) PREC(2,I) = PREF(2,I) PREC(3,I) = PREF(3,I) IF ( I.LE.200 ) THEN SREC(1,I) = SREF(1,I) SREC(2,I) = SREF(2,I) SREC(3,I) = SREF(3,I) END IF END DO CALL MAKEGAMMAS(GAMMA,400,GAMMA2,200,5,1,BAD,TIME) C C ORTHOGONALIZE DATA WITH SENSOR MATRIX AFTER GAMMAS (MODE SENSITIVE) C IF ( SROTATE ) THEN CALL SENSOR_ALIGN(GAMMA,GAMMA2,400,200,1,BAD) END IF C C ROTATE DATA WITH BOOM ALIGNMENT MATRIX AFTER GAMMAS (MODE SENSITIVE) C IF ( BROTATE ) THEN CALL BOOM_ALIGN(GAMMA,GAMMA2,400,200,1,BAD) END IF C RETURN END SUBROUTINE CR2PNS(PRI,GAMMA2,TIME,BAD) C C USING 48 SECOND CR-2 EDR RECORD, INTERPOLATE SECONDARY MAG DETAIL (0.24 SEC) C DATA POINTS TO PRIMARY MAG DETAIL RATE (0.12 SEC). C INTEGER*2 TIME(6) C REAL*4 PRI(3,400),GAMMA2(3,200),SEC(3,400) C INCLUDE 'UNPACK.INC' C DO I=1,400 C C STEP INTERPOLATE 0.24 SECOND CR-2 SECONDARY MAG DATA C ISEC = (I-1)/2 + 1 SEC(1,I) = GAMMA2(1,ISEC) SEC(2,I) = GAMMA2(2,ISEC) SEC(3,I) = GAMMA2(3,ISEC) C END DO C C CALL CR-2 AVERAGING ROUTINES C CALL CR2PRI(PRI,SEC,TIME,BAD) C RETURN END SUBROUTINE CR2PRI(GAMMA,SCF,TIME,BAD) C C USING 48 SECOND CR-2 EDR RECORD, PRODUCE 48 SECOND BLOCK OF C 1.92 SEC AVERAGES FROM PRIMARY MAG DETAIL (0.12 SEC) DATA POINTS. C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER 03/22/96 C CHARACTER RECTYPE*4,TELFMT*4,FLTID*4 C INTEGER*2 TIME(6),EDRTIME(6),LAUNCH(6), & WORD30(2),WORD31(2),WORD32(2) C INTEGER*4 IB192(25) C REAL*4 SCF(3,400),GAMMA(3,400),FMOD(400),DEL(400),LAM(400), & B192(3,25),DEL192(25),LAM192(25),FMOD192(25), & FMAG192(25),RMS192(3,25),X192(25),Y192(25),Z192(25) C REAL*4 HDR(32),DATA(341) C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (SUMOUT(33),DATA(1)) C EQUIVALENCE (HDR(30),WORD30(1)), (HDR(31),WORD31(1)) C EQUIVALENCE (DATA(67),FMAG192(1)), (DATA(92),FMOD192(1)), & (DATA(117),DEL192(1)), (DATA(142),LAM192(1)), & (DATA(242),RMS192(1,1)),(DATA(317),IB192(1)) C C COMPUTE 25 1.92 SECOND AVERAGES FOR ONE 48 SECOND PERIOD C DO J=1,25 C I = (J-1)*16 + 1 C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(GAMMA(1,I),16,FMOD(I),DEL(I),LAM(I),BAD) C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(GAMMA(1,I),FMOD(I),16,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C WORD30(1) = 400 WORD30(2) = 200 WORD31(1) = 400 WORD31(2) = 200 C C COMPUTE 48 SECOND AVERAGE OF THE SPACECRAFT FIELD C CALL CR2SCF(SCF(1,1),TIME,BAD) C C COMPUTE 9.6 SECOND AVERAGES AND 48 SECOND AVERAGES C CALL BIGAVE(B192,TIME,BAD) C RETURN END SUBROUTINE CR2SCF(SCF,TIME,BAD) C C COMPUTE 48 SECOND AVERAGED SPACECRAFT FIELD FOR CR-2 RECORD C C INPUT 48 SECONDS OF DETAIL SPACECRAFT FIELD - SCF C OUTPUT RMS(SCF)(1,2,3), #DETAIL PTS, SCF(1,2,3), NORM(SCF(1,2,3) C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX - 03/22/96 C INTEGER*2 TIME(6) INTEGER*4 IB192(25),IB96(5),IB48 C REAL*4 SCF(3,400),FMOD(400),DEL(400),LAM(400),SCFLD(155), & FMAG192(25),FMOD192(25),DEL192(25), & LAM192(25),B192(3,25),RMS192(3,25), & X192(25),Y192(25),Z192(25), & XRMS192(25),YRMS192(25),ZRMS192(25), & FMAG96(5),FMOD96(5),DEL96(5), & LAM96(5),B96(3,5),RMS96(3,5), & X96(5),Y96(5),Z96(5), & XRMS96(5),YRMS96(5),ZRMS96(5), & FMAG48,FMOD48,DEL48, & LAM48,B48(3),RMS48(3), & X48,Y48,Z48,HG(3,25), & SPV(6),RANGE,ANG(2), & MTB(3,3),MTB5(3,3),MHG(3,3) C REAL*8 TD,TN,TP C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(342),SCFLD(1)) C EQUIVALENCE (SCFLD(148),RMS48(1)), (SCFLD(151),IB48), & (SCFLD(152),X48), (SCFLD(153),Y48), & (SCFLD(154),Z48), (SCFLD(155),FMOD48) C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(SCF,400,FMOD,DEL,LAM,BAD) C C COMPUTE 25 1.92 SECOND AVERAGES FOR 48 SECOND PERIOD C DO J = 1,25 C C 400 PRIMARY GAMMAS PER 48 SECOND PERIOD THEREFORE C 16 PRIMARY GAMMAS PER 1.92 SECOND AVERAGE C I = (J-1)*16 + 1 C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(SCF(1,I),FMOD(I),16,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C C ROTATE 1.92 SECOND AVERAGES C IF ( .NOT.SYS2(9) ) THEN CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) CALL ROTATE(HG,B192,MHG,25,BAD) DO I192 = 1,25 B192(1,I192) = HG(1,I192) B192(2,I192) = HG(2,I192) B192(3,I192) = HG(3,I192) END DO END IF C C GENERIC AVERAGING ROUTINE TO COMPUTE 9.6 AND 48 SECOND AVERAGES C DO I = 1,25,5 C C COMPUTE 1.92 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B192(1,I),5,FMOD192(I),DEL192(I),LAM192(I),BAD) C J = (I-1)/5 + 1 C C COMPUTE 9.6 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B192(1,I),FMOD192(I),5,B96(1,J),FMAG96(J),RMS96(1,J), & IB96(J),BAD) C END DO C C COMPUTE 9.6 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B96,5,FMOD96,DEL96,LAM96,BAD) C C COMPUTE 48 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B96,FMOD96,5,B48,FMAG48,RMS48,IB48,BAD) C C COMPUTE 48 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B48,1,FMOD48,DEL48,LAM48,BAD) C C SEPARATE FIELD AND RMS COMPONENT VECTORS FROM MATRICES C DO I96 = 1,5 X96(I96) = B96(1,I96) Y96(I96) = B96(2,I96) Z96(I96) = B96(3,I96) XRMS96(I96) = RMS96(1,I96) YRMS96(I96) = RMS96(2,I96) ZRMS96(I96) = RMS96(3,I96) DO J = 1,5 I192 = (I96-1)*5 + J X192(I192) = B192(1,I192) Y192(I192) = B192(2,I192) Z192(I192) = B192(3,I192) XRMS192(I192) = RMS192(1,I192) YRMS192(I192) = RMS192(2,I192) ZRMS192(I192) = RMS192(3,I192) END DO END DO X48 = B48(1) Y48 = B48(2) Z48 = B48(3) C RETURN END SUBROUTINE CR2SEC(GAMMA2,SCF,TIME,BAD) C C USING 48 SECOND CR-2 EDR RECORD, C INTERPOLATE SECONDARY MAG DATA (0.24 SEC) TO C PRIMARY MAG RATE (0.12 SEC). C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX CODE 692 - 03/22/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,400),GAMMA2(3,200),SCF(3,400) C INCLUDE 'UNPACK.INC' C DO I=1,400 C C STEP INTERPOLATE 0.24 SECOND CR-2 SECONDARY MAG DATA TO 0.12 SECOND C PRIMARY MAG RATE. C ISEC = (I-1)/2 + 1 GAMMA(1,I) = GAMMA2(1,ISEC) GAMMA(2,I) = GAMMA2(2,ISEC) GAMMA(3,I) = GAMMA2(3,ISEC) C END DO C C CALL CR-2 AVERAGING ROUTINES C CALL CR2PRI(GAMMA,SCF,TIME,BAD) C RETURN END SUBROUTINE CR3AVE(GAMMA,GAMMA2,BAD,TIME) C C MASTER CALLING ROUTINE FOR THE PRODUCTION OF CR-3 AVERAGES C C WRITTEN BY SANDY KRAMER 03/25/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,400),GAMMA2(3,100),SCF(3,400),AMBIENT(3,400) C DATA SCF /1200*999.0/ C INCLUDE 'UNPACK.INC' C C GET SPACECRAFT FIELD AND AMBIENT FIELD VALUES C CALL CR3FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C DETAIL OUTPUT C IF ( SYS2(4).OR.SYS2(5) ) THEN CALL CR3DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) RETURN END IF C C SINGLE MAG MODE - PRIMARY C IF ( SYS2(21) .AND. (.NOT.SYS2(22)) ) THEN CALL CR3PRI(GAMMA,SCF,TIME,BAD) C C SINGLE MAG MODE - SECONDARY C ELSE IF ( (.NOT.SYS2(21)) .AND. SYS2(22) ) THEN CALL CR3SEC(GAMMA2,SCF,TIME,BAD) C C SINGLE MAG MODE - PRIMARY AND SECONDARY C ELSE IF ( SYS2(21) .AND. SYS2(22) ) THEN CALL CR3PNS(GAMMA,GAMMA2,TIME,BAD) C C DUAL MAG MODE - AMBIENT AND SPACECRAFT FIELDS C ELSE IF ( (.NOT.SYS2(21)) .AND. (.NOT.SYS2(22)) ) THEN C C IF SYS2(27) IS TRUE, USE S/C FIELD AS AMBIENT C IF ( SYS2(27) ) THEN CALL CR3PRI(SCF,SCF,TIME,BAD) ELSE CALL CR3PRI(AMBIENT,SCF,TIME,BAD) END IF C END IF C RETURN END C C OBSOLETE ROUTINE REPLACED BY MAKEGAMMAS 12/30/1996 SBK C SUBROUTINE CR3CNT(GAMMA,GAMMA2,BAD,TIME,INBOARD) C C CR-3 ROUTINE C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER 03/25/96 C C THIS SUBROUTINE SUBTRACTS THE ZERO OFFSET FROM EACH COUNT AND MULTIPIES THE C RESULTING DIFFERENCE BY THE SENSITIVITY TO YIELD FIELD STRENGTH IN GAMMAS. C INTEGER*2 TIME(6) INTEGER*4 PRIOFF(3),SECOFF(3) LOGICAL*1 RECTEST,INBOARD REAL*4 GAMMA(3,400),GAMMA2(3,100),PRISEN(3),SECSEN(3) C INCLUDE 'UNPACK.INC' C IF ( SYS2(32) ) RECTEST = .TRUE. C DO IWRD = 1,400 C IWRD2 = (IWRD-1)/4 + 1 C C STAT1 WORD COUNTER (10 STAT1 WORDS PER 40 MF CR-3 RECORD) C ICYC = INT((IWRD-1)/40) + 1 C C ASSIGN OFFSETS AND SENSITIVITIES TO LOCAL VARIABLES CHECKING PRIME C LFM STATUS. C DO IAX = 1,3 IF ( .NOT.INBOARD ) THEN PRIOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) SECOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) PRISEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) SECSEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) ELSE PRIOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) SECOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) PRISEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) SECSEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) END IF END DO C C BEGIN 3 AXES GAMMA CONVERSION C DO IAX = 1,3 C C CONVERT PRIMARY MODE CR-3 COUNTS TO GAMMAS C GAMMA(IAX,IWRD) = BAD IF ( PREF(IAX,IWRD).NE.0 ) GAMMA(IAX,IWRD) = & (PREF(IAX,IWRD)-PRIOFF(IAX))*PRISEN(IAX) C C CONVERT SECONDARY MODE CR-3 COUNTS TO GAMMAS C IF ( MOD(IWRD,2).NE.0 ) THEN GAMMA2(IAX,IWRD2) = BAD IF ( SREF(IAX,IWRD2).NE.0 ) GAMMA2(IAX,IWRD2) = & (SREF(IAX,IWRD2)-SECOFF(IAX))*SECSEN(IAX) END IF C C END 3 AXES GAMMA CONVERSION C END DO C C OUTPUT COUNTS AND GAMMAS C IF ( RECTEST ) THEN C IF ( IWRD.EQ.1 ) WRITE(81,'(1X,''EDR TIME: '',6(1X,I3))') TIME C WRITE(81,'(4(1X,I5),3(1X,F7.3),4(1X,I5),3(1X,F7.3), & 1X,I2,2(1X,Z4.4),4(1X,I1))') & IWRD,PREF(1,IWRD),PREF(2,IWRD),PREF(3,IWRD), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD), & IWRD2,SREF(1,IWRD2),SREF(2,IWRD2),SREF(3,IWRD2), & GAMMA2(1,IWRD2),GAMMA2(2,IWRD2),GAMMA2(3,IWRD2), & ICYC,STAT1(ICYC),STAT2(ICYC), & IBMODE(ICYC),OBMODE(ICYC),IBRNG(ICYC),OBRNG(ICYC) C END IF C END DO C RETURN END SUBROUTINE CR3COMM(TIME) C C CR3 ROUTINE C C ADAPTED FROM CR2COMM ROUTINE BY SANDY KRAMER 03/25/96 C C THIS ROUTINE EXTRACTS VALUES FROM THE TWO STATUS WORDS, STAT1 AND STAT2, C THAT WERE UNPACKED FROM THE PLASMA SUB-HEADER BLOCK. STAT1 CONTAINS RANGE C AND MODE VALUES. STAT2 CONTAINS SENSOR STATES. C INTEGER*2 TIME(6) INTEGER*4 OBDIFF,IBDIFF C INCLUDE 'UNPACK.INC' C C GET INSTRUMENT STATUS VALUES FROM SECOND STATUS WORD (STAT2) C DO I = 1,2 C C ELECTRICAL FLIPPER STATUS C EFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 0, 1, EFLIP(I), 0) C C EXTRACT PRIME LFM STATUS C PRIME(I) = .FALSE. CALL MOVBIT(STAT2(I), 1, 1, PRIME(I), 0) C C INBOARD LFM FLIP STATUS C IBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 4, 2, IBFLIP(I), 0) C C OUTBOARD LFM FLIP STATUS C OBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 2, 2, OBFLIP(I), 0) C C EXTRACT PROCESSOR STATUS C MPROC(I) = .FALSE. CALL MOVBIT(STAT2(I), 6, 1, MPROC(I), 0) C C EXTRACT POLARITY C POLAR(I) = .FALSE. CALL MOVBIT(STAT2(I), 7, 1, POLAR(I), 0) C C INBOARD LFM FLIGHT CALIBRATION INDICATOR C IBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 10, 1, IBCAL(I), 0) C C OUTBOARD LFM FLIGHT CALIBRATION INDICATOR C OBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 11, 1, OBCAL(I), 0) C END DO C C GET INSTRUMENT STATUS VALUES FROM FIRST STATUS WORD (STAT1) C DO I=1,10 C C CHECK FOR RANGE OVERRIDE C IF ( RNGSET.NE.-1 ) THEN OBRNG(I) = RNGSET IBRNG(I) = RNGSET GOTO 100 END IF C C EXTRACT OUTBOARD AND INBOARD RANGE MODES [0,1] C IF ( MODSET.EQ.-1 ) THEN CALL MOVBIT(STAT1(I), 11, 1, OBMODE(I), 0) CALL MOVBIT(STAT1(I), 7, 1, IBMODE(I), 0) ELSE IF ( MODSET.EQ.0 ) THEN OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. ELSE IF ( MODSET.EQ.1 ) THEN OBMODE(I) = .TRUE. IBMODE(I) = .TRUE. END IF C C EXTRACT OUTBOARD AND INBOARD RANGE SENSITIVITIES [0,7] C DO J = 1,3 CALL MOVBIT(STAT1(I), 11-J, 1, OBRNG(I), J-1) CALL MOVBIT(STAT1(I), 7-J, 1, IBRNG(I), J-1) END DO C C TEST FOR RANGE ERRORS. SENSITIVITY MAY CHANGE ONLY BY ONE C IN AUTO RANGE MODE. C IBDIFF = ABS(IBRNG(I)-IBRNG(I-1)) OBDIFF = ABS(OBRNG(I)-OBRNG(I-1)) C C INBOARD MAG RANGE CHECK C IF ( IBDIFF.GT.1 .AND. (IBMODE(I).AND.IBMODE(I-1)) ) THEN WRITE(68,889) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) IBRNG(I) = IBRNG(I-1) IBMODE(I) = IBMODE(I-1) ELSE IF ( IBDIFF.NE.0 ) THEN WRITE(68,899) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) END IF C C OUTBOARD MAG RANGE CHECK C IF ( OBDIFF.GT.1 .AND. (OBMODE(I).AND.OBMODE(I-1)) ) THEN WRITE(68,888) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) OBRNG(I) = OBRNG(I-1) OBMODE(I) = OBMODE(I-1) ELSE IF ( OBDIFF.NE.0 ) THEN WRITE(68,898) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) END IF C 100 CONTINUE C END DO C C PUT LAST RANGE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBRNG(0) = IBRNG(10) OBRNG(0) = OBRNG(10) C C PUT LAST MODE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBMODE(0) = IBMODE(10) OBMODE(0) = OBMODE(10) C RETURN 888 FORMAT(1X,'*CR3COMM* OUTBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 889 FORMAT(1X,'*CR3COMM* INBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 898 FORMAT(1X,'*CR3COMM* OUTBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 899 FORMAT(1X,'*CR3COMM* INBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) END SUBROUTINE CR3DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C OUTPUT DETAIL DATA FROM CR-3 EDR PROCESSING. C C ORIGINAL SOURCE - SBK 04/04/96 C MODIFIED OUTPUT FORMAT FOR UNIFORMITY ACROSS TELEMETRY MODES C SBK 02/23/2007 C CHARACTER DATAID*4,FLTID*4,COORD*2,MODE*4,TELEM*4 INTEGER*2 TIME(6),CR3TIME(6),DELTA(6), & DATATYPE(2),WORD30(2),WORD32(2) REAL*4 HDR(32),TIMEPD REAL*4 GAMMA(3,400),GAMMA2(3,100),SCF(3,400),AMBIENT(3,400), & PRIDAT(3,400),SECDAT(3,100),SCFDAT(3,400),AMBDAT(3,400) REAL*4 SPV(6),RANGE,ANG(2),PL(3), & HG(3,400),MTB(3,3),MTB5(3,3),MHG(3,3) REAL*8 TD,TN,TP C DATA ICALL/0/, DELTA/5*0,240/, CR3TIME/6*0/, TELEM/'CR-3'/ C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (DETOUT(1),HDR(1)), & (HDR(1),DATAID), & (HDR(12),TIMEPD), (HDR(17),DATATYPE(1)), & (HDR(30),WORD30(1)), (HDR(32),WORD32(1)) C IUNIT = 84 RECWRITE = RECWRITE + 1 ICALL = ICALL + 1 IF ( SYS2(7) ) THEN COORD = 'HG' ELSE COORD = 'PL' END IF C C CHECK FOR CONFLICTING PROCESSING FLAGS C IF ( SYS2(4).AND..NOT.SYS2(5) ) THEN MODE = 'SNGL' LEN = 1532 ELSE IF ( SYS2(5).AND..NOT.SYS2(4) ) THEN MODE = 'DUAL' LEN = 2432 ELSE WRITE(6,*) WRITE(6,*) & '*CR3DET* CONFLICTING DETAIL PROCESSING FLAGS' STOP END IF C IF ( SYS2(6).AND.ICALL.EQ.1 ) THEN C C FORTRAN OUTPUT UNIT ASSIGNED TO FILE NAME IN VMS DCL ROUTINE CALLING C THE VOYPROD EXECUTABLE ex. $ ASSIGN FILE.DAT FOR084 C OPEN(IUNIT,STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST',RECL=124) END IF C CR3TIME(1) = TIME(1) CR3TIME(2) = TIME(2) CR3TIME(3) = TIME(3) CR3TIME(4) = TIME(4) CR3TIME(5) = TIME(5) CR3TIME(6) = TIME(6) C IF ( SCID.EQ.0 ) THEN FLTID = "FLT2" ELSE IF ( SCID.EQ.1 ) THEN FLTID = "FLT1" ELSE FLTID = "FLT?" END IF DATAID = 'LFM ' TIMEPD = 48.0 DATATYPE(1) = 1 WORD32(1) = RECWRITE C IF ( SYS2(4) ) THEN WORD30(1) = 400 WORD30(2) = 100 WORD32(2) = 1500 ELSE IF ( SYS2(5) ) THEN WORD30(1) = 400 WORD30(2) = 400 WORD32(2) = 2400 END IF C C REASSIGN DETAIL VALUES TO LOCAL VARIABLES C DO I = 1,400 C C SECONDARY MAG SAMPLE COUNTER (1-100) C ISEC = (I-1)/4 + 1 C PRIDAT(1,I) = GAMMA(1,I) PRIDAT(2,I) = GAMMA(2,I) PRIDAT(3,I) = GAMMA(3,I) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,4).EQ.0 ) THEN SECDAT(1,ISEC) = GAMMA2(1,ISEC) SECDAT(2,ISEC) = GAMMA2(2,ISEC) SECDAT(3,ISEC) = GAMMA2(3,ISEC) END IF C AMBDAT(1,I) = AMBIENT(1,I) AMBDAT(2,I) = AMBIENT(2,I) AMBDAT(3,I) = AMBIENT(3,I) C SCFDAT(1,I) = SCF(1,I) SCFDAT(2,I) = SCF(2,I) SCFDAT(3,I) = SCF(3,I) C END DO C IF ( SYS2(7) ) THEN C C GET SEDR DATA C CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) C IF ( SYS2(4) ) THEN C C ROTATE PRIMARY AND SECONDARY DATA INTO HG COORDINATES C CALL ROTATE(HG,PRIDAT,MHG,400,BAD) DO II = 1,400 PRIDAT(1,II) = HG(1,II) PRIDAT(2,II) = HG(2,II) PRIDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SECDAT,MHG,100,BAD) DO II = 1,100 SECDAT(1,II) = HG(1,II) SECDAT(2,II) = HG(2,II) SECDAT(3,II) = HG(3,II) END DO C ELSE IF ( SYS2(5) ) THEN C C ROTATE AMBIENT AND SPACECRAFT FIELD DATA INTO HG COORDINATES C CALL ROTATE(HG,AMBDAT,MHG,400,BAD) DO II = 1,400 AMBDAT(1,II) = HG(1,II) AMBDAT(2,II) = HG(2,II) AMBDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SCFDAT,MHG,400,BAD) DO II = 1,400 SCFDAT(1,II) = HG(1,II) SCFDAT(2,II) = HG(2,II) SCFDAT(3,II) = HG(3,II) END DO C END IF C END IF C C WRITE 48 SECOND CR-3 RECORD C DO I = 1,400 C C SECONDARY MAG SAMPLE COUNTER (1-100) C ISEC = (I-1)/4 + 1 C IF ( SYS2(4) ) THEN C C OUTPUT PRIMARY FIELD X,Y,Z FOLLOWED BY SECONDARY FIELD X,Y,Z C DETOUT(32+I) = PRIDAT(1,I) DETOUT(32+400+I) = PRIDAT(2,I) DETOUT(32+800+I) = PRIDAT(3,I) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,4).EQ.0 ) THEN DETOUT(32+1200+ISEC) = SECDAT(1,ISEC) DETOUT(32+1300+ISEC) = SECDAT(2,ISEC) DETOUT(32+1400+ISEC) = SECDAT(3,ISEC) END IF C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR3TIME,RANGE,ANG(2), & ANG(1),(PRIDAT(J,I),J=1,3),(SECDAT(J,ISEC),J=1,3) END IF C ELSE IF ( SYS2(5) ) THEN C C OUTPUT AMBIENT FIELD X,Y,Z FOLLOWED BY SPACECRAFT FIELD X,Y,Z C DETOUT(32+I) = AMBDAT(1,I) DETOUT(32+400+I) = AMBDAT(2,I) DETOUT(32+800+I) = AMBDAT(3,I) C DETOUT(32+1200+I) = SCFDAT(1,I) DETOUT(32+1600+I) = SCFDAT(2,I) DETOUT(32+2000+I) = SCFDAT(3,I) C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR3TIME,RANGE,ANG(2), & ANG(1),(AMBDAT(J,I),J=1,3),(SCFDAT(J,I),J=1,3) END IF C END IF C CALL INC_TIME(CR3TIME,DELTA) C END DO WRITE(66) (DETOUT(I),I=1,LEN) C RETURN 800 FORMAT(2(A4,1X),A2,1X,A4,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,F8.4, & 2(1X,F8.3),6(1X,F9.3)) END SUBROUTINE CR3FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C USING 48 SECOND CR-3 EDR RECORD, COMPUTE SPACECRAFT AND AMBIENT FIELDS. C C WRITTEN BY SANDY KRAMER 03/25/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,400),GAMMA2(3,100),SCF(3,400),AMBIENT(3,400) C C IMPLEMENT SPACECRAFT FIELD COUPLING COEFFICIENT, ALPHA, C IN COMPUTATION OF S/C FIELD C C COEF = ALPHA/(1.0-ALPHA) WHERE ALPHA = .1846 C = 0.230921 C DATA ALPHA/0.1876/,COEF/0.230921/ C INCLUDE 'UNPACK.INC' C DO I=1,400 ISEC = (I-1)/4 + 1 ISTAT = (I-1)/40 + 1 DO J = 1,3 C C COMPUTER DIFFERENCE BETWEEN PRIMARY AND SECONDARY MAGNETOMETERS C AND THEN COMPUTE AMBIENT FIELD FOR RETURN AT PRIMARY MAG RATE. C IF ( GAMMA(J,I).NE.BAD .AND. & GAMMA2(J,ISEC).NE.BAD ) THEN SCF(J,I) = (GAMMA2(J,ISEC)-GAMMA(J,I))*COEF IF ( PRIME(ISTAT) ) THEN ! INBOARD PRIME SCF(J,I) = -SCF(J,I) AMBIENT(J,I) = GAMMA2(J,ISEC) - SCF(J,I) ELSE ! OUTBOARD PRIME AMBIENT(J,I) = GAMMA(J,I) - SCF(J,I) END IF ELSE SCF(J,I) = BAD AMBIENT(J,I) = BAD END IF C END DO END DO C RETURN END ****************************************************************** * * TITLE: CONVERT RECONSTRUCTED DIGITAL VALUES INTO GAMMAS * * FILE NAME: CR3LFM.FOR * * PURPOSE: TO CONVERT DIGITAL CR-3 MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 03/25/96 ORIGINAL CODE * (MODE CR-3) * * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * * PDL: * * CALL COMMAND AND STATUS WORD EXTRACTION ROUTINE * CALL COUNTS TO GAMMAS CONVERSION ROUTINE * CALL SENSOR ALIGNMENT ROUTINE * CALL BOOM ALIGNMENT ROUTINE * * RETURN * ****************************************************************** SUBROUTINE CR3LFM(GAMMA,GAMMA2,BAD,TIME) C INTEGER*2 TIME(6) LOGICAL*1 SROTATE,BROTATE REAL*4 GAMMA(3,400),GAMMA2(3,100) C INCLUDE 'UNPACK.INC' C DATA SROTATE/.TRUE./, & BROTATE/.TRUE./ C C SENSOR ROTATION SWITCH C IF ( SYS2(13) ) SROTATE = .FALSE. C C BOOM ALIGNMENT ROTATION SWITCH C IF ( SYS2(23) ) BROTATE = .FALSE. C C EXTRACT INSTRUMENT STATUS FROM STAT WORDS C CALL MAGSTATUS(TIME,10,2) C C CONVERT COUNTS INTO GAMMAS (MODE SENSITIVE) C DO I = 1,400 PREC(1,I) = PREF(1,I) PREC(2,I) = PREF(2,I) PREC(3,I) = PREF(3,I) IF ( I.LE.100 ) THEN SREC(1,I) = SREF(1,I) SREC(2,I) = SREF(2,I) SREC(3,I) = SREF(3,I) END IF END DO CALL MAKEGAMMAS(GAMMA,400,GAMMA2,100,10,2,BAD,TIME) C C ORTHOGONALIZE DATA WITH SENSOR MATRIX AFTER GAMMAS (MODE SENSITIVE) C IF ( SROTATE ) THEN CALL SENSOR_ALIGN(GAMMA,GAMMA2,800,800,2,BAD) END IF C C ROTATE DATA WITH BOOM ALIGNMENT MATRIX AFTER GAMMAS (MODE SENSITIVE) C IF ( BROTATE ) THEN CALL BOOM_ALIGN(GAMMA,GAMMA2,800,800,2,BAD) END IF C RETURN END SUBROUTINE CR3PNS(PRI,GAMMA2,TIME,BAD) C C USING 48 SECOND CR-3 EDR RECORD, INTERPOLATE SECONDARY MAG DETAIL (0.96 SEC) C DATA POINTS TO PRIMARY MAG DETAIL RATE (0.24 SEC). C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/25/96 C INTEGER*2 TIME(6) C REAL*4 PRI(3,400),GAMMA2(3,100),SEC(3,400) C INCLUDE 'UNPACK.INC' C DO I=1,400 C C STEP INTERPOLATE 0.96 SECOND CR-3 SECONDARY MAG DATA C ISEC = (I-1)/4 + 1 SEC(1,I) = GAMMA2(1,ISEC) SEC(2,I) = GAMMA2(2,ISEC) SEC(3,I) = GAMMA2(3,ISEC) C END DO C C CALL CR-3 AVERAGING ROUTINES C CALL CR3PRI(PRI,SEC,TIME,BAD) C RETURN END SUBROUTINE CR3PRI(GAMMA,SCF,TIME,BAD) C C USING 96 SECOND EDR RECORD, PRODUCE 48 SECOND BLOCKS OF 1.92 SEC C AVERAGES FROM PRIMARY MAG (.24 SEC) DATA POINTS. C C ORIGINAL CODE WRITTEN BY SANDY KRAMER, CODE 692 10/20/94 C CHARACTER RECTYPE*4,TELFMT*4,FLTID*4 C INTEGER*2 TIME(6),DELTA(6),EDRTIME(6),LAUNCH(6), & WORD13(2),WORD30(2),WORD31(2),WORD32(2) C INTEGER*4 IB192(25) C REAL*4 SCF(3,400),GAMMA(3,400),FMOD(400),DEL(400),LAM(400), & B192(3,25),DEL192(25),LAM192(25),FMOD192(25), & FMAG192(25),RMS192(3,25),X192(25),Y192(25),Z192(25) C REAL*4 HDR(32),DATA(341) C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (SUMOUT(33),DATA(1)), & (HDR(13),WORD13(1)), (HDR(30),WORD30(1)), & (HDR(31),WORD31(1)) C EQUIVALENCE (DATA(67),FMAG192(1)), (DATA(92),FMOD192(1)), & (DATA(117),DEL192(1)), (DATA(142),LAM192(1)), & (DATA(242),RMS192(1,1)),(DATA(317),IB192(1)) C C 48 SECOND TIME TAG INCREMENT ARRAY C DELTA(1) = 0 DELTA(2) = 0 DELTA(3) = 0 DELTA(4) = 0 DELTA(5) = 48 DELTA(6) = 0 C C CREATE 2 48 SECOND SUMMARY BLOCKS FROM 96 SECOND CR-3 RECORD C DO K = 1,2 ! 48 SECOND BLOCK COUNTER (2*48=96 SEC) C C COMPUTE 25 1.92 SECOND AVERAGES FOR ONE 48 SECOND PERIOD C DO J = 1,25 ! 1.92 SECOND AVERAGE COUNTER (25*1.92=48 SEC) C C 200 PRIMARY GAMMAS PER 48 SECOND PERIOD THEREFORE C 8 PRIMARY GAMMAS PER 1.92 SECOND AVERAGE C I = (K-1)*200 + (J-1)*8 + 1 C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(GAMMA(1,I),8,FMOD(I),DEL(I),LAM(I),BAD) C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(GAMMA(1,I),FMOD(I),8,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C WORD30(1) = 400 WORD30(2) = 100 WORD31(1) = 400 WORD31(2) = 100 C C COMPUTE 48 SECOND AVERAGE OF THE SPACECRAFT FIELD C KREC = (K-1)*200 + 1 CALL CR3SCF(SCF(1,KREC),TIME,BAD) C C COMPUTE 9.6 SECOND AVERAGES AND 48 SECOND AVERAGES C CALL BIGAVE(B192,TIME,BAD) C C INCREMENT CR-3 RECORD BLOCK TIME BY 48 SECONDS C CALL INC_TIME(TIME,DELTA) C C INCREMENT 48 SECOND COUNTER C WORD13(2) = WORD13(2) + 1 C END DO C RETURN END SUBROUTINE CR3SCF(SCF,TIME,BAD) C C COMPUTE 48 SECOND AVERAGED SPACECRAFT FIELD FOR CR-3 RECORD C C INPUT 48 SECONDS OF DETAIL SPACECRAFT FIELD - SCF C OUTPUT RMS(SCF)(1,2,3), #DETAIL PTS, SCF(1,2,3), NORM(SCF(1,2,3) C C WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/25/96 C INTEGER*2 TIME(6) INTEGER*4 IB192(25),IB96(5),IB48 C REAL*4 SCF(3,200),FMOD(200),DEL(200),LAM(200),SCFLD(155), & FMAG192(25),FMOD192(25),DEL192(25), & LAM192(25),B192(3,25),RMS192(3,25), & X192(25),Y192(25),Z192(25), & XRMS192(25),YRMS192(25),ZRMS192(25), & FMAG96(5),FMOD96(5),DEL96(5), & LAM96(5),B96(3,5),RMS96(3,5), & X96(5),Y96(5),Z96(5), & XRMS96(5),YRMS96(5),ZRMS96(5), & FMAG48,FMOD48,DEL48, & LAM48,B48(3),RMS48(3), & X48,Y48,Z48,HG(3,25), & SPV(6),RANGE,ANG(2), & MTB(3,3),MTB5(3,3),MHG(3,3) C REAL*8 TD,TN,TP C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(342),SCFLD(1)) C EQUIVALENCE (SCFLD(148),RMS48(1)), (SCFLD(151),IB48), & (SCFLD(152),X48), (SCFLD(153),Y48), & (SCFLD(154),Z48), (SCFLD(155),FMOD48) C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(SCF,200,FMOD,DEL,LAM,BAD) C C COMPUTE 25 1.92 SECOND AVERAGES FOR 48 SECOND PERIOD C DO J = 1,25 C C 200 PRIMARY GAMMAS PER 48 SECOND PERIOD THEREFORE C 8 PRIMARY GAMMAS PER 1.92 SECOND AVERAGE C I = (J-1)*8 + 1 C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(SCF(1,I),FMOD(I),8,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C C ROTATE 1.92 SECOND AVERAGES C IF ( .NOT.SYS2(9) ) THEN CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) CALL ROTATE(HG,B192,MHG,25,BAD) DO I192 = 1,25 B192(1,I192) = HG(1,I192) B192(2,I192) = HG(2,I192) B192(3,I192) = HG(3,I192) END DO END IF C C GENERIC AVERAGING ROUTINE TO COMPUTE 9.6 AND 48 SECOND AVERAGES C DO I = 1,25,5 C C COMPUTE 1.92 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B192(1,I),5,FMOD192(I),DEL192(I),LAM192(I),BAD) C J = (I-1)/5 + 1 C C COMPUTE 9.6 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B192(1,I),FMOD192(I),5,B96(1,J),FMAG96(J),RMS96(1,J), & IB96(J),BAD) C END DO C C COMPUTE 9.6 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B96,5,FMOD96,DEL96,LAM96,BAD) C C COMPUTE 48 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B96,FMOD96,5,B48,FMAG48,RMS48,IB48,BAD) C C COMPUTE 48 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B48,1,FMOD48,DEL48,LAM48,BAD) C C SEPARATE FIELD AND RMS COMPONENT VECTORS FROM MATRICES C DO I96 = 1,5 X96(I96) = B96(1,I96) Y96(I96) = B96(2,I96) Z96(I96) = B96(3,I96) XRMS96(I96) = RMS96(1,I96) YRMS96(I96) = RMS96(2,I96) ZRMS96(I96) = RMS96(3,I96) DO J = 1,5 I192 = (I96-1)*5 + J X192(I192) = B192(1,I192) Y192(I192) = B192(2,I192) Z192(I192) = B192(3,I192) XRMS192(I192) = RMS192(1,I192) YRMS192(I192) = RMS192(2,I192) ZRMS192(I192) = RMS192(3,I192) END DO END DO X48 = B48(1) Y48 = B48(2) Z48 = B48(3) C RETURN END SUBROUTINE CR3SEC(GAMMA2,SCF,TIME,BAD) C C USING 48 SECOND CR-3 EDR RECORD, INTERPOLATE SECONDARY MAG DATA (0.96 SEC) TO C PRIMARY MAG RATE (0.24 SEC). C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX CODE 692 - 03/25/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,400),GAMMA2(3,100),SCF(3,400) C INCLUDE 'UNPACK.INC' C DO I=1,400 C C STEP INTERPOLATE 0.96 SECOND CR-3 SECONDARY MAG DATA TO 0.24 SECOND C PRIMARY MAG RATE. C ISEC = (I-1)/4 + 1 GAMMA(1,I) = GAMMA2(1,ISEC) GAMMA(2,I) = GAMMA2(2,ISEC) GAMMA(3,I) = GAMMA2(3,ISEC) C END DO C C CALL CR-3 AVERAGING ROUTINES C CALL CR3PRI(GAMMA,SCF,TIME,BAD) C RETURN END SUBROUTINE CR4AVE(GAMMA,GAMMA2,BAD,TIME) C C MASTER CALLING ROUTINE FOR THE PRODUCTION OF CR-4 AVERAGES C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/26/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,640),GAMMA2(3,80),SCF(3,640),AMBIENT(3,640) C DATA SCF /1920*999.0/ C INCLUDE 'UNPACK.INC' C C GET SPACECRAFT FIELD AND AMBIENT FIELD VALUES C CALL CR4FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C DETAIL OUTPUT C IF ( SYS2(4).OR.SYS2(5) ) THEN CALL CR4DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) RETURN END IF C C SINGLE MAG MODE - PRIMARY C IF ( SYS2(21) .AND. (.NOT.SYS2(22)) ) THEN CALL CR4PRI(GAMMA,SCF,TIME,BAD) C C SINGLE MAG MODE - SECONDARY C ELSE IF ( (.NOT.SYS2(21)) .AND. SYS2(22) ) THEN CALL CR4SEC(GAMMA2,SCF,TIME,BAD) C C SINGLE MAG MODE - PRIMARY AND SECONDARY C ELSE IF ( SYS2(21) .AND. SYS2(22) ) THEN CALL CR4PNS(GAMMA,GAMMA2,TIME,BAD) C C DUAL MAG MODE C ELSE IF ( (.NOT.SYS2(21)) .AND. (.NOT.SYS2(22)) ) THEN C C IF SYS2(27) IS TRUE, USE S/C FIELD AS AMBIENT C IF (SYS2(27)) THEN CALL CR4PRI(SCF,SCF,TIME,BAD) ELSE CALL CR4PRI(AMBIENT,SCF,TIME,BAD) END IF C END IF C RETURN END C C OBSOLETE ROUTINE REPLACED BY MAKEGAMMAS 12/30/1996 SBK C SUBROUTINE CR4CNT(GAMMA,GAMMA2,BAD,TIME,INBOARD) C C CR-4 ROUTINE C C THIS SUBROUTINE SUBTRACTS THE ZERO OFFSET FROM EACH COUNT AND MULTIPIES THE C RESULTING DIFFERENCE BY THE SENSITIVITY TO YIELD FIELD STRENGTH IN GAMMAS. C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/26/96 C INTEGER*2 TIME(6) INTEGER*4 PRIOFF(3),SECOFF(3) LOGICAL*1 RECTEST,INBOARD REAL*4 GAMMA(3,640),GAMMA2(3,80),PRISEN(3),SECSEN(3) C INCLUDE 'UNPACK.INC' C IF ( SYS2(32) ) RECTEST = .TRUE. C DO IWRD = 1,640 C IWRD2 = (IWRD-1)/8 + 1 C C STAT1 WORD COUNTER (20 STAT1 WORDS PER 40 MF CR-4 RECORD) C ICYC = INT((IWRD-1)/32) + 1 C C ASSIGN OFFSETS AND SENSITIVITIES TO LOCAL VARIABLES CHECKING PRIME C LFM STATUS. C DO IAX = 1,3 IF ( .NOT.INBOARD ) THEN PRIOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) SECOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) PRISEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) SECSEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) ELSE PRIOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) SECOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) PRISEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) SECSEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) END IF END DO C C CONVERT PRIMARY MODE CR-4 COUNTS TO GAMMAS C DO IAX = 1,3 GAMMA(IAX,IWRD) = BAD IF ( PREC(IAX,IWRD).NE.0 ) GAMMA(IAX,IWRD) = & (PREC(IAX,IWRD)-PRIOFF(IAX))*PRISEN(IAX) END DO C C CONVERT SECONDARY MODE CR-4 COUNTS TO GAMMAS C IF ( MOD(IWRD-1,8).EQ.0 ) THEN DO IAX = 1,3 GAMMA2(IAX,IWRD2) = BAD IF ( SREC(IAX,IWRD2).NE.0 ) GAMMA2(IAX,IWRD2) = & (SREC(IAX,IWRD2)-SECOFF(IAX))*SECSEN(IAX) END DO END IF C IF ( RECTEST ) THEN C IF ( IWRD.EQ.1 ) WRITE(81,'(1X,''EDR TIME: '',6(1X,I3))') TIME C WRITE(81,'(4(1X,I5),3(1X,F7.3),4(1X,I5),3(1X,F7.3))') & IWRD,PREC(1,IWRD),PREC(2,IWRD),PREC(3,IWRD), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD), & IWRD2,SREC(1,IWRD2),SREC(2,IWRD2),SREC(3,IWRD2), & GAMMA2(1,IWRD2),GAMMA2(2,IWRD2),GAMMA2(3,IWRD2) C END IF C END DO C RETURN END SUBROUTINE CR4COMM(TIME) C C CR-4 ROUTINE C C ADAPTED FROM CR3COMM ROUTINE BY SANDY KRAMER 03/26/96 C C THIS ROUTINE EXTRACTS VALUES FROM THE TWO STATUS WORDS, STAT1 AND STAT2, C THAT WERE UNPACKED FROM THE PLASMA SUB-HEADER BLOCK. STAT1 CONTAINS RANGE C AND MODE VALUES. STAT2 CONTAINS SENSOR STATES. C INTEGER*2 TIME(6) INTEGER*4 OBDIFF,IBDIFF C INCLUDE 'UNPACK.INC' C C GET INSTRUMENT STATUS VALUES FROM SECOND STATUS WORD (STAT2) C DO I = 1,4 C C ELECTRICAL FLIPPER STATUS C EFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 0, 1, EFLIP(I), 0) C C EXTRACT PRIME LFM STATUS C PRIME(I) = .FALSE. CALL MOVBIT(STAT2(I), 1, 1, PRIME(I), 0) C C INBOARD LFM FLIP STATUS C IBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 4, 2, IBFLIP(I), 0) C C OUTBOARD LFM FLIP STATUS C OBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 2, 2, OBFLIP(I), 0) C C EXTRACT PROCESSOR STATUS C MPROC(I) = .FALSE. CALL MOVBIT(STAT2(I), 6, 1, MPROC(I), 0) C C EXTRACT POLARITY C POLAR(I) = .FALSE. CALL MOVBIT(STAT2(I), 7, 1, POLAR(I), 0) C C INBOARD LFM FLIGHT CALIBRATION INDICATOR C IBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 10, 1, IBCAL(I), 0) C C OUTBOARD LFM FLIGHT CALIBRATION INDICATOR C OBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 11, 1, OBCAL(I), 0) C END DO C C GET INSTRUMENT STATUS VALUES FROM FIRST STATUS WORD (STAT1) C DO I = 1,20 C C CHECK FOR RANGE OVERRIDE C IF ( RNGSET.NE.-1 ) THEN OBRNG(I) = RNGSET IBRNG(I) = RNGSET GOTO 100 END IF C C EXTRACT OUTBOARD AND INBOARD RANGE MODES [0,1] C IF ( MODSET.EQ.-1 ) THEN CALL MOVBIT(STAT1(I), 11, 1, OBMODE(I), 0) CALL MOVBIT(STAT1(I), 7, 1, IBMODE(I), 0) ELSE IF ( MODSET.EQ.0 ) THEN OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. ELSE IF ( MODSET.EQ.1 ) THEN OBMODE(I) = .TRUE. IBMODE(I) = .TRUE. END IF C C EXTRACT OUTBOARD AND INBOARD RANGE SENSITIVITIES [0,7] C DO J = 1,3 CALL MOVBIT(STAT1(I), 11-J, 1, OBRNG(I), J-1) CALL MOVBIT(STAT1(I), 7-J, 1, IBRNG(I), J-1) END DO C C TEST FOR RANGE ERRORS. SENSITIVITY MAY CHANGE ONLY BY ONE C IN AUTO RANGE MODE. C IBDIFF = ABS(IBRNG(I)-IBRNG(I-1)) OBDIFF = ABS(OBRNG(I)-OBRNG(I-1)) C C INBOARD MAG RANGE CHECK C IF ( IBDIFF.GT.1 .AND. (IBMODE(I).AND.IBMODE(I-1)) ) THEN WRITE(68,889) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) IBRNG(I) = IBRNG(I-1) IBMODE(I) = IBMODE(I-1) ELSE IF ( IBDIFF.NE.0 ) THEN WRITE(68,899) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) END IF C C OUTBOARD MAG RANGE CHECK C IF ( OBDIFF.GT.1 .AND. (OBMODE(I).AND.OBMODE(I-1)) ) THEN WRITE(68,888) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) OBRNG(I) = OBRNG(I-1) OBMODE(I) = OBMODE(I-1) ELSE IF ( OBDIFF.NE.0 ) THEN WRITE(68,898) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) END IF C 100 CONTINUE C END DO C C PUT LAST RANGE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBRNG(0) = IBRNG(10) OBRNG(0) = OBRNG(10) C C PUT LAST MODE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBMODE(0) = IBMODE(10) OBMODE(0) = OBMODE(10) C RETURN 888 FORMAT(1X,'*CR4COMM* OUTBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 889 FORMAT(1X,'*CR4COMM* INBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 898 FORMAT(1X,'*CR4COMM* OUTBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 899 FORMAT(1X,'*CR4COMM* INBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) END SUBROUTINE CR4DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C OUTPUT DETAIL DATA FROM CR-4 EDR PROCESSING. C C ORIGINAL SOURCE - SBK 04/04/96 C MODIFIED OUTPUT FORMAT FOR UNIFORMITY ACROSS TELEMETRY MODES C SBK 02/23/2007 C CHARACTER DATAID*4,FLTID*4,COORD*2,MODE*4,TELEM*4 INTEGER*2 TIME(6),CR4TIME(6),DELTA(6), & DATATYPE(2),WORD30(2),WORD32(2) REAL*4 HDR(32),TIMEPD REAL*4 GAMMA(3,640),GAMMA2(3,80),SCF(3,640),AMBIENT(3,640), & PRIDAT(3,640),SECDAT(3,80),SCFDAT(3,640),AMBDAT(3,640) REAL*4 SPV(6),RANGE,ANG(2),PL(3), & HG(3,640),MTB(3,3),MTB5(3,3),MHG(3,3) REAL*8 TD,TN,TP C DATA ICALL/0/, DELTA/5*0,300/, CR4TIME/6*0/, TELEM/'CR-4'/ C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (DETOUT(1),HDR(1)), & (HDR(1),DATAID), & (HDR(12),TIMEPD), (HDR(17),DATATYPE(1)), & (HDR(30),WORD30(1)), (HDR(32),WORD32(1)) C IUNIT = 84 RECWRITE = RECWRITE + 1 ICALL = ICALL + 1 IF ( SYS2(7) ) THEN COORD = 'HG' ELSE COORD = 'PL' END IF C C CHECK FOR CONFLICTING PROCESSING FLAGS C IF ( SYS2(4).AND..NOT.SYS2(5) ) THEN MODE = 'SNGL' LEN = 2192 ELSE IF ( SYS2(5).AND..NOT.SYS2(4) ) THEN MODE = 'DUAL' LEN = 3872 ELSE WRITE(6,*) WRITE(6,*) & '*CR4DET* CONFLICTING DETAIL PROCESSING FLAGS' STOP END IF C IF ( SYS2(6).AND.ICALL.EQ.1 ) THEN C C FORTRAN OUTPUT UNIT ASSIGNED TO FILE NAME IN VMS DCL ROUTINE CALLING C THE VOYPROD EXECUTABLE ex. $ ASSIGN FILE.DAT FOR084 C OPEN(IUNIT,STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST',RECL=124) END IF C CR4TIME(1) = TIME(1) CR4TIME(2) = TIME(2) CR4TIME(3) = TIME(3) CR4TIME(4) = TIME(4) CR4TIME(5) = TIME(5) CR4TIME(6) = TIME(6) C IF ( SCID.EQ.0 ) THEN FLTID = "FLT2" ELSE IF ( SCID.EQ.1 ) THEN FLTID = "FLT1" ELSE FLTID = "FLT?" END IF DATAID = 'LFM ' TIMEPD = 192.0 DATATYPE(1) = 1 WORD32(1) = RECWRITE C IF ( SYS2(4) ) THEN WORD30(1) = 640 WORD30(2) = 80 WORD32(2) = 2160 ELSE IF ( SYS2(5) ) THEN WORD30(1) = 640 WORD30(2) = 640 WORD32(2) = 3840 END IF C C REASSIGN DETAIL VALUES TO LOCAL VARIABLES C DO I = 1,640 C C SECONDARY MAG SAMPLE COUNTER (1-80) C ISEC = (I-1)/8 + 1 C PRIDAT(1,I) = GAMMA(1,I) PRIDAT(2,I) = GAMMA(2,I) PRIDAT(3,I) = GAMMA(3,I) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,8).EQ.0 ) THEN SECDAT(1,ISEC) = GAMMA2(1,ISEC) SECDAT(2,ISEC) = GAMMA2(2,ISEC) SECDAT(3,ISEC) = GAMMA2(3,ISEC) END IF C AMBDAT(1,I) = AMBIENT(1,I) AMBDAT(2,I) = AMBIENT(2,I) AMBDAT(3,I) = AMBIENT(3,I) C SCFDAT(1,I) = SCF(1,I) SCFDAT(2,I) = SCF(2,I) SCFDAT(3,I) = SCF(3,I) C END DO C IF ( SYS2(7) ) THEN C C GET SEDR DATA C CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) C IF ( SYS2(4) ) THEN C C ROTATE PRIMARY AND SECONDARY DATA INTO HG COORDINATES C CALL ROTATE(HG,PRIDAT,MHG,640,BAD) DO II = 1,640 PRIDAT(1,II) = HG(1,II) PRIDAT(2,II) = HG(2,II) PRIDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SECDAT,MHG,80,BAD) DO II = 1,80 SECDAT(1,II) = HG(1,II) SECDAT(2,II) = HG(2,II) SECDAT(3,II) = HG(3,II) END DO C ELSE IF ( SYS2(5) ) THEN C C ROTATE AMBIENT AND SPACECRAFT FIELD DATA INTO HG COORDINATES C CALL ROTATE(HG,AMBDAT,MHG,640,BAD) DO II = 1,640 AMBDAT(1,II) = HG(1,II) AMBDAT(2,II) = HG(2,II) AMBDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SCFDAT,MHG,640,BAD) DO II = 1,640 SCFDAT(1,II) = HG(1,II) SCFDAT(2,II) = HG(2,II) SCFDAT(3,II) = HG(3,II) END DO C END IF C END IF C C WRITE 192 SECOND CR-4 RECORD C DO I = 1,640 C C SECONDARY MAG SAMPLE COUNTER (1-80) C ISEC = (I-1)/8 + 1 C IF ( SYS2(4) ) THEN C C OUTPUT PRIMARY FIELD X,Y,Z FOLLOWED BY SECONDARY FIELD X,Y,Z C DETOUT(32+I) = PRIDAT(1,I) DETOUT(32+640+I) = PRIDAT(2,I) DETOUT(32+1280+I) = PRIDAT(3,I) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,8).EQ.0 ) THEN DETOUT(32+1920+ISEC) = SECDAT(1,ISEC) DETOUT(32+2000+ISEC) = SECDAT(2,ISEC) DETOUT(32+2080+ISEC) = SECDAT(3,ISEC) END IF C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR4TIME,RANGE,ANG(2), & ANG(1),(PRIDAT(J,I),J=1,3),(SECDAT(J,ISEC),J=1,3) END IF C ELSE IF ( SYS2(5) ) THEN C C OUTPUT AMBIENT FIELD X,Y,Z FOLLOWED BY SPACECRAFT FIELD X,Y,Z C DETOUT(32+I) = AMBDAT(1,I) DETOUT(32+640+I) = AMBDAT(2,I) DETOUT(32+1280+I) = AMBDAT(3,I) C DETOUT(32+1920+I) = SCFDAT(1,I) DETOUT(32+2560+I) = SCFDAT(2,I) DETOUT(32+3200+I) = SCFDAT(3,I) C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR4TIME,RANGE,ANG(2), & ANG(1),(AMBDAT(J,I),J=1,3),(SCFDAT(J,I),J=1,3) END IF C END IF C CALL INC_TIME(CR4TIME,DELTA) C END DO C C WRITE BINARY DETAIL DATA C WRITE(66) (DETOUT(I),I=1,LEN) C RETURN 800 FORMAT(2(A4,1X),A2,1X,A4,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,F8.4, & 2(1X,F8.3),6(1X,F9.3)) END C C OBSOLETE ROUTINE REPLACED BY ROUTINE DIFFERENCE 12/26/1996 SBK C SUBROUTINE CR4DIFF(TIME) C C CR-4 ROUTINE C C THIS SUBROUTINE RECONSTRUCTS FULL WORDS FROM 12 BIT REFERENCE AND 6 BIT C DIFFERENCE WORDS. RECONSTRUCTION IS VERIFIED AGAINST PRIMARY REFERENCE C WORDS OCCURRING EVERY 16TH COUNT AND SECONDARY REFERENCE WORDS OCCURRING C EVERY 4TH COUNT. AN INCORRECT RECONSTRUCTION RESULTS IN ALL RECONSTRUCTED C FULL WORDS FOR A REFERENCE CYCLE TO BE FLAGGED AS ERRED AND REPLACED WITH C THE FILL VALUE ZERO. C C PREF PRIMARY REFERENCE FULL WORD (FILL = 0) C PDIFF PRIMARY DIFFERENCE HALF WORD (FILL = 255) C PREC PRIMARY RECONSTRUCTED FULL WORD (FILL = 0) C PERR PRIMARY RECONSTRUCTION ERROR FLAG (0 = FALSE) C (1 = TRUE) C SREF SECONDARY REFERENCE FULL WORD (FILL = 0) C SDIFF SECONDARY DIFFERENCE HALF WORD (FILL = 255) C SREC SECONDARY RECONSTRUCTED FULL WORD (FILL = 0) C SERR SECONDARY RECONSTRUCTION ERROR FLAG (0 = FALSE) C (1 = TRUE) C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/26/96 C INTEGER*2 PSUM(3),PERR(3,40),TIME(6), & SSUM(3),SERR(3,20) LOGICAL*1 RECTEST C INCLUDE 'UNPACK.INC' C C OUTPUT PRIMARY AND SECONDARY REFERENCE WORDS, PRIMARY DIFFERENCE WORDS, C RECONSTRUCTED PRIMARY FULL WORDS, MODES AND RANGES. COUNTS ARE NOT C ROTATED BY SENSOR, BOOM ALIGNMENT OR SEDR MATRICES. C IF (SYS2(31)) RECTEST = .TRUE. C C RECONSTRUCT PRIMARY FULL WORDS FROM PRIMARY DIFFERENCES. C TEST FOR BAD DIFFERENCE WORDS AND NULL DATA. C IP = 1 PSUM(1) = 0 PSUM(2) = 0 PSUM(3) = 0 PERR(1,40) = 0 PERR(2,40) = 0 PERR(3,40) = 0 C C LOAD FIRST PRIMARY REFERENCE WORDS C DO IAX = 1,3 IF ( PREF(IAX,1).NE.0 ) THEN PREC(IAX,1) = PREF(IAX,1) PERR(IAX,1) = 0 ELSE PREC(IAX,1) = 0 PERR(IAX,1) = 1 END IF END DO C C RECONSTRUCT 12 BIT FULL WORDS FROM 6 BIT DIFFERENCE WORDS. USE C PRIMARY REFERENCE WORDS TO TEST FOR ERRORS IN RECONSTRUCTION OF C FULL WORDS FROM DIFFERENCE WORDS. C DO IWRD=1,640 C C VERIFY RECONSTRUCTED FULL WORDS C IF ( MOD(IWRD-1,16).EQ.0 .AND. IWRD.GT.1 ) THEN IP = IP + 1 DO IAX = 1,3 PERR(IAX,IP) = 0 PREC(IAX,IWRD) = 0 IF ( PREF(IAX,IP-1).NE.0 .AND. & PDIFF(IAX,IWRD).NE.255 .AND. & PERR(IAX,IP-1).EQ.0 ) THEN PSUM(IAX) = PSUM(IAX) + PDIFF(IAX,IWRD) PREC(IAX,IWRD) = PREF(IAX,IP-1) + PSUM(IAX) ELSE PERR(IAX,IP-1) = 1 END IF IF ( PREC(IAX,IWRD).NE.PREF(IAX,IP) ) THEN PREC(IAX,IWRD) = PREF(IAX,IP) PERR(IAX,IP-1) = 1 END IF PSUM(IAX) = 0 ! REINITIALIZE DIFFERENCE WORD ACCUMULATORS END DO C C OPERATE ON PRIMARY DIFFERENCE WORDS. C ELSE DO IAX = 1,3 PREC(IAX,IWRD) = 0 IF ( PDIFF(IAX,IWRD).NE.255 .AND. & PERR(IAX,IP).EQ.0 ) THEN PSUM(IAX) = PSUM(IAX) + PDIFF(IAX,IWRD) PREC(IAX,IWRD) = PREF(IAX,IP) + PSUM(IAX) ELSE PERR(IAX,IP) = 1 END IF END DO END IF C C END PRIMARY FULL WORD RECONSTRUCTION C END DO C C RECONSTRUCT SECONDARY FULL WORDS FROM SECONDARY DIFFERENCES. C TEST FOR BAD DIFFERENCE WORDS AND NULL DATA. C IS = 1 SSUM(1) = 0 SSUM(2) = 0 SSUM(3) = 0 SERR(1,20) = 0 SERR(2,20) = 0 SERR(3,20) = 0 C C LOAD FIRST SECONDARY REFERENCE WORDS C DO IAX = 1,3 IF ( SREF(IAX,1).NE.0 ) THEN SREC(IAX,1) = SREF(IAX,1) SERR(IAX,1) = 0 ELSE SREC(IAX,1) = 0 SERR(IAX,1) = 1 END IF END DO C C RECONSTRUCT 12 BIT FULL WORDS FROM 6 BIT DIFFERENCE WORDS. USE C SECONDARY REFERENCE WORDS TO TEST FOR ERRORS IN RECONSTRUCTION OF C FULL WORDS FROM DIFFERENCE WORDS. C DO IWRD = 1,80 C C VERIFY RECONSTRUCTED FULL WORDS C IF ( MOD(IWRD-1,4).EQ.0 .AND. IWRD.GT.1 ) THEN IS = IS + 1 DO IAX = 1,3 SERR(IAX,IS) = 0 SREC(IAX,IWRD) = 0 IF (SREF(IAX,IS-1).NE.0.AND. & SDIFF(IAX,IWRD).NE.255.AND. & SERR(IAX,IS-1).NE.1) THEN SSUM(IAX) = SSUM(IAX) + SDIFF(IAX,IWRD) SREC(IAX,IWRD) = SREF(IAX,IS-1) + SSUM(IAX) ELSE SREC(IAX,IWRD) = 0 SERR(IAX,IS-1) = 1 END IF IF (SREC(IAX,IWRD).NE.SREF(IAX,IS)) THEN SREC(IAX,IWRD) = SREF(IAX,IS) SERR(IAX,IS-1) = 1 END IF SSUM(IAX) = 0 ! REINITIALIZE DIFFERENCE WORD ACCUMULATORS END DO C C OPERATE ON SECONDARY DIFFERENCE WORDS C ELSE DO IAX = 1,3 SREC(IAX,IWRD) = 0 IF (SDIFF(IAX,IWRD).NE.255.AND. & SERR(IAX,IS).NE.1) THEN SSUM(IAX) = SSUM(IAX) + SDIFF(IAX,IWRD) SREC(IAX,IWRD) = SREF(IAX,IS) + SSUM(IAX) ELSE SREC(IAX,IWRD) = 0 SERR(IAX,IS) = 1 END IF END DO END IF C C END SECONDARY FULL WORD RECONSTRUCTION C END DO C C REMOVE ERROR FLAGGED RECONSTRUCTED FULL WORDS C DO IWRD = 1,640 C C PRIMARY REFERENCE WORD COUNTER C IP = INT((IWRD-1)/16) + 1 C C CHECK FOR PRIMARY FULL WORD RECONSTRUCTION ERRORS C DO IAX = 1,3 IF ( PERR(IAX,IP).EQ.1 ) PREC(IAX,IWRD) = 0 END DO C C SECONDARY REFERENCE WORD COUNTER C IS = INT((IWRD-1)/32) + 1 C C CHECK FOR SECONDARY FULL WORD RECONSTRUCTION ERRORS C IF (MOD(IWRD,2).NE.0) THEN IWRD2 = (IWRD-1)/8 + 1 DO IAX = 1,3 IF (SERR(IAX,IS).EQ.1) SREC(IAX,IWRD2) = 0 END DO END IF C C 2 MF CYCLE COUNTER (40 MF / CR-4 RECORD) C ICYC = INT((IWRD-1)/32) + 1 C IF (RECTEST) THEN C IF (IWRD.EQ.1) WRITE(80,'(1X,''EDR TIME: '',6(1X,I3))') TIME C WRITE(80,'(22(1X,I4),4(1X,I1),2(1X,Z4.4))') & IWRD, PDIFF(1,IWRD),PDIFF(2,IWRD),PDIFF(3,IWRD), & IP, PREF(1,IP), PREF(2,IP), PREF(3,IP), & PREC(1,IWRD),PREC(2,IWRD),PREC(3,IWRD), & IWRD2,SDIFF(1,IWRD2),SDIFF(2,IWRD2),SDIFF(3,IWRD2), & IS, SREF(1,IS), SREF(2,IS), SREF(3,IS), & SREC(1,IWRD2),SREC(2,IWRD2),SREC(3,IWRD2), & OBMODE(ICYC),OBRNG(ICYC),IBMODE(ICYC),IBRNG(ICYC), & STAT1(ICYC),STAT2(ICYC) C END IF C END DO C RETURN END SUBROUTINE CR4FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C USING 48 SECOND CR-4 EDR RECORD, INTERPOLATE SECONDARY MAG C DETAIL (2.40 SEC) DATA POINTS TO PRIMARY MAG DETAIL RATE (0.30 SEC) C TO COMPUTE SPACECRAFT AND AMBIENT FIELDS. C C ORIGINAL SOURCE WRIITEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/26/96 C MODIFIED TO INTERPOLATE MISSING S/C FIELD - SBK 04/09/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,640),GAMMA2(3,80),SCF(3,640),AMBIENT(3,640), & SCFHOLD(3) C C IMPLEMENT SPACECRAFT FIELD COUPLING COEFFICIENT, ALPHA, C IN COMPUTATION OF S/C FIELD C C COEF = ALPHA/(1.0-ALPHA) WHERE ALPHA = .1846 C = 0.230921 C DATA ALPHA/0.1876/,COEF/0.230921/ C INCLUDE 'UNPACK.INC' C DO I=1,640 C C STEP INTERPOLATE 2.40 SECOND CR-4 SECONDARY MAG DATA TO 0.30 SECOND PRIMARY C MAG RATE C ISEC = (I-1)/8 + 1 DO J = 1,3 C C COMPUTER DIFFERENCE BETWEEN PRIMARY AND SECONDARY MAGNETOMETERS C IF ( GAMMA(J,I).NE.BAD .AND. & GAMMA2(J,ISEC).NE.BAD ) THEN SCF(J,I) = (GAMMA2(J,ISEC)-GAMMA(J,I))*COEF SCFHOLD(J) = SCF(J,I) ! HOLD NON-FILL SCF VALUE ELSE SCF(J,I) = BAD END IF C C COMPUTE AMBIENT FIELD FOR RETURN AT PRIMARY MODE RATE C IF ( GAMMA(J,I).NE.BAD .AND. SCF(J,I).NE.BAD ) THEN AMBIENT(J,I) = GAMMA(J,I) - SCF(J,I) ELSE IF ( GAMMA(J,I).NE.BAD .AND. SCF(J,I).EQ.BAD ) THEN AMBIENT(J,I) = GAMMA(J,I) - SCFHOLD(J) ELSE AMBIENT(J,I) = BAD END IF C END DO C END DO C RETURN END ****************************************************************** * * TITLE: CONVERT RECONSTRUCTED DIGITAL VALUES INTO GAMMAS * * FILE NAME: CR4LFM.FOR * * PURPOSE: TO CONVERT DIGITAL CR-4 MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 03/25/96 ORIGINAL CODE * (MODE CR-4) * * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * * PDL: * * CALL COMMAND AND STATUS WORD EXTRACTION ROUTINE * CALL DIFFERENCE WORD RECONTRUCTION ROUTINE * CALL COUNTS TO GAMMAS CONVERSION ROUTINE * CALL SENSOR ALIGNMENT ROUTINE * CALL BOOM ALIGNMENT ROUTINE * * RETURN * ****************************************************************** SUBROUTINE CR4LFM(GAMMA,GAMMA2,BAD,TIME) INTEGER*2 TIME(6) LOGICAL*1 SROTATE,BROTATE REAL*4 GAMMA(3,640),GAMMA2(3,80) INCLUDE 'UNPACK.INC' DATA SROTATE/.TRUE./, & BROTATE/.TRUE./ C SENSOR ROTATION SWITCH IF ( SYS2(13) ) SROTATE = .FALSE. C BOOM ALIGNMENT ROTATION SWITCH IF ( SYS2(23) ) BROTATE = .FALSE. C EXTRACT INSTRUMENT STATUS FROM STAT WORDS CALL MAGSTATUS(TIME,20,4) C RECONSTRUCT PRIMARY FULL WORDS FROM DIFFERENCE WORDS CALL DIFFERENCE(PDIFF,640,PREF,40,PREC) C RECONSTRUCT SECONDARY FULL WORDS FROM DIFFERENCE WORDS CALL DIFFERENCE(SDIFF,80,SREF,20,SREC) C CONVERT COUNTS INTO GAMMAS (MODE SENSITIVE) CALL MAKEGAMMAS(GAMMA,640,GAMMA2,80,20,4,BAD,TIME) C ORTHOGONALIZE DATA WITH SENSOR MATRIX AFTER GAMMAS (MODE SENSITIVE) IF ( SROTATE ) CALL SENSOR_ALIGN(GAMMA,GAMMA2,640,80,4,BAD) C ROTATE DATA WITH BOOM ALIGNMENT MATRIX AFTER GAMMAS (MODE SENSITIVE) IF ( BROTATE ) CALL BOOM_ALIGN(GAMMA,GAMMA2,640,80,4,BAD) C RETURN END SUBROUTINE CR4PNS(PRI,GAMMA2,TIME,BAD) C C USING 192 SECOND CR-4 EDR RECORD, INTERPOLATE SECONDARY MAG DETAIL (2.40 SEC) C DATA POINTS TO PRIMARY MAG DETAIL RATE (0.30 SEC). C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/26/96 C INTEGER*2 TIME(6) C REAL*4 PRI(3,640),GAMMA2(3,80),SEC(3,640) C INCLUDE 'UNPACK.INC' C DO I = 1,640 C C STEP INTERPOLATE 2.40 SECOND CR-4 SECONDARY MAG DATA C ISEC = (I-1)/8 + 1 SEC(1,I) = GAMMA2(1,ISEC) SEC(2,I) = GAMMA2(2,ISEC) SEC(3,I) = GAMMA2(3,ISEC) C END DO C C CALL CR-4 AVERAGING ROUTINES C CALL CR4PRI(PRI,SEC,TIME,BAD) C RETURN END SUBROUTINE CR4PRI(GAMMA,SCF,TIME,BAD) C C USING 192 SECOND CR-4 EDR RECORD, PRODUCE 48 SECOND BLOCK OF 1.92 SEC C AVERAGES FROM PRIMARY MAG DETAIL (0.30 SEC) DATA POINTS. C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/26/96 C CHARACTER RECTYPE*4,TELFMT*4,FLTID*4 C INTEGER*2 TIME(6),DELTA(6),EDRTIME(6),LAUNCH(6), & WORD13(2),WORD30(2),WORD31(2),WORD32(2) C INTEGER*4 IB192(25) C REAL*4 SCF(3,640),GAMMA(3,640),FMOD(640),DEL(640),LAM(640), & B192(3,25),DEL192(25),LAM192(25),FMOD192(25), & FMAG192(25),RMS192(3,25),X192(25),Y192(25),Z192(25) C REAL*4 HDR(32),DATA(341) C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (SUMOUT(33),DATA(1)), & (HDR(13),WORD13(1)), (HDR(30),WORD30(1)), & (HDR(31),WORD31(1)) C EQUIVALENCE (DATA(67),FMAG192(1)), (DATA(92),FMOD192(1)), & (DATA(117),DEL192(1)), (DATA(142),LAM192(1)), & (DATA(242),RMS192(1,1)),(DATA(317),IB192(1)) C C 48 SECOND TIME TAG INCREMENT ARRAY C DELTA(1) = 0 DELTA(2) = 0 DELTA(3) = 0 DELTA(4) = 0 DELTA(5) = 48 DELTA(6) = 0 C C CREATE FOUR 48 SECOND SUMMARY BLOCKS FROM 192 SECOND CR-4 RECORD C DO K = 1,4 ! 48 SECOND BLOCK COUNTER (4*48=192 SEC) C C COMPUTE DETAIL FIELD MODULUS AND ANGLES FOR ONE 48 SECOND PERIOD C I = (K-1)*160 + 1 CALL ANGLES(GAMMA(1,I),160,FMOD(I),DEL(I),LAM(I),BAD) C C COMPUTE 25 1.92 SECOND AVERAGES FOR ONE 48 SECOND PERIOD C ISTART = I DO J = 1,25 C C 160 PRIMARY GAMMAS PER 48 SECOND PERIOD THEREFORE C 32 PRIMARY GAMMAS PER 9.6 SECOND AVERAGE. INTERPOLATE C 1.92 SECOND AVERAGES USING OLD MVS SOURCE METHOD C L = MOD(J-1,5) + 1 ! COUNTER, RANGE = 1-5 INCR = 6 + MOD(L+1,2) ! NUMBER OF DETAIL POINTS PER 1.92 SEC AVG (6,7) C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(GAMMA(1,ISTART),FMOD(ISTART),INCR,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) ISTART = ISTART + INCR C END DO C WORD30(1) = 160 WORD30(2) = 20 WORD31(1) = 10 WORD31(2) = 5 C C COMPUTE 48 SECOND AVERAGE OF THE SPACECRAFT FIELD C KREC = (K-1)*160 + 1 CALL CR4SCF(SCF(1,KREC),TIME,BAD) C C COMPUTE 9.6 SECOND AVERAGES AND 48 SECOND AVERAGES C CALL BIGAVE(B192,TIME,BAD) C C INCREMENT CR-4 RECORD BLOCK TIME BY 48 SECONDS C CALL INC_TIME(TIME,DELTA) C C INCREMENT 48 SECOND COUNTER C WORD13(2) = WORD13(2) + 1 C END DO C RETURN END SUBROUTINE CR4SCF(SCF,TIME,BAD) C C COMPUTE 48 SECOND AVERAGED SPACECRAFT FIELD FOR CR-4 RECORD C C INPUT 48 SECONDS OF DETAIL SPACECRAFT FIELD - SCF C OUTPUT RMS(SCF)(1,2,3), #DETAIL PTS, SCF(1,2,3), NORM(SCF(1,2,3) C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/26/96 C INTEGER*2 TIME(6) INTEGER*4 IB192(25),IB96(5),IB48 C REAL*4 SCF(3,160),FMOD(160),DEL(160),LAM(160),SCFLD(155), & FMAG192(25),FMOD192(25),DEL192(25), & LAM192(25),B192(3,25),RMS192(3,25), & X192(25),Y192(25),Z192(25), & XRMS192(25),YRMS192(25),ZRMS192(25), & FMAG96(5),FMOD96(5),DEL96(5), & LAM96(5),B96(3,5),RMS96(3,5), & X96(5),Y96(5),Z96(5), & XRMS96(5),YRMS96(5),ZRMS96(5), & FMAG48,FMOD48,DEL48, & LAM48,B48(3),RMS48(3), & X48,Y48,Z48,HG(3,5), & SPV(6),RANGE,ANG(2), & MTB(3,3),MTB5(3,3),MHG(3,3) C REAL*8 TD,TN,TP C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(342),SCFLD(1)) C EQUIVALENCE (SCFLD(148),RMS48(1)), (SCFLD(151),IB48), & (SCFLD(152),X48), (SCFLD(153),Y48), & (SCFLD(154),Z48), (SCFLD(155),FMOD48) C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(SCF,160,FMOD,DEL,LAM,BAD) C C COMPUTE 5 9.6 SECOND AVERAGES FOR 48 SECOND PERIOD C DO J = 1,5 C C 160 PRIMARY GAMMAS PER 48 SECOND PERIOD THEREFORE C 32 PRIMARY GAMMAS PER 9.6 SECOND AVERAGE C I = (J-1)*32 + 1 C C COMPUTE 9.6 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(SCF(1,I),FMOD(I),32,B96(1,J), & FMAG96(J),RMS96(1,J),IB96(J),BAD) C END DO C C ROTATE 9.6 SECOND AVERAGES C IF ( .NOT.SYS2(9) ) THEN CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) CALL ROTATE(HG,B96,MHG,5,BAD) DO I96 = 1,5 B96(1,I96) = HG(1,I96) B96(2,I96) = HG(2,I96) B96(3,I96) = HG(3,I96) END DO END IF C C COMPUTE 9.6 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B96,5,FMOD96,DEL96,LAM96,BAD) C C COMPUTE 48 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B96,FMOD96,5,B48,FMAG48,RMS48,IB48,BAD) C C COMPUTE 48 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B48,1,FMOD48,DEL48,LAM48,BAD) C C SEPARATE FIELD AND RMS COMPONENT VECTORS FROM MATRICES C DO I96 = 1,5 X96(I96) = B96(1,I96) Y96(I96) = B96(2,I96) Z96(I96) = B96(3,I96) XRMS96(I96) = RMS96(1,I96) YRMS96(I96) = RMS96(2,I96) ZRMS96(I96) = RMS96(3,I96) DO J = 1,5 I192 = (I96-1)*5 + J X192(I192) = B192(1,I192) Y192(I192) = B192(2,I192) Z192(I192) = B192(3,I192) XRMS192(I192) = RMS192(1,I192) YRMS192(I192) = RMS192(2,I192) ZRMS192(I192) = RMS192(3,I192) END DO END DO X48 = B48(1) Y48 = B48(2) Z48 = B48(3) C RETURN END SUBROUTINE CR4SEC(GAMMA2,SCF,TIME,BAD) C C USING 96 SECOND CR-4 EDR RECORD, INTERPOLATE SECONDARY MAG DATA (2.40 SEC) C TO PRIMARY MAG RATE (.30 SEC). C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/26/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,640),GAMMA2(3,80),SCF(3,640) C INCLUDE 'UNPACK.INC' C DO I=1,640 C C STEP INTERPOLATE 2.40 SECOND CR-4 SECONDARY MAG DATA TO .30 SECOND C PRIMARY MAG RATE. C ISEC = (I-1)/8 + 1 GAMMA(1,I) = GAMMA2(1,ISEC) GAMMA(2,I) = GAMMA2(2,ISEC) GAMMA(3,I) = GAMMA2(3,ISEC) C END DO C C CALL CR-4 AVERAGING ROUTINES C CALL CR4PRI(GAMMA,SCF,TIME,BAD) C RETURN END SUBROUTINE CR5AVE(GAMMA,GAMMA2,BAD,TIME) C C MASTER CALLING ROUTINE FOR THE PRODUCTION OF CR-5 AVERAGES C C ORIGINAL SOURCE BY SANDY KRAMER, HUGHES STX, CODE 692 - 10/21/94 C MODIFIED TO INCLUDE DELTA MODULATED WORDS - SBK 02/21/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,2400),GAMMA2(3,600),SCF(3,2400),AMBIENT(3,2400) C DATA SCF /7200*999.0/ C INCLUDE 'UNPACK.INC' C C GET SPACECRAFT FIELD AND AMBIENT FIELD VALUES C CALL CR5FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C DETAIL OUTPUT C IF ( SYS2(4).OR.SYS2(5) ) THEN CALL CR5DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) RETURN END IF C C SINGLE MAG MODE - PRIMARY C IF ( SYS2(21) .AND. (.NOT.SYS2(22)) ) THEN CALL CR5PRI(GAMMA,SCF,TIME,BAD) C C SINGLE MAG MODE - SECONDARY C ELSE IF ( SYS2(22) .AND. (.NOT.SYS2(21)) ) THEN CALL CR5SEC(GAMMA2,SCF,TIME,BAD) C C SINGLE MAG MODE - PRIMARY AND SECONDARY C ELSE IF ( SYS2(21) .AND. SYS2(22) ) THEN CALL CR5PNS(GAMMA,GAMMA2,TIME,BAD) C C DUAL MAG MODE C ELSE IF ( (.NOT.SYS2(21)) .AND. (.NOT.SYS2(22)) ) THEN C C IF SYS2(27) IS TRUE, USE S/C FIELD AS AMBIENT C IF (SYS2(27)) THEN CALL CR5PRI(SCF,SCF,TIME,BAD) ELSE CALL CR5PRI(AMBIENT,SCF,TIME,BAD) END IF C END IF C RETURN END C C OBSOLETE ROUTINE REPLACED BY MAKEGAMMAS 12/30/1996 SBK C SUBROUTINE CR5CNT(GAMMA,GAMMA2,BAD,TIME,INBOARD) C C CR-5 ROUTINE C C THIS SUBROUTINE SUBTRACTS THE ZERO OFFSET FROM EACH COUNT AND MULTIPIES THE C RESULTING DIFFERENCE BY THE SENSITIVITY TO YIELD FIELD STRENGTH IN GAMMAS. C C ORIGINAL CODE WRITTEN BY SANDY KRAMER - 10/21/94 C MODIFIED TO ACCEPT DELTA MODULATED WORDS - SBK 02/20/96 C INTEGER*2 TIME(6) INTEGER*4 PRIOFF(3),SECOFF(3) LOGICAL*1 RECTEST,INBOARD REAL*4 GAMMA(3,2400),GAMMA2(3,600),PRISEN(3),SECSEN(3) C INCLUDE 'UNPACK.INC' C IF ( SYS2(32) ) RECTEST = .TRUE. C DO IWRD = 1,2400 C IWRD2 = (IWRD-1)/4 + 1 C C STAT1 WORD COUNTER (12 STAT1 WORDS PER 60 MF CR-5 RECORD) C ICYC = INT((IWRD-1)/200) + 1 C C ASSIGN OFFSETS AND SENSITIVITIES TO LOCAL VARIABLES CHECKING PRIME C LFM STATUS. C DO IAX = 1,3 IF ( .NOT.INBOARD ) THEN PRIOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) SECOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) PRISEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) SECSEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) ELSE PRIOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) SECOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) PRISEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) SECSEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) END IF END DO C C CONVERT PRIMARY MODE CR-5 COUNTS TO GAMMAS C DO IAX = 1,3 GAMMA(IAX,IWRD) = BAD IF (PREC(IAX,IWRD).NE.0) GAMMA(IAX,IWRD) = & (PREC(IAX,IWRD)-PRIOFF(IAX))*PRISEN(IAX) END DO C C CONVERT SECONDARY MODE CR-5 COUNTS TO GAMMAS C IF ( MOD(IWRD,2).NE.0 ) THEN DO IAX = 1,3 GAMMA2(IAX,IWRD2) = BAD IF (SREC(IAX,IWRD2).NE.0) GAMMA2(IAX,IWRD2) = & (SREC(IAX,IWRD2)-SECOFF(IAX))*SECSEN(IAX) END DO END IF C IF ( RECTEST ) THEN IF ( IWRD.EQ.1 ) WRITE(81,'(1X,''EDR TIME: '',6(1X,I3))') TIME WRITE(81,'(4(1X,I5),3(1X,F7.3),4(1X,I5),3(1X,F7.3), & 1X,I2,2(1X,Z4.4),4(1X,I1))') & IWRD,PREC(1,IWRD),PREC(2,IWRD),PREC(3,IWRD), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD), & IWRD2,SREC(1,IWRD2),SREC(2,IWRD2),SREC(3,IWRD2), & GAMMA2(1,IWRD2),GAMMA2(2,IWRD2),GAMMA2(3,IWRD2), & ICYC,STAT1(ICYC),STAT2(ICYC), & IBMODE(ICYC),IBRNG(ICYC),OBMODE(ICYC),OBRNG(ICYC) END IF C END DO C RETURN END SUBROUTINE CR5COMM(TIME) C C CR5 ROUTINE C C THIS ROUTINE EXTRACTS VALUES FROM THE TWO STATUS WORDS, STAT1 AND STAT2, C THAT WERE UNPACKED FROM THE PLASMA SUB-HEADER BLOCK. STAT1 CONTAINS RANGE C AND MODE VALUES. STAT2 CONTAINS SENSOR STATES. C THERE ARE 12 STATUS PERIODS IN THE 60 MF CR-5 MAG SCIENCE BLOCK. C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER 08/25/95 C INTEGER*2 TIME(6) INTEGER*4 OBDIFF,IBDIFF C INCLUDE 'UNPACK.INC' C C GET INSTRUMENT STATUS VALUES FROM SECOND STATUS WORD C DO I = 1,12 C C ELECTRICAL FLIPPER STATUS C EFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 0, 1, EFLIP(I), 0) C C EXTRACT PRIME LFM STATUS C PRIME(I) = .FALSE. CALL MOVBIT(STAT2(I), 1, 1, PRIME(I), 0) C C INBOARD LFM FLIP STATUS C IBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 4, 2, IBFLIP(I), 0) C C OUTBOARD LFM FLIP STATUS C OBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 2, 2, OBFLIP(I), 0) C C EXTRACT PROCESSOR STATUS C MPROC(I) = .FALSE. CALL MOVBIT(STAT2(I), 6, 1, MPROC(I), 0) C C EXTRACT POLARITY C POLAR(I) = .FALSE. CALL MOVBIT(STAT2(I), 7, 1, POLAR(I), 0) C C INBOARD LFM FLIGHT CALIBRATION INDICATOR C IBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 10, 1, IBCAL(I), 0) C C OUTBOARD LFM FLIGHT CALIBRATION INDICATOR C OBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 11, 1, OBCAL(I), 0) C END DO C C GET INSTRUMENT STATUS VALUES FROM FIRST STATUS WORD C DO I=1,12 C C CHECK FOR RANGE OVERRIDE C IF (RNGSET.NE.-1) THEN OBRNG(I) = RNGSET IBRNG(I) = RNGSET GOTO 100 END IF C C EXTRACT OUTBOARD AND INBOARD RANGE MODES [0,1] C IF (MODSET.EQ.-1) THEN OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. CALL MOVBIT(STAT1(I), 11, 1, OBMODE(I), 0) CALL MOVBIT(STAT1(I), 7, 1, IBMODE(I), 0) ELSE IF (MODSET.EQ.0) THEN OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. ELSE IF (MODSET.EQ.1) THEN OBMODE(I) = .TRUE. IBMODE(I) = .TRUE. END IF C C EXTRACT OUTBOARD AND INBOARD RANGE SENSITIVITIES [0,7] C OBRNG(I) = 0 IBRNG(I) = 0 DO J = 1,3 CALL MOVBIT(STAT1(I), 11-J, 1, OBRNG(I), J-1) CALL MOVBIT(STAT1(I), 7-J, 1, IBRNG(I), J-1) END DO C C TEST FOR RANGE ERRORS. SENSITIVITY MAY CHANGE ONLY BY ONE C IN AUTO RANGE MODE. C IBDIFF = ABS(IBRNG(I)-IBRNG(I-1)) OBDIFF = ABS(OBRNG(I)-OBRNG(I-1)) C C INBOARD MAG RANGE CHECK C IF (IBDIFF.GT.1.AND.(IBMODE(I).AND.IBMODE(I-1))) THEN WRITE(68,889) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) IBRNG(I) = IBRNG(I-1) IBMODE(I) = IBMODE(I-1) ELSE IF ( IBDIFF.NE.0 ) THEN WRITE(68,899) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) END IF C C OUTBOARD MAG RANGE CHECK C IF (OBDIFF.GT.1.AND.(OBMODE(I).AND.OBMODE(I-1))) THEN WRITE(68,888) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) OBRNG(I) = OBRNG(I-1) OBMODE(I) = OBMODE(I-1) ELSE IF ( OBDIFF.NE.0 ) THEN WRITE(68,898) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) END IF C 100 CONTINUE C C IF (IBRNG(I).NE.0) WRITE(6,889) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) C IF (OBRNG(I).NE.0) WRITE(6,888) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) C END DO C C PUT LAST RANGE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBRNG(0) = IBRNG(12) OBRNG(0) = OBRNG(12) C C PUT LAST MODE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBMODE(0) = IBMODE(12) OBMODE(0) = OBMODE(12) C RETURN 888 FORMAT(1X,'*CR5COMM* OUTBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 889 FORMAT(1X,'*CR5COMM* INBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 898 FORMAT(1X,'*CR5COMM* OUTBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 899 FORMAT(1X,'*CR5COMM* INBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) END SUBROUTINE CR5DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C OUTPUT DETAIL DATA FROM CR-5 EDR PROCESSING. C C ORIGINAL SOURCE - SBK 02/21/96 C MODIFIED OUTPUT FORMAT FOR UNIFORMITY ACROSS TELEMETRY MODES C SBK 02/23/2007 C CHARACTER DATAID*4,FLTID*4,COORD*2,MODE*4,TELEM*4 INTEGER*2 TIME(6),DELTA(6),CR5TIME(6),DATATYPE(2), & WORD30(2),WORD32(2) REAL*4 HDR(32),TIMEPD REAL*4 GAMMA(3,2400),GAMMA2(3,600),SCF(3,2400),AMBIENT(3,2400), & PRIDAT(3,2400),SECDAT(3,600),SCFDAT(3,2400),AMBDAT(3,2400) REAL*4 SPV(6),RANGE,ANG(2),PL(3), & HG(3,2400),MTB(3,3),MTB5(3,3),MHG(3,3) REAL*8 TD,TN,TP C DATA ICALL/0/, DELTA/4*0,48,0/, CR5TIME/6*0/, TELEM/'CR-5'/ C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (DETOUT(1),HDR(1)), & (HDR(1),DATAID), (HDR(4),CR5TIME(1)), & (HDR(12),TIMEPD), (HDR(17),DATATYPE(1)), & (HDR(30),WORD30(1)), (HDR(32),WORD32(1)) C IUNIT = 84 RECWRITE = RECWRITE + 1 ICALL = ICALL + 1 IF ( SYS2(7) ) THEN COORD = 'HG' ELSE COORD = 'PL' END IF C C CHECK FOR CONFLICTING PROCESSING FLAGS C IF ( SYS2(4).AND..NOT.SYS2(5) ) THEN MODE = 'SNGL' LEN = 782 ELSE IF ( SYS2(5).AND..NOT.SYS2(4) ) THEN MODE = 'DUAL' LEN = 1232 ELSE WRITE(6,*) WRITE(6,*) & '*CR5DET* CONFLICTING DETAIL PROCESSING FLAGS' STOP END IF C IF ( SYS2(6).AND.ICALL.EQ.1 ) THEN C C FORTRAN OUTPUT UNIT ASSIGNED TO FILE NAME IN VMS DCL ROUTINE CALLING C THE VOYPROD EXECUTABLE ex. $ ASSIGN FILE.DAT FOR084 C OPEN(IUNIT,STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST',RECL=124) END IF C CR5TIME(1) = TIME(1) CR5TIME(2) = TIME(2) CR5TIME(3) = TIME(3) CR5TIME(4) = TIME(4) CR5TIME(5) = TIME(5) CR5TIME(6) = TIME(6) C IF ( SCID.EQ.0 ) THEN FLTID = "FLT2" ELSE IF ( SCID.EQ.1 ) THEN FLTID = "FLT1" ELSE FLTID = "FLT?" END IF DATAID = 'LFM ' TIMEPD = 48.0 DATATYPE(1) = 1 WORD32(1) = RECWRITE C IF ( SYS2(4) ) THEN WORD30(1) = 200 WORD30(2) = 50 WORD32(2) = 750 ELSE IF ( SYS2(5) ) THEN WORD30(1) = 200 WORD30(2) = 200 WORD32(2) = 1200 END IF C C REASSIGN DETAIL VALUES TO LOCAL VARIABLES C DO I = 1,2400 C C SECONDARY MAG SAMPLE COUNTER (1-600) C ISEC = (I-1)/4 + 1 C PRIDAT(1,I) = GAMMA(1,I) PRIDAT(2,I) = GAMMA(2,I) PRIDAT(3,I) = GAMMA(3,I) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,4).EQ.0 ) THEN SECDAT(1,ISEC) = GAMMA2(1,ISEC) SECDAT(2,ISEC) = GAMMA2(2,ISEC) SECDAT(3,ISEC) = GAMMA2(3,ISEC) END IF C AMBDAT(1,I) = AMBIENT(1,I) AMBDAT(2,I) = AMBIENT(2,I) AMBDAT(3,I) = AMBIENT(3,I) C SCFDAT(1,I) = SCF(1,I) SCFDAT(2,I) = SCF(2,I) SCFDAT(3,I) = SCF(3,I) C END DO C IF ( SYS2(7) ) THEN C C GET SEDR DATA C CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) C IF ( SYS2(4) ) THEN C C ROTATE PRIMARY AND SECONDARY DATA INTO HG COORDINATES C CALL ROTATE(HG,PRIDAT,MHG,2400,BAD) DO II = 1,2400 PRIDAT(1,II) = HG(1,II) PRIDAT(2,II) = HG(2,II) PRIDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SECDAT,MHG,600,BAD) DO II = 1,600 SECDAT(1,II) = HG(1,II) SECDAT(2,II) = HG(2,II) SECDAT(3,II) = HG(3,II) END DO C ELSE IF ( SYS2(5) ) THEN C C ROTATE AMBIENT AND SPACECRAFT FIELD DATA INTO HG COORDINATES C CALL ROTATE(HG,AMBDAT,MHG,2400,BAD) DO II = 1,2400 AMBDAT(1,II) = HG(1,II) AMBDAT(2,II) = HG(2,II) AMBDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SCFDAT,MHG,2400,BAD) DO II = 1,2400 SCFDAT(1,II) = HG(1,II) SCFDAT(2,II) = HG(2,II) SCFDAT(3,II) = HG(3,II) END DO C END IF C END IF C C BREAK 576 SECOND CR-5 RECORD INTO 48 SECOND SEGMENTS C DO N = 1,12 C L = (N-1)*200 K = (N-1)*50 C DO I = 1,200 C C SECONDARY MAG SAMPLE COUNTER (1-50) C ISEC = (I-1)/4 + 1 C IF ( SYS2(4) ) THEN C C OUTPUT PRIMARY FIELD X,Y,Z FOLLOWED BY SECONDARY FIELD X,Y,Z C DETOUT(32+I) = PRIDAT(1,I+L) DETOUT(32+200+I) = PRIDAT(2,I+L) DETOUT(32+400+I) = PRIDAT(3,I+L) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,4).EQ.0 ) THEN DETOUT(32+600+ISEC) = SECDAT(1,ISEC+K) DETOUT(32+600+50+ISEC) = SECDAT(2,ISEC+K) DETOUT(32+600+100+ISEC) = SECDAT(3,ISEC+K) END IF C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR5TIME,RANGE,ANG(2), & ANG(1),(PRIDAT(J,I),J=1,3),(SECDAT(J,ISEC),J=1,3) END IF C ELSE IF ( SYS2(5) ) THEN C C OUTPUT AMBIENT FIELD X,Y,Z FOLLOWED BY SPACECRAFT FIELD X,Y,Z C DETOUT(32+I) = AMBDAT(1,I+L) DETOUT(32+200+I) = AMBDAT(2,I+L) DETOUT(32+400+I) = AMBDAT(3,I+L) C DETOUT(32+600+I) = SCFDAT(1,I+L) DETOUT(32+800+I) = SCFDAT(2,I+L) DETOUT(32+1000+I) = SCFDAT(3,I+L) C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR5TIME,RANGE,ANG(2), & ANG(1),(AMBDAT(J,I),J=1,3),(SCFDAT(J,I),J=1,3) END IF C END IF C END DO C C C WRITE BINARY DETAIL DATA C WRITE(66) (DETOUT(I),I=1,LEN) CALL INC_TIME(CR5TIME,DELTA) C END DO C RETURN 800 FORMAT(2(A4,1X),A2,1X,A4,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,F8.4, & 2(1X,F8.3),6(1X,F9.3)) END SUBROUTINE CR5FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C USING 576 SECOND CR-5 EDR RECORD, INTERPOLATE SECONDARY MAG C DATA (.96 SEC) POINTS TO PRIMARY MAG DATA RATE (.24 SEC) C TO COMPUTE SPACECRAFT AND AMBIENT FIELDS. C C ORIGINAL SOURCE - SBK 10/21/94 C MODIFIED TO INCLUDE DELTA MODULATED WORDS - SBK 02/21/96 C INTEGER*2 TIME(6) REAL*4 GAMMA(3,2400),GAMMA2(3,600),SCF(3,2400),AMBIENT(3,2400) C C IMPLEMENT SPACECRAFT FIELD COUPLING COEFFICIENT, ALPHA, C IN COMPUTATION OF S/C FIELD C C COEF = ALPHA/(1.0-ALPHA) WHERE ALPHA = .1876 C = 0.230921 C DATA ALPHA/0.1876/,COEF/0.230921/ C INCLUDE 'UNPACK.INC' C DO I=1,2400 C C STEP INTERPOLATE .96 SECOND CR-5 SECONDARY MAG DATA TO .24 SECOND C PRIMARY MAG RATE C ISEC = (I-1)/4 + 1 DO J = 1,3 C C COMPUTER DIFFERENCE BETWEEN PRIMARY AND SECONDARY MAGNETOMETERS C IF (GAMMA(J,I).NE.BAD.AND. & GAMMA2(J,ISEC).NE.BAD) THEN SCF(J,I) = (GAMMA2(J,ISEC)-GAMMA(J,I))*COEF ELSE SCF(J,I) = BAD END IF C C COMPUTE AMBIENT FIELD FOR RETURN AT PRIMARY MODE RATE C IF (GAMMA(J,I).NE.BAD.AND.SCF(J,I).NE.BAD) THEN AMBIENT(J,I) = GAMMA(J,I) - SCF(J,I) ELSE AMBIENT(J,I) = BAD END IF C END DO C END DO C RETURN END ****************************************************************** * * TITLE: CONVERT RECONSTRUCTED DIGITAL VALUES INTO GAMMAS * * FILE NAME: CR5LFM.FOR * * PURPOSE: TO CONVERT DIGITAL CR-5 MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 11/02/92 ORIGINAL CODE * (MODE CR-5) * S. B. KRAMER 02/21/96 ADD DELTA RECONSTRUCTION * * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * * PDL: * * CALL COMMAND AND STATUS WORD EXTRACTION ROUTINE * CALL DELTA MODULATION RECONSTRUCT ROUTINES * CALL COUNTS TO GAMMAS CONVERSION ROUTINE * CALL SENSOR ALIGNMENT ROUTINE * CALL BOOM ALIGNMENT ROUTINE * * RETURN * ****************************************************************** SUBROUTINE CR5LFM(GAMMA,GAMMA2,BAD,TIME) C CR-5 MASTER ROUTINE TO PRODUCE GAMMAS FOR BIGAVE INTEGER*2 TIME(6) LOGICAL*1 SROTATE,BROTATE REAL*4 GAMMA(3,2400),GAMMA2(3,600) INCLUDE 'UNPACK.INC' DATA SROTATE/.TRUE./, & BROTATE/.TRUE./, & ICALL/0/ ICALL = ICALL + 1 C SENSOR ROTATION SWITCH IF ( SYS2(13) ) SROTATE = .FALSE. C BOOM ALIGNMENT ROTATION SWITCH IF ( SYS2(23) ) BROTATE = .FALSE. C EXTRACT INSTRUMENT STATUS FROM STAT WORDS CALL MAGSTATUS(TIME,12,12) C RECOVER 12 BIT PREDICTED WORDS CALL DELTA(PDELTA,2400,PREF,120,PREC) CALL DELTA(SDELTA,600,SREF,60,SREC) C ADJUST LEVEL OF RECONSTRUCTED PREDICT WORDS CALL SHIVOT(PREF,120,PREC,2400,SYS2(8)) CALL SHIVOT(SREF,60,SREC,600,SYS2(8)) C CONVERT COUNTS INTO GAMMAS (MODE SENSITIVE) CALL MAKEGAMMAS(GAMMA,2400,GAMMA2,600,12,12,BAD,TIME) C ORTHOGONALIZE DATA WITH SENSOR MATRIX AFTER GAMMAS (MODE SENSITIVE) IF ( SROTATE ) CALL SENSOR_ALIGN(GAMMA,GAMMA2,2400,600,12,BAD) C ROTATE DATA WITH BOOM ALIGNMENT MATRIX AFTER GAMMAS (MODE SENSITIVE) IF ( BROTATE ) CALL BOOM_ALIGN(GAMMA,GAMMA2,2400,600,12,BAD) C RETURN END SUBROUTINE CR5PNS(PRI,GAMMA2,TIME,BAD) C C USING 48 SECOND CR-5 EDR RECORD, INTERPOLATE SECONDARY MAG DETAIL (0.96 SEC) C DATA POINTS TO PRIMARY MAG DETAIL RATE (0.24 SEC). C INTEGER*2 TIME(6) C REAL*4 PRI(3,2400),GAMMA2(3,600),SEC(3,2400) C INCLUDE 'UNPACK.INC' C DO I=1,2400 C C STEP INTERPOLATE 0.12 SECOND GS-3 SECONDARY MAG DATA C ISEC = (I-1)/4 + 1 SEC(1,I) = GAMMA2(1,ISEC) SEC(2,I) = GAMMA2(2,ISEC) SEC(3,I) = GAMMA2(3,ISEC) C END DO C C CALL CR-5 AVERAGING ROUTINES C CALL CR5PRI(PRI,SEC,TIME,BAD) C RETURN END SUBROUTINE CR5PRI(GAMMA,SCF,TIME,BAD) C C USING 9.6 MINUTE EDR RECORD, PRODUCE 48 SECOND BLOCKS OF 1.92 SEC C AVERAGES FROM PRIMARY MAG (.24 SEC) DATA POINTS. C C ORIGINAL CODE WRITTEN 10/20/94 S. KRAMER, CODE 692. C MODIFIED TO ACCEPT DELTA MODULATION - SBK 02/21/96 C CHARACTER RECTYPE*4,TELFMT*4,FLTID*4 C INTEGER*2 TIME(6),DELTA(6),EDRTIME(6),LAUNCH(6), & WORD13(2),WORD30(2),WORD31(2),WORD32(2) C INTEGER*4 IB192(25) C REAL*4 SCF(3,2400),GAMMA(3,2400),FMOD(2400),DEL(2400),LAM(2400), & B192(3,25),DEL192(25),LAM192(25),FMOD192(25), & FMAG192(25),RMS192(3,25),X192(25),Y192(25),Z192(25) C REAL*4 HDR(32),DATA(341) C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (SUMOUT(33),DATA(1)), & (HDR(13),WORD13(1)), (HDR(30),WORD30(1)), & (HDR(31),WORD31(1)) C EQUIVALENCE (DATA(67),FMAG192(1)), (DATA(92),FMOD192(1)), & (DATA(117),DEL192(1)), (DATA(142),LAM192(1)), & (DATA(242),RMS192(1,1)),(DATA(317),IB192(1)) C C 48 SECOND TIME TAG INCREMENT ARRAY C DELTA(1) = 0 DELTA(2) = 0 DELTA(3) = 0 DELTA(4) = 0 DELTA(5) = 48 DELTA(6) = 0 C C CREATE 12 48 SECOND SUMMARY BLOCKS FROM 576 SECOND CR-5 RECORD C DO K = 1,12 ! 48 SECOND BLOCK COUNTER (12*48=576 SEC) C C COMPUTE 25 1.92 SECOND AVERAGES FOR ONE 48 SECOND PERIOD C DO J = 1,25 ! 1.92 SECOND AVERAGE COUNTER (25*1.92=48 SEC) C C 200 PRIMARY GAMMAS PER 48 SECOND PERIOD THEREFORE C 8 PRIMARY GAMMAS PER 1.92 SECOND AVERAGE C I = (K-1)*200 + (J-1)*8 + 1 C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(GAMMA(1,I),8,FMOD(I),DEL(I),LAM(I),BAD) C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(GAMMA(1,I),FMOD(I),8,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C WORD30(1) = 200 WORD30(2) = 50 WORD31(1) = 10 WORD31(2) = 5 C C COMPUTE 48 SECOND AVERAGE OF THE SPACECRAFT FIELD C KREC = (K-1)*200 + 1 CALL CR5SCF(SCF(1,KREC),TIME,BAD) C C COMPUTE 9.6 SECOND AVERAGES AND 48 SECOND AVERAGES C CALL BIGAVE(B192,TIME,BAD) C C INCREMENT CR-5 RECORD BLOCK TIME BY 48 SECONDS C CALL INC_TIME(TIME,DELTA) C C INCREMENT 48 SECOND COUNTER C WORD13(2) = WORD13(2) + 1 C END DO C RETURN END SUBROUTINE CR5SCF(SCF,TIME,BAD) C C COMPUTE 48 SECOND AVERAGED SPACECRAFT FIELD FOR CR-5 RECORD C C INPUT 48 SECONDS OF DETAIL SPACECRAFT FIELD - SCF C OUTPUT RMS(SCF)(1,2,3), #DETAIL PTS, SCF(1,2,3), NORM(SCF(1,2,3) C INTEGER*2 TIME(6) INTEGER*4 IB192(25),IB96(5),IB48 C REAL*4 SCF(3,200),FMOD(200),DEL(200),LAM(200),SCFLD(155), & FMAG192(25),FMOD192(25),DEL192(25), & LAM192(25),B192(3,25),RMS192(3,25), & X192(25),Y192(25),Z192(25), & XRMS192(25),YRMS192(25),ZRMS192(25), & FMAG96(5),FMOD96(5),DEL96(5), & LAM96(5),B96(3,5),RMS96(3,5), & X96(5),Y96(5),Z96(5), & XRMS96(5),YRMS96(5),ZRMS96(5), & FMAG48,FMOD48,DEL48, & LAM48,B48(3),RMS48(3), & X48,Y48,Z48,HG(3,25), & SPV(6),RANGE,ANG(2), & MTB(3,3),MTB5(3,3),MHG(3,3) C REAL*8 TD,TN,TP C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(342),SCFLD(1)) C EQUIVALENCE (SCFLD(148),RMS48(1)), (SCFLD(151),IB48), & (SCFLD(152),X48), (SCFLD(153),Y48), & (SCFLD(154),Z48), (SCFLD(155),FMOD48) C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(SCF,200,FMOD,DEL,LAM,BAD) C C COMPUTE 25 1.92 SECOND AVERAGES FOR 48 SECOND PERIOD C DO J = 1,25 C C 200 PRIMARY GAMMAS PER 48 SECOND PERIOD THEREFORE C 8 PRIMARY GAMMAS PER 1.92 SECOND AVERAGE C I = (J-1)*8 + 1 C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(SCF(1,I),FMOD(I),8,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C C ROTATE 1.92 SECOND AVERAGES C IF ( .NOT.SYS2(9) ) THEN CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) CALL ROTATE(HG,B192,MHG,25,BAD) DO I192 = 1,25 B192(1,I192) = HG(1,I192) B192(2,I192) = HG(2,I192) B192(3,I192) = HG(3,I192) END DO END IF C C GENERIC AVERAGING ROUTINE TO COMPUTE 9.6 AND 48 SECOND AVERAGES C DO I = 1,25,5 C C COMPUTE 1.92 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B192(1,I),5,FMOD192(I),DEL192(I),LAM192(I),BAD) C J = (I-1)/5 + 1 C C COMPUTE 9.6 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B192(1,I),FMOD192(I),5,B96(1,J),FMAG96(J),RMS96(1,J), & IB96(J),BAD) C END DO C C COMPUTE 9.6 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B96,5,FMOD96,DEL96,LAM96,BAD) C C COMPUTE 48 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B96,FMOD96,5,B48,FMAG48,RMS48,IB48,BAD) C C COMPUTE 48 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B48,1,FMOD48,DEL48,LAM48,BAD) C C SEPARATE FIELD AND RMS COMPONENT VECTORS FROM MATRICES C DO I96 = 1,5 X96(I96) = B96(1,I96) Y96(I96) = B96(2,I96) Z96(I96) = B96(3,I96) XRMS96(I96) = RMS96(1,I96) YRMS96(I96) = RMS96(2,I96) ZRMS96(I96) = RMS96(3,I96) DO J = 1,5 I192 = (I96-1)*5 + J X192(I192) = B192(1,I192) Y192(I192) = B192(2,I192) Z192(I192) = B192(3,I192) XRMS192(I192) = RMS192(1,I192) YRMS192(I192) = RMS192(2,I192) ZRMS192(I192) = RMS192(3,I192) END DO END DO X48 = B48(1) Y48 = B48(2) Z48 = B48(3) C RETURN END SUBROUTINE CR5SEC(GAMMA2,SCF,TIME,BAD) C C USING 9.6 MINUTE (576 SECONDS) CR-5 EDR RECORD, INTERPOLATE SECONDARY MAG C DATA (.96 SEC) TO PRIMARY MAG RATE (.24 SEC). C C WRITTEN 10/21/94 BY S. KRAMER, CODE 692. C MODIFIED TO ACCEPT DELTA MODULATION - SBK 02/21/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,2400),GAMMA2(3,600),SCF(3,2400) C INCLUDE 'UNPACK.INC' C DO I=1,2400 C C STEP INTERPOLATE .96 SECOND CR-5 SECONDARY MAG DATA TO .24 SECOND C PRIMARY MAG RATE. C ISEC = (I-1)/4 + 1 GAMMA(1,I) = GAMMA2(1,ISEC) GAMMA(2,I) = GAMMA2(2,ISEC) GAMMA(3,I) = GAMMA2(3,ISEC) C END DO C C CALL CR-5 AVERAGING ROUTINES C CALL CR5PRI(GAMMA,SCF,TIME,BAD) C RETURN END SUBROUTINE CR6AVE(GAMMA,GAMMA2,BAD,TIME) C C MASTER CALLING ROUTINE FOR THE PRODUCTION OF CR-6 AVERAGES C C ORIGINAL SOURCE BY SANDY KRAMER, HUGHES STX, CODE 692 - 03/21/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,750),GAMMA2(3,375),SCF(3,750),AMBIENT(3,750) C DATA SCF /2250*999.0/ C INCLUDE 'UNPACK.INC' C C GET SPACECRAFT FIELD AND AMBIENT FIELD VALUES C CALL CR6FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C DETAIL OUTPUT C IF ( SYS2(4).OR.SYS2(5) ) THEN CALL CR6DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) RETURN END IF C C SINGLE MAG MODE - PRIMARY C IF ( SYS2(21) .AND. (.NOT.SYS2(22)) ) THEN CALL CR6PRI(GAMMA,SCF,TIME,BAD) C C SINGLE MAG MODE - SECONDARY C ELSE IF ( SYS2(22) .AND. (.NOT.SYS2(21)) ) THEN CALL CR6SEC(GAMMA2,SCF,TIME,BAD) C C SINGLE MAG MODE - PRIMARY AND SECONDARY C ELSE IF ( SYS2(21) .AND. SYS2(22) ) THEN CALL CR6PNS(GAMMA,GAMMA2,TIME,BAD) C C DUAL MAG MODE C ELSE IF ( (.NOT.SYS2(21)) .AND. (.NOT.SYS2(22)) ) THEN C C IF SYS2(27) IS TRUE, USE S/C FIELD AS AMBIENT C IF (SYS2(27)) THEN CALL CR6PRI(SCF,SCF,TIME,BAD) ELSE CALL CR6PRI(AMBIENT,SCF,TIME,BAD) END IF C END IF C RETURN END C C OBSOLETE ROUTINE REPLACED BY MAKEGAMMAS 12/30/1996 SBK C SUBROUTINE CR6CNT(GAMMA,GAMMA2,BAD,TIME,INBOARD) C C CR-6 ROUTINE C C THIS SUBROUTINE SUBTRACTS THE ZERO OFFSET FROM EACH COUNT AND MULTIPIES THE C RESULTING DIFFERENCE BY THE SENSITIVITY TO YIELD FIELD STRENGTH IN GAMMAS. C C ORIGINAL CODE WRITTEN BY SANDY KRAMER - 03/21/96 C INTEGER*2 TIME(6) INTEGER*4 PRIOFF(3),SECOFF(3) LOGICAL*1 RECTEST,INBOARD REAL*4 GAMMA(3,750),GAMMA2(3,375),PRISEN(3),SECSEN(3) C INCLUDE 'UNPACK.INC' C IF ( SYS2(32) ) RECTEST = .TRUE. C DO IWRD = 1,750 C IWRD2 = (IWRD-1)/2 + 1 C C STAT1 WORD COUNTER (10 STAT1 WORDS PER 75 MF CR-6 RECORD) C ICYC = INT((IWRD-1)/75) + 1 C C ASSIGN OFFSETS AND SENSITIVITIES TO LOCAL VARIABLES CHECKING PRIME C LFM STATUS. C DO IAX = 1,3 IF ( .NOT.INBOARD ) THEN PRIOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) SECOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) PRISEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) SECSEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) ELSE PRIOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) SECOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) PRISEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) SECSEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) END IF END DO C C CONVERT PRIMARY MODE CR-6 COUNTS TO GAMMAS C DO IAX = 1,3 GAMMA(IAX,IWRD) = BAD IF (PREC(IAX,IWRD).NE.0) GAMMA(IAX,IWRD) = & (PREC(IAX,IWRD)-PRIOFF(IAX))*PRISEN(IAX) END DO C C CONVERT SECONDARY MODE CR-6 COUNTS TO GAMMAS C IF ( MOD(IWRD,2).NE.0 ) THEN DO IAX = 1,3 GAMMA2(IAX,IWRD2) = BAD IF (SREC(IAX,IWRD2).NE.0) GAMMA2(IAX,IWRD2) = & (SREC(IAX,IWRD2)-SECOFF(IAX))*SECSEN(IAX) END DO END IF C IF ( RECTEST ) THEN IF ( IWRD.EQ.1 ) WRITE(81,'(1X,''EDR TIME: '',6(1X,I3))') TIME WRITE(81,'(4(1X,I5),3(1X,F7.3),4(1X,I5),3(1X,F7.3), & 1X,I2,2(1X,Z4.4),4(1X,I1))') & IWRD,PREC(1,IWRD),PREC(2,IWRD),PREC(3,IWRD), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD), & IWRD2,SREC(1,IWRD2),SREC(2,IWRD2),SREC(3,IWRD2), & GAMMA2(1,IWRD2),GAMMA2(2,IWRD2),GAMMA2(3,IWRD2), & ICYC,STAT1(ICYC),STAT2(ICYC), & IBMODE(ICYC),IBRNG(ICYC),OBMODE(ICYC),OBRNG(ICYC) END IF C END DO C RETURN END SUBROUTINE CR6COMM(TIME) C C CR-6 ROUTINE C C THIS ROUTINE EXTRACTS VALUES FROM THE STATUS WORD (STAT1) C THAT WAS UNPACKED FROM THE PLASMA SUB-HEADER BLOCK. STAT1 C CONTAINS RANGE AND MODE VALUES. THERE ARE NO STAT2 WORDS C IN THE CR-6 PLASMA SUB-HEADER. C C THERE ARE 10 STATUS PERIODS IN THE 75 MF CR-6 MAG SCIENCE BLOCK. C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/21/96 C INTEGER*2 TIME(6) INTEGER*4 OBDIFF,IBDIFF C INCLUDE 'UNPACK.INC' C C GET INSTRUMENT STATUS VALUES FROM FIRST STATUS WORD C DO I = 1,10 C C CHECK FOR RANGE OVERRIDE C IF ( RNGSET.NE.-1 ) THEN OBRNG(I) = RNGSET IBRNG(I) = RNGSET GOTO 100 END IF C C EXTRACT OUTBOARD AND INBOARD RANGE MODES [0,1] C IF ( MODSET.EQ.-1 ) THEN OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. CALL MOVBIT(STAT1(I), 11, 1, OBMODE(I), 0) CALL MOVBIT(STAT1(I), 7, 1, IBMODE(I), 0) ELSE IF ( MODSET.EQ.0 ) THEN OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. ELSE IF ( MODSET.EQ.1 ) THEN OBMODE(I) = .TRUE. IBMODE(I) = .TRUE. END IF C C EXTRACT OUTBOARD AND INBOARD RANGE SENSITIVITIES [0,7] C OBRNG(I) = 0 IBRNG(I) = 0 DO J = 1,3 CALL MOVBIT(STAT1(I), 11-J, 1, OBRNG(I), J-1) CALL MOVBIT(STAT1(I), 7-J, 1, IBRNG(I), J-1) END DO C C TEST FOR RANGE ERRORS. SENSITIVITY MAY CHANGE ONLY BY ONE C IN AUTO RANGE MODE. C IBDIFF = ABS(IBRNG(I)-IBRNG(I-1)) OBDIFF = ABS(OBRNG(I)-OBRNG(I-1)) C C INBOARD MAG RANGE CHECK C IF ( IBDIFF.GT.1 .AND. ( IBMODE(I) .AND. IBMODE(I-1) ) ) THEN WRITE(68,889) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) IBRNG(I) = IBRNG(I-1) IBMODE(I) = IBMODE(I-1) ELSE IF ( IBDIFF.NE.0 ) THEN WRITE(68,899) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) END IF C C OUTBOARD MAG RANGE CHECK C IF ( OBDIFF.GT.1 .AND. ( OBMODE(I) .AND. OBMODE(I-1) ) ) THEN WRITE(68,888) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) OBRNG(I) = OBRNG(I-1) OBMODE(I) = OBMODE(I-1) ELSE IF ( OBDIFF.NE.0 ) THEN WRITE(68,898) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) END IF C 100 CONTINUE C END DO C C PUT LAST RANGE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBRNG(0) = IBRNG(10) OBRNG(0) = OBRNG(10) C C PUT LAST MODE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBMODE(0) = IBMODE(10) OBMODE(0) = OBMODE(10) C RETURN 888 FORMAT(1X,'*CR6COMM* OUTBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 889 FORMAT(1X,'*CR6COMM* INBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 898 FORMAT(1X,'*CR6COMM* OUTBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 899 FORMAT(1X,'*CR6COMM* INBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) END SUBROUTINE CR6DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C OUTPUT DETAIL DATA FROM CR-6 EDR PROCESSING. C C ORIGINAL SOURCE BY SANDY KRAMER, HUGHES STX, CODE 692 04/05/96 C MODIFIED OUTPUT FORMAT FOR UNIFORMITY ACROSS TELEMETRY MODES C SBK 02/23/2007 C CHARACTER DATAID*4,FLTID*4,COORD*2,MODE*4,TELEM*4 INTEGER*2 TIME(6),DELTA(6),CR6TIME(6),DATATYPE(2), & WORD30(2),WORD32(2) REAL*4 HDR(32),TIMEPD REAL*4 GAMMA(3,750),GAMMA2(3,375),SCF(3,750),AMBIENT(3,750), & PRIDAT(3,750),SECDAT(3,375),SCFDAT(3,750),AMBDAT(3,750) REAL*4 SPV(6),RANGE,ANG(2),PL(3), & HG(3,750),MTB(3,3),MTB5(3,3),MHG(3,3) REAL*8 TD,TN,TP C DATA ICALL/0/, DELTA/0,0,0,0,1,920/, CR6TIME/6*0/, TELEM/'CR-6'/ C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (DETOUT(1),HDR(1)), & (HDR(1),DATAID), (HDR(4),CR6TIME(1)), & (HDR(12),TIMEPD), (HDR(17),DATATYPE(1)), & (HDR(30),WORD30(1)), (HDR(32),WORD32(1)) C IUNIT = 84 RECWRITE = RECWRITE + 1 ICALL = ICALL + 1 IF ( SYS2(7) ) THEN COORD = 'HG' ELSE COORD = 'PL' END IF C C CHECK FOR CONFLICTING PROCESSING FLAGS C IF ( SYS2(4).AND..NOT.SYS2(5) ) THEN MODE = 'SNGL' LEN = 3407 ELSE IF ( SYS2(5).AND..NOT.SYS2(4) ) THEN MODE = 'DUAL' LEN = 4532 ELSE WRITE(6,*) WRITE(6,*) & '*CR6DET* CONFLICTING DETAIL PROCESSING FLAGS' STOP END IF C IF ( SYS2(6).AND.ICALL.EQ.1 ) THEN C C FORTRAN OUTPUT UNIT ASSIGNED TO FILE NAME IN VMS DCL ROUTINE CALLING C THE VOYPROD EXECUTABLE ex. $ ASSIGN FILE.DAT FOR084 C OPEN(IUNIT,STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST',RECL=124) END IF C IF ( SCID.EQ.0 ) THEN FLTID = "FLT2" ELSE IF ( SCID.EQ.1 ) THEN FLTID = "FLT1" ELSE FLTID = "FLT?" END IF C IF ( SYS2(4) ) THEN WORD30(1) = 200 WORD30(2) = 50 WORD32(2) = 750 ELSE IF ( SYS2(5) ) THEN WORD30(1) = 200 WORD30(2) = 200 WORD32(2) = 1200 END IF C DATAID = 'LFM ' TIMEPD = 1440.0 DATATYPE(1) = 1 WORD32(1) = RECWRITE CR6TIME(1) = TIME(1) CR6TIME(2) = TIME(2) CR6TIME(3) = TIME(3) CR6TIME(4) = TIME(4) CR6TIME(5) = TIME(5) CR6TIME(6) = TIME(6) C IF ( SYS2(4) ) THEN WORD30(1) = 750 WORD30(2) = 375 WORD32(2) = 3375 ELSE IF ( SYS2(5) ) THEN WORD30(1) = 750 WORD30(2) = 750 WORD32(2) = 4500 END IF C C REASSIGN DETAIL VALUES TO LOCAL VARIABLES C DO I = 1,750 C C SECONDARY MAG SAMPLE COUNTER (1-375) C ISEC = (I-1)/2 + 1 C PRIDAT(1,I) = GAMMA(1,I) PRIDAT(2,I) = GAMMA(2,I) PRIDAT(3,I) = GAMMA(3,I) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,2).EQ.0 ) THEN SECDAT(1,ISEC) = GAMMA2(1,ISEC) SECDAT(2,ISEC) = GAMMA2(2,ISEC) SECDAT(3,ISEC) = GAMMA2(3,ISEC) END IF C AMBDAT(1,I) = AMBIENT(1,I) AMBDAT(2,I) = AMBIENT(2,I) AMBDAT(3,I) = AMBIENT(3,I) C SCFDAT(1,I) = SCF(1,I) SCFDAT(2,I) = SCF(2,I) SCFDAT(3,I) = SCF(3,I) C END DO C IF ( SYS2(7) ) THEN C C GET SEDR DATA C CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) C IF ( SYS2(4) ) THEN C C ROTATE PRIMARY AND SECONDARY DATA INTO HG COORDINATES C CALL ROTATE(HG,PRIDAT,MHG,750,BAD) DO II = 1,750 PRIDAT(1,II) = HG(1,II) PRIDAT(2,II) = HG(2,II) PRIDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SECDAT,MHG,375,BAD) DO II = 1,375 SECDAT(1,II) = HG(1,II) SECDAT(2,II) = HG(2,II) SECDAT(3,II) = HG(3,II) END DO C ELSE IF ( SYS2(5) ) THEN C C ROTATE AMBIENT AND SPACECRAFT FIELD DATA INTO HG COORDINATES C CALL ROTATE(HG,AMBDAT,MHG,750,BAD) DO II = 1,750 AMBDAT(1,II) = HG(1,II) AMBDAT(2,II) = HG(2,II) AMBDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SCFDAT,MHG,750,BAD) DO II = 1,750 SCFDAT(1,II) = HG(1,II) SCFDAT(2,II) = HG(2,II) SCFDAT(3,II) = HG(3,II) END DO C END IF C END IF C DO I = 1,750 C C SECONDARY MAG SAMPLE COUNTER (1-375) C ISEC = (I-1)/2 + 1 C IF ( SYS2(4) ) THEN C C OUTPUT PRIMARY FIELD X,Y,Z FOLLOWED BY SECONDARY FIELD X,Y,Z C DETOUT(32+I) = PRIDAT(1,I) DETOUT(32+750+I) = PRIDAT(2,I) DETOUT(32+1500+I) = PRIDAT(3,I) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,2).EQ.0 ) THEN DETOUT(32+2250+ISEC) = SECDAT(1,ISEC) DETOUT(32+2625+ISEC) = SECDAT(2,ISEC) DETOUT(32+3000+ISEC) = SECDAT(3,ISEC) END IF C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR6TIME,RANGE,ANG(2), & ANG(1),(PRIDAT(J,I),J=1,3),(SECDAT(J,ISEC),J=1,3) END IF C ELSE IF ( SYS2(5) ) THEN C C OUTPUT AMBIENT FIELD X,Y,Z FOLLOWED BY SPACECRAFT FIELD X,Y,Z C DETOUT(32+I) = AMBDAT(1,I) DETOUT(32+750+I) = AMBDAT(2,I) DETOUT(32+1500+I) = AMBDAT(3,I) C DETOUT(32+2250+I) = SCFDAT(1,I) DETOUT(32+3000+I) = SCFDAT(2,I) DETOUT(32+3750+I) = SCFDAT(3,I) C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,CR6TIME,RANGE,ANG(2), & ANG(1),(AMBDAT(J,I),J=1,3),(SCFDAT(J,I),J=1,3) END IF C END IF C CALL INC_TIME(CR6TIME,DELTA) C END DO C C WRITE BINARY DETAIL DATA C WRITE(66) (DETOUT(I),I=1,LEN) C RETURN 800 FORMAT(2(A4,1X),A2,1X,A4,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,F8.4, & 2(1X,F8.3),6(1X,F9.3)) END SUBROUTINE CR6FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C USING 1440 SECOND CR-6 EDR RECORD, INTERPOLATE SECONDARY MAG C DATA (3.84 SEC) POINTS TO PRIMARY MAG DATA RATE (1.92 SEC) C TO COMPUTE SPACECRAFT AND AMBIENT FIELDS. C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 - 03/21/96 C INTEGER*2 TIME(6) REAL*4 GAMMA(3,750),GAMMA2(3,375),SCF(3,750),AMBIENT(3,750) C C IMPLEMENT SPACECRAFT FIELD COUPLING COEFFICIENT, ALPHA, C IN COMPUTATION OF S/C FIELD C C COEF = ALPHA/(1.0-ALPHA) WHERE ALPHA = .1876 C = 0.230921 C DATA ALPHA/0.1876/,COEF/0.230921/ C INCLUDE 'UNPACK.INC' C DO I=1,750 C C STEP INTERPOLATE 3.84 SECOND CR-6 SECONDARY MAG DATA TO 1.92 SECOND C PRIMARY MAG RATE C ISEC = (I-1)/2 + 1 DO J = 1,3 C C COMPUTER DIFFERENCE BETWEEN PRIMARY AND SECONDARY MAGNETOMETERS C IF (GAMMA(J,I).NE.BAD.AND. & GAMMA2(J,ISEC).NE.BAD) THEN SCF(J,I) = (GAMMA2(J,ISEC)-GAMMA(J,I))*COEF ELSE SCF(J,I) = BAD END IF C C COMPUTE AMBIENT FIELD FOR RETURN AT PRIMARY MODE RATE C IF (GAMMA(J,I).NE.BAD.AND.SCF(J,I).NE.BAD) THEN AMBIENT(J,I) = GAMMA(J,I) - SCF(J,I) ELSE AMBIENT(J,I) = BAD END IF C END DO C END DO C RETURN END ****************************************************************** * * TITLE: CONVERT RECONSTRUCTED DIGITAL VALUES INTO GAMMAS * * FILE NAME: CR6LFM.FOR * * PURPOSE: TO CONVERT DIGITAL CR-6 MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 03/21/96 ORIGINAL CODE * (MODE CR-6) * * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * CR-6 FORMAT LACKS MAG STATUS 2 WORDS. ONLY INSTRUMENT * RANGE AND MODE AVAILABLE. * * PDL: * * CALL COMMAND AND STATUS WORD EXTRACTION ROUTINE * CALL DELTA MODULATION RECONSTRUCT ROUTINES * CALL COUNTS TO GAMMAS CONVERSION ROUTINE * CALL SENSOR ALIGNMENT ROUTINE * CALL BOOM ALIGNMENT ROUTINE * * RETURN * ****************************************************************** SUBROUTINE CR6LFM(GAMMA,GAMMA2,BAD,TIME) C C CR-6 MASTER ROUTINE TO PRODUCE GAMMAS FOR BIGAVE C INTEGER*2 TIME(6) LOGICAL*1 SROTATE,BROTATE,INBOARD REAL*4 GAMMA(3,750),GAMMA2(3,375) C INCLUDE 'UNPACK.INC' C DATA SROTATE/.TRUE./, & BROTATE/.TRUE./, & ICALL/0/ C ICALL = ICALL + 1 C C SENSOR ROTATION SWITCH C IF ( SYS2(13) ) SROTATE = .FALSE. C C BOOM ALIGNMENT ROTATION SWITCH C IF ( SYS2(23) ) BROTATE = .FALSE. C C EXTRACT INSTRUMENT STATUS FROM STAT WORDS C CALL MAGSTATUS(TIME,10,0) C C NO MAG STATUS 2 WORDS AVAILABLE IN CR-6 C IF ( SYS2(24) ) THEN INBOARD = .TRUE. ELSE INBOARD = .FALSE. END IF C C RECOVER 12 BIT PREDICTED WORDS C CALL DELTA(PDELTA,750,PREF,25,PREC) CALL DELTA(SDELTA,375,SREF,25,SREC) C C ADJUST LEVEL OF RECONSTRUCTED PREDICT WORDS C CALL SHIVOT(PREF,25,PREC,750,SYS2(8)) CALL SHIVOT(SREF,25,SREC,375,SYS2(8)) C C CONVERT COUNTS INTO GAMMAS (MODE SENSITIVE) C CALL MAKEGAMMAS(GAMMA,750,GAMMA2,375,10,0,BAD,TIME) C C ORTHOGONALIZE DATA WITH SENSOR MATRIX AFTER GAMMAS (MODE SENSITIVE) C IF ( SROTATE ) CALL SENSOR_ALIGN(GAMMA,GAMMA2,750,375,0,BAD) C C ROTATE DATA WITH BOOM ALIGNMENT MATRIX AFTER GAMMAS (MODE SENSITIVE) C IF ( BROTATE ) CALL BOOM_ALIGN(GAMMA,GAMMA2,750,375,0,BAD) C RETURN END SUBROUTINE CR6PNS(PRI,GAMMA2,TIME,BAD) C C USING 24 MINUTE CR-6 EDR RECORD, INTERPOLATE SECONDARY MAG DETAIL (3.84 SEC) C DATA POINTS TO PRIMARY MAG DETAIL RATE (1.92 SEC). C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 03/22/96 C INTEGER*2 TIME(6) C REAL*4 PRI(3,750),GAMMA2(3,375),SEC(3,750) C INCLUDE 'UNPACK.INC' C DO I=1,750 C C STEP INTERPOLATE 3.84 SECOND CR-6 SECONDARY MAG DATA C ISEC = (I-1)/2 + 1 SEC(1,I) = GAMMA2(1,ISEC) SEC(2,I) = GAMMA2(2,ISEC) SEC(3,I) = GAMMA2(3,ISEC) C END DO C C CALL CR-6 AVERAGING ROUTINES C CALL CR6PRI(PRI,SEC,TIME,BAD) C RETURN END SUBROUTINE CR6PRI(GAMMA,SCF,TIME,BAD) C C USING 24 MINUTE EDR RECORD, PRODUCE 48 SECOND BLOCKS OF 1.92 SEC C AVERAGES FROM PRIMARY MAG (1.92 SEC) DATA POINTS. C C ORIGINAL CODE WRITTEN 03/21/96 BY SANDY KRAMER, HUGHES STX, CODE 692. C CHARACTER RECTYPE*4,TELFMT*4,FLTID*4 C INTEGER*2 TIME(6),DELTA(6),EDRTIME(6),LAUNCH(6), & WORD13(2),WORD30(2),WORD31(2),WORD32(2) C INTEGER*4 IB192(25) C REAL*4 SCF(3,750),GAMMA(3,750),FMOD(750),DEL(750),LAM(750), & B192(3,25),DEL192(25),LAM192(25),FMOD192(25), & FMAG192(25),RMS192(3,25),X192(25),Y192(25),Z192(25) C REAL*4 HDR(32),DATA(341) C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (SUMOUT(33),DATA(1)), & (HDR(13),WORD13(1)), (HDR(30),WORD30(1)), & (HDR(31),WORD31(1)) C EQUIVALENCE (DATA(67),FMAG192(1)), (DATA(92),FMOD192(1)), & (DATA(117),DEL192(1)), (DATA(142),LAM192(1)), & (DATA(242),RMS192(1,1)),(DATA(317),IB192(1)) C C 48 SECOND TIME TAG INCREMENT ARRAY C DELTA(1) = 0 DELTA(2) = 0 DELTA(3) = 0 DELTA(4) = 0 DELTA(5) = 48 DELTA(6) = 0 C C CREATE 30 48 SECOND SUMMARY BLOCKS FROM 1440 SECOND CR-6 RECORD C DO K = 1,30 ! 48 SECOND BLOCK COUNTER (30*48=1440 SEC) C C COMPUTE 25 1.92 SECOND AVERAGES FOR ONE 48 SECOND PERIOD C DO J = 1,25 ! 1.92 SECOND AVERAGE COUNTER (25*1.92=48 SEC) C C 25 PRIMARY GAMMAS PER 48 SECOND PERIOD THEREFORE C 1 PRIMARY GAMMA PER 1.92 SECOND AVERAGE C I = (K-1)*25 + J C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(GAMMA(1,I),1,FMOD(I),DEL(I),LAM(I),BAD) C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(GAMMA(1,I),FMOD(I),1,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C WORD30(1) = 150 WORD30(2) = 75 WORD31(1) = 5 WORD31(2) = 5 C C COMPUTE 48 SECOND AVERAGE OF THE SPACECRAFT FIELD C KREC = (K-1)*25 + 1 CALL CR6SCF(SCF(1,KREC),TIME,BAD) C C COMPUTE 9.6 SECOND AVERAGES AND 48 SECOND AVERAGES C CALL BIGAVE(B192,TIME,BAD) C C INCREMENT CR-6 RECORD BLOCK TIME BY 48 SECONDS C CALL INC_TIME(TIME,DELTA) C C INCREMENT 48 SECOND COUNTER C WORD13(2) = WORD13(2) + 1 C END DO C RETURN END SUBROUTINE CR6SCF(SCF,TIME,BAD) C C COMPUTE 48 SECOND AVERAGED SPACECRAFT FIELD FOR CR-6 RECORD C C INPUT 48 SECONDS OF DETAIL SPACECRAFT FIELD - SCF C OUTPUT RMS(SCF)(1,2,3), #DETAIL PTS, SCF(1,2,3), NORM(SCF(1,2,3) C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX - 03/21/96 C INTEGER*2 TIME(6) INTEGER*4 IB192(25),IB96(5),IB48 C REAL*4 SCF(3,25),FMOD(25),DEL(25),LAM(25),SCFLD(155), & FMAG192(25),FMOD192(25),DEL192(25), & LAM192(25),B192(3,25),RMS192(3,25), & X192(25),Y192(25),Z192(25), & XRMS192(25),YRMS192(25),ZRMS192(25), & FMAG96(5),FMOD96(5),DEL96(5), & LAM96(5),B96(3,5),RMS96(3,5), & X96(5),Y96(5),Z96(5), & XRMS96(5),YRMS96(5),ZRMS96(5), & FMAG48,FMOD48,DEL48, & LAM48,B48(3),RMS48(3), & X48,Y48,Z48,HG(3,25), & SPV(6),RANGE,ANG(2), & MTB(3,3),MTB5(3,3),MHG(3,3) C REAL*8 TD,TN,TP C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(342),SCFLD(1)) C EQUIVALENCE (SCFLD(148),RMS48(1)), (SCFLD(151),IB48), & (SCFLD(152),X48), (SCFLD(153),Y48), & (SCFLD(154),Z48), (SCFLD(155),FMOD48) C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(SCF,25,FMOD,DEL,LAM,BAD) C C COMPUTE 25 1.92 SECOND AVERAGES FOR 48 SECOND PERIOD C DO J = 1,25 C C 25 PRIMARY GAMMAS PER 48 SECOND PERIOD THEREFORE C 1 PRIMARY GAMMA PER 1.92 SECOND AVERAGE C I = J C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(SCF(1,I),FMOD(I),1,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C C ROTATE 1.92 SECOND AVERAGES C IF ( .NOT.SYS2(9) ) THEN CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) CALL ROTATE(HG,B192,MHG,25,BAD) DO I192 = 1,25 B192(1,I192) = HG(1,I192) B192(2,I192) = HG(2,I192) B192(3,I192) = HG(3,I192) END DO END IF C C GENERIC AVERAGING ROUTINE TO COMPUTE 9.6 AND 48 SECOND AVERAGES C DO I = 1,25,5 C C COMPUTE 1.92 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B192(1,I),5,FMOD192(I),DEL192(I),LAM192(I),BAD) C J = (I-1)/5 + 1 C C COMPUTE 9.6 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B192(1,I),FMOD192(I),5,B96(1,J),FMAG96(J),RMS96(1,J), & IB96(J),BAD) C END DO C C COMPUTE 9.6 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B96,5,FMOD96,DEL96,LAM96,BAD) C C COMPUTE 48 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B96,FMOD96,5,B48,FMAG48,RMS48,IB48,BAD) C C COMPUTE 48 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B48,1,FMOD48,DEL48,LAM48,BAD) C C SEPARATE FIELD AND RMS COMPONENT VECTORS FROM MATRICES C DO I96 = 1,5 X96(I96) = B96(1,I96) Y96(I96) = B96(2,I96) Z96(I96) = B96(3,I96) XRMS96(I96) = RMS96(1,I96) YRMS96(I96) = RMS96(2,I96) ZRMS96(I96) = RMS96(3,I96) DO J = 1,5 I192 = (I96-1)*5 + J X192(I192) = B192(1,I192) Y192(I192) = B192(2,I192) Z192(I192) = B192(3,I192) XRMS192(I192) = RMS192(1,I192) YRMS192(I192) = RMS192(2,I192) ZRMS192(I192) = RMS192(3,I192) END DO END DO X48 = B48(1) Y48 = B48(2) Z48 = B48(3) C RETURN END SUBROUTINE CR6SEC(GAMMA2,SCF,TIME,BAD) C C USING 24 MINUTE (1440 SECONDS) CR-6 EDR RECORD, INTERPOLATE SECONDARY MAG C DATA (3.84 SEC) TO PRIMARY MAG RATE (1.92 SEC). C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX CODE 692 - 03/21/96 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,750),GAMMA2(3,375),SCF(3,750) C INCLUDE 'UNPACK.INC' C DO I=1,750 C C STEP INTERPOLATE 3.84 SECOND CR-6 SECONDARY MAG DATA TO 1.92 SECOND C PRIMARY MAG RATE. C ISEC = (I-1)/2 + 1 GAMMA(1,I) = GAMMA2(1,ISEC) GAMMA(2,I) = GAMMA2(2,ISEC) GAMMA(3,I) = GAMMA2(3,ISEC) C END DO C C CALL CR-6 AVERAGING ROUTINES C CALL CR6PRI(GAMMA,SCF,TIME,BAD) C RETURN END REAL*8 FUNCTION DAYS(IYR) C C COMPUTE NUMBER OF DAYS IN YR (IYR). C DAYS = 365.0D0 IF (MOD(IYR,4).NE.0) DAYS = 366.0D0 C RETURN END SUBROUTINE DECOMM(DEC) C C EXTRACT DECOMMUTATION MAP WORDS C LOGICAL*1 DEC(448),BYTE(4) C INCLUDE 'UNPACK.INC' C C EXTRACT 16 BIT DECOMM MAP WORD FROM 32 BIT IBM DATA WORD C C 10987654321098765432109876543210 BIT ORDER C ______________________________ C | || | IBM 32 BIT DATA WORD C | MAP WORD(X) || MAP WORD(X+1)| CONTENTS C | || | C ------------------------------ C C READ PAIR OF 16 BIT WORDS FROM EACH 32 BIT IBM DATA WORD C SWAP BYTES FOR PROPER INTERPRETATION UNDER DEC ARCHITECTURE C C 112 32 BIT WORD DECOMMUTATION MAP DATA BLOCK CONTAINS 223 16 BIT C MAP WORDS AND 1 SPARE 16 BIT WORD C DO I = 1,112 C BIT OFFSET OF LSB IN DATA WORD I J = (I-1)*32 C MAP WORD COUNT K = (I-1)*2 C MOVE MAP WORD DATA INTO 2 BYTE INTEGER VARIABLES MAP(K+1) = 0 MAP(K+2) = 0 CALL MOVBIT(DEC, J, 8, MAP(K+1), 8) CALL MOVBIT(DEC, J+8, 8, MAP(K+1), 0) CALL MOVBIT(DEC, J+16, 8, MAP(K+2), 8) CALL MOVBIT(DEC, J+24, 8, MAP(K+2), 0) END DO C C DO I = 1,224,8 C WRITE(6,800) I,(MAP(I+J),J=0,7) C END DO C 800 FORMAT(1X,I3,2X,8(1X,I3)) C RETURN END REAL*8 FUNCTION DECYR(TIME) C C CONVERT INTEGER TIME VALUES INTO DECIMAL YEAR C INTEGER*2 TIME(6) REAL*8 DYEAR,DDAY,DHOUR,DMIN,DSEC,LEAP,DAYS C IYR = TIME(1) IDY = TIME(2) IHR = TIME(3) MIN = TIME(4) ISEC = TIME(5) MSEC = TIME(6) C LEAP = DAYS(IYR) DSEC = DBLE(ISEC) + DBLE(MSEC)/1000.0D0 DMIN = DBLE(MIN) + DSEC/60.0D0 DHOUR = DBLE(IHR) + DMIN/60.0D0 DDAY = DBLE(IDY) - 1.0D0 + DHOUR/24.0D0 DYEAR = DBLE(IYR) + DDAY/LEAP DECYR = DYEAR C RETURN END SUBROUTINE DELTA(DM,NDM,REF,NREF,REC) C This routine reconstructs 12 bit predicted words from 2 bit delta C modulated words. Predicted words must be processed by shift and pivot C routines to fully recover 12 bit full words that have been delta C modulated. See JPL Voyager software document FP35-14-4 for delta C reconstruction algorithm. C Written by Sandy Kramer, HSTX, Code 692, NASA GSFC C Original code - 02/16/96 C Debugged and verified - 05/03/96 INTEGER*2 DM(3,NDM),REC(3,NDM),REF(3,NREF) INTEGER*4 COMPARE,DMSTORE,DMSUM,DMW C Input Data: C DM 2 bit delta modulated word C NDM Number of delta modulated words C REF Reference words C NREF Number of reference words C Output Data: C REC Reconstructed predict words C Local Variables: C COMPARE Previous DM's MSB C DMSTORE Reconstructed difference from previous predicted 12 bit word C DMSUM Predicted 12 bit word C IRES Ratio of DM words to reference words C LSB Least significant bit of DM C MSB Most significant bit of DM IF ( MOD(NDM,NREF).NE.0 ) THEN WRITE(6,'(1X,''*DELTA* INVALID DM/REF RATIO!'')') STOP END IF IRES = NDM/NREF DO IAX = 1,3 C Set initial values COMPARE = 1 DMSTORE = 1 DMSUM = 2048 DO IDM = 1,NDM C Skip missing minor frames IREF = (IDM-1)/IRES + 1 IF ( REF(IAX,IREF).LE.0 ) THEN COMPARE = 1 ! reinitialize DMSTORE = 1 ! reinitialize DMSUM = 2048 ! reinitialize GO TO 100 END IF DMW = DM(IAX,IDM) MSB = 0 LSB = 0 CALL MOVBIT(DMW, 1, 1, MSB, 0) CALL MOVBIT(DMW, 0, 1, LSB, 0) DO ISTEP = 1,2 IF ( ISTEP.EQ.1 ) THEN ! process MSB of 2 bit DM word (step 1) IF ( MSB.EQ.COMPARE ) THEN ! present compare = previous compare DMSTORE = ABS(DMSTORE) * 2 IF ( DMSTORE.GT.64 ) DMSTORE = 64 ELSE ! present compare <> previous compare DMSTORE = ABS(DMSTORE) / 2 IF ( DMSTORE.LT.2 ) DMSTORE = 2 END IF IF ( MSB.NE.0 ) DMSTORE = -DMSTORE ! sign rule COMPARE = MSB ! save current DM's MSB ELSE ! process LSB of 2 bit DM word (step 2) IF ( LSB.NE.MSB ) DMSTORE = - DMSTORE / 2 END IF DMSUM = DMSUM + DMSTORE ! add DMSTORE to accumulating sum END DO REC(IAX,IDM) = DMSUM 100 END DO END DO RETURN END subroutine difference(diff,ndiff,ref,nref,rec) c This subroutine reconstructs 12 bit full words from 6 bit difference words. c Reconstruction of a series of difference words is verified against the c reference word occurring in parallel with the last difference of the series. c The last series of reconstructed full words can not be verified without c knowledge of the first reference and difference words from the immediate c following record. This routine currently does not have this information. c The last series of reconstructed words are not verified against a c reference word. c Data and variable definitions: c Input data: c diff difference word (fill = 255) c ndiff number of difference words c ref reference words (fill = 0) c nref number of reference words c Output data: c rec reconstructed full words (fill = 0) c Local variables: c iratio number of difference words per reference word c err reconstruction error flag c ALGORITHM: c Given N = nref, M = ndiff and n = M/N ... c RECONSTRUCTION: x(1) = R(1), x(j) = x(j-1) + D(j), j=2,M c VERIFICATION: R(k) = R(k-1) + SUM(D(j+(k-2)*n)), where j=2,n+1 and k=2,N c Example: R(2) = R(1) + ( D(2) + D(3) + ... + D(n) + D(n+1) ) c REF R R R c 1 2 ... N=nref c | | | c REC x x x x x x x x x x x x x x x x x x x x ... x x x x x x x x x x c 1 2 3 . . . . . . . . . . . . . . . . . . . . . . . . . . . . M=ndiff c c DIFF D D D D D D D D D D D D D D D D D D D D ... D D D D D D D D D D c 1 2 3 . . . . . . n n c + c 1 c Generic differencing routine to replace mode specific routines c written by Sandy Kramer, code 692, 12/11/96 integer*2 diff(3,ndiff),rec(3,ndiff),ref(3,nref) logical*1 err(3,nref) iratio = ndiff/nref do iax = 1,3 c first reconstructed word is equal to first reference word iref = 1 rec(iax,1) = ref(iax,1) err(iax,1) = .false. do i = 2,ndiff c flag bad data if ( diff(iax,i).eq.255 .or. ref(iax,iref).eq.0 ) then err(iax,iref) = .true. end if c accumulate sums to reconstruct full words rec(iax,i) = rec(iax,i-1) + diff(iax,i) c verify reconstruction if ( mod(i-1,iratio).eq.0 ) then iref = iref + 1 err(iax,iref) = .false. if ( rec(iax,i).ne.ref(iax,iref) ) then if ( ref(iax,iref).ne.0 ) err(iax,iref-1) = .true. rec(iax,i) = ref(iax,iref) end if end if end do c remove error flagged reconstructed words do i = 1,ndiff iref = (i-1)/iratio + 1 if ( err(iax,iref) ) rec(iax,i) = 0 c if ( iax.eq.3 ) then c write(6,800) iref,ref(1,iref),ref(2,iref),ref(3,iref), c & i,diff(1,i),diff(2,i),diff(3,i) c & i,rec(1,i),rec(2,i),rec(3,i), c end if end do end do return 800 format(12(1x,i5)) end SUBROUTINE DISPLAY(RECLEN,NCNT,TFLAG,TIME) C C DISPLAY KEY VALUES FROM UNPACKED EDR C 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) C RETURN 900 FORMAT(1X,I5,1X,I4,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 ELPSTIME(START,TIME,DAYS) C C THIS ROUTINE COMPUTES A POSITIVE ELAPSED TIME BETWEEN TWO INTEGER C ARRAYED TIME VALUES WHERE: C C TIME ELEMENT 1 = YEAR C TIME ELEMENT 2 = DAY C TIME ELEMENT 3 = HOUR C TIME ELEMENT 4 = MINUTE C TIME ELEMENT 5 = SECOND C TIME ELEMENT 6 = MILLISECOND C INTEGER*2 START(6),TIME(6) REAL*8 DAYS,REALTIME C C TEST FOR PROPER INPUT. 2 DIGIT YEAR EXPECTED (LESS THAN 77 ASSUMED 21ST C CENTURY) C IF ((MOD(START(1),4).EQ.0.AND. & START(2).GT.366).OR. & (MOD(START(1),4).NE.0.AND. & START(2).GT.365).OR. & START(1).GT.99.OR. & START(3).GT.23.OR. & START(4).GT.59.OR. & START(5).GT.59.OR. & START(6).GT.999.OR. & START(1).LT.0.OR. & START(2).LT.1.OR. & START(3).LT.0.OR. & START(4).LT.0.OR. & START(5).LT.0.OR. & START(6).LT.0) THEN WRITE(6,'(1X,''*ELPSTIME* INVALID START TIME: '', & I2,''-'',I3.3,''/'',I2.2,'':'',I2.2,'':'', & I2.2,''.'',I3.3)') START DAYS = -1.0D0 RETURN END IF C IF ((MOD(TIME(1),4).EQ.0.AND. & TIME(2).GT.366).OR. & (MOD(TIME(1),4).NE.0.AND. & TIME(2).GT.365).OR. & TIME(1).GT.99.OR. & TIME(3).GT.23.OR. & TIME(4).GT.59.OR. & TIME(5).GT.59.OR. & TIME(6).GT.999.OR. & TIME(1).LT.0.OR. & TIME(2).LT.1.OR. & TIME(3).LT.0.OR. & TIME(4).LT.0.OR. & TIME(5).LT.0.OR. & TIME(6).LT.0) THEN WRITE(6,'(1X,''*ELPSTIME* INVALID CURRENT TIME: '', & I2,''-'',I3.3,''/'',I2.2,'':'',I2.2,'':'', & I2.2,''.'',I3.3)') TIME DAYS = -1.0D0 RETURN END IF C DAYS = DBLE(START(2)) + & DBLE(START(3))/24.0D0 + & DBLE(START(4))/24.0D0/60.0D0 + & DBLE(START(5))/24.0D0/60.0D0/60.0D0 + & DBLE(START(6))/24.0D0/60.0D0/60.0D0/1000.0D0 DAYS = - DAYS C C CONVERT YEARS DIFFERENCE INTO DECIMAL DAYS C IF (TIME(1).LT.77) THEN ICENT = 100 ELSE ICENT = 0 END IF C DO I = START(1), TIME(1) - 1 + ICENT C IF (MOD(I,4).EQ.0) THEN DAYS = DAYS + 366.0D0 ELSE DAYS = DAYS + 365.0D0 END IF C END DO C C ADD DECIMAL DAYS OF CURRENT YEAR TO SUM C DAYS = DAYS + & DBLE(TIME(2)) + & DBLE(TIME(3))/24.0D0 + & DBLE(TIME(4))/24.0D0/60.0D0 + & DBLE(TIME(5))/24.0D0/60.0D0/60.0D0 + & DBLE(TIME(6))/24.0D0/60.0D0/60.0D0/1000.0D0 C RETURN END SUBROUTINE ENGOUT(ENG) C C READ 60 MINOR FRAMES OF ENGINEERING DATA. EACH MINOR FRAME CONTAINS 60 C ENGINEERING WORDS REPRESENTING COMMUTATOR POSITIONS 100 THROUGH 159. C THE 60 COMMUTATOR POSITIONS ARE MAPPED TO 223 DECK WORDS. COMMUTATOR C WORDS 116, 120, 125, 130, 146, 150 AND 156 ARE MAPPED TO SPECIFIC DECK C WORDS ACCORDING TO ENGINEERING MINOR FRAME COUNT. ONCE ENGINEERING WORDS C ARE MAPPED TO CORRESPONDING DECK WORDS, THE DECOMMUTATION MAP PROVIDES C IDENTIFICATION OF A PARTICULAR ENGINEERING WORD. C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, CODE 692, 06/09/94 C ENHANCED TO MAP ENGINEERING DATA - SBK 05/13/96 C ADD ASCII OUTPUT OF MAG E CHANNELS SBK 12/7/2006 C C VARIABLES: C C TABLE - A TABLE OF 223 DECK NUMBERS MAPPED TO THE 60 C WORDS OF EACH ENGINEERING DATA MINOR FRAME C C MAP - DECOMMUTATION MAP, 223 E-NUMS TO BE MAPPED INTO C 223 DECK NUMBERS FOUND IN ARRAY "TABLE" EXTRACTED C FROM ENGINEERING RECORD BY ROUTINE DECOMM C C COM116 - CONTAINS FIRST HALF OF THE 300 DECK. 30 DECK C NUMBERS REPEATED ONCE TO YIELD 60 DECK NUMBERS, C ONE FOR EACH OF THE 60 MINOR FRAMES OF ENGINEERING C DATA C C COM120 - CONTAINS THE A00 DECK. 15 DECK NUMBERS REPEATED C THREE TIMES TO YIELD 60 DECK NUMBERS, ONE FOR EACH C OF THE 60 MINOR FRAMES OF ENGINEERING DATA C C COM125 - CONTAINS FIRST HALF OF THE 200 DECK. 10 DECK NUMBERS C REPEATED FIVE TIMES TO YIELD 60 DECK NUMBERS, ONE FOR C EACH OF THE 60 MINOR FRAMES OF ENGINEERING DATA C C COM130 - CONTAINS 400 DECK. 60 DECK NUMBERS, ONE FOR EACH C OF THE 60 MINOR FRAMES OF ENGINEERING DATA C C COM146 - CONTAINS SECOND HALF OF THE 300 DECK. 30 DECK C NUMBERS REPEATED ONCE TO YIELD 60 DECK NUMBERS, C ONE FOR EACH OF THE 60 MINOR FRAMES OF ENGINEERING C DATA C C COM150 - CONTAINS THE B00 DECK. 15 DECK NUMBERS REPEATED C THREE TIMES TO YIELD 60 DECK NUMBERS, ONE FOR EACH C OF THE 60 MINOR FRAMES OF ENGINEERING DATA C C COM155 - CONTAINS SECOND HALF OF THE 200 DECK. 10 DECK C NUMBERS REPEATED ONCE TO YIELD 60 DECK NUMBERS, C ONE FOR EACH OF THE 60 MINOR FRAMES OF ENGINEERING C DATA C C E NUMBERS: THE DATA CHANNELS CONTAINING INSTRUMENT AND SYSTEM DATA C EACH E NUMBER REPRESENTS THE VALUES OF A SPECIFIC COMPONENT C C 660 HOLDS VALUE OF E NUMS 665-672 DEPENDING UPON MOD60 AND C LINE COUNT EXTRACTED FROM FRAME IDENTIFICATION FIELD C 661 OB LFM TEMP C 662 IB LFM TEMP C 663 OB HFM TEMP C 664 IB HFM TEMP C 665 MAG INSTRUMENT SERIAL NUMBER C 666 +12 V DC VOLTAGE C 667 MAG INBOARD ELECTRONICS TEMP C 668 -12 V DC VOLTAGE C 669 MAG OUTBOARD ELECTRONICS TEMP C 670 A ADC REFERENCE VOLTAGE C 671 POWER CONVERTER TEMP C 672 B ADC REFERENCE VOLTAGE C CHARACTER DATAID*4 LOGICAL*1 ENG(3600),COM(60),EDAT(224,60),EVAL(0:720)/721*0/ INTEGER*2 DATATYPE(2),WORD32(2),LINECT,EMOD60,EMOD16, & DECK660,MAGMUX,EDRTIME(6) INTEGER*2 COM116(60),COM120(60),COM125(60),COM130(60), & COM146(60),COM150(60),COM155(60) C INTEGER*2 TABLE(223)/ 100,101,102,103,104,105,106,107,108,109,110, & 111,112,113,114,115,300,301,302,303,304,305,306,307,308,309,310, & 311,312,313,314,315,316,317,318,319,320,321,322,323,324,325,326, & 327,328,329,117,118,119,500,501,502,503,504,505,506,507,508,509, & 510,511,512,513,514,121,122,123,124,200,201,202,203,204,205,206, & 207,208,209,126,127,128,129,400,401,402,403,404,405,406,407,408, & 409,410,411,412,413,414,415,416,417,418,419,420,421,422,423,424, & 425,426,427,428,429,430,431,432,433,434,435,436,437,438,439,440, & 441,442,443,444,445,446,447,448,449,450,451,452,453,454,455,456, & 457,458,459,131,132,133,134,135,136,137,138,139,140,141,142,143, & 144,145,330,331,332,333,334,335,336,337,338,339,340,341,342,343, & 344,345,346,347,348,349,350,351,352,353,354,355,356,357,358,359, & 147,148,149,600,601,602,603,604,605,606,607,608,609,610,611,612, & 613,614,151,152,153,154,210,211,212,213,214,215,216,217,218,219, & 156,157,158,159/ C REAL*4 HDR(32) C EQUIVALENCE (SUMOUT, HDR(1)), (HDR(1), DATAID), & (HDR(12), TIMEPD), (HDR(17), DATATYPE(1)), & (HDR(32), WORD32(1) ), & (HDR(4), EDRTIME(1) ) C DATA COM116 & /300,301,302,303,304,305,306,307,308,309, & 310,311,312,313,314,315,316,317,318,319, & 320,321,322,323,324,325,326,327,328,329, & 300,301,302,303,304,305,306,307,308,309, & 310,311,312,313,314,315,316,317,318,319, & 320,321,322,323,324,325,326,327,328,329/ C C A00 DECK NUMBERS ALIASED AS 5XX C DATA COM120 & /500,501,502,503,504,505,506,507,508,509, & 510,511,512,513,514,500,501,502,503,504, & 505,506,507,508,509,510,511,512,513,514, & 500,501,502,503,504,505,506,507,508,509, & 510,511,512,513,514,500,501,502,503,504, & 505,506,507,508,509,510,511,512,513,514/ C DATA COM125 & /200,201,202,203,204,205,206,207,208,209, & 200,201,202,203,204,205,206,207,208,209, & 200,201,202,203,204,205,206,207,208,209, & 200,201,202,203,204,205,206,207,208,209, & 200,201,202,203,204,205,206,207,208,209, & 200,201,202,203,204,205,206,207,208,209/ C DATA COM130 & /400,401,402,403,404,405,406,407,408,409, & 410,411,412,413,414,415,416,417,418,419, & 420,421,422,423,424,425,426,427,428,429, & 430,431,432,433,434,435,436,437,438,439, & 440,441,442,443,444,445,446,447,448,449, & 450,451,452,453,454,455,456,457,458,459/ C DATA COM146 & /330,331,332,333,334,335,336,337,338,339, & 340,341,342,343,344,345,346,347,348,349, & 350,351,352,353,354,355,356,357,358,359, & 330,331,332,333,334,335,336,337,338,339, & 340,341,342,343,344,345,346,347,348,349, & 350,351,352,353,354,355,356,357,358,359/ C C B00 DECK NUMBERS ALIASES AS 6XX C DATA COM150 & /600,601,602,603,604,605,606,607,608,609, & 610,611,612,613,614,600,601,602,603,604, & 605,606,607,608,609,610,611,612,613,614, & 600,601,602,603,604,605,606,607,608,609, & 610,611,612,613,614,600,601,602,603,604, & 605,606,607,608,609,610,611,612,613,614/ C DATA COM155 & /210,211,212,213,214,215,216,217,218,219, & 210,211,212,213,214,215,216,217,218,219, & 210,211,212,213,214,215,216,217,218,219, & 210,211,212,213,214,215,216,217,218,219, & 210,211,212,213,214,215,216,217,218,219, & 210,211,212,213,214,215,216,217,218,219/ C DATA ICNT/0/ C INCLUDE 'UNPACK.INC' C ICNT = ICNT + 1 RECWRITE = RECWRITE + 1 DATAID = 'ENG ' TIMEPD = 0.0 DATATYPE(1) = 7 WORD32(1) = RECWRITE WORD32(2) = 3416 C IF ( ICNT.EQ.1 ) & OPEN(87,FILE='ENG.DAT',STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST') C C READ 60 MINOR FRAMES OF ENGINEERING DATA C DO J = 1,60 C C EXTRACT 8-BIT ENGINEERING DATA. FIRST EIGHT WORDS CORRESPOND TO MEASUREMENT C NUMBERS E-160 THROUGH E-167. E-160 THROUGH E-163 CONTAIN THE HEX FRAME C SYNCHRONIZATION CODE 03915ED3. C C READ 60 BYTES OF ENGINEERING MINOR FRAME C DO I = 1,60 C COM(I) = 0 K = (J-1)*480 + (I-1)*8 CALL MOVBIT(ENG, K, 8, COM(I), 0) L = I + 99 ! commuter number IF ( L.EQ.116 ) L = COM116(J) IF ( L.EQ.120 ) L = COM120(J) IF ( L.EQ.125 ) L = COM125(J) IF ( L.EQ.130 ) L = COM130(J) IF ( L.EQ.146 ) L = COM146(J) IF ( L.EQ.150 ) L = COM150(J) IF ( L.EQ.155 ) L = COM155(J) C C MAP ENGINEERING NUMBERS TO DECK NUMBERS C DO IMAP = 1,223 INDEX = TABLE(IMAP) ! get deck number IF ( L.EQ.INDEX ) THEN IF ( MAP(IMAP).EQ.660) DECK660 = L EVAL(MAP(IMAP)) = COM(I) ! save measurementS w/E-num indexing EDAT(IMAP,J) = COM(I) ! save measurements from each MF c write(87,888) imap,index,map(imap),com(i) 888 format(3(1x,i3.3),3x,z2.2) END IF END DO C END DO C if ( eval(160).eq.'03'x .and. & eval(161).eq.'91'x .and. & eval(162).eq.'5e'x .and. & eval(163).eq.'d3'x ) then linect = 0 emod60 = 0 emod16 = 0 call movbit(eval(165), 0, 8, emod16, 0) call movbit(eval(166), 2, 6, emod60, 0) call movbit(eval(166), 0, 2, linect, 8) call movbit(eval(167), 0, 8, linect, 0) write(87,'(1x,I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & 8(1x,z2.2),9(1x,i3.3))') (edrtime(mm),mm=1,6), & (eval(n),n=160,167),emod60,linect, & deck660,magmux(deck660,emod60,linect), & (zext(eval(nn)),nn=660,664) end if C END DO C C output 14016 byte record (3504 words) C WRITE(66) HDR, MAP, EDAT C RETURN END INTEGER*2 FUNCTION MAGMUX(DECK660,EMOD60,LINECT) C INTEGER*2 DECK660,EMOD60,LINECT C MAGPOS = -1 IF ( DECK660.EQ.334 ) THEN IF ( EMOD60.EQ.1 .AND. LINECT.EQ.1 ) THEN MAGPOS = 4 ELSE IF (EMOD60.EQ.8 .AND. LINECT.EQ.401 ) THEN MAGPOS = 2 ELSE IF (EMOD60.EQ.16 .AND. LINECT.EQ.1 ) THEN MAGPOS = 0 ELSE IF (EMOD60.EQ.23 .AND. LINECT.EQ.401 ) THEN MAGPOS = 6 ELSE IF (EMOD60.EQ.31 .AND. LINECT.EQ.1 ) THEN MAGPOS = 4 ELSE IF (EMOD60.EQ.38 .AND. LINECT.EQ.401 ) THEN MAGPOS = 2 ELSE IF (EMOD60.EQ.46 .AND. LINECT.EQ.1 ) THEN MAGPOS = 0 ELSE IF (EMOD60.EQ.53 .AND. LINECT.EQ.401 ) THEN MAGPOS = 6 ELSE WRITE(6,*) '*ENGOUT/MAGMUX* INVALID MOD60/LINECT VALUE', & EMOD60,LINECT END IF ELSE IF ( DECK660.EQ.202 ) THEN IF ( MOD(EMOD60,10).EQ.0 .AND. LINECT.EQ.401 ) THEN MAGPOS = 2 ELSE IF ( MOD(EMOD60+7,10).EQ.0 .AND. LINECT.EQ.1 ) THEN MAGPOS = 4 ELSE IF ( MOD(EMOD60+5,10).EQ.0 .AND. LINECT.EQ.401 ) THEN MAGPOS = 6 ELSE IF ( MOD(EMOD60+2,10).EQ.0 .AND. LINECT.EQ.1 ) THEN MAGPOS = 0 ELSE WRITE(6,*) '*ENGOUT/MAGMUX* INVALID MOD60/LINECT VALUE', & EMOD60,LINECT END IF ELSE IF ( (DECK660-100).LT.100 ) THEN IF ( MOD(EMOD60,2).EQ.0 .AND. LINECT.EQ.1 ) THEN MAGPOS = 0 ELSE IF ( MOD(EMOD60,2).EQ.0 .AND. LINECT.EQ.201 ) THEN MAGPOS = 1 ELSE IF ( MOD(EMOD60,2).EQ.0 .AND. LINECT.EQ.401 ) THEN MAGPOS = 2 ELSE IF ( MOD(EMOD60,2).EQ.0 .AND. LINECT.EQ.601 ) THEN MAGPOS = 3 ELSE IF ( LINECT.EQ.1 ) THEN MAGPOS = 4 ELSE IF ( LINECT.EQ.201 ) THEN MAGPOS = 5 ELSE IF ( LINECT.EQ.401 ) THEN MAGPOS = 6 ELSE IF ( LINECT.EQ.601 ) THEN MAGPOS = 7 ELSE WRITE(6,*) '*ENGOUT/MAGMUX* INVALID MOD60/LINECT VALUE', & EMOD60,LINECT END IF ELSE WRITE(6,*) '*ENGOUT/MAGMUX* INVALID DECK NUMBER', DECK660 END IF C IF ( MAGPOS.EQ.0 ) THEN MAGMUX = 665 ELSE IF ( MAGPOS.EQ.1 ) THEN MAGMUX = 666 ELSE IF ( MAGPOS.EQ.2 ) THEN MAGMUX = 667 ELSE IF ( MAGPOS.EQ.3 ) THEN MAGMUX = 668 ELSE IF ( MAGPOS.EQ.4 ) THEN MAGMUX = 669 ELSE IF ( MAGPOS.EQ.5 ) THEN MAGMUX = 670 ELSE IF ( MAGPOS.EQ.6 ) THEN MAGMUX = 671 ELSE IF ( MAGPOS.EQ.7 ) THEN MAGMUX = 672 ELSE MAGMUX = 999 END IF C RETURN END SUBROUTINE EXTRACTDATE(TIME,PVRD) C C EXTRACT POINTING VECTOR RECORD TIME C INTEGER*2 TIME(6) CHARACTER PVRD*77 C READ(UNIT=PVRD,FMT=89) TIME C RETURN 89 FORMAT(I2,1X,I3,3(1X,I2),1X,I3) END CHARACTER*(*) FUNCTION FILENAME(DSN) C C EXTRACT FILENAME FROM FULLY QUALIFIED NAME OF STRUCTURE: C [DIRECTORY PATH]FILENAME.EXT C SBK 07/08/94 C CHARACTER DSN*(*) C C INITIALIZE FUNCTION VALUE C FILENAME = ' ' C C FIND END OF CHARACTER STRING C I = 1 DO WHILE ( DSN(I:I).NE.' ' ) I = I + 1 END DO LEN = I C C FIND FIRST CHARACTER OF FILE NAME C I = 1 DO WHILE ( DSN(I:I).NE.']' .AND. I.LT.LEN ) I = I + 1 END DO C IF ( I.LT.LEN ) THEN IBEG = I + 1 ELSE IBEG = 1 END IF C C FIND LAST CHARACTER OF FILE NAME C I = IBEG DO WHILE ( DSN(I:I).NE.'.' .AND. I.LT.LEN ) I = I + 1 END DO C IEND = I - 1 C FILENAME = DSN(IBEG:IEND) C RETURN END SUBROUTINE FLAGS() C C OUTPUT COMMAND FLAGS TO LOG FILE C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692, NASA GSFC C C CORRECT TO REFLECT PREVIOUS REPLACEMENT OF ONE WAY LIGHT CHECK WITH FORWARD C TIME PROGRESSION CHECK (FLAG 16). DESIGNATE FLAG 14 PROPERLY AS TIME C REGRESSION NOT PROGRESSION. SBK, 01/21/99 C C ADD FLAG 28: SUMMARY COMPOSITE MAG MODE (INTERPOLATED SEC X AND Z REPLACE C PRIMARY) 01/30/2006 - SBK C INCLUDE 'UNPACK.INC' C WRITE(68,*) WRITE(68,*) 'MAG PROCESSING CONTROL FLAGS' WRITE(68,*) WRITE(68,'(1X,''SYS2(1) '',L, & '' WRITE 1.92 SECOND AVERAGES'')') SYS2(1) WRITE(68,'(1X,''SYS2(2) '',L, & '' WRITE 48.0 SECOND AVERAGES'')') SYS2(2) WRITE(68,'(1X,''SYS2(3) '',L, & '' PROCESS ENGINEERING RECORDS'')') SYS2(3) WRITE(68,'(1X,''SYS2(4) '',L, & '' WRITE MAG DETAIL DATA PRI, SEC'')') SYS2(4) WRITE(68,'(1X,''SYS2(5) '',L, & '' WRITE MAG DETAIL DATA AMB, S/C FIELD'')') SYS2(5) WRITE(68,'(1X,''SYS2(6) '',L, & '' WRITE ASCII DETAIL DATA'')') SYS2(6) WRITE(68,'(1X,''SYS2(7) '',L, & '' ROTATE DETAIL DATA FROM PAYLOAD'')') SYS2(7) WRITE(68,'(1X,''SYS2(8) '',L, & '' ENABLE DELTA MODULATION RECONSTRUCTION'')') SYS2(8) WRITE(68,'(1X,''SYS2(9) '',L, & '' SUPPRESS COORDINATE SYSTEM ROTATION'')') SYS2(9) WRITE(68,'(1X,''SYS2(10)'',L, & '' SUPPRESS DATA PRESENCE CHECK'')') SYS2(10) WRITE(68,'(1X,''SYS2(11)'',L, & '' SUPPRESS DATA QUALITY CHECK'')') SYS2(11) WRITE(68,'(1X,''SYS2(12)'',L & '' ENABLE POPULATION FILTER'')') SYS2(12) WRITE(68,'(1X,''SYS2(13)'',L, & '' BYPASS SENSOR ALIGNMENT'')') SYS2(13) c WRITE(68,'(1X,''SYS2(14)'',L, c & '' BYPASS TIME PROGRESSION CHECK'')') SYS2(14) WRITE(68,'(1X,''SYS2(14)'',L, & '' BYPASS TIME REGRESSION CHECK'')') SYS2(14) WRITE(68,'(1X,''SYS2(15)'',L, & '' FORCE ZEROS TO FIRST TABLE'')') SYS2(15) c WRITE(68,'(1X,''SYS2(16)'',L, c & '' BYPASS ONE WAY LIGHT TIME CHECK'')') SYS2(16) WRITE(68,'(1X,''SYS2(16)'',L, & '' BYPASS TIME PROGRESSION CHECK'')') SYS2(16) WRITE(68,'(1X,''SYS2(17)'',L, & '' JUPITER PLANETARY COORDINATES'')') SYS2(17) WRITE(68,'(1X,''SYS2(18)'',L, & '' SATURN PLANETARY COORDINATES'')') SYS2(18) WRITE(68,'(1X,''SYS2(19)'',L, & '' URANUS PLANETARY COORDINATES'')') SYS2(19) WRITE(68,'(1X,''SYS2(20)'',L, & '' NEPTUNE PLANETARY COORDINATES'')') SYS2(20) WRITE(68,'(1X,''SYS2(21)'',L, & '' PRIMARY MAG ONLY'')') SYS2(21) WRITE(68,'(1X,''SYS2(22)'',L, & '' SECONDARY MAG ONLY'')') SYS2(22) WRITE(68,'(1X,''SYS2(23)'',L, & '' BYPASS BOOM ALIGNMENT'')') SYS2(23) WRITE(68,'(1X,''SYS2(24)'',L, & '' FORCE IB MAG AS PRIMARY'')') SYS2(24) WRITE(68,'(1X,''SYS2(25)'',L, & '' WRITE MAG/PLS COMMAND WORDS AND MAG STAT WORDS'')') SYS2(25) WRITE(68,'(1X,''SYS2(26)'',L, & '' WRITE LFM RECORDS ONLY'')') SYS2(26) WRITE(68,'(1X,''SYS2(27)'',L, & '' PROCESS S/C FIELD AS AMBIENT'')') SYS2(27) WRITE(68,'(1X,''SYS2(28)'',L, & '' COMPOSITE MAG - SECONDARY X & Z REPLACE PRIMARY'')') SYS2(28) WRITE(68,'(1X,''SYS2(29)'',L, & '' OVERRIDE RECORD CHECK ROUTINE'')') SYS2(29) WRITE(68,'(1X,''SYS2(30)'',L, & '' RESERVED'')') SYS2(30) WRITE(68,'(1X,''SYS2(31)'',L, & '' APPLY FLIPPER FIX MATRIX TO VGR-2 OUTBOARD MAG'')') SYS2(31) WRITE(68,'(1X,''SYS2(32)'',L, & '' WRITE COUNTS & GAMMAS BEFORE SENSOR & BOOM ALIGNMENT'')') & SYS2(32) C RETURN END SUBROUTINE FLIPPER_FIX(GAMMA,NPRI,BAD) C This routine applies correction matrix to outboard MAG data skewed C by unwanted rotation of the outboard MAG flipper assembly following C spacecraft commanding errors on Nov. 30, 2006 C written by Sandy Kramer, GST, Inc., code 690, 05/18/2007 C INPUT VARIABLES C BAD FILL VALUE C GAMMA PRIMARY MAG FIELD STRENGTH C NPRI NUMBER OF PRIMARY WORDS C OUTPUT VARIABLES C GAMMA PRIMARY MAG FIELD STRENGTH C LOCAL VARIABLES C FIELD TEMPORARY VARIABLE REAL*4 GAMMA(3,NPRI),FIELD(3),FIX(3,3) C FIX(1,1) = 1.0 FIX(1,2) = 0.0 FIX(1,3) = 0.0 FIX(2,1) = 0.0 FIX(2,2) = 0.52992 FIX(2,3) = 0.848048 FIX(3,1) = 0.0 FIX(3,2) = -0.848048 FIX(3,3) = 0.52992 C DO I = 1,NPRI C PRIMARY MAG SENSOR ALIGNMENT IF ( GAMMA(1,I).NE.BAD .AND. & GAMMA(2,I).NE.BAD .AND. & GAMMA(3,I).NE.BAD ) THEN CALL MPRD31(FIELD,FIX,GAMMA(1,I)) GAMMA(1,I) = FIELD(1) GAMMA(2,I) = FIELD(2) GAMMA(3,I) = FIELD(3) ELSE GAMMA(1,I) = BAD GAMMA(2,I) = BAD GAMMA(3,I) = BAD END IF C END PRIMARY MAG SENSOR ALIGNMENT END DO RETURN END SUBROUTINE GETBIT( BUFFER, OFFSET, VALUE ) C C GET VALUE OF BIT AT OFFSET IN BUFFER C INTEGER BUFFER(1), OFFSET, VALUE, ADDRESS C VALUE = 0 INDEX = 1 IOFF = OFFSET DO WHILE ( IOFF .GT. 32 ) INDEX = INDEX + 1 IOFF = IOFF - 32 ENDDO VALUE = IBITS( BUFFER(INDEX), IOFF, 1 ) C RETURN END SUBROUTINE GETFLAGS() C C READ SYSTEM FLAGS INPUT FILE C INCLUDE 'UNPACK.INC' C READ(5,'(32L1)',ERR=100,END=200) SYS2 C GOTO 999 100 WRITE(6,*) 'ERROR READING SYSTEM FLAG FILE' STOP GOTO 999 200 WRITE(6,*) 'NO SYSTEM FLAG DATA IN FILE' STOP C 999 CONTINUE C RETURN END SUBROUTINE GETSEDR(EDRTIME,TD,TN,TP,ESPV,ERANGE,EANG, & MAT1,MAT2,MAT3) C C EXTRACT POINTING VECTOR AND NAVIGATION WORDS NECESSARY FOR THE COMPUTATION C OF MATRICES TO ROTATE FIELD DATA FROM PAYLOAD TO IHG AND HG COORDINATES. C C ORIGINAL CODE BY SANDY KRAMER, HUGHES STX, CODE 692 NASA GSFC, 10/25/93 C HANDLE ENCOUNTER MODES, 05/01/95 - SBK C INTERPOLATE POINTING VECTOR AND NAVIGATION DATA, 07/31/95 - SBK C DETECT HEADER RECORDS IN CONCATENATED NAV FILES, 08/05/96 - SBK C DETECT HEADER RECORDS IN CONCATENATED PTG FILES, 08/06/96 - SBK C DETECT BAD NAV REC TIME TAGS, 08/22/96 - SBK C RESTORE DETECTION OF FILE COMMENTS, 09/11/96 - SBK C MOD TO ADD TIME TAG RESOLUTION TO SECONDS LEVEL, 07/12/2006 - SBK C CHARACTER IHDR(45)*4,TYPE*4 CHARACTER STAR*12,PVRD*77 INTEGER*2 EDRTIME(6),PTIME(6),NTIME(6),LAUNCH(6) INTEGER*4 INAV(126,2) REAL*4 RNAV(126,2),NAV(252),PV(3,3),OPV(3,3), & RH(3),VH(3),SPV(6),RANGE,ANG(2),OANG(2),EANG(2), & OSPV(6),ESPV(6),MTB(3,3),MTB5(3,3),MHG(3,3), & OMTB(3,3),OMTB5(3,3),OMHG(3,3), & MAT1(3,3),MAT2(3,3),MAT3(3,3),PMAT(3,3) REAL*8 TD,TP,TN,REALTIME,DATATIME, & PVTIME,NAVTIME,OTN,OTP C DATA ICALL/0/,ARAD/1.495985E8/ C EQUIVALENCE ( IHDR(1), INAV(1,1) ), & ( NAV(1), RNAV(1,1) ) C SAVE PVRD,PVTIME,PV,NAVTIME,INAV,NAV,ICALL C INCLUDE 'UNPACK.INC' C C DIAGNOSTIC OUTPUT UNIT C IUNIT = 68 C C COUNT CALLS FOR SEDR DATA C ICALL = ICALL + 1 C C LAUNCH TIME FOR CALCULATION OF NAV AND PNTG EPIC TIMES C LAUNCH(1) = 77 LAUNCH(2) = 232 LAUNCH(3) = 0 LAUNCH(4) = 0 LAUNCH(5) = 0 LAUNCH(6) = 0 C C DETERMINE DESIRED COORDINATE PROCESSING C IF ( SYS2(17) ) THEN ICOORD = 4 ! JUPITER ELSE IF ( SYS2(18) ) THEN ICOORD = 3 ! SATURN ELSE IF ( SYS2(19) ) THEN ICOORD = 5 ! URANUS ELSE IF ( SYS2(20) ) THEN ICOORD = 6 ! NEPTUNE ELSE ICOORD = 2 ! HG (DEFAULT) END IF C C CONVERT CALENDAR DATA TIME TO DECIMAL YEAR. C DATATIME = REALTIME(EDRTIME) C C COMPUTE ELAPSED EDR TIME C CALL ELPSTIME(LAUNCH,EDRTIME,TD) C IF ( ICALL.GT.1 .AND. DATATIME.GT.PVTIME ) GOTO 7 ! GET NEW PTG VECTOR IF ( ICALL.GT.1 .AND. DATATIME.LE.PVTIME ) GOTO 12 ! CHECK NAV DATA C C READ POINTING VECTOR FILE HEADER. EXPECT $$VGR AT HEADER START AND C $$EOH AT HEADER END. C READ(40,'(A77)') PVRD 4 CONTINUE IF ( PVRD(1:5).NE.'$$VGR' ) THEN WRITE(IUNIT,804) STOP END IF WRITE(IUNIT,*) WRITE(IUNIT,*) 'POINTING VECTOR FILE INFO' DO WHILE ( PVRD(1:5).NE.'$$EOH' ) READ(40,'(A77)') PVRD IF ( PVRD(1:1).NE.'*' ) WRITE(IUNIT,*) PVRD END DO C C READ POINTING VECTOR DATA C 5 CONTINUE READ(40,'(A77)',END=200) PVRD IF (PVRD(1:5).EQ.'$$VGR') GOTO 4 ! NEW HEADER BLOCK IF (PVRD(1:1).EQ.'*') THEN WRITE(IUNIT,*) WRITE(IUNIT,*) 'POINTING VECTOR FILE INFO' WRITE(IUNIT,'(A77)') PVRD GOTO 5 END IF C C GET POINTING VECTORS' TIME TAG C CALL EXTRACTDATE(PTIME,PVRD) PVTIME = REALTIME(PTIME) C C COMPUTE ELAPSED POINTING VECTOR TIME C CALL ELPSTIME(LAUNCH,PTIME,TP) C IF (PVTIME.LT.DATATIME) THEN C C LOAD 3X3 SENSOR POINTING MATRIX. INSTRUMENT AXIS VECTORS ARE COLUMN C ORIENTED. C C X AXIS VECTOR TO COLUMN 1 C READ(PVRD,'(34X,2(E13.12,2X),E13.12)') (PV(I,1),I=1,3) C C Y AXIS VECTOR TO COLUMN 2 C READ(40,'(A77)',END=200) PVRD READ(PVRD,'(34X,2(E13.12,2X),E13.12)') (PV(I,2),I=1,3) C C Z AXIS VECTOR TO COLUMN 3 C READ(40,'(A77)',END=200) PVRD READ(PVRD,'(34X,2(E13.12,2X),E13.12)') (PV(I,3),I=1,3) C END IF 7 CONTINUE IF (PVTIME.LT.DATATIME) THEN C C SAVE POINTING VECTOR DATA BEFORE GETTING NEXT RECORD C DO J = 1,3 DO I = 1,3 OPV(I,J) = PV(I,J) END DO END DO OTP = TP GOTO 5 END IF C C GET POINTING VECTOR WITH TIME TAG FOLLOWING DATA TIME TAG C C LOAD 3X3 SENSOR POINTING MATRIX. INSTRUMENT AXIS VECTORS ARE COLUMN C ORIENTED. C C X AXIS VECTOR TO COLUMN 1 C READ(PVRD,'(34X,2(E13.12,2X),E13.12)') (PV(I,1),I=1,3) C C Y AXIS VECTOR TO COLUMN 2 C READ(40,'(A77)',END=200) PVRD READ(PVRD,'(34X,2(E13.12,2X),E13.12)') (PV(I,2),I=1,3) C C Z AXIS VECTOR TO COLUMN 3 C READ(40,'(A77)',END=200) PVRD READ(PVRD,'(34X,2(E13.12,2X),E13.12)') (PV(I,3),I=1,3) C C INTERPOLATE POINTING VECTOR DATA C CALL SEDRIP(OTP,OPV,TP,PV,TD,PMAT,9,0) C IF (ICALL.GT.1) GOTO 12 C C GET NAVIGATION FILE HEADER RECORD. CONTAINS CHARACTER AND INTEGER DATA. C READ(41) IHDR IF ( IHDR(2).NE.'SEDR' ) THEN WRITE(IUNIT,805) STOP END IF 9 CONTINUE WRITE(IUNIT,*) WRITE(IUNIT,*) 'NAVIGATION FILE INFO' WRITE(IUNIT,'(1X,''PROJECT ID: '',A4)') IHDR(1) WRITE(IUNIT,'(1X,''FILE TYPE: '',A4)') IHDR(2) WRITE(IUNIT,'(1X,''FLIGHT: '',I2.2)') INAV(3,1) WRITE(IUNIT,'(1X,''FILE ID: '',2A4)') IHDR(4),IHDR(5) WRITE(IUNIT,'(1X,''FILE FORMAT: '',2A4)') IHDR(14),IHDR(15) TYPE = IHDR(14) C C GET NAVIGATION DATA RECORDS. CONTAINS INTEGER AND FLOATING POINT DATA. C FLOATING POINT VALUES ARE CONVERTED FROM VAXG TO IEEE REPRESENTATION BY C DEC FORTRAN CONVERT PARAMETER IN OPEN STATEMENT WHEN SOURCE CODE IS C COMPILED USING THE FLOAT=IEEE FLAG. C 10 CONTINUE READ(41,END=100,ERR=11) (INAV(I,1),I=1,6),(RNAV(I,1),I=7,126), & (RNAV(I,2),I=1,126) 11 CONTINUE C C GET NAVIGATION RECORD TIME TAG. USE 2 DIGIT YEAR. C IF ( IHDR(2).EQ.'SEDR' ) GOTO 9 ! DETECT HDR REC IN CONCAT SEDRS NTIME(1) = INAV(1,1) - 1900 IF (NTIME(1).GT.99) NTIME(1) = NTIME(1) - 100 NTIME(2) = INAV(2,1) NTIME(3) = INAV(3,1) NTIME(4) = INAV(4,1) NTIME(5) = INAV(5,1) NTIME(6) = INAV(6,1) NAVTIME = REALTIME(NTIME) C C COMPUTE ELAPSED NAVIGATION TIME C CALL ELPSTIME(LAUNCH,NTIME,TN) C C DETECT BAD NAV REC BASED ON VALID TIME TAG C IF ( TN.EQ.-1.0D0 ) GOTO 10 C C STORE CONTENTS OF NAVIGATION RECORD WHILE NAVIGATION TIME IS LESS THAN C EDR TIME C IF (NAVTIME.LT.DATATIME) THEN C C CALL SEDR PROCESSING ROUTINE C IF ( ICOORD.EQ.2 ) THEN CALL SEDRCRU(NTIME,NAV,PMAT,SPV,ANG,MTB,MHG,MTB5,RANGE) ELSE IF ( ICOORD.GE.3 ) THEN CALL SEDRENC(NTIME,NAV,PMAT,SPV,ANG,MTB,MHG,MTB5,RANGE) END IF C END IF 12 CONTINUE C C SAVE PROCESSED SEDR VALUES BEFORE GETTING NEW NAV DATA C IF (NAVTIME.LT.DATATIME) THEN DO J = 1,3 DO I = 1,3 OMTB(I,J) = MTB(I,J) OMTB5(I,J) = MTB5(I,J) OMHG(I,J) = MHG(I,J) END DO END DO OTN = TN OSPV(1) = SPV(1) OSPV(2) = SPV(2) OSPV(3) = SPV(3) OSPV(4) = SPV(4) OSPV(5) = SPV(5) OSPV(6) = SPV(6) ORANGE = RANGE OANG(1) = ANG(1) OANG(2) = ANG(2) GOTO 10 ! CHECK NEXT NAV RECORD END IF C C CALL SEDR PROCESSING ROUTINE C IF ( ICOORD.EQ.2 ) THEN CALL SEDRCRU(NTIME,NAV,PMAT,SPV,ANG,MTB,MHG,MTB5,RANGE) ELSE IF ( ICOORD.GE.3 ) THEN CALL SEDRENC(NTIME,NAV,PMAT,SPV,ANG,MTB,MHG,MTB5,RANGE) END IF C C INTERPOLATE ROTATION MATRICES, ANGLES, POSITION AND VELOCITY C CALL SEDRIP(OTN,OMTB,TN,MTB,TD,MAT1,9,0) ! ROTATION MATRIX 1 CALL SEDRIP(OTN,OMTB5,TN,MTB5,TD,MAT2,9,0) ! ROTATION MATRIX 2 CALL SEDRIP(OTN,OMHG,TN,MHG,TD,MAT3,9,0) ! ROTATION MATRIX 3 CALL SEDRIP(OTN,ORANGE,TN,RANGE,TD,ERANGE,1,0) ! RANGE CALL SEDRIP(OTN,OSPV,TN,SPV,TD,ESPV,6,0) ! S/C POSITION/VELOCITY CALL SEDRIP(OTN,OANG(1),TN,ANG(1),TD,EANG(1),1,3) ! LONGITUDE CALL SEDRIP(OTN,OANG(2),TN,ANG(2),TD,EANG(2),1,4) ! LATITUDE GOTO 900 100 CONTINUE WRITE(IUNIT,800) WRITE(IUNIT,801) NTIME GOTO 900 200 CONTINUE WRITE(IUNIT,802) WRITE(IUNIT,803) PTIME 900 CONTINUE C RETURN 800 FORMAT(1X,'*GETSEDR* WARNING! ', & 'END OF NAVIGATION FILE REACHED.') 801 FORMAT(1X,'*GETSEDR* LAST NAVIGATION TIME TAG AT', & 1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3) 802 FORMAT(1X,'*GETSEDR* WARNING! ' & 'END OF POINTING VECTOR FILE REACHED.') 803 FORMAT(1X,'*GETSEDR* LAST POINTING VECTOR TIME TAG AT', & 1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3) 804 FORMAT(1X,'*GETSEDR* ERROR! ', & 'INVALID POINTING VECTOR FILE HEADER.') 805 FORMAT(1X,'*GETSEDR* ERROR! ', & 'INVALID NAVIGATION FILE HEADER.') 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 SUBROUTINE GETZERO(IUNIT,ZERONAME,FLIGHT,EDRTIME,ZEROTIME,ISTAT) C C SEARCH ASCII ZERO TABLE DATASET FOR DESIRED EDR TIME. C RETRIEVE ZERO TABLE WITH TIME CLOSEST BUT NOT GREATER C THAN EDR TIME. C C WRITTEN BY S.KRAMER, CODE 692 05/13/94 C MOD TO READ TIME TAG TO SECONDS LEVEL, SBK 07/12/2006 C INTEGER*4 RANGE C CHARACTER LINE*72,ZERONAME*8,CURRNAME*8 INTEGER*2 EDRTIME(6),ZEROTIME(6),CURRTIME(6) INTEGER*4 FLIGHT,ISTAT,ITAB LOGICAL*1 LOAD,FORCE REAL*8 REALTIME,ZTIME,ETIME DATA LOAD/.FALSE./,ICALL/0/,ITAB/0/,FORCE/.FALSE./ C INCLUDE 'UNPACK.INC' C FORCE = SYS2(15) C C GET DECIMAL YEAR TIME VALUE OF EDR TIME C ETIME = REALTIME(EDRTIME) C ICALL = ICALL + 1 IF ( ICALL.GT.1.AND.FORCE ) RETURN IF ( ICALL.GT.1 ) GOTO 50 C C READ ZERO OFFSET TABLES C ISTAT = 0 ICNT = 0 10 CONTINUE READ(IUNIT,'(A72)',END=900) LINE ICNT = ICNT + 1 C C LOOK FOR NEW TABLE DELIMITER C IF ( LINE(1:1).EQ.'#' ) THEN ICNT = 0 ITAB = ITAB + 1 END IF C C READ FORCED ZERO TABLE C IF ( FORCE.AND.ITAB.GT.1 ) THEN WRITE(6,*) WRITE(6,'(1X,''ZERO TABLE FORCED'')') WRITE(6,'(1X,''FIRST TABLE USED'')') RETURN END IF C C GET SPACECRAFT ID C IF ( ICNT.EQ.1.AND.LINE(2:8).EQ.'VOYAGER' ) & READ(LINE,'(8X,I1)') FLIGHT C C READ ZERO TABLE TIME TAG AND NAME C IF ( ICNT.EQ.2 ) THEN READ(LINE,'(8X,I2,1X,I3,3(1X,I2),9X,A8)') & (CURRTIME(I),I=1,5),CURRNAME WRITE(6,800) CURRTIME, CURRNAME ZTIME = REALTIME(CURRTIME) END IF C 50 CONTINUE C C USE THE CLOSEST ZERO TABLE TIME NOT GREATER THAN THE EDR TIME C IF ( ICNT.EQ.2.AND.ZTIME.GT.ETIME.AND..NOT.FORCE ) THEN IF ( ITAB.EQ.1 ) THEN WRITE(6,*) WRITE(6,'(1X,''ALL ZERO TABLE TIMES EXCEED EDR TIME'')') WRITE(6,'(1X,''NO ZERO TABLE LOADED'')') WRITE(6,'(1X,''PRODUCTION EXECUTION STOPPED'')') WRITE(6,*) STOP END IF RETURN END IF C IF ( ICNT.EQ.3 ) CONTINUE IF ( ICNT.EQ.4 ) CONTINUE C C LOAD INBOARD LFM RANGES C IF ( ICNT.EQ.5 ) READ(LINE,*) RANGE,(IBOFF(J,0),J=1,3) IF ( ICNT.EQ.6 ) READ(LINE,*) RANGE,(IBOFF(J,1),J=1,3) IF ( ICNT.EQ.7 ) READ(LINE,*) RANGE,(IBOFF(J,2),J=1,3) IF ( ICNT.EQ.8 ) READ(LINE,*) RANGE,(IBOFF(J,3),J=1,3) IF ( ICNT.EQ.9 ) READ(LINE,*) RANGE,(IBOFF(J,4),J=1,3) IF ( ICNT.EQ.10 ) READ(LINE,*) RANGE,(IBOFF(J,5),J=1,3) IF ( ICNT.EQ.11 ) READ(LINE,*) RANGE,(IBOFF(J,6),J=1,3) IF ( ICNT.EQ.12 ) READ(LINE,*) RANGE,(IBOFF(J,7),J=1,3) C C LOAD INBOARD HFM RANGES C IF ( ICNT.EQ.13 ) READ(LINE,*) RANGE,(IBOFF(J,8),J=1,3) IF ( ICNT.EQ.14 ) READ(LINE,*) RANGE,(IBOFF(J,9),J=1,3) C IF ( ICNT.EQ.15 ) CONTINUE IF ( ICNT.EQ.16 ) CONTINUE C C LOAD OUTBOARD LFM RANGES C IF ( ICNT.EQ.17 ) READ(LINE,*) RANGE,(OBOFF(J,0),J=1,3) IF ( ICNT.EQ.18 ) READ(LINE,*) RANGE,(OBOFF(J,1),J=1,3) IF ( ICNT.EQ.19 ) READ(LINE,*) RANGE,(OBOFF(J,2),J=1,3) IF ( ICNT.EQ.20 ) READ(LINE,*) RANGE,(OBOFF(J,3),J=1,3) IF ( ICNT.EQ.21 ) READ(LINE,*) RANGE,(OBOFF(J,4),J=1,3) IF ( ICNT.EQ.22 ) READ(LINE,*) RANGE,(OBOFF(J,5),J=1,3) IF ( ICNT.EQ.23 ) READ(LINE,*) RANGE,(OBOFF(J,6),J=1,3) IF ( ICNT.EQ.24 ) READ(LINE,*) RANGE,(OBOFF(J,7),J=1,3) C C LOAD OUTBOARD HFM RANGES C IF ( ICNT.EQ.25 ) READ(LINE,*) RANGE,(OBOFF(J,8),J=1,3) IF ( ICNT.EQ.26 ) READ(LINE,*) RANGE,(OBOFF(J,9),J=1,3) C C SAVE CURRENT ZERO TABLE TIME TAG C IF ( ICNT.EQ.2) THEN DO I = 1,6 ZEROTIME(I) = CURRTIME(I) END DO ZERONAME = CURRNAME C WRITE(6,1) ZERONAME,ZEROTIME,EDRTIME END IF LOAD = .TRUE. C GOTO 10 C 900 CONTINUE WRITE(6,*) WRITE(6,*) 'END OF FILE REACHED' IF (LOAD) THEN WRITE(6,'( 1X,''LAST ZERO TABLE TAGGED '', & I2,1X,I3,1X,I2)') (ZEROTIME(I),I=1,3) ISTAT = 1 END IF IF (.NOT.LOAD) THEN WRITE(6,'(1X,''EMPTY ZERO TABLE FILE'')') WRITE(6,'(1X,''NO ZERO TABLE LOADED'')') WRITE(6,'(1X,''PRODUCTION EXECUTION STOPPED'')') WRITE(6,*) STOP END IF C RETURN 1 FORMAT(1X,A8,3X,6(1X,I3),3X,6(1X,I3)) 800 FORMAT(1X,I2,1X,I3,3(1X,I2),1X,I3,3X,A8) END SUBROUTINE GS3AVE(GAMMA,GAMMA2,BAD,TIME) C C MASTER CALLING ROUTINE FOR THE PRODUCTION OF GS-3 AVERAGES C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 07/05/94 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,800),GAMMA2(3,400),SCF(3,800),AMBIENT(3,800) C DATA SCF /2400*999.0/ C INCLUDE 'UNPACK.INC' C C GET SPACECRAFT FIELD AND AMBIENT FIELD VALUES C CALL GS3FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C DETAIL OUTPUT C IF ( SYS2(4).OR.SYS2(5) ) THEN CALL GS3DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) RETURN END IF C C SINGLE MAG MODE - PRIMARY C IF ( SYS2(21) .AND. (.NOT.SYS2(22)) ) THEN CALL GS3PRI(GAMMA,SCF,TIME,BAD) C C SINGLE MAG MODE - SECONDARY C ELSE IF ( (.NOT.SYS2(21)) .AND. SYS2(22) ) THEN CALL GS3SEC(GAMMA2,SCF,TIME,BAD) C C SINGLE MAG MODE - PRIMARY AND SECONDARY C ELSE IF ( SYS2(21) .AND. SYS2(22) ) THEN CALL GS3PNS(GAMMA,GAMMA2,TIME,BAD) C C DUAL MAG MODE C ELSE IF ( (.NOT.SYS2(21)) .AND. (.NOT.SYS2(22)) ) THEN C C IF SYS2(27) IS TRUE, USE S/C FIELD AS AMBIENT C IF (SYS2(27)) THEN CALL GS3PRI(SCF,SCF,TIME,BAD) ELSE CALL GS3PRI(AMBIENT,SCF,TIME,BAD) END IF C END IF C RETURN END C C OBSOLETE ROUTINE REPLACED BY MAKEGAMMAS 12/30/1996 SBK C SUBROUTINE GS3CNT(GAMMA,GAMMA2,BAD,TIME,INBOARD) C C GS-3 ROUTINE C C THIS SUBROUTINE SUBTRACTS THE ZERO OFFSET FROM EACH COUNT AND MULTIPIES THE C RESULTING DIFFERENCE BY THE SENSITIVITY TO YIELD FIELD STRENGTH IN GAMMAS. C INTEGER*2 TIME(6) INTEGER*4 PRIOFF(3),SECOFF(3) LOGICAL*1 RECTEST,INBOARD REAL*4 GAMMA(3,800),GAMMA2(3,400),PRISEN(3),SECSEN(3) C INCLUDE 'UNPACK.INC' C IF (SYS2(32)) RECTEST = .TRUE. C DO IWRD = 1,800 C IWRD2 = (IWRD-1)/2 + 1 C C STAT1 WORD COUNTER (10 STAT1 WORDS PER 80 MF GS-3 RECORD) C ICYC = INT((IWRD-1)/80) + 1 C C ASSIGN OFFSETS AND SENSITIVITIES TO LOCAL VARIABLES CHECKING PRIME C LFM STATUS. C DO IAX = 1,3 IF (.NOT.INBOARD) PRIOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) IF (.NOT.INBOARD) SECOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) IF (.NOT.INBOARD) PRISEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) IF (.NOT.INBOARD) SECSEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) IF (INBOARD) PRIOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) IF (INBOARD) SECOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) IF (INBOARD) PRISEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) IF (INBOARD) SECSEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) END DO C C CONVERT PRIMARY MODE GS-3 COUNTS TO GAMMAS C DO IAX = 1,3 GAMMA(IAX,IWRD) = BAD IF (PREC(IAX,IWRD).NE.0) GAMMA(IAX,IWRD) = & (PREC(IAX,IWRD)-PRIOFF(IAX))*PRISEN(IAX) END DO C C CONVERT SECONDARY MODE GS-3 COUNTS TO GAMMAS C IF (MOD(IWRD,2).NE.0) THEN DO IAX = 1,3 GAMMA2(IAX,IWRD2) = BAD IF (SREC(IAX,IWRD2).NE.0) GAMMA2(IAX,IWRD2) = & (SREC(IAX,IWRD2)-SECOFF(IAX))*SECSEN(IAX) END DO END IF C IF (RECTEST) THEN C IF (IWRD.EQ.1) WRITE(81,'(1X,''EDR TIME: '',6(1X,I3))') TIME C WRITE(81,'(4(1X,I5),3(1X,F7.3),4(1X,I5),3(1X,F7.3))') & IWRD,PREC(1,IWRD),PREC(2,IWRD),PREC(3,IWRD), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD), & IWRD2,SREC(1,IWRD2),SREC(2,IWRD2),SREC(3,IWRD2), & GAMMA2(1,IWRD2),GAMMA2(2,IWRD2),GAMMA2(3,IWRD2) C END IF C END DO C RETURN END SUBROUTINE GS3COMM(TIME) C C GS3 ROUTINE C C THIS ROUTINE EXTRACTS VALUES FROM THE TWO STATUS WORDS, STAT1 AND STAT2, C THAT WERE UNPACKED FROM THE PLASMA SUB-HEADER BLOCK. STAT1 CONTAINS RANGE C AND MODE VALUES. STAT2 CONTAINS SENSOR STATES. C C ORIGINAL SOURCE WRITTEN BY SANDY KRAMER 07/11/94 C INTEGER*2 TIME(6) INTEGER*4 OBDIFF,IBDIFF C INCLUDE 'UNPACK.INC' C C GET INSTRUMENT STATUS VALUES FROM SECOND STATUS WORD C DO I = 1,10 C C ELECTRICAL FLIPPER STATUS C EFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 0, 1, EFLIP(I), 0) C C EXTRACT PRIME LFM STATUS C PRIME(I) = .FALSE. CALL MOVBIT(STAT2(I), 1, 1, PRIME(I), 0) C C INBOARD LFM FLIP STATUS C IBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 4, 2, IBFLIP(I), 0) C C OUTBOARD LFM FLIP STATUS C OBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 2, 2, OBFLIP(I), 0) C C EXTRACT PROCESSOR STATUS C MPROC(I) = .FALSE. CALL MOVBIT(STAT2(I), 6, 1, MPROC(I), 0) C C EXTRACT POLARITY C POLAR(I) = .FALSE. CALL MOVBIT(STAT2(I), 7, 1, POLAR(I), 0) C C INBOARD LFM FLIGHT CALIBRATION INDICATOR C IBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 10, 1, IBCAL(I), 0) C C OUTBOARD LFM FLIGHT CALIBRATION INDICATOR C OBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 11, 1, OBCAL(I), 0) C END DO C C GET INSTRUMENT STATUS VALUES FROM FIRST STATUS WORD C DO I=1,10 C C CHECK FOR RANGE OVERRIDE C IF (RNGSET.NE.-1) THEN OBRNG(I) = RNGSET IBRNG(I) = RNGSET GOTO 100 END IF C C EXTRACT OUTBOARD AND INBOARD RANGE MODES [0,1] C IF (MODSET.EQ.-1) THEN CALL MOVBIT(STAT1(I), 11, 1, OBMODE(I), 0) CALL MOVBIT(STAT1(I), 7, 1, IBMODE(I), 0) ELSE IF (MODSET.EQ.0) THEN OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. ELSE IF (MODSET.EQ.1) THEN OBMODE(I) = .TRUE. IBMODE(I) = .TRUE. END IF C C EXTRACT OUTBOARD AND INBOARD RANGE SENSITIVITIES [0,7] C DO J = 1,3 CALL MOVBIT(STAT1(I), 11-J, 1, OBRNG(I), J-1) CALL MOVBIT(STAT1(I), 7-J, 1, IBRNG(I), J-1) END DO C C TEST FOR RANGE ERRORS. SENSITIVITY MAY CHANGE ONLY BY ONE C IN AUTO RANGE MODE. C IBDIFF = ABS(IBRNG(I)-IBRNG(I-1)) OBDIFF = ABS(OBRNG(I)-OBRNG(I-1)) C C INBOARD MAG RANGE CHECK C IF (IBDIFF.GT.1.AND.(IBMODE(I).AND.IBMODE(I-1))) THEN WRITE(68,889) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) IBRNG(I) = IBRNG(I-1) IBMODE(I) = IBMODE(I-1) ELSE IF ( IBDIFF.NE.0 ) THEN WRITE(68,899) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) END IF C C OUTBOARD MAG RANGE CHECK C IF (OBDIFF.GT.1.AND.(OBMODE(I).AND.OBMODE(I-1))) THEN WRITE(68,888) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) OBRNG(I) = OBRNG(I-1) OBMODE(I) = OBMODE(I-1) ELSE IF ( OBDIFF.NE.0 ) THEN WRITE(68,898) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) END IF C 100 CONTINUE C END DO C C PUT LAST RANGE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBRNG(0) = IBRNG(10) OBRNG(0) = OBRNG(10) C C PUT LAST MODE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBMODE(0) = IBMODE(10) OBMODE(0) = OBMODE(10) C RETURN 888 FORMAT(1X,'*GS3COMM* OUTBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 889 FORMAT(1X,'*GS3COMM* INBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 898 FORMAT(1X,'*GS3COMM* OUTBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 899 FORMAT(1X,'*GS3COMM* INBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) END SUBROUTINE GS3DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C OUTPUT DETAIL DATA FROM GS3 EDR PROCESSING. C C REVISED 05/26/95 SBK - NEW ROTATION MATRIX FORMAT FROM SEDR ROUTINES C MODIFIED OUTPUT FORMAT FOR UNIFORMITY ACROSS TELEMETRY MODES C SBK 02/23/2007 C CHARACTER DATAID*4,FLTID*4,COORD*2,MODE*4,TELEM*4 INTEGER*2 GS3TIME(6),TIME(6),DELTA(6), & DATATYPE(2),WORD30(2),WORD32(2) REAL*4 HDR(32),TIMEPD REAL*4 GAMMA(3,800),GAMMA2(3,400),SCF(3,800),AMBIENT(3,800), & PRIDAT(3,800),SECDAT(3,400),SCFDAT(3,800),AMBDAT(3,800) REAL*4 SPV(6),RANGE,ANG(2), & MTB(3,3),MTB5(3,3),MHG(3,3) REAL*8 TD,TN,TP C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (DETOUT(1),HDR(1)) C EQUIVALENCE (HDR(1),DATAID), (HDR(12),TIMEPD), & (HDR(17),DATATYPE(1)), (HDR(30),WORD30(1)), & (HDR(32),WORD32(1)) C DATA ICALL/0/, DELTA/5*0,60/, GS3TIME/6*0/, TELEM/'GS-X'/ C IUNIT = 84 RECWRITE = RECWRITE + 1 ICALL = ICALL + 1 IF ( SYS2(7) ) THEN COORD = 'HG' ELSE COORD = 'PL' END IF C C CHECK FOR CONFLICTING PROCESSING FLAGS C IF ( SYS2(4).AND..NOT.SYS2(5) ) THEN MODE = 'SNGL' LEN = 3632 ELSE IF ( SYS2(5).AND..NOT.SYS2(4) ) THEN MODE = 'DUAL' LEN = 4832 ELSE WRITE(6,*) WRITE(6,*) & '*GS3DET* CONFLICTING DETAIL PROCESSING FLAGS' STOP END IF C IF ( SYS2(6).AND.ICALL.EQ.1 ) THEN C C FORTRAN OUTPUT UNIT ASSIGNED TO FILE NAME IN VMS DCL ROUTINE CALLING C THE VOYPROD EXECUTABLE ex. $ ASSIGN FILE.DAT FOR084 C OPEN(IUNIT,STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST',RECL=124) END IF C GS3TIME(1) = TIME(1) GS3TIME(2) = TIME(2) GS3TIME(3) = TIME(3) GS3TIME(4) = TIME(4) GS3TIME(5) = TIME(5) GS3TIME(6) = TIME(6) C IF ( SCID.EQ.0 ) THEN FLTID = "FLT2" ELSE IF ( SCID.EQ.1 ) THEN FLTID = "FLT1" ELSE FLTID = "FLT?" END IF DATAID = 'LFM ' TIMEPD = 48.0 DATATYPE(1) = 1 WORD32(1) = RECWRITE C IF ( SYS2(4) ) THEN C C OUTPUT PRIMARY AND SECONDARY DETAIL FIELD C WORD30(1) = 800 WORD30(2) = 400 WORD32(2) = 3600 C ELSE IF ( SYS2(5) ) THEN C C OUTPUT AMBIENT AND SPACECRAFT DETAIL FIELD C WORD30(1) = 800 WORD30(2) = 800 WORD32(2) = 4800 C END IF C C REASSIGN DETAIL VALUES TO LOCAL VARIABLES C DO I = 1,800 C IF ( SYS2(7) ) & CALL GETSEDR(GS3TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) C C SECONDARY MAG SAMPLE COUNTER (1-2) C ISEC = (I-1)/2 + 1 C IF ( SYS2(4) ) THEN C C GET PRIMARY VALUES C IF ( SYS2(7) ) THEN CALL ROTATE1(PRIDAT(1,I),GAMMA(1,I),MHG,BAD) ELSE PRIDAT(1,I) = GAMMA(1,I) PRIDAT(2,I) = GAMMA(2,I) PRIDAT(3,I) = GAMMA(3,I) END IF C C OUTPUT PRIMARY FIELD X,Y,Z C DETOUT(32+I) = PRIDAT(1,I) DETOUT(32+800+I) = PRIDAT(2,I) DETOUT(32+1600+I) = PRIDAT(3,I) C C GET SECONDARY VALUES C IF ( MOD(I-1,2).EQ.0 ) THEN IF ( SYS2(7) ) THEN CALL ROTATE1(SECDAT(1,ISEC),GAMMA2(1,ISEC),MHG,BAD) ELSE SECDAT(1,ISEC) = GAMMA2(1,ISEC) SECDAT(2,ISEC) = GAMMA2(2,ISEC) SECDAT(3,ISEC) = GAMMA2(3,ISEC) END IF C C OUTPUT SECONDARY FIELD X,Y,Z C DETOUT(32+2400+ISEC) = SECDAT(1,ISEC) DETOUT(32+2400+400+ISEC) = SECDAT(2,ISEC) DETOUT(32+2400+800+ISEC) = SECDAT(3,ISEC) END IF C C OUTPUT 800 PRIMARY SAMPLES AND 400 SECONDARY SAMPLES C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,GS3TIME,RANGE,ANG(2), & ANG(1),(PRIDAT(J,I),J=1,3),(SECDAT(J,ISEC),J=1,3) END IF C ELSE IF ( SYS2(5) ) THEN C C GET AMBIENT FIELD VALUES C IF ( SYS2(7) ) THEN CALL ROTATE1(AMBDAT(1,I),AMBIENT(1,I),MHG,BAD) ELSE AMBDAT(1,I) = AMBIENT(1,I) AMBDAT(2,I) = AMBIENT(2,I) AMBDAT(3,I) = AMBIENT(3,I) END IF C C GET SPACECRAFT FIELD VALUES C IF ( SYS2(7) ) THEN CALL ROTATE1(SCFDAT(1,I),SCF(1,I),MHG,BAD) ELSE SCFDAT(1,I) = SCF(1,I) SCFDAT(2,I) = SCF(2,I) SCFDAT(3,I) = SCF(3,I) END IF C C OUTPUT AMBIENT FIELD X,Y,Z C DETOUT(32+I) = AMBDAT(1,I) DETOUT(32+800+I) = AMBDAT(2,I) DETOUT(32+1600+I) = AMBDAT(3,I) C C OUTPUT SPACECRAFT FIELD X,Y,Z C DETOUT(32+2400+I) = SCFDAT(1,I) DETOUT(32+3200+I) = SCFDAT(2,I) DETOUT(32+4000+I) = SCFDAT(3,I) C C OUTPUT 800 AMBIENT SAMPLES AND 800 SPACECRAFT FIELD SAMPLES C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,GS3TIME,RANGE,ANG(2), & ANG(1),(AMBDAT(J,I),J=1,3),(SCFDAT(J,I),J=1,3) END IF C END IF C CALL INC_TIME(GS3TIME,DELTA) C END DO C C WRITE BINARY DETAIL DATA C WRITE(66) (DETOUT(I),I=1,LEN) C RETURN 800 FORMAT(2(A4,1X),A2,1X,A4,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,F8.4, & 2(1X,F8.3),6(1X,F9.3)) END C C OBSOLETE ROUTINE REPLACED BY ROUTINE DIFFERENCE 12/26/1996 SBK C SUBROUTINE GS3DIFF(TIME) C C GS3 ROUTINE C C THIS SUBROUTINE RECONSTRUCTS FULL WORDS FROM 12 BIT REFERENCE AND 6 BIT C DIFFERENCE WORDS. RECONSTRUCTION IS VERIFIED AGAINST PRIMARY REFERENCE C WORDS OCCURRING EVERY 5TH COUNT AND SECONDARY REFERENCE WORDS OCCURRING C EVERY 10TH COUNT. AN INCORRECT RECONSTRUCTION RESULTS IN ALL RECONSTRUCTED C FULL WORDS FOR A REFERENCE CYCLE TO BE FLAGGED AS ERRED AND REPLACED WITH C THE FILL VALUE ZERO. C C PREF PRIMARY REFERENCE FULL WORD (FILL = 0) C PDIFF PRIMARY DIFFERENCE HALF WORD (FILL = 255) C PREC PRIMARY RECONSTRUCTED FULL WORD (FILL = 0) C PERR PRIMARY RECONSTRUCTION ERROR FLAG (0 = FALSE) C (1 = TRUE) C SREF SECONDARY REFERENCE FULL WORD (FILL = 0) C SDIFF SECONDARY DIFFERENCE HALF WORD (FILL = 255) C SREC SECONDARY RECONSTRUCTED FULL WORD (FILL = 0) C SERR SECONDARY RECONSTRUCTION ERROR FLAG (0 = FALSE) C (1 = TRUE) C INTEGER*2 PSUM(3),PERR(3,160),TIME(6), & SSUM(3),SERR(3,80) LOGICAL*1 RECTEST C INCLUDE 'UNPACK.INC' C C OUTPUT PRIMARY AND SECONDARY REFERENCE WORDS, PRIMARY DIFFERENCE WORDS, C RECONSTRUCTED PRIMARY FULL WORDS, MODES AND RANGES. COUNTS ARE NOT C ROTATED BY SENSOR, BOOM ALIGNMENT OR SEDR MATRICES. C IF (SYS2(31)) RECTEST = .TRUE. C C RECONSTRUCT PRIMARY FULL WORDS FROM PRIMARY DIFFERENCES. C TEST FOR BAD DIFFERENCE WORDS AND NULL DATA. C IP = 1 PSUM(1) = 0 PSUM(2) = 0 PSUM(3) = 0 PERR(1,160) = 0 PERR(2,160) = 0 PERR(3,160) = 0 C C LOAD FIRST PRIMARY REFERENCE WORDS C DO IAX = 1,3 IF ( PREF(IAX,1).NE.0 ) THEN PREC(IAX,1) = PREF(IAX,1) PERR(IAX,1) = 0 ELSE PREC(IAX,1) = 0 PERR(IAX,1) = 1 END IF END DO C C RECONSTRUCT 12 BIT FULL WORDS FROM 6 BIT DIFFERENCE WORDS. USE C PRIMARY REFERENCE WORDS TO TEST FOR ERRORS IN RECONSTRUCTION OF C FULL WORDS FROM DIFFERENCE WORDS. C DO IWRD=1,800 C C VERIFY RECONSTRUCTED FULL WORDS C IF ( MOD(IWRD-1,5).EQ.0 .AND. IWRD.GT.1 ) THEN IP = IP + 1 DO IAX = 1,3 PERR(IAX,IP) = 0 PREC(IAX,IWRD) = 0 IF ( PREF(IAX,IP-1).NE.0 .AND. & PDIFF(IAX,IWRD).NE.255 .AND. & PERR(IAX,IP-1).EQ.0 ) THEN PSUM(IAX) = PSUM(IAX) + PDIFF(IAX,IWRD) PREC(IAX,IWRD) = PREF(IAX,IP-1) + PSUM(IAX) ELSE PERR(IAX,IP-1) = 1 END IF IF ( PREC(IAX,IWRD).NE.PREF(IAX,IP) ) THEN PREC(IAX,IWRD) = PREF(IAX,IP) PERR(IAX,IP-1) = 1 END IF PSUM(IAX) = 0 ! REINITIALIZE DIFFERENCE WORD ACCUMULATORS END DO C C OPERATE ON PRIMARY DIFFERENCE WORDS. C ELSE DO IAX = 1,3 PREC(IAX,IWRD) = 0 IF ( PDIFF(IAX,IWRD).NE.255 .AND. & PERR(IAX,IP).EQ.0 ) THEN PSUM(IAX) = PSUM(IAX) + PDIFF(IAX,IWRD) PREC(IAX,IWRD) = PREF(IAX,IP) + PSUM(IAX) ELSE PERR(IAX,IP) = 1 END IF END DO END IF C C END PRIMARY FULL WORD RECONSTRUCTION C END DO C C RECONSTRUCT SECONDARY FULL WORDS FROM SECONDARY DIFFERENCES. C TEST FOR BAD DIFFERENCE WORDS AND NULL DATA. C IS = 1 SSUM(1) = 0 SSUM(2) = 0 SSUM(3) = 0 SERR(1,80) = 0 SERR(2,80) = 0 SERR(3,80) = 0 C C LOAD FIRST SECONDARY REFERENCE WORDS C DO IAX = 1,3 IF ( SREF(IAX,1).NE.0 ) THEN SREC(IAX,1) = SREF(IAX,1) SERR(IAX,1) = 0 ELSE SREC(IAX,1) = 0 SERR(IAX,1) = 1 END IF END DO C C RECONSTRUCT 12 BIT FULL WORDS FROM 6 BIT DIFFERENCE WORDS. USE C SECONDARY REFERENCE WORDS TO TEST FOR ERRORS IN RECONSTRUCTION OF C FULL WORDS FROM DIFFERENCE WORDS. C DO IWRD = 1,400 C C VERIFY RECONSTRUCTED FULL WORDS C IF ( MOD(IWRD-1,5).EQ.0 .AND. IWRD.GT.1 ) THEN IS = IS + 1 DO IAX = 1,3 SERR(IAX,IS) = 0 SREC(IAX,IWRD) = 0 IF (SREF(IAX,IS-1).NE.0.AND. & SDIFF(IAX,IWRD).NE.255.AND. & SERR(IAX,IS-1).NE.1) THEN SSUM(IAX) = SSUM(IAX) + SDIFF(IAX,IWRD) SREC(IAX,IWRD) = SREF(IAX,IS-1) + SSUM(IAX) ELSE SREC(IAX,IWRD) = 0 SERR(IAX,IS-1) = 1 END IF IF (SREC(IAX,IWRD).NE.SREF(IAX,IS)) THEN SREC(IAX,IWRD) = SREF(IAX,IS) SERR(IAX,IS-1) = 1 END IF SSUM(IAX) = 0 ! REINITIALIZE DIFFERENCE WORD ACCUMULATORS END DO C C OPERATE ON SECONDARY DIFFERENCE WORDS C ELSE DO IAX = 1,3 SREC(IAX,IWRD) = 0 IF (SDIFF(IAX,IWRD).NE.255.AND. & SERR(IAX,IS).NE.1) THEN SSUM(IAX) = SSUM(IAX) + SDIFF(IAX,IWRD) SREC(IAX,IWRD) = SREF(IAX,IS) + SSUM(IAX) ELSE SREC(IAX,IWRD) = 0 SERR(IAX,IS) = 1 END IF END DO END IF C C END SECONDARY FULL WORD RECONSTRUCTION C END DO C C REMOVE ERROR FLAGGED RECONSTRUCTED FULL WORDS C DO IWRD = 1,800 C C PRIMARY REFERENCE WORD COUNTER C IP = INT((IWRD-1)/5) + 1 C C CHECK FOR PRIMARY FULL WORD RECONSTRUCTION ERRORS C DO IAX = 1,3 IF ( PERR(IAX,IP).EQ.1 ) PREC(IAX,IWRD) = 0 END DO C C SECONDARY REFERENCE WORD COUNTER C IS = INT((IWRD-1)/10) + 1 C C CHECK FOR SECONDARY FULL WORD RECONSTRUCTION ERRORS C IF (MOD(IWRD,2).NE.0) THEN IWRD2 = (IWRD-1)/2 + 1 DO IAX = 1,3 IF (SERR(IAX,IS).EQ.1) SREC(IAX,IWRD2) = 0 END DO END IF C C 8 MF CYCLE COUNTER (80 MF / GS-3 RECORD) C ICYC = INT((IWRD-1)/80) + 1 C IF (RECTEST) THEN C IF (IWRD.EQ.1) WRITE(80,'(1X,''EDR TIME: '',6(1X,I3))') TIME C WRITE(80,'(22(1X,I4),4(1X,I1),2(1X,Z4.4))') & IWRD, PDIFF(1,IWRD),PDIFF(2,IWRD),PDIFF(3,IWRD), & IP, PREF(1,IP), PREF(2,IP), PREF(3,IP), & PREC(1,IWRD),PREC(2,IWRD),PREC(3,IWRD), & IWRD2,SDIFF(1,IWRD2),SDIFF(2,IWRD2),SDIFF(3,IWRD2), & IS, SREF(1,IS), SREF(2,IS), SREF(3,IS), & SREC(1,IWRD2),SREC(2,IWRD2),SREC(3,IWRD2), & OBMODE(ICYC),OBRNG(ICYC),IBMODE(ICYC),IBRNG(ICYC), & STAT1(ICYC),STAT2(ICYC) C END IF C END DO C RETURN END SUBROUTINE GS3FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C USING 48 SECOND GS-3 EDR RECORD, INTERPOLATE SECONDARY MAG C DETAIL (0.12 SEC) DATA POINTS TO PRIMARY MAG DETAIL RATE (0.06 SEC) C TO COMPUTE SPACECRAFT AND AMBIENT FIELDS. C SBK 01/07/94 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,800),GAMMA2(3,400),SCF(3,800),AMBIENT(3,800) C C IMPLEMENT SPACECRAFT FIELD COUPLING COEFFICIENT, ALPHA, C IN COMPUTATION OF S/C FIELD C C COEF = ALPHA/(1.0-ALPHA) WHERE ALPHA = .1846 C = 0.230921 C DATA ALPHA/0.1876/,COEF/0.230921/ C INCLUDE 'UNPACK.INC' C DO I=1,800 C C STEP INTERPOLATE 0.12 SECOND GS-3 SECONDARY MAG DATA C TO 0.06 SECOND PRIMARY MODE RATE C ISEC = (I-1)/2 + 1 DO J = 1,3 C C COMPUTER DIFFERENCE BETWEEN PRIMARY AND SECONDARY MAGNETOMETERS C IF (GAMMA(J,I).NE.BAD.AND. & GAMMA2(J,ISEC).NE.BAD) THEN SCF(J,I) = (GAMMA2(J,ISEC)-GAMMA(J,I))*COEF ELSE SCF(J,I) = BAD END IF C C COMPUTE AMBIENT FIELD FOR RETURN AT PRIMARY MODE RATE C IF (GAMMA(J,I).NE.BAD.AND.SCF(J,I).NE.BAD) THEN AMBIENT(J,I) = GAMMA(J,I) - SCF(J,I) ELSE AMBIENT(J,I) = BAD END IF C END DO C END DO C RETURN END ****************************************************************** * * TITLE: CONVERT RECONSTRUCTED DIGITAL VALUES INTO GAMMAS * * FILE NAME: GS3LFM.FOR * * PURPOSE: TO CONVERT DIGITAL GS-3 MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 01/06/94 ORIGINAL CODE * (MODE GS-3) * * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * * PDL: * * CALL COMMAND AND STATUS WORD EXTRACTION ROUTINE * CALL FULL WORD RECONSTRUCTION ROUTINE * CALL COUNTS TO GAMMAS CONVERSION ROUTINE * CALL SENSOR ALIGNMENT ROUTINE * CALL BOOM ALIGNMENT ROUTINE * * RETURN * ****************************************************************** SUBROUTINE GS3LFM(GAMMA,GAMMA2,BAD,TIME) C INTEGER*2 TIME(6) LOGICAL*1 SROTATE,BROTATE REAL*4 GAMMA(3,800),GAMMA2(3,400) C INCLUDE 'UNPACK.INC' C DATA SROTATE/.TRUE./, & BROTATE/.TRUE./ C SENSOR ROTATION SWITCH IF ( SYS2(13) ) SROTATE = .FALSE. C BOOM ALIGNMENT ROTATION SWITCH IF ( SYS2(23) ) BROTATE = .FALSE. C EXTRACT INSTRUMENT STATUS FROM STAT WORDS CALL MAGSTATUS(TIME,10,10) C RECONSTRUCT PRIMARY FULL WORDS FROM DIFFERENCE WORDS CALL DIFFERENCE(PDIFF,800,PREF,160,PREC) C RECONSTRUCT SECONDARY FULL WORDS FROM DIFFERENCE WORDS CALL DIFFERENCE(SDIFF,400,SREF,80,SREC) C CONVERT COUNTS INTO GAMMAS (MODE SENSITIVE) CALL MAKEGAMMAS(GAMMA,800,GAMMA2,400,10,10,BAD,TIME) C ORTHOGONALIZE DATA WITH SENSOR MATRIX AFTER GAMMAS (MODE SENSITIVE) IF ( SROTATE ) CALL SENSOR_ALIGN(GAMMA,GAMMA2,800,400,10,BAD) C ROTATE DATA WITH BOOM ALIGNMENT MATRIX AFTER GAMMAS (MODE SENSITIVE) IF ( BROTATE ) CALL BOOM_ALIGN(GAMMA,GAMMA2,800,400,10,BAD) C RETURN END SUBROUTINE GS3PNS(PRI,GAMMA2,TIME,BAD) C C USING 48 SECOND GS-3 EDR RECORD, C INTERPOLATE SECONDARY MAG DETAIL (0.12 SEC) DATA POINTS C TO PRIMARY MAG DETAIL RATE (0.06 SEC). C INTEGER*2 TIME(6) C REAL*4 PRI(3,800),GAMMA2(3,400),SEC(3,800) C INCLUDE 'UNPACK.INC' C DO I=1,800 C C STEP INTERPOLATE 0.12 SECOND GS-3 SECONDARY MAG DATA C ISEC = (I-1)/2 + 1 SEC(1,I) = GAMMA2(1,ISEC) SEC(2,I) = GAMMA2(2,ISEC) SEC(3,I) = GAMMA2(3,ISEC) C END DO C C CALL GS-3 AVERAGING ROUTINES C CALL GS3PRI(PRI,SEC,TIME,BAD) C RETURN END SUBROUTINE GS3PRI(GAMMA,SCF,TIME,BAD) C C USING 48 SECOND GS-3 EDR RECORD, C PRODUCE 48 SECOND BLOCK OF 1.92 SEC AVERAGES FROM C PRIMARY MAG DETAIL (0.06 SEC) DATA POINTS. C CHARACTER RECTYPE*4,TELFMT*4,FLTID*4 C INTEGER*2 TIME(6),EDRTIME(6),LAUNCH(6), & WORD30(2),WORD31(2),WORD32(2) C INTEGER*4 IB192(25) C REAL*4 SCF(3,800),GAMMA(3,800),FMOD(800),DEL(800),LAM(800), & B192(3,25),DEL192(25),LAM192(25),FMOD192(25), & FMAG192(25),RMS192(3,25),X192(25),Y192(25),Z192(25) C REAL*4 HDR(32),DATA(341) C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (SUMOUT(33),DATA(1)) C EQUIVALENCE (HDR(30),WORD30(1)), (HDR(31),WORD31(1)) C EQUIVALENCE (DATA(67),FMAG192(1)), (DATA(92),FMOD192(1)), & (DATA(117),DEL192(1)), (DATA(142),LAM192(1)), & (DATA(242),RMS192(1,1)),(DATA(317),IB192(1)) C C COMPUTE 25 1.92 SECOND AVERAGES FOR ONE 48 SECOND PERIOD C DO J=1,25 C I = (J-1)*32 + 1 C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(GAMMA(1,I),32,FMOD(I),DEL(I),LAM(I),BAD) C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(GAMMA(1,I),FMOD(I),32,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C WORD30(1) = 800 WORD30(2) = 400 WORD31(1) = 160 WORD31(2) = 80 C C COMPUTE 48 SECOND AVERAGE OF THE SPACECRAFT FIELD C CALL GS3SCF(SCF(1,1),TIME,BAD) C C COMPUTE 9.6 SECOND AVERAGES AND 48 SECOND AVERAGES C CALL BIGAVE(B192,TIME,BAD) C RETURN END SUBROUTINE GS3SCF(SCF,TIME,BAD) C C COMPUTE 48 SECOND AVERAGED SPACECRAFT FIELD FOR GS-3 RECORD C C INPUT 48 SECONDS OF DETAIL SPACECRAFT FIELD - SCF C OUTPUT RMS(SCF)(1,2,3), #DETAIL PTS, SCF(1,2,3), NORM(SCF(1,2,3) C INTEGER*2 TIME(6) C INTEGER*4 IB192(25),IB96(5),IB48 C REAL*4 SCFLD(155),SCF(3,800),FMOD(800),DEL(800),LAM(800), & FMAG192(25),FMOD192(25),DEL192(25), & LAM192(25),B192(3,25),RMS192(3,25), & X192(25),Y192(25),Z192(25), & XRMS192(25),YRMS192(25),ZRMS192(25), & FMAG96(5),FMOD96(5),DEL96(5), & LAM96(5),B96(3,5),RMS96(3,5), & X96(5),Y96(5),Z96(5), & XRMS96(5),YRMS96(5),ZRMS96(5), & FMAG48,FMOD48,DEL48, & LAM48,B48(3),RMS48(3), & X48,Y48,Z48,HG(3,25), & SPV(6),RANGE,ANG(2), & MTB(3,3),MTB5(3,3),MHG(3,3) C REAL*8 TD,TN,TP C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(342),SCFLD(1)) C EQUIVALENCE (SCFLD(148),RMS48(1)), (SCFLD(151),IB48), & (SCFLD(152),X48), (SCFLD(153),Y48), & (SCFLD(154),Z48), (SCFLD(155),FMOD48) C C COMPUTE DETAIL FIELD MODULUS AND ANGLES FOR 48 SECOND PERIOD C CALL ANGLES(SCF,800,FMOD,DEL,LAM,BAD) C C COMPUTE 25 1.92 SECOND AVERAGES FOR 48 SECOND PERIOD C DO J=1,25 C I = (J-1)*32 + 1 C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(SCF(1,I),FMOD(I),32,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C C ROTATE 1.92 SECOND AVERAGES C IF ( .NOT.SYS2(9) ) THEN CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) CALL ROTATE(HG,B192,MHG,25,BAD) DO I192 = 1,25 B192(1,I192) = HG(1,I192) B192(2,I192) = HG(2,I192) B192(3,I192) = HG(3,I192) END DO END IF C C GENERIC AVERAGING ROUTINE TO COMPUTE 9.6 AND 48 SECOND AVERAGES C DO I = 1,25,5 C C COMPUTE 1.92 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B192(1,I),5,FMOD192(I),DEL192(I),LAM192(I),BAD) C J = (I-1)/5 + 1 C C COMPUTE 9.6 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B192(1,I),FMOD192(I),5,B96(1,J),FMAG96(J),RMS96(1,J), & IB96(J),BAD) C END DO C C COMPUTE 9.6 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B96,5,FMOD96,DEL96,LAM96,BAD) C C COMPUTE 48 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B96,FMOD96,5,B48,FMAG48,RMS48,IB48,BAD) C C COMPUTE 48 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B48,1,FMOD48,DEL48,LAM48,BAD) C C SEPARATE FIELD COMPONENT VECTORS FROM MATRICES C DO I96 = 1,5 X96(I96) = B96(1,I96) Y96(I96) = B96(2,I96) Z96(I96) = B96(3,I96) XRMS96(I96) = RMS96(1,I96) YRMS96(I96) = RMS96(2,I96) ZRMS96(I96) = RMS96(3,I96) DO J = 1,5 I192 = (I96-1)*5 + J X192(I192) = B192(1,I192) Y192(I192) = B192(2,I192) Z192(I192) = B192(3,I192) XRMS192(I192) = RMS192(1,I192) YRMS192(I192) = RMS192(2,I192) ZRMS192(I192) = RMS192(3,I192) END DO END DO X48 = B48(1) Y48 = B48(2) Z48 = B48(3) C RETURN END SUBROUTINE GS3SEC(GAMMA2,SCF,TIME,BAD) C C USING 48 SECOND GS-3 EDR RECORD, C INTERPOLATE SECONDARY MAG DETAIL (0.12 SEC) DATA POINTS C TO PRIMARY MAG DETAIL RATE (0.06 SEC). C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,800),GAMMA2(3,400),SCF(3,800) C INCLUDE 'UNPACK.INC' C DO I=1,800 C C STEP INTERPOLATE 0.12 SECOND GS-3 SECONDARY MAG DATA C ISEC = (I-1)/2 + 1 GAMMA(1,I) = GAMMA2(1,ISEC) GAMMA(2,I) = GAMMA2(2,ISEC) GAMMA(3,I) = GAMMA2(3,ISEC) C END DO C C CALL GS-3 AVERAGING ROUTINES C CALL GS3PRI(GAMMA,SCF,TIME,BAD) C RETURN END SUBROUTINE HDR1OUT(IUNIT,EDRTIME,EDRDSN,SEDRDSN,ZERODSN,SENSDSN) C C THIS ROUTINE WRITES THE HDR1 RECORD WHICH CONTAINS INFORMATION ABOUT C PROCESSING PARAMETERS, RUN-TIME INPUT AND BASIC SPACECRAFT TELEMETRY. C THE HDR1 RECORD APPEARS AS THE FIRST AND LAST FILE OF BOTH SUMMARY C AND DETAIL FILES. C C WRITTEN BY SANDY KRAMER, HSTX, CODE 692 C CHARACTER TFLAG*4,RECTYPE*4,FLTID*4,TIMEFMT*4,TELFMT*4, & RUNTYPE*8,COORD*4,RUNTIME*9,RUNMONTH*4, & ZERODSN*8,SENSDSN*8,ZERONAME*8,SENSNAME*8, & EDRDSN(10)*8,SEDRDSN(6)*8,EDRNAME(10)*8, & SEDRNAME(6)*8,DM(0:31)*4 INTEGER*2 EDRTIME(6),TIME(6),DATAID(2),WORD32(2) INTEGER*4 RUNDAY,RUNYEAR,CALDAY LOGICAL*1 MAGSYS(32),EDRSYS(32) REAL*4 HDR1(100) C INCLUDE 'UNPACK.INC' C EQUIVALENCE (HDR1(1),RECTYPE), (HDR1(2),TELFMT), & (HDR1(3),FLTID), (HDR1(4),TIME(1)), & (HDR1(7),RUNYEAR), (HDR1(8),CALDAY), & (HDR1(9),RUNMONTH), (HDR1(10),RUNDAY), & (HDR1(11),RUNTYPE), (HDR1(13),COORD), & (HDR1(17),DATAID(1)), (HDR1(32),WORD32(1)), & (HDR1(33),EDRNAME(1)), (HDR1(53),SEDRNAME(1)), & (HDR1(69),EDRSYS), (HDR1(77),MAGSYS), & (HDR1(93),ZERONAME), (HDR1(95),SENSNAME) C DATA DM/'ENG ','CR-2','CR-3','CR-4','CR-5','CR-6','CR-7','CR-1', & 'G10A','****','GS-3','****','GS-7','****','GS-6','GS-4', & '****','GS-2','****','****','****','****','OC-2','OC-1', & 'CR5A','GS10','GS-8','****','****','UV5A','****','****'/ C C OUTPUT RECORD COUNTER C RECWRITE = RECWRITE + 1 C C GET SYSTEM DATE ( DD-MMM-YY ) C CALL DATE(RUNTIME) RUNMONTH = ' '//RUNTIME(4:6) READ(RUNTIME,'(7X,I2)') RUNYEAR IF ( RUNYEAR.GT.77 ) THEN RUNYEAR = RUNYEAR + 1900 ELSE RUNYEAR = RUNYEAR + 2000 END IF READ(RUNTIME,'(I2,7X)') RUNDAY IF (RUNMONTH.EQ.'JAN') THEN CALDAY = 1 ELSE IF (RUNMONTH.EQ.' FEB') THEN CALDAY = 32 ELSE IF (RUNMONTH.EQ.' MAR') THEN CALDAY = 60 ELSE IF (RUNMONTH.EQ.' APR') THEN CALDAY = 91 ELSE IF (RUNMONTH.EQ.' MAY') THEN CALDAY = 121 ELSE IF (RUNMONTH.EQ.' JUN') THEN CALDAY = 152 ELSE IF (RUNMONTH.EQ.' JUL') THEN CALDAY = 182 ELSE IF (RUNMONTH.EQ.' AUG') THEN CALDAY = 213 ELSE IF (RUNMONTH.EQ.' SEP') THEN CALDAY = 244 ELSE IF (RUNMONTH.EQ.' OCT') THEN CALDAY = 274 ELSE IF (RUNMONTH.EQ.' NOV') THEN CALDAY = 305 ELSE IF (RUNMONTH.EQ.' DEC') THEN CALDAY = 335 ELSE CALDAY = -1 END IF IF (MOD(RUNYEAR,4).EQ.0.AND.CALDAY.GT.1) CALDAY = CALDAY + 1 CALDAY = CALDAY + RUNDAY - 1 C RECTYPE = 'HDR1' IF ( SYS2(17) .OR. SYS2(18) .OR. SYS2(19) .OR. SYS2(20) ) THEN RUNTYPE = 'ENCOUNTR' ELSE RUNTYPE = 'CRUISE' END IF IF ( SYS2(7).OR..NOT.SYS2(9) ) THEN COORD = 'HG ' ELSE COORD = 'PL ' END IF DATAID(1) = 8 WORD32(1) = RECWRITE WORD32(2) = 68 C C TELEMETRY FORMAT C TELFMT = DM(DATMOD) C C S/C ID C IF (SCID.EQ.0) THEN FLTID = 'FLT2' ELSE IF (SCID.EQ.1) THEN FLTID = 'FLT1' ELSE IF (SCID.EQ.2) THEN FLTID = 'PTM ' ELSE IF (SCID.EQ.3) THEN FLTID = 'SIM1' ELSE IF (SCID.EQ.4) THEN FLTID = 'SIM2' ELSE FLTID = 'UKWN' END IF C C DATA TIME C DO I = 1,6 TIME(I) = EDRTIME(I) END DO C C MAG SWITCHING VECTORS C DO I = 1,32 MAGSYS(I) = SYS2(I) END DO C C EDR DATA SET NAME(S) C DO I = 1,10 EDRNAME(I) = EDRDSN(I) END DO C C SEDR DATA SET NAME(S) C DO I = 1,6 SEDRNAME(I) = SEDRDSN(I) END DO C C ZERO TABLE NAME C ZERONAME = ZERODSN C C SENSITIVITY TABLE NAME C SENSNAME = SENSDSN C WRITE(IUNIT) HDR1 C RETURN END SUBROUTINE HEADCHK(RECLEN,NCNT,ISTAT) C C THIS ROUTINE CHECKS KEY EDR HEADER BLOCK FIELDS FOR ACCEPTABLE VALUES. C THE ERROR FLAG ISTAT IS SET AT FIRST OCCURANCE OF AN IMPROPER VALUE AND C THE ROUTINE IS EXITTED. C C ISTAT = 0 GOOD RETURN C ISTAT = 1 BAD RETURN C C SANDY KRAMER 08/11/94 C INTEGER*2 RECLEN C INCLUDE 'UNPACK.INC' C IF ( RECLEN.NE.716 .AND. & RECLEN.NE.1712 .AND. & RECLEN.NE.3704 .AND. & RECLEN.NE.3860 .AND. & RECLEN.NE.3992 .AND. & RECLEN.NE.5848 .AND. & RECLEN.NE.6512 .AND. & RECLEN.NE.6536 .AND. & RECLEN.NE.11280 ) THEN WRITE(6,800) RECLEN,NCNT ISTAT = 1 RETURN ELSE IF ( RECID.LT.0 .OR. RECID.GT.15 ) THEN WRITE(6,801) NCNT ISTAT = 1 RETURN ELSE IF ( DATMOD.LT.0 .OR. DATMOD.GT.31 ) THEN WRITE(6,802) NCNT ISTAT = 1 RETURN ELSE IF ( DRSDAT.LT.32 .OR. DRSDAT.GT.48 ) THEN WRITE(6,803) NCNT ISTAT = 1 RETURN ELSE IF ( YEAR3.LT.0 .OR. YEAR3.GT.99 ) THEN WRITE(6,804) NCNT ISTAT = 1 RETURN ELSE IF ( SCETHR.LT.0 .OR. SCETHR.GT.8784 ) THEN WRITE(6,805) NCNT ISTAT = 1 RETURN ELSE IF ( SCETSC.LT.0 .OR. SCETSC.GT.3600 ) THEN WRITE(6,806) NCNT ISTAT = 1 RETURN ELSE IF ( SCETML.LT.0 .OR. SCETML.GT.999 ) THEN WRITE(6,807) NCNT ISTAT = 1 RETURN ELSE ISTAT = 0 END IF C RETURN 800 FORMAT(1X,'*HEADCHK* INVALID RECORD LENGTH OF ',I5.5, & ' BYTES AT RECORD',1X,I5) 801 FORMAT(1X,'*HEADCHK* INVALID RECORD IDENTIFICATION AT RECORD', & 1X,I5) 802 FORMAT(1X,'*HEADCHK* INVALID DATA MODE AT RECORD',1X,I5) 803 FORMAT(1X,'*HEADCHK* INVALID DRS DATA TYPE AT RECORD',1X,I5) 804 FORMAT(1X,'*HEADCHK* INVALID SCET YEAR AT RECORD',1X,I5) 805 FORMAT(1X,'*HEADCHK* INVALID SCET HOUR AT RECORD',1X,I5) 806 FORMAT(1X,'*HEADCHK* INVALID SCET SECONDS AT RECORD',1X,I5) 807 FORMAT(1X,'*HEADCHK* INVALID SCET MILLISECONDS AT RECORD',1X,I5) END SUBROUTINE HEADFILL(TFLAG,EDRTIME,SCMODE) C C FILL SUMMARY HEADER BLOCK C CHARACTER TFLAG*4,RECTYPE*4,FLTID*4,TIMEFMT*4,TELFMT*4, & DM(0:31)*4 C INTEGER*2 EDRTIME(6),TIME(6),CURRYEAR(6),LAUNCH(6),MODCNT(3), & DATATYPE(2),COUNT(2),MAGCOMM(2),STATUS(2) C INTEGER*4 SCMODE C REAL*4 HDR(32) C REAL*8 DD,TD C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)) C EQUIVALENCE (HDR(1),RECTYPE), (HDR(2),TELFMT), & (HDR(3),FLTID), (HDR(4),TIME(1)), & (HDR(7),DD), (HDR(9),TD), & (HDR(11),TIMEFMT(1:1)), (HDR(12),TIMEPD), & (HDR(13),MODCNT(1)), (HDR(15),STATUS(1)), & (HDR(16),MAGCOMM(1)), (HDR(17),DATATYPE(1)), & (HDR(32),COUNT(1)) C DATA DM/'ENG ','CR-2','CR-3','CR-4','CR-5','CR-6','CR-7','CR-1', & 'G10A','****','GS-3','****','GS-7','****','GS-6','GS-4', & '****','GS-2','****','****','****','****','OC-2','OC-1', & 'CR5A','GS10','GS-8','****','****','UV5A','****','****'/ C C DATA TIME C DO I = 1,6 TIME(I) = EDRTIME(I) END DO C C TIME TYPE C TIMEFMT = TFLAG C LAUNCH(1) = 77 LAUNCH(2) = 232 LAUNCH(3) = 0 LAUNCH(4) = 0 LAUNCH(5) = 0 LAUNCH(6) = 0 CALL ELPSTIME(LAUNCH,TIME,TD) C CURRYEAR(1) = TIME(1) CURRYEAR(2) = 1 CURRYEAR(3) = 0 CURRYEAR(4) = 0 CURRYEAR(5) = 0 CURRYEAR(6) = 0 CALL ELPSTIME(CURRYEAR,TIME,DD) C C TELEMETRY FORMAT C TELFMT = DM(DATMOD) C C S/C ID C IF (SCID.EQ.0) THEN FLTID = 'FLT2' ELSE IF (SCID.EQ.1) THEN FLTID = 'FLT1' ELSE IF (SCID.EQ.2) THEN FLTID = 'PTM ' ELSE IF (SCID.EQ.3) THEN FLTID = 'SIM1' ELSE IF (SCID.EQ.4) THEN FLTID = 'SIM2' ELSE FLTID = 'UKWN' END IF C C COUNTERS C MODCNT(1) = MOD216 MODCNT(2) = MOD60 MODCNT(3) = LINCNT C C ASSIGN FIRST MAG STATUS WORD OF SUB-HEADER BLOCK TO SUMMARY HEADER C STATUS(1) = STAT1(1) STATUS(2) = STAT2(1) C C MAG COMMAND WORD C MAGCOMM(1) = MCOMM1(1) MAGCOMM(2) = MCOMM2(1) C C DATA RATE C DATATYPE(2) = SCMODE C RETURN END SUBROUTINE HG(MHG,MTB,MSUN) C C COMPUTE PAYLOAD TO HG ROTATION MATRIX (MHG). C REAL*4 MHG(3,3),MTB(3,3),MSUN(3,3) C MHG(1,1) = MTB(1,1)*MSUN(1,1) + MTB(1,2)*MSUN(2,1) + & MTB(1,3)*MSUN(3,1) MHG(1,2) = MTB(1,1)*MSUN(1,2) + MTB(1,2)*MSUN(2,2) + & MTB(1,3)*MSUN(3,2) MHG(1,3) = MTB(1,1)*MSUN(1,3) + MTB(1,2)*MSUN(2,3) + & MTB(1,3)*MSUN(3,3) C MHG(2,1) = MTB(2,1)*MSUN(1,1) + MTB(2,2)*MSUN(2,1) + & MTB(2,3)*MSUN(3,1) MHG(2,2) = MTB(2,1)*MSUN(1,2) + MTB(2,2)*MSUN(2,2) + & MTB(2,3)*MSUN(3,2) MHG(2,3) = MTB(2,1)*MSUN(1,3) + MTB(2,2)*MSUN(2,3) + & MTB(2,3)*MSUN(3,3) C MHG(3,1) = MTB(3,1)*MSUN(1,1) + MTB(3,2)*MSUN(2,1) + & MTB(3,3)*MSUN(3,1) MHG(3,2) = MTB(3,1)*MSUN(1,2) + MTB(3,2)*MSUN(2,2) + & MTB(3,3)*MSUN(3,2) MHG(3,3) = MTB(3,1)*MSUN(1,3) + MTB(3,2)*MSUN(2,3) + & MTB(3,3)*MSUN(3,3) C RETURN END SUBROUTINE IHG(MSUN,M5,MPE) C C COMPUTE THE PAYLOAD TO IHG TRANSFORMATION MATRIX (MSUN). C REAL*4 MSUN(3,3),M5(3,3),MPE(3,3) C MSUN(1,1) = M5(1,1)*MPE(1,1) + M5(1,2)*MPE(2,1) + M5(1,3)*MPE(3,1) MSUN(1,2) = M5(1,1)*MPE(1,2) + M5(1,2)*MPE(2,2) + M5(1,3)*MPE(3,2) MSUN(1,3) = M5(1,1)*MPE(1,3) + M5(1,2)*MPE(2,3) + M5(1,3)*MPE(3,3) C MSUN(2,1) = M5(2,1)*MPE(1,1) + M5(2,2)*MPE(2,1) + M5(2,3)*MPE(3,1) MSUN(2,2) = M5(2,1)*MPE(1,2) + M5(2,2)*MPE(2,2) + M5(2,3)*MPE(3,2) MSUN(2,3) = M5(2,1)*MPE(1,3) + M5(2,2)*MPE(2,3) + M5(2,3)*MPE(3,3) C MSUN(3,1) = M5(3,1)*MPE(1,1) + M5(3,2)*MPE(2,1) + M5(3,3)*MPE(3,1) MSUN(3,2) = M5(3,1)*MPE(1,2) + M5(3,2)*MPE(2,2) + M5(3,3)*MPE(3,2) MSUN(3,3) = M5(3,1)*MPE(1,3) + M5(3,2)*MPE(2,3) + M5(3,3)*MPE(3,3) C RETURN END SUBROUTINE INC_TIME(TIME,DELTA) C C INCREMENT CALENDAR TIME (YY,DDD,HH,MM,SS,FFF) BY DELTA(6) C INTEGER*2 TIME(6),DELTA(6) C IYR = TIME(1) LEAP = 365 IF (MOD(IYR,4).EQ.0) LEAP = 366 C TIME(6) = TIME(6) + DELTA(6) IF (TIME(6).GT.999) THEN TIME(5) = TIME(5) + 1 TIME(6) = TIME(6) - 1000 END IF C TIME(5) = TIME(5) + DELTA(5) IF (TIME(5).GT.59) THEN TIME(4) = TIME (4) + 1 TIME(5) = TIME (5) - 60 END IF C TIME(4) = TIME(4) + DELTA(4) IF (TIME(4).GT.59) THEN TIME(3) = TIME(3) + 1 TIME(4) = TIME(4) - 60 END IF C TIME(3) = TIME(3) + DELTA(3) IF (TIME(3).GT.23) THEN TIME(2) = TIME(2) + 1 TIME(3) = TIME(3) - 24 END IF C TIME(2) = TIME(2) + DELTA(2) IF (TIME(2).GT.LEAP) THEN TIME(1) = TIME(1) + 1 TIME(2) = TIME(2) - LEAP IF (TIME(1).GT.99) TIME(1) = TIME(1) - 100 END IF C TIME(1) = TIME(1) + DELTA(1) C RETURN END REAL*8 FUNCTION LEAP(YEAR) C C CONVERT INTEGER*2 YEAR INTO DOUBLE PRECISION DAYS C SBK 07/07/94 C INTEGER*2 YEAR C IYR = YEAR IF (MOD(IYR,4).EQ.0) THEN LEAP = 366.0D0 ELSE LEAP = 365.0D0 END IF 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 SUBROUTINE MAGSTATUS(TIME,NSTAT1,NSTAT2) C C THIS ROUTINE EXTRACTS VALUES FROM THE TWO STATUS WORDS, STAT1 AND STAT2, C THAT WERE UNPACKED FROM THE PLASMA SUB-HEADER BLOCK. STAT1 CONTAINS RANGE C AND MODE VALUES. STAT2 CONTAINS SENSOR STATES. C INTEGER*2 TIME(6), STAT2TEST(0:15,4) INTEGER*4 OBDIFF,IBDIFF C C ARRAY INDEX 0 NOT USED IN ALL LOGICAL*1 EXTRACTED STATUS WORD VARIABLES C DATA ICALL/0/ C INCLUDE 'UNPACK.INC' C IUNIT = 88 ICALL = ICALL + 1 C C FORTRAN OUTPUT UNIT ASSIGNED TO FILE NAME IN VMS DCL ROUTINE CALLING C THE VOYPROD EXECUTABLE ex. $ ASSIGN FILE.DAT FOR088 C IF ( SYS2(25) .AND. ICALL.EQ.1 ) THEN OPEN(IUNIT,STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST',RECL=132) C & CARRIAGECONTROL='LIST',RECL=80) WRITE(IUNIT,'(''REC MODE TIME'')') WRITE(IUNIT,'('' YY DDD HH MM SS MS STAT2 EFLIP '', & ''PRIME OBLCK OBFLP IBLCK IBFLP MPROC POLAR '', & ''IBCAL OBCAL'')') END IF C C GET INSTRUMENT STATUS VALUES FROM SECOND STATUS WORD C DO I = 1,NSTAT2 C C ELECTRICAL FLIPPER STATUS C EFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 0, 1, EFLIP(I), 0) C C EXTRACT PRIME LFM STATUS C PRIME(I) = .FALSE. CALL MOVBIT(STAT2(I), 1, 1, PRIME(I), 0) C C EXTRACT OUTBOARD LFM FLIPPER LOCK STATUS C OBLOCK(I) = .FALSE. CALL MOVBIT(STAT2(I), 2, 1, OBLOCK(I), 0) C C OUTBOARD LFM FLIP STATUS C OBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 3, 1, OBFLIP(I), 0) C C EXTRACT OUTBOARD LFM FLIPPER LOCK STATUS C IBLOCK(I) = .FALSE. CALL MOVBIT(STAT2(I), 4, 1, IBLOCK(I), 0) C C INBOARD LFM FLIP STATUS C IBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 5, 1, IBFLIP(I), 0) C C EXTRACT PROCESSOR STATUS C MPROC(I) = .FALSE. CALL MOVBIT(STAT2(I), 6, 1, MPROC(I), 0) C C EXTRACT POLARITY C POLAR(I) = .FALSE. CALL MOVBIT(STAT2(I), 7, 1, POLAR(I), 0) C C INBOARD LFM FLIGHT CALIBRATION INDICATOR C IBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 10, 1, IBCAL(I), 0) C C OUTBOARD LFM FLIGHT CALIBRATION INDICATOR C OBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 11, 1, OBCAL(I), 0) C IF ( SYS2(25) ) THEN WRITE(IUNIT,880) RECNUM,DATMOD,TIME,STAT2(I),EFLIP(I),PRIME(I), & OBLOCK(I),OBFLIP(I),IBLOCK(I),IBFLIP(I),MPROC(I),POLAR(I), & IBCAL(I),OBCAL(I) END IF 880 FORMAT(I5.5,1X,I2,3X,I2.2,1X,I3.3,3(1X,I2.2),1X,I3.3, & 1X,Z4.4,2X,10(Z1,5X)) END DO C C GET INSTRUMENT STATUS VALUES FROM FIRST STATUS WORD C DO I=1,NSTAT1 C C CHECK FOR RANGE OVERRIDE C IF ( RNGSET.NE.-1 ) THEN OBRNG(I) = RNGSET IBRNG(I) = RNGSET GOTO 100 END IF C C EXTRACT OUTBOARD AND INBOARD RANGE MODES [0,1] C IF ( MODSET.EQ.-1 ) THEN CALL MOVBIT(STAT1(I), 11, 1, OBMODE(I), 0) CALL MOVBIT(STAT1(I), 7, 1, IBMODE(I), 0) ELSE IF ( MODSET.EQ.0 ) THEN OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. ELSE IF ( MODSET.EQ.1 ) THEN OBMODE(I) = .TRUE. IBMODE(I) = .TRUE. END IF C C EXTRACT OUTBOARD AND INBOARD RANGE SENSITIVITIES [0,7] C DO J = 1,3 CALL MOVBIT(STAT1(I), 11-J, 1, OBRNG(I), J-1) CALL MOVBIT(STAT1(I), 7-J, 1, IBRNG(I), J-1) END DO C C TEST FOR RANGE ERRORS. SENSITIVITY MAY CHANGE ONLY BY ONE C IN AUTO RANGE MODE (XXMODE = 1). C IBDIFF = ABS(IBRNG(I)-IBRNG(I-1)) OBDIFF = ABS(OBRNG(I)-OBRNG(I-1)) C C INBOARD MAG RANGE CHECK C IF ( IBDIFF.GT.1 .AND. IBMODE(I) .AND. IBMODE(I-1) ) THEN WRITE(68,889) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) IBRNG(I) = IBRNG(I-1) IBMODE(I) = IBMODE(I-1) ELSE IF ( IBDIFF.NE.0 ) THEN WRITE(68,899) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) END IF C C OUTBOARD MAG RANGE CHECK C IF ( OBDIFF.GT.1 .AND. OBMODE(I) .AND. OBMODE(I-1) ) THEN WRITE(68,888) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) OBRNG(I) = OBRNG(I-1) OBMODE(I) = OBMODE(I-1) ELSE IF ( OBDIFF.NE.0 ) THEN WRITE(68,898) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) END IF C 100 CONTINUE C END DO C C PUT LAST RANGE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBRNG(0) = IBRNG(NSTAT1) OBRNG(0) = OBRNG(NSTAT1) C C PUT LAST MODE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBMODE(0) = IBMODE(NSTAT1) OBMODE(0) = OBMODE(NSTAT1) C RETURN 888 FORMAT(1X,'*MAGSTATUS* OUTBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 889 FORMAT(1X,'*MAGSTATUS* INBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 898 FORMAT(1X,'*MAGSTATUS* OUTBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 899 FORMAT(1X,'*MAGSTATUS* INBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 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 SUBROUTINE MAG_SENS(SENSDSN) C C READ MAG SENSITIVITIES C SBK 12/14/93 C CHARACTER SENSDSN*8 CHARACTER*72 LINE(100) INTEGER*4 RANGE C INCLUDE 'UNPACK.INC' C I = 1 5 CONTINUE READ(51,'(A72)',END=10,ERR=5) LINE(I) I = I + 1 GOTO 5 10 CONTINUE ILINE = I - 1 C IF (ILINE.EQ.0) THEN WRITE(68,*) WRITE(68,*) '***EMPTY MAG SENSITIVITIES FILE DETECTED***' STOP END IF C C GET SENSITIVITIES FILE NAME C READ(LINE(1)(1:8),'(A8)') SENSDSN C K = 2 DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C INBOARD MAGNETOMETER SENSITIVITIES C DO I=0,7 READ(LINE(K+I),*) RANGE,(IBSENS(J,RANGE),J=1,3) END DO K = K + 8 DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C OUTBOARD MAGNETOMETER SENSITIVITIES C DO I=0,7 READ(LINE(K+I),*) RANGE,(OBSENS(J,RANGE),J=1,3) END DO K = K + 8 DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C RETURN END PROGRAM VOYPROD C C EDR UNPACKING PROGRAM WRITTEN FOR EXECUTION UNDER VMS SYSTEM ENVIRONMENT. C C 1. EDR INPUT DATA IS WRITTEN FOR THE IBM 360 ARCHITECTURE. C 2. NAVIGATION INPUT DATA IS EXPECTED TO BE IN VAX G_FLOATING FORMAT. C 3. SOURCE MUST BE COMPILED WITH DEC FORTRAN VERSION 6.0 OR HIGHER. C 4. SOURCE MUST BE COMPILED WITH THE /ALIGN QUALIFIER ON ALPHA VMS. C 5. USE THE /FLOAT=IEEE FLAG TO PRODUCE SUMMARY OUTPUT DATA IN IEEE FORMAT. C (IEEE ON VMS SYSTEMS IS LITTLE ENDIAN). C C ORIGINAL CODE WRITTEN BY SANDY KRAMER, HUGHES-STX, CODE 692, NASA GSFC. C C FIRST RELEASE 12/01/93 VIM-5 CRUISE MODE ONLY AVAILABLE. C SECOND RELEASE 05/26/94 GS-X ENCOUNTER MODE ADDED. C THIRD RELEASE 10/21/94 CR-5 CRUISE MODE ADDED (FULL WORDS ONLY). C FOURTH RELEASE 07/09/95 PLANETARY COORDINATE TRANSFORMATIONS ADDED. C FIFTH RELEASE 10/11/95 CR-1 CRUISE MODE ADDED. C SIXTH RELEASE 03/21/96 CR-6 CRUISE MODE ADDED (FULL WORDS ONLY). C SEVENTH RELEASE 03/22/96 CR-2 CRUISE MODE ADDED. C EIGHTH RELEASE 03/25/96 CR-3 CRUISE MODE ADDED. C NINTH RELEASE 03/26/96 CR-4 CRUISE MODE ADDED. C TENTH RELEASE 05/09/96 CR-5 DELTA MODULATION ADDED. C ELEVENTH RELEASE 01/30/2006 VIM-5 COMPOSITE MAG ADDED C TWELTH RELEASE 04/24/2006 DUMP CALIBRATION GAMMAS C THIRTEENTH RELEASE 07/12/2006 READ SECONDS LEVEL ZERO DATA C C Notes: C CR-6 delta modulation not properly implemented by JPL. C Process CR-6 data using full words only. C CHARACTER TFLAG*4,SYSTIME(2)*8,ZERONAME*8,SENSDSN*8, & EDRDSN(10)*8,SEDRDSN(6)*8,SYSDATE*9,DSN*50, & OLDZERO*8,FILENAME*8 C INTEGER*2 RECLEN,EDRTIME(6),SCETIME(6),EERTIME(6),SERTIME(6), & OLDTIME(6),STIME(6),ETIME(6),ZEROTIME(6) C INTEGER*4 YEAR,MODE,SCMODE,OLDMODE,ZFLIGHT,MODECNT(-1:13)/15*0/ C LOGICAL*1 REC(11280),FIRST,LAST C REAL*4 GAMMA(3,2400),GAMMA2(3,2400) C REAL*8 REALTIME,START,STOP,LEAP,DELTA,SCTDIFF, & DIST,OLDDIST,DISTLM,CURRTIME C INCLUDE 'UNPACK.INC' C C GET CURRENT DATE AND TIME C CALL DATE(SYSDATE) CALL TIME(SYSTIME(1)) 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 PROGRAM LOG FILE C WRITE(6,*) 'ENTER LOG FILE NAME' READ(5,'(A)') DSN OPEN(68,FILE=DSN,STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST') WRITE(68,*) 'LOG FILE NAME: ',DSN C C OPEN NAVIGATION FILE FOR READING. EXPECT UNFORMATTED, VAXG FLOATING C POINT DATA. C WRITE(6,*) 'ENTER NAVIGATION FILE NAME' READ(5,'(A)') DSN OPEN(41,FILE=DSN,STATUS='OLD',CONVERT='VAXG', & FORM='UNFORMATTED',RECORDTYPE='VARIABLE',READONLY) WRITE(68,*) 'NAVIGATION FILE NAME: ',DSN SEDRDSN(1) = FILENAME(DSN) C C OPEN POINTING VECTOR FILE FOR READING C WRITE(6,*) 'ENTER POINTING VECTOR FILE NAME' READ(5,'(A)') DSN OPEN(40,FILE=DSN,STATUS='OLD',FORM='FORMATTED',READONLY) WRITE(68,*) 'POINTING VECTOR FILE NAME: ',DSN C C GET MAG ZERO OFFSETS FROM TABLE FILE C WRITE(6,*) 'ENTER ZEROES FILE NAME' READ(5,'(A)') DSN OPEN(50,FILE=DSN,STATUS='OLD',FORM='FORMATTED',READONLY) WRITE(68,*) 'ZEROES FILE NAME: ',DSN C C GET MAG SENSITIVITIES C WRITE(6,*) 'ENTER SENSITIVITIES FILE NAME' READ(5,'(A)') DSN OPEN(51,FILE=DSN,STATUS='OLD',FORM='FORMATTED',READONLY) WRITE(68,*) 'SENSITIVITIES FILE NAME: ',DSN CALL MAG_SENS(SENSDSN) CLOSE(51) C C GET SENSOR ALIGNMENT MATRICES C WRITE(6,*) 'ENTER SENSOR ALIGNMENT FILE NAME' READ(5,'(A)') DSN OPEN(52,FILE=DSN,STATUS='OLD',FORM='FORMATTED',READONLY) WRITE(68,*) 'SENSOR ALIGNMENT FILE NAME: ',DSN CALL SENSOR_DAT() CLOSE(52) C C GET BOOM ALIGNMENT MATRICES C WRITE(6,*) 'ENTER BOOM ALIGNMENT FILE NAME' READ(5,'(A)') DSN OPEN(53,FILE=DSN,STATUS='OLD',FORM='FORMATTED',READONLY) WRITE(68,*) 'BOOM ALIGNMENT FILE NAME: ',DSN CALL BOOM_DAT() CLOSE(53) C C OPEN BINARY EDR INPUT DATASET C WRITE(6,*) 'ENTER EDR FILE NAME' READ(5,'(A)') DSN OPEN(54,FILE=DSN,STATUS='OLD',FORM='FORMATTED', & RECORDTYPE='VARIABLE',RECL=8191,READONLY) WRITE(68,*) 'EDR FILE NAME: ',DSN EDRDSN(1) = FILENAME(DSN) C C OPEN OUTPUT DATA SET C WRITE(6,*) 'ENTER OUTPUT DATA FILE NAME' READ(5,'(A)') DSN OPEN(66,FILE=DSN,STATUS='NEW', & FORM='UNFORMATTED',RECORDTYPE='VARIABLE',RECL=8191) WRITE(68,*) 'OUTPUT FILE NAME: ',DSN C C READ SYSTEM FLAGS C CALL GETFLAGS() CALL FLAGS() C C SELECT START AND STOP TIMES C CALL TBOUND(START,STOP) C WRITE(6,*) WRITE(6,*) 'SELECT TIME TYPE (SCET,ERTS,ERTE)' READ(5,'(A)') TFLAG C WRITE(6,*) 'SELECT LIMITS FOR ONE WAY LIGHT TIME DEVIATION' WRITE(6,*) 'SELECT LIMIT FOR MAXIMUM TIME PROGRESSION (SECONDS)' READ(5,*) DISTLM WRITE(6,*) & 'RANGE BIT OVERRIDE ( -1 DISABLE, 0 - 7 TO FORCE VALUE )' READ(5,*) RNGSET WRITE(6,*) 'INBOARD LFM STARTING RANGE VALUE (0,7)' READ(5,*) IBRNG(0) WRITE(6,*) 'OUTBOARD LFM STARTING RANGE VALUE (0,7)' READ(5,*) OBRNG(0) WRITE(6,*) 'MODE BIT OVERRIDE ( -1 DISABLE, 0 MANUAL, 1 AUTO )' READ(5,*) MODSET WRITE(6,*) & 'INBOARD LFM STARTING RANGE MODE VALUE (T-AUTO,F-MANUAL)' READ(5,'(L1)') IBMODE(0) WRITE(6,*) & 'OUTBOARD LFM STARTING RANGE MODE VALUE (T-AUTO,F-MANUAL)' READ(5,'(L1)') OBMODE(0) WRITE(6,*) & 'PRIME LFM START VALUE (T-INBOARD PRIME, F-OUTBOARD PRIME)' READ(5,'(L1)') PRIME(0) WRITE(6,*) 'FILTER PARAMETER (REJECTION LEVEL)' READ(5,*) SIGK WRITE(6,*) 'FILTER PARAMETER (# PASSES)' READ(5,*) NPASS C WRITE(68,*) WRITE(68,'(1X,''TIME TYPE: '',A4)') TFLAG C WRITE(68,'(1X,''ONE WAY LIGHT TIME DEVIATION: '',F7.3)') DISTLM WRITE(68,'(1X,''MAXIMUM TIME PROGRESSION (SECONDS): '',F8.0)') DISTLM WRITE(68,'(1X,''RANGE VALUE: '',I2)') RNGSET WRITE(68,'(1X,''IB RANGE START PRIMER: '',I2)') IBRNG(0) WRITE(68,'(1X,''OB RANGE START PRIMER: '',I2)') OBRNG(0) WRITE(68,'(1X,''MODE VALUE: '',I2)') MODSET WRITE(68,'(1X,''IB MODE START PRIMER: '',L1)') IBMODE(0) WRITE(68,'(1X,''OB MODE START PRIMER: '',L1)') OBMODE(0) WRITE(68,'(1X,''INBOARD MAG PRIME SWITCH: '',L1)') PRIME(0) WRITE(68,'(1X,''FILTER LIMIT: '',F3.1)') SIGK WRITE(68,'(1X,''FILTER PASSES: '',I2)') NPASS C C OUTPUT MAG SENSITIVITIES TO THE LOG FILE C WRITE(68,*) WRITE(68,'(1X,''INBOARD LFM MAG SENSITIVITIES:'')') DO I = 0,7 WRITE(68,'(4X,I1,3(3X,E10.4))') I+1,(IBSENS(J,I),J=1,3) END DO WRITE(68,'(1X,''OUTBOARD LFM MAG SENSITIVITIES:'')') DO I = 0,7 WRITE(68,'(4X,I1,3(3X,E10.4))') I+1,(OBSENS(J,I),J=1,3) END DO C C OUTPUT MAG SENSOR ALIGNMENT MATRICES C WRITE(68,*) WRITE(68,*) 'INBOARD LFM SENSOR MATRIX (FLIP=0):' WRITE(68,*) WRITE(68,'(3(3(1X,E10.4)/))') ((VSLIB(I,J),J=1,3),I=1,3) C WRITE(68,*) WRITE(68,*) 'OUTBOARD LFM SENSOR MATRIX (FLIP=0):' WRITE(68,*) WRITE(68,'(3(3(1X,E10.4)/))') ((VSLOB(I,J),J=1,3),I=1,3) C WRITE(68,*) WRITE(68,*) 'INBOARD LFM SENSOR MATRIX (FLIP=180):' WRITE(68,*) WRITE(68,'(3(3(1X,E10.4)/))') ((VSLIB(I,J),J=1,3),I=1,3) C WRITE(68,*) WRITE(68,*) 'OUTBOARD LFM SENSOR MATRIX (FLIP=180):' WRITE(68,*) WRITE(68,'(3(3(1X,E10.4)/))') ((VSLOB(I,J),J=1,3),I=1,3) C C OUTPUT MAG BOOM ALIGNMENT MATRICES C WRITE(68,*) 'INBOARD LFM BOOM ALIGNMENT MATRIX:' WRITE(68,*) WRITE(68,'(3(3(1X,E10.4)/))') ((VBLIB(I,J),J=1,3),I=1,3) C WRITE(68,*) WRITE(68,*) 'OUTBOARD LFM BOOM ALIGNMENT MATRIX:' WRITE(68,*) WRITE(68,'(3(3(1X,E10.4)/))') ((VBLOB(I,J),J=1,3),I=1,3) C C MINIMUM RATIO OF DIFFERENCE BETWEEN TIME TAGS OF TWO ADJACENT MAG RECORDS C AND THE PERIOD OF THE FIRST MAG RECORD IN THAT DIFFERENCE C TIMECHK = 0.99 C C INITIALIZE MAIN LOOP C ITDFLG = 0 RATIO = 1 IBADTIM = 0 FIRST = .TRUE. LAST = .FALSE. BAD = 999.0 NCNT = 0 GOTO 10 C C INPUT ERROR CHECK C 5 CONTINUE WRITE(6,*) '*VOYPROD* EDR READ ERROR!' 10 CONTINUE C C USE DEC FORTRAN 'Q' FORMAT SPECIFIER TO RETURN RECORD LENGTH FROM C UNFORMATTED EDR FILE OPENED AS FORMATTED FILE. C READ(54,'(Q,A1)',END=100,ERR=5) & RECLEN,(REC(I),I=1,RECLEN) NCNT = NCNT + 1 C C UNPACK HEADER BLOCK C CALL UNHEAD(REC) C C CHECK HEADER DATA C CALL HEADCHK(RECLEN,NCNT,ISTAT) IF ( ISTAT.NE.0 .AND. .NOT.SYS2(29) ) GOTO 10 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 FILL HEADER BLOCK OF SUMMARY RECORD C CALL HEADFILL(TFLAG,EDRTIME,SCMODE) C C WRITE HDR1 SUMMARY RECORD C IF ( FIRST .AND. ( .NOT.SYS2(26) ) ) & CALL HDR1OUT(66,EDRTIME,EDRDSN,SEDRDSN,ZERONAME,SENSDSN) FIRST = .FALSE. 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 CALCULATE TIME DIFFERENCE BETWEEN SEQUENTIAL MAG RECORDS AND C REMOVE OUT OF BOUND TIME TAGS C IF ( RECID.EQ.4 ) THEN C CURRTIME = REALTIME(EDRTIME) C C CHECK ALL MAG RECORDS FOLLOWING THE FIRST C IF ( ITDFLG.EQ.1 ) THEN C C COMPUTE TIME DIFFERENCE IN SECONDS C DELTA = (CURRTIME-REALTIME(OLDTIME))* & LEAP(OLDTIME(1))*24.0D0*3600.0D0 C C COMPARE DELTA TO PERIOD OF PREVIOUS MAG RECORD C RATIO = REAL(DELTA/SCTDIFF(OLDMODE)) C C REMOVE MAG RECORDS WITH RETROGRADE TIME TAGS C IF ( RATIO.LT.TIMECHK ) THEN IBADTIM = IBADTIM + 1 WRITE(6,'(1X,''*VOYPROD* BAD RETROGRADE TIME AT: '', & I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & '' DELTA t = '',E10.4)') & EDRTIME,DELTA IF ( .NOT.SYS2(14) ) GOTO 10 END IF C C CHECK TIME TAGS FOR EXCESSIVE FORWARD ADVANCE C IF ( DELTA.GT.DISTLM ) THEN IBADTIM = IBADTIM + 1 WRITE(6,'(1X,''*VOYPROD* EXCESSIVE TIME ADVANCE AT: '', & I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & '' DELTA t = '',E10.4)') & EDRTIME,DELTA IF ( .NOT.SYS2(16) ) GOTO 10 END IF C ELSE C C FLAG FIRST MAG TIME LOAD C ITDFLG = 1 C C GET ZERO TABLE FOR FIRST MAG TIME C CALL GETZERO(50,ZERONAME,ZFLIGHT,EDRTIME,ZEROTIME,ISTAT) OLDZERO = ZERONAME WRITE(68,*) WRITE(68,*) 'ZERO TABLE INFO' WRITE(68,'(1X,''EDR TIME: '', & I2,1X,I3.3,3(1X,I2.2),1X,I3.3)') EDRTIME WRITE(68,'(1X,''ZERO TABLE TIME: '', & I2,1X,I3.3,3(1X,I2.2),1X,I3.3)') ZEROTIME WRITE(68,'(1X,''ZERO TABLE NAME: '',A8)') ZERONAME WRITE(68,'(1X,''FLIGHT: '',I2.2)') ZFLIGHT WRITE(68,'(1X,''INBOARD LFM ZERO OFFSETS:'')') DO I = 0,7 WRITE(68,'(4X,I1,3(3X,I4))') I+1,(IBOFF(J,I),J=1,3) END DO WRITE(68,'(1X,''OUTBOARD LFM ZERO OFFSETS:'')') DO I = 0,7 WRITE(68,'(4X,I1,3(3X,I4))') I+1,(OBOFF(J,I),J=1,3) END DO C END IF C C SAVE CURRENT MAG EDR TIME FOR COMPARISON WITH THE NEXT MAG EDR TIME C DO JJ = 1,6 OLDTIME(JJ) = EDRTIME(JJ) END DO C C SAVE CURRENT MAG EDR TELEMETRY MODE FOR COMPARISON WITH THE NEXT C MAG EDR TELEMETRY MODE C OLDMODE = SCMODE C C CHECK DATA AGAINST START AND STOP TIMES C IF ( CURRTIME.LT.START ) GOTO 10 C C CHECK ALL DATA TO EXTRACT ANY IMBEDDED PLAYBACK RECORDS C IF ( CURRTIME.GE.STOP ) THEN IF ( SYS2(14) ) THEN GOTO 10 ELSE WRITE(6,*) '*VOYPROD* STOP TIME REACHED, PROCESSING HALTED.' WRITE(6,*) '*VOYPROD* REALTIME(EDRTIME) = ',CURRTIME WRITE(6,*) '*VOYPROD* STOP TIME = ',STOP GOTO 100 END IF END IF C C END MAG RECORD TIME CHECK C 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 C C GET ZERO OFFSET FROM TABLE FILE C CALL GETZERO(50,ZERONAME,ZFLIGHT,EDRTIME,ZEROTIME,ISTAT) C C OUTPUT ZERO TABLE INFO IF NEW TABLE C IF ( OLDZERO.NE.ZERONAME ) THEN WRITE(68,*) WRITE(68,*) 'ZERO TABLE INFO' WRITE(68,'(1X,''EDR TIME: '', & I2,1X,I3.3,3(1X,I2.2),1X,I3.3)') EDRTIME WRITE(68,'(1X,''ZERO TABLE TIME: '', & I2,1X,I3.3,3(1X,I2.2),1X,I3.3)') ZEROTIME WRITE(68,'(1X,''ZERO TABLE NAME: '',A8)') ZERONAME WRITE(68,'(1X,''FLIGHT: '',I2.2)') ZFLIGHT WRITE(68,'(1X,''INBOARD LFM ZERO OFFSETS:'')') DO I = 0,7 WRITE(68,'(4X,I1,3(3X,I4))') I+1,(IBOFF(J,I),J=1,3) END DO WRITE(68,'(1X,''OUTBOARD LFM ZERO OFFSETS:'')') DO I = 0,7 WRITE(68,'(4X,I1,3(3X,I4))') I+1,(OBOFF(J,I),J=1,3) END DO OLDZERO = ZERONAME END IF C C CONVERT COUNTS TO GAMMAS AND PERFORM NECESSARY ROTATIONS C IF ( SCMODE.EQ.13 ) THEN CALL VIM5LFM(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.6 ) THEN CALL CR6LFM(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.5 ) THEN CALL CR5LFM(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.4 ) THEN CALL CR4LFM(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.3 ) THEN CALL CR3LFM(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.2 ) THEN CALL CR2LFM(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.1 ) THEN CALL CR1LFM(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.0 ) THEN CALL GS3LFM(GAMMA,GAMMA2,BAD,EDRTIME) END IF C C BUFFER AND FILTER DATA WITH POPULATION FILTER C IF ( SYS2(12) ) THEN IF ( SCMODE.EQ.13 ) THEN CALL QUE(GAMMA,400,GAMMA2,8,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.6 ) THEN CALL QUE(GAMMA,750,GAMMA2,375,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.5 ) THEN CALL QUE(GAMMA,2400,GAMMA2,600,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.4 ) THEN CALL QUE(GAMMA,640,GAMMA2,80,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.3 ) THEN CALL QUE(GAMMA,400,GAMMA2,100,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.2 ) THEN CALL QUE(GAMMA,400,GAMMA2,200,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.1 ) THEN CALL QUE(GAMMA,800,GAMMA2,800,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.0 ) THEN CALL QUE(GAMMA,800,GAMMA2,400,LAST,SIGK,NPASS,BAD) END IF ELSE IF ( SCMODE.EQ.13 ) THEN CALL VIM5AVE(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.6 ) THEN CALL CR6AVE(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.5 ) THEN CALL CR5AVE(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.4 ) THEN CALL CR4AVE(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.3 ) THEN CALL CR3AVE(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.2 ) THEN CALL CR2AVE(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.1 ) THEN CALL CR1AVE(GAMMA,GAMMA2,BAD,EDRTIME) ELSE IF ( SCMODE.EQ.0 ) THEN CALL GS3AVE(GAMMA,GAMMA2,BAD,EDRTIME) END IF END IF C C END MAG RECORD PROCESSING C END IF C GOTO 10 100 CONTINUE WRITE(6,*) WRITE(6,'(1X,''NUMBER OF BAD RECORD TIMES: '',I5)') & IBADTIM WRITE(6,*) C C PROCESS MAG RECORDS REMAINING IN ROBERT'S FILTER BUFFER C LAST = .TRUE. IF ( SYS2(12) ) THEN IF ( SCMODE.EQ.13 ) THEN CALL QUE(GAMMA,400,GAMMA2,8,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.6 ) THEN CALL QUE(GAMMA,750,GAMMA2,375,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.5 ) THEN CALL QUE(GAMMA,2400,GAMMA2,600,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.4 ) THEN CALL QUE(GAMMA,640,GAMMA2,80,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.3 ) THEN CALL QUE(GAMMA,400,GAMMA2,100,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.2 ) THEN CALL QUE(GAMMA,400,GAMMA2,200,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.1 ) THEN CALL QUE(GAMMA,800,GAMMA2,800,LAST,SIGK,NPASS,BAD) ELSE IF ( SCMODE.EQ.0 ) THEN CALL QUE(GAMMA,800,GAMMA2,400,LAST,SIGK,NPASS,BAD) END IF END IF C C WRITE HDR1 SUMMARY RECORD C IF ( .NOT.SYS2(26) ) & CALL HDR1OUT(66,EDRTIME,EDRDSN,SEDRDSN,ZERONAME,SENSDSN) C CLOSE(40) CLOSE(41) CLOSE(50) CLOSE(54) CLOSE(66) C WRITE(68,*) WRITE(68,*) WRITE(68,*) '***EDR PROCESSING SUMMARY***' WRITE(68,*) WRITE(68,800) WRITE(68,*) WRITE(68,801) MODECNT(8),(MODECNT(I),I=0,6),MODECNT(9), & MODECNT(13),MODECNT(-1) CALL TIME(SYSTIME(2)) WRITE(68,*) WRITE(68,'(1X,''RUN DATE: '',A9)') SYSDATE WRITE(68,'(1X,''START CLOCK TIME: '',A8)') SYSTIME(1) WRITE(68,'(1X,''END CLOCK TIME: '',A8)') SYSTIME(2) WRITE(68,*) CLOSE(68) C 999 CONTINUE C STOP 800 FORMAT(1X,' ENG',3X,'GS-X',3X,'CR-1',3X,'CR-2',3X,'CR-3',3X, & 'CR-4',3X,'CR-5',3X,'CR-6',3X,'CR-7',3X,'VIM5',3X,'????') 801 FORMAT(11(I5,2X)) END SUBROUTINE MAKEGAMMAS(GAMMA,NPREC,GAMMA2,NSREC, & NSTAT1,NSTAT2,BAD,TIME) C THIS SUBROUTINE SUBTRACTS THE ZERO OFFSET FROM EACH COUNT AND MULTIPIES THE C RESULTING DIFFERENCE BY THE SENSITIVITY TO YIELD FIELD STRENGTH IN GAMMAS. C WRITTEN BY SANDY KRAMER, CODE 692, 12/30/96 C INPUT VARIABLES C BAD FILL VALUE C IAX MAG AXIS C IBOFF INBOARD MAG OFFSET (GLOBAL) C IBRNG INBOARD RANGE (GLOBAL) C IBSENS INBOARD MAG SENSITIVITY (GLOBAL) C PRIME PRIMARY MAG STATUS (FALSE = OUTBOARD PRIMARY) C NPREC NUMBER OF PRIMARY WORDS C NSREC NUMBER OF SECONDARY WORDS C NSTAT1 NUMBER OF MAG STATUS 1 WORDS C NSTAT2 NUMBER OF MAG STATUS 2 WORDS C OBOFF OUTBOARD MAG OFFSET (GLOBAL) C OBRNG OUTBOARD RANGE (GLOBAL) C OBSENS OUTBOARD MAG SENSITIVITY (GLOBAL) C PREC PRIMARY FULL WORD (GLOBAL) C SREC SECONDARY FULL WORD (GLOBAL) C TIME INTEGER TIME ARRAY C OUTPUT VARIABLES C GAMMA PRIMARY MAG FIELD STRENGTH C GAMMA2 SECONDARY MAG FIELD STRENGTH C LOCAL VARIABLES C ICYC MAG STATUS WORD 1 COUNTER C ICYC2 MAG STATUS WORD 2 COUNTER C INBOARD PRIMARY MAG STATUS C IWRD PRIMARY FULL WORD COUNTER C IWRD2 SECONDARY FULL WORD COUNTER C PRIOFF PRIMARY MAG OFFSET C PRISEN PRIMARY MAG SENSITIVITY C RSTAT1 NUMBER OF PRIMARY WORDS PER STAT1 WORD C SECOFF SECONDARY MAG OFFSET C SECSEN SECONDARY MAG SENSITIVITY C SRATIO NUMBER OF PRIMARY WORDS PER SECONDARY WORD CHARACTER FLTID*4 INTEGER*2 TIME(6),CURRTIME(6),DELTA(6)/6*0/ INTEGER*4 PRIOFF(3),SECOFF(3),RSTAT1,SRATIO LOGICAL*1 INBOARD REAL*4 GAMMA(3,NPREC),GAMMA2(3,NSREC),PRISEN(3),SECSEN(3) INCLUDE 'UNPACK.INC' C DATA ICALL/0/ ICALL = ICALL + 1 C IF ( SCID.EQ.0 ) THEN FLTID = "FLT2" ELSE IF ( SCID.EQ.1 ) THEN FLTID = "FLT1" ELSE FLTID = "FLT?" END IF C IF ( SYS2(32).AND.ICALL.EQ.1 ) THEN C C FORTRAN OUTPUT UNIT ASSIGNED TO FILE NAME IN VMS DCL ROUTINE CALLING C THE VOYPROD EXECUTABLE ex. $ ASSIGN FILE.DAT FOR081 C OPEN(81,STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST') END IF C IF ( MODE().EQ.0 ) THEN DELTA(6) = 60 ELSE IF ( MODE().EQ.4 ) THEN DELTA(6) = 300 ELSE IF ( MODE().EQ.13 ) THEN DELTA(6) = 480 ELSE DELTA(6) = 0 WRITE(6,'(1X,''BAD MODE VALUE: '',I5,3X,I5)') MODE(),DATMOD STOP END IF CURRTIME(1) = TIME(1) CURRTIME(2) = TIME(2) CURRTIME(3) = TIME(3) CURRTIME(4) = TIME(4) CURRTIME(5) = TIME(5) CURRTIME(6) = TIME(6) C SRATIO = NPREC/NSREC RSTAT1 = NPREC/NSTAT1 IF ( NSTAT2.GT.0 ) THEN RSTAT2 = NPREC/NSTAT2 ELSE RSTAT2 = -1 ! accommodate CR-6 mode lacking MAG status 2 word END IF DO IWRD = 1,NPREC ICYC = INT((IWRD-1)/RSTAT1) + 1 ICYC2 = INT((IWRD-1)/RSTAT2) + 1 IWRD2 = INT((IWRD-1)/SRATIO) + 1 IF ( SYS2(24) ) THEN INBOARD = .TRUE. ! user forced ELSE IF ( NSTAT2.EQ.0 ) THEN INBOARD = .FALSE. ! CR-6 ELSE INBOARD = PRIME(ICYC2) ! normal mode END IF DO IAX = 1,3 C ASSIGN OFFSETS AND SENSITIVITIES TO LOCAL VARIABLES IF ( INBOARD ) THEN ! INBOARD MAG PRIMARY PRIOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) SECOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) PRISEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) SECSEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) ELSE ! OUTBOARD MAG PRIMARY PRIOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) SECOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) PRISEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) SECSEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) END IF C CONVERT PRIMARY MAG COUNTS TO GAMMAS IF ( PREC(IAX,IWRD).NE.0 ) THEN GAMMA(IAX,IWRD) = (PREC(IAX,IWRD)-PRIOFF(IAX))*PRISEN(IAX) ELSE GAMMA(IAX,IWRD) = BAD END IF C CONVERT SECONDARY MAG COUNTS TO GAMMAS IF ( MOD(IWRD-1,SRATIO).EQ.0 ) THEN IF ( SREC(IAX,IWRD2).NE.0 ) THEN GAMMA2(IAX,IWRD2) = (SREC(IAX,IWRD2)-SECOFF(IAX))*SECSEN(IAX) ELSE GAMMA2(IAX,IWRD2) = BAD END IF END IF END DO C WRITE GAMMAS TO FILE IF ( SYS2(32) ) THEN WRITE(81,'(A4,1X,I2,1X,I3,3(1X,I2.2),1X,I3.3,4(1X,I5), & 3(1X,F7.3),4(1X,I5),3(1X,F7.3))') & FLTID,CURRTIME, & IWRD,PREC(1,IWRD),PREC(2,IWRD),PREC(3,IWRD), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD), & IWRD2,SREC(1,IWRD2),SREC(2,IWRD2),SREC(3,IWRD2), & GAMMA2(1,IWRD2),GAMMA2(2,IWRD2),GAMMA2(3,IWRD2) END IF CALL INC_TIME(CURRTIME,DELTA) END DO RETURN END INTEGER FUNCTION MODE(NCNT) 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-X = 0 C ENG = 8 C VIM-5 = 13 C N/A = -1 C C SANDY KRAMER 07/05/94 C INCLUDE 'UNPACK.INC' C IF ( DATMOD.EQ.0 ) MODE = 8 ! ENG IF ( DATMOD.EQ.1 ) MODE = 2 ! CR-2 IF ( DATMOD.EQ.2 ) MODE = 3 ! CR-3 IF ( DATMOD.EQ.3 ) MODE = 4 ! CR-4 IF ( DATMOD.EQ.4 ) MODE = 5 ! CR-5 IF ( DATMOD.EQ.5 ) MODE = 6 ! CR-6 IF ( DATMOD.EQ.6 ) MODE = 9 ! CR-7 IF ( DATMOD.EQ.7 ) MODE = 1 ! CR-1 IF ( DATMOD.EQ.8 ) MODE = 0 ! GS-10A IF ( DATMOD.EQ.9 ) MODE = -1 IF ( DATMOD.EQ.10 ) MODE = 0 ! GS-3 IF ( DATMOD.EQ.11 ) MODE = -1 IF ( DATMOD.EQ.12 ) MODE = 0 ! GS-7 IF ( DATMOD.EQ.13 ) MODE = -1 IF ( DATMOD.EQ.14 ) MODE = 0 ! GS-6 IF ( DATMOD.EQ.15 ) MODE = 0 ! GS-4 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 ! OC-2 IF ( DATMOD.EQ.23 ) MODE = 0 ! OC-1 IF ( DATMOD.EQ.24 ) MODE = 13 ! CR5-A (VIM-5) IF ( DATMOD.EQ.25 ) MODE = 0 ! GS-10 IF ( DATMOD.EQ.26 ) MODE = 0 ! GS-8 IF ( DATMOD.EQ.27 ) MODE = -1 IF ( DATMOD.EQ.28 ) MODE = -1 IF ( DATMOD.EQ.29 ) MODE = 13 ! UV-5A (VIM-5) IF ( DATMOD.EQ.30 ) MODE = -1 IF ( DATMOD.EQ.31 ) MODE = -1 C IF ( DATMOD.LT.0 .OR. DATMOD.GT.31 ) THEN WRITE(6,800) DATMOD,NCNT MODE = -1 END IF C RETURN 800 FORMAT(1X,'*MODE* INVALID DATMOD VALUE: ',I3,' AT RECORD',1X,I5) END SUBROUTINE MOVBIT(DATA,POS,NBITS,VAL,IBEG) 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 INTEGER*4 VAL INTEGER*4 DATA(1),POS LOGICAL*4 IVAL 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 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 SUBROUTINE MPRD31(R,A,B) C C PERFORM MATRIX MULTIPLICATION (3X3 BY 3X1) C REAL*4 R(3,1),A(3,3),B(3,1) C R(1,1) = A(1,1)*B(1,1) + A(1,2)*B(2,1) + A(1,3)*B(3,1) R(2,1) = A(2,1)*B(1,1) + A(2,2)*B(2,1) + A(2,3)*B(3,1) R(3,1) = A(3,1)*B(1,1) + A(3,2)*B(2,1) + A(3,3)*B(3,1) C RETURN END SUBROUTINE MPRD33(R,A,B) C C PERFORM MATRIX MULTIPLICATION (3X3 BY 3X3) C REAL*4 R(3,3),A(3,3),B(3,3) C R(1,1) = A(1,1)*B(1,1) + A(1,2)*B(2,1) + A(1,3)*B(3,1) R(1,2) = A(1,1)*B(1,2) + A(1,2)*B(2,2) + A(1,3)*B(3,2) R(1,3) = A(1,1)*B(1,3) + A(1,2)*B(2,3) + A(1,3)*B(3,3) C R(2,1) = A(2,1)*B(1,1) + A(2,2)*B(2,1) + A(2,3)*B(3,1) R(2,2) = A(2,1)*B(1,2) + A(2,2)*B(2,2) + A(2,3)*B(3,2) R(2,3) = A(2,1)*B(1,3) + A(2,2)*B(2,3) + A(2,3)*B(3,3) C R(3,1) = A(3,1)*B(1,1) + A(3,2)*B(2,1) + A(3,3)*B(3,1) R(3,2) = A(3,1)*B(1,2) + A(3,2)*B(2,2) + A(3,3)*B(3,2) R(3,3) = A(3,1)*B(1,3) + A(3,2)*B(2,3) + A(3,3)*B(3,3) C RETURN END SUBROUTINE ROT31(R,A,B,N,BAD) C C PERFORM MATRIX MULTIPLICATION (3X3 BY 3X1) C REAL*4 R(3,N),A(3,3),B(3,N) C DO I = 1,N IF ( B(1,I).NE.BAD .AND. & B(2,I).NE.BAD .AND. & B(3,I).NE.BAD ) THEN R(1,I) = A(1,1)*B(1,I) + A(1,2)*B(2,I) + A(1,3)*B(3,I) R(2,I) = A(2,1)*B(1,I) + A(2,2)*B(2,I) + A(2,3)*B(3,I) R(3,I) = A(3,1)*B(1,I) + A(3,2)*B(2,I) + A(3,3)*B(3,I) ELSE R(1,I) = BAD R(2,I) = BAD R(3,I) = BAD END IF END DO C RETURN END ****************************************************************** * * TITLE: UNPACK VOYAGER 360 WORD EDR SUBHEADER (PLS DATA) * * FILE NAME: PLSCR1.FOR * * PURPOSE: TO UNPACK THE SUBHEADER (PLS DATA) ACCORDING TO THE * SPECIFIED MOD60 FORMAT * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------ * S. B. KRAMER 10/04/95 ORIGINAL CODE * * CALLING SEQUENCE: SUBROUTINE PLSCR1() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * EXTRACT MAG AND PLASMA COMMAND WORDS * EXTRACT MAG STATUS WORDS * RETURN * ******************************************************************* SUBROUTINE PLSCR1() C INTEGER*2 TIME(6) C LOGICAL*4 STATIM C INCLUDE 'UNPACK.INC' C DATA ICALL/0/ C IF (DRSDAT.NE.35) RETURN C ICALL = ICALL + 1 C PCOMM1(1) = 0 CALL MOVBIT( PLS, 8, 8, PCOMM1(1), 0) CALL MOVBIT( PLS, 0, 8, PCOMM1(1), 8) PCOMM2(1) = 0 CALL MOVBIT( PLS, 24, 8, PCOMM2(1), 0) CALL MOVBIT( PLS, 16, 8, PCOMM2(1), 8) MCOMM1(1) = 0 CALL MOVBIT( PLS, 40, 8, MCOMM1(1), 0) CALL MOVBIT( PLS, 32, 8, MCOMM1(1), 8) MCOMM2(1) = 0 CALL MOVBIT( PLS, 56, 8, MCOMM2(1), 0) CALL MOVBIT( PLS, 48, 8, MCOMM2(1), 8) C C WORDS 3 AND 4 (BITS 64-127) ARE SPARE C CONTINUE C C START SPACECRAFT EVENT TIME IN MILLISECONDS OF DAY (UNSIGNED INTEGER) C CALL MOVBIT( PLS, 152, 8, STATIM, 0) CALL MOVBIT( PLS, 144, 8, STATIM, 8) CALL MOVBIT( PLS, 136, 8, STATIM, 16) CALL MOVBIT( PLS, 128, 8, STATIM, 24) C C WORDS 6 AND 7 (BITS 160-223) ARE SPARE C CONTINUE C C MAG STATUS WORDS FOR MF'S 1, 11, 21, 31, 41, 51, 61, 71 C C BIT 15 0 15 0 C |______________| |______________| C | STAT1 | | STAT2 | C +--------------+ +--------------+ C C 15 - FILL FILL C 14 - FILL FILL C 13 - FILL FILL C 12 - FILL FILL C 11 - OBLFM MODE OBLFM FLIGHT CALIBRATION C 10 - OBLFM RANGE BIT 1 (LSB) IBLFM FLIGHT CALIBRATION C 9 - OBLFM RANGE BIT 2 OBHFM FLIGHT CALIBRATION C 8 - OBLFM RANGE BIT 3 (MSB) IBHFM FLIGHT CALIBRATION C 7 - IBLFM MODE IFC POLARITY C 6 - IBLFM RANGE BIT 1 (LSB) PROCESSOR SELECTION C 5 - IBLFM RANGE BIT 2 IBLFM FLIPPER POSITION C 4 - IBLFM RANGE BIT 3 (MSB) IBLFM FLIPPER LOCK STATUS C 3 - OBHFM MODE OBLFM FLIPPER POSITION C 2 - OBHFM RANGE BIT 1 OBLFM FLIPPER LOCK STATUS C 1 - IBHFM MODE PRIME LFM STATUS C 0 - IBHFM RANGE BIT 1 ELECTRICAL FLIPPER C DO I=1,8 J = (I-1) * 32 STAT1(I) = 0 CALL MOVBIT( PLS, 232+J, 8, STAT1(I), 0) CALL MOVBIT( PLS, 224+J, 8, STAT1(I), 8) STAT2(I) = 0 CALL MOVBIT( PLS, 248+J, 8, STAT2(I), 0) CALL MOVBIT( PLS, 240+J, 8, STAT2(I), 8) END DO C C WORD 16 (BITS 480-511) SPARE C CONTINUE C C PLASMA DATA IN WORDS 17-336 (BITS 512-10751) - 1280 PLASMA WORDS C DO J = 1,1280 IOFF = (J-1)*8 ! BIT OFFSET CALL MOVBIT(PLS, 512+IOFF, 8, M(J), 0) END DO C C OUTPUT MAG AND PLS COMMAND WORDS AND MAG STATUS WORDS C IF ( SYS2(25) ) THEN C IF ( ICALL.EQ.1 ) THEN OPEN(90,FORM='FORMATTED',STATUS='NEW',CARRIAGECONTROL='LIST') WRITE(90,'('' REC M MILLI- TIME MAG MAG'', & '' PLS PLS MAG MAG'')') WRITE(90,'('' # O SECONDS CMD CMD'', & '' CMD CMD STAT STAT'')') WRITE(90,'('' D OF DAY YY DDD HH MM SS MS #1 #2'', & '' #1 #2 #1 #2'')') WRITE(90,'('' E'')') WRITE(90,*) END IF C TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML DO I=1,8 WRITE(90,800) RECNUM,DATMOD,STATIM,TIME,MCOMM1(1),MCOMM2(1), & PCOMM1(1),PCOMM2(1),STAT1(I),STAT2(I) END DO END IF C RETURN 800 FORMAT(I5,1X,Z2.2,1X,I8,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & 6(1X,Z4.4)) END ****************************************************************** * * TITLE: UNPACK VOYAGER 66 WORD EDR SUBHEADER (PLS DATA) * * FILE NAME: PLSCR2.FOR * * PURPOSE: TO UNPACK THE SUBHEADER (PLS DATA) ACCORDING TO THE * SPECIFIED MOD60 FORMAT * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------ * S. B. KRAMER 02/01/96 ORIGINAL CODE * * CALLING SEQUENCE: SUBROUTINE PLSCR2() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * EXTRACT MAG AND PLASMA COMMAND WORDS * EXTRACT MAG STATUS WORDS * RETURN * ******************************************************************* SUBROUTINE PLSCR2() C INTEGER*2 TIME(6) C LOGICAL*4 STATIM C INCLUDE 'UNPACK.INC' C DATA ICALL/0/ C IF ( DRSDAT.NE.35 ) RETURN C ICALL = ICALL + 1 C PCOMM1(1) = 0 CALL MOVBIT( PLS, 0, 8, PCOMM1(1), 8) CALL MOVBIT( PLS, 8, 8, PCOMM1(1), 0) C MCOMM1(1) = 0 CALL MOVBIT( PLS, 32, 8, MCOMM1(1), 8) CALL MOVBIT( PLS, 40, 8, MCOMM1(1), 0) MCOMM2(1) = 0 CALL MOVBIT( PLS, 48, 8, MCOMM2(1), 8) CALL MOVBIT( PLS, 56, 8, MCOMM2(1), 0) C C WORDS 3 - 5 (BITS 64-159) ARE SPARE C CONTINUE C C MAG STATUS WORDS FOR MF'S 1, 11, 21, 31, 41, 51, 61, 71 C C BIT 15 0 15 0 C |______________| |______________| C | STAT1 | | STAT2 | C +--------------+ +--------------+ C C 15 - FILL FILL C 14 - FILL FILL C 13 - FILL FILL C 12 - FILL FILL C 11 - OBLFM MODE OBLFM FLIGHT CALIBRATION C 10 - OBLFM RANGE BIT 1 (LSB) IBLFM FLIGHT CALIBRATION C 9 - OBLFM RANGE BIT 2 OBHFM FLIGHT CALIBRATION C 8 - OBLFM RANGE BIT 3 (MSB) IBHFM FLIGHT CALIBRATION C 7 - IBLFM MODE IFC POLARITY C 6 - IBLFM RANGE BIT 1 (LSB) PROCESSOR SELECTION C 5 - IBLFM RANGE BIT 2 IBLFM FLIPPER POSITION C 4 - IBLFM RANGE BIT 3 (MSB) IBLFM FLIPPER LOCK STATUS C 3 - OBHFM MODE OBLFM FLIPPER POSITION C 2 - OBHFM RANGE BIT 1 OBLFM FLIPPER LOCK STATUS C 1 - IBHFM MODE PRIME LFM STATUS C 0 - IBHFM RANGE BIT 1 ELECTRICAL FLIPPER C STAT1(1) = 0 CALL MOVBIT( PLS, 192, 8, STAT1(1), 8) CALL MOVBIT( PLS, 200, 8, STAT1(1), 0) STAT2(1) = 0 CALL MOVBIT( PLS, 208, 8, STAT2(1), 8) CALL MOVBIT( PLS, 216, 8, STAT2(1), 0) STAT1(2) = 0 CALL MOVBIT( PLS, 224, 8, STAT1(2), 8) CALL MOVBIT( PLS, 232, 8, STAT1(2), 0) STAT1(3) = 0 CALL MOVBIT( PLS, 240, 8, STAT1(3), 8) CALL MOVBIT( PLS, 248, 8, STAT1(3), 0) STAT1(4) = 0 CALL MOVBIT( PLS, 256, 8, STAT1(4), 8) CALL MOVBIT( PLS, 264, 8, STAT1(4), 0) STAT1(5) = 0 CALL MOVBIT( PLS, 272, 8, STAT1(5), 8) CALL MOVBIT( PLS, 280, 8, STAT1(5), 0) C C WORDS 10 - 14 AND 7 (BITS 288-447) ARE SPARE C CONTINUE C C START SPACECRAFT EVENT TIME IN MILLISECONDS OF DAY (UNSIGNED INTEGER) C CALL MOVBIT( PLS, 448, 8, STATIM, 24) CALL MOVBIT( PLS, 456, 8, STATIM, 16) CALL MOVBIT( PLS, 464, 8, STATIM, 8) CALL MOVBIT( PLS, 472, 8, STATIM, 0) CONTINUE C C WORD 16 (BITS 480-511) SPARE C CONTINUE C C PLASMA DATA (15 WORDS) IN WORDS 17-65 (BITS 512-2063) - 195 PLASMA WORDS C DO J = 1,195 IOFF = (J-1)*8 CALL MOVBIT( PLS, 512+IOFF, 8, M(J), 0) END DO C C OUTPUT MAG AND PLS COMMAND WORDS AND MAG STATUS WORDS C IF ( SYS2(25) ) THEN C IF ( ICALL.EQ.1 ) THEN OPEN(90,FORM='FORMATTED',STATUS='NEW',CARRIAGECONTROL='LIST') WRITE(90,'('' REC M MILLI- TIME MAG MAG'', & '' PLS PLS MAG MAG'')') WRITE(90,'('' # O SECONDS CMD CMD'', & '' CMD CMD STAT STAT'')') WRITE(90,'('' D OF DAY YY DDD HH MM SS MS #1 #2'', & '' #1 #2 #1 #2'')') WRITE(90,'('' E'')') WRITE(90,*) END IF C TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML DO I=1,5 WRITE(90,800) RECNUM,DATMOD,STATIM,TIME,MCOMM1(1),MCOMM2(1), & PCOMM1(1),PCOMM2(1),STAT1(I),STAT2(1) END DO WRITE(90,*) END IF C RETURN 800 FORMAT(I5,1X,Z2.2,1X,I8,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & 6(1X,Z4.4)) END ****************************************************************** * * TITLE: UNPACK VOYAGER 116 WORD EDR SUBHEADER (PLS DATA) * * FILE NAME: PLSCR3.FOR * * PURPOSE: TO UNPACK THE SUBHEADER (PLS DATA) ACCORDING TO THE * SPECIFIED MOD60 FORMAT * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------ * S. B. KRAMER 02/05/96 ORIGINAL CODE * * CALLING SEQUENCE: SUBROUTINE PLSCR3() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * EXTRACT MAG AND PLASMA COMMAND WORDS * EXTRACT MAG STATUS WORDS * RETURN * ******************************************************************* SUBROUTINE PLSCR3() C INTEGER*2 TIME(6) C LOGICAL*4 STATIM C INCLUDE 'UNPACK.INC' C DATA ICALL/0/ C IF ( DRSDAT.NE.35 ) RETURN C ICALL = ICALL + 1 C PCOMM1(1) = 0 CALL MOVBIT( PLS, 0, 8, PCOMM1(1), 8) CALL MOVBIT( PLS, 8, 8, PCOMM1(1), 0) C MCOMM1(1) = 0 CALL MOVBIT( PLS, 32, 8, MCOMM1(1), 8) CALL MOVBIT( PLS, 40, 8, MCOMM1(1), 0) MCOMM2(1) = 0 CALL MOVBIT( PLS, 48, 8, MCOMM2(1), 8) CALL MOVBIT( PLS, 56, 8, MCOMM2(1), 0) C C WORDS 3 - 6 (BITS 64-191) ARE SPARE C CONTINUE C C MAG STATUS WORDS FOR MF'S 1, 11, 21, 31, 41, 51, 61, 71 C C BIT 15 0 15 0 C |______________| |______________| C | STAT1 | | STAT2 | C +--------------+ +--------------+ C C 15 - FILL FILL C 14 - FILL FILL C 13 - FILL FILL C 12 - FILL FILL C 11 - OBLFM MODE OBLFM FLIGHT CALIBRATION C 10 - OBLFM RANGE BIT 1 (LSB) IBLFM FLIGHT CALIBRATION C 9 - OBLFM RANGE BIT 2 OBHFM FLIGHT CALIBRATION C 8 - OBLFM RANGE BIT 3 (MSB) IBHFM FLIGHT CALIBRATION C 7 - IBLFM MODE IFC POLARITY C 6 - IBLFM RANGE BIT 1 (LSB) PROCESSOR SELECTION C 5 - IBLFM RANGE BIT 2 IBLFM FLIPPER POSITION C 4 - IBLFM RANGE BIT 3 (MSB) IBLFM FLIPPER LOCK STATUS C 3 - OBHFM MODE OBLFM FLIPPER POSITION C 2 - OBHFM RANGE BIT 1 OBLFM FLIPPER LOCK STATUS C 1 - IBHFM MODE PRIME LFM STATUS C 0 - IBHFM RANGE BIT 1 ELECTRICAL FLIPPER C STAT1(1) = 0 CALL MOVBIT(PLS, 192, 8, STAT1(1), 8) CALL MOVBIT(PLS, 200, 8, STAT1(1), 0) STAT2(1) = 0 CALL MOVBIT(PLS, 208, 8, STAT2(1), 8) CALL MOVBIT(PLS, 216, 8, STAT2(1), 0) STAT1(2) = 0 CALL MOVBIT(PLS, 224, 8, STAT1(2), 8) CALL MOVBIT(PLS, 232, 8, STAT1(2), 0) STAT1(3) = 0 CALL MOVBIT(PLS, 240, 8, STAT1(3), 8) CALL MOVBIT(PLS, 248, 8, STAT1(3), 0) STAT1(4) = 0 CALL MOVBIT(PLS, 256, 8, STAT1(4), 8) CALL MOVBIT(PLS, 264, 8, STAT1(4), 0) STAT1(5) = 0 CALL MOVBIT(PLS, 272, 8, STAT1(5), 8) CALL MOVBIT(PLS, 280, 8, STAT1(5), 0) STAT1(6) = 0 CALL MOVBIT(PLS, 288, 8, STAT1(6), 8) CALL MOVBIT(PLS, 296, 8, STAT1(6), 0) STAT2(2) = 0 CALL MOVBIT(PLS, 304, 8, STAT2(2), 8) CALL MOVBIT(PLS, 312, 8, STAT2(2), 0) STAT1(7) = 0 CALL MOVBIT(PLS, 320, 8, STAT1(7), 8) CALL MOVBIT(PLS, 328, 8, STAT1(7), 0) STAT1(8) = 0 CALL MOVBIT(PLS, 336, 8, STAT1(8), 8) CALL MOVBIT(PLS, 344, 8, STAT1(8), 0) STAT1(9) = 0 CALL MOVBIT(PLS, 352, 8, STAT1(9), 8) CALL MOVBIT(PLS, 360, 8, STAT1(9), 0) STAT1(10) = 0 CALL MOVBIT(PLS, 368, 8, STAT1(10), 8) CALL MOVBIT(PLS, 376, 8, STAT1(10), 0) C C WORDS 10 - 14 AND 7 (BITS 288-447) ARE SPARE C CONTINUE C C START SPACECRAFT EVENT TIME IN MILLISECONDS OF DAY (UNSIGNED INTEGER) C CALL MOVBIT( PLS, 448, 8, STATIM, 24) CALL MOVBIT( PLS, 456, 8, STATIM, 16) CALL MOVBIT( PLS, 464, 8, STATIM, 8) CALL MOVBIT( PLS, 472, 8, STATIM, 0) CONTINUE C C WORD 16 (BITS 480-511) SPARE C CONTINUE C C PLASMA DATA (15 WORDS) IN WORDS 17-116 (BITS 512-3711) - 400 PLASMA WORDS C EACH 40 PLASMA WORDS CONSTITUTES A CYCLE C DO J = 1,400 IOFF = (J-1)*8 CALL MOVBIT( PLS, 512+IOFF, 8, M(J), 0) END DO C C OUTPUT MAG AND PLS COMMAND WORDS AND MAG STATUS WORDS C IF ( SYS2(25) ) THEN C IF ( ICALL.EQ.1 ) THEN OPEN(90,FORM='FORMATTED',STATUS='NEW',CARRIAGECONTROL='LIST') WRITE(90,'('' REC M MILLI- TIME MAG MAG'', & '' PLS PLS MAG MAG'')') WRITE(90,'('' # O SECONDS CMD CMD'', & '' CMD CMD STAT STAT'')') WRITE(90,'('' D OF DAY YY DDD HH MM SS MS #1 #2'', & '' #1 #2 #1 #2'')') WRITE(90,'('' E'')') WRITE(90,*) END IF C TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML DO I=1,10 K=(I-1)/5 + 1 WRITE(90,800) RECNUM,DATMOD,STATIM,TIME,MCOMM1(1),MCOMM2(1), & PCOMM1(1),PCOMM2(1),STAT1(I),STAT2(K) END DO WRITE(90,*) END IF C RETURN 800 FORMAT(I5,1X,Z2.2,1X,I8,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & 6(1X,Z4.4)) END ****************************************************************** * * TITLE: UNPACK VOYAGER 218 WORD CR-4 EDR SUBHEADER (PLS DATA) * * FILE NAME: PLSCR4.FOR * * PURPOSE: TO UNPACK THE SUBHEADER (PLS DATA) ACCORDING TO THE * SPECIFIED MOD60 FORMAT * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------ * S. B. KRAMER 01/29/96 ORIGINAL CODE * (MODE CR-4) * * CALLING SEQUENCE: SUBROUTINE PLSCR4() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * EXTRACT MAG AND PLASMA COMMAND WORDS * EXTRACT MAG STATUS WORDS * RETURN * ****************************************************************** SUBROUTINE PLSCR4() C INTEGER*2 TIME(6) C LOGICAL*4 STATIM C INCLUDE 'UNPACK.INC' C DATA ICALL/0/ C IF ( DRSDAT.NE.35 ) RETURN C ICALL = ICALL + 1 C C PLASMA COMMAND WORDS C PCOMM1(1) = 0 PCOMM2(1) = 0 CALL MOVBIT(PLS, 0, 8, PCOMM1(1), 8) CALL MOVBIT(PLS, 8, 8, PCOMM1(1), 0) CALL MOVBIT(PLS, 16, 8, PCOMM2(1), 8) CALL MOVBIT(PLS, 24, 8, PCOMM2(1), 0) C PCOMM1(2) = 0 PCOMM2(2) = 0 CALL MOVBIT(PLS, 32, 8, PCOMM1(2), 8) CALL MOVBIT(PLS, 40, 8, PCOMM1(2), 0) CALL MOVBIT(PLS, 48, 8, PCOMM2(2), 8) CALL MOVBIT(PLS, 56, 8, PCOMM2(2), 0) C C MAG COMMAND WORDS C MCOMM1(1) = 0 MCOMM2(1) = 0 CALL MOVBIT(PLS, 64, 8, MCOMM1(1), 8) CALL MOVBIT(PLS, 72, 8, MCOMM1(1), 0) CALL MOVBIT(PLS, 80, 8, MCOMM2(1), 8) CALL MOVBIT(PLS, 88, 8, MCOMM2(1), 0) C MCOMM1(2) = 0 MCOMM2(2) = 0 CALL MOVBIT(PLS, 96, 8, MCOMM1(2), 8) CALL MOVBIT(PLS, 104, 8, MCOMM1(2), 0) CALL MOVBIT(PLS, 112, 8, MCOMM2(2), 8) CALL MOVBIT(PLS, 120, 8, MCOMM2(2), 0) C C MAG STATUS WORDS FORMAT C C BIT 15 0 15 0 C |______________| |______________| C | STAT1 | | STAT2 | C +--------------+ +--------------+ C C 15 - FILL FILL C 14 - FILL FILL C 13 - FILL FILL C 12 - FILL FILL C 11 - OBLFM MODE OBLFM FLIGHT CALIBRATION C 10 - OBLFM RANGE BIT 1 (LSB) IBLFM FLIGHT CALIBRATION C 9 - OBLFM RANGE BIT 2 OBHFM FLIGHT CALIBRATION C 8 - OBLFM RANGE BIT 3 (MSB) IBHFM FLIGHT CALIBRATION C 7 - IBLFM MODE IFC POLARITY C 6 - IBLFM RANGE BIT 1 (LSB) PROCESSOR SELECTION C 5 - IBLFM RANGE BIT 2 IBLFM FLIPPER POSITION C 4 - IBLFM RANGE BIT 3 (MSB) IBLFM FLIPPER LOCK STATUS C 3 - OBHFM MODE OBLFM FLIPPER POSITION C 2 - OBHFM RANGE BIT 1 OBLFM FLIPPER LOCK STATUS C 1 - IBHFM MODE PRIME LFM STATUS C 0 - IBHFM RANGE BIT 1 ELECTRICAL FLIPPER C C MAG STATUS WORDS FOR MF-1, MF-3, MF-5, MF-7, MF-9 C STAT2(1) = 0 CALL MOVBIT(PLS, 128, 8, STAT2(1), 8) CALL MOVBIT(PLS, 136, 8, STAT2(1), 0) DO J = 1,5 STAT1(J) = 0 I = (J-1)*16 CALL MOVBIT(PLS, 144+I, 8, STAT1(J), 8) CALL MOVBIT(PLS, 152+I, 8, STAT1(J), 0) END DO C C MAG STATUS WORDS FOR MF-11, MF-13, MF-15, MF-17, MF-19 C STAT2(2) = 0 CALL MOVBIT(PLS, 224, 8, STAT2(2), 8) CALL MOVBIT(PLS, 232, 8, STAT2(2), 0) DO J = 6,10 I = (J-6)*16 STAT1(J) = 0 CALL MOVBIT(PLS, 240, 8, STAT1(J), 8) CALL MOVBIT(PLS, 248, 8, STAT1(J), 0) END DO C C MAG STATUS WORDS FOR MF-21, MF-23, MF-25, MF-27, MF-29 C STAT2(3) = 0 CALL MOVBIT(PLS, 320, 8, STAT2(3), 8) CALL MOVBIT(PLS, 328, 8, STAT2(3), 0) DO J = 11,15 I = (J-11)*16 STAT1(J) = 0 CALL MOVBIT(PLS, 336+I, 8, STAT1(J), 8) CALL MOVBIT(PLS, 344+I, 8, STAT1(J), 0) END DO C C MAG STATUS WORDS FOR MF-31 C STAT2(4) = 0 CALL MOVBIT(PLS, 416, 8, STAT2(4), 8) CALL MOVBIT(PLS, 424, 8, STAT2(4), 0) STAT1(16) = 0 CALL MOVBIT(PLS, 432, 8, STAT1(16), 8) CALL MOVBIT(PLS, 440, 8, STAT1(16), 0) C C START SPACECRAFT EVENT TIME IN MILLISECONDS OF DAY (UNSIGNED INTEGER) C WORD 15 C CALL MOVBIT(PLS, 448, 8, STATIM, 24) CALL MOVBIT(PLS, 456, 8, STATIM, 16) CALL MOVBIT(PLS, 464, 8, STATIM, 8) CALL MOVBIT(PLS, 472, 8, STATIM, 0) C C MAG STATUS WORDS FOR MF-33, MF-35, MF-37, MF-39 C DO J = 17,20 I = (J-17)*16 STAT1(J) = 0 CALL MOVBIT(PLS, 480+I, 8, STAT1(J), 8) CALL MOVBIT(PLS, 488+I, 8, STAT1(J), 0) END DO C C SPARE BITS 544-575 (WORD 18) C CONTINUE C C PLASMA WORDS (800 WORDS) C DO J = 1,800 IOFF = (J-1)*8 CALL MOVBIT(PLS, 576+IOFF, 8, M(J), 0) END DO C IF ( SYS2(25) ) THEN C IF ( ICALL.EQ.1 ) THEN OPEN(90,FORM='FORMATTED',STATUS='NEW',CARRIAGECONTROL='LIST') WRITE(90,'('' REC M MILLI- TIME MAG MAG'', & '' PLS PLS MAG MAG'')') WRITE(90,'('' # O SECONDS CMD CMD'', & '' CMD CMD STAT STAT'')') WRITE(90,'('' D OF DAY YY DDD HH MM SS MS #1 #2'', & '' #1 #2 #1 #2'')') WRITE(90,'('' E'')') WRITE(90,*) END IF C TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML DO I=1,20 J = (I-1)/10 + 1 K = (I-1)/5 + 1 WRITE(90,800) RECNUM,DATMOD,STATIM,TIME,MCOMM1(J),MCOMM2(J), & PCOMM1(J),PCOMM2(J),STAT1(I),STAT2(K) END DO END IF C RETURN 800 FORMAT(I5,1X,Z2.2,1X,I8,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & 6(1X,Z4.4)) END ****************************************************************** * * TITLE: UNPACK VOYAGER 322 WORD CR-5 EDR SUBHEADER (PLS DATA) * * FILE NAME: PLSCR5.FOR * * PURPOSE: TO UNPACK THE SUBHEADER (PLS DATA) ACCORDING TO THE * SPECIFIED MOD60 FORMAT * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------ * S. B. KRAMER 09/26/92 ORIGINAL CODE * (MODE CR-5) * * CALLING SEQUENCE: SUBROUTINE PLSCR5() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * EXTRACT MAG AND PLASMA COMMAND WORDS * EXTRACT MAG STATUS WORDS * RETURN * ****************************************************************** SUBROUTINE PLSCR5() C INTEGER*2 TIME(6) C LOGICAL*4 STATIM C DATA ICALL/0/ C INCLUDE 'UNPACK.INC' C IF (DRSDAT.NE.35) RETURN ICALL = ICALL + 1 C C MAG COMMAND WORDS C MCOMM1(1) = 0 MCOMM2(1) = 0 CALL MOVBIT(PLS, 8, 8, MCOMM1(1), 0) CALL MOVBIT(PLS, 0, 8, MCOMM1(1), 8) CALL MOVBIT(PLS, 24, 8, MCOMM2(1), 0) CALL MOVBIT(PLS, 16, 8, MCOMM2(1), 8) C C PLASMA COMMAND WORDS C PCOMM1(1) = 0 PCOMM2(1) = 0 CALL MOVBIT(PLS, 40, 8, PCOMM1(1), 0) CALL MOVBIT(PLS, 32, 8, PCOMM1(1), 8) CALL MOVBIT(PLS, 56, 8, PCOMM2(1), 0) CALL MOVBIT(PLS, 48, 8, PCOMM2(1), 8) C C MAG COMMAND WORDS C MCOMM1(2) = 0 MCOMM2(2) = 0 CALL MOVBIT(PLS, 72, 8, MCOMM1(2), 0) CALL MOVBIT(PLS, 64, 8, MCOMM1(2), 8) CALL MOVBIT(PLS, 88, 8, MCOMM2(2), 0) CALL MOVBIT(PLS, 80, 8, MCOMM2(2), 8) C C PLASMA COMMAND WORDS C PCOMM1(2) = 0 PCOMM2(2) = 0 CALL MOVBIT(PLS, 104, 8, PCOMM1(2), 0) CALL MOVBIT(PLS, 96, 8, PCOMM1(2), 8) CALL MOVBIT(PLS, 120, 8, PCOMM2(2), 0) CALL MOVBIT(PLS, 112, 8, PCOMM2(2), 8) C C MAG COMMAND WORDS C MCOMM1(3) = 0 MCOMM2(3) = 0 CALL MOVBIT(PLS, 136, 8, MCOMM1(3), 0) CALL MOVBIT(PLS, 128, 8, MCOMM1(3), 8) CALL MOVBIT(PLS, 152, 8, MCOMM2(3), 0) CALL MOVBIT(PLS, 144, 8, MCOMM2(3), 8) C C PLASMA COMMAND WORDS C PCOMM1(3) = 0 PCOMM2(3) = 0 CALL MOVBIT(PLS, 168, 8, PCOMM1(3), 0) CALL MOVBIT(PLS, 160, 8, PCOMM1(3), 8) CALL MOVBIT(PLS, 184, 8, PCOMM2(3), 0) CALL MOVBIT(PLS, 176, 8, PCOMM2(3), 8) C C SPARE BITS 192-255 (WORDS 7-8) C CONTINUE C C MAG STATUS WORDS FORMAT C C BIT 15 0 15 0 C |______________| |______________| C | STAT1 | | STAT2 | C +--------------+ +--------------+ C C 15 - FILL FILL C 14 - FILL FILL C 13 - FILL FILL C 12 - FILL FILL C 11 - OBLFM MODE OBLFM FLIGHT CALIBRATION C 10 - OBLFM RANGE BIT 1 (LSB) IBLFM FLIGHT CALIBRATION C 9 - OBLFM RANGE BIT 2 OBHFM FLIGHT CALIBRATION C 8 - OBLFM RANGE BIT 3 (MSB) IBHFM FLIGHT CALIBRATION C 7 - IBLFM MODE IFC POLARITY C 6 - IBLFM RANGE BIT 1 (LSB) PROCESSOR SELECTION C 5 - IBLFM RANGE BIT 2 IBLFM FLIPPER POSITION C 4 - IBLFM RANGE BIT 3 (MSB) IBLFM FLIPPER LOCK STATUS C 3 - OBHFM MODE OBLFM FLIPPER POSITION C 2 - OBHFM RANGE BIT 1 OBLFM FLIPPER LOCK STATUS C 1 - IBHFM MODE PRIME LFM STATUS C 0 - IBHFM RANGE BIT 1 ELECTRICAL FLIPPER C C MAG STATUS WORDS FOR MF-1 C STAT1(1) = 0 STAT2(1) = 0 CALL MOVBIT(PLS, 264, 8, STAT1(1), 0) CALL MOVBIT(PLS, 256, 8, STAT1(1), 8) CALL MOVBIT(PLS, 280, 8, STAT2(1), 0) CALL MOVBIT(PLS, 272, 8, STAT2(1), 8) c write(6,'(1x,2(z4.4))') stat1(1),stat2(1) C C MAG STATUS WORDS FOR MF-6 C STAT1(2) = 0 STAT2(2) = 0 CALL MOVBIT(PLS, 296, 8, STAT1(2), 0) CALL MOVBIT(PLS, 288, 8, STAT1(2), 8) CALL MOVBIT(PLS, 312, 8, STAT2(2), 0) CALL MOVBIT(PLS, 304, 8, STAT2(2), 8) c write(6,'(1x,2(z4.4))') stat1(2),stat2(2) C C MAG STATUS WORDS FOR MF-11 C STAT1(3) = 0 STAT2(3) = 0 CALL MOVBIT(PLS, 328, 8, STAT1(3), 0) CALL MOVBIT(PLS, 320, 8, STAT1(3), 8) CALL MOVBIT(PLS, 344, 8, STAT2(3), 0) CALL MOVBIT(PLS, 336, 8, STAT2(3), 8) c write(6,'(1x,2(z4.4))') stat1(3),stat2(3) C C MAG STATUS WORDS FOR MF-16 C STAT1(4) = 0 STAT2(4) = 0 CALL MOVBIT(PLS, 360, 8, STAT1(4), 0) CALL MOVBIT(PLS, 352, 8, STAT1(4), 8) CALL MOVBIT(PLS, 376, 8, STAT2(4), 0) CALL MOVBIT(PLS, 368, 8, STAT2(4), 8) c write(6,'(1x,2(z4.4))') stat1(4),stat2(4) C C MAG STATUS WORDS FOR MF-21 C STAT1(5) = 0 STAT2(5) = 0 CALL MOVBIT(PLS, 392, 8, STAT1(5), 0) CALL MOVBIT(PLS, 384, 8, STAT1(5), 8) CALL MOVBIT(PLS, 408, 8, STAT2(5), 0) CALL MOVBIT(PLS, 400, 8, STAT2(5), 8) c write(6,'(1x,2(z4.4))') stat1(5),stat2(5) C C MAG STATUS WORDS FOR MF-26 C STAT1(6) = 0 STAT2(6) = 0 CALL MOVBIT(PLS, 424, 8, STAT1(6), 0) CALL MOVBIT(PLS, 416, 8, STAT1(6), 8) CALL MOVBIT(PLS, 440, 8, STAT2(6), 0) CALL MOVBIT(PLS, 432, 8, STAT2(6), 8) c write(6,'(1x,2(z4.4))') stat1(6),stat2(6) C C START SPACECRAFT EVENT TIME IN MILLISECONDS OF DAY (UNSIGNED INTEGER) C CALL MOVBIT(PLS, 472, 8, STATIM, 0) CALL MOVBIT(PLS, 464, 8, STATIM, 8) CALL MOVBIT(PLS, 456, 8, STATIM, 16) CALL MOVBIT(PLS, 448, 8, STATIM, 24) C C SPARE BITS 480-511 (WORD 16) C CONTINUE C C MAG STATUS WORDS FOR MF-31 C STAT1(7) = 0 STAT2(7) = 0 CALL MOVBIT(PLS, 520, 8, STAT1(7), 0) CALL MOVBIT(PLS, 512, 8, STAT1(7), 8) CALL MOVBIT(PLS, 536, 8, STAT2(7), 0) CALL MOVBIT(PLS, 528, 8, STAT2(7), 8) c write(6,'(1x,2(z4.4))') stat1(7),stat2(7) C C MAG STATUS WORDS FOR MF-36 C STAT1(8) = 0 STAT2(8) = 0 CALL MOVBIT(PLS, 552, 8, STAT1(8), 0) CALL MOVBIT(PLS, 544, 8, STAT1(8), 8) CALL MOVBIT(PLS, 568, 8, STAT2(8), 0) CALL MOVBIT(PLS, 560, 8, STAT2(8), 8) c write(6,'(1x,2(z4.4))') stat1(8),stat2(8) C C MAG STATUS WORDS FOR MF-41 C STAT1(9) = 0 STAT2(9) = 0 CALL MOVBIT(PLS, 584, 8, STAT1(9), 0) CALL MOVBIT(PLS, 576, 8, STAT1(9), 8) CALL MOVBIT(PLS, 600, 8, STAT2(9), 0) CALL MOVBIT(PLS, 592, 8, STAT2(9), 8) c write(6,'(1x,2(z4.4))') stat1(9),stat2(9) C C MAG STATUS WORDS FOR MF-46 C STAT1(10) = 0 STAT2(10) = 0 CALL MOVBIT(PLS, 616, 8, STAT1(10), 0) CALL MOVBIT(PLS, 608, 8, STAT1(10), 8) CALL MOVBIT(PLS, 632, 8, STAT2(10), 0) CALL MOVBIT(PLS, 624, 8, STAT2(10), 8) c write(6,'(1x,2(z4.4))') stat1(10),stat2(10) C C MAG STATUS WORDS FOR MF-51 C STAT1(11) = 0 STAT2(11) = 0 CALL MOVBIT(PLS, 648, 8, STAT1(11), 0) CALL MOVBIT(PLS, 640, 8, STAT1(11), 8) CALL MOVBIT(PLS, 664, 8, STAT2(11), 0) CALL MOVBIT(PLS, 656, 8, STAT2(11), 8) c write(6,'(1x,2(z4.4))') stat1(11),stat2(11) C C MAG STATUS WORDS FOR MF-56 C STAT1(12) = 0 STAT2(12) = 0 CALL MOVBIT(PLS, 680, 8, STAT1(12), 0) CALL MOVBIT(PLS, 672, 8, STAT1(12), 8) CALL MOVBIT(PLS, 696, 8, STAT2(12), 0) CALL MOVBIT(PLS, 688, 8, STAT2(12), 8) c write(6,'(1x,2(z4.4))') stat1(12),stat2(12) C C PLASMA WORDS (1200 WORDS) C DO J = 1,1200 IOFF = (J-1)*8 CALL MOVBIT(PLS, 640+IOFF, 8, M(J), 0) END DO C IF ( SYS2(25) ) THEN C IF ( ICALL.EQ.1 ) THEN OPEN(90,FORM='FORMATTED',STATUS='NEW',CARRIAGECONTROL='LIST') WRITE(90,'('' REC M MILLI- TIME MAG MAG'', & '' PLS PLS MAG MAG'')') WRITE(90,'('' # O SECONDS CMD CMD'', & '' CMD CMD STAT STAT'')') WRITE(90,'('' D OF DAY YY DDD HH MM SS MS #1 #2'', & '' #1 #2 #1 #2'')') WRITE(90,'('' E'')') WRITE(90,*) END IF C TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML DO I=1,12 ICMD = (I-1)/6 + 1 WRITE(90,800) RECNUM,DATMOD,STATIM,TIME, & MCOMM1(ICMD),MCOMM2(ICMD),PCOMM1(1),PCOMM2(1), & STAT1(I),STAT2(I) END DO END IF C RETURN 800 FORMAT(I5,1X,Z2.2,1X,I8,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & 6(1X,Z4.4)) END ****************************************************************** * * TITLE: UNPACK VOYAGER 754 WORD CR-6 EDR SUBHEADER (PLS DATA) * * FILE NAME: PLSCR6.FOR * * PURPOSE: TO UNPACK THE SUBHEADER (PLS DATA) ACCORDING TO THE * SPECIFIED MOD60 FORMAT * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------ * S. B. KRAMER 03/21/95 ORIGINAL CODE * (MODE CR-6) * * CALLING SEQUENCE: SUBROUTINE PLSCR6() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * EXTRACT MAG AND PLASMA COMMAND WORDS * EXTRACT MAG STATUS WORDS * RETURN * ****************************************************************** SUBROUTINE PLSCR6() C INTEGER*2 TIME(6) C LOGICAL*4 STATIM C DATA ICALL/0/ C INCLUDE 'UNPACK.INC' C IF (DRSDAT.NE.35) RETURN ICALL = ICALL + 1 C C PLASMA COMMAND WORDS (8) C DO IP = 1,8 IOFF = (IP-1)*16 PCOMM1(IP) = 0 CALL MOVBIT(PLS, 0+IOFF, 8, PCOMM1(IP), 8) CALL MOVBIT(PLS, 8+IOFF, 8, PCOMM1(IP), 0) END DO C C MAG COMMAND WORDS (16) C DO IM = 1,16 IOFF = (IM-1)*16 IDX = (IM-1)/2 + 1 MCOMM1(IDX) = 0 ! MAG CMD WRD #1 MCOMM2(IDX) = 0 ! MAG CMD WRD #2 IF ( MOD(IM,2).EQ.0 ) THEN CALL MOVBIT(PLS, 128+IOFF, 8, MCOMM2(IDX), 8) CALL MOVBIT(PLS, 136+IOFF, 8, MCOMM2(IDX), 0) ELSE CALL MOVBIT(PLS, 128+IOFF, 8, MCOMM1(IDX), 8) CALL MOVBIT(PLS, 136+IOFF, 8, MCOMM1(IDX), 0) END IF END DO C C PLS STATUS WORD C CALL MOVBIT(PLS, 384, 8, PSTAT, 8) CALL MOVBIT(PLS, 392, 8, PSTAT, 0) C C SPARE BITS 400-447 (WORDS 13.5-16) C CONTINUE C C START SPACECRAFT EVENT TIME IN MILLISECONDS OF DAY (UNSIGNED INTEGER) C CALL MOVBIT(PLS, 448, 8, STATIM, 24) CALL MOVBIT(PLS, 456, 8, STATIM, 16) CALL MOVBIT(PLS, 464, 8, STATIM, 8) CALL MOVBIT(PLS, 472, 8, STATIM, 0) C C MAG STATUS WORDS C DO ISTAT = 1,10 STAT1(ISTAT) = 0 CALL MOVBIT(PLS, 544, 8, STAT1(ISTAT), 8) CALL MOVBIT(PLS, 552, 8, STAT1(ISTAT), 0) END DO C C NO MAG STAT2 WORDS APPARENT IN EDR FORMAT DOCS C CONTINUE C C PLASMA WORDS (2925 WORDS) C DO J = 1,2925 IOFF = (J-1)*8 CALL MOVBIT(PLS, 704+IOFF, 8, M(J), 0) END DO C IF ( SYS2(25) ) THEN C IF ( ICALL.EQ.1 ) THEN OPEN(90,FORM='FORMATTED',STATUS='NEW',CARRIAGECONTROL='LIST') WRITE(90,'('' REC M MILLI- TIME MAG MAG'', & '' PLS PLS MAG MAG'')') WRITE(90,'('' # O SECONDS CMD CMD'', & '' CMD CMD STAT STAT'')') WRITE(90,'('' D OF DAY YY DDD HH MM SS MS #1 #2'', & '' #1 #2 #1 #2'')') WRITE(90,'('' E'')') WRITE(90,*) END IF C TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML DO I=1,16 WRITE(90,800) RECNUM,DATMOD,STATIM,TIME, & MCOMM1(I),MCOMM2(I),PCOMM1(1),PCOMM2(1), & STAT1(I),STAT2(I) END DO C END IF C RETURN 800 FORMAT(I5,1X,Z2.2,1X,I8,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & 6(1X,Z4.4)) END ****************************************************************** * * TITLE: UNPACK VOYAGER 68 WORD EDR SUBHEADER (PLS DATA) * *************** CONTAINS L SHOER CORRECTION ****************** * * FILE NAME: PLSGS3.FOR * * PURPOSE: TO UNPACK THE SUBHEADER (PLS DATA) ACCORDING TO THE * SPECIFIED MOD60 FORMAT * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------ * S. J. KEMPLER 8/12/85 ORIGINAL CODE * S. B. KRAMER 11/01/93 MODIFIED FOR NEW VOY PROD PGM * * CALLING SEQUENCE: SUBROUTINE PLSGS3() * * ARGUMENT LIST: * * NAME TYPE USED PURPOSE * ----- ----- ---- ------- * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * THE PLS DATA FORMAT TO BE USED IS DETERMINED BY THE REMAINDER * AFTER DIVIDING THE VARIABLE MOD60 BY 15. THEREFORE, * FORMATS MAY BE NUMBERED 0 TO 14. * * PDL: * * SET UNSTAT TO 0 * CALL MOVBIT TO LOAD THE FIRST 20 WORDS (PLS HEADER) INTO I*2 * VARIABLES * CALCULATE THE REMAINDER OF MOD60 DIVIDED BY 15 * CALL MOVBIT TO LOAD THE REMAINING 48 WORDS ACCORDING TO THE * FORMAT NUMBER CALCULATED ABOVE (SEE NOTES) INTO I*2 VARIABLES * RETURN * ******************************************************************* SUBROUTINE PLSGS3() C INTEGER*2 TIME(6) LOGICAL*4 STATIM DATA ICALL/0/ C INCLUDE 'UNPACK.INC' C IF (DRSDAT.NE.35) RETURN ICALL = ICALL + 1 C PCOMM1(1) = 0 CALL MOVBIT( PLS, 8, 8, PCOMM1(1), 0) CALL MOVBIT( PLS, 0, 8, PCOMM1(1), 8) PCOMM2(1) = 0 CALL MOVBIT( PLS, 24, 8, PCOMM2(1), 0) CALL MOVBIT( PLS, 16, 8, PCOMM2(1), 8) MCOMM1(1) = 0 CALL MOVBIT( PLS, 40, 8, MCOMM1(1), 0) CALL MOVBIT( PLS, 32, 8, MCOMM1(1), 8) MCOMM2(1) = 0 CALL MOVBIT( PLS, 56, 8, MCOMM2(1), 0) CALL MOVBIT( PLS, 48, 8, MCOMM2(1), 8) C C MAG STATUS WORDS FOR MF'S 1, 9, 17, 25, 33, 41, 49, 57, 65, 73 C C BIT 15 0 15 0 C |______________| |______________| C | STAT1 | | STAT2 | C +--------------+ +--------------+ C C 15 - FILL FILL C 14 - FILL FILL C 13 - FILL FILL C 12 - FILL FILL C 11 - OBLFM MODE OBLFM FLIGHT CALIBRATION C 10 - OBLFM RANGE BIT 1 (LSB) IBLFM FLIGHT CALIBRATION C 9 - OBLFM RANGE BIT 2 OBHFM FLIGHT CALIBRATION C 8 - OBLFM RANGE BIT 3 (MSB) IBHFM FLIGHT CALIBRATION C 7 - IBLFM MODE IFC POLARITY C 6 - IBLFM RANGE BIT 1 (LSB) PROCESSOR SELECTION C 5 - IBLFM RANGE BIT 2 IBLFM FLIPPER POSITION C 4 - IBLFM RANGE BIT 3 (MSB) IBLFM FLIPPER LOCK STATUS C 3 - OBHFM MODE OBLFM FLIPPER POSITION C 2 - OBHFM RANGE BIT 1 OBLFM FLIPPER LOCK STATUS C 1 - IBHFM MODE PRIME LFM STATUS C 0 - IBHFM RANGE BIT 1 ELECTRICAL FLIPPER C DO 10 I=1,10 C J = (I-1) * 32 C STAT1(I) = 0 CALL MOVBIT( PLS, 72+J, 8, STAT1(I), 0) CALL MOVBIT( PLS, 64+J, 8, STAT1(I), 8) STAT2(I) = 0 CALL MOVBIT( PLS, 88+J, 8, STAT2(I), 0) CALL MOVBIT( PLS, 80+J, 8, STAT2(I), 8) C 10 CONTINUE C C START SPACECRAFT EVENT TIME IN MILLISECONDS OF DAY (UNSIGNED INTEGER) C CALL MOVBIT( PLS, 472, 8, STATIM, 0) CALL MOVBIT( PLS, 464, 8, STATIM, 8) CALL MOVBIT( PLS, 456, 8, STATIM, 16) CALL MOVBIT( PLS, 448, 8, STATIM, 24) C PLSREC = IMOD(MOD60,15) + 1 GO TO (1,2,2,2,2,2,2,2,2,2,2,2,13,14,15) PLSREC C 1 L63 = 0 CALL MOVBIT( PLS, 640, 8, L63, 0) L64 = 0 CALL MOVBIT( PLS, 648, 8, L64, 0) C 2 LSTAT1 = 0 CALL MOVBIT( PLS, 864, 8, LSTAT1, 0) C I=0 DO 20 I1=1,16 DO 21 I2=1,4 I=I+1 J = (I-1) * 8 LSHORT(I1,I2) = 0 CALL MOVBIT( PLS, 872+J, 8, LSHORT(I1,I2), 0) 21 CONTINUE 20 CONTINUE C C L SHORT CORRECTION BEFORE THE YEAR 2000 C IF (YEAR3.GT.60) THEN DO 25 I=1,15 DO 26 J=1,4 LSHORT(I,J) = LSHORT(I+1,J) 26 CONTINUE 25 CONTINUE DO 27 J=1,4 LSHORT(16,J) = -1 27 CONTINUE ENDIF C ESTAT1 = 0 CALL MOVBIT( PLS, 1384, 8, ESTAT1, 0) C DO 30 I=1,16 J = (I-1) * 8 ESHORT(I) = 0 CALL MOVBIT( PLS, 1392+J, 8, ESHORT(I), 0) 30 CONTINUE C LSTAT2 = 0 CALL MOVBIT( PLS, 1520, 8, LSTAT2, 0) C I=0 DO 40 I1=1,16 DO 41 I2=1,4 I=I+1 J = (I-1) * 8 LLONG(I1,I2) = 0 CALL MOVBIT( PLS, 1528+J, 8, LLONG(I1,I2), 0) 41 CONTINUE 40 CONTINUE C ESTAT2 = 0 CALL MOVBIT( PLS, 2040, 8, ESTAT2, 0) C DO 50 I=1,16 J = (I-1) * 8 ELONG(I) = 0 CALL MOVBIT( PLS, 2048+J, 8, ELONG(I), 0) 50 CONTINUE C GO TO 95 C 13 MSTAT = 0 CALL MOVBIT( PLS, 640, 8, DMSTAT, 0) C DO 60 I=1,191 J = (I-1) * 8 M(I) = 0 CALL MOVBIT( PLS, 648+J, 8, M(I), 0) 60 CONTINUE C GO TO 95 C 14 DO 70 I=1,192 J = (I-1) * 8 M(I) = 0 CALL MOVBIT( PLS, 640+J, 8, M(I), 0) 70 CONTINUE C GO TO 95 C 15 DO 80 I=1,129 J = (I-1) * 8 M(I) = 0 CALL MOVBIT( PLS, 640+J, 8, M(I), 0) 80 CONTINUE C LSTAT = 0 CALL MOVBIT( PLS, 1672, 8, LSTAT, 0) C I=0 DO 90 I1=1,16 DO 91 I2=1,4 I=I+1 IF(I.GT.62) GO TO 95 J = (I-1) * 8 LLONG(I1,I2) = 0 CALL MOVBIT( PLS, 1680+J, 8, LLONG(I1,I2), 0) 91 CONTINUE 90 CONTINUE 95 CONTINUE C C OUTPUT MAG/PLS COMMAND WORDS AND MAG STATUS WORDS C IF ( SYS2(25) ) THEN C IF ( ICALL.EQ.1 ) THEN OPEN(90,FORM='FORMATTED',STATUS='NEW',CARRIAGECONTROL='LIST') WRITE(90,'('' REC M MILLI- TIME MAG MAG'', & '' PLS PLS MAG MAG'')') WRITE(90,'('' # O SECONDS CMD CMD'', & '' CMD CMD STAT STAT'')') WRITE(90,'('' D OF DAY YY DDD HH MM SS MS #1 #2'', & '' #1 #2 #1 #2'')') WRITE(90,'('' E'')') WRITE(90,*) END IF C TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML DO I=1,10 WRITE(90,800) RECNUM,DATMOD,STATIM,TIME,MCOMM1(1),MCOMM2(1), & PCOMM1(1),PCOMM2(1),STAT1(I),STAT2(I) END DO END IF C RETURN 800 FORMAT(I5,1X,Z2.2,1X,I8,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & 6(1X,Z4.4)) END ****************************************************************** * * TITLE: UNPACK VOYAGER 108 WORD VIM-5 EDR SUBHEADER (PLS DATA) * * FILE NAME: PLSVIM5.FOR * * PURPOSE: TO UNPACK THE SUBHEADER (PLS DATA) ACCORDING TO THE * SPECIFIED MOD60 FORMAT * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------ * S. B. KRAMER 11/04/92 ORIGINAL CODE * (MODE VIM-5) * * CALLING SEQUENCE: SUBROUTINE PLSVIM5() * * MODULES REFERENCED: * * MOVBIT * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * PDL: * * EXTRACT MAG AND PLASMA COMMAND WORDS * EXTRACT MAG STATUS WORDS * RETURN * ****************************************************************** SUBROUTINE PLSVIM5() C INTEGER*2 TIME(6) C LOGICAL*4 STATIM C INCLUDE 'UNPACK.INC' C DATA ICALL/0/ C IF (DRSDAT.NE.35) RETURN C ICALL = ICALL + 1 C C MAG COMMAND WORDS C MCOMM1(1) = 0 MCOMM2(1) = 0 CALL MOVBIT(PLS, 8, 8, MCOMM1(1), 0) CALL MOVBIT(PLS, 0, 8, MCOMM1(1), 8) CALL MOVBIT(PLS, 24, 8, MCOMM2(1), 0) CALL MOVBIT(PLS, 16, 8, MCOMM2(1), 8) C C PLASMA COMMAND WORDS C PCOMM1(1) = 0 PCOMM2(1) = 0 CALL MOVBIT(PLS, 40, 8, PCOMM1(1), 0) CALL MOVBIT(PLS, 32, 8, PCOMM1(1), 8) CALL MOVBIT(PLS, 56, 8, PCOMM2(1), 0) CALL MOVBIT(PLS, 48, 8, PCOMM2(1), 8) C C MAG STATUS WORDS FORMAT C C BIT 15 0 15 0 C |______________| |______________| C | STAT1 | | STAT2 | C +--------------+ +--------------+ C C 15 - FILL FILL C 14 - FILL FILL C 13 - FILL FILL C 12 - FILL FILL C 11 - OBLFM MODE OBLFM FLIGHT CALIBRATION C 10 - OBLFM RANGE BIT 1 (LSB) IBLFM FLIGHT CALIBRATION C 9 - OBLFM RANGE BIT 2 OBHFM FLIGHT CALIBRATION C 8 - OBLFM RANGE BIT 3 (MSB) IBHFM FLIGHT CALIBRATION C 7 - IBLFM MODE IFC POLARITY C 6 - IBLFM RANGE BIT 1 (LSB) PROCESSOR SELECTION C 5 - IBLFM RANGE BIT 2 IBLFM FLIPPER POSITION C 4 - IBLFM RANGE BIT 3 (MSB) IBLFM FLIPPER LOCK STATUS C 3 - OBHFM MODE OBLFM FLIPPER POSITION C 2 - OBHFM RANGE BIT 1 OBLFM FLIPPER LOCK STATUS C 1 - IBHFM MODE PRIME LFM STATUS C 0 - IBHFM RANGE BIT 1 ELECTRICAL FLIPPER C C MAG STATUS WORDS FOR MF-1 C STAT1(1) = 0 STAT2(1) = 0 CALL MOVBIT(PLS, 72, 8, STAT1(1), 0) CALL MOVBIT(PLS, 64, 8, STAT1(1), 8) CALL MOVBIT(PLS, 88, 8, STAT2(1), 0) CALL MOVBIT(PLS, 80, 8, STAT2(1), 8) C C MAG STATUS WORDS FOR MF-6 C STAT1(2) = 0 STAT2(2) = 0 CALL MOVBIT(PLS, 104, 8, STAT1(2), 0) CALL MOVBIT(PLS, 96, 8, STAT1(2), 8) CALL MOVBIT(PLS, 120, 8, STAT2(2), 0) CALL MOVBIT(PLS, 112, 8, STAT2(2), 8) C C MAG STATUS WORDS FOR MF-11 C STAT1(3) = 0 STAT2(3) = 0 CALL MOVBIT(PLS, 136, 8, STAT1(3), 0) CALL MOVBIT(PLS, 128, 8, STAT1(3), 8) CALL MOVBIT(PLS, 152, 8, STAT2(3), 0) CALL MOVBIT(PLS, 144, 8, STAT2(3), 8) C C MAG STATUS WORDS FOR MF-16 C STAT1(4) = 0 STAT2(4) = 0 CALL MOVBIT(PLS, 168, 8, STAT1(4), 0) CALL MOVBIT(PLS, 160, 8, STAT1(4), 8) CALL MOVBIT(PLS, 184, 8, STAT2(4), 0) CALL MOVBIT(PLS, 176, 8, STAT2(4), 8) C C START SPACECRAFT EVENT TIME IN MILLISECONDS OF DAY (UNSIGNED INTEGER) C CALL MOVBIT(PLS, 216, 8, STATIM, 0) CALL MOVBIT(PLS, 208, 8, STATIM, 8) CALL MOVBIT(PLS, 200, 8, STATIM, 16) CALL MOVBIT(PLS, 192, 8, STATIM, 24) C C SPARE BITS 224-255 (WORD 8) C C PLASMA WORDS (400 WORDS) C DO J = 1,400 IOFF = (J-1)*8 CALL MOVBIT(PLS, 256+IOFF, 8, M(J), 0) END DO C IF ( SYS2(25) ) THEN C IF ( ICALL.EQ.1 ) THEN OPEN(90,FORM='FORMATTED',STATUS='NEW',CARRIAGECONTROL='LIST') WRITE(90,'('' REC M MILLI- TIME MAG MAG'', & '' PLS PLS MAG MAG'')') WRITE(90,'('' # O SECONDS CMD CMD'', & '' CMD CMD STAT STAT'')') WRITE(90,'('' D OF DAY YY DDD HH MM SS MS #1 #2'', & '' #1 #2 #1 #2'')') WRITE(90,'('' E'')') WRITE(90,*) END IF C TIME(1) = YEAR3 CALL CONHOUR(SCETHR,TIME) CALL CONSEC(SCETSC,TIME) TIME(6) = SCETML DO I=1,4 WRITE(90,800) RECNUM,DATMOD,STATIM,TIME,MCOMM1(1),MCOMM2(1), & PCOMM1(1),PCOMM2(1),STAT1(I),STAT2(I) END DO END IF C RETURN 800 FORMAT(I5,1X,Z2.2,1X,I8,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & 6(1X,Z4.4)) END SUBROUTINE POS(RE,VE,M5,RH,VH,THETA,BETA,MTB) C C ROTATE SPACECRAFT POSITION AND VELOCITY FROM EME'50 COORDINATES C TO IHG COORDINATES. C COMPUTE SPACECRAFT LATITUDE AND LONGITUDE IN IHG COORDINATES. C COMPUTE THE IHG TO HG ROTATION MATRIX (MTB). C REAL*4 RE(3),VE(3),M5(3,3),RH(3),VH(3),MTB(3,3) C DATA TPIE/6.2831853E0/,ARAD/1.495985E8/ C C ROTATE S/C POSITION VECTOR INTO IHG COORDINATES. C RH(1) = ( M5(1,1)*RE(1) + M5(1,2)*RE(2) + M5(1,3)*RE(3) )/ARAD RH(2) = ( M5(2,1)*RE(1) + M5(2,2)*RE(2) + M5(2,3)*RE(3) )/ARAD RH(3) = ( M5(3,1)*RE(1) + M5(3,2)*RE(2) + M5(3,3)*RE(3) )/ARAD C C ROTATE S/C VELOCITY VECTOR INTO IHG COORDINATES. C VH(1) = M5(1,1)*VE(1) + M5(1,2)*VE(2) + M5(1,3)*VE(3) VH(2) = M5(2,1)*VE(1) + M5(2,2)*VE(2) + M5(2,3)*VE(3) VH(3) = M5(3,1)*VE(1) + M5(3,2)*VE(2) + M5(3,3)*VE(3) C X = RH(1) Y = RH(2) Z = RH(3) C C SPACECRAFT RANGE C R = SQRT(X**2 + Y**2 + Z**2) C C SPACECRAFT LATITUDINAL POSITION ANGLE C THETA = ASIN(Z/R) C C SPACECRAFT LONGITUDINAL POSITION ANGLE C BETA = ATAN2(Y,X) IF (BETA.LT.0.0) BETA = BETA + TPIE C CSB = X/SQRT(X**2 + Y**2) SNB = Y/SQRT(X**2 + Y**2) SNT = Z/R CST = SQRT(1.0 - SNT**2) C MTB(1,1) = CST*CSB MTB(1,2) = CST*SNB MTB(1,3) = SNT C MTB(2,1) = -SNB MTB(2,2) = CSB MTB(2,3) = 0.0 C MTB(3,1) = -SNT*CSB MTB(3,2) = -SNT*SNB MTB(3,3) = CST C RETURN END ****************************************************************** * * TITLE: DATA BUFFERRING ROUTINE * * FILE NAME: QUE.FOR * * PURPOSE: TO BUFFER DATA PRIOR TO FILTER PROCESSING * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 12/17/92 ORIGINAL CODE * 04/02/93 ADD SECONDARY MODE BUFFERRING * ****************************************************************** SUBROUTINE QUE(GAMMA,LEN,GAMMA2,LEN2, & LAST,SIGMUL,PASS,BAD) C C BUFFER GAMMA VALUES FROM THREE MAGNETOMETER AXES OF PRIMARY AND C SECONDARY MODES. WHEN SUFFICIENT NUMBER OF POINTS IS ACCUMULATED, C PASS ARRAYS TO FILTERING ROUTINE AND THEN AVERAGING ROUTINE. C PRIMARY AND SECONDARY MODE DATA ARE PROCESSED IN PARALLEL. IT IS C ASSUMED THAT THE NUMBER OF SECONDARY MODE POINTS PER RECORD IS ALWAYS C LESS THAN OR EQUAL TO THE NUMBER OF PRIMARY POINTS. C C ORIGINAL CODE WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692 C MODIFIED FOR PARALLEL PROCESSING OF PRI AND SEC MODES SBK 09-23-93 C ADD CR-5 AVERAGING CALL SBK 02-14-95 C FIX RECORD COUNTER (NREC) AND DEFINE SCMODE AS INTEGER SBK 02-16-95 C FIX FILTER BUFFER INDEXING ON UNPACK SBK 02-20-95 C BUFFER MAG STATUS DATA SBK 08-29-2007 C PARAMETER (IARR=50000,MAX=20000,IFULL=48000, & IBACK=1000,IFRONT=1000) C C IARR MAX BUFFER ARRAY LENGTH <= IFULL+IFRONT+IBACK C MAX MAX NUMBER OF RECORDS TO BE BUFFERED FOR FILTER C IFULL MAX NUMBER OF DATA POINTS TO BE PASSED INTO FILTER C IFRONT NUMBER OF FRONT END FILTER PRIME POINTS C IBACK NUMBER OF BACK END FILTER PRIME POINTS C INTEGER*2 BUFFTIME(6),DATATYPE(2),EDRTIME(6), & BEGTIME(6),ENDTIME(6), & STAT1BUFF(20,MAX),STAT2BUFF(20,MAX) C INTEGER*4 NTOTG(6),NTOTB(6),PASS,BLOCKLEN(2,MAX),SCMODE C LOGICAL*1 CLEAN/.TRUE./,LAST C REAL*4 HEADBUFF(32,MAX),HDR(32),AVE(6), & GAMMA(3,LEN),GAMMA2(3,LEN2), & BUFFER(IARR,3),BUFFER2(IARR,3) C SAVE IBUFF,BUFFER,IBUFF2,BUFFER2,HEADBUFF,BLOCKLEN,NREC, & STAT1BUFF,STAT2BUFF C DATA IBUFF/0/,IBUFF2/0/,NREC/0/ C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1), HDR(1)), & (HDR(4), BUFFTIME(1)), & (HDR(17), DATATYPE(1)) C C GO TO FILTER IF FINAL EDR C IF (LAST) GOTO 100 C C INITIALIZE START PRIME AREA FOR PRIMARY AND SECONDARY MODE BUFFERS C IF (IBUFF.EQ.0) THEN DO J = 1,3 DO I = 1,IFRONT BUFFER(I,J) = BAD BUFFER2(I,J) = BAD END DO END DO END IF C C LOAD ONE SCIENCE BLOCK OF PRIMARY MODE DATA INTO BUFFER ARRAY C DO I=1,LEN IBUFF = IBUFF + 1 IF (IBUFF.GT.IARR) THEN WRITE(6,*) '***QUE***PRIMARY BUFFER ARRAY OVERFLOW' STOP END IF DO J = 1,3 BUFFER(IBUFF+IFRONT,J) = GAMMA(J,I) C C PRIME FRONT END OF PRIMARY MODE BUFFER ARRAY WITH FIRST POINTS C IN REVERSE ORDER C IF (IBUFF.LE.IFRONT) BUFFER(IFRONT+1-IBUFF,J) = GAMMA(J,I) END DO END DO C C LOAD ONE SCIENCE BLOCK OF SECONDARY MODE DATA INTO BUFFER ARRAY C DO I=1,LEN2 IBUFF2 = IBUFF2 + 1 IF (IBUFF2.GT.IARR) THEN WRITE(6,*) '***QUE***SECONDARY BUFFER ARRAY OVERFLOW' STOP END IF DO J=1,3 BUFFER2(IBUFF2+IFRONT,J) = GAMMA2(J,I) C C PRIME FRONT END OF SECONDARY MODE BUFFER ARRAY WITH FIRST POINTS C IN REVERSE ORDER C IF (IBUFF2.LE.IFRONT) BUFFER2(IFRONT+1-IBUFF2,J) = GAMMA2(J,I) END DO END DO C C INCREMENT RECORD COUNTER C NREC = NREC + 1 IF ( NREC.GT.MAX ) THEN WRITE(6,*) '***QUE***NUMBER OF RECORDS OVERFLOWS MAX ARRAY SIZE' STOP END IF C C STORE CURRENT HEADER IN BUFFER C DO IHD = 1,32 HEADBUFF(IHD,NREC) = HDR(IHD) END DO C C STORE CURRENT MAG STATUS WORDS C DO ISTATUS = 1,20 STAT1BUFF(ISTATUS,NREC) = STAT1(ISTATUS) STAT2BUFF(ISTATUS,NREC) = STAT2(ISTATUS) END DO C C GET BEGINNING TIME C IF (NREC.EQ.1) THEN DO IT = 1,6 BEGTIME(IT) = BUFFTIME(IT) END DO END IF C C STORE PRIMARY AND SECONDARY DATA COUNTS IN BUFFER C BLOCKLEN(1,NREC) = LEN BLOCKLEN(2,NREC) = LEN2 C 100 CONTINUE C IF ( (IBUFF.GE.IFULL) .OR. LAST ) THEN C C GET END TIME C DO IT = 1,6 ENDTIME(IT) = BUFFTIME(IT) END DO C C PRIME FILTER BACK END WITH LAST POINTS IN REVERSE ORDER C DO J = 1,3 C DO I = 1,IBACK C C PRIMARY MODE FILTER C IF (I.LE.IBUFF) THEN BUFFER(IFRONT+IBUFF+I,J) = BUFFER(IFRONT+IBUFF-I+1,J) ELSE BUFFER(IFRONT+IBUFF+I,J) = BAD END IF C C SECONDARY MODE FILTER C IF (I.LE.IBUFF2) THEN BUFFER2(IFRONT+IBUFF2+I,J) = BUFFER2(IFRONT+IBUFF2-I+1,J) ELSE BUFFER2(IFRONT+IBUFF2+I,J) = BAD END IF C END DO C END DO NBUFF = IBUFF + IFRONT + IBACK NBUFF2 = IBUFF2 + IFRONT + IBACK C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C PASS BUFFERRED DATA TO FILTERING ROUTINE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C IF ( SYS2(12) ) THEN C C FILTER PRIMARY MODE GAMMAS C CALL CLEAN1(BUFFER(1,1),NBUFF,NTOTB(1),NTOTG(1), & SIGMUL,BAD,AVE(1),PASS) C CALL CLEAN1(BUFFER(1,2),NBUFF,NTOTB(2),NTOTG(2), & SIGMUL,BAD,AVE(2),PASS) C CALL CLEAN1(BUFFER(1,3),NBUFF,NTOTB(3),NTOTG(3), & SIGMUL,BAD,AVE(3),PASS) C C WRITE(68,*) WRITE(68,*) 'POPULATION FILTER PROCESSING' WRITE(68,'(1X,''START TIME: '',I2,1X,I3.3,3(1X,I2.2), & 1X,I3.3)') BEGTIME WRITE(68,'(1X,''END TIME: '',I2,1X,I3.3,3(1X,I2.2), & 1X,I3.3)') ENDTIME WRITE(68,'(3X,''# NON-FILL PTS'',6X,''# BAD PTS'',11X, & ''AVERAGE VALUE'',5X,''TOTAL'')') WRITE(68,'(3X,''X'',5X,''Y'',5X,''Z'',5X,''X'',5X,''Y'', & 5X,''Z'',7X,''X'',7X,''Y'',7X,''Z'',4X,''PTS'')') WRITE(68,'(3(1X,I5),3(1X,I5),3(1X,F7.3),1X,I5)') & (NTOTG(I),I=1,3),(NTOTB(I),I=1,3),(AVE(I),I=1,3), & IBUFF C C FILTER SECONDARY MODE GAMMAS C CALL CLEAN1(BUFFER2(1,1),NBUFF2,NTOTB(4),NTOTG(4), & SIGMUL,BAD,AVE(4),PASS) C CALL CLEAN1(BUFFER2(1,2),NBUFF2,NTOTB(5),NTOTG(5), & SIGMUL,BAD,AVE(5),PASS) C CALL CLEAN1(BUFFER2(1,3),NBUFF2,NTOTB(6),NTOTG(6), & SIGMUL,BAD,AVE(6),PASS) C WRITE(68,'(3(1X,I5),3(1X,I5),3(1X,F7.3),1X,I5)') & (NTOTG(I),I=4,6),(NTOTB(I),I=4,6),(AVE(I),I=4,6), & IBUFF2 C C END FILTERING ROUTINE C END IF C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C EXTRACT PRIMARY AND SECONDARY MODE SCIENCE BLOCKS C FROM CONCATENATED BUFFER ARRAYS C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C IOFF = 0 IOFF2 = 0 DO I = 1,NREC C ILEN = BLOCKLEN(1,I) ILEN2 = BLOCKLEN(2,I) C DO J = 1,3 C C PRIMARY MODE REBLOCK C DO K = 1,ILEN L = IOFF + K GAMMA(J,K) = BUFFER(L+IFRONT,J) END DO C C SECONDARY MODE REBLOCK C DO K = 1,ILEN2 L = IOFF2 + K GAMMA2(J,K) = BUFFER2(L+IFRONT,J) END DO C C END PRIMARY AND SECONDARY MAG GAMMAS REBLOCK C END DO IOFF = IOFF + ILEN IOFF2 = IOFF2 + ILEN2 C C REBLOCK HEADER BLOCKS C DO IHD = 1,32 HDR(IHD) = HEADBUFF(IHD,I) END DO C C REBLOCK MAG STATUS WORDS C DO ISTATUS = 1,20 STAT1(ISTATUS) = STAT1BUFF(ISTATUS,I) STAT2(ISTATUS) = STAT2BUFF(ISTATUS,I) END DO C C EXTRACT SPACECRAFT MODE C SCMODE = DATATYPE(2) C C EXTRACT EDR TIME C DO II = 1,6 EDRTIME(II) = BUFFTIME(II) END DO C C CALL SUMMARY AVERAGING ROUTINES C IF (SCMODE.EQ.13) THEN CALL MAGSTATUS(EDRTIME,4,4) CALL VIM5AVE(GAMMA,GAMMA2,BAD,EDRTIME) END IF IF (SCMODE.EQ.6) CALL CR6AVE(GAMMA,GAMMA2,BAD,EDRTIME) IF (SCMODE.EQ.5) CALL CR5AVE(GAMMA,GAMMA2,BAD,EDRTIME) IF (SCMODE.EQ.4) CALL CR4AVE(GAMMA,GAMMA2,BAD,EDRTIME) IF (SCMODE.EQ.3) CALL CR3AVE(GAMMA,GAMMA2,BAD,EDRTIME) IF (SCMODE.EQ.2) CALL CR2AVE(GAMMA,GAMMA2,BAD,EDRTIME) IF (SCMODE.EQ.1) CALL CR1AVE(GAMMA,GAMMA2,BAD,EDRTIME) IF (SCMODE.EQ.0) CALL GS3AVE(GAMMA,GAMMA2,BAD,EDRTIME) C END DO C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C REINITIALIZE POINT AND RECORD COUNTERS C IBUFF = 0 IBUFF2 = 0 NREC = 0 C END IF C RETURN END REAL*8 FUNCTION REALTIME(TIME) C C CONVERT INTEGER CALENDAR TIME INTO DECIMAL YEAR REAL TIME. C INTEGER*2 TIME(6) REAL*8 DAYS C DAYS = 365.0D0 IF (MOD(TIME(1),4).EQ.0) DAYS = 366.0D0 REALTIME = DBLE(TIME(1)) + & DBLE(TIME(2)-1)/DAYS + & DBLE(TIME(3))/24.0D0/DAYS + & DBLE(TIME(4))/60.0D0/24.0D0/DAYS + & DBLE(TIME(5))/60.0D0/60.0D0/24.0D0/DAYS + & DBLE(TIME(6))/1000.0D0/60.0D0/60.0D0/24.0D0/DAYS C C ASSUME 2 DIGIT YEAR. ANY YEAR BEFORE VOYAGER LAUNCH (77) IS INTO NEXT C CENTURY. C IF (TIME(1).LT.77) REALTIME = REALTIME + 100.0D0 C RETURN END SUBROUTINE ROTATE(R,A,B,N,BAD) C C ROTATE 3 ELEMENT VECTORS C REAL*4 R(3,N),A(3,N),B(3,3) C DO I = 1,N IF ( A(1,I).NE.BAD .AND. & A(2,I).NE.BAD .AND. & A(3,I).NE.BAD ) THEN R(1,I) = A(1,I)*B(1,1) + A(2,I)*B(2,1) + A(3,I)*B(3,1) R(2,I) = A(1,I)*B(1,2) + A(2,I)*B(2,2) + A(3,I)*B(3,2) R(3,I) = A(1,I)*B(1,3) + A(2,I)*B(2,3) + A(3,I)*B(3,3) ELSE R(1,I) = BAD R(2,I) = BAD R(3,I) = BAD END IF END DO C RETURN END SUBROUTINE ROTATE1(R,A,B,BAD) C C ROTATE 3 ELEMENT VECTOR IF NOT FILL C REAL*4 R(3),A(3),B(3,3) C IF ( A(1).NE.BAD .AND. & A(2).NE.BAD .AND. & A(3).NE.BAD ) THEN R(1) = A(1)*B(1,1) + A(2)*B(2,1) + A(3)*B(3,1) R(2) = A(1)*B(1,2) + A(2)*B(2,2) + A(3)*B(3,2) R(3) = A(1)*B(1,3) + A(2)*B(2,3) + A(3)*B(3,3) ELSE R(1) = BAD R(2) = BAD R(3) = BAD END IF C RETURN END REAL*8 FUNCTION SCTDIFF(SCMODE) C C RETURN DOUBLE PRECISION TIME PERIOD OF SCIENCE BLOCK FOR MODE = SCMODE C INTEGER*4 SCMODE C IF ( SCMODE.EQ.3 ) THEN SCTDIFF = 96.0D0 ELSE IF ( SCMODE.EQ.4 ) THEN SCTDIFF = 192.0D0 ELSE IF ( SCMODE.EQ.5 ) THEN SCTDIFF = 576.0D0 ELSE IF ( SCMODE.EQ.6 ) THEN SCTDIFF = 1440.0D0 ELSE IF ( SCMODE.EQ.13 ) THEN SCTDIFF = 192.0D0 ELSE SCTDIFF = 48.0D0 END IF C RETURN END SUBROUTINE SEDRCRU(GMT,NAV,MPE,SPV,ANG,MTB,MHG,MTB5,RANGE) C C COMPUTE THE TRANFORMATION FROM THE EARTH MEAN ECLIPTIC AND EQUINOX C OF 1950.0 (EME'50) COORDINATES TO HELIOGRAPHIC COORDINATES. C C INPUT NAVIGATION RECORD DATA (NAV) AND POINTING VECTOR DATA (MPE) C INTEGER*2 GMT(6) C REAL*4 NAV(252),RE(3),RH(3),VE(3),VH(3),SPV(6),ANG(2), & MHG(3,3),MTB(3,3),M5(3,3),MPE(3,3),MTB5(3,3) C DATA TPIE / 6.2831853E0 /, ARAD / 1.495985E8 / C C M5 IS A PSEUDO-CONSTANT ORTHOGONAL MATRIX THAT MAPS VECTORS FROM THE EARTH- C MEAN-ECLIPTIC, EQUINOX OF 1950 (EME'50) INERTIAL SYSTEM TO AN INERTIAL C HELIOGRAPHIC SYSTEM (IHG). C C MTB5 IS THE EME'50 TO HG TRANSFORMATION MATRIX (MTB5) C C MHG IS THE PAYLOAD TO HG TRANSFORMATION MATRIX (MHG) C DATA M5 / 0.2576, 0.9662, 0.0 , & -0.9585, 0.2555, 0.1262, & 0.1219,-0.0325, 0.9920 / C INCLUDE 'UNPACK.INC' C C LOAD S/C POSITION VECTOR INTO ARRAY RE. C RE(1) = NAV(13) RE(2) = NAV(14) RE(3) = NAV(15) C C LOAD S/C VELOCITY VECTOR INTO ARRAY VE. C VE(1) = NAV(16) VE(2) = NAV(17) VE(3) = NAV(18) C DO I = 1,3 RH(I) = ( M5(1,I)*RE(1) + M5(2,I)*RE(2) + M5(3,I)*RE(3) ) / ARAD VH(I) = M5(1,I)*VE(1) + M5(2,I)*VE(2) + M5(3,I)*VE(3) END DO C C GET IHG SPACECRAFT LATITUDE (THETA) AND LONGITUDE (BETA), AND C IHG TO HG TRANSFORMATION MATRIX (MTB). C X = RH(1) Y = RH(2) Z = RH(3) RANGE = SQRT(RH(1)**2+RH(2)**2+RH(3)**2) C C SPACECRAFT LATITUDINAL POSITION ANGLE C THETA = ASIN(Z/RANGE) C C SPACECRAFT LONGITUDINAL POSITION ANGLE C BETA = ATAN2(Y,X) IF (BETA.LT.0.0) BETA = BETA + TPIE C DEN = SQRT(X**2 + Y**2) CSB = X/DEN SNB = Y/DEN SNT = Z/RANGE CST = SQRT(1.0 - SNT**2) C MTB(1,1) = CST*CSB MTB(1,2) = -SNB MTB(1,3) = -SNT*CSB C MTB(2,1) = CST*SNB MTB(2,2) = CSB MTB(2,3) = -SNT*SNB C MTB(3,1) = SNT MTB(3,2) = 0.0 MTB(3,3) = CST C SPV(1) = RH(1) SPV(2) = RH(2) SPV(3) = RH(3) SPV(4) = VH(1) SPV(5) = VH(2) SPV(6) = VH(3) ANG(1) = BETA ANG(2) = THETA C C GET EME'50 TO HG TRANSFORMATION MATRIX (MTB5) C DO I = 1,3 DO J = 1,3 MTB5(I,J) = MTB(1,I)*M5(J,1) + & MTB(2,I)*M5(J,2) + & MTB(3,I)*M5(J,3) END DO END DO C C GET PAYLOAD TO HG TRANSFORMATION MATRIX (MHG) C DO I = 1,3 DO J = 1,3 MHG(J,I) = MTB5(I,1)*MPE(1,J) + & MTB5(I,2)*MPE(2,J) + & MTB5(I,3)*MPE(3,J) END DO END DO C RETURN END C C COMPUTE THE MATRICES FOR TRANSFORMATION FROM THE EARTH MEAN ECLIPTIC AND C EQUINOX OF 1950 (EME'50) COORDINATES TO PLANETARY SPHERICAL COORDINATES. C C MODIFIED TO SWAP VALUES OF LATITUDE AND LONGITUDE BEFORE RETURN C 07/31/95 SBK C SUBROUTINE SEDRENC(GMT,NAV,PV,RJVE,ANG,S,ROT,Q,RANGE) C C NAV - Navigation record of either 126 or 252 word length. C C PV - Pointing vector data from words 12-20 of original MVS pointing C vector block. C PV(1,1) = PITCH X COMPONENT C PV(2,1) = PITCH Y COMPONENT C PV(3,1) = PITCH Z COMPONENT C PV(1,2) = YAW X COMPONENT C PV(2,2) = YAW Y COMPONENT C PV(3,2) = YAW Z COMPONENT C PV(1,3) = ROLL X COMPONENT C PV(2,3) = ROLL Y COMPONENT C PV(3,3) = ROLL Z COMPONENT C C RJVE - Spacecraft range and velocity in planetary coordinates C INTEGER*2 GMT(6) C REAL*4 NAV(252),RJVE(6),ANG(2),PV(3,3),Q(3,3),ROT(3,3),S(3,3) C REAL*8 DAYS,LONG,DRANGE,RA C C P-MATRICES TRANSFORM FROM CATERSIAN COMPONENTS REFERRED TO BY THE C EARTH MEAN ECLIPTIC AND EQUINOX OF 1950 (EME'50) SYSTEM TO A C PLANETOCENTRIC CARTESIAN VERNAL EQUINOX SYSTEM (INERTIAL). C REAL*4 PJ(3,3) / -7.214966E-1, +6.922823E-1, +1.370326E-2, & -6.922676E-1, -7.207863E-1, -3.511083E-2, & -1.442949E-2, -3.481867E-2, +9.992895E-1 / C REAL*4 PS(3,3) / +9.915140E-1, -1.244780E-1, -3.749200E-2, & +9.252900E-2, +8.783090E-1, -4.690540E-1, & +9.131600E-2, +4.616040E-1, +8.823730E-1 / C REAL*4 PU(3,3) / +9.737952E-1, -2.270260E-1, -1.349334E-2, & -4.308389E-2, -1.258954E-1, -9.911075E-1, & +2.233085E-1, +9.657171E-1, -1.323775E-1 / C REAL*4 PN(3,3) / -7.093737E-1, -7.041542E-1, +3.091500E-2, & +6.092710E-1, -6.346587E-1, -4.753915E-1, & +3.543694E-1, -3.183947E-1, +8.792310E-1 / C REAL*4 ARADJ/71372.0E0/, ARADS/60330.0E0/, ARADU/25600.E0/, & ARADN/24765.0E0/, DTR/0.17453293E0/ C INCLUDE 'UNPACK.INC' C IF ( ICOORD.EQ.4 ) THEN C C JUPITER C DO I=1,3 DO J=1,3 Q(J,I) = PJ(1,I)*PV(1,J) + PJ(2,I)*PV(2,J) + PJ(3,I)*PV(3,J) END DO RJVE(I) = & (PJ(1,I)*NAV(19) + PJ(2,I)*NAV(20) + PJ(3,I)*NAV(21))/ARADJ RJVE(I+3) = & (PJ(1,I)*NAV(22) + PJ(2,I)*NAV(23) + PJ(3,I)*NAV(24))/ARADJ END DO ANG(1) = NAV(157) ANG(2) = NAV(159) RANGE = NAV(176)/ARADJ C ELSE IF ( ICOORD.EQ.3 ) THEN C C SATURN C DO I=1,3 DO J=1,3 Q(J,I) = PS(1,I)*PV(1,J) + PS(2,I)*PV(2,J) + PS(3,I)*PV(3,J) END DO RJVE(I) = & (PS(1,I)*NAV(19) + PS(2,I)*NAV(20) + PS(3,I)*NAV(21))/ARADS RJVE(I+3) = & (PS(1,I)*NAV(22) + PS(2,I)*NAV(23) + PS(3,I)*NAV(24))/ARADS END DO ANG(1) = NAV(76) ANG(2) = NAV(77) ! NEED TO SEE ORIGINAL CODE DAYS = GMT(2) - 1.0D0 + (GMT(3) + (GMT(4) + (GMT(5) + & GMT(6)/1000.0D0)/60.0D0)/60.0D0)/24.0D0 IF ( GMT(1).EQ.1981 ) DAYS = DAYS + 366.0D0 DRANGE = DBLE(NAV(83)) RA = NAV(103) LONG = 810.76D0*(DAYS - 3.860695545D-11*DRANGE) - RA ANG(2) = DMOD(LONG,360.D0) RANGE = NAV(83)/ARADS C ELSE IF ( ICOORD.EQ.5 ) THEN C C URANUS C DO I=1,3 DO J=1,3 Q(J,I) = PU(1,I)*PV(1,J) + PU(2,I)*PV(2,J) + PU(3,I)*PV(3,J) END DO RJVE(I) = & (PU(1,I)*NAV(19) + PU(2,I)*NAV(20) + PU(3,I)*NAV(21))/ARADU RJVE(I+3) = & (PU(1,I)*NAV(22) + PU(2,I)*NAV(23) + PU(3,I)*NAV(24))/ARADU END DO ANG(1) = NAV(139) ANG(2) = NAV(140) RANGE = NAV(153)/ARADU C ELSE IF ( ICOORD.EQ.6 ) THEN C C NEPTUNE C DO I=1,3 DO J=1,3 Q(J,I) = PN(1,I)*PV(1,J) + PN(2,I)*PV(2,J) + PN(3,I)*PV(3,J) END DO RJVE(I) = & (PN(1,I)*NAV(19) + PN(2,I)*NAV(20) + PN(3,I)*NAV(21))/ARADN RJVE(I+3) = & (PN(1,I)*NAV(22) + PN(2,I)*NAV(23) + PN(3,I)*NAV(24))/ARADN END DO ANG(1) = NAV(139) ANG(2) = NAV(140) RANGE = NAV(153)/ARADN C END IF C C COMPUTE PSI AND OMEGA C SQ = SQRT(RJVE(1)**2+RJVE(2)**2+RJVE(3)**2) IF ( SQ.NE.0.0 ) THEN PSI = ACOS(RJVE(3)/SQ) ELSE PSI = 0.0 END IF OMG = ATAN2(RJVE(2),RJVE(1)) C C COMPUTES SINES AND COSINES OF ANGLES PSI AND OMEGA C CPSI = COS(PSI) SPSI = SIN(PSI) COMG = COS(OMG) SOMG = SIN(OMG) C C COMPUTE S MATRIX C 1 C S(1,1) = SPSI*COMG S(1,2) = CPSI*COMG S(1,3) = -SOMG S(2,1) = SPSI*SOMG S(2,2) = CPSI*SOMG S(2,3) = COMG S(3,1) = CPSI S(3,2) = -SPSI S(3,3) = 0.0 C C T C COMPUTE ROTATION MATRIX S PA C 1 C DO I = 1,3 DO J = 1,3 ROT(J,I) = S(1,I)*Q(J,1) + S(2,I)*Q(J,2) + S(3,I)*Q(J,3) END DO END DO C C COMPUTE S MATRIX C 2 C COMG = COS(DTR*(360.0-ANG(2))) SOMG = SIN(DTR*(360.0-ANG(2))) S(1,1) = SPSI*COMG S(1,2) = CPSI*COMG S(1,3) = -SOMG S(2,1) = SPSI*SOMG S(2,2) = CPSI*SOMG S(2,3) = COMG C C T T C COMPUTE S S PA C 2 1 C DO I = 1,3 DO J = 1,3 Q(J,I) = S(I,1)*ROT(J,1) + S(I,2)*ROT(J,2) + S(I,3)*ROT(J,3) END DO END DO C C SWAP LATITUDE AND LONGITUDE FOR CONFORMANCE TO CRUISE MODE ROUTINES. C TEMP = ANG(1) ANG(1) = ANG(2) ANG(2) = TEMP C RETURN END SUBROUTINE SEDRIP (T1,B1,T2,B2,T,B,N,MD) C C**** =U2ADS.SEDRIP 05-OCT-79 ALLAN SILVER C REAL*8 T1,T2,T REAL*4 B1(1),B2(1),B(1) C --> REAL*4 RL(3)/0.,-3.1415927E0,0./ <-- REPLACED 86-APR-19, C --> REAL*4 RU(3)/+3.1415927E0,+3.1415927E0,+360./ JAJONES, SAR REAL*4 RL(4)/0.,-3.1415927E0,0.,-90./ REAL*4 RU(4)/+3.1415927E0,+3.1415927E0,+360.,+90./ C*********************************************************************** C******** LINEAR INTERPOLATION WITHIN LIMITS & NORMALIZATION *********** C*********************************************************************** C**** INDEPENDENT VARIABLE FUNCTION VALUE(S) * C**** T1 (INPUT) B1(1...N) (INPUT) * C**** T2 (INPUT) B2(1...N) (INPUT) * C**** T (INPUT) B(1...N) (OUTPUT; LINEAR INTERP.) * C*********************************************************************** C**** MD LIMITS OF FUNCTION * C**** 0 UNLIMITED * C**** 1 0 TO PI * C**** 2 - PI TO + PI * C**** 3 0 TO 360 * C**** 4 - 90 TO + 90 ( <-- ADDED BY JAJ 86-APR19 ) * C*********************************************************************** C**** T1<0 ---> DO NOT USE B1 **** T2<0 ---> DO NOT USE B2 * C**** T1=T2 ---> USE B1 ONLY * C*********************************************************************** C**** FOR N=9 & MD=0, TREAT B AS A 3X3 MATRIX & NORMALIZE BY ROWS * C*********************************************************************** C C**** COMPUTE RANGE AND HALF RANGE C IF (MD.NE.0) THEN RG = RU(MD) - RL(MD) RGH = .5E0*RG END IF C C**** COMPUTE LINEAR INTERPOLATION COEFFICIENTS C IF (T1.GE.0.D0) THEN IF ( T2.GE.0.D0 .AND. T1.NE.T2 ) THEN ALF = (T2 - T)/(T2 - T1) BET = (T - T1)/(T2 - T1) ELSE ALF = 1.E0 BET = 0.E0 END IF ELSE IF (T2.LT.0.D0) THEN WRITE (6,2001) T1,T2 ! ERROR RETURN ELSE ALF = 0.E0 BET = 1.E0 END IF C C**** DO THE INTERPOLATION C DO I = 1,N B(I) = ALF*B1(I) + BET*B2(I) IF ( MD.NE.0 ) THEN C**** PUT B1 AND B2 WITHIN HALF-RANGE OF EACH OTHER K = INT((B2(I) - B1(I))/RGH) B(I) = B(I) + RGH*ALF*(K + MOD(K,2)) C**** PUT B WITHIN LIMITS B(I) = B(I) - RG*INT((B(I) - RL(MD))/RG) IF ( B(I).LT.RL(MD) ) B(I) = B(I) + RG END IF END DO IF (N.NE.9.OR.MD.NE.0) RETURN ! EXIT ROUTINE IF NOT 3X3 MATRIX C C**** NORMALIZE THE MATRIX C DO J = 1,7,3 FCT = SQRT(B(J)**2 + B(J+1)**2 + B(J+2)**2) IF ( FCT.NE.0.E0 ) THEN B(J) = B(J)/FCT B(J+1) = B(J+1)/FCT B(J+2) = B(J+2)/FCT END IF END DO C RETURN 2001 FORMAT (' SEDRIP ERROR: ',1P2D15.7) END SUBROUTINE SEDRPROC(NVBLK,MPE,RH,VH,THETA,BETA,MTB,MHG,MTB5) C C COMPUTE THE TRANFORMATION FROM THE EARTH MEAN ECLIPTIC AND EQUINOX C OF 1950.0 (EME'50) COORDINATES TO HELIOGRAPHIC COORDINATES. C C INPUT NAVIGATION RECORD DATA (NVBLK) AND POINTING VECTOR DATA (MPE) C C MATRICES ARE REPRESENTED IN ROW MAJOR ORDER, IE; C 11 12 13 C 21 22 23 C 31 32 33 C REAL*4 NVBLK(6),RE(3),RH(3),VE(3),VH(3) REAL*4 MHG(3,3),MTB(3,3),MSUN(3,3),M5(3,3),MPE(3,3),MTB5(3,3) C C M5 IS A PSEUDO-CONSTANT ORTHOGONAL MATRIX THAT MAPS VECTORS FROM THE EARTH- C MEAN-ECLIPTIC, EQUINOX OF 1950 (EME'50) INERTIAL SYSTEM TO AN INERTIAL C HELIOGRAPHIC SYSTEM (IHG). C DATA M5 / 0.2576, -0.9585, 0.1219, & 0.9662, 0.2555, -0.0325, & 0.0 , 0.1262, 0.9920 / C C LOAD S/C POSITION VECTOR INTO ARRAY RE. C RE(1) = NVBLK(1) RE(2) = NVBLK(2) RE(3) = NVBLK(3) C C LOAD S/C VELOCITY VECTOR INTO ARRAY VE. C VE(1) = NVBLK(4) VE(2) = NVBLK(5) VE(3) = NVBLK(6) C C GET IHG SPACECRAFT LATITUDE (THETA) AND LONGITUDE (BETA), AND C IHG TO HG TRANSFORMATION MATRIX (MTB). C CALL POS(RE,VE,M5,RH,VH,THETA,BETA,MTB) C C GET PAYLOAD TO IHG TRANSFORMATION MATRIX (MSUN) C CALL IHG(MSUN,M5,MPE) C C GET PAYLOAD TO HG TRANSFORMATION MATRIX (MHG) C CALL HG(MHG,MTB,MSUN) C C GET EME'50 TO HG TRANSFORMATION MATRIX (MTB5) C CALL MPRD33(MTB5,MTB,M5) C RETURN END SUBROUTINE SENSOR_ALIGN(GAMMA,GAMMA2,NPRI,NSEC,NSTAT2,BAD) C THIS ROUTINE DETERMINES THE STATE OF THE LFM MECHANICAL FLIPPER C AND APPLIES THE CORRECT SENSOR ALIGNMENT MATRICES TO ROTATE DATA. C WRITTEN BY SANDY KRAMER, HUGHES STX, CODE 692, 11/07/96 C INPUT VARIABLES C BAD FILL VALUE C GAMMA PRIMARY MAG FIELD STRENGTH C GAMMA2 SECONDARY MAG FIELD STRENGTH C IBFLIP INBOARD MAG ELECTRONIC FLIPPER STATUS (GLOBAL) C NPRI NUMBER OF PRIMARY WORDS C NSEC NUMBER OF SECONDARY WORDS C NSTAT2 NUMBER OF MAG STATUS 2 WORDS C OBFLIP OUTBOARD MAG ELECTRONIC FLIPPER STATUS (GLOBAL) C PRIME PRIMARY MAG FLAG ARRAY (GLOBAL) C VSLIB INBOARD SENSOR ALIGNMENT MATRIX C VSLIB180 INBOARD SENSOR ALIGNMENT FLIP MATRIX C VSLOB OUTBOARD SENSOR ALIGNMENT MATRIX C VSLOB180 OUTBOARD SENSOR ALIGNMENT FLIP MATRIX C OUTPUT VARIABLES C GAMMA PRIMARY MAG FIELD STRENGTH C GAMMA2 SECONDARY MAG FIELD STRENGTH C LOCAL VARIABLES C FIELD TEMPORARY VARIABLE C INBOARD PRIMARY MAG FLAG LOGICAL*1 INBOARD REAL*4 GAMMA(3,NPRI),GAMMA2(3,NSEC),FIELD(3) INCLUDE 'UNPACK.INC' C PRIMARY MAG SENSOR ALIGNMENT DO I = 1,NPRI IF ( NSTAT2.EQ.0 ) THEN INBOARD = .FALSE. ISTAT = 0 IBFLIP(0) = .FALSE. OBFLIP(0) = .FALSE. ELSE IRATIO = NPRI/NSTAT2 ISTAT = (I-1)/IRATIO + 1 INBOARD = PRIME(ISTAT) END IF IF ( GAMMA(1,I).NE.BAD .AND. & GAMMA(2,I).NE.BAD .AND. & GAMMA(3,I).NE.BAD ) THEN C INBOARD MAG IS PRIMARY IF ( INBOARD ) THEN IF ( IBFLIP(ISTAT) ) THEN CALL MPRD31(FIELD,VSLIB180,GAMMA(1,I)) ! INBOARD LFM FLIP = 180 ELSE CALL MPRD31(FIELD,VSLIB,GAMMA(1,I)) ! INBOARD LFM FLIP = 0 END IF GAMMA(1,I) = FIELD(1) GAMMA(2,I) = FIELD(2) GAMMA(3,I) = FIELD(3) C OUTBOARD MAG IS PRIMARY ELSE IF ( OBFLIP(ISTAT) ) THEN CALL MPRD31(FIELD,VSLOB180,GAMMA(1,I)) ! OUTBOARD LFM FLIP = 180 ELSE CALL MPRD31(FIELD,VSLOB,GAMMA(1,I)) ! OUTBOARD LFM FLIP = 0 END IF GAMMA(1,I) = FIELD(1) GAMMA(2,I) = FIELD(2) GAMMA(3,I) = FIELD(3) END IF ELSE GAMMA(1,I) = BAD GAMMA(2,I) = BAD GAMMA(3,I) = BAD END IF C END PRIMARY MAG SENSOR ALIGNMENT END DO C SECONDARY MAG SENSOR ALIGNMENT DO I = 1,NSEC IF ( NSTAT2.EQ.0 ) THEN INBOARD = .FALSE. ISTAT = 0 IBFLIP(0) = .FALSE. OBFLIP(0) = .FALSE. ELSE IRATIO = NSEC/NSTAT2 ISTAT = (I-1)/IRATIO + 1 INBOARD = PRIME(ISTAT) END IF IF ( GAMMA2(1,I).NE.BAD .AND. & GAMMA2(2,I).NE.BAD .AND. & GAMMA2(3,I).NE.BAD ) THEN C OUTBOARD MAG IS SECONDARY IF ( INBOARD ) THEN IF ( OBFLIP(ISTAT) ) THEN CALL MPRD31(FIELD,VSLOB180,GAMMA2(1,I)) ! OUTBOARD LFM FLIP = 180 ELSE CALL MPRD31(FIELD,VSLOB,GAMMA2(1,I)) ! OUTBOARD LFM FLIP = 0 END IF GAMMA2(1,I) = FIELD(1) GAMMA2(2,I) = FIELD(2) GAMMA2(3,I) = FIELD(3) C INBOARD MAG IS SECONDARY ELSE IF ( IBFLIP(ISTAT) ) THEN CALL MPRD31(FIELD,VSLIB180,GAMMA2(1,I)) ! INBOARD LFM FLIP = 180 ELSE CALL MPRD31(FIELD,VSLIB,GAMMA2(1,I)) ! INBOARD LFM FLIP = 0 END IF GAMMA2(1,I) = FIELD(1) GAMMA2(2,I) = FIELD(2) GAMMA2(3,I) = FIELD(3) END IF ELSE GAMMA2(1,I) = BAD GAMMA2(2,I) = BAD GAMMA2(3,I) = BAD END IF C END SECONDARY MAG SENSOR ALIGNMENT END DO RETURN END SUBROUTINE SENSOR_DAT() C C READ SENSOR ALIGNMENT MATRICES FOR INBOARD AND OUTBOARD MAGS C SBK 04/07/93 C CHARACTER*72 LINE(100) C INCLUDE 'UNPACK.INC' C I = 1 5 CONTINUE READ(52,'(A72)',END=10,ERR=5) LINE(I) I = I + 1 GOTO 5 10 CONTINUE ILINE = I - 1 C K = 1 DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C INBOARD SENSOR MATRIX C DO I = 0,2 READ(LINE(K),*) (VSLIB(I+1,J),J=1,3) K = K + 1 END DO C DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C OUTBOARD SENSOR MATRIX C DO I = 0,2 READ(LINE(K),*) (VSLOB(I+1,J),J=1,3) K = K + 1 END DO C DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C INBOARD SENSOR MATRIX (FLIP=180) C DO I = 0,2 READ(LINE(K),*) (VSLIB180(I+1,J),J=1,3) K = K + 1 END DO C DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C OUTBOARD SENSOR MATRIX (FLIP=180) C DO I = 0,2 READ(LINE(K),*) (VSLOB180(I+1,J),J=1,3) K = K + 1 END DO C RETURN END SUBROUTINE SETBIT( BUFFER, OFFSET, LENGTH ) C C SET LENGTH BITS TO ONE STARTING AT OFFSET IN BUFFER C INTEGER BUFFER(1), OFFSET, LENGTH C INDEX = 1 IOFF = OFFSET DO WHILE ( IOFF .GE. 32 ) IOFF = IOFF - 32 INDEX = INDEX + 1 ENDDO C NBITS = LENGTH DO WHILE ( NBITS .GT. 0 ) BUFFER(INDEX) = IBSET( BUFFER(INDEX), IOFF ) NBITS = NBITS - 1 IOFF = MOD( IOFF+1, 32 ) IF ( IOFF .EQ. 0 ) INDEX = INDEX + 1 ENDDO C RETURN END SUBROUTINE SHIVOT(REF,NREF,REC,NDM,PASSALL) C THIS ROUTINE ADJUSTS 12 BIT PREDICT WORDS RECONSTRUCTED FROM DELTA C MODULATED WORDS TO TRACK 12 BIT REFERENCE WORDS. ALGORITHM IS BASED C UPON REFERENCES IN JPL VOYAGER SOFTWARE DOC FP35-14-4 C ORIGINAL CODE WRITTEN BY SANDY KRAMER, HUGHES STX, 02/20/96 C ERROR CHECKING ADDED BY SBK - 05/03/96 C REMOVAL OF INCLUDE FILE DEPENDENCE - SBK 12/26/96 C INPUT: C REF = 12 BIT REFERENCE FULL WORDS C NREF = NUMBER OF REFERENCE FULL WORDS C REC = RECONSTRUCTED DELTA MODULATED (DM) WORDS C NDM = NUMBER OF RECONSTRUCTED DELTA MODULATED (DM) WORDS C PASSALL = FLAG CONTROLING THE INCLUSION/EXCLUSION OF C RECONSTRUCTED PREDICT WORDS C OUPUT: C REC = ADJUSTED RECONSTRUCTED DELTA MODULATED (DM) WORDS C LOCAL VARIABLES: C IRES = RATIO OF DM WORDS TO FULL WORDS C LEFT = see description in following algorithm C RITE = see description in following algorithm C ERR = ERROR IN RECONSTRUCTION C NOTES: C CR-5 C IRES = 20 PRIMARY C = 10 SECONDARY C C CR-6 C IRES = 30 PRIMARY C = 15 SECONDARY C ALGORITHM: C Given n reconstructed delta words (DM) per reference word (R), C R(1) and R(2) are two full twelve bit reference words. C DM(i) is the ith reconstructed full word between R(1) and R(2). C DM(n) immediately precedes R(2) in the raw telemetry stream. C DM(n+1) immediately follows R(2) in the raw telemetry stream. C x(i) is the ith adjusted reconstructed full word. C LEFT = R(1) - DM(1) C RITE = R(2) - ( DM(n+1) + LEFT ) C x(i) = DM(i) + LEFT + (i-1)*(RITE/n), where i=1,n+1 C x(1) = R(1) C x(n+1) = R(2) C Align reference and reconstructed full words as follows: C R R R C 1 2 ...N=NREF C | | | C x x x x x x x x x x x x x x x x x x x x ...x x x x x x x x x x C 1 2 3 . . . . . . . . . . . . . . . . . . . . . . . . . . . .K=NDM C C D D D D D D D D D D D D D D D D D D D D ...D D D D D D D D D D C M M M M M M M M M M M M M M M M M M M M M M M M M M M M M M C 1 2 3 . . . . . . n n C + C 1 INTEGER*2 REF(3,NREF),REC(3,NDM) INTEGER*4 LEFT,RITE,ERR LOGICAL*1 PASSALL IF ( MOD(NDM,NREF).NE.0 ) THEN WRITE(6,'(1X,''*SHIVOT* INVALID DM/REF RATIO!'')') STOP END IF IRES = NDM/NREF IF ( PASSALL ) GOTO 10 C PASS ONLY REFERENCE WORDS DO IAX = 1,3 DO I = 1,NDM J = (I-1)/IRES + 1 REC(IAX,I) = 0 IF ( MOD(I-1,IRES).EQ.0 ) REC(IAX,I) = REF(IAX,J) END DO END DO RETURN C RECOVER DELTA MODULATED WORDS 10 CONTINUE C PROCESS ALL THREE AXES DO IAX = 1,3 C SHIFT AND PIVOT DATA DO I = 1,NREF-1 J = (I-1)*IRES + 1 LEFT = REF(IAX,I) - REC(IAX,J) RITE = REF(IAX,I+1) - ( REC(IAX,J+IRES) + LEFT ) ERR = ABS(RITE) DO IDM = 0,IRES-1 REC(IAX,J+IDM) = REC(IAX,J+IDM) + LEFT ! shift REC(IAX,J+IDM) = REC(IAX,J+IDM) + IDM*(RITE/IRES) ! pivot IF ( REF(IAX,I).EQ.0 ) REC(IAX,J+IDM) = 0 ! null data check IF ( ERR.GE.5 ) REC(IAX,J+IDM) = 0 ! error check END DO END DO C FINAL SHIFT, NO PIVOT, NO RECONSTRUCTION ERROR CHECK J = (NREF-1)*IRES + 1 LEFT = REF(IAX,NREF) - REC(IAX,J) DO IDM = 0,IRES-1 REC(IAX,J+IDM) = REC(IAX,J+IDM) + LEFT ! shift IF ( REF(IAX,NREF).EQ.0 ) REC(IAX,J+IDM) = 0 ! null data check END DO END DO RETURN END SUBROUTINE STATS(B,FMOD,LEN,BAVE,FMAG,RMS,IFMAG,BAD) C INTEGER*4 IAV(3),IRMS(3),IFMAG REAL*4 B(3,LEN),FMOD(LEN),BAVE(3),FMAG,RMS(3) C C INITIALIZE VARIABLES C DO IAX = 1,3 IAV(IAX) = 0 IRMS(IAX) = 0 BAVE(IAX) = 0.0 RMS(IAX) = 0.0 END DO IFMAG = 0 FMAG = 0.0 C DO I = 1,LEN C C ACCUMULATE COMPONENT AVERAGES C DO IAX = 1,3 IF (B(IAX,I).NE.BAD) THEN BAVE(IAX) = BAVE(IAX) + B(IAX,I) IAV(IAX) = IAV(IAX) + 1 END IF END DO C C ACCUMULATE FIELD MAGNITUDE C IF (FMOD(I).NE.BAD) THEN FMAG = FMAG + FMOD(I) IFMAG = IFMAG + 1 END IF C END DO C C CALCULATE FIELD MAGNITUDE C IF (IFMAG.GT.0) THEN FMAG = FMAG/REAL(IFMAG) ELSE FMAG = BAD END IF C C CALCULATE FIELD COMPONENT AVERAGES C DO IAX = 1,3 C IF (IAV(IAX).GT.0) THEN BAVE(IAX) = BAVE(IAX)/REAL(IAV(IAX)) ELSE BAVE(IAX) = BAD END IF C C ACCUMULATE RMS OF FIELD COMPONENTS C DO I = 1,LEN C IF (B(IAX,I).NE.BAD.AND.BAVE(IAX).NE.BAD) THEN RMS(IAX) = RMS(IAX) + (B(IAX,I)-BAVE(IAX))**2 IRMS(IAX) = IRMS(IAX) + 1 END IF C END DO C C CALCULATE RMS OF FIELD COMPONENTS C IF (IRMS(IAX).GT.0) THEN RMS(IAX) = SQRT(RMS(IAX)/REAL(IRMS(IAX))) ELSE RMS(IAX) = BAD END IF C END DO C RETURN END SUBROUTINE TBOUND(START,STOP) C C GET DATA START AND STOP TIMES C INTEGER*2 STIME(6),ETIME(6) REAL*8 START,STOP C 1 WRITE(6,*) 'ENTER START TIME (YY/DDD/HH:MM:SS)' READ(5,800,ERR=1,END=2) STIME 2 CONTINUE C 3 WRITE(6,*) 'ENTER STOP TIME (YY/DDD/HH:MM:SS)' READ(5,800,ERR=3,END=4) ETIME 4 CONTINUE C IF (STIME(1).GE.0) THEN START = REALTIME(STIME) ELSE WRITE(6,801) STOP END IF C IF (ETIME(1).GE.0) THEN STOP = REALTIME(ETIME) ELSE WRITE(6,802) STOP END IF C C ASSUME DESIRE TO PROCESS ENTIRE EDR FOR ALL NON-NEGATIVE TIME TAGS C IF (START.EQ.STOP) THEN START = 0.0D0 STOP = 999.0D0 END IF C WRITE(68,*) WRITE(68,805) STIME WRITE(68,806) ETIME C RETURN C 800 FORMAT(I2,1X,I3,3(1X,I2),1X,I3) 801 FORMAT(1X,'*TBOUND* INVALID NEGATIVE START YEAR') 802 FORMAT(1X,'*TBOUND* INVALID NEGATIVE STOP YEAR') 805 FORMAT(1X,'DATA START TIME: ',I2,1X,I3.3,3(1X,I2.2),1X,I3.3) 806 FORMAT(1X,'DATA STOP TIME: ',I2,1X,I3.3,3(1X,I2.2),1X,I3.3) C END SUBROUTINE TRANS31(GAMMAS,IAX,IVEC,MATRIX,NULL) C C ROTATE THREE ELEMENT VECTOR C REAL*4 OUTVAL(3),MATRIX(3,3),GAMMAS(IAX,IVEC),NULL C IF (IAX.NE.3) RETURN C DO IREC = 1,IVEC C C ROTATE FILL-FREE VECTORS C IF (GAMMAS(1,IREC).NE.NULL.AND. & GAMMAS(2,IREC).NE.NULL.AND. & GAMMAS(3,IREC).NE.NULL) THEN C C ROTATE THREE ELEMENT VECTOR C OUTVAL(1) = MATRIX(1,1)*GAMMAS(1,IREC) + & MATRIX(1,2)*GAMMAS(2,IREC) + & MATRIX(1,3)*GAMMAS(3,IREC) OUTVAL(2) = MATRIX(2,1)*GAMMAS(1,IREC) + & MATRIX(2,2)*GAMMAS(2,IREC) + & MATRIX(2,3)*GAMMAS(3,IREC) OUTVAL(3) = MATRIX(3,1)*GAMMAS(1,IREC) + & MATRIX(3,2)*GAMMAS(2,IREC) + & MATRIX(3,3)*GAMMAS(3,IREC) C C REASSIGN ORIGINAL GAMMA COMPONENTS WITH OUTPUT VECTOR VALUES C GAMMAS(1,IREC) = OUTVAL(1) GAMMAS(2,IREC) = OUTVAL(2) GAMMAS(3,IREC) = OUTVAL(3) C ELSE C GAMMAS(1,IREC) = NULL GAMMAS(2,IREC) = NULL GAMMAS(3,IREC) = NULL C END IF C END DO 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 SUBROUTINE VIM5AVE(GAMMA,GAMMA2,BAD,TIME) C C MASTER CALLING ROUTINE FOR THE PRODUCTION OF VIM-5 AVERAGES C MODIFIED TO PROCESS BOTH SINGLE MAGS CONCURRENTLY 07/26/95 - SBK C MODIFIED TO INCLUDE COMPOSITE MAG OPTION 01/30/2006 - SBK C MODIFIED TO OUTPUT ONLY CALIBRATION DATA ON DETECTION 12/19/2006 - SBK C CALIBRATION LOGIC CHANGED TO SKIP MAGCAL DATA BOUNDED BY CALIBRATION C BIT SET TO 1 AND ENDING WITH SERIES OF EFLIP BITS SET TO 1. -SBK 08/15/2007 C LOGICAL*1 CALDAT, EFLPDAT C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,400),GAMMA2(3,8),SCF(3,400),AMBIENT(3,400) C DATA SCF /1200*999.0/, CALDAT /.FALSE./, EFLPDAT /.FALSE./ C INCLUDE 'UNPACK.INC' C C GET SPACECRAFT FIELD AND AMBIENT FIELD VALUES C CALL VIM5FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C DETAIL OUTPUT C IF ( SYS2(4).OR.SYS2(5) ) THEN CALL VIM5DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) RETURN END IF C IF ( SYS2(11) ) GOTO 100 C C CALIBRATION DETAIL DATA OUTPUT - FIRST CALIBRATION BIT SET MARKS BEGINNING C OF CALIBRATION PERIOD. PERIOD END MARKED BY SERIES OF EFLIP BITS. LAST C EFLIP BIT SET TO 1 ENDS CALIBRATION PERIOD. LOOK FOR RETURN OF EFLIP BIT C WITH ZERO VALUE. C DO I=1,4 IF ( (IBCAL(I).OR.OBCAL(I) ) .AND. .NOT.CALDAT ) THEN CALDAT = .TRUE. EFLPDAT = .FALSE. ELSE IF ( CALDAT .AND. EFLIP(I) ) THEN EFLPDAT = .TRUE. END IF IF ( EFLPDAT .AND. .NOT.EFLIP(I) ) THEN CALDAT = .FALSE. EFLPDAT = .FALSE. WRITE(6,*) '***VIM5AVE***SKIPPING MAGCAL DATA' RETURN END IF END DO IF ( CALDAT ) THEN WRITE(6,*) '***VIM5AVE***SKIPPING MAGCAL DATA' RETURN END IF C C SKIP NON-RANGE 0 DATA C DO IRNG = 1,4 IF ( IBRNG(IRNG).GT.0 .OR. OBRNG(IRNG).GT.0 ) THEN WRITE(6,*) '***VIM5AVE***SKIPPING NON RANGE 0 DATA ', & IBRNG(IRNG),' ',OBRNG(IRNG) RETURN END IF END DO C 100 CONTINUE C C COMPOSITE MAG MODE - INTERPOLATED SECONDARY X AND Z REPLACE PRIMARY X AND Z C IF ( SYS2(28) ) THEN CALL VIM5SPL(GAMMA,GAMMA2,SCF,TIME,BAD) C C SINGLE MAG MODE - PRIMARY C ELSE IF ( SYS2(21) .AND. (.NOT.SYS2(22)) ) THEN CALL VIM5PRI(GAMMA,SCF,TIME,BAD) C C SINGLE MAG MODE - SECONDARY C ELSE IF ( (.NOT.SYS2(21)) .AND. SYS2(22) ) THEN CALL VIM5SEC(GAMMA2,SCF,TIME,BAD) C C SINGLE MAG MODE - PRIMARY AND SECONDARY C ELSE IF ( SYS2(21) .AND. SYS2(22) ) THEN CALL VIM5PNS(GAMMA,GAMMA2,TIME,BAD) C C DUAL MAG MODE - AMBIENT AND SPACECRAFT FIELDS C ELSE IF ( (.NOT.SYS2(21)) .AND. (.NOT.SYS2(22)) ) THEN C C IF SYS2(27) IS TRUE, USE S/C FIELD AS AMBIENT C IF (SYS2(27)) THEN CALL VIM5PRI(SCF,SCF,TIME,BAD) ELSE CALL VIM5PRI(AMBIENT,SCF,TIME,BAD) END IF C END IF C RETURN END C C OBSOLETE ROUTINE REPLACED BY MAKEGAMMAS 12/30/1996 SBK C SUBROUTINE VIM5CNT(GAMMA,GAMMA2,BAD,TIME,INBOARD) C C VIM-5 ROUTINE C C THIS SUBROUTINE SUBTRACTS THE ZERO OFFSET FROM EACH COUNT AND MULTIPIES THE C RESULTING DIFFERENCE BY THE SENSITIVITY TO YIELD FIELD STRENGTH IN GAMMAS. C INTEGER*2 TIME(6) INTEGER*4 PRIOFF(3),SECOFF(3) LOGICAL*1 RECTEST,INBOARD REAL*4 GAMMA(3,400),GAMMA2(3,8),PRISEN(3),SECSEN(3) C INCLUDE 'UNPACK.INC' C IF (SYS2(32)) RECTEST = .TRUE. C IP = 0 IS = 0 DO IWRD = 1,400 C C STAT1 WORD COUNTER (4 STAT1 WORDS PER 20 MF VIM-5 RECORD) C ICYC = INT((IWRD-1)/100) + 1 C C ASSIGN OFFSETS AND SENSITIVITIES TO LOCAL VARIABLES CHECKING PRIME C LFM STATUS. C DO IAX = 1,3 IF (.NOT.INBOARD) PRIOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) IF (.NOT.INBOARD) SECOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) IF (.NOT.INBOARD) PRISEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) IF (.NOT.INBOARD) SECSEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) IF (INBOARD) PRIOFF(IAX) = IBOFF(IAX,IBRNG(ICYC)) IF (INBOARD) SECOFF(IAX) = OBOFF(IAX,OBRNG(ICYC)) IF (INBOARD) PRISEN(IAX) = IBSENS(IAX,IBRNG(ICYC)) IF (INBOARD) SECSEN(IAX) = OBSENS(IAX,OBRNG(ICYC)) END DO C C CONVERT PRIMARY MODE VIM-5 COUNTS TO GAMMAS C DO IAX = 1,3 GAMMA(IAX,IWRD) = BAD IF (PREC(IAX,IWRD).NE.0) GAMMA(IAX,IWRD) = & (PREC(IAX,IWRD)-PRIOFF(IAX))*PRISEN(IAX) END DO C C CONVERT SECONDARY MODE VIM-5 COUNTS TO GAMMAS C IF (MOD(IWRD-1,50).EQ.0) THEN C IP = IP + 1 IS = IS + 1 DO IAX = 1,3 GAMMA2(IAX,IS) = BAD IF (SREF(IAX,IS).NE.0) GAMMA2(IAX,IS) = & (SREF(IAX,IS)-SECOFF(IAX))*SECSEN(IAX) END DO C ELSE IF (MOD(IWRD-1,25).EQ.0) THEN IP = IP + 1 END IF C IF (RECTEST) THEN C IF (IWRD.EQ.1) WRITE(81,'(1X,''EDR TIME: '',6(1X,I3))') TIME C WRITE(81,'(4(1X,I5),3(1X,F7.3),3(1X,I5),3(1X,F7.3))') & IWRD,PREC(1,IWRD),PREC(2,IWRD),PREC(3,IWRD), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD), & SREF(1,IS),SREF(2,IS),SREF(3,IS), & GAMMA2(1,IS),GAMMA2(2,IS),GAMMA2(3,IS) C END IF C END DO C RETURN END SUBROUTINE VIM5COMM(TIME) C C VIM5 ROUTINE C C THIS ROUTINE EXTRACTS VALUES FROM THE TWO STATUS WORDS, STAT1 AND STAT2, C THAT WERE UNPACKED FROM THE PLASMA SUB-HEADER BLOCK. STAT1 CONTAINS RANGE C AND MODE VALUES. STAT2 CONTAINS SENSOR STATES. C INTEGER*2 TIME(6) INTEGER*4 OBDIFF,IBDIFF C INCLUDE 'UNPACK.INC' C C GET INSTRUMENT STATUS VALUES FROM SECOND STATUS WORD C DO I = 1,4 C C ELECTRICAL FLIPPER STATUS C EFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 0, 1, EFLIP(I), 0) C C EXTRACT PRIME LFM STATUS C PRIME(I) = .FALSE. CALL MOVBIT(STAT2(I), 1, 1, PRIME(I), 0) C C OUTBOARD LFM FLIP STATUS C OBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 3, 1, OBFLIP(I), 0) C C INBOARD LFM FLIP STATUS C IBFLIP(I) = .FALSE. CALL MOVBIT(STAT2(I), 5, 1, IBFLIP(I), 0) C C EXTRACT PROCESSOR STATUS C MPROC(I) = .FALSE. CALL MOVBIT(STAT2(I), 6, 1, MPROC(I), 0) C C EXTRACT POLARITY C POLAR(I) = .FALSE. CALL MOVBIT(STAT2(I), 7, 1, POLAR(I), 0) C C INBOARD LFM FLIGHT CALIBRATION INDICATOR C IBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 10, 1, IBCAL(I), 0) C C OUTBOARD LFM FLIGHT CALIBRATION INDICATOR C OBCAL(I) = .FALSE. CALL MOVBIT(STAT2(I), 11, 1, OBCAL(I), 0) C END DO C C GET INSTRUMENT STATUS VALUES FROM FIRST STATUS WORD C DO I=1,4 C C CHECK FOR RANGE OVERRIDE C IF (RNGSET.NE.-1) THEN OBRNG(I) = RNGSET IBRNG(I) = RNGSET GOTO 100 END IF C C EXTRACT OUTBOARD AND INBOARD RANGE MODES [0,1] C IF (MODSET.EQ.-1) THEN CALL MOVBIT(STAT1(I), 11, 1, OBMODE(I), 0) CALL MOVBIT(STAT1(I), 7, 1, IBMODE(I), 0) ELSE IF (MODSET.EQ.0) THEN OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. ELSE IF (MODSET.EQ.1) THEN OBMODE(I) = .TRUE. IBMODE(I) = .TRUE. END IF C C EXTRACT OUTBOARD AND INBOARD RANGE SENSITIVITIES [0,7] C DO J = 1,3 CALL MOVBIT(STAT1(I), 11-J, 1, OBRNG(I), J-1) CALL MOVBIT(STAT1(I), 7-J, 1, IBRNG(I), J-1) END DO C C TEST FOR RANGE ERRORS. SENSITIVITY MAY CHANGE ONLY BY ONE C IN AUTO RANGE MODE. C IBDIFF = ABS(IBRNG(I)-IBRNG(I-1)) OBDIFF = ABS(OBRNG(I)-OBRNG(I-1)) C C INBOARD MAG RANGE CHECK C IF (IBDIFF.GT.1.AND.(IBMODE(I).AND.IBMODE(I-1))) THEN WRITE(68,889) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) IBRNG(I) = IBRNG(I-1) IBMODE(I) = IBMODE(I-1) ELSE IF ( IBDIFF.NE.0 ) THEN WRITE(68,899) TIME,RECNUM,I,IBRNG(I-1),IBRNG(I) END IF C C OUTBOARD MAG RANGE CHECK C IF (OBDIFF.GT.1.AND.(OBMODE(I).AND.OBMODE(I-1))) THEN WRITE(68,888) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) OBRNG(I) = OBRNG(I-1) OBMODE(I) = OBMODE(I-1) ELSE IF ( OBDIFF.NE.0 ) THEN WRITE(68,898) TIME,RECNUM,I,OBRNG(I-1),OBRNG(I) END IF C 100 CONTINUE C END DO C C PUT LAST RANGE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBRNG(0) = IBRNG(4) OBRNG(0) = OBRNG(4) C C PUT LAST MODE VALUE IN RESERVED RANGE VALUE REFERENCE ELEMENT 0 C IBMODE(0) = IBMODE(4) OBMODE(0) = OBMODE(4) C RETURN 888 FORMAT(1X,'*VIM5COMM* OUTBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 889 FORMAT(1X,'*VIM5COMM* INBOARD RANGE ERROR!', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 898 FORMAT(1X,'*VIM5COMM* OUTBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) 899 FORMAT(1X,'*VIM5COMM* INBOARD RANGE CHANGE', & 3X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,3X, C & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'RANGE(I-1,I)',2(1X,I2)) & 'REC# ',I4,3X,'STATUS PD ',I2,3X,'PREVIOUS RANGE = ',I2,3X, & 'CURRENT RANGE = ',I2) END SUBROUTINE VIM5DET(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C OUTPUT DETAIL DATA FROM VIM5 EDR PROCESSING. C C REVISED 05/26/95 SBK - NEW ROTATION MATRIX FORMAT FROM SEDR ROUTINES C MODIFIED 04/04/96 SBK - CHANGE ASCII OUTPUT FORMAT C MODIFIED OUTPUT FORMAT FOR UNIFORMITY ACROSS TELEMETRY MODES C SBK 11/30/2006 C CHARACTER DATAID*4,FLTID*4,COORD*2,MODE*4,TELEM*4 INTEGER*2 TIME(6),VIM5TIME(6),DELTA(6), & DATATYPE(2),WORD30(2),WORD32(2) REAL*4 HDR(32),TIMEPD REAL*4 GAMMA(3,400),GAMMA2(3,8),SCF(3,400),AMBIENT(3,400), & PRIDAT(3,400),SECDAT(3,8),SCFDAT(3,400),AMBDAT(3,400) REAL*4 SPV(6),RANGE,ANG(2),PL(3), & HG(3,400),MTB(3,3),MTB5(3,3),MHG(3,3) REAL*8 TD,TN,TP C DATA ICALL/0/, DELTA/5*0,480/, VIM5TIME/6*0/, TELEM/'VIM5'/ C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (DETOUT(1),HDR(1)) C EQUIVALENCE (HDR(1),DATAID), (HDR(12),TIMEPD), & (HDR(17),DATATYPE(1)), (HDR(30),WORD30(1)), & (HDR(32),WORD32(1)) C IUNIT = 84 RECWRITE = RECWRITE + 1 ICALL = ICALL + 1 IF ( SYS2(7) ) THEN COORD = 'HG' ELSE COORD = 'PL' END IF C C CHECK FOR CONFLICTING PROCESSING FLAGS C IF ( SYS2(4).AND..NOT.SYS2(5) ) THEN MODE = 'SNGL' LEN = 1256 ELSE IF ( SYS2(5).AND..NOT.SYS2(4) ) THEN MODE = 'DUAL' LEN = 2432 ELSE WRITE(6,*) WRITE(6,*) & '*VIM5DET* CONFLICTING DETAIL PROCESSING FLAGS' STOP END IF C IF ( SYS2(6).AND.ICALL.EQ.1 ) THEN C C FORTRAN OUTPUT UNIT ASSIGNED TO FILE NAME IN VMS DCL ROUTINE CALLING C THE VOYPROD EXECUTABLE ex. $ ASSIGN FILE.DAT FOR084 C OPEN(IUNIT,STATUS='NEW',FORM='FORMATTED', & CARRIAGECONTROL='LIST',RECL=124) END IF C VIM5TIME(1) = TIME(1) VIM5TIME(2) = TIME(2) VIM5TIME(3) = TIME(3) VIM5TIME(4) = TIME(4) VIM5TIME(5) = TIME(5) VIM5TIME(6) = TIME(6) C IF ( SCID.EQ.0 ) THEN FLTID = "FLT2" ELSE IF ( SCID.EQ.1 ) THEN FLTID = "FLT1" ELSE FLTID = "FLT?" END IF DATAID = 'LFM ' TIMEPD = 192.0 DATATYPE(1) = 1 WORD32(1) = RECWRITE C IF ( SYS2(4) ) THEN WORD30(1) = 400 WORD30(2) = 8 WORD32(2) = 1224 ELSE IF ( SYS2(5) ) THEN WORD30(1) = 400 WORD30(2) = 400 WORD32(2) = 2400 END IF C C REASSIGN DETAIL VALUES TO LOCAL VARIABLES C DO I = 1,400 C C SECONDARY MAG SAMPLE COUNTER (1-8) C ISEC = (I-1)/50 + 1 C PRIDAT(1,I) = GAMMA(1,I) PRIDAT(2,I) = GAMMA(2,I) PRIDAT(3,I) = GAMMA(3,I) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,50).EQ.0 ) THEN SECDAT(1,ISEC) = GAMMA2(1,ISEC) SECDAT(2,ISEC) = GAMMA2(2,ISEC) SECDAT(3,ISEC) = GAMMA2(3,ISEC) END IF C AMBDAT(1,I) = AMBIENT(1,I) AMBDAT(2,I) = AMBIENT(2,I) AMBDAT(3,I) = AMBIENT(3,I) C SCFDAT(1,I) = SCF(1,I) SCFDAT(2,I) = SCF(2,I) SCFDAT(3,I) = SCF(3,I) C END DO C IF ( SYS2(7) ) THEN C C GET SEDR DATA C CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) C IF ( SYS2(4) ) THEN C C ROTATE PRIMARY AND SECONDARY DATA INTO HG COORDINATES C CALL ROTATE(HG,PRIDAT,MHG,400,BAD) DO II = 1,400 PRIDAT(1,II) = HG(1,II) PRIDAT(2,II) = HG(2,II) PRIDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SECDAT,MHG,8,BAD) DO II = 1,8 SECDAT(1,II) = HG(1,II) SECDAT(2,II) = HG(2,II) SECDAT(3,II) = HG(3,II) END DO C ELSE IF ( SYS2(5) ) THEN C C ROTATE AMBIENT AND SPACECRAFT FIELD DATA INTO HG COORDINATES C CALL ROTATE(HG,AMBDAT,MHG,400,BAD) DO II = 1,400 AMBDAT(1,II) = HG(1,II) AMBDAT(2,II) = HG(2,II) AMBDAT(3,II) = HG(3,II) END DO C CALL ROTATE(HG,SCFDAT,MHG,400,BAD) DO II = 1,400 SCFDAT(1,II) = HG(1,II) SCFDAT(2,II) = HG(2,II) SCFDAT(3,II) = HG(3,II) END DO C END IF C END IF C C OUTPUT 400 PRIMARY SAMPLES AND 8 SECONDARY SAMPLES C DO I = 1,400 C C SECONDARY MAG SAMPLE COUNTER (1-8) C ISEC = (I-1)/50 + 1 C IF ( SYS2(4) ) THEN C C OUTPUT PRIMARY FIELD X,Y,Z FOLLOWED BY SECONDARY FIELD X,Y,Z C DETOUT(32+I) = PRIDAT(1,I) DETOUT(32+400+I) = PRIDAT(2,I) DETOUT(32+800+I) = PRIDAT(3,I) C C AVOID RENDUNDANT ASSIGNMENTS C IF ( MOD(I-1,50).EQ.0 ) THEN DETOUT(32+1200+ISEC) = SECDAT(1,ISEC) DETOUT(32+1200+8+ISEC) = SECDAT(2,ISEC) DETOUT(32+1200+16+ISEC) = SECDAT(3,ISEC) END IF C C OUTPUT 400 PRIMARY SAMPLES AND 8 SECONDARY SAMPLES C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,VIM5TIME,RANGE,ANG(2), & ANG(1),(PRIDAT(J,I),J=1,3),(SECDAT(J,ISEC),J=1,3) END IF C ELSE IF ( SYS2(5) ) THEN C C OUTPUT AMBIENT FIELD X,Y,Z FOLLOWED BY SPACECRAFT FIELD X,Y,Z C DETOUT(32+I) = AMBDAT(1,I) DETOUT(32+400+I) = AMBDAT(2,I) DETOUT(32+800+I) = AMBDAT(3,I) C DETOUT(32+1200+I) = SCFDAT(1,I) DETOUT(32+1600+I) = SCFDAT(2,I) DETOUT(32+2000+I) = SCFDAT(3,I) C C OUTPUT 400 PRIMARY SAMPLES AND 400 S/C FIELD SAMPLES C IF ( SYS2(6) ) THEN WRITE(IUNIT,800) FLTID,TELEM,COORD,MODE,VIM5TIME,RANGE,ANG(2), & ANG(1),(AMBDAT(J,I),J=1,3),(SCFDAT(J,I),J=1,3) END IF C END IF C CALL INC_TIME(VIM5TIME,DELTA) C END DO C C WRITE BINARY DETAIL DATA C WRITE(66) (DETOUT(I),I=1,LEN) C RETURN 800 FORMAT(2(A4,1X),A2,1X,A4,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,F8.4, & 2(1X,F8.3),6(1X,F9.3)) END C C OBSOLETE ROUTINE REPLACED BY ROUTINE DIFFERENCE 12/26/1996 SBK C SUBROUTINE VIM5DIFF(TIME) C C VIM5 ROUTINE C C THIS SUBROUTINE RECONSTRUCTS PRIMARY FULL WORDS FROM PRIMARY REFERENCE C AND PRIMARY DIFFERENCE WORDS. RECONSTRUCTION IS VERIFIED AGAINST PRIMARY C REFERENCE WORDS OCCURRING EVERY 25TH COUNT. AN INCORRECT RECONSTRUCTION C RESULTS IN ALL RECONSTRUCTED PRIMARY FULL WORDS FOR A 25 COUNT CYCLE TO BE C FLAGGED IN ERROR AND REPLACED WITH THE FILL VALUE ZERO. C C PREF PRIMARY REFERENCE FULL WORD (FILL = 0) C PDIFF PRIMARY DIFFERENCE HALF WORD (FILL = 255) C PREC PRIMARY RECONSTRUCTED FULL WORD (FILL = 0) C PERR PRIMARY RECONSTRUCTION ERROR FLAG (0 = FALSE) C (1 = TRUE) C INTEGER*2 PSUM(3),PERR(3,16),TIME(6) LOGICAL*1 RECTEST C INCLUDE 'UNPACK.INC' C C OUTPUT PRIMARY AND SECONDARY REFERENCE WORDS, PRIMARY DIFFERENCE WORDS, C RECONSTRUCTED PRIMARY FULL WORDS, MODES AND RANGES. COUNTS ARE NOT C ROTATED BY SENSOR, BOOM ALIGNMENT OR SEDR MATRICES. C IF ( SYS2(31) ) RECTEST = .TRUE. C C RECONSTRUCT PRIMARY FULL WORDS FROM PRIMARY DIFFERENCES. C TEST FOR BAD DIFFERENCE WORDS AND NULL DATA. C IP = 1 PSUM(1) = 0 PSUM(2) = 0 PSUM(3) = 0 PERR(1,16) = 0 PERR(2,16) = 0 PERR(3,16) = 0 C C LOAD FIRST PRIMARY REFERENCE WORDS C DO IAX = 1,3 IF ( PREF(IAX,1).NE.0 ) THEN PREC(IAX,1) = PREF(IAX,1) PERR(IAX,1) = 0 ELSE PREC(IAX,1) = 0 PERR(IAX,1) = 1 END IF END DO C C RECONSTRUCT 12 BIT FULL WORDS FROM 6 BIT DIFFERENCE WORDS. USE C PRIMARY REFERENCE WORDS TO TEST FOR ERRORS IN RECONSTRUCTION OF C FULL WORDS FROM DIFFERENCE WORDS. C DO IWRD=1,400 C C VERIFY RECONSTRUCTED FULL WORDS C IF ( MOD(IWRD-1,25).EQ.0 .AND. IWRD.GT.1 ) THEN IP = IP + 1 DO IAX = 1,3 PERR(IAX,IP) = 0 PREC(IAX,IWRD) = 0 IF (PREF(IAX,IP-1).NE.0.AND. & PDIFF(IAX,IWRD).NE.255.AND. & PERR(IAX,IP-1).NE.1) THEN PSUM(IAX) = PSUM(IAX) + PDIFF(IAX,IWRD) PREC(IAX,IWRD) = PREF(IAX,IP-1) + PSUM(IAX) ELSE PERR(IAX,IP-1) = 1 END IF IF (PREC(IAX,IWRD).NE.PREF(IAX,IP)) THEN PREC(IAX,IWRD) = PREF(IAX,IP) PERR(IAX,IP-1) = 1 END IF PSUM(IAX) = 0 END DO C C OPERATE ON PRIMARY DIFFERENCE WORDS C ELSE DO IAX = 1,3 PREC(IAX,IWRD) = 0 IF (PDIFF(IAX,IWRD).NE.255.AND. & PERR(IAX,IP).NE.1) THEN PSUM(IAX) = PSUM(IAX) + PDIFF(IAX,IWRD) PREC(IAX,IWRD) = PREF(IAX,IP) + PSUM(IAX) ELSE PERR(IAX,IP) = 1 END IF END DO END IF C C END PRIMARY FULL WORD RECONTRUCTION C END DO C C REMOVE ERROR FLAGGED RECONSTRUCTED FULL WORDS C DO IWRD = 1,400 C C PRIMARY REFERENCE WORD COUNTER C IREF = INT((IWRD-1)/25) + 1 C C 5 MF CYCLE COUNTER (20 MF / VIM-5 RECORD) C ICYC = INT((IWRD-1)/100) + 1 C DO IAX = 1,3 IF (PERR(IAX,IREF).EQ.1) THEN PREC(IAX,IWRD) = 0 END IF END DO C IP = IREF C C SECONDARY REFERENCE WORD COUNTER C IS = INT((IWRD-1)/50) + 1 C IF (RECTEST) THEN IF (IWRD.EQ.1) WRITE(80,'(1X,''EDR TIME: '',6(1X,I3))') TIME WRITE(80,'(15(1X,I4),4(1X,I1),2(1X,Z4.4))') & IWRD, PDIFF(1,IWRD),PDIFF(2,IWRD),PDIFF(3,IWRD), & IP, PREF(1,IP), PREF(2,IP), PREF(3,IP), & PREC(1,IWRD),PREC(2,IWRD),PREC(3,IWRD), & IS, SREF(1,IS), SREF(2,IS), SREF(3,IS), & OBMODE(ICYC),OBRNG(ICYC),IBMODE(ICYC),IBRNG(ICYC), & STAT1(ICYC),STAT2(ICYC) END IF C END DO C RETURN END SUBROUTINE VIM5FLD(GAMMA,GAMMA2,SCF,AMBIENT,TIME,BAD) C C USING 192 SECOND VIM-5 EDR RECORD, INTERPOLATE SECONDARY MAG C DETAIL (24 SEC) DATA POINTS TO PRIMARY MAG DETAIL RATE (.48 SEC) C TO COMPUTE SPACECRAFT AND AMBIENT FIELDS. C SBK 10/07/93 C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,400),GAMMA2(3,8),SCF(3,400),AMBIENT(3,400) C C IMPLEMENT SPACECRAFT FIELD COUPLING COEFFICIENT, ALPHA, C IN COMPUTATION OF S/C FIELD C C COEF = ALPHA/(1.0-ALPHA) WHERE ALPHA = .1876 C = 0.230921 C DATA ALPHA/0.1876/,COEF/0.230921/ C INCLUDE 'UNPACK.INC' C DO I=1,400 C C STEP INTERPOLATE 24 SECOND VIM-5 SECONDARY MAG DATA C TO .48 SECOND PRIMARY MODE RATE C ISEC = (I-1)/50 + 1 DO J = 1,3 C C COMPUTER DIFFERENCE BETWEEN PRIMARY AND SECONDARY MAGNETOMETERS C IF (GAMMA(J,I).NE.BAD.AND. & GAMMA2(J,ISEC).NE.BAD) THEN SCF(J,I) = (GAMMA2(J,ISEC)-GAMMA(J,I))*COEF ELSE SCF(J,I) = BAD END IF C C COMPUTE AMBIENT FIELD FOR RETURN AT PRIMARY MODE RATE C IF (GAMMA(J,I).NE.BAD.AND.SCF(J,I).NE.BAD) THEN AMBIENT(J,I) = GAMMA(J,I) - SCF(J,I) ELSE AMBIENT(J,I) = BAD END IF C END DO C END DO C RETURN END ****************************************************************** * * TITLE: CONVERT RECONSTRUCTED DIGITAL VALUES INTO GAMMAS * * FILE NAME: VIM5LFM.FOR * * PURPOSE: TO CONVERT DIGITAL VIM-5 MAG SCIENCE DATA * * HISTORY: * * AUTHOR DATE CHANGE * -------- ---- ------- * S. B. KRAMER 11/02/92 ORIGINAL CODE * (MODE VIM-5) * 04/26/95 MOD TO ACCEPT LFM FLIP MATRICES * * COMMON AREAS: * * SEE UNPACK.INC FOR COMMON AREA DEFINITIONS * * NOTES: * * * PDL: * * CALL COMMAND AND STATUS WORD EXTRACTION ROUTINE * CALL FULL WORD RECONSTRUCTION ROUTINE * CALL COUNTS TO GAMMAS CONVERSION ROUTINE * CALL SENSOR ALIGNMENT ROUTINE * CALL BOOM ALIGNMENT ROUTINE * * RETURN * ****************************************************************** SUBROUTINE VIM5LFM(GAMMA,GAMMA2,BAD,TIME) INTEGER*2 TIME(6) LOGICAL*1 SROTATE,BROTATE REAL*4 GAMMA(3,400),GAMMA2(3,8) INCLUDE 'UNPACK.INC' DATA SROTATE/.TRUE./, & BROTATE/.TRUE./ C SENSOR ROTATION SWITCH IF ( SYS2(13) ) SROTATE = .FALSE. C BOOM ALIGNMENT ROTATION SWITCH IF ( SYS2(23) ) BROTATE = .FALSE. C EXTRACT INSTRUMENT STATUS FROM STAT WORDS CALL MAGSTATUS(TIME,4,4) C RECONSTRUCT PRIMARY FULL WORDS FROM DIFFERENCE WORDS CALL DIFFERENCE(PDIFF,400,PREF,16,PREC) C ASSIGN SECONDARY REFERENCE WORDS TO SECONDARY FULL WORDS DO I = 1,8 SREC(1,I) = SREF(1,I) SREC(2,I) = SREF(2,I) SREC(3,I) = SREF(3,I) END DO C CONVERT COUNTS INTO GAMMAS (MODE SENSITIVE) CALL MAKEGAMMAS(GAMMA,400,GAMMA2,8,4,4,BAD,TIME) C ORTHOGONALIZE DATA WITH SENSOR MATRIX AFTER GAMMAS (MODE SENSITIVE) IF ( SROTATE ) CALL SENSOR_ALIGN(GAMMA,GAMMA2,400,8,4,BAD) C ROTATE DATA WITH BOOM ALIGNMENT MATRIX AFTER GAMMAS (MODE SENSITIVE) IF ( BROTATE ) CALL BOOM_ALIGN(GAMMA,GAMMA2,400,8,4,BAD) C APPLY CORRECTION TO OUTBOARD MAG FOR FLIPPER DAMAGE RESULTING FROM C SPACECRAFT COMMAND ERROR ON NOV. 30, 2006 IF ( SYS2(31) ) CALL FLIPPER_FIX(GAMMA,400,BAD) RETURN END SUBROUTINE VIM5PNS(PRI,GAMMA2,TIME,BAD) C C USING 192 SECOND VIM-5 EDR RECORD, INTERPOLATE SECONDARY MAG DETAIL (24 SEC) C DATA POINTS TO PRIMARY MAG DETAIL RATE (.48 SEC). PASS INTERPOLATED C SECONDARY MAG DATA TO FIELD AVERAGING ROUTINES FOR ADDITION TO THE SUMMARY C RECORD. C C CREATED 07/26/95 - SBK C INTEGER*2 TIME(6) C REAL*4 PRI(3,400),GAMMA2(3,8),SEC(3,400) C INCLUDE 'UNPACK.INC' C DO I=1,400 C C STEP INTERPOLATE 24 SECOND VIM-5 SECONDARY MAG DATA C ISEC = (I-1)/50 + 1 SEC(1,I) = GAMMA2(1,ISEC) SEC(2,I) = GAMMA2(2,ISEC) SEC(3,I) = GAMMA2(3,ISEC) C END DO C C CALL VIM-5 AVERAGING ROUTINES C CALL VIM5PRI(PRI,SEC,TIME,BAD) C RETURN END SUBROUTINE VIM5PRI(GAMMA,SCF,TIME,BAD) C C USING THE 192 SECOND VIM-5 EDR MAG SCIENCE RECORD, C PRODUCE 48 SECOND BLOCKS OF 1.92 SEC AVERAGES FROM C PRIMARY MAG DETAIL (.48 SEC) DATA POINTS. C CHARACTER RECTYPE*4,TELFMT*4,FLTID*4 C INTEGER*2 TIME(6),DELTA(6),EDRTIME(6),LAUNCH(6), & WORD13(2),WORD30(2),WORD31(2),WORD32(2) C INTEGER*4 IB192(25) C REAL*4 SCF(3,400),GAMMA(3,400),FMOD(400),DEL(400),LAM(400), & B192(3,25),DEL192(25),LAM192(25),FMOD192(25), & FMAG192(25),RMS192(3,25),X192(25),Y192(25),Z192(25) C REAL*4 HDR(32),DATA(341) C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(1),HDR(1)), (SUMOUT(33),DATA(1)) C EQUIVALENCE (HDR(13), WORD13(1)), (HDR(30),WORD30(1)), & (HDR(31),WORD31(1)) C EQUIVALENCE (DATA(67),FMAG192(1)), (DATA(92),FMOD192(1)), & (DATA(117),DEL192(1)), (DATA(142),LAM192(1)), & (DATA(242),RMS192(1,1)),(DATA(317),IB192(1)) C C SEPARATE 192 SECOND VIM-5 RECORD INTO FOUR 48 SECOND PERIODS C DELTA(1) = 0 DELTA(2) = 0 DELTA(3) = 0 DELTA(4) = 0 DELTA(5) = 48 DELTA(6) = 0 C C DIVIDE 192 SECOND VIM-5 SCIENCE BLOCK INTO 4 48 SECOND BLOCKS C DO K = 1,4 C C COMPUTE 25 1.92 SECOND AVERAGES FOR ONE 48 SECOND PERIOD C DO J = 1,25 C I = (K-1)*100 + (J-1)*4 + 1 C C COMPUTE DETAIL FIELD MODULUS AND ANGLES C CALL ANGLES(GAMMA(1,I),4,FMOD(I),DEL(I),LAM(I),BAD) C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(GAMMA(1,I),FMOD(I),4,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C C COMPUTE 9.6 SECOND AVERAGES AND 48 SECOND AVERAGES C WORD30(1) = 100 WORD30(2) = 2 WORD31(1) = 4 WORD31(2) = 2 C C COMPUTE 48 SECOND AVERAGES OF THE SPACECRAFT FIELD C L = (K-1)*100 + 1 CALL VIM5SCF(SCF(1,L),TIME,BAD) C C COMPUTE 9.6 AND 48 SECOND AVERAGES OF 1.92 SECOND GAMMAS C CALL BIGAVE(B192,TIME,BAD) C C INCREMENT VIM-5 RECORD BLOCK TIME BY 48 SECONDS C CALL INC_TIME(TIME,DELTA) C C INCREMENT 48 SECOND COUNTER C WORD13(2) = WORD13(2) + 1 C END DO C RETURN END SUBROUTINE VIM5SCF(SCF,TIME,BAD) C C COMPUTE 48 SECOND AVERAGED SPACECRAFT FIELD FOR VIM-5 RECORD C C INPUT 48 SECONDS OF DETAIL SPACECRAFT FIELD - SCF C OUTPUT RMS(SCF)(1,2,3), #DETAIL PTS, SCF(1,2,3), NORM(SCF(1,2,3) C INTEGER*2 TIME(6) C INTEGER*4 IB192(25),IB96(5),IB48 C REAL*4 SCFLD(155),SCF(3,100),FMOD(100),DEL(100),LAM(100), & FMAG192(25),FMOD192(25),DEL192(25), & LAM192(25),B192(3,25),RMS192(3,25), & X192(25),Y192(25),Z192(25), & XRMS192(25),YRMS192(25),ZRMS192(25), & FMAG96(5),FMOD96(5),DEL96(5), & LAM96(5),B96(3,5),RMS96(3,5), & X96(5),Y96(5),Z96(5), & XRMS96(5),YRMS96(5),ZRMS96(5), & FMAG48,FMOD48,DEL48, & LAM48,B48(3),RMS48(3), & X48,Y48,Z48,HG(3,25), & SPV(6),RANGE,ANG(2), & MTB(3,3),MTB5(3,3),MHG(3,3) C REAL*8 TD,TN,TP C INCLUDE 'UNPACK.INC' C EQUIVALENCE (SUMOUT(342),SCFLD(1)) C EQUIVALENCE (SCFLD(148),RMS48(1)), (SCFLD(151),IB48), & (SCFLD(152),X48), (SCFLD(153),Y48), & (SCFLD(154),Z48), (SCFLD(155),FMOD48) C C COMPUTE DETAIL FIELD MODULUS AND ANGLES FOR 48 SECOND PERIOD C CALL ANGLES(SCF,100,FMOD,DEL,LAM,BAD) C C COMPUTE 25 1.92 SECOND AVERAGES FOR 48 SECOND PERIOD C DO I = 1,100,4 C J = (I-1)/4 + 1 C C COMPUTE 1.92 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(SCF(1,I),FMOD(I),4,B192(1,J), & FMAG192(J),RMS192(1,J),IB192(J),BAD) C END DO C C ROTATE 1.92 SECOND AVERAGES C IF ( .NOT.SYS2(9) ) THEN CALL GETSEDR(TIME,TD,TN,TP,SPV,RANGE,ANG,MTB,MTB5,MHG) CALL ROTATE(HG,B192,MHG,25,BAD) DO I192 = 1,25 B192(1,I192) = HG(1,I192) B192(2,I192) = HG(2,I192) B192(3,I192) = HG(3,I192) END DO END IF C C GENERIC AVERAGING ROUTINE TO COMPUTE 9.6 AND 48 SECOND AVERAGES C DO I = 1,25,5 C C COMPUTE 1.92 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B192(1,I),5,FMOD192(I),DEL192(I),LAM192(I),BAD) C J = (I-1)/5 + 1 C C COMPUTE 9.6 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B192(1,I),FMOD192(I),5,B96(1,J),FMAG96(J),RMS96(1,J), & IB96(J),BAD) C END DO C C COMPUTE 9.6 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B96,5,FMOD96,DEL96,LAM96,BAD) C C COMPUTE 48 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS C CALL STATS(B96,FMOD96,5,B48,FMAG48,RMS48,IB48,BAD) C C COMPUTE 48 SECOND FIELD MODULUS AND ANGLES C CALL ANGLES(B48,1,FMOD48,DEL48,LAM48,BAD) C C SEPARATE FIELD AND RMS COMPONENT VECTORS FROM MATRICES C DO I96 = 1,5 X96(I96) = B96(1,I96) Y96(I96) = B96(2,I96) Z96(I96) = B96(3,I96) XRMS96(I96) = RMS96(1,I96) YRMS96(I96) = RMS96(2,I96) ZRMS96(I96) = RMS96(3,I96) DO J = 1,5 I192 = (I96-1)*5 + J X192(I192) = B192(1,I192) Y192(I192) = B192(2,I192) Z192(I192) = B192(3,I192) XRMS192(I192) = RMS192(1,I192) YRMS192(I192) = RMS192(2,I192) ZRMS192(I192) = RMS192(3,I192) END DO END DO X48 = B48(1) Y48 = B48(2) Z48 = B48(3) C RETURN END SUBROUTINE VIM5SEC(GAMMA2,SCF,TIME,BAD) C C USING 192 SECOND VIM-5 EDR RECORD, C INTERPOLATE SECONDARY MAG DETAIL (24 SEC) DATA POINTS C TO PRIMARY MAG DETAIL RATE (.48 SEC). C INTEGER*2 TIME(6) C REAL*4 GAMMA(3,400),GAMMA2(3,8),SCF(3,400) C INCLUDE 'UNPACK.INC' C DO I=1,400 C C STEP INTERPOLATE 24 SECOND VIM-5 SECONDARY MAG DATA C ISEC = (I-1)/50 + 1 GAMMA(1,I) = GAMMA2(1,ISEC) GAMMA(2,I) = GAMMA2(2,ISEC) GAMMA(3,I) = GAMMA2(3,ISEC) C END DO C C CALL VIM-5 AVERAGING ROUTINES C CALL VIM5PRI(GAMMA,SCF,TIME,BAD) C RETURN END SUBROUTINE VIM5SPL(PRI,GAMMA2,SCF,TIME,BAD) C C REPLACE X AND Z AXES OF VOYAGER 2 PRIMARY MAG CONTAMINATED WITH SPORADIC C NOISE OSCILLATIONS WITH INTERPOLATED SECONDARY MAG DATA TO CREATE A C COMPOSITE MAG C C PASS COMPOSITE MAG DATA AS PRIMARY MAG TO FIELD AVERAGING ROUTINES FOR C ADDITION TO THE SUMMARY RECORD. C C USING 192 SECOND VIM-5 EDR RECORD, INTERPOLATE SECONDARY MAG DETAIL (24 SEC) C DATA POINTS TO PRIMARY MAG DETAIL RATE (.48 SEC). C C ***NOTE: NO COMPOSITE MAG MODE FOR DETAIL DATA OUTPUT*** C C CREATED 01/30/2006 - SANDY KRAMER, GST, CODE 690 C INTEGER*2 TIME(6) C REAL*4 PRI(3,400),GAMMA2(3,8),SCF(3,400),CMP(3,400) C INCLUDE 'UNPACK.INC' C DO I=1,400 C C STEP INTERPOLATE 24 SECOND VIM-5 SECONDARY MAG DATA C ISEC = (I-1)/50 + 1 CMP(1,I) = GAMMA2(1,ISEC) ! REPLACE PRIMARY X COMPONENT W/SECONDARY CMP(2,I) = PRI(2,I) ! PRIMARY Y COMPONENT CMP(3,I) = GAMMA2(3,ISEC) ! REPLACE PRIMARY Z COMPONENT W/SECONDARY C END DO C C CALL VIM-5 AVERAGING ROUTINES C CALL VIM5PRI(CMP,PRI,TIME,BAD) ! OUTPUT COMPOSITE MAG AND PRIMARY C RETURN END ****************************************************************** * * TITLE: INCLUDE MODULE FOR UNPACKING VOYAGER MAG (PLS) EDR * * FILE NAME: UNPACK.INC * * PURPOSE: TO MAINTAIN THE COMMON AREAS IN WHICH EDR DATA IS UNPACKED * INTO * * HISTORY: * * AUTHOR DATE CHANGE * ------ ----- ------ * S. J. KEMPLER 8/12/85 ORIGINAL CODE * S. B. KRAMER JR. 10/28/92 NEW MODE CR-5A * * IMPLEMENTATION: INCLUDE UNPACK.INC * * NOTES: * * THIS INCLUDE CONTAINS THE THREE COMMON AREAS THAT DEFINE THE CONTENTS * OF: 1.) THE EDR HEADER, 2.) THE EDR SUBHEADER (PLS DATA) AND 3.) THE * SCIENCE DATA (MAG). * * COMMON VARIABLE TYPE DESCRIPTION * ------ -------- ---- ----------- * * HEADER REFER TO VOYAGER EDR FORMAT * SPECIFICATION, APPENDIX C FOR * DETAILED DESCRIPTION OF * VARIABLES. * * PROJID A*3 WORD 1, BITS 0-23 * RECID I*2 WORD 1, BITS 24-27 * SCID I*2 WORD 1, BITS 28-31 * RECNUM I*2 WORD 2, BITS 0-15 * DATMOD I*2 WORD 2, BITS 16-23 * EEXTFL I*2 WORD 2, BITS 24-25 * SCPLAB I*2 WORD 2, BIT 26 * RECTIM I*2 WORD 2, BITS 27-31 * ERTSHR I*2 WORD 3, BITS 0-15 * ERTSSC I*2 WORD 3, BITS 16-31 * ERTSML I*2 WORD 4, BITS 0-15 * YEAR1 I*2 WORD 4, BITS 16-23 * DATSRC I*2 WORD 4, BITS 24-25 * GOLAY I*2 WORD 4, BITS 26-27 * SEGNUM I*2 WORD 4, BITS 28-31 * ERTEHR I*2 WORD 5, BITS 0-15 * ERTESC I*2 WORD 5, BITS 16-31 * ERTEML I*2 WORD 6, BITS 0-15 * YEAR2 I*2 WORD 6, BITS 16-23 * SWVERS I*2 WORD 6, BITS 24-31 * SCETHR I*2 WORD 7, BITS 0-15 * SCETSC I*2 WORD 7, BITS 16-31 * SCETML I*2 WORD 8, BITS 0-15 * YEAR3 I*2 WORD 8, BITS 16-23 * SCEVFL I*2 WORD 8, BITS 24-27 * CORRFL I*2 WORD 8, BITS 28-31 * MOD216 I*2 WORD 9, BITS 0-15 * MOD60 I*2 WORD 9, BITS 16-13 * LINCNT I*2 WORD 9, BITS 24-31, WORD 10, * BITS 0-7 * TELRAT I*2 WORD 10, BITS 8-15 * EFFRAT I*2 WORD 10, BITS 16-23 * FORMID I*2 WORD 10, BITS 24-31 * BERTOL I*2 WORD 11, BITS 0-7 * DSNCON I*2 WORD 11, BITS 8-15 * RECAGC I*2 WORD 11, BITS 16-31 * DSNNUM I*2 WORD 12, BITS 0-7 * EBEC I*2 WORD 12, BITS 16-31 * SYMSNR I*2 WORD 13, BITS 0-15 * DECSNR I*2 WORD 13, BITS 16-31 * PHYSRN I*2 WORD 14, BITS 0-15 * * DQSW(10), I*2 DQSW DQI * DQI(10) ---- --- * WORD 14, BITS 16-23, BITS 24-31 * WORD 15, BITS 0-7, BITS 8-15 * WORD 15, BITS 16-23, BITS 24-31 * WORD 16, BITS 0-7, BITS 8-15 * WORD 16, BITS 16-23, BITS 24-31 * WORD 17, BITS 0-7, BITS 8-15 * WORD 17, BITS 16-23, BITS 24-31 * WORD 18, BITS 0-7, BITS 8-15 * WORD 18, BITS 16-23, BITS 24-31 * WORD 19, BITS 0-7, BITS 8-15 * * DPI (80), I*2 DPI GCI * GCI (80) --- --- * WORD 19, BITS 16-23 BITS 24-31 * WORD 20, BITS 0-7, BITS 8-15 * WORD 20, BITS 16-23, BITS 24-31 * WORD 21, BITS 0-7, BITS 8-15 * * * * * * * * * WORD 57, BITS 16-23, BITS 24-31 * WORD 58, BITS 0-7, BITS 8-15 * WORD 58, BITS 16-23, BITS 24-31 * WORD 59, BITS 0-7, BITS 8-15 * * DPIRIS I*2 WORD 59, BITS 16-23 * GPIRIS I*2 WORD 59, BITS 24-31 * DRSDAT I*2 WORD 60, BITS 0-7 * GCBEC I*2 WORD 60, BITS 8-15 * GBITES I*2 WORD 60, BITS 16-31 * ****************************************************************** C C 09/23/96 CHANGE PLASMA ARRAY M() FROM INTEGER*2 TO LOGICAL*1 C AND INCREASE ARRAY SIZE FROM 192 TO 2925 TO ACCOMMODATE C ALL MODES. C LOGICAL*1 HEAD(240), PLS(3016), MAG(9600), FLIP(0:255), & IBMODE(0:20), OBMODE(0:20), PRIME(0:20), MPROC(0:20), & EFLIP(0:20), IBCAL(0:20), OBCAL(0:20), POLAR(0:20), & IBFLIP(0:20), OBFLIP(0:20), IBLOCK(0:20), OBLOCK(0:20), & SYS1(32), SYS2(32), M(2925) C CHARACTER*3 PROJID C INTEGER*2 RECID, SCID, RECNUM, DATMOD, H EEXTFL, SCPLAB, RECTIM, ERTSHR, ERTSSC, H ERTSML, YEAR1, DATSRC, GOLAY, SEGNUM, H ERTEHR, ERTESC, ERTEML, YEAR2, SWVERS, H SCETHR, SCETSC, SCETML, YEAR3, SCEVFL, H CORRFL, MOD216, MOD60, LINCNT, TELRAT, H EFFRAT, FORMID, BERTOL, DSNCON, RECAGC, H DSNNUM, EBEC, SYMSNR, DECSNR, PHYSRN, H DQSW(10),DQI(10),DPI(150),GCI(150), DPIRIS, H GPIRIS, DRSDAT, GCBEC, GBITES, RECWRITE C INTEGER*2 MCOMM1(10)/10*0/, PCOMM1(10)/10*0/, P MCOMM2(10)/10*0/, PCOMM2(10)/10*0/, P STAT1(20)/20*0/, STAT2(20)/20*0/, P COMAND, OBCOM, IBCOM, P L63, L64, LSTAT1, LSHORT(16,4), P ESTAT1, ESHORT(16), LSTAT2, LLONG(16,4), P ESTAT2, ELONG(16), MSTAT, LSTAT C INTEGER*2 PDIFF(3,800), PREF(3,800), PREC(3,2400), M SDIFF(3,800), SREF(3,800), SREC(3,2400), M PDELTA(3,2400), SDELTA(3,2400), M OBHFM(3,80), IBHFM(3,80), M IBOFF(1:3,0:9), OBOFF(1:3,0:9) C INTEGER*2 MAP(224) C INTEGER*4 RNGSET, MODSET, IBRNG(0:20), OBRNG(0:20) C REAL*4 IBSENS(1:3,0:9), OBSENS(1:3,0:9), M VSLIB(3,3), VSLOB(3,3), M VSLIB180(3,3), VSLOB180(3,3), M VBLIB(3,3), VBLOB(3,3) C REAL*4 SUMOUT(568),DETOUT(10000) C DATA RECWRITE/0/ C COMMON /SYSTEM/ SYS1, SYS2 C COMMON /HEADER/ PROJID, RECID, SCID, RECNUM, DATMOD, H EEXTFL, SCPLAB, RECTIM, ERTSHR, ERTSSC, H ERTSML, YEAR1, DATSRC, GOLAY, SEGNUM, H ERTEHR, ERTESC, ERTEML, YEAR2, SWVERS, H SCETHR, SCETSC, SCETML, YEAR3, SCEVFL, H CORRFL, MOD216, MOD60, LINCNT, TELRAT, H EFFRAT, FORMID, BERTOL, DSNCON, RECAGC, H DSNNUM, EBEC, SYMSNR, DECSNR, PHYSRN, H DQSW, DQI, DPI, GCI, DPIRIS, H GPIRIS, DRSDAT, GCBEC, GBITES, RECWRITE C COMMON /PLSDAT/ MCOMM1, MCOMM2, PCOMM1, PCOMM2, P STAT1, STAT2, STATIM, P L63, L64, LSTAT1, LSHORT, P ESTAT1, ESHORT, LSTAT2, LLONG, P ESTAT2, ELONG, MSTAT, M, P LSTAT C COMMON /MAGDAT/ VSLIB, VSLOB, VBLIB, VBLOB, M PDIFF, PREF, PREC, SDIFF, M SREF, SREC, OBHFM, IBHFM, M IBOFF, OBOFF, IBSENS, OBSENS, M IBRNG, OBRNG, IBMODE, OBMODE, M PRIME, MPROC, MODSET, RNGSET, M IBFLIP, OBFLIP, PDELTA, SDELTA, M EFLIP, IBCAL, OBCAL, IBLOCK, M OBLOCK C COMMON /SEDRDAT/ ICOORD C COMMON /OUTPUT/ SUMOUT C COMMON /ALLDAT/ HEAD, PLS, MAG, FLIP, A MAP C