X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/8bd488d2f6b7042f4a7dd2879ce490f127b16ec2..e9f0018b823e34405847177b25a85d3facc30ae1:/src/smpi/smpi_f77.c

diff --git a/src/smpi/smpi_f77.c b/src/smpi/smpi_f77.c
index a832f33a37..03e1f24f29 100644
--- a/src/smpi/smpi_f77.c
+++ b/src/smpi/smpi_f77.c
@@ -1,4 +1,4 @@
-/* Copyright (c) 2010-2014. The SimGrid Team.
+/* Copyright (c) 2010-2015. The SimGrid Team.
  * All rights reserved.                                                     */
 
 /* This program is free software; you can redistribute it and/or modify it
@@ -60,6 +60,71 @@ static char* get_key_id(char* key, int id) {
   return key;
 }
 
+
+
+static void smpi_init_fortran_types(){
+   if(!comm_lookup){
+     comm_lookup = xbt_dict_new_homogeneous(NULL);
+     smpi_comm_c2f(MPI_COMM_WORLD);
+     group_lookup = xbt_dict_new_homogeneous(NULL);
+     request_lookup = xbt_dict_new_homogeneous(NULL);
+     datatype_lookup = xbt_dict_new_homogeneous(NULL);
+     win_lookup = xbt_dict_new_homogeneous(NULL);
+     info_lookup = xbt_dict_new_homogeneous(NULL);
+     smpi_type_c2f(MPI_BYTE);
+     smpi_type_c2f(MPI_CHAR);
+     #if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__)
+     smpi_type_c2f(MPI_INT);
+     smpi_type_c2f(MPI_INT);
+     #else
+     smpi_type_c2f(MPI_LONG);
+     smpi_type_c2f(MPI_LONG);
+     #endif
+     smpi_type_c2f(MPI_INT8_T);
+     smpi_type_c2f(MPI_INT16_T);
+     smpi_type_c2f(MPI_INT32_T);
+     smpi_type_c2f(MPI_INT64_T);
+     smpi_type_c2f(MPI_FLOAT);
+     smpi_type_c2f(MPI_FLOAT);
+     smpi_type_c2f(MPI_DOUBLE);
+     smpi_type_c2f(MPI_DOUBLE);
+     smpi_type_c2f(MPI_C_FLOAT_COMPLEX);
+     smpi_type_c2f(MPI_C_DOUBLE_COMPLEX);
+     #if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__)
+     smpi_type_c2f(MPI_2INT);
+     #else
+     smpi_type_c2f(MPI_2LONG);
+     #endif
+     smpi_type_c2f(MPI_UINT8_T);
+     smpi_type_c2f(MPI_UINT16_T);
+     smpi_type_c2f(MPI_UINT32_T);
+     smpi_type_c2f(MPI_UINT64_T);
+     smpi_type_c2f(MPI_2FLOAT);
+     smpi_type_c2f(MPI_2DOUBLE);
+     smpi_type_c2f(MPI_DOUBLE);
+     smpi_type_c2f(MPI_DOUBLE);
+     smpi_type_c2f(MPI_INT);
+     smpi_type_c2f(MPI_DATATYPE_NULL);
+     smpi_type_c2f(MPI_DATATYPE_NULL);
+     smpi_type_c2f(MPI_DATATYPE_NULL);
+     smpi_type_c2f(MPI_DATATYPE_NULL);
+     op_lookup = xbt_dict_new_homogeneous(NULL);
+     smpi_op_c2f(MPI_MAX);
+     smpi_op_c2f(MPI_MIN);
+     smpi_op_c2f(MPI_MAXLOC);
+     smpi_op_c2f(MPI_MINLOC);
+     smpi_op_c2f(MPI_SUM);
+     smpi_op_c2f(MPI_PROD);
+     smpi_op_c2f(MPI_LAND);
+     smpi_op_c2f(MPI_LOR);
+     smpi_op_c2f(MPI_LXOR);
+     smpi_op_c2f(MPI_BAND);
+     smpi_op_c2f(MPI_BOR);
+     smpi_op_c2f(MPI_BXOR);
+   }
+}
+
+
 int smpi_comm_c2f(MPI_Comm comm) {
   static int comm_id = 0;
   char key[KEY_SIZE];
@@ -74,6 +139,7 @@ static void free_comm(int comm) {
 }
 
 MPI_Comm smpi_comm_f2c(int comm) {
+  smpi_init_fortran_types();
   if(comm == -2) {
     return MPI_COMM_SELF;
   }else if(comm==0){
@@ -96,6 +162,7 @@ int smpi_group_c2f(MPI_Group group) {
 }
 
 MPI_Group smpi_group_f2c(int group) {
+  smpi_init_fortran_types();
   if(group == -2) {
     return MPI_GROUP_EMPTY;
   } else if(group_lookup && group >= 0) {
@@ -121,6 +188,7 @@ int smpi_request_c2f(MPI_Request req) {
 }
 
 MPI_Request smpi_request_f2c(int req) {
+  smpi_init_fortran_types();
   char key[KEY_SIZE];
   if(req==MPI_FORTRAN_REQUEST_NULL)return MPI_REQUEST_NULL;
   return (MPI_Request)xbt_dict_get(request_lookup, get_key_id(key, req));
@@ -141,6 +209,7 @@ int smpi_type_c2f(MPI_Datatype datatype) {
 }
 
 MPI_Datatype smpi_type_f2c(int datatype) {
+  smpi_init_fortran_types();
   char key[KEY_SIZE];
   return datatype >= 0
          ? (MPI_Datatype)xbt_dict_get_or_null(datatype_lookup, get_key(key, datatype))
@@ -161,6 +230,7 @@ int smpi_op_c2f(MPI_Op op) {
 }
 
 MPI_Op smpi_op_f2c(int op) {
+  smpi_init_fortran_types();
   char key[KEY_SIZE];
    return op >= 0
           ? (MPI_Op)xbt_dict_get_or_null(op_lookup,  get_key(key, op))
@@ -181,6 +251,7 @@ int smpi_win_c2f(MPI_Win win) {
 }
 
 MPI_Win smpi_win_f2c(int win) {
+  smpi_init_fortran_types();
   char key[KEY_SIZE];
    return win >= 0
           ? (MPI_Win)xbt_dict_get_or_null(win_lookup,  get_key(key, win))
@@ -202,6 +273,7 @@ int smpi_info_c2f(MPI_Info info) {
 }
 
 MPI_Info smpi_info_f2c(int info) {
+  smpi_init_fortran_types();
   char key[KEY_SIZE];
    return info >= 0
           ? (MPI_Info)xbt_dict_get_or_null(info_lookup,  get_key(key, info))
@@ -213,68 +285,6 @@ static void free_info(int info) {
   xbt_dict_remove(info_lookup, get_key(key, info));
 }
 
-static void smpi_init_fortran_types(){
-   if(!comm_lookup){
-     comm_lookup = xbt_dict_new_homogeneous(NULL);
-     smpi_comm_c2f(MPI_COMM_WORLD);
-     group_lookup = xbt_dict_new_homogeneous(NULL);
-     request_lookup = xbt_dict_new_homogeneous(NULL);
-     datatype_lookup = xbt_dict_new_homogeneous(NULL);
-     win_lookup = xbt_dict_new_homogeneous(NULL);
-     info_lookup = xbt_dict_new_homogeneous(NULL);
-     smpi_type_c2f(MPI_BYTE);
-     smpi_type_c2f(MPI_CHAR);
-     #if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__)
-     smpi_type_c2f(MPI_INT);
-     smpi_type_c2f(MPI_INT);
-     #else
-     smpi_type_c2f(MPI_LONG);
-     smpi_type_c2f(MPI_LONG);
-     #endif
-     smpi_type_c2f(MPI_INT8_T);
-     smpi_type_c2f(MPI_INT16_T);
-     smpi_type_c2f(MPI_INT32_T);
-     smpi_type_c2f(MPI_INT64_T);
-     smpi_type_c2f(MPI_FLOAT);
-     smpi_type_c2f(MPI_FLOAT);
-     smpi_type_c2f(MPI_DOUBLE);
-     smpi_type_c2f(MPI_DOUBLE);
-     smpi_type_c2f(MPI_C_FLOAT_COMPLEX);
-     smpi_type_c2f(MPI_C_DOUBLE_COMPLEX);
-     #if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__)
-     smpi_type_c2f(MPI_2INT);
-     #else
-     smpi_type_c2f(MPI_2LONG);
-     #endif
-     smpi_type_c2f(MPI_UINT8_T);
-     smpi_type_c2f(MPI_UINT16_T);
-     smpi_type_c2f(MPI_UINT32_T);
-     smpi_type_c2f(MPI_UINT64_T);
-     smpi_type_c2f(MPI_2FLOAT);
-     smpi_type_c2f(MPI_2DOUBLE);
-     smpi_type_c2f(MPI_DOUBLE);
-     smpi_type_c2f(MPI_DOUBLE);
-     smpi_type_c2f(MPI_INT);
-     smpi_type_c2f(MPI_DATATYPE_NULL);
-     smpi_type_c2f(MPI_DATATYPE_NULL);
-     smpi_type_c2f(MPI_DATATYPE_NULL);
-     smpi_type_c2f(MPI_DATATYPE_NULL);
-     op_lookup = xbt_dict_new_homogeneous(NULL);
-     smpi_op_c2f(MPI_MAX);
-     smpi_op_c2f(MPI_MIN);
-     smpi_op_c2f(MPI_MAXLOC);
-     smpi_op_c2f(MPI_MINLOC);
-     smpi_op_c2f(MPI_SUM);
-     smpi_op_c2f(MPI_PROD);
-     smpi_op_c2f(MPI_LAND);
-     smpi_op_c2f(MPI_LOR);
-     smpi_op_c2f(MPI_LXOR);
-     smpi_op_c2f(MPI_BAND);
-     smpi_op_c2f(MPI_BOR);
-     smpi_op_c2f(MPI_BXOR);
-   }
-}
-
 
 void mpi_init_(int* ierr) {
     smpi_init_fortran_types();
@@ -379,7 +389,7 @@ void mpi_initialized_(int* flag, int* ierr){
 void mpi_send_init_(void *buf, int* count, int* datatype, int* dst, int* tag,
                      int* comm, int* request, int* ierr) {
   MPI_Request req;
-
+  buf = (char *) FORT_BOTTOM(buf);
   *ierr = MPI_Send_init(buf, *count, smpi_type_f2c(*datatype), *dst, *tag,
                         smpi_comm_f2c(*comm), &req);
   if(*ierr == MPI_SUCCESS) {
@@ -411,12 +421,14 @@ void mpi_irsend_(void *buf, int* count, int* datatype, int* dst,
 
 void mpi_send_(void* buf, int* count, int* datatype, int* dst,
                 int* tag, int* comm, int* ierr) {
+  buf = (char *) FORT_BOTTOM(buf);
    *ierr = MPI_Send(buf, *count, smpi_type_f2c(*datatype), *dst, *tag,
                     smpi_comm_f2c(*comm));
 }
 
 void mpi_rsend_(void* buf, int* count, int* datatype, int* dst,
                 int* tag, int* comm, int* ierr) {
+  buf = (char *) FORT_BOTTOM(buf);
    *ierr = MPI_Rsend(buf, *count, smpi_type_f2c(*datatype), *dst, *tag,
                     smpi_comm_f2c(*comm));
 }
@@ -425,6 +437,8 @@ void mpi_sendrecv_(void* sendbuf, int* sendcount, int* sendtype, int* dst,
                 int* sendtag, void *recvbuf, int* recvcount,
                 int* recvtype, int* src, int* recvtag,
                 int* comm, MPI_Status* status, int* ierr) {
+  sendbuf = (char *) FORT_BOTTOM(sendbuf);
+  recvbuf = (char *) FORT_BOTTOM(recvbuf);
    *ierr = MPI_Sendrecv(sendbuf, *sendcount, smpi_type_f2c(*sendtype), *dst,
        *sendtag, recvbuf, *recvcount,smpi_type_f2c(*recvtype), *src, *recvtag,
        smpi_comm_f2c(*comm), FORT_STATUS_IGNORE(status));
@@ -433,7 +447,7 @@ void mpi_sendrecv_(void* sendbuf, int* sendcount, int* sendtype, int* dst,
 void mpi_recv_init_(void *buf, int* count, int* datatype, int* src, int* tag,
                      int* comm, int* request, int* ierr) {
   MPI_Request req;
-
+  buf = (char *) FORT_BOTTOM(buf);
   *ierr = MPI_Recv_init(buf, *count, smpi_type_f2c(*datatype), *src, *tag,
                         smpi_comm_f2c(*comm), &req);
   if(*ierr == MPI_SUCCESS) {
@@ -454,7 +468,8 @@ void mpi_irecv_(void *buf, int* count, int* datatype, int* src, int* tag,
 
 void mpi_recv_(void* buf, int* count, int* datatype, int* src,
                 int* tag, int* comm, MPI_Status* status, int* ierr) {
-   *ierr = MPI_Recv(buf, *count, smpi_type_f2c(*datatype), *src, *tag,
+  buf = (char *) FORT_BOTTOM(buf);
+  *ierr = MPI_Recv(buf, *count, smpi_type_f2c(*datatype), *src, *tag,
                     smpi_comm_f2c(*comm), status);
 }
 
@@ -748,6 +763,22 @@ void mpi_win_create_( int *base, MPI_Aint* size, int* disp_unit, int* info, int*
  }
 }
 
+void mpi_win_post_(int* group, int assert, int* win, int* ierr){
+  *ierr =  MPI_Win_post(smpi_group_f2c(*group), assert, smpi_win_f2c(*win));
+}
+
+void mpi_win_start_(int* group, int assert, int* win, int* ierr){
+  *ierr =  MPI_Win_start(smpi_group_f2c(*group), assert, smpi_win_f2c(*win));
+}
+
+void mpi_win_complete_(int* win, int* ierr){
+  *ierr =  MPI_Win_complete(smpi_win_f2c(*win));
+}
+
+void mpi_win_wait_(int* win, int* ierr){
+  *ierr =  MPI_Win_wait(smpi_win_f2c(*win));
+}
+
 void mpi_win_set_name_ (int*  win, char * name, int* ierr, int size){
  //handle trailing blanks
  while(name[size-1]==' ')size--;
@@ -1341,18 +1372,30 @@ void mpi_type_create_indexed_block_ (int* count, int* blocklength, int* indices,
 
 void mpi_type_struct_ (int* count, int* blocklens, MPI_Aint* indices, int* old_types, int*  newtype, int* ierr) {
   MPI_Datatype tmp;
-  *ierr = MPI_Type_struct(*count, blocklens, indices, (MPI_Datatype*)old_types, &tmp);
+  int i=0;
+  MPI_Datatype* types = (MPI_Datatype*)xbt_malloc(*count*sizeof(MPI_Datatype));
+  for(i=0; i< *count; i++){
+    types[i] = smpi_type_f2c(old_types[i]);
+  }
+  *ierr = MPI_Type_struct(*count, blocklens, indices, types, &tmp);
   if(*ierr == MPI_SUCCESS) {
     *newtype = smpi_type_c2f(tmp);
   }
+  xbt_free(types);
 }
 
 void mpi_type_create_struct_ (int* count, int* blocklens, MPI_Aint* indices, int*  old_types, int*  newtype, int* ierr) {
   MPI_Datatype tmp;
-  *ierr = MPI_Type_create_struct(*count, blocklens, indices, (MPI_Datatype*)old_types, &tmp);
+  int i=0;
+  MPI_Datatype* types = (MPI_Datatype*)xbt_malloc(*count*sizeof(MPI_Datatype));
+  for(i=0; i< *count; i++){
+    types[i] = smpi_type_f2c(old_types[i]);
+  }
+  *ierr = MPI_Type_create_struct(*count, blocklens, indices, types, &tmp);
   if(*ierr == MPI_SUCCESS) {
     *newtype = smpi_type_c2f(tmp);
   }
+  xbt_free(types);
 }
 
 void mpi_ssend_ (void* buf, int* count, int* datatype, int* dest, int* tag, int* comm, int* ierr) {
@@ -1729,3 +1772,4 @@ void mpi_comm_get_parent_ ( int* parent, int* ierr){
     *parent = smpi_comm_c2f(tmp);
   }
 }
+