fstarpu_mpi_mod.f90 37 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648
  1. ! StarPU --- Runtime system for heterogeneous multicore architectures.
  2. !
  3. ! Copyright (C) 2016 Inria
  4. !
  5. ! StarPU is free software; you can redistribute it and/or modify
  6. ! it under the terms of the GNU Lesser General Public License as published by
  7. ! the Free Software Foundation; either version 2.1 of the License, or (at
  8. ! your option) any later version.
  9. !
  10. ! StarPU is distributed in the hope that it will be useful, but
  11. ! WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13. !
  14. ! See the GNU Lesser General Public License in COPYING.LGPL for more details.
  15. module fstarpu_mpi_mod
  16. use iso_c_binding
  17. use fstarpu_mod
  18. implicit none
  19. interface
  20. ! == mpi/include/starpu_mpi.h ==
  21. ! int starpu_mpi_isend(starpu_data_handle_t data_handle, starpu_mpi_req *req, int dest, int mpi_tag, MPI_Comm comm);
  22. function fstarpu_mpi_isend (dh, mpi_req, dst, mpi_tag, mpi_comm) bind(C)
  23. use iso_c_binding
  24. implicit none
  25. integer(c_int) :: fstarpu_mpi_isend
  26. type(c_ptr), value, intent(in) :: dh
  27. type(c_ptr), value, intent(in) :: mpi_req
  28. integer(c_int), value, intent(in) :: dst
  29. integer(c_int), value, intent(in) :: mpi_tag
  30. integer(c_int), value, intent(in) :: mpi_comm
  31. end function fstarpu_mpi_isend
  32. ! int starpu_mpi_irecv(starpu_data_handle_t data_handle, starpu_mpi_req *req, int source, int mpi_tag, MPI_Comm comm);
  33. function fstarpu_mpi_irecv (dh, mpi_req, src, mpi_tag, mpi_comm) bind(C)
  34. use iso_c_binding
  35. implicit none
  36. integer(c_int) :: fstarpu_mpi_irecv
  37. type(c_ptr), value, intent(in) :: dh
  38. type(c_ptr), value, intent(in) :: mpi_req
  39. integer(c_int), value, intent(in) :: src
  40. integer(c_int), value, intent(in) :: mpi_tag
  41. integer(c_int), value, intent(in) :: mpi_comm
  42. end function fstarpu_mpi_irecv
  43. ! int starpu_mpi_send(starpu_data_handle_t data_handle, int dest, int mpi_tag, MPI_Comm comm);
  44. function fstarpu_mpi_send (dh, dst, mpi_tag, mpi_comm) bind(C)
  45. use iso_c_binding
  46. implicit none
  47. integer(c_int) :: fstarpu_mpi_send
  48. type(c_ptr), value, intent(in) :: dh
  49. integer(c_int), value, intent(in) :: dst
  50. integer(c_int), value, intent(in) :: mpi_tag
  51. integer(c_int), value, intent(in) :: mpi_comm
  52. end function fstarpu_mpi_send
  53. ! int starpu_mpi_recv(starpu_data_handle_t data_handle, int source, int mpi_tag, MPI_Comm comm, MPI_Status *status);
  54. function fstarpu_mpi_recv (dh, src, mpi_tag, mpi_comm, mpi_status) bind(C)
  55. use iso_c_binding
  56. implicit none
  57. integer(c_int) :: fstarpu_mpi_recv
  58. type(c_ptr), value, intent(in) :: dh
  59. integer(c_int), value, intent(in) :: src
  60. integer(c_int), value, intent(in) :: mpi_tag
  61. integer(c_int), value, intent(in) :: mpi_comm
  62. type(c_ptr), value, intent(in) :: mpi_status
  63. end function fstarpu_mpi_recv
  64. ! int starpu_mpi_isend_detached(starpu_data_handle_t data_handle, int dest, int mpi_tag, MPI_Comm comm, void (*callback)(void *), void *arg);
  65. function fstarpu_mpi_isend_detached (dh, dst, mpi_tag, mpi_comm, callback, arg) bind(C)
  66. use iso_c_binding
  67. implicit none
  68. integer(c_int) :: fstarpu_mpi_isend_detached
  69. type(c_ptr), value, intent(in) :: dh
  70. integer(c_int), value, intent(in) :: dst
  71. integer(c_int), value, intent(in) :: mpi_tag
  72. integer(c_int), value, intent(in) :: mpi_comm
  73. type(c_funptr), value, intent(in) :: callback
  74. type(c_ptr), value, intent(in) :: arg
  75. end function fstarpu_mpi_isend_detached
  76. ! int starpu_mpi_irecv_detached(starpu_data_handle_t data_handle, int source, int mpi_tag, MPI_Comm comm, void (*callback)(void *), void *arg);
  77. function fstarpu_mpi_recv_detached (dh, src, mpi_tag, mpi_comm, callback, arg) bind(C)
  78. use iso_c_binding
  79. implicit none
  80. integer(c_int) :: fstarpu_mpi_recv_detached
  81. type(c_ptr), value, intent(in) :: dh
  82. integer(c_int), value, intent(in) :: src
  83. integer(c_int), value, intent(in) :: mpi_tag
  84. integer(c_int), value, intent(in) :: mpi_comm
  85. type(c_funptr), value, intent(in) :: callback
  86. type(c_ptr), value, intent(in) :: arg
  87. end function fstarpu_mpi_recv_detached
  88. ! int starpu_mpi_issend(starpu_data_handle_t data_handle, starpu_mpi_req *req, int dest, int mpi_tag, MPI_Comm comm);
  89. function fstarpu_mpi_issend (dh, mpi_req, dst, mpi_tag, mpi_comm) bind(C)
  90. use iso_c_binding
  91. implicit none
  92. integer(c_int) :: fstarpu_mpi_issend
  93. type(c_ptr), value, intent(in) :: dh
  94. type(c_ptr), value, intent(in) :: mpi_req
  95. integer(c_int), value, intent(in) :: dst
  96. integer(c_int), value, intent(in) :: mpi_tag
  97. integer(c_int), value, intent(in) :: mpi_comm
  98. end function fstarpu_mpi_issend
  99. ! int starpu_mpi_issend_detached(starpu_data_handle_t data_handle, int dest, int mpi_tag, MPI_Comm comm, void (*callback)(void *), void *arg);
  100. function fstarpu_mpi_issend_detached (dh, dst, mpi_tag, mpi_comm, callback, arg) bind(C)
  101. use iso_c_binding
  102. implicit none
  103. integer(c_int) :: fstarpu_mpi_issend_detached
  104. type(c_ptr), value, intent(in) :: dh
  105. integer(c_int), value, intent(in) :: dst
  106. integer(c_int), value, intent(in) :: mpi_tag
  107. integer(c_int), value, intent(in) :: mpi_comm
  108. type(c_funptr), value, intent(in) :: callback
  109. type(c_ptr), value, intent(in) :: arg
  110. end function fstarpu_mpi_issend_detached
  111. ! int starpu_mpi_wait(starpu_mpi_req *req, MPI_Status *status);
  112. function fstarpu_mpi_wait(req,st) bind(C,name="starpu_mpi_wait")
  113. use iso_c_binding
  114. implicit none
  115. integer(c_int) :: fstarpu_mpi_wait
  116. type(c_ptr), value, intent(in) :: req
  117. type(c_ptr), value, intent(in) :: st
  118. end function fstarpu_mpi_wait
  119. ! int starpu_mpi_test(starpu_mpi_req *req, int *flag, MPI_Status *status);
  120. function fstarpu_mpi_test(req,flag,st) bind(C,name="starpu_mpi_test")
  121. use iso_c_binding
  122. implicit none
  123. integer(c_int) :: fstarpu_mpi_test
  124. type(c_ptr), value, intent(in) :: req
  125. type(c_ptr), value, intent(in) :: flag
  126. type(c_ptr), value, intent(in) :: st
  127. end function fstarpu_mpi_test
  128. ! int starpu_mpi_barrier(MPI_Comm comm);
  129. function fstarpu_mpi_barrier (mpi_comm) bind(C)
  130. use iso_c_binding
  131. implicit none
  132. integer(c_int) :: fstarpu_mpi_barrier
  133. integer(c_int), value, intent(in) :: mpi_comm
  134. end function fstarpu_mpi_barrier
  135. ! 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);
  136. function fstarpu_mpi_recv_detached_sequential_consistency (dh, src, mpi_tag, mpi_comm, callback, arg, seq_const) &
  137. bind(C)
  138. use iso_c_binding
  139. implicit none
  140. integer(c_int) :: fstarpu_mpi_recv_detached_sequential_consistency
  141. type(c_ptr), value, intent(in) :: dh
  142. integer(c_int), value, intent(in) :: src
  143. integer(c_int), value, intent(in) :: mpi_tag
  144. integer(c_int), value, intent(in) :: mpi_comm
  145. type(c_funptr), value, intent(in) :: callback
  146. type(c_ptr), value, intent(in) :: arg
  147. integer(c_int), value, intent(in) :: seq_const
  148. end function fstarpu_mpi_recv_detached_sequential_consistency
  149. ! int starpu_mpi_init_comm(int *argc, char ***argv, int initialize_mpi, MPI_Comm comm);
  150. ! -> cf fstarpu_mpi_init
  151. ! int starpu_mpi_init(int *argc, char ***argv, int initialize_mpi);
  152. ! -> cf fstarpu_mpi_init
  153. ! int starpu_mpi_initialize(void) STARPU_DEPRECATED;
  154. ! -> cf fstarpu_mpi_init
  155. ! int starpu_mpi_initialize_extended(int *rank, int *world_size) STARPU_DEPRECATED;
  156. ! -> cf fstarpu_mpi_init
  157. ! int starpu_mpi_shutdown(void);
  158. function fstarpu_mpi_shutdown () bind(C,name="starpu_mpi_shutdown")
  159. use iso_c_binding
  160. implicit none
  161. integer(c_int) :: fstarpu_mpi_shutdown
  162. end function fstarpu_mpi_shutdown
  163. ! struct starpu_task *starpu_mpi_task_build(MPI_Comm comm, struct starpu_codelet *codelet, ...);
  164. function fstarpu_mpi_task_build(mpi_comm,arglist) bind(C)
  165. use iso_c_binding, only: c_ptr,c_int
  166. type(c_ptr) :: fstarpu_mpi_task_build
  167. integer(c_int), value, intent(in) :: mpi_comm
  168. type(c_ptr), dimension(:), intent(in) :: arglist
  169. end function fstarpu_mpi_task_build
  170. ! int starpu_mpi_task_post_build(MPI_Comm comm, struct starpu_codelet *codelet, ...);
  171. function fstarpu_mpi_task_post_build(mpi_comm,arglist) bind(C)
  172. use iso_c_binding, only: c_ptr,c_int
  173. integer(c_int) :: fstarpu_mpi_task_post_build
  174. integer(c_int), value, intent(in) :: mpi_comm
  175. type(c_ptr), dimension(:), intent(in) :: arglist
  176. end function fstarpu_mpi_task_post_build
  177. ! int starpu_mpi_task_insert(MPI_Comm comm, struct starpu_codelet *codelet, ...);
  178. function fstarpu_mpi_task_insert(mpi_comm,arglist) bind(C)
  179. use iso_c_binding, only: c_ptr,c_int
  180. integer(c_int) :: fstarpu_mpi_task_insert
  181. integer(c_int), value, intent(in) :: mpi_comm
  182. type(c_ptr), dimension(:), intent(in) :: arglist
  183. end function fstarpu_mpi_task_insert
  184. function fstarpu_mpi_insert_task(mpi_comm,arglist) bind(C,name="fstarpu_mpi_task_insert")
  185. use iso_c_binding, only: c_ptr,c_int
  186. integer(c_int) :: fstarpu_mpi_insert_task
  187. integer(c_int), value, intent(in) :: mpi_comm
  188. type(c_ptr), dimension(:), intent(in) :: arglist
  189. end function fstarpu_mpi_insert_task
  190. ! void starpu_mpi_get_data_on_node(MPI_Comm comm, starpu_data_handle_t data_handle, int node);
  191. subroutine fstarpu_mpi_get_data_on_node(mpi_comm,dh,node) bind(C)
  192. use iso_c_binding
  193. implicit none
  194. integer(c_int), value, intent(in) :: mpi_comm
  195. type(c_ptr), value, intent(in) :: dh
  196. integer(c_int), value, intent(in) :: node
  197. end subroutine fstarpu_mpi_get_data_on_node
  198. ! void starpu_mpi_get_data_on_node_detached(MPI_Comm comm, starpu_data_handle_t data_handle, int node, void (*callback)(void*), void *arg);
  199. subroutine fstarpu_mpi_get_data_on_node_detached(mpi_comm,dh,node,callback,arg) bind(C)
  200. use iso_c_binding
  201. implicit none
  202. integer(c_int), value, intent(in) :: mpi_comm
  203. type(c_ptr), value, intent(in) :: dh
  204. integer(c_int), value, intent(in) :: node
  205. type(c_funptr), value, intent(in) :: callback
  206. type(c_ptr), value, intent(in) :: arg
  207. end subroutine fstarpu_mpi_get_data_on_node_detached
  208. ! void starpu_mpi_redux_data(MPI_Comm comm, starpu_data_handle_t data_handle);
  209. subroutine fstarpu_mpi_redux_data(mpi_comm,dh) bind(C)
  210. use iso_c_binding
  211. implicit none
  212. integer(c_int), value, intent(in) :: mpi_comm
  213. type(c_ptr), value, intent(in) :: dh
  214. end subroutine fstarpu_mpi_redux_data
  215. ! 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);
  216. function fstarpu_mpi_scatter_detached (dhs, cnt, root, mpi_comm, scallback, sarg, rcallback, rarg) bind(C)
  217. use iso_c_binding
  218. implicit none
  219. integer(c_int) :: fstarpu_mpi_scatter_detached
  220. type(c_ptr), intent(in) :: dhs(*)
  221. integer(c_int), value, intent(in) :: cnt
  222. integer(c_int), value, intent(in) :: root
  223. integer(c_int), value, intent(in) :: mpi_comm
  224. type(c_funptr), value, intent(in) :: scallback
  225. type(c_ptr), value, intent(in) :: sarg
  226. type(c_funptr), value, intent(in) :: rcallback
  227. type(c_ptr), value, intent(in) :: rarg
  228. end function fstarpu_mpi_scatter_detached
  229. ! 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);
  230. function fstarpu_mpi_gather_detached (dhs, cnt, root, mpi_comm, scallback, sarg, rcallback, rarg) bind(C)
  231. use iso_c_binding
  232. implicit none
  233. integer(c_int) :: fstarpu_mpi_gather_detached
  234. type(c_ptr), intent(in) :: dhs(*)
  235. integer(c_int), value, intent(in) :: cnt
  236. integer(c_int), value, intent(in) :: root
  237. integer(c_int), value, intent(in) :: mpi_comm
  238. type(c_funptr), value, intent(in) :: scallback
  239. type(c_ptr), value, intent(in) :: sarg
  240. type(c_funptr), value, intent(in) :: rcallback
  241. type(c_ptr), value, intent(in) :: rarg
  242. end function fstarpu_mpi_gather_detached
  243. ! 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);
  244. function fstarpu_mpi_isend_detached_unlock_tag (dh, dst, mpi_tag, mpi_comm, starpu_tag) bind(C)
  245. use iso_c_binding
  246. implicit none
  247. integer(c_int) :: fstarpu_mpi_isend_detached_unlock_tag
  248. type(c_ptr), value, intent(in) :: dh
  249. integer(c_int), value, intent(in) :: dst
  250. integer(c_int), value, intent(in) :: mpi_tag
  251. integer(c_int), value, intent(in) :: mpi_comm
  252. type(c_ptr), value, intent(in) :: starpu_tag
  253. end function fstarpu_mpi_isend_detached_unlock_tag
  254. ! 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);
  255. function fstarpu_mpi_recv_detached_unlock_tag (dh, src, mpi_tag, mpi_comm, starpu_tag) bind(C)
  256. use iso_c_binding
  257. implicit none
  258. integer(c_int) :: fstarpu_mpi_recv_detached_unlock_tag
  259. type(c_ptr), value, intent(in) :: dh
  260. integer(c_int), value, intent(in) :: src
  261. integer(c_int), value, intent(in) :: mpi_tag
  262. integer(c_int), value, intent(in) :: mpi_comm
  263. type(c_ptr), value, intent(in) :: starpu_tag
  264. end function fstarpu_mpi_recv_detached_unlock_tag
  265. ! 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);
  266. function fstarpu_mpi_isend_array_detached_unlock_tag (array_size, dhs, dsts, mpi_tags, mpi_comms, starpu_tag) &
  267. bind(C)
  268. use iso_c_binding
  269. implicit none
  270. integer(c_int) :: fstarpu_mpi_isend_array_detached_unlock_tag
  271. integer(c_int), value, intent(in) :: array_size
  272. type(c_ptr), intent(in) :: dhs(*)
  273. integer(c_int), intent(in) :: dsts(*)
  274. integer(c_int), intent(in) :: mpi_tags(*)
  275. integer(c_int), intent(in) :: mpi_comms(*)
  276. type(c_ptr), value, intent(in) :: starpu_tag
  277. end function fstarpu_mpi_isend_array_detached_unlock_tag
  278. ! 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);
  279. function fstarpu_mpi_recv_array_detached_unlock_tag (array_size, dhs, srcs, mpi_tags, mpi_comms, starpu_tag) &
  280. bind(C)
  281. use iso_c_binding
  282. implicit none
  283. integer(c_int) :: fstarpu_mpi_recv_array_detached_unlock_tag
  284. integer(c_int), value, intent(in) :: array_size
  285. type(c_ptr), intent(in) :: dhs(*)
  286. integer(c_int), intent(in) :: srcs(*)
  287. integer(c_int), intent(in) :: mpi_tags(*)
  288. integer(c_int), intent(in) :: mpi_comms(*)
  289. type(c_ptr), value, intent(in) :: starpu_tag
  290. end function fstarpu_mpi_recv_array_detached_unlock_tag
  291. ! void starpu_mpi_comm_amounts_retrieve(size_t *comm_amounts);
  292. subroutine fstarpu_mpi_comm_amounts_retrieve (comm_amounts) bind(C,name="starpu_mpi_comm_amounts_retrieve")
  293. use iso_c_binding
  294. implicit none
  295. integer(c_size_t), intent(in) :: comm_amounts(*)
  296. end subroutine fstarpu_mpi_comm_amounts_retrieve
  297. ! void starpu_mpi_cache_flush(MPI_Comm comm, starpu_data_handle_t data_handle);
  298. subroutine fstarpu_mpi_cache_flush(mpi_comm,dh) bind(C)
  299. use iso_c_binding
  300. implicit none
  301. integer(c_int), value, intent(in) :: mpi_comm
  302. type(c_ptr), value, intent(in) :: dh
  303. end subroutine fstarpu_mpi_cache_flush
  304. ! void starpu_mpi_cache_flush_all_data(MPI_Comm comm);
  305. subroutine fstarpu_mpi_cache_flush_all_data(mpi_comm) bind(C)
  306. use iso_c_binding
  307. implicit none
  308. integer(c_int), value, intent(in) :: mpi_comm
  309. end subroutine fstarpu_mpi_cache_flush_all_data
  310. ! int starpu_mpi_comm_size(MPI_Comm comm, int *size);
  311. function fstarpu_mpi_comm_size(mpi_comm,sz) bind(C)
  312. use iso_c_binding
  313. implicit none
  314. integer(c_int), value, intent(in) :: mpi_comm
  315. integer(c_int), intent(out) :: sz
  316. integer(c_int) :: fstarpu_mpi_comm_size
  317. end function fstarpu_mpi_comm_size
  318. ! int starpu_mpi_comm_rank(MPI_Comm comm, int *rank);
  319. function fstarpu_mpi_comm_rank(mpi_comm,rank) bind(C)
  320. use iso_c_binding
  321. implicit none
  322. integer(c_int), value, intent(in) :: mpi_comm
  323. integer(c_int), intent(out) :: rank
  324. integer(c_int) :: fstarpu_mpi_comm_rank
  325. end function fstarpu_mpi_comm_rank
  326. ! int starpu_mpi_world_rank(void);
  327. function fstarpu_mpi_world_rank() bind(C,name="starpu_mpi_world_rank")
  328. use iso_c_binding
  329. implicit none
  330. integer(c_int) :: fstarpu_mpi_world_rank
  331. end function fstarpu_mpi_world_rank
  332. ! int starpu_mpi_world_size(void);
  333. function fstarpu_mpi_world_size() bind(C,name="starpu_mpi_world_size")
  334. use iso_c_binding
  335. implicit none
  336. integer(c_int) :: fstarpu_mpi_world_size
  337. end function fstarpu_mpi_world_size
  338. ! int starpu_mpi_world_size(void);
  339. function fstarpu_mpi_world_comm() bind(C)
  340. use iso_c_binding
  341. implicit none
  342. integer(c_int) :: fstarpu_mpi_world_comm
  343. end function fstarpu_mpi_world_comm
  344. ! int starpu_mpi_get_communication_tag(void);
  345. function fstarpu_mpi_get_communication_tag() bind(C,name="starpu_mpi_get_communication_tag")
  346. use iso_c_binding
  347. implicit none
  348. integer(c_int) :: fstarpu_mpi_get_communication_tag
  349. end function fstarpu_mpi_get_communication_tag
  350. ! void starpu_mpi_set_communication_tag(int tag);
  351. subroutine fstarpu_mpi_set_communication_tag(tag) bind(C,name="starpu_mpi_set_communication_tag")
  352. use iso_c_binding
  353. implicit none
  354. integer(c_int), value, intent(in) :: tag
  355. end subroutine fstarpu_mpi_set_communication_tag
  356. ! void starpu_mpi_data_register_comm(starpu_data_handle_t data_handle, int tag, int rank, MPI_Comm comm);
  357. subroutine fstarpu_mpi_data_register_comm(dh,tag,rank,mpi_comm) bind(C)
  358. use iso_c_binding
  359. implicit none
  360. type(c_ptr), value, intent(in) :: dh
  361. integer(c_int), value, intent(in) :: tag
  362. integer(c_int), value, intent(in) :: rank
  363. integer(c_int), value, intent(in) :: mpi_comm
  364. end subroutine fstarpu_mpi_data_register_comm
  365. ! #define starpu_mpi_data_register(data_handle, tag, rank) starpu_mpi_data_register_comm(data_handle, tag, rank, MPI_COMM_WORLD)
  366. subroutine fstarpu_mpi_data_register(dh,tag,rank) bind(C)
  367. use iso_c_binding
  368. implicit none
  369. type(c_ptr), value, intent(in) :: dh
  370. integer(c_int), value, intent(in) :: tag
  371. integer(c_int), value, intent(in) :: rank
  372. end subroutine fstarpu_mpi_data_register
  373. ! void starpu_mpi_data_set_rank_comm(starpu_data_handle_t handle, int rank, MPI_Comm comm);
  374. subroutine fstarpu_mpi_data_set_rank_comm(dh,rank,mpi_comm) bind(C)
  375. use iso_c_binding
  376. implicit none
  377. type(c_ptr), value, intent(in) :: dh
  378. integer(c_int), value, intent(in) :: rank
  379. integer(c_int), value, intent(in) :: mpi_comm
  380. end subroutine fstarpu_mpi_data_set_rank_comm
  381. ! #define starpu_mpi_data_set_rank(handle, rank) starpu_mpi_data_set_rank_comm(handle, rank, MPI_COMM_WORLD)
  382. subroutine fstarpu_mpi_data_set_rank(dh,rank) bind(C)
  383. use iso_c_binding
  384. implicit none
  385. type(c_ptr), value, intent(in) :: dh
  386. integer(c_int), value, intent(in) :: rank
  387. end subroutine fstarpu_mpi_data_set_rank
  388. ! void starpu_mpi_data_set_tag(starpu_data_handle_t handle, int tag);
  389. subroutine fstarpu_mpi_data_set_tag(dh,tag) bind(C,name="starpu_mpi_data_set_tag")
  390. use iso_c_binding
  391. implicit none
  392. type(c_ptr), value, intent(in) :: dh
  393. integer(c_int), value, intent(in) :: tag
  394. end subroutine fstarpu_mpi_data_set_tag
  395. ! int starpu_mpi_data_get_rank(starpu_data_handle_t handle);
  396. function fstarpu_mpi_data_get_rank(dh) bind(C,name="starpu_mpi_data_get_rank")
  397. use iso_c_binding
  398. implicit none
  399. integer(c_int) :: fstarpu_mpi_data_get_rank
  400. type(c_ptr), value, intent(in) :: dh
  401. end function fstarpu_mpi_data_get_rank
  402. ! int starpu_mpi_data_get_tag(starpu_data_handle_t handle);
  403. function fstarpu_mpi_data_get_tag(dh) bind(C,name="starpu_mpi_data_get_tag")
  404. use iso_c_binding
  405. implicit none
  406. integer(c_int) :: fstarpu_mpi_data_get_tag
  407. type(c_ptr), value, intent(in) :: dh
  408. end function fstarpu_mpi_data_get_tag
  409. ! void starpu_mpi_data_migrate(MPI_Comm comm, starpu_data_handle_t handle, int rank);
  410. subroutine fstarpu_mpi_data_migrate(mpi_comm,dh,rank) bind(C)
  411. use iso_c_binding
  412. implicit none
  413. integer(c_int), value, intent(in) :: mpi_comm
  414. type(c_ptr), value, intent(in) :: dh
  415. integer(c_int), value, intent(in) :: rank
  416. end subroutine fstarpu_mpi_data_migrate
  417. ! #define STARPU_MPI_NODE_SELECTION_CURRENT_POLICY -1
  418. ! #define STARPU_MPI_NODE_SELECTION_MOST_R_DATA 0
  419. ! int starpu_mpi_node_selection_register_policy(starpu_mpi_select_node_policy_func_t policy_func);
  420. function fstarpu_mpi_node_selection_register_policy(policy_func) &
  421. bind(C,name="starpu_mpi_node_selection_register_policy")
  422. use iso_c_binding
  423. implicit none
  424. integer(c_int) :: fstarpu_mpi_node_selection_register_policy
  425. type(c_funptr), value, intent(in) :: policy_func
  426. end function fstarpu_mpi_node_selection_register_policy
  427. ! int starpu_mpi_node_selection_unregister_policy(int policy);
  428. function fstarpu_mpi_node_selection_unregister_policy(policy) &
  429. bind(C,name="starpu_mpi_node_selection_unregister_policy")
  430. use iso_c_binding
  431. implicit none
  432. integer(c_int) :: fstarpu_mpi_node_selection_unregister_policy
  433. type(c_ptr), value, intent(in) :: policy
  434. end function fstarpu_mpi_node_selection_unregister_policy
  435. ! int starpu_mpi_node_selection_get_current_policy();
  436. function fstarpu_mpi_data_selection_get_current_policy() &
  437. bind(C,name="starpu_mpi_data_selection_get_current_policy")
  438. use iso_c_binding
  439. implicit none
  440. integer(c_int) :: fstarpu_mpi_data_selection_get_current_policy
  441. end function fstarpu_mpi_data_selection_get_current_policy
  442. ! int starpu_mpi_node_selection_set_current_policy(int policy);
  443. function fstarpu_mpi_data_selection_set_current_policy(policy) &
  444. bind(C,name="starpu_mpi_data_selection_set_current_policy")
  445. use iso_c_binding
  446. implicit none
  447. integer(c_int) :: fstarpu_mpi_data_selection_set_current_policy
  448. type(c_ptr), value, intent(in) :: policy
  449. end function fstarpu_mpi_data_selection_set_current_policy
  450. ! int starpu_mpi_cache_is_enabled();
  451. function fstarpu_mpi_cache_is_enabled() bind(C,name="starpu_mpi_cache_is_enabled")
  452. use iso_c_binding
  453. implicit none
  454. integer(c_int) :: fstarpu_mpi_cache_is_enabled
  455. end function fstarpu_mpi_cache_is_enabled
  456. ! int starpu_mpi_cache_set(int enabled);
  457. function fstarpu_mpi_cache_set(enabled) bind(C,name="starpu_mpi_cache_set")
  458. use iso_c_binding
  459. implicit none
  460. integer(c_int) :: fstarpu_mpi_cache_set
  461. integer(c_int), value, intent(in) :: enabled
  462. end function fstarpu_mpi_cache_set
  463. ! int starpu_mpi_wait_for_all(MPI_Comm comm);
  464. function fstarpu_mpi_wait_for_all (mpi_comm) bind(C)
  465. use iso_c_binding
  466. implicit none
  467. integer(c_int) :: fstarpu_mpi_wait_for_all
  468. integer(c_int), value, intent(in) :: mpi_comm
  469. end function fstarpu_mpi_wait_for_all
  470. ! 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);
  471. function fstarpu_mpi_datatype_register(dh, alloc_func, free_func) bind(C,name="starpu_mpi_datatype_register")
  472. use iso_c_binding
  473. implicit none
  474. integer(c_int) :: fstarpu_mpi_datatype_register
  475. type(c_ptr), value, intent(in) :: dh
  476. type(c_funptr), value, intent(in) :: alloc_func
  477. type(c_funptr), value, intent(in) :: free_func
  478. end function fstarpu_mpi_datatype_register
  479. ! int starpu_mpi_datatype_unregister(starpu_data_handle_t handle);
  480. function fstarpu_mpi_datatype_unregister(dh) bind(C,name="starpu_mpi_datatype_unregister")
  481. use iso_c_binding
  482. implicit none
  483. integer(c_int) :: fstarpu_mpi_datatype_unregister
  484. type(c_ptr), value, intent(in) :: dh
  485. end function fstarpu_mpi_datatype_unregister
  486. function fstarpu_mpi_req_alloc() bind(C)
  487. use iso_c_binding
  488. implicit none
  489. type(c_ptr) :: fstarpu_mpi_req_alloc
  490. end function fstarpu_mpi_req_alloc
  491. subroutine fstarpu_mpi_req_free(req) bind(C)
  492. use iso_c_binding
  493. implicit none
  494. type(c_ptr),value,intent(in) :: req
  495. end subroutine fstarpu_mpi_req_free
  496. function fstarpu_mpi_status_alloc() bind(C)
  497. use iso_c_binding
  498. implicit none
  499. type(c_ptr) :: fstarpu_mpi_status_alloc
  500. end function fstarpu_mpi_status_alloc
  501. subroutine fstarpu_mpi_status_free(st) bind(C)
  502. use iso_c_binding
  503. implicit none
  504. type(c_ptr),value,intent(in) :: st
  505. end subroutine fstarpu_mpi_status_free
  506. end interface
  507. contains
  508. function fstarpu_mpi_init (initialize_mpi,mpi_comm) bind(C)
  509. use iso_c_binding
  510. implicit none
  511. integer(c_int) :: fstarpu_mpi_init
  512. integer(c_int), intent(in) :: initialize_mpi
  513. integer(c_int), optional, intent(in) :: mpi_comm
  514. type(c_ptr) :: argcv
  515. integer(c_int) :: fargc,i,farg_len
  516. character(len=1) :: farg_1
  517. character(len=:), allocatable :: farg
  518. integer(c_int) :: mpi_comm_present, mpi_comm_or_0
  519. integer(c_int) :: ret
  520. interface
  521. function fstarpu_mpi_argcv_alloc(argc, initialize_mpi, comm_present, comm) bind(C)
  522. use iso_c_binding
  523. implicit none
  524. type(c_ptr) :: fstarpu_mpi_argcv_alloc
  525. integer(c_int),value,intent(in) :: argc
  526. integer(c_int),value,intent(in) :: initialize_mpi
  527. integer(c_int),value,intent(in) :: comm_present
  528. integer(c_int),value,intent(in) :: comm
  529. end function fstarpu_mpi_argcv_alloc
  530. subroutine fstarpu_mpi_argcv_set_arg(argcv, i, l, s) bind(C)
  531. use iso_c_binding
  532. implicit none
  533. type(c_ptr),value,intent(in) :: argcv
  534. integer(c_int),value,intent(in) :: i
  535. integer(c_int),value,intent(in) :: l
  536. character(c_char),intent(in) :: s
  537. end subroutine fstarpu_mpi_argcv_set_arg
  538. subroutine fstarpu_mpi_argcv_free(argcv) bind(C)
  539. use iso_c_binding
  540. implicit none
  541. type(c_ptr),value,intent(in) :: argcv
  542. end subroutine fstarpu_mpi_argcv_free
  543. function fstarpu_mpi_init_c(argcv) bind(C)
  544. use iso_c_binding
  545. implicit none
  546. integer(c_int) :: fstarpu_mpi_init_c
  547. type(c_ptr),value,intent(in) :: argcv
  548. end function fstarpu_mpi_init_c
  549. end interface
  550. fargc = command_argument_count()
  551. write(*,*) "fargc",fargc
  552. if (present(mpi_comm)) then
  553. mpi_comm_present = 1
  554. mpi_comm_or_0 = mpi_comm
  555. else
  556. mpi_comm_present = 0
  557. mpi_comm_or_0 = 0
  558. end if
  559. write(*,*) "initialize_mpi",initialize_mpi
  560. write(*,*) "mpi_comm_present",mpi_comm_present
  561. argcv = fstarpu_mpi_argcv_alloc(fargc, initialize_mpi, mpi_comm_present, mpi_comm_or_0)
  562. do i=0,fargc-1
  563. call get_command_argument(i, farg_1, farg_len)
  564. allocate (character(len=farg_len) :: farg)
  565. call get_command_argument(i, farg)
  566. call fstarpu_mpi_argcv_set_arg(argcv, i, farg_len, farg)
  567. deallocate (farg)
  568. end do
  569. ret = fstarpu_mpi_init_c(argcv)
  570. call fstarpu_mpi_argcv_free(argcv)
  571. fstarpu_mpi_init = ret
  572. end function fstarpu_mpi_init
  573. end module fstarpu_mpi_mod