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

diff --git a/src/smpi/smpi_f77.c b/src/smpi/smpi_f77.c
index e6e20f229c..e4c23e812f 100644
--- a/src/smpi/smpi_f77.c
+++ b/src/smpi/smpi_f77.c
@@ -1,8 +1,8 @@
-/* Copyright (c) 2010. The SimGrid Team.
+/* Copyright (c) 2010-2014. The SimGrid Team.
  * All rights reserved.                                                     */
 
 /* This program is free software; you can redistribute it and/or modify it
-  * under the terms of the license (GNU LGPL) which comes with this package. */
+ * under the terms of the license (GNU LGPL) which comes with this package. */
 
 #include <limits.h>
 #include <stdio.h>
@@ -10,120 +10,204 @@
 #include "private.h"
 #include "xbt.h"
 
-extern int xargc;
-extern char** xargv;
-
-static xbt_dynar_t comm_lookup = NULL;
-static xbt_dynar_t group_lookup = NULL;
+static xbt_dict_t comm_lookup = NULL;
+static xbt_dict_t group_lookup = NULL;
 static xbt_dict_t request_lookup = NULL;
-static xbt_dynar_t datatype_lookup = NULL;
-static xbt_dynar_t op_lookup = NULL;
+static xbt_dict_t datatype_lookup = NULL;
+static xbt_dict_t op_lookup = NULL;
+static xbt_dict_t win_lookup = NULL;
+static int running_processes = 0;
+
+#if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__)
+typedef int integer;
+typedef unsigned int uinteger;
+#else
+typedef long int integer;
+typedef unsigned long int uinteger;
+#endif
+
+/* Bindings for MPI special values */
+
+  struct s_smpi_common {
+    integer _MPI_IN_PLACE;
+    integer _MPI_BOTTOM;
+    integer _MPI_STATUS_IGNORE;
+    integer _MPI_STATUSES_IGNORE;
+  } smpi_;
+
+
+
+/* Convert between Fortran and C */
+#define FORT_ADDR(addr, val)                                         \
+  (((void *)(addr) == (void*) &(smpi_._ ## val))                  \
+   ? (val) : (void *)(addr))
+#define FORT_BOTTOM(addr)          FORT_ADDR(addr, MPI_BOTTOM)
+#define FORT_IN_PLACE(addr)        FORT_ADDR(addr, MPI_IN_PLACE)
+#define FORT_STATUS_IGNORE(addr)   FORT_ADDR(addr, MPI_STATUS_IGNORE)
+#define FORT_STATUSES_IGNORE(addr) FORT_ADDR(addr, MPI_STATUSES_IGNORE)
 
 #define KEY_SIZE (sizeof(int) * 2 + 1)
 
+
+static char* get_key(char* key, int id) {
+  snprintf(key, KEY_SIZE, "%x",id);
+  return key;
+}
+static char* get_key_id(char* key, int id) {
+  snprintf(key, KEY_SIZE, "%x_%d",id, smpi_process_index());
+  return key;
+}
+
 static int new_comm(MPI_Comm comm) {
-  xbt_dynar_push(comm_lookup, &comm);
-  return (int)xbt_dynar_length(comm_lookup) - 1;
+  static int comm_id = 0;
+  char key[KEY_SIZE];
+  xbt_dict_set(comm_lookup, comm==MPI_COMM_WORLD? get_key(key, comm_id) : get_key_id(key, comm_id), comm, NULL);
+  comm_id++;
+  return comm_id-1;
 }
 
 static void free_comm(int comm) {
-  xbt_dynar_remove_at(comm_lookup, comm, NULL);
+  char key[KEY_SIZE];
+  xbt_dict_remove(comm_lookup, comm==0? get_key(key, comm) : get_key_id(key, comm));
 }
 
 static MPI_Comm get_comm(int comm) {
   if(comm == -2) {
     return MPI_COMM_SELF;
-  } else if(comm_lookup && comm >= 0 && comm < (int)xbt_dynar_length(comm_lookup)) {
-    return *(MPI_Comm*)xbt_dynar_get_ptr(comm_lookup, comm);
+  }else if(comm==0){
+    return MPI_COMM_WORLD;
+  }     else if(comm_lookup && comm >= 0) {
+
+      char key[KEY_SIZE];
+      MPI_Comm tmp =  (MPI_Comm)xbt_dict_get_or_null(comm_lookup,get_key_id(key, comm));
+      return tmp != NULL ? tmp : MPI_COMM_NULL ;
   }
   return MPI_COMM_NULL;
 }
 
 static int new_group(MPI_Group group) {
-  xbt_dynar_push(group_lookup, &group);
-  return (int)xbt_dynar_length(group_lookup) - 1;
+  static int group_id = 0;
+  char key[KEY_SIZE];
+  xbt_dict_set(group_lookup, get_key(key, group_id), group, NULL);
+  group_id++;
+  return group_id-1;
 }
 
 static MPI_Group get_group(int group) {
   if(group == -2) {
     return MPI_GROUP_EMPTY;
-  } else if(group_lookup && group >= 0 && group < (int)xbt_dynar_length(group_lookup)) {
-    return *(MPI_Group*)xbt_dynar_get_ptr(group_lookup, group);
+  } else if(group_lookup && group >= 0) {
+    char key[KEY_SIZE];
+    return (MPI_Group)xbt_dict_get_or_null(group_lookup, get_key(key, group));
   }
-  return MPI_COMM_NULL;
+  return MPI_GROUP_NULL;
 }
 
 static void free_group(int group) {
-  xbt_dynar_remove_at(group_lookup, group, NULL);
+  char key[KEY_SIZE];
+  xbt_dict_remove(group_lookup, get_key(key, group));
 }
 
-static char* get_key(char* key, int id) {
-  snprintf(key, KEY_SIZE, "%x", id);
-  return key;
-}
+
 
 static int new_request(MPI_Request req) {
   static int request_id = INT_MIN;
   char key[KEY_SIZE];
-
-  xbt_dict_set(request_lookup, get_key(key, request_id), req, NULL);
-  return request_id++;
+  xbt_dict_set(request_lookup, get_key_id(key, request_id), req, NULL);
+  request_id++;
+  return request_id-1;
 }
 
 static MPI_Request find_request(int req) {
   char key[KEY_SIZE];
-   
-  return (MPI_Request)xbt_dict_get(request_lookup, get_key(key, req));
+  if(req==MPI_FORTRAN_REQUEST_NULL)return MPI_REQUEST_NULL;
+  return (MPI_Request)xbt_dict_get(request_lookup, get_key_id(key, req));
 }
 
 static void free_request(int request) {
   char key[KEY_SIZE];
-  xbt_dict_remove(request_lookup, get_key(key, request));
+  if(request!=MPI_FORTRAN_REQUEST_NULL)
+  xbt_dict_remove(request_lookup, get_key_id(key, request));
 }
 
 static int new_datatype(MPI_Datatype datatype) {
-  xbt_dynar_push(datatype_lookup, &datatype);
-  return (int)xbt_dynar_length(datatype_lookup) - 1;
+  static int datatype_id = 0;
+  char key[KEY_SIZE];
+  xbt_dict_set(datatype_lookup, get_key(key, datatype_id), datatype, NULL);
+  datatype_id++;
+  return datatype_id-1;
 }
 
 static MPI_Datatype get_datatype(int datatype) {
+  char key[KEY_SIZE];
   return datatype >= 0
-         ? *(MPI_Datatype*)xbt_dynar_get_ptr(datatype_lookup, datatype)
+         ? (MPI_Datatype)xbt_dict_get_or_null(datatype_lookup, get_key(key, datatype))
          : MPI_DATATYPE_NULL;
 }
 
 static void free_datatype(int datatype) {
-  xbt_dynar_remove_at(datatype_lookup, datatype, NULL);
+  char key[KEY_SIZE];
+  xbt_dict_remove(datatype_lookup, get_key(key, datatype));
 }
 
 static int new_op(MPI_Op op) {
-  xbt_dynar_push(op_lookup, &op);
-  return (int)xbt_dynar_length(op_lookup) - 1;
+  static int op_id = 0;
+  char key[KEY_SIZE];
+  xbt_dict_set(op_lookup, get_key(key, op_id), op, NULL);
+  op_id++;
+  return op_id-1;
 }
 
 static MPI_Op get_op(int op) {
+  char key[KEY_SIZE];
    return op >= 0
-          ? *(MPI_Op*)xbt_dynar_get_ptr(op_lookup, op)
+          ? (MPI_Op)xbt_dict_get_or_null(op_lookup,  get_key(key, op))
           : MPI_OP_NULL;
 }
 
 static void free_op(int op) {
-  xbt_dynar_remove_at(op_lookup, op, NULL);
+  char key[KEY_SIZE];
+  xbt_dict_remove(op_lookup, get_key(key, op));
+}
+
+static int new_win(MPI_Win win) {
+  static int win_id = 0;
+  char key[KEY_SIZE];
+  xbt_dict_set(win_lookup, get_key(key, win_id), win, NULL);
+  win_id++;
+  return win_id-1;
+}
+
+static MPI_Win get_win(int win) {
+  char key[KEY_SIZE];
+   return win >= 0
+          ? (MPI_Win)xbt_dict_get_or_null(win_lookup,  get_key(key, win))
+          : MPI_WIN_NULL;
+}
+
+static void free_win(int win) {
+  char key[KEY_SIZE];
+  xbt_dict_remove(win_lookup, get_key(key, win));
 }
 
+
 void mpi_init_(int* ierr) {
    if(!comm_lookup){
-     comm_lookup = xbt_dynar_new(sizeof(MPI_Comm), NULL);
+     comm_lookup = xbt_dict_new_homogeneous(NULL);
      new_comm(MPI_COMM_WORLD);
-     group_lookup = xbt_dynar_new(sizeof(MPI_Group), NULL);
-
+     group_lookup = xbt_dict_new_homogeneous(NULL);
      request_lookup = xbt_dict_new_homogeneous(NULL);
-
-     datatype_lookup = xbt_dynar_new(sizeof(MPI_Datatype), NULL);
+     datatype_lookup = xbt_dict_new_homogeneous(NULL);
+     win_lookup = xbt_dict_new_homogeneous(NULL);
      new_datatype(MPI_BYTE);
      new_datatype(MPI_CHAR);
+     #if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__)
      new_datatype(MPI_INT);
      new_datatype(MPI_INT);
+     #else
+     new_datatype(MPI_LONG);
+     new_datatype(MPI_LONG);
+     #endif
      new_datatype(MPI_INT8_T);
      new_datatype(MPI_INT16_T);
      new_datatype(MPI_INT32_T);
@@ -134,16 +218,26 @@ void mpi_init_(int* ierr) {
      new_datatype(MPI_DOUBLE);
      new_datatype(MPI_C_FLOAT_COMPLEX);
      new_datatype(MPI_C_DOUBLE_COMPLEX);
+     #if defined(__alpha__) || defined(__sparc64__) || defined(__x86_64__) || defined(__ia64__)
      new_datatype(MPI_2INT);
+     #else
+     new_datatype(MPI_2LONG);
+     #endif
      new_datatype(MPI_UINT8_T);
      new_datatype(MPI_UINT16_T);
      new_datatype(MPI_UINT32_T);
      new_datatype(MPI_UINT64_T);
      new_datatype(MPI_2FLOAT);
      new_datatype(MPI_2DOUBLE);
-
-
-     op_lookup = xbt_dynar_new(sizeof(MPI_Op), NULL);
+     new_datatype(MPI_DOUBLE);
+     new_datatype(MPI_DOUBLE);
+     new_datatype(MPI_INT);
+     new_datatype(MPI_DATATYPE_NULL);
+     new_datatype(MPI_DATATYPE_NULL);
+     new_datatype(MPI_DATATYPE_NULL);
+     new_datatype(MPI_DATATYPE_NULL);
+     op_lookup = xbt_dict_new_homogeneous(NULL);
+     new_op(MPI_MAX);
      new_op(MPI_MIN);
      new_op(MPI_MAXLOC);
      new_op(MPI_MINLOC);
@@ -156,20 +250,20 @@ void mpi_init_(int* ierr) {
      new_op(MPI_BOR);
      new_op(MPI_BXOR);
    }
-   /* smpif2c is responsible for generating a call with the final arguments */
    *ierr = MPI_Init(NULL, NULL);
+   running_processes++;
 }
 
 void mpi_finalize_(int* ierr) {
    *ierr = MPI_Finalize();
-   xbt_dynar_free(&op_lookup);
-   op_lookup = NULL;
-   xbt_dynar_free(&datatype_lookup);
-   datatype_lookup = NULL;
-   xbt_dict_free(&request_lookup);
-   request_lookup = NULL;
-   xbt_dynar_free(&comm_lookup);
-   comm_lookup = NULL;
+   running_processes--;
+   if(running_processes==0){
+     xbt_dict_free(&op_lookup);
+     xbt_dict_free(&datatype_lookup);
+     xbt_dict_free(&request_lookup);
+     xbt_dict_free(&group_lookup);
+     xbt_dict_free(&comm_lookup);
+   }
 }
 
 void mpi_abort_(int* comm, int* errorcode, int* ierr) {
@@ -267,7 +361,7 @@ void mpi_send_init_(void *buf, int* count, int* datatype, int* dst, int* tag,
 void mpi_isend_(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_Isend(buf, *count, get_datatype(*datatype), *dst, *tag,
                     get_comm(*comm), &req);
   if(*ierr == MPI_SUCCESS) {
@@ -278,7 +372,7 @@ void mpi_isend_(void *buf, int* count, int* datatype, int* dst,
 void mpi_irsend_(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_Irsend(buf, *count, get_datatype(*datatype), *dst, *tag,
                     get_comm(*comm), &req);
   if(*ierr == MPI_SUCCESS) {
@@ -304,7 +398,7 @@ void mpi_sendrecv_(void* sendbuf, int* sendcount, int* sendtype, int* dst,
                 int* comm, MPI_Status* status, int* ierr) {
    *ierr = MPI_Sendrecv(sendbuf, *sendcount, get_datatype(*sendtype), *dst,
        *sendtag, recvbuf, *recvcount,get_datatype(*recvtype), *src, *recvtag,
-       get_comm(*comm), status);
+       get_comm(*comm), FORT_STATUS_IGNORE(status));
 }
 
 void mpi_recv_init_(void *buf, int* count, int* datatype, int* src, int* tag,
@@ -321,7 +415,7 @@ void mpi_recv_init_(void *buf, int* count, int* datatype, int* src, int* tag,
 void mpi_irecv_(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_Irecv(buf, *count, get_datatype(*datatype), *src, *tag,
                     get_comm(*comm), &req);
   if(*ierr == MPI_SUCCESS) {
@@ -356,7 +450,11 @@ void mpi_startall_(int* count, int* requests, int* ierr) {
 void mpi_wait_(int* request, MPI_Status* status, int* ierr) {
    MPI_Request req = find_request(*request);
    
-   *ierr = MPI_Wait(&req, status);
+   *ierr = MPI_Wait(&req, FORT_STATUS_IGNORE(status));
+   if(req==MPI_REQUEST_NULL){
+     free_request(*request);
+     *request=MPI_FORTRAN_REQUEST_NULL;
+   }
 }
 
 void mpi_waitany_(int* count, int* requests, int* index, MPI_Status* status, int* ierr) {
@@ -368,6 +466,10 @@ void mpi_waitany_(int* count, int* requests, int* index, MPI_Status* status, int
     reqs[i] = find_request(requests[i]);
   }
   *ierr = MPI_Waitany(*count, reqs, index, status);
+  if(reqs[*index]==MPI_REQUEST_NULL){
+      free_request(requests[*index]);
+      requests[*index]=MPI_FORTRAN_REQUEST_NULL;
+  }
   free(reqs);
 }
 
@@ -379,7 +481,14 @@ void mpi_waitall_(int* count, int* requests, MPI_Status* status, int* ierr) {
   for(i = 0; i < *count; i++) {
     reqs[i] = find_request(requests[i]);
   }
-  *ierr = MPI_Waitall(*count, reqs, status);
+  *ierr = MPI_Waitall(*count, reqs, FORT_STATUSES_IGNORE(status));
+  for(i = 0; i < *count; i++) {
+      if(reqs[i]==MPI_REQUEST_NULL){
+          free_request(requests[i]);
+          requests[i]=MPI_FORTRAN_REQUEST_NULL;
+      }
+  }
+
   free(reqs);
 }
 
@@ -393,18 +502,23 @@ void mpi_bcast_(void *buf, int* count, int* datatype, int* root, int* comm, int*
 
 void mpi_reduce_(void* sendbuf, void* recvbuf, int* count,
                   int* datatype, int* op, int* root, int* comm, int* ierr) {
+  sendbuf = (char *) FORT_IN_PLACE(sendbuf);
+  sendbuf = (char *) FORT_BOTTOM(sendbuf);
+  recvbuf = (char *) FORT_BOTTOM(recvbuf);
   *ierr = MPI_Reduce(sendbuf, recvbuf, *count,
                      get_datatype(*datatype), get_op(*op), *root, get_comm(*comm));
 }
 
 void mpi_allreduce_(void* sendbuf, void* recvbuf, int* count, int* datatype,
                      int* op, int* comm, int* ierr) {
+  sendbuf = (char *) FORT_IN_PLACE(sendbuf);
   *ierr = MPI_Allreduce(sendbuf, recvbuf, *count, get_datatype(*datatype),
                         get_op(*op), get_comm(*comm));
 }
 
 void mpi_reduce_scatter_(void* sendbuf, void* recvbuf, int* recvcounts, int* datatype,
                      int* op, int* comm, int* ierr) {
+  sendbuf = (char *) FORT_IN_PLACE(sendbuf);
   *ierr = MPI_Reduce_scatter(sendbuf, recvbuf, recvcounts, get_datatype(*datatype),
                         get_op(*op), get_comm(*comm));
 }
@@ -412,6 +526,7 @@ void mpi_reduce_scatter_(void* sendbuf, void* recvbuf, int* recvcounts, int* dat
 void mpi_scatter_(void* sendbuf, int* sendcount, int* sendtype,
                    void* recvbuf, int* recvcount, int* recvtype, 
                    int* root, int* comm, int* ierr) {
+  recvbuf = (char *) FORT_IN_PLACE(recvbuf);
   *ierr = MPI_Scatter(sendbuf, *sendcount, get_datatype(*sendtype),
                       recvbuf, *recvcount, get_datatype(*recvtype), *root, get_comm(*comm));
 }
@@ -420,6 +535,7 @@ void mpi_scatter_(void* sendbuf, int* sendcount, int* sendtype,
 void mpi_scatterv_(void* sendbuf, int* sendcounts, int* displs, int* sendtype,
                    void* recvbuf, int* recvcount, int* recvtype,
                    int* root, int* comm, int* ierr) {
+  recvbuf = (char *) FORT_IN_PLACE(recvbuf);
   *ierr = MPI_Scatterv(sendbuf, sendcounts, displs, get_datatype(*sendtype),
                       recvbuf, *recvcount, get_datatype(*recvtype), *root, get_comm(*comm));
 }
@@ -427,6 +543,9 @@ void mpi_scatterv_(void* sendbuf, int* sendcounts, int* displs, int* sendtype,
 void mpi_gather_(void* sendbuf, int* sendcount, int* sendtype,
                   void* recvbuf, int* recvcount, int* recvtype,
                   int* root, int* comm, int* ierr) {
+  sendbuf = (char *) FORT_IN_PLACE(sendbuf);
+  sendbuf = (char *) FORT_BOTTOM(sendbuf);
+  recvbuf = (char *) FORT_BOTTOM(recvbuf);
   *ierr = MPI_Gather(sendbuf, *sendcount, get_datatype(*sendtype),
                      recvbuf, *recvcount, get_datatype(*recvtype), *root, get_comm(*comm));
 }
@@ -434,6 +553,9 @@ void mpi_gather_(void* sendbuf, int* sendcount, int* sendtype,
 void mpi_gatherv_(void* sendbuf, int* sendcount, int* sendtype,
                   void* recvbuf, int* recvcounts, int* displs, int* recvtype,
                   int* root, int* comm, int* ierr) {
+  sendbuf = (char *) FORT_IN_PLACE(sendbuf);
+  sendbuf = (char *) FORT_BOTTOM(sendbuf);
+  recvbuf = (char *) FORT_BOTTOM(recvbuf);
   *ierr = MPI_Gatherv(sendbuf, *sendcount, get_datatype(*sendtype),
                      recvbuf, recvcounts, displs, get_datatype(*recvtype), *root, get_comm(*comm));
 }
@@ -441,6 +563,7 @@ void mpi_gatherv_(void* sendbuf, int* sendcount, int* sendtype,
 void mpi_allgather_(void* sendbuf, int* sendcount, int* sendtype,
                      void* recvbuf, int* recvcount, int* recvtype,
                      int* comm, int* ierr) {
+  sendbuf = (char *) FORT_IN_PLACE(sendbuf);
   *ierr = MPI_Allgather(sendbuf, *sendcount, get_datatype(*sendtype),
                         recvbuf, *recvcount, get_datatype(*recvtype), get_comm(*comm));
 }
@@ -448,6 +571,7 @@ void mpi_allgather_(void* sendbuf, int* sendcount, int* sendtype,
 void mpi_allgatherv_(void* sendbuf, int* sendcount, int* sendtype,
                      void* recvbuf, int* recvcounts,int* displs, int* recvtype,
                      int* comm, int* ierr) {
+  sendbuf = (char *) FORT_IN_PLACE(sendbuf);
   *ierr = MPI_Allgatherv(sendbuf, *sendcount, get_datatype(*sendtype),
                         recvbuf, recvcounts, displs, get_datatype(*recvtype), get_comm(*comm));
 }
@@ -472,7 +596,11 @@ void mpi_alltoallv_(void* sendbuf, int* sendcounts, int* senddisps, int* sendtyp
 
 void mpi_test_ (int * request, int *flag, MPI_Status * status, int* ierr){
   MPI_Request req = find_request(*request);
-  *ierr= MPI_Test(&req, flag, status);
+  *ierr= MPI_Test(&req, flag, FORT_STATUS_IGNORE(status));
+  if(req==MPI_REQUEST_NULL){
+      free_request(*request);
+      *request=MPI_FORTRAN_REQUEST_NULL;
+  }
 }
 
 
@@ -483,7 +611,13 @@ void mpi_testall_ (int* count, int * requests,  int *flag, MPI_Status * statuses
   for(i = 0; i < *count; i++) {
     reqs[i] = find_request(requests[i]);
   }
-  *ierr= MPI_Testall(*count, reqs, flag, statuses);
+  *ierr= MPI_Testall(*count, reqs, flag, FORT_STATUSES_IGNORE(statuses));
+  for(i = 0; i < *count; i++) {
+    if(reqs[i]==MPI_REQUEST_NULL){
+        free_request(requests[i]);
+        requests[i]=MPI_FORTRAN_REQUEST_NULL;
+    }
+  }
 }
 
 
@@ -492,7 +626,7 @@ void mpi_get_processor_name_(char *name, int *resultlen, int* ierr){
 }
 
 void mpi_get_count_(MPI_Status * status, int* datatype, int *count, int* ierr){
-  *ierr = MPI_Get_count(status, get_datatype(*datatype), count);
+  *ierr = MPI_Get_count(FORT_STATUS_IGNORE(status), get_datatype(*datatype), count);
 }
 
 void mpi_attr_get_(int* comm, int* keyval, void* attr_value, int* flag, int* ierr ){
@@ -566,15 +700,36 @@ void mpi_error_string_(int* errorcode, char* string, int* resultlen, int* ierr){
 }
 
 void mpi_win_fence_( int* assert,  int* win, int* ierr){
-  *ierr =  MPI_Win_fence(* assert, *(MPI_Win*)win);
+  *ierr =  MPI_Win_fence(* assert, get_win(*win));
 }
 
 void mpi_win_free_( int* win, int* ierr){
-  *ierr =  MPI_Win_free(  (MPI_Win*)win);
+  MPI_Win tmp = get_win(*win);
+  *ierr =  MPI_Win_free(&tmp);
+  if(*ierr == MPI_SUCCESS) {
+    free_win(*win);
+  }
 }
 
 void mpi_win_create_( int *base, MPI_Aint* size, int* disp_unit, int* info, int* comm, int *win, int* ierr){
-  *ierr =  MPI_Win_create( (void*)base, *size, *disp_unit, *(MPI_Info*)info, get_comm(*comm),(MPI_Win*)win);
+  MPI_Win tmp;
+  *ierr =  MPI_Win_create( (void*)base, *size, *disp_unit, *(MPI_Info*)info, get_comm(*comm),&tmp);
+ if(*ierr == MPI_SUCCESS) {
+   *win = new_win(tmp);
+ }
+}
+
+void mpi_win_set_name_ (int*  win, char * name, int* ierr, int size){
+ char* tname = xbt_malloc((size+1)*sizeof(char));
+ strncpy(tname, name, size);
+ tname[size]='\0';
+ *ierr = MPI_Win_set_name(get_win(*win), tname);
+ xbt_free(tname);
+}
+
+void mpi_win_get_name_ (int*  win, char * name, int* len, int* ierr){
+ *ierr = MPI_Win_get_name(get_win(*win),name,len);
+ if(*len>0) name[*len]=' ';//blank padding, not \0
 }
 
 void mpi_info_create_( int *info, int* ierr){
@@ -592,7 +747,19 @@ void mpi_info_free_(int* info, int* ierr){
 void mpi_get_( int *origin_addr, int* origin_count, int* origin_datatype, int *target_rank,
     MPI_Aint* target_disp, int *target_count, int* target_datatype, int* win, int* ierr){
   *ierr =  MPI_Get( (void*)origin_addr,*origin_count, get_datatype(*origin_datatype),*target_rank,
-      *target_disp, *target_count,get_datatype(*target_datatype), *(MPI_Win *)win);
+      *target_disp, *target_count,get_datatype(*target_datatype), get_win(*win));
+}
+
+void mpi_accumulate_( int *origin_addr, int* origin_count, int* origin_datatype, int *target_rank,
+    MPI_Aint* target_disp, int *target_count, int* target_datatype, int* op, int* win, int* ierr){
+  *ierr =  MPI_Accumulate( (void*)origin_addr,*origin_count, get_datatype(*origin_datatype),*target_rank,
+      *target_disp, *target_count,get_datatype(*target_datatype), get_op(*op), get_win(*win));
+}
+
+void mpi_put_( int *origin_addr, int* origin_count, int* origin_datatype, int *target_rank,
+    MPI_Aint* target_disp, int *target_count, int* target_datatype, int* win, int* ierr){
+  *ierr =  MPI_Put( (void*)origin_addr,*origin_count, get_datatype(*origin_datatype),*target_rank,
+      *target_disp, *target_count,get_datatype(*target_datatype), get_win(*win));
 }
 
 
@@ -604,13 +771,13 @@ void mpi_finalized_ (int * flag, int* ierr){
 
 void mpi_init_thread_ (int* required, int *provided, int* ierr){
   if(!comm_lookup){
-    comm_lookup = xbt_dynar_new(sizeof(MPI_Comm), NULL);
+    comm_lookup = xbt_dict_new_homogeneous(NULL);
     new_comm(MPI_COMM_WORLD);
-    group_lookup = xbt_dynar_new(sizeof(MPI_Group), NULL);
+    group_lookup = xbt_dict_new_homogeneous(NULL);
 
     request_lookup = xbt_dict_new_homogeneous(NULL);
 
-    datatype_lookup = xbt_dynar_new(sizeof(MPI_Datatype), NULL);
+    datatype_lookup = xbt_dict_new_homogeneous(NULL);
     new_datatype(MPI_BYTE);
     new_datatype(MPI_CHAR);
     new_datatype(MPI_INT);
@@ -633,8 +800,7 @@ void mpi_init_thread_ (int* required, int *provided, int* ierr){
     new_datatype(MPI_2FLOAT);
     new_datatype(MPI_2DOUBLE);
 
-
-    op_lookup = xbt_dynar_new(sizeof(MPI_Op), NULL);
+    op_lookup = xbt_dict_new_homogeneous( NULL);
     new_op(MPI_MAX);
     new_op(MPI_MIN);
     new_op(MPI_MAXLOC);
@@ -648,7 +814,7 @@ void mpi_init_thread_ (int* required, int *provided, int* ierr){
     new_op(MPI_BOR);
     new_op(MPI_BXOR);
   }
-  /* smpif2c is responsible for generating a call with the final arguments */
+
  *ierr = MPI_Init_thread(NULL, NULL,*required, provided);
 }
 
@@ -680,14 +846,17 @@ void mpi_type_dup_ (int*  datatype, int* newdatatype, int* ierr){
  }
 }
 
-void mpi_type_set_name_ (int*  datatype, char * name, int* ierr){
-
- *ierr = MPI_Type_set_name(get_datatype(*datatype), name);
+void mpi_type_set_name_ (int*  datatype, char * name, int* ierr, int size){
+ char* tname = xbt_malloc((size+1)*sizeof(char));
+ strncpy(tname, name, size);
+ tname[size]='\0';
+ *ierr = MPI_Type_set_name(get_datatype(*datatype), tname);
+ xbt_free(tname);
 }
 
 void mpi_type_get_name_ (int*  datatype, char * name, int* len, int* ierr){
-
  *ierr = MPI_Type_get_name(get_datatype(*datatype),name,len);
+  if(*len>0) name[*len]=' ';
 }
 
 void mpi_type_get_attr_ (int* type, int* type_keyval, void *attribute_val, int* flag, int* ierr){
@@ -848,8 +1017,8 @@ void mpi_comm_free_keyval_ (int* keyval, int* ierr) {
 }
 
 void mpi_comm_get_name_ (int* comm, char* name, int* len, int* ierr){
-
  *ierr = MPI_Comm_get_name(get_comm(*comm), name, len);
+  if(*len>0) name[*len]=' ';
 }
 
 void mpi_comm_compare_ (int* comm1, int* comm2, int *result, int* ierr){
@@ -878,7 +1047,7 @@ void mpi_sendrecv_replace_ (void *buf, int* count, int* datatype, int* dst, int*
 {
 
  *ierr = MPI_Sendrecv_replace(buf, *count, get_datatype(*datatype), *dst, *sendtag, *src,
- *recvtag, get_comm(*comm), status);
+ *recvtag, get_comm(*comm), FORT_STATUS_IGNORE(status));
 }
 
 void mpi_testany_ (int* count, int* requests, int *index, int *flag, MPI_Status* status, int* ierr)
@@ -890,9 +1059,13 @@ void mpi_testany_ (int* count, int* requests, int *index, int *flag, MPI_Status*
   for(i = 0; i < *count; i++) {
     reqs[i] = find_request(requests[i]);
   }
-  *ierr = MPI_Testany(*count, reqs, index, flag, status);
+  *ierr = MPI_Testany(*count, reqs, index, flag, FORT_STATUS_IGNORE(status));
+  if(*index!=MPI_UNDEFINED)
+  if(reqs[*index]==MPI_REQUEST_NULL){
+    free_request(requests[*index]);
+    requests[*index]=MPI_FORTRAN_REQUEST_NULL;
+  }
   free(reqs);
-
 }
 
 void mpi_waitsome_ (int* incount, int* requests, int *outcount, int *indices, MPI_Status* status, int* ierr)
@@ -905,8 +1078,13 @@ void mpi_waitsome_ (int* incount, int* requests, int *outcount, int *indices, MP
     reqs[i] = find_request(requests[i]);
   }
   *ierr = MPI_Waitsome(*incount, reqs, outcount, indices, status);
+  for(i=0;i<*outcount;i++){
+    if(reqs[indices[i]]==MPI_REQUEST_NULL){
+        free_request(requests[indices[i]]);
+        requests[indices[i]]=MPI_FORTRAN_REQUEST_NULL;
+    }
+  }
   free(reqs);
-
 }
 
 void mpi_reduce_local_ (void *inbuf, void *inoutbuf, int* count, int* datatype, int* op, int* ierr){
@@ -916,7 +1094,7 @@ void mpi_reduce_local_ (void *inbuf, void *inoutbuf, int* count, int* datatype,
 
 void mpi_reduce_scatter_block_ (void *sendbuf, void *recvbuf, int* recvcount, int* datatype, int* op, int* comm, int* ierr)
 {
-
+  sendbuf = (char *) FORT_IN_PLACE(sendbuf);
  *ierr = MPI_Reduce_scatter_block(sendbuf, recvbuf, *recvcount, get_datatype(*datatype), get_op(*op), get_comm(*comm));
 }
 
@@ -1020,6 +1198,10 @@ void mpi_comm_set_errhandler_ (int* comm, void* errhandler, int* ierr) {
  *ierr = MPI_Errhandler_set(get_comm(*comm), *(MPI_Errhandler*)errhandler);
 }
 
+void mpi_comm_get_errhandler_ (int* comm, void* errhandler, int* ierr) {
+ *ierr = MPI_Errhandler_set(get_comm(*comm), (MPI_Errhandler*)errhandler);
+}
+
 void mpi_type_contiguous_ (int* count, int* old_type, int*  newtype, int* ierr) {
   MPI_Datatype tmp;
   *ierr = MPI_Type_contiguous(*count, get_datatype(*old_type), &tmp);
@@ -1045,7 +1227,24 @@ void mpi_buffer_detach_ (void* buffer, int* size, int* ierr) {
 }
 
 void mpi_testsome_ (int* incount, int*  requests, int* outcount, int* indices, MPI_Status*  statuses, int* ierr) {
- *ierr = MPI_Testsome(*incount, (MPI_Request*)requests, outcount, indices, statuses);
+  MPI_Request* reqs;
+  int i;
+
+  reqs = xbt_new(MPI_Request, *incount);
+  for(i = 0; i < *incount; i++) {
+    reqs[i] = find_request(requests[i]);
+    indices[i]=0;
+  }
+  *ierr = MPI_Testsome(*incount, reqs, outcount, indices, FORT_STATUSES_IGNORE(statuses));
+  for(i=0;i<*incount;i++){
+    if(indices[i]){
+      if(reqs[indices[i]]==MPI_REQUEST_NULL){
+          free_request(requests[indices[i]]);
+          requests[indices[i]]=MPI_FORTRAN_REQUEST_NULL;
+      }
+    }
+  }
+  free(reqs);
 }
 
 void mpi_comm_test_inter_ (int* comm, int* flag, int* ierr) {
@@ -1193,7 +1392,7 @@ void mpi_issend_ (void* buf, int* count, int* datatype, int *dest, int* tag, int
 }
 
 void mpi_probe_ (int* source, int* tag, int* comm, MPI_Status*  status, int* ierr) {
- *ierr = MPI_Probe(*source, *tag, get_comm(*comm), status);
+ *ierr = MPI_Probe(*source, *tag, get_comm(*comm), FORT_STATUS_IGNORE(status));
 }
 
 void mpi_attr_delete_ (int* comm, int* keyval, int* ierr) {
@@ -1295,8 +1494,12 @@ void mpi_exscan_ (void *sendbuf, void *recvbuf, int* count, int* datatype, int*
  *ierr = MPI_Exscan(sendbuf, recvbuf, *count, get_datatype(*datatype), get_op(*op), get_comm(*comm));
 }
 
-void mpi_comm_set_name_ (int* comm, char* name, int* ierr){
- *ierr = MPI_Comm_set_name (get_comm(*comm), name);
+void mpi_comm_set_name_ (int* comm, char* name, int* ierr, int size){
+ char* tname = xbt_malloc((size+1)*sizeof(char));
+ strncpy(tname, name, size);
+ tname[size]='\0';
+ *ierr = MPI_Comm_set_name (get_comm(*comm), tname);
+ xbt_free(tname);
 }
 
 void mpi_comm_dup_with_info_ (int* comm, int* info, int* newcomm, int* ierr){