//Z1SBKCLN JOB (U0016,N598,15),'HIGH RES',TIME=(6,00),CLASS=N, // MSGCLASS=X,NOTIFY=Z1SBK /*JOBPARM LINES=100 //*EXEC FORTRAN // EXEC FORTVCLG C C WRITTEN BY SANDY KRAMER, 01/93. C UPDATED AND VERIFIED 03/18/93 SBK C READS MAG RECORD FROM SUMMARY TAPE. C FILTERS 1.92 SEC AVGS TO CREATE NEW SUMMARY RECORD. C CHARACTER*4 FLT CHARACTER*29 DSN INTEGER*2 TIME(6),ID LOGICAL*1 LAST REAL*4 FIN(568),MAG(496),HEADER(32),SEDR(40) EQUIVALENCE (FIN(1),HEADER(1)),(FIN(33),MAG(1)), & (HEADER(4),TIME(1)),(HEADER(17),ID), & (HEADER(3),FLT),(SEDR(1),FIN(529)) C C SPECIFY FILTER PARAMETERS C SIGMUL = 5.0 IPASS = 3 BAD = 999.0 RMAX = 0.0 C WRITE(6,*) '******************************' WRITE(6,*) WRITE(6,*) 'ENTER FILTER ROUTINE' WRITE(6,*) WRITE(6,220) IPASS,' PASS FILTER' 220 FORMAT(1X,I2,A) WRITE(6,221) 'REJECT AT ',SIGMUL,' * STD LEVEL' 221 FORMAT(1X,A,F4.1,A) WRITE(6,*) C WRITE(6,222) 'NON-FILL PTS','BAD PTS','AVE (LAST 100 PTS)' WRITE(6,222) 'NON-FILL PTS','BAD PTS',' % BAD PTS ' 222 FORMAT(1X,T7,A12,T36,A7,T56,A18) WRITE(6,*) WRITE(6,223) 'F1','B1','B2','B3','F1','B1','B2','B3', & 'F1','B1','B2','B3' 223 FORMAT(1X,T3,A2,T9,A2,T15,A2,T21,A2, & T28,A2,T34,A2,T40,A2,T46,A2, & T53,A2,T61,A2,T69,A2,T77,A2) WRITE(6,*) C IREC = 0 LAST = .FALSE. 30 CONTINUE READ(10,NUM=LEN,END=100,ERR=30) FIN IF (ID.NE.1) GO TO 30 IREC = IREC + 1 C IF (IREC.GT.50) GOTO 100 READ(FLT,'(3X,I1)') ISC C WRITE(6,800) ISC,TIME C C CALL DATA BUFFERING ROUTINE C CALL QUE(MAG,HEADER,SEDR,LAST,SIGMUL,IPASS,BAD,RMAX) GO TO 30 100 CONTINUE C C FILTER REMAINING DATA IN BUFFER C LAST = .TRUE. CALL QUE(MAG,HEADER,SEDR,LAST,SIGMUL,IPASS,BAD,RMAX) C WRITE(6,*) WRITE(6,*) 'EXIT FILTER ROUTINE' WRITE(6,*) WRITE(6,810) IREC WRITE(6,*) WRITE(6,*) '******************************' STOP 800 FORMAT(1X,I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3) 810 FORMAT(1X,I5.5,' LFM RECORDS READ') END SUBROUTINE CLEAN1(DATA1,NPTS,NTOTB,NTOTG,SIGMUL,BAD,AVE,PASS) C C PROGRAM TO AUTOMATICALLY FLAG AND ASSIGN 999.0 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. ALL PARALLEL SERIES POINTS ARE DELETED. C FLAGGED POINTS ARE REMOVED FROM THE SERIES AND NOT USED FOR C SUBSEQUENT TESTS OF POINTS; THIS CLEANS "RATTY" SERIES MUCH BETTER. C INTEGER*4 I100PT(100), IUP(100), IDN(100), PASS REAL*4 DATA1(1) REAL*8 SUM,SUMSQ,SIG C C MULTI-PASS LOOP C NBD = 0 DO IPASS = 1,PASS 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 C C LEAVE ROUTINE IF STARTING WITH INSUFFICIENT NUMBER OF POINTS (100) C IF (NPTS.LT.100) GOTO 200 IPT = 1 DO NPT1 = 1, 100 25 IF (ABS(DATA1(IPT)-BAD).LT.0.01) THEN IPT = IPT + 1 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 200 ENDDO AVE = SUM/100.0 IF (SUM**2/100.0.GT.SUMSQ) THEN SIG = 0.0D0 ELSE SIG = DSQRT((SUMSQ - SUM**2/100.0)/100.0) ! DBLE PREC 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 IF (SUM**2/100.0.GT.SUMSQ) THEN SIG = 0.0D0 ELSE SIG = DSQRT((SUMSQ - SUM**2/100.0)/100.0) END IF GOTO 50 ! LOOP BACK TO THE TEST FOR THIS SET OF POINTS 200 CONTINUE C IF (IPASS.EQ.1) NGD = NTOTG NBD = NBD + NTOTB 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 QUE(MAG,HEAD,SEDR,LAST,SIGMUL,PASS,BAD,RMAX) C C BUFFER GAMMA VALUES FROM THREE MAGNETOMETER AXIS AND MAGNITUDE. C WHEN SUFFICIENT NUMBER OF POINTS IS ACCUMULATED, PASS ARRAY TO C FILTERING ROUTINE AND THEN AVERAGING ROUTINE. C PARAMETER (IARR=25000,IPARM=4,MAX=1000,LEN=25,IFULL=20000) INTEGER*4 IBUFF,NTOTG(IPARM),NTOTB(IPARM),PASS INTEGER*4 NGOOD(IPARM),NBAD(IPARM),ISPARE(147) LOGICAL*1 CLEAN,LAST,PRIME REAL*4 MAG(496),DATA(8,25),BUFFER(IARR,8),AVE(IPARM) REAL*4 HEAD(32),SEDR(40),HEADBUFF(32,MAX),SEDRBUFF(40,MAX) REAL*4 PYLD(8),PYLDBUFF(8,MAX),SPARE(147) EQUIVALENCE(ISPARE(1),SPARE(1)) SAVE NREC,IBUFF,BUFFER,HEADBUFF,SEDRBUFF,PYLDBUFF DATA IBUFF/0/ C C PRIME = .FALSE. PRIME = .TRUE. C CLEAN = .FALSE. CLEAN = .TRUE. C C INITIALIZE PRIME AREA C IF (IBUFF.EQ.0) THEN DO J = 1,8 DO I = 1,500 BUFFER(I,J) = BAD END DO END DO END IF C C LOAD 1.92 SEC F2,B1,B2,B3,RMS1,RMS2,RMS3,#PTS INTO DATA ARRAY C DO I = 1,LEN C DATA(1,I) = MAG(66+I) DATA(2,I) = MAG(166+I) DATA(3,I) = MAG(191+I) DATA(4,I) = MAG(216+I) DATA(5,I) = MAG(241+I) DATA(6,I) = MAG(266+I) DATA(7,I) = MAG(291+I) DATA(8,I) = MAG(316+I) C C REMOVE DATA POINTS EXCEEDING THRESHOLD IF VALUE SET ABOVE ZERO C IF (RMAX.GT.0.0.AND.DATA(1,I).GT.RMAX) THEN DATA(1,I) = BAD DATA(2,I) = BAD DATA(3,I) = BAD DATA(4,I) = BAD END IF C END DO C DO I = 1,8 PYLD(I) = MAG(488+I) END DO C C GOTO FILTER ROUTINE IF END OF DATA REACHED IN MAIN PROGRAM C IF (LAST) GOTO 100 C C LOAD ONE MAG BLOCK OF DATA INTO BUFFER ARRAY C DO I=1,LEN C IBUFF = IBUFF + 1 C DO J = 1,8 C IF (.NOT.PRIME) BUFFER(IBUFF,J) = DATA(J,I) IF (PRIME) THEN BUFFER(IBUFF+500,J) = DATA(J,I) C C PRIME FILTER WITH FIRST 500 POINTS IN REVERSE ORDER C IF (IBUFF.LE.500) BUFFER(501-IBUFF,J) = DATA(J,I) END IF C END DO C END DO C NREC = INT((IBUFF-1)/LEN) + 1 C C BUFFER HEADER DATA C DO I = 1,32 HEADBUFF(I,NREC) = HEAD(I) END DO C C BUFFER SEDR DATA C DO I = 1,40 SEDRBUFF(I,NREC) = SEDR(I) END DO C C BUFFER PAYLOAD DATA C DO I = 1,8 PYLDBUFF(I,NREC) = PYLD(I) END DO C C FILTER BUFFERED DATA C IF (IBUFF.GE.IFULL) THEN 100 CONTINUE IF (CLEAN) THEN C C ADD END DATA TO PRIME FILTER END WINDOW C IF (PRIME) THEN ISK = 500 IF (ISK.GT.IBUFF) ISK = IBUFF DO I = 1,ISK BUFFER(I+IBUFF,1) = BUFFER(IBUFF-I+1,1) BUFFER(I+IBUFF,2) = BUFFER(IBUFF-I+1,2) BUFFER(I+IBUFF,3) = BUFFER(IBUFF-I+1,3) BUFFER(I+IBUFF,4) = BUFFER(IBUFF-I+1,4) END DO NBUFF = IBUFF + ISK ELSE NBUFF = IBUFF END IF C C COUNT NUMBER OF NON-FILL POINTS INDEPEDENT OF FILTER STATS C DO I = 1,4 NGOOD(I) = 0 END DO C DO J = 1,4 DO I = 1,IBUFF IF (PRIME) THEN IF (BUFFER(I+500,J).NE.BAD) NGOOD(J) = NGOOD(J) + 1 ELSE IF (BUFFER(I,J).NE.BAD) NGOOD(J) = NGOOD(J) + 1 END IF END DO END DO C CALL CLEAN1(BUFFER(1,1),NBUFF,NTOTB(1),NTOTG(1), & SIGMUL,BAD,AVE(1),PASS) CALL CLEAN1(BUFFER(1,2),NBUFF,NTOTB(2),NTOTG(2), & SIGMUL,BAD,AVE(2),PASS) CALL CLEAN1(BUFFER(1,3),NBUFF,NTOTB(3),NTOTG(3), & SIGMUL,BAD,AVE(3),PASS) CALL CLEAN1(BUFFER(1,4),NBUFF,NTOTB(4),NTOTG(4), & SIGMUL,BAD,AVE(4),PASS) C WRITE(6,'(4(1X,I5),4(1X,I5),4(1X,F7.3))') NTOTG,NTOTB, C & (100.0*REAL(NTOTB(I))/REAL(NTOTG(I)),I=1,4) C DO I = 1,4 NBAD(I) = 0 END DO C DO J = 1,4 DO I = 1,IBUFF IF (PRIME) THEN IF (BUFFER(I+500,J).NE.BAD) NBAD(J) = NBAD(J) + 1 ELSE IF (BUFFER(I,J).NE.BAD) NBAD(J) = NBAD(J) + 1 END IF END DO END DO C DO I = 1,4 NBAD(I) = NGOOD(I) - NBAD(I) END DO C C OUTPUT FILTER STATS COMPUTED EXTERNAL TO SUBROUTINE CLEAN1 C WRITE(6,'(4(1X,I5),4(1X,I5),4(1X,F7.3))') NGOOD,NBAD, & (100.0*REAL(NBAD(I))/REAL(NGOOD(I)),I=1,4) END IF C C EXTRACT SUMMARY RECORDS FROM CONCATENATED BUFFER ARRAYS C DO I = 1,NREC C C EXTRACT ONE HEADER BLOCK C DO IHDR = 1,32 HEAD(IHDR) = HEADBUFF(IHDR,I) END DO C C EXTRACT ONE SCIENCE BLOCK C DO J = 1,8 DO K = 1,LEN L = (I-1)*LEN + K IF (PRIME) DATA(J,K) = BUFFER(L+500,J) IF (.NOT.PRIME) DATA(J,K) = BUFFER(L,J) END DO END DO C C EXTRACT ONE SEDR BLOCK C DO ISDR = 1,40 SEDR(ISDR) = SEDRBUFF(ISDR,I) END DO C C EXTRACT ONE PAYLOAD BLOCK C DO IPYLD = 1,8 PYLD(IPYLD) = PYLDBUFF(IPYLD,I) END DO C C RECORD FILTER PARAMETERS AND STATS C ISPARE(1) = I ISPARE(2) = PASS SPARE(3) = SIGMUL ISPARE(4) = NGOOD(1) ISPARE(5) = NGOOD(2) ISPARE(6) = NGOOD(3) ISPARE(7) = NGOOD(4) ISPARE(8) = NBAD(1) ISPARE(9) = NBAD(2) ISPARE(10) = NBAD(3) ISPARE(11) = NBAD(4) SPARE(12) = RMAX C C CALL AVERAGE GENERATION AND OUTPUT ROUTINE C CALL MAVE(DATA,PYLD,HEADBUFF(1,I),SEDRBUFF(1,I),SPARE) C END DO C IBUFF = 0 C END IF C RETURN END SUBROUTINE MAVE(DATA,PYLD,HEAD,SEDR,SPARE) C C ROUTINE TO RECONSTRUCT MAG DATA OF LFM SUMMARY RECORD C BASED ON FILTERED 1.92 SEC AVERAGES. C INTEGER*2 TIME(6) INTEGER*4 IF19_6(5),IB9_6(3,5),IB48(3),NPTS(25) REAL*4 HEAD(32),SEDR(40),DATA(8,25),PYLD(8),SPARE(147) REAL*4 F1(25),F2(25),B(3,25),RMS(3,25),PNTS(25) REAL*4 F19_6(5),F29_6(5),B9_6(3,5),RMS9_6(3,5) REAL*4 B48(3),LAM48,RMS48(3) REAL*4 DELTA(25),LAMBDA(25) REAL*4 DEL9_6(5),LAM9_6(5) EQUIVALENCE(NPTS(1),PNTS(1)) C DO I = 1,25 C F1(I) = DATA(1,I) B(1,I) = DATA(2,I) B(2,I) = DATA(3,I) B(3,I) = DATA(4,I) RMS(1,I) = DATA(5,I) RMS(2,I) = DATA(6,I) RMS(3,I) = DATA(7,I) PNTS(I) = DATA(8,I) C C COMPUTE 1.92 SEC FIELD MODULUS C IF ( B(1,I).NE.999.0 .AND. & B(2,I).NE.999.0 .AND. & B(3,I).NE.999.0 ) THEN F2(I) = SQRT(B(1,I)**2+B(2,I)**2+B(3,I)**2) ELSE F2(I) = 999.0 END IF C C COMPUTE 1.92 SEC LATITUDINAL FIELD ANGLE C IF ( B(3,I).NE.999.0 .AND. F2(I).NE.999.0 .AND. & F2(I).NE.0.0 ) THEN DELTA(I) = ASIN( B(3,I)/F2(I) )*57.2957795D0 ELSE DELTA(I) = 90.0 END IF C C COMPUTE 1.92 SEC LONGITUDINAL FIELD ANGLE C IF ( B(1,I).NE.999.0 .AND. B(2,I).NE.999.0 .AND. & B(1,I).NE.0.0 ) THEN LAMBDA(I) = 180.0 - ATAN2( B(2,I),-B(1,I) )*57.2957795D0 ELSE LAMBDA(I) = 45.0 END IF C C WRITE(6,888) F1(I),F2(I),B(1,I),B(2,I),B(3,I),DELTA(I),LAMBDA(I), C & RMS(1,I),RMS(2,I),RMS(3,I),NPTS(I) C END DO C 888 FORMAT(5(1X,F7.3),2(1X,F5.1),3(1X,F7.3),1X,I4) C C COMPUTE 9.6 SEC AVERAGES C DO I = 1,5 C F19_6(I) = 0.0 B9_6(1,I) = 0.0 B9_6(2,I) = 0.0 B9_6(3,I) = 0.0 IF19_6(I) = 0 IB9_6(1,I) = 0 IB9_6(2,I) = 0 IB9_6(3,I) = 0 C DO J = 1,5 C K = (I-1)*5 + J C IF (F2(K).NE.999.0) THEN F19_6(I) = F19_6(I) + F2(K) IF19_6(I) = IF19_6(I) + 1 END IF C IF (B(1,K).NE.999.0) THEN B9_6(1,I) = B9_6(1,I) + B(1,K) IB9_6(1,I) = IB9_6(1,I) + 1 END IF C IF (B(2,K).NE.999.0) THEN B9_6(2,I) = B9_6(2,I) + B(2,K) IB9_6(2,I) = IB9_6(2,I) + 1 END IF C IF (B(3,K).NE.999.0) THEN B9_6(3,I) = B9_6(3,I) + B(3,K) IB9_6(3,I) = IB9_6(3,I) + 1 END IF C END DO C C COMPUTE 9.6 SEC FIELD MAGNITUDE C IF (IF19_6(I).NE.0) THEN F19_6(I) = F19_6(I)/IF19_6(I) ELSE F19_6(I) = 999.0 END IF C C COMPUTE 9.6 SEC RADIAL COMPONENT AND RMS C RMS9_6(1,I) = 0.0 IF (IB9_6(1,I).NE.0) THEN B9_6(1,I) = B9_6(1,I)/IB9_6(1,I) DO J = 1,5 K = (I-1)*5 + J IF ( B(1,K).NE.999.0 ) & RMS9_6(1,I) = RMS9_6(1,I) + ( B(1,K) - B9_6(1,I) )**2 END DO RMS9_6(1,I) = SQRT( RMS9_6(1,I)/IB9_6(1,I) ) ELSE B9_6(1,I) = 999.0 RMS9_6(1,I) = 999.0 END IF C C COMPUTE 9.6 SEC TANGENTIAL COMPONENT AND RMS C RMS9_6(2,I) = 0.0 IF (IB9_6(2,I).NE.0) THEN B9_6(2,I) = B9_6(2,I)/IB9_6(2,I) DO J = 1,5 K = (I-1)*5 + J IF ( B(2,K).NE.999.0 ) & RMS9_6(2,I) = RMS9_6(2,I) + ( B(2,K) - B9_6(2,I) )**2 END DO RMS9_6(2,I) = SQRT( RMS9_6(2,I)/IB9_6(2,I) ) ELSE B9_6(2,I) = 999.0 RMS9_6(2,I) = 999.0 END IF C C COMPUTE 9.6 SEC NORMAL COMPONENT AND RMS C RMS9_6(3,I) = 0.0 IF (IB9_6(3,I).NE.0) THEN B9_6(3,I) = B9_6(3,I)/IB9_6(3,I) DO J = 1,5 K = (I-1)*5 + J IF ( B(3,K).NE.999.0 ) & RMS9_6(3,I) = RMS9_6(3,I) + ( B(3,K) - B9_6(3,I) )**2 END DO RMS9_6(3,I) = SQRT( RMS9_6(3,I)/IB9_6(3,I) ) ELSE B9_6(3,I) = 999.0 RMS9_6(3,I) = 999.0 END IF C C COMPUTE 9.6 SEC FIELD MODULUS C IF ( B9_6(1,I).NE.999.0 .AND. & B9_6(2,I).NE.999.0 .AND. & B9_6(3,I).NE.999.0 ) THEN F29_6(I) = SQRT(B9_6(1,I)**2+B9_6(2,I)**2+B9_6(3,I)**2) ELSE F29_6(I) = 999.0 END IF C C COMPUTE 9.6 SEC LATITUDINAL FIELD ANGLE C IF ( B9_6(3,I).NE.999.0 .AND. F29_6(I).NE.999.0 .AND. & F29_6(I).NE.0.0 ) THEN DEL9_6(I) = ASIN( B9_6(3,I)/F29_6(I) )*57.2957795D0 ELSE DEL9_6(I) = 90.0 END IF C C COMPUTE 9.6 SEC LONGITUDINAL FIELD ANGLE C IF ( B9_6(1,I).NE.999.0 .AND. B9_6(2,I).NE.999.0 .AND. & B9_6(1,I).NE.0.0 ) THEN LAM9_6(I) = 180.0 - ATAN2( B9_6(2,I),-B9_6(1,I) )*57.2957795D0 ELSE LAM9_6(I) = 45.0 END IF C C WRITE(6,889) F19_6(I),F29_6(I),(B9_6(L,I),L=1,3), C & DEL9_6(I),LAM9_6(I),RMS9_6(1,I), C & RMS9_6(2,I),RMS9_6(3,I),IF19_6(I) C END DO C 889 FORMAT(5(1X,F7.3),2(1X,F5.1),3(1X,F7.3),1X,I2) C C COMPUTE 48 SEC AVERAGES C F148 = 0.0 B48(1) = 0.0 B48(2) = 0.0 B48(3) = 0.0 IF148 = 0 IB48(1) = 0 IB48(2) = 0 IB48(3) = 0 C DO I = 1,5 C IF (F29_6(I).NE.999.0) THEN F148 = F148 + F29_6(I) IF148 = IF148 + 1 END IF C IF (B9_6(1,I).NE.999.0) THEN B48(1) = B48(1) + B9_6(1,I) IB48(1) = IB48(1) + 1 END IF C IF (B9_6(2,I).NE.999.0) THEN B48(2) = B48(2) + B9_6(2,I) IB48(2) = IB48(2) + 1 END IF C IF (B9_6(3,I).NE.999.0) THEN B48(3) = B48(3) + B9_6(3,I) IB48(3) = IB48(3) + 1 END IF C END DO C C COMPUTE 48 SEC FIELD MAGNITUDE C IF (IF148.NE.0) THEN F148 = F148/IF148 ELSE F148 = 999.0 END IF C C COMPUTE 48 SEC RADIAL COMPONENT AND RMS C RMS48(1) = 0.0 IF (IB48(1).NE.0) THEN B48(1) = B48(1)/IB48(1) DO I = 1,5 IF (B9_6(1,I).NE.999.0) & RMS48(1) = RMS48(1) + ( B9_6(1,I) - B48(1) )**2 END DO RMS48(1) = SQRT( RMS48(1)/IB48(1) ) ELSE B48(1) = 999.0 RMS48(1) = 999.0 END IF C C COMPUTE 48 SEC TANGENTIAL COMPONENT AND RMS C RMS48(2) = 0.0 IF (IB48(2).NE.0) THEN B48(2) = B48(2)/IB48(2) DO I = 1,5 IF (B9_6(2,I).NE.999.0) & RMS48(2) = RMS48(2) + ( B9_6(2,I) - B48(2) )**2 END DO RMS48(2) = SQRT( RMS48(2)/IB48(2) ) ELSE B48(2) = 999.0 RMS48(2) = 999.0 END IF C C COMPUTE 48 SEC NORMAL COMPONENT AND RMS C RMS48(3) = 0.0 IF (IB48(3).NE.0) THEN B48(3) = B48(3)/IB48(3) DO I = I,5 IF (B9_6(3,I).NE.999.0) & RMS48(3) = RMS48(3) + ( B9_6(3,I) - B48(3) )**2 END DO RMS48(3) = SQRT( RMS48(3)/IB48(3) ) ELSE B48(3) = 999.0 RMS48(3) = 999.0 END IF C C COMPUTE 48 SEC FIELD MODULUS C IF ( B48(1).NE.999.0 .AND. & B48(2).NE.999.0 .AND. & B48(3).NE.999.0 ) THEN F248 = SQRT(B48(1)**2+B48(2)**2+B48(3)**2) ELSE F248 = 999.0 END IF C C COMPUTE 48 SEC LATITUDINAL FIELD ANGLE C IF ( B48(3).NE.999.0 .AND. F248.NE.999.0 .AND. F248.NE.0.0 ) THEN DEL48 = ASIN( B48(3)/F248 )*57.2957795D0 ELSE DEL48 = 90.0 END IF C C COMPUTE 48 SEC LONGITUDINAL FIELD ANGLE C IF ( B48(1).NE.999.0 .AND. B48(2).NE.999.0 .AND. & B48(1).NE.0.0 ) THEN LAM48 = 180.0 - ATAN2( B48(2),-B48(1) )*57.2957795D0 ELSE LAM48 = 45.0 END IF C C WRITE(6,890) F148,F248,B48(1),B48(2),B48(3),DEL48,LAM48, C & RMS48(1),RMS48(2),RMS48(3),IF148 890 FORMAT(5(1X,F7.3),2(1X,F5.1),3(1X,F7.3),1X,I2) C C PAYLOAD DATA C C WRITE(6,891) (PYLD(I),I=1,8) 891 FORMAT(3(1X,F7.3),1X,I4,4(1X,F7.3)) C C OUTPUT FILTERED MAG SUMMARY RECORD C WRITE(9) (HEAD(I),I=1,32),F148,F248,DEL48,LAM48,(B48(I),I=1,3), & (RMS48(I),I=1,3),IF148,(F19_6(I),I=1,5),(F29_6(I),I=1,5), & (DEL9_6(I),I=1,5),(LAM9_6(I),I=1,5),((B9_6(J,I),I=1,5),J=1,3), & ((RMS9_6(J,I),I=1,5),J=1,3),(IF19_6(I),I=1,5),(F1(I),I=1,25), & (F2(I),I=1,25),(DELTA(I),I=1,25),(LAMBDA(I),I=1,25), & ((B(J,I),I=1,25),J=1,3),((RMS(J,I),I=1,25),J=1,3), & (NPTS(I),I=1,25),(SPARE(I),I=1,147),(PYLD(I),I=1,8), & (SEDR(I),I=1,40) C RETURN END //LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR //GO.SYSUDUMP DD DUMMY //*T09F001 DD DSN=Z1SBK.FILT.M91106,DISP=OLD //*T09F001 DD DSN=Z1SBK.RONREQ.PRICLN2,DISP=OLD //FT09F001 DD DSN=Z1SBK.PRIFILT.M91106,SPACE=(TRK,(400,15),RLSE), // DCB=(RECFM=VB,LRECL=5000,BLKSIZE=32760), // UNIT=TEMPDA,DISP=(NEW,CATLG) //FT10F001 DD DSN=U0#16.PREFILT.PRIMARY.M91106,DISP=OLD //*T10F001 DD DSN=U0#16.RONREQ.PRIMARY.$92A213,DISP=OLD //*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.MXXXXX, //* DISP=OLD,UNIT=T3480,VOL=SER=289271, //* DCB=(RECFM=VB,LRECL=5000,BLKSIZE=32760), //* LABEL=(1,SL,,IN) //TELL EXEC NOTIFY // //Z1SBKEDR JOB (U0016,N598,5),'EDR FILTER',TIME=(0,30),MSGCLASS=X //FORT77 EXEC FORTVCLG C PROGRAM EDR C C EDR UNPACKING PROGRAM WRITTEN FOR THE VIM-5 CRUISE MODE C LOGICAL*1 REC(6512) CHARACTER*4 TFLAG CHARACTER*20 DSN INTEGER*2 BLEN,MTIME(6) INTEGER*4 KTEMP(32) LOGICAL*1 SCET,ERTS,ERTE,CLEAN,LAST REAL*4 GAMMA(4,400),GAMMA2(4,8) C INCLUDE 'Z1SBK.UNPACK.INC' C C CREATE BIT FLIP TABLE FOR LOGICAL*1 WORDS. ASSIGN FLIP(0:255) THE C BIT FLIP INVERSE OF VALUES 0 TO 255. C DO J=0,255 DO I=0,7 CALL MOVBIT2(J, I, 1, FLIP(J), 7-I) END DO C JTEMP = 0 C CALL MOVBIT(FLIP(J), 0, 8, JTEMP, 0) C WRITE(6,'(3(1X,I3))') J,JTEMP END DO C C GET ZERO OFFSETS AND SENSITIVITIES C CALL MTABLES() C C OPEN BINARY EDR INPUT DATASET C OPEN(50,FILE='/U0#16.EDR.$92B258',STATUS='OLD', & FORM='UNFORMATTED') C C OPEN PRIMARY MAG OUTPUT DATA SET C OPEN(66,FILE='/Z1SBK.EDR.PRI',STATUS='OLD', & FORM='FORMATTED') C C OPEN SECONDARY MAG OUTPUT DATA SET C OPEN(67,FILE='/Z1SBK.EDR.SEC',STATUS='OLD', & FORM='FORMATTED') C C OPEN PROGRAM STATISTICS RECORD FILE C OPEN(68,FILE='/Z1SBK.EDR.HIS',STATUS='OLD', & FORM='FORMATTED') C C SELECT TIME TYPE C SCET = .TRUE. ERTS = .FALSE. ERTE = .FALSE. C C FILTER PARAMETERS C SIGK = 4.0 NPASS = 1 CLEAN = .FALSE. C CLEAN = .TRUE. C C INITIALIZE MAIN LOOP C LAST = .FALSE. NCNT = 0 GOTO 10 C C INPUT ERROR CHECK C 555 CONTINUE WRITE(6,*) '!!!DATA INPUT ERROR!!!' 10 CONTINUE READ(50,NUM=LEN,END=100,ERR=555) REC NCNT = NCNT + 1 IF (NCNT.LT.3) GOTO 10 IF (NCNT.GT.100) GOTO 100 CALL UNPACK(REC,ISTAT) C C CONVERT TIME TO CALENDAR UNITS C IF (ERTS) THEN TFLAG = 'ERTS' IYR = YEAR1 IERTSHR = ERTSHR CALL CONHOUR(IERTSHR,IDYS,IHRS) IERTSSC = ERTSSC CALL CONSEC(IERTSSC,IMIN,ISEC) MSEC = ERTSML ELSE IF (ERTE) THEN TFLAG = 'ERTE' IYR = YEAR2 IERTEHR = ERTEHR CALL CONHOUR(IERTEHR,IDYS,IHRS) IERTESC = ERTESC CALL CONSEC(IERTESC,IMIN,ISEC) MSEC = ERTEML ELSE IF (SCET) THEN TFLAG = 'SCET' IYR = YEAR3 ISCETHR = SCETHR CALL CONHOUR(SCETHR,IDYS,IHRS) ISCETSC = SCETSC CALL CONSEC(SCETSC,IMIN,ISEC) MSEC = SCETML END IF MTIME(1) = IYR MTIME(2) = IDYS MTIME(3) = IHRS MTIME(4) = IMIN MTIME(5) = ISEC MTIME(6) = MSEC CALL DISPLAY(LEN,NCNT,TFLAG,MTIME) IF (DRSDAT.NE.35) GOTO 10 CALL LFMOUT(GAMMA,GAMMA2) IF (CLEAN) CALL BIGQUE(GAMMA,400,MTIME,LAST,SIGK,NPASS) IF (.NOT.CLEAN) CALL BIGAVE(GAMMA,MTIME) CALL SMALLAVE(GAMMA2,MTIME) C GOTO 10 100 CONTINUE LAST = .TRUE. IF (CLEAN) CALL BIGQUE(GAMMA,400,MTIME,LAST,SIGK,NPASS) C CLOSE(50) CLOSE(66) CLOSE(67) CLOSE(68) C STOP END SUBROUTINE CONSEC(SOC,NMIN,NSEC) C INTEGER*4 SOC C C CONVERT I*2 SECONDS OF HOUR INTO MINUTES AND SECONDS. C NMIN = INT(SOC/60.0) NSEC = NINT(((SOC/60.0)-NMIN)*60.0) RETURN END SUBROUTINE CONHOUR(HOY,NDYS,NHRS) C INTEGER*4 HOY C C CONVERT I*2 HOUR OF YEAR INTO DAYS AND HOURS (DAY 0 = JAN 1) C NDYS = INT(HOY/24.0) NHRS = NINT(((HOY/24.0)-NDYS)*24.0) RETURN END SUBROUTINE UNPACK(INBUF,UNSTAT) C LOGICAL*1 INBUF(6512) C INTEGER*4 UNSTAT C INCLUDE 'Z1SBK.UNPACK.INC' C UNSTAT=0 C DO 1 I=1,240 HEAD(I) = INBUF(I) 1 CONTINUE C DO 2 I=241,672 J=I-240 PLS(J) = INBUF(I) 2 CONTINUE C C CR-5A MAG SCIENCE BLOCK WILL HAVE 1040 BYTES C DO 3 I=673,6512 J=I-672 MAG(J) = INBUF(I) 3 CONTINUE C CALL UNHEAD(INBUF,UNSTAT) CALL UNPLS(INBUF,UNSTAT) CALL UNMAG(INBUF,UNSTAT) C RETURN END C SUBROUTINE UNHEAD(INBUF,UNSTAT) C LOGICAL*1 INBUF(6512),LPROJ(3),TEMP C INTEGER*4 UNSTAT, ITEMP(240) C INCLUDE 'Z1SBK.UNPACK.INC' C EQUIVALENCE (PROJID,LPROJ(1)) C UNSTAT=0 C LPROJ(1) = HEAD(1) LPROJ(2) = HEAD(2) LPROJ(3) = HEAD(3) C C FLIP BYTES OF EACH 32 BIT WORD C DO I = 1,60 J = (I-1) * 4 C TEMP = HEAD(J+1) HEAD(J+1) = HEAD(J+4) HEAD(J+4) = TEMP C TEMP = HEAD(J+2) HEAD(J+2) = HEAD(J+3) HEAD(J+3) = TEMP C END DO C C DO I=1,20 C ITEMP(I) = 0 C J = (I-1) * 8 C CALL MOVBIT(HEAD, J, 8, ITEMP(I), 0) C END DO C WRITE(6,'(20(1X,I3))') (ITEMP(I),I=1,20) C RECID = 0 CALL MOVBIT( HEAD, 28, 4, RECID, 0) SCID = 0 CALL MOVBIT( HEAD, 24, 4, SCID, 0) RECNUM = 0 CALL MOVBIT( HEAD, 32, 8, RECNUM, 8) CALL MOVBIT( HEAD, 40, 8, RECNUM, 0) DATMOD = 0 CALL MOVBIT( HEAD, 48, 8, DATMOD, 0) EEXTFL = 0 CALL MOVBIT( HEAD, 62, 2, EEXTFL, 0) SCPLAB = 0 CALL MOVBIT( HEAD, 61, 1, SCPLAB, 0) RECTIM = 0 CALL MOVBIT( HEAD, 56, 5, RECTIM, 0) 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) DATSRC = 0 CALL MOVBIT( HEAD, 126, 2, DATSRC, 0) GOLAY = 0 CALL MOVBIT( HEAD, 124, 2, GOLAY, 0) SEGNUM = 0 CALL MOVBIT( HEAD, 120, 4, SEGNUM, 0) 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) SCEVFL = 0 CALL MOVBIT( HEAD, 252, 4, SCEVFL, 0) CORRFL = 0 CALL MOVBIT( HEAD, 248, 4, CORRFL, 0) 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 FOR CR-5A MODE, 75 MF MAX. C DO 20 I=1,38 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 FIELDS GCI, DPIRIS, GPIRIS ARE NOT USED IN CR-5A 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 C IDENTIFY CR-5A MODE C IF (DATMOD.NE.24.AND.DATMOD.NE.29) UNSTAT=1 C C IDENTIFY MARINER JUPITER SATURN (MJS) PROJECT ID C IF (PROJID.NE.'MJS') UNSTAT=2 C RETURN END SUBROUTINE UNPLS(INBUF,UNSTAT) C LOGICAL*1 INBUF,TEMP,PSCAN(20,20) C INTEGER*2 MCOMM(2),PCOMM(2) C INTEGER*4 UNSTAT,SSCE C INCLUDE 'Z1SBK.UNPACK.INC' C IF (DRSDAT.NE.35) RETURN C C FLIP BYTES OF EACH 32 BIT WORD C DO I = 1,108 J = (I-1) * 4 C TEMP = PLS(J+1) PLS(J+1) = PLS(J+4) PLS(J+4) = TEMP C TEMP = PLS(J+2) PLS(J+2) = PLS(J+3) PLS(J+3) = TEMP C END DO C C MAG COMMAND WORDS C MCOMM(1) = 0 MCOMM(2) = 0 CALL MOVBIT(PLS, 8, 8, MCOMM(1), 0) CALL MOVBIT(PLS, 0, 8, MCOMM(1), 8) CALL MOVBIT(PLS, 24, 8, MCOMM(2), 0) CALL MOVBIT(PLS, 16, 8, MCOMM(2), 8) C C PLASMA COMMAND WORDS C PCOMM(1) = 0 PCOMM(2) = 0 CALL MOVBIT(PLS, 40, 8, PCOMM(1), 0) CALL MOVBIT(PLS, 32, 8, PCOMM(1), 8) CALL MOVBIT(PLS, 56, 8, PCOMM(2), 0) CALL MOVBIT(PLS, 48, 8, PCOMM(2), 8) 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 C CALL MOVBIT(PLS, 216, 8, SSCE, 0) CALL MOVBIT(PLS, 208, 8, SSCE, 8) CALL MOVBIT(PLS, 200, 8, SSCE, 16) CALL MOVBIT(PLS, 192, 8, SSCE, 24) C C PLASMA WORDS C DO I = 1,20 DO J = 1,20 IPLS = (I-1)*20 + J IOFF = (I-1)*160+(J-1)*8 CALL MOVBIT(PLS, 256+IOFF, 8, PSCAN(I,J), 0) END DO END DO C RETURN END SUBROUTINE UNMAG(INBUF,UNSTAT) C LOGICAL*1 INBUF(6512),TEMP,HOLD(1040) C INTEGER*4 UNSTAT,ITEMP(1040),JTEMP(1040),KTEMP(1040) 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) 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 INCLUDE 'Z1SBK.UNPACK.INC' C IF (DRSDAT.NE.35) RETURN C C FLIP BYTE ORDER OF EACH 32 BIT WORD C DO I = 1,260 J = (I-1) * 4 C TEMP = MAG(J+1) MAG(J+1) = MAG(J+4) MAG(J+4) = TEMP C TEMP = MAG(J+2) MAG(J+2) = MAG(J+3) MAG(J+3) = TEMP C END DO C DO I = 1,20 J = (I-1) * 8 ITEMP(I) = 0 JTEMP(I) = 0 C KTEMP(I) = 0 CALL MOVBIT(MAG, J, 8, ITEMP(I), 0) CALL MOVBIT(FLIP(ITEMP(I)), 0, 8, JTEMP(I), 0) CALL MOVBIT(FLIP(ITEMP(I)), 0, 8, HOLD, J) C CALL MOVBIT(JTEMP(I), 0, 8, MAG, J) C CALL MOVBIT(MAG, J, 8, KTEMP(I), 0) END DO WRITE(6,'(20(1X,I3))') (ITEMP(I),I=1,20) WRITE(6,'(20(1X,I3))') (JTEMP(I),I=1,20) C WRITE(6,'(20(1X,I3))') (KTEMP(I),I=1,20) C C REVERSE BIT ORDER IN EACH BYTE, IE 0-7 -> 7-0 C C DO I = 1,20 C J = (I-1) * 8 C JTEMP = 0 C CALL MOVBIT(MAG(I), 0, 8, JTEMP, 0) C CALL MOVBIT(FLIP(JTEMP), 0, 8, KTEMP, 0) C WRITE(6,*) JTEMP,KTEMP C END DO C WRITE(6,'(20(1X,I3))') (ITEMP(I),I=1,20) C C READ 20 MINOR FRAMES (52 BYTE EACH) OF CR-5A 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 IFRM = 0 IMAG = -416 DO 200 J = 1,4 C DO 100 K = 1,5 C IFRM = IFRM + 1 IMAG = IMAG + 416 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) , 8, PREF(1,IPRX), 0) CALL MOVBIT(MAG, IMAG+PRXIND(K)+8 , 4, PREF(1,IPRX), 8) C CALL MOVBIT(MAG, IMAG+PRXIND(K) , 1, PREF(1,IPRX), 11) C CALL MOVBIT(MAG, IMAG+PRXIND(K)+1 , 1, PREF(1,IPRX), 10) C CALL MOVBIT(MAG, IMAG+PRXIND(K)+2 , 1, PREF(1,IPRX), 9) C CALL MOVBIT(MAG, IMAG+PRXIND(K)+3 , 1, PREF(1,IPRX), 8) C CALL MOVBIT(MAG, IMAG+PRXIND(K)+4 , 1, PREF(1,IPRX), 7) C CALL MOVBIT(MAG, IMAG+PRXIND(K)+5 , 1, PREF(1,IPRX), 6) C CALL MOVBIT(MAG, IMAG+PRXIND(K)+6 , 1, PREF(1,IPRX), 5) C CALL MOVBIT(MAG, IMAG+PRXIND(K)+7 , 1, PREF(1,IPRX), 4) C CALL MOVBIT(MAG, IMAG+PRXIND(K)+8 , 1, PREF(1,IPRX), 3) C CALL MOVBIT(MAG, IMAG+PRXIND(K)+9 , 1, PREF(1,IPRX), 2) C CALL MOVBIT(MAG, IMAG+PRXIND(K)+10, 1, PREF(1,IPRX), 1) C CALL MOVBIT(MAG, IMAG+PRXIND(K)+11, 1, PREF(1,IPRX), 0) END IF IF (PRYIND(K).NE.-1) THEN IPRY = IPRY + 1 PREF(2,IPRY) = 0 C CALL MOVBIT(MAG, IMAG+PRYIND(K) , 12, 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) END IF IF (PRZIND(K).NE.-1) THEN IPRZ = IPRZ + 1 PREF(3,IPRZ) = 0 C CALL MOVBIT(MAG, IMAG+PRZIND(K) , 12, 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) 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) END IF 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) END IF 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) 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 C CALL MOVBIT(MAG, IMAG+PDXIND(IOFF) , 1, PDIFF(1,IPDX), 15) 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 C CALL GETBIT(PDIFF(1,IPDX),15,IVAL) C IF (IVAL.EQ.1) THEN C CALL SETBIT(PDIFF(1,IPDX),5,10) C END IF END IF IF (PDYIND(IOFF).NE.-1) THEN IPDY = IPDY + 1 PDIFF(2,IPDY) = 0 C CALL MOVBIT(MAG, IMAG+PDYIND(IOFF) , 1, PDIFF(2,IPDY), 15) 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 C CALL GETBIT(PDIFF(2,IPDY),15,IVAL) C IF (IVAL.EQ.1) THEN C CALL SETBIT(PDIFF(2,IPDY),5,10) C END IF END IF IF (PDZIND(IOFF).NE.-1) THEN IPDZ = IPDZ + 1 PDIFF(3,IPDZ) = 0 C CALL MOVBIT(MAG, IMAG+PDZIND(IOFF) , 1, PDIFF(3,IPDZ), 15) 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 C CALL GETBIT(PDIFF(3,IPDZ),15,IVAL) C IF (IVAL.EQ.1) THEN C CALL SETBIT(PDIFF(3,IPDZ),5,10) C END IF END IF END DO C 100 CONTINUE C 200 CONTINUE C RETURN END SUBROUTINE MTABLES() C CHARACTER*20 DSN CHARACTER*72 LINE(100) INTEGER*4 RANGE C INCLUDE 'Z1SBK.UNPACK.INC' C C READ ZERO OFFSETS AND SENSITIVITIES FROM JPL MAG TABLES C OPEN(51,FILE='/Z1SBK.MTABLES.DAT',STATUS='OLD', & FORM='FORMATTED') C I = 1 5 CONTINUE READ(51,'(A72)',END=10,ERR=5) LINE(I) I = I + 1 GOTO 5 10 CONTINUE ILINE = I - 1 CLOSE(51) C K = 1 DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C INBOARD MAGNETOMETER OFFSETS C DO I=0,7 READ(LINE(K+I),*) RANGE,(IBOFF(J,RANGE+1),J=1,3) WRITE(6,'(1X,I1,3(3X,I4))') RANGE,(IBOFF(J,RANGE+1),J=1,3) END DO K = K + 8 DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C OUTBOARD MAGNETOMETER OFFSETS C DO I=0,7 READ(LINE(K+I),*) RANGE,(OBOFF(J,RANGE+1),J=1,3) WRITE(6,'(1X,I1,3(3X,I4))') RANGE,(OBOFF(J,RANGE+1),J=1,3) END DO K = K + 8 DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C INBOARD MAGNETOMETER SENSITIVITY C DO I=0,7 READ(LINE(K+I),*) RANGE,(IBSENS(J,RANGE+1),J=1,3) WRITE(6,'(1X,I1,3(3X,E10.4))') RANGE,(IBSENS(J,RANGE+1),J=1,3) END DO K = K + 8 DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C C OUTBOARD MAGNETOMETER SENSITIVITY C DO I=0,7 READ(LINE(K+I),*) RANGE,(OBSENS(J,RANGE+1),J=1,3) WRITE(6,'(1X,I1,3(3X,E10.4))') RANGE,(OBSENS(J,RANGE+1),J=1,3) END DO K = K + 8 DO WHILE (LINE(K)(1:1).EQ.'#') K = K + 1 END DO C RETURN END SUBROUTINE LFMOUT(GAMMA,GAMMA2) C INTEGER*2 PREC(3),PSUM(3) INTEGER*2 PERR(4,16) INTEGER*4 IBLFM(4),OBLFM(4),IBDIFF,OBDIFF LOGICAL*1 RECTEST,IBMODE(4),OBMODE(4) REAL*4 GAMMA(4,400),GAMMA2(4,8) C INCLUDE 'Z1SBK.UNPACK.INC' C C RECTEST = .TRUE. RECTEST = .FALSE. C C EXTRACT LOW FIELD MAGNETOMETER RANGE VALUES 0-7 AND MODES 0,1 C DO I=1,4 OBMODE(I) = .FALSE. IBMODE(I) = .FALSE. OBLFM(I) = 0 IBLFM(I) = 0 CALL MOVBIT(STAT1(I), 11, 1, OBMODE(I), 0) CALL MOVBIT(STAT1(I), 7, 1, IBMODE(I), 0) DO J=1,3 CALL MOVBIT(STAT1(I), 11-J, 1, OBLFM(I), J-1) CALL MOVBIT(STAT1(I), 7-J, 1, IBLFM(I), J-1) END DO C C SHIFT SENSITIVITY RANGE FROM 0-7 TO 1-8 TO MATCH ARRAY INDEXING C OF ZERO OFFSET AND SENSITIVITY TABLES C IBLFM(I) = IBLFM(I) + 1 OBLFM(I) = OBLFM(I) + 1 C C TEST FOR RANGE ERRORS. SENSITIVITY MAY ONLY CHANGE BY ONE C IN AUTO RANGE MODE. C IF (I.GT.1) THEN IBDIFF = IABS(IBLFM(I)-IBLFM(I-1)) OBDIFF = IABS(OBLFM(I)-OBLFM(I-1)) C C INBOARD MAG RANGE CHECK C IF (IBDIFF.GT.1.AND.(IBMODE(I).AND.IBMODE(I-1))) THEN WRITE(68,'(1X,''INBOARD RANGE WORD ERROR!'',3X, & ''CYCLE# '',I1,3X,''REC# '',I4)') I,RECNUM IBLFM(I) = IBLFM(I-1) END IF C C OUTBOARD MAG RANGE CHECK C IF (OBDIFF.GT.1.AND.(OBMODE(I).AND.OBMODE(I-1))) THEN WRITE(68,'(1X,''OUTBOARD RANGE WORD ERROR!'',3X, & ''CYCLE# '',I1,3X,''REC# '',I4)') I,RECNUM OBLFM(I) = OBLFM(I-1) END IF END IF END DO C C CONVERT DIGITAL WORDS INTO GAMMAS. C TEST FOR BAD DIFFERENCE WORDS AND NULL DATA. C IP = 0 IS = 0 PREC(1) = 0 PREC(2) = 0 PREC(3) = 0 DO IWRD=1,400 ICYC = INT((IWRD-1)/100)+1 C C OPERATE ON PRIMARY AND SECONDARY REFERENCE WORDS C AND PRIMARY DIFFERENCE WORDS. C IF (IWRD.EQ.1.OR.MOD(IWRD-1,50).EQ.0) THEN IP = IP + 1 PERR(1,IP) = 0 PERR(2,IP) = 0 PERR(3,IP) = 0 PERR(4,IP) = 0 IS = IS + 1 IF (IP.GT.1) THEN PSUM(1) = PSUM(1) + PDIFF(1,IWRD) PSUM(2) = PSUM(2) + PDIFF(2,IWRD) PSUM(3) = PSUM(3) + PDIFF(3,IWRD) PREC(1) = PREF(1,IP-1) + PSUM(1) PREC(2) = PREF(2,IP-1) + PSUM(2) PREC(3) = PREF(3,IP-1) + PSUM(3) ELSE PREC(1) = PREF(1,IP) PREC(2) = PREF(2,IP) PREC(3) = PREF(3,IP) END IF C C TEST FOR ERRORS IN RECONSTRUCTION OF FULL WORDS FROM DIFFERENCE WORDS. C IF (PREC(1).NE.PREF(1,IP)) THEN PREC(1) = PREF(1,IP) PERR(1,IP) = 1 PERR(4,IP) = 1 C WRITE(6,'(1X,''ERROR IN X COMPONENT DIFFERENCE SUM AT WORD '', C & I3,3X,''REC# '',I4)') IWRD,RECNUM END IF IF (PREC(2).NE.PREF(2,IP)) THEN PREC(2) = PREF(2,IP) PERR(2,IP) = 1 PERR(4,IP) = 1 C WRITE(6,'(1X,''ERROR IN Y COMPONENT DIFFERENCE SUM AT WORD '', C & I3,3X,''REC# '',I4)') IWRD,RECNUM END IF IF (PREC(3).NE.PREF(3,IP)) THEN PREC(3) = PREF(3,IP) PERR(3,IP) = 1 PERR(4,IP) = 1 C WRITE(6,'(1X,''ERROR IN Z COMPONENT DIFFERENCE SUM AT WORD '', C & I3,3X,''REC# '',I4)') IWRD,RECNUM END IF PSUM(1) = 0 PSUM(2) = 0 PSUM(3) = 0 C C COMPUTE PRIMARY MAG GAMMAS AND ASSIGN FILL VALUES TO NULL DATA. C C IF (PREC(1).EQ.0.AND.PREC(2).EQ.0.AND.PREC(3).EQ.0) THEN IF (PREC(1).EQ.0.OR.PREC(2).EQ.0.OR.PREC(3).EQ.0) THEN GAMMA(1,IWRD) = 999. GAMMA(2,IWRD) = 999. GAMMA(3,IWRD) = 999. GAMMA(4,IWRD) = 999. ELSE GAMMA(1,IWRD) = (PREC(1)-OBOFF(1,OBLFM(ICYC))) & *OBSENS(1,OBLFM(ICYC)) GAMMA(2,IWRD) = (PREC(2)-OBOFF(2,OBLFM(ICYC))) & *OBSENS(2,OBLFM(ICYC)) GAMMA(3,IWRD) = (PREC(3)-OBOFF(3,OBLFM(ICYC))) & *OBSENS(3,OBLFM(ICYC)) GAMMA(4,IWRD) = SQRT(GAMMA(1,IWRD)**2+GAMMA(2,IWRD)**2 & +GAMMA(3,IWRD)**2) END IF IF (GAMMA(4,IWRD).GE.1000.0) THEN GAMMA(1,IWRD) = 999. GAMMA(2,IWRD) = 999. GAMMA(3,IWRD) = 999. GAMMA(4,IWRD) = 999. END IF C C COMPUTE SECONDARY MAG GAMMAS AND ASSIGN FILL VALUES TO NULL DATA. C C IF (SREF(1,IS).EQ.0.AND.SREF(2,IS).EQ.0.AND. C & SREF(3,IS).EQ.0) THEN IF (SREF(1,IS).EQ.0.OR.SREF(2,IS).EQ.0.OR. & SREF(3,IS).EQ.0) THEN GAMMA2(1,IS) = 999. GAMMA2(2,IS) = 999. GAMMA2(3,IS) = 999. GAMMA2(4,IS) = 999. ELSE GAMMA2(1,IS) = (SREF(1,IS)-IBOFF(1,IBLFM(ICYC))) & *IBSENS(1,IBLFM(ICYC)) GAMMA2(2,IS) = (SREF(2,IS)-IBOFF(2,IBLFM(ICYC))) & *IBSENS(2,IBLFM(ICYC)) GAMMA2(3,IS) = (SREF(3,IS)-IBOFF(3,IBLFM(ICYC))) & *IBSENS(3,IBLFM(ICYC)) GAMMA2(4,IS) = SQRT(GAMMA2(1,IS)**2+GAMMA2(2,IS)**2 & +GAMMA2(3,IS)**2) END IF IF (GAMMA2(4,IS).GE.1000.0) THEN GAMMA2(1,IS) = 999. GAMMA2(2,IS) = 999. GAMMA2(3,IS) = 999. GAMMA2(4,IS) = 999. END IF IF (RECTEST) THEN WRITE(6,'(15(1X,I5),2(1X,I4),4(1X,F7.3))') & IP, PREF(1,IP), PREF(2,IP), PREF(3,IP), IS, SREF(1,IS), & SREF(2,IS), SREF(3,IS), IWRD, PDIFF(1,IWRD),PDIFF(2,IWRD), & PDIFF(3,IWRD),PREC(1),PREC(2),PREC(3),OBMODE(ICYC),OBLFM(ICYC), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD),GAMMA(4,IWRD) END IF C C OPERATE ON PRIMARY REFERENCE WORDS AND PRIMARY DIFFERENCE WORDS. C ELSE IF (MOD(IWRD-1,25).EQ.0) THEN IP = IP + 1 PERR(1,IP) = 0 PERR(2,IP) = 0 PERR(3,IP) = 0 PERR(4,IP) = 0 PSUM(1) = PSUM(1) + PDIFF(1,IWRD) PSUM(2) = PSUM(2) + PDIFF(2,IWRD) PSUM(3) = PSUM(3) + PDIFF(3,IWRD) PREC(1) = PREF(1,IP-1) + PSUM(1) PREC(2) = PREF(2,IP-1) + PSUM(2) PREC(3) = PREF(3,IP-1) + PSUM(3) C C TEST FOR ERRORS IN RECONSTRUCTION OF FULL WORDS FROM DIFFERENCE WORDS. C IF (PREC(1).NE.PREF(1,IP)) THEN PREC(1) = PREF(1,IP) PERR(1,IP) = 1 PERR(4,IP) = 1 C WRITE(6,'(1X,''ERROR IN X COMPONENT DIFFERENCE SUM AT WORD '', C & I3,3X,''REC# '',I4)') IWRD,RECNUM END IF IF (PREC(2).NE.PREF(2,IP)) THEN PREC(2) = PREF(2,IP) PERR(2,IP) = 1 PERR(4,IP) = 1 C WRITE(6,'(1X,''ERROR IN Y COMPONENT DIFFERENCE SUM AT WORD '', C & I3,3X,''REC# '',I4)') IWRD,RECNUM END IF IF (PREC(3).NE.PREF(3,IP)) THEN PREC(3) = PREF(3,IP) PERR(3,IP) = 1 PERR(4,IP) = 1 C WRITE(6,'(1X,''ERROR IN Z COMPONENT DIFFERENCE SUM AT WORD '', C & I3,3X,''REC# '',I4)') IWRD,RECNUM END IF PSUM(1) = 0 PSUM(2) = 0 PSUM(3) = 0 C C COMPUTE PRIMARY MAG GAMMAS AND ASSIGN FILL VALUES TO NULL DATA. C C IF (PREC(1).EQ.0.AND.PREC(2).EQ.0.AND.PREC(3).EQ.0) THEN IF (PREC(1).EQ.0.OR.PREC(2).EQ.0.OR.PREC(3).EQ.0) THEN GAMMA(1,IWRD) = 999. GAMMA(2,IWRD) = 999. GAMMA(3,IWRD) = 999. GAMMA(4,IWRD) = 999. ELSE GAMMA(1,IWRD) = (PREC(1)-OBOFF(1,OBLFM(ICYC))) & *OBSENS(1,OBLFM(ICYC)) GAMMA(2,IWRD) = (PREC(2)-OBOFF(2,OBLFM(ICYC))) & *OBSENS(2,OBLFM(ICYC)) GAMMA(3,IWRD) = (PREC(3)-OBOFF(3,OBLFM(ICYC))) & *OBSENS(3,OBLFM(ICYC)) GAMMA(4,IWRD) = SQRT(GAMMA(1,IWRD)**2+GAMMA(2,IWRD)**2 & +GAMMA(3,IWRD)**2) END IF IF (GAMMA(4,IWRD).GE.1000.0) THEN GAMMA(1,IWRD) = 999. GAMMA(2,IWRD) = 999. GAMMA(3,IWRD) = 999. GAMMA(4,IWRD) = 999. END IF IF (RECTEST) THEN WRITE(6,'(15(1X,I5),2(1X,I4),4(1X,F7.3))') & IP, PREF(1,IP), PREF(2,IP), PREF(3,IP), IS, 0, 0, 0, & IWRD,PDIFF(1,IWRD),PDIFF(2,IWRD),PDIFF(3,IWRD), & PREC(1),PREC(2),PREC(3),OBMODE(ICYC),OBLFM(ICYC), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD),GAMMA(4,IWRD) END IF C C OPERATE ON PRIMARY DIFFERENCE WORDS. C ELSE PSUM(1) = PSUM(1) + PDIFF(1,IWRD) PSUM(2) = PSUM(2) + PDIFF(2,IWRD) PSUM(3) = PSUM(3) + PDIFF(3,IWRD) PREC(1) = PREF(1,IP) + PSUM(1) PREC(2) = PREF(2,IP) + PSUM(2) PREC(3) = PREF(3,IP) + PSUM(3) C C COMPUTE PRIMARY MAG GAMMAS AND ASSIGN FILL VALUES TO NULL DATA. C C IF (PREC(1).EQ.0.AND.PREC(2).EQ.0.AND.PREC(3).EQ.0) THEN IF (PREC(1).EQ.0.OR.PREC(2).EQ.0.OR.PREC(3).EQ.0) THEN GAMMA(1,IWRD) = 999. GAMMA(2,IWRD) = 999. GAMMA(3,IWRD) = 999. GAMMA(4,IWRD) = 999. ELSE GAMMA(1,IWRD) = (PREC(1)-OBOFF(1,OBLFM(ICYC))) & *OBSENS(1,OBLFM(ICYC)) GAMMA(2,IWRD) = (PREC(2)-OBOFF(2,OBLFM(ICYC))) & *OBSENS(2,OBLFM(ICYC)) GAMMA(3,IWRD) = (PREC(3)-OBOFF(3,OBLFM(ICYC))) & *OBSENS(3,OBLFM(ICYC)) GAMMA(4,IWRD) = SQRT(GAMMA(1,IWRD)**2+GAMMA(2,IWRD)**2 & +GAMMA(3,IWRD)**2) END IF IF (GAMMA(4,IWRD).GE.1000.0) THEN GAMMA(1,IWRD) = 999. GAMMA(2,IWRD) = 999. GAMMA(3,IWRD) = 999. GAMMA(4,IWRD) = 999. END IF IF (RECTEST) THEN WRITE(6,'(15(1X,I5),2(1X,I4),4(1X,F7.3))') & IP, 0, 0, 0, IS, 0, 0, 0, & IWRD, PDIFF(1,IWRD),PDIFF(2,IWRD),PDIFF(3,IWRD), & PREC(1),PREC(2),PREC(3),OBMODE(ICYC),OBLFM(ICYC), & GAMMA(1,IWRD),GAMMA(2,IWRD),GAMMA(3,IWRD),GAMMA(4,IWRD) END IF END IF END DO C C REMOVE ERROR FLAGGED PRIMARY DIFFERENCES C DO I=1,400 IREF = INT((I-1)/25) + 1 IF (PERR(1,IREF).EQ.1) GAMMA(1,I) = 999.0 IF (PERR(2,IREF).EQ.1) GAMMA(2,I) = 999.0 IF (PERR(3,IREF).EQ.1) GAMMA(3,I) = 999.0 IF (PERR(4,IREF).EQ.1) GAMMA(4,I) = 999.0 END DO C RETURN END SUBROUTINE BIGAVE(GAMMA,TIME) C INTEGER*2 TIME(6) INTEGER*4 NTOTB(4),NTOTG(4) INTEGER*4 NUM(4),NUM48(4,4),NUM9_6(4,20),NUM1_92(4,100) LOGICAL*1 HEADER,CLEAN REAL*4 GAMMA(4,400),AVE(4) REAL*4 AVG(4),AVG48(4,4),AVG9_6(4,20),AVG1_92(4,100) REAL*4 SUM(4),SUM48(4,4),SUM9_6(4,20),SUM1_92(4,100) C INCLUDE 'Z1SBK.UNPACK.INC' C HEADER = .FALSE. C HEADER = .TRUE. C C PRODUCE 192 SEC (1 VIM-5 EDR RECORD), 48 SEC, 9.6 SEC AND 1.92 SEC C AVERAGES FROM INDIVIDUAL (.48 SEC) PRIMARY MAG DETAIL DATA POINTS. C DO I=1,4 AVG(I) = 999. SUM(I) = 0. NUM(I) = 0 DO J=1,4 AVG48(I,J) = 999. SUM48(I,J) = 0. NUM48(I,J) = 0 DO K=1,5 KK = (J-1)*5+K AVG9_6(I,KK) = 999. SUM9_6(I,KK) = 0. NUM9_6(I,KK) = 0 DO L=1,5 LL = (J-1)*25+(K-1)*5+L AVG1_92(I,LL) = 999. SUM1_92(I,LL) = 0. NUM1_92(I,LL) = 0 END DO END DO END DO END DO C DO I=1,400 I1_92 = INT((I-1)/4) + 1 I9_6 = INT((I-1)/20) + 1 I48 = INT((I-1)/100) + 1 C C PRIMARY X COMPONENT AVERAGES C IF (GAMMA(1,I).NE.999.0) THEN SUM(1) = SUM(1) + GAMMA(1,I) SUM48(1,I48) = SUM48(1,I48) + GAMMA(1,I) SUM9_6(1,I9_6) = SUM9_6(1,I9_6) + GAMMA(1,I) SUM1_92(1,I1_92) = SUM1_92(1,I1_92) + GAMMA(1,I) NUM(1) = NUM(1) + 1 NUM48(1,I48) = NUM48(1,I48) + 1 NUM9_6(1,I9_6) = NUM9_6(1,I9_6) + 1 NUM1_92(1,I1_92) = NUM1_92(1,I1_92) + 1 END IF C C PRIMARY Y COMPONENT AVERAGES C IF (GAMMA(2,I).NE.999.0) THEN SUM(2) = SUM(2) + GAMMA(2,I) SUM48(2,I48) = SUM48(2,I48) + GAMMA(2,I) SUM9_6(2,I9_6) = SUM9_6(2,I9_6) + GAMMA(2,I) SUM1_92(2,I1_92) = SUM1_92(2,I1_92) + GAMMA(2,I) NUM(2) = NUM(2) + 1 NUM48(2,I48) = NUM48(2,I48) + 1 NUM9_6(2,I9_6) = NUM9_6(2,I9_6) + 1 NUM1_92(2,I1_92) = NUM1_92(2,I1_92) + 1 END IF C C PRIMARY Z COMPONENT AVERAGES C IF (GAMMA(3,I).NE.999.0) THEN SUM(3) = SUM(3) + GAMMA(3,I) SUM48(3,I48) = SUM48(3,I48) + GAMMA(3,I) SUM9_6(3,I9_6) = SUM9_6(3,I9_6) + GAMMA(3,I) SUM1_92(3,I1_92) = SUM1_92(3,I1_92) + GAMMA(3,I) NUM(3) = NUM(3) + 1 NUM48(3,I48) = NUM48(3,I48) + 1 NUM9_6(3,I9_6) = NUM9_6(3,I9_6) + 1 NUM1_92(3,I1_92) = NUM1_92(3,I1_92) + 1 END IF C C PRIMARY MAGNITUDE AVERAGES C IF (GAMMA(4,I).NE.999.0) THEN SUM(4) = SUM(4) + GAMMA(4,I) SUM48(4,I48) = SUM48(4,I48) + GAMMA(4,I) SUM9_6(4,I9_6) = SUM9_6(4,I9_6) + GAMMA(4,I) SUM1_92(4,I1_92) = SUM1_92(4,I1_92) + GAMMA(4,I) NUM(4) = NUM(4) + 1 NUM48(4,I48) = NUM48(4,I48) + 1 NUM9_6(4,I9_6) = NUM9_6(4,I9_6) + 1 NUM1_92(4,I1_92) = NUM1_92(4,I1_92) + 1 END IF END DO C DO I=1,4 IF (NUM(I).GT.0) AVG(I) = SUM(I)/REAL(NUM(I)) DO J=1,4 IF (NUM48(I,J).GT.0) AVG48(I,J) = SUM48(I,J)/REAL(NUM48(I,J)) DO K=1,5 KK = (J-1)*5+K IF (NUM9_6(I,KK).GT.0) AVG9_6(I,KK) = SUM9_6(I,KK)/ & REAL(NUM9_6(I,KK)) DO L=1,5 LL = (J-1)*25+(K-1)*5+L IF (NUM1_92(I,LL).GT.0) AVG1_92(I,LL) = SUM1_92(I,LL)/ & REAL(NUM1_92(I,LL)) END DO END DO END DO END DO C C NEED TO: C ROTATE DATA, COMPUTE LATITUDINAL AND LONGITUDINAL ANGLES, OUTPUT DATA C IF (SCID.EQ.0) THEN ISC = 2 ELSE IF (SCID.EQ.1) THEN ISC = 1 ELSE WRITE(6,'(1X,''INVALID S/C ID IN RECORD # '',I4)') RECNUM RETURN END IF IF (HEADER) THEN WRITE(6,'(1X,I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,4(1X,F7.3))') & ISC,(TIME(I),I=1,6),(AVG(J),J=1,4) END IF WRITE(66,'(I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,4(1X,F7.3))') & ISC,(TIME(I),I=1,6),(AVG(J),J=1,4) C RETURN END SUBROUTINE SMALLAVE(GAMMA2,TIME) C INTEGER*2 TIME(6) INTEGER*4 NUM(4),NUM48(4,4),NUM9_6(4,20),NUM1_92(4,100) LOGICAL*1 HEADER,CLEAN REAL*4 GAMMA(4,400),GAMMA2(4,8) REAL*4 AVG(4),AVG48(4,4),AVG9_6(4,20),AVG1_92(4,100) REAL*4 SUM(4),SUM48(4,4),SUM9_6(4,20),SUM1_92(4,100) C INCLUDE 'Z1SBK.UNPACK.INC' C HEADER = .FALSE. C HEADER = .TRUE. C C INTERPOLATE .48 SEC DETAIL RESOLUTION (400 POINTS PER RECORD) FROM 24 SEC C SECONDARY MAGNETOMETER DATA (8 POINTS PER RECORD). C PRODUCE 192 SEC (1 VIM-5 EDR RECORD), 48 SEC, 9.6 SEC AND 1.92 SEC C AVERAGES FROM INTERPOLATED (.48 SEC) SECONDARY MAG DETAIL DATA POINTS. C DO I=1,4 AVG(I) = 999. SUM(I) = 0. NUM(I) = 0 DO J=1,4 AVG48(I,J) = 999. SUM48(I,J) = 0. NUM48(I,J) = 0 DO K=1,5 KK = (J-1)*5+K AVG9_6(I,KK) = 999. SUM9_6(I,KK) = 0. NUM9_6(I,KK) = 0 DO L=1,5 LL = (J-1)*25+(K-1)*5+L AVG1_92(I,LL) = 999. SUM1_92(I,LL) = 0. NUM1_92(I,LL) = 0 END DO END DO END DO END DO C DO I=1,400 ISEC = INT((I-1)/50) + 1 I1_92 = INT((I-1)/4) + 1 I9_6 = INT((I-1)/20) + 1 I48 = INT((I-1)/100) + 1 C C SECONDARY X COMPONENT AVERAGES C GAMMA(1,I) = GAMMA2(1,ISEC) IF (GAMMA(1,I).NE.999.0) THEN SUM(1) = SUM(1) + GAMMA(1,I) SUM48(1,I48) = SUM48(1,I48) + GAMMA(1,I) SUM9_6(1,I9_6) = SUM9_6(1,I9_6) + GAMMA(1,I) SUM1_92(1,I1_92) = SUM1_92(1,I1_92) + GAMMA(1,I) NUM(1) = NUM(1) + 1 NUM48(1,I48) = NUM48(1,I48) + 1 NUM9_6(1,I9_6) = NUM9_6(1,I9_6) + 1 NUM1_92(1,I1_92) = NUM1_92(1,I1_92) + 1 END IF C C SECONDARY Y COMPONENT AVERAGES C GAMMA(2,I) = GAMMA2(2,ISEC) IF (GAMMA(2,I).NE.999.0) THEN SUM(2) = SUM(2) + GAMMA(2,I) SUM48(2,I48) = SUM48(2,I48) + GAMMA(2,I) SUM9_6(2,I9_6) = SUM9_6(2,I9_6) + GAMMA(2,I) SUM1_92(2,I1_92) = SUM1_92(2,I1_92) + GAMMA(2,I) NUM(2) = NUM(2) + 1 NUM48(2,I48) = NUM48(2,I48) + 1 NUM9_6(2,I9_6) = NUM9_6(2,I9_6) + 1 NUM1_92(2,I1_92) = NUM1_92(2,I1_92) + 1 END IF C C SECONDARY Z COMPONENT AVERAGES C GAMMA(3,I) = GAMMA2(3,ISEC) IF (GAMMA(3,I).NE.999.0) THEN SUM(3) = SUM(3) + GAMMA(3,I) SUM48(3,I48) = SUM48(3,I48) + GAMMA(3,I) SUM9_6(3,I9_6) = SUM9_6(3,I9_6) + GAMMA(3,I) SUM1_92(3,I1_92) = SUM1_92(3,I1_92) + GAMMA(3,I) NUM(3) = NUM(3) + 1 NUM48(3,I48) = NUM48(3,I48) + 1 NUM9_6(3,I9_6) = NUM9_6(3,I9_6) + 1 NUM1_92(3,I1_92) = NUM1_92(3,I1_92) + 1 END IF C C SECONDARY MAGNITUDE AVERAGES C GAMMA(4,I) = GAMMA2(4,ISEC) IF (GAMMA(4,I).NE.999.0) THEN SUM(4) = SUM(4) + GAMMA(4,I) SUM48(4,I48) = SUM48(4,I48) + GAMMA(4,I) SUM9_6(4,I9_6) = SUM9_6(4,I9_6) + GAMMA(4,I) SUM1_92(4,I1_92) = SUM1_92(4,I1_92) + GAMMA(4,I) NUM(4) = NUM(4) + 1 NUM48(4,I48) = NUM48(4,I48) + 1 NUM9_6(4,I9_6) = NUM9_6(4,I9_6) + 1 NUM1_92(4,I1_92) = NUM1_92(4,I1_92) + 1 END IF END DO C DO I=1,4 IF (NUM(I).GT.0) AVG(I) = SUM(I)/REAL(NUM(I)) DO J=1,4 IF (NUM48(I,J).GT.0) AVG48(I,J) = SUM48(I,J)/REAL(NUM48(I,J)) DO K=1,5 KK = (J-1)*5+K IF (NUM9_6(I,KK).GT.0) AVG9_6(I,KK) = SUM9_6(I,KK)/ & REAL(NUM9_6(I,KK)) DO L=1,5 LL = (J-1)*25+(K-1)*5+L IF (NUM1_92(I,LL).GT.0) AVG1_92(I,LL) = SUM1_92(I,LL)/ & REAL(NUM1_92(I,LL)) END DO END DO END DO END DO C C NEED TO: C ROTATE DATA, COMPUTE LATITUDINAL AND LONGITUDINAL ANGLES, OUTPUT DATA C IF (SCID.EQ.0) THEN ISC = 2 ELSE IF (SCID.EQ.1) THEN ISC = 1 ELSE WRITE(6,'(1X,''INVALID S/C ID IN RECORD # '',I4)') RECNUM RETURN END IF IF (HEADER) THEN WRITE(6,'(1X,I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,4(1X,F7.3))') & ISC,(TIME(I),I=1,6),(AVG(J),J=1,4) END IF WRITE(67,'(I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,4(1X,F7.3))') & ISC,(TIME(I),I=1,6),(AVG(J),J=1,4) C RETURN END SUBROUTINE CLEAN1(DATA1,NPTS,NTOTB,NTOTG,SIGMUL,BAD,AVE,PASS) C C PROGRAM TO AUTOMATICALLY FLAG AND ASSIGN 999.0 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. ALL PARALLEL SERIES POINTS ARE DELETED. C FLAGGED POINTS ARE REMOVED FROM THE SERIES AND NOT USED FOR C SUBSEQUENT TESTS OF POINTS; THIS CLEANS "RATTY" SERIES MUCH BETTER. C INTEGER*2 RECNUM INTEGER*4 I100PT(100), IUP(100), IDN(100), PASS REAL*4 DATA1(1) REAL*8 SUM,SUMSQ,SIG C C MULTI-PASS LOOP C DO IPASS = 1,PASS C C LEAVE ROUTINE IF STARTING WITH INSUFFICIENT NUMBER OF POINTS (100) C IF (NPTS.LT.100) GOTO 200 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 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 200 ENDDO AVE = SUM/100.0 SIG = DSQRT((SUMSQ - SUM**2/100.0)/100.0) ! DBLE PREC C WRITE(6,'(1X,''REC# '',I4,3X,''AVG '',F7.3,3X,''SIG '', C & E10.4)') RECNUM,AVE,SIG 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 SIG = DSQRT((SUMSQ - SUM**2/100.0)/100.0) GOTO 50 ! LOOP BACK TO THE TEST FOR THIS SET OF POINTS 200 CONTINUE C END DO C C UPDATE THE HISTORY AND SAVE C FRACT = REAL(NTOTB)/REAL(NTOTG) C WRITE(6,'(1X,''REC# '',I4,3X,''FRACTION OF BAD PTS '',E10.4)') C & RECNUM,FRACT C RETURN END SUBROUTINE BIGQUE(GAMMA,LEN,MTIME,LAST,SIGMUL,PASS) C C BUFFER GAMMA VALUES FROM THREE MAGNETOMETER AXIS AND MAGNITUDE. C WHEN SUFFICIENT NUMBER OF POINTS IS ACCUMULATED, PASS ARRAY TO C FILTERING ROUTINE AND THEN AVERAGING ROUTINE. C PARAMETER (IARR=75000,MAX=1000) INTEGER*2 TIME(6,MAX),MTIME(6) INTEGER*4 LEN,IBUFF,NTOTG(4),NTOTB(4),PASS LOGICAL*1 CLEAN,LAST REAL*4 GAMMA(4,LEN),BUFFER(IARR,4),AVE(4) SAVE IBUFF,BUFFER DATA IBUFF/0/ C INCLUDE 'Z1SBK.UNPACK.INC' C C CLEAN = .FALSE. CLEAN = .TRUE. C IF (LAST) GOTO 100 C C LOAD ONE SCIENCE BLOCK OF DATA INTO BUFFER ARRAY C DO I=1,LEN IBUFF = IBUFF + 1 DO J = 1,4 BUFFER(IBUFF,J) = GAMMA(J,I) END DO END DO ITIM = INT((IBUFF-1)/LEN) + 1 C C LOAD SCIENCE BLOCK TIME TAGS INTO HOLDING ARRAY C TIME(1,ITIM) = MTIME(1) TIME(2,ITIM) = MTIME(2) TIME(3,ITIM) = MTIME(3) TIME(4,ITIM) = MTIME(4) TIME(5,ITIM) = MTIME(5) TIME(6,ITIM) = MTIME(6) C WRITE(6,'(1X,I4,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,4(1X,F7.3))') C & ITIM,(TIME(I,ITIM),I=1,6),(BUFFER(IBUFF,J),J=1,4) C IF (IBUFF.GE.50000) THEN 100 CONTINUE IF (CLEAN) THEN BAD = 999.0 CALL CLEAN1(BUFFER(1,1),IBUFF,NTOTB(1),NTOTG(1), & SIGMUL,BAD,AVE(1),PASS) CALL CLEAN1(BUFFER(1,2),IBUFF,NTOTB(2),NTOTG(2), & SIGMUL,BAD,AVE(2),PASS) CALL CLEAN1(BUFFER(1,3),IBUFF,NTOTB(3),NTOTG(3), & SIGMUL,BAD,AVE(3),PASS) CALL CLEAN1(BUFFER(1,4),IBUFF,NTOTB(4),NTOTG(4), & SIGMUL,BAD,AVE(4),PASS) WRITE(68,'(4(1X,I5),4(1X,I5),4(1X,F7.3))') NTOTG,NTOTB,AVE END IF C C EXTRACT SCIENCE BLOCKS FROM CONCATENATED BUFFER ARRAYS ARRAYS C NREC = INT(IBUFF/LEN) DO I = 1,NREC DO J = 1,4 DO K = 1,LEN L = (I-1)*LEN + K GAMMA(J,K) = BUFFER(L,J) END DO END DO CALL BIGAVE(GAMMA,TIME(1,I)) END DO IBUFF = 0 END IF C RETURN END SUBROUTINE DISPLAY(BLEN,NCNT,TFLAG,TIME) C C DISPLAY KEY VALUES FROM UNPACKED EDR C INTEGER*2 TIME(6) INTEGER*4 BLEN CHARACTER*4 TFLAG,EX(0:15) CHARACTER*6 DM(0:31) CHARACTER*7 DDT(32:48) C INCLUDE 'Z1SBK.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','ENGS', & 'MON 5-9'/ C WRITE(6,900) NCNT,RECNUM,BLEN,PROJID,EX(RECID),SCID, & TFLAG,TIME,DM(DATMOD),DDT(DRSDAT), & DATSRC,GOLAY,SEGNUM C RETURN 900 FORMAT(1X,I4,1X,I4,1X,I4,' 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, & 2(1X,I1),1X,I2) END SUBROUTINE MOVBIT(HOLD,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 C INTEGER*4 VAL INTEGER*4 DATA(260),POS LOGICAL*1 IDAT(1040),HOLD(1040) LOGICAL*4 IVAL EQUIVALENCE(IDAT(1),DATA(1)) C DO I = 1,1040 IDAT(I) = HOLD(I) END DO C IWORD = INT(POS/32) + 1 IOFF = MOD(POS,32) DO I=0,NBITS-1 C IVAL = BTEST(DATA(1),POS+I) IVAL = BTEST(DATA(IWORD),IOFF+I) C TYPE*,I,IVAL IF (IVAL) VAL = (IBSET(VAL,IBEG+I)) IF (.NOT.IVAL) VAL = (IBCLR(VAL,IBEG+I)) END DO C RETURN END SUBROUTINE MOVBIT2(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 C INTEGER*4 VAL INTEGER*4 DATA(1),POS LOGICAL*4 IVAL C IWORD = INT(POS/32) + 1 IOFF = MOD(POS,32) DO I=0,NBITS-1 C IVAL = BTEST(DATA(1),POS+I) IVAL = BTEST(DATA(IWORD),IOFF+I) C TYPE*,I,IVAL IF (IVAL) VAL = (IBSET(VAL,IBEG+I)) IF (.NOT.IVAL) VAL = (IBCLR(VAL,IBEG+I)) END DO C RETURN END //*UN77 EXEC LOADER,GOREGN=0K,PARM.GO='SIZE=900K' // //Z1SBKNAV JOB (U0016,N598,10),'SEPARATE SEDR',TIME=(2,30), 00010036 // MSGCLASS=X,CLASS=A,NOTIFY=Z1SBK 00020004 /*JOBPARM LINES=200 00030018 //FORTRAN EXEC FORTVCLG 00040018 PROGRAM SEDRDATA 00060036 C 00070000 C READ PRE 1990 VOYAGER SEDR RECORDS FROM TAPE OR DISK SET 00080036 C SEPARATE HEADER NAV AND POINTING VECTORS 00090036 C 00091036 CHARACTER SCID*1,DSN*6 00100033 CHARACTER*4 PROJID,FILEID 00110010 CHARACTER*8 SEDRID,NAVID,DATAID 00120010 LOGICAL*1 LNAV 00121060 LOGICAL*4 LEX 00122074 INTEGER*4 INAV(126,3),IHDR(45) 00130044 REAL*4 RNAV(126,3) 00140036 EQUIVALENCE ( INAV(1,1), RNAV(1,1) ), ( PROJID, IHDR(1) ), 00150037 & ( FILEID, IHDR(2) ),( SEDRID, IHDR(4) ), 00160037 & ( NAVID, IHDR(12) ),( DATAID, IHDR(14) ), 00170037 & ( INAV(1,1), IHDR(1) ) 00170137 C 00171033 DSN = 'A00159' ! SHOULD MATCH TAPE VOLSER NAME IN BOTTOM JCL 00172066 C 00180000 C INPUT DATASET FORMAT 00190033 C 00200010 C CALL FILEINF(ISTAT,'DEVICE','3480','VOLSER',DSN, 00201033 C & 'RECFM','VBS','LRECL',1516,'BLKSIZE',32760) 00202033 C WRITE(6,*) ISTAT,' FILEINF RETURN CODE UNIT 10' 00203033 C OPEN(10,FILE='/Z1SBK.SEDR.'//DSN, 00210067 C & STATUS='OLD',FORM='UNFORMATTED') 00220067 IREC = 0 00390001 5 CONTINUE 00391056 C 00400023 C READ HEADER RECORD ( 180 BYTES ) 00410036 C 00420023 READ(10,NUM=LEN,END=100) INAV 00430037 IREC = IREC + 1 00450006 IF ( LEN.NE.180 ) THEN 00450155 C WRITE(6,*) 'SEDR HEADER RECORD LENGTH ERROR' 00450274 C WRITE(6,'(4X,''RECORD '',I6,'' IS '',I5,'' BYTES'')') 00450374 C & IREC,LEN 00450474 GOTO 5 00450556 END IF 00450636 50 CONTINUE 00450746 C 00450845 C GET OUTPUT DSN NAME FROM TRUNCATED SEDR ID 00450945 C 00451045 DSN = SEDRID(3:8) 00451145 INQUIRE(FILE='/Z1SBK.SEDR.'//DSN//'.HDR',EXIST=LEX) 00451273 IF ( LEX ) GOTO 5 00451374 WRITE(6,'(2(1X,I5),2(1X,A4),3(1X,A8),3(1X,I6))') 00451445 & IREC,LEN,PROJID,FILEID,SEDRID,NAVID,DATAID, 00451545 & IHDR(3),IHDR(6),IHDR(7) 00451645 C 00451745 C OUTPUT HDR DATASET FORMAT (RECFM=VB,LRECL=184) 00451851 C 00451945 CALL FILEINF(ISTAT,'DEVICE','TEMPDA','TRK',5,'SECOND',1, 00452047 & 'RECFM','VB','LRECL',184) 00452164 C WRITE(6,*) ISTAT,' FILEINF RETURN CODE UNIT 11' 00452249 OPEN(11,FILE='/Z1SBK.SEDR.'//DSN//'.HDR', 00452346 & STATUS='NEW',FORM='UNFORMATTED') 00452445 C 00452545 C OUTPUT PTG DATASET FORMAT (RECFM=VB,LRECL=84) 00452651 C 00452745 CALL FILEINF(ISTAT,'DEVICE','TEMPDA','TRK',10,'SECOND',5, 00452847 & 'RECFM','VB','LRECL',84) 00452964 C WRITE(6,*) ISTAT,' FILEINF RETURN CODE UNIT 12' 00453049 OPEN(12,FILE='/Z1SBK.SEDR.'//DSN//'.PTG', 00453146 & STATUS='NEW',FORM='FORMATTED') 00453245 C 00453345 C OUTPUT NAV DATASET FORMAT (RECFM=VB,LRECL=1012) 00453464 C 00453545 CALL FILEINF(ISTAT,'DEVICE','TEMPDA','CYL',10,'SECOND',5, 00453647 & 'RECFM','VB','LRECL',1012) 00453764 C WRITE(6,*) ISTAT,' FILEINF RETURN CODE UNIT 13' 00453849 OPEN(13,FILE='/Z1SBK.SEDR.'//DSN//'.NAV', 00453946 & STATUS='NEW',FORM='UNFORMATTED') 00454045 C 00454136 C WRITE BINARY HEADER RECORD 00454236 C 00454336 WRITE(11) IHDR 00455036 IHCNT = IHCNT + 1 00456052 C 00490026 C WRITE POINTING VECTOR DATA HDR 00500026 C 00510026 WRITE(12,*) '$$VGR' 00520051 C WRITE(12,700) PROJID 00521051 WRITE(12,701) SEDRID 00530028 IF ( SEDRID(4:4).EQ.'0' ) SCID = 'B' 00540025 IF ( SEDRID(4:4).EQ.'1' ) SCID = 'A' 00550025 WRITE(12,702) SCID 00560028 WRITE(12,703) 00570028 WRITE(12,704) 00580028 WRITE(12,705) 00590028 WRITE(12,706) 00600028 WRITE(12,707) 00610028 WRITE(12,*) '*' 00620028 WRITE(12,709) 00630028 WRITE(12,710) 00640028 WRITE(12,*) '*' 00650028 WRITE(12,*) '$$EOH' 00660028 700 FORMAT(1X,'PROJECT ID ',A4) 00670024 701 FORMAT(1X,'FILE ID ',A8,3X,'POINTING VECTOR FILE') 00680024 702 FORMAT(1X,'SCID ',A1) 00690028 703 FORMAT(1X,'CREATION ') 00700024 704 FORMAT(1X,'BEGIN SCE 00-000/00:00:00.000') 00710036 705 FORMAT(1X,'CUTOFF SCE 00-000/00:00:00.000') 00720036 706 FORMAT(1X,'OPTION ') 00730025 707 FORMAT(1X,'INITIAL ') 00740025 709 FORMAT(1X,'*',T24,'UNIT',T40,'ECL50',T55,'ECL50',T70,'ECL50') 00750025 710 FORMAT(1X,'*',T7,'SCET (UTC)',T24,'VECTOR',T37,'X-COMPONENT', 00760025 & T52,'Y-COMPONENT',T67,'Z-COMPONENT') 00770025 C 00780026 LNAV = .TRUE. 00781059 10 CONTINUE 00790000 READ(10,NUM=LEN,END=100) INAV 00800012 IREC = IREC + 1 00810001 C 00810138 C CHECK FOR HEADER RECORD FROM CONCATENATED DATA SETS 00810239 C 00810338 IF ( LEN.EQ.180 ) THEN 00810455 C WRITE(6,'(2(1X,I5),2(1X,A4),3(1X,A8),3(1X,I6))') 00810546 C & IREC,LEN,PROJID,FILEID,SEDRID,NAVID,DATAID, 00810646 C & IHDR(3),IHDR(6),IHDR(7) 00810746 CLOSE(11) 00810846 CLOSE(12) 00810946 CLOSE(13) 00811046 IREC = 1 00811146 C 00811248 C OUTPUT SEPARATED SEDR DATA SETS 00811348 C 00811448 GOTO 50 00811546 END IF 00811638 C 00811738 C REMOVE IMPROPER LENGTH RECORDS 00811838 C 00811938 IF ( LEN.NE.1008 .AND. LEN.NE.1512 ) THEN 00812036 WRITE(6,*) 'SEDR RECORD LENGTH ERROR' 00813036 WRITE(6,'(4X,''RECORD '',I6,'' IS '',I5,'' BYTES'')') 00814036 & IREC,LEN 00815036 GOTO 10 00816036 END IF 00817036 WRITE(6,'(8(1X,I5))') IREC,LEN,(INAV(I,1),I=1,6) 00818038 C 00818259 C WRITE POINTING VECTOR RECORDS IF APPROPRIATE 00818359 C 00818459 IF ( .NOT.LNAV ) GOTO 75 00818559 C 00818758 C WRITE BINARY NAVIGATION RECORD 00818858 C 00818958 IF ( LEN.EQ.1008 ) THEN 00819058 IPV = 2 00830058 WRITE(13) (INAV(I,1),I=1,126) 00840058 INCNT = INCNT + 1 00841058 ELSE IF ( LEN.EQ.1512 ) THEN 00850058 IPV = 3 00860158 WRITE(13) ((INAV(I,J),I=1,126),J=1,2) 00860258 INCNT = INCNT + 1 00860358 END IF 00860458 C 00864236 C WRITE POINTING VECTOR DATA TO ASCII "NEW STYLE" FILE 00864336 C 00864436 IF ( INAV(1,IPV).LT.2000 ) INAV(1,IPV) = INAV(1,IPV) - 1900 00864562 IF ( INAV(1,IPV).GE.2000 ) INAV(1,IPV) = INAV(1,IPV) - 2000 00864662 WRITE(12,801) (INAV(I,IPV),I=1,6),(RNAV(I,IPV),I=12,14) 00940062 WRITE(12,802) (RNAV(I,IPV),I=15,17) 00950058 WRITE(12,803) (RNAV(I,IPV),I=18,20) 00960058 IPCNT = IPCNT + 1 00961058 LNAV = .FALSE. 00961159 C 00962058 C CHECK FOR POINTING VECTOR CONTINUATION BIT 00963058 C LNAV = F - IF CONTINUATION 00963160 C LNAV = T - IF NO REMAINING PV'S IN LOGICAL BLOCK 00963260 C 00964058 IF ( INAV(101,IPV).EQ.0 ) LNAV = .TRUE. 00965058 C 00970026 GOTO 10 01060010 C 01060160 C CONTINUED PV'S 01060260 C 01060360 75 CONTINUE 01061059 LIM = LEN/504 01061159 DO 85 IPV = 1,LIM 01061259 C 01062059 C WRITE POINTING VECTOR DATA TO ASCII "NEW STYLE" FILE 01063059 C 01064059 IF ( INAV(1,IPV).LT.2000 ) INAV(1,IPV) = INAV(1,IPV) - 1900 01064162 IF ( INAV(1,IPV).GE.2000 ) INAV(1,IPV) = INAV(1,IPV) - 2000 01064262 WRITE(12,801) (INAV(I,IPV),I=1,6),(RNAV(I,IPV),I=12,14) 01065062 WRITE(12,802) (RNAV(I,IPV),I=15,17) 01066059 WRITE(12,803) (RNAV(I,IPV),I=18,20) 01067059 IPCNT = IPCNT + 1 01068059 IF ( INAV(101,IPV).NE.1 ) THEN 01069059 LNAV = .TRUE. 01069159 GOTO 10 01069259 END IF 01069359 85 CONTINUE 01069459 GOTO 10 01069559 100 CONTINUE 01070000 WRITE(6,*) 01071052 WRITE(6,*) IHCNT,' HEADER RECORDS WRITTEN' 01072052 WRITE(6,*) INCNT,' NAVIGATION RECORDS WRITTEN' 01073057 WRITE(6,*) IPCNT,' POINTING VECTOR RECORDS WRITTEN' 01074052 WRITE(6,*) 01076052 STOP 01080000 801 FORMAT(1X,I2,'-',I3.3,'/',2(I2.2,':'),I2.2,'.',I3.3, 01090025 & 3X,'PITCH',7X,3(E13.7,2X)) 01100025 802 FORMAT(23X,'YAW ',7X,3(E13.7,2X)) 01110025 803 FORMAT(23X,'ROLL ',7X,3(E13.7,2X)) 01120025 END 01130000 //LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR 01150018 //GO.SYSUDUMP DD DUMMY 01160018 //FT10F001 DD VOL=(PRIVATE,SER=S2083A),LABEL=(1,NL,,IN),UNIT=3480, 01170077 // DCB=(RECFM=VBS,LRECL=1516,BLKSIZE=32760,OPTCD=B) 01180067 //*T99F001 DD DSN=Z1SBK.BADSEDR.DAT,DISP=(NEW,CATLG,DELETE), 01181061 //* DCB=(RECFM=VB,LRECL=1516,BLKSIZE=7580), 01182061 //* SPACE=(CYL,(200,10),RLSE),UNIT=TEMPDA 01183061 //NOTIFY EXEC NOTIFY 01190000 // 01200000 //Z1SBKPLS JOB (U0016,N598,10),'MIT PLS MRG',TIME=(0,30), // CLASS=A,MSGCLASS=X,NOTIFY=Z1SBK //FORTRAN EXEC FORTVCLG CHARACTER DSN*50 INTEGER*4 IN(35) REAL*4 FIN(35),WORD(8) C EQUIVALENCE (IN(1), FIN(1)) C DEG = 180.0/3.14159 BLT = 1.38066E-23 PRTN = 1.67265E-27 C C S/C ID (VOYAGER 2 ONLY - NO PLS FROM VOYAGER 1 AFTER NOV 1980) C IN(1) = 2 C C INPUT MIT PLASMA HOUR AVERAGE DATA SET C DSN = 'Z1SBK.V291.PLS' OPEN(10,FILE='/'//DSN,STATUS='OLD',FORM='FORMATTED') C C READ MIT KEY PARMS FORMAT DATA C YEAR,DAY,HOUR,V,DEN,W,VR,VT,VN,ALF,EXP C DO I = 2,35 IN(I) = 0 END DO C IREAD = 0 IWRITE = 0 10 CONTINUE READ(10,*,ERR=10,END=100) IYR,IDY,HR,(WORD(I),I=1,8) IREAD = IREAD + 1 IN(2) = IYR - 1900 IN(3) = IDY IN(4) = INT(HR) C V = WORD(1) IF (V.GT.200.0.AND.V.LT.1500.0) THEN VR = WORD(4) VT = WORD(5) VN = WORD(6) VRT = SQRT(VR**2+VT**2) VD = ATAN2(VN,VRT)*DEG VL = -ATAN2(VT,VR)*DEG FIN(13) = WORD(1) FIN(14) = VD FIN(15) = VL ELSE FIN(13) = 0.0 FIN(14) = 0.0 FIN(13) = 0.0 END IF C IF (WORD(2).GT.0) THEN FIN(16) = WORD(2) ELSE FIN(16) = 0.0 END IF C W = WORD(3) IF (WORD(3).GT.0.0.AND.WORD(3).LT.1.0E10) THEN TEMP = PRTN*(W*1000.0)**2.0/(2.0*BLT) FIN(17) = TEMP ELSE FIN(17) = 0.0 END IF C WRITE(6,800) (IN(I),I=1,4),(FIN(I),I=13,17) WRITE(11) FIN IWRITE = IWRITE + 1 C GOTO 10 100 CONTINUE CLOSE(10) C WRITE(6,*) IREAD, ' PLASMA RECORDS READ' WRITE(6,*) IWRITE, ' PLASMA RECORDS WRITTEN' C STOP 800 FORMAT(1X,I1,1X,I2,1X,I3,1X,I2,1X,F6.1,2(1X,F7.2),2(1X,E10.4)) END //LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR //GO.SYSUDUMP DD DUMMY //FT11F001 DD DSN=Z1SBK.MSPERM,DISP=MOD //NOTIFY EXEC NOTIFY // //Z1SBKNAV JOB (U0008,N598,20),'NAV RCD REBLOCK',TIME=(2,00), // CLASS=N,MSGCLASS=X,NOTIFY=Z1SBK // EXEC FORTVCLG PROGRAM REBLOCK C C NAVIGATION RECORD REBLOCKER. EXPECT EACH RECORD TO BE PRECEDED AND C FOLLOWED BY A RECORD LENGTH QUALIFIER (BYTES). C CHARACTER*4 CNAV(64) CHARACTER*50 DSN INTEGER*4 REC(64),TREC(1000),INAV(126),SYNC EQUIVALENCE(INAV(1),TREC(1)),(CNAV(1),TREC(1)) C C OPEN BINARY IBM BIT MAPPED EDR . 256 BYTE LENGTH RECORD EXPECTED. C READ AS SPANNED RECORD. WRITE OUT 180 BYTE HEADER RECORD, 504 BYTE C DATA RECORDS. C DSN = '/Z1SBK.A00159.BIN' OPEN(50,FILE=DSN,STATUS='OLD',FORM='UNFORMATTED') C DSN = '/Z1SBK.SEDR.A00159' OPEN(51,FILE=DSN,STATUS='OLD',FORM='UNFORMATTED') C NREC = 0 READ(50,NUM=LEN,END=100,ERR=10) REC C C EXTRACT 45 WORD HEADER RECORD C SYNC = REC(1)/4 IWORD = 0 DO I = 2,LEN/4 IWORD = IWORD + 1 IF (IWORD.LE.SYNC+2) THEN TREC(IWORD) = REC(I) ELSE WRITE(51,NUM=IOUT) (TREC(K),K=1,SYNC) NREC = NREC + 1 WRITE(6,888) SYNC,REC(I-2)/4,NREC, & CNAV(1),CNAV(2),CNAV(4),CNAV(5),INAV(3),INAV(6) IWORD = 0 SYNC = REC(I-1)/4 IWORD = IWORD + 1 TREC(IWORD) = REC(I) END IF END DO C 10 CONTINUE READ(50,NUM=LEN,END=100,ERR=10) REC C C BUFFER INPUT. OUTPUT 1008 BYTE RECORDS. C DO I = 1,LEN/4 C C BUILD HOLDING ARRAY TREC C IWORD = IWORD + 1 IF (IWORD.LE.SYNC+2) THEN TREC(IWORD) = REC(I) ELSE WRITE(51,NUM=IOUT) (TREC(K),K=1,SYNC) NREC = NREC + 1 WRITE(6,'(9(1X,I5))') SYNC,REC(I-2)/4,NREC,(INAV(K),K=1,6) IWORD = 0 C SYNC = REC(I-1)/4 C C SOME RECORD LENGTH QUALIFIERS FOUND TO BE CORRUPTED THEREFORE C RECORD LENGTH IS FORCED TO PROPER 1008 BYTES (252 WORDS). C SYNC = 252 IWORD = IWORD + 1 TREC(IWORD) = REC(I) END IF C END DO GOTO 10 100 CONTINUE C IF (IWORD.GT.0) THEN WRITE(51,NUM=LEN) (TREC(K),K=1,SYNC) NREC = NREC + 1 WRITE(6,'(9(1X,I5))') SYNC,REC(I-2),NREC,(INAV(K),K=1,6) END IF C CLOSE(50) CLOSE(51) C WRITE(6,*) NREC,' RECORDS WRITTEN' C STOP 888 FORMAT(3(1X,I5),2(1X,A4),1X,2A4,2(1X,I6)) END //LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR //GO.SYSUDUMP DD DUMMY //TELL EXEC NOTIFY // //Z1SBKNCY JOB (U0016,N598,5),'COPY NAV TAPE',TIME=(0,30), 00010012 // MSGCLASS=X,CLASS=A,NOTIFY=Z1SBK 00020004 //FORTRAN EXEC FORTVCLG 00021018 PROGRAM NAVCOPY 00022012 C 00023000 C READ VOYAGER NAVIGATION RECORDS FROM TAPE AND COPY TO DISK SET 00023110 C 00023300 CHARACTER*4 PROJID,FILEID 00023410 CHARACTER*8 SEDRID,NAVID,DATAID 00023610 INTEGER*4 INAV(252),IHDR(45) 00023715 REAL*4 RNAV(252) 00023815 EQUIVALENCE(INAV(1),RNAV(1)),(PROJID,IHDR(1)), 00023910 & (FILEID,IHDR(2)),(SEDRID,IHDR(4)), 00024006 & (NAVID,IHDR(12)),(DATAID,IHDR(14)) 00024110 C 00024213 C INPUT DISK DATASET (USE FTIO JCL FOR TAPE) 00024314 C 00024413 OPEN(10,FILE='/Z1SBK.SEDR.S2089A',STATUS='OLD',FORM='UNFORMATTED')00024518 C 00024600 C OPEN(11,FILE='/Z1SBK.A00159.HDR',STATUS='OLD',FORM='UNFORMATTED') 00024917 C 00025016 C OPEN(12,FILE='/Z1SBK.A00159.DAT',STATUS='OLD',FORM='UNFORMATTED') 00025117 C 00025216 IREC = 0 00025301 READ(10,END=100) IHDR 00025418 IREC = IREC + 1 00025506 C WRITE(11) IHDR 00025617 WRITE(6,'(1(1X,I5),2(1X,A4),3(1X,A8),3(1X,I6))') 00025710 & IREC,PROJID,FILEID,SEDRID,NAVID,DATAID, 00025810 & IHDR(3),IHDR(6),IHDR(7) 00025910 10 CONTINUE 00026000 READ(10,NUM=LEN,END=100) INAV 00026118 C WRITE(11) INAV 00026216 C WRITE(12) INAV 00026317 IREC = IREC + 1 00026401 WRITE(6,'(7(1X,I5))') IREC,(INAV(I),I=1,6) 00026510 GOTO 10 00026610 100 CONTINUE 00026700 STOP 00026800 END 00026900 //LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR 00027018 //GO.SYSUDUMP DD DUMMY 00027118 //*T10F001 DD VOL=(PRIVATE,SER=S2089A),LABEL=(1,NL,,IN),UNIT=3480, 00027218 //* DCB=(RECFM=U,BLKSIZE=1512) 00028018 //NOTIFY EXEC NOTIFY 00030000 // 00040000 SUBROUTINE HEAD(SEDREC) 00001001 INTEGER*4 IC/0/,SEDREC(1) 00001101 IC = IC + 1 00001200 C WRITE (6,10) IC, SEDREC(14) 00001302 C 10 FORMAT (' HEADER #',I3,3X,A4) 00001402 RETURN 00002000 END 00003000 SUBROUTINE NAV (NAVREC, NAVBYT) 00010000 INTEGER*4 NAVREC(252),NAVBYT 00020000 WRITE (6,10) (NAVREC(I),I=1,6), NAVREC(83) 00030006 10 FORMAT (' NAV ',I5,'/',I3,':',I2,':',I2,':',I2,'.',I3, 00040003 1 /,' RANGE =',E22.11) 00050007 RETURN 00060000 END 00070000 SUBROUTINE PV (PVREC) 00080000 C INTEGER*4 PVREC(126) 00090002 C WRITE (6,10) (PVREC(I),I=1,6),PVREC(101) 00100002 C 10 FORMAT (' PV ',I5,'/',I3,':',I2,':',I2,':',I2,'.',I3,' WD 101 =',00110002 C 1 Z8) 00120002 RETURN 00130000 END 00140000 //Z1SBKNVT JOB (U0016,N598,5),'READ SEDR',TIME=(0,30), // CLASS=N,MSGCLASS=X,NOTIFY=Z1SBK // EXEC FORTVCLG C C READ BINARY SEDR FILE C CHARACTER*50 DSN INTEGER*4 INAV(126,3) REAL*4 RNAV(126,3) CHARACTER*4 CNAV(45) EQUIVALENCE ( RNAV(1,1), INAV(1,1) ), ( CNAV(1), INAV(1,1) ) C DSN = '/Z1SBK.SEDR.A09232.NAV' C OPEN(10,FILE=DSN,STATUS='OLD',FORM='UNFORMATTED') C IREC = 0 10 CONTINUE READ(10,NUM=LEN) INAV IREC = IREC + 1 DO I = 1,126 WRITE(6,*) IREC,LEN,I,(INAV(I,J),J=1,3) END DO IF (IREC.LT.10) GOTO 10 100 CONTINUE STOP END //LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR //GO.SYSUDUMP DD DUMMY // EXEC NOTIFY // //Z1SBKBLK JOB (U0016,N598,5),'EDR REBLOCK',TIME=(2,00),MSGCLASS=X /*JOBPARM LINES=100 //FORT77 EXEC FORTRAN PROGRAM REBLOCK C C EDR RECORD REBLOCKER C PARAMETER (LREC=256) CHARACTER*3 PROJID CHARACTER*4 RECLEN CHARACTER*20 DSNIN,DSNOUT INTEGER*4 BLEN LOGICAL*1 REC(LREC),TREC(6512) C C OPEN BINARY IBM BIT MAPPED EDR . 256 BYTE LENGTH RECORD EXPECTED. C READ AS SPANNED RECORD WITH EBCIDC STRING 'MJS' DENOTING THE START C OF RECORD. WRITE REBLOCKED RECORDS. C DSNIN = 'Z1SBK.EDR.JPL' DSNOUT = 'Z1SBK.EDR.DAT' C C OPEN INPUT DATASET C OPEN(50,FILE='/'//DSNIN,STATUS='OLD',FORM='UNFORMATTED') C C OPEN OUTPUT DATASET C OPEN(51,FILE='/'//DSNOUT,STATUS='NEW',FORM='UNFORMATTED', & RECL=3862) C WRITE(RECLEN,'(I4)') LREC IBYTE = 0 NREC = 0 10 CONTINUE READ(50,END=100,ERR=10) (REC(I),I=1,LREC) C C SEARCH INPUT RECORD FOR 'MJS' PROJECT ID STRING C DO J = 1,LREC C C BUILD HOLDING ARRAY TREC C TREC(IBYTE+J) = REC(J) IF (IBYTE+J.GE.3) THEN WRITE(PROJID,'(3A1)') (TREC(K),K=IBYTE+J-2,IBYTE+J) C C WHEN STRING MJS IS ENCOUNTERED WRITE PRECEDING BYTES AS ONE RECORD C AND REINITIALIZE BYTE COUNTER FOR TREC C IF (PROJID.EQ.'MJS') THEN BLEN = IBYTE + J - 3 IF (BLEN.GT.3) THEN WRITE(51) (TREC(L),L=1,BLEN) NREC = NREC + 1 TREC(1) = TREC(IBYTE+J-2) TREC(2) = TREC(IBYTE+J-1) TREC(3) = TREC(IBYTE+J) IBYTE = 3 - J END IF END IF END IF END DO IBYTE = IBYTE + LREC GOTO 10 100 CONTINUE C C WRITE FINAL RECORD C BLEN = IBYTE IF (BLEN.GT.3) THEN WRITE(51) (TREC(L),L=1,BLEN) NREC = NREC + 1 END IF WRITE(6,'(1X,I5.5,'' RECORDS WRITTEN'')') NREC C CLOSE(50) CLOSE(51) C STOP 800 FORMAT('RECLEN'A1) END //NOTIFY EXEC NOTIFY // CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC00010000 C 00020000 C PROGRAM: SEDRREAD 00030000 C 00040000 C PROGRAMMER: T. W. VOLLMER (GSFC) 00050004 C 00051004 C DATE: FEBRUARY 8, 1984 00052004 C 00060000 C DESCRIPTION: THIS ROUTINE READS AN SEDR IN ANY FORMAT (LAUNCH, 00070000 C CRUISE, JUPITER, ETC.), BREAKING THE RECORDS INTO 00080000 C HEADER RECORDS, NAVIGATION BLOCKS AND POINTING VECTORS. 00090000 C THESE ARE THEN PASSED TO SUBROUTINES (HEAD, NAV & PV) 00100000 C WHERE THEY ARE PROCESSED. IT IS ASSUMED THAT THE 00110000 C SUBROUTINES 'HEAD', 'NAV' AND 'PV' WILL CHANGE FOR 00120000 C DIFFERENT APPLICATIONS. NOTE THAT ONLY THE NAVAGATION 00130000 C BLOCK IS CHECKED AGAINST THE INPUT TIME LIMITS. POINTING00140000 C VECTORS ARE PROCESSED IF AND ONLY IF THE PRECEEDING NAV 00150000 C IS PROCESSED. THIS IS TO ACCOUNT FOR THE FACT THAT A PV 00160000 C CAN HAVE AN EARLIER TIME THAN THE NAV. 00170000 C 00180000 C PDL: 00190000 C READ THE SEDR TIMES TO BE PROCESSED 00200000 C READ THE SEDR RECORD 00210000 C IF THIS IS A HEADER RECORD THEN CALL HEAD 00220000 C ELSE 00230000 C IF THE RECORD DOES NOT HAVE THE CORRECT LENGTH THEN DISCARD 00240003 C IF THIS IS A NAVIGATION RECORD 00250000 C THEN IF RECORD IS WITHIN TIMES TO BE PROCESSED 00260000 C THEN SET FLAG INDICATING RECORD IS TO BE PROCESSED 00270000 C IF THIS IS A JUPITER FORMAT RECORD 00280000 C THEN SET NAV BLOCK LENGTH TO 1008 00290000 C SET POINTING VECTOR POSITION TO 3 00300000 C ELSE SET NAV BLOCK LENGTH TO 504 00310000 C SET POINTING VECTOR POSITION TO 2 00320000 C IF THIS RECORD IS TO BE PROCESSED 00330000 C THEN CALL NAV TO PROCESS NAVIGATION BLOCK 00340000 C CALL PV TO PROCESS POINTING VECTOR 00350000 C IF THIS IS THE LAST POINTING VECTOR 00360000 C THEN SET SET FLAG INDICATING A NAVIGATION BLOCK NEXT 00370000 C ELSE TURN OFF FLAG INDICATING A NAVIGATION BLOCK NEXT00380000 C ELSE DO FOR EACH POINTING VECTOR 00390000 C IF THIS RECORD IS TO BE PROCESSED 00400000 C THEN CALL PV TO PROCESS THE POINTING VECTOR 00410000 C IF THIS IS THE LAST POINTING 00420000 C THEN SET FLAG INDICATING A NAVIGATION BLOCK 00430000 C GO BACK AND READ A NEW SEDR RECORD 00440000 C END DO 00450000 C 00460000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC00470000 LOGICAL*1 LNAV/.TRUE./, PROC 00480000 INTEGER*4 SDREC(126,3), YRBEG, DAYBEG, HRBEG, MINBEG, 00490000 1 YREND, DAYEND, HREND, MINEND 00500000 C READ LIMITS OF TIMES TO BE PROCESSED 00510000 READ (5,10) YRBEG, DAYBEG, HRBEG, MINBEG, 00520000 1 YREND, DAYEND, HREND, MINEND 00530000 WRITE (6,10000) YRBEG,DAYBEG,HRBEG,MINBEG, 00540000 1 YREND,DAYEND,HREND,MINEND 00550000 10000 FORMAT (' TIME LIMITS ',8I5) 00560000 10 FORMAT (8I5) 00570000 NREC = 0 00580000 20 CONTINUE 00590000 C READ AN SEDR RECORD 00600000 CALL FREAD (SDREC, 10, NBYT, &150, &130) 00610000 C WRITE (6,22) NBYT 00611007 C 22 FORMAT (' READ SEDR RECORD NBYTE = ',I5) 00612007 IF (NBYT .NE. 180) GO TO 25 00620000 C PROCESS HEADER RECORD 00630003 CALL HEAD (SDREC) 00640003 25 CONTINUE 00650003 C IF SEDR RECORD IS NOT A VALID LENGTH THEN DISCARD 00660003 IF ((NBYT .NE. 1008) .AND. (NBYT .NE.1512)) GO TO 20 00670003 IF (.NOT. LNAV) GO TO 100 00680000 C NAVIGATION BLOCK 00690000 C CHECK THAT RECORD IS WITHIN TIME LIMIT REQUISTED 00700000 IF (SDREC(1,1) .LT. YRBEG) GO TO 30 00710003 IF (SDREC(1,1) .GT. YRBEG) GO TO 40 00720003 IF (SDREC(2,1) .LT. DAYBEG) GO TO 30 00730003 IF (SDREC(2,1) .GT. DAYBEG) GO TO 40 00740003 IF (SDREC(3,1) .LT. HRBEG) GO TO 30 00750003 IF (SDREC(3,1) .GT. HRBEG) GO TO 40 00760003 IF (SDREC(4,1) .LT. MINBEG) GO TO 30 00770003 IF (SDREC(4,1) .GT. MINBEG) GO TO 40 00780003 GO TO 50 00790003 30 CONTINUE 00800003 PROC = .FALSE. 00810000 GO TO 60 00820003 40 CONTINUE 00830003 IF (SDREC(1,1) .LT. YREND) GO TO 50 00840003 IF (SDREC(1,1) .GT. YREND) GO TO 150 00850003 IF (SDREC(2,1) .LT. DAYEND) GO TO 50 00860003 IF (SDREC(2,1) .GT. DAYEND) GO TO 150 00870003 IF (SDREC(3,1) .LT. HREND) GO TO 50 00880003 IF (SDREC(3,1) .GT. HREND) GO TO 150 00890003 IF (SDREC(4,1) .LT. MINEND) GO TO 50 00900003 IF (SDREC(4,1) .GT. MINEND) GO TO 150 00910000 50 CONTINUE 00920003 PROC = .TRUE. 00930003 60 CONTINUE 00940000 IF (NBYT .EQ. 1512) GO TO 70 00950000 C NON-JUPITER NAVIGATION BLOCK 00960000 NAVBYT = 504 00970000 IPV = 2 00980000 GO TO 80 00990000 70 CONTINUE 01000000 C JUPITER NAVIGATION BLOCK 01010000 NAVBYT = 1008 01020000 IPV = 3 01030000 80 CONTINUE 01040000 IF (.NOT. PROC) GO TO 90 01050000 C PROCESS NAV AND PV 01060000 CALL NAV (SDREC(1,1), SDREC(1,1), NAVBYT) 01070005 CALL PV (SDREC(1,IPV), SDREC(1,IPV)) 01080005 90 CONTINUE 01090000 LNAV = .FALSE. 01100000 IF (SDREC(101,IPV) .EQ. 0) LNAV = .TRUE. 01110000 GO TO 20 01120000 100 CONTINUE 01130000 C POINTING VECTOR 01140000 LIM = NBYT / 504 01150000 DO 120 IPV = 1, LIM 01160000 IF (.NOT. PROC) GO TO 110 01170000 CALL PV (SDREC(1,IPV), SDREC(1,IPV)) 01180005 110 CONTINUE 01190000 IF (SDREC(101,IPV) .EQ. 1) GO TO 120 01200000 LNAV = .TRUE. 01210000 GO TO 20 01220000 120 CONTINUE 01230000 GO TO 20 01240000 130 CONTINUE 01250000 C ERROR READING SEDR TAPE 01260000 WRITE (6,140) NREC 01270000 140 FORMAT (' ERROR READING RECORD',I5) 01280000 GO TO 20 01290000 150 CONTINUE 01300000 C WRITE (6,10020) 01310000 C0020 FORMAT (' END OF SEDR') 01320000 STOP 01330000 END 01340000 //Z1SBKSUM JOB (U0016,N598,15),'HIGH RES',TIME=(6,00),CLASS=N, // MSGCLASS=X,NOTIFY=Z1SBK /*JOBPARM LINES=100 //*EXEC FORTRAN // EXEC FORTVCLG C C WRITTEN BY SANDY KRAMER, 01/93. C READS MAG RECORD FROM SUMMARY TAPE. C FILTERS 1.92 SEC AVGS TO CREATE NEW SUMMARY RECORD. C CHARACTER*4 FLT CHARACTER*29 DSN INTEGER*2 TIME(6),ID,DATA(2) INTEGER*4 IMAG(496) REAL*4 FIN(568),MAG(496),HEADER(32),SEDR(40) EQUIVALENCE (FIN(1),HEADER(1)),(FIN(33),MAG(1)), & (HEADER(4),TIME(1)),(HEADER(17),ID), & (HEADER(3),FLT),(SEDR(1),FIN(529)), & (IMAG(1),MAG(1)),(DATA(1),HEADER(17)) C IREC = 0 30 CONTINUE READ(10,NUM=LEN,END=100,ERR=30) FIN IF (ID.NE.1) GO TO 30 IREC = IREC + 1 C IF (IREC.GT.50) GOTO 100 READ(FLT,'(3X,I1)') ISC WRITE(6,808) ISC,TIME,(MAG(488+I),I=1,3),IMAG(492),MAG(496), & DATA(2) GO TO 30 100 CONTINUE STOP 800 FORMAT(1X,I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,I3,1X,F5.2, & 8(1X,I5)) 808 FORMAT(1X,I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3, & 3(1X,F7.3),1X,I5,1X,F7.3,1X,I5) 810 FORMAT(1X,I5.5,' LFM RECORDS READ') END //LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR //GO.SYSUDUMP DD DUMMY //FT10F001 DD DSN=U0#16.UNITTREE.V2.D8109500,DISP=OLD //*T10F001 DD DSN=U0#16.VOYAGER.PRIMARY.M91076,DISP=OLD //*T10F001 DD DSN=U0#16.VOYAGER.SECOND.M91261,DISP=OLD //*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21372, //* DISP=OLD,UNIT=T3480,VOL=SER=289271, //* DCB=(RECFM=VB,LRECL=5000,BLKSIZE=32760), //* LABEL=(1,SL,,IN) //TELL EXEC NOTIFY // ****************************************************************** LOGICAL*1 HEAD(240), PLS(432), MAG(5840), FLIP(0:255) C CHARACTER*3 PROJID C INTEGER*4 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(80),GCI(80), DPIRIS, H GPIRIS, DRSDAT, GCBEC, GBITES C C INTEGER*2 STAT1(4) ,STAT2(4) C INTEGER*2 PDIFF(3,400), PREF(3,16), M SREF(3,8) , M IBOFF(3,8) , OBOFF(3,8) C REAL*4 IBSENS(3,8) , OBSENS(3,8) C C C COMMON PROJID C C COMMON /HEADER/ 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 C C COMMON /PLSDAT/ STAT1, STAT2 C C COMMON /MAGDAT/ IBSENS, OBSENS, M PDIFF, PREF, SREF, M IBOFF, OBOFF C COMMON/ALLDAT/ HEAD, PLS, MAG, FLIP ******************************************************************