!fpx3_header(0.13_3a)
!
!dependencies
!   dir: ~/devel/gyre-4/src/utils 
!   sources: -
!   includes: ../extern/core/core.inc
!   uses: core_order core_parallel core_kinds ISO_FORTRAN_ENV
!   provides: gyre_cocache
!end dependencies
!
!end fpx3_header
! Module   : gyre_cocache
! Purpose  : coefficients cache
!
! Copyright 2013 Rich Townsend
!
! This file is part of GYRE. GYRE is free software: you can
! redistribute it and/or modify it under the terms of the GNU General
! Public License as published by the Free Software Foundation, version 3.
!
! GYRE is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
! License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program.  If not, see <http://www.gnu.org/licenses/>.

! Incfile  : core
! Purpose  : fpx3 macros

!****

!****

!****

!****

!****

!****

!****

!****

!****

module gyre_cocache

  ! Uses

  use core_kinds
  use core_parallel
  use core_order

  use ISO_FORTRAN_ENV

  ! No implicit typing

  implicit none

  ! Derived-type definitions

  type :: cocache_t
     private
     real(WP), allocatable :: x(:)
     real(WP), allocatable :: c(:,:)
     integer               :: n
     integer               :: n_c
   contains
     private
     procedure, public :: lookup => lookup_
  end type cocache_t

  ! Interfaces

  interface cocache_t
     module procedure cocache_t_
  end interface cocache_t

  ! Access specifiers

  private

  public :: cocache_t

contains

  function cocache_t_ (x, c) result (cc)

    real(WP), intent(in) :: x(:)
    real(WP), intent(in) :: c(:,:)
    type(cocache_t)      :: cc

    integer, allocatable :: i(:)

  if(SIZE(c, 2)/= SIZE(x)) then
    write(UNIT=ERROR_UNIT, FMT=*) 'SIZE(c, 2) :', SIZE(c, 2)
    write(UNIT=ERROR_UNIT, FMT=*) 'SIZE(x) :', SIZE(x)
    write(UNIT=ERROR_UNIT, FMT=*) 'CHECK_BOUNDS SIZE(c, 2)==SIZE(x) failed at line 78 <gyre_cocache:cocache_t_>'
    stop
  endif

    ! Construct the cocache_t

    i = unique_indices(x)

    cc%x = x(i)
    cc%c = c(:,i)

    cc%n = SIZE(i)
    cc%n_c = SIZE(c, 1)

    ! Finish

    return

  end function cocache_t_

!****

!****

  function lookup_ (this, j, x) result (c)

    class(cocache_t), intent(in) :: this
    integer, intent(in)          :: j
    real(WP), intent(in)         :: x
    real(WP)                     :: c

    integer :: k

    if(.NOT. (j >= 1)) then
      write(UNIT=ERROR_UNIT, FMT=*) 'ASSERT ''j >= 1'' failed at line 132 <gyre_cocache:lookup_>:'
      write(UNIT=ERROR_UNIT, FMT=*) 'Invalid index'
      stop
    endif

    if(.NOT. (j <= this%n_c)) then
      write(UNIT=ERROR_UNIT, FMT=*) 'ASSERT ''j <= this%n_c'' failed at line 133 <gyre_cocache:lookup_>:'
      write(UNIT=ERROR_UNIT, FMT=*) 'Invalid index'
      stop
    endif

    ! Find where x falls in the cache

    call locate_(this%x, x, k)

    ! Lookup the coeff

    c = this%c(j,k)

    ! Finish

    return

  contains

    subroutine locate_ (x, x_loc, i_loc)

      real(WP), intent(in) :: x(:)
      real(WP), intent(in) :: x_loc
      integer, intent(out) :: i_loc

      integer       :: n
      integer, save :: i_lo
      integer, save :: i_hi
      integer       :: di
      integer       :: i_mid

      !$OMP THREADPRIVATE (i_lo, i_hi)

      ! Use a binary search to find where x_loc falls in x (assumed to
      ! be in ascending order); x(i_loc) == x_loc

      n = SIZE(x)

      if(x_loc == x(n)) then

         i_loc = n

      elseif(x_loc == x(1)) then

         i_loc = 1

      else

         if(i_lo < 1 .OR. i_lo >= n) then

            i_lo = 0
            i_hi = n+1

         else

            di = 1

            if(x_loc >= x(i_lo)) then

               search_up_loop : do

                  i_hi = i_lo + di

                  if(i_hi > n) then
                     i_hi = n + 1
                     exit search_up_loop
                  endif

                  if(x_loc < x(i_hi)) exit search_up_loop

                  i_lo = i_hi
                  di = 2*di

               end do search_up_loop

            else

               search_down_loop : do

                  i_hi = i_lo
                  i_lo = i_hi - di

                  if(i_lo < 1) then
                     i_lo = 0
                     exit search_down_loop
                  endif

                  if(x_loc >= x(i_lo)) exit search_down_loop

               end do search_down_loop

            endif

         endif

         refine_loop : do

            if(i_hi-i_lo <= 1) exit refine_loop

            i_mid = (i_hi + i_lo)/2

            if(x_loc >= x(i_mid)) then
               i_lo = i_mid
            else
               i_hi = i_mid
            endif

         end do refine_loop

         i_loc = i_lo

      endif

    if(.NOT. (x(i_loc) == x_loc)) then
      write(UNIT=ERROR_UNIT, FMT=*) 'ASSERT ''x(i_loc) == x_loc'' failed at line 243 <gyre_cocache:lookup_:locate_>:'
      write(UNIT=ERROR_UNIT, FMT=*) 'Value not found in cache'
      stop
    endif

      ! Finish

      return

    end subroutine locate_

  end function lookup_

end module gyre_cocache
