! Module  : limb_photint_m
! Purpose : Define limb_photint_t type, for representing photometric
!           intensity parameterized by a limb-darkening law
!
! 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 limb_photint_m

   ! Uses

   use forum_m

   use file_m
   use limb_m
   use math_m
   use photint_m
   use stat_m

   use ISO_FORTRAN_ENV

   ! No implicit typing

   implicit none

   ! Derived-type definitions

   type, extends(photint_t) :: limb_photint_t
      private
      type(limb_t)          :: limb
      real(RD), allocatable :: c(:)
      integer               :: n_b
      logical               :: precise
   contains
      private
      procedure, public :: get_precise
      procedure, public :: get_ssize
      #:for name in ('intensity', 'E_moment', 'D_moment', 'flux')
         procedure, public :: interp_${name}$
      #:endfor
      procedure, public :: read
      procedure, public :: write
   end type limb_photint_t

   ! Interfaces

   interface limb_photint_t
      module procedure limb_photint_t_
      module procedure limb_photint_t_fit_
   end interface limb_photint_t

   ! Access specifiers

   private

   public :: limb_photint_t

   ! Procedures

contains

   function limb_photint_t_(c, limb, precise) result(photint)

      real(RD), intent(in)          :: c(:)
      type(limb_t), intent(in)      :: limb 
      logical, intent(in), optional :: precise
      type(limb_photint_t)          :: photint

      logical :: precise_
      integer :: n_b

      if (PRESENT(precise)) then
         precise_ = precise
      else
         precise_ = .TRUE.
      end if

      ! Construct photint from the supplied data

      call limb%get_n(n_b)

      @:CHECK_BOUNDS(SIZE(c), n_b)

      photint%limb = limb
      photint%c = c

      photint%n_b = n_b

      photint%precise = precise_
      
      ! Finish

      return

   end function limb_photint_t_

   !****

   function limb_photint_t_fit_(I, mu, limb, precise) result(photint)

      real(RD), intent(in)          :: I(:)
      real(RD), intent(in)          :: mu(:)
      type(limb_t), intent(in)      :: limb
      logical, intent(in), optional :: precise
      type(limb_photint_t)          :: photint

      real(RD), allocatable :: c(:)

      ! Construct photint by fitting the supplied I(mu)
      ! intensity data

      call limb%fit_intensity(I, mu, c)

      photint = limb_photint_t(c, limb, precise)

      ! Finish

      return

   end function limb_photint_t_fit_

   !****

   subroutine get_precise(self, precise)

      class(limb_photint_t), intent(in) :: self
      logical, intent(out)              :: precise

      ! Get the precision flag

      precise = self%precise

      ! Finish

      return

   end subroutine get_precise

   !****

   subroutine get_ssize(self, ssize)

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

      integer(ID) :: ssize_limb

      ! Get the storage size

      call self%limb%get_ssize(ssize_limb)
      
      ssize = STORAGE_SIZE(self)/8 +                 &
              STORAGE_SIZE(self%c)/8*SIZE(self%c) +  &
              ssize_limb

      ! Finish

      return

   end subroutine get_ssize

   !****

   #:for name, arg_var, arg_type in (('intensity', 'mu', 'real(RD)'), &
                                     ('E_moment', 'k', 'integer'), &
                                     ('D_moment', 'l', 'integer'))

      subroutine interp_${name}$(self, ${arg_var}$, res, stat)

         class(limb_photint_t), intent(in) :: self
         ${arg_type}$, intent(in)          :: ${arg_var}$
         real(RD), intent(out)             :: res
         integer, intent(out), optional    :: stat

         real(RD) :: b(self%n_b)

         ! Set up the basis functions

         call self%limb%eval_${name}$_basis(${arg_var}$, b, stat)
         if (PRESENT(stat)) then
            if (stat /= STAT_OK) return
         endif

         ! Interpolate ${name}$

         res = DOT_PRODUCT(b, self%c)

         if (PRESENT(stat)) stat = STAT_OK

         ! Finish

         return

      end subroutine interp_${name}$

   #:endfor
      
   !****

   #:for name in ('flux',)

      subroutine interp_${name}$(self, res, stat)

         class(limb_photint_t), intent(in) :: self
         real(RD), intent(out)             :: res
         integer, intent(out), optional    :: stat

         real(RD) :: b(self%n_b)

         ! Set up the basis functions

         call self%limb%eval_${name}$_basis(b, stat)
         if (PRESENT(stat)) then
            if (stat /= STAT_OK) return
         endif

         ! Interpolate ${name}$

         res = DOT_PRODUCT(b, self%c)

         if (PRESENT(stat)) stat = STAT_OK

         ! Finish

         return

      end subroutine interp_${name}$

   #:endfor

   !****

   subroutine read(self, hdf5io, stat)

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

      integer :: revision

      ! Read the limb_photint_t

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

         logical               :: precise
         real(RD), allocatable :: c(:)
         type(hdf5io_t)        :: hdf5io_limb
         type(limb_t)          :: limb

         call hdf5io%read_attr('precise', precise)

         call hdf5io%alloc_read_dset('c', c)

         hdf5io_limb = hdf5io_t(hdf5io, 'limb')
         call limb%read(hdf5io_limb, stat)
         call hdf5io_limb%final()
         if (PRESENT(stat)) then
            if (stat /= STAT_OK) return
         end if

         select type(self)
         type is(limb_photint_t)
            self = limb_photint_t(c, limb, precise)
         class default
            @:ABORT('incalid type')
         end select

         if (PRESENT(stat)) stat = STAT_OK

         return

      end subroutine read_rev1_

   end subroutine read

   !****

   subroutine write(self, hdf5io, stat)

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

      type(hdf5io_t) :: hdf5io_limb

      ! Write the limb_photint_t

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

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

      if (self%precise) then
         call hdf5io%write_dset('c', REAL(self%c, RD))
      else
         call hdf5io%write_dset('c', REAL(self%c, RS))
      endif

      hdf5io_limb = hdf5io_t(hdf5io, 'limb')
      call self%limb%write(hdf5io_limb, stat)
      call hdf5io_limb%final()
      if (PRESENT(stat)) then
         if (stat /= STAT_OK) return
      end if

      ! Finish

      if (PRESENT(stat)) stat = STAT_OK

      return

   end subroutine write

end module limb_photint_m
