      PROGRAM RESUMM
C
C RECONSTRUCT SUMMARY AVERAGES FROM FILTERED 1.92 SECOND AVERAGES
C S. KRAMER 03/01/94
C
      CHARACTER DSN*50,RECTYPE*4
      INTEGER*2 TIME(6),SUMMTIME(6)
C     INTEGER*4 SUMOUT(568)
      REAL*4 B192(3,25),RECORD(496),SUMOUT(568)
C
      COMMON /OUTPUT/ SUMOUT
C
      EQUIVALENCE (SUMOUT(1),RECTYPE),   (SUMOUT(4),SUMMTIME(1)),
     &            (SUMOUT(33),RECORD(1))
C
C OPEN FILTERED 1.92 SECOND SUMMARY DATA SET FOR INPUT
C
      WRITE(6,*)
      WRITE(6,*) 'ENTER INPUT DSN'
      READ(5,'(A)') DSN
      WRITE(6,*) DSN
      OPEN(10,FILE=DSN,STATUS='OLD',FORM='FORMATTED',
     &     RECORDTYPE='VARIABLE',RECL=8191,READONLY)
C
C OPEN RECONSTRUCTED FILTERED SUMMARY DATA SET FOR OUTPUT
C
      WRITE(6,*)
      WRITE(6,*) 'ENTER OUTPUT DSN'
      READ(5,'(A)') DSN
      WRITE(6,*) DSN
      OPEN(66,FILE=DSN,STATUS='NEW',FORM='UNFORMATTED',
     &     RECORDTYPE='VARIABLE',RECL=8191)    
C
      WRITE(6,*)
      WRITE(6,*) 'RECALCULATING SUMMARY AVERAGES...'
      BAD = 999.0
   10 CONTINUE
       READ(10,'(Q,<LEN>A4)',END=100) LEN,(SUMOUT(I),I=1,LEN/4)
       IF (RECTYPE.EQ.'LFM ') THEN
        DO I = 1,6
         TIME(I) = SUMMTIME(I)
        END DO
        DO I192 = 1,25
         B192(1,I192) = RECORD(167+I192-1)
         B192(2,I192) = RECORD(192+I192-1)
         B192(3,I192) = RECORD(217+I192-1)
        END DO
C       WRITE(6,'(1X,A4,1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3)')
C    &   RECTYPE,TIME
C
C COMPUTE 9.6 AND 48 SECOND AVERAGES OF 1.92 SECOND GAMMAS
C
        CALL BIGAVE(B192,TIME,BAD)
C
C WRITE HDR1 RECORD
C
       ELSE IF (RECTYPE.EQ.'HDR1') THEN
        WRITE(66) (SUMOUT(I),I=1,LEN/4)
       END IF
C
       GOTO 10
  100 CONTINUE
C
      WRITE(6,*)
C
      STOP
      END
******************************************************************
      SUBROUTINE STATS(B,FMOD,LEN,BAVE,FMAG,RMS,IFMAG,BAD)
C
      INTEGER*4 IAV(3),IRMS(3),IFMAG
      REAL*4 B(3,LEN),FMOD(LEN),BAVE(3),FMAG,RMS(3)
C
C INITIALIZE VARIABLES
C
      DO IAX = 1,3
       IAV(IAX) = 0
       IRMS(IAX) = 0
       BAVE(IAX) = 0.0
       RMS(IAX) = 0.0
      END DO
      IFMAG = 0
      FMAG = 0.0
C
      DO I = 1,LEN
C
C ACCUMULATE COMPONENT AVERAGES
C
       DO IAX = 1,3
        IF (B(IAX,I).NE.BAD) THEN
         BAVE(IAX) = BAVE(IAX) + B(IAX,I)
         IAV(IAX) = IAV(IAX) + 1
        END IF
       END DO
C
C ACCUMULATE FIELD MAGNITUDE
C
       IF (FMOD(I).NE.BAD) THEN
        FMAG = FMAG + FMOD(I)
        IFMAG = IFMAG + 1
       END IF
C
      END DO
C
C CALCULATE FIELD MAGNITUDE
C
      IF (IFMAG.GT.0) THEN
       FMAG = FMAG/REAL(IFMAG)
      ELSE
       FMAG = BAD
      END IF
C
C CALCULATE FIELD COMPONENT AVERAGES
C
      DO IAX = 1,3
C
       IF (IAV(IAX).GT.0) THEN
        BAVE(IAX) = BAVE(IAX)/REAL(IAV(IAX))
       ELSE
        BAVE(IAX) = BAD
       END IF
C
C ACCUMULATE RMS OF FIELD COMPONENTS
C
       DO I = 1,LEN
C
        IF (B(IAX,I).NE.BAD.AND.BAVE(IAX).NE.BAD) THEN
         RMS(IAX) = RMS(IAX) + (B(IAX,I)-BAVE(IAX))**2
         IRMS(IAX) = IRMS(IAX) + 1
        END IF
C
       END DO
C
C CALCULATE RMS OF FIELD COMPONENTS
C
       IF (IRMS(IAX).GT.0) THEN
        RMS(IAX) = SQRT(RMS(IAX)/REAL(IRMS(IAX)))
       ELSE
        RMS(IAX) = BAD
       END IF
C
      END DO
C
      RETURN
      END
******************************************************************
      SUBROUTINE ANGLES(B,LEN,FMOD,DEL,LAM,BAD)
C
C CALCULATE FIELD ANGLES FROM FIELD COMPONENTS AND MODULUS
C
C INPUT ARRAY OF FIELD COMPONENTS
C OUTPUT FIELD MODULUS, LATITUDINAL AND LONGITUDINAL FIELD ANGLES
C 
      REAL*4 B(3,LEN),FMOD(LEN),DEL(LEN),LAM(LEN)
C
      DO I = 1,LEN
C
C CALCULATE FIELD COMPONENT NORM (MODULUS)
C
       IF (B(1,I).NE.BAD.AND.
     &     B(2,I).NE.BAD.AND.
     &     B(3,I).NE.BAD) THEN
        FMOD(I) = SQRT(B(1,I)**2+B(2,I)**2+B(3,I)**2)
       ELSE
        FMOD(I) = BAD
       END IF
C
C CALCULATE LATITUDINAL FIELD ANGLE
C
       IF (FMOD(I).NE.BAD.AND.
     &     FMOD(I).NE.0.0.AND.
     &     B(3,I).NE.BAD) THEN
        DEL(I) = ASIN(B(3,I)/FMOD(I)) * 
     &   57.2957795D0
       ELSE
        DEL(I) = BAD
       END IF
C
C CALCULATE LONGITUDINAL FIELD ANGLE
C
       IF (B(1,I).NE.BAD.AND.
     &     B(2,I).NE.BAD.AND.
     &     B(1,I).NE.0.0) THEN
        LAM(I) = 180.0 - 
     &   ATAN2(B(2,I),-B(1,I)) * 57.2957795D0
       ELSE IF (B(1,I).NE.BAD.AND.
     &          B(2,I).NE.BAD.AND.
     &          B(1,I).EQ.0.0.AND.
     &          B(2,I).NE.0.0) THEN
        LAM(I) = 90.0
       ELSE IF (B(1,I).NE.BAD.AND.
     &          B(2,I).NE.BAD.AND.
     &          B(1,I).NE.0.0.AND.
     &          B(2,I).EQ.0.0) THEN
        LAM(I) = 180.0
       ELSE
        LAM(I) = BAD
       END IF
C
      END DO
C
      RETURN
      END
******************************************************************
      SUBROUTINE BIGAVE(B192,TIME,BAD)
C
C PRODUCE 1 48 SECOND AVERAGE AND 5 9.6 SECOND AVERAGES FROM 25 1.92 SECOND
C FIELD COMPONENT AVERAGES (48 SEC PERIOD).
C
      CHARACTER DATAID*4
C
      LOGICAL*1 ROTATE /.FALSE./,
     &          SYS2(32) /32*.FALSE./
C
      INTEGER*2 TIME(6),SEDRTIME(6),AVETIME(6),WORD32(2),DATATYPE(2)
C
      INTEGER*4 IB192(25),IB96(5),IB48
C
      REAL*4 GAMMA(3,400),FMOD(400),DEL(400),LAM(400),
     &       FMAG192(25),FMOD192(25),DEL192(25),
     &       LAM192(25),B192(3,25),RMS192(3,25),
     &       X192(25),Y192(25),Z192(25),
     &       XRMS192(25),YRMS192(25),ZRMS192(25),
     &       FMAG96(5),FMOD96(5),DEL96(5),
     &       LAM96(5),B96(3,5),RMS96(3,5),
     &       X96(5),Y96(5),Z96(5),
     &       XRMS96(5),YRMS96(5),ZRMS96(5),
     &       FMAG48,FMOD48,DEL48,
     &       LAM48,B48(3),RMS48(3),
     &       X48,Y48,Z48
C
      REAL*4 HDR(32),DATA(341),SCFLD(155),POSN(13),ATTD(27),SUMOUT(568)   
C
      REAL*4 SPV(6),RANGE,ANG(2),PYLD(3),HG(3),
     &       MTB(3,3),MTB5(3,3),MHG(3,3)
C
      DATA ICALL/0/
C
      COMMON /OUTPUT/ SUMOUT
C
      EQUIVALENCE (SUMOUT(1),HDR(1)),    (SUMOUT(33),DATA(1)),  
     &            (SUMOUT(342),SCFLD(1)),
     &            (SUMOUT(529),POSN(1)), (SUMOUT(542),ATTD(1))  
C
      EQUIVALENCE (HDR(1),DATAID),       (HDR(4),AVETIME(1)),
     &            (HDR(12),TIMEPD),      (HDR(17),DATATYPE(1)),
     &            (HDR(32),WORD32(1))
C
      EQUIVALENCE (DATA(1),FMAG48),      (DATA(2),FMOD48),
     &            (DATA(3),DEL48),       (DATA(4),LAM48),     
     &            (DATA(5),X48),         (DATA(6),Y48),
     &            (DATA(7),Z48),         (DATA(8),RMS48(1)),
     &            (DATA(11),IB48),       (DATA(12),FMAG96(1)),
     &            (DATA(17),FMOD96(1)),  (DATA(22),DEL96(1)),  
     &            (DATA(27),LAM96(1)),   (DATA(32),X96(1)),
     &            (DATA(37),Y96(1)),     (DATA(42),Z96(1)),
     &            (DATA(47),RMS96(1,1)), (DATA(62),IB96(1)),
     &            (DATA(67),FMAG192(1)), (DATA(92),FMOD192(1)),
     &            (DATA(117),DEL192(1)), (DATA(142),LAM192(1)),
     &            (DATA(167),X192(1)),   (DATA(192),Y192(1)),
     &            (DATA(217),Z192(1)),   (DATA(242),RMS192(1,1)),
     &            (DATA(317),IB192(1))
C
C COUNT 48 SECOND SUMMARY OUTPUT RECORDS
C
      ICALL = ICALL + 1
C
      DATAID = 'LFM '
      DO IT = 1,6
       AVETIME(IT) = TIME(IT)
      END DO
      TIMEPD = 48.0
      DATATYPE(1) = 1
      WORD32(2) = 536
C
C GENERIC AVERAGING ROUTINE TO COMPUTE 9.6 AND 48 SECOND AVERAGES
C
      DO I = 1,25,5
C
C COMPUTE 1.92 SECOND FIELD MODULUS AND ANGLES
C
       CALL ANGLES(B192(1,I),5,FMOD192(I),DEL192(I),LAM192(I),BAD)
C
       J = (I-1)/5 + 1
C
C COMPUTE 9.6 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS
C 
       CALL STATS(B192(1,I),FMOD192(I),5,B96(1,J),FMAG96(J),RMS96(1,J),
     &            IB96(J),BAD)
C
      END DO
C
C COMPUTE 9.6 SECOND FIELD MODULUS AND ANGLES
C
      CALL ANGLES(B96,5,FMOD96,DEL96,LAM96,BAD)
C
C COMPUTE 48 SECOND FIELD COMPONENTS, MAGNITUDE AND COMPONENT RMS
C
      CALL STATS(B96,FMOD96,5,B48,FMAG48,RMS48,IB48,BAD)
C
C COMPUTE 48 SECOND FIELD MODULUS AND ANGLES
C
      CALL ANGLES(B48,1,FMOD48,DEL48,LAM48,BAD)
C
C SEPARATE FIELD AND RMS COMPONENT VECTORS FROM MATRICES
C
      DO I96 = 1,5
       X96(I96) = B96(1,I96)
       Y96(I96) = B96(2,I96)
       Z96(I96) = B96(3,I96)
       XRMS96(I96) = RMS96(1,I96)
       YRMS96(I96) = RMS96(2,I96)
       ZRMS96(I96) = RMS96(3,I96)
       DO J = 1,5
        I192 = (I96-1)*5 + J
        X192(I192) = B192(1,I192)
        Y192(I192) = B192(2,I192)
        Z192(I192) = B192(3,I192)
        XRMS192(I192) = RMS192(1,I192)
        YRMS192(I192) = RMS192(2,I192)
        ZRMS192(I192) = RMS192(3,I192)
       END DO
      END DO
      X48 = B48(1)
      Y48 = B48(2)
      Z48 = B48(3)
C
      WRITE(66) SUMOUT
C
C OUTPUT 1.92 SECOND AVERAGES
C
      IF (SYS2(1)) THEN
       DO I = 1,25
        WRITE(6,888) TIME,FMAG192(I),FMOD192(I),(B192(J,I),J=1,3),
     &                DEL192(I),LAM192(I),(RMS192(J,I),J=1,3),IB192(I)
       END DO
C
C OUTPUT 48 SECOND AVERAGES
C
      ELSE IF (SYS2(2)) THEN
        WRITE(6,888) TIME,FMAG48,FMOD48,B48,DEL48,LAM48,RMS48,IB48
      END IF
C
      RETURN
C
  888 FORMAT(1X,I2,1X,I3.3,3(1X,I2.2),1X,I3.3,5(1X,F7.3),
     &       2(1X,F5.1),3(1X,F7.3),1X,I2)
C
      END
