! Module  : axis_m
! Purpose : define axis_t type, representing a grid axis
!
! Copyright 2021-2022 Rich Townsend & The MSG Team
!
! This file is part of MSG. MSG 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.
!
! MSG 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/>.

#:include 'forum.inc'

module axis_m

   ! Uses

   use forum_m, locate_ => locate

   use file_m
   use stat_m

   use ISO_FORTRAN_ENV

   ! No implicit typing

   implicit none

   ! Parameter definitions

   integer, parameter :: LABEL_LEN = 16

   ! Derived-type definitions

   type axis_t
      private
      real(RD), allocatable :: x(:)
      integer               :: n
      character(LABEL_LEN)  :: label
   contains
      private
      procedure, public :: get_n
      procedure, public :: get_x_min
      procedure, public :: get_x_max
      procedure, public :: get_label
      procedure, public :: fetch
      procedure, public :: locate
      procedure, public :: read
      procedure, public :: write
   end type axis_t

   ! Interfaces

   interface axis_t
      module procedure axis_t_
   end interface axis_t

   ! Access specifiers

   private

   public :: LABEL_LEN
   public :: axis_t

   ! Procedures

contains

   function axis_t_(x, label) result (ax)

      real(RD), intent(in)     :: x(:)
      character(*), intent(in) :: label
      type(axis_t)             :: ax

      integer :: n

      ! Construct axis from the supplied data

      n = SIZE(x)

      @:ASSERT(n > 0,'insufficient data')

      ax%x = x

      ax%n = n

      ax%label = label

      ! Finish

      return

   end function axis_t_

   !****

   subroutine get_n(self, n)

      class(axis_t), intent(in) :: self
      integer, intent(out)      :: n

      ! Get the axis length

      n = self%n

      ! Finish

      return

   end subroutine get_n

   !****

   subroutine get_x_min(self, x_min)

      class(axis_t), intent(in) :: self
      real(RD), intent(out)     :: x_min

      ! Get the axis minimum

      x_min = self%x(1)

      ! Finish

      return

   end subroutine get_x_min

   !****

   subroutine get_x_max(self, x_max)

      class(axis_t), intent(in) :: self
      real(RD), intent(out)     :: x_max

      ! Get the axis maximum

      x_max = self%x(self%n)

      ! Finish

      return

   end subroutine get_x_max

   !****

   subroutine get_label(self, label)

      class(axis_t), intent(in) :: self
      character(*), intent(out) :: label

      ! Get the axis label

      label = self%label

      ! Finish

      return

   end subroutine get_label

   !****

   subroutine fetch(self, i, x, stat)

      class(axis_t), intent(in)      :: self
      integer, intent(in)            :: i
      real(RD), intent(out)          :: x
      integer, intent(out), optional :: stat

      ! Fetch an x value

      if (i < 1) then
         if (PRESENT(stat)) then
            stat = STAT_OUT_OF_BOUNDS_AXIS_LO
            return
         else
            @:ABORT('out-of-bounds (lo) on '//self%label//' axis')
         endif
      endif

      if (i > self%n) then
         if (PRESENT(stat)) then
            stat = STAT_OUT_OF_BOUNDS_AXIS_HI
            return
         else
            @:ABORT('out-of-bounds (hi) on '//self%label//' axis')
         endif
      endif

      x = self%x(i)

      ! Finish

      return

   end subroutine fetch

   !****

   subroutine locate(self, x, i)

      class(axis_t), intent(in) :: self
      real(RD), intent(in)      :: x
      integer, intent(inout)    :: i

      ! Locate where along axis x falls

      call locate_(self%x, x, i)

      ! Finish

      return

   end subroutine locate

   !****

   subroutine read(self, hdf5io, stat)

      class(axis_t), intent(out)     :: self
      type(hdf5io_t), intent(inout)  :: hdf5io
      integer, intent(out), optional :: stat

      integer :: revision

      ! Read the axis

      call check_type(hdf5io, 'axis_t', stat)
      if (PRESENT(stat)) then
         if (stat /= STAT_OK) return
      end if

      call hdf5io%read_attr('REVISION', revision)

      select case(revision)
      case(1)
         call read_rev1_(self, hdf5io, stat)
      case default
         if (PRESENT(stat)) then
            stat = STAT_INVALID_GROUP_REVISION
            return
         else
            @:ABORT('invalid group revision')
         end if
      end select

      ! Finish

      return

   contains

      subroutine read_rev1_(self, hdf5io, stat)

         class(axis_t), intent(out)     :: self
         type(hdf5io_t), intent(inout)  :: hdf5io
         integer, intent(out), optional :: stat

         character(LABEL_LEN)  :: label
         real(RD), allocatable :: x(:)

         call hdf5io%read_attr('label', label)

         call hdf5io%alloc_read_dset('x', x)

         select type(self)
         type is(axis_t)
            self = axis_t(x, label)
         class default
            @:ABORT('invalid type')
         end select

         if (PRESENT(stat)) stat = STAT_OK

         return

      end subroutine read_rev1_

   end subroutine read

   !****

   subroutine write(self, hdf5io, stat)

      class(axis_t), intent(in)      :: self
      type(hdf5io_t), intent(inout)  :: hdf5io
      integer, intent(out), optional :: stat

      ! Write axis

      call hdf5io%write_attr('TYPE', 'axis_t')
      call hdf5io%write_attr('REVISION', 1)

      call hdf5io%write_attr('label', self%label)

      call hdf5io%write_dset('x', self%x)

      ! Finish

      if (PRESENT(stat)) stat = STAT_OK

      return

   end subroutine write

end module axis_m
