Browse Source

- add more native Fortran routine for MPI
- add a basic ring example

Olivier Aumage 8 years ago
parent
commit
fba4edd577

+ 15 - 2
mpi/examples/Makefile.am

@@ -274,7 +274,8 @@ if STARPU_HAVE_MPIFORT
 if BUILD_EXAMPLES
 if !STARPU_SANITIZE
 examplebin_PROGRAMS +=		\
-	native_fortran/nf_mm
+	native_fortran/nf_mm	\
+	native_fortran/nf_basic_ring
 
 native_fortran_nf_mm_SOURCES	=			\
 	native_fortran/nf_mm_cl.f90			\
@@ -286,8 +287,18 @@ native_fortran_nf_mm_LDADD =					\
 	../src/libstarpumpi-@STARPU_EFFECTIVE_VERSION@.la	\
 	-lm
 
+native_fortran_nf_basic_ring_SOURCES	=			\
+	$(top_srcdir)/mpi/include/fstarpu_mpi_mod.f90	\
+	$(top_srcdir)/include/fstarpu_mod.f90		\
+	native_fortran/nf_basic_ring.f90
+
+native_fortran_nf_basic_ring_LDADD =					\
+	../src/libstarpumpi-@STARPU_EFFECTIVE_VERSION@.la	\
+	-lm
+
 starpu_mpi_EXAMPLES +=				\
-	native_fortran/nf_mm
+	native_fortran/nf_mm			\
+	native_fortran/nf_basic_ring
 endif
 endif
 endif
@@ -372,6 +383,8 @@ nf_mm_cl.o: $(top_srcdir)/mpi/examples/native_fortran/nf_mm_cl.f90 fstarpu_mpi_m
 nf_mm.o: $(top_srcdir)/mpi/examples/native_fortran/nf_mm.f90 nf_mm_cl.mod fstarpu_mpi_mod.mod fstarpu_mod.mod
 	$(AM_V_FC)$(FC) $(native_fortran_nf_mm_FCFLAGS) $(FCFLAGS) -c -o $@ `test -f 'native_fortran/nf_mm.f90' || echo '$(srcdir)/'`native_fortran/nf_mm.f90
 
+nf_basic_ring.o: $(top_srcdir)/mpi/examples/native_fortran/nf_basic_ring.f90 fstarpu_mpi_mod.mod fstarpu_mod.mod
+	$(AM_V_FC)$(FC) $(native_fortran_nf_basic_ring_FCFLAGS) $(FCFLAGS) -c -o $@ `test -f 'native_fortran/nf_basic_ring.f90' || echo '$(srcdir)/'`native_fortran/nf_basic_ring.f90
 endif
 endif
 endif

+ 108 - 0
mpi/examples/native_fortran/nf_basic_ring.f90

@@ -0,0 +1,108 @@
+! StarPU --- Runtime system for heterogeneous multicore architectures.
+!
+! Copyright (C) 2016  Inria
+!
+! StarPU is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at
+! your option) any later version.
+!
+! StarPU 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 Lesser General Public License in COPYING.LGPL for more details.
+
+program nf_basic_ring
+        use iso_c_binding       ! C interfacing module
+        use fstarpu_mod         ! StarPU interfacing module
+        use fstarpu_mpi_mod     ! StarPU-MPI interfacing module
+        implicit none
+
+        integer(c_int) :: ncpu
+        integer(c_int) :: ret
+        integer(c_int) :: rank,sz
+        integer(c_int),target :: token = 42
+        integer(c_int) :: nloops = 32
+        integer(c_int) :: loop
+        integer(c_int) :: tag
+        integer(c_int) :: world
+        integer(c_int) :: src,dst
+        type(c_ptr) :: token_dh, st
+
+        ret = fstarpu_mpi_init(1)
+        print *,"fstarpu_mpi_init status:", ret
+        if (ret /= 0) then
+                stop 1
+        end if
+
+        ret = fstarpu_init(C_NULL_PTR)
+        if (ret == -19) then
+                stop 77
+        else if (ret /= 0) then
+                stop 1
+        end if
+
+        ! stop there if no CPU worker available
+        ncpu = fstarpu_cpu_worker_get_count()
+        if (ncpu == 0) then
+                call fstarpu_shutdown()
+                ret = fstarpu_mpi_shutdown()
+                stop 77
+        end if
+
+        world = fstarpu_mpi_world_comm()
+        rank = fstarpu_mpi_world_rank()
+        sz = fstarpu_mpi_world_size()
+        write(*,*) "rank=", rank,"size=",sz,"world=",world
+        if (sz < 2) then
+                call fstarpu_shutdown()
+                ret = fstarpu_mpi_shutdown()
+                stop 77
+        end if
+
+        call fstarpu_variable_data_register(token_dh, 0, c_loc(token), c_sizeof(token))
+
+        st = fstarpu_mpi_status_alloc()
+        do loop=1,nloops
+                tag = loop*sz+rank
+                token = 0
+                if (loop == 1.and.rank == 0) then
+                        write(*,*) "rank=", rank,"token=",token
+                else
+                        src = modulo((rank+sz-1),sz)
+                        write(*,*) "rank=", rank,"recv--> src =", src, "tag =", tag
+                        ret = fstarpu_mpi_recv(token_dh, src, tag, world, st)
+                        if (ret /= 0) then
+                                write(*,*) "fstarpu_mpi_recv failed"
+                                stop 1
+                        end if
+                        write(*,*) "rank=", rank,"recv<--","token=",token
+                        token = token+1
+                end if
+                if (loop == nloops.and.rank == (sz-1)) then
+                        call fstarpu_data_acquire(token_dh, FSTARPU_R)
+                        write(*,*) "finished: rank=", rank,"token=",token
+                        call fstarpu_data_release(token_dh)
+                else
+                        dst = modulo((rank+1),sz)
+                        write(*,*) "rank=", rank,"send--> dst =", dst, "tag =", tag+1
+                        ret = fstarpu_mpi_send(token_dh, dst, tag+1, world)
+                        if (ret /= 0) then
+                                write(*,*) "fstarpu_mpi_recv failed"
+                                stop 1
+                        end if
+                        write(*,*) "rank=", rank,"send<--"
+                end if
+        end do
+        call fstarpu_mpi_status_free(st)
+        call fstarpu_data_unregister(token_dh)
+        call fstarpu_shutdown()
+
+        ret = fstarpu_mpi_shutdown()
+        print *,"fstarpu_mpi_shutdown status:", ret
+        if (ret /= 0) then
+                stop 1
+        end if
+end program nf_basic_ring
+

+ 434 - 18
mpi/include/fstarpu_mpi_mod.f90

@@ -18,36 +18,153 @@ module fstarpu_mpi_mod
         use fstarpu_mod
         implicit none
 
-        ! TODO:
-        ! starpu_mpi_data_register
-        ! starpu_mpi_get_data_on_node
-        ! starpu_mpi_data_set_rank
-        ! starpu_mpi_init
-        ! starpu_mpi_shutdown
-        ! starpu_mpi_comm_rank
-        ! starpu_mpi_comm_size
-        ! starpu_mpi_task_insert
-
         interface
                 ! == mpi/include/starpu_mpi.h ==
                 ! int starpu_mpi_isend(starpu_data_handle_t data_handle, starpu_mpi_req *req, int dest, int mpi_tag, MPI_Comm comm);
+                function fstarpu_mpi_isend (dh, mpi_req, dst, mpi_tag, mpi_comm) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_isend
+                        type(c_ptr), value, intent(in) :: dh
+                        type(c_ptr), value, intent(in) :: mpi_req
+                        integer(c_int), value, intent(in) :: dst
+                        integer(c_int), value, intent(in) :: mpi_tag
+                        integer(c_int), value, intent(in) :: mpi_comm
+                end function fstarpu_mpi_isend
+
                 ! int starpu_mpi_irecv(starpu_data_handle_t data_handle, starpu_mpi_req *req, int source, int mpi_tag, MPI_Comm comm);
+                function fstarpu_mpi_irecv (dh, mpi_req, src, mpi_tag, mpi_comm) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_irecv
+                        type(c_ptr), value, intent(in) :: dh
+                        type(c_ptr), value, intent(in) :: mpi_req
+                        integer(c_int), value, intent(in) :: src
+                        integer(c_int), value, intent(in) :: mpi_tag
+                        integer(c_int), value, intent(in) :: mpi_comm
+                end function fstarpu_mpi_irecv
+
                 ! int starpu_mpi_send(starpu_data_handle_t data_handle, int dest, int mpi_tag, MPI_Comm comm);
+                function fstarpu_mpi_send (dh, dst, mpi_tag, mpi_comm) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_send
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: dst
+                        integer(c_int), value, intent(in) :: mpi_tag
+                        integer(c_int), value, intent(in) :: mpi_comm
+                end function fstarpu_mpi_send
+
                 ! int starpu_mpi_recv(starpu_data_handle_t data_handle, int source, int mpi_tag, MPI_Comm comm, MPI_Status *status);
+                function fstarpu_mpi_recv (dh, src, mpi_tag, mpi_comm, mpi_status) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_recv
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: src
+                        integer(c_int), value, intent(in) :: mpi_tag
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_ptr), value, intent(in) :: mpi_status
+                end function fstarpu_mpi_recv
+
                 ! int starpu_mpi_isend_detached(starpu_data_handle_t data_handle, int dest, int mpi_tag, MPI_Comm comm, void (*callback)(void *), void *arg);
+                function fstarpu_mpi_isend_detached (dh, dst, mpi_tag, mpi_comm, callback, arg) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_isend_detached
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: dst
+                        integer(c_int), value, intent(in) :: mpi_tag
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_funptr), value, intent(in) :: callback
+                        type(c_ptr), value, intent(in) :: arg
+                end function fstarpu_mpi_isend_detached
+
                 ! int starpu_mpi_irecv_detached(starpu_data_handle_t data_handle, int source, int mpi_tag, MPI_Comm comm, void (*callback)(void *), void *arg);
+                function fstarpu_mpi_recv_detached (dh, src, mpi_tag, mpi_comm, callback, arg) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_recv_detached
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: src
+                        integer(c_int), value, intent(in) :: mpi_tag
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_funptr), value, intent(in) :: callback
+                        type(c_ptr), value, intent(in) :: arg
+                end function fstarpu_mpi_recv_detached
+
                 ! int starpu_mpi_issend(starpu_data_handle_t data_handle, starpu_mpi_req *req, int dest, int mpi_tag, MPI_Comm comm);
+                function fstarpu_mpi_issend (dh, mpi_req, dst, mpi_tag, mpi_comm) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_issend
+                        type(c_ptr), value, intent(in) :: dh
+                        type(c_ptr), value, intent(in) :: mpi_req
+                        integer(c_int), value, intent(in) :: dst
+                        integer(c_int), value, intent(in) :: mpi_tag
+                        integer(c_int), value, intent(in) :: mpi_comm
+                end function fstarpu_mpi_issend
+
                 ! int starpu_mpi_issend_detached(starpu_data_handle_t data_handle, int dest, int mpi_tag, MPI_Comm comm, void (*callback)(void *), void *arg);
+                function fstarpu_mpi_issend_detached (dh, dst, mpi_tag, mpi_comm, callback, arg) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_issend_detached
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: dst
+                        integer(c_int), value, intent(in) :: mpi_tag
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_funptr), value, intent(in) :: callback
+                        type(c_ptr), value, intent(in) :: arg
+                end function fstarpu_mpi_issend_detached
+
                 ! int starpu_mpi_wait(starpu_mpi_req *req, MPI_Status *status);
+                function fstarpu_mpi_wait(req,st) bind(C,name="starpu_mpi_wait")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_wait
+                        type(c_ptr), value, intent(in) :: req
+                        type(c_ptr), value, intent(in) :: st
+                end function fstarpu_mpi_wait
+
                 ! int starpu_mpi_test(starpu_mpi_req *req, int *flag, MPI_Status *status);
+                function fstarpu_mpi_test(req,flag,st) bind(C,name="starpu_mpi_test")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_test
+                        type(c_ptr), value, intent(in) :: req
+                        type(c_ptr), value, intent(in) :: flag
+                        type(c_ptr), value, intent(in) :: st
+                end function fstarpu_mpi_test
+
                 ! int starpu_mpi_barrier(MPI_Comm comm);
+                function fstarpu_mpi_barrier (mpi_comm) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_barrier
+                        integer(c_int), value, intent(in) :: mpi_comm
+                end function fstarpu_mpi_barrier
+
                 ! int starpu_mpi_irecv_detached_sequential_consistency(starpu_data_handle_t data_handle, int source, int mpi_tag, MPI_Comm comm, void (*callback)(void *), void *arg, int sequential_consistency);
+                function fstarpu_mpi_recv_detached_sequential_consistency (dh, src, mpi_tag, mpi_comm, callback, arg, seq_const) &
+                                bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_recv_detached_sequential_consistency
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: src
+                        integer(c_int), value, intent(in) :: mpi_tag
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_funptr), value, intent(in) :: callback
+                        type(c_ptr), value, intent(in) :: arg
+                        integer(c_int), value, intent(in) :: seq_const
+                end function fstarpu_mpi_recv_detached_sequential_consistency
+
 
                 ! int starpu_mpi_init_comm(int *argc, char ***argv, int initialize_mpi, MPI_Comm comm);
                 ! -> cf fstarpu_mpi_init
                 ! int starpu_mpi_init(int *argc, char ***argv, int initialize_mpi);
                 ! -> cf fstarpu_mpi_init
-
                 ! int starpu_mpi_initialize(void) STARPU_DEPRECATED;
                 ! -> cf fstarpu_mpi_init
                 ! int starpu_mpi_initialize_extended(int *rank, int *world_size) STARPU_DEPRECATED;
@@ -63,22 +180,159 @@ module fstarpu_mpi_mod
                 ! struct starpu_task *starpu_mpi_task_build(MPI_Comm comm, struct starpu_codelet *codelet, ...);
                 ! int starpu_mpi_task_post_build(MPI_Comm comm, struct starpu_codelet *codelet, ...);
                 ! int starpu_mpi_task_insert(MPI_Comm comm, struct starpu_codelet *codelet, ...);
-                ! /* the function starpu_mpi_insert_task has the same semantics as starpu_mpi_task_insert, it is kept to avoid breaking old codes */
-                ! int starpu_mpi_insert_task(MPI_Comm comm, struct starpu_codelet *codelet, ...);
+
                 ! void starpu_mpi_get_data_on_node(MPI_Comm comm, starpu_data_handle_t data_handle, int node);
+                subroutine fstarpu_mpi_get_data_on_node(mpi_comm,dh,node) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: node
+                end subroutine fstarpu_mpi_get_data_on_node
+
                 ! void starpu_mpi_get_data_on_node_detached(MPI_Comm comm, starpu_data_handle_t data_handle, int node, void (*callback)(void*), void *arg);
+                subroutine fstarpu_mpi_get_data_on_node_detached(mpi_comm,dh,node,callback,arg) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: node
+                        type(c_funptr), value, intent(in) :: callback
+                        type(c_ptr), value, intent(in) :: arg
+                end subroutine fstarpu_mpi_get_data_on_node_detached
+
                 ! void starpu_mpi_redux_data(MPI_Comm comm, starpu_data_handle_t data_handle);
+                subroutine fstarpu_mpi_redux_data(mpi_comm,dh) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_ptr), value, intent(in) :: dh
+                end subroutine fstarpu_mpi_redux_data
+
                 ! int starpu_mpi_scatter_detached(starpu_data_handle_t *data_handles, int count, int root, MPI_Comm comm, void (*scallback)(void *), void *sarg, void (*rcallback)(void *), void *rarg);
+                function fstarpu_mpi_scatter_detached (dhs, cnt, root, mpi_comm, scallback, sarg, rcallback, rarg) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_scatter_detached
+                        type(c_ptr), intent(in) :: dhs(*)
+                        integer(c_int), value, intent(in) :: cnt
+                        integer(c_int), value, intent(in) :: root
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_funptr), value, intent(in) :: scallback
+                        type(c_ptr), value, intent(in) :: sarg
+                        type(c_funptr), value, intent(in) :: rcallback
+                        type(c_ptr), value, intent(in) :: rarg
+                end function fstarpu_mpi_scatter_detached
+
                 ! int starpu_mpi_gather_detached(starpu_data_handle_t *data_handles, int count, int root, MPI_Comm comm, void (*scallback)(void *), void *sarg, void (*rcallback)(void *), void *rarg);
+                function fstarpu_mpi_gather_detached (dhs, cnt, root, mpi_comm, scallback, sarg, rcallback, rarg) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_gather_detached
+                        type(c_ptr), intent(in) :: dhs(*)
+                        integer(c_int), value, intent(in) :: cnt
+                        integer(c_int), value, intent(in) :: root
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_funptr), value, intent(in) :: scallback
+                        type(c_ptr), value, intent(in) :: sarg
+                        type(c_funptr), value, intent(in) :: rcallback
+                        type(c_ptr), value, intent(in) :: rarg
+                end function fstarpu_mpi_gather_detached
+
+
                 ! int starpu_mpi_isend_detached_unlock_tag(starpu_data_handle_t data_handle, int dest, int mpi_tag, MPI_Comm comm, starpu_tag_t tag);
+                function fstarpu_mpi_isend_detached_unlock_tag (dh, dst, mpi_tag, mpi_comm, starpu_tag) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_isend_detached_unlock_tag
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: dst
+                        integer(c_int), value, intent(in) :: mpi_tag
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_ptr), value, intent(in) :: starpu_tag
+                end function fstarpu_mpi_isend_detached_unlock_tag
+
                 ! int starpu_mpi_irecv_detached_unlock_tag(starpu_data_handle_t data_handle, int source, int mpi_tag, MPI_Comm comm, starpu_tag_t tag);
+                function fstarpu_mpi_recv_detached_unlock_tag (dh, src, mpi_tag, mpi_comm, starpu_tag) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_recv_detached_unlock_tag
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: src
+                        integer(c_int), value, intent(in) :: mpi_tag
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_ptr), value, intent(in) :: starpu_tag
+                end function fstarpu_mpi_recv_detached_unlock_tag
+
                 ! int starpu_mpi_isend_array_detached_unlock_tag(unsigned array_size, starpu_data_handle_t *data_handle, int *dest, int *mpi_tag, MPI_Comm *comm, starpu_tag_t tag);
+                function fstarpu_mpi_isend_array_detached_unlock_tag (array_size, dhs, dsts, mpi_tags, mpi_comms, starpu_tag) &
+                                bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_isend_array_detached_unlock_tag
+                        integer(c_int), value, intent(in) :: array_size
+                        type(c_ptr), intent(in) :: dhs(*)
+                        integer(c_int), intent(in) :: dsts(*)
+                        integer(c_int), intent(in) :: mpi_tags(*)
+                        integer(c_int), intent(in) :: mpi_comms(*)
+                        type(c_ptr), value, intent(in) :: starpu_tag
+                end function fstarpu_mpi_isend_array_detached_unlock_tag
+
                 ! int starpu_mpi_irecv_array_detached_unlock_tag(unsigned array_size, starpu_data_handle_t *data_handle, int *source, int *mpi_tag, MPI_Comm *comm, starpu_tag_t tag);
+                function fstarpu_mpi_recv_array_detached_unlock_tag (array_size, dhs, srcs, mpi_tags, mpi_comms, starpu_tag) &
+                                bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_recv_array_detached_unlock_tag
+                        integer(c_int), value, intent(in) :: array_size
+                        type(c_ptr), intent(in) :: dhs(*)
+                        integer(c_int), intent(in) :: srcs(*)
+                        integer(c_int), intent(in) :: mpi_tags(*)
+                        integer(c_int), intent(in) :: mpi_comms(*)
+                        type(c_ptr), value, intent(in) :: starpu_tag
+                end function fstarpu_mpi_recv_array_detached_unlock_tag
+
                 ! void starpu_mpi_comm_amounts_retrieve(size_t *comm_amounts);
+                subroutine fstarpu_mpi_comm_amounts_retrieve (comm_amounts) bind(C,name="starpu_mpi_comm_amounts_retrieve")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_size_t), intent(in) :: comm_amounts(*)
+                end subroutine fstarpu_mpi_comm_amounts_retrieve
+
+
                 ! void starpu_mpi_cache_flush(MPI_Comm comm, starpu_data_handle_t data_handle);
+                subroutine fstarpu_mpi_cache_flush(mpi_comm,dh) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        type(c_ptr), value, intent(in) :: dh
+                end subroutine fstarpu_mpi_cache_flush
+
                 ! void starpu_mpi_cache_flush_all_data(MPI_Comm comm);
+                subroutine fstarpu_mpi_cache_flush_all_data(mpi_comm) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int), value, intent(in) :: mpi_comm
+                end subroutine fstarpu_mpi_cache_flush_all_data
+
                 ! int starpu_mpi_comm_size(MPI_Comm comm, int *size);
+                function fstarpu_mpi_comm_size(mpi_comm,sz) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        integer(c_int), intent(out) :: sz
+                        integer(c_int) :: fstarpu_mpi_comm_size
+                end function fstarpu_mpi_comm_size
+
                 ! int starpu_mpi_comm_rank(MPI_Comm comm, int *rank);
+                function fstarpu_mpi_comm_rank(mpi_comm,rank) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int), value, intent(in) :: mpi_comm
+                        integer(c_int), intent(out) :: rank
+                        integer(c_int) :: fstarpu_mpi_comm_rank
+                end function fstarpu_mpi_comm_rank
+
 
                 ! int starpu_mpi_world_rank(void);
                 function fstarpu_mpi_world_rank() bind(C,name="starpu_mpi_world_rank")
@@ -94,31 +348,193 @@ module fstarpu_mpi_mod
                         integer(c_int) :: fstarpu_mpi_world_size
                 end function fstarpu_mpi_world_size
 
+                ! int starpu_mpi_world_size(void);
+                function fstarpu_mpi_world_comm() bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_world_comm
+                end function fstarpu_mpi_world_comm
+
                 ! int starpu_mpi_get_communication_tag(void);
+                function fstarpu_mpi_get_communication_tag() bind(C,name="starpu_mpi_get_communication_tag")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_get_communication_tag
+                end function fstarpu_mpi_get_communication_tag
+
                 ! void starpu_mpi_set_communication_tag(int tag);
+                subroutine fstarpu_mpi_set_communication_tag(tag) bind(C,name="starpu_mpi_set_communication_tag")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int), value, intent(in) :: tag
+                end subroutine fstarpu_mpi_set_communication_tag
+
                 ! void starpu_mpi_data_register_comm(starpu_data_handle_t data_handle, int tag, int rank, MPI_Comm comm);
+                subroutine fstarpu_mpi_data_register_comm(dh,tag,rank,mpi_comm) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: tag
+                        integer(c_int), value, intent(in) :: rank
+                        integer(c_int), value, intent(in) :: mpi_comm
+                end subroutine fstarpu_mpi_data_register_comm
+
                 ! #define starpu_mpi_data_register(data_handle, tag, rank) starpu_mpi_data_register_comm(data_handle, tag, rank, MPI_COMM_WORLD)
+                subroutine fstarpu_mpi_data_register(dh,tag,rank) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: tag
+                        integer(c_int), value, intent(in) :: rank
+                end subroutine fstarpu_mpi_data_register
+
                 ! void starpu_mpi_data_set_rank_comm(starpu_data_handle_t handle, int rank, MPI_Comm comm);
+                subroutine fstarpu_mpi_data_set_rank_comm(dh,rank,mpi_comm) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: rank
+                        integer(c_int), value, intent(in) :: mpi_comm
+                end subroutine fstarpu_mpi_data_set_rank_comm
+
                 ! #define starpu_mpi_data_set_rank(handle, rank) starpu_mpi_data_set_rank_comm(handle, rank, MPI_COMM_WORLD)
+                subroutine fstarpu_mpi_data_set_rank(dh,rank) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: rank
+                end subroutine fstarpu_mpi_data_set_rank
+
                 ! void starpu_mpi_data_set_tag(starpu_data_handle_t handle, int tag);
-                ! #define starpu_data_set_rank starpu_mpi_data_set_rank
-                ! #define starpu_data_set_tag starpu_mpi_data_set_tag
+                subroutine fstarpu_mpi_data_set_tag(dh,tag) bind(C,name="starpu_mpi_data_set_tag")
+                        use iso_c_binding
+                        implicit none
+                        type(c_ptr), value, intent(in) :: dh
+                        integer(c_int), value, intent(in) :: tag
+                end subroutine fstarpu_mpi_data_set_tag
+
                 ! int starpu_mpi_data_get_rank(starpu_data_handle_t handle);
+                function fstarpu_mpi_data_get_rank(dh) bind(C,name="starpu_mpi_data_get_rank")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_data_get_rank
+                        type(c_ptr), value, intent(in) :: dh
+                end function fstarpu_mpi_data_get_rank
+
                 ! int starpu_mpi_data_get_tag(starpu_data_handle_t handle);
-                ! #define starpu_data_get_rank starpu_mpi_data_get_rank
-                ! #define starpu_data_get_tag starpu_mpi_data_get_tag
+                function fstarpu_mpi_data_get_tag(dh) bind(C,name="starpu_mpi_data_get_tag")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_data_get_tag
+                        type(c_ptr), value, intent(in) :: dh
+                end function fstarpu_mpi_data_get_tag
+
                 ! #define STARPU_MPI_NODE_SELECTION_CURRENT_POLICY -1
                 ! #define STARPU_MPI_NODE_SELECTION_MOST_R_DATA    0
-                ! typedef int (*starpu_mpi_select_node_policy_func_t)(int me, int nb_nodes, struct starpu_data_descr *descr, int nb_data);
+
                 ! int starpu_mpi_node_selection_register_policy(starpu_mpi_select_node_policy_func_t policy_func);
+                function fstarpu_mpi_node_selection_register_policy(policy_func) &
+                                bind(C,name="starpu_mpi_node_selection_register_policy")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_node_selection_register_policy
+                        type(c_funptr), value, intent(in) :: policy_func
+                end function fstarpu_mpi_node_selection_register_policy
+
                 ! int starpu_mpi_node_selection_unregister_policy(int policy);
+                function fstarpu_mpi_node_selection_unregister_policy(policy) &
+                                bind(C,name="starpu_mpi_node_selection_unregister_policy")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_node_selection_unregister_policy
+                        type(c_ptr), value, intent(in) :: policy
+                end function fstarpu_mpi_node_selection_unregister_policy
+
                 ! int starpu_mpi_node_selection_get_current_policy();
+                function fstarpu_mpi_data_selection_get_current_policy() &
+                                bind(C,name="starpu_mpi_data_selection_get_current_policy")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_data_selection_get_current_policy
+                end function fstarpu_mpi_data_selection_get_current_policy
+
                 ! int starpu_mpi_node_selection_set_current_policy(int policy);
+                function fstarpu_mpi_data_selection_set_current_policy(policy) &
+                                bind(C,name="starpu_mpi_data_selection_set_current_policy")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_data_selection_set_current_policy
+                        type(c_ptr), value, intent(in) :: policy
+                end function fstarpu_mpi_data_selection_set_current_policy
+
                 ! int starpu_mpi_cache_is_enabled();
+                function fstarpu_mpi_cache_is_enabled() bind(C,name="starpu_mpi_cache_is_enabled")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_cache_is_enabled
+                end function fstarpu_mpi_cache_is_enabled
+
                 ! int starpu_mpi_cache_set(int enabled);
+                function fstarpu_mpi_cache_set(enabled) bind(C,name="starpu_mpi_cache_set")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_cache_set
+                        integer(c_int), value, intent(in) :: enabled
+                end function fstarpu_mpi_cache_set
+
                 ! int starpu_mpi_wait_for_all(MPI_Comm comm);
+                function fstarpu_mpi_wait_for_all (mpi_comm) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_wait_for_all
+                        integer(c_int), value, intent(in) :: mpi_comm
+                end function fstarpu_mpi_wait_for_all
+
                 ! int starpu_mpi_datatype_register(starpu_data_handle_t handle, starpu_mpi_datatype_allocate_func_t allocate_datatype_func, starpu_mpi_datatype_free_func_t free_datatype_func);
+                function fstarpu_mpi_datatype_register(dh, alloc_func, free_func) bind(C,name="starpu_mpi_datatype_register")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_datatype_register
+                        type(c_ptr), value, intent(in) :: dh
+                        type(c_funptr), value, intent(in) :: alloc_func
+                        type(c_funptr), value, intent(in) :: free_func
+                end function fstarpu_mpi_datatype_register
+
                 ! int starpu_mpi_datatype_unregister(starpu_data_handle_t handle);
+                function fstarpu_mpi_datatype_unregister(dh) bind(C,name="starpu_mpi_datatype_unregister")
+                        use iso_c_binding
+                        implicit none
+                        integer(c_int) :: fstarpu_mpi_datatype_unregister
+                        type(c_ptr), value, intent(in) :: dh
+                end function fstarpu_mpi_datatype_unregister
+
+
+                function fstarpu_mpi_req_alloc() bind(C)
+                        use iso_c_binding
+                        implicit none
+                        type(c_ptr) :: fstarpu_mpi_req_alloc
+                end function fstarpu_mpi_req_alloc
+
+                subroutine fstarpu_mpi_req_free(req) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        type(c_ptr),value,intent(in) :: req
+                end subroutine fstarpu_mpi_req_free
+
+                function fstarpu_mpi_status_alloc() bind(C)
+                        use iso_c_binding
+                        implicit none
+                        type(c_ptr) :: fstarpu_mpi_status_alloc
+                end function fstarpu_mpi_status_alloc
+
+                subroutine fstarpu_mpi_status_free(st) bind(C)
+                        use iso_c_binding
+                        implicit none
+                        type(c_ptr),value,intent(in) :: st
+                end subroutine fstarpu_mpi_status_free
+
+
+
         end interface
 
         contains

+ 187 - 0
mpi/src/starpu_mpi.c

@@ -1866,7 +1866,194 @@ void fstarpu_mpi_argcv_free(struct _starpu_mpi_argc_argv *argcv)
 	free(argcv);
 }
 
+starpu_mpi_req *fstarpu_mpi_req_alloc(void)
+{
+	return calloc(1, sizeof(starpu_mpi_req));
+}
+
+void fstarpu_mpi_req_free(starpu_mpi_req *req)
+{
+	free(req);
+}
+
+MPI_Status *fstarpu_mpi_status_alloc(void)
+{
+	return calloc(1, sizeof(MPI_Status));
+}
+
+void fstarpu_mpi_status_free(MPI_Status *status)
+{
+	free(status);
+}
+
+int fstarpu_mpi_barrier(MPI_Fint comm)
+{
+	return starpu_mpi_barrier(MPI_Comm_f2c(comm));
+}
+
+int fstarpu_mpi_irecv_detached_sequential_consistency(starpu_data_handle_t data_handle, int src, int mpi_tag, MPI_Fint comm, void (*callback)(void *), void *arg, int seq_const)
+{
+	return starpu_mpi_irecv_detached_sequential_consistency(data_handle, src, mpi_tag, MPI_Comm_f2c(comm), callback, arg, seq_const);
+}
+
 int fstarpu_mpi_init_c(struct _starpu_mpi_argc_argv *argcv)
 {
 	return starpu_mpi_init_comm(argcv->argc, argcv->argv, argcv->initialize_mpi, argcv->comm);
 }
+
+void fstarpu_mpi_get_data_on_node(MPI_Fint comm, starpu_data_handle_t data_handle, int node)
+{
+	starpu_mpi_get_data_on_node(MPI_Comm_f2c(comm), data_handle, node);
+}
+
+void fstarpu_mpi_get_data_on_node_detached(MPI_Fint comm, starpu_data_handle_t data_handle, int node, void (*callback)(void *), void *arg)
+{
+	starpu_mpi_get_data_on_node_detached(MPI_Comm_f2c(comm), data_handle, node, callback, arg);
+}
+
+void fstarpu_mpi_redux_data(MPI_Fint comm, starpu_data_handle_t data_handle)
+{
+	starpu_mpi_redux_data(MPI_Comm_f2c(comm), data_handle);
+}
+
+/* scatter/gather */
+int fstarpu_mpi_scatter_detached(starpu_data_handle_t *data_handles, int cnt, int root, MPI_Fint comm, void (*scallback)(void *), void *sarg, void (*rcallback)(void *), void *rarg)
+{
+	return starpu_mpi_scatter_detached(data_handles, cnt, root, MPI_Comm_f2c(comm), scallback, sarg, rcallback, rarg);
+}
+
+int fstarpu_mpi_gather_detached(starpu_data_handle_t *data_handles, int cnt, int root, MPI_Fint comm, void (*scallback)(void *), void *sarg, void (*rcallback)(void *), void *rarg)
+{
+	return starpu_mpi_gather_detached(data_handles, cnt, root, MPI_Comm_f2c(comm), scallback, sarg, rcallback, rarg);
+}
+
+/* isend/irecv detached unlock tag */
+int fstarpu_mpi_isend_detached_unlock_tag(starpu_data_handle_t data_handle, int dst, int mpi_tag, MPI_Fint comm, starpu_tag_t *starpu_tag)
+{
+	return starpu_mpi_isend_detached_unlock_tag(data_handle, dst, mpi_tag, MPI_Comm_f2c(comm), *starpu_tag);
+}
+
+int fstarpu_mpi_irecv_detached_unlock_tag(starpu_data_handle_t data_handle, int src, int mpi_tag, MPI_Fint comm, starpu_tag_t *starpu_tag)
+{
+	return starpu_mpi_irecv_detached_unlock_tag(data_handle, src, mpi_tag, MPI_Comm_f2c(comm), *starpu_tag);
+}
+
+/* isend/irecv array detached unlock tag */
+int fstarpu_mpi_isend_array_detached_unlock_tag(int array_size, starpu_data_handle_t *data_handles, int *dsts, int *mpi_tags, MPI_Fint *_comms, starpu_tag_t *starpu_tag)
+{
+	MPI_Comm comms[array_size];
+	int i;
+	for (i = 0; i < array_size; i++)
+	{
+		comms[i] = MPI_Comm_f2c(_comms[i]);
+	}
+	int ret = starpu_mpi_isend_array_detached_unlock_tag((unsigned)array_size, data_handles, dsts, mpi_tags, comms, *starpu_tag);
+	return ret;
+}
+
+int fstarpu_mpi_irecv_array_detached_unlock_tag(int array_size, starpu_data_handle_t *data_handles, int *srcs, int *mpi_tags, MPI_Fint *_comms, starpu_tag_t *starpu_tag)
+{
+	MPI_Comm comms[array_size];
+	int i;
+	for (i = 0; i < array_size; i++)
+	{
+		comms[i] = MPI_Comm_f2c(_comms[i]);
+	}
+	int ret = starpu_mpi_irecv_array_detached_unlock_tag((unsigned)array_size, data_handles, srcs, mpi_tags, comms, *starpu_tag);
+	return ret;
+}
+
+/* isend/irecv */
+int fstarpu_mpi_isend(starpu_data_handle_t data_handle, starpu_mpi_req *req, int dst, int mpi_tag, MPI_Fint comm)
+{
+	return starpu_mpi_isend(data_handle, req, dst, mpi_tag, MPI_Comm_f2c(comm));
+}
+
+int fstarpu_mpi_irecv(starpu_data_handle_t data_handle, starpu_mpi_req *req, int src, int mpi_tag, MPI_Fint comm)
+{
+	return starpu_mpi_irecv(data_handle, req, src, mpi_tag, MPI_Comm_f2c(comm));
+}
+
+/* send/recv */
+int fstarpu_mpi_send(starpu_data_handle_t data_handle, int dst, int mpi_tag, MPI_Fint comm)
+{
+	return starpu_mpi_send(data_handle, dst, mpi_tag, MPI_Comm_f2c(comm));
+}
+
+int fstarpu_mpi_recv(starpu_data_handle_t data_handle, int src, int mpi_tag, MPI_Fint comm, MPI_Status *status)
+{
+	return starpu_mpi_recv(data_handle, src, mpi_tag, MPI_Comm_f2c(comm), status);
+}
+
+/* isend/irecv detached */
+int fstarpu_mpi_isend_detached(starpu_data_handle_t data_handle, int dst, int mpi_tag, MPI_Fint comm, void (*callback)(void *), void *arg)
+{
+	return starpu_mpi_isend_detached(data_handle, dst, mpi_tag, MPI_Comm_f2c(comm), callback, arg);
+}
+
+int fstarpu_mpi_irecv_detached(starpu_data_handle_t data_handle, int src, int mpi_tag, MPI_Fint comm, void (*callback)(void *), void *arg)
+{
+	return starpu_mpi_irecv_detached(data_handle, src, mpi_tag, MPI_Comm_f2c(comm), callback, arg);
+}
+
+/* issend / issend detached */
+int fstarpu_mpi_issend(starpu_data_handle_t data_handle, starpu_mpi_req *req, int dst, int mpi_tag, MPI_Fint comm)
+{
+	return starpu_mpi_issend(data_handle, req, dst, mpi_tag, MPI_Comm_f2c(comm));
+}
+
+int fstarpu_mpi_issend_detached(starpu_data_handle_t data_handle, int dst, int mpi_tag, MPI_Fint comm, void (*callback)(void *), void *arg)
+{
+	return starpu_mpi_issend_detached(data_handle, dst, mpi_tag, MPI_Comm_f2c(comm), callback, arg);
+}
+
+/* cache */
+void fstarpu_mpi_cache_flush(MPI_Fint comm, starpu_data_handle_t data_handle)
+{
+	return starpu_mpi_cache_flush(MPI_Comm_f2c(comm), data_handle);
+}
+
+void fstarpu_mpi_cache_flush_all_data(MPI_Fint comm)
+{
+	return starpu_mpi_cache_flush_all_data(MPI_Comm_f2c(comm));
+}
+
+int fstarpu_mpi_comm_size(MPI_Fint comm, int *size)
+{
+	return starpu_mpi_comm_size(MPI_Comm_f2c(comm), size);
+}
+
+int fstarpu_mpi_comm_rank(MPI_Fint comm, int *rank)
+{
+	return starpu_mpi_comm_rank(MPI_Comm_f2c(comm), rank);
+}
+
+MPI_Fint fstarpu_mpi_world_comm()
+{
+	return MPI_Comm_c2f(MPI_COMM_WORLD);
+}
+
+void fstarpu_mpi_data_register_comm(starpu_data_handle_t handle, int tag, int rank, MPI_Fint comm)
+{
+	return starpu_mpi_data_register_comm(handle, tag, rank, MPI_Comm_f2c(comm));
+}
+
+void fstarpu_mpi_data_register(starpu_data_handle_t handle, int tag, int rank)
+{
+	return starpu_mpi_data_register_comm(handle, tag, rank, MPI_COMM_WORLD);
+}
+
+void fstarpu_mpi_data_set_rank_comm(starpu_data_handle_t handle, int rank, MPI_Fint comm)
+{
+	return starpu_mpi_data_set_rank_comm(handle, rank, MPI_Comm_f2c(comm));
+}
+
+void fstarpu_mpi_data_set_rank(starpu_data_handle_t handle, int rank)
+{
+	return starpu_mpi_data_set_rank_comm(handle, rank, MPI_COMM_WORLD);
+}
+
+int fstarpu_mpi_wait_for_all(MPI_Fint comm)
+{
+	return starpu_mpi_wait_for_all(MPI_Comm_f2c(comm));
+}