fMathClass.f90 Source File

module fMathClass
   use iso_c_binding

   implicit none

   !type(c_ptr) :: pa
   !integer(c_int)::n

   interface
      subroutine testc(pa) bind(c)
         use iso_c_binding
         type(c_ptr):: pa
      end subroutine testc
   end interface

   interface
      subroutine addValVec(pa, n, i, val_in) bind(c)
         use iso_c_binding
         type(c_ptr):: pa
         integer(c_int), value:: i
         integer(c_int), value:: n
         real(c_double), value::val_in

      end subroutine addValVec
   end interface

   interface
      subroutine putValVec(pa, n, i, val_in) bind(c)
         use iso_c_binding
         type(c_ptr):: pa
         integer(c_int), value:: i
         integer(c_int), value:: n
         real(c_double), value::val_in

      end subroutine putValVec
   end interface

   interface
      subroutine setZeroVec(pa, n) bind(c)
         use iso_c_binding
         type(c_ptr):: pa
         integer(c_int), value:: n

      end subroutine setZeroVec
   end interface

   interface
      subroutine initVec(pa, n) bind(c)
         use iso_c_binding
         type(c_ptr):: pa
         integer(c_int), value:: n

      end subroutine initVec
   end interface

   interface
      subroutine c_allocatev(pa, n) bind(c)
         use iso_c_binding
         type(c_ptr):: pa
         integer(c_int), value:: n

      end subroutine c_allocatev
   end interface

   interface
      function dotproduct(pa, pa2, n) result(val) bind(c)
         use iso_c_binding
         type(c_ptr):: pa, pa2
         integer(c_int), value:: n
         real(c_double):: val
      end function dotproduct
   end interface

   interface
      function opencl_dotproduct(pa, pa2, n) result(val) bind(c)
         use iso_c_binding
         type(c_ptr):: pa, pa2
         integer(c_int), value:: n
         real(c_double):: val
      end function opencl_dotproduct
   end interface

   interface
      function opencl_dotproduct_f(pa, pa2, n) result(val) bind(c)
         use iso_c_binding
         type(c_ptr):: pa, pa2
         integer(c_int), value:: n
         real(c_float):: val
      end function opencl_dotproduct_f
   end interface

contains

   subroutine showValue()
      type(c_ptr) :: pa
      real(c_double), pointer::fpa(:)
      real(c_double)::val
      double precision, allocatable, target :: vec(:), vec2(:)
      integer(c_int)::n
      integer :: i

      n = 10000
      allocate (vec(n))

      do i = 1, n
         val = dble(i)
         call putValVec(pa, n, i, val)
      end do

      call c_f_pointer(pa, fpa, [n])

      vec(:) = fpa(:)

      print *, vec(:)
   end subroutine

   function c_dot_product(a, b, nf) result(dp)
      use iso_c_binding
      integer, intent(in)::nf
      real(8), intent(in), target::a(nf), b(nf)
      real(4), target::a_f(nf), b_f(nf)
      double precision, pointer ::fpa(:), fpb(:)
      real(4), pointer ::fpa_f(:), fpb_f(:)

      real(8) :: dp
      real(4) :: dp_f

      type(c_ptr) :: pa
      type(c_ptr) :: pa2

      type(c_ptr) :: pa_f
      type(c_ptr) :: pa2_f

      real(c_double)::val
      real(c_float)::val_f
      integer(c_int)::n
      integer :: i

      do i = 1, nf
         a_f(i) = real(a(i))
         b_f(i) = real(b(i))
      end do

      fpa => a
      fpb => b

      n = nf
      !call c_f_pointer(fpa, a, [n])
      !call c_f_pointer(fpb, b, [n])
      call c_allocatev(pa, n)
      call c_f_pointer(pa, fpa, [n])
      fpa(:) = a(:)
      call c_allocatev(pa2, n)
      call c_f_pointer(pa2, fpb, [n])
      fpb(:) = b(:)

      dp_f = opencl_dotproduct(pa, pa2, n)
      print *, dp

   end function c_dot_product

   function c_dot_product_f(a, b, nf) result(dp)
      use iso_c_binding
      integer, intent(in)::nf
      real(8), intent(in), target::a(nf), b(nf)
      real(4), target::a_f(nf), b_f(nf)
      double precision, pointer ::fpa(:), fpb(:)
      real(4), pointer ::fpa_f(:), fpb_f(:)

      real(8) :: dp
      real(4) :: dp_f

      type(c_ptr) :: pa
      type(c_ptr) :: pa2

      type(c_ptr) :: pa_f
      type(c_ptr) :: pa2_f

      real(c_double)::val
      real(c_float)::val_f
      integer(c_int)::n
      integer :: i

      do i = 1, nf
         a_f(i) = real(a(i))
         b_f(i) = real(b(i))
      end do

      !fpa => a
      !fpb => b

      n = nf
      !call c_f_pointer(fpa, a, [n])
      !call c_f_pointer(fpb, b, [n])
      !call c_allocatev(pa,n)
      !call c_f_pointer(pa, fpa, [n])
      !fpa(:)=a(:)
      !call c_allocatev(pa2,n)
      !call c_f_pointer(pa2, fpb, [n])
      !fpb(:)=b(:)

      ! pointer
      fpa_f => a_f
      fpb_f => b_f

      call c_allocatev(pa_f, n)
      call c_f_pointer(pa_f, fpa_f, [n])
      fpa_f(:) = a_f(:)
      call c_allocatev(pa2_f, n)
      call c_f_pointer(pa2_f, fpb_f, [n])
      fpb_f(:) = b_f(:)

      dp_f = opencl_dotproduct_f(pa_f, pa2_f, n)
      print *, dp

   end function c_dot_product_f

end module fMathClass