basic implementation of MPI_TYPE_GET_VALUE_INDEX

docs/Makefile.am

@@ -518,6 +518,7 @@ OMPI_MAN3 = \
         MPI_Type_get_name.3 \
         MPI_Type_get_true_extent.3 \
         MPI_Type_get_true_extent_x.3 \
+        MPI_Type_get_value_index.3 \
         MPI_Type_hindexed.3 \
         MPI_Type_hvector.3 \
         MPI_Type_indexed.3 \

docs/man-openmpi/man3/MPI_Type_get_value_index.3.rst

@@ -0,0 +1,36 @@
+.. _mpi_type_get_value_index:
+
+
+MPI_Type_get_value_index
+========================
+
+.. include_body
+
+:ref:`MPI_Type_get_value_index` |mdash| Returns a reference (handle) to one of the predefined
+datatypes suitable for the use with MPI_MINLOC and MPI_MAXLOC if such predefined type
+exists.
+
+.. The following file was automatically generated
+.. include:: ./bindings/mpi_type_get_value_index.rst
+
+INPUT PARAMETERS
+----------------
+* ``value_type``: Datatype of the value in pair (handle)
+* ``index_type``: Datatype of the index in pair (handle)
+
+OUTPUT PARAMETERS
+-----------------
+* ``pair_type``: Datatype of the value-index pair (handle)
+* ``ierror``: Fortran only: Error status (integer).
+
+DESCRIPTION
+-----------
+
+:ref:`MPI_Type_get_value_index` Returns a reference (handle) to one of the predefined
+datatypes suitable for the use with MPI_MINLOC and MPI_MAXLOC if such predefined type
+exists.
+
+ERRORS
+------
+
+.. include:: ./ERRORS.rst

docs/man-openmpi/man3/index.rst

@@ -443,6 +443,7 @@ MPI API manual pages (section 3)
    MPI_Type_get_name.3.rst
    MPI_Type_get_true_extent.3.rst
    MPI_Type_get_true_extent_x.3.rst
+   MPI_Type_get_value_index.3.rst
    MPI_Type_hindexed.3.rst
    MPI_Type_hvector.3.rst
    MPI_Type_indexed.3.rst

ompi/datatype/ompi_datatype.h

@@ -389,6 +389,10 @@ OMPI_DECLSPEC int ompi_datatype_unpack_external( const char datarep[], const voi
 OMPI_DECLSPEC int ompi_datatype_pack_external_size( const char datarep[], size_t incount,
                                                     ompi_datatype_t *datatype, MPI_Aint *size);
 
+OMPI_DECLSPEC int ompi_datatype_get_value_index(const ompi_datatype_t *value_type,
+                                                const ompi_datatype_t *index_type,
+                                                ompi_datatype_t **pair_type);
+
 #define OMPI_DATATYPE_RETAIN(ddt)                                       \
     {                                                                   \
         if( !ompi_datatype_is_predefined((ddt)) ) {                     \

ompi/datatype/ompi_datatype_create.c

@@ -11,6 +11,8 @@
  * Copyright (c) 2009      Oak Ridge National Labs.  All rights reserved.
  * Copyright (c) 2010-2018 Cisco Systems, Inc.  All rights reserved
  * Copyright (c) 2018      Amazon.com, Inc. or its affiliates.  All Rights reserved.
+ * Copyright (c) 2025      Triad National Security, LLC. All rights
+ *                         reserved.
  * $COPYRIGHT$
  *
  * Additional copyrights may follow
@@ -27,6 +29,7 @@
 #include "opal/util/printf.h"
 #include "opal/util/string_copy.h"
 #include "ompi/datatype/ompi_datatype.h"
+#include "ompi/datatype/ompi_datatype_internal.h"
 #include "ompi/attribute/attribute.h"
 
 static void __ompi_datatype_allocate( ompi_datatype_t* datatype )
@@ -121,3 +124,54 @@ ompi_datatype_duplicate( const ompi_datatype_t* oldType, ompi_datatype_t** newTy
     return OMPI_SUCCESS;
 }
 
+/*
+ * Note this is not a complete implementation for the MPI_Type_get_value_index function described in
+ * MPI 4.1 and newer as it doesn't support possible unnamed datatypes returned for other value_type/index_type
+ * pairs.
+ */
+int
+ompi_datatype_get_value_index(const ompi_datatype_t *value_type, const ompi_datatype_t *index_type, ompi_datatype_t **pair_type)
+{
+    /* C predefined data types */
+    if (index_type->id == OMPI_DATATYPE_MPI_INT) {
+        if (value_type->id == OMPI_DATATYPE_MPI_FLOAT) {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_float_int;
+        } else if (value_type->id == OMPI_DATATYPE_MPI_DOUBLE) {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_double_int;
+        } else if (value_type->id == OMPI_DATATYPE_MPI_LONG) {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_long_int;
+        } else if (value_type->id == OMPI_DATATYPE_MPI_SHORT) {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_short_int;
+        } else if (value_type->id == OMPI_DATATYPE_MPI_INT) {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_2int;
+        } else if (value_type->id == OMPI_DATATYPE_MPI_LONG_DOUBLE) {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_longdbl_int;
+        } else {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_datatype_null;
+        }
+    /* Fortran predefined data types */
+    } else if ((index_type->id == OMPI_DATATYPE_MPI_INTEGER) &&
+        (value_type->id == OMPI_DATATYPE_MPI_INTEGER)) {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_2integer;
+    } else if ((index_type->id == OMPI_DATATYPE_MPI_FLOAT) &&
+        (value_type->id == OMPI_DATATYPE_MPI_FLOAT)) {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_2real;
+    } else if ((index_type->id == OMPI_DATATYPE_MPI_DOUBLE) &&
+        (value_type->id == OMPI_DATATYPE_MPI_DOUBLE)) {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_2dblprec;
+#if OMPI_HAVE_FORTRAN_COMPLEX
+    } else if ((index_type->id == OMPI_DATATYPE_MPI_COMPLEX) &&
+        (value_type->id == OMPI_DATATYPE_MPI_COMPLEX)) {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_2cplex;
+#endif
+#if OMPI_HAVE_FORTRAN_DOUBLE_COMPLEX
+    } else if ((index_type->id == OMPI_DATATYPE_MPI_DOUBLE_COMPLEX) &&
+        (value_type->id == OMPI_DATATYPE_MPI_DOUBLE_COMPLEX)) {
+            *pair_type = (ompi_datatype_t *)&ompi_mpi_2dblcplex;
+#endif
+    } else {
+        *pair_type = (ompi_datatype_t *)&ompi_mpi_datatype_null;
+    }
+
+    return OMPI_SUCCESS;
+}

ompi/include/mpi.h.in

@@ -826,7 +826,8 @@ enum {
   MPI_COMBINER_F90_COMPLEX,
   MPI_COMBINER_F90_INTEGER,
   MPI_COMBINER_RESIZED,
-  MPI_COMBINER_HINDEXED_BLOCK
+  MPI_COMBINER_HINDEXED_BLOCK,
+  MPI_COMBINER_VALUE_INDEX
 };
 
 #if (OMPI_OMIT_MPI1_COMPAT_DECLS)
@@ -2501,6 +2502,8 @@ OMPI_DECLSPEC  int MPI_Type_get_true_extent(MPI_Datatype datatype, MPI_Aint *tru
                                             MPI_Aint *true_extent);
 OMPI_DECLSPEC  int MPI_Type_get_true_extent_c(MPI_Datatype datatype, MPI_Count *true_lb,
                                              MPI_Count *true_extent);
+OMPI_DECLSPEC  int MPI_Type_get_value_index(MPI_Datatype value_type, MPI_Datatype index_type,
+                                             MPI_Datatype *pair_type);
 OMPI_DECLSPEC  int MPI_Type_indexed(int count, const int array_of_blocklengths[],
                                     const int array_of_displacements[],
                                     MPI_Datatype oldtype, MPI_Datatype *newtype);
@@ -3658,6 +3661,8 @@ OMPI_DECLSPEC  int PMPI_Type_get_true_extent(MPI_Datatype datatype, MPI_Aint *tr
                                              MPI_Aint *true_extent);
 OMPI_DECLSPEC  int PMPI_Type_get_true_extent_c(MPI_Datatype datatype, MPI_Count *true_lb,
                                               MPI_Count *true_extent);
+OMPI_DECLSPEC  int PMPI_Type_get_value_index(MPI_Datatype value_type, MPI_Datatype index_type,
+                                             MPI_Datatype *pair_type);
 OMPI_DECLSPEC  int PMPI_Type_indexed(int count, const int array_of_blocklengths[],
                                      const int array_of_displacements[],
                                      MPI_Datatype oldtype, MPI_Datatype *newtype);

ompi/include/mpif-values.py

@@ -9,6 +9,8 @@
 #                         reserved.
 # Copyright (c) 2022      IBM Corporation.  All rights reserved.
 # Copyright (c) 2025      Jeffrey M. Squyres.  All rights reserved.
+# Copyright (c) 2025      Triad National Security, LLC. All rights
+#                         reserved.
 # $COPYRIGHT$
 #
 # Additional copyrights may follow
@@ -320,6 +322,7 @@
     'MPI_COMBINER_F90_INTEGER': 16,
     'MPI_COMBINER_RESIZED': 17,
     'MPI_COMBINER_HINDEXED_BLOCK': 18,
+    'MPI_COMBINER_VALUE_INDEX': 19,
     'MPI_COMM_TYPE_SHARED': 0,
     'OMPI_COMM_TYPE_HWTHREAD': 1,
     'OMPI_COMM_TYPE_CORE': 2,

ompi/mpi/c/Makefile.am

@@ -427,6 +427,7 @@ prototype_sources = \
 	type_get_name.c.in \
 	type_get_true_extent.c.in \
 	type_get_true_extent_x.c.in \
+	type_get_value_index.c.in \
 	type_indexed.c.in \
 	type_match_size.c.in \
 	type_set_attr.c.in \

ompi/mpi/c/type_get_value_index.c.in

@@ -0,0 +1,58 @@
+/*
+ * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana
+ *                         University Research and Technology
+ *                         Corporation.  All rights reserved.
+ * Copyright (c) 2004-2020 The University of Tennessee and The University
+ *                         of Tennessee Research Foundation.  All rights
+ *                         reserved.
+ * Copyright (c) 2004-2008 High Performance Computing Center Stuttgart,
+ *                         University of Stuttgart.  All rights reserved.
+ * Copyright (c) 2004-2005 The Regents of the University of California.
+ *                         All rights reserved.
+ * Copyright (c) 2015      Research Organization for Information Science
+ *                         and Technology (RIST). All rights reserved.
+ * Copyright (c) 2024-2025 Triad National Security, LLC. All rights
+ *                         reserved.
+ * $COPYRIGHT$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+#include "ompi_config.h"
+
+#include "ompi/mpi/c/bindings.h"
+#include "ompi/runtime/params.h"
+#include "ompi/communicator/communicator.h"
+#include "ompi/errhandler/errhandler.h"
+#include "ompi/datatype/ompi_datatype.h"
+#include "ompi/attribute/attribute.h"
+#include "ompi/memchecker.h"
+
+PROTOTYPE ERROR_CLASS type_get_value_index(DATATYPE value_type,
+                                           DATATYPE index_type,
+                                           DATATYPE_OUT pair_type)
+{
+   int ret;
+
+   MEMCHECKER(
+      memchecker_datatype(type);
+   );
+
+   if( MPI_PARAM_CHECK ) {
+      OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
+      if (NULL == value_type || MPI_DATATYPE_NULL == value_type ||
+          NULL == index_type || MPI_DATATYPE_NULL == index_type ||
+          NULL == pair_type) {
+        return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE,
+                                      FUNC_NAME );
+      }
+   }
+
+   if (OMPI_SUCCESS != (ret = ompi_datatype_get_value_index( value_type, index_type, pair_type))) {
+       OMPI_ERRHANDLER_NOHANDLE_RETURN( ret, ret, FUNC_NAME );
+   }
+
+   return MPI_SUCCESS;
+}

ompi/mpi/fortran/mpif-h/Makefile.am

@@ -476,6 +476,7 @@ lib@OMPI_LIBMPI_NAME@_mpifh_la_SOURCES += \
         type_get_name_f.c \
         type_get_true_extent_f.c \
         type_get_true_extent_x_f.c \
+	type_get_value_index_f.c \
         type_indexed_f.c \
         type_match_size_f.c \
         type_set_attr_f.c \

ompi/mpi/fortran/mpif-h/profile/Makefile.am

@@ -387,6 +387,7 @@ linked_files = \
         ptype_get_name_f.c \
         ptype_get_true_extent_f.c \
         ptype_get_true_extent_x_f.c \
+	ptype_get_value_index_f.c \
         ptype_indexed_f.c \
         ptype_match_size_f.c \
         ptype_set_attr_f.c \

ompi/mpi/fortran/mpif-h/prototypes_mpi.h

@@ -444,6 +444,7 @@ PN2(void, MPI_Type_get_extent_x, mpi_type_get_extent_x, MPI_TYPE_GET_EXTENT_X, (
 PN2(void, MPI_Type_get_name, mpi_type_get_name, MPI_TYPE_GET_NAME, (MPI_Fint *type, char *type_name, MPI_Fint *resultlen, MPI_Fint *ierr, int name_len));
 PN2(void, MPI_Type_get_true_extent, mpi_type_get_true_extent, MPI_TYPE_GET_TRUE_EXTENT, (MPI_Fint *datatype, MPI_Aint *true_lb, MPI_Aint *true_extent, MPI_Fint *ierr));
 PN2(void, MPI_Type_get_true_extent_x, mpi_type_get_true_extent_x, MPI_TYPE_GET_TRUE_EXTENT_X, (MPI_Fint *datatype, MPI_Count *true_lb, MPI_Count *true_extent, MPI_Fint *ierr));
+PN2(void, MPI_Type_get_value_index, mpi_type_get_value_index, MPI_TYPE_GET_VALUE_INDEX, (MPI_Fint *value_type, MPI_Fint *index_type, MPI_Fint *pair_type, MPI_Fint *ierr));
 PN2(void, MPI_Type_hindexed, mpi_type_hindexed, MPI_TYPE_HINDEXED, (MPI_Fint *count, MPI_Fint *array_of_blocklengths, MPI_Fint *array_of_displacements, MPI_Fint *oldtype, MPI_Fint *newtype, MPI_Fint *ierr));
 PN2(void, MPI_Type_hvector, mpi_type_hvector, MPI_TYPE_HVECTOR, (MPI_Fint *count, MPI_Fint *blocklength, MPI_Fint *stride, MPI_Fint *oldtype, MPI_Fint *newtype, MPI_Fint *ierr));
 PN2(void, MPI_Type_indexed, mpi_type_indexed, MPI_TYPE_INDEXED, (MPI_Fint *count, MPI_Fint *array_of_blocklengths, MPI_Fint *array_of_displacements, MPI_Fint *oldtype, MPI_Fint *newtype, MPI_Fint *ierr));

ompi/mpi/fortran/mpif-h/type_get_value_index_f.c

@@ -0,0 +1,82 @@
+/*
+ * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
+ *                         University Research and Technology
+ *                         Corporation.  All rights reserved.
+ * Copyright (c) 2004-2005 The University of Tennessee and The University
+ *                         of Tennessee Research Foundation.  All rights
+ *                         reserved.
+ * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
+ *                         University of Stuttgart.  All rights reserved.
+ * Copyright (c) 2004-2005 The Regents of the University of California.
+ *                         All rights reserved.
+ * Copyright (c) 2011-2012 Cisco Systems, Inc.  All rights reserved.
+ * Copyright (c) 2015      Research Organization for Information Science
+ *                         and Technology (RIST). All rights reserved.
+ * $COPYRIGHT$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+#include "ompi_config.h"
+
+#include "ompi/mpi/fortran/mpif-h/bindings.h"
+
+#if OMPI_BUILD_MPI_PROFILING
+#if OPAL_HAVE_WEAK_SYMBOLS
+#pragma weak PMPI_TYPE_GET_VALUE_INDEX = ompi_type_get_value_index_f
+#pragma weak pmpi_type_get_value_index = ompi_type_get_value_index_f
+#pragma weak pmpi_type_get_value_index_ = ompi_type_get_value_index_f
+#pragma weak pmpi_type_get_value_index__ = ompi_type_get_value_index_f
+
+#pragma weak PMPI_Type_get_value_index_f = ompi_type_get_value_index_f
+#pragma weak PMPI_Type_get_value_index_f08 = ompi_type_get_value_index_f
+#else
+OMPI_GENERATE_F77_BINDINGS (PMPI_TYPE_GET_VALUE_INDEX,
+                           pmpi_type_get_value_index,
+                           pmpi_type_get_value_index_,
+                           pmpi_type_get_value_index__,
+                           pompi_type_get_value_index_f,
+                           (MPI_Fint *value_type, MPI_Fint *index_type, MPI_Fint *pair_type, MPI_Fint *ierr),
+                           (value_type, index_type, pair_type, ierr) )
+#endif
+#endif
+
+#if OPAL_HAVE_WEAK_SYMBOLS
+#pragma weak MPI_TYPE_GET_VALUE_INDEX = ompi_type_get_value_index_f
+#pragma weak mpi_type_get_value_index = ompi_type_get_value_index_f
+#pragma weak mpi_type_get_value_index_ = ompi_type_get_value_index_f
+#pragma weak mpi_type_get_value_index__ = ompi_type_get_value_index_f
+
+#pragma weak MPI_Type_get_value_index_f = ompi_type_get_value_index_f
+#pragma weak MPI_Type_get_value_index_f08 = ompi_type_get_value_index_f
+#else
+#if ! OMPI_BUILD_MPI_PROFILING
+OMPI_GENERATE_F77_BINDINGS (MPI_TYPE_GET_VALUE_INDEX,
+                           mpi_type_get_value_index,
+                           mpi_type_get_value_index_,
+                           mpi_type_get_value_index__,
+                           ompi_type_get_value_index_f,
+                           (MPI_Fint *value_type, MPI_Fint *index_type, MPI_Fint *pair_type, MPI_Fint *ierr),
+                           (value_type, index_type, pair_type, ierr) )
+#else
+#define ompi_type_get_value_index_f pompi_type_get_value_index_f
+#endif
+#endif
+
+
+void ompi_type_get_value_index_f(MPI_Fint *value_type, MPI_Fint *index_type, MPI_Fint *pair_type, MPI_Fint *ierr)
+{
+    int c_ierr;
+    MPI_Datatype c_value_type = PMPI_Type_f2c(*value_type);
+    MPI_Datatype c_index_type = PMPI_Type_f2c(*index_type);
+    MPI_Datatype c_new;
+
+    c_ierr = PMPI_Type_get_value_index(c_value_type, c_index_type, &c_new);
+    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+
+    if (MPI_SUCCESS == c_ierr) {
+        *pair_type = PMPI_Type_c2f(c_new);
+    }
+}

ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files

@@ -160,6 +160,7 @@ prototype_files = \
         type_create_struct.c.in \
         type_create_subarray.c.in \
         type_get_true_extent.c.in \
+        type_get_value_index.c.in \
         type_indexed.c.in \
         type_size.c.in \
         type_vector.c.in \

ompi/mpi/fortran/use-mpi-f08/type_get_value_index.c.in

@@ -0,0 +1,36 @@
+/*
+ * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
+ *                         University Research and Technology
+ *                         Corporation.  All rights reserved.
+ * Copyright (c) 2004-2005 The University of Tennessee and The University
+ *                         of Tennessee Research Foundation.  All rights
+ *                         reserved.
+ * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
+ *                         University of Stuttgart.  All rights reserved.
+ * Copyright (c) 2004-2005 The Regents of the University of California.
+ *                         All rights reserved.
+ * Copyright (c) 2011-2012 Cisco Systems, Inc.  All rights reserved.
+ * Copyright (c) 2015      Research Organization for Information Science
+ *                         and Technology (RIST). All rights reserved.
+ * $COPYRIGHT$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+PROTOTYPE VOID type_get_value_index(DATATYPE value_type, DATATYPE index_type, DATATYPE_OUT pair_type)
+{
+    int c_ierr;
+    MPI_Datatype c_value_type = PMPI_Type_f2c(*value_type);
+    MPI_Datatype c_index_type = PMPI_Type_f2c(*index_type);
+    MPI_Datatype c_pair_type;
+
+    c_ierr = @INNER_CALL@(c_value_type, c_index_type, &c_pair_type);
+    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+
+    if (MPI_SUCCESS == c_ierr) {
+        *pair_type = PMPI_Type_c2f(c_pair_type);
+    }
+}
+