! Module  : lin_range_m
! Purpose : define lin_range_t type, representing a linearly distributed
!           range
!
! Copyright 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 lin_range_m

   ! Uses

   use forum_m

   use file_m
   use range_m
   use stat_m

   use ISO_FORTRAN_ENV

   ! No implicit typing

   implicit none

   ! Derived-type definitions

   type, extends(range_t) :: lin_range_t
      private
      real(RD) :: x_0
      real(RD) :: dx
      integer  :: n
   contains
      private
      procedure, public :: get_n
      procedure, public :: get_x_min
      procedure, public :: get_x_max
      procedure, public :: get_ssize
      procedure, public :: unpack
      procedure, public :: subset
      procedure, public :: read
      procedure, public :: write
   end type lin_range_t

   ! Interfaces

   interface lin_range_t
      module procedure lin_range_t_
   end interface lin_range_t

   ! Access specifiers

   private

   public :: lin_range_t
   public :: read
   public :: write

contains

   function lin_range_t_(x_0, dx, n) result(range)

      real(RD), intent(in) :: x_0
      real(RD), intent(in) :: dx
      integer, intent(in)  :: n
      type(lin_range_t)    :: range

      ! Construct range from the supplied data

      @:ASSERT(n >= 1,'insufficient data')

      range%x_0 = x_0
      range%dx = dx

      range%n = n

      ! Finish

      return

   end function lin_range_t_

   !****

   subroutine get_n(self, n)

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

      ! Get the size

      n = self%n

      ! Finish

      return

   end subroutine get_n

   !****

   subroutine get_x_min(self, x_min)

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

      ! Get the x-minimum

      x_min = self%x_0

      ! Finish

      return

   end subroutine get_x_min

   !****

   subroutine get_x_max(self, x_max)

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

      ! Get the x-maximum

      x_max = self%x_0 + self%dx*(self%n-1)

      ! Finish

      return

   end subroutine get_x_max

   !****

   subroutine get_ssize(self, ssize)

      class(lin_range_t), intent(in) :: self
      integer(ID), intent(out)       :: ssize

      ! Get the storage size

      ssize = STORAGE_SIZE(self)/8

      ! Finish

      return

   end subroutine get_ssize

   !****

   subroutine unpack(self, x)

      class(lin_range_t), intent(in) :: self
      real(RD), intent(out)          :: x(:)

      integer :: i

      @:CHECK_BOUNDS(SIZE(x), self%n)

      ! Unpack the range into the array

      do i = 1, self%n
         x(i) = self%x_0 + self%dx*(i-1)
      end do

      ! Finish

      return

   end subroutine unpack

   !****

   subroutine subset(self, i_a, i_b, range, stat)

      class(lin_range_t), intent(in)           :: self
      integer, intent(in)                      :: i_a
      integer, intent(in)                      :: i_b
      class(range_t), allocatable, intent(out) :: range
      integer, intent(out), optional           :: stat
      
      ! Subset the range

      if (i_a < 1) then
         if (PRESENT(stat)) then
            stat = STAT_OUT_OF_BOUNDS_RANGE_LO
            return
         else
            @:ABORT('out of bounds (lo) range')
         end if
      end if

      if (i_b > self%n) then
         if (PRESENT(stat)) then
            stat = STAT_OUT_OF_BOUNDS_RANGE_HI
            return
         else
            @:ABORT('out of bounds (hi) range')
         end if
      end if

      if (i_b < i_a) then
         if (PRESENT(stat)) then
            stat = STAT_INVALID_ARGUMENT
            return
         else
            @:ABORT('invalid argument')
         end if
      end if

      range = lin_range_t(self%x_0+self%dx*(i_a-1), self%dx, i_b-i_a+1)

      ! Finish

      return

   end subroutine subset

   !****

   subroutine read(self, hdf5io, stat)

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

      integer :: revision

      ! Read the range

      call check_type(hdf5io, 'lin_range_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(lin_range_t), intent(out) :: self
         type(hdf5io_t), intent(inout)   :: hdf5io
         integer, intent(out), optional  :: stat

         real(RD) :: x_0
         real(RD) :: dx
         integer  :: n

         call hdf5io%read_attr('x_0', x_0)
         call hdf5io%read_attr('dx', dx)
         call hdf5io%read_attr('n', n)

         select type(self)
         type is (lin_range_t)
            self = lin_range_t(x_0, dx, n)
         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(lin_range_t), intent(in) :: self
      type(hdf5io_t), intent(inout)  :: hdf5io
      integer, intent(out), optional :: stat

      ! Write the range

      call hdf5io%write_attr('TYPE', 'lin_range_t')
      call hdf5io%write_attr('REVISION', 1)
      
      call hdf5io%write_attr('x_0', self%x_0)
      call hdf5io%write_attr('dx', self%dx)
      call hdf5io%write_attr('n', self%n)
     
      ! Finish

      if (PRESENT(stat)) stat = STAT_OK

      return

   end subroutine write

end module lin_range_m
