module utils

  use const_and_precisions, only : wp_

  implicit none

contains

  function locatef(a,n,x) result(j)
! Given an array a(n), and a value x, with a(n) monotonic, either
! increasing or decreasing, returns a value j such that
! a(j) < x <= a(j+1) for a increasing, and such that
! a(j+1) < x <= a(j) for a decreasing.
! j=0 or j=n  indicate that x is out of range  (Numerical Recipes)
    integer, intent(in) :: n
    real(wp_), dimension(n), intent(in) :: a
    real(wp_), intent(in) :: x
    integer :: j
    integer :: jl,ju,jm
    logical :: incr
    jl=0
    ju=n+1
    incr=a(n)>a(1)
    do while ((ju-jl)>1)
      jm=(ju+jl)/2
      if(incr.eqv.(x>a(jm))) then
        jl=jm
      else
        ju=jm
      endif
    end do
    j=jl
  end function locatef

  subroutine locate(xx,n,x,j)
    integer, intent(in) :: n
    real(wp_), intent(in) :: xx(n), x
    integer, intent(out) :: j
    integer :: jl,ju,jm
    logical :: incr
!
! Given an array xx(n), and a value x
! returns a value j such that xx(j) < x < xx(j+1)
! xx(n) must be monotonic, either increasing or decreasing.
! j=0 or j=n  indicate that x is out of range  (Numerical Recipes)
!
    jl=0
    ju=n+1
    incr=xx(n)>xx(1)
    do while ((ju-jl)>1)
      jm=(ju+jl)/2
      if(incr .eqv. (x>xx(jm))) then
        jl=jm
      else
        ju=jm
      endif
    end do
    j=jl
  end subroutine locate

  subroutine locatex(xx,n,n1,n2,x,j)
    integer, intent(in) :: n,n1,n2
    real(wp_), intent(in) :: xx(n), x
    integer, intent(out) :: j
    integer :: jl,ju,jm
!
! Given an array xx(n), and a value x
! returns a value j such that xx(j) < x < xx(j+1)
! xx(n) must be monotonic, either increasing or decreasing.
! j=n1-1or j=n2+1 indicate that x is out of range
! modified from subr. locate (Numerical Recipes)
!
    jl=n1-1
    ju=n2+1
    do while ((ju-jl)>1)
      jm=(ju+jl)/2
      if((xx(n2)>xx(n1)) .eqv. (x>xx(jm))) then
        jl=jm
      else
        ju=jm
      endif
    end do
    j=jl
  end subroutine locatex


  subroutine locate_unord(array, value, locs, n, nlocs)
    ! Given an `array` of size `n` and a `value`, finds at most
    ! `n` locations `locs` such that `value` is between
    ! `array(locs(i))` and `array(locs(i+i))`, in whichever order.

    ! subroutine arguments
    real(wp_), intent(in)    :: array(:)
    real(wp_), intent(in)    :: value
    integer,   intent(inout) :: locs(n)
    integer,   intent(in)    :: n
    integer,   intent(out)   :: nlocs

    ! local variables
    integer :: i
    logical :: larger_than_last

    nlocs = 0
    if (size(array) < 2) return

    larger_than_last = value > array(1)
    do i = 2, size(array)
      ! Note: the condition is equivalent to
      ! (array(i-1) < value < array(i))
      ! .or. (array(i) < value < array(i-1))
      if (array(i) < value .neqv. larger_than_last) then
        larger_than_last = value > array(i)
        nlocs = nlocs + 1
        if (nlocs <= n) locs(nlocs) = i - 1
      end if
    end do
  end subroutine locate_unord


  function intlinf(x1,y1,x2,y2,x) result(y)
    !linear interpolation
    !must be x1 != x2
    use const_and_precisions, only : one
    real(wp_),intent(in) :: x1,y1,x2,y2,x
    real(wp_) :: y
    real(wp_) :: a
    a=(x2-x)/(x2-x1)
    y=a*y1+(one-a)*y2
  end function intlinf

  subroutine intlin(x1,y1,x2,y2,x,y)
    real(wp_), intent(in) :: x1,y1,x2,y2,x
    real(wp_), intent(out) :: y
    real(wp_) :: dx,aa,bb
!
! linear interpolation
! (x1,y1) < (x,y) < (x2,y2)
!
    dx=x2-x1
    aa=(x2-x)/dx
    bb=1.0_wp_-aa
    y=aa*y1+bb*y2
  end subroutine intlin

  subroutine vmax(x,n,xmax,imx)
    integer, intent(in) :: n
    real(wp_), intent(in) :: x(n)
    real(wp_), intent(out) :: xmax
    integer, intent(out) :: imx
    integer :: i

    if (n<1) then
      imx=0
      return
    end if
    imx=1
    xmax=x(1)
    do i=2,n
      if(x(i)>xmax) then
        xmax=x(i)
        imx=i
      end if
    end do
  end subroutine vmax

  subroutine vmin(x,n,xmin,imn)
    integer, intent(in) :: n
    real(wp_), intent(in) :: x(n)
    real(wp_), intent(out) :: xmin
    integer, intent(out) :: imn
    integer :: i

    if (n<1) then
      imn=0
      return
    end if
    imn=1
    xmin=x(1)
    do i=2,n
      if(x(i)<xmin) then
        xmin=x(i)
        imn=i
      end if
    end do
  end subroutine vmin

  subroutine vmaxmini(x,n,xmin,xmax,imn,imx)
    integer, intent(in) :: n
    real(wp_), intent(in) :: x(n)
    real(wp_), intent(out) :: xmin, xmax
    integer, intent(out) :: imn, imx
    integer :: i
    if (n<1) then
      imn=0
      imx=0
      return
    end if
    imn=1
    imx=1
    xmin=x(1)
    xmax=x(1)
    do i=2,n
      if(x(i)<xmin) then
        xmin=x(i)
        imn=i
      else if(x(i)>xmax) then
        xmax=x(i)
        imx=i
      end if
    end do
  end subroutine vmaxmini

  subroutine vmaxmin(x,n,xmin,xmax)
    integer, intent(in) :: n
    real(wp_), intent(in) :: x(n)
    real(wp_), intent(out) :: xmin, xmax
    integer :: i

    if (n<1) then
      return
    end if
    xmin=x(1)
    xmax=x(1)
    do i=2,n
      if(x(i)<xmin) then
        xmin=x(i)
      else if(x(i)>xmax) then
        xmax=x(i)
      end if
    end do
  end subroutine vmaxmin

  subroutine order(p,q)
! returns p,q in ascending order
    real(wp_), intent(inout) :: p,q
    real(wp_) :: temp
    if (p>q) then
      temp=p
      p=q
      q=temp
    end if
  end subroutine order

  subroutine bubble(a,n)
! bubble sorting of array a
    integer, intent(in) :: n
    real(wp_), dimension(n), intent(inout) :: a
    integer :: i, j
    do i=1,n
      do j=n,i+1,-1
        call order(a(j-1), a(j))
      end do
    end do
  end subroutine bubble


  subroutine range2rect(xmin, xmax, ymin, ymax, x, y)
    ! Given two ranges [xmin, xmax], [ymin, ymax] builds
    ! the x and y vertices of the following rectangle:
    !
    !  (xmin, ymax)╔═════╗(xmax, ymax)
    !              ║4   3║
    !              ║     ║
    !              ║1   2║
    !  (xmin, ymin)╚═════╝(xmin, ymax)
    !

    ! subroutine arguments
    real(wp_), intent(in) :: xmin, xmax, ymin, ymax
    real(wp_), intent(out), dimension(5) :: x, y

    x = [xmin, xmax, xmax, xmin, xmin]
    y = [ymin, ymin, ymax, ymax, ymin]
  end subroutine range2rect


  function inside(vertx, verty, x0, y0)
    ! Tests whether the point (`x0`, `y0`) lies inside the
    ! simple polygon of vertices `vertx`, `verty`.


    ! subroutine arguments
    real(wp_), dimension(:), intent(in) :: vertx, verty
    real(wp_),               intent(in) :: x0, y0
    logical                             :: inside

    ! local variables
    integer   :: seg(size(vertx))
    real(wp_) :: x, vertx_(size(vertx)+1), verty_(size(vertx)+1)
    integer   :: i, nsegs, n

    ! Ensure the first and last point are the same
    n = size(vertx)
    vertx_(1:n) = vertx(1:n)
    verty_(1:n) = verty(1:n)
    vertx_(n+1) = vertx(1)
    verty_(n+1) = verty(1)

    inside = .false.

    ! Find the `nsegs` segments that intersect the horizontal
    ! line y=y0, i.e. `verty(seg(i)) < y < verty(seg(i)+1)`
    call locate_unord(verty_, y0, seg, n, nsegs)

    ! No intersections, it must be outside (above or below)
    if (nsegs == 0) return

    ! Count the number of intersections that lie to the left
    ! (equivalently, to the right) of the point. An even number
    ! means that the point is outside the polygon.
    do i = 1, nsegs
      ! coordinate of the intersection between segment and y=y0
      x = intlinf(verty_(seg(i)), vertx_(seg(i)), &
                  verty_(seg(i)+1), vertx_(seg(i)+1), y0)
      if (x < x0) inside = .not. inside
    end do
  end function inside


  function get_free_unit(unit) result(i)
    ! Returns `unit` back or the first free unit
    ! number `i` if `unit` is absent.
    ! When no unit is available, returns -1.

    ! function arguments
    integer :: i
    integer, intent(in), optional :: unit

    ! local variables
    integer, parameter :: max_allowed = 999
    integer :: error
    logical :: ex, op

    if (present(unit)) then
      i = unit
      return
    end if

    do i=0,max_allowed
      inquire(unit=i, exist=ex, opened=op, iostat=error)
      ! if unit i exists and is free
      if (error == 0 .and. ex .and. .not. op) return
    end do
    i = -1

  end function get_free_unit


  function dirname(filepath) result(directory)
    ! Get the parent `directory` of `filepath`

    ! function arguments
    character(*), intent(in)  :: filepath
    character(:), allocatable :: directory

    ! local variables
    character(255) :: cwd
    integer :: last_sep

    last_sep = scan(filepath, '/', back=.true.)
    directory = filepath(1:last_sep)

    ! append the cwd to relative paths
    if (isrelative(filepath)) then
      call getcwd(cwd)
      directory = trim(cwd) // '/' // directory
    end if
  end function dirname


  function isrelative(filepath)
    ! Check if `filepath` is a relative or an absolute path

    ! function arguments
    character(*), intent(in)  :: filepath
    logical :: isrelative

    isrelative = (filepath(1:1) /= '/')
  end function isrelative

end module utils