C                                                                       00010001
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CTITLESASTATS -- ESTABLISH STATISTICS FOR A GATHER                      00020001
CA    AUTHOR       J. J. LEE                                            00030001
CA    DESIGNER     J. J. LEE                                            00040001
CA    LANGUAGE     FORTRAN                                              00050001
CA    SYSTEM       IBM / CRAY                                           00060001
CA    WRITTEN      AUGUST, 1990                                         00070001
C     REVISED      12-21-91 JJC - MODIFIED TO MEET EDP STANDARDS.
C                                                                       00080001
CA                                                                      00090001
CA    CALL SASTATS(XSD,MTRC,SMEAN,DEV,MDPN,MT,ISR,IPR,METHOD,FACT,MODE) 01660000
CA                                                                      00110001
CA         INPUT   XSD    = INPUT ARRAY TO BE SMOOTHED              R4  00120001
CA         INPUT   MTRC   = NUMBER OF ELEMENTS IN Y                 I4  00130001
CA         INPUT   SMEAN  = STRIDE OF THE ARRAY Y                   I4
CA         INPUT   DEV    = THE LENGTH OF THE FILTER                I4  00140001
CA         INPUT   MDPN   = CDP NUMBER                              I4  00180001
CA         INPUT   MT     = TIEM WINDOW FOR AMPLITUDE STATISTICS    I4  00150001
CA         INPUT   ISR    = SAMPLING INTERVAL                       I4  00120001
CA         INPUT   IPR    = PRINTER UNIT NUMBER                     I4  00130001
CA         INPUT   METHOD = METHOD OF EDITING                       I4
CA         INPUT   FACT   = THE LENGTH OF THE FILTER                I4  00140001
CA         INPUT   MODE   = THE MODE TYPE OF GATHER                 I4  00180001
C
C      PURPOSE : ESTABLISH STATISTICS FOR A GATHER
C
C**************************************************************
C                                                             *
C SUBROUTINES AND FUNCTIONS CALLED FROM THIS ROUTINE          *
C                                                             *
C SSORT                                                       *
C                                                             *
C**************************************************************
      SUBROUTINE SASTATS(XSD,MTRC,SMEAN,DEV,MDPN,MT,ISR,IPR,METHOD,     01660000
     + FACT,MODE)                                                       01660000
C
      IMPLICIT INTEGER (A-Z)
C
      DIMENSION XSD(1),IWORD(500)                                       01660000
      CHARACTER*1  ASTER                                                02340018
      CHARACTER*1 ISTAR(80)
C
      REAL    DEV
      REAL    FACT
      REAL    PW
      REAL    SINT
      REAL    SMAX
      REAL    SMEAN
      REAL    SMIN
      REAL    XSD
      DATA ASTER /'*'/                                                  02620018
C                                                                       02620018
      MTIME = MT * ISR
      IF (MODE .EQ. 0) WRITE ( IPR, 9000 ) MDPN, MTIME
      IF (MODE .NE. 0) WRITE ( IPR, 9010 ) MDPN, MTIME
 9000 FORMAT(/,'  AMPLITUDE STATISTICS FOR SSP #',I5,' AT TIME ',
     1I6,' MS ')
 9010 FORMAT(/,'  AMPLITUDE STATISTICS FOR CDP #',I5,' AT TIME ',
     1I6,' MS ')
      CALL SSORT ( XSD, 1, MTRC )
      DO 100 I = 1, 80
         ISTAR(I) = ASTER
 100  CONTINUE
      SMIN = XSD(1)
      SMAX = XSD(MTRC)
      SINT = (SMAX - SMIN )  / 50
      WRITE ( IPR, 9020 ) SMEAN
 9020 FORMAT(/,'   MEAN               =',E10.3)
      WRITE ( IPR, 9030 ) DEV
 9030 FORMAT('   STANDARD DEVIATION =',E10.3)
      WRITE ( IPR, 9040 ) SMIN
 9040 FORMAT('   MIN AMPLITUDE      =',E10.3)
      WRITE ( IPR, 9050 ) SMAX
 9050 FORMAT('   MAX AMPLITUDE      =',E10.3,//)
      WRITE ( IPR, 9060 ) SMIN, SMAX
 9060 FORMAT('            ',E10.3,'                        ',
     1'              ',E10.3)
 9070 FORMAT('              ======================================',
     1'=============',/)
      WRITE ( IPR, 9070 )
      DO 120 II = 1, MTRC
         IWORD(II) = (XSD(II) - SMIN )  / SINT + 1
 120  CONTINUE
C
C     IF (MTRC .GT. NFOD) JJ = 2
C
      MTRC1 = MTRC - 1
      IF (METHOD .EQ. 2) THEN
         PW = SMEAN - FACT * DEV
         IP1 = 1
         IP2 = MTRC
         DO 140 J1 = 1, MTRC1
            IF (PW .GE. XSD(J1) .AND. PW .LT. XSD(J1+1)) GO TO 160
 140     CONTINUE
         GO TO 180
 160     CONTINUE
         IP1 = J1
 180     CONTINUE
         PW = SMEAN + FACT * DEV
         DO 200 J1 = 1, MTRC1
            IF (PW .GE. XSD(J1) .AND. PW .LT. XSD(J1+1)) GO TO 220
 200     CONTINUE
         GO TO 240
 220     CONTINUE
         IP2 = J1
 240     CONTINUE
C
         DO 260 II = 1, MTRC
            K2 = IWORD(II)
            WRITE ( IPR, 9080 ) II,  ( ISTAR(KK), KK = 1, K2 )
 9080 FORMAT('  TRC # ',I3,3X,51A1)
            IF (II .EQ. IP1) WRITE ( IPR, 9090 )
 9090 FORMAT('              --------------------------------------',
     1'------------- DATA REJECTED BEFORE THIS LINE ')
            IF (II .EQ. IP2) WRITE ( IPR, 9100 )
 9100 FORMAT('              --------------------------------------',
     1'------------- DATA REJECTED AFTER THIS LINE ')
 260     CONTINUE
         WRITE ( IPR, 9070 )
      ELSE
C
C     METHOD = 3 ( % REJECTION)
C
         IP2 = IFIX ( FACT )
C
         DO 280 II = 1, MTRC
            K2 = IWORD(II)
            WRITE ( IPR, 9110 ) II,  ( ISTAR(KK), KK = 1, K2 )
 9110 FORMAT('  TRC # ',I3,3X,51A1)
C     IF(II.EQ.IP1 ) WRITE(IPR,  104)
            IF (II .EQ. IP2) WRITE ( IPR, 9100 )
 280     CONTINUE
         WRITE ( IPR, 9070 )
C
      ENDIF
      WRITE ( IPR, 9060 ) SMIN, SMAX
C
      RETURN
      END