sll_m_rectangle_integration.F90

Go to the documentation of this file.

 
module sll_m_rectangle_integration
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#include "sll_working_precision.h"
 
   implicit none
 
   public :: &
      sll_o_rectangle_integrate_1d
 
   private
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
#ifndef DOXYGEN_SHOULD_SKIP_THIS
   abstract interface
 
      function function_1d(x)
         use sll_m_working_precision ! can't pass a header file because the
         ! preprocessor prevents double inclusion.
         ! This is very rare.
         sll_real64             :: function_1d
         sll_real64, intent(in) :: x
      end function function_1d
   end interface
#endif
 
   interface sll_o_rectangle_integrate_1d
      module procedure rectangle_integral_1d
   end interface
 
contains
 
   function rectangle_integral_1d(f, x, n)
      sll_real64                :: rectangle_integral_1d
      procedure(function_1d)    :: f
      sll_int32, intent(in)    :: n
      sll_real64, dimension(n)  :: x
      sll_int32                 :: k
      sll_real64                :: ans
 
      ans = 0.0_f64
      do k = 1, n - 1
         ans = ans + f(x(k))*(x(k + 1) - x(k))
      end do
      rectangle_integral_1d = ans
 
   end function rectangle_integral_1d
 
   function rectangle_weights(n, x) result(w)
      sll_int32, intent(in)           :: n
      sll_real64, dimension(n)         :: x
      sll_real64, dimension(n)         :: w
      sll_int32                        :: k
 
      do k = 1, n - 1
         w(k) = x(k + 1) - x(k)
      end do
      w(n) = 0.0_f64
 
   end function rectangle_weights
 
end module sll_m_rectangle_integration