From da50804d2a717fefbe61a02820b43b3117908374 Mon Sep 17 00:00:00 2001 From: Thomas Naughton Date: Tue, 1 Jul 2025 17:49:01 -0400 Subject: [PATCH] Support MPI 4.1 removal of error class/code/string - add MPI_Remove_error_{class,code,string} C & Fortran bindings - add MPI_Remove_error_{class,code,string} to docs - Note: There are also some tests in the ompi-tests-public repo (under environ-mgmt) that can exercise these changes. Signed-off-by: Thomas Naughton --- docs/Makefile.am | 3 + .../man3/MPI_Remove_error_class.3.rst | 41 +++++++++ .../man3/MPI_Remove_error_code.3.rst | 41 +++++++++ .../man3/MPI_Remove_error_string.3.rst | 40 +++++++++ docs/man-openmpi/man3/index.rst | 3 + ompi/errhandler/errcode.c | 85 +++++++++++++++++++ ompi/errhandler/errcode.h | 75 +++++++--------- ompi/include/mpi.h.in | 7 ++ ompi/mpi/c/Makefile.am | 4 + ompi/mpi/c/remove_error_class.c.in | 73 ++++++++++++++++ ompi/mpi/c/remove_error_code.c.in | 72 ++++++++++++++++ ompi/mpi/c/remove_error_string.c.in | 57 +++++++++++++ ompi/mpi/fortran/mpif-h/Makefile.am | 3 + ompi/mpi/fortran/mpif-h/profile/Makefile.am | 3 + ompi/mpi/fortran/mpif-h/prototypes_mpi.h | 4 + .../mpi/fortran/mpif-h/remove_error_class_f.c | 81 ++++++++++++++++++ ompi/mpi/fortran/mpif-h/remove_error_code_f.c | 81 ++++++++++++++++++ .../fortran/mpif-h/remove_error_string_f.c | 76 +++++++++++++++++ ompi/mpi/fortran/use-mpi-f08/Makefile.am | 3 + .../bindings/mpi-f-interfaces-bind.h | 22 +++++ .../use-mpi-f08/mod/mpi-f08-interfaces.h.in | 25 ++++++ .../fortran/use-mpi-f08/mod/mpi-f08-rename.h | 7 ++ .../use-mpi-f08/remove_error_class_f08.F90 | 23 +++++ .../use-mpi-f08/remove_error_code_f08.F90 | 23 +++++ .../use-mpi-f08/remove_error_string_f08.F90 | 24 ++++++ .../mpi-ignore-tkr-interfaces.h.in | 31 +++++++ .../pmpi-ignore-tkr-interfaces.h | 4 + 27 files changed, 868 insertions(+), 43 deletions(-) create mode 100644 docs/man-openmpi/man3/MPI_Remove_error_class.3.rst create mode 100644 docs/man-openmpi/man3/MPI_Remove_error_code.3.rst create mode 100644 docs/man-openmpi/man3/MPI_Remove_error_string.3.rst create mode 100644 ompi/mpi/c/remove_error_class.c.in create mode 100644 ompi/mpi/c/remove_error_code.c.in create mode 100644 ompi/mpi/c/remove_error_string.c.in create mode 100644 ompi/mpi/fortran/mpif-h/remove_error_class_f.c create mode 100644 ompi/mpi/fortran/mpif-h/remove_error_code_f.c create mode 100644 ompi/mpi/fortran/mpif-h/remove_error_string_f.c create mode 100644 ompi/mpi/fortran/use-mpi-f08/remove_error_class_f08.F90 create mode 100644 ompi/mpi/fortran/use-mpi-f08/remove_error_code_f08.F90 create mode 100644 ompi/mpi/fortran/use-mpi-f08/remove_error_string_f08.F90 diff --git a/docs/Makefile.am b/docs/Makefile.am index 739114737bd..ca620636990 100644 --- a/docs/Makefile.am +++ b/docs/Makefile.am @@ -392,6 +392,9 @@ OMPI_MAN3 = \ MPI_Reduce_scatter_block_init.3 \ MPI_Reduce_scatter_init.3 \ MPI_Register_datarep.3 \ + MPI_Remove_error_class.3 \ + MPI_Remove_error_code.3 \ + MPI_Remove_error_string.3 \ MPI_Request_c2f.3 \ MPI_Request_f2c.3 \ MPI_Request_free.3 \ diff --git a/docs/man-openmpi/man3/MPI_Remove_error_class.3.rst b/docs/man-openmpi/man3/MPI_Remove_error_class.3.rst new file mode 100644 index 00000000000..d1ceb0c9566 --- /dev/null +++ b/docs/man-openmpi/man3/MPI_Remove_error_class.3.rst @@ -0,0 +1,41 @@ +.. _mpi_remove_error_class: + + +MPI_Remove_error_class +====================== + +.. include_body + +:ref:`MPI_Remove_error_class` |mdash| Removes a user-created error class. + +.. The following file was automatically generated +.. include:: ./bindings/mpi_remove_error_class.rst + +INPUT PARAMETERS +---------------- +* ``errorclass``: New error class (integer). + +OUTPUT PARAMETERS +----------------- +* ``ierror``: Fortran only: Error status (integer). + +DESCRIPTION +----------- + +The function :ref:`MPI_Remove_error_class` removes a user-created error class. +It is erroneous to call :ref:`MPI_Remove_error_class` with a value for +*errorclass* that was not added by a call to :ref:`MPI_Add_error_class`. +It is erroneous to remove an error class when its associated error codes +have not been removed before. + +ERRORS +------ + +.. include:: ./ERRORS.rst + +.. seealso:: + * :ref:`MPI_Add_error_class` + * :ref:`MPI_Remove_error_code` + * :ref:`MPI_Remove_error_string` + * :ref:`MPI_Error_class` + * :ref:`MPI_Error_string` diff --git a/docs/man-openmpi/man3/MPI_Remove_error_code.3.rst b/docs/man-openmpi/man3/MPI_Remove_error_code.3.rst new file mode 100644 index 00000000000..94cf7273109 --- /dev/null +++ b/docs/man-openmpi/man3/MPI_Remove_error_code.3.rst @@ -0,0 +1,41 @@ +.. _mpi_remove_error_code: + + +MPI_Remove_error_code +===================== + +.. include_body + +:ref:`MPI_Remove_error_code` |mdash| Remove a user-created error code associated with +*errorcode* + +.. The following file was automatically generated +.. include:: ./bindings/mpi_remove_error_code.rst + +INPUT PARAMETER +--------------- +* ``errorcode``: MPI error code (integer). + +OUTPUT PARAMETERS +----------------- +* ``ierror``: Fortran only: Error status (integer). + +DESCRIPTION +----------- + +Removes a user-created error code associated with *errorcode*. +It is erroneous to call :ref:`MPI_Remove_error_code` with a value for +*errorcode* that was not added by a call to :ref:`MPI_Add_error_code`. +It is erroneous to remove an error code when its associated error string has +not been removed before. + +ERRORS +------ + +.. include:: ./ERRORS.rst + +.. seealso:: + * :ref:`MPI_Add_error_code` + * :ref:`MPI_Remove_error_class` + * :ref:`MPI_Remove_error_string` + * :ref:`MPI_Error_class` diff --git a/docs/man-openmpi/man3/MPI_Remove_error_string.3.rst b/docs/man-openmpi/man3/MPI_Remove_error_string.3.rst new file mode 100644 index 00000000000..18be70f9a28 --- /dev/null +++ b/docs/man-openmpi/man3/MPI_Remove_error_string.3.rst @@ -0,0 +1,40 @@ +.. _mpi_remove_error_string: + + +MPI_Remove_error_string +======================= + +.. include_body + +:ref:`MPI_Remove_error_string` |mdash| Removes the error string associated with +a user-created error code. + +.. The following file was automatically generated +.. include:: ./bindings/mpi_remove_error_string.rst + +INPUT PARAMETERS +---------------- +* ``errorcode``: MPI error code, returned by an MPI routine (integer). + +OUTPUT PARAMETER +---------------- +* ``ierror``: Fortran only: Error status (integer). + +DESCRIPTION +----------- + +This routine removes an error string associated with a user-created error code. +It is erroneous to call :ref:`MPI_Remove_error_string` with a value for *errorcode* +that does not have an error string added by a call to :ref:`MPI_Add_error_string`. + +ERRORS +------ + +.. include:: ./ERRORS.rst + +.. seealso:: + * :ref:`MPI_Add_error_string` + * :ref:`MPI_Remove_error_class` + * :ref:`MPI_Remove_error_code` + * :ref:`MPI_Error_class` + * :ref:`MPI_Error_string` diff --git a/docs/man-openmpi/man3/index.rst b/docs/man-openmpi/man3/index.rst index 8991988e78f..c746815fbf3 100644 --- a/docs/man-openmpi/man3/index.rst +++ b/docs/man-openmpi/man3/index.rst @@ -312,6 +312,9 @@ MPI API manual pages (section 3) MPI_Reduce_scatter_block_init.3.rst MPI_Reduce_scatter_init.3.rst MPI_Register_datarep.3.rst + MPI_Remove_error_class.3.rst + MPI_Remove_error_code.3.rst + MPI_Remove_error_string.3.rst MPI_Request_c2f.3.rst MPI_Request_f2c.3.rst MPI_Request_free.3.rst diff --git a/ompi/errhandler/errcode.c b/ompi/errhandler/errcode.c index ea3fc8c2ab9..1e157595da0 100644 --- a/ompi/errhandler/errcode.c +++ b/ompi/errhandler/errcode.c @@ -19,6 +19,7 @@ * and Technology (RIST). All rights reserved. * Copyright (c) 2022 Triad National Security, LLC. All rights * reserved. + * Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -419,6 +420,90 @@ int ompi_mpi_errnum_add_string(int errnum, const char *errstring, int len) return OMPI_SUCCESS; } +int ompi_mpi_errcode_remove(int errnum) +{ + int ret = OMPI_ERROR; + ompi_mpi_errcode_t *errcodep = NULL; + + opal_mutex_lock(&errcode_lock); + + errcodep = (ompi_mpi_errcode_t *)opal_pointer_array_get_item(&ompi_mpi_errcodes, errnum); + if ( NULL == errcodep ) { + opal_mutex_unlock(&errcode_lock); + return OMPI_ERROR; + } + + /* Must have already removed estring before remove error code */ + if (errcodep->errstring[0] == '\0') { + if (MPI_UNDEFINED != errcodep->code) { + ret = opal_pointer_array_set_item(&ompi_mpi_errcodes, errnum, NULL); + if (OPAL_SUCCESS == ret) { + if (errnum == ompi_mpi_errcode_lastused) { + ompi_mpi_errcode_lastused--; + } + } + } + } + + opal_mutex_unlock(&errcode_lock); + + return ret; +} + +int ompi_mpi_errclass_remove(int errclass) +{ + int ret = OMPI_ERROR; + ompi_mpi_errcode_t *errcodep = NULL; + + opal_mutex_lock(&errcode_lock); + + errcodep = (ompi_mpi_errcode_t *)opal_pointer_array_get_item(&ompi_mpi_errcodes, errclass); + if ( NULL == errcodep ) { + opal_mutex_unlock(&errcode_lock); + return OMPI_ERROR; + } + + /* Must have already removed estring before remove error class */ + if (errcodep->errstring[0] == '\0') { + /* Must have already removed ecode before remove error class */ + if (MPI_UNDEFINED == errcodep->code) { + if (MPI_UNDEFINED != errcodep->cls) { + ret = opal_pointer_array_set_item(&ompi_mpi_errcodes, errcodep->cls, NULL); + if (OPAL_SUCCESS == ret) { + if (errclass == ompi_mpi_errcode_lastused) { + ompi_mpi_errcode_lastused--; + } + } + } + } + } + + opal_mutex_unlock(&errcode_lock); + + return ret; +} + +int ompi_mpi_errnum_remove_string(int errnum) +{ + ompi_mpi_errcode_t *errcodep = NULL; + + opal_mutex_lock(&errcode_lock); + + errcodep = (ompi_mpi_errcode_t *)opal_pointer_array_get_item(&ompi_mpi_errcodes, errnum); + if ( NULL == errcodep ) { + opal_mutex_unlock(&errcode_lock); + return OMPI_ERROR; + } + + if (errcodep->errstring[0] != '\0') { + memset ( errcodep->errstring, 0, MPI_MAX_ERROR_STRING); + } + + opal_mutex_unlock(&errcode_lock); + + return OMPI_SUCCESS; +} + static void ompi_mpi_errcode_construct(ompi_mpi_errcode_t *errcode) { errcode->code = MPI_UNDEFINED; diff --git a/ompi/errhandler/errcode.h b/ompi/errhandler/errcode.h index 24d070fb4f3..728616a5b03 100644 --- a/ompi/errhandler/errcode.h +++ b/ompi/errhandler/errcode.h @@ -110,6 +110,38 @@ int ompi_mpi_errclass_add (void); */ int ompi_mpi_errnum_add_string (int errnum, const char* string, int len); +/** + * Remove an error code + * + * @param: error code to be removed + * + * @returns OMPI_SUCCESS on success + * @returns OMPI_ERROR otherwise + * + */ +int ompi_mpi_errcode_remove (int errcode); + +/** + * Remove an error class + * + * @param: none + * + * @returns OMPI_SUCCESS on success + * @returns OMPI_ERROR otherwise + * + */ +int ompi_mpi_errclass_remove (int errclass); + +/** + * Remove an error string to an error code + * + * @param: error code for which the string is defined + * + * @returns OMPI_SUCCESS on success + * @returns OMPI_ERROR on error + */ +int ompi_mpi_errnum_remove_string (int errnum); + /** * Check for a valid error code */ @@ -217,49 +249,6 @@ static inline char* ompi_mpi_errnum_get_string (int errnum) } -/** - * Initialize the error codes - * - * @returns OMPI_SUCCESS Upon success - * @returns OMPI_ERROR Otherwise - * - * Invoked from ompi_mpi_init(); sets up all static MPI error codes, - */ -int ompi_mpi_errcode_init(void); - -/** - * Add an error code - * - * @param: error class to which this new error code belongs to - * - * @returns the new error code on SUCCESS (>0) - * @returns OMPI_ERROR otherwise - * - */ -int ompi_mpi_errcode_add (int errclass); - -/** - * Add an error class - * - * @param: none - * - * @returns the new error class on SUCCESS (>0) - * @returns OMPI_ERROR otherwise - * - */ -int ompi_mpi_errclass_add (void); - -/** - * Add an error string to an error code - * - * @param: error code for which the string is defined - * @param: error string to add - * @param: length of the string - * - * @returns OMPI_SUCCESS on success - * @returns OMPI_ERROR on error - */ -int ompi_mpi_errnum_add_string (int errnum, const char* string, int len); END_C_DECLS diff --git a/ompi/include/mpi.h.in b/ompi/include/mpi.h.in index b352fc2caf5..2f52b40abaf 100644 --- a/ompi/include/mpi.h.in +++ b/ompi/include/mpi.h.in @@ -29,6 +29,7 @@ * reserved. * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved * Copyright (c) 2025 Jeffrey M. Squyres. All rights reserved. + * Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -2246,6 +2247,9 @@ OMPI_DECLSPEC int MPI_Register_datarep_c(const char *datarep, MPI_Datarep_conversion_function_c *write_conversion_fn, MPI_Datarep_extent_function *dtype_file_extent_fn, void *extra_state); +OMPI_DECLSPEC int MPI_Remove_error_class(int errorclass); +OMPI_DECLSPEC int MPI_Remove_error_code(int errorcode); +OMPI_DECLSPEC int MPI_Remove_error_string(int errorcode); OMPI_DECLSPEC MPI_Fint MPI_Request_c2f(MPI_Request request); OMPI_DECLSPEC MPI_Request MPI_Request_f2c(MPI_Fint request); OMPI_DECLSPEC int MPI_Request_free(MPI_Request *request); @@ -3419,6 +3423,9 @@ OMPI_DECLSPEC int PMPI_Register_datarep_c(const char *datarep, MPI_Datarep_conversion_function_c *write_conversion_fn, MPI_Datarep_extent_function *dtype_file_extent_fn, void *extra_state); +OMPI_DECLSPEC int PMPI_Remove_error_class(int errorclass); +OMPI_DECLSPEC int PMPI_Remove_error_code(int errorcode); +OMPI_DECLSPEC int PMPI_Remove_error_string(int errorcode); OMPI_DECLSPEC MPI_Fint PMPI_Request_c2f(MPI_Request request); OMPI_DECLSPEC MPI_Request PMPI_Request_f2c(MPI_Fint request); OMPI_DECLSPEC int PMPI_Request_free(MPI_Request *request); diff --git a/ompi/mpi/c/Makefile.am b/ompi/mpi/c/Makefile.am index 3f071c9f329..5dbd959cd44 100644 --- a/ompi/mpi/c/Makefile.am +++ b/ompi/mpi/c/Makefile.am @@ -21,6 +21,7 @@ # reserved. # Copyright (c) 2025 Advanced Micro Devices, Inc. All Rights reserved. # Copyright (c) 2025 Triad National Security, LLC. All rights reserved. +# Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. # $COPYRIGHT$ # # Additional copyrights may follow @@ -351,6 +352,9 @@ prototype_sources = \ register_datarep.c.in \ request_c2f.c.in \ request_f2c.c.in \ + remove_error_class.c.in \ + remove_error_code.c.in \ + remove_error_string.c.in \ request_free.c.in \ request_get_status.c.in \ request_get_status_all.c.in \ diff --git a/ompi/mpi/c/remove_error_class.c.in b/ompi/mpi/c/remove_error_class.c.in new file mode 100644 index 00000000000..fda93f7151f --- /dev/null +++ b/ompi/mpi/c/remove_error_class.c.in @@ -0,0 +1,73 @@ +/* + * 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-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) 2006 University of Houston. All rights reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/errhandler/errcode.h" +#include "ompi/communicator/communicator.h" +#include "ompi/attribute/attribute.h" + +PROTOTYPE ERROR_CLASS remove_error_class(INT errorclass) +{ + int rc; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( !ompi_mpi_errnum_is_class ( errorclass ) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + + } + + rc = ompi_mpi_errclass_remove( errorclass ); + if ( MPI_SUCCESS != rc ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INTERN, + FUNC_NAME); + } + + + /* + ** Update the attribute value. See the comments + ** in attribute/attribute.c and attribute/attribute_predefined.c + ** why we have to call the fortran attr_set function + */ + rc = ompi_attr_set_fint (COMM_ATTR, + MPI_COMM_WORLD, + &MPI_COMM_WORLD->c_keyhash, + MPI_LASTUSEDCODE, + ompi_mpi_errcode_lastused, + true); + if ( MPI_SUCCESS != rc ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } + + return MPI_SUCCESS; +} + diff --git a/ompi/mpi/c/remove_error_code.c.in b/ompi/mpi/c/remove_error_code.c.in new file mode 100644 index 00000000000..9ecc74b5e50 --- /dev/null +++ b/ompi/mpi/c/remove_error_code.c.in @@ -0,0 +1,72 @@ +/* + * 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-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) 2006 University of Houston. All rights reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/errhandler/errcode.h" +#include "ompi/attribute/attribute.h" + +PROTOTYPE ERROR_CLASS remove_error_code(INT errorcode) +{ + int code; + int rc; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_mpi_errcode_is_invalid(errorcode) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + + } + + code = ompi_mpi_errcode_remove ( errorcode ); + if ( 0 > code ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INTERN, + FUNC_NAME); + } + + /* + ** Update the attribute value. See the comments + ** in attribute/attribute.c and attribute/attribute_predefined.c + ** why we have to call the fortran attr_set function + */ + rc = ompi_attr_set_fint (COMM_ATTR, + MPI_COMM_WORLD, + &MPI_COMM_WORLD->c_keyhash, + MPI_LASTUSEDCODE, + ompi_mpi_errcode_lastused, + true); + if ( MPI_SUCCESS != rc ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/remove_error_string.c.in b/ompi/mpi/c/remove_error_string.c.in new file mode 100644 index 00000000000..eec991fbbb6 --- /dev/null +++ b/ompi/mpi/c/remove_error_string.c.in @@ -0,0 +1,57 @@ +/* + * 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-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) 2006 University of Houston. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/errhandler/errcode.h" + +PROTOTYPE ERROR_CLASS remove_error_string(INT errorcode) +{ + int rc; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_mpi_errcode_is_invalid(errorcode) ) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + + if ( ompi_mpi_errcode_is_predefined(errorcode) ) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + + rc = ompi_mpi_errnum_remove_string (errorcode); + if ( OMPI_SUCCESS != rc ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INTERN, + FUNC_NAME); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/fortran/mpif-h/Makefile.am b/ompi/mpi/fortran/mpif-h/Makefile.am index 9429def5b29..6280e37cb8a 100644 --- a/ompi/mpi/fortran/mpif-h/Makefile.am +++ b/ompi/mpi/fortran/mpif-h/Makefile.am @@ -137,6 +137,9 @@ lib@OMPI_LIBMPI_NAME@_mpifh_la_SOURCES += \ add_error_class_f.c \ add_error_code_f.c \ add_error_string_f.c \ + remove_error_class_f.c \ + remove_error_code_f.c \ + remove_error_string_f.c \ aint_add_f.c \ aint_diff_f.c \ allgather_f.c \ diff --git a/ompi/mpi/fortran/mpif-h/profile/Makefile.am b/ompi/mpi/fortran/mpif-h/profile/Makefile.am index 13a78b59639..88e495b56db 100644 --- a/ompi/mpi/fortran/mpif-h/profile/Makefile.am +++ b/ompi/mpi/fortran/mpif-h/profile/Makefile.am @@ -49,6 +49,9 @@ linked_files = \ padd_error_class_f.c \ padd_error_code_f.c \ padd_error_string_f.c \ + premove_error_class_f.c \ + premove_error_code_f.c \ + premove_error_string_f.c \ paint_add_f.c \ paint_diff_f.c \ pallgather_f.c \ diff --git a/ompi/mpi/fortran/mpif-h/prototypes_mpi.h b/ompi/mpi/fortran/mpif-h/prototypes_mpi.h index d307fae3767..931d019dce7 100644 --- a/ompi/mpi/fortran/mpif-h/prototypes_mpi.h +++ b/ompi/mpi/fortran/mpif-h/prototypes_mpi.h @@ -19,6 +19,7 @@ * Copyright (c) 2019-2025 Triad National Security, LLC. All rights * reserved. * Copyright (c) 2021 Bull S.A.S. All rights reserved. + * Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -378,6 +379,9 @@ PN2(void, MPI_Reduce_scatter_init, mpi_reduce_scatter_init, MPI_REDUCE_SCATTER_I PN2(void, MPI_Reduce_scatter_block, mpi_reduce_scatter_block, MPI_REDUCE_SCATTER_BLOCK, (char *sendbuf, char *recvbuf, MPI_Fint *recvcount, MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, MPI_Fint *ierr)); PN2(void, MPI_Reduce_scatter_block_init, mpi_reduce_scatter_block_init, MPI_REDUCE_SCATTER_BLOCK_INIT, (char *sendbuf, char *recvbuf, MPI_Fint *recvcount, MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, MPI_Fint *info, MPI_Fint *request, MPI_Fint *ierr)); PN2(void, MPI_Register_datarep, mpi_register_datarep, MPI_REGISTER_DATAREP, (char *datarep, ompi_mpi2_fortran_datarep_conversion_fn_t *read_conversion_fn, ompi_mpi2_fortran_datarep_conversion_fn_t *write_conversion_fn, ompi_mpi2_fortran_datarep_extent_fn_t *dtype_file_extent_fn, MPI_Aint *extra_state, MPI_Fint *ierr, int datarep_len)); +PN2(void, MPI_Remove_error_class, mpi_remove_error_class, MPI_REMOVE_ERROR_CLASS, (MPI_Fint *errorclass, MPI_Fint *ierr)); +PN2(void, MPI_Remove_error_code, mpi_remove_error_code, MPI_REMOVE_ERROR_CODE, (MPI_Fint *errorcode, MPI_Fint *ierr)); +PN2(void, MPI_Remove_error_string, mpi_remove_error_string, MPI_REMOVE_ERROR_STRING, (MPI_Fint *errorcode, MPI_Fint *ierr)); PN2(void, MPI_Request_free, mpi_request_free, MPI_REQUEST_FREE, (MPI_Fint *request, MPI_Fint *ierr)); PN2(void, MPI_Request_get_status, mpi_request_get_status, MPI_REQUEST_GET_STATUS, (MPI_Fint *request, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr)); PN2(void, MPI_Request_get_status_all, mpi_request_get_status_all, MPI_REQUEST_GET_STATUS_ALL, (MPI_Fint *count, MPI_Fint *array_of_requests, ompi_fortran_logical_t *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr)); diff --git a/ompi/mpi/fortran/mpif-h/remove_error_class_f.c b/ompi/mpi/fortran/mpif-h/remove_error_class_f.c new file mode 100644 index 00000000000..478ddd16504 --- /dev/null +++ b/ompi/mpi/fortran/mpif-h/remove_error_class_f.c @@ -0,0 +1,81 @@ +/* + * 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 (c) 2025 UT-Battelle, LLC. 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_REMOVE_ERROR_CLASS = ompi_remove_error_class_f +#pragma weak pmpi_remove_error_class = ompi_remove_error_class_f +#pragma weak pmpi_remove_error_class_ = ompi_remove_error_class_f +#pragma weak pmpi_remove_error_class__ = ompi_remove_error_class_f + +#pragma weak PMPI_Remove_error_class_f = ompi_remove_error_class_f +#pragma weak PMPI_Remove_error_class_f08 = ompi_remove_error_class_f +#else +OMPI_GENERATE_F77_BINDINGS (PMPI_REMOVE_ERROR_CLASS, + pmpi_remove_error_class, + pmpi_remove_error_class_, + pmpi_remove_error_class__, + pompi_remove_error_class_f, + (MPI_Fint *errorclass, MPI_Fint *ierr), + (errorclass, ierr) ) +#endif +#endif + +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_REMOVE_ERROR_CLASS = ompi_remove_error_class_f +#pragma weak mpi_remove_error_class = ompi_remove_error_class_f +#pragma weak mpi_remove_error_class_ = ompi_remove_error_class_f +#pragma weak mpi_remove_error_class__ = ompi_remove_error_class_f + +#pragma weak MPI_Remove_error_class_f = ompi_remove_error_class_f +#pragma weak MPI_Remove_error_class_f08 = ompi_remove_error_class_f +#else +#if ! OMPI_BUILD_MPI_PROFILING +OMPI_GENERATE_F77_BINDINGS (MPI_REMOVE_ERROR_CLASS, + mpi_remove_error_class, + mpi_remove_error_class_, + mpi_remove_error_class__, + ompi_remove_error_class_f, + (MPI_Fint *errorclass, MPI_Fint *ierr), + (errorclass, ierr) ) +#else +#define ompi_remove_error_class_f pompi_remove_error_class_f +#endif +#endif + + +void ompi_remove_error_class_f(MPI_Fint *errorclass, MPI_Fint *ierr) +{ + int ierr_c; + OMPI_SINGLE_NAME_DECL(errorclass); + + ierr_c = PMPI_Remove_error_class(OMPI_FINT_2_INT(*errorclass)); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(ierr_c); + + if (MPI_SUCCESS == ierr_c) { + OMPI_SINGLE_INT_2_FINT(errorclass); + } +} diff --git a/ompi/mpi/fortran/mpif-h/remove_error_code_f.c b/ompi/mpi/fortran/mpif-h/remove_error_code_f.c new file mode 100644 index 00000000000..1cd6536e461 --- /dev/null +++ b/ompi/mpi/fortran/mpif-h/remove_error_code_f.c @@ -0,0 +1,81 @@ +/* + * 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 (c) 2025 UT-Battelle, LLC. 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_REMOVE_ERROR_CODE = ompi_remove_error_code_f +#pragma weak pmpi_remove_error_code = ompi_remove_error_code_f +#pragma weak pmpi_remove_error_code_ = ompi_remove_error_code_f +#pragma weak pmpi_remove_error_code__ = ompi_remove_error_code_f + +#pragma weak PMPI_Remove_error_code_f = ompi_remove_error_code_f +#pragma weak PMPI_Remove_error_code_f08 = ompi_remove_error_code_f +#else +OMPI_GENERATE_F77_BINDINGS (PMPI_REMOVE_ERROR_CODE, + pmpi_remove_error_code, + pmpi_remove_error_code_, + pmpi_remove_error_code__, + pompi_remove_error_code_f, + (MPI_Fint *errorcode, MPI_Fint *ierr), + (errorcode, ierr) ) +#endif +#endif + +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_REMOVE_ERROR_CODE = ompi_remove_error_code_f +#pragma weak mpi_remove_error_code = ompi_remove_error_code_f +#pragma weak mpi_remove_error_code_ = ompi_remove_error_code_f +#pragma weak mpi_remove_error_code__ = ompi_remove_error_code_f + +#pragma weak MPI_Remove_error_code_f = ompi_remove_error_code_f +#pragma weak MPI_Remove_error_code_f08 = ompi_remove_error_code_f +#else +#if ! OMPI_BUILD_MPI_PROFILING +OMPI_GENERATE_F77_BINDINGS (MPI_REMOVE_ERROR_CODE, + mpi_remove_error_code, + mpi_remove_error_code_, + mpi_remove_error_code__, + ompi_remove_error_code_f, + (MPI_Fint *errorcode, MPI_Fint *ierr), + (errorcode, ierr) ) +#else +#define ompi_remove_error_code_f pompi_remove_error_code_f +#endif +#endif + + +void ompi_remove_error_code_f(MPI_Fint *errorcode, MPI_Fint *ierr) +{ + int ierr_c; + OMPI_SINGLE_NAME_DECL(errorcode); + + ierr_c = PMPI_Remove_error_code(OMPI_FINT_2_INT(*errorcode)); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(ierr_c); + if (MPI_SUCCESS == ierr_c) { + OMPI_SINGLE_INT_2_FINT(errorcode); + } +} diff --git a/ompi/mpi/fortran/mpif-h/remove_error_string_f.c b/ompi/mpi/fortran/mpif-h/remove_error_string_f.c new file mode 100644 index 00000000000..09b7ecddd1b --- /dev/null +++ b/ompi/mpi/fortran/mpif-h/remove_error_string_f.c @@ -0,0 +1,76 @@ +/* + * 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-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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2025 UT-Battelle, LLC. 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_REMOVE_ERROR_STRING = ompi_remove_error_string_f +#pragma weak pmpi_remove_error_string = ompi_remove_error_string_f +#pragma weak pmpi_remove_error_string_ = ompi_remove_error_string_f +#pragma weak pmpi_remove_error_string__ = ompi_remove_error_string_f + +#pragma weak PMPI_Remove_error_string_f = ompi_remove_error_string_f +#pragma weak PMPI_Remove_error_string_f08 = ompi_remove_error_string_f +#else +OMPI_GENERATE_F77_BINDINGS (PMPI_REMOVE_ERROR_STRING, + pmpi_remove_error_string, + pmpi_remove_error_string_, + pmpi_remove_error_string__, + pompi_remove_error_string_f, + (MPI_Fint *errorcode, MPI_Fint *ierr), + (errorcode, ierr) ) +#endif +#endif + +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_REMOVE_ERROR_STRING = ompi_remove_error_string_f +#pragma weak mpi_remove_error_string = ompi_remove_error_string_f +#pragma weak mpi_remove_error_string_ = ompi_remove_error_string_f +#pragma weak mpi_remove_error_string__ = ompi_remove_error_string_f + +#pragma weak MPI_Remove_error_string_f = ompi_remove_error_string_f +#pragma weak MPI_Remove_error_string_f08 = ompi_remove_error_string_f +#else +#if ! OMPI_BUILD_MPI_PROFILING +OMPI_GENERATE_F77_BINDINGS (MPI_REMOVE_ERROR_STRING, + mpi_remove_error_string, + mpi_remove_error_string_, + mpi_remove_error_string__, + ompi_remove_error_string_f, + (MPI_Fint *errorcode, MPI_Fint *ierr), + (errorcode, ierr) ) +#else +#define ompi_remove_error_string_f pompi_remove_error_string_f +#endif +#endif + + +void ompi_remove_error_string_f(MPI_Fint *errorcode, MPI_Fint *ierr) +{ + int ierr_c; + + ierr_c = PMPI_Remove_error_string(OMPI_FINT_2_INT(*errorcode)); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(ierr_c); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/Makefile.am index 9d11dbe571d..36a84d20b4a 100644 --- a/ompi/mpi/fortran/use-mpi-f08/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-f08/Makefile.am @@ -278,6 +278,9 @@ mpi_api_files = \ publish_name_f08.F90 \ query_thread_f08.F90 \ register_datarep_f08.F90 \ + remove_error_class_f08.F90 \ + remove_error_code_f08.F90 \ + remove_error_string_f08.F90 \ request_free_f08.F90 \ session_call_errhandler_f08.F90\ session_create_errhandler_f08.F90\ diff --git a/ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h b/ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h index 3b1ac4ff827..fd49853b3f7 100644 --- a/ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h +++ b/ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h @@ -14,6 +14,7 @@ ! Copyright (c) 2021 Bull S.A.S. All rights reserved. ! Copyright (c) 2021-2022 Triad National Security, LLC. All rights ! reserved. +! Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. ! $COPYRIGHT$ ! ! This file provides the interface specifications for the MPI Fortran @@ -394,6 +395,27 @@ subroutine ompi_recv_init_f(buf,count,datatype,source,tag,comm,request,ierror) & INTEGER, INTENT(OUT) :: ierror end subroutine ompi_recv_init_f +subroutine ompi_remove_error_class_f(errorclass,ierror) & + BIND(C, name="ompi_remove_error_class_f") + implicit none + INTEGER, INTENT(IN) :: errorclass + INTEGER, INTENT(OUT) :: ierror +end subroutine ompi_remove_error_class_f + +subroutine ompi_remove_error_code_f(errorcode,ierror) & + BIND(C, name="ompi_remove_error_code_f") + implicit none + INTEGER, INTENT(IN) :: errorcode + INTEGER, INTENT(OUT) :: ierror +end subroutine ompi_remove_error_code_f + +subroutine ompi_remove_error_string_f(errorcode,ierror) & + BIND(C, name="ompi_remove_error_string_f") + implicit none + INTEGER, INTENT(IN) :: errorcode + INTEGER, INTENT(OUT) :: ierror +end subroutine ompi_remove_error_string_f + subroutine ompi_request_free_f(request,ierror) & BIND(C, name="ompi_request_free_f") implicit none diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in index cf738294432..e2ec132302d 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in +++ b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in @@ -12,6 +12,7 @@ ! Copyright (c) 2017-2018 FUJITSU LIMITED. All rights reserved. ! Copyright (c) 2021-2023 Triad National Security, LLC. All rights ! reserved. +! Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. ! $COPYRIGHT$ ! ! This file provides the interface specifications for the MPI Fortran @@ -2345,6 +2346,30 @@ subroutine MPI_Register_datarep_f08(datarep,read_conversion_fn,write_conversion_ end subroutine MPI_Register_datarep_f08 end interface MPI_Register_datarep +interface MPI_Remove_error_class +subroutine MPI_Remove_error_class_f08(errorclass,ierror) + implicit none + INTEGER, INTENT(IN) :: errorclass + INTEGER, OPTIONAL, INTENT(OUT) :: ierror +end subroutine MPI_Remove_error_class_f08 +end interface MPI_Remove_error_class + +interface MPI_Remove_error_code +subroutine MPI_Remove_error_code_f08(errorcode,ierror) + implicit none + INTEGER, INTENT(IN) :: errorcode + INTEGER, OPTIONAL, INTENT(OUT) :: ierror +end subroutine MPI_Remove_error_code_f08 +end interface MPI_Remove_error_code + +interface MPI_Remove_error_string +subroutine MPI_Remove_error_string_f08(errorcode,ierror) + implicit none + integer, intent(in) :: errorcode + integer, optional, intent(out) :: ierror +end subroutine MPI_Remove_error_string_f08 +end interface MPI_Remove_error_string + ! ! MPI_Sizeof is generic for numeric types. This ignore TKR interface ! is replaced by the specific generics. Implemented in mpi_sizeof_mod.F90. diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h index f77e423efb4..4010a6bbd8e 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h +++ b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h @@ -2,6 +2,7 @@ ! ! Copyright (c) 2019-2020 Research Organization for Information Science ! and Technology (RIST). All rights reserved. +! Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. #if OMPI_BUILD_MPI_PROFILING @@ -560,6 +561,12 @@ #define MPI_Reduce_scatter PMPI_Reduce_scatter #define MPI_Register_datarep_f08 PMPI_Register_datarep_f08 #define MPI_Register_datarep PMPI_Register_datarep +#define MPI_Remove_error_class_f08 PMPI_Remove_error_class_f08 +#define MPI_Remove_error_class PMPI_Remove_error_class +#define MPI_Remove_error_code_f08 PMPI_Remove_error_code_f08 +#define MPI_Remove_error_code PMPI_Remove_error_code +#define MPI_Remove_error_string_f08 PMPI_Remove_error_string_f08 +#define MPI_Remove_error_string PMPI_Remove_error_string #define MPI_Request_free_f08 PMPI_Request_free_f08 #define MPI_Request_free PMPI_Request_free #define MPI_Rget_accumulate_f08 PMPI_Rget_accumulate_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/remove_error_class_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/remove_error_class_f08.F90 new file mode 100644 index 00000000000..5d89ce912f5 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/remove_error_class_f08.F90 @@ -0,0 +1,23 @@ +! -*- f90 -*- +! +! Copyright (c) 2010-2012 Cisco Systems, Inc. All rights reserved. +! Copyright (c) 2009-2012 Los Alamos National Security, LLC. +! All rights reserved. +! Copyright (c) 2018-2020 Research Organization for Information Science +! and Technology (RIST). All rights reserved. +! Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. +! $COPYRIGHT$ + +#include "mpi-f08-rename.h" + +subroutine MPI_Remove_error_class_f08(errorclass,ierror) + use :: ompi_mpifh_bindings, only : ompi_remove_error_class_f + implicit none + INTEGER, INTENT(IN) :: errorclass + INTEGER, OPTIONAL, INTENT(OUT) :: ierror + integer :: c_ierror + + call ompi_remove_error_class_f(errorclass,c_ierror) + if (present(ierror)) ierror = c_ierror + +end subroutine MPI_Remove_error_class_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/remove_error_code_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/remove_error_code_f08.F90 new file mode 100644 index 00000000000..b0f432c5bd6 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/remove_error_code_f08.F90 @@ -0,0 +1,23 @@ +! -*- f90 -*- +! +! Copyright (c) 2010-2012 Cisco Systems, Inc. All rights reserved. +! Copyright (c) 2009-2012 Los Alamos National Security, LLC. +! All rights reserved. +! Copyright (c) 2018-2020 Research Organization for Information Science +! and Technology (RIST). All rights reserved. +! Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. +! $COPYRIGHT$ + +#include "mpi-f08-rename.h" + +subroutine MPI_Remove_error_code_f08(errorcode,ierror) + use :: ompi_mpifh_bindings, only : ompi_remove_error_code_f + implicit none + INTEGER, INTENT(IN) :: errorcode + INTEGER, OPTIONAL, INTENT(OUT) :: ierror + integer :: c_ierror + + call ompi_remove_error_code_f(errorcode,c_ierror) + if (present(ierror)) ierror = c_ierror + +end subroutine MPI_Remove_error_code_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/remove_error_string_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/remove_error_string_f08.F90 new file mode 100644 index 00000000000..b4fdd80f279 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/remove_error_string_f08.F90 @@ -0,0 +1,24 @@ +! -*- f90 -*- +! +! Copyright (c) 2010-2011 Cisco Systems, Inc. All rights reserved. +! Copyright (c) 2009-2012 Los Alamos National Security, LLC. +! All rights reserved. +! Copyright (c) 2018-2020 Research Organization for Information Science +! and Technology (RIST). All rights reserved. +! Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. +! $COPYRIGHT$ + +#include "mpi-f08-rename.h" + +subroutine MPI_Remove_error_string_f08(errorcode,ierror) + use :: ompi_mpifh_bindings, only : ompi_remove_error_string_f + use, intrinsic :: ISO_C_BINDING, only : C_INT + implicit none + integer, intent(in) :: errorcode + integer, optional, intent(out) :: ierror + integer :: c_ierror + + call ompi_remove_error_string_f(errorcode, c_ierror) + if (present(ierror)) ierror = c_ierror + +end subroutine MPI_Remove_error_string_f08 diff --git a/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in b/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in index 45b8a22941d..187fcbcf245 100644 --- a/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in +++ b/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in @@ -15,6 +15,7 @@ ! reserved. ! Copyright (c) 2021 Bull S.A.S. All rights reserved. ! Copyright (c) 2021 IBM Corporation. All rights reserved. +! Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. ! $COPYRIGHT$ ! ! Additional copyrights may follow @@ -3354,6 +3355,36 @@ end subroutine MPI_Request_free end interface +interface + +subroutine MPI_Remove_error_class(errorclass, ierror) + integer, intent(in) :: errorclass + integer, intent(out) :: ierror +end subroutine MPI_Remove_error_class + +end interface + + +interface + +subroutine MPI_Remove_error_code(errorcode, ierror) + integer, intent(in) :: errorcode + integer, intent(out) :: ierror +end subroutine MPI_Remove_error_code + +end interface + + +interface + +subroutine MPI_Remove_error_string(errorcode, ierror) + integer, intent(in) :: errorcode + integer, intent(out) :: ierror +end subroutine MPI_Remove_error_string + +end interface + + interface subroutine MPI_Rget(origin_addr, origin_count, origin_datatype, & diff --git a/ompi/mpi/fortran/use-mpi-ignore-tkr/pmpi-ignore-tkr-interfaces.h b/ompi/mpi/fortran/use-mpi-ignore-tkr/pmpi-ignore-tkr-interfaces.h index d180f04addd..358e882538c 100644 --- a/ompi/mpi/fortran/use-mpi-ignore-tkr/pmpi-ignore-tkr-interfaces.h +++ b/ompi/mpi/fortran/use-mpi-ignore-tkr/pmpi-ignore-tkr-interfaces.h @@ -2,6 +2,7 @@ ! ! Copyright (c) 2020-2022 Research Organization for Information Science ! and Technology (RIST). All rights reserved. +! Copyright (c) 2025 UT-Battelle, LLC. All rights reserved. ! $COPYRIGHT$ ! ! Additional copyrights may follow @@ -227,6 +228,9 @@ #define MPI_Reduce_scatter_block PMPI_Reduce_scatter_block #define MPI_Reduce_scatter_block_init PMPI_Reduce_scatter_block_init #define MPI_Register_datarep PMPI_Register_datarep +#define MPI_Remove_error_class PMPI_Remove_error_class +#define MPI_Remove_error_code PMPI_Remove_error_code +#define MPI_Remove_error_string PMPI_Remove_error_string #define MPI_Request_free PMPI_Request_free #define MPI_Rget PMPI_Rget #define MPI_Rget_accumulate PMPI_Rget_accumulate