!# This source file is part of code Pégase.3.0.1 (2019-02-21).
!# Copyright: Michel Fioc (Michel.Fioc@iap.fr), Sorbonne université, 
!# Institut d'astrophysique de Paris/CNRS, France.
!# 
!# Pégase.3.0.1 is governed by the CeCILL license under French law and abides 
!# by the rules of distribution of free software. You can use, modify and/or 
!# redistribute this software under the terms of the CeCILL license as circulated 
!# by CEA, CNRS and INRIA at "http://www.cecill.info". The text of this license
!# is also available in French and in English in directory "doc_dir/" of this
!# code.
!# 
!# As a counterpart to the access to the source code and to the rights to copy,
!# modify and redistribute it granted by the license, users are provided only
!# with a limited warranty, and the software's author, the holder of the
!# economic rights, and the successive licensors have only limited
!# liability. 
!# 
!# The fact that you are presently reading this means that you have had
!# knowledge of the CeCILL license and that you accept its terms.
!#====================================================================== 

module mod_intersperse

  private
  public :: intersperse

contains

!#======================================================================
!# Given two arrays, `x1` and `x2`, of size `n1` and `n2`, ordered by
!# increasing values, `intersperse` intersperses in `x1` all the values
!# of `x2` unless they are too close to one of `x1` (see parameter `eps`).

  subroutine intersperse(n1, n2, x1, x2, eps)

    use mod_types
    implicit none
    integer, intent(inout) :: n1
    integer, intent(in) :: n2
    real(CDR), dimension(:), pointer :: x1
    real(CDR), dimension(:), intent(in) :: x2
    real(CDR), intent(in), optional :: eps
!#......................................................................
    integer :: n
    real(CDR), dimension(size(x1)+size(x2)) :: x
    integer :: i1, i2
    real(CDR) :: eps_eff
!#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

    if (present(eps)) then
       eps_eff = eps
    else
       eps_eff = 0
    endif

    n = 1
    if (x1(1) <= x2(1)) then
       x(n) = x1(1)
       i1 = 2
       i2 = 1
    else
       x(n) = x2(1)
       i1 = 1
       i2 = 2
    endif
    do
       if (i2 > n2) then
          if (i1 > n1) exit
          if (x1(i1)-x(n) > eps_eff*x(n)) then
             n = n+1
             x(n) = x1(i1)
          endif
          i1 = i1+1
       else if (i1 > n1) then
          if (x2(i2)-x(n) > eps_eff*x(n)) then
             n = n+1
             x(n) = x2(i2)
          endif
          i2 = i2+1
       else
          if (x1(i1) <= x2(i2)) then
             if (x1(i1)-x(n) > eps_eff*x(n)) then
                n = n+1
                x(n) = x1(i1)
             endif
             i1 = i1+1
          else
             if (x2(i2)-x(n) > eps_eff*x(n)) then
                n = n+1
                x(n) = x2(i2)
             endif
             i2 = i2+1
          endif
       endif
    enddo

    n1 = n
    deallocate(x1)
    allocate(x1(n1))
    x1(1:n1) = x(1:n)

  end subroutine intersperse

end module mod_intersperse
