From 09504c3bfa81e9575d5d8a9e18793d55a3a2570d Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Tue, 12 Aug 2025 13:23:33 -0600 Subject: [PATCH 1/3] basic implementation of MPI_TYPE_GET_VALUE_INDEX We only support named types with this first pass. related to #12076 Fortran interfaces will be added once Fortran infrastructure additions in PR #13279 are merged in to main. Signed-off-by: Howard Pritchard --- docs/Makefile.am | 1 + .../man3/MPI_Type_get_value_index.3.rst | 36 ++++++++++++ docs/man-openmpi/man3/index.rst | 1 + ompi/datatype/ompi_datatype.h | 4 ++ ompi/datatype/ompi_datatype_create.c | 54 +++++++++++++++++ ompi/include/mpi.h.in | 7 ++- ompi/include/mpif-values.py | 3 + ompi/mpi/c/Makefile.am | 1 + ompi/mpi/c/type_get_value_index.c.in | 58 +++++++++++++++++++ 9 files changed, 164 insertions(+), 1 deletion(-) create mode 100644 docs/man-openmpi/man3/MPI_Type_get_value_index.3.rst create mode 100644 ompi/mpi/c/type_get_value_index.c.in diff --git a/docs/Makefile.am b/docs/Makefile.am index ebfb4b4c6c2..871ac41079e 100644 --- a/docs/Makefile.am +++ b/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 \ diff --git a/docs/man-openmpi/man3/MPI_Type_get_value_index.3.rst b/docs/man-openmpi/man3/MPI_Type_get_value_index.3.rst new file mode 100644 index 00000000000..0ad6720b50b --- /dev/null +++ b/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 diff --git a/docs/man-openmpi/man3/index.rst b/docs/man-openmpi/man3/index.rst index 60f5e0b798c..eb9d69fc532 100644 --- a/docs/man-openmpi/man3/index.rst +++ b/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 diff --git a/ompi/datatype/ompi_datatype.h b/ompi/datatype/ompi_datatype.h index 87de1e30aca..86f7396abe9 100644 --- a/ompi/datatype/ompi_datatype.h +++ b/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)) ) { \ diff --git a/ompi/datatype/ompi_datatype_create.c b/ompi/datatype/ompi_datatype_create.c index f9e39710f74..96acab93bdf 100644 --- a/ompi/datatype/ompi_datatype_create.c +++ b/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; +} diff --git a/ompi/include/mpi.h.in b/ompi/include/mpi.h.in index 29c34242b2a..6c5a4a5461a 100644 --- a/ompi/include/mpi.h.in +++ b/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); diff --git a/ompi/include/mpif-values.py b/ompi/include/mpif-values.py index f871a2b4b65..6045fbf5a1c 100755 --- a/ompi/include/mpif-values.py +++ b/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, diff --git a/ompi/mpi/c/Makefile.am b/ompi/mpi/c/Makefile.am index 70c080e4d2d..30d1cc571ad 100644 --- a/ompi/mpi/c/Makefile.am +++ b/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 \ diff --git a/ompi/mpi/c/type_get_value_index.c.in b/ompi/mpi/c/type_get_value_index.c.in new file mode 100644 index 00000000000..8349c15dd15 --- /dev/null +++ b/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; +} From 57d271e6a9ce3b14fde41c8e290e72cb3d9e618b Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Tue, 26 Aug 2025 15:17:26 -0600 Subject: [PATCH 2/3] add f90 and f08 interfaces Signed-off-by: Howard Pritchard --- ompi/mpi/fortran/mpif-h/Makefile.am | 1 + ompi/mpi/fortran/mpif-h/profile/Makefile.am | 1 + ompi/mpi/fortran/mpif-h/prototypes_mpi.h | 1 + .../fortran/mpif-h/type_get_value_index_f.c | 82 +++++++++++++++++++ .../use-mpi-f08/Makefile.prototype_files | 1 + .../use-mpi-f08/type_get_value_index.c.in | 36 ++++++++ .../Makefile.prototype_files | 7 +- 7 files changed, 126 insertions(+), 3 deletions(-) create mode 100644 ompi/mpi/fortran/mpif-h/type_get_value_index_f.c create mode 100644 ompi/mpi/fortran/use-mpi-f08/type_get_value_index.c.in diff --git a/ompi/mpi/fortran/mpif-h/Makefile.am b/ompi/mpi/fortran/mpif-h/Makefile.am index 2ea0d33bb14..086f35fe7d3 100644 --- a/ompi/mpi/fortran/mpif-h/Makefile.am +++ b/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 \ diff --git a/ompi/mpi/fortran/mpif-h/profile/Makefile.am b/ompi/mpi/fortran/mpif-h/profile/Makefile.am index 11b4af4d555..033f3819adc 100644 --- a/ompi/mpi/fortran/mpif-h/profile/Makefile.am +++ b/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 \ diff --git a/ompi/mpi/fortran/mpif-h/prototypes_mpi.h b/ompi/mpi/fortran/mpif-h/prototypes_mpi.h index db58f760e9c..cc538ab98a6 100644 --- a/ompi/mpi/fortran/mpif-h/prototypes_mpi.h +++ b/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)); diff --git a/ompi/mpi/fortran/mpif-h/type_get_value_index_f.c b/ompi/mpi/fortran/mpif-h/type_get_value_index_f.c new file mode 100644 index 00000000000..8ac23331e60 --- /dev/null +++ b/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); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files b/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files index 0c6e755ce85..fe55803049c 100644 --- a/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files +++ b/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 \ diff --git a/ompi/mpi/fortran/use-mpi-f08/type_get_value_index.c.in b/ompi/mpi/fortran/use-mpi-f08/type_get_value_index.c.in new file mode 100644 index 00000000000..6efbc8a5e82 --- /dev/null +++ b/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); + } +} + diff --git a/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.prototype_files b/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.prototype_files index 72dd7ea9550..67adffe7c9e 100644 --- a/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.prototype_files +++ b/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.prototype_files @@ -4,6 +4,7 @@ prototype_files = \ request_get_status.c.in \ - request_get_status_all.c.in \ - request_get_status_any.c.in \ - request_get_status_some.c.in + request_get_status_all.c.in \ + request_get_status_any.c.in \ + request_get_status_some.c.in \ + type_get_value_index.c.in From 6fa7a48984cfaf78ecfc004609eff73d6263d471 Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Wed, 3 Sep 2025 15:54:41 -0600 Subject: [PATCH 3/3] pr feedback Signed-off-by: Howard Pritchard --- ompi/datatype/ompi_datatype_create.c | 6 ++---- ompi/mpi/fortran/mpif-h/Makefile.am | 2 +- ompi/mpi/fortran/mpif-h/profile/Makefile.am | 2 +- 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/ompi/datatype/ompi_datatype_create.c b/ompi/datatype/ompi_datatype_create.c index 96acab93bdf..4b01f2dfed6 100644 --- a/ompi/datatype/ompi_datatype_create.c +++ b/ompi/datatype/ompi_datatype_create.c @@ -132,6 +132,8 @@ ompi_datatype_duplicate( const ompi_datatype_t* oldType, ompi_datatype_t** newTy int ompi_datatype_get_value_index(const ompi_datatype_t *value_type, const ompi_datatype_t *index_type, ompi_datatype_t **pair_type) { + *pair_type = (ompi_datatype_t *)&ompi_mpi_datatype_null; + /* C predefined data types */ if (index_type->id == OMPI_DATATYPE_MPI_INT) { if (value_type->id == OMPI_DATATYPE_MPI_FLOAT) { @@ -146,8 +148,6 @@ ompi_datatype_get_value_index(const ompi_datatype_t *value_type, const ompi_data *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) && @@ -169,8 +169,6 @@ ompi_datatype_get_value_index(const ompi_datatype_t *value_type, const ompi_data (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; diff --git a/ompi/mpi/fortran/mpif-h/Makefile.am b/ompi/mpi/fortran/mpif-h/Makefile.am index 086f35fe7d3..96d848fc4a7 100644 --- a/ompi/mpi/fortran/mpif-h/Makefile.am +++ b/ompi/mpi/fortran/mpif-h/Makefile.am @@ -476,7 +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_get_value_index_f.c \ type_indexed_f.c \ type_match_size_f.c \ type_set_attr_f.c \ diff --git a/ompi/mpi/fortran/mpif-h/profile/Makefile.am b/ompi/mpi/fortran/mpif-h/profile/Makefile.am index 033f3819adc..39160a8c9de 100644 --- a/ompi/mpi/fortran/mpif-h/profile/Makefile.am +++ b/ompi/mpi/fortran/mpif-h/profile/Makefile.am @@ -387,7 +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_get_value_index_f.c \ ptype_indexed_f.c \ ptype_match_size_f.c \ ptype_set_attr_f.c \