sll_m_spline_1d.F90

Go to the documentation of this file.

 
 
module sll_m_spline_1d
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#include "sll_assert.h"
 
   use sll_m_working_precision, only: f64
   use sll_m_bsplines_base, only: sll_c_bsplines
 
   implicit none
 
   public :: &
      sll_t_spline_1d
 
   private
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
   integer, parameter :: wp = f64
 
   type :: sll_t_spline_1d
 
      real(wp), allocatable      :: bcoef(:)
      class(sll_c_bsplines), pointer, private :: bspl => null()
 
   contains
 
      procedure :: init => s_spline_1d__init
      procedure :: free => s_spline_1d__free
      procedure :: belongs_to_space => f_spline_1d__belongs_to_space
      procedure :: eval => f_spline_1d__eval
      procedure :: eval_deriv => f_spline_1d__eval_deriv
      procedure :: eval_array => s_spline_1d__eval_array
      procedure :: eval_array_deriv => s_spline_1d__eval_array_deriv
 
   end type sll_t_spline_1d
 
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
contains
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
   !-----------------------------------------------------------------------------
   !-----------------------------------------------------------------------------
   subroutine s_spline_1d__init(self, bsplines)
 
      class(sll_t_spline_1d), intent(out)         :: self
      class(sll_c_bsplines), intent(in), target :: bsplines
 
      ! Store pointer to B-splines
      self%bspl => bsplines
 
      ! Allocate array of spline coefficients: in case of periodic BCs, the last
      ! p coefficients are a periodic copy of the first p ones
      associate(n => bsplines%ncells, p => bsplines%degree)
 
         allocate (self%bcoef(1:n + p))
 
      end associate
 
      ! Set all coefficients to zero
      self%bcoef = 0.0_f64
 
   end subroutine s_spline_1d__init
 
   !-----------------------------------------------------------------------------
   !-----------------------------------------------------------------------------
   subroutine s_spline_1d__free(self)
 
      class(sll_t_spline_1d), intent(inout) :: self
 
      deallocate (self%bcoef)
      nullify (self%bspl)
 
   end subroutine s_spline_1d__free
 
   !-----------------------------------------------------------------------------
   !-----------------------------------------------------------------------------
   sll_pure function f_spline_1d__belongs_to_space(self, bsplines) result(in_space)
 
      class(sll_t_spline_1d), intent(in)         :: self
      class(sll_c_bsplines), intent(in), target :: bsplines
      logical :: in_space
 
      in_space = associated(self%bspl, bsplines)
 
   end function f_spline_1d__belongs_to_space
 
   !-----------------------------------------------------------------------------
   !-----------------------------------------------------------------------------
   sll_pure function f_spline_1d__eval(self, x) result(y)
 
      class(sll_t_spline_1d), intent(in) :: self
      real(wp), intent(in) :: x
      real(wp) :: y
 
      real(wp) :: values(1:self%bspl%degree + 1)
      integer  :: jmin, jmax
 
      call self%bspl%eval_basis(x, values, jmin)
 
      jmax = jmin + self%bspl%degree
 
      y = dot_product(self%bcoef(jmin:jmax), values)
 
   end function f_spline_1d__eval
 
   !-----------------------------------------------------------------------------
   !-----------------------------------------------------------------------------
   sll_pure function f_spline_1d__eval_deriv(self, x) result(y)
 
      class(sll_t_spline_1d), intent(in) :: self
      real(wp), intent(in) :: x
      real(wp) :: y
 
      real(wp) :: derivs(1:self%bspl%degree + 1)
      integer  :: jmin, jmax
 
      call self%bspl%eval_deriv(x, derivs, jmin)
 
      jmax = jmin + self%bspl%degree
 
      y = dot_product(self%bcoef(jmin:jmax), derivs)
 
   end function f_spline_1d__eval_deriv
 
   !-----------------------------------------------------------------------------
   !-----------------------------------------------------------------------------
   sll_pure subroutine s_spline_1d__eval_array(self, x, y)
 
      class(sll_t_spline_1d), intent(in) :: self
      real(wp), intent(in) :: x(:)
      real(wp), intent(out) :: y(:)
 
      integer :: i
 
      sll_assert(size(x) == size(y))
 
      do i = 1, size(x)
         y(i) = f_spline_1d__eval(self, x(i))
      end do
 
   end subroutine s_spline_1d__eval_array
 
   !-----------------------------------------------------------------------------
   !-----------------------------------------------------------------------------
   sll_pure subroutine s_spline_1d__eval_array_deriv(self, x, y)
 
      class(sll_t_spline_1d), intent(in) :: self
      real(wp), intent(in) :: x(:)
      real(wp), intent(out) :: y(:)
 
      integer :: i
 
      sll_assert(size(x) == size(y))
 
      do i = 1, size(x)
         y(i) = f_spline_1d__eval_deriv(self, x(i))
      end do
 
   end subroutine s_spline_1d__eval_array_deriv
 
end module sll_m_spline_1d