!******************** START FILE DDROP.FOR ; GROUP FILTR6 ******************
!
!  DDROP   SUBROUTINE TO DROP OUT DATA POINTS THAT DIVERGE
!          TOO FAR FROM THEIR IMMEDIATE NEIGHBOURS, I.E.,
!          TO REMOVE 'SPIKES' FROM THE DATA SIGNAL.
!
!    X AND Y ARE ARRAYS CONTAINING THE ABSCISSAE AND ORDINATES
!    OF THE DATA SIGNAL, RESPECTIVELY, AND N IS THE
!    NUMBER OF DATA POINTS.
!      DDV, IN PHYSICAL UNITS (UNITS OF THE DATA ORDINATES)
!    IS THE DATA DROP CRITERION.  EACH ORDINATE (EXCEPT THE
!    ENDPOINT ORDINATES) IS COMPARED WITH THE VALUE LIN-
!    EARLY INTERPOLATED FROM THE POINT'S TWO IMMEDIATE
!    NEIGHBORS.  IF THE DIFFERENCE IS MORE THAN DDV,  THE
!    ORDINATE IS CONSIDERED A 'SPIKE', ELIGIBLE FOR REMOVAL.
!    IF THE SPIKE IS ISOLATED FROM OTHER SPIKES, SO THAT
!    THE ALGORITHM CAN REASONABLY DISTINGUISH BETWEEN SPIKE
!    AND SIGNAL, THE SPIKE IS REMOVED BY SUBSTITUTING THE
!   LINEARLY INTERPOLATED VALUE.
!
!  IF CONSECUTIVE POINTS VIOLATE THE DDV CRITERION, IT MAY BE
!  THAT THE ENTIRE SIGNAL CONSISTS OF SPIKES, AND NO ACTION
!   WILL BE TAKEN UNLESS BY CORRECTING ONE OF THE ORDINATES,
!  THE ENTIRE SEQUENCE OF VIOLATIONS CAN BE REMOVED (NOTE THAT
!  FOR A SINGLE SPIKE WHICH IS LARGE ENOUGH, A VIOLATION MAY
!  BE DETECTED AT THE SPIKE POINT ITSELF AND ITS IMMEDIATE
!  NEIGHBORS, RESULTING IN THREE CONSECUTIVE VIOLATIONS)
!
!--------------------------------------------------------
!  WRITTEN D. MC CUNE @PPPL   JAN 10 1979
!   REVISED:
!
SUBROUTINE r8ddrop(X,Y,N,DDV,NDROP)
  use iso_c_binding, only: fp => c_double
  use physconst_mod, only: ZERO
  implicit none
  ! Arguments
  integer, intent(in) :: n
  real(fp), dimension(n), intent(in)    :: x
  real(fp), dimension(n), intent(inout) :: y
  real(fp), intent(in) :: ddv
  integer, intent(out) :: ndrop  ! Number of points dropped
  ! Local variables
  integer :: nm1,na1,na2,i,im1,ip1,nv1,j,nv2,nviol,nv,nvc,iv, &
       ncm1,ncp1,nam1,np1
  real(fp) :: ysav,dynew
  real(fp), dimension(5) :: dytes
  !
  !  SET UP
  !
  NDROP=0
  NM1=N-1
  IF(N.LT.3) RETURN
  NA1=1
  NA2=5
  DYTES(1)=ZERO
  DO I=2,5
    DYTES(I)=ZERO
    IF(I.GT.NM1) cycle
    IM1=I-1
    IP1=I+1
    DYTES(I)=Y(I)-YLININ(X(I),X(IM1),Y(IM1),X(IP1),Y(IP1))
  END DO
  !
  !  MAIN LOOP
  !
  !  THE FIVE ELEMENT ARRAY DYTES IS A MOVING 'WINDOW' ON THE
  !  DATA, CONTAINING THE LOCAL 'SPIKE HEIGHT' FOR DATA ORDINATES
  !  NA1 THRU NA2.  WHEN A SPIKE HEIGHT VIOLATION IS DETECTED
  !  AND DETERMINED TO BE ISOLATED FROM OTHER VIOLATIONS THRU THIS
  !  WINDOW, IT IS PROCESSED.  ANY PLACE WHERE FOUR OR MORE
  !  CONSECUTIVE VIOLATIONS OCCUR WILL NOT BE PROCESSED
  !
20 CONTINUE
  !  TEST FOR COMPLETION
  IF(NA1.GE.NM1) GO TO 200
  !  TEST FOR CONTINUATION OF SEQUENCE OF VIOLATIONS TOO LENGTHY
  !  TO CORRECT
  IF(ABS(DYTES(1)).GE.DDV) GO TO 150
  !  LOOK FOR NEW VIOLATION
  DO I=2,4
    IF(ABS(DYTES(I)).GE.DDV) GO TO 40
  END DO
  !  NO VIOLATION FOUND
  GO TO 150
  !  FIND END OF SEQUENCE OF VIOLATIONS (IN WINDOW)
40 CONTINUE
  NV1=NA1+I-1
  DO J=I+1,5
    IF(ABS(DYTES(J)).LT.DDV) GO TO 60
  END DO
  !  END OF SEQUENCE OF VIOLATIONS NOT FOUND
  GO TO 150
  !  END OF SEQUENCE OF VIOLATIONS FOUND; SEQUENCE IS AT MOST
  !  THREE DATA POINTS LONG
60 CONTINUE
  NV2=NA1+J-2
  NVIOL=NV2-NV1+1
  GO TO (70,80,100) NVIOL
  !
  !  ISOLATED (SINGLE POINT) VIOLATION
  !
70 CONTINUE
  Y(NV1)=Y(NV1)-DYTES(I)
  NDROP=NDROP+1
  DYTES(I)=ZERO
  GO TO 150
  !
  !  VIOLATEION INVOLVING TWO CONSECUTIVE DATA POINTS
  !
80 CONTINUE
  NV=NV1
  NVC=NV2
  IV=I
  IF(ABS(DYTES(I+1)).LT.ABS(DYTES(I))) GO TO 90
  NV=NV2
  NVC=NV1
  IV=I+1
  !
90 CONTINUE
  !  APPLY CORRECTION FOR LARGER VIOLATION ONLY IF THIS
  !  ALSO REMOVES THE VIOLATION FOR THE OTHER POINT AS WELL
  !
  YSAV=Y(NV)
  Y(NV)=Y(NV)-DYTES(IV)
  NCM1=NVC-1
  NCP1=NVC+1
  DYNEW=Y(NVC)-YLININ(X(NVC),X(NCM1),Y(NCM1),X(NCP1),Y(NCP1))
  IF(ABS(DYNEW).GE.DDV) Y(NV)=YSAV
  IF(Y(NV).EQ.YSAV) GO TO 150
  NDROP=NDROP+1
  DYTES(I)=ZERO
  DYTES(I+1)=ZERO
  GO TO 150
  !
  !  VIOLATION INVOLVING THREE CONSECUTIVE DATA POINTS
  !  TRY CORRECTING MIDDLE VIOLATING POINT ONLY AND
  !  APPLY ONLY IF THIS REMOVES THE VIOLATION FOR ALL THREE
  !  POINTS
  !
100 CONTINUE
  NV=NV1+1
  IV=I+1
  YSAV=Y(NV)
  Y(NV)=Y(NV)-DYTES(IV)
  NCM1=NV1-1
  NCP1=NV2+1
  DYNEW=Y(NV1)-YLININ(X(NV1),X(NCM1),Y(NCM1),X(NV),Y(NV))
  IF(ABS(DYNEW).GE.DDV) Y(NV)=YSAV
  DYNEW=Y(NV2)-YLININ(X(NV2),X(NV),Y(NV),X(NCP1),Y(NCP1))
  IF(ABS(DYNEW).GE.DDV) Y(NV)=YSAV
  IF(YSAV.EQ.Y(NV)) GO TO 150
  NDROP=NDROP+1
  DO J=I,I+2
    DYTES(J)=ZERO
  END DO
  GO TO 150
  !
  !  END OF MAIN LOOP ... ADVANCE WINDOW
  !
150 CONTINUE
  NA1=NA1+1
  DO I=1,4
    DYTES(I)=DYTES(I+1)
  END DO
  DYTES(5)=ZERO
  NA2=NA1+4
  NAM1=NA2-1
  NP1=NA2+1
  IF(NA2.LE.NM1) &
       DYTES(5)=Y(NA2)-YLININ(X(NA2),X(NAM1),Y(NAM1),X(NP1),Y(NP1))
  GO TO 20
  !
  !  LOOP EXIT ***
  !
200 CONTINUE
  RETURN

contains

  real(fp) function ylinin(xx,x1,y1,x2,y2)
    use iso_c_binding, only: fp => c_double
    implicit none
    real(fp), intent(in) :: xx,x1,y1,x2,y2
    ylinin = y1 + (xx-x1)*(y2-y1)/(x2-x1)
    return
  end function ylinin

END SUBROUTINE r8ddrop
