-static int data_pack_data(starpu_data_handle_t handle, unsigned node, void **ptr, starpu_ssize_t *count)
-{
- (void)handle;
- (void)node;
- (void)ptr;
- (void)count;
- STARPU_ASSERT_MSG(0, "The data interface has been registered with starpu_mpi_datatype_register(). Calling the pack_data function should not happen\n");
- return 0;
-}
-
-static int data_unpack_data(starpu_data_handle_t handle, unsigned node, void *ptr, size_t count)
-{
- (void)handle;
- (void)node;
- (void)ptr;
- (void)count;
- STARPU_ASSERT_MSG(0, "The data interface has been registered with starpu_mpi_datatype_register(). Calling the unpack_data function should not happen\n");
-! StarPU --- Runtime system for heterogeneous multicore architectures.
-!
-! Copyright (C) 2016 Inria
-! Copyright (C) 2017 Université de Bordeaux
-!
-! 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.
-
-module fstarpu_mpi_mod
- use iso_c_binding
- use fstarpu_mod
- implicit none
-
- 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
-
- ! == mpi/include/starpu_mpi.h ==
- ! int starpu_mpi_isend_prio(starpu_data_handle_t data_handle, starpu_mpi_req *req, int dest, int mpi_tag, int prio, MPI_Comm comm);
- function fstarpu_mpi_isend_prio (dh, mpi_req, dst, mpi_tag, prio, mpi_comm) bind(C)
- use iso_c_binding
- implicit none
- integer(c_int) :: fstarpu_mpi_isend_prio
- 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) :: prio
- integer(c_int), value, intent(in) :: mpi_comm
- end function fstarpu_mpi_isend_prio
-
- ! 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_send_prio(starpu_data_handle_t data_handle, int dest, int mpi_tag, int prio, MPI_Comm comm);
- function fstarpu_mpi_send_prio (dh, dst, mpi_tag, prio, mpi_comm) bind(C)
- use iso_c_binding
- implicit none
- integer(c_int) :: fstarpu_mpi_send_prio
- 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) :: prio
- integer(c_int), value, intent(in) :: mpi_comm
- end function fstarpu_mpi_send_prio
-
- ! 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_isend_detached_prio(starpu_data_handle_t data_handle, int dest, int mpi_tag, int prio, MPI_Comm comm, void (*callback)(void *), void *arg);
- ! 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_prio(starpu_data_handle_t data_handle, starpu_mpi_req *req, int dest, int mpi_tag, int prio, MPI_Comm comm);
- function fstarpu_mpi_issend_prio (dh, mpi_req, dst, mpi_tag, prio, mpi_comm) bind(C)
- use iso_c_binding
- implicit none
- integer(c_int) :: fstarpu_mpi_issend_prio
- 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) :: prio
- integer(c_int), value, intent(in) :: mpi_comm
- end function fstarpu_mpi_issend_prio
-
- ! 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_issend_detached_prio(starpu_data_handle_t data_handle, int dest, int mpi_tag, int prio, MPI_Comm comm, void (*callback)(void *), void *arg);
- ! 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);
- 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) &
- end function fstarpu_mpi_isend_array_detached_unlock_tag
-
- ! int starpu_mpi_isend_array_detached_unlock_tag_prio(unsigned array_size, starpu_data_handle_t *data_handle, int *dest, int *mpi_tag, int *prio, MPI_Comm *comm, starpu_tag_t tag);
- function fstarpu_mpi_isend_array_detached_unlock_tag_prio (array_size, dhs, dsts, mpi_tags, prio, mpi_comms, &
- end function fstarpu_mpi_isend_array_detached_unlock_tag_prio
-
- ! 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) &
-void starpu_mpi_redux_data_prio(MPI_Comm comm, starpu_data_handle_t data_handle, int prio);
-
-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);
-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);
-
-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);
-int starpu_mpi_isend_detached_unlock_tag_prio(starpu_data_handle_t data_handle, int dest, int mpi_tag, int prio, MPI_Comm comm, starpu_tag_t 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);
-
-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);
-int starpu_mpi_isend_array_detached_unlock_tag_prio(unsigned array_size, starpu_data_handle_t *data_handle, int *dest, int *mpi_tag, int *prio, MPI_Comm *comm, starpu_tag_t 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);
- _STARPU_MSG("Error : no load balancer with the name %s. Load balancing will be disabled for this run.\n", policy_name);
- return;
- }
-
- ret = defined_policy->init(itf);
- if (ret != 0)
- {
- _STARPU_MSG("Error (%d) in %s->init: invalid starpu_mpi_lb_conf. Load balancing will be disabled for this run.\n", ret, defined_policy->policy_name);
- /* The data has been moved out, and now is moved back, so
- * update the state of the moved_data hash table to reflect
- * this change */
- struct moved_data_entry *md = NULL;
- HASH_FIND_PTR(mdh, &handle, md);
- if (md)
- {
- HASH_DEL(mdh, md);
- free(md);
- }
- }
-
- //if (i == my_rank)
- //{
- // if (dst_rank != my_rank)
- // fprintf(stderr,"Move data %p (tag %d) from node %d to node %d\n", handle, (data_movements_get_tags_table(data_movements_handles[i]))[j], my_rank, dst_rank);
- // else
- // fprintf(stderr,"Bring back data %p (tag %d) from node %d on node %d\n", handle, (data_movements_get_tags_table(data_movements_handles[i]))[j], starpu_mpi_data_get_rank(handle), my_rank);
- //}
-
- _STARPU_DEBUG("Call of starpu_mpi_get_data_on_node(%d,%d) on node %d\n", starpu_mpi_data_get_tag(handle), dst_rank, my_rank);
- STARPU_ASSERT_MSG(_starpu_mpi_early_data_handle_hashmap_count == 0, "Number of unexpected received messages left is not zero (but %d), did you forget to post a receive corresponding to a send?", _starpu_mpi_early_data_handle_hashmap_count);
- _STARPU_MPI_DEBUG(60, "Looking for early_data_handle with comm %ld source %d tag %d\n", (long int)node_tag->comm, node_tag->rank, node_tag->data_tag);
- _STARPU_MPI_DEBUG(60, "Trying to add early_data_handle %p with comm %ld source %d tag %d\n", early_data_handle, (long int)early_data_handle->node_tag.comm,
- _STARPU_MPI_DEBUG(100, "Adding request %p with comm %ld source %d tag %d in the application request hashmap\n", req, (long int)req->node_tag.comm, req->node_tag.rank, req->node_tag.data_tag);
- STARPU_ASSERT_MSG(_starpu_mpi_sync_data_handle_hashmap_count == 0, "Number of sync received messages left is not zero, did you forget to post a receive corresponding to a send?");
- _STARPU_MPI_DEBUG(2000, "Adding sync_req %p with comm %ld source %d tag %d in the hashmap\n", sync_req, (long int)sync_req->node_tag.comm, sync_req->node_tag.rank, sync_req->node_tag.data_tag);
-int fstarpu_mpi_isend_detached_unlock_tag_prio(starpu_data_handle_t data_handle, int dst, int mpi_tag, int prio, MPI_Fint comm, starpu_tag_t *starpu_tag)
-int fstarpu_mpi_isend_array_detached_unlock_tag_prio(int array_size, starpu_data_handle_t *data_handles, int *dsts, int *mpi_tags, int *prio, 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_prio((unsigned)array_size, data_handles, dsts, mpi_tags, prio, comms, *starpu_tag);
- return ret;
-}
-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)
- _STARPU_DEBUG("MPI%s MPI_THREAD_SERIALIZED; Multiple threads may make MPI calls, but only one at a time.\n", msg);
- break;
- }
- case MPI_THREAD_FUNNELED:
- {
- _STARPU_DISP("MPI%s MPI_THREAD_FUNNELED; The application can safely make calls to StarPU-MPI functions, but should not call directly MPI communication functions.\n", msg);
- break;
- }
- case MPI_THREAD_SINGLE:
- {
- _STARPU_DISP("MPI%s MPI_THREAD_SINGLE; MPI does not have multi-thread support, this might cause problems. The application can make calls to StarPU-MPI functions, but not call directly MPI Communication functions.\n", msg);