Initial Commit

.svn/pristine/f9/f92db995771cf1d8324cd9f9fbdbe92552fe12f7.svn-base

@@ -0,0 +1,57 @@
+module timer_c_wrapper
+  use :: iso_c_binding, only: c_ptr
+  use timer_module, only: timer, null_timer
+  implicit none
+
+  !
+  ! C interoperable callback setup
+  !
+  abstract interface
+     subroutine c_timer_callback (context, dname, k)
+       use, intrinsic :: iso_c_binding, only: c_ptr, c_char
+       implicit none
+       type(c_ptr), value, intent(in) :: context
+       character(c_char), intent(in) :: dname(*)
+       integer, intent(in), value :: k
+     end subroutine c_timer_callback
+  end interface
+
+  public :: init, fini
+
+  private
+
+  !
+  ! the following are singleton items which assumes that any timer
+  ! implementation should only assume one global instance, probably a
+  ! struct or class object whose address is stored the context below
+  !
+  type(c_ptr), private :: the_context
+  procedure(C_timer_callback), pointer, private :: the_callback
+
+contains
+  subroutine timer_callback_wrapper (dname, k)
+    use, intrinsic :: iso_c_binding, only: c_null_char
+    implicit none
+    character(len=8), intent(in) :: dname
+    integer, intent(in) :: k
+    call the_callback (the_context, trim (dname) // c_null_char, k)
+  end subroutine timer_callback_wrapper
+
+  subroutine init (context, callback)
+    use, intrinsic :: iso_c_binding, only: c_ptr, c_funptr, c_f_procpointer
+    use iso_c_utilities, only: c_to_f_string
+    use timer_module, only: timer
+    implicit none
+    type(c_ptr), value, intent(in) :: context
+    type(c_funptr), value, intent(in) :: callback
+    the_context=context
+    call c_f_procpointer (callback, the_callback)
+    timer => timer_callback_wrapper
+  end subroutine init
+
+  subroutine fini ()
+    implicit none
+    timer => null_timer
+  end subroutine fini
+
+end module timer_c_wrapper