collective.c 8.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428
  1. #include "mpiP.h"
  2. /*
  3. * COLLECTIVE
  4. */
  5. FC_FUNC( mpi_barrier , MPI_BARRIER )(int *comm, int *ierror)
  6. {
  7. *ierror=MPI_Barrier( *comm );
  8. }
  9. int MPI_Barrier(MPI_Comm comm )
  10. {
  11. return(MPI_SUCCESS);
  12. }
  13. /*********/
  14. FC_FUNC( mpi_bcast , MPI_BCAST )(void *buffer, int *count, int *datatype,
  15. int *root, int *comm, int *ierror )
  16. {
  17. *ierror=MPI_Bcast(buffer, *count, *datatype, *root, *comm);
  18. }
  19. int MPI_Bcast(void* buffer, int count, MPI_Datatype datatype,
  20. int root, MPI_Comm comm )
  21. {
  22. if (root==MPI_ROOT)
  23. return(MPI_SUCCESS);
  24. if (root!=0)
  25. {
  26. fprintf(stderr,"MPI_Bcast: bad root = %d\n",root);
  27. abort();
  28. }
  29. return(MPI_SUCCESS);
  30. }
  31. /*********/
  32. FC_FUNC( mpi_gather , MPI_GATHER )
  33. (void *sendbuf, int *sendcount, int *sendtype,
  34. void *recvbuf, int *recvcount, int *recvtype,
  35. int *root, int *comm, int *ierror)
  36. {
  37. *ierror=MPI_Gather( sendbuf, *sendcount, *sendtype,
  38. recvbuf, *recvcount, *recvtype,
  39. *root, *comm);
  40. }
  41. int MPI_Gather(void* sendbuf, int sendcount, MPI_Datatype sendtype,
  42. void* recvbuf, int recvcount, MPI_Datatype recvtype,
  43. int root, MPI_Comm comm)
  44. {
  45. if (root==MPI_ROOT)
  46. return(MPI_SUCCESS);
  47. if (root!=0)
  48. {
  49. fprintf(stderr,"MPI_Gather: bad root = %d\n",root);
  50. abort();
  51. }
  52. memcpy(recvbuf,sendbuf,sendcount*sendtype);
  53. return(MPI_SUCCESS);
  54. }
  55. /*********/
  56. FC_FUNC( mpi_gatherv , MPI_GATHERV )
  57. ( void *sendbuf, int *sendcount, int *sendtype,
  58. void *recvbuf, int *recvcounts, int *displs,
  59. int *recvtype, int *root, int *comm, int *ierror)
  60. {
  61. *ierror=MPI_Gatherv( sendbuf, *sendcount, *sendtype,
  62. recvbuf, recvcounts, displs,
  63. *recvtype, *root, *comm);
  64. }
  65. int MPI_Gatherv(void* sendbuf, int sendcount, MPI_Datatype sendtype,
  66. void* recvbuf, int *recvcounts, int *displs,
  67. MPI_Datatype recvtype, int root, MPI_Comm comm)
  68. {
  69. int offset;
  70. if (root==MPI_ROOT)
  71. return(MPI_SUCCESS);
  72. if (root!=0)
  73. {
  74. fprintf(stderr,"MPI_Gatherv: bad root = %d\n",root);
  75. abort();
  76. }
  77. offset=displs[0]*recvtype;
  78. memcpy( (char *)recvbuf+offset, sendbuf, recvcounts[0] * recvtype);
  79. return(MPI_SUCCESS);
  80. }
  81. /*********/
  82. FC_FUNC( mpi_allgather , MPI_ALLGATHER )
  83. ( void *sendbuf, int *sendcount, int *sendtype,
  84. void *recvbuf, int *recvcount, int *recvtype,
  85. int *comm, int *ierror)
  86. {
  87. *ierror=MPI_Allgather( sendbuf, *sendcount, *sendtype,
  88. recvbuf, *recvcount, *recvtype,
  89. *comm );
  90. }
  91. int MPI_Allgather(void* sendbuf, int sendcount, MPI_Datatype sendtype,
  92. void* recvbuf, int recvcount, MPI_Datatype recvtype,
  93. MPI_Comm comm)
  94. {
  95. memcpy(recvbuf,sendbuf,sendcount * sendtype);
  96. return(MPI_SUCCESS);
  97. }
  98. /*********/
  99. FC_FUNC( mpi_allgatherv , MPI_ALLGATHERV )
  100. ( void *sendbuf, int *sendcount, int *sendtype,
  101. void *recvbuf, int *recvcounts, int *displs,
  102. int *recvtype, int *comm, int *ierror)
  103. {
  104. *ierror=MPI_Allgatherv( sendbuf, *sendcount, *sendtype,
  105. recvbuf, recvcounts, displs,
  106. *recvtype, *comm );
  107. }
  108. int MPI_Allgatherv(void* sendbuf, int sendcount, MPI_Datatype sendtype,
  109. void* recvbuf, int *recvcounts, int *displs,
  110. MPI_Datatype recvtype, MPI_Comm comm)
  111. {
  112. int offset;
  113. offset=displs[0]*recvtype;
  114. memcpy( (char *)recvbuf+offset, sendbuf, recvcounts[0] * recvtype);
  115. return(MPI_SUCCESS);
  116. }
  117. /*********/
  118. FC_FUNC( mpi_scatter , MPI_SCATTER )
  119. ( void *sendbuf, int *sendcount, int *sendtype,
  120. void *recvbuf, int *recvcount, int *recvtype,
  121. int *root, int *comm, int *ierror)
  122. {
  123. *ierror=MPI_Scatter( sendbuf, *sendcount, *sendtype,
  124. recvbuf, *recvcount, *recvtype,
  125. *root, *comm);
  126. }
  127. int MPI_Scatter( void* sendbuf, int sendcount, MPI_Datatype sendtype,
  128. void* recvbuf, int recvcount, MPI_Datatype recvtype,
  129. int root, MPI_Comm comm)
  130. {
  131. if (root==MPI_ROOT)
  132. return(MPI_SUCCESS);
  133. if (root!=0)
  134. {
  135. fprintf(stderr,"MPI_Scatter: bad root = %d\n",root);
  136. abort();
  137. }
  138. memcpy(recvbuf,sendbuf,sendcount * sendtype);
  139. return(MPI_SUCCESS);
  140. }
  141. /*********/
  142. FC_FUNC( mpi_scatterv , MPI_SCATTERV )
  143. ( void *sendbuf, int *sendcounts, int *displs,
  144. int *sendtype, void *recvbuf, int *recvcount,
  145. int *recvtype, int *root, int *comm, int *ierror)
  146. {
  147. *ierror=MPI_Scatterv(sendbuf, sendcounts, displs,
  148. *sendtype, recvbuf, *recvcount,
  149. *recvtype, *root, *comm);
  150. }
  151. int MPI_Scatterv(void* sendbuf, int *sendcounts, int *displs,
  152. MPI_Datatype sendtype, void* recvbuf, int recvcount,
  153. MPI_Datatype recvtype, int root, MPI_Comm comm)
  154. {
  155. int offset;
  156. if (root==MPI_ROOT)
  157. return(MPI_SUCCESS);
  158. if (root!=0)
  159. {
  160. fprintf(stderr,"MPI_Scatterv: bad root = %d\n",root);
  161. abort();
  162. }
  163. offset=displs[0]*sendtype;
  164. memcpy(recvbuf,(char *)sendbuf+offset,sendcounts[0] * sendtype);
  165. return(MPI_SUCCESS);
  166. }
  167. /*********/
  168. FC_FUNC( mpi_reduce , MPI_REDUCE )
  169. ( void *sendbuf, void *recvbuf, int *count,
  170. int *datatype, int *op, int *root, int *comm,
  171. int *ierror)
  172. {
  173. *ierror=MPI_Reduce(sendbuf, recvbuf, *count,
  174. *datatype, *op, *root, *comm);
  175. }
  176. int MPI_Reduce(void* sendbuf, void* recvbuf, int count,
  177. MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm)
  178. {
  179. if (root==MPI_ROOT)
  180. return(MPI_SUCCESS);
  181. if (root!=0)
  182. {
  183. fprintf(stderr,"MPI_Reduce: bad root = %d\n",root);
  184. abort();
  185. }
  186. memcpy(recvbuf,sendbuf,count * datatype);
  187. return(MPI_SUCCESS);
  188. }
  189. /*********/
  190. FC_FUNC( mpi_allreduce , MPI_ALLREDUCE )
  191. ( void *sendbuf, void *recvbuf, int *count,
  192. int *datatype, int *op, int *comm, int *ierror)
  193. {
  194. *ierror=MPI_Allreduce(sendbuf, recvbuf, *count,
  195. *datatype, *op, *comm);
  196. }
  197. int MPI_Allreduce(void* sendbuf, void* recvbuf, int count,
  198. MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
  199. {
  200. memcpy(recvbuf,sendbuf,count * datatype);
  201. return(MPI_SUCCESS);
  202. }
  203. /*********/
  204. FC_FUNC( mpi_scan , MPI_SCAN )
  205. ( void *sendbuf, void *recvbuf, int *count,
  206. int *datatype, int *op, int *comm,
  207. int *ierror)
  208. {
  209. *ierror=MPI_Scan( sendbuf, recvbuf, *count,
  210. *datatype, *op, *comm);
  211. }
  212. int MPI_Scan( void* sendbuf, void* recvbuf, int count,
  213. MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
  214. {
  215. memcpy(recvbuf,sendbuf,count * datatype);
  216. return(MPI_SUCCESS);
  217. }
  218. /*********/
  219. FC_FUNC( mpi_alltoall , MPI_ALLTOALL )
  220. ( void *sendbuf, int *sendcount, int *sendtype,
  221. void *recvbuf, int *recvcount, int *recvtype,
  222. int *comm, int *ierror )
  223. {
  224. *ierror=MPI_Alltoall(sendbuf, *sendcount, *sendtype,
  225. recvbuf, *recvcount, *recvtype,
  226. *comm);
  227. }
  228. int MPI_Alltoall(void *sendbuf, int sendcount, MPI_Datatype sendtype,
  229. void *recvbuf, int recvcount, MPI_Datatype recvtype,
  230. MPI_Comm comm)
  231. {
  232. memcpy(recvbuf,sendbuf,sendcount * sendtype);
  233. return(MPI_SUCCESS);
  234. }
  235. /*********/
  236. FC_FUNC( mpi_alltoallv , MPI_ALLTOALLV )
  237. ( void *sendbuf, int *sendcounts, int *sdispls, int *sendtype,
  238. void *recvbuf, int *recvcounts, int *rdispls, int *recvtype,
  239. int *comm, int *ierror )
  240. {
  241. *ierror=MPI_Alltoallv(sendbuf, sendcounts, sdispls, *sendtype,
  242. recvbuf, recvcounts, rdispls, *recvtype,
  243. *comm);
  244. }
  245. int MPI_Alltoallv(void *sendbuf, int *sendcounts,
  246. int *sdispls, MPI_Datatype sendtype,
  247. void *recvbuf, int *recvcounts,
  248. int *rdispls, MPI_Datatype recvtype,
  249. MPI_Comm comm)
  250. {
  251. int send_offset;
  252. int recv_offset;
  253. send_offset=sdispls[0]*sendtype;
  254. recv_offset=rdispls[0]*recvtype;
  255. memcpy( (char *)recvbuf+recv_offset, (char *)sendbuf+send_offset,
  256. sendcounts[0] * sendtype);
  257. return(MPI_SUCCESS);
  258. }
  259. /*********/
  260. FC_FUNC( mpi_op_create , MPI_OP_CREATE )
  261. ( void *function, int *commute, int *op, int *ierror )
  262. {
  263. *ierror=MPI_Op_create(function,*commute,op);
  264. }
  265. int MPI_Op_create(MPI_User_function *function, int commute, MPI_Op *op)
  266. {
  267. *op=MPI_OP_NULL;
  268. return(MPI_SUCCESS);
  269. }
  270. /*********/
  271. MPI_Op MPI_Op_f2c(MPI_Fint op)
  272. {
  273. return(op);
  274. }
  275. /*********/
  276. MPI_Fint MPI_Op_c2f(MPI_Op op)
  277. {
  278. return(op);
  279. }