SMPI : Implementation of MPI_Type_create_subarray

Mostly inspired from openMPI's one

diff --git a/src/smpi/bindings/smpi_mpi.cpp b/src/smpi/bindings/smpi_mpi.cpp
index 3e331dd..9ed1afb 100644 (file)
--- a/src/smpi/bindings/smpi_mpi.cpp
+++ b/src/smpi/bindings/smpi_mpi.cpp
@@ -166,6 +166,7 @@ WRAPPED_PMPI_CALL(int,MPI_Type_create_indexed,(int count, int* blocklens, int* i
 WRAPPED_PMPI_CALL(int,MPI_Type_create_keyval,(MPI_Type_copy_attr_function* copy_fn, MPI_Type_delete_attr_function* delete_fn, int* keyval,void* extra_state),(copy_fn,delete_fn,keyval,extra_state))
 WRAPPED_PMPI_CALL(int,MPI_Type_create_resized,(MPI_Datatype oldtype,MPI_Aint lb, MPI_Aint extent, MPI_Datatype *newtype),(oldtype,lb, extent, newtype))
 WRAPPED_PMPI_CALL(int,MPI_Type_create_struct,(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype* old_types,MPI_Datatype* newtype) ,(count, blocklens, indices, old_types, newtype))
 WRAPPED_PMPI_CALL(int,MPI_Type_create_keyval,(MPI_Type_copy_attr_function* copy_fn, MPI_Type_delete_attr_function* delete_fn, int* keyval,void* extra_state),(copy_fn,delete_fn,keyval,extra_state))
 WRAPPED_PMPI_CALL(int,MPI_Type_create_resized,(MPI_Datatype oldtype,MPI_Aint lb, MPI_Aint extent, MPI_Datatype *newtype),(oldtype,lb, extent, newtype))
 WRAPPED_PMPI_CALL(int,MPI_Type_create_struct,(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype* old_types,MPI_Datatype* newtype) ,(count, blocklens, indices, old_types, newtype))

+WRAPPED_PMPI_CALL(int,MPI_Type_create_subarray,(int ndims,int *array_of_sizes, int *array_of_subsizes, int *array_of_starts, int order,MPI_Datatype oldtype, MPI_Datatype *newtype),(ndims,array_of_sizes, array_of_subsizes, array_of_starts, order, oldtype, newtype))

 WRAPPED_PMPI_CALL(int,MPI_Type_delete_attr ,(MPI_Datatype type, int type_keyval),(type,type_keyval))
 WRAPPED_PMPI_CALL(int,MPI_Type_dup,(MPI_Datatype datatype, MPI_Datatype * newdatatype),(datatype, newdatatype))
 WRAPPED_PMPI_CALL(int,MPI_Type_extent,(MPI_Datatype datatype, MPI_Aint * extent),(datatype, extent))
 WRAPPED_PMPI_CALL(int,MPI_Type_delete_attr ,(MPI_Datatype type, int type_keyval),(type,type_keyval))
 WRAPPED_PMPI_CALL(int,MPI_Type_dup,(MPI_Datatype datatype, MPI_Datatype * newdatatype),(datatype, newdatatype))
 WRAPPED_PMPI_CALL(int,MPI_Type_extent,(MPI_Datatype datatype, MPI_Aint * extent),(datatype, extent))


@@ -367,7 +368,6 @@ UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Status_set_elements,( MPI_Status *status
 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int, MPI_Test_cancelled,(MPI_Status* status, int* flag) ,(status, flag))
 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Topo_test,(MPI_Comm comm, int* top_type) ,(comm, top_type))
 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Type_create_darray,(int size, int rank, int ndims, int* array_of_gsizes, int* array_of_distribs, int* array_of_dargs, int* array_of_psizes,int order, MPI_Datatype oldtype, MPI_Datatype *newtype) ,(size, rank, ndims, array_of_gsizes,array_of_distribs, array_of_dargs, array_of_psizes,order,oldtype, newtype))
 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int, MPI_Test_cancelled,(MPI_Status* status, int* flag) ,(status, flag))
 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Topo_test,(MPI_Comm comm, int* top_type) ,(comm, top_type))
 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Type_create_darray,(int size, int rank, int ndims, int* array_of_gsizes, int* array_of_distribs, int* array_of_dargs, int* array_of_psizes,int order, MPI_Datatype oldtype, MPI_Datatype *newtype) ,(size, rank, ndims, array_of_gsizes,array_of_distribs, array_of_dargs, array_of_psizes,order,oldtype, newtype))

-UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Type_create_subarray,(int ndims,int *array_of_sizes, int *array_of_subsizes, int *array_of_starts, int order,MPI_Datatype oldtype, MPI_Datatype *newtype),(ndims,array_of_sizes, array_of_subsizes, array_of_starts, order, oldtype, newtype))

 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Type_get_contents,(MPI_Datatype datatype, int max_integers, int max_addresses, int max_datatypes, int* array_of_integers, MPI_Aint* array_of_addresses, MPI_Datatype *array_of_datatypes),(datatype, max_integers, max_addresses,max_datatypes, array_of_integers, array_of_addresses, array_of_datatypes))
 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Type_get_envelope,( MPI_Datatype datatype, int *num_integers, int *num_addresses, int *num_datatypes, int *combiner),(datatype, num_integers, num_addresses, num_datatypes, combiner))
 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Type_match_size,(int typeclass,int size,MPI_Datatype *datatype),(typeclass,size,datatype))
 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Type_get_contents,(MPI_Datatype datatype, int max_integers, int max_addresses, int max_datatypes, int* array_of_integers, MPI_Aint* array_of_addresses, MPI_Datatype *array_of_datatypes),(datatype, max_integers, max_addresses,max_datatypes, array_of_integers, array_of_addresses, array_of_datatypes))
 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Type_get_envelope,( MPI_Datatype datatype, int *num_integers, int *num_addresses, int *num_datatypes, int *combiner),(datatype, num_integers, num_addresses, num_datatypes, combiner))
 UNIMPLEMENTED_WRAPPED_PMPI_CALL(int,MPI_Type_match_size,(int typeclass,int size,MPI_Datatype *datatype),(typeclass,size,datatype))

diff --git a/src/smpi/bindings/smpi_pmpi_type.cpp b/src/smpi/bindings/smpi_pmpi_type.cpp
index 69b7eaa..7687c40 100644 (file)
--- a/src/smpi/bindings/smpi_pmpi_type.cpp
+++ b/src/smpi/bindings/smpi_pmpi_type.cpp
@@ -238,6 +238,27 @@ int PMPI_Type_create_struct(int count, int* blocklens, MPI_Aint* indices, MPI_Da
   return PMPI_Type_struct(count, blocklens, indices, old_types, new_type);
 }
 
   return PMPI_Type_struct(count, blocklens, indices, old_types, new_type);
 }
 

+
+int PMPI_Type_create_subarray(int ndims, int* array_of_sizes,
+                             int* array_of_subsizes, int* array_of_starts,
+                             int order, MPI_Datatype oldtype, MPI_Datatype *newtype) {
+  if (ndims<0){
+    return MPI_ERR_COUNT;
+  } else if (ndims==0){
+    *newtype = MPI_DATATYPE_NULL;
+    return MPI_SUCCESS;
+  } else if (ndims==1){
+    simgrid::smpi::Datatype::create_contiguous( array_of_subsizes[0], oldtype, array_of_starts[0]*oldtype->get_extent(), newtype);
+    return MPI_SUCCESS;
+  } else if (oldtype == MPI_DATATYPE_NULL || not oldtype->is_valid() ) {
+    return MPI_ERR_TYPE;
+  } else if (order != MPI_ORDER_FORTRAN && order != MPI_ORDER_C){
+    return MPI_ERR_ARG;
+  } else {
+    return simgrid::smpi::Datatype::create_subarray(ndims, array_of_sizes, array_of_subsizes, array_of_starts, order, oldtype, newtype);
+  }
+}
+

 int PMPI_Type_create_resized(MPI_Datatype oldtype,MPI_Aint lb, MPI_Aint extent, MPI_Datatype *newtype){
   if (oldtype == MPI_DATATYPE_NULL) {
     return MPI_ERR_TYPE;
 int PMPI_Type_create_resized(MPI_Datatype oldtype,MPI_Aint lb, MPI_Aint extent, MPI_Datatype *newtype){
   if (oldtype == MPI_DATATYPE_NULL) {
     return MPI_ERR_TYPE;

diff --git a/src/smpi/include/smpi_datatype.hpp b/src/smpi/include/smpi_datatype.hpp
index e96134e..fa59556 100644 (file)
--- a/src/smpi/include/smpi_datatype.hpp
+++ b/src/smpi/include/smpi_datatype.hpp
@@ -127,7 +127,9 @@ public:
                              MPI_Datatype* new_type);
   static int create_struct(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype* old_types,
                            MPI_Datatype* new_type);
                              MPI_Datatype* new_type);
   static int create_struct(int count, int* blocklens, MPI_Aint* indices, MPI_Datatype* old_types,
                            MPI_Datatype* new_type);

-
+  static int create_subarray(int ndims, int* array_of_sizes,
+                             int* array_of_subsizes, int* array_of_starts,
+                             int order, MPI_Datatype oldtype, MPI_Datatype *newtype);

   static Datatype* f2c(int id);
 };
 
   static Datatype* f2c(int id);
 };
 

diff --git a/src/smpi/mpi/smpi_datatype.cpp b/src/smpi/mpi/smpi_datatype.cpp
index d60ea40..cc3ff44 100644 (file)
--- a/src/smpi/mpi/smpi_datatype.cpp
+++ b/src/smpi/mpi/smpi_datatype.cpp
@@ -497,6 +497,65 @@ int Datatype::create_struct(int count, int* block_lengths, MPI_Aint* indices, MP
   return MPI_SUCCESS;
 }
 
   return MPI_SUCCESS;
 }
 

+int Datatype::create_subarray(int ndims, int* array_of_sizes,
+                             int* array_of_subsizes, int* array_of_starts,
+                             int order, MPI_Datatype oldtype, MPI_Datatype *newtype){
+
+  int i, step, end;
+  MPI_Datatype tmp;
+  
+  for (i=0; i < ndims; i++) {
+    if (array_of_subsizes[i] > array_of_sizes[i]){
+      XBT_WARN("subarray : array_of_subsizes > array_of_sizes for dim %d\n",i);
+      return MPI_ERR_ARG;
+    }
+    if (array_of_starts[i] + array_of_subsizes[i] > array_of_sizes[i]){
+      XBT_WARN("subarray : array_of_starts + array_of_subsizes > array_of_sizes for dim %d\n",i);
+      return MPI_ERR_ARG;
+    }
+  }
+  
+  MPI_Aint extent = oldtype->get_extent();
+  
+  if( order==MPI_ORDER_C ) {
+      i = ndims - 1;
+      step = -1;
+      end = -1;
+  } else {
+      i = 0;
+      step = 1;
+      end = ndims;
+  }
+
+  create_vector( array_of_subsizes[i+step], array_of_subsizes[i], array_of_sizes[i],
+                               oldtype, newtype );
+
+  tmp = *newtype;
+  MPI_Aint size = (MPI_Aint)array_of_sizes[i] * (MPI_Aint)array_of_sizes[i+step];
+  MPI_Aint lb = (MPI_Aint)array_of_starts[i] + (MPI_Aint)array_of_starts[i+step] *(MPI_Aint)array_of_sizes[i];
+  
+  
+  for( i += 2 * step; i != end; i += step ) {
+      create_hvector( array_of_subsizes[i], 1, size * extent,
+                                    tmp, newtype );
+      unref(tmp);
+      lb += size * array_of_starts[i];
+      size *= array_of_sizes[i];
+      tmp = *newtype;
+  }
+
+  MPI_Aint lbs[1] = {lb * extent};
+  int sizes [1]={1};
+  
+  create_hindexed( 1, sizes, lbs, tmp, newtype);
+  unref(tmp);
+  
+  tmp = *newtype;
+  create_resized(tmp, 0, extent, newtype);
+
+  unref(tmp);
+  return MPI_SUCCESS;
+}

 Datatype* Datatype::f2c(int id){
   return static_cast<Datatype*>(F2C::f2c(id));
 }
 Datatype* Datatype::f2c(int id){
   return static_cast<Datatype*>(F2C::f2c(id));
 }