!******************** START FILE FILTR6.FOR ; GROUP FILTR6 *************
!
!  FILTR6     DATA SMOOTHING ALGORITHM    D. MCCUNE  5 SEPT 78
!						PPPL
!
!
!     THIS IS AN ALGORITHM TO SMOOTH DATA.  INSTEAD OF
!   USING SPLINE FUNCTIONS, THE ALGORITHM USES A LOCAL
!   WEIGHTED AVERAGE TO GENERATE SMOOTHING ACTION.  THIS HAS
!   THE ADVANTAGE OF AVOIDING THE LARGE COEFFICENT ARRAYS
!   AND WORK SPACES NEEDED BY SPLINE FUNCTION AL
!   GORITHMS; AND IN MANY CASES (IN THE EXPERIENCE
!   OF THE AUTHOR) THE ALGORITHM IS MORE EFFICIENT IN CPU TIME
!   BY AS MUCH AS A FACTOR OF 10.
!
!     THE USER SPECIFIES THE RADIUS OF THE LOCAL WEIGHTED
!   AVERAGE ( CALLED 'DELTA' IN THIS ALGORITHM).  THIS DELTA
!   SHOULD BE SET AS SMALL AS POSSIBLE TO REMOVE 'NOISE' FROM
!   THE DATA SIGNAL, TO ASSURE MAXIMUM EFFICIENCY OF THE ALGOR
!   ITHM.  IF COMPONENTS OF THE SIGNAL OF WAVELENGTH
!   LAMDA OR LESS ARE DEEMED NOISE, DELTA SHOULD BE SET TO APPROX.
!   LAMDA/2.
!     ** note DELTA is an ARRAY ** of same dimension as the input
!   data; DELTA(j) specifies the smoothing delta at pt. j in the
!   input data.
!       IN THIS VERSION THE WEIGHTING FUNCTION IS TRIANGULAR
!   SHAPED, WITH BASE WIDTH TWO*DELTA, SYMMETRIC ABOUT
!   AND PEAKED AT THE POINT WHERE THE
!   LOCAL AVERAGE IS BEING COMPUTED.  THIS FUNCTION WAS
!   FOUND TO GENERATE ALMOST EQUIVALENT SMOOTHING ACTION
!   TO MORE COMPLICATED WEIGHTING FUNCTIONS, WITH A
!   CONSIDERABLE SAVINGS IN CPU TIME.
!   THE FORMULA FOR THE WEIGHTING FUNCTION IS:
!
!   W(X-T)=1./DELTA * (1.-ABS((X-T)/DELTA))
!        IF ABS(X-T) < DELTA,              OR
!   W(X-T)=0. IF ABS(X-T) >= DELTA.
!
!   THIS IS THE WEIGHTING FUNCTION CENTERED AT X.
!
!   THE ALGORITHM EVALUATES THE SMOOTHED DATA CURVE BY
!   COMPUTING THE LOCAL WEIGHTED AVERAGE ABOUT EACH POINT
!   USING THE WEIGHTING FUNCTION:
!
!             INTEGRAL(T=X(J)-DELTA TO X(J)+DELTA)[W(X(J)-T)*F(T)*DT]
!   YSM(J)=  ----------------------------------------------------
!             INTEGRAL(T=X(J)-DELTA TO X(J)+DELTA)[W(X(J)-T)*DT]
!
!   WHERE F(T) IS THE LINEARLY INTERPOLATED (CONTINUOUS, PIECE-
!   WISE LINEAR) FUNCTION OF THE ORIGINAL DATA (X(1),Y(1)) THRU
!   (X(N),Y(N))
!
!
! *******EPSLON FEATURE *********
!
!   IN MANY APPLICATIONS, WE MAY KNOW NOT ONLY THE FREQUENCY
!  OF 'NOISE' IN A SIGNAL, BUT ALSO ITS NOMINAL AMPLITUDE.
!    THEREFORE IT IS DESIRABLE THAT THE ALGORITHM NOT SMOOTH
!    OUT COMPONENTS OF THE SIGNAL WHICH ARE OF AMPLITUDE
!    GREATER THAN THIS NOMINAL AMPLITUDE, EVEN IF
!    THE CORRESPONDING FREQUENCY IS VERY HIGH.  TO THIS END
!    AN 'EPSILON' FEATURE IS PROVIDED IN THIS ALGORITHM.
!      THE USER SPECIFIES A VALLUE EPSLON WHICH SAYS
!    TO THE ALGORITHM, NO POINT SHALL BE MOVED MORE THAN
!    EPSLON FROM THE POINTS  IN THE ORIGINAL DATA.  THIS FEATURE
!    IS VERY USEFUL IF THE CURVE BEING SMOOTHED HAS A 'REAL'
!    FEATURE, TO BE PRESERVED, WHICH IS VERY SHARP OR NARROW, OR
!    WHICH INVOLVES A VERY RAPID RISE OR FALL TIME.
!
!    THE ALGORITHM, AFTER EVALUATING A SMOOTHED DATA CURVE
!    BY THE ABOVE FORMULA, COMPARES THE RESULT WITH THE ORIGINAL
!    DATA. IF AT ANY POINT THE ORDINATE VALUES HAVE CHANGED BY
!    MORE THAN EPSLON, THE SMOOTHED CURVE IN THE VICINITY OF THAT
!    POINT IS REEVALUATED USING A SMALLER, PROGRAM DEFINED
!    DELTA.  THE PROCEDURE IS REPEATED UNTIL THERE ARE NO
!    'EPSLON VIOLATIONS' IN THE SMOOTHED CURVE.
!
!  THE EPSLON VALUES MAY BE PASSED AS AN ARRAY OF DIMENSION
!  NE <= N=DIMENSION OF DATA ARRAYS; TO SPECIFY AN EPSLON
!  'ERROR BAR' FOR EACH POINT INDIVIDUALLY, SPECIFY NE=N;
!  TO USE THE SAME 'ERROR BAR ' FOR ALL POINTS SPECIFY NE=1;
!  IF 1 < NE < N, THE ERROR BAR FOR DATA POINTS J=1 THRU NE
!  IS EPS(J), FOR DATA POINTS J=NE+1 THRU N, THE ERROR BAR
!  IS THE LAST EPSLON, EPS(NE).
!
!  THE WEIGHTED AVERAGE WIDTH DELTA IS ALSO PASSED AS
!  AN ARRAY WHICH MAY CONTAIN DIFFERENT VALUES FOR
!  FOR DIFFERENT DATA POINTS.  HOWEVER,
!  THE USER **MUST** REDEFINE THE DELTA ARRAY BEFORE EACH
!  CALL TO FILTR6, SINCE THE ARRAY MAY BE
!  MODIFIED DURING IMPLIMENTATION OF THE EPSLON FEATURE*****
!
!
!    *** END CONDITIONS ****
!
!  END CONDITION PARAMETERS XENDA (LEFT SIDE) AND XENDB (RIGHT SIDE)
!  MAY BE SET ANYWHERE BETWEEN THE EXTREMES (0 AND 1):
!    XEND_=0:  THE END-POINT IS EFFECTIVELY FIXED
!         (YSM(1) WILL EQUAL Y(1)).  THE WEIGHTED AVERAGE
!         INTEGRAL IN THE VICINITY OF THE ENDPOINT IS CALCULATED
!         BY 'CONTINUING' THE DATA BEYOND THE END-POINT BY
!         REFLECTION ABOUT THE ENDPOINT (E.G. IF (0,0) IS THE
!         ENDPOINT AND (1,1) IS THE NEXT POINT, (-1,-1) IS THE
!         REFLECTED POINT.
!   XEND_ =1:  THE FIRST DERIVATIVE AT THE ENDPOINT IS EFFECTIVELY
!        SET TO ZERO.  THE WEIGHTED AVERAGE IN THE VICINITY
!        OF THE ENDPOINT IS CALCULATED BY 'EXTENDING' THE DATA
!        BEYOND THE ENDPOINT BY REFLECTION ABOUT THE LINE
!        X=CONST. PASSING THRU THE ENDPOINT. (E.G. IF THE END
!        POINT IS (0,0) AND THE NEXT POINT (1,1) THE REFL
!        ECTED POINT IS (-1,1)  ).  THE ENDPOINT WILL BE MOVED
!        BUT BY SYMMETRY OF THE REFLECTION THE SLOPE
!        OF THE SMOOTHED DATA CURVE WILL GO TO ZERO.
!
!   EPSLN2  FEATURE... AN ARRAY OF MULTIPLIERS OF THE ORIGINAL
!        ERROR BARS MAY BE SUPPLIED BY THE USER FOR USE WHEN
!        THE NUMBER OF POINTS INVOLVED IN A VIOLATION IS
!        SMALL.
!
!   ALSO, THE USER MAY USE A DATA 'DROPOUT' FEATURE:
!    (SEE BELOW)
!
!
!    A BASELINE FEATURE IS ALSO AVAILABLE (SEE BELOW)
!
!---------------------------------------------------
!  ARGUMENTS           FILTR6
!
!    X()     INPUT    DATA ABSCISSAE (ORDERED S.T. X(I+1) > X(I))
!    Y1()    INPUT    ORIGINAL DATA ORDINATES *MAY BE MODIFIED
!					BY DATA DROPOUT
!    Y()     OUTPUT   SMOOTHED DATA ORDINATES
!		      (NOTE Y AND Y1 MUST BE DISTINCT ARRAYS
!                     FOR PROPER IMPLEMENTATION OF EPSLON FEATURE)
!    N       INPUT    # OF DATA PTS (DIMENSION OF X,Y1,Y)
!    EPS()   INPUT    'EPSLON' DISCUSSED ABOVE.  (EXCEPT FOR EPS2
!                     FEATURE) NO POINT SHALL BE MOVED MORE THAN
!                     EPS, I.E [ABS(Y1(J)-Y(J)) <= EPS] ALL J.
!                            EPS IN DATA ORDINATE UNITS.
!                     *EPS IS AN ARRAY*
!    NE      INPUT    DIMENSION OF EPS
!    EPS2()  INPUT    'EPSLN2' FEATURE DISCUSSED ABOVE.
!                     MULTIPLIER FOR EPSLON ARRAY FOR SHORT VIOLATIONS
!
!    NEPS2   INPUT    DIMENSION OF EPS2.:
!                        NEPS2=0==> EPSLON FEATURE STRICTLY
!				    IMPLEMENTED
!     			 NEPS2=1==> IF AN ISOLATED VIOLATION OF
!				    EPS INVOLVING ONLY ONE DATA
!   				    PT IS DETECTED, EPS2(1)*EPS
!				    IS USED INSTEAD OF EPS
!                        NEPS2=2==> EPSLON VIOLATION OF LENGTH 1,
!                                   EPS2(1)*EPS USED INSTEAD OF EPS;
!				     VIOLATION OF LENGTH 2 DATA
!				    PTS, EPS2(2)*EPS USED INSTEAD OF EPS
!			 NEPS2 CAN BE ANY NONNEG. INTEGER.
!   DELT() INPUT         'DELTA', RADIUS OF WEIGHTED AVERAGE,
!			 DISCUSSED ABOVE.  **array of size N**
!   IDDF   INPUT	DATA DROPOUT FLAG:
!			=0: DONT USE DATA DROPOUT FEATURE
!			=1: DO USE FEATURE
!   DDV    INPUT	DATA DROPOUT CRITERION: (IF IDDF=1):
!			DATA PT. (X(I),Y1(I)) DROPS OUT IF Y1(I)
!			IS MORE THAN DDV ABOVE OR BELOW THE LINE
!			SEGMENT CONNECTING ITS IMMEDIATE NEIGHBORS
!			Y1(I) IS THEN RESET TO LIE ON SAID LINE
!			SEGMENT.
!    IBLF   INPUT    BASELINE FEATURE FLAG:
!			=0==> DONT PUT IN A BASELINE
!			=1==> DO PUT IN A BASELINE
!
!    BLV    INPUT    BASELINE VALUE (IF IBLF=1):  ALL POINTS IN
!			THE CURVE FOUND TO BE LESS THAN BLV
!			ARE RESET TO EQUAL BLV.
!
!     SM     OUTPUT SUM SQUARED OF (Y1(I)-Y(I)), EXCLUDING
!                   POINTS AT THE BASELINE (IF ANY).
!    *** MODIFIED *** SM= SUM SQUARED OF (Y1(J)-Y(J))
!           DIVIDED BY (MAX[J]ABS(Y1(J)))**2
!           NORMALIZATION TO PREVENT OVERFLOWS
!
!     NDROP  OUTPUT NUMBER OF 'DROPOUT' PTS.
!     NBLRS  OUTPUT NUMBER OF PTS RESET TO THE BASELINE.
!
SUBROUTINE r8filtr6(X,Y1,Y,N,EPS,NE,EPS2,NEPS2,DELT,IDDF,DDV, &
     IBLF,BLV,XENDA,XENDB,SM,NDROP,NBLRS)
  use iso_c_binding, only: fp => c_double
  use physconst_mod, only: ZERO, ONE
  implicit none
  ! Arguments
  integer, intent(in)   :: n
  integer, intent(in)   :: ne
  integer, intent(in)   :: neps2
  integer, intent(in)   :: iddf
  integer, intent(in)   :: iblf
  integer, intent(out)  :: ndrop
  integer, intent(out)  :: nblrs
  real(fp), dimension(n),  intent(in)    :: x
  real(fp), dimension(n),  intent(inout) :: y1
  real(fp), dimension(n),  intent(inout) :: y
  real(fp), dimension(n),  intent(in)    :: delt
  real(fp), dimension(ne), intent(in)    :: eps
  real(fp), dimension(*),  intent(in)    :: eps2
  integer, intent(in) :: ddv
  integer, intent(in) :: blv
  real(fp), intent(in) :: xenda,xendb
  real(fp), intent(out) :: sm
  ! Local variables
  integer :: ierr,j,ierr1,j2,n2,je,nel
  real(fp) :: zxp,xend1,xend2,zeps,y1a,y1b,zmax,dy
!
!  START OF EXECUTABLE CODE
!
  NBLRS=0
  NDROP=0
!  DROP DATA PTS IN Y1 ARRAY
  IF(IDDF.EQ.1) CALL r8ddrop(X,Y1,N,DDV,NDROP)
!
  IERR=0
  ZXP=X(1)-(X(2)-X(1))
  DO J=1,N
    IF(ZXP.GE.X(J)) IERR=J   ! CHECKING MONOTONICITY
    ZXP=X(J)
    Y(J)=Y1(J)
  END DO
!
  IF(IERR.NE.0) THEN
    IERR=MAX(2,IERR)
    IERR1=IERR-1
    WRITE(6,1001) IERR1,X(IERR1),IERR,X(IERR)
    SM=ZERO
    RETURN
  ENDIF
1001 FORMAT( &
          ' ?FILTR6:  INPUT "X" ARRAY NOT MONOTONIC, CANNOT SMOOTH:'/ &
          '  X(',I6,')=',1PE13.6,'  X(',I6,')=',1PE13.6/)
  !
  !  SMOOTH ENTIRE REGION IF BASELINE FEATURE NOT IN EFFECT.
  !
  IF(IBLF.EQ.1) GO TO 15
  !
  XEND1=XENDA
  XEND2=XENDB
  CALL r8filter(X,Y1,Y,N,DELT,XEND1,XEND2)

  !  IMPLEMENT EPSLON FEATURE --
  CALL r8fileps(X,Y1,Y,N,DELT,EPS,NE,EPS2,NEPS2,XEND1,XEND2)
  !
  GO TO 500
  !
  !  RESET PTS IF BASELINE FEATURE IS IN EFFECT
  !
 15 CONTINUE
  DO J=1,N
    IF(Y(J).GT.(BLV)) cycle
    NBLRS=NBLRS+1
    Y(J)=BLV
  END DO
  !
  !  SMOOTH BETWEEN PTS RESET TO BASELINE.
  !
  J=0
30 J=J+1
  IF(J.GE.N) GO TO 500
  IF(Y(J).LE.BLV) GO TO 30
  IF(J.GT.1) J=J-1
!  SMOOTHING WILL BE BETWEEN INDICES J AND J2
!
  J2=J
40 J2=J2+1
  IF((Y(J2).GT.BLV).AND.(J2.LT.N)) GO TO 40
  !
  !  DMC MAY 1985 - MODIFYING SMALL INTERVAL HANDLING
  !
  !  IF REGION ABOUT TO BE SMOOTHED IS OF WIDTH LESS THAN DELT,
  !  AND CONTAINS NO PTS MORE THAN EPS ABOVE THE BASE LINE,
  !  RESET THE WHOLE REGION TO THE BASELINE RATHER THAN SMOOTHING.
  !
  !X	IF((X(J2)-X(J)).GT.AMIN1(DELT(J),DELT(J2))) GO TO 45
  !X	DO 42 I=J,J2
  !X	ZEPS=EPS(NE)
  !X	IF(I.LT.NE) ZEPS=EPS(I)
  !X	IF(Y(I).GT.(BLV+ZEPS)) GO TO 45
  !X 42	CONTINUE
  !XC  ZERO OUT THE REGION
  !X	DO 43 I=J,J2
  !X 43	Y(I)=BLV
  !X	GO TO 50
  !
45 N2=J2-J+1
  !  SMOOTH IF THERE ARE ENUF DATA PTS.
  IF(N2.LT.2) THEN
    ZEPS=EPS(NE)
    IF(J.LT.NE) ZEPS=EPS(J)
    IF(Y(J).GT.(BLV+ZEPS)) Y(J)=BLV
    GO TO 50
  ENDIF
  !
  Y1A=Y1(J)
  Y1B=Y1(J2)
  IF(Y1(J).LT.BLV) Y1(J)=BLV
  IF(Y1(J2).LT.BLV) Y1(J2)=BLV
  XEND1=ZERO
  XEND2=ZERO
  IF(J.EQ.1) XEND1=XENDA
  IF(J2.EQ.N) XEND2=XENDB
  CALL r8filter(X(J),Y1(J),Y(J),N2,DELT(J),XEND1,XEND2)
  !  IMPLEMENT EPSLON FEATURE --
  JE=J
  IF(JE.GT.NE) JE=NE
  NEL=NE-JE+1
  !
  CALL r8fileps(X(J),Y1(J),Y(J),N2,DELT(J),EPS(JE),NEL, &
       EPS2,NEPS2,XEND1,XEND2)
  Y1(J)=Y1A
  Y1(J2)=Y1B
!
50 J=J2
  GO TO 30
  !
  !  ***EXIT FROM LOOP.  COMPUTE SM
  !
500 CONTINUE
  SM=ZERO
  !  D. MC CUNE JUNE 1980-- PREVENT OVERFLOW ON CALCULTION OF SM
  !     SM NORMALIZED BY 1/(MAX(ABS(Y1(J)))**2
  !
  ZMAX=ZERO
  DO J=1,N
    ZMAX=max(ZMAX,ABS(Y1(J)))
  END DO
  IF(ZMAX.EQ.ZERO) ZMAX=ONE
  !
  DO J=1,N
    DY=(Y(J)-Y1(J))/ZMAX
    IF((IBLF.EQ.0).OR.(Y(J).GT.BLV)) SM=SM+DY*DY
  END DO
  RETURN
END SUBROUTINE r8filtr6
