src/smpi/bindings/smpi_f77_request.cpp

   1 /* Copyright (c) 2010-2019. The SimGrid Team. All rights reserved.          */
   2
   3 /* This program is free software; you can redistribute it and/or modify it
   4  * under the terms of the license (GNU LGPL) which comes with this package. */
   5
   6 #include "private.hpp"
   7 #include "smpi_comm.hpp"
   8 #include "smpi_datatype.hpp"
   9 #include "smpi_request.hpp"
  10
  11
  12 extern "C" { // This should really use the C linkage to be usable from Fortran
  13
  14 void mpi_send_init_(void *buf, int* count, int* datatype, int* dst, int* tag, int* comm, int* request, int* ierr) {
  15   MPI_Request req;
  16   buf = static_cast<char *>(FORT_BOTTOM(buf));
  17   *ierr = MPI_Send_init(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dst, *tag, simgrid::smpi::Comm::f2c(*comm), &req);
  18   if(*ierr == MPI_SUCCESS) {
  19     *request = req->add_f();
  20   }
  21 }
  22
  23 void mpi_isend_(void *buf, int* count, int* datatype, int* dst, int* tag, int* comm, int* request, int* ierr) {
  24   MPI_Request req;
  25   buf = static_cast<char *>(FORT_BOTTOM(buf));
  26   *ierr = MPI_Isend(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dst, *tag, simgrid::smpi::Comm::f2c(*comm), &req);
  27   if(*ierr == MPI_SUCCESS) {
  28     *request = req->add_f();
  29   }
  30 }
  31
  32 void mpi_irsend_(void *buf, int* count, int* datatype, int* dst, int* tag, int* comm, int* request, int* ierr) {
  33   MPI_Request req;
  34   buf = static_cast<char *>(FORT_BOTTOM(buf));
  35   *ierr = MPI_Irsend(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dst, *tag, simgrid::smpi::Comm::f2c(*comm), &req);
  36   if(*ierr == MPI_SUCCESS) {
  37     *request = req->add_f();
  38   }
  39 }
  40
  41 void mpi_send_(void* buf, int* count, int* datatype, int* dst, int* tag, int* comm, int* ierr) {
  42   buf = static_cast<char *>(FORT_BOTTOM(buf));
  43    *ierr = MPI_Send(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dst, *tag, simgrid::smpi::Comm::f2c(*comm));
  44 }
  45
  46 void mpi_rsend_(void* buf, int* count, int* datatype, int* dst, int* tag, int* comm, int* ierr) {
  47   buf = static_cast<char *>(FORT_BOTTOM(buf));
  48    *ierr = MPI_Rsend(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dst, *tag, simgrid::smpi::Comm::f2c(*comm));
  49 }
  50
  51 void mpi_sendrecv_(void* sendbuf, int* sendcount, int* sendtype, int* dst, int* sendtag, void *recvbuf, int* recvcount,
  52                    int* recvtype, int* src, int* recvtag, int* comm, MPI_Status* status, int* ierr) {
  53   sendbuf = static_cast<char *>( FORT_BOTTOM(sendbuf));
  54   recvbuf = static_cast<char *>( FORT_BOTTOM(recvbuf));
  55    *ierr = MPI_Sendrecv(sendbuf, *sendcount, simgrid::smpi::Datatype::f2c(*sendtype), *dst, *sendtag, recvbuf, *recvcount,
  56                         simgrid::smpi::Datatype::f2c(*recvtype), *src, *recvtag, simgrid::smpi::Comm::f2c(*comm), FORT_STATUS_IGNORE(status));
  57 }
  58
  59 void mpi_recv_init_(void *buf, int* count, int* datatype, int* src, int* tag, int* comm, int* request, int* ierr) {
  60   MPI_Request req;
  61   buf = static_cast<char *>( FORT_BOTTOM(buf));
  62   *ierr = MPI_Recv_init(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *src, *tag, simgrid::smpi::Comm::f2c(*comm), &req);
  63   if(*ierr == MPI_SUCCESS) {
  64     *request = req->add_f();
  65   }
  66 }
  67
  68 void mpi_irecv_(void *buf, int* count, int* datatype, int* src, int* tag, int* comm, int* request, int* ierr) {
  69   MPI_Request req;
  70   buf = static_cast<char *>( FORT_BOTTOM(buf));
  71   *ierr = MPI_Irecv(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *src, *tag, simgrid::smpi::Comm::f2c(*comm), &req);
  72   if(*ierr == MPI_SUCCESS) {
  73     *request = req->add_f();
  74   }
  75 }
  76
  77 void mpi_recv_(void* buf, int* count, int* datatype, int* src, int* tag, int* comm, MPI_Status* status, int* ierr) {
  78   buf = static_cast<char *>( FORT_BOTTOM(buf));
  79   *ierr = MPI_Recv(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *src, *tag, simgrid::smpi::Comm::f2c(*comm), status);
  80 }
  81
  82 void mpi_sendrecv_replace_ (void *buf, int* count, int* datatype, int* dst, int* sendtag, int* src, int* recvtag,
  83                             int* comm, MPI_Status* status, int* ierr)
  84 {
  85  *ierr = MPI_Sendrecv_replace(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dst, *sendtag, *src,
  86  *recvtag, simgrid::smpi::Comm::f2c(*comm), FORT_STATUS_IGNORE(status));
  87 }
  88
  89 void mpi_ssend_ (void* buf, int* count, int* datatype, int* dest, int* tag, int* comm, int* ierr) {
  90  *ierr = MPI_Ssend(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dest, *tag, simgrid::smpi::Comm::f2c(*comm));
  91 }
  92
  93 void mpi_ssend_init_ (void* buf, int* count, int* datatype, int* dest, int* tag, int* comm, int* request, int* ierr) {
  94   MPI_Request tmp;
  95  *ierr = MPI_Ssend_init(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dest, *tag, simgrid::smpi::Comm::f2c(*comm), &tmp);
  96  if(*ierr == MPI_SUCCESS) {
  97    *request = tmp->add_f();
  98  }
  99 }
 100
 101 void mpi_bsend_ (void* buf, int* count, int* datatype, int *dest, int* tag, int* comm, int* ierr) {
 102  *ierr = MPI_Bsend(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dest, *tag, simgrid::smpi::Comm::f2c(*comm));
 103 }
 104
 105 void mpi_bsend_init_ (void* buf, int* count, int* datatype, int *dest, int* tag, int* comm, int*  request, int* ierr) {
 106   MPI_Request tmp;
 107   *ierr = MPI_Bsend_init(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dest, *tag, simgrid::smpi::Comm::f2c(*comm), &tmp);
 108  if(*ierr == MPI_SUCCESS) {
 109    *request = tmp->add_f();
 110  }
 111 }
 112
 113 void mpi_ibsend_ (void* buf, int* count, int* datatype, int *dest, int* tag, int* comm, int*  request, int* ierr) {
 114   MPI_Request tmp;
 115   *ierr = MPI_Ibsend(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dest, *tag, simgrid::smpi::Comm::f2c(*comm), &tmp);
 116  if(*ierr == MPI_SUCCESS) {
 117    *request = tmp->add_f();
 118  }
 119 }
 120
 121 void mpi_issend_ (void* buf, int* count, int* datatype, int *dest, int* tag, int* comm, int*  request, int* ierr) {
 122   MPI_Request tmp;
 123   *ierr = MPI_Issend(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dest, *tag, simgrid::smpi::Comm::f2c(*comm), &tmp);
 124  if(*ierr == MPI_SUCCESS) {
 125    *request = tmp->add_f();
 126  }
 127 }
 128
 129 void mpi_rsend_init_ (void* buf, int* count, int* datatype, int *dest, int* tag, int* comm, int*  request, int* ierr) {
 130   MPI_Request tmp;
 131   *ierr = MPI_Rsend_init(buf, *count, simgrid::smpi::Datatype::f2c(*datatype), *dest, *tag, simgrid::smpi::Comm::f2c(*comm), &tmp);
 132  if(*ierr == MPI_SUCCESS) {
 133    *request = tmp->add_f();
 134  }
 135 }
 136
 137 void mpi_start_(int* request, int* ierr) {
 138   MPI_Request req = simgrid::smpi::Request::f2c(*request);
 139
 140   *ierr = MPI_Start(&req);
 141 }
 142
 143 void mpi_startall_(int* count, int* requests, int* ierr) {
 144   MPI_Request* reqs;
 145   int i;
 146
 147   reqs = xbt_new(MPI_Request, *count);
 148   for(i = 0; i < *count; i++) {
 149     reqs[i] = simgrid::smpi::Request::f2c(requests[i]);
 150   }
 151   *ierr = MPI_Startall(*count, reqs);
 152   xbt_free(reqs);
 153 }
 154
 155 void mpi_wait_(int* request, MPI_Status* status, int* ierr) {
 156    MPI_Request req = simgrid::smpi::Request::f2c(*request);
 157
 158    *ierr = MPI_Wait(&req, FORT_STATUS_IGNORE(status));
 159    if(req==MPI_REQUEST_NULL){
 160      simgrid::smpi::Request::free_f(*request);
 161      *request=MPI_FORTRAN_REQUEST_NULL;
 162    }
 163 }
 164
 165 void mpi_waitany_(int* count, int* requests, int* index, MPI_Status* status, int* ierr) {
 166   MPI_Request* reqs;
 167   int i;
 168
 169   reqs = xbt_new(MPI_Request, *count);
 170   for(i = 0; i < *count; i++) {
 171     reqs[i] = simgrid::smpi::Request::f2c(requests[i]);
 172   }
 173   *ierr = MPI_Waitany(*count, reqs, index, status);
 174   if(*index!=MPI_UNDEFINED){
 175     if(reqs[*index]==MPI_REQUEST_NULL){
 176         simgrid::smpi::Request::free_f(requests[*index]);
 177         requests[*index]=MPI_FORTRAN_REQUEST_NULL;
 178     }
 179   *index=*index+1;
 180   }
 181   xbt_free(reqs);
 182 }
 183
 184 void mpi_waitall_(int* count, int* requests, MPI_Status* status, int* ierr) {
 185   MPI_Request* reqs;
 186   int i;
 187
 188   reqs = xbt_new(MPI_Request, *count);
 189   for(i = 0; i < *count; i++) {
 190     reqs[i] = simgrid::smpi::Request::f2c(requests[i]);
 191   }
 192   *ierr = MPI_Waitall(*count, reqs, FORT_STATUSES_IGNORE(status));
 193   for(i = 0; i < *count; i++) {
 194       if(reqs[i]==MPI_REQUEST_NULL){
 195           simgrid::smpi::Request::free_f(requests[i]);
 196           requests[i]=MPI_FORTRAN_REQUEST_NULL;
 197       }
 198   }
 199
 200   xbt_free(reqs);
 201 }
 202
 203 void mpi_waitsome_ (int* incount, int* requests, int *outcount, int *indices, MPI_Status* status, int* ierr)
 204 {
 205   MPI_Request* reqs;
 206   int i;
 207
 208   reqs = xbt_new(MPI_Request, *incount);
 209   for(i = 0; i < *incount; i++) {
 210     reqs[i] = simgrid::smpi::Request::f2c(requests[i]);
 211   }
 212   *ierr = MPI_Waitsome(*incount, reqs, outcount, indices, status);
 213   for(i=0;i<*outcount;i++){
 214     if(reqs[indices[i]]==MPI_REQUEST_NULL){
 215         simgrid::smpi::Request::free_f(requests[indices[i]]);
 216         requests[indices[i]]=MPI_FORTRAN_REQUEST_NULL;
 217     }
 218   }
 219   xbt_free(reqs);
 220 }
 221
 222 void mpi_test_ (int * request, int *flag, MPI_Status * status, int* ierr){
 223   MPI_Request req = simgrid::smpi::Request::f2c(*request);
 224   *ierr= MPI_Test(&req, flag, FORT_STATUS_IGNORE(status));
 225   if(req==MPI_REQUEST_NULL){
 226       simgrid::smpi::Request::free_f(*request);
 227       *request=MPI_FORTRAN_REQUEST_NULL;
 228   }
 229 }
 230
 231 void mpi_testall_ (int* count, int * requests,  int *flag, MPI_Status * statuses, int* ierr){
 232   int i;
 233   MPI_Request* reqs = xbt_new(MPI_Request, *count);
 234   for(i = 0; i < *count; i++) {
 235     reqs[i] = simgrid::smpi::Request::f2c(requests[i]);
 236   }
 237   *ierr= MPI_Testall(*count, reqs, flag, FORT_STATUSES_IGNORE(statuses));
 238   for(i = 0; i < *count; i++) {
 239     if(reqs[i]==MPI_REQUEST_NULL){
 240         simgrid::smpi::Request::free_f(requests[i]);
 241         requests[i]=MPI_FORTRAN_REQUEST_NULL;
 242     }
 243   }
 244   xbt_free(reqs);
 245 }
 246
 247 void mpi_testany_ (int* count, int* requests, int *index, int *flag, MPI_Status* status, int* ierr)
 248 {
 249   MPI_Request* reqs;
 250   int i;
 251
 252   reqs = xbt_new(MPI_Request, *count);
 253   for(i = 0; i < *count; i++) {
 254     reqs[i] = simgrid::smpi::Request::f2c(requests[i]);
 255   }
 256   *ierr = MPI_Testany(*count, reqs, index, flag, FORT_STATUS_IGNORE(status));
 257   if(*index!=MPI_UNDEFINED){
 258     if(reqs[*index]==MPI_REQUEST_NULL){
 259     simgrid::smpi::Request::free_f(requests[*index]);
 260     requests[*index]=MPI_FORTRAN_REQUEST_NULL;
 261     }
 262   *index=*index+1;
 263   }
 264   xbt_free(reqs);
 265 }
 266
 267 void mpi_testsome_ (int* incount, int*  requests, int* outcount, int* indices, MPI_Status*  statuses, int* ierr) {
 268   MPI_Request* reqs;
 269   int i;
 270
 271   reqs = xbt_new(MPI_Request, *incount);
 272   for(i = 0; i < *incount; i++) {
 273     reqs[i] = simgrid::smpi::Request::f2c(requests[i]);
 274     indices[i]=0;
 275   }
 276   *ierr = MPI_Testsome(*incount, reqs, outcount, indices, FORT_STATUSES_IGNORE(statuses));
 277   for(i=0;i<*incount;i++){
 278     if(indices[i] && reqs[indices[i]]==MPI_REQUEST_NULL){
 279       simgrid::smpi::Request::free_f(requests[indices[i]]);
 280       requests[indices[i]]=MPI_FORTRAN_REQUEST_NULL;
 281     }
 282   }
 283   xbt_free(reqs);
 284 }
 285
 286 void mpi_probe_ (int* source, int* tag, int* comm, MPI_Status*  status, int* ierr) {
 287  *ierr = MPI_Probe(*source, *tag, simgrid::smpi::Comm::f2c(*comm), FORT_STATUS_IGNORE(status));
 288 }
 289
 290
 291 void mpi_iprobe_ (int* source, int* tag, int* comm, int* flag, MPI_Status*  status, int* ierr) {
 292  *ierr = MPI_Iprobe(*source, *tag, simgrid::smpi::Comm::f2c(*comm), flag, status);
 293 }
 294
 295 }