//Z1SBKFXE JOB (U0016,N598,50),KRAMER,TIME=(2,00),MSGCLASS=X,CLASS=A
/*JOBPARM LINES=100
//*ROUTE PRINT SCFVM.Z1SBK
//FORT77 EXEC FORTRAN
C FIXES VOYAGER 48 SECOND FIELD VALUES
C USES CONNERNY ROUTINE ARGUS, WHICH THROWS AWAY POINTS TOO
C FAR FROM THE MEDIAN VALUE OF A GROUP OF POINTS OF
C LENGTH FIXINT HOURS
C CREATES AND WRITES NEW AVERAGES FROM CLEAN DATA SET
      CHARACTER*2 CO
      CHARACTER*6 INDEX
      CHARACTER*29 DSN
      INTEGER*4 READCT,MAX48
      REAL*4 B(10000),BR(10000),BT(10000),BN(10000)
      REAL*8 TIME(10000),TDAT0,TDAT1,DTIME,TSTART,TSTOP
      NIL = 0
C INIT PARAMETERS
      FIXINT = 1.0
      NYR = 90
      NDY = 141
      NHR = 0
      TSTART = DTIME(NYR,NDY,NHR,NIL,NIL,NIL)
      KYR = 90
      KDY = 260
      KHR = 0
      TSTOP = DTIME(KYR,KDY,KHR,NIL,NIL,NIL)
      ISC = 2
      NREAD = 75
      READCT = 0
      IUNIT = 10
      DSN = 'U0#16.VOYAGER.SUMMARY.INDEX'
      WRITE(6,892) IUNIT,DSN
      OPEN(IUNIT,FILE='/'//DSN,STATUS='OLD',FORM='FORMATTED',
     C     ACTION='READ')
C READ CATALOGUE ... PROCESS FROM TSTART THROUGH NREAD DATA SETS
   10 CONTINUE
        READ(10,901,END=100)
     C          ISCC,IY00,ID00,IH00,IY11,ID11,IH11,CO,INDEX
C READ ONLY CRUISE DATA (HG COORDS)
        IF (CO.NE.'HG') GO TO 10
        TDAT0 = DTIME(IY00,ID00,IH00,NIL,NIL,NIL)
        TDAT1 = DTIME(IY11,ID11,IH11,NIL,NIL,NIL)
        NMAX = MAX48(TDAT0,TDAT1)
        IF (ISCC.NE.ISC) GO TO 10
        IF (TDAT1.LT.TSTART) GO TO 10
        READCT = READCT + 1
        IF (READCT.GT.NREAD) GO TO 100
        DSN = 'U0#16.VOYAGER.SUMMARY.'//INDEX
        IUNIT = IUNIT + 1
C SKIP BAD DATASETS
        IF (INDEX.EQ.'M21368') GO TO 10
        IF (INDEX.EQ.'M21420') GO TO 10
        WRITE(6,892) IUNIT,DSN
        WRITE(6,901) ISCC,IY00,ID00,IH00,IY11,ID11,IH11,
     C          CO,INDEX
        WRITE(6,890) TSTART,TSTOP,TDAT0,TDAT1
        WRITE(6,891) NMAX,READCT
C GET ONE SUMMARY TAPE'S WORTH OF DATA
         CALL INIT(TIME,B,BR,BT,BN)
         CALL AQUIRE(IUNIT,DSN,TIME,B,BR,BT,BN,TDAT0,TSTART,TSTOP)
         CALL FIX(FIXINT,NMAX,ISC,TIME,B,BR,BT,BN)
        GO TO 10
  100 CONTINUE
      CLOSE(10)
      STOP
  890 FORMAT(1X,'MAIN PGM***TSTART,TSTOP,TDAT0,TDAT1 = ',4F12.8)
  891 FORMAT(1X,'MAIN PGM***NMAX,READCT = ',2I10)
  892 FORMAT(1X,'MAIN PGM***UNIT,DSN = ',I3,A30)
  901 FORMAT(1X,I1,1X,I2,1X,I3,1X,I2,4X,I2,1X,I3,1X,I2,1X,A2,
     C       1X,A6)
      END
      SUBROUTINE FIX(FIXINT,NMAX,ISC,TIME,B,BR,BT,BN)
      INTEGER*4 IA(1000)
      REAL*4 B(1),BR(1),BT(1),BN(1),B1(1000),BR1(1000),BT1(1000),
     C       BN1(1000),DA(1000),A2(1000),Y(1000)
      REAL*8 TIME(1),T1(1000),TAV,DELTA,FIXPD
C
C  FIX DATA IN INTERVALS OF MAXIMUM OF FIXINT HOURS AT A TIME
C
      N0 = 1
      FIX48 = FIXINT * 3600.0 / 48.0
      MAXFIX = INT(FIX48)
      FIXPD = DBLE(FIXINT)/10.0D0/(24.0D0*365.0D0)
   10 CONTINUE
      NFIX = 0
        DO 12 I = 1,MAXFIX
          LL = I + N0 - 1
C         WRITE(6,874)  I,LL,NFIX,TIME(LL),B(LL)
          NYR = IDINT(TIME(LL))
          IF (NYR.GT.91 .OR. NYR.LT. 77) GO TO 12
          YY = SQRT(BR(LL)**2 + BT(LL)**2 + BN(LL)**2)
          IF (YY.GT.5.0 .OR. B(LL).GT.5.0) GO TO 12
          DELTA = TIME(LL) - T1(NFIX)
          IF (NFIX.GT.2 .AND. DELTA.GT.FIXPD) GO TO 20
          NFIX = NFIX + 1
          B1(NFIX) = B(LL)
          BR1(NFIX) = BR(LL)
          BT1(NFIX) = BT(LL)
          BN1(NFIX) = BN(LL)
          T1(NFIX) = TIME(LL)
          Y(NFIX) = YY
C         WRITE(6,895) I,N0,LL,NFIX,TIME(LL),B(LL),BR(LL),BT(LL),
C    C                 BN(LL)
   12   CONTINUE
C
   20 CONTINUE
      IF (NFIX.LT.5) GO TO 30
C     WRITE(6,890) NMAX,MAXFIX,NFIX,N0
C      DO 22 I = 1,NFIX
C       WRITE(6,902) I,T1(I),B1(I),Y(I)
C  22  CONTINUE
C   COMPUTE NEW AVERAGES FROM CLEANED TIME SERIES
      BAVE = 999.
      BRAVE = 999.
      BTAVE = 999.
      BNAVE = 999.
      CALL ARGUS(B1,A2,DA,IA,1000,NFIX,3.,BAVE,MB1,N999)
      CALL ARGUS(BR1,A2,DA,IA,1000,NFIX,3.,BRAVE,MBR1,N999)
      CALL ARGUS(BT1,A2,DA,IA,1000,NFIX,3.,BTAVE,MBT1,N999)
      CALL ARGUS(BN1,A2,DA,IA,1000,NFIX,3.,BNAVE,MBN1,N999)
      M = MIN0(MB1,MBR1,MBT1,MBN1)
      IF (M.LT.5) GO TO 30
C TIME AVERAGE
      TAV = 0.0
      DO  25 I = 1,M
        TAV = TAV + T1(I)
   25 CONTINUE
      TAV = TAV / M
C WRITE NEW, CLEAN AVERAGES TO INTERMEDIARY MERGE SET
      WRITE(9,900) ISC,TAV,BAVE,BRAVE,BTAVE,BNAVE
C
C       WRITE(6,904) NFIX,M,N999,AVE
C      DO 28 I = 1,NFIX
C       WRITE(6,901) ISC,T1(I),B1(I),BR1(I),BT1(I),BN1(I),
C       WRITE(6,903) I,T1(I),Y(I),A2(I),IA(I),DA(I)
C  28  CONTINUE
   30 CONTINUE
      N0 = LL + 1
      IF (N0.GT.NMAX-1) GO TO 100
      GO TO 10
  100 CONTINUE
      RETURN
  874 FORMAT(' I,LL,NFIX,TIME(LL),B(LL) ',3I5,F12.8,F8.3)
  890 FORMAT(' NMAX,MAXFIX,NFIX,N0 = ',4I10)
  895 FORMAT(4I5,F12.8,4F8.3)
  900 FORMAT(I2,F12.8,4F8.3)
  901 FORMAT(I2,F12.8,4F8.3,3I5)
  902 FORMAT(' BEFORE FIX: T1,B1,Y ',I5,F12.8,2F8.3)
  903 FORMAT(' AFTER FIX: T1,Y,A2,IA,DA ',I5,F12.8,2F8.3,I5,F8.3)
  904 FORMAT(' NFIX,M,N999,AVE = ',3I5,F8.3)
      END
      SUBROUTINE INIT(TIME,B,BR,BT,BN)
      REAL*4 B(1),BR(1),BT(1),BN(1)
      REAL*8 TIME(1)
      DO 10 I = 1,10000
        TIME(I) = 999.
        B(I) = 999.
        BR(I) = 999.
        BT(I) = 999.
        BN(I) = 999.
   10 CONTINUE
      RETURN
      END
      SUBROUTINE AQUIRE(IUNIT,DSN,TIM,B,BR,BT,BN,TDAT0,TBEG,TEND)
C
C  MASS STORE RECORD - FROM SUMMARY TAPES
C
      CHARACTER*4 SC
      CHARACTER*29 DSN
      INTEGER*2 TIME(6),ID
      INTEGER*4 MAX48
      REAL*4 FIN(568),MAG(496),HEADER(32),MSEDR(40)
      REAL*4 B(1),BR(1),BT(1),BN(1),LAM,PLS(150),PSEDR(50)
      REAL*4 F196(5),F296(5),DEL96(5),LAM96(5)
      REAL*4 B196(5),B296(5),B396(5)
      REAL*8 T,TDAT0,TIM(1),DTIME,T96(5),TBEG,TEND
      EQUIVALENCE (FIN(1),HEADER(1)),(FIN(33),MAG(1)),
     C            (HEADER(4),TIME(1)),(HEADER(17),ID),
     C            (HEADER(3),SC),(FIN(529),MSEDR(1)),
     C            (FIN(33),PLS(1)),(FIN(183),PSEDR(1)),
     C            (F196(1),MAG(12)),(F296(1),MAG(17)),
     C            (DEL96(1),MAG(22)),(LAM96(1),MAG(27)),
     C            (B196(1),MAG(32)),(B296(1),MAG(37)),
     C            (B396(1),MAG(42))
C
C   OPEN DATA SET CONTAINING SUMMARY TAPE DATA
C
      WRITE(6,23) IUNIT,DSN
      WRITE(6,89) TBEG,TEND
      OPEN(IUNIT,FILE='/'//DSN,FORM='UNFORMATTED',STATUS='OLD',
     C     ACTION='READ')
      WRITE(6,24) IUNIT,DSN
C
      DEG = 180.0/3.14159
      BLT = 1.38066E-23
      PRTN = 1.67265E-27
   30 CONTINUE
        READ(IUNIT,NUM=LEN,END=100,ERR=30) FIN
        IF (ID.NE.1) GO TO 30
        IF (SC.EQ.'FLT1') ISC = 1
        IF (SC.EQ.'FLT2') ISC = 2
        NYR = TIME(1)
        NDY = TIME(2)
        NHR = TIME(3)
        NMIN = TIME(4)
        ISEC = TIME(5)
        MSEC = TIME(6)
        T = DTIME(NYR,NDY,NHR,NMIN,ISEC,MSEC)
        IF (T.LT.TBEG) GO TO 30
        IF (T.GT.TEND) GO TO 100
        IF (ID.EQ.1) THEN
         IF (MAG(1).LT.0.001) GO TO 30
         IND = MAX48(TDAT0,T) - 1
         IF (IND.LT.1.OR.IND.GT.10000) GO TO 30
         IF (ABS(MAG(5)).GT.0.001) BR(IND) = MAG(5)
         IF (ABS(MAG(6)).GT.0.001) BT(IND) = MAG(6)
         IF (ABS(MAG(7)).GT.0.001) BN(IND) = MAG(7)
         IF (MAG(1).GT.0.001) B(IND) = MAG(1)
         F1 = MAG(1)
         F2 = MAG(2)
         DEL = MAG(3)
         LAM = MAG(4)
         DIST = MSEDR(11)
C
C GET 9.6 SEC AVERAGES
C
C        DO JJ = 1,5
C         JMSEC = MSEC + 9600*(JJ-1)
C         JSEC = ISEC + INT(JMSEC/1000)
C         JMSEC = MOD(JMSEC,1000)
C         JMIN = NMIN + INT(JSEC/60)
C         JSEC = MOD(JSEC,60)
C         JHOUR = NHR + INT(JMIN/60)
C         JMIN = MOD(JMIN,60)
C         JDAY = NDY + INT(JHOUR/24)
C         JHOUR = MOD(JHOUR,24)
C         WRITE(9,91) NYR,NDY,NHR,NMIN,ISEC,MSEC
C         WRITE(9,91) NYR,JDAY,JHOUR,JMIN,JSEC,JMSEC
C         T96(JJ) = DTIME(NYR,JDAY,JHOUR,JMIN,JSEC,JMSEC)
C         WRITE(9,88) ISC,T96(JJ),F196(JJ),B196(JJ),B296(JJ),
C    C                B396(JJ),F296(JJ)
C        END DO
        END IF
C       IF (ID.EQ.3) THEN
C        F1 = PLS(8)
C        F2 = PLS(9)
C        BRAD = PLS(96)
C        BTAN = PLS(97)
C        BNOR = PLS(98)
C        BRT = SQRT(BRAD**2 + BTAN**2)
C        IF (BRT.NE.0.0) THEN
C         DEL = DEG * ATAN(BNOR/BRT)
C         LAM = DEG * ATAN2(BTAN,BRAD)
C         IF (LAM.LT.0.0) LAM = LAM + 360.0
C        ELSE
C         DEL = -99.9
C         LAM = -99.9
C        END IF
C        VEL = PLS(108)
C        VDEL = PLS(109)
C        VLAM = PLS(110)
C        DEN = PLS(52)
C        TEMP = PRTN * (PLS(53)*1000.0)**2 / (2*BLT)
C        DIST = PSEDR(11)
C       END IF
        TIM(IND) = T
C       WRITE(6,28) IND,TIM(IND),B(IND),BR(IND),BT(IND),BN(IND)
C       WRITE(9,29) ISC,T,F1,DEL,LAM,VEL,VDEL,VLAM,
C    C              CR,DEN,TEMP,DIST,F2
      GO TO 30
  100 CONTINUE
      CLOSE(IUNIT)
      WRITE(6,25) IUNIT,DSN
      RETURN
   23 FORMAT(1X,'SUB AQUIRE/PRE-OPEN***UNIT = ',I3.3,' DSN = ',A29)
   24 FORMAT(1X,'SUB AQUIRE/POST-OPEN***UNIT = ',I3.3,' DSN = ',A29)
   25 FORMAT(1X,'SUB AQUIRE/POST-CLOSE***UNIT = ',I3.3,' DSN = ',A29)
   28 FORMAT(1X,I5,F12.8,4F8.3)
   29 FORMAT(I2,F12.8,6F6.2,3E10.4,F5.2,F6.2)
   88 FORMAT(I2,F12.8,5(F6.2))
   89 FORMAT(1X,'TBEG,TEND',2F12.8)
   91 FORMAT(6(1X,I4))
      END
      INTEGER FUNCTION MAX48(TIME1,TIME2)
C
C COMPUTE NUMBER OF 48 SEC AVERAGES IN TIME INTERVAL (TIME1,TIME2)
C
      REAL*8 TIME1,TIME2,LEAP,AVG48
      NYR = IDINT(TIME1)
      LEAP = 365.0D0
      IF (MOD(NYR,4).EQ.0) LEAP = 366.0D0
      AVG48 = (TIME2 - TIME1) * LEAP * 24.0D0 * 3600.0D0 / 48.0D0
      MAX48 = IDINT(AVG48) + 1
      RETURN
      END
      DOUBLE PRECISION FUNCTION DTIME(YR,DY,HR,MIN,SEC,MSEC)
C
C CONVERT INTEGER TIME WORDS (YEAR,DAY,HOUR,MINUTE,SECOND,MILLISEC)
C INTO DECIMAL YEAR
C
      INTEGER*4 YR,DY,HR,MIN,SEC,MSEC
      REAL*8 YEAR,DAY,HOUR,MINUTE,SECOND,MILLISEC,LEAP
      LEAP = 365.0D0
      IF (MOD(YR,4).EQ.0) LEAP = 366.0D0
      MILLISEC = DFLOAT(MSEC)
      SECOND = DFLOAT(SEC) + MILLISEC/1000.0D0
      MINUTE = DFLOAT(MIN) + SECOND/60.0D0
      HOUR = DFLOAT(HR) + MINUTE/60.0D0
      DAY = DFLOAT(DY) - 1.0D0 + HOUR/24.0D0
      YEAR = DFLOAT(YR) + DAY/LEAP
      DTIME = YEAR
      RETURN
      END
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CC                                                         CC
CC  ARGUS : SUBROUTINE WHICH, LIKE THE THE HUNDRED EYED    CC
CC          MONSTER WHICH WAS SENT TO OBSERVE IO, LOOKS    CC
CC          THROUGH THE DATA STRING FOR 'BAD' DATA.        CC
CC          ARGUS TRIES TO MEASUREABLY IMPROVE THE         CC
CC          COMPUTED AVERAGE BY TOSSING OUT, ONE BY ONE,   CC
CC          THE WORST-FITTING POINTS. ARGUS IS HAPPY AND   CC
CC          STOPS THROWING AWAY DATA WHEN THE IMPROVEMENT  CC
CC          IS MINIMAL ( <SDI ,TYPICALLY 2 OR 3 )          CC
CC                                                         CC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      SUBROUTINE ARGUS(A,A2,DA,IA,N,NPTS,SDI,AVE,M,N999)
C
C     A IS THE REAL INPUT ARRAY A(N) WITH NPTS DATA
C     A2 IS A WORK ARRAY OF LENGTH N
C     DA IS A WORK ARRAY OF LENGTH N
C     IA IS AN INTEGER ARRAY OF LENGTH N
C     N IS DIMENSION OF ARRAY A
C     NPTS IS NUMBER OF POINTS IN ARRAY
C     SDI IS THE DESIRED RATIO STD DEVIATION TO MEDIAN DIFF.
C     AVE IS OUTPUT AVERAGE
C     M IS NUMBER OF PTS IN THE AVERAGE
C     N999 IS THE NUMBER OF 999 DATA FILL ENCOUNTERED
C
C
      REAL A(N),A2(N),DA(N)
      INTEGER IA(N)
C
      N2=0
      DO 10 I=1,NPTS
      IA(I)=I
      IF (A(I) .EQ. 999.) GO TO 10
      N2=N2+1
      A2(N2)=A(I)
   10 CONTINUE
C
      N999=NPTS-N2
      IF ( N999 .GT. N2 ) GO TO 999
C
C     HAVE NEW ARRAY OF N2 POINTS WITH NO PESKY 999 FILL DATA
C     HAVE ALSO INITIALIZED THE IA ARRAY TO KEEP TRACK OF PERMUTES
C
      NX = N2
      SDOLD=0.0
C
  100 CONTINUE
C
C     LOOP TO COMPUTE AVERAGE AND STD. DEVIATION OF DATA STRING
C     WRITE(6,21) NX
   21 FORMAT(1H ,' IN AVERAGE LOOP ,NX=',I3)
C
C     ACTUALLY USE THE MEDIAN DATA VALUE INSTEAD OF AVERAGE
C     AND CALCULATE THE DIFFERENCE FROM THE MEDIAN
C     SINCE THE MEDIAN VALUE IS LESS PRONE TO ERROR BY BAD DATA
C
      SUM = 0.0
      DO 20 I=1,NX
      SUM=SUM+A2(I)
      IA(I)=I
      A(I)=A2(I)
   20 CONTINUE
      AVE=SUM/NX
C
C     HERE SORT FOR MEDIAN DATA VALUE
C
      CALL VSRTR(A,NX,IA)
      AMED= ( A(NX/2) + A((NX+1)/2) )/2.
      DSUM=0.0
      DO 30 I=1,NX
      DA(I)=A2(I)-AMED
      DSUM=DSUM+DA(I)**2
      IA(I)=I
   30 CONTINUE
C
C
      SD=SQRT(DSUM/(NX-1))
C
C     SORT ON DIFFERENCE FROM AVERAGE, ( DA ARRAY )
C
C     WRITE(6,22) AVE,SD
   22 FORMAT(1H ,' AVE:',F8.2,'  SD:',F8.2)
C      WRITE(6,23) A,A2,DA,IA
   23 FORMAT(1H ,' PRE-SORT ARRAYS A,A2,DA,IA:'/
     * 10F8.2/10F8.2/10F8.2/10I8)
      CALL VSRTP(DA,NX,IA)
C
C
      DO 40 I=1,NX
      A(I)=A2(I)
   40 CONTINUE
      DO 50 I=1,NX
      IX = IA(I)
      A2(I)=A(IX)
   50 CONTINUE
C      WRITE(6,24) A,A2,DA,IA
   24 FORMAT(1H ,' POST-SORT ARRAYS A,A2,DA,IA:'/
     * 10F8.2/10F8.2/10F8.2/10I8)
C
C     ABOVE SORTED THE DATA ARRAY A ACCORDING TO INCREASING DIFF
C     FROM THE MEDIAN ( THE DA SORT  )
C
   80 CONTINUE
C
      DMED= (DA(NX/2)+DA((NX+1)/2))/2
      IF ( DA(NX) .LT. SDI*DMED ) GO TO 998
   90 CONTINUE
      NX = NX-1
      AVEOLD = AVE
      SDOLD = SD
C
C     IF WEVE GOT DATA LEFT, GO BACK AND RE-AVERAGE WITH 1 LESS
C
      IF (NX .GT. 4) GO TO 100
C
  999 CONTINUE
C
C     HERE IF LOTS OF 999'S ARE ENCOUNTERED
C
      M=0
      RETURN
  998 CONTINUE
C
C     HERE ON COMPLETION (NO FURTHER IMPROVEMENT) OR QUIT
C
      M=NX
      RETURN
      END
//RUN77 EXEC LOADER,REGION=3250K,PARM='SIZE=700K'
//SYSLIB DD DSN=SYS2.IMSLS,DISP=SHR
//SYSUDUMP DD DUMMY
//*T09F001 DD DSN=Z1SBK.HIGHRES.DAT,DISP=OLD
//FT09F001 DD DSN=Z1SBK.MAGHRV2,DISP=MOD
//*T11F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21365,DISP=OLD
//*T12F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21366,DISP=OLD
//*T13F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21367,DISP=OLD
//**T14F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21368,DISP=OLD
//*T15F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21369,DISP=OLD
//*T16F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21370,DISP=OLD
//*T17F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21371,DISP=OLD
//*T18F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21372,DISP=OLD
//*T19F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21373,DISP=OLD
//*T20F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21374,DISP=OLD
//*T21F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21375,DISP=OLD
//*T22F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21376,DISP=OLD
//*T23F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21377,DISP=OLD
//*T24F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21378,DISP=OLD
//*T25F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21379,DISP=OLD
//*T26F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21380,DISP=OLD
//*T27F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21381,DISP=OLD
//*T28F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21382,DISP=OLD
//*T29F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21383,DISP=OLD
//*T30F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21384,DISP=OLD
//*T31F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21385,DISP=OLD
//*T32F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21386,DISP=OLD
//*T33F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21387,DISP=OLD
//*T34F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21388,DISP=OLD
//*T35F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21389,DISP=OLD
//*T36F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21390,DISP=OLD
//SYSUDUMP DD DUMMY
//ABNLDUMP DD DUMMY
// EXEC NTSO
//
//Z1SBKNUL JOB (U0008,N598,20),'VGR FILL FIX',TIME=(1,00),
// MSGCLASS=X,CLASS=A,NOTIFY=Z1SBK
/*JOBPARM LINES=100
//FORT77 EXEC FORTVCLG
C
C MAKE NULL VALUES IN VOYAGER MAG DATA CONFORM TO 0.0 VALUE.
C
      INTEGER*4 IN(35)
      REAL*4 FIN(35)
      EQUIVALENCE(IN(1),FIN(1))
C
      IREAD = 0
      IWRITE = 0
    5 CONTINUE
       READ(10,NUM=LEN,END=100,ERR=5) FIN
       IREAD = IREAD + 1
       IF (IN(1).NE.1.AND.IN(1).NE.2) GOTO 50
C
       IF (FIN(9).LE.0.0.OR.FIN(9).GT.100.0) THEN
        FIN(9) = 0.0
        FIN(10) = 0.0
        FIN(11) = 0.0
        FIN(12) = 0.0
       END IF
C
   50  CONTINUE
       WRITE(11,NUM=N) FIN
       IWRITE = IWRITE + 1
      GO TO 5
  100 CONTINUE
      WRITE(6,*) IREAD,' RECORDS READ BY MEMBER CONFORM'
      WRITE(6,*) IWRITE,' RECORDS WRITTEN BY MEMBER CONFORM'
      STOP
      END
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR
//GO.SYSUDUMP DD DUMMY
//FT10F001 DD DSN=Z1SBK.MSTEMP,DISP=OLD
//FT11F001 DD DSN=Z1SBK.MSPERM,DISP=OLD
//*T11F001 DD VOL=(PRIVATE,,SER=HRBACK),LABEL=(2,NL,,OUT),UNIT=6250,
//*        DCB=(RECFM=FB,LRECL=140,BLKSIZE=12880,DEN=4)
//*T11F001 DD VOL=(PRIVATE,,SER=SBK001),LABEL=(1,AL,,OUT),UNIT=T6250,
//*        DCB=(RECFM=FB,LRECL=80,BLKSIZE=8000,OPTCD=Q,DEN=4)
//TELL EXEC NOTIFY
//
//Z1SBKCPY JOB (U0016,N598,5),'KRAMER',TIME=(1,00),MSGCLASS=X
/*JOBPARM LINES=100
//FORT77 EXEC FORTRAN                                                   00000000
C
C   READ DATA ACQUIRED FROM THE MARK4 DATABASE AND UNFORMAT             00000010
C   FIRST 20 WORDS TO OBTAIN MAG DATA.  PLASMA DATA FOLLOWS
C   FROM WORD 21 ONWARD.  SEE DESCRIPTION OF VOYAGER HOURLY             00000020
C   AVERAGE CARD FORMAT FOR DETAILS.
C   LAST PGM REVISION 12/17/90 SBK
C
C CHECK JCL AT END OF JOB CARD FOR PROPER TAPE IE, SATELLITE SELECTION
C
      CHARACTER*1 FLT
      CHARACTER*2 CSYS
      CHARACTER*80 CFIN
      INTEGER*4 IN(197),RECLEN,DRUN,YRUN                                00000040
      REAL*4 FIN(197)                                                   00000030
      EQUIVALENCE (IN(1),FIN(1))                                        00000060
C
      ISTART = 7220000
      ISTOP = 9200100
C
      IREAD = 0
   10 READ(10,NUM=RECLEN,END=100,ERR=10) CFIN,(FIN(I),I=21,197)         00000070
      READ(CFIN,900) FLT,CSYS,DRUN,YRUN,JX,JY,JZ,IY,ID,IH,F1,DEL,FLA,   00000090
     C               NAV,SIGC,SIGF,SIGR,SIGT,SIGN,F2                    00000100
      IREAD = IREAD + 1
      IF (IREAD.EQ.1) WRITE(6,'('' RECLEN = '',I7.7)') RECLEN
      ITIME = 100000*IY + 100*ID + IH
      IF (ITIME.LT.ISTART) GOTO 10
      IF (ITIME.GE.ISTOP) GOTO 100
C S/C ID 
      IN(1)=ICHAR(FLT)-240                                              00000130
C COORDINATE SYSTEM
      IF (CSYS.EQ.'HG') THEN
       IN(2)=1
      ELSE IF (CSYS.EQ.'S3') THEN
       IN(2)=2
      ELSE IF (CSYS.EQ.'L1') THEN
       IN(2)=3
      ELSE
       IN(2)=0
      END IF
C DAY OF YEAR OF RUN
      IN(3)=DRUN
C LAST DIGIT YEAR OF RUN
      IN(4)=YRUN                                                        00000140
C S/C POSITION VECTORS
      IN(5)=JX                                                          00000150
      IN(6)=JY                                                          00000160
      IN(7)=JZ                                                          00000170
C YEAR OF DATA - 2 DIGITS
      IN(8)=IY                                                          00000180
C CALENDAR DAY OF DATA
      IN(9)=ID                                                          00000190
C HOUR OF DATA
      IN(10)=IH                                                         00000200
C FIELD MAGNITUDE
      FIN(11)=F1                                                        00000210
C FIELD LATITUDINAL ANGLE
      FIN(12)=DEL                                                       00000220
C FIELD LONGITUDINAL ANGLE
      FIN(13)=FLA                                                       00000230
C NUMBER OF 48 SEC AVERAGES
      IN(14)=NAV                                                        00000240
C NORM OF (RMS1,RMS2,RMS3)
      FIN(15)=SIGC                                                      00000250
C STD DEV IN FIELD MAGNITUDE F1
      FIN(16)=SIGF                                                      00000260
C RMS1
      FIN(17)=SIGR                                                      00000270
C RMS2
      FIN(18)=SIGT                                                      00000280
C RMS3
      FIN(19)=SIGN                                                      00000290
C FIELD MODULUS
      FIN(20)=F2                                                        00000300
C OUTPUT DATA IN BINARY FORM
      WRITE(11,NUM=RECLEN) FIN                                          00000310
C SAMPLE OUTPUT DATA (DAILY, HOUR 0)
      IF (IH.EQ.0) WRITE(6,901) FLT,IY,ID,IH,F1,DEL,FLA,JX,JY,JZ,       00000320
     C             FIN(21),FIN(24),FIN(27)                              00000330
      GO TO 10                                                          00000370
  100 CONTINUE
      WRITE(6,'('' # RECORDS READ '',I7.7)') IREAD
      STOP                                                              00000380
  900 FORMAT(A1,A2,I3,I1,3I5,I2,I3,I2,F5.2,2F5.1,I2,F6.3,F5.3,3F6.3,    00000110
     C       F5.2)
  901 FORMAT(1X,A1,I2,I3.3,I2.2,F5.2,2F5.1,3I5,F7.2,F8.4,E10.4)         00000350
      END                                                               00000390
//RUN77 EXEC LOADER,REGION=700K                                         00000400
//SYSUDUMP DD DUMMY
//*T09F001 DD DSN=Z1SBK.TEMP,DISP=OLD
//*T10F001 DD DSN=VOYAGER1.HOURAVG,DISP=SHR,UNIT=6250,LABEL=(,SL,,IN),  00000420
//*           VOL=SER=V1HAVE                                            00000430
//*T11F001 DD DSN=VOYAGER1.HOURAVG,DISP=SHR,UNIT=6250,LABEL=(,SL,,OUT), 00000440
//*     VOL=SER=V1NEW,DCB=(RECFM=FB,LRECL=788,BLKSIZE=31520,DEN=4)      00000450
//FT10F001 DD DSN=VOYAGER2.HOURAVG,DISP=SHR,UNIT=6250,LABEL=(,SL,,IN),  00000420
//            VOL=SER=V2HAVE                                            00000430
//FT11F001 DD DSN=VOYAGER2.HOURAVG,DISP=SHR,UNIT=6250,LABEL=(,SL,,OUT), 00000440
//      VOL=SER=V2NEW,DCB=(RECFM=FB,LRECL=788,BLKSIZE=31520,DEN=4)      00000450
//NOTIFY EXEC NTSO
//
//Z1SBKTCY JOB (U0008,N598,20),'HOURAVG COPY',TIME=(1,00),
// MSGCLASS=X,CLASS=A,NOTIFY=Z1SBK
/*JOBPARM LINES=100
//FORT77 EXEC FORTRAN
C
C   COPY SUBSET OF HOUR AVERAGE DATA SET
C
      INTEGER*4 IN(35)
      REAL*4 FIN(35)
      EQUIVALENCE(IN(1),FIN(1))
C
      ISC = 2
      ISTART = 7723200
      ISTOP = 9400100
      IREC = 0
   10 CONTINUE
       READ(10,NUM=LEN,END=100,ERR=10) FIN
       IF (IN(1).NE.ISC) GOTO 10
       ITIME = IN(2)*100000 + IN(3)*100 + IN(4)
       IF (ITIME.LT.ISTART) GOTO 10
       IF (ITIME.GE.ISTOP) GOTO 100
       WRITE(11,NUM=N) FIN
       IREC = IREC + 1
      GO TO 10
  100 CONTINUE
C     WRITE(6,*) LEN,'  BYTES IN READ RECORD'
C     WRITE(6,*) N,' BYTES IN WRITE RECORD'
      WRITE(6,*) IREC,' RECORDS COPIED BY MEMBER CPYSAT'
      STOP
      END
//RUN EXEC LOADER,REGION=500K
//FT10F001 DD DSN=Z1SBK.HOURAVG2,DISP=OLD
//FT11F001 DD DSN=Z1SBK.MSTEMP,DISP=OLD
//*T11F001 DD DSN=Z1SBK.MSPERM,DISP=MOD
//*T10F001 DD VOL=(PRIVATE,SER=HRBACK),LABEL=(1,NL,,IN),UNIT=T6250,
//*T11F001 DD VOL=(PRIVATE,,SER=HRBACK),LABEL=(1,NL,,OUT),UNIT=6250,
//*T11F001 DD VOL=(PRIVATE,,SER=HRBACK),LABEL=(2,NL,,OUT),UNIT=6250,
//*        DCB=(RECFM=FB,LRECL=140,BLKSIZE=12880,DEN=4)
//*T11F001 DD VOL=(PRIVATE,,SER=SBK001),LABEL=(1,AL,,OUT),UNIT=T6250,
//*        DCB=(RECFM=FB,LRECL=80,BLKSIZE=8000,OPTCD=Q,DEN=4)
//*T11F001 DD DSN=Z1SBK.HOURAVG2,DISP=OLD
//TELL EXEC NTSO
//
//Z1SBKCRX JOB (U0008,N598,10),'CR SPL',TIME=(1,00),MSGCLASS=X,CLASS=A
//FOR77 EXEC FORTRAN
C
C READ PIONEER COSMIC RAY DATA PROVIDED BY JOHN KATON
C
      CHARACTER*80 RECORD
      INTEGER*4 IOUT(35)
      REAL*4 OUT(35)
      EQUIVALENCE(OUT(1),IOUT(1))
C PIONEER 10
      IOUT(1) = 6
C PIONEER 11
C     IOUT(1) = 7
C
      ISTART = 7200100
      ISTOP = 7300100
C     IREAD = 0
C  10 CONTINUE
C      READ(10,'(A)',END=15,ERR=10) RECORD
C      IREAD = IREAD + 1
C     IF (IREAD.LT.3) GOTO 10
C  15 CONTINUE
      IREAD = 0
   20 CONTINUE
       READ(10,*,END=100,ERR=20) ID,IDY,IYR,IHR,CR1,SIG1,CR2,SIG2
       ITIME = IYR*100000 + IDY*100 + IHR
       IF (ITIME.LT.ISTART) GOTO 20
       IF (ITIME.GT.ISTOP) GOTO 100
       IREAD = IREAD + 1
       WRITE(6,*) IREAD,ID,ITIME,CR2,SIG2
C
       IOUT(2) = IYR
       IOUT(3) = IDY
       IOUT(4) = IHR
C
       DO I = 5,35
        OUT(I) = 0.0
       END DO
C
       OUT(29) = CR2
       OUT(30) = SIG2
       WRITE(11,NUM=LEN) OUT
      GOTO 20
  100 CONTINUE
      WRITE(6,'(I5.5,'' RECORDS WRITTEN'')') IREAD
      STOP
      END
//RUN77 EXEC LOADER
//SYSUDUMP DD DUMMY
//FT10F001 DD DSN=Z1SBK.P10CR.DAT,DISP=OLD
//FT11F001 DD DSN=Z1SBK.HOURAVG6,DISP=OLD
//NOTIFY EXEC NOTIFY
//
//Z1SBKTCY JOB (U0008,N598,20),'HOURAVG BACKUP',TIME=(1,00),MSGCLASS=X
/*JOBPARM LINES=100
//FORT77 EXEC FORTRAN
C
C BACKUP 11/21/89 FILE#1
C BACKUP 03/19/90 FILE#2
C BACKUP 01/22/91 FILE#3 FAILED, INSUFFICIENT SPACE
C BACKUP 01/23/91 FILE#1 OVERWRITE
C BACKUP 06/25/91 FILE#1 NEW TAPE
C BACKUP 10/07/91 FILE#2
C BACKUP 11/01/91 FILE#1 OVERWRITE
C BACKUP 11/20/91 FILE#2 OVERWRITE
C BACKUP 01/28/92 FILE#1 NEW TAPE
C
C   COPY HOUR AVERAGE DATA SET TO TAPE
C
         REAL*4 FIN(35)
         IREC = 0
  10     CONTINUE
         READ(10,NUM=LEN,END=100,ERR=10) FIN
         WRITE(11,NUM=N) FIN
         IREC = IREC + 1
         GO TO 10
  100    CONTINUE
C        WRITE(6,*) LEN,'  BYTES IN READ RECORD'
C        WRITE(6,*) N,' BYTES IN WRITE RECORD'
         WRITE(6,*) IREC,' RECORDS COPIED BY MEMBER CPYHRAVG'
         STOP
         END
//RUN EXEC LOADER,REGION=500K
//*T10F001 DD DSN=Z1SBK.MSTRDS,DISP=OLD
//FT10F001 DD VOL=(PRIVATE,SER=HRBACK),LABEL=(1,NL,,IN),UNIT=T6250,
//*T11F001 DD VOL=(PRIVATE,,SER=HRBACK),LABEL=(1,NL,,OUT),UNIT=6250,
//*T11F001 DD VOL=(PRIVATE,,SER=HRBACK),LABEL=(2,NL,,OUT),UNIT=6250,
//         DCB=(RECFM=FB,LRECL=140,BLKSIZE=12880,DEN=4)
//FT11F001 DD DSN=Z1SBK.MSTEMP,DISP=OLD
//TELL EXEC NTSO
//
//Z1SBKFCY JOB (U0008,N598,20),'FORMATTED COPY',TIME=(10,00),           00010050
//         MSGCLASS=X                                                   00020050
/*JOBPARM LINES=100                                                     00030050
//FORT77 EXEC FORTRAN                                                   00040050
C                                                                       00050050
C   COPY FORMATTED DISK DATASET TO TAPE                                 00060050
C                                                                       00070050
      INTEGER*4 IN(7)                                                   00080050
      REAL*4 FIN(8)                                                     00090050
C                                                                       00100050
      IREC = 0                                                          00110050
   10 CONTINUE                                                          00120050
       READ(10,800,END=100,ERR=10) (IN(I),I=1,7),(FIN(J),J=1,8)         00130050
       WRITE(11,800) (IN(I),I=1,7),(FIN(J),J=1,8)                       00140050
       IREC = IREC + 1                                                  00150050
       IF (IREC.EQ.1) WRITE(6,801) (IN(I),I=1,7),(FIN(J),J=1,8)         00160050
      GO TO 10                                                          00170050
  100 CONTINUE                                                          00180050
      WRITE(6,801) (IN(I),I=1,7),(FIN(J),J=1,8)                         00190050
      WRITE(6,*) IREC,' RECORDS COPIED BY MEMBER FCOPY'                 00200050
      STOP                                                              00210050
  800 FORMAT(I1,1X,I2,1X,I3.3,1X,3(1X,I2.2),1X,I3.3,                    00220050
     &       1X,F6.3,2(1X,F5.1),4(1X,F6.3),1X,F8.4)                     00230050
  801 FORMAT(1X,I1,1X,I2,1X,I3.3,1X,3(1X,I2.2),1X,I3.3,                 00240050
     &       1X,F6.3,2(1X,F5.1),4(1X,F6.3),1X,F8.4)                     00250050
      END                                                               00260050
//RUN EXEC LOADER                                                       00270050
//FT10F001 DD DSN=Z1SBK.M20609.DAT,DISP=OLD                             00280050
//FT11F001 DD VOL=(PRIVATE,,SER=MAG192),LABEL=(1,NL,,OUT),UNIT=6250,    00290050
//         DCB=(RECFM=FB,LRECL=80,BLKSIZE=8000),DEN=4                   00300050
//TELL EXEC NOTIFY                                                      00310050
//                                                                      00320050
//Z1SBKCRS JOB (U0016,N598,10),'COSMIC RAY',TIME=(2,00),
// MSGCLASS=X,NOTIFY=Z1SBK
/*JOBPARM LINES=100
//FOR77 EXEC FORTVCLG
C
C READ COSMIC RAY COUNTS/SEC FROM XRPAS (PAM SCHUSTER)                  00000010
C AND APPEND HOUR AVERAGES TO MASTER DATASET                            00000020
C CHECK JOB CARDS AT BOTTOM OF JCL TO SET FOR
C APPROPRIATE DATASET/SATTELITE.
C
      CHARACTER RECORD(132)*1,FILE(132)*1,STRING*132                    00000030
      INTEGER*2 NBIN,NREC,BASEYR                                        00000040
      REAL*8 AVTIME,TIME,DAYS,HOURS                                     00000050
      REAL*4 ATIME,DATA(8),OUT(35)                                      00000060
      INTEGER*4 IOUT(35)/35*0/                                          00000070
      EQUIVALENCE (OUT(1),IOUT(1))                                      00000090
      EQUIVALENCE (RECORD(1),NBIN),(FILE(31),NREC),                     00000100
     &            (RECORD(5),ATIME),(RECORD(13),BASEYR),                00000110
     &            (RECORD(1),DATA(1)),(RECORD(1),TIME),                 00000120
     &            (RECORD(1),STRING)
C
      ISTART = 9300100
      ISTOP = 9500100
      IREAD = 0                                                         00000200
   10 CONTINUE                                                          00000210
       READ(20,NUM=LEN,END=100,ERR=10) RECORD                           00000220
       IREAD = IREAD + 1                                                00000230
   15  CONTINUE
       IF (IREAD.EQ.1 ) READ(21,NUM=IREC,END=100,ERR=15) FILE
       AVTIME = ATIME
       IF ( IREAD .EQ. 1 ) WRITE(6,900) NBIN,NREC,AVTIME,BASEYR         00000240
       IF ( IREAD .EQ. 1 ) IY = BASEYR -  INT(BASEYR/100.) * 100        00000250
       IF ( IREAD .EQ. 2 ) THEN                                         00000260
        WRITE(6,901) (RECORD(K),K=1,12)                                 00000260
C
C DETERMINE S/C ID
C
        IF ( STRING(1:3).EQ.'IMP' ) THEN
         IOUT(1) = 0
        ELSE IF ( STRING(1:9).EQ.'VOYAGER-1' ) THEN
         IOUT(1)=1
        ELSE IF ( STRING(1:9).EQ.'VOYAGER-2' ) THEN
         IOUT(1)=2
        ELSE IF ( STRING(1:10).EQ.'PIONEER-10' ) THEN
         IOUT(1)=6
        ELSE IF ( STRING(1:10).EQ.'PIONEER-11' ) THEN
         IOUT(1)=7
        ELSE
         WRITE(6,*) 'INVALID S/C NAME'
         STOP
        END IF
       END IF
       IF ( 2 .LT. IREAD .AND. IREAD .LE. 3-NBIN+2 ) THEN               00000270
        WRITE(6,902) (RECORD(K),K=4,130)                                00000280
       END IF
       IF ( IREAD .LE. 3-NBIN+2 ) GO TO 10                              00000290
       CALL DATEN(IY,TIME,IYEAR,ID,IH)                                  00000300
       IT = IYEAR*100000 + ID*100 + IH
       IF ( IT .LT. ISTART ) GO TO 10
       IF ( IT .GE. ISTOP ) GO TO 100
       IOUT(2) = IYEAR                                                  00000310
       IOUT(3) = ID                                                     00000320
       IOUT(4) = IH                                                     00000330
       DO 20 I = 5,35                                                   00000340
        OUT(I) = 0.0                                                    00000350
   20  CONTINUE                                                         00000360
       IF( DATA(3) .GT. 0.001 ) OUT(27) = DATA(3)                       00000370
       IF( DATA(4) .GT. 0.001 ) OUT(28) = DATA(4)                       00000380
       IF( DATA(5) .GT. 0.001 ) OUT(29) = DATA(5)                       00000390
       IF( DATA(6) .GT. 0.001 ) OUT(30) = DATA(6)                       00000400
       IF( DATA(3) .LT. 0.001 .AND. DATA(5) .LT. 0.001 ) GO TO 10       00000410
       WRITE(11,NUM=N) OUT                                              00000420
       WRITE(6,905) IOUT(1),IYEAR,ID,IH,DATA(3),DATA(4),
     &               DATA(5),DATA(6)
      GO TO 10                                                          00000450
  100 CONTINUE                                                          00000460
      STOP                                                              00000470
  900 FORMAT(I6,I6,F12.0,I6)                                            00000480
  908 FORMAT(I2,I3,I4,I3,4E10.3)                                        00000490
  901 FORMAT(2X,12A1)                                                   00000500
  902 FORMAT(2X,127A1)                                                  00000510
  903 FORMAT(I2,I3,I4,I3,4F8.3)                                         00000520
  905 FORMAT(1X,I2,1X,I2,1X,I3.3,1X,I2.2,4(1X,E10.4))
      END                                                               00000530
      SUBROUTINE DATEN(IYR,TSEC,JYR,JDAY,JHR)                           00000540
      REAL*8 TSEC,USEC,YR,YRL,SECD                                      00000550
      YR = 86400.*365.                                                  00000560
      YRL = 86400.*366.                                                 00000570
      USEC = TSEC                                                       00000580
      KYR = IYR                                                         00000590
   10 IF( MOD(KYR,4) .EQ. 0 ) GO TO 1                                   00000600
      IF( USEC .GE. YR ) GO TO 2                                        00000610
      JYR = KYR                                                         00000620
      GO TO 3                                                           00000630
    2 KYR = KYR + 1                                                     00000640
      USEC = USEC -YR                                                   00000650
      GO TO 10                                                          00000660
    1 IF( USEC .GE. YRL ) GO TO 4                                       00000670
      JYR = KYR                                                         00000680
      GO TO 3                                                           00000690
    4 KYR = KYR + 1                                                     00000700
      USEC = USEC - YRL                                                 00000710
      GO TO 10                                                          00000720
    3 JDAY = INT(USEC/86400.) + 1                                       00000730
      SECD = USEC - DFLOAT(JDAY-1) * 86400.                             00000740
      JHR = INT(SECD/3600.)                                             00000750
      RETURN                                                            00000760
      END                                                               00000770
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR                             00000780
//GO.SYSUDUMP DD DUMMY
//*T20F001 DD DSN=XRPAS.I8BUR10A,DISP=OLD
//*T21F001 DD DSN=XRPAS.I8BUR10,DISP=OLD
//*T20F001 DD DSN=XRPAS.V1BUR9A,DISP=OLD                                00000790
//*T21F001 DD DSN=XRPAS.V1BUR9,DISP=OLD
//*T20F001 DD DSN=XRPAS.V2BUR17A,DISP=OLD
//*T21F001 DD DSN=XRPAS.V2BUR17,DISP=OLD
//FT20F001 DD DSN=SB#VG.V1BUR94A,DISP=OLD
//FT21F001 DD DSN=SB#VG.V1BUR94,DISP=OLD
//*T11F001 DD DSN=Z1SBK.MSPERM,DISP=MOD                                 00000860
//FT11F001 DD DSN=Z1SBK.HOURAVG,DISP=OLD                                00000860
//*T12F001 DD DSN=Z1SBK.TEMP,DISP=OLD
// EXEC NOTIFY
//
//Z1SBKHRD JOB (U0016,N598,10),'READ HOUR AVGS',TIME=(0,30),
// MSGCLASS=X,CLASS=A,NOTIFY=Z1SBK
/*JOBPARM LINES=200
//FORTRAN EXEC FORTVCLG
C
C READ BINARY HOUR AVERAGE DATA SET AND OUTPUT DESIRED ASCII SUBSET
C
      REAL*8 TIME,DAY
      REAL*4 FIN(35),LAM
      INTEGER*4 IN(35)
      EQUIVALENCE (IN(1),FIN(1))
C
      CON = 3.14159 / 180.0
      DIST1 = 0.0
      DIST2 = 100.0
      IT0 = 7700100
      IT1 = 9500100
      ISC = 2
      IREAD = 0
   10 CONTINUE
      READ(10,NUM=LEN,END=100,ERR=10) FIN
       IF (IN(1).NE.ISC) GO TO 10
       IT = IN(2)*100000 + IN(3)*100 + IN(4)
C
C SELECT BY TIME TAG
C
       IF (IT.LT.IT0) GO TO 10
       IF (IT.GE.IT1) GO TO 100
C
C SELECT BY DISTANCE
C
       IF (FIN(8).LT.DIST1) GOTO 10
       IF (FIN(8).GE.DIST2) GOTO 100
C
       IREAD = IREAD + 1
C      IF (IREAD.EQ.1000) GOTO 100
       FILL = 0.0
       FILL2 = 0.0
       VLAM = FILL2
       VDEL = FILL2
       LAM = FILL2
       DEL = FILL2
       F1 = FILL2
       F2 = FILL2
       BR = FILL2
       BT = FILL2
       BN = FILL2
       RMSC = FILL2
       RMSF1 = FILL2
       RMSBR = FILL2
       RMSBT = FILL2
       RMSBN = FILL2
       VR = FILL2
       VT = FILL2
       VN = FILL2
       SPEED = FILL2
       CRCNT1 = FILL2
       CRCNT2 = FILL2
       DEN = FILL2
       TEMP = FILL2
       X = FILL2
       Y = FILL2
       Z = FILL2
       R = FILL2
C OBTAIN MAGNETIC FIELD PARAMETERS
       IF (.001 .LT. FIN(9) .AND. FIN(9) .LT. 100.0) THEN
        F1 = FIN(9)
C LONGITUDINAL FIELD ANGLES
        IF (0.0 .LE. FIN(12) .AND. FIN(12) .LE. 360.0) LAM = FIN(12)
C LATITUDINAL FIELD ANGLE
        IF (-90.0 .LE. FIN(11) .AND. FIN(11) .LE. 90.0) DEL = FIN(11)
C NORM OF COMPONENT RMS'S ***VOYAGER ONLY***
        RMSC = FIN(22)
C FIELD MAG RMS              "          "
        RMSF1 = FIN(23)
C RADIAL COMP RMS            "          "
        RMSBR = FIN(24)
C TANGENTIAL COMP RMS        "          "
        RMSBT = FIN(25)
C NORMAL COMP RMS            "          "
        RMSBN = FIN(26)
       END IF
C FIELD MODULUS AND COMPS
       IF (.001.LT.FIN(10).AND.FIN(10).LT.100.0
     &     .AND.-90.0.LE.FIN(11).AND.FIN(11).LE.90.0
     &     .AND.0.0.LE.FIN(12).AND.FIN(12).LE.360.0) THEN
        F2 = FIN(10)
        BR = FIN(10) * COS(FIN(12)*CON) * COS(FIN(11)*CON)
        BT = FIN(10) * SIN(FIN(12)*CON) * COS(FIN(11)*CON)
        BN = FIN(10) * SIN(FIN(11)*CON)
       END IF
   20  CONTINUE
C COMPUTE VELOCITY COMPONENTS
       IF (200.0.LT.FIN(13).AND.FIN(13).LT.1500.0) THEN
        SPEED = FIN(13)
        VR = FIN(13) * COS(FIN(15)*CON) * COS(FIN(14)*CON)
        VT = FIN(13) * SIN(FIN(15)*CON) * COS(FIN(14)*CON)
        VN = FIN(13) * SIN(FIN(14)*CON)
C OBTAIN FLOW DIRECTION ANGLES
        IF ( -90.0.LE.FIN(14).AND.FIN(14).LE.90.0 ) VDEL = FIN(14)
        IF ( -180.0.LE.FIN(15).AND.FIN(15).LE.180.0 ) VLAM = FIN(15)
       ENDIF
   30  CONTINUE
C OBTAIN SPACECRAFT COORDINATES
       IF ( 0.0.LT.FIN(8).AND.FIN(8).LT.100.0) THEN
        X = FIN(5)
        Y = FIN(6)
        Z = FIN(7)
        R = FIN(8)
       ELSE IF (IN(1).EQ.0) THEN
        R = 1.0
       END IF
C PLASMA DATA
C      IF (1.0E-4.LT.FIN(16).AND.FIN(16).LT.1.0E3) DEN = FIN(16)
C      IF (1.0E3.LT.FIN(17).AND.FIN(17).LT.1.0E7) TEMP = FIN(17)
       IF (0.0.LT.FIN(16).AND.FIN(16).LT.1.0E3) DEN = FIN(16)
       IF (0.0.LT.FIN(17).AND.FIN(17).LT.1.0E7) TEMP = FIN(17)
C ISEE ELECTRONS
C      DENEL = -.999
C      IF (FIN(20).GT.0.001.AND.FIN(20).LT.100.0) DENEL = FIN(20)
       DENEL = FIN(20)
       VELEL = FIN(19)
       TEMEL = FIN(21)
C COSMIC RAY COUNTS AND RMS'S
       IF (FIN(27).GT.0.0.AND.FIN(27).LT.10.0) CRCNT1 = FIN(27)
       IF (FIN(27).GT.0.0.AND.FIN(27).LT.10.0) CRSIG1 = FIN(28)
       IF (FIN(29).GT.0.0.AND.FIN(29).LT.10.0) CRCNT2 = FIN(29)
       IF (FIN(29).GT.0.0.AND.FIN(29).LT.10.0) CRSIG2 = FIN(30)
C KP FROM IMP TAPE
       KP = IN(34)
C ALPHA/PROTON RATIOS
       TALPHA = -99.
       DENA = -.999
       VALPHA = -99.9
       IF (ABS(FIN(33)).GT.10.0**3.0) TALPHA = FIN(33)
C ALPHA/PROTON DENSITY RATIO
       IF (FIN(32).GT.1.0E-5.AND.DEN.GT.1.0E-3.AND.FIN(32)
     &    .LT.1.0E1.AND.DEN.LT.1.0E2) DENA = FIN(32)/DEN
C ALPHA/ELECTRON DENSITY RATIO
       DENAEL = -.999
       IF (FIN(32).GT.1.0E-5.AND.FIN(32).LT.10.0.AND.
     &     DENEL.GT.0.001) DENAEL = FIN(32)/DENEL
       IF (200.0.LT.FIN(31).AND.FIN(31).LT.1000.0) VALPHA=FIN(31)
C COMPUTE TIME IN DECIMAL DAY
       DECDAY = REAL(IN(3)) + REAL(IN(4))/24.0
C COMPUTE TIME IN DECIMAL YEAR
       DAY = 365.D0
       IF (MOD(IN(2),4).EQ.0) DAY = 366.D0
       TIME = DBLE(IN(2))+DBLE(IN(3)-1.0D0+DBLE(IN(4))/24.0D0)/DAY
C OUTPUT DATA
C      WRITE(11,912) IN(1),(IN(I),I=2,4),F1,F2,DEL,LAM,BR,BT,BN,R
C      WRITE(11,913) IN(1),TIME,F1,DEL,LAM,SPEED,VDEL,VLAM,
C    &               CRCNT1,DEN,TEMP,R
C      WRITE(11,914) IN(1),TIME,F1,DEL,LAM,SPEED,VDEL,VLAM,
C    &               CRCNT1,DEN,TEMP,R,F2
C      WRITE(11,915) IN(1),TIME,BR,BT,BN,VR,VT,VN,DEN,TEMP
C      WRITE(11,920) IN(1),TIME,F1,DEL,LAM,X,Y,Z,R
C      WRITE(11,925) IN(1),IN(2),IN(3),IN(4),DECDAY,R,F1,BR,BT,BN,
C    &               F2,SPEED,VR,VT,VN,TEMP,DEN
C      WRITE(11,926) IN(1),IN(2),IN(3),IN(4),F1,F2
C      WRITE(11,NUM=L) FIN(1),FIN(2),FIN(3),FIN(4),SPEED,F1,X,Y,Z,R
C      WRITE(11,927) IN(1),IN(2),IN(3),IN(4),SPEED,F1,X,Y,Z,R,CRCNT1
C      WRITE(11,928) IN(1),TIME,F1,DEL,LAM,SPEED,VDEL,VLAM,
C    &               CRCNT1,DEN,TEMP,R,F2
       WRITE(06,929) IN(1),TIME,F1,DEL,LAM,SPEED,VDEL,VLAM,
     &               CRCNT1,DEN,TEMP,X,Y,Z,F2
C      WRITE(11,929) IN(1),TIME,F1,DEL,LAM,VELEL,VDEL,VLAM,
C    &               CRCNT1,DENEL,TEMEL,X,Y,Z,F2
C      WRITE(11,930) (IN(I),I=1,4),F1,DEL,LAM,R
C      WRITE(11,931) IN(1),TIME,F1,DEL,LAM,RMSC,RMSF1,
C    &               RMSBR,RMSBT,RMSBN,X,Y,Z,F2
C      WRITE(11,932) (IN(I),I=1,4),(FIN(J),J=9,12)
C      WRITE(11,933) IN(1),TIME,F1,DEL,LAM,BR,BT,BN,F2,R
C      WRITE(11,934) (IN(I),I=1,4),F1,DEL,LAM,BR,BT,BN,F2,X,Y,Z,R
C      WRITE(11,935) IN(1),TIME,F1,DEL,LAM,SPEED,DEN,TEMP,R
C      WRITE(11,936) (IN(I),I=1,4),F1,DEL,LAM,SPEED,DEN,TEMP,R
C      WRITE(11,937) IN(1),TIME,F1,F2,DEL,LAM,BR,BT,BN,
C    &               SPEED,VDEL,VLAM,VR,VT,VN,DEN,TEMP
C      WRITE(11,950) (IN(I),I=1,4),F2,BR,BT,BN,
C    &               SPEED,VR,VT,VN,DEN,TEMP,CRCNT1
C      WRITE(6,951) (IN(I),I=1,4),(FIN(I),I=9,12),FIN(13),FIN(16),
C    &  FIN(17)
C      WRITE(11,952) (IN(I),I=1,4),(FIN(I),I=5,12)
      GO TO 10
  100 CONTINUE
      WRITE(6,'(1X,''RECORDS PROCESSED: '',I6.6)') IREAD
      STOP
  912 FORMAT(1X,I1,1X,I2,1X,I3,1X,I2,2(1X,F5.2),2(1X,F5.1),3(1X,F6.2),
     &       1X,F8.4)
  913 FORMAT(I2,F12.8,6F6.2,3E10.4,F5.2)
  914 FORMAT(I2,F12.8,6F6.2,3E10.4,F5.2,F6.2)
  915 FORMAT(I2,F12.8,3F6.3,3F8.3,F8.4,E10.4)
  920 FORMAT(I2,F12.8,F5.2,2F5.1,4F6.3)
  925 FORMAT(I2,1X,I2,1X,I3.3,1X,I2.2,1X,F8.4,12(1X,E10.4))
  926 FORMAT(I2,1X,I2,1X,I3.3,1X,I2.2,2(1X,F6.2))
  927 FORMAT(I1,I2,I3.3,I2.2,F7.2,F6.2,4F8.4,F6.2)
  928 FORMAT(I1,1X,F11.8,1X,F5.2,2(1X,F5.1),1X,F7.2,
     C       2(1X,F5.1),1X,F5.2,2(1X,E10.4),1X,F8.4,1X,F5.2)
  929 FORMAT(1X,I1,1X,F11.8,1X,F7.3,2(1X,F5.1),1X,F7.2,
     C       2(1X,F5.1),1X,F7.3,2(1X,E10.4),3(1X,F8.4),1X,F7.3)
  930 FORMAT(I1,1X,I2,1X,I3.3,1X,I2.2,1X,F5.2,2(1X,F5.1),
     C       1X,F8.4)
  931 FORMAT(I1,1X,F11.8,1X,F5.2,2(1X,F5.1),1X,F6.3,1X,F5.3,
     C       3(1X,F6.3),3(1X,F8.4),1X,F5.2)
  932 FORMAT(1X,I1,1X,I2,1X,I3.3,1X,I2.2,2(1X,F5.2),2(1X,F5.1))
  933 FORMAT(I1,1X,F11.8,1X,F7.3,2(1X,F5.1),3(1X,F7.3),1X,F7.3,1X,F8.4)
  934 FORMAT(I1,1X,I2,1X,I3,1X,I2,1X,F5.2,2(1X,F5.1),3(1X,F6.2),1X,F5.2,
     C       4(1X,F8.4))
  935 FORMAT(I1,1X,F11.8,1X,F5.2,1X,2(1X,F5.1),1X,F7.2,2(1X,E10.4),
     C       1X,F8.4)
  936 FORMAT(I1,1X,I2,1X,I3.3,1X,I2.2,1X,F5.2,1X,2(1X,F5.1),1X,F7.2,
     C       2(1X,E10.4),1X,F8.4)
  937 FORMAT(I1,1X,F11.8,2(1X,F6.3),2(1X,F5.1),3(1X,F7.3),
     &       1X,F6.1,2(1X,F5.1),3(1X,F7.1),2(1X,E10.4))
  950 FORMAT(I1,1X,I2,1X,I3.3,1X,I2.2,1X,F7.3,3(1X,F8.3),
     &       1X,F7.2,3(1X,F8.2),2(1X,E10.4),1X,F5.2)
  951 FORMAT(1X,I1,1X,I2,1X,I3.3,1X,I2.2,4(1X,F7.3),1X,F6.1,2(1X,E10.4))
  952 FORMAT(1X,I1,1X,I2,1X,I3,1X,I2,4(1X,F8.4),2(1X,F5.2),2(1X,F5.1))
      END
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR
//GO.SYSUDUMP DD DUMMY
//* INPUT DATA
//*T10F001 DD DSN=Z1SBK.HOURAVG2,DISP=OLD
//FT10F001 DD DSN=Z1SBK.MSPERM,DISP=OLD
//*T10F001 DD VOL=SER=(PRIVATE,,SBK001),LABEL=(1,NL,,OUT),UNIT=6250,
//*        DCB=(RECFM=FB,LRECL=140,BLKSIZE=12880,DEN=4)
//* OUTPUT DATA
//*T11F001 DD DSN=Z1SBK.V290.DAT,SPACE=(TRK,(200,5),RLSE),
//*           DCB=(RECFM=VBA,LRECL=132,BLKSIZE=6600),
//*           UNIT=TEMPDA,DISP=(NEW,CATLG)
//*T11F001 DD DSN=Z1SBK.P10T.DAT,DISP=OLD
//*T11F001 DD DSN=WBYCW.LIB.CLIST(DATA),DISP=OLD
//NOTIFY EXEC NOTIFY
//
//Z1SBKHDR JOB (U0016,N598,15),'HDR1 READ',TIME=(2,00),CLASS=N,         00010099
// MSGCLASS=X,NOTIFY=Z1SBK                                              00020099
/*JOBPARM LINES=200                                                     00030099
// EXEC FORTVCLG                                                        00050099
C                                                                       00060099
C WRITTEN BY SANDY KRAMER, 07/93.                                       00070099
C READS HDR RECORD FROM SUMMARY TAPE.                                   00080099
C                                                                       00150099
      CHARACTER*4 FLT,TELFMT,DATAID,SCTIME                              00160099
      CHARACTER*8 DATCON                                                00161099
      CHARACTER*29 DSN                                                  00170099
      INTEGER*2 TIME(6),DATATYPE(2),RECDAT(2),                          00180099
     &          MODCNT(2),LINECNT(2),WORDS(4)                           00181099
      LOGICAL*1 MAGSYS(32),EDRSYS(32)                                   00181199
      LOGICAL*4 STATWRD,COMMWRD                                         00182099
      REAL*4 FIN(568),HEADER(32),HDR1(100)                              00190099
      REAL*8 DECDAY,ELPSTIME                                            00201099
      EQUIVALENCE (FIN(1),HEADER(1)),                                   00210099
     &            (HEADER(1),DATAID),       (HEADER(2),TELFMT),         00211099
     &            (HEADER(3),FLT),          (HEADER(4),TIME(1)),        00211199
     &            (HEADER(7),DECDAY),       (HEADER(9),ELPSTIME),       00211299
     &            (HEADER(11),SCTIME),      (HEADER(12),TIMEPD),        00212099
     &            (HEADER(13),MODCNT(1)),   (HEADER(14),LINECNT(1)),    00212199
     &            (HEADER(15),STATWRD),     (HEADER(16),COMMWRD),       00212299
     &            (HEADER(17),DATATYPE(1)), (HEADER(19),DATCON),        00212399
     &            (HEADER(30),WORDS(1)),    (HEADER(32),RECDAT(1)),     00220099
     &            (HDR1(1),FIN(1)),         (HDR1(69),EDRSYS(1)),       00231099
     &            (HDR1(77),MAGSYS(1))                                  00232099
C                                                                       00240099
C   OPEN DATA SET CONTAINING SUMMARY TAPE DATA                          00250099
C                                                                       00260099
C     OPEN(IUNIT,FILE='/'//DSN,FORM='UNFORMATTED',STATUS='OLD',         00270099
C    C     ACTION='READ')                                               00280099
C                                                                       00300099
C                                                                       00370099
C SPECIFY START AND STOP TIMES (YYDDDHH)                                00380099
C                                                                       00390099
      ISTART = 7724000                                                  00400099
      ISTOP = 9300100                                                   00410099
      IND = 0                                                           00420099
   30 CONTINUE                                                          00430099
        READ(10,NUM=LEN,END=100,ERR=30) FIN                             00440099
        IF (DATATYPE(1).NE.8) GO TO 30                                  00461099
        READ(FLT,'(3X,I1)') ISC                                         00480099
        NYR = TIME(1)                                                   00490099
        NDY = TIME(2)                                                   00500099
        NHR = TIME(3)                                                   00510099
        NMIN = TIME(4)                                                  00520099
        NSEC = TIME(5)                                                  00530099
        MSEC = TIME(6)                                                  00540099
        ITIME = NYR*100000+NDY*100+NHR                                  00560099
        IF (ITIME.LT.ISTART) GOTO 30                                    00570099
        IF (ITIME.GE.ISTOP) GOTO 100                                    00580099
        WRITE(6,800) TIME,DATAID,TELFMT,FLT,SCTIME,                     00590099
     &               '12345678901234567890123456789012',                00591099
     &                EDRSYS,MAGSYS                                     00600099
      GO TO 30                                                          00890099
  100 CONTINUE                                                          00900099
C     CLOSE(IUNIT)                                                      00910099
      STOP                                                              00930099
  800 FORMAT(6(1X,I3),4(1X,A4)/,                                        00940099
     &       1X,A32/                                                    00950099
     &       1X,32L1/,                                                  00960099
     &       1X,32L1)                                                   00961099
      END                                                               00970099
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR                             01601099
//GO.SYSUDUMP DD DUMMY                                                  01610099
//*T09F001 DD DSN=Z1SBK.V178A.MAG,DISP=OLD                              01620099
//*T09F001 DD DSN=Z1SBK.VTEMP.MAG,SPACE=(TRK,(400,15),RLSE),            01630099
//*        DCB=(RECFM=FB,LRECL=100,BLKSIZE=8000),                       01640099
//*        UNIT=TEMPDA,DISP=(NEW,CATLG)                                 01650099
//*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.M91152,DISP=OLD                 01650199
//FT10F001 DD DSN=U0#16.UNITTREE.V2.D9135100,DISP=OLD                   01650299
//*T10F001 DD DSN=U0#16.VOYAGER.SECOND.M91261,DISP=OLD                  01651099
//*T10F001 DD DSN=U0#16.MASS.COPY.M21308,DCB=(RECFM=U,LRECL=11280),     01660099
//*        DISP=OLD                                                     01670099
//*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21308,                         01690099
//*        DISP=OLD,UNIT=T3480,VOL=SER=289151,                          01700099
//*        DCB=(RECFM=VB,LRECL=5000,BLKSIZE=32760),                     01710099
//*        LABEL=(1,SL,,IN)                                             01720099
//TELL EXEC NOTIFY                                                      01730099
//                                                                      01740099
//Z1SBKHE2 JOB (U0008,N598,10),'HELIOS',TIME=(2,00),MSGCLASS=X
/*JOBPARM LINES=100
//FORT77 EXEC FORTRAN
C
C HELIOS (GERMAN)                                                       00000020
C ORIGINAL TAPE WAS FROM LINDAU                                         00000030
C THIS TAPE WAS MODIFIED BY NSSDC
C
C SET JCL AT BOTTOM OF JOB CARD FOR APPROPRIATE SATELLITE
C FILE 1 = DOCUMENTATION, FILE 2 = HELIOS 1, FILE 3 = HELIOS 2
C
      CHARACTER*4 SC
      INTEGER*4 IN(30),IOUT(35)                                         00000050
      REAL*4 FIN(30),OUT(35),LAM                                        00000040
      EQUIVALENCE (FIN(1),IN(1)),(OUT(1),IOUT(1))                       00000060
      EQUIVALENCE(SC,FIN(1))
C
      ISTART = 7400100
      ISTOP = 8100100
      IREAD = 0
      IWRITE = 0
C                                                                       00000090
   20 CONTINUE                                                          00000100
      DO 10 I=1,35                                                      00000110
       OUT(I) = 0.0                                                     00000120
   10 CONTINUE                                                          00000130
       READ(10,NUM=LEN,END=100,ERR=20) FIN                              00000140
       IREAD = IREAD + 1
C      IF (IREAD.GT.100) GOTO 100
C
       IF (SC.EQ.' HE1') THEN
        IOUT(1) = 3
       ELSE IF (SC.EQ.' HE2') THEN
        IOUT(1) = 4
       ELSE
        IOUT(1) = -1
        WRITE(6,*) 'BAD S/C ID'
       END IF
C YEAR
       IOUT(2) = INT(FIN(3))                                            00000150
C DAY
       IOUT(3) = INT(FIN(4))                                            00000160
C HOUR
       IOUT(4) = INT(FIN(5))                                            00000170
C
       ITIME = IOUT(2)*100000 + IOUT(3)*100 + IOUT(4)
C      IF (ITIME.LT.ISTART) GO TO 20
C      IF (ITIME.GE.ISTOP) GO TO 100
C RADIAL DISTANCE
       OUT(8) = FIN(7)                                                  00000180
C FIELD MAGNITUDE
       IF (FIN(15).LT.0.001.OR.FIN(15).GT.250.0) GO TO 25               00000230
       OUT(9) = FIN(15)                                                 00000190
C FIELD COMPONENTS
       BXSE = FIN(12)
       BYSE = FIN(13)
       BZSE = FIN(14)
C FIELD MODULUS
       OUT(10) = SQRT(BXSE**2+BYSE**2+BZSE**2)                          00000240
C FIELD LATITUDINAL ANGLE (DELTA)
       OUT(11) = FIN(28)                                                00000250
C FIELD LONGITUDINAL ANGLE (LAMBDA)
       OUT(12) = FIN(29) - 180.0                                        00000260
       IF (OUT(12).LT.0.0) OUT(12) = OUT(12) + 360.0                    00000270
  25  CONTINUE                                                          00000280
C BULK SPEED
       IF (FIN(20).GT.1200.0) FIN(20) = 0.0                             00000290
       OUT(13) = FIN(20)                                                00000300
C LATITUDINAL FLOW ANGLE
       OUT(14) = FIN(26)                                                00000320
C LONGITUDINAL FLOW ANGLE
       OUT(15) = FIN(27)                                                00000330
C ION DENSITY
       IF (FIN(22).GT.1000.0) FIN(22) = 0.0                             00000310
       OUT(16) = FIN(22)                                                00000340
C ION TEMPERATURE
       OUT(17) = FIN(21) * 1000.0                                       00000350
C
       IF (ISC.NE.-1) THEN
        WRITE(11,NUM=N) OUT                                             00000430
        IWRITE = IWRITE + 1
       END IF
C
       ISC = IOUT(1)
       IYR = IOUT(2)
       IDY = IOUT(3)
       IHR = IOUT(4)
       F1 = OUT(9)
       F2 = OUT(10)
       DEL = OUT(11)
       LAM = OUT(12)
       VEL = OUT(13)
       VDEL = OUT(14)
       VLAM = OUT(15)
       DEN = OUT(16)
       TEMP = OUT(17)
       DIST = OUT(8)
       IF (ISC.NE.-1.AND.IHR.EQ.0) THEN
        WRITE(6,900) SC,ISC,IYR,IDY,IHR,F1,F2,DEL,LAM,
     C               VEL,VDEL,VLAM,DEN,TEMP,DIST
       END IF
      GO TO 20                                                          00000440
  100 CONTINUE
      WRITE(6,'(1X,''RECORDS READ:  '',I5.5)') IREAD
      WRITE(6,'(1X,''RECORDS WRITTEN:  '',I5.5)') IWRITE
      STOP                                                              00000450
  900 FORMAT(A4,I2,3I3,2F8.2,2F5.1,F6.0,2F5.1,F8.4,E10.4,F6.2)
      END                                                               00000460
//RUN77 EXEC LOADER,REGION=500K                                         00000470
//FT10F001 DD LABEL=(3,NL,,IN),DCB=(RECFM=FB,LRECL=120,BLKSIZE=12000,   00000480
//     DEN=3),UNIT=6250,VOL=SER=HELIOS                                  00000490
//FT11F001 DD DSN=Z1SBK.MSTRDS,DISP=MOD                                 00000500
// EXEC NTSO
//
//Z1SBKETN JOB (U0016,N598,15),'HIGH RES',TIME=(2,00),CLASS=N,          00010099
// MSGCLASS=X,NOTIFY=Z1SBK                                              00020099
/*JOBPARM LINES=100                                                     00030099
//*EXEC FORTRAN                                                         00040099
// EXEC FORTVCLG                                                        00050099
C                                                                       00060099
C WRITTEN BY SANDY KRAMER, 06/93.                                       00070099
C READS ELETRON RECORD FROM SUMMARY TAPE.  NEED TO MODIFY DATA ID       00080099
C PARAMETER TO SPECIFY E1 (IMODE=4) OR E2 (IMODE=6).                    00090099
C FIND APPROPRIATE SUMARRY TAPE IN U0#16.VOYAGER.SUMMARY.INDEX          00100099
C DETERMINE VOLUME USING ISPF 3.4 UTILITY                               00110099
C GET FILE NUMBER BY RUNNING FATAR SCAN ON VOLUME                       00120099
C SEE 1ST REVISION (JUNE 1978) OF "COMMONLY USED DIGITAL TAPE,          00121099
C DISK AND CARD FORMATS" FOR COMPLETE DESCRIPTION OF ELECTRON           00122099
C SUMMARY DATA.                                                         00123099
C                                                                       00130099
      CHARACTER*4 FLT                                                   00160099
      CHARACTER*50 DSN                                                  00170099
      INTEGER*2 TIME(6),ID,IETN(6)                                      00180099
      REAL*4 FIN(170),ETN(80),HEADER(32),SEDR(50),DFCN(16)              00190099
      REAL*8 T,DAYS                                                     00200099
      EQUIVALENCE (FIN(1),HEADER(1)),(FIN(33),ETN(1)),                  00210099
     &            (HEADER(4),TIME(1)),(HEADER(17),ID),                  00220099
     &            (HEADER(3),FLT),(SEDR(1),FIN(113)),                   00230099
     &            (ETN(1),IETN(1)),(ETN(16),FLUX),                      00231099
     &            (ETN(17),TEMP),(ETN(18),DFCN(1))                      00232099
C                                                                       00240099
C   OPEN DATA SET CONTAINING SUMMARY TAPE DATA                          00250099
C                                                                       00260099
C     OPEN(IUNIT,FILE='/'//DSN,FORM='UNFORMATTED',STATUS='OLD',         00270099
C    C     ACTION='READ')                                               00280099
C                                                                       00300099
C                                                                       00301099
C SPECIFY ELECTRON MODE                                                 00310099
C                                                                       00311099
C   IMODE = 4 - E1 MODE                                                 00320099
C           6 - E2 MODE                                                 00330099
C                                                                       00350099
      IMODE = 6                                                         00360099
C                                                                       00370099
C SPECIFY START AND STOP TIMES (YYDDDHH)                                00380099
C                                                                       00390099
      ISTART = 8012211                                                  00400099
      ISTOP = 8012212                                                   00410099
      IND = 0                                                           00420099
   30 CONTINUE                                                          00430099
        READ(10,NUM=LEN,END=100,ERR=30) FIN                             00440099
        IF (ID.NE.IMODE) GOTO 30                                        00460099
        IF (IND.GE.20000) GOTO 100                                      00470099
        READ(FLT,'(3X,I1)') ISC                                         00480099
        NYR = TIME(1)                                                   00490099
        NDY = TIME(2)                                                   00500099
        NHR = TIME(3)                                                   00510099
        NMIN = TIME(4)                                                  00520099
        NSEC = TIME(5)                                                  00530099
        MSEC = TIME(6)                                                  00540099
        T = DECYR(NYR,NDY,NHR,NMIN,NSEC,MSEC)                           00550099
        ITIME = NYR*100000+NDY*100+NHR                                  00560099
C       IF (ITIME.LT.ISTART) GOTO 30                                    00570099
C       IF (ITIME.GE.ISTOP) GOTO 100                                    00580099
C                                                                       00590099
C EXTRACT DATA                                                          00600099
C                                                                       00610099
        WRITE(6,*) ID,(IETN(I),I=1,2),ETN(16),ETN(17),ETN(18)           00620099
        IND = IND + 1                                                   00621099
C                                                                       00630099
      GO TO 30                                                          00890099
  100 CONTINUE                                                          00900099
C     CLOSE(IUNIT)                                                      00910099
      WRITE(6,810) IND                                                  00920099
      STOP                                                              00930099
  800 FORMAT(I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,                       00940099
     &       2(1X,F7.3),2(1X,F5.1),3(1X,F7.3),1X,F6.2)                  00950099
  805 FORMAT(I1,1X,F11.8,                                               00951099
     &       2(1X,F7.3),2(1X,F5.1),3(1X,F7.3),1X,F6.2)                  00952099
  810 FORMAT(1X,I5.5,' RECORDS WRITTEN FROM FILE ')                     00960099
      END                                                               00970099
      SUBROUTINE CONVERT(DDATE,NYEAR,NDAY,NHOUR,NMIN,NSEC,MSEC)         00980099
C                                                                       00990099
C CONVERT DECIMAL YEAR INTO CALENDAR DATE                               01000099
C                                                                       01010099
      REAL*8 DDATE,YEAR,DAY,HOUR,MIN,SEC,FSEC                           01020099
      NYEAR = IDINT(DDATE)                                              01030099
      YEAR = DFLOAT(NYEAR)                                              01040099
      DAY = (DDATE-YEAR)*DAYS(NYEAR)                                    01050099
      NDAY = IDINT(DAY) + 1                                             01060099
      HOUR = (DAY-DFLOAT(NDAY-1))*24.0D0                                01070099
      NHOUR = IDINT(HOUR)                                               01080099
      MIN = (HOUR-DFLOAT(NHOUR))*60.0D0                                 01090099
      NMIN = IDINT(MIN)                                                 01100099
      SEC = (MIN-DFLOAT(NMIN))*60.0D0                                   01110099
      NSEC = IDINT(SEC)                                                 01120099
      FSEC = (SEC-DFLOAT(NSEC))*1000.0D0                                01130099
      MSEC = IDINT(FSEC)                                                01140099
      IF (MSEC.GE.1000) THEN                                            01150099
       NSEC = NSEC + 1                                                  01160099
       MSEC = MSEC - 1000                                               01170099
      END IF                                                            01180099
      IF (NSEC.GE.60) THEN                                              01190099
       NMIN = NMIN + 1                                                  01200099
       NSEC = NSEC - 60                                                 01210099
      END IF                                                            01220099
      IF (NMIN.GE.60) THEN                                              01230099
       NHOUR = NOUR + 1                                                 01240099
       NMIN = NMIN - 60                                                 01250099
      END IF                                                            01260099
      IF (NHOUR.GE.24) THEN                                             01270099
       NDAY = NDAY + 1                                                  01280099
       NHOUR = NHOUR - 24                                               01290099
      END IF                                                            01300099
      IF (NDAY.GT.DAYS(NYEAR)) THEN                                     01310099
       NYEAR = NYEAR + 1                                                01320099
       NDAY = NDAY - DAYS(NYEAR)                                        01330099
      END IF                                                            01340099
      RETURN                                                            01350099
      END                                                               01360099
      DOUBLE PRECISION FUNCTION DECYR(IYR,IDY,IHR,MIN,ISEC,MSEC)        01370099
C                                                                       01380099
C CONVERT INTEGER TIME VALUES INTO DECIMAL YEAR                         01390099
C                                                                       01400099
      REAL*8 DYEAR,DDAY,DHOUR,DMIN,DSEC,LEAP                            01410099
      LEAP = 365.0D0                                                    01420099
      IF (MOD(IYR,4).EQ.0) LEAP = 366.0D0                               01430099
      DSEC = DBLE(ISEC) + DBLE(MSEC)/1000.0D0                           01440099
      DMIN = DBLE(MIN) + DSEC/60.0D0                                    01450099
      DHOUR = DBLE(IHR) + DMIN/60.0D0                                   01460099
      DDAY = DBLE(IDY) - 1.0D0 + DHOUR/24.0D0                           01470099
      DYEAR = DBLE(IYR) + DDAY/LEAP                                     01480099
      DECYR = DYEAR                                                     01490099
      RETURN                                                            01500099
      END                                                               01510099
      DOUBLE PRECISION FUNCTION DAYS(IYR)                               01520099
C                                                                       01530099
C COMPUTE NUMBER OF DAYS IN YEAR (IYR).                                 01540099
C                                                                       01550099
      DAYS = 365.0D0                                                    01560099
      IF (MOD(IYR,4).EQ.0) DAYS = 366.0D0                               01570099
      RETURN                                                            01580099
      END                                                               01590099
//*EXEC LOADER,REGION=3250K,PARM='SIZE=700K'                            01600099
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR                             01601099
//GO.SYSUDUMP DD DUMMY                                                  01610099
//*T09F001 DD DSN=Z1SBK.V178A.MAG,DISP=OLD                              01620099
//*T09F001 DD DSN=Z1SBK.V180A.MAG,SPACE=(TRK,(200,15),RLSE),            01630099
//*        DCB=(RECFM=FB,LRECL=80,BLKSIZE=8000),                        01640099
//*        UNIT=TEMPDA,DISP=(NEW,CATLG)                                 01650099
//FT10F001 DD DSN=U0#16.UNITTREE.V1.D8012100,DISP=OLD                   01650199
//*T10F001 DD DSN=U0#16.PREFILT.SECOND.M91086,DISP=OLD                  01651099
//*T10F001 DD DSN=U0#16.MASS.COPY.M21308,DCB=(RECFM=U,LRECL=11280),     01660099
//*        DISP=OLD                                                     01670099
//*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21279,                         01690099
//*        DISP=OLD,UNIT=T3480,VOL=SER=288271,                          01700099
//*        DCB=(RECFM=VB,LRECL=5000,BLKSIZE=32760),                     01710099
//*        LABEL=(3,SL,,IN)                                             01720099
//TELL EXEC NOTIFY                                                      01730099
//                                                                      01740099
//Z1SBKHDR JOB (U0016,N598,15),'HIGH RES HDR',TIME=(2,00),CLASS=N,      00010099
// MSGCLASS=X,NOTIFY=Z1SBK                                              00020099
/*JOBPARM LINES=200                                                     00030099
// EXEC FORTVCLG                                                        00050099
C                                                                       00060099
C WRITTEN BY SANDY KRAMER, 07/93.                                       00070099
C READS HDR RECORD FROM SUMMARY TAPE.                                   00080099
C                                                                       00150099
      CHARACTER*4 FLT,TELFMT,DATAID,SCTIME                              00160099
      CHARACTER*8 DATCON                                                00161099
      CHARACTER*29 DSN                                                  00170099
      INTEGER*2 TIME(6),DATATYPE(2),RECDAT(2),                          00180099
     &          MODCNT(2),LINECNT(2),WORDS(4)                           00181099
      LOGICAL*1 MAGSYS(32)                                              00181199
      LOGICAL*4 STATWRD,COMMWRD                                         00182099
      REAL*4 FIN(568),MAG(496),HEADER(32),SEDR(40),SPARE(32),HDR1(100)  00190099
      REAL*8 DECDAY,ELPSTIME                                            00201099
      EQUIVALENCE (FIN(1),HEADER(1)),       (FIN(33),MAG(1)),           00210099
     &            (HEADER(1),DATAID),       (HEADER(2),TELFMT),         00211099
     &            (HEADER(3),FLT),          (HEADER(4),TIME(1)),        00211199
     &            (HEADER(7),DECDAY),       (HEADER(9),ELPSTIME),       00211299
     &            (HEADER(11),SCTIME),      (HEADER(12),TIMEPD),        00212099
     &            (HEADER(13),MODCNT(1)),   (HEADER(14),LINECNT(1)),    00212199
     &            (HEADER(15),STATWRD),     (HEADER(16),COMMWRD),       00212299
     &            (HEADER(17),DATATYPE(1)), (HEADER(19),DATCON),        00212399
     &            (HEADER(30),WORDS(1)),    (HEADER(32),RECDAT(1)),     00220099
     &            (HEADER(1),SPARE(1)),     (SEDR(1),FIN(529)),         00230099
     &            (HDR1(1),FIN(1)),         (HDR1(77),MAGSYS(1))        00231099
C                                                                       00240099
C   OPEN DATA SET CONTAINING SUMMARY TAPE DATA                          00250099
C                                                                       00260099
C     OPEN(IUNIT,FILE='/'//DSN,FORM='UNFORMATTED',STATUS='OLD',         00270099
C    C     ACTION='READ')                                               00280099
C                                                                       00300099
C                                                                       00370099
C SPECIFY START AND STOP TIMES (YYDDDHH)                                00380099
C                                                                       00390099
      ISTART = 7724000                                                  00400099
      ISTOP = 9300100                                                   00410099
      IND = 0                                                           00420099
   30 CONTINUE                                                          00430099
        READ(10,NUM=LEN,END=100,ERR=30) FIN                             00440099
        IF (DATATYPE(1).EQ.8) THEN                                      00460099
        END IF                                                          00460199
        IF (DATATYPE(1).NE.1) GO TO 30                                  00461099
C       IF (IND.GE.200) GOTO 100                                        00470099
        READ(FLT,'(3X,I1)') ISC                                         00480099
        NYR = TIME(1)                                                   00490099
        NDY = TIME(2)                                                   00500099
        NHR = TIME(3)                                                   00510099
        NMIN = TIME(4)                                                  00520099
        NSEC = TIME(5)                                                  00530099
        MSEC = TIME(6)                                                  00540099
        ITIME = NYR*100000+NDY*100+NHR                                  00560099
        IF (ITIME.LT.ISTART) GOTO 30                                    00570099
        IF (ITIME.GE.ISTOP) GOTO 100                                    00580099
C                                                                       00580199
C INTERPRET MODCNT(1) AS UNSIGNED INTEGER                               00580299
C                                                                       00580399
        IF (MODCNT(1).LT.0) THEN                                        00580499
         MOD216 = MODCNT(1) + 65536                                     00580599
        ELSE                                                            00580699
         MOD216 = MODCNT(1)                                             00580799
        END IF                                                          00580899
C       WRITE(6,800) TIME,DATAID,TELFMT,FLT,SCTIME,DATCON,DATATYPE,     00590099
C    &   RECDAT                                                         00856099
C       WRITE(6,801) TIME,DATAID,TELFMT,FLT,SCTIME,DATCON,WORDS         00857099
        WRITE(6,802) DATAID,TELFMT,FLT,TIME,DECDAY,ELPSTIME,            00858099
     &               SCTIME,TIMEPD,MOD216,MODCNT(2),LINECNT(1),         00859099
     &               STATWRD,COMMWRD,DATATYPE,DATCON,WORDS,RECDAT       00860099
      GO TO 30                                                          00890099
  100 CONTINUE                                                          00900099
C     CLOSE(IUNIT)                                                      00910099
      STOP                                                              00930099
  800 FORMAT(6(1X,I3),4(1X,A4),1X,A8,2(1X,I2),2(1X,I8))                 00940099
  801 FORMAT(6(1X,I3),4(1X,A4),1X,A8,4(1X,I8))                          00950099
  802 FORMAT(1X,3A4,6I3,2F9.4,A4,F7.2,3I6,2Z4,2I2,A8,6I4)               00960099
      END                                                               00970099
//*EXEC LOADER,REGION=3250K,PARM='SIZE=700K'                            01600099
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR                             01601099
//GO.SYSUDUMP DD DUMMY                                                  01610099
//*T09F001 DD DSN=Z1SBK.V178A.MAG,DISP=OLD                              01620099
//*T09F001 DD DSN=Z1SBK.VTEMP.MAG,SPACE=(TRK,(400,15),RLSE),            01630099
//*        DCB=(RECFM=FB,LRECL=100,BLKSIZE=8000),                       01640099
//*        UNIT=TEMPDA,DISP=(NEW,CATLG)                                 01650099
//*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.M91152,DISP=OLD                 01650199
//FT10F001 DD DSN=U0#16.UNITTREE.V2.D9112100,DISP=OLD                   01650299
//*T10F001 DD DSN=U0#16.VOYAGER.SECOND.M91261,DISP=OLD                  01651099
//*T10F001 DD DSN=U0#16.MASS.COPY.M21308,DCB=(RECFM=U,LRECL=11280),     01660099
//*        DISP=OLD                                                     01670099
//*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21308,                         01690099
//*        DISP=OLD,UNIT=T3480,VOL=SER=289151,                          01700099
//*        DCB=(RECFM=VB,LRECL=5000,BLKSIZE=32760),                     01710099
//*        LABEL=(1,SL,,IN)                                             01720099
//TELL EXEC NOTIFY                                                      01730099
//                                                                      01740099
//Z1SBKMAG JOB (U0016,N598,15),'SUMMARY MAG',TIME=(2,00),               00010099
// MSGCLASS=X,CLASS=A,NOTIFY=Z1SBK                                      00020099
/*JOBPARM LINES=100                                                     00030099
//*EXEC FORTRAN                                                         00040099
// EXEC FORTVCLG                                                        00050099
C                                                                       00060099
C WRITTEN BY SANDY KRAMER, 03/92.                                       00070099
C READS MAG RECORD FROM SUMMARY TAPE.  MAG INSTRUMENT SENSITIVE         00080099
C TO 2*10**-3 GAMMA.                                                    00090099
C FIND APPROPRIATE SUMARRY TAPE IN U0#16.VOYAGER.SUMMARY.INDEX          00100099
C DETERMINE VOLUME USING ISPF 3.4 UTILITY                               00110099
C GET FILE NUMBER BY RUNNING FATAR SCAN ON VOLUME                       00120099
C                                                                       00130099
C SELECT FROM 48 SEC, 9.6 SEC OR 1.92 SEC RESOLUTION                    00140099
C                                                                       00150099
      CHARACTER*4 FLT                                                   00160099
      CHARACTER*29 DSN                                                  00170099
      INTEGER*2 TIME(6),ID                                              00180099
      INTEGER*4 IMAG(496)                                               00181099
      REAL*4 FIN(568),MAG(496),HEADER(32),SEDR(40)                      00190099
      REAL*8 T,DECYR,T96(5),T192(25),DAYS                               00200099
      EQUIVALENCE (FIN(1),HEADER(1)),(FIN(33),MAG(1)),                  00210099
     &            (HEADER(4),TIME(1)),(HEADER(17),ID),                  00220099
     &            (HEADER(3),FLT),(SEDR(1),FIN(529)),                   00230099
     &            (IMAG(1),MAG(1))                                      00231099
C                                                                       00240099
C   OPEN DATA SET CONTAINING SUMMARY TAPE DATA                          00250099
C                                                                       00260099
C     OPEN(IUNIT,FILE='/'//DSN,FORM='UNFORMATTED',STATUS='OLD',         00270099
C    C     ACTION='READ')                                               00280099
C                                                                       00300099
C SPECIFY TIME SERIES RESOLUTION                                        00310099
C                                                                       00311099
C   IRES = 1 - 48 SEC AVGS                                              00320099
C          2 - 9.6 SEC AVGS                                             00330099
C          3 - 1.92 SEC AVGS                                            00340099
C                                                                       00350099
      IRES = 1                                                          00360099
C                                                                       00370099
C SPECIFY START AND STOP TIMES (YYDDDHH)                                00380099
C                                                                       00390099
      ISTART = 7723200                                                  00400099
      ISTOP = 9400100                                                   00410099
      IND = 0                                                           00420099
   30 CONTINUE                                                          00430099
        READ(10,NUM=LEN,END=100,ERR=30) FIN                             00440099
        IF (ID.NE.1) GO TO 30                                           00460099
C       IF (IND.GE.200) GOTO 100                                        00470099
C       WRITE(6,*) (SEDR(I),I=11,13)                                    00471099
C       WRITE(6,'(10(1X,F7.3),1X,I2)') (MAG(I),I=1,10),IMAG(11)         00472099
        READ(FLT,'(3X,I1)') ISC                                         00480099
        NYR = TIME(1)                                                   00490099
        NDY = TIME(2)                                                   00500099
        NHR = TIME(3)                                                   00510099
        NMIN = TIME(4)                                                  00520099
        NSEC = TIME(5)                                                  00530099
        MSEC = TIME(6)                                                  00540099
        T = DECYR(NYR,NDY,NHR,NMIN,NSEC,MSEC)                           00550099
        ITIME = NYR*100000+NDY*100+NHR                                  00560099
        IF (ITIME.LT.ISTART) GOTO 30                                    00570099
        IF (ITIME.GE.ISTOP) GOTO 100                                    00580099
        IF (IRES.EQ.1) THEN                                             00590099
C 48 SECOND AVERAGES                                                    00600099
         WRITE(9,800) ISC,NYR,NDY,NHR,NMIN,NSEC,MSEC,(MAG(I),I=1,7),    00610099
     &                SEDR(11)                                          00620099
C                                                                       00620199
C SPECIAL OUTPUT F2,BR,BT,BN,R,X,Y,Z FOR 1 HR AVG PRODUCTION SBK 8/23/9300620399
C                                                                       00620499
C        WRITE(9,803) ISC,NYR,NDY,NHR,NMIN,NSEC,MSEC,MAG(2),            00620599
C    &                (MAG(I),I=5,7),SEDR(11),(SEDR(I),I=5,7)           00620699
C        WRITE(9,805) ISC,T,(MAG(I),I=1,7),SEDR(11)                     00621099
         IND = IND + 1                                                  00630099
        END IF                                                          00640099
        IF (IRES.EQ.2) THEN                                             00650099
C 9.6 SECOND AVERAGES                                                   00660099
         DO 96 I96 = 1,5                                                00670099
          T96(I96) = T + DBLE(I96-1)*9.6D0/86400.0D0/DAYS(NYR)          00680099
          CALL CONVERT(T96(I96),IYR,IDY,IHR,IMIN,ISEC,IMS)              00690099
          WRITE(9,800) ISC,IYR,IDY,IHR,IMIN,ISEC,IMS,                   00700099
     &                 MAG(12+I96-1),MAG(17+I96-1),MAG(22+I96-1),       00710099
     &                 MAG(27+I96-1),MAG(32+I96-1),MAG(37+I96-1),       00720099
     &                 MAG(42+I96-1),SEDR(11)                           00730099
          IND = IND + 1                                                 00740099
   96     CONTINUE                                                      00750099
        END IF                                                          00760099
        IF (IRES.EQ.3) THEN                                             00770099
C 1.92 SECOND AVERAGES                                                  00780099
         DO 192 J192 = 1,25                                             00790099
          T192(J192) = T + DBLE(J192-1)*1.92D0/86400.0D0/DAYS(NYR)      00800099
          CALL CONVERT(T192(J192),IYR,IDY,IHR,IMIN,ISEC,IMS)            00810099
          WRITE(9,800) ISC,IYR,IDY,IHR,IMIN,ISEC,IMS,                   00820099
     &                 MAG(67+J192-1),MAG(92+J192-1),MAG(117+J192-1),   00830099
     &                 MAG(142+J192-1),MAG(167+J192-1),MAG(192+J192-1), 00840099
     &                 MAG(217+J192-1),SEDR(11)                         00850099
C                                                                       00851099
C         WRITE(9,888) ISC,IYR,IDY,IHR,IMIN,ISEC,IMS,                   00852099
C    &                 MAG(167+J192-1),MAG(192+J192-1),MAG(217+J192-1), 00853099
C    &                 MAG(67+J192-1),SEDR(11)                          00854099
  888 FORMAT(I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,4(1X,F7.3),1X,F8.4)    00855099
C                                                                       00856099
          IND = IND + 1                                                 00860099
  192    CONTINUE                                                       00870099
       END IF                                                           00880099
      GO TO 30                                                          00890099
  100 CONTINUE                                                          00900099
C     CLOSE(IUNIT)                                                      00910099
      WRITE(6,810) IND                                                  00920099
      STOP                                                              00930099
  800 FORMAT(I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,                       00940099
     &       2(1X,F7.3),2(1X,F5.1),3(1X,F7.3),1X,F8.4)                  00950099
  803 FORMAT(I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,                       00950199
     &       4(1X,F7.3),4(1X,F8.4))                                     00950299
  805 FORMAT(I1,1X,F11.8,                                               00951099
     &       2(1X,F7.3),2(1X,F5.1),3(1X,F7.3),1X,F8.4)                  00952099
  810 FORMAT(1X,I5.5,' RECORDS WRITTEN FROM FILE ')                     00960099
      END                                                               00970099
      SUBROUTINE CONVERT(DDATE,NYEAR,NDAY,NHOUR,NMIN,NSEC,MSEC)         00980099
C                                                                       00990099
C CONVERT DECIMAL YEAR INTO CALENDAR DATE                               01000099
C                                                                       01010099
      REAL*8 DDATE,YEAR,DAY,HOUR,MIN,SEC,FSEC                           01020099
      NYEAR = IDINT(DDATE)                                              01030099
      YEAR = DFLOAT(NYEAR)                                              01040099
      DAY = (DDATE-YEAR)*DAYS(NYEAR)                                    01050099
      NDAY = IDINT(DAY) + 1                                             01060099
      HOUR = (DAY-DFLOAT(NDAY-1))*24.0D0                                01070099
      NHOUR = IDINT(HOUR)                                               01080099
      MIN = (HOUR-DFLOAT(NHOUR))*60.0D0                                 01090099
      NMIN = IDINT(MIN)                                                 01100099
      SEC = (MIN-DFLOAT(NMIN))*60.0D0                                   01110099
      NSEC = IDINT(SEC)                                                 01120099
      FSEC = (SEC-DFLOAT(NSEC))*1000.0D0                                01130099
      MSEC = IDINT(FSEC)                                                01140099
      IF (MSEC.GE.1000) THEN                                            01150099
       NSEC = NSEC + 1                                                  01160099
       MSEC = MSEC - 1000                                               01170099
      END IF                                                            01180099
      IF (NSEC.GE.60) THEN                                              01190099
       NMIN = NMIN + 1                                                  01200099
       NSEC = NSEC - 60                                                 01210099
      END IF                                                            01220099
      IF (NMIN.GE.60) THEN                                              01230099
       NHOUR = NOUR + 1                                                 01240099
       NMIN = NMIN - 60                                                 01250099
      END IF                                                            01260099
      IF (NHOUR.GE.24) THEN                                             01270099
       NDAY = NDAY + 1                                                  01280099
       NHOUR = NHOUR - 24                                               01290099
      END IF                                                            01300099
      IF (NDAY.GT.DAYS(NYEAR)) THEN                                     01310099
       NYEAR = NYEAR + 1                                                01320099
       NDAY = NDAY - DAYS(NYEAR)                                        01330099
      END IF                                                            01340099
      RETURN                                                            01350099
      END                                                               01360099
      DOUBLE PRECISION FUNCTION DECYR(IYR,IDY,IHR,MIN,ISEC,MSEC)        01370099
C                                                                       01380099
C CONVERT INTEGER TIME VALUES INTO DECIMAL YEAR                         01390099
C                                                                       01400099
      REAL*8 DYEAR,DDAY,DHOUR,DMIN,DSEC,LEAP                            01410099
      LEAP = 365.0D0                                                    01420099
      IF (MOD(IYR,4).EQ.0) LEAP = 366.0D0                               01430099
      DSEC = DBLE(ISEC) + DBLE(MSEC)/1000.0D0                           01440099
      DMIN = DBLE(MIN) + DSEC/60.0D0                                    01450099
      DHOUR = DBLE(IHR) + DMIN/60.0D0                                   01460099
      DDAY = DBLE(IDY) - 1.0D0 + DHOUR/24.0D0                           01470099
      DYEAR = DBLE(IYR) + DDAY/LEAP                                     01480099
      DECYR = DYEAR                                                     01490099
      RETURN                                                            01500099
      END                                                               01510099
      DOUBLE PRECISION FUNCTION DAYS(IYR)                               01520099
C                                                                       01530099
C COMPUTE NUMBER OF DAYS IN YEAR (IYR).                                 01540099
C                                                                       01550099
      DAYS = 365.0D0                                                    01560099
      IF (MOD(IYR,4).EQ.0) DAYS = 366.0D0                               01570099
      RETURN                                                            01580099
      END                                                               01590099
//*EXEC LOADER,REGION=3250K,PARM='SIZE=700K'                            01600099
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR                             01601099
//GO.SYSUDUMP DD DUMMY                                                  01610099
//*T09F001 DD DSN=Z1SBK.V291C.SUM,DISP=MOD                              01620099
//FT09F001 DD DSN=Z1SBK.V2TMP.MAG,SPACE=(TRK,(100,15),RLSE),            01630099
//         DCB=(RECFM=FB,LRECL=100,BLKSIZE=8000),                       01640099
//         UNIT=TEMPDA,DISP=(NEW,CATLG)                                 01650099
//*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.M91152,DISP=OLD                 01650199
//FT10F001 DD DSN=U0#16.UNITTREE.V2.D9112100,DISP=OLD                   01650299
//*T10F001 DD DSN=U0#16.VOYAGER.SECOND.M91261,DISP=OLD                  01651099
//*T10F001 DD DSN=U0#16.MASS.COPY.M21308,DCB=(RECFM=U,LRECL=11280),     01660099
//*        DISP=OLD                                                     01670099
//*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21308,                         01690099
//*        DISP=OLD,UNIT=T3480,VOL=SER=289151,                          01700099
//*        DCB=(RECFM=VB,LRECL=5000,BLKSIZE=32760),                     01710099
//*        LABEL=(1,SL,,IN)                                             01720099
//TELL EXEC NOTIFY                                                      01730099
//                                                                      01740099
//Z1SBKPLS JOB (U0016,N598,15),'SUMMARY PLASMA',TIME=(1,00),
// MSGCLASS=X,CLASS=A,NOTIFY=Z1SBK
/*JOBPARM LINES=100
// EXEC FORTRAN
C
C WRITTEN BY SANDY KRAMER 03/92.   MODIFIED FOR L MODE 06/93 SBK.
C READS PLS RECORD FROM SUMMARY TAPE
C FIND APPROPRIATE SUMMARY TAPE IN U0#16.VOYAGER.SUMMARY.INDEX
C DETERMINE VOLUME USING ISPF 3.4 UTILITY.
C GET FILE NUMBER BY RUNNING FATAR SCAN ON VOLUME
C
      CHARACTER*4 FLT
      CHARACTER*29 DSN
      INTEGER*2 TIME(6),ID
      REAL*4 FIN(232),PLS(150),HEADER(32),SEDR(50)
      REAL*8 T,DECYR
      EQUIVALENCE (FIN(1),HEADER(1)),(FIN(33),PLS(1)),
     &            (HEADER(4),TIME(1)),(HEADER(17),ID),
     &            (HEADER(3),FLT),(FIN(183),SEDR(1))
C
      CALL ERRSET(118,256,1,1,1,208)
C
C   OPEN DATA SET CONTAINING SUMMARY TAPE DATA
C
C     OPEN(IUNIT,FILE='/'//DSN,FORM='UNFORMATTED',STATUS='OLD',
C    C     ACTION='READ')
C
C
C    SELECT PLASMA MODE
C
C IMODE = 3  M MODE
C IMODE = 5  L MODE
C
      IMODE = 3
C
C
C SPECIFY FIT OR MOMENT DATA
C
C IFIT = 1 - FIT DATA
C IFIT = 2 - MOMENT DATA
C
      IFIT = 1
C
      ISTART = 7723200
      ISTOP = 9400100
C
      BLT = 1.38066E-23
      PRTN = 1.67265E-27
C
      IND = 0
   30 CONTINUE
        READ(10,NUM=LEN,END=100,ERR=30) FIN
        IF (ID.NE.IMODE) GO TO 30
        IND = IND + 1
        READ(FLT,'(3X,I1)') ISC
        NYR = TIME(1)
        NDY = TIME(2)
        NHR = TIME(3)
        NMIN = TIME(4)
        NSEC = TIME(5)
        MSEC = TIME(6)
        T = DECYR(NYR,NDY,NHR,NMIN,NSEC,MSEC)
        ITIME = NYR*100000 + NDY*100 + NHR
        IF (ITIME.LT.ISTART) GOTO 30
        IF (ITIME.GE.ISTOP) GOTO 100
        IF (IFIT.EQ.1) THEN
C
C FIT DATA
C
         VFIT = PLS(108)
         VRFIT = PLS(105)
         VTFIT = PLS(106)
         VNFIT = PLS(107)
         VDFIT = PLS(109)
         VLFIT = PLS(110)
         DENFIT = PLS(52)
         WFIT = PLS(53)
         TEMFIT = PRTN*(WFIT*1000.0)**2.0/(2.0*BLT)
C        WRITE(9,800) ISC,T,
C    &                VFIT,VDFIT,VLFIT,DENFIT,TEMFIT,SEDR(11)
         WRITE(9,801) ISC,NYR,NDY,NHR,NMIN,NSEC,MSEC,
     &                VFIT,VDFIT,VLFIT,DENFIT,TEMFIT,SEDR(11)
        END IF
        IF (IFIT.EQ.2) THEN
C
C MOMENT DATA
C
         VMOM = PLS(102)
         VRMOM = PLS(99)
         VTMOM = PLS(100)
         VNMOM = PLS(101)
         VDMOM = PLS(103)
         VLMOM = PLS(104)
         DENMOM = PLS(38)
         WMOM = PLS(40)
         TEMMOM = PRTN*(WMOM*1000.0)**2.0/(2.0*BLT)
C        WRITE(9,800) ISC,T,VMOM,VRMOM,VTMOM,VNMOM,
C    &                VDMOM,VLMOM,DENMOM,TEMMOM,SEDR(11)
         WRITE(9,801) ISC,NYR,NDY,NHR,NMIN,NSEC,MSEC,
     &                VMOM,VDMOM,VLMOM,DENMOM,TEMMOM,SEDR(11)
C        WRITE(9,888) ISC,NYR,NDY,NHR,NMIN,NSEC,MSEC,
C    &                PLS(96),PLS(97),PLS(98),
C    &                VMOM,VRMOM,VTMOM,VNMOM,DENMOM,WMOM
        END IF
C
C USE FOLLOWING WRITE STATEMENT FOR DATA DUMP TO CHECK PLASMA DATA.
C ARRAY PLS CONTAINS PLASMA DATA (150 WORDS).  SELECT DESIRED WORDS
C AND ADJUST OUTPUT FORM ACCORDINGLY.
C
C       WRITE(6,'(1X,I1,1X,F11.8,1X,F6.1)') ISC,T,PLS(31)
C
      GO TO 30
  100 CONTINUE
C     CLOSE(IUNIT)
      WRITE(6,810) IND
      STOP
  800 FORMAT(I1,1X,F11.8,1X,F6.1,2(1X,F5.1),2(1X,E10.4),1X,F8.4)
  801 FORMAT(I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,F6.1,2(1X,F5.1),
     &       2(1X,E10.4),1X,F8.4)
  810 FORMAT(1X,I5.5,' RECORDS WRITTEN FROM FILE ')
  888 FORMAT(I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,
     &       3(1X,F7.3),4(1X,F6.1),1X,E10.4,1X,F6.1)
      END
      DOUBLE PRECISION FUNCTION DECYR(IYR,IDY,IHR,MIN,ISEC,MSEC)
      REAL*8 DYEAR,DDAY,DHOUR,DMIN,DSEC,LEAP
C
C CONVERT INTEGER TIME VALUES INTO DECIMAL YEAR
C
      LEAP = 365.0D0
      IF (MOD(IYR,4).EQ.0) LEAP = 366.0D0
      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
      RETURN
      END
//RUN77 EXEC LOADER,REGION=3250K,PARM='SIZE=700K'
//SYSUDUMP DD DUMMY
//*T09F001 DD DSN=Z1SBK.V284A.PLS,DISP=OLD
//FT09F001 DD DSN=Z1SBK.V277A.PLF,SPACE=(TRK,(20,5),RLSE),
//         DCB=(RECFM=FB,LRECL=100,BLKSIZE=8000),
//         UNIT=TEMPDA,DISP=(NEW,CATLG)
//FT10F001 DD DSN=U0#16.UNITTREE.V2.D7730100,DISP=OLD
//*T10F001 DD DSN=U0#16.MASS.COPY.M21308,
//*        DCB=(RECFM=U,LRECL=11280),DISP=OLD
//*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21308,
//*        DISP=OLD,UNIT=T3480,VOL=SER=289151,
//*        DCB=(RECFM=VB,LRECL=5000,BLKSIZE=32760),
//*        LABEL=(1,SL,,IN)
//TELL EXEC NOTIFY
//
//Z1SBKSDR JOB (U0016,N598,15),'HIGH RES SEDR',TIME=(2,00),CLASS=N,     00010099
// MSGCLASS=X,NOTIFY=Z1SBK                                              00020099
/*JOBPARM LINES=100                                                     00030099
// EXEC FORTVCLG                                                        00050099
C                                                                       00060099
C WRITTEN BY SANDY KRAMER, 11/93.                                       00070099
C READS SEDR BLOCK FROM MAG RECORD ON SUMMARY TAPE.                     00080099
C                                                                       00150099
      CHARACTER*4 FLT,TELFMT,DATAID,SCTIME                              00160099
      CHARACTER*8 DATCON                                                00161099
      CHARACTER*29 DSN                                                  00170099
      INTEGER*2 TIME(6),DATATYPE(2),RECDAT(2),                          00180099
     &          MODCNT(2),LINECNT(2),WORDS(4)                           00181099
      LOGICAL*4 STATWRD,COMMWRD                                         00182099
      REAL*4 FIN(568),MAG(496),HEADER(32),SEDR(40),SPARE(32),           00190099
     &       MHG(3,3),MTB(3,3),MTB5(3,3)                                00200099
      REAL*8 DECDAY,ELPSTIME                                            00201099
C                                                                       00202099
      EQUIVALENCE (FIN(1),HEADER(1)),       (FIN(33),MAG(1)),           00210099
     &            (FIN(529),SEDR(1))                                    00210199
C                                                                       00210299
      EQUIVALENCE (HEADER(1),DATAID),       (HEADER(2),TELFMT),         00211099
     &            (HEADER(3),FLT),          (HEADER(4),TIME(1)),        00211199
     &            (HEADER(7),DECDAY),       (HEADER(9),ELPSTIME),       00211299
     &            (HEADER(11),SCTIME),      (HEADER(12),TIMEPD),        00212099
     &            (HEADER(13),MODCNT(1)),   (HEADER(14),LINECNT(1)),    00212199
     &            (HEADER(15),STATWRD),     (HEADER(16),COMMWRD),       00212299
     &            (HEADER(17),DATATYPE(1)), (HEADER(19),DATCON),        00212399
     &            (HEADER(30),WORDS(1)),    (HEADER(32),RECDAT(1)),     00220099
     &            (HEADER(1),SPARE(1))                                  00230099
C                                                                       00231099
      EQUIVALENCE (SEDR(14),MTB(1,1)),      (SEDR(23),MTB5(1,1)),       00232099
     &            (SEDR(32),MHG(1,1))                                   00233099
C                                                                       00240099
C   OPEN DATA SET CONTAINING SUMMARY TAPE DATA                          00250099
C                                                                       00260099
C     OPEN(IUNIT,FILE='/'//DSN,FORM='UNFORMATTED',STATUS='OLD',         00270099
C    C     ACTION='READ')                                               00280099
C                                                                       00300099
C                                                                       00370099
C SPECIFY START AND STOP TIMES (YYDDDHH)                                00380099
C                                                                       00390099
      ISTART = 9112100                                                  00400099
      ISTOP = 9112200                                                   00410099
      IND = 0                                                           00420099
   30 CONTINUE                                                          00430099
        READ(10,NUM=LEN,END=100,ERR=30) FIN                             00440099
        IF (DATATYPE(1).NE.1) GO TO 30                                  00460099
C       IF (IND.GE.200) GOTO 100                                        00470099
        READ(FLT,'(3X,I1)') ISC                                         00480099
        NYR = TIME(1)                                                   00490099
        NDY = TIME(2)                                                   00500099
        NHR = TIME(3)                                                   00510099
        NMIN = TIME(4)                                                  00520099
        NSEC = TIME(5)                                                  00530099
        MSEC = TIME(6)                                                  00540099
        ITIME = NYR*100000+NDY*100+NHR                                  00560099
        IF (ITIME.LT.ISTART) GOTO 30                                    00570099
        IF (ITIME.GE.ISTOP) GOTO 100                                    00580099
        IF (MODCNT(1).LT.0) MODCNT(1) = MODCNT(1) + 32767               00581099
C       WRITE(6,800) TIME,DATAID,TELFMT,FLT,SCTIME,DATCON,DATATYPE,     00590099
C    &   RECDAT                                                         00856099
C       WRITE(6,801) TIME,DATAID,TELFMT,FLT,SCTIME,DATCON,WORDS         00857099
C       WRITE(6,802) DATAID,TELFMT,FLT,TIME,DECDAY,ELPSTIME,            00858099
C    &               SCTIME,TIMEPD,MODCNT(1),MODCNT(2),LINECNT(1),      00859099
C    &               STATWRD,COMMWRD,DATATYPE,DATCON,WORDS,RECDAT       00860099
C                                                                       00870099
C SEDR OUTPUT                                                           00880099
C                                                                       00881099
        WRITE(6,803) TIME                                               00881199
        WRITE(6,804) ((MTB(I,J),J=1,3),I=1,3)                           00882099
        WRITE(6,804) ((MTB5(I,J),J=1,3),I=1,3)                          00882199
        WRITE(6,804) ((MHG(I,J),J=1,3),I=1,3)                           00882299
C                                                                       00883099
      GO TO 30                                                          00890099
  100 CONTINUE                                                          00900099
C     CLOSE(IUNIT)                                                      00910099
      STOP                                                              00930099
  800 FORMAT(6(1X,I3),4(1X,A4),1X,A8,2(1X,I2),2(1X,I8))                 00940099
  801 FORMAT(6(1X,I3),4(1X,A4),1X,A8,4(1X,I8))                          00950099
  802 FORMAT(1X,3A4,6I3,2F9.4,A4,F7.2,3I6,2A4,2I2,A8,6I4)               00960099
  803 FORMAT(1X,I2,1X,I3,3(1X,I2),1X,I3)                                00961099
  804 FORMAT(3(3(1X,E10.4)/))                                           00962099
      END                                                               00970099
//*EXEC LOADER,REGION=3250K,PARM='SIZE=700K'                            01600099
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR                             01601099
//GO.SYSUDUMP DD DUMMY                                                  01610099
//*T09F001 DD DSN=Z1SBK.V178A.MAG,DISP=OLD                              01620099
//*T09F001 DD DSN=Z1SBK.VTEMP.MAG,SPACE=(TRK,(400,15),RLSE),            01630099
//*        DCB=(RECFM=FB,LRECL=100,BLKSIZE=8000),                       01640099
//*        UNIT=TEMPDA,DISP=(NEW,CATLG)                                 01650099
//*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.M91152,DISP=OLD                 01650199
//FT10F001 DD DSN=U0#16.UNITTREE.V2.D9112100,DISP=OLD                   01650299
//*T10F001 DD DSN=U0#16.VOYAGER.SECOND.M91261,DISP=OLD                  01651099
//*T10F001 DD DSN=U0#16.MASS.COPY.M21308,DCB=(RECFM=U,LRECL=11280),     01660099
//*        DISP=OLD                                                     01670099
//*T10F001 DD DSN=U0#16.VOYAGER.SUMMARY.M21308,                         01690099
//*        DISP=OLD,UNIT=T3480,VOL=SER=289151,                          01700099
//*        DCB=(RECFM=VB,LRECL=5000,BLKSIZE=32760),                     01710099
//*        LABEL=(1,SL,,IN)                                             01720099
//TELL EXEC NOTIFY                                                      01730099
//                                                                      01740099
//Z1SBKSUM JOB (U0016,N598,10),'SUMMARY DATA',TIME=(2,00),
// CLASS=N,MSGCLASS=X,NOTIFY=Z1SBK
/*JOBPARM LINES=200
// EXEC FORTVCLG
      PROGRAM SUMMREAD
C
      CHARACTER RECTYPE*4,TELFMT*4,FLTID*4,TIMEFMT*4,DATCON*8
C
      INTEGER*2 TIME(6),MODCNT(3),DATATYPE(2),LINECNT(2),WORDS(4),
     &          RECDAT(2)
C
      INTEGER*4 IB192(25),IB96(5),IB48,SIB48
C
      LOGICAL*4 STATWRD,COMMWRD
C
      REAL*4 B192(3,25),DEL192(25),LAM192(25),FMOD192(25),
     &       FMAG192(25),RMS192(3,25),
     &       B96(3,5),DEL96(5),LAM96(5),FMOD96(5),
     &       FMAG96(5),RMS96(3,5),
     &       B48(3),DEL48,LAM48,FMOD48,
     &       FMAG48,RMS48(3)
C
      REAL*4 SRMS48(3),SX48,SY48,SZ48,SFMOD48
C
      REAL*4 MTB(3,3),MTB5(3,3),MHG(3,3),POS(3),ANG(2),VEL(3)
C
      REAL*4 HDR(32),DATA(341),SCFLD(155),POSN(13),ATTD(27),SUMOUT(568)
C
      REAL*8 DD,TD,TN,TP
C
      EQUIVALENCE (HDR(1),RECTYPE),      (HDR(2),TELFMT),
     &            (HDR(3),FLTID),        (HDR(4),TIME(1)),
     &            (HDR(7),DD),           (HDR(9),TD),
     &            (HDR(11),TIMEFMT),     (HDR(12),TIMEPD),
     &            (HDR(13),MODCNT(1)),   (HDR(14),LINECNT(1)),
     &            (HDR(15),STATWRD),     (HDR(16),COMMWRD),
     &            (HDR(17),DATATYPE(1)), (HDR(19),DATCON),
     &            (HDR(30),WORDS(1)),    (HDR(32),RECDAT(1))
C
      EQUIVALENCE (DATA(1),FMAG48),      (DATA(2),FMOD48),
     &            (DATA(3),DEL48),       (DATA(4),LAM48),
     &            (DATA(5),B48(1)),      (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),B96(1,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),B192(1,1)), (DATA(242),RMS192(1,1)),
     &            (DATA(317),IB192(1))
C
      EQUIVALENCE (SCFLD(148),SRMS48(1)), (SCFLD(151),SIB48),
     &            (SCFLD(152),SX48),      (SCFLD(153),SY48),
     &            (SCFLD(154),SZ48),      (SCFLD(155),SFMOD48)
C
      EQUIVALENCE (POSN(1),TN),     (POSN(3),TP),
     &            (POSN(5),POS(1)), (POSN(11),RANGE),
     &            (POSN(12),ANG(1)),(POSN(8),VEL(1))
C
      EQUIVALENCE (ATTD(1),MTB(1,1)), (ATTD(10),MTB5(1,1)),
     &            (ATTD(19),MHG(1,1))
C
      EQUIVALENCE (SUMOUT(1),HDR(1)),     (SUMOUT(33),DATA(1)),
     &            (SUMOUT(342),SCFLD(1)), (SUMOUT(529),POSN(1)),
     &            (SUMOUT(542),ATTD(1))
C
   10 CONTINUE
       READ(70,END=100,ERR=10) SUMOUT
       IF (DATATYPE(1).NE.1) GOTO 10
       NCNT = NCNT + 1
C
C GET SEDR DATA
C
       WRITE(6,'(1X,''RECORD #: '',I5)') NCNT
C      WRITE(6,*)
       WRITE(6,'(1X,I2,1X,I3,3(1X,I2),1X,I3)') TIME
       WRITE(6,'(4(1X,F17.8))') DD,TD,TN,TP
       WRITE(6,'(4(1X,F9.4),2(1X,E10.4))') POS,RANGE,ANG
       WRITE(6,'(3(1X,E10.4))') VEL
       WRITE(6,*) 'MTB'
       WRITE(6,'(2(3(3x,e10.4)/),3(3x,e10.4))')
     &      ((MTB(I,J),J=1,3),I=1,3)
       WRITE(6,*) 'MTB5'
       WRITE(6,'(2(3(3x,e10.4)/),3(3x,e10.4))')
     &      ((MTB5(I,J),J=1,3),I=1,3)
       WRITE(6,*) 'MHG'
       WRITE(6,'(2(3(3x,e10.4)/),3(3x,e10.4))')
     &      ((MHG(I,J),J=1,3),I=1,3)
       WRITE(6,*)
      IF (NCNT.LT.100) GOTO 10
  100 CONTINUE
      WRITE(6,'(1X,''NUMBER OF RECORDS READ: '',I5)') NCNT
      CLOSE(70)
C
      STOP
      END
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR
//GO.SYSUDUMP DD DUMMY
//FT70F001 DD DSN=U0#16.UNITTREE.V2.D9112100,DISP=OLD
//TELL EXEC NOTIFY
//
//Z1SBKIMP JOB (U0016,N598,30),'IMP ADD',TIME=(0,30),MSGCLASS=X,
// CLASS=N,NOTIFY=Z1SBK
/*JOBPARM LINES=100
//FOR EXEC FORTRAN
C
C FOR CONCATENATED HOURAVG TAPE
C IMP/ISEE FROM OMNI TAPE
C
      REAL*4 FIN(37),OUT(35),LAM
      INTEGER*4 IN(37),IOUT(35),YR,DY,HR
      EQUIVALENCE (OUT(1),IOUT(1)),(IN(1),FIN(1))
      PI = 3.1415926
C
C ASSIGN CURRENT DATE TO VARIABLE IDATE (MMDDYY)
C
      IDATE = 070893
C
      IOUT(1) = 0
C
   20 CONTINUE
      DO 10 I=2,35
       OUT(I) = 0.0
   10 CONTINUE
C
   15 CONTINUE
      READ(10,NUM=LEN,END=100,ERR=15) FIN
      ITIME = IN(2)*100000 + IN(3)*100 + IN(4)
      IF ( ITIME.LT.6900100 ) GOTO 15
      IF ( ITIME.GE.7200100 ) GOTO 100
      IOUT(2) = IN(2)
      IOUT(3) = IN(3)
      IOUT(4) = IN(4)
      IF ( FIN(10).GT.50.0.OR.FIN(10).LT.0.001 ) GOTO 25
       OUT(9) = FIN(10)
       OUT(10) = FIN(11)
       BX = -FIN(14)
       BY = -FIN(15)
       BZ = FIN(16)
       IF ( BX.NE.0.0.AND.BY.NE.0.0 ) THEN
        OUT(11) = ATAN(BZ/SQRT(BX**2+BY**2)) * 180.0/PI
        OUT(12) = ATAN2(BY,BX) * 180.0/PI
       ENDIF
       IF ( OUT(12).LT.0.0 ) OUT(12) = OUT(12) + 360.0
   25 CONTINUE
      IF (FIN(26).GT.200.0.AND.FIN(26).LT.1500.0) THEN
       OUT(13) = FIN(26)
       OUT(14) = FIN(28)
       OUT(15) = -FIN(27)
      ENDIF
      IF (FIN(25).GT.0.001.AND.FIN(25).LT.100.0) OUT(16) = FIN(25)
      IF (FIN(24).GT.1.E3.AND.FIN(24).LT.1E7) OUT(17) = FIN(24)
      IOUT(23) = IDATE
      IOUT(24) = IN(36)
      IOUT(25) = IN(37)
      IOUT(30) = IN(5)
      IOUT(34) = IN(34)
      IOUT(35) = IN(6)
C
C CONFIRM DATA
C
      ISC = IOUT(1)
      YR = IOUT(2)
      DY = IOUT(3)
      HR = IOUT(4)
      F1 = OUT(10)
      DEL = OUT(11)
      LAM = OUT(12)
      DEN = OUT(16)
      TEM = OUT(17)
      VEL = OUT(13)
      VDEL = OUT(14)
      VLAM = OUT(15)
      ID = IN(6)
      IF (IOUT(4).EQ.0)
     & WRITE(6,900) ID,ISC,YR,DY,HR,F1,DEL,LAM,DEN,TEM,VEL,VDEL,VLAM
C
      WRITE(11,NUM=N) OUT
      GOTO 20
  100 CONTINUE
      WRITE(6,900) ID,ISC,YR,DY,HR,F1,DEL,LAM,DEN,TEM,VEL,VDEL,VLAM
      STOP
  900 FORMAT(2(1X,I2),1X,I2,1X,I3,1X,I2,3(1X,F6.2),1X,F5.1,1X,E10.4,
     &       3(1X,F6.1))
      END
//RUN EXEC LOADER
//SYSUDUMP DD DUMMY
//FT10F001 DD VOL=(PRIVATE,SER=OMNI),UNIT=T6250,LABEL=(,NL,,IN),
//            DCB=(RECFM=FB,LRECL=148,BLKSIZE=28416,DEN=3)
//*T11F001 DD DSN=Z1SBK.MSTRDS,DISP=MOD
//FT11F001 DD DSN=Z1SBK.HOURAVG0,DISP=OLD
//NOTIFY EXEC NTSO
//
//Z1SBKDSK JOB (U0016,N598,40),
//            TIME=(9,59),
//            CLASS=E,NOTIFY=Z1SBK,
//            MSGCLASS=X
//COPY10      EXEC PGM=IEBGENER,REGION=500K
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
//SYSUT1 DD UNIT=T3480,DISP=(OLD,KEEP),
//           DCB=(RECFM=U,BLKSIZE=11280),DSN=MAGEDR,
//           LABEL=(,SL,,IN),
//           VOL=(PRIVATE,SER=(78B216))
//SYSUT2 DD DSN=XRTPM.E78B216.EDR,UNIT=USERDA,
//           DISP=(NEW,CATLG,DELETE),
//           DCB=(RECFM=U,BLKSIZE=11280),
//           SPACE=(CYL,(200,10),RLSE)
//FTPIT EXEC PGM=FTP
//INPUT DD *
lepvgrcd 
anonymous
voyager
type i
cd v2
cd edr
cd y78
put 'XRTPM.E78B216.EDR' E78B216.EDR
dir
quit
//OUTPUT DD SYSOUT=*
//COPY11      EXEC PGM=IEBGENER,REGION=500K
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
//SYSUT1 DD UNIT=T3480,DISP=(OLD,KEEP),
//           DCB=(RECFM=U,BLKSIZE=11280),DSN=MAGEDR,
//           LABEL=(,SL,,IN),
//           VOL=(PRIVATE,SER=(78B221))
//SYSUT2 DD DSN=XRTPM.E78B221.EDR,UNIT=USERDA,
//           DISP=(NEW,CATLG,DELETE),
//           DCB=(RECFM=U,BLKSIZE=11280),
//           SPACE=(CYL,(200,10),RLSE)
//FTPIT EXEC PGM=FTP
//INPUT DD *
lepvgrcd 
anonymous
voyager
type i
cd v2
cd edr
cd y78
put 'XRTPM.E78B221.EDR' E78B221.EDR
dir
quit
//OUTPUT DD SYSOUT=*
//COPY12      EXEC PGM=IEBGENER,REGION=500K
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
//SYSUT1 DD UNIT=T3480,DISP=(OLD,KEEP),
//           DCB=(RECFM=U,BLKSIZE=11280),DSN=MAGEDR,
//           LABEL=(,SL,,IN),
//           VOL=(PRIVATE,SER=(78B226))
//SYSUT2 DD DSN=XRTPM.E78B226.EDR,UNIT=USERDA,
//           DISP=(NEW,CATLG,DELETE),
//           DCB=(RECFM=U,BLKSIZE=11280),
//           SPACE=(CYL,(200,10),RLSE)
//FTPIT EXEC PGM=FTP
//INPUT DD *
lepvgrcd 
anonymous
voyager
type i
cd v2
cd edr
cd y78
put 'XRTPM.E78B226.EDR' E78B226.EDR
dir
quit
//OUTPUT DD SYSOUT=*
//COPY13      EXEC PGM=IEBGENER,REGION=500K
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
//SYSUT1 DD UNIT=T3480,DISP=(OLD,KEEP),
//           DCB=(RECFM=U,BLKSIZE=11280),DSN=MAGEDR,
//           LABEL=(,SL,,IN),
//           VOL=(PRIVATE,SER=(78B231))
//SYSUT2 DD DSN=XRTPM.E78B231.EDR,UNIT=USERDA,
//           DISP=(NEW,CATLG,DELETE),
//           DCB=(RECFM=U,BLKSIZE=11280),
//           SPACE=(CYL,(200,10),RLSE)
//FTPIT EXEC PGM=FTP
//INPUT DD *
lepvgrcd 
anonymous
voyager
type i
cd v2
cd edr
cd y78
put 'XRTPM.E78B231.EDR' E78B231.EDR
dir
quit
//OUTPUT DD SYSOUT=*
//COPY14      EXEC PGM=IEBGENER,REGION=500K
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
//SYSUT1 DD UNIT=T3480,DISP=(OLD,KEEP),
//           DCB=(RECFM=U,BLKSIZE=11280),DSN=MAGEDR,
//           LABEL=(,SL,,IN),
//           VOL=(PRIVATE,SER=(78B236))
//SYSUT2 DD DSN=XRTPM.E78B236.EDR,UNIT=USERDA,
//           DISP=(NEW,CATLG,DELETE),
//           DCB=(RECFM=U,BLKSIZE=11280),
//           SPACE=(CYL,(200,10),RLSE)
//FTPIT EXEC PGM=FTP
//INPUT DD *
lepvgrcd 
anonymous
voyager
type i
cd v2
cd edr
cd y78
put 'XRTPM.E78B236.EDR' E78B236.EDR
dir
quit
//OUTPUT DD SYSOUT=*
//COPY15      EXEC PGM=IEBGENER,REGION=500K
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
//SYSUT1 DD UNIT=T3480,DISP=(OLD,KEEP),
//           DCB=(RECFM=U,BLKSIZE=11280),DSN=MAGEDR,
//           LABEL=(,SL,,IN),
//           VOL=(PRIVATE,SER=(78B241))
//SYSUT2 DD DSN=XRTPM.E78B241.EDR,UNIT=USERDA,
//           DISP=(NEW,CATLG,DELETE),
//           DCB=(RECFM=U,BLKSIZE=11280),
//           SPACE=(CYL,(200,10),RLSE)
//FTPIT EXEC PGM=FTP
//INPUT DD *
lepvgrcd 
anonymous
voyager
type i
cd v2
cd edr
cd y78
put 'XRTPM.E78B241.EDR' E78B241.EDR
dir
quit
//OUTPUT DD SYSOUT=*
//COPY16      EXEC PGM=IEBGENER,REGION=500K
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
//SYSUT1 DD UNIT=T3480,DISP=(OLD,KEEP),
//           DCB=(RECFM=U,BLKSIZE=11280),DSN=MAGEDR,
//           LABEL=(,SL,,IN),
//           VOL=(PRIVATE,SER=(78B246))
//SYSUT2 DD DSN=XRTPM.E78B246.EDR,UNIT=USERDA,
//           DISP=(NEW,CATLG,DELETE),
//           DCB=(RECFM=U,BLKSIZE=11280),
//           SPACE=(CYL,(200,10),RLSE)
//FTPIT EXEC PGM=FTP
//INPUT DD *
lepvgrcd 
anonymous
voyager
type i
cd v2
cd edr
cd y78
put 'XRTPM.E78B246.EDR' E78B246.EDR
dir
quit
//OUTPUT DD SYSOUT=*
//COPY17      EXEC PGM=IEBGENER,REGION=500K
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
//SYSUT1 DD UNIT=T3480,DISP=(OLD,KEEP),
//           DCB=(RECFM=U,BLKSIZE=11280),DSN=MAGEDR,
//           LABEL=(,SL,,IN),
//           VOL=(PRIVATE,SER=(78B251))
//SYSUT2 DD DSN=XRTPM.E78B251.EDR,UNIT=USERDA,
//           DISP=(NEW,CATLG,DELETE),
//           DCB=(RECFM=U,BLKSIZE=11280),
//           SPACE=(CYL,(200,10),RLSE)
//FTPIT EXEC PGM=FTP
//INPUT DD *
lepvgrcd 
anonymous
voyager
type i
cd v2
cd edr
cd y78
put 'XRTPM.E78B251.EDR' E78B251.EDR
dir
quit
//OUTPUT DD SYSOUT=*
//COPY18      EXEC PGM=IEBGENER,REGION=500K
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
//SYSUT1 DD UNIT=T3480,DISP=(OLD,KEEP),
//           DCB=(RECFM=U,BLKSIZE=11280),DSN=MAGEDR,
//           LABEL=(,SL,,IN),
//           VOL=(PRIVATE,SER=(78B256))
//SYSUT2 DD DSN=XRTPM.E78B256.EDR,UNIT=USERDA,
//           DISP=(NEW,CATLG,DELETE),
//           DCB=(RECFM=U,BLKSIZE=11280),
//           SPACE=(CYL,(200,10),RLSE)
//FTPIT EXEC PGM=FTP
//INPUT DD *
lepvgrcd 
anonymous
voyager
type i
cd v2
cd edr
cd y78
put 'XRTPM.E78B256.EDR' E78B256.EDR
dir
quit
//OUTPUT DD SYSOUT=*
//
//Z1SBKMRG JOB (U0016,N598,10),'SUMMARY MERGE',TIME=(2,00),
// CLASS=A,MSGCLASS=X,NOTIFY=Z1SBK
/*JOBPARM LINES=200
// EXEC FORTVCLG
C
C MERGE 48 SEC FIELD AND SUMMARY PLASMA SUMMARY DATA
C FROM POST-1990 IBM SUMMARY DATA FILES.
C WRITEN BY SANDY KRAMER, HUGHES-STX, CODE 694
C PORTED TO MVS FROM VMS BY SANDY KRAMER 12/03/93
C
      PARAMETER (IARR=10000,MAG=8,IPLS=6,NFIELD=14)
      CHARACTER*50 DSN,MAGDSN,PLSDSN,MRGDSN
      INTEGER*4 NUM(IARR,NFIELD),NOUT(NFIELD),DATE(6)
      REAL*4 DATA(IARR,NFIELD),AVG(IARR,NFIELD),
     &       FIELD(MAG),PLASMA(IPLS)
      REAL*8 TIME(IARR),T1,T2,TOUT(IARR),T,CONVERT,
     &       DECYR,DECDY
C
C PROGRAM START AND STOP TIMES YYDDDHH
C
      IBEG = 7730100
      IEND = 7730600
      T1 = CONVERT(IBEG)
      T2 = CONVERT(IEND)
C
C AVERAGING WINDOW OFFSET (SECONDS)
C
      BTIME =  0.0
C
C AVERAGING PERIOD (SECONDS)
C
      DTIME = 192.0
C
      MAGDSN = 'Z1SBK.V277A.MAG'
      PLSDSN = 'Z1SBK.V277A.PLF'
      MRGDSN = 'Z1SBK.V277A.MRG'
C
C GET SUMMARY MAG DATA
C
      DSN = MAGDSN
      OPEN(50,FILE='/'//DSN,STATUS='OLD',FORM='FORMATTED')
C
C MAG DATA FORMAT: F1,F2,BDELTA,BLAMBDA,BR,BT,BN,R
C
      NPTS = 0
   10 CONTINUE
       READ(50,*,END=100,ERR=10) ID,(DATE(J),J=1,6),(FIELD(I),I=1,MAG)
C      WRITE(6,801) ID,(DATE(J),J=1,6),(FIELD(I),I=1,MAG)
       T = DECYR(DATE)
C      IF (T.LT.T1) GOTO 10
C      IF (T.GE.T2) GOTO 100
       NPTS = NPTS + 1
       IF (NPTS.EQ.1) T1 = T
       TIME(NPTS) = T
       DO J=1,MAG
        IF (FIELD(1).NE.999.0) THEN
         DATA(NPTS,J) = FIELD(J)
        ELSE
         DATA(NPTS,J) = 999.0
        END IF
       END DO
C      WRITE(6,802) ID,TIME(NPTS),(DATA(NPTS,K),K=1,MAG)
      GOTO 10
  100 CONTINUE
  801 FORMAT(1X,I1,1X,I2,1X,I3,3(1X,I2),1X,I3,7(1X,F7.3),1X,F8.4)
  802 FORMAT(1X,I1,1X,F11.8,7(1X,F7.3),1X,F8.4)
      CLOSE(50)
      T2 = T
C
      WRITE(6,*)
      WRITE(6,'(1X,I5.5,'' RECORDS INPUTTED'')') NPTS
C
C CHECK NUMBER OF INPUT RECORDS IN BOUNDS
C
      IF (NPTS.GT.IARR) THEN
       WRITE(6,*)
       WRITE(6,*) 'REDIMENSION IARR GT ',NPTS
       GOTO 999
      END IF
C
C AVERAGE MAG DATA
C
C ALL DATA FIELDS ARE AVERAGED OVER THE SAME TIME PERIODS SUCH THAT EACH
C FIELD AVERAGE ARRAY SHARES A COMMON TIME AVERAGE ARRAY.
C
C     WRITE(6,*) 'ENTER RESOLUTION OF INPUT DATA (SECONDS)'
C     READ(5,*) BTIME
      BTIME = BTIME/3600.
C     WRITE(6,*) 'ENTER AVERAGING PERIOD (SECONDS)'
C     READ(5,*) DTIME
      DTIME = DTIME/3600.0
      NUMAVGS = NINT((T2-T1)/(DTIME/(24.0*DAYS(T1))))
C
C CHECK NUMBER CALCULATED AVERAGES IN BOUNDS
C
      IF (NUMAVGS.GT.IARR) THEN
       WRITE(6,*) 'EXPECTED NUMBER OF AVERAGES EXCEEDS PARAMETER IARR'
       WRITE(6,*) 'REDIMENSION IARR GT ',NUMAVGS
      END IF
      IF (NUMAVGS.GT.IARR) GOTO 999
      FILL = 999.0
      NMAX = 0
C
      WRITE(6,*)
      WRITE(6,*) 'BEGIN AVERAGING FIELDS'
      WRITE(6,*)
      DO IVAR = 1,MAG
       CALL HRAVG(T1,T2,FILL,BTIME,DTIME,TIME,DATA(1,IVAR),NPTS,
     &            TOUT,AVG(1,IVAR),NUM(1,IVAR),NOUT(IVAR))
       IF (IVAR.EQ.1) THEN
        NMAX = NOUT(IVAR)
       ELSE
        IF (NOUT(IVAR).NE.NMAX) WRITE(6,*) 'ARRAY PHASING ERROR'
       END IF
      END DO
      WRITE(6,*)
      WRITE(6,*) 'END AVERAGING FIELDS'
C
C GET SUMMARY PLASMA DATA
C
      DSN = PLSDSN
      OPEN(51,FILE='/'//DSN,STATUS='OLD',FORM='FORMATTED')
C
C SUPPRESS INVALID CHARACTER ERR MESSAGE IN PLASMA DATA READ
C
      CALL ERRSET(227,256,-1)
C
      NPTS = 0
  110 CONTINUE
       READ(51,*,END=200,ERR=110) ID,(DATE(J),J=1,6),
     &  (PLASMA(I),I=1,IPLS)
C      WRITE(6,901) ID,(DATE(J),J=1,6),(DATA(NPTS,K+MAG),K=1,IPLS)
       T = DECYR(DATE)
       IF (T.LT.T1) GOTO 110
       IF (T.GE.T2) GOTO 200
       NPTS = NPTS + 1
       TIME(NPTS) = T
       DO J=1,IPLS
        IF (PLASMA(J).NE.0.0) THEN
         DATA(NPTS,J+MAG) = PLASMA(J)
        ELSE
         DATA(NPTS,J+MAG) = 999.0
        END IF
       END DO
C      WRITE(6,902) ID,TIME(NPTS),(DATA(NPTS,K+MAG),K=1,IPLS)
      GOTO 110
  200 CONTINUE
  901 FORMAT(1X,I1,1X,I2,1X,I3,3(1X,I2),1X,I3,3(1X,F6.1),2(1X,E10.4),
     &       1X,F8.4)
  902 FORMAT(1X,I1,1X,F11.8,3(1X,F6.1),2(1X,E10.4),1X,F8.4)
      CLOSE(51)
C
      WRITE(6,*)
      WRITE(6,'(1X,I5.5,'' RECORDS INPUTTED'')') NPTS
C
C CHECK NUMBER OF INPUT RECORDS IN BOUNDS
C
      IF (NPTS.GT.IARR) THEN
       WRITE(6,*) 'REDIMENSION IARR GT ',NPTS
       GOTO 999
      END IF
C
C AVERAGE PLASMA DATA
C
C ALL DATA FIELDS ARE AVERAGED OVER THE SAME TIME PERIODS SUCH THAT EACH
C FIELD AVERAGE ARRAY SHARES A COMMON TIME AVERAGE ARRAY.
C
      NUMAVGS = NINT((T2-T1)/(DTIME/(24.0*DAYS(T1))))
C
C CHECK NUMBER CALCULATED AVERAGES IN BOUNDS
C
      IF (NUMAVGS.GT.IARR) THEN
       WRITE(6,*) 'EXPECTED NUMBER OF AVERAGES EXCEEDS PARAMETER IARR'
       WRITE(6,*) 'REDIMENSION IARR GT ',NUMAVGS
      END IF
      IF (NUMAVGS.GT.IARR) GOTO 999
      FILL = 999.0
      NMAX = 0
C
      WRITE(6,*)
      WRITE(6,*) 'BEGIN AVERAGING FIELDS'
      WRITE(6,*)
      DO IVAR = MAG+1,MAG+IPLS
       CALL HRAVG(T1,T2,FILL,BTIME,DTIME,TIME,DATA(1,IVAR),NPTS,
     &            TOUT,AVG(1,IVAR),NUM(1,IVAR),NOUT(IVAR))
       IF (IVAR.EQ.MAG+1) THEN
        NMAX = NOUT(IVAR)
       ELSE
        IF (NOUT(IVAR).NE.NMAX) WRITE(6,*) 'ARRAY PHASING ERROR'
       END IF
      END DO
      WRITE(6,*)
      WRITE(6,*) 'END AVERAGING FIELDS'
      WRITE(6,*)
C
  888 CONTINUE
      DSN = MRGDSN
C     OPEN(52,FILE='/'//DSN,STATUS='NEW',FORM='FORMATTED')
      DO K = 1,NMAX
       CALL GETDATE(TOUT(K),DATE)
C      WRITE(52,950) ID,TOUT(K),AVG(K,1),AVG(K,3),AVG(K,4),
C    &               AVG(K,9),AVG(K,10),AVG(K,11),AVG(K,12),
C    &               AVG(K,13),AVG(K,8)
       WRITE( 6,955) ID,DATE,AVG(K,1),AVG(K,3),AVG(K,4),
     &               AVG(K,9),AVG(K,10),AVG(K,11),AVG(K,12),
     &               AVG(K,13),AVG(K,8)
      END DO
C     CLOSE(52)
C
  999 CONTINUE
      STOP
  950 FORMAT(I1,1X,F12.9,1X,F7.3,2(1X,F6.2),
     &       1X,F6.1,2(1X,F6.2),2(1X,E10.4),1X,F6.2)
  955 FORMAT(1X,I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,1X,
     &       F7.3,2(1X,F6.2),
     &       1X,F6.1,2(1X,F6.2),2(1X,E10.4),1X,F6.2)
      END
      SUBROUTINE HRAVG(T1,T2,FILL,BTIME,DTIME,T,DATA,NPTS,
     &                 TOUT,DOUT,PARR,NOUT)
C
C PRODUCE AVERAGES OF PERIOD DTIME FROM INPUTTED HOUR AVERAGE DATA.
C ROUTINE DOES NOT REMOVE TIME POINTS WITH NULL AVERAGES.
C
      INTEGER*4 PARR(NPTS),DATE(6)
      REAL*4 DATA(NPTS),DOUT(NPTS)
      REAL*8 T(NPTS),TIME,TIME1,TIME2,TOUT(NPTS),T1,T2,TEND
C
C T1 START TIME
C T2 END TIME
C FILL  FILL DATA VALUE
C BTIME RESOLUTION OF INPUT DATA (HOURS)
C DTIME AVERAGING INTERVAL (HOURS)
C T     INPUT TIME ARRAY
C DATA  INPUT DATA ARRAY
C NPTS  NUMBER OF POINTS IN INPUT DATA
C TOUT  OUTPUT TIME ARRAY
C DOUT  OUTPUT ARRAY OF DTIME AVERAGES
C PARR  OUTPUT ARRAY - # OF AVGS/PT
C NOUT NUMBER OF POINTS IN OUTPUT DATA
C
      SUM = 0.0
      NUM = 0
      TEND = T2 + DBLE(BTIME/(100.0*24.0*DAYS(T2)))
C
      TIME1 = T1 - DBLE(BTIME/(100.0*24.0*DAYS(T1)))
      TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))
      IARR = 0
      INDEX = 0
  10  CONTINUE
       IARR = IARR + 1
       IF (IARR.GT.NPTS) GOTO 20
       TIME = T(IARR)
       VAL = DATA(IARR)
C
C GET DATA FROM PROPER TIME INTERVAL
C
  15   CONTINUE
       IF (TIME.LT.TIME1) GOTO 10
       IF (TIME.GE.TIME2) GOTO 20
       IF (TIME.GT.TEND) GOTO 20
C
C ACCUMULATE DATA NOT INCLUDING FILL POINTS
C
       IF (VAL.NE.FILL) THEN
        SUM = SUM + VAL
        NUM = NUM + 1
       END IF
C
      GOTO 10
   20 CONTINUE
C
C AVERAGE DATA AND INCREMENT TIME INTERVAL
C
       IF (NUM.NE.0) THEN
        AVG = SUM/FLOAT(NUM)
       ELSE
        AVG = FILL
       END IF
       INDEX = INDEX + 1
       TOUT(INDEX) = TIME1 + DBLE(BTIME/(100.0*24.0*DAYS(TIME1)))
       DOUT(INDEX) = AVG
       PARR(INDEX) = NUM
       TIME1 = TIME2
       TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))
       SUM = 0.0
       NUM = 0
      IF (IARR.LE.NPTS.AND.TIME.LE.TEND) GOTO 15
C
C RETURN FROM AVERAGING OVER DESIRED TIME INTERVAL
C
 100  CONTINUE
      WRITE(6,800) TOUT(1),TOUT(INDEX),INDEX
      CLOSE(10)
      NOUT = INDEX
C
      RETURN
 800  FORMAT(' START ',F12.8,'   STOP ',F12.8,'   POINTS ',I5)
      END
      REAL FUNCTION DAYS(TIME)
C
C RETURN NUMBER OF DAYS IN YEAR
C
      REAL*8 TIME
C
      IYR = INT(TIME)
      IF (MOD(IYR,4).EQ.0) THEN
       DAYS = 366.0
      ELSE
       DAYS = 365.0
      END IF
C
      RETURN
      END
      SUBROUTINE GETDATE(TIME,DATE)
C
C CONVERT DECIMAL YEAR TIME INTO INTEGER CALENDAR TIME
C
      INTEGER*4 DATE(6)
      REAL*8 TIME,LEAP,YEAR,DAY,HOUR,MIN,SEC,FSEC
C
      DATE(1) = INT(TIME)
      IF (MOD(DATE(1),4).EQ.0) THEN
       LEAP = 366.0
      ELSE
       LEAP = 365.0
      END IF
      DAY = (TIME-REAL(DATE(1)))*LEAP
      DATE(2) = INT(DAY)
      HOUR = (DAY-REAL(DATE(2)))*24.0
      DATE(3) = INT(HOUR)
      MIN = (HOUR-REAL(DATE(3)))*60.0
      DATE(4) = INT(MIN)
      SEC = (MIN-REAL(DATE(4)))*60.0
      DATE(5) = INT(SEC)
      FSEC = (SEC-REAL(DATE(5)))*1000.0
      DATE(6) = INT(FSEC)
C
C SET DAY 1 = JAN 1
C
      DATE(2) = DATE(2) + 1
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION DECDY(DATE)
C
C CONVERT INTEGER CALENDAR TIME TO DECIMAL DAY
C
      INTEGER*4 DATE(6)
      REAL*8 DAY,HOUR,MIN,SEC,MSEC
C
      MSEC = DFLOAT(DATE(6))
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0
      DAY = DFLOAT(DATE(2)) + HOUR/24.0D0
      DECDY = DAY
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION DECYR(DATE)
C
C CONVERT INTEGER CALENDAR TIME TO DECIMAL YEAR
C
      INTEGER*4 DATE(6)
      REAL*8 YEAR,DAY,HOUR,MIN,SEC,MSEC,LEAP
C
      LEAP = 365.0D0
      IF (MOD(DATE(1),4).EQ.0) LEAP = 366.0D0
      MSEC = DFLOAT(DATE(6))
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0
      DAY = DFLOAT(DATE(2)-1) + HOUR/24.0D0
      YEAR = DFLOAT(DATE(1)) + DAY/LEAP
      DECYR = YEAR
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION CONVERT(TIME)
C
C CONVERT REAL TIME TAG OF YYDDDHH FORMAT INTO DECIMAL YEAR
C
      CHARACTER CTIME*7
      INTEGER*4 TIME
      REAL*8 DTIME
C
      WRITE(CTIME,'(I7)') TIME
      READ(CTIME,'(I2,I3,I2)') IYR,IDY,IHR
C
      IF (MOD(IYR,4).EQ.0) THEN
       LEAP = 366.0D0
      ELSE
       LEAP = 365.0D0
      END IF
C
      DTIME = DBLE(IYR) + DBLE(IDY-1)/LEAP + DBLE(IHR)/24.0D0/LEAP
      CONVERT = DTIME
C
      RETURN
      END
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR
//GO.SYSUDUMP DD DUMMY
//TELL EXEC NOTIFY
//
//Z1SBKMRG JOB (U0016,N598,10),'SUMMARY MERGE',TIME=(2,00),
// CLASS=A,MSGCLASS=X,NOTIFY=Z1SBK
/*JOBPARM LINES=200
// EXEC FORTVCLG
C
C MERGE 48 SEC FIELD AND SUMMARY PLASMA SUMMARY DATA
C FROM PRE-1990 IBM SUMMARY DATA FILES.
C WRITEN BY SANDY KRAMER, HUGHES-STX, CODE 694
C PORTED TO MVS FROM VMS BY SANDY KRAMER 12/03/93
C
      PARAMETER (IARR=10000,MAG=8,IPLS=8,NFIELD=16)
      CHARACTER FLT*4
      CHARACTER*50 DSN,SUMDSN,MRGDSN
      INTEGER*2 ID,HDRTIME(6)
      INTEGER*4 NUM(IARR,NFIELD),NOUT(NFIELD),DATE(6)
      REAL*4 DATA(IARR,NFIELD),AVG(IARR,NFIELD),
     &       FIELD(496),PLASMA(150),FIN(1000),
     &       HEADER(32),MSEDR(40)
      REAL*8 TIME(IARR,2),T1,T2,TOUT(IARR),T,
     &       CONVERT,DECYR,DECDY,DD
C
      EQUIVALENCE (HEADER(1),FIN(1)),  (HDRTIME(1),HEADER(4)),
     &            (ID,HEADER(17)),     (FIELD(1),FIN(33)),
     &            (PLASMA(1),FIN(33)), (MSEDR(1),FIN(529)),
     &            (FLT,HEADER(3))
C
C AVERAGING WINDOW OFFSET (SECONDS)
C
      BTIME =  0.0
C
C AVERAGING PERIOD (SECONDS)
C
      DTIME = 192.0
C
      SUMDSN = 'U0#16.UNITTREE.V2.D7730100'
C
C GET SUMMARY MAG DATA
C
      DSN = SUMDSN
      OPEN(10,FILE='/'//DSN,STATUS='OLD',FORM='UNFORMATTED')
C
C READ SUMMARY DATASET.  EXTRACT MAG OR PLASMA AS APPROPRIATE.
C
      BLT = 1.38066E-23
      PRTN = 1.67265E-27
      NPTS = 0
      NMAG = 0
      NPLS = 0
   10 CONTINUE
       READ(10,NUM=LEN,END=100,ERR=10) FIN
       DATE(1) = HDRTIME(1)
       DATE(2) = HDRTIME(2)
       DATE(3) = HDRTIME(3)
       DATE(4) = HDRTIME(4)
       DATE(5) = HDRTIME(5)
       DATE(6) = HDRTIME(6)
       IF (ID.EQ.1) THEN
C MAG RECORD
        READ(FLT,'(3X,I1)') ISC
        NMAG = NMAG + 1
        TIME(NMAG,1) = DECYR(DATE)
        IF (FIELD(1).LT.999.0) THEN
C FIELD MAGNITUDE
         DATA(NMAG,1) = FIELD(1)
C FIELD MODULUS
         DATA(NMAG,2) = FIELD(2)
C LATITUDINAL FIELD ANGLE
         DATA(NMAG,3) = FIELD(3)
C LONGITUDINAL FIELD ANGLE
         DATA(NMAG,4) = FIELD(4)
C FIELD RADIAL COMPONENT
         DATA(NMAG,5) = FIELD(5)
C FIELD TANGENTIAL COMPONENT
         DATA(NMAG,6) = FIELD(6)
C FIELD NORMAL COMPONENT
         DATA(NMAG,7) = FIELD(7)
        ELSE
         DATA(NMAG,1) = 999.0
         DATA(NMAG,2) = 999.0
         DATA(NMAG,3) = 999.0
         DATA(NMAG,4) = 999.0
         DATA(NMAG,5) = 999.0
         DATA(NMAG,6) = 999.0
         DATA(NMAG,7) = 999.0
        END IF
C S/C DISTANCE
        DATA(NMAG,8) = MSEDR(11)
C       WRITE(6,801) ISC,DATE,(DATA(NMAG,I),I=1,8)
       ELSE IF (ID.EQ.3) THEN
        READ(FLT,'(3X,I1)') ISC
C PLASMA RECORD
        NPLS = NPLS + 1
        TIME(NPLS,2) = DECYR(DATE)
C ION VELOCITY MAGNITUDE (FIT)
        IF (0.0.LT.PLASMA(108).AND.PLASMA(108).LT.1500.0) THEN
         DATA(NPLS,9) = PLASMA(108)
C ION VELOCITY RADIAL COMPONENT (FIT)
         DATA(NPLS,10) = PLASMA(105)
C ION VELOCITY TANGENTIAL COMPONENT (FIT)
         DATA(NPLS,11) = PLASMA(106)
C ION VELOCITY NORMAL COMPONENT (FIT)
         DATA(NPLS,12) = PLASMA(107)
C LATITUDINAL FLOW ANGLE
         DATA(NPLS,13) = PLASMA(109)
C LONGITUDINAL FLOW ANGLE
         DATA(NPLS,14) = PLASMA(110)
        ELSE
         DATA(NPLS,9) = 999.0
         DATA(NPLS,10) = 999.0
         DATA(NPLS,11) = 999.0
         DATA(NPLS,12) = 999.0
         DATA(NPLS,13) = 999.0
         DATA(NPLS,14) = 999.0
        END IF
C ION DENSITY
        IF (0.0.LT.PLASMA(52).AND.PLASMA(52).LT.1.0E10) THEN
         DATA(NPLS,15) = PLASMA(52)
        ELSE
         DATA(NPLS,15) = 999.0
        END IF
C ION TEMPERATURE (FIT)
        WFIT = PLASMA(53)
        IF (WFIT.GT.0.AND.WFIT.LT.1.0E10) THEN
         DATA(NPLS,16) = PRTN*(WFIT*1000.0)**2.0/(2.0*BLT)
        ELSE
         DATA(NPLS,16) = 999.0
        END IF
C       WRITE(6,901) ISC,DATE,(DATA(NPLS,I),I=10,17)
       END IF
C
       NPTS = NMAG + NPLS
       IF (NPTS.EQ.1) T1 = DECYR(DATE)
      GOTO 10
C
  100 CONTINUE
  801 FORMAT(1X,I1,1X,I2,1X,I3,3(1X,I2),1X,I3,7(1X,F7.3),1X,F8.4)
  802 FORMAT(1X,I1,1X,F11.8,7(1X,F7.3),1X,F8.4)
  901 FORMAT(1X,I1,1X,I2,1X,I3,3(1X,I2),1X,I3,4(1X,F6.1),2(1X,F6.2),
     &       2(1X,E10.4))
      CLOSE(10)
      T2 = DECYR(DATE)
      WRITE(6,*) 'START TIME (T1)',T1
      WRITE(6,*) 'END TIME (T2)  ',T2
C
      WRITE(6,*)
      WRITE(6,'(1X,I5.5,'' MAG RECORDS INPUTTED'')') NMAG
      WRITE(6,'(1X,I5.5,'' PLS RECORDS INPUTTED'')') NPLS
C
C AVERAGE MAG DATA
C
C ALL DATA FIELDS ARE AVERAGED OVER THE SAME TIME PERIODS SUCH THAT EACH
C FIELD AVERAGE ARRAY SHARES A COMMON TIME AVERAGE ARRAY.
C
C     WRITE(6,*) 'ENTER RESOLUTION OF INPUT DATA (SECONDS)'
C     READ(5,*) BTIME
      BTIME = BTIME/3600.
C     WRITE(6,*) 'ENTER AVERAGING PERIOD (SECONDS)'
C     READ(5,*) DTIME
      DTIME = DTIME/3600.0
      NUMAVGS = NINT((T2-T1)/(DTIME/(24.0*DAYS(T1))))
C
C CHECK NUMBER CALCULATED AVERAGES IN BOUNDS
C
      IF (NUMAVGS.GT.IARR) THEN
       WRITE(6,*) 'EXPECTED NUMBER OF AVERAGES EXCEEDS PARAMETER IARR'
       WRITE(6,*) 'REDIMENSION IARR GT ',NUMAVGS
      END IF
      IF (NUMAVGS.GT.IARR) GOTO 999
C AVERAGE MAG DATA
      WRITE(6,*)
      WRITE(6,*) 'BEGIN AVERAGING MAG DATA'
      WRITE(6,*)
      FILL = 999.0
      MAXM = 0
      DO IVAR = 1,MAG
       CALL HRAVG(T1,T2,FILL,BTIME,DTIME,TIME(1,1),DATA(1,IVAR),NMAG,
     &            TOUT,AVG(1,IVAR),NUM(1,IVAR),NOUT(IVAR))
       IF (IVAR.EQ.1) THEN
        MAXM = NOUT(IVAR)
       ELSE
        IF (NOUT(IVAR).NE.MAXM) WRITE(6,*) 'ARRAY PHASING ERROR'
       END IF
      END DO
C AVERAGE PLASMA DATA
      WRITE(6,*)
      WRITE(6,*) 'BEGIN AVERAGING PLS DATA'
      WRITE(6,*)
      FILL = 999.0
      MAXP = 0
      DO IVAR = MAG+1,MAG+IPLS
       CALL HRAVG(T1,T2,FILL,BTIME,DTIME,TIME(1,2),DATA(1,IVAR),NPLS,
     &            TOUT,AVG(1,IVAR),NUM(1,IVAR),NOUT(IVAR))
       IF (IVAR.EQ.1+MAG) THEN
        MAXP = NOUT(IVAR)
       ELSE
        IF (NOUT(IVAR).NE.MAXP) WRITE(6,*) 'ARRAY PHASING ERROR'
       END IF
      END DO
C
      IF (MAXP.GT.MAXM) THEN
       NMAX = MAXM
      ELSE
       NAMX = MAXP
      END IF
C
      WRITE(6,*)
      WRITE(6,*) 'END SUMMARY AVERAGING'
      WRITE(6,*)
C
      DSN = MRGDSN
C     OPEN(52,FILE='/'//DSN,STATUS='NEW',FORM='FORMATTED')
C
C OUTPUT S/C ID,TIME,F1,BR,BT,BN,V,VR,VT,VN,N,T,R
C
      DO K = 1,NMAX
       CALL GETDATE(TOUT(K),DATE)
       DD = DECDY(DATE)
C      WRITE(52,950) ISC,TOUT(K),AVG(K,1),AVG(K,3),AVG(K,4),
C    &               AVG(K,9),AVG(K,10),AVG(K,11),AVG(K,12),
C    &               AVG(K,13),AVG(K,8)
       WRITE( 6,956) ISC,DATE(1),DD,AVG(K,2),AVG(K,5),AVG(K,6),
     &               AVG(K,7),AVG(K,9),AVG(K,10),AVG(K,11),
     &               AVG(K,12),AVG(K,15),AVG(K,16),AVG(K,8)
      END DO
C     CLOSE(52)
C
  999 CONTINUE
      STOP
  950 FORMAT(I1,1X,F12.9,1X,F7.3,2(1X,F6.2),
     &       1X,F6.1,2(1X,F6.2),2(1X,E10.4),1X,F6.2)
  955 FORMAT(1X,I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,
     &       4(1X,F7.3),4(1X,F6.1),2(1X,E10.4),1X,F8.4)
  956 FORMAT(1X,I1,1X,I2,1X,F12.8,
     &       4(1X,F7.3),4(1X,F6.1),2(1X,E10.4),1X,F8.4)
      END
      SUBROUTINE HRAVG(T1,T2,FILL,BTIME,DTIME,T,DATA,NPTS,
     &                 TOUT,DOUT,PARR,NOUT)
C
C PRODUCE AVERAGES OF PERIOD DTIME FROM INPUTTED HOUR AVERAGE DATA.
C ROUTINE DOES NOT REMOVE TIME POINTS WITH NULL AVERAGES.
C
      INTEGER*4 PARR(NPTS),DATE(6)
      REAL*4 DATA(NPTS),DOUT(NPTS)
      REAL*8 T(NPTS),TIME,TIME1,TIME2,TOUT(NPTS),T1,T2,TEND
C
C T1 START TIME
C T2 END TIME
C FILL  FILL DATA VALUE
C BTIME RESOLUTION OF INPUT DATA (HOURS)
C DTIME AVERAGING INTERVAL (HOURS)
C T     INPUT TIME ARRAY
C DATA  INPUT DATA ARRAY
C NPTS  NUMBER OF POINTS IN INPUT DATA
C TOUT  OUTPUT TIME ARRAY
C DOUT  OUTPUT ARRAY OF DTIME AVERAGES
C PARR  OUTPUT ARRAY - # OF AVGS/PT
C NOUT NUMBER OF POINTS IN OUTPUT DATA
C
      SUM = 0.0
      NUM = 0
      TEND = T2 + DBLE(BTIME/(100.0*24.0*DAYS(T2)))
C
      TIME1 = T1 - DBLE(BTIME/(100.0*24.0*DAYS(T1)))
      TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))
      IARR = 0
      INDEX = 0
  10  CONTINUE
       IARR = IARR + 1
       IF (IARR.GT.NPTS) GOTO 20
       TIME = T(IARR)
       VAL = DATA(IARR)
C
C GET DATA FROM PROPER TIME INTERVAL
C
  15   CONTINUE
       IF (TIME.LT.TIME1) GOTO 10
       IF (TIME.GE.TIME2) GOTO 20
       IF (TIME.GT.TEND) GOTO 20
C
C ACCUMULATE DATA NOT INCLUDING FILL POINTS
C
       IF (VAL.NE.FILL) THEN
        SUM = SUM + VAL
        NUM = NUM + 1
       END IF
C
      GOTO 10
   20 CONTINUE
C
C AVERAGE DATA AND INCREMENT TIME INTERVAL
C
       IF (NUM.NE.0) THEN
        AVG = SUM/FLOAT(NUM)
       ELSE
        AVG = FILL
       END IF
       INDEX = INDEX + 1
       TOUT(INDEX) = TIME1 + DBLE(BTIME/(100.0*24.0*DAYS(TIME1)))
       DOUT(INDEX) = AVG
       PARR(INDEX) = NUM
       TIME1 = TIME2
       TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))
       SUM = 0.0
       NUM = 0
      IF (IARR.LE.NPTS.AND.TIME.LE.TEND) GOTO 15
C
C RETURN FROM AVERAGING OVER DESIRED TIME INTERVAL
C
 100  CONTINUE
      WRITE(6,800) TOUT(1),TOUT(INDEX),INDEX
      CLOSE(10)
      NOUT = INDEX
C
      RETURN
 800  FORMAT(' START ',F12.8,'   STOP ',F12.8,'   POINTS ',I5)
      END
      REAL FUNCTION DAYS(TIME)
C
C RETURN NUMBER OF DAYS IN YEAR
C
      REAL*8 TIME
C
      IYR = INT(TIME)
      IF (MOD(IYR,4).EQ.0) THEN
       DAYS = 366.0
      ELSE
       DAYS = 365.0
      END IF
C
      RETURN
      END
      SUBROUTINE GETDATE(TIME,DATE)
C
C CONVERT DECIMAL YEAR TIME INTO INTEGER CALENDAR TIME
C
      INTEGER*4 DATE(6)
      REAL*8 TIME,LEAP,YEAR,DAY,HOUR,MIN,SEC,FSEC
C
      DATE(1) = INT(TIME)
      IF (MOD(DATE(1),4).EQ.0) THEN
       LEAP = 366.0
      ELSE
       LEAP = 365.0
      END IF
      DAY = (TIME-REAL(DATE(1)))*LEAP
      DATE(2) = INT(DAY)
      HOUR = (DAY-REAL(DATE(2)))*24.0
      DATE(3) = INT(HOUR)
      MIN = (HOUR-REAL(DATE(3)))*60.0
      DATE(4) = INT(MIN)
      SEC = (MIN-REAL(DATE(4)))*60.0
      DATE(5) = INT(SEC)
      FSEC = (SEC-REAL(DATE(5)))*1000.0
      DATE(6) = INT(FSEC)
C
C SET DAY 1 = JAN 1
C
      DATE(2) = DATE(2) + 1
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION DECDY(DATE)
C
C CONVERT INTEGER CALENDAR TIME TO DECIMAL DAY
C
      INTEGER*4 DATE(6)
      REAL*8 DAY,HOUR,MIN,SEC,MSEC
C
      MSEC = DFLOAT(DATE(6))
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0
      DAY = DFLOAT(DATE(2)) + HOUR/24.0D0
      DECDY = DAY
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION DECYR(DATE)
C
C CONVERT INTEGER CALENDAR TIME TO DECIMAL YEAR
C
      INTEGER*4 DATE(6)
      REAL*8 YEAR,DAY,HOUR,MIN,SEC,MSEC,LEAP
C
      LEAP = 365.0D0
      IF (MOD(DATE(1),4).EQ.0) LEAP = 366.0D0
      MSEC = DFLOAT(DATE(6))
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0
      DAY = DFLOAT(DATE(2)-1) + HOUR/24.0D0
      YEAR = DFLOAT(DATE(1)) + DAY/LEAP
      DECYR = YEAR
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION CONVERT(TIME)
C
C CONVERT REAL TIME TAG OF YYDDDHH FORMAT INTO DECIMAL YEAR
C
      CHARACTER CTIME*7
      INTEGER*4 TIME
      REAL*8 DTIME
C
      WRITE(CTIME,'(I7)') TIME
      READ(CTIME,'(I2,I3,I2)') IYR,IDY,IHR
C
      IF (MOD(IYR,4).EQ.0) THEN
       LEAP = 366.0D0
      ELSE
       LEAP = 365.0D0
      END IF
C
      DTIME = DBLE(IYR) + DBLE(IDY-1)/LEAP + DBLE(IHR)/24.0D0/LEAP
      CONVERT = DTIME
C
      RETURN
      END
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR
//GO.SYSUDUMP DD DUMMY
//TELL EXEC NOTIFY
//
C
C MERGE 48 SEC FIELD AND SUMMARY PLASMA SUMMARY DATA
C FROM PRE-1990 IBM SUMMARY DATA FILES.
C WRITEN BY SANDY KRAMER, HUGHES-STX, CODE 694
C PORTED TO MVS FROM VMS BY SANDY KRAMER 12/03/93
C
      PARAMETER (IARR=30000,MAG=8,IPLS=8,NFIELD=16)
      CHARACTER FLT*4
      CHARACTER*50 DSN,SUMDSN,MRGDSN
      INTEGER*2 ID,HDRTIME(6)
      INTEGER*4 NUM(IARR,NFIELD),NOUT(NFIELD),DATE(6)
      REAL*4 DATA(IARR,NFIELD),AVG(IARR,NFIELD),
     &       FIELD(496),PLASMA(150),FIN(1000),
     &       HEADER(32),MSEDR(40)
      REAL*8 TIME(IARR,2),T1,T2,TOUT(IARR),T,
     &       CONVERT,DECYR,DECDY,DD
C
      EQUIVALENCE (HEADER(1),FIN(1)),  (HDRTIME(1),HEADER(4)),
     &            (ID,HEADER(17)),     (FIELD(1),FIN(33)),
     &            (PLASMA(1),FIN(33)), (MSEDR(1),FIN(529)),
     &            (FLT,HEADER(3))
      WRITE(6,*)
C
C AVERAGING WINDOW OFFSET (SECONDS)
C
      BTIME =  0.0
C
C INPUT SUMMARY DATASET
C
      READ(5,'(A)') SUMDSN
C     SUMDSN = 'U0#16.UNITTREE.V2.D7730100'
      WRITE(6,'(1X,''INPUT SUMMARY DATASET:  '',A50)') SUMDSN
      WRITE(6,*)
C
C AVERAGING PERIOD (SECONDS)
C
      READ(5,*) DTIME
C     DTIME = 48.0
      WRITE(6,'(1X,''AVERAGING PERIOD (SEC):  '',F7.2)') DTIME
      WRITE(6,*)
C
C OUTPUT MERGED DATASET
C
      READ(5,'(A)') MRGDSN
C     MRGDSN = 'Z1SBK.MRG.OUT'
      WRITE(6,'(1X,''OUTPUT MERGED DATASET:  '',A50)') MRGDSN
      WRITE(6,*)
C
C GET SUMMARY MAG DATA
C
      DSN = SUMDSN
      OPEN(10,FILE='/'//DSN,STATUS='OLD',FORM='UNFORMATTED')
C
C READ SUMMARY DATASET.  EXTRACT MAG OR PLASMA AS APPROPRIATE.
C
      BLT = 1.38066E-23
      PRTN = 1.67265E-27
      NPTS = 0
      NMAG = 0
      NPLS = 0
   10 CONTINUE
       READ(10,NUM=LEN,END=100,ERR=10) FIN
       DATE(1) = HDRTIME(1)
       DATE(2) = HDRTIME(2)
       DATE(3) = HDRTIME(3)
       DATE(4) = HDRTIME(4)
       DATE(5) = HDRTIME(5)
       DATE(6) = HDRTIME(6)
       IF (ID.EQ.1) THEN
C MAG RECORD
        READ(FLT,'(3X,I1)') ISC
        NMAG = NMAG + 1
        TIME(NMAG,1) = DECYR(DATE)
        IF (FIELD(1).LT.999.0) THEN
C FIELD MAGNITUDE
         DATA(NMAG,1) = FIELD(1)
C FIELD MODULUS
         DATA(NMAG,2) = FIELD(2)
C LATITUDINAL FIELD ANGLE
         DATA(NMAG,3) = FIELD(3)
C LONGITUDINAL FIELD ANGLE
         DATA(NMAG,4) = FIELD(4)
C FIELD RADIAL COMPONENT
         DATA(NMAG,5) = FIELD(5)
C FIELD TANGENTIAL COMPONENT
         DATA(NMAG,6) = FIELD(6)
C FIELD NORMAL COMPONENT
         DATA(NMAG,7) = FIELD(7)
        ELSE
         DATA(NMAG,1) = 999.0
         DATA(NMAG,2) = 999.0
         DATA(NMAG,3) = 999.0
         DATA(NMAG,4) = 999.0
         DATA(NMAG,5) = 999.0
         DATA(NMAG,6) = 999.0
         DATA(NMAG,7) = 999.0
        END IF
C S/C DISTANCE
        DATA(NMAG,8) = MSEDR(11)
C       WRITE(6,801) ISC,DATE,(DATA(NMAG,I),I=1,8)
       ELSE IF (ID.EQ.3) THEN
        READ(FLT,'(3X,I1)') ISC
C PLASMA RECORD
        NPLS = NPLS + 1
        TIME(NPLS,2) = DECYR(DATE)
C ION VELOCITY MAGNITUDE (FIT)
        IF (0.0.LT.PLASMA(108).AND.PLASMA(108).LT.1500.0) THEN
         DATA(NPLS,9) = PLASMA(108)
C ION VELOCITY RADIAL COMPONENT (FIT)
         DATA(NPLS,10) = PLASMA(105)
C ION VELOCITY TANGENTIAL COMPONENT (FIT)
         DATA(NPLS,11) = PLASMA(106)
C ION VELOCITY NORMAL COMPONENT (FIT)
         DATA(NPLS,12) = PLASMA(107)
C LATITUDINAL FLOW ANGLE
         DATA(NPLS,13) = PLASMA(109)
C LONGITUDINAL FLOW ANGLE
         DATA(NPLS,14) = PLASMA(110)
        ELSE
         DATA(NPLS,9) = 999.0
         DATA(NPLS,10) = 999.0
         DATA(NPLS,11) = 999.0
         DATA(NPLS,12) = 999.0
         DATA(NPLS,13) = 999.0
         DATA(NPLS,14) = 999.0
        END IF
C ION DENSITY
        IF (0.0.LT.PLASMA(52).AND.PLASMA(52).LT.1.0E10) THEN
         DATA(NPLS,15) = PLASMA(52)
        ELSE
         DATA(NPLS,15) = 999.0
        END IF
C ION TEMPERATURE (FIT)
        WFIT = PLASMA(53)
        IF (WFIT.GT.0.AND.WFIT.LT.1.0E10) THEN
         DATA(NPLS,16) = PRTN*(WFIT*1000.0)**2.0/(2.0*BLT)
        ELSE
         DATA(NPLS,16) = 999.0
        END IF
C       WRITE(6,901) ISC,DATE,(DATA(NPLS,I),I=10,17)
       END IF
C
       NPTS = NMAG + NPLS
       IF (NPTS.EQ.1) T1 = DECYR(DATE)
      GOTO 10
C
  100 CONTINUE
  801 FORMAT(1X,I1,1X,I2,1X,I3,3(1X,I2),1X,I3,7(1X,F7.3),1X,F8.4)
  802 FORMAT(1X,I1,1X,F11.8,7(1X,F7.3),1X,F8.4)
  901 FORMAT(1X,I1,1X,I2,1X,I3,3(1X,I2),1X,I3,4(1X,F6.1),2(1X,F6.2),
     &       2(1X,E10.4))
      CLOSE(10)
      T2 = DECYR(DATE)
      WRITE(6,*) 'START TIME (T1)',T1
      WRITE(6,*) 'END TIME (T2)  ',T2
C
      WRITE(6,*)
      WRITE(6,'(1X,I5.5,'' MAG RECORDS INPUTTED'')') NMAG
      WRITE(6,'(1X,I5.5,'' PLS RECORDS INPUTTED'')') NPLS
C
C AVERAGE MAG DATA
C
C ALL DATA FIELDS ARE AVERAGED OVER THE SAME TIME PERIODS SUCH THAT EACH
C FIELD AVERAGE ARRAY SHARES A COMMON TIME AVERAGE ARRAY.
C
C     WRITE(6,*) 'ENTER RESOLUTION OF INPUT DATA (SECONDS)'
C     READ(5,*) BTIME
      BTIME = BTIME/3600.
C     WRITE(6,*) 'ENTER AVERAGING PERIOD (SECONDS)'
C     READ(5,*) DTIME
      DTIME = DTIME/3600.0
      NUMAVGS = NINT((T2-T1)/(DTIME/(24.0*DAYS(T1))))
C
C CHECK NUMBER CALCULATED AVERAGES IN BOUNDS
C
      IF (NUMAVGS.GT.IARR) THEN
       WRITE(6,*) 'EXPECTED NUMBER OF AVERAGES EXCEEDS PARAMETER IARR'
       WRITE(6,*) 'REDIMENSION IARR GT ',NUMAVGS
      END IF
      IF (NUMAVGS.GT.IARR) GOTO 999
C AVERAGE MAG DATA
      WRITE(6,*)
      WRITE(6,*) 'BEGIN AVERAGING MAG DATA'
      WRITE(6,*)
      FILL = 999.0
      MAXM = 0
      DO IVAR = 1,MAG
       CALL HRAVG(T1,T2,FILL,BTIME,DTIME,TIME(1,1),DATA(1,IVAR),NMAG,
     &            TOUT,AVG(1,IVAR),NUM(1,IVAR),NOUT(IVAR))
       IF (IVAR.EQ.1) THEN
        MAXM = NOUT(IVAR)
       ELSE
        IF (NOUT(IVAR).NE.MAXM) WRITE(6,*) 'ARRAY PHASING ERROR'
       END IF
      END DO
C AVERAGE PLASMA DATA
      WRITE(6,*)
      WRITE(6,*) 'BEGIN AVERAGING PLS DATA'
      WRITE(6,*)
      FILL = 999.0
      MAXP = 0
      DO IVAR = MAG+1,MAG+IPLS
       CALL HRAVG(T1,T2,FILL,BTIME,DTIME,TIME(1,2),DATA(1,IVAR),NPLS,
     &            TOUT,AVG(1,IVAR),NUM(1,IVAR),NOUT(IVAR))
       IF (IVAR.EQ.1+MAG) THEN
        MAXP = NOUT(IVAR)
       ELSE
        IF (NOUT(IVAR).NE.MAXP) WRITE(6,*) 'ARRAY PHASING ERROR'
       END IF
      END DO
C
      IF (MAXP.GT.MAXM) THEN
       NMAX = MAXM
      ELSE
       NMAX = MAXP
      END IF
C
      WRITE(6,*)
      WRITE(6,*) 'END SUMMARY AVERAGING'
      WRITE(6,*)
C
      DSN = MRGDSN
      CALL FILEINF(IRCODE,'DEVICE','TEMPDA','RECFM','VBA',
     & 'LRECL',132,'TRK',500,'SECOND',100)
      OPEN(52,FILE='/'//DSN,STATUS='NEW',FORM='FORMATTED')
C
C OUTPUT S/C ID,TIME,F1,BR,BT,BN,V,VR,VT,VN,N,T,R
C
      DO K = 1,NMAX
       CALL GETDATE(TOUT(K),DATE)
       DD = DECDY(DATE)
C      WRITE(52,950) ISC,TOUT(K),AVG(K,1),AVG(K,3),AVG(K,4),
C    &               AVG(K,9),AVG(K,10),AVG(K,11),AVG(K,12),
C    &               AVG(K,13),AVG(K,8)
       WRITE(52,956) ISC,DATE(1),DD,AVG(K,2),AVG(K,5),AVG(K,6),
     &               AVG(K,7),AVG(K,9),AVG(K,10),AVG(K,11),
     &               AVG(K,12),AVG(K,15),AVG(K,16),AVG(K,8)
      END DO
      CLOSE(52)
C
  999 CONTINUE
      STOP
  950 FORMAT(I1,1X,F12.9,1X,F7.3,2(1X,F6.2),
     &       1X,F6.1,2(1X,F6.2),2(1X,E10.4),1X,F6.2)
  955 FORMAT(1X,I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,
     &       4(1X,F7.3),4(1X,F6.1),2(1X,E10.4),1X,F8.4)
  956 FORMAT(I1,1X,I2,1X,F12.8,
     &       4(1X,F7.3),4(1X,F6.1),2(1X,E10.4),1X,F8.4)
      END
      SUBROUTINE HRAVG(T1,T2,FILL,BTIME,DTIME,T,DATA,NPTS,
     &                 TOUT,DOUT,PARR,NOUT)
C
C PRODUCE AVERAGES OF PERIOD DTIME FROM INPUTTED HOUR AVERAGE DATA.
C ROUTINE DOES NOT REMOVE TIME POINTS WITH NULL AVERAGES.
C
      INTEGER*4 PARR(NPTS),DATE(6)
      REAL*4 DATA(NPTS),DOUT(NPTS)
      REAL*8 T(NPTS),TIME,TIME1,TIME2,TOUT(NPTS),T1,T2,TEND
C
C T1 START TIME
C T2 END TIME
C FILL  FILL DATA VALUE
C BTIME RESOLUTION OF INPUT DATA (HOURS)
C DTIME AVERAGING INTERVAL (HOURS)
C T     INPUT TIME ARRAY
C DATA  INPUT DATA ARRAY
C NPTS  NUMBER OF POINTS IN INPUT DATA
C TOUT  OUTPUT TIME ARRAY
C DOUT  OUTPUT ARRAY OF DTIME AVERAGES
C PARR  OUTPUT ARRAY - # OF AVGS/PT
C NOUT NUMBER OF POINTS IN OUTPUT DATA
C
      SUM = 0.0
      NUM = 0
      TEND = T2 + DBLE(BTIME/(100.0*24.0*DAYS(T2)))
C
      TIME1 = T1 - DBLE(BTIME/(100.0*24.0*DAYS(T1)))
      TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))
      IARR = 0
      INDEX = 0
  10  CONTINUE
       IARR = IARR + 1
       IF (IARR.GT.NPTS) GOTO 20
       TIME = T(IARR)
       VAL = DATA(IARR)
C
C GET DATA FROM PROPER TIME INTERVAL
C
  15   CONTINUE
       IF (TIME.LT.TIME1) GOTO 10
       IF (TIME.GE.TIME2) GOTO 20
       IF (TIME.GT.TEND) GOTO 20
C
C ACCUMULATE DATA NOT INCLUDING FILL POINTS
C
       IF (VAL.NE.FILL) THEN
        SUM = SUM + VAL
        NUM = NUM + 1
       END IF
C
      GOTO 10
   20 CONTINUE
C
C AVERAGE DATA AND INCREMENT TIME INTERVAL
C
       IF (NUM.NE.0) THEN
        AVG = SUM/FLOAT(NUM)
       ELSE
        AVG = FILL
       END IF
       INDEX = INDEX + 1
       TOUT(INDEX) = TIME1 + DBLE(BTIME/(100.0*24.0*DAYS(TIME1)))
       DOUT(INDEX) = AVG
       PARR(INDEX) = NUM
       TIME1 = TIME2
       TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))
       SUM = 0.0
       NUM = 0
      IF (IARR.LE.NPTS.AND.TIME.LE.TEND) GOTO 15
C
C RETURN FROM AVERAGING OVER DESIRED TIME INTERVAL
C
 100  CONTINUE
      WRITE(6,800) TOUT(1),TOUT(INDEX),INDEX
      CLOSE(10)
      NOUT = INDEX
C
      RETURN
 800  FORMAT(' START ',F12.8,'   STOP ',F12.8,'   POINTS ',I5)
      END
      REAL FUNCTION DAYS(TIME)
C
C RETURN NUMBER OF DAYS IN YEAR
C
      REAL*8 TIME
C
      IYR = INT(TIME)
      IF (MOD(IYR,4).EQ.0) THEN
       DAYS = 366.0
      ELSE
       DAYS = 365.0
      END IF
C
      RETURN
      END
      SUBROUTINE GETDATE(TIME,DATE)
C
C CONVERT DECIMAL YEAR TIME INTO INTEGER CALENDAR TIME
C
      INTEGER*4 DATE(6)
      REAL*8 TIME,LEAP,YEAR,DAY,HOUR,MIN,SEC,FSEC
C
      DATE(1) = INT(TIME)
      IF (MOD(DATE(1),4).EQ.0) THEN
       LEAP = 366.0
      ELSE
       LEAP = 365.0
      END IF
      DAY = (TIME-REAL(DATE(1)))*LEAP
      DATE(2) = INT(DAY)
      HOUR = (DAY-REAL(DATE(2)))*24.0
      DATE(3) = INT(HOUR)
      MIN = (HOUR-REAL(DATE(3)))*60.0
      DATE(4) = INT(MIN)
      SEC = (MIN-REAL(DATE(4)))*60.0
      DATE(5) = INT(SEC)
      FSEC = (SEC-REAL(DATE(5)))*1000.0
      DATE(6) = INT(FSEC)
C
C SET DAY 1 = JAN 1
C
      DATE(2) = DATE(2) + 1
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION DECDY(DATE)
C
C CONVERT INTEGER CALENDAR TIME TO DECIMAL DAY
C
      INTEGER*4 DATE(6)
      REAL*8 DAY,HOUR,MIN,SEC,MSEC
C
      MSEC = DFLOAT(DATE(6))
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0
      DAY = DFLOAT(DATE(2)) + HOUR/24.0D0
      DECDY = DAY
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION DECYR(DATE)
C
C CONVERT INTEGER CALENDAR TIME TO DECIMAL YEAR
C
      INTEGER*4 DATE(6)
      REAL*8 YEAR,DAY,HOUR,MIN,SEC,MSEC,LEAP
C
      LEAP = 365.0D0
      IF (MOD(DATE(1),4).EQ.0) LEAP = 366.0D0
      MSEC = DFLOAT(DATE(6))
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0
      DAY = DFLOAT(DATE(2)-1) + HOUR/24.0D0
      YEAR = DFLOAT(DATE(1)) + DAY/LEAP
      DECYR = YEAR
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION CONVERT(TIME)
C
C CONVERT REAL TIME TAG OF YYDDDHH FORMAT INTO DECIMAL YEAR
C
      CHARACTER CTIME*7
      INTEGER*4 TIME
      REAL*8 DTIME
C
      WRITE(CTIME,'(I7)') TIME
      READ(CTIME,'(I2,I3,I2)') IYR,IDY,IHR
C
      IF (MOD(IYR,4).EQ.0) THEN
       LEAP = 366.0D0
      ELSE
       LEAP = 365.0D0
      END IF
C
      DTIME = DBLE(IYR) + DBLE(IDY-1)/LEAP + DBLE(IHR)/24.0D0/LEAP
      CONVERT = DTIME
C
      RETURN
      END
      PROGRAM MERGE4
C
C MERGE 48 SEC FIELD AND 192 SEC PLASMA HIGH RESOLUTION AVERAGES
C FROM POST-1990 GSFC IBM BINARY AND MIT ASCII SUMMARY DATA FILES.
C WRITEN BY SANDY KRAMER, HUGHES-STX, CODE 692
C PORTED FROM LEPVGR NODE BY SANDY KRAMER 12/03/93
C MODIFIED TO MERGE SEPARATE MAG AND PLS DATASETS  SBK 06/02/94
C INCLUDE S/C POSITION COMPONENTS AND ANGLES  SBK 06/09/94
C
      PARAMETER (IARR=30000,MAG=8,IPLS=8,NFIELD=16)
      CHARACTER FLT*4
      CHARACTER*50 DSN,MAGDSN,PLSDSN,MRGDSN
      INTEGER*2 ID,HDRTIME(6)
      INTEGER*4 NUM(IARR,NFIELD),NOUT(NFIELD),DATE(6)
      REAL*4 DATA(IARR,NFIELD),AVG(IARR,NFIELD),
     &       FIELD(496),PLASMA(8),FIN(1000),
     &       HEADER(32),MSEDR(40)
      REAL*8 TIME(IARR,2),T1,T2,TOUT(IARR),T,
     &       CONVERT,DECYR,DECDY,DD
C
      EQUIVALENCE (HEADER(1),FIN(1)),  (HDRTIME(1),HEADER(4)),
     &            (ID,HEADER(17)),     (FIELD(1),FIN(33)),
     &            (MSEDR(1),FIN(529)),
     &            (FLT,HEADER(3))
      WRITE(6,*)
C
C AVERAGING WINDOW OFFSET (SECONDS)
C
      BTIME =  48.0
C
C INPUT MAG DATASET
C
      READ(5,'(A)') MAGDSN
C     MAGDSN = 'U0#16.UNITTREE.V2.D9118600'
      WRITE(6,'(1X,''INPUT MAG DATASET:  '',A50)') MAGDSN
      WRITE(6,*)
C
C INPUT PLS DATASET
C
      READ(5,'(A)') PLSDSN
C     PLSDSN = 'Z1SBK.V291PLS.SUM'
      WRITE(6,'(1X,''INPUT PLS DATASET:  '',A50)') PLSDSN
      WRITE(6,*)
C
C AVERAGING PERIOD (SECONDS)
C
      READ(5,*) DTIME
C     DTIME = 192.0
      WRITE(6,'(1X,''AVERAGING PERIOD (SEC):  '',F7.2)') DTIME
      WRITE(6,*)
C
C OUTPUT MERGED DATASET
C
      READ(5,'(A)') MRGDSN
C     MRGDSN = 'Z1SBK.MRG.OUT'
      WRITE(6,'(1X,''OUTPUT MERGED DATASET:  '',A50)') MRGDSN
      WRITE(6,*)
C
C GET SUMMARY MAG DATA
C
      DSN = MAGDSN
      OPEN(10,FILE='/'//DSN,STATUS='OLD',FORM='UNFORMATTED')
C
C READ SUMMARY DATASET.  EXTRACT MAG OR PLASMA AS APPROPRIATE.
C
      BLT = 1.38066E-23
      PRTN = 1.67265E-27
      CON =  180.0 / 3.14159
C
C READ GSFC IBM BINARY SUMMARY MAG DATA
C FILL DATA = 999.0
C
      NMAG = 0
   10 CONTINUE
       READ(10,NUM=LEN,END=100,ERR=10) FIN
       DATE(1) = HDRTIME(1)
       DATE(2) = HDRTIME(2)
       DATE(3) = HDRTIME(3)
       DATE(4) = HDRTIME(4)
       DATE(5) = HDRTIME(5)
       DATE(6) = HDRTIME(6)
C
C BEGIN LFM RECORD READ
C
       IF (ID.EQ.1) THEN
        READ(FLT,'(3X,I1)') ISC
        NMAG = NMAG + 1
        TIME(NMAG,1) = DECYR(DATE)
        IF (0.0.LT.FIELD(1).AND.FIELD(1).LT.999.0) THEN
C FIELD MAGNITUDE
         DATA(NMAG,1) = FIELD(1)
C FIELD MODULUS
         DATA(NMAG,2) = FIELD(2)
C FIELD RADIAL COMPONENT
         DATA(NMAG,3) = FIELD(5)
C FIELD TANGENTIAL COMPONENT
         DATA(NMAG,4) = FIELD(6)
C FIELD NORMAL COMPONENT
         DATA(NMAG,5) = FIELD(7)
        ELSE
         DATA(NMAG,1) = 999.0
         DATA(NMAG,2) = 999.0
         DATA(NMAG,3) = 999.0
         DATA(NMAG,4) = 999.0
         DATA(NMAG,5) = 999.0
        END IF
C S/C POSITION
        RANGE = MSEDR(11)
        IF (RANGE.GE.1.0.AND.RANGE.LT.999.0) THEN
C X COMPONENT
         DATA(NMAG,6) = MSEDR(5)
C Y COMPONENT
         DATA(NMAG,7) = MSEDR(6)
C Z COMPONENT
         DATA(NMAG,8) = MSEDR(7)
        ELSE
         DATA(NMAG,6) = 999.0
         DATA(NMAG,7) = 999.0
         DATA(NMAG,8) = 999.0
        END IF
C       WRITE(6,801) ISC,DATE,(DATA(NMAG,I),I=1,8)
C       WRITE(6,802) ISC,TIME(NMAG,1),KDATA(NMAG,I),I=1,8)
C START TIME (DECIMAL YEAR)
        IF (NMAG.EQ.1) T1 = DECYR(DATE)
C
C END LFM RECORD READ
C
       END IF
C
      GOTO 10
C
C END MAG DATA ACQUISITION
C
  100 CONTINUE
      CLOSE(10)
      IF ( NMAG.LE.0 ) THEN
       WRITE(6,*) 'MAG DATA SET EMPTY'
       WRITE(6,*) 'PROGRAM TERMINATED'
       GOTO 999
      END IF
  801 FORMAT(1X,I1,1X,I2,1X,I3,3(1X,I2),1X,I3,5(1X,F7.3),3(1X,F9.4))
  802 FORMAT(1X,I1,1X,F11.8,5(1X,F7.3),3(1X,F9.4))
      T2 = DECYR(DATE)
      WRITE(6,*) 'MAG START TIME (T1)',T1
      WRITE(6,*) 'MAG END TIME (T2)  ',T2
C
      WRITE(6,*)
      WRITE(6,'(1X,I5.5,'' MAG RECORDS INPUTTED'')') NMAG
C
C GET MIT HIGH RESOLUTION PLASMA DATA
C
      DSN = PLSDSN
      OPEN(51,FILE='/'//DSN,STATUS='OLD',FORM='FORMATTED')
C
C SURPRESS INVALID CHARACTER ERROR MSG IN PLASMA DATA READ
C
      CALL ERRSET(227,256,-1)
C
C READ MIT KEY PARAMS FORMAT PLASMA DATA
C IYEAR,IDAY,HOUR,V,N,W,VR,VT,VN,ALP,EFX
C FILL DATA = 0.0
C
      NPLS = 0
  110 CONTINUE
       READ(51,*,END=200,ERR=110) IYEAR,IDAY,HOUR,
     &  (PLASMA(I),I=1,IPLS)
       DATE(1) = IYEAR - 1900
       DATE(2) = IDAY
       DATE(3) = INT(HOUR)
       REALMIN = (HOUR-REAL(DATE(3)))*60.0
       DATE(4) = INT(REALMIN)
       SEC = (REALMIN-REAL(DATE(4)))*60.0
       DATE(5) = INT(SEC)
       FSEC = (SEC-REAL(DATE(5)))*1000.0
       DATE(6) = INT(FSEC)
C      WRITE(6,'(6(1X,I3))') DATE
       T = DECYR(DATE)
       IF ( T.LT.T1 ) GOTO 110
       IF ( T.GE.T2 ) GOTO 200
       NPLS = NPLS + 1
       TIME(NPLS,2) = T
       IF (PLASMA(1).GT.0.0.AND.PLASMA(1).LT.1500.0) THEN
C ION VELOCITY
        DATA(NPLS,9) = PLASMA(1)
C ION VELOCITY RADIAL COMPONENT
        DATA(NPLS,10) = PLASMA(4)
C ION VELOCITY TANGENTIAL COMPONENT
        DATA(NPLS,11) = PLASMA(5)
C ION VELOCITY NORMAL COMPONENT
        DATA(NPLS,12) = PLASMA(6)
       ELSE
        DATA(NPLS,9) = 0.0
        DATA(NPLS,10) = 0.0
        DATA(NPLS,11) = 0.0
        DATA(NPLS,12) = 0.0
       END IF
C ION DENSITY
       IF ( PLASMA(2).GT.0.0 ) THEN
        DATA(NPLS,13) = PLASMA(2)
       ELSE
        DATA(NPLS,13) = 0.0
       END IF
C ION TEMPERATURE (FIT)
       IF ( PLASMA(3).GT.0.0 ) THEN
        W = PLASMA(3)
        DATA(NPLS,14) = PRTN*(W*1000.0)**2.0/(2.0*BLT)
       ELSE
        DATA(NPLS,14) = 0.0
       END IF
C      WRITE(6,'(6(1X,I3),6(1X,F7.1),2(1X,E10.4))')
C    &  DATE,(PLASMA(J),J=1,8)
      GOTO 110
  200 CONTINUE
      CLOSE(51)
      IF ( NPLS.LE.0 ) THEN
       WRITE(6,*) 'PLS DATA SET MISSING MAG TIME PERIOD'
       WRITE(6,*) 'PROGRAM TERMINATED'
       GOTO 999
      END IF
C
      WRITE(6,*)
      WRITE(6,'(1X,I5.5,'' PLS RECORDS INPUTTED'')') NPLS
C
C AVERAGE MAG DATA
C
C ALL DATA FIELDS ARE AVERAGED OVER THE SAME TIME PERIODS SUCH THAT EACH
C FIELD AVERAGE ARRAY SHARES A COMMON TIME AVERAGE ARRAY.
C
C     WRITE(6,*) 'ENTER RESOLUTION OF INPUT DATA (SECONDS)'
C     READ(5,*) BTIME
      BTIME = BTIME/3600.
C     WRITE(6,*) 'ENTER AVERAGING PERIOD (SECONDS)'
C     READ(5,*) DTIME
      DTIME = DTIME/3600.0
      NUMAVGS = NINT((T2-T1)/(DTIME/(24.0*DAYS(T1))))
C
C CHECK NUMBER CALCULATED AVERAGES IN BOUNDS
C
      IF (NUMAVGS.GT.IARR) THEN
       WRITE(6,*) 'EXPECTED NUMBER OF AVERAGES EXCEEDS PARAMETER IARR'
       WRITE(6,*) 'REDIMENSION IARR GT ',NUMAVGS
       GOTO 999
      END IF
C AVERAGE MAG DATA
C
C DATA(X,1) = F1(48 S) AVGS
C DATA(X,2) = F2(48 S) AVGS
C DATA(X,3) = BR(48 S) AVGS
C DATA(X,4) = BT(48 S) AVGS
C DATA(X,5) = BN(48 S) AVGS
C DATA(X,6) = X(48 S) AVGS
C DATA(X,7) = Y(48 S) AVGS
C DATA(X,8) = Z(48 S) AVGS
C
      WRITE(6,*)
      WRITE(6,*) 'BEGIN AVERAGING MAG DATA'
      WRITE(6,*)
      FILL = 999.0
      MAXM = 0
      DO IVAR = 1,MAG
       CALL HRAVG(T1,T2,FILL,BTIME,DTIME,TIME(1,1),DATA(1,IVAR),NMAG,
     &            TOUT,AVG(1,IVAR),NUM(1,IVAR),NOUT(IVAR))
       IF (IVAR.EQ.1) THEN
        MAXM = NOUT(IVAR)
       ELSE
        IF (NOUT(IVAR).NE.MAXM) WRITE(6,*) 'ARRAY PHASING ERROR'
       END IF
      END DO
C AVERAGE PLASMA DATA
C
C DATA(X,9) = V(192S) AVGS
C DATA(X,10) = VR(192S) AVGS
C DATA(X,11) = VT(192S) AVGS
C DATA(X,12) = VN(192S) AVGS
C DATA(X,13) = N(192S) AVGS
C DATA(X,14) = T(192S) AVGS
C
      WRITE(6,*)
      WRITE(6,*) 'BEGIN AVERAGING PLS DATA'
      WRITE(6,*)
      FILL = 0.0
      MAXP = 0
      DO IVAR = MAG+1,MAG+IPLS
       CALL HRAVG(T1,T2,FILL,BTIME,DTIME,TIME(1,2),DATA(1,IVAR),NPLS,
     &            TOUT,AVG(1,IVAR),NUM(1,IVAR),NOUT(IVAR))
       IF (IVAR.EQ.1+MAG) THEN
        MAXP = NOUT(IVAR)
       ELSE
        IF (NOUT(IVAR).NE.MAXP) WRITE(6,*) 'ARRAY PHASING ERROR'
       END IF
      END DO
C
      IF (MAXP.GT.MAXM) THEN
       NMAX = MAXM
      ELSE
       NMAX = MAXP
      END IF
C
      WRITE(6,*)
      WRITE(6,*) 'END SUMMARY AVERAGING'
      WRITE(6,*)
C
      DSN = MRGDSN
      CALL FILEINF(IRCODE,'DEVICE','TEMPDA','RECFM','VBA',
     & 'LRECL',209,'TRK',500,'SECOND',100)
      OPEN(52,FILE='/'//DSN,STATUS='NEW',FORM='FORMATTED')
C
C OUTPUT AVERAGES
C
      DO K = 1,NMAX
       CALL GETDATE(TOUT(K),DATE)
       DD = DECDY(DATE)
C
C COMPUTE FIELD ANGLES
C
       F1 = AVG(K,2)
       BR = AVG(K,3)
       BT = AVG(K,4)
       BN = AVG(K,5)
       IF (BR.NE.999.0.AND.
     &     BT.NE.999.0.AND.
     &     BN.NE.999.0) THEN
        F2 = SQRT(BR**2+BT**2+BN**2)
        BDEL = ASIN(BN/F2) * CON
        BLAM = 180.0 - ATAN2(BT,-BR)*CON
       ELSE
        F2 = 999.0
        BDEL = 999.0
        BLAM = 999.0
       END IF
C
C COMPUTE S/C RANGE AND POSITION ANGLES
C
       X = AVG(K,6)
       Y = AVG(K,7)
       Z = AVG(K,8)
       IF (X.NE.999.0.AND.
     &     Y.NE.999.0.AND.
     &     Z.NE.999.0) THEN
        R = SQRT(X**2+Y**2+Z**2)
        THETA = ASIN(Z/R) * CON
        BETA = ATAN2(Y,X)
        IF (BETA.LT.0.0) BETA = BETA + 6.2831853
       ELSE
        R = 999.0
        THETA = 999.0
        BETA = 999.0
       END IF
C
C COMPUTE FLOW ANGLES
C
       V = AVG(K,9)
       VR = AVG(K,10)
       VT = AVG(K,11)
       VN = AVG(K,12)
       VRT = SQRT(VR**2+VT**2)
       IF (VR.NE.0.0.AND.VT.NE.0.0.AND.VN.NE.0.0) THEN
        VDEL = ATAN2(VN,VRT)*CON
        VLAM = -ATAN2(VT,VR)*CON
       ELSE
        VDEL = 0.0
        VLAM = 0.0
       END IF
C AVERAGED DENSITY
       DEN = AVG(K,13)
C AVERAGED TEMPERATURE
       TEM = AVG(K,14)
C COUNTS PER AVERAGE
       NF1 = NUM(K,1)
       NV = NUM(K,9)
       NN = NUM(K,13)
       NT = NUM(K,14)
       NR = NUM(K,6)
C
C OUTPUT ID,IYEAR,DAY,F1,BR,BT,BN,BDEL,BLAM,V,VR,VT,VN,VDEL,VLAM,
C        N,T,R,X,Y,Z,#F1,#V,#N,#T,#R
C
       WRITE(52,956) ISC,DATE(1),DD,F1,BR,BT,BN,BDEL,BLAM,
     &               V,VR,VT,VN,VDEL,VLAM,DEN,TEM,R,X,Y,Z,
     &               THETA,BETA,NF1,NV,NN,NT,NR
      END DO
      CLOSE(52)
      WRITE(6,*)
      WRITE(6,*) NMAX, 'MERGE RECORDS WRITTEN'
C
  999 CONTINUE
      STOP
  955 FORMAT(1X,I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,
     &       4(1X,F7.3),2(1X,F6.2),4(1X,F6.1),2(1X,F6.2),
     &       2(1X,E10.4),4(1X,F9.4),2(1X,E10.4),5(1X,I2))
  956 FORMAT(1X,I1,1X,I2,1X,F12.8,
     &       4(1X,F7.3),2(1X,F6.2),4(1X,F6.1),2(1X,F6.2),
     &       2(1X,E10.4),4(1X,F9.4),2(1X,E10.4),5(1X,I2))
      END
      SUBROUTINE HRAVG(T1,T2,FILL,BTIME,DTIME,T,DATA,NPTS,
     &                 TOUT,DOUT,PARR,NOUT)
C
C PRODUCE AVERAGES OF PERIOD DTIME FROM INPUTTED HOUR AVERAGE DATA.
C ROUTINE DOES NOT REMOVE TIME POINTS WITH NULL AVERAGES.
C
      INTEGER*4 PARR(NPTS),DATE(6)
      REAL*4 DATA(NPTS),DOUT(NPTS)
      REAL*8 T(NPTS),TIME,TIME1,TIME2,TOUT(NPTS),T1,T2,TEND
C
C T1 START TIME
C T2 END TIME
C FILL  FILL DATA VALUE
C BTIME RESOLUTION OF INPUT DATA (HOURS)
C DTIME AVERAGING INTERVAL (HOURS)
C T     INPUT TIME ARRAY
C DATA  INPUT DATA ARRAY
C NPTS  NUMBER OF POINTS IN INPUT DATA
C TOUT  OUTPUT TIME ARRAY
C DOUT  OUTPUT ARRAY OF DTIME AVERAGES
C PARR  OUTPUT ARRAY - # OF AVGS/PT
C NOUT NUMBER OF POINTS IN OUTPUT DATA
C
      SUM = 0.0
      NUM = 0
      TEND = T2 + DBLE(BTIME/(100.0*24.0*DAYS(T2)))
C
      TIME1 = T1 - DBLE(BTIME/(100.0*24.0*DAYS(T1)))
      TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))
      IARR = 0
      INDEX = 0
  10  CONTINUE
       IARR = IARR + 1
       IF (IARR.GT.NPTS) GOTO 20
       TIME = T(IARR)
       VAL = DATA(IARR)
C
C GET DATA FROM PROPER TIME INTERVAL
C
  15   CONTINUE
       IF (TIME.LT.TIME1) GOTO 10
       IF (TIME.GE.TIME2) GOTO 20
       IF (TIME.GT.TEND) GOTO 20
C
C ACCUMULATE DATA NOT INCLUDING FILL POINTS
C
       IF (VAL.NE.FILL) THEN
        SUM = SUM + VAL
        NUM = NUM + 1
       END IF
C
      GOTO 10
   20 CONTINUE
C
C AVERAGE DATA AND INCREMENT TIME INTERVAL
C
       IF (NUM.NE.0) THEN
        AVG = SUM/FLOAT(NUM)
       ELSE
        AVG = FILL
       END IF
       INDEX = INDEX + 1
       TOUT(INDEX) = TIME1 + DBLE(BTIME/(100.0*24.0*DAYS(TIME1)))
       DOUT(INDEX) = AVG
       PARR(INDEX) = NUM
       TIME1 = TIME2
       TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))
       SUM = 0.0
       NUM = 0
      IF (IARR.LE.NPTS.AND.TIME.LE.TEND) GOTO 15
C
C RETURN FROM AVERAGING OVER DESIRED TIME INTERVAL
C
 100  CONTINUE
      WRITE(6,800) TOUT(1),TOUT(INDEX),INDEX
      CLOSE(10)
      NOUT = INDEX
C
      RETURN
 800  FORMAT(' START ',F12.8,'   STOP ',F12.8,'   POINTS ',I5)
      END
      REAL FUNCTION DAYS(TIME)
C
C RETURN NUMBER OF DAYS IN YEAR
C
      REAL*8 TIME
C
      IYR = INT(TIME)
      IF (MOD(IYR,4).EQ.0) THEN
       DAYS = 366.0
      ELSE
       DAYS = 365.0
      END IF
C
      RETURN
      END
      SUBROUTINE GETDATE(TIME,DATE)
C
C CONVERT DECIMAL YEAR TIME INTO INTEGER CALENDAR TIME
C
      INTEGER*4 DATE(6)
      REAL*8 TIME,LEAP,YEAR,DAY,HOUR,MIN,SEC,FSEC
C
      DATE(1) = INT(TIME)
      IF (MOD(DATE(1),4).EQ.0) THEN
       LEAP = 366.0
      ELSE
       LEAP = 365.0
      END IF
      DAY = (TIME-REAL(DATE(1)))*LEAP
      DATE(2) = INT(DAY)
      HOUR = (DAY-REAL(DATE(2)))*24.0
      DATE(3) = INT(HOUR)
      MIN = (HOUR-REAL(DATE(3)))*60.0
      DATE(4) = INT(MIN)
      SEC = (MIN-REAL(DATE(4)))*60.0
      DATE(5) = INT(SEC)
      FSEC = (SEC-REAL(DATE(5)))*1000.0
      DATE(6) = INT(FSEC)
C
C SET DAY 1 = JAN 1
C
      DATE(2) = DATE(2) + 1
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION DECDY(DATE)
C
C CONVERT INTEGER CALENDAR TIME TO DECIMAL DAY
C
      INTEGER*4 DATE(6)
      REAL*8 DAY,HOUR,MIN,SEC,MSEC
C
      MSEC = DFLOAT(DATE(6))
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0
      DAY = DFLOAT(DATE(2)) + HOUR/24.0D0
      DECDY = DAY
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION DECYR(DATE)
C
C CONVERT INTEGER CALENDAR TIME TO DECIMAL YEAR
C
      INTEGER*4 DATE(6)
      REAL*8 YEAR,DAY,HOUR,MIN,SEC,MSEC,LEAP
C
      LEAP = 365.0D0
      IF (MOD(DATE(1),4).EQ.0) LEAP = 366.0D0
      MSEC = DFLOAT(DATE(6))
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0
      DAY = DFLOAT(DATE(2)-1) + HOUR/24.0D0
      YEAR = DFLOAT(DATE(1)) + DAY/LEAP
      DECYR = YEAR
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION CONVERT(TIME)
C
C CONVERT REAL TIME TAG OF YYDDDHH FORMAT TO DECIMAL YEAR
C
      CHARACTER CTIME*7
      INTEGER*4 TIME
      REAL*8 DTIME
C
      WRITE(CTIME,'(I7)') TIME
      READ(CTIME,'(I2,I3,I2)') IYR,IDY,IHR
C
      IF (MOD(IYR,4).EQ.0) THEN
       LEAP = 366.0D0
      ELSE
       LEAP = 365.0D0
      END IF
C
      DTIME = DBLE(IYR) + DBLE(IDY-1)/LEAP + DBLE(IHR)/24.0D0/LEAP
      CONVERT = DTIME
C
      RETURN
      END
CONTROL NOFLUSH NOMSG NOLIST ASIS
CLEAR
WRITE ENTER INPUT SUMMARY DATASET NAME
READ SUMMDSN
WRITE ENTER AVERAGING PERIOD (SECONDS)
READ AVGPD
WRITE ENTER OUTPUT MERGE DATASET NAME
READ MRGDSN
EDIT $SUBMIT$ DATA NEW ASIS EMODE
IN //Z1SBKMRG JOB (U0016,N598,10),'SUMMARY MERGE',
IN // TIME=(1,00),CLASS=A,MSGCLASS=X,NOTIFY=Z1SBK
UNNUM
IN // EXEC FORTVCLG
IN //FORT.SYSIN DD DSN=Z1SBK.DATAMGR.JCL(MERGE3),DISP=SHR
IN //LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR
IN //GO.SYSUDUMP DD DUMMY
IN &SUMMDSN
IN &AVGPD
IN &MRGDSN
IN // EXEC NOTIFY
IN //
SUBMIT * 
END
//Z1SBKM4D JOB (U0016,N598,10),M4DATA,TIME=(02,00),MSGCLASS=X,CLASS=N
//*JOBPARM LINES=100                                                    00000001
//* USED BY SBK TO READ MARKIV OUTPUT DATASET                           00000002
//FORT77 EXEC FORTRAN                                                   00000010
C                                                                       00000020
C READ DATA DIRECTLY FROM MARKIV DATA TAPES W/O INVOKING MARKIV         00000030
C PROGRAM TO EXTRACT FORMAT.                                            00000040
C
      CHARACTER*1 SAT,CODE
      CHARACTER*2 SYS,MIN
      CHARACTER*5 THETA,PHI,TAPE
      CHARACTER*8 CFIN2                                                 00000060
      CHARACTER*95 CFIN1                                                00000050
      INTEGER*2 PASS,STAT                                               00000080
      INTEGER*4 PIO6,PIO7
C                                                                       00000100
C IY - DATA YEAR
C ID - DATA DAY
C IH - DATA HOUR
C NOR - ORBIT #
C RD - RADIAL DISTANCE
C XD - X COMPONENT S/C POS
C YD - Y COMPONENT S/C POS
C ZD - Z COMPONENT S/C POS
C F - FIELD MAG
C THETA - THETA ANGLE
C PHI - PHI ANGLE
C NPTS - # POINTS IN AVG
C SYS - COORDINATE SYSTEM
C SLAT - GEOMAGNETIC LATITUDE
C RMSF - FIELD MAG ERROR
C RMSX - X COMP FIELD ERROR
C RMSY - Y COMP FIELD ERROR
C RMSZ - Z COMP FIELD ERROR
C FC - FIELD MODULUS
C X - X COMP FIELD
C Y - Y COMP FIELD
C Z - Z COMP FIELD
C SAT - S/C ID
C PASS - PASS #                     *
C STAT - RECORDING STATION          *
C TAPE - INPUT TAPE #               *  PIONEER DATA ONLY
C CODE - CALIBRATE/FLIP INDICATOR   *
C MIN - START MIN OF AVG            *
C
      IMPA = 0
      IMPB = 0
      IMPC = 0
      IMPD = 0
      IMPE = 0
      IMPF = 0
      IMPG = 0
      IMPH = 0
      IMPI = 0
      IMPJ = 0
      PIO6 = 0
      PIO7 = 0
      MR10 = 0
C
      IREAD = 0                                                         00000110
      IWRITE = 0
   10 CONTINUE                                                          00000110
       READ(10,NUM=LEN,END=100,ERR=10) CFIN1,PASS,STAT,CFIN2            00000120
       IREAD = IREAD + 1
C      IF (IREAD.GT.5000) GOTO 100
C      READ(CFIN1,800) IY,ID,IH,NOR,RD,XD,YD,ZD,F,THETA,PHI,NPTS,       00000130
C    &                 SYS,SLAT,RMSF,RMSX,RMSY,RMSZ,FC,X,Y,Z,
C    &                 SAT
       READ(CFIN1,'(94X,A1)') SAT
C      WRITE(6,'(1X,I6.6,3X,A1)') IREAD,SAT
       READ(CFIN2,801) TAPE,CODE,MIN                                    00000140
C
       IF (SAT.EQ.'A') IMPA = IMPA + 1
       IF (SAT.EQ.'B') IMPB = IMPB + 1
       IF (SAT.EQ.'C') IMPC = IMPC + 1
       IF (SAT.EQ.'D') IMPD = IMPD + 1
       IF (SAT.EQ.'E') IMPE = IMPE + 1
       IF (SAT.EQ.'F') IMPF = IMPF + 1
       IF (SAT.EQ.'G') IMPG = IMPG + 1
       IF (SAT.EQ.'H') IMPH = IMPH + 1
       IF (SAT.EQ.'I') IMPI = IMPI + 1
       IF (SAT.EQ.'J') IMPJ = IMPJ + 1
       IF (SAT.EQ.'6') PIO6 = PIO6 + 1
       IF (SAT.EQ.'7') PIO7 = PIO7 + 1
       IF (SAT.EQ.'M') MR10 = MR10 + 1
C
       WRITE(11,850) CFIN1,PASS,STAT,CFIN2                              00000150
C      WRITE(11,850) IY,ID,IH,NOR,RD,XD,YD,ZD,F,THETA,PHI,NPTS,         00000130
C    &               SYS,SLAT,RMSF,RMSX,RMSY,RMSZ,FC,X,Y,Z,
C    &               SAT,PASS,STAT,TAPE,CODE,MIN
       IWRITE = IWRITE + 1                                              00000160
      GOTO 10                                                           00000170
  100 CONTINUE                                                          00000180
C
      WRITE(6,'(1X,I6.6,'' IMP-A RECORDS'')') IMPA
      WRITE(6,'(1X,I6.6,'' IMP-B RECORDS'')') IMPB
      WRITE(6,'(1X,I6.6,'' IMP-C RECORDS'')') IMPC
      WRITE(6,'(1X,I6.6,'' IMP-D RECORDS'')') IMPD
      WRITE(6,'(1X,I6.6,'' IMP-E RECORDS'')') IMPE
      WRITE(6,'(1X,I6.6,'' IMP-F RECORDS'')') IMPF
      WRITE(6,'(1X,I6.6,'' IMP-G RECORDS'')') IMPG
      WRITE(6,'(1X,I6.6,'' IMP-H RECORDS'')') IMPH
      WRITE(6,'(1X,I6.6,'' IMP-I RECORDS'')') IMPI
      WRITE(6,'(1X,I6.6,'' IMP-J RECORDS'')') IMPJ
      WRITE(6,'(1X,I6.6,'' PIONEER 6 RECORDS'')') PIO6
      WRITE(6,'(1X,I6.6,'' PIONEER 7 RECORDS'')') PIO7
      WRITE(6,'(1X,I6.6,'' MARINER 10 RECORDS'')') MR10
C
      WRITE(6,'(1X)')
      WRITE(6,'(1X,I6.6,'' MARKIV RECORDS INPUTTED'')') IREAD
      WRITE(6,'(1X,I6.6,'' MARKIV RECORDS OUTPUTTED'')') IWRITE
C
      STOP                                                              00000190
  800 FORMAT(I2,I3,2I2,4F5.1,F4.1,1X,2A5,I4,A2,F4.0,8F5.1,A1)           00000200
  801 FORMAT(A5,A1,A2)                                                  00000210
C 850 FORMAT(I2,I3,2I2,4F5.1,F4.1,1X,2A5,I4,A2,F4.0,8F5.1,A1,2I2,       00000200
C            A5,A1,A2)
  850 FORMAT(A95,2I2,A8)
      END                                                               00000220
//RUN77 EXEC LOADER,REGION=700K                                         00000230
//SYSUDUMP DD DUMMY                                                     00000240
//FT10F001 DD DSN=HRAVG.IP,DISP=OLD,UNIT=6250,                          00000250
//         LABEL=(,SL,,IN),VOL=SER=FP2620,
//         DCB=(RECFM=FB,LRECL=107,BLKSIZE=2568,DEN=3)
//FT11F001 DD DSN=Z1SBK.M4IPM.DAT,DISP=OLD
//NOTIFY EXEC NTSO                                                      00000260
//                                                                      00000270
//Z1SBKNWA JOB (U0008,N598,20),'MERGE',TIME=(1,30),MSGCLASS=X,
// CLASS=N,NOTIFY=Z1SBK
/*JOBPARM LINES=100
//FORTRAN EXEC FORTVCLG
C                                                                       00000010
C    REPLACES FILL DATA WITH NEW VALUES WHEN TWO RECORDS                00000020
C    ARE ENCOUNTERED WITH THE SAME TIME.                                00000030
C         UPDATE 11/07/91 SBK  WRITE FINAL RECORD
C    LAST UPDATE 08/26/93 SBK  SET FILL TO -99.9, 0.0, 999.0
C
      INTEGER*4 I1(35),I2(35)                                           00000040
      REAL*4 F1(35),F2(35)                                              00000050
      EQUIVALENCE (F1(1),I1(1)),(F2(1),I2(1))                           00000060
      INTEGER*4 IREAD/0/,IWRITE/0/                                      00000070
C                                                                       00000080
      IDATE = 090294
C                                                                       00000090
    5 CONTINUE
      READ(10,NUM=LEN,END=200,ERR=5) F1                                 00000100
      IREAD = IREAD + 1                                                 00000120
      WRITE(6,'('' READ'',I4,'' BYTES'')') LEN
      ICHK1 = I1(1)*10000000+I1(2)*100000+I1(3)*100+I1(4)               00000110
   10 CONTINUE                                                          00000150
      READ(10,NUM=LEN,END=100,ERR=10) F2                                00000160
      IREAD = IREAD + 1                                                 00000170
      ICHK2 = I2(1)*10000000+I2(2)*100000+I2(3)*100+I2(4)               00000180
C
C CHECK SEQUENTIAL RECORDS.  IF DUPLICATE RECORD EXISTS,
C WRITE THE DESIRED RECORD.  WRITE ALL NON-DUPLICATE RECORDS.
C
      IF( ICHK1 .NE. ICHK2 ) GO TO 20                                   00000190
      DO 15 K = 5,35                                                    00000192
       IF (F1(K).EQ.-99.9.OR.
     &     F1(K).EQ.0.0.OR.
     &     F1(K).EQ.999.0)  F1(K) = F2(K)
   15 CONTINUE                                                          00000194
      GO TO 10                                                          00000195
   20 CONTINUE                                                          00000250
      WRITE(11,NUM=N) F1                                                00000260
      IWRITE = IWRITE + 1                                               00000270
      DO 40 I = 1,35                                                    00000280
       F1(I) = F2(I)                                                    00000290
   40 CONTINUE                                                          00000300
      ICHK1 = ICHK2                                                     00000310
      GO TO 10                                                          00000320
  100 CONTINUE                                                          00000330
      WRITE(11,NUM=N) F1                                                00000260
      IWRITE = IWRITE + 1                                               00000270
  200 CONTINUE
      WRITE(6,805) IREAD                                                00000340
      WRITE(6,810) IWRITE                                               00000340
      STOP                                                              00000350
  805 FORMAT(1X,'RECORDS INPUT: ',I7.7)                                 00000360
  810 FORMAT(1X,'RECORDS OUTPUT: ',I7.7)
      END                                                               00000370
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR
//GO.SYSUDUMP DD DUMMY
//FT10F001 DD DSN=Z1SBK.MSTEMP,DISP=OLD
//*T10F001 DD VOL=SER=SBK001,LABEL=(1,NL,,OUT),UNIT=6250,
//*           DCB=(RECFM=FB,LRECL=140,BLKSIZE=12880,DEN=4)
//FT11F001 DD DSN=Z1SBK.MSPERM,DISP=OLD
//NOTIFY EXEC NOTIFY
//
//Z1SBKIMP JOB (U0016,N598,30),'OMNI READ',TIME=(0,30),
// MSGCLASS=X,CLASS=N,NOTIFY=Z1SBK
/*JOBPARM LINES=100
//FOR EXEC FORTRAN
C
C FOR CONCATENATED HOURAVG TAPE
C IMP/ISEE FROM OMNI TAPE
C
      INTEGER*4 IN(36)
      REAL*4 FIN(36)
      EQUIVALENCE(IN(1),FIN(1))
C
   20 CONTINUE
       READ(10,NUM=LEN,END=100,ERR=20) FIN
       ITIME = IN(2)*100000 + IN(3)*100 + IN(4)
       IF ( ITIME.LT.6904100 ) GOTO 20
       IF ( ITIME.GE.6904400 ) GOTO 100
       WRITE(11,900) (IN(I),I=2,4),(FIN(J),J=10,16),(FIN(K),K=24,28)
      GOTO 20
  100 CONTINUE
      STOP
  900 FORMAT(I2,1X,I3,1X,I2,2(1X,F7.3),2(1X,F5.1),3(1X,F8.3),
     &       2(1X,E10.4),1X,F6.1,2(1X,F5.1))
      END
//RUN EXEC LOADER
//SYSUDUMP DD DUMMY
//FT10F001 DD VOL=(PRIVATE,SER=OMNI),UNIT=T6250,LABEL=(,NL,,IN),
//            DCB=(RECFM=FB,LRECL=148,BLKSIZE=28416,DEN=3)
//FT11F001 DD DSN=Z1SBK.IMP.DAT,DISP=OLD
//NOTIFY EXEC NOTIFY
//
//Z1SBKPCR JOB (U0016,N598,15),'PIONEER CR',TIME=(0,30),MSGCLASS=X,
//    CLASS=N
//FORT77 EXEC FORTRAN
C
C READ PIONEER 10 COSMIC RAY COUNT AND TRANSLATE INTO MASTER DATA SET FORMAT
C
      INTEGER*4 YEAR,MONTH,DAY,HOUR,DAYS,MDAY
      INTEGER*4 DUMMY1,DUMMY2,IN(35)
      REAL*4 FIN(35)
      EQUIVALENCE(IN(1),FIN(1))
C
      ISC = 6
      ISTART = 9100100
      ISTOP = 9200100
C
      IREAD = 0
      IWRITE = 0
    5 CONTINUE
      DO I=1,35
       FIN(I) = 0.0
      END DO
   10 CONTINUE
       READ(10,*,END=100,ERR=10) MONTH,DAY,YEAR,HOUR,DUMMY1,DUMMY2,
     &                           CRCNT,CRSIG
       IREAD = IREAD + 1
       DAYS = MDAY(MONTH,YEAR) + DAY
C      WRITE(6,850) YEAR,DAYS,HOUR,CRCNT,CRSIG
       ITIME = YEAR*100000 + DAYS*100 + HOUR
       IF (ITIME.LT.ISTART) GOTO 10
       IF (ITIME.GE.ISTOP) GOTO 100
       IN(1) = ISC
       IN(2) = YEAR
       IN(3) = DAYS
       IN(4) = HOUR
       FIN(29) = CRCNT
       FIN(30) = CRSIG
       IWRITE = IWRITE + 1
C      IF (IWRITE.GT.10000) GOTO 100
       WRITE(11,NUM=LEN) FIN
      GOTO 5
  100 CONTINUE
      STOP
  850 FORMAT(1X,I2,1X,I3.3,1X,I2,2(1X,F8.4))
      END
      INTEGER FUNCTION MDAY(MONTH,YEAR)
      INTEGER*4 MONTH,YEAR,DAYS
C
      IF (MONTH.EQ.1) THEN
       DAYS = 0
      ELSE IF (MONTH.EQ.2) THEN
       DAYS = 31
      ELSE IF (MONTH.EQ.3) THEN
       DAYS = 59
      ELSE IF (MONTH.EQ.4) THEN
       DAYS = 90
      ELSE IF (MONTH.EQ.5) THEN
       DAYS = 120
      ELSE IF (MONTH.EQ.6) THEN
       DAYS = 151
      ELSE IF (MONTH.EQ.7) THEN
       DAYS = 181
      ELSE IF (MONTH.EQ.8) THEN
       DAYS = 212
      ELSE IF (MONTH.EQ.9) THEN
       DAYS = 243
      ELSE IF (MONTH.EQ.10) THEN
       DAYS = 273
      ELSE IF (MONTH.EQ.11) THEN
       DAYS = 304
      ELSE IF (MONTH.EQ.12) THEN
       DAYS = 334
      ELSE
       WRITE(6,'(1X,''INVALID MONTH'')')
      END IF
      IF (MOD(YEAR,4).EQ.0.AND.MONTH.GT.2) DAYS = DAYS + 1
      MDAY = DAYS
      RETURN
      END
//RUN77 EXEC LOADER
//FT10F001 DD DSN=Z1SBK.P10CR.DAT,DISP=OLD
//FT11F001 DD DSN=Z1SBK.HOURAVG6,DISP=OLD
//TELL EXEC NOTIFY
//
//Z1SBKP10 JOB (U0016,N598,10),'MAG',TIME=(2,00),MSGCLASS=X
/*JOBPARM LINES=100
//FORT77 EXEC FORTRAN
C
C READS ED SMITH PIONEER FIELD TAPE                                     00000010
C WRITES CONCATENATED HOUR AVERAGE RECORD                               00000020
C CHECK FTIO FOR PROPER TAPE
C                                                                       00000030
C CODE LOGIC VERIFIED, CLEANED AND UPDATED BY Z1SBK 02/20/91
C
      CHARACTER*1 ISC
      CHARACTER*4 TEXT(30)                                              00000070
      INTEGER*4 IOUT(35)                                                00000050
      REAL*4 TRAJ(6),MAG(15),OUT(35)/35*0.0/                            00000040
      EQUIVALENCE (OUT(1),IOUT(1))                                      00000060
C
      ISTART = 72001
      ISTOP = 76001
      CON = 3.14159 / 180.0
      IWRITE = 0
   10 CONTINUE                                                          00000120
C
C READ HEADER RECORD FOR DATE, S/C IDENTIFIER AND TRAJECTORY DATA
C
       READ(10,890,END=100,ERR=10) IYR,IDAY,ISC,TRAJ,TEXT               00000130
C
       ITIME = IYR*1000 + IDAY
       IF (ITIME.LT.ISTART) GOTO 10
       IF (ITIME.GE.ISTOP) GOTO 100
C
       IF (ISC.EQ.'F') THEN
        IOUT(1) = 6
       ELSE IF (ISC.EQ.'G') THEN
        IOUT(1) = 7
       ELSE IF (ISC.EQ.'3') THEN
        IOUT(1) = 0
       ELSE
        IOUT(1) = -1
       END IF
       IF (IOUT(1).LT.0) GO TO 100
C
C      WRITE(6,890) IYR,IDAY,ISC,TRAJ(1)
       R = TRAJ(1) / 1.5E8
       OUT(5) = 0.
       OUT(6) = 0.
       OUT(7) = 0.
       OUT(8) = 0.
       IF (R.GE.0.9 .AND. R.LE.100.0) THEN
        OUT(8) = R
        OUT(5) = R*COS(TRAJ(2)*CON)*COS(TRAJ(3)*CON)
        OUT(6) = R*COS(TRAJ(2)*CON)*SIN(TRAJ(3)*CON)
        OUT(7) = R*SIN(TRAJ(2)*CON)
       END IF
C
C READ 24 HOUR AVERAGE MAG RECORDS FOLLOWED BY SINGLE DAILY AVERAGE
C MAG RECORD AND 5 BLANK RECORDS.
C
       DO 20 I = 1,30                                                   00000190
        IHOUR = I - 1                                                   00000200
        READ(10,891,END=100) (MAG(K),K=1,15)                            00000210
        IF (I.GT.24) GO TO 20
C       WRITE(6,909) IHOUR,MAG(2),MAG(3),MAG(4),MAG(14)
        IOUT(2) = IYR                                                   00000240
        IOUT(3) = IDAY                                                  00000250
        IOUT(4) = IHOUR                                                 00000260
C
        OUT(9) = 0.
        OUT(10) = 0.
        OUT(11) = 0.
        OUT(12) = 0.
        F1 = MAG(14)
        F2  = SQRT(MAG(2)**2 + MAG(3)**2 + MAG(4)**2)                   00000290
        IF (F1.GE.0.001 .AND. F2.GE.0.001) THEN                         00000270
         OUT(9) = F1                                                    00000280
         OUT(10) = F2                                                   00000300
         OUT(11) = ATAN(MAG(4)/SQRT(MAG(2)**2+MAG(3)**2)) / CON         00000310
         OUT(12) = ATAN2(MAG(3),MAG(2)) / CON                           00000320
         IF (OUT(12).LT.0.0) OUT(12) = 360.0 + OUT(12)                  00000330
        END IF
        WRITE(6,907) IOUT(1),IOUT(2),IOUT(3),IOUT(4),OUT(9),OUT(10),
     .                OUT(11),OUT(12),OUT(5),OUT(6),OUT(7),OUT(8)
        WRITE(11,NUM=N) OUT                                             00000340
        IWRITE = IWRITE + 1
   20  CONTINUE                                                         00000350
      GOTO 10                                                           00000360
 100  CONTINUE                                                          00000420
      WRITE(6,'('' NUMBER OF RECORDS WRITTEN: '',I5.5)') IWRITE
      STOP                                                              00000430
 890  FORMAT(3X,I2,2X,I3,4X,A1,15X,6E15.6,30A4)                         00000440
 891  FORMAT(8E15.6,15X,7E15.6)                                         00000450
 900  FORMAT(I2,I3,I4,I3,4F7.2,4F7.3)                                   00000460
 901  FORMAT(I4,4E15.6)                                                 00000480
 902  FORMAT(30A4)                                                      00000470
 907  FORMAT(I2,I3,I4,I3,2F8.3,2F5.1,4F7.2)
 909  FORMAT(I3,4F12.4)
      END                                                               00000490
//RUN77 EXEC LOADER,REGION=500K                                         00000500
//SYSUDUMP DD DUMMY
//FT10F001 DD LABEL=(1,NL,,IN),DCB=(RECFM=FB,BLKSIZE=7440,              00000510
//            LRECL=240,OPTCD=Q,DEN=4),UNIT=6250,VOL=SER=MAGP10         00000520
//*T10F001 DD LABEL=(1,NL,,IN),DCB=(RECFM=FB,BLKSIZE=7440,              00000510
//*           LRECL=240,OPTCD=Q,DEN=4),UNIT=6250,VOL=SER=P11MAG         00000520
//*T11F001 DD DSN=Z1SBK.HOURAVG6,DISP=OLD                               00000530
//FT11F001 DD DSN=Z1SBK.MSTRDS,DISP=MOD                                 00000530
//*T12F001 DD DSN=Z1SBK.TEMP,DISP=OLD
//NOTIFY EXEC NTSO
//
//Z1SBKP11 JOB (U0016,N598,15),'PIOPLS',TIME=(1,00),MSGCLASS=X
//FORT77 EXEC FORTRAN
C
C FOR CONCATENATED HOUR AVERAGE TAPE                                    00000010
C INCLUDES SELECTED PIONEER HOUR AVERAGES                               00000020
C                                                                       00000030
C PROGRAM WRITTEN BY Z1SBK 03/13/91
C
      CHARACTER*5 YYDDD
      INTEGER*4 IN(35),IOUT(35)                                         00000050
      REAL*4 FIN(35),OUT(35),ORBIT(16)                                  00000040
      EQUIVALENCE (OUT(1),IOUT(1)),(FIN(1),IN(1)),(FIN(15),ORBIT(1))    00000060
C
      CON = 3.14159/180.0                                               00000180
C
C PIONEER 10
C     IOUT(1) = 6
C PIONEER 11
      IOUT(1) = 7                                                       00000070
C
      IREAD = 0
      IWRITE = 0
   20 CONTINUE                                                          00000090
       DO I=2,35                                                        00000100
        OUT(I) = 0.0                                                    00000110
       END DO                                                           00000120
   15 READ(10,NUM=LEN,ERR=15,END=100) FIN
       IREAD = IREAD + 1
       WRITE(YYDDD,'(I5)') IN(1)
       READ(YYDDD,'(I2,I3)') IYEAR,IDAY
       IOUT(2) = IYEAR
       IOUT(3) = IDAY
       IOUT(4) = IN(3)
       IF (IYEAR.GT.74) GOTO 100
       R = ORBIT(1) / 1.497E8                                           00000170
       X = R * COS(ORBIT(16)*CON) * COS(ORBIT(15)*CON)                  00000190
       Y = R * SIN(ORBIT(16)*CON) * COS(ORBIT(15)*CON)                  00000200
       Z = R * SIN(ORBIT(15)*CON)                                       00000210
       OUT(5) = X                                                       00000220
       OUT(6) = Y                                                       00000230
       OUT(7) = Z                                                       00000240
       OUT(8) = R                                                       00000250
       OUT(13) = FIN(5)                                                 00000260
       OUT(14) = FIN(7)                                                 00000270
       OUT(15) = FIN(6)                                                 00000280
       OUT(16) = FIN(8)                                                 00000290
       OUT(17) = FIN(4)                                                 00000300
       OUT(31) = FIN(31)
       OUT(32) = FIN(32)
       OUT(33) = FIN(33)
       OUT(34) = FIN(34)
       WRITE(11,NUM=N) OUT
       IWRITE = IWRITE + 1
      GO TO 20                                                          00000320
  100 CONTINUE
      WRITE(6,'('' RECORDS READ: '',I5)') IREAD
      WRITE(6,'('' RECORDS WRITTEN: '',I5)') IWRITE
      STOP                                                              00000330
      END                                                               00000340
//RUN77 EXEC LOADER,REGION=750K                                         00000350
//FT10F001 DD DCB=(RECFM=VBS,LRECL=144,BLKSIZE=14404,DEN=3),            00000360
//            UNIT=6250,LABEL=(2,NL,,IN),VOL=SER=P11PLS                 00000370
//FT11F001 DD DSN=Z1SBK.HOURAVG7,DISP=OLD                               00000380
//NOTIFY EXEC NTSO
//
//Z1SBKPLS JOB (U0016,N598,05),'AVG PLS DATA',TIME=(1,00),              00010004
// CLASS=A,MSGCLASS=X,NOTIFY=Z1SBK                                      00020004
/*JOBPARM LINES=200                                                     00030004
// EXEC FORTVCLG                                                        00040004
      PARAMETER (IARR=65000,NFIELD=7,NWORD=8,CON=57.2957795,            00050004
     &           BLT=1.38066E-23,PRTN=1.67265E-27,                      00060004
     &           PWGT=0.01)                                             00070004
      CHARACTER DSN*50                                                  00080004
      INTEGER*4 NUM(IARR,NFIELD),NOUT(NFIELD),DATE(6),IN(35)            00090004
      REAL*4 DATA(IARR,NFIELD),AVG(IARR,NFIELD),VAL,                    00100004
     &       V(IARR),DEN(IARR),TEMP(IARR),TDAY(IARR),                   00110004
     &       VD(IARR),VL(IARR),WORD(NWORD),FIN(35)                      00120004
      REAL*8 TIME(IARR),T1,T2,TOUT(IARR),T,DECYR,DECDY,DAYS             00130004
C                                                                       00140004
      EQUIVALENCE(DATA(1,1),V(1)),                                      00150004
     &           (DATA(1,2),VD(1)),                                     00160004
     &           (DATA(1,3),VL(1)),                                     00170004
     &           (DATA(1,4),DEN(1)),                                    00180004
     &           (DATA(1,5),TEMP(1))                                    00190004
C                                                                       00200004
      DATA IN/35*0/, FIN/35*0.0/                                        00210004
C                                                                       00220004
C     WRITE(6,*)                                                        00230004
C     WRITE(6,*) 'ENTER PLASMA DATA SET NAME'                           00240004
C     READ(5,'(A)') DSN                                                 00250004
      DSN = '/Z1SBK.V290DET.PLS'                                        00260008
      OPEN(50,FILE=DSN,STATUS='OLD',FORM='FORMATTED')                   00270004
C                                                                       00280004
C GET DECIMAL YEAR START AND END TIMES                                  00290004
C                                                                       00300004
C     WRITE(6,*)                                                        00310004
C     WRITE(6,*) 'ENTER START TIME (YY/DDD/HH:MM:SS:FFF)'               00320004
C     READ(5,'(I2,1X,I3,1X,3(1X,I2),1X,I3)',ERR=5) DATE                 00330004
      DATE(1) = 90                                                      00340004
      DATE(2) = 1                                                       00350004
      DATE(3) = 0                                                       00360004
      DATE(4) = 0                                                       00370004
      DATE(5) = 0                                                       00380004
      DATE(6) = 0                                                       00390004
    5 CONTINUE                                                          00400004
      T1 = DECYR(DATE)                                                  00410004
C     WRITE(6,*)                                                        00420004
C     WRITE(6,*) 'ENTER STOP TIME  (YY/DDD/HH:MM:SS:FFF)'               00430004
C     READ(5,'(I2,1X,I3,1X,3(1X,I2),1X,I3)',ERR=6) DATE                 00440004
      DATE(1) = 91                                                      00450004
      DATE(2) = 1                                                       00460004
      DATE(3) = 0                                                       00470004
      DATE(4) = 0                                                       00480004
      DATE(5) = 0                                                       00490004
      DATE(6) = 0                                                       00500004
    6 CONTINUE                                                          00510004
      T2 = DECYR(DATE)                                                  00520004
C                                                                       00530004
      FILL = 0.0                                                        00540007
      NPTS = 0                                                          00550004
   20 CONTINUE                                                          00560004
       READ(50,*,END=200) IYEAR,IDAY,HOUR,                              00570004
     &                           (WORD(I),I=1,8)                        00580004
C                                                                       00590004
       DATE(1) = IYEAR - 1900                                           00600004
       DATE(2) = IDAY                                                   00610004
       DATE(3) = INT(HOUR)                                              00620004
       REALMIN = (HOUR-REAL(DATE(3)))*60.0                              00630004
       DATE(4) = INT(REALMIN)                                           00640004
       SEC = (REALMIN-REAL(DATE(4)))*60.0                               00650004
       DATE(5) = INT(SEC)                                               00660004
       FRACSEC = (SEC-REAL(DATE(5)))*1000.0                             00670004
       DATE(6) = INT(FRACSEC)                                           00680004
C                                                                       00690004
       T = DECYR(DATE)                                                  00700004
       IF (T.LT.T1) GOTO 20                                             00710004
       IF (T.GT.T2) GOTO 200                                            00720004
       NPTS = NPTS + 1                                                  00730004
       TIME(NPTS) = T                                                   00740004
C                                                                       00750004
       VMAG = WORD(1)                                                   00760004
       IF (VMAG.LT.200.0) THEN                                          00770004
        WORD(1) = FILL                                                  00780004
        WORD(4) = FILL                                                  00790004
        WORD(5) = FILL                                                  00800004
        WORD(6) = FILL                                                  00810004
       END IF                                                           00820004
       IF (WORD(2).LE.0.0) WORD(2) = FILL                               00830004
       IF (WORD(3).LE.0.0) WORD(3) = FILL                               00840004
C VELOCITY                                                              00850004
       DATA(NPTS,1) = WORD(1)                                           00860004
C RADIAL COMPONENT                                                      00870004
       DATA(NPTS,2) = WORD(4)                                           00880004
C TANGENTIAL COMPONENT                                                  00890004
       DATA(NPTS,3) = WORD(5)                                           00900004
C NORMAL COMPONENT                                                      00910004
       DATA(NPTS,4) = WORD(6)                                           00920004
C ION DENSITY                                                           00930004
       DATA(NPTS,5) = WORD(2)                                           00940004
C THERMAL VELOCITY                                                      00950004
       DATA(NPTS,6) = WORD(3)                                           00960004
C                                                                       00970004
C      WRITE(6,'(6(1X,I3),4(1X,F6.1),2(1X,E10.4))')                     00980004
C    &  DATE,(DATA(NPTS,I),I=1,6)                                       00990004
C                                                                       01000004
      GOTO 20                                                           01010004
C                                                                       01020004
  200 CONTINUE                                                          01030004
      CLOSE(50)                                                         01040004
      WRITE(6,*)                                                        01050004
      WRITE(6,'(1X,I5.5,'' RECORDS INPUTTED'')') NPTS                   01060004
      IF (NPTS.GT.IARR) THEN                                            01070004
       WRITE(6,*)                                                       01080004
       WRITE(6,*) 'REDIMENSION IARR GT ',NPTS                           01090004
       GOTO 999                                                         01100004
      END IF                                                            01110004
C      DO N = 1,NPTS                                                    01120004
C       CALL CALTIME(TIME(N),DATE)                                      01130004
C       WRITE(6,'(6(1X,I3),4(1X,F6.1),2(1X,E10.4))')                    01140004
C     &  DATE,(DATA(N,I),I=1,6)                                         01150004
C      END DO                                                           01160004
C                                                                       01170004
C ALL DATA FIELDS ARE AVERAGED OVER THE SAME TIME PERIODS SUCH THAT EACH01180004
C FIELD AVERAGE ARRAY SHARES A COMMON TIME AVERAGE ARRAY.               01190004
C                                                                       01200004
C     WRITE(6,*)                                                        01210005
C     WRITE(6,*) 'ENTER RESOLUTION OF INPUT DATA (SECONDS)'             01220005
C     READ(5,*) BTIME                                                   01230005
      BTIME = 0.0                                                       01231005
      BTIME = BTIME/3600.0                                              01240004
C     WRITE(6,*)                                                        01250005
C     WRITE(6,*) 'ENTER AVERAGING PERIOD (SECONDS)'                     01260005
C     READ(5,*) DTIME                                                   01270005
      DTIME = 3600.0                                                    01271005
      DTIME = DTIME/3600.0                                              01280004
      NUMAVGS = NINT((T2-T1)/(DTIME/24.0/DAYS(T1)))                     01290004
      IF (NUMAVGS.GT.IARR) THEN                                         01300004
       WRITE(6,*)                                                       01310004
       WRITE(6,*) 'EXPECTED NUMBER OF AVERAGES EXCEEDS PARAMETER IARR'  01320004
       WRITE(6,*) 'REDIMENSION IARR GT ',NUMAVGS                        01330004
      END IF                                                            01340004
      IF (NUMAVGS.GT.IARR) GOTO 999                                     01350004
      NMAX = 0                                                          01360004
C                                                                       01370004
      WRITE(6,*)                                                        01380004
      WRITE(6,*) 'BEGIN AVERAGING FIELDS'                               01390004
      DO IVAR = 1,NFIELD                                                01400004
       CALL HRAVG(T1,T2,FILL,BTIME,DTIME,TIME,DATA(1,IVAR),NPTS,        01410004
     &            TOUT,AVG(1,IVAR),NUM(1,IVAR),NOUT(IVAR))              01420004
       IF (IVAR.EQ.1) THEN                                              01430004
        NMAX = NOUT(IVAR)                                               01440004
       ELSE                                                             01450004
        IF (NOUT(IVAR).NE.NMAX) WRITE(6,*) 'ARRAY PHASING ERROR'        01460004
       END IF                                                           01470004
      END DO                                                            01480004
      WRITE(6,*) 'END AVERAGING FIELDS'                                 01490004
C                                                                       01500004
      WRITE(6,*)                                                        01510006
C     WRITE(6,*) 'ENTER OUTPUT DATASET NAME'                            01520004
C     READ(5,'(A)') DSN                                                 01530004
C     DSN = '/Z1SBK.V290PLS.AVE'                                        01540004
C     OPEN(70,FILE=DSN,STATUS='NEW',FORM='UNFORMATTED')                 01550004
C     WRITE(6,*)                                                        01560004
C     WRITE(6,*) 'ENTER S/C ID #'                                       01570004
C     READ(5,*) ID                                                      01580004
      ID = 2                                                            01590004
C                                                                       01600004
C OUTPUT AVERAGED PLASMA DATA                                           01610004
C                                                                       01620004
      IWRITE = 0                                                        01621006
      DO JJ = 1,NMAX                                                    01630004
       ITIME = INT(TOUT(JJ))                                            01640004
       LEAP = 365.0                                                     01650004
       IF (MOD(ITIME,4).EQ.0) LEAP = 366.0                              01660004
       TDAY(JJ) = REAL((TOUT(JJ)-DBLE(ITIME))*DBLE(LEAP)) + 1.0         01670004
       V(JJ) = AVG(JJ,1)                                                01680004
       VR = AVG(JJ,2)                                                   01690004
       VT = AVG(JJ,3)                                                   01700004
       VN = AVG(JJ,4)                                                   01710004
       VRT = SQRT(VR**2+VT**2)                                          01720004
C                                                                       01730004
       IF (VR.NE.FILL.AND.VT.NE.FILL.AND.VN.NE.FILL) THEN               01740004
        VD(JJ) = ATAN2(VN,VRT)*CON                                      01750004
        VL(JJ) = -ATAN2(VT,VR)*CON                                      01760004
       ELSE                                                             01770004
        VD(JJ) = FILL                                                   01780004
        VL(JJ) = FILL                                                   01790004
       END IF                                                           01800004
C                                                                       01810004
       DEN(JJ) = AVG(JJ,5)                                              01820004
C                                                                       01830004
       W = AVG(JJ,6)                                                    01840004
       IF (W.NE.FILL) THEN                                              01850004
        TEMP(JJ) = PRTN*(W*1000.0)**2.0/(2.0*BLT)                       01860004
       ELSE                                                             01870004
        TEMP(JJ) = FILL                                                 01880004
       END IF                                                           01890004
C                                                                       01900004
C OUTPUT AVERAGED PLASMA DATA                                           01910004
C                                                                       01920004
       CALL CALTIME(TOUT(JJ),DATE)                                      01930004
       IN(1) = ID                                                       01940004
       IN(2) = DATE(1)                                                  01950004
       IN(3) = DATE(2)                                                  01960004
       IN(4) = DATE(3)                                                  01970004
       FIN(13) = V(JJ)                                                  01980004
       FIN(14) = VD(JJ)                                                 01990004
       FIN(15) = VL(JJ)                                                 02000004
       FIN(16) = DEN(JJ)                                                02010004
       FIN(17) = TEMP(JJ)                                               02020004
       WRITE(70) (IN(I),I=1,4),(FIN(I),I=5,35)                          02030006
       WRITE(6,'(6(1X,I3),3(1X,F6.1),2(1X,E10.4))')                     02040006
     &  DATE,V(JJ),VD(JJ),VL(JJ),DEN(JJ),TEMP(JJ)                       02040106
       IWRITE = IWRITE + 1                                              02041006
      END DO                                                            02050004
      WRITE(6,*)                                                        02051006
      WRITE(6,*) IWRITE, ' RECORDS WRITTEN'                             02052006
      WRITE(6,*)                                                        02053006
C                                                                       02060004
  900 CONTINUE                                                          02070004
  975 FORMAT(1X,I1,1X,F11.8,4(1X,F8.2),2(1X,F6.2),2(1X,E10.4))          02080004
C                                                                       02090004
  999 CONTINUE                                                          02100004
      STOP                                                              02110004
      END                                                               02120004
      SUBROUTINE HRAVG(T1,T2,FILL,BTIME,DTIME,T,DATA,NPTS,              02130004
     &                 TOUT,DOUT,PARR,NOUT)                             02140004
C                                                                       02150004
C PRODUCE AVERAGES OF PERIOD DTIME FROM INPUTTED HOUR AVERAGE DATA.     02160004
C ROUTINE DOES NOT REMOVE TIME POINTS WITH NULL AVERAGES.               02170004
C                                                                       02180004
      INTEGER*4 PARR(1)                                                 02190004
      REAL*4 DATA(1),DOUT(1)                                            02200004
      REAL*8 T(1),TIME,TIME1,TIME2,TOUT(1),T1,T2,TEND,DAYS              02210004
C                                                                       02220004
C T1 START TIME                                                         02230004
C T2 END TIME                                                           02240004
C FILL  FILL DATA VALUE                                                 02250004
C BTIME RESOLUTION OF INPUT DATA (HOURS)                                02260004
C DTIME AVERAGING INTERVAL (HOURS)                                      02270004
C T     INPUT TIME ARRAY                                                02280004
C DATA  INPUT DATA ARRAY                                                02290004
C NPTS  NUMBER OF POINTS IN INPUT DATA                                  02300004
C TOUT  OUTPUT TIME ARRAY                                               02310004
C DOUT  OUTPUT ARRAY OF DTIME AVERAGES                                  02320004
C PARR  OUTPUT ARRAY - # OF AVGS/PT                                     02330004
C NOUT NUMBER OF POINTS IN OUTPUT DATA                                  02340004
C                                                                       02350004
      SUM = 0.0                                                         02360004
      NUM = 0                                                           02370004
      TEND = T2 + DBLE(BTIME/(100.0*24.0*DAYS(T2)))                     02380004
C                                                                       02390004
      TIME1 = T1 - DBLE(BTIME/(100.0*24.0*DAYS(T1)))                    02400004
      TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))                    02410004
      IARR = 0                                                          02420004
      INDEX = 0                                                         02430004
  10  CONTINUE                                                          02440004
       IARR = IARR + 1                                                  02450004
       IF (IARR.GT.NPTS) GOTO 20                                        02460004
       TIME = T(IARR)                                                   02470004
       VAL = DATA(IARR)                                                 02480004
C                                                                       02490004
C GET DATA FROM PROPER TIME INTERVAL                                    02500004
C                                                                       02510004
  15   CONTINUE                                                         02520004
       IF (TIME.LT.TIME1) GOTO 10                                       02530004
       IF (TIME.GE.TIME2) GOTO 20                                       02540004
       IF (TIME.GT.TEND) GOTO 20                                        02550004
C                                                                       02560004
C ACCUMULATE DATA NOT INCLUDING FILL POINTS                             02570004
C                                                                       02580004
       IF (VAL.NE.FILL) THEN                                            02590004
        SUM = SUM + VAL                                                 02600004
        NUM = NUM + 1                                                   02610004
       END IF                                                           02620004
C                                                                       02630004
      GOTO 10                                                           02640004
   20 CONTINUE                                                          02650004
C                                                                       02660004
C AVERAGE DATA AND INCREMENT TIME INTERVAL                              02670004
C                                                                       02680004
       AVG = FILL                                                       02690004
       IF (NUM.NE.0) THEN                                               02700004
        AVG = SUM/FLOAT(NUM)                                            02710004
       END IF                                                           02720004
       INDEX = INDEX + 1                                                02730004
       TOUT(INDEX) = TIME1 + DBLE(BTIME/(100.0*24.0*DAYS(TIME1)))       02740004
       DOUT(INDEX) = AVG                                                02750004
       PARR(INDEX) = NUM                                                02760004
       TIME1 = TIME2                                                    02770004
       TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))                   02780004
       SUM = 0.0                                                        02790004
       NUM = 0                                                          02800004
      IF (IARR.LE.NPTS.AND.TIME.LE.TEND) GOTO 15                        02810004
C                                                                       02820004
C RETURN FROM AVERAGING OVER DESIRED TIME INTERVAL                      02830004
C                                                                       02840004
 100  CONTINUE                                                          02850004
      WRITE(6,800) TOUT(1),TOUT(INDEX),INDEX                            02860004
      CLOSE(10)                                                         02870004
      NOUT = INDEX                                                      02880004
C                                                                       02890004
      RETURN                                                            02900004
 800  FORMAT(' START ',F12.8,'   STOP ',F12.8,'   POINTS ',I5)          02910004
      END                                                               02920004
      DOUBLE PRECISION FUNCTION DECYR(DATE)                             02930004
C                                                                       02940004
C CONVERT HIGH RESOLUTION CALENDAR TIME INTO DECIMAL TIME               02950004
C                                                                       02960004
      INTEGER*4 DATE(6)                                                 02970004
      REAL*8 YEAR,DAY,HOUR,MIN,SEC,MSEC,LEAP                            02980004
      LEAP = 365.0D0                                                    02990004
      IF ( MOD(DATE(1),4 ).EQ.0 ) LEAP = 366.0D0                        03000004
      MSEC = DFLOAT(DATE(6))                                            03010004
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0                             03020004
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0                                03030004
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0                               03040004
      DAY = DFLOAT(DATE(2)-1) + HOUR/24.0D0                             03050004
      YEAR = DFLOAT(DATE(1)) + DAY/LEAP                                 03060004
      DECYR = YEAR                                                      03070004
      RETURN                                                            03080004
      END                                                               03090004
      DOUBLE PRECISION FUNCTION DECDY(DATE)                             03100004
C                                                                       03110004
C CONVERT HIGH RESOLUTION CALENDAR DATA TO DECIMAL DAY                  03120004
C                                                                       03130004
      INTEGER*4 DATE(6)                                                 03140004
      REAL*8 DAY,HOUR,MIN,SEC,MSEC                                      03150004
      MSEC = DFLOAT(DATE(6))                                            03160004
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0                             03170004
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0                                03180004
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0                               03190004
      DAY = DFLOAT(DATE(2)) + HOUR/24.0D0                               03200004
      DECDY = DAY                                                       03210004
C                                                                       03220004
      RETURN                                                            03230004
      END                                                               03240004
      DOUBLE PRECISION FUNCTION DAYS(YEAR)                              03250004
C                                                                       03260004
C DETERMINE NUMBER OF DAYS IN DECIMAL YEAR                              03270004
C                                                                       03280004
      REAL*8 YEAR                                                       03290004
C                                                                       03300004
      IYR = INT(YEAR)                                                   03310004
      IF ( MOD(IYR,4).EQ.0 ) THEN                                       03320004
       DAYS = 366.0D0                                                   03330004
      ELSE                                                              03340004
       DAYS = 365.0D0                                                   03350004
      END IF                                                            03360004
C                                                                       03370004
      RETURN                                                            03380004
      END                                                               03390004
      SUBROUTINE CALTIME(YEAR,DATE)                                     03400004
C                                                                       03410004
C CONVERT DECIMAL YEAR INTO CALENDAR TIME                               03420004
C                                                                       03430004
      INTEGER*4 DATE(6)                                                 03440004
      REAL*8 YEAR,DAY,HOUR,MIN,SEC,MSEC                                 03450004
C                                                                       03460004
      YEAR = YEAR + 0.00000001D0                                        03470004
      DATE(1) = INT(YEAR)                                               03480004
      IF ( MOD(DATE(1),4).EQ.0 ) THEN                                   03490004
       LEAP = 366.0D0                                                   03500004
      ELSE                                                              03510004
       LEAP = 365.0D0                                                   03520004
      END IF                                                            03530004
      DAY = (YEAR - DBLE(DATE(1))) * LEAP                               03540004
      DATE(2) = INT(DAY)                                                03550004
      HOUR = (DAY - DBLE(DATE(2))) * 24.0D0                             03560004
      DATE(3) = INT(HOUR)                                               03570004
      MIN = (HOUR -  DBLE(DATE(3))) * 60.0D0                            03580004
      DATE(4) = INT(MIN)                                                03590004
      SEC =  (MIN - DBLE(DATE(4))) * 60.0D0                             03600004
      DATE(5) = INT(MIN)                                                03610004
      MSEC = (MIN - DBLE(DATE(5))) * 1000.0D0                           03620004
      DATE(6) = INT(MSEC)                                               03630004
C                                                                       03640004
C MAKE DAY 1 = JAN 1                                                    03650004
C                                                                       03660004
      DATE(2) = DATE(2) + 1                                             03670004
C                                                                       03680004
      RETURN                                                            03690004
      END                                                               03700004
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR                             03710004
//GO.SYSUDUMP DD DUMMY                                                  03720004
//FT70F001 DD DSN=Z1SBK.HOURAVG2,DISP=OLD                               03721006
//TELL EXEC NOTIFY                                                      03730004
//                                                                      03740004
//Z1SBKPLS JOB (U0016,N598,10),'AVG PLS DATA',TIME=(2,00),
// CLASS=A,MSGCLASS=X,NOTIFY=Z1SBK
/*JOBPARM LINES=200
// EXEC FORTVCLG
C
C AVERAGE HIGH RESOLUTION MIT PLASMA DATA
C FROM UNITREE DATA FILES.
C WRITTEN BY SANDY KRAMER, HUGHES-STX, CODE 694
C
      PARAMETER (IARR=70000,NFIELD=8)
      CHARACTER*50 DSN,PLSDSN,AVGDSN
      INTEGER*4 NUM(IARR,NFIELD),NOUT(NFIELD),DATE(6)
      REAL*4 DATA(IARR,NFIELD),AVG(IARR,NFIELD),
     &       PLASMA(8),HR
      REAL*8 TIME(IARR),T1,T2,TOUT(IARR),T,CONVERT,
     &       DECYR,DECDY
C
C PROGRAM START AND STOP TIMES YYDDDHH
C
      IBEG = 9000100
      IEND = 9100100
      T1 = CONVERT(IBEG)
      T2 = CONVERT(IEND)
C
C AVERAGING WINDOW OFFSET (SECONDS)
C
      BTIME =  0.0
C
C AVERAGING PERIOD (SECONDS)
C
      DTIME = 192.0
C
      PLSDSN = 'Z1SBK.V290.PLS'
      AVGDSN = 'Z1SBK.V290.AVG'
C
C GET SUMMARY PLASMA DATA
C
      DSN = PLSDSN
      OPEN(51,FILE='/'//DSN,STATUS='OLD',FORM='FORMATTED')
C
C SUPPRESS INVALID CHARACTER ERR MESSAGE IN PLASMA DATA READ
C
      CALL ERRSET(227,256,-1)
C
C READ MIT PLASMA DATA IN KEY PARAMS FORMAT
C
      NPTS = 0
  110 CONTINUE
       READ(51,*,NUM=LEN,ERR=110,END=200) IYR,IDY,HR,(PLASMA(I),I=1,6)
C      WRITE(6,900) IYR,IDY,HR,(PLASMA(I),I=1,8)
       DATE(1) = IYR - 1900
       DATE(2) = IDY
       DATE(3) = INT(HR)
       RMIN = (HR-DATE(3)) * 60.0
       DATE(4) = INT(RMIN)
       RSEC = (RMIN-DATE(4)) * 60.0
       DATE(5) = INT(RSEC)
       DATE(6) = INT(RSEC-DATE(5)) * 1000
C      WRITE(6,901) (DATE(J),J=1,6),(PLASMA(I),I=1,8)
       T = DECYR(DATE)
       IF (T.LT.T1) GOTO 110
       IF (T.GE.T2) GOTO 200
       NPTS = NPTS + 1
       TIME(NPTS) = T
       DO J=1,8
        IF (PLASMA(J).NE.0.0) THEN
         DATA(NPTS,J) = PLASMA(J)
        ELSE
         DATA(NPTS,J) = 999.0
        END IF
       END DO
C      WRITE(6,902) ID,TIME(NPTS),(DATA(NPTS,K),K=1,8)
      GOTO 110
  200 CONTINUE
  900 FORMAT(1X,2I4,F10.5,F7.1,F9.5,4F7.1,F6.1,E10.3)
  901 FORMAT(1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,
     &       F7.1,F9.5,4F7.1,F6.1,E10.3)
  902 FORMAT(1X,I1,1X,F11.8,3(1X,F6.1),2(1X,E10.4),1X,F8.4)
      CLOSE(51)
C
      WRITE(6,*)
      WRITE(6,'(1X,I5.5,'' RECORDS INPUTTED'')') NPTS
C
C CHECK NUMBER OF INPUT RECORDS IN BOUNDS
C
      IF (NPTS.GT.IARR) THEN
       WRITE(6,*) 'REDIMENSION IARR GT ',NPTS
       GOTO 999
      END IF
C
C AVERAGE PLASMA DATA
C
C ALL DATA FIELDS ARE AVERAGED OVER THE SAME TIME PERIODS SUCH THAT EACH
C FIELD AVERAGE ARRAY SHARES A COMMON TIME AVERAGE ARRAY.
C
      NUMAVGS = NINT((T2-T1)/(DTIME/(24.0*DAYS(T1))))
C
C CHECK NUMBER CALCULATED AVERAGES IN BOUNDS
C
      IF (NUMAVGS.GT.IARR) THEN
       WRITE(6,*) 'EXPECTED NUMBER OF AVERAGES EXCEEDS PARAMETER IARR'
       WRITE(6,*) 'REDIMENSION IARR GT ',NUMAVGS
       GOTO 999
      END IF
      FILL = 999.0
      NMAX = 0
C
      WRITE(6,*)
      WRITE(6,*) 'BEGIN AVERAGING FIELDS'
      WRITE(6,*)
      DO IVAR = 1,8
       CALL HRAVG(T1,T2,FILL,BTIME,DTIME,TIME,DATA(1,IVAR),NPTS,
     &            TOUT,AVG(1,IVAR),NUM(1,IVAR),NOUT(IVAR))
       IF (IVAR.EQ.1) THEN
        NMAX = NOUT(IVAR)
       ELSE
        IF (NOUT(IVAR).NE.NMAX) WRITE(6,*) 'ARRAY PHASING ERROR'
       END IF
      END DO
      WRITE(6,*)
      WRITE(6,*) 'END AVERAGING FIELDS'
      WRITE(6,*)
C
  888 CONTINUE
      DSN = AVGDSN
C     OPEN(52,FILE='/'//DSN,STATUS='NEW',FORM='FORMATTED')
      DO K = 1,NMAX
       CALL GETDATE(TOUT(K),DATE)
C      WRITE(52,950) ID,TOUT(K),(AVG(K,I),I=1,8)
       WRITE( 6,955) ID,DATE,(AVG(K,I),I=1,8)
      END DO
C     CLOSE(52)
C
  999 CONTINUE
      STOP
  950 FORMAT(1X,F12.9,F7.1,F9.5,4F7.1,F6.1,E10.3)
  955 FORMAT(1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,
     &       F7.1,F9.5,4F7.1,F6.1,E10.3)
      END
      SUBROUTINE HRAVG(T1,T2,FILL,BTIME,DTIME,T,DATA,NPTS,
     &                 TOUT,DOUT,PARR,NOUT)
C
C PRODUCE AVERAGES OF PERIOD DTIME FROM INPUTTED HOUR AVERAGE DATA.
C ROUTINE DOES NOT REMOVE TIME POINTS WITH NULL AVERAGES.
C
      INTEGER*4 PARR(NPTS),DATE(6)
      REAL*4 DATA(NPTS),DOUT(NPTS)
      REAL*8 T(NPTS),TIME,TIME1,TIME2,TOUT(NPTS),T1,T2,TEND
C
C T1 START TIME
C T2 END TIME
C FILL  FILL DATA VALUE
C BTIME RESOLUTION OF INPUT DATA (HOURS)
C DTIME AVERAGING INTERVAL (HOURS)
C T     INPUT TIME ARRAY
C DATA  INPUT DATA ARRAY
C NPTS  NUMBER OF POINTS IN INPUT DATA
C TOUT  OUTPUT TIME ARRAY
C DOUT  OUTPUT ARRAY OF DTIME AVERAGES
C PARR  OUTPUT ARRAY - # OF AVGS/PT
C NOUT NUMBER OF POINTS IN OUTPUT DATA
C
      SUM = 0.0
      NUM = 0
      TEND = T2 + DBLE(BTIME/(100.0*24.0*DAYS(T2)))
C
      TIME1 = T1 - DBLE(BTIME/(100.0*24.0*DAYS(T1)))
      TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))
      IARR = 0
      INDEX = 0
  10  CONTINUE
       IARR = IARR + 1
       IF (IARR.GT.NPTS) GOTO 20
       TIME = T(IARR)
       VAL = DATA(IARR)
C
C GET DATA FROM PROPER TIME INTERVAL
C
  15   CONTINUE
       IF (TIME.LT.TIME1) GOTO 10
       IF (TIME.GE.TIME2) GOTO 20
       IF (TIME.GT.TEND) GOTO 20
C
C ACCUMULATE DATA NOT INCLUDING FILL POINTS
C
       IF (VAL.NE.FILL) THEN
        SUM = SUM + VAL
        NUM = NUM + 1
       END IF
C
      GOTO 10
   20 CONTINUE
C
C AVERAGE DATA AND INCREMENT TIME INTERVAL
C
       IF (NUM.NE.0) THEN
        AVG = SUM/FLOAT(NUM)
       ELSE
        AVG = FILL
       END IF
       INDEX = INDEX + 1
       TOUT(INDEX) = TIME1 + DBLE(BTIME/(100.0*24.0*DAYS(TIME1)))
       DOUT(INDEX) = AVG
       PARR(INDEX) = NUM
       TIME1 = TIME2
       TIME2 = TIME1 + DBLE(DTIME/(24.0*DAYS(TIME1)))
       SUM = 0.0
       NUM = 0
      IF (IARR.LE.NPTS.AND.TIME.LE.TEND) GOTO 15
C
C RETURN FROM AVERAGING OVER DESIRED TIME INTERVAL
C
 100  CONTINUE
      WRITE(6,800) TOUT(1),TOUT(INDEX),INDEX
      CLOSE(10)
      NOUT = INDEX
C
      RETURN
 800  FORMAT(' START ',F12.8,'   STOP ',F12.8,'   POINTS ',I5)
      END
      REAL FUNCTION DAYS(TIME)
C
C RETURN NUMBER OF DAYS IN YEAR
C
      REAL*8 TIME
C
      IYR = INT(TIME)
      IF (MOD(IYR,4).EQ.0) THEN
       DAYS = 366.0
      ELSE
       DAYS = 365.0
      END IF
C
      RETURN
      END
      SUBROUTINE GETDATE(TIME,DATE)
C
C CONVERT DECIMAL YEAR TIME INTO INTEGER CALENDAR TIME
C
      INTEGER*4 DATE(6)
      REAL*8 TIME,LEAP,YEAR,DAY,HOUR,MIN,SEC,FSEC
C
      DATE(1) = INT(TIME)
      IF (MOD(DATE(1),4).EQ.0) THEN
       LEAP = 366.0
      ELSE
       LEAP = 365.0
      END IF
      DAY = (TIME-REAL(DATE(1)))*LEAP
      DATE(2) = INT(DAY)
      HOUR = (DAY-REAL(DATE(2)))*24.0
      DATE(3) = INT(HOUR)
      MIN = (HOUR-REAL(DATE(3)))*60.0
      DATE(4) = INT(MIN)
      SEC = (MIN-REAL(DATE(4)))*60.0
      DATE(5) = INT(SEC)
      FSEC = (SEC-REAL(DATE(5)))*1000.0
      DATE(6) = INT(FSEC)
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION DECDY(DATE)
C
C CONVERT HIGH RESOLUTION CALENDAR DATA TO DECIMAL DAY
C
      INTEGER*4 DATE(6)
      REAL*8 DAY,HOUR,MIN,SEC,MSEC
C
      MSEC = DFLOAT(DATE(6))
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0
      DAY = DFLOAT(DATE(2)) + HOUR/24.0D0
      DECDY = DAY
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION DECYR(DATE)
C
C CONVERT HIGH RESOLUTION CALENDAR TIME INTO DECIMAL TIME
C
      INTEGER*4 DATE(6)
      REAL*8 YEAR,DAY,HOUR,MIN,SEC,MSEC,LEAP
C
      LEAP = 365.0D0
      IF (MOD(DATE(1),4).EQ.0) LEAP = 366.0D0
      MSEC = DFLOAT(DATE(6))
      SEC = DFLOAT(DATE(5)) + MSEC/1000.0D0
      MIN = DFLOAT(DATE(4)) + SEC/60.0D0
      HOUR = DFLOAT(DATE(3)) + MIN/60.0D0
      DAY = DFLOAT(DATE(2)-1) + HOUR/24.0D0
      YEAR = DFLOAT(DATE(1)) + DAY/LEAP
      DECYR = YEAR
C
      RETURN
      END
      DOUBLE PRECISION FUNCTION CONVERT(TIME)
C
C CONVERT REAL TIME TAG OF YYDDDHH FORMAT INTO DECIMAL YEAR
C
      CHARACTER CTIME*7
      INTEGER*4 TIME
      REAL*8 DTIME
C
      WRITE(CTIME,'(I7)') TIME
      READ(CTIME,'(I2,I3,I2)') IYR,IDY,IHR
C
      IF (MOD(IYR,4).EQ.0) THEN
       LEAP = 366.0D0
      ELSE
       LEAP = 365.0D0
      END IF
C
      DTIME = DBLE(IYR) + DBLE(IDY-1)/LEAP + DBLE(IHR)/24.0D0/LEAP
      CONVERT = DTIME
C
      RETURN
      END
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR
//GO.SYSUDUMP DD DUMMY
//TELL EXEC NOTIFY
//
//Z1SBKREM JOB (U0008,N598,20),'VGR MAG EDIT',TIME=(1,00),
// MSGCLASS=X,CLASS=A,NOTIFY=Z1SBK
/*JOBPARM LINES=100
//FORT77 EXEC FORTVCLG
C
C REMOVE USER SELECTED BAD DATA FROM HOUR AVERAGES
C WHILE COPYING DATASET.  SBK 12/17/93
C
      INTEGER*4 IN(35)
      REAL*4 FIN(35)
      EQUIVALENCE(IN(1),FIN(1))
C
      ISC = 2
      IREAD = 0
      IWRITE = 0
    5 CONTINUE
       READ(10,NUM=LEN,END=100,ERR=5) FIN
       IREAD = IREAD + 1
       IF (IN(1).NE.ISC) GOTO 50
       ITIME = IN(2)*100000 + IN(3)*100 + IN(4)
C
C BAD VOYAGER 2 TIME TAGS
C
       IF (ITIME.EQ.8925607) GOTO 10
       IF (ITIME.EQ.8925612) GOTO 10
       IF (ITIME.EQ.8928215) GOTO 10
       IF (ITIME.EQ.8933122) GOTO 10
       IF (ITIME.GE.8934816.AND.ITIME.LT.8934822) GOTO 10
C      IF (ITIME.GE.8934919.AND.ITIME.LT.8934922) GOTO 10
       IF (ITIME.EQ.9000315) GOTO 10
       IF (ITIME.EQ.9000820) GOTO 10
       IF (ITIME.EQ.9003117) GOTO 10
       IF (ITIME.EQ.9005916) GOTO 10
       IF (ITIME.GE.9007312.AND.ITIME.LT.9007318) GOTO 10
C
       IF (ITIME.GE.9011515) GOTO 10
C
       IF (ITIME.GE.9016215) GOTO 10
       IF (ITIME.GE.9019013) GOTO 10
       IF (ITIME.GE.9019113) GOTO 10
       IF (ITIME.GE.9022518) GOTO 10
C
       IF (ITIME.GE.9023613.AND.ITIME.LT.9023620) GOTO 10
       IF (ITIME.EQ.9025010) GOTO 10
       IF (ITIME.EQ.9025018) GOTO 10
       IF (ITIME.EQ.9025408) GOTO 10
       IF (ITIME.EQ.9025409) GOTO 10
       IF (ITIME.EQ.9026903) GOTO 10
       IF (ITIME.EQ.9031018) GOTO 10
       IF (ITIME.EQ.9035222) GOTO 10
       IF (ITIME.GE.9035419.AND.ITIME.LT.9035503) GOTO 10
       IF (ITIME.EQ.9101521) GOTO 10
       IF (ITIME.EQ.9101617) GOTO 10
       IF (ITIME.EQ.9101618) GOTO 10
       IF (ITIME.EQ.9105914) GOTO 10
       IF (ITIME.EQ.9107117) GOTO 10
       IF (ITIME.EQ.9107118) GOTO 10
       IF (ITIME.GE.9108013.AND.ITIME.LT.9108020) GOTO 10
       IF (ITIME.EQ.9109816) GOTO 10
       IF (ITIME.EQ.9112614) GOTO 10
       IF (ITIME.EQ.9115412) GOTO 10
       IF (ITIME.EQ.9115513) GOTO 10
       IF (ITIME.GE.9117207.AND.ITIME.LT.9117214) GOTO 10
       IF (ITIME.EQ.9118311) GOTO 10
       IF (ITIME.EQ.9118906) GOTO 10
       IF (ITIME.EQ.9121109) GOTO 10
       IF (ITIME.EQ.9121110) GOTO 10
       IF (ITIME.EQ.9123908) GOTO 10
       IF (ITIME.GE.9126301.AND.ITIME.LT.9126308) GOTO 10
       IF (ITIME.EQ.9126702) GOTO 10
       IF (ITIME.EQ.9129500) GOTO 10
       IF (ITIME.EQ.9129501) GOTO 10
       IF (ITIME.EQ.9132222) GOTO 10
       IF (ITIME.EQ.9132223) GOTO 10
       GOTO 50
C
C ASSIGN FILL VALUES TO BAD MAG DATA
C
   10  CONTINUE
       FIN(9) = 0.0
       FIN(10) = 0.0
       FIN(11) = 0.0
       FIN(12) = 0.0
C
   50  CONTINUE
       WRITE(11,NUM=N) FIN
       IWRITE = IWRITE + 1
      GO TO 5
  100 CONTINUE
      WRITE(6,*) IREAD,' RECORDS READ BY MEMBER REMOVE'
      WRITE(6,*) IWRITE,' RECORDS WRITTEN BY MEMBER REMOVE'
      STOP
      END
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR
//GO.SYSUDUMP DD DUMMY
//FT10F001 DD DSN=Z1SBK.HOURAVG,DISP=OLD
//FT11F001 DD DSN=Z1SBK.MSTEMP,DISP=OLD
//*T11F001 DD DSN=Z1SBK.MSPERM,DISP=MOD
//*T11F001 DD VOL=(PRIVATE,,SER=HRBACK),LABEL=(2,NL,,OUT),UNIT=6250,
//*        DCB=(RECFM=FB,LRECL=140,BLKSIZE=12880,DEN=4)
//*T11F001 DD VOL=(PRIVATE,,SER=SBK001),LABEL=(1,AL,,OUT),UNIT=T6250,
//*        DCB=(RECFM=FB,LRECL=80,BLKSIZE=8000,OPTCD=Q,DEN=4)
//TELL EXEC NOTIFY
//
//Z1SBKSRT JOB (U0016,N598,30),'SORT MSTR HAV DATA',TIME=(2,00),
// CLASS=A,MSGCLASS=X,NOTIFY=Z1SBK
/*JOBPARM LINES=100
//*
//* SORT HOUR AVERAGE DATA SET BY TIME AND SPACECRAFT
//*
//*ORT EXEC SORTN  THIS ROUTINE REPLACED ON MVS/ESA.  SBK 08/26/93      00000010
//SORT EXEC SORT                                                        00000010
//SYSIN DD *                                                            00000020
 SORT FIELDS=(5.,4.,A,9.,4.,A,13.,4.,A,1.,4.,A),FORMAT=BI               00000030
//SORTIN DD DSN=Z1SBK.MSPERM,DISP=OLD                                   00000050
//*ORTIN DD VOL=SER=SBK001,LABEL=(1,NL,,IN),UNIT=6250,                  00000050
//*         DCB=(RECFM=FB,LRECL=140,BLKSIZE=12880,DEN=4),DISP=OLD
//SORTOUT DD DSN=Z1SBK.MSTEMP,DISP=OLD                                  00000050
//*ORTOUT DD VOL=SER=SBK001,LABEL=(1,NL,,OUT),UNIT=6250,                00000050
//*          DCB=(RECFM=FB,LRECL=140,BLKSIZE=12880,DEN=4)
//NOTIFY EXEC NOTIFY
//
C  PROGRAM: SUMBLOCK                                                    00001033
C  PROGRAMMER: T. MCCLANAHAN  12/20/92                                  00002069
C  MODIFIED TO REMOVE LOCAL FTIO ROUTINES BY S. KRAMER  05/21/93        00002170
C  THIS PROGRAM WILL REBLOCK VOYAGER SUMMARY DATA RETRIEVED FROM        00003069
C  UNITTREE.                                                            00004069
       INTEGER*4 I4REC(63),INUNIT/10/,OUTUNIT/20/,NBYTS                 00010044
       INTEGER*4 OUT4(5000),TBYTS,INCNT,OCNT,IWRDS,TREC                 00011068
       INTEGER*2 I2REC(126),OUT2REC(10000)                              00020068
       EQUIVALENCE (I4REC(1),I2REC(1))                                  00030065
C  INITIALIZE COUNTERS. TREC  = TOTAL RECORDS PROCESSED                 00030169
C                       INCNT = CURRENT WORD IN INPUT ARRAY             00030269
C                       OCNT  = CURRENT WORD IN OUTPUT ARRAY            00030369
C                       IWRDS = VALUE READ FROM 64TH I*2 IN RECORD      00030469
C                               (NUMBER OF WORDS LEFT IN LOGICAL REC)   00030572
       TREC = 0                                                         00031024
       NBYTS = 0                                                        00031168
       IWRDS = -2                                                       00032067
       OCNT = 1                                                         00040067
       INCNT = 1                                                        00040167
       WRITE (6,*)'BEGINNING PROCESSING......'                          00041025
       DO WHILE (.TRUE.)                                                00042052
         IF (INCNT .GT. NBYTS/4) THEN                                   00050065
C          CALL FREAD(I4REC,INUNIT,NBYTS,&50,&50)                       00060070
           READ(INUNIT,NUM=NBYTS,ERR=50,END=50) I4REC                   00061070
           INCNT = 1                                                    00070065
         ENDIF                                                          00080468
           IF (OCNT .EQ. 32) IWRDS = I2REC(INCNT*2)                     00090068
           IF (IWRDS .EQ. -1) THEN                                      00120068
             TBYTS = (OCNT-1)*4                                         00121068
C            CALL FWRITE(OUT4,OUTUNIT,TBYTS)                            00130070
             WRITE(OUTUNIT,NUM=TBYTS) OUT4                              00130170
             TREC = TREC + 1                                            00130368
             OCNT = 1                                                   00130468
           END IF                                                       00151068
           OUT4(OCNT) = I4REC(INCNT)                                    00160067
           INCNT = INCNT + 1                                            00170067
           IWRDS = IWRDS - 1                                            00171067
           OCNT = OCNT + 1                                              00172067
       END DO                                                           00180065
 50    CONTINUE                                                         00341800
       TBYTS = (OCNT-1)*4                                               00342068
C      CALL FWRITE(OUT4,OUTUNIT,TBYTS)                                  00342270
       WRITE(OUTUNIT,NUM=TBYTS) OUT4                                    00342370
       TREC = TREC + 1                                                  00342461
       WRITE(6,*) 'TOTAL RECORDS PROCESSED = ',TREC                     00342524
       STOP                                                             00343000
       END                                                              00350000
//Z1SBKAVG JOB (U0016,N598,20),'AVG VGR SUMMARY DATA',TIME=(2,00),      00010036
// CLASS=A,MSGCLASS=X,NOTIFY=Z1SBK                                      00020036
// EXEC FORTVCLG                                                        00030036
      PROGRAM SUMMAVGS                                                  00040036
C                                                                       00050036
C PROGRAM MAKES AVERAGES OF HIGH RESOLUTION SUMMARY DATA                00060036
C                                                                       00070036
      PARAMETER(IARR=1000)                                              00080036
      INTEGER*2 TIME(6),OLDTIME(6),NEWTIME(6),DELTA(6)                  00090036
      INTEGER*4 MAGCNT(4),SEDRCNT(4),IN(35)                             00100036
      LOGICAL*1 STASH,HOUR                                              00110036
      REAL*4 MAGSUM(4),MAGAVG(4),MAG(4),                                00120036
     &       SEDRSUM(4),SEDRAVG(4),SEDR(4),                             00130036
     &       BR,BT,BN,F2,DEL,LAM,                                       00140036
     &       B(IARR,4),RMS(4),                                          00150036
     &       FIN(35)                                                    00160036
      REAL*8 REALTIME                                                   00170036
C                                                                       00180036
      EQUIVALENCE(IN(1),FIN(1))                                         00190036
C                                                                       00200036
C HOUR AVERAGE FORMAT OUTPUT FLAG                                       00210036
C                                                                       00220036
      HOUR = .TRUE.                                                     00230036
C     HOUR = .FALSE.                                                    00240036
C                                                                       00250036
C START TIME  YEAR/DAY/HOUR/MIN/SEC/MSEC                                00260036
C                                                                       00270036
      TIME(1) = 91                                                      00280036
      TIME(2) = 266                                                     00290039
      TIME(3) = 0                                                       00300036
      TIME(4) = 0                                                       00310036
      TIME(5) = 0                                                       00320036
      TIME(6) = 0                                                       00330036
      CALL MOVETIME(TIME,OLDTIME)                                       00340036
C                                                                       00350036
C AVERAGING PERIOD  YEARS/DAYS/HOURS/MINS/SECS/MSECS                    00360036
C                                                                       00370036
      DELTA(1) = 0                                                      00380036
      DELTA(2) = 0                                                      00390036
      DELTA(3) = 1                                                      00400036
      DELTA(4) = 0                                                      00410036
      DELTA(5) = 0                                                      00420036
      DELTA(6) = 0                                                      00430036
C                                                                       00440036
C ESTABLISH STARTING AVERAGING WINDOW                                   00450036
C                                                                       00460036
      CALL INCRTIME(TIME,DELTA)                                         00470036
      CALL MOVETIME(TIME,NEWTIME)                                       00480036
C                                                                       00490036
C INITIALIZE VARIALBLES                                                 00500036
C                                                                       00510036
      DO I = 1,4                                                        00520036
       MAGCNT(I) = 0                                                    00530036
       MAGSUM(I) = 0.0                                                  00540036
       MAGAVG(I) = 999.0                                                00550036
       RMS(I) = 999.0                                                   00560036
       SEDRCNT(I) = 0                                                   00570036
       SEDRSUM(I) = 0.0                                                 00580036
       SEDRAVG(I) = 0.0                                                 00590036
      END DO                                                            00600036
      RMSC = 999.0                                                      00610036
C                                                                       00620036
C OPEN INPUT AND OUTPUT FILES                                           00630036
C                                                                       00640036
      OPEN(10,FILE='/Z1SBK.V291C.SUM',STATUS='OLD',FORM='FORMATTED')    00650039
C     OPEN(11,FILE='/Z1SBK.V291.HAV',STATUS='OLD',FORM='FORMATTED')     00660036
C                                                                       00670036
      IREAD = 0                                                         00680036
      IWRITE = 0                                                        00690036
   10 CONTINUE                                                          00700036
C                                                                       00710036
C READ HIGH RESOLUTION AVGS.  EXPECT S/C ID,TIME,F2,BR,BT,BN,R,X,Y,Z    00720036
C                                                                       00730036
       READ(10,*,END=100,ERR=10) ID,TIME,(MAG(I),I=1,4),(SEDR(J),J=1,4) 00740036
       IREAD = IREAD + 1                                                00750036
C                                                                       00760036
       IF (REALTIME(TIME).LT.REALTIME(OLDTIME)) GOTO 10                 00770036
   15  CONTINUE                                                         00780036
C                                                                       00790036
C SUM VALUES IN AVERAGING PERIOD                                        00800036
C                                                                       00810036
       IF (REALTIME(TIME).GE.REALTIME(OLDTIME).AND.                     00820036
     &     REALTIME(TIME).LT.REALTIME(NEWTIME)) THEN                    00830036
C                                                                       00840036
C ACCUMULATE FIELD MAGNITUDE AND COMPONENTS IF MODULUS IS NON-FILL      00850036
C                                                                       00860036
        IF (MAG(1).EQ.999.0) GOTO 33                                    00870036
C                                                                       00880036
        DO I = 1,4                                                      00890036
         MAGSUM(I) = MAGSUM(I) + MAG(I)                                 00900036
         MAGCNT(I) = MAGCNT(I) + 1                                      00910036
         B(MAGCNT(I),I) = MAG(I)                                        00920036
        END DO                                                          00930036
C                                                                       00940036
   33   CONTINUE                                                        00950036
C                                                                       00960036
C ACCUMULATE NAVIGATION DATA IF RANGE IS NON-FILL                       00970036
C                                                                       00980036
        IF (SEDR(1).LT.1.0) GOTO 66                                     00990036
C                                                                       01000036
        DO I = 1,4                                                      01010036
         SEDRSUM(I) = SEDRSUM(I) + SEDR(I)                              01020036
         SEDRCNT(I) = SEDRCNT(I) + 1                                    01030036
        END DO                                                          01040036
                                                                        01050036
   66   CONTINUE                                                        01060036
        STASH = .TRUE.                                                  01070036
C                                                                       01080036
C COMPUTE AVERAGES WHEN INCREMENTING AVERAGING WINDOW                   01090036
C                                                                       01100036
       ELSE IF (REALTIME(TIME).GE.REALTIME(NEWTIME)) THEN               01110036
C                                                                       01120036
        DO I = 1,4                                                      01130036
C                                                                       01140036
         IF (MAGCNT(I).GE.1) THEN                                       01150036
          MAGAVG(I) = MAGSUM(I) / FLOAT(MAGCNT(I))                      01160036
C                                                                       01170036
C COMPUTE FIELD MAGNITUDE RMS AND COMPONENT RMS'S                       01180036
C                                                                       01190036
          DO J = 1,MAGCNT(I)                                            01200036
           RMS(I) = ABS(B(J,I)-MAGAVG(I))**2.0                          01210036
          END DO                                                        01220036
          RMS(I) = SQRT(RMS(I)/FLOAT(MAGCNT(I)))                        01230036
C                                                                       01240036
         ELSE                                                           01250036
          MAGAVG(I) = 999.0                                             01260036
          RMS(I) = 999.0                                                01270036
         END IF                                                         01280036
C                                                                       01290036
        END DO                                                          01300036
C                                                                       01310036
C COMPUTE FIELD MODULUS, ANGLES AND COMPONENT RMS NORM                  01320036
C                                                                       01330036
        F1 = MAGAVG(1)                                                  01340036
        BR = MAGAVG(2)                                                  01350036
        BT = MAGAVG(3)                                                  01360036
        BN = MAGAVG(4)                                                  01370036
        IF (BR.NE.999.0.AND.                                            01380036
     &      BT.NE.999.0.AND.                                            01390036
     &      BN.NE.999.0) THEN                                           01400036
         CALL ANGLES(BR,BT,BN,F2,DEL,LAM)                               01410036
         RMSC = SQRT(RMS(2)**2+RMS(3)**2+RMS(4)**2)                     01420036
        ELSE                                                            01430036
         F2 = 999.0                                                     01440036
         DEL = 90.0                                                     01450036
         LAM = 45.0                                                     01460036
         RMSC = 999.0                                                   01470036
        END IF                                                          01480036
C                                                                       01490036
C COMPUTE RANGE AND POSITION COMPONENT AVERAGES                         01500036
C                                                                       01510036
        DO I = 1,4                                                      01520036
         IF (SEDRCNT(I).GE.1) THEN                                      01530036
          SEDRAVG(I) = SEDRSUM(I) / FLOAT(SEDRCNT(I))                   01540036
         ELSE                                                           01550036
          SEDRAVG(I) = 0.0                                              01560036
         END IF                                                         01570036
        END DO                                                          01580036
C                                                                       01590036
        WRITE(6,'(6(1X,I3),5(1X,F7.3),1X,I5)')                          01600036
     &        OLDTIME,F2,(MAGAVG(I),I=1,4),MAGCNT(1)                    01610036
C       WRITE(6,'(6(1X,I3),5(1X,F7.3),1X,I5)')                          01620036
C    &        OLDTIME,RMSC,(RMS(I),I=1,4),MAGCNT(1)                     01630036
        WRITE(11,890) ID,OLDTIME,                                       01640036
     &                F1,F2,DEL,LAM,BR,BT,BN,(SEDRAVG(I),I=1,4)         01650036
C                                                                       01660036
C MASTER HOUR AVERAGE OUTPUT                                            01670036
C                                                                       01680036
        IN(1) = ID                                                      01690036
        IN(2) = OLDTIME(1)                                              01700036
        IN(3) = OLDTIME(2)                                              01710036
        IN(4) = OLDTIME(3)                                              01720036
        FIN(5) = SEDRAVG(2)                                             01730036
        FIN(6) = SEDRAVG(3)                                             01740036
        FIN(7) = SEDRAVG(4)                                             01750036
        FIN(8) = SEDRAVG(1)                                             01760036
        FIN(9) = F1                                                     01770036
        FIN(10) = F2                                                    01780036
        FIN(11) = DEL                                                   01790036
        FIN(12) = LAM                                                   01800036
        FIN(22) = RMSC                                                  01810036
        FIN(23) = RMS(1)                                                01820036
        FIN(24) = RMS(2)                                                01830036
        FIN(25) = RMS(3)                                                01840036
        FIN(26) = RMS(4)                                                01850036
        IF (HOUR) WRITE(20) FIN                                         01860036
C                                                                       01870036
        IWRITE = IWRITE + 1                                             01880036
C                                                                       01890036
        DO I = 1,4                                                      01900036
         MAGCNT(I) = 0                                                  01910036
         MAGSUM(I) = 0.0                                                01920036
         MAGAVG(I) = 999.0                                              01930036
         RMS(I) = 999.0                                                 01940036
         SEDRCNT(I) = 0                                                 01950036
         SEDRSUM(I) = 0.0                                               01960036
         SEDRAVG(I) = 0.0                                               01970036
        END DO                                                          01980036
        RMSC = 999.0                                                    01990036
C                                                                       02000036
C INCREMENT AVERAGING WINDOW                                            02010036
C                                                                       02020036
        CALL MOVETIME(NEWTIME,OLDTIME)                                  02030036
        CALL INCRTIME(NEWTIME,DELTA)                                    02040036
        STASH = .FALSE.                                                 02050036
C                                                                       02060036
       END IF                                                           02070036
C                                                                       02080036
       IF (.NOT.STASH) GOTO 15                                          02090036
C                                                                       02100036
      GOTO 10                                                           02110036
  100 CONTINUE                                                          02120036
C                                                                       02130036
C COMPUTE AND OUTPUT FINAL AVERAGING PERIOD                             02140036
C                                                                       02150036
      IF (STASH) THEN                                                   02160036
C                                                                       02170036
       DO I = 1,4                                                       02180036
C                                                                       02190036
        IF (MAGCNT(I).GE.1) THEN                                        02200036
         MAGAVG(I) = MAGSUM(I) / FLOAT(MAGCNT(I))                       02210036
C                                                                       02220036
C COMPUTE FIELD MAGNITUDE RMS AND COMPONENT RMS'S                       02230036
C                                                                       02240036
         DO J = 1,MAGCNT(I)                                             02250036
          RMS(I) = ABS(B(J,I)-MAGAVG(I))**2.0                           02260036
         END DO                                                         02270036
         RMS(I) = SQRT(RMS(I)/FLOAT(MAGCNT(I)))                         02280036
C                                                                       02290036
        ELSE                                                            02300036
         MAGAVG(I) = 999.0                                              02310036
         RMS(I) = 999.0                                                 02320036
        END IF                                                          02330036
C                                                                       02340036
       END DO                                                           02350036
C                                                                       02360036
C COMPUTE FIELD MODULUS, ANGLES AND COMPONENT RMS NORM                  02370036
C                                                                       02380036
       F1 = MAGAVG(1)                                                   02390036
       BR = MAGAVG(2)                                                   02400036
       BT = MAGAVG(3)                                                   02410036
       BN = MAGAVG(4)                                                   02420036
       IF (BR.NE.999.0.AND.                                             02430036
     &     BT.NE.999.0.AND.                                             02440036
     &     BN.NE.999.0) THEN                                            02450036
        CALL ANGLES(BR,BT,BN,F2,DEL,LAM)                                02460036
        RMSC = SQRT(RMS(2)**2+RMS(3)**2+RMS(4)**2)                      02470036
       ELSE                                                             02480036
        F2 = 999.0                                                      02490036
        DEL = 90.0                                                      02500036
        LAM = 45.0                                                      02510036
        RMSC = 999.0                                                    02520036
       END IF                                                           02530036
C                                                                       02540036
C COMPUTE RANGE AND POSITION COMPONENT AVERAGES                         02550036
C                                                                       02560036
       DO I = 1,4                                                       02570036
        IF (SEDRCNT(I).GE.1) THEN                                       02580036
         SEDRAVG(I) = SEDRSUM(I) / FLOAT(SEDRCNT(I))                    02590036
        ELSE                                                            02600036
         SEDRAVG(I) = 0.0                                               02610036
        END IF                                                          02620036
       END DO                                                           02630036
C                                                                       02640036
       WRITE(6,'(6(1X,I3),5(1X,F7.3),1X,I5)')                           02650036
     &       OLDTIME,F2,(MAGAVG(I),I=1,4),MAGCNT(1)                     02660036
C      WRITE(6,'(6(1X,I3),5(1X,F7.3),1X,I5)')                           02670036
C    &       OLDTIME,RMSC,(RMS(I),I=1,4),MAGCNT(1)                      02680036
       WRITE(11,890) ID,OLDTIME,                                        02690036
     &               F1,F2,DEL,LAM,BR,BT,BN,(SEDRAVG(I),I=1,4)          02700036
C                                                                       02710036
C MASTER HOUR AVERAGE OUTPUT                                            02720036
C                                                                       02730036
        IN(1) = ID                                                      02740036
        IN(2) = OLDTIME(1)                                              02750036
        IN(3) = OLDTIME(2)                                              02760036
        IN(4) = OLDTIME(3)                                              02770036
        FIN(5) = SEDRAVG(2)                                             02780036
        FIN(6) = SEDRAVG(3)                                             02790036
        FIN(7) = SEDRAVG(4)                                             02800036
        FIN(8) = SEDRAVG(1)                                             02810036
        FIN(9) = F1                                                     02820036
        FIN(10) = F2                                                    02830036
        FIN(11) = DEL                                                   02840036
        FIN(12) = LAM                                                   02850036
        FIN(22) = RMSC                                                  02860036
        FIN(23) = RMS(1)                                                02870036
        FIN(24) = RMS(2)                                                02880036
        FIN(25) = RMS(3)                                                02890036
        FIN(26) = RMS(4)                                                02900036
        IF (HOUR) WRITE(20) FIN                                         02910036
C                                                                       02920036
       IWRITE = IWRITE + 1                                              02930036
C                                                                       02940036
      END IF                                                            02950036
C                                                                       02960036
      WRITE(6,'(1X,''RECORDS READ: '',I6.6)') IREAD                     02970036
      WRITE(6,'(1X,''RECORDS WRITTEN: '',I6.6)') IWRITE                 02980036
C                                                                       02990036
      STOP                                                              03000036
  890 FORMAT(I1,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,                       03010036
     &       2(1X,F7.3),2(1X,F5.1),3(1X,F7.3),4(1X,F8.4))               03020036
      END                                                               03030036
      SUBROUTINE MOVETIME(INTIME,OUTTIME)                               03040036
C                                                                       03050036
C ASSIGN INTIME ARRAY VALUES TO OUTTIME ARRAY                           03060036
C                                                                       03070036
      INTEGER*2 INTIME(6),OUTTIME(6)                                    03080036
C                                                                       03090036
      DO I = 1,6                                                        03100036
       OUTTIME(I) = INTIME(I)                                           03110036
      END DO                                                            03120036
C                                                                       03130036
      RETURN                                                            03140036
      END                                                               03150036
      SUBROUTINE INCRTIME(TIME,DELTA)                                   03160036
C                                                                       03170036
C INCREMENT CALENDAR TIME (YY,DDD,HH,MM,SS,FFF) BY DELTA(6)             03180036
C                                                                       03190036
      INTEGER*2 TIME(6),DELTA(6)                                        03200036
C                                                                       03210036
      IYR = TIME(1)                                                     03220036
      LEAP = 365                                                        03230036
      IF (MOD(IYR,4).EQ.0.AND.IYR.NE.0) LEAP = 366                      03240036
C                                                                       03250036
      TIME(6) = TIME(6) + DELTA(6)                                      03260036
      IF (TIME(6).GT.999) THEN                                          03270036
       TIME(5) = TIME(5) + 1                                            03280036
       TIME(6) = TIME(6) - 1000                                         03290036
      END IF                                                            03300036
C                                                                       03310036
      TIME(5) = TIME(5) + DELTA(5)                                      03320036
      IF (TIME(5).GT.59) THEN                                           03330036
       TIME(4) = TIME (4) + 1                                           03340036
       TIME(5) = TIME (5) - 60                                          03350036
      END IF                                                            03360036
C                                                                       03370036
      TIME(4) = TIME(4) + DELTA(4)                                      03380036
      IF (TIME(4).GT.59) THEN                                           03390036
       TIME(3) = TIME(3) + 1                                            03400036
       TIME(4) = TIME(4) - 60                                           03410036
      END IF                                                            03420036
C                                                                       03430036
      TIME(3) = TIME(3) + DELTA(3)                                      03440036
      IF (TIME(3).GT.23) THEN                                           03450036
       TIME(2) = TIME(2) + 1                                            03460036
       TIME(3) = TIME(3) - 24                                           03470036
      END IF                                                            03480036
C                                                                       03490036
      TIME(2) = TIME(2) + DELTA(2)                                      03500036
      IF (TIME(2).GT.LEAP) THEN                                         03510036
       TIME(1) = TIME(1) + 1                                            03520036
       TIME(2) = TIME(2) - LEAP                                         03530036
       IF (TIME(1).GT.99) TIME(1) = TIME(1) - 100                       03540036
      END IF                                                            03550036
C                                                                       03560036
      TIME(1) = TIME(1) + DELTA(1)                                      03570036
      IF (TIME(1).GT.99) TIME(1) = TIME(1) - 100                        03580036
C                                                                       03590036
      RETURN                                                            03600036
      END                                                               03610036
      DOUBLE PRECISION FUNCTION REALTIME(TIME)                          03620036
C                                                                       03630036
C CONVERT CALENDAR TIME INTO DECIMAL YEAR REAL TIME.                    03640036
C                                                                       03650036
      INTEGER*2 TIME(6)                                                 03660036
      REAL*8 DAYS                                                       03670036
C                                                                       03680036
      IYEAR = TIME(1)                                                   03690036
      IDAY = TIME(2)                                                    03700036
      IHOUR = TIME(3)                                                   03710036
      IMIN = TIME(4)                                                    03720036
      ISEC = TIME(5)                                                    03730036
      MS = TIME(6)                                                      03740036
C                                                                       03750036
      IF (IYEAR.GE.0.AND.IYEAR.LT.77) IYEAR = IYEAR + 2000              03760036
      IF (IYEAR.GE.77.AND.IYEAR.LE.99) IYEAR = IYEAR + 1900             03770036
C                                                                       03780036
      DAYS = 365.0D0                                                    03790036
      IF (MOD(IYEAR,4).EQ.0.AND.IYEAR.NE.2000) DAYS = 366.0D0           03800036
      REALTIME = DBLE(IYEAR) +                                          03810036
     &           DBLE(IDAY-1)/DAYS +                                    03820036
     &           DBLE(IHOUR)/24.0D0/DAYS +                              03830036
     &           DBLE(IMIN)/60.0D0/24.0D0/DAYS +                        03840036
     &           DBLE(ISEC)/60.0D0/60.0D0/24.0D0/DAYS +                 03850036
     &           DBLE(MS)/1000.0D0/60.0D0/60.0D0/24.0D0/DAYS            03860036
C                                                                       03870036
      RETURN                                                            03880036
      END                                                               03890036
      SUBROUTINE ANGLES(BX,BY,BZ,F2,DEL,LAM)                            03900036
C                                                                       03910036
      REAL*4 LAM                                                        03920036
C                                                                       03930036
C CALCULATE FIELD ANGLES AND MODULUS FROM COMPONENTS.                   03940036
C BAD COMPONENTS ARE FILTERED BEFORE CALLING THIS ROUTINE.              03950036
C DELTA FILL VALUE IS 90.0                                              03960036
C LAMBDA FILL VALUE IS 45.0                                             03970036
C                                                                       03980036
      F2 = SQRT(BX**2+BY**2+BZ**2)                                      03990036
C                                                                       04000036
      IF (F2.NE.0.0) THEN                                               04010036
       DEL = ASIN(BZ/F2) * 57.2957795D0                                 04020036
      ELSE                                                              04030036
       DEL = 90.0                                                       04040036
      END IF                                                            04050036
C                                                                       04060036
      IF (BX.NE.0) THEN                                                 04070036
       LAM = 180.0 - ATAN2(BY,-BX) * 57.2957795D0                       04080036
      ELSE IF (BX.EQ.0.0.AND.BY.NE.0.0) THEN                            04090036
       LAM = 90.0                                                       04100036
      ELSE                                                              04110036
       LAM = 45.0                                                       04120036
      END IF                                                            04130036
C                                                                       04140036
      RETURN                                                            04150036
      END                                                               04160036
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR                             04170036
//GO.SYSUDUMP DD DUMMY                                                  04180036
//FT11F001 DD DSN=Z1SBK.V291.HAV,DISP=MOD                               04190039
//*T20F001 DD DSN=Z1SBK.HOURAVG1,DISP=OLD                               04200036
//FT20F001 DD DSN=Z1SBK.HOURAVG2,DISP=MOD                               04210039
//NOTIFY EXEC NOTIFY                                                    04220036
//                                                                      04230036
//Z1SBKHAV JOB (U0016,N598,20),'AVG HOURAVG DATA',TIME=(2,00),          00010051
// CLASS=A,MSGCLASS=X,NOTIFY=Z1SBK                                      00020036
// EXEC FORTVCLG                                                        00030036
      PROGRAM SUMMAVGS                                                  00040036
C                                                                       00050036
C PROGRAM MAKES AVERAGES OF MASTER HOUR AVERAGES DATA                   00060046
C WRITTEN 09/17/93 SBK                                                  00061049
C                                                                       00070036
      PARAMETER(IARR=1000)                                              00080036
      INTEGER*2 TIME(6),OLDTIME(6),NEWTIME(6),DELTA(6),ENDTIME(6)       00090046
      INTEGER*4 CNT(14),IN(35)                                          00100047
      LOGICAL*1 STASH                                                   00110044
      REAL*4 SUM(14),AVG(14),FIN(35),VAL(IARR,14)                       00120049
      REAL*8 REALTIME                                                   00170036
C                                                                       00180036
      EQUIVALENCE(IN(1),FIN(1))                                         00190036
C                                                                       00191054
C OPEN INPUT AND OUTPUT FILES                                           00192054
C                                                                       00193054
      OPEN(10,FILE='/Z1SBK.MSPERM',STATUS='OLD',FORM='UNFORMATTED')     00194054
      OPEN(11,FILE='/Z1SBK.P11.DLY',STATUS='OLD',FORM='FORMATTED',      00195055
     & ACTION='WRITE')                                                  00196054
C                                                                       00200047
      ISC = 7                                                           00210055
C                                                                       00250036
C START TIME  YEAR/DAY/HOUR/MIN/SEC/MSEC                                00260036
C                                                                       00270036
      TIME(1) = 80                                                      00280047
      TIME(2) = 1                                                       00290047
      TIME(3) = 0                                                       00300036
      TIME(4) = 0                                                       00310036
      TIME(5) = 0                                                       00320036
      TIME(6) = 0                                                       00330036
      CALL MOVETIME(TIME,OLDTIME)                                       00340036
C                                                                       00341046
C END TIME  YEAR/DAY/HOUR/MIN/SEC/MSEC                                  00341147
C                                                                       00341247
      ENDTIME(1) = 93                                                   00342052
      ENDTIME(2) = 1                                                    00343046
      ENDTIME(3) = 0                                                    00344046
      ENDTIME(4) = 0                                                    00345046
      ENDTIME(5) = 0                                                    00346046
      ENDTIME(6) = 0                                                    00347046
C                                                                       00350036
C AVERAGING PERIOD  YEARS/DAYS/HOURS/MINS/SECS/MSECS                    00360036
C                                                                       00370036
      DELTA(1) = 0                                                      00380036
      DELTA(2) = 1                                                      00390044
      DELTA(3) = 0                                                      00400044
      DELTA(4) = 0                                                      00410036
      DELTA(5) = 0                                                      00420036
      DELTA(6) = 0                                                      00430036
C                                                                       00440036
C ESTABLISH STARTING AVERAGING WINDOW                                   00450036
C                                                                       00460036
      CALL INCRTIME(TIME,DELTA)                                         00470036
      CALL MOVETIME(TIME,NEWTIME)                                       00480036
C                                                                       00490036
C INITIALIZE VARIALBLES                                                 00500036
C                                                                       00510036
      DO I = 1,14                                                       00520047
       CNT(I) = 0                                                       00530041
       SUM(I) = 0.0                                                     00540041
       AVG(I) = 999.0                                                   00550041
      END DO                                                            00600036
C                                                                       00670036
      STASH = .FALSE.                                                   00671047
      IREAD = 0                                                         00680036
      IWRITE = 0                                                        00690036
      DTR = 3.14159 / 180.0                                             00691044
      RTD = 180.0 / 3.14159                                             00692044
   10 CONTINUE                                                          00700036
C                                                                       00710036
C READ HOUR AVERAGES.  EXPECT MASTER HOUR AVERAGE FORMAT.               00720050
C                                                                       00730036
       READ(10,NUM=LEN,ERR=10,END=100) FIN                              00740053
       IREAD = IREAD + 1                                                00750036
C                                                                       00750145
       TIME(1) = IN(2)                                                  00750645
       TIME(2) = IN(3)                                                  00750745
       TIME(3) = IN(4)                                                  00750845
       TIME(4) = 0                                                      00750945
       TIME(5) = 0                                                      00751045
       TIME(6) = 0                                                      00751145
C                                                                       00751242
       IF (IN(1).NE.ISC) GOTO 10                                        00751647
       IF (REALTIME(TIME).LT.REALTIME(OLDTIME)) GOTO 10                 00751847
       IF (REALTIME(TIME).GE.REALTIME(ENDTIME)) GOTO 100                00752147
C                                                                       00752247
C FIELD PARAMETERS                                                      00752349
C                                                                       00752449
       F2 = FIN(10)                                                     00752543
       IF (0.0.LT.F2.AND.F2.LT.100.0) THEN                              00752647
        BD = FIN(11)                                                    00752749
        BL = FIN(12)                                                    00752849
        B1 = F2 * COS(BL*DTR) * COS(BD*DTR)                             00752949
        B2 = F2 * SIN(BL*DTR) * COS(BD*DTR)                             00753049
        B3 = F2 * SIN(BL*DTR)                                           00753149
       ELSE                                                             00753243
        F2 = 999.0                                                      00753343
        B1 = 999.0                                                      00753443
        B2 = 999.0                                                      00753543
        B3 = 999.0                                                      00753643
       END IF                                                           00753743
C                                                                       00754043
C VELOCITY PARAMETERS                                                   00754149
C                                                                       00754249
       V = FIN(13)                                                      00754343
       IF (200.0.LT.V.AND.V.LT.1500.0) THEN                             00754443
        VD = FIN(14)                                                    00754549
        VL = FIN(15)                                                    00754649
        V1 = V * COS(VL*DTR) * COS(VD*DTR)                              00754752
        V2 = V * SIN(VL*DTR) * COS(VD*DTR)                              00754852
        V3 = V * SIN(VL*DTR)                                            00754952
       ELSE                                                             00755143
        V = 999.0                                                       00755243
        V1= 999.0                                                       00755343
        V2 = 999.0                                                      00755443
        V3 = 999.0                                                      00755543
       END IF                                                           00755643
C                                                                       00755949
C ION DENSITY                                                           00756050
C                                                                       00756149
       DEN = FIN(16)                                                    00756342
       IF (DEN.LE.0.0.OR.DEN.GT.1.0E4) DEN = 999.0                      00756444
C                                                                       00756549
C ION TEMPERATURE                                                       00756650
C                                                                       00756749
       TEM = FIN(17)                                                    00757142
       IF (TEM.LE.0.0.OR.TEM.GT.1.0E7) TEM = 999.0                      00757244
C                                                                       00757349
C COSMIC RAY COUNT                                                      00757449
C                                                                       00757549
       CRC = FIN(27)                                                    00757645
       IF (CRC.LE.0.0.OR.CRC.GT.100.0) CRC = 999.0                      00757745
C                                                                       00757849
C S/C POSITION PARAMTERS                                                00757949
C                                                                       00758049
       R = FIN(8)                                                       00758147
       IF (0.0.LT.R.AND.R.LT.150.0) THEN                                00758247
        X = FIN(5)                                                      00758347
        Y = FIN(6)                                                      00759047
        Z = FIN(7)                                                      00759147
       ELSE                                                             00759347
        X = 999.0                                                       00759447
        Y = 999.0                                                       00759547
        Z = 999.0                                                       00759647
        R = 999.0                                                       00759747
       END IF                                                           00759847
C                                                                       00760036
   15  CONTINUE                                                         00780036
C                                                                       00790036
C SUM VALUES IN AVERAGING PERIOD                                        00800036
C                                                                       00810036
       IF (REALTIME(TIME).GE.REALTIME(OLDTIME).AND.                     00820036
     &     REALTIME(TIME).LT.REALTIME(NEWTIME)) THEN                    00830036
C                                                                       00840036
C ACCUMULATE HOUR AVERAGE VALUES                                        00850044
C                                                                       00860036
        IF (F2.NE.999.0) THEN                                           00890044
         SUM(1) = SUM(1) + F2                                           00890144
         SUM(2) = SUM(2) + B1                                           00890244
         SUM(3) = SUM(3) + B2                                           00890344
         SUM(4) = SUM(4) + B3                                           00890444
         CNT(1) = CNT(1) + 1                                            00890544
         CNT(2) = CNT(2) + 1                                            00890644
         CNT(3) = CNT(3) + 1                                            00890744
         CNT(4) = CNT(4) + 1                                            00890844
        END IF                                                          00890944
C                                                                       00891044
        IF (V.NE.999.0) THEN                                            00891144
         SUM(5) = SUM(5) + V                                            00891244
         SUM(6) = SUM(6) + V1                                           00891344
         SUM(7) = SUM(7) + V2                                           00891444
         SUM(8) = SUM(8) + V3                                           00891544
         CNT(5) = CNT(5) + 1                                            00891644
         CNT(6) = CNT(6) + 1                                            00891744
         CNT(7) = CNT(7) + 1                                            00891844
         CNT(8) = CNT(8) + 1                                            00891944
        END IF                                                          00892044
C                                                                       00892144
        IF (DEN.NE.999.0) THEN                                          00892244
         SUM(9) = SUM(9) + DEN                                          00892344
         CNT(9) = CNT(9) + 1                                            00892444
        END IF                                                          00892544
C                                                                       00892644
        IF (TEM.NE.999.0) THEN                                          00893044
         SUM(10) = SUM(10) + TEM                                        00893144
         CNT(10) = CNT(10) + 1                                          00893244
        END IF                                                          00893344
C                                                                       00893444
        IF (CRC.NE.999.0) THEN                                          00894045
         SUM(11) = SUM(11) + CRC                                        00894145
         CNT(11) = CNT(11) + 1                                          00894244
        END IF                                                          00895044
C                                                                       00940036
        IF (X.NE.999.0) THEN                                            00950047
         SUM(12) = SUM(12) + X                                          00960049
         CNT(12) = CNT(12) + 1                                          00970047
        END IF                                                          00980047
C                                                                       00990047
        IF (Y.NE.999.0) THEN                                            01000047
         SUM(13) = SUM(13) + Y                                          01010049
         CNT(13) = CNT(13) + 1                                          01020047
        END IF                                                          01030047
C                                                                       01040047
        IF (Z.NE.999.0) THEN                                            01050047
         SUM(14) = SUM(14) + Z                                          01060049
         CNT(14) = CNT(14) + 1                                          01061047
        END IF                                                          01062047
C                                                                       01063047
        STASH = .TRUE.                                                  01070036
C                                                                       01080036
C COMPUTE AVERAGES WHEN INCREMENTING AVERAGING WINDOW                   01090036
C                                                                       01100036
       ELSE IF (REALTIME(TIME).GE.REALTIME(NEWTIME)) THEN               01110036
C                                                                       01120036
        DO I = 1,14                                                     01130047
C                                                                       01140036
         IF (CNT(I).GE.1) THEN                                          01150040
          AVG(I) = SUM(I) / FLOAT(CNT(I))                               01160040
         END IF                                                         01280036
C                                                                       01290036
        END DO                                                          01300036
C                                                                       01310048
C CALCULATE FIELD MODULUS AND FIELD ANGLES (LAT. AND LONG.)             01310149
C                                                                       01310249
        IF (AVG(2).NE.999.0.AND.                                        01311049
     &      AVG(3).NE.999.0.AND.                                        01312049
     &      AVG(4).NE.999.0) THEN                                       01313049
         FMOD = SQRT(AVG(2)**2+AVG(3)**2+AVG(4)**2)                     01320049
         BDEL = ASIN(AVG(4)/FMOD) * RTD                                 01320149
         BLAM = 180 - ATAN2(AVG(3),-AVG(2)) * RTD                       01320249
        ELSE                                                            01321049
         FMOD = 999.0                                                   01322049
         BDEL = 999.0                                                   01322151
         BLAM = 999.0                                                   01322251
        END IF                                                          01323049
C                                                                       01323149
C COMPUTE FLOW ANGLES                                                   01323249
C                                                                       01323349
        IF (AVG(6).NE.999.0.AND.                                        01323449
     &      AVG(7).NE.999.0.AND.                                        01323549
     &      AVG(8).NE.999.0) THEN                                       01323649
         VMOD = SQRT(AVG(6)**2+AVG(7)**2+AVG(8)**2)                     01323749
         VRT = SQRT(AVG(6)**2+AVG(7)**2)                                01323849
         VDEL = ATAN2(AVG(8),VRT) * RTD                                 01323951
         VLAM = - ATAN2(AVG(7),AVG(6)) * RTD                            01324051
        ELSE                                                            01324249
         VMOD = 999.0                                                   01324349
         VDEL = 999.0                                                   01324451
         VLAM = 999.0                                                   01324551
        END IF                                                          01324649
C                                                                       01324749
C CALCULATE DISTANCE                                                    01325049
C                                                                       01326049
        IF (AVG(12).NE.999.0.AND.                                       01330049
     &      AVG(13).NE.999.0.AND.                                       01340049
     &      AVG(14).NE.999.0) THEN                                      01350049
         RAU = SQRT(AVG(12)**2+AVG(13)**2+AVG(14)**2)                   01360049
        ELSE                                                            01370049
         RAU = 999.0                                                    01380049
        END IF                                                          01390049
C                                                                       01400049
        WRITE(11,800)                                                   01600050
     &   ISC,OLDTIME,AVG(1),FMOD,BDEL,BLAM,(AVG(I),I=2,4),              01610051
     &   (AVG(J),J=5,8),VDEL,VLAM,(AVG(K),K=9,14),RAU                   01620051
        IWRITE = IWRITE + 1                                             01880036
C                                                                       01890036
        DO I = 1,14                                                     01900047
         CNT(I) = 0                                                     01910041
         SUM(I) = 0.0                                                   01920041
         AVG(I) = 999.0                                                 01930041
        END DO                                                          01980036
C                                                                       02000036
C INCREMENT AVERAGING WINDOW                                            02010036
C                                                                       02020036
        CALL MOVETIME(NEWTIME,OLDTIME)                                  02030036
        CALL INCRTIME(NEWTIME,DELTA)                                    02040036
        STASH = .FALSE.                                                 02050036
C                                                                       02060036
       END IF                                                           02070036
C                                                                       02080036
       IF (.NOT.STASH) GOTO 15                                          02090036
C                                                                       02100036
      GOTO 10                                                           02110036
  100 CONTINUE                                                          02120036
C                                                                       02130036
C COMPUTE AND OUTPUT FINAL AVERAGING PERIOD                             02140036
C                                                                       02150036
      IF (STASH) THEN                                                   02160036
C                                                                       02170036
       DO I = 1,14                                                      02180047
C                                                                       02190036
        IF (CNT(I).GE.1) THEN                                           02200045
         AVG(I) = SUM(I) / FLOAT(CNT(I))                                02210045
        END IF                                                          02330036
C                                                                       02340036
       END DO                                                           02350036
C                                                                       02640036
       WRITE(11,800)                                                    02640150
     &  ISC,OLDTIME,AVG(1),FMOD,BDEL,BLAM,(AVG(I),I=2,4),               02640250
     &  (AVG(J),J=5,8),VDEL,VLAM,(AVG(K),K=9,14),RAU                    02640350
       IWRITE = IWRITE + 1                                              02641048
C                                                                       02940036
      END IF                                                            02950036
C                                                                       02960036
      WRITE(6,'(1X,''RECORDS READ: '',I6.6)') IREAD                     02970036
      WRITE(6,'(1X,''RECORDS WRITTEN: '',I6.6)') IWRITE                 02980036
C                                                                       02990036
      STOP                                                              03000036
  800 FORMAT(I1,1X,6(1X,I3),2(1X,F7.3),2(1X,F5.1),3(1X,F7.3),           03010050
     &       4(1X,F6.1),2(1X,F5.1),2(1X,E10.4),1X,F5.1,4(1X,F6.2))      03020051
      END                                                               03030036
      SUBROUTINE MOVETIME(INTIME,OUTTIME)                               03040036
C                                                                       03050036
C ASSIGN INTIME ARRAY VALUES TO OUTTIME ARRAY                           03060036
C                                                                       03070036
      INTEGER*2 INTIME(6),OUTTIME(6)                                    03080036
C                                                                       03090036
      DO I = 1,6                                                        03100036
       OUTTIME(I) = INTIME(I)                                           03110036
      END DO                                                            03120036
C                                                                       03130036
      RETURN                                                            03140036
      END                                                               03150036
      SUBROUTINE INCRTIME(TIME,DELTA)                                   03160036
C                                                                       03170036
C INCREMENT CALENDAR TIME (YY,DDD,HH,MM,SS,FFF) BY DELTA(6)             03180036
C                                                                       03190036
      INTEGER*2 TIME(6),DELTA(6)                                        03200036
C                                                                       03210036
      IYR = TIME(1)                                                     03220036
      LEAP = 365                                                        03230036
      IF (MOD(IYR,4).EQ.0.AND.IYR.NE.0) LEAP = 366                      03240036
C                                                                       03250036
      TIME(6) = TIME(6) + DELTA(6)                                      03260036
      IF (TIME(6).GT.999) THEN                                          03270036
       TIME(5) = TIME(5) + 1                                            03280036
       TIME(6) = TIME(6) - 1000                                         03290036
      END IF                                                            03300036
C                                                                       03310036
      TIME(5) = TIME(5) + DELTA(5)                                      03320036
      IF (TIME(5).GT.59) THEN                                           03330036
       TIME(4) = TIME (4) + 1                                           03340036
       TIME(5) = TIME (5) - 60                                          03350036
      END IF                                                            03360036
C                                                                       03370036
      TIME(4) = TIME(4) + DELTA(4)                                      03380036
      IF (TIME(4).GT.59) THEN                                           03390036
       TIME(3) = TIME(3) + 1                                            03400036
       TIME(4) = TIME(4) - 60                                           03410036
      END IF                                                            03420036
C                                                                       03430036
      TIME(3) = TIME(3) + DELTA(3)                                      03440036
      IF (TIME(3).GT.23) THEN                                           03450036
       TIME(2) = TIME(2) + 1                                            03460036
       TIME(3) = TIME(3) - 24                                           03470036
      END IF                                                            03480036
C                                                                       03490036
      TIME(2) = TIME(2) + DELTA(2)                                      03500036
      IF (TIME(2).GT.LEAP) THEN                                         03510036
       TIME(1) = TIME(1) + 1                                            03520036
       TIME(2) = TIME(2) - LEAP                                         03530036
       IF (TIME(1).GT.99) TIME(1) = TIME(1) - 100                       03540036
      END IF                                                            03550036
C                                                                       03560036
      TIME(1) = TIME(1) + DELTA(1)                                      03570036
      IF (TIME(1).GT.99) TIME(1) = TIME(1) - 100                        03580036
C                                                                       03590036
      RETURN                                                            03600036
      END                                                               03610036
      DOUBLE PRECISION FUNCTION REALTIME(TIME)                          03620036
C                                                                       03630036
C CONVERT CALENDAR TIME INTO DECIMAL YEAR REAL TIME.                    03640036
C                                                                       03650036
      INTEGER*2 TIME(6)                                                 03660036
      REAL*8 DAYS                                                       03670036
C                                                                       03680036
      IYEAR = TIME(1)                                                   03690036
      IDAY = TIME(2)                                                    03700036
      IHOUR = TIME(3)                                                   03710036
      IMIN = TIME(4)                                                    03720036
      ISEC = TIME(5)                                                    03730036
      MS = TIME(6)                                                      03740036
C                                                                       03750036
      IF (IYEAR.GE.0.AND.IYEAR.LT.57) IYEAR = IYEAR + 2000              03760048
      IF (IYEAR.GE.57.AND.IYEAR.LE.99) IYEAR = IYEAR + 1900             03770048
C                                                                       03780036
      DAYS = 365.0D0                                                    03790036
      IF (MOD(IYEAR,4).EQ.0.AND.IYEAR.NE.2000) DAYS = 366.0D0           03800036
      REALTIME = DBLE(IYEAR) +                                          03810036
     &           DBLE(IDAY-1)/DAYS +                                    03820036
     &           DBLE(IHOUR)/24.0D0/DAYS +                              03830036
     &           DBLE(IMIN)/60.0D0/24.0D0/DAYS +                        03840036
     &           DBLE(ISEC)/60.0D0/60.0D0/24.0D0/DAYS +                 03850036
     &           DBLE(MS)/1000.0D0/60.0D0/60.0D0/24.0D0/DAYS            03860036
C                                                                       03870036
      RETURN                                                            03880036
      END                                                               03890036
      SUBROUTINE ANGLES(BX,BY,BZ,F2,DEL,LAM)                            03900036
C                                                                       03910036
      REAL*4 LAM                                                        03920036
C                                                                       03930036
C CALCULATE FIELD ANGLES AND MODULUS FROM COMPONENTS.                   03940036
C BAD COMPONENTS ARE FILTERED BEFORE CALLING THIS ROUTINE.              03950036
C DELTA FILL VALUE IS 90.0                                              03960036
C LAMBDA FILL VALUE IS 45.0                                             03970036
C                                                                       03980036
      F2 = SQRT(BX**2+BY**2+BZ**2)                                      03990036
C                                                                       04000036
      IF (F2.NE.0.0) THEN                                               04010036
       DEL = ASIN(BZ/F2) * 57.2957795D0                                 04020036
      ELSE                                                              04030036
       DEL = 90.0                                                       04040036
      END IF                                                            04050036
C                                                                       04060036
      IF (BX.NE.0) THEN                                                 04070036
       LAM = 180.0 - ATAN2(BY,-BX) * 57.2957795D0                       04080036
      ELSE IF (BX.EQ.0.0.AND.BY.NE.0.0) THEN                            04090036
       LAM = 90.0                                                       04100036
      ELSE                                                              04110036
       LAM = 45.0                                                       04120036
      END IF                                                            04130036
C                                                                       04140036
      RETURN                                                            04150036
      END                                                               04160036
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR                             04170036
//GO.SYSUDUMP DD DUMMY                                                  04180036
//FT11F001 DD DSN=Z1SBK.V291.HAV,DISP=MOD                               04190039
//*T20F001 DD DSN=Z1SBK.HOURAVG1,DISP=OLD                               04200036
//FT20F001 DD DSN=Z1SBK.HOURAVG2,DISP=MOD                               04210039
//NOTIFY EXEC NOTIFY                                                    04220036
//                                                                      04230036
//Z1SBKVMR JOB (U0016,N598,50),'PROCESS HAV CARDS',TIME=(2,00),
// CLASS=A,MSGCLASS=X,NOTIFY=Z1SBK
/*JOBPARM LINES=100
//FORTRAN EXEC FORTVCLG                                                 00000000
C
C   READ FIELD HOUR AVERAGE DATA PRODUCED BY THE VOYAGER PRODUCTION     00000010
C   PROGRAM AND UNFORMAT THE 80 BYTE RECORD TO OBTAIN MAG DATA.
C   LAST PGM REVISION 01/02/92 SBK
C
C FLT - S/C ID
C CSYS - COORDINATE SYSTEM (HG,S3,L1)
C DRUN - DAY OF YEAR OF RUN
C YRUN - LAST DIGIT YEAR OF RUN
C JX - S/C X POSITION VECTOR
C JY       Y                                                            00000160
C JZ       Z                                                            00000170
C IY - YEAR OF DATA - 2 DIGITS
C ID - CALENDAR DAY OF DATA
C IH - HOUR OF DATA
C F1 - FIELD MAGNITUDE
C DEL - FIELD LATITUDINAL ANGLE
C FLA - FIELD LONGITUDINAL ANGLE
C NAV - NUMBER OF 48 SEC AVERAGES
C SIGC NORM OF COMPONENT RMS'S
C SIGF - STD DEV IN FIELD MAGNITUDE F1
C SIGR - RMS FIELD RADIAL COMP
C SIGT - RMS FIELD TANGENTIAL COMP
C SIGN - RMS FIELD NORMAL COMP
C F2 - FIELD MODULUS
C
      PARAMETER (MAXNAM=999)
      CHARACTER*2 CSYS
      CHARACTER*8 CARD(MAXNAM),MEMBR
      CHARACTER*22 DSN,INDEX
      CHARACTER*80 CFIN
      INTEGER*4 FLT,DRUN,YRUN,RLEN,IN(35)
      REAL*4 FIN(35)
      EQUIVALENCE (IN(1),FIN(1))
C
C CONFIRM THAT FTIO UNIT 10 IN JCL MATCHES THE DYNAMIC DATA SET DSN
C
      DSN = 'Z1SBK.V2.HOURAVG.CARDS'
C
      IBEG = 8900100
      IEND = 9100100
C
C
C GET MEMBER NAMES FROM PARTIONED VOYAGER HOUR AVERAGE DATA SET
C
      CALL PDSMEM('FT10F001',MAXNAM,MAXRTN,MAXMEM,CARD,IERR)
      CLOSE(10)
      WRITE(6,'(1X,''PDSMEM MAXNAM: '',I3)') MAXNAM
      WRITE(6,'(1X,''PDSMEM MAXRTN: '',I3)') MAXRTN
      WRITE(6,'(1X,''PDSMEM MAXMEM: '',I3)') MAXMEM
      WRITE(6,'(1X,''PDSMEM ERROR RETURN CODE: '',I2)') IERR
C
C READ DESIRED HOUR AVERAGE CARDS (MEMBERS)
C
      IUNIT = 10
      I = 0
    5 CONTINUE
       I = I + 1
       IF ( I.GT.MAXNAM ) THEN
        WRITE(6,*)
        WRITE(6,*) 'MEMBER COUNTER EXCEEDS ARRAY ALLOCATION'
        STOP
       END IF
       READ(CARD(I),'(1X,I2,I3,I2)') NYR,NDY,NHR
       NTIME = NYR*100000 + NDY*100 + NHR
       IF (NTIME.LT.IBEG) GOTO 5
       IF (NTIME.GE.IEND) GOTO 200
       IUNIT = IUNIT + 1
       OPEN(IUNIT,FILE='/'//DSN//'('//CARD(I)//')',STATUS='OLD',
     &      ACTION='READ')
       WRITE(6,'(1X,I3,3X,A22,''('',A8,'')'')') IUNIT,DSN,CARD(I)
       IREAD = 0
       IWRITE = 0
   10  CONTINUE
        READ(IUNIT,'(A80)',END=100,ERR=10) CFIN                         00000070
        READ(CFIN,900,ERR=10)                                           00000090
     &               FLT,CSYS,DRUN,YRUN,JX,JY,JZ,IY,ID,IH,F1,DEL,FLA,   00000090
     &               NAV,SIGC,SIGF,SIGR,SIGT,SIGN,F2                    00000100
        IREAD = IREAD + 1
C       WRITE(6,901) FLT,CSYS,DRUN,YRUN,JX,JY,JZ,IY,ID,IH,F1,DEL,FLA,   00000090
C    &               NAV,SIGC,SIGF,SIGR,SIGT,SIGN,F2                    00000100
C
C INITIALIZE OUTPUT ARRAY
C
        DO II = 1,35
         FIN(II) = 0.0
        END DO
C
        IN(1) = FLT                                                     00000130
        IN(2) = IY
        IN(3) = ID
        IN(4) = IH
C
C CONVERT INTEGER S/C POSITION COMPONENTS INTO REAL VALUES IN AU.
C
        XP = JX/1000.0
        YP = JY/1000.0
        ZP = JZ/1000.0
        R = SQRT(XP**2+YP**2+ZP**2)
        IF (IY.GE.80.AND.R.LT.5.0) XP = XP * 10.0
        IF (IY.GE.80.AND.R.LT.5.0) YP = YP * 10.0
        IF (IY.GE.80.AND.R.LT.5.0) ZP = ZP * 10.0
        IF (IY.GE.80.AND.R.LT.5.0) R = R * 10.0
        FIN(5) = XP
        FIN(6) = YP
        FIN(7) = ZP
        FIN(8) = R
C
C FIELD DATA
C
        FIN(9) = F1
        FIN(10) = F2
        FIN(11) = DEL
        FIN(12) = FLA
C NO PLASMA OR COSMIC RAY DATA
        FIN(22) = SIGC
        FIN(23) = SIGF
        FIN(24) = SIGR
        FIN(25) = SIGT
        FIN(26) = SIGN
C OUTPUT DATA
        WRITE(9,NUM=LOUT) FIN
        IWRITE = IWRITE + 1
       GO TO 10                                                         00000370
  100  CONTINUE
       CLOSE(IUNIT)
       WRITE(6,'(1X,''RECORDS READ: '',I4.4)') IREAD
       WRITE(6,'(1X,''RECORDS WRITTEN: '',I4.4)') IWRITE
       IF ( IUNIT.EQ.99 ) IUNIT = 10
      IF (I.LT.MAXMEM) GOTO 5
  200 CONTINUE
      STOP                                                              00000380
  900 FORMAT(I1,A2,I3,I1,3I5,I2,I3,I2,F5.2,2F5.1,I2,F6.3,F5.3,3F6.3,    00000110
     C       F5.2)
  901 FORMAT(1X,I1,A2,I3,I1,3I5,I2,I3,I2,F5.2,2F5.1,I2,F6.3,F5.3,3F6.3, 00000110
     C       F5.2)
      END                                                               00000390
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR                             00000400
//GO.SYSUDUMP DD DUMMY
//FT09F001 DD DSN=Z1SBK.HOURAVG2,DISP=OLD
//*T09F001 DD VOL=SER=SBK001,LABEL=(1,NL,,OUT),UNIT=6250,
//*        DCB=(RECFM=FB,LRECL=140,BLKSIZE=12880,DEN=4),DISP=MOD
//FT10F001 DD DSN=Z1SBK.V2.HOURAVG.CARDS,DISP=OLD
//NOTIFY EXEC NOTIFY
//
//Z1SBKMEM JOB (U0016,N598,5),'KRAMER',TIME=(0,30),MSGCLASS=X,CLASS=N
/*JOBPARM LINES=100
//*ORT77 EXEC FORTRAN                                                   00000000
//FORTRAN EXEC FORTVCLG
C
C   READ PARTITIONED DATA SET AND RETURN LIST OF MEMBER NAMES           00000010
C
      PARAMETER (MAXNAM=200)
      CHARACTER*8  MEMBRS(MAXNAM)
C
      CALL PDSMEM('FT10F001',MAXNAM,MAXRTN,MAXFND,MEMBRS,IERR)
      WRITE(6,'(1X,''ERROR CODE: '',I2)') IERR
      DO I = 1,MAXRTN
       WRITE(6,'(1X,I3,3X,A8)') I,MEMBRS(I)
C      WRITE(11,'(A8)') MEMBRS(I)
      END DO
      STOP                                                              00000380
      END                                                               00000390
//*UN77 EXEC LOADER,REGION=700K                                         00000400
//LKED.SYSLIB DD DSN=SYS1.VLNKMLIB,DISP=SHR
//GO.SYSUDUMP DD DUMMY
//FT10F001 DD DSN=Z1SBK.V2.HOURAVG.CARDS,DISP=SHR
//*T11F001 DD DSN=Z1SBK.V2.HOURAVG.CARDS,DISP=OLD
//NOTIFY EXEC NTSO
//
//Z1SBKVYA JOB (U0016,N598,10),'KRAMER',TIME=(1,00),MSGCLASS=X
/*JOBPARM LINES=100
//FORT77 EXEC FORTRAN
C
C FOR CONCATENATED HOUR AVERAGE TAPE                                    00000010
C INCLUDES SELECTED VOYAGER HOUR AVERAGES                               00000020
C LAST PGM MOD 12/17/90 REFLECTS CHANGES MADE IN MEMBER COPY
C                                                                       00000030
      INTEGER*4 IN(197),IOUT(35)                                        00000050
      REAL*4 FIN(197),OUT(35)                                           00000040
      REAL*8 TIME
      EQUIVALENCE (OUT(1),IOUT(1)),(FIN(1),IN(1))                       00000060
C
      IDATE = 110491
      ISTART = 8900100
      ISTOP = 9100100
C
C CHECK JCL AT BOTTOM OF JOB CARD FOR PROPER TAPE AND DATASET SELECTION
C
      IWRITE = 0
   20 CONTINUE                                                          00000100
      DO 15 I=1,35                                                      00000110
       OUT(I) = 0.0                                                     00000120
   15 CONTINUE
   10 CONTINUE                                                          00000130
      READ(10,NUM=LEN,END=100,ERR=20) FIN                               00000140
      ITIME = IN(8)*100000 + IN(9)*100 + IN(10)                         00000141
      IF (ITIME.LT.ISTART) GOTO 20
      IF (ITIME.GE.ISTOP) GOTO 100
C SPACECRAFT LABEL
      IOUT(1) = IN(1)
C YEAR
      IOUT(2) = IN(8)                                                   00000150
C DAY
      IOUT(3) = IN(9)                                                   00000160
C HOUR
      IOUT(4) = IN(10)                                                  00000170
C SPACECRAFT POSITION (AU, IHG SYSTEM)
      FAC = 1000.0                                                      00000180
      X = IN(5) / FAC                                                   00000190
      Y = IN(6) / FAC                                                   00000200
      Z = IN(7) / FAC                                                   00000210
      R = SQRT(X*X + Y*Y + Z*Z)                                         00000220
      IF ( IN(8) .GE. 80 .AND. R .LT. 5.0 ) X = X * 10.0                00000230
      IF ( IN(8) .GE. 80 .AND. R .LT. 5.0 ) Y = Y * 10.0                00000240
      IF ( IN(8) .GE. 80 .AND. R .LT. 5.0 ) Z = Z * 10.0                00000250
      IF ( IN(8) .GE. 80 .AND. R .LT. 5.0 ) R = R * 10.0                00000260
      OUT(5) = X                                                        00000280
      OUT(6) = Y                                                        00000290
      OUT(7) = Z                                                        00000300
      OUT(8) = R                                                        00000310
C FIELD MAGNITUDE
      IF ( FIN(11) .GT. 10.0 ) GO TO 30                                 00000320
      OUT(9) = FIN(11)                                                  00000330
C FIELD MODULUS
      OUT(10) = FIN(20)                                                 00000340
C FIELD LATITUDINAL ANGLE
      OUT(11) = FIN(12)                                                 00000350
C FIELD LONGITUDINAL ANGLE
      OUT(12) = FIN(13)                                                 00000360
   30 CONTINUE                                                          00000370
      IF ( FIN(21) .GT. 1300. ) FIN(21) = 0.0                           00000380
      IF ( FIN(24) .GT. 100.  ) FIN(24) = 0.0                           00000390
C BULK SPEED
      OUT(13) = FIN(21)                                                 00000400
C FLOW LATITUDINAL ANGLE
      OUT(14) = FIN(39)                                                 00000410
C FLOW LONGITUDINAL ANGLE
      OUT(15) = FIN(36)                                                 00000420
C ION DENSITY
      OUT(16) = FIN(24)                                                 00000430
      IF (ABS(FIN(27)) .GT. 1000.0) FIN(27) = 0.0                       00000440
      IF (ABS(FIN(48)) .GT. 1000.0) FIN(48) = 0.0                       00000450
C ION TEMPERATURE
      OUT(17) = FIN(27) * FIN(27) * 60.5                                00000470
C ALPHA DENSITY
      OUT(32) = FIN(42) * FIN(87) / 100.0                               00000480
C ALPHA TEMPERATURE
      OUT(33) = FIN(48) * FIN(48) * 4.0 * 60.5                          00000490
C DATA MERGE DATE
      IOUT(35) = IDATE                                                  00000491
C OUTPUT BINARY DATA
C
C REMOVE VOYAGER 1 1986 NOISE POINTS
C     IF (ITIME.GE.8603015.AND.ITIME.LE.8603017) GOTO 20
C     IF (ITIME.EQ.8603509) GOTO 20
C     IF (ITIME.EQ.8604512) GOTO 20
C     IF (ITIME.EQ.8604513) GOTO 20
C     IF (ITIME.EQ.8605517) GOTO 20
C     IF (ITIME.EQ.8606207) GOTO 20
C     IF (ITIME.EQ.8607722) GOTO 20
C     IF (ITIME.EQ.8610208) GOTO 20
C     IF (ITIME.EQ.8611221) GOTO 20
C     IF (ITIME.EQ.8612516) GOTO 20
C     IF (ITIME.EQ.8613922) GOTO 20
C     IF (ITIME.EQ.8614118) GOTO 20
C     IF (ITIME.EQ.8623820) GOTO 20
C     IF (ITIME.EQ.8630320) GOTO 20
C     IF (ITIME.EQ.8633615) GOTO 20
C REMOVE 1987 NOISE POINTS
C     IF (ITIME.EQ.8704213) GOTO 20
C     IF (ITIME.EQ.8709723) GOTO 20
C     IF (ITIME.GE.8710505.AND.ITIME.LE.8710507) GOTO 20
C     IF (ITIME.EQ.8715915) GOTO 20
C     IF (ITIME.EQ.8716816) GOTO 20
C     IF (ITIME.EQ.8725811) GOTO 20
C     IF (ITIME.EQ.8729510) GOTO 20
C     IF (ITIME.EQ.8729703) GOTO 20
C     IF (ITIME.EQ.8729711) GOTO 20
C     IF (ITIME.EQ.8729712) GOTO 20
C     IF (ITIME.GE.8730918.AND.ITIME.LE.8731023) GOTO 20
C     IF (ITIME.EQ.8734120) GOTO 20
C     IF (ITIME.EQ.8734404) GOTO 20
C REMOVE 1988 NOISE POINTS
C     IF (ITIME.EQ.8800419) GOTO 20
C     IF (ITIME.GE.8802517.AND.ITIME.LE.8802521) GOTO 20
C     IF (ITIME.GE.8802722.AND.ITIME.LE.8802723) GOTO 20
C     IF (ITIME.EQ.8804810) GOTO 20
C     IF (ITIME.EQ.8804905) GOTO 20
C     IF (ITIME.EQ.8805523) GOTO 20
C     IF (ITIME.EQ.8805600) GOTO 20
C     IF (ITIME.EQ.8808119) GOTO 20
C     IF (ITIME.EQ.8808120) GOTO 20
C     IF (ITIME.EQ.8808323) GOTO 20
C     IF (ITIME.EQ.8810519) GOTO 20
C     IF (ITIME.EQ.8810520) GOTO 20
C     IF (ITIME.GE.8811600.AND.ITIME.LE.8812023) GOTO 20
C     IF (ITIME.GE.8815605.AND.ITIME.LE.8815612) GOTO 20
C     IF (ITIME.GE.8817903.AND.ITIME.LE.8817906) GOTO 20
C     IF (ITIME.GE.8821514.AND.ITIME.LE.8821609) GOTO 20
C     IF (ITIME.GE.8824300.AND.ITIME.LE.8824306) GOTO 20
C     IF (ITIME.GE.8825012.AND.ITIME.LE.8825113) GOTO 20
C REMOVE 1989 NOISE POINTS
C     IF (ITIME.EQ.8901113) GOTO 20
C     IF (ITIME.EQ.8907214) GOTO 20
C     IF (ITIME.EQ.8934121) GOTO 20
C     IF (ITIME.EQ.8935423) GOTO 20
C REMOVE 1990 NOISE POINTS
C     IF (ITIME.EQ.9002406) GOTO 20
C     IF (ITIME.EQ.9003815) GOTO 20
C     IF (ITIME.GE.9004505.AND.ITIME.LE.9004621) GOTO 20
C     IF (ITIME.EQ.9007800) GOTO 20
C     IF (ITIME.EQ.9008220) GOTO 20
C     IF (ITIME.EQ.9009000) GOTO 20
C     IF (ITIME.GE.9010418.AND.ITIME.LE.9010501) GOTO 20
C
      WRITE(11,NUM=IREC) OUT                                            00000500
      IWRITE = IWRITE + 1
C SAMPLE OUTPUT DATA (DAILY, HOUR 0)
      IF (OUT(4).EQ.0)
     C WRITE(6,899) IOUT(1),IOUT(2),IOUT(3),IOUT(4),OUT(9),
     C               OUT(10),OUT(11),OUT(12),OUT(13),OUT(16),
     C               OUT(17)
      GO TO 20                                                          00000510
  100 CONTINUE
      WRITE(6,'('' NUMBER OF RECORDS WRITTEN:  '',I5.5)') IWRITE
      STOP                                                              00000520
  899 FORMAT(I2,I2,I3.3,I2.2,2F7.3,2F7.1,F5.1,F8.4,E10.4)
      END                                                               00000530
//RUN77 EXEC LOADER,REGION=500K                                         00000540
//SYSUDUMP DD DUMMY
//*T10F001 DD DSN=VOYAGER1.HOURAVG,DISP=SHR,VOL=SER=V1NEW,              00000550
//*           UNIT=6250,LABEL=(,SL)                                     00000560
//FT10F001 DD DSN=VOYAGER2.HOURAVG,DISP=SHR,VOL=SER=V2NEW,              00000550
//            UNIT=6250,LABEL=(,SL)                                     00000560
//FT11F001 DD DSN=Z1SBK.HOURAVG2,DISP=OLD                               00000570
//*T11F001 DD DSN=Z1SBK.MSTRDS,DISP=MOD
//*T12F001 DD DSN=Z1SBK.TEMP.DAT,DISP=OLD
//NOTIFY EXEC NTSO
//
CONTROL NOFLUSH NOMSG NOLIST ASIS
WRITE ENTER SPACECRAFT 1 or 2
READ SPC 
WRITE ENTER YEAR OF DATASET:
READ YR
WRITE ENTER DAY OF DATASET
READ DY
WRITE ENTER HOUR OF DATASET
READ HR
WRITE ENTER FILENAME SUFFIX IF APPLICABLE
READ SUFFIX
CLEAR
WRITE ENTER USERID FOR UNITREE
READ USR 
WRITE ENTER PASSWORD FOR UNITREE
READ PASS
WRITE YOUR OUTPUT DATASET NAME WILL BE:
WRITE U0#16.UNITTREE.V&SPC..D&YR.&DY.&HR
DELETE 'U0#16.UNITTREE.V&SPC..D&YR.&DY.&HR'
DELETE 'U0#16.TEMP&YR..T&DY.&HR'
EDIT $SUBMIT$ DATA NEW ASIS EMODE
IN //Z1SBKUNI JOB (U0016,N598,20),'VGR SUMMARY REBLOCK',
IN //             TIME=(10,00),
IN //             CLASS=N,
IN //             MSGCLASS=X,
IN //             NOTIFY=Z1SBK
IN //BATCHFTP EXEC PGM=FTP,REGION=8M,DYNAMNBR=50
IN //SYSPRT   DD  SYSOUT=*,DCB=(RECFM=VB,LRECL=124,BLKSIZE=4096)
IN //OUTPUT   DD  SYSOUT=*
IN //SYSPRINT DD  SYSOUT=*
IN //INPUT    DD  *
IN dirac 1021
IN &USR
IN &PASS 
IN cd /u3/xrtpm
IN type i
in quote stage 300 ./v&SPC./hgsum/y&YR./d&DY.&HR.&SUFFIX
IN locsite cylinder primary=20 secondary=10
IN get ./v&SPC./hgsum/y&YR./d&DY.&HR.&suffix. 'U0#16.TEMP&YR..T&DY.&HR'
IN dir ./v&SPC./hgsum/y&YR.
IN quit
unnum
IN //FORTRAN  EXEC FORTVCLG,PARM.FORT='SOURCE,XREF',
IN //            REGION=5120K,
IN //            PARM.LKED='LET,MAP,NOXREF,AMODE=24'
IN //*ORT.SYSIN    DD   DSN=U0#16.SOURCE.FORT(SUMBLOCK),DISP=SHR
IN //FORT.SYSIN    DD   DSN=Z1SBK.DATAMGR.JCL(SUMBLOCK),DISP=SHR
IN //LKED.SYSLIB   DD
IN //              DD
IN //              DD   DSN=SYS1.VFORTLIB,DISP=SHR
IN //              DD   DSN=SYS3.FORTLIB,DISP=SHR
IN //GO.FT10F001 DD DSN=U0#16.TEMP&YR..T&DY.&HR.,DISP=SHR
IN //GO.FT20F001 DD DSN=U0#16.UNITTREE.V&SPC..D&YR.&DY.&HR,
IN // UNIT=USERDA,SPACE=(CYL,(200,30),RLSE),DISP=(NEW,CATLG,KEEP),
IN // DCB=(RECFM=VB,LRECL=5000,BLKSIZE=32760)
IN //GO.SYSUDUMP DD   DUMMY
SUBMIT * 
END
CONTROL NOFLUSH NOMSG NOLIST ASIS
WRITE ENTER SPACECRAFT 1 or 2
READ SPC 
WRITE ENTER YEAR OF DATASET:
READ YR
WRITE ENTER USERID FOR UNITREE
READ USRID
WRITE ENTER PASSWORD FOR UNITREE
READ PASS
WRITE HIT RETURN
READ X
EDIT $SUBMIT$ DATA NEW ASIS EMODE
IN //Z1SBKUNI JOB (U0016,N598,50),'VGR SUMMARY LIST',
IN //             TIME=(08,30),
IN //             CLASS=N,
IN //             MSGCLASS=X,
IN //             NOTIFY=Z1SBK
IN //BATCHFTP EXEC PGM=FTP,REGION=8M,DYNAMNBR=50
IN //SYSPRT   DD  SYSOUT=*,DCB=(RECFM=VB,LRECL=124,BLKSIZE=4096)
IN //OUTPUT   DD  SYSOUT=*
IN //SYSPRINT DD  SYSOUT=*
IN //INPUT    DD  *
IN dirac 1021
IN &USRID
IN &PASS 
IN cd /u3/xrtpm
IN type i
IN dir ./v&SPC./hgsum/y&YR
IN quit
unnum
IN //GO.SYSUDUMP DD DUMMY
SUBMIT * 
WRITE ZSUMLIST INVOKED BY &SYSUID AT &SYSTIME ON &SYSDATE
END