CTITLEMCUT   -- TRUNCATES STARTING WAVELET                              00000010
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA       AUTHOR                 D. D. THOMPSON                          00000020
CA       DESIGNER               D. D. THOMPSON                          00000030
CA       LANGUAGE               FORTRAN 77                              00000040
CA       SYSTEM                 IBM & CRAY                              00000041
CA       WRITTEN                1972                                    00000050
C        REVISED                MO-DA-YR                                00000060
C        REVISED                05-20-85 TWH. ADAPTED TO IBM & CRAY.    00000061
C                                                                       00000070
CA                                                                      00000080
CA                                                                      00000090
CA       CALL MCUT (W, NMAX, N, P)                                      00000100
CA             INPUT  W      = INPUT WAVELET                        R4  00000110
CA             INPUT  NMAX   = LENGTH OF W ON INPUT                 I4  00000120
CA             OUTPUT N      = RETURNED TRUNCATED LENGTH OF W       I4  00000130
CA             INPUT  P      = PERCENT OF PEAK TO DETERMINE         R4  00000140
CA                             TRUNCATION                               00000150
CA                                                                      00000160
CA                                                                      00000170
CA              THIS ROUTINE TRUNCATES AN INPUT WAVELET TO THE          00000180
CA          NEAREST ZERO CROSSING SUCH THAT THE TRUNCATED TAIL          00000190
CA          IS LESS THAN A SPECIFIED PERCENTAGE OF THE PEAK.            00000200
CA                                                                      00000210
CA                                                                      00000220
C                                                                       00000230
C    SUBROUTINES CALLED: MPEAK                                          00000240
C                                                                       00000250
C     EJECT                                                             00000260
C                                                                       00000270
      SUBROUTINE MCUT (W, NMAX, N, P)                                   00000280
CAEND                                                                   00000290
C                                                                       00000300
      DIMENSION W(1)                                                    00000310
      N=NMAX                                                            00000320
      IF(P.LE.0.) RETURN                                                00000330
      CALL MPEAK(W,NMAX,Q,PNT)                                          00000340
      Q=P*ABS(Q)/100.                                                   00000350
      T=W(NMAX)                                                         00000360
      IL=2                                                              00000370
C                                                                       00000380
   10     DO                                                        30  00000390
     *    I=IL,NMAX                                                     00000400
          A=W(NMAX-I+1)                                                 00000410
          IF(I.NE.IL) GO TO                                         20  00000420
          SEY=-1.                                                       00000430
          IF(A.GE.T) SEY=1.                                             00000440
C                                                                       00000450
   20     IF(SEY*(A-T).LT.0.) GO TO                                 40  00000460
C                                                                       00000470
   30     T=A                                                           00000480
C                                                                       00000490
      RETURN                                                            00000500
C                                                                       00000510
   40 IF(ABS(T).GT.Q)GO TO                                          50  00000520
      IL=I                                                              00000530
      GO TO                                                         10  00000540
C                                                                       00000550
   50 IL=NMAX-I+2                                                       00000560
C                                                                       00000570
          DO                                                        70  00000580
     *    I=IL,NMAX                                                     00000590
          A=W(I)                                                        00000600
          IF(I.NE.IL) GO TO                                         60  00000610
          SEY=-1.                                                       00000620
          IF(A.GE.0.) SEY=1.                                            00000630
C                                                                       00000640
   60     IF(SEY*A.LT.0.) GO TO                                     80  00000650
C                                                                       00000660
   70     CONTINUE                                                      00000670
C                                                                       00000680
      IF(ABS(W(IL)).LT.ABS(W(NMAX))) N=IL                               00000690
      RETURN                                                            00000700
C                                                                       00000710
   80 N=I                                                               00000720
      IF(ABS(A).GT.ABS(W(I-1))) N=I-1                                   00000730
      RETURN                                                            00000740
      END                                                               00000750