add support for request_get_status_any/all/some

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

@@ -18,7 +18,7 @@
 #                         and Technology (RIST).  All rights reserved.
 # Copyright (c) 2016      IBM Corporation.  All rights reserved.
 # Copyright (c) 2018      FUJITSU LIMITED.  All rights reserved.
-# Copyright (c) 2021-2022 Triad National Security, LLC. All rights
+# Copyright (c) 2021-2025 Triad National Security, LLC. All rights
 #                         reserved.
 # Copyright (c) 2025      Jeffrey M. Squyres.  All rights reserved.
 #
@@ -410,6 +410,9 @@ lib@OMPI_LIBMPI_NAME@_mpifh_la_SOURCES += \
         register_datarep_f.c \
         request_free_f.c \
         request_get_status_f.c \
+        request_get_status_all_f.c \
+        request_get_status_any_f.c \
+        request_get_status_some_f.c \
         rsend_f.c \
         rsend_init_f.c \
         scan_f.c \

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

@@ -321,6 +321,9 @@ linked_files = \
         preduce_scatter_block_init_f.c \
         prequest_free_f.c \
         prequest_get_status_f.c \
+        prequest_get_status_all_f.c \
+        prequest_get_status_any_f.c \
+        prequest_get_status_some_f.c \
         prsend_f.c \
         prsend_init_f.c \
         pscan_f.c \

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

@@ -374,6 +374,9 @@ PN2(void, MPI_Reduce_scatter_block_init, mpi_reduce_scatter_block_init, MPI_REDU
 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_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));
+PN2(void, MPI_Request_get_status_any, mpi_request_get_status_any, MPI_REQUEST_GET_STATUS_ANY, (MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *index, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr));
+PN2(void, MPI_Request_get_status_some, mpi_request_get_status_some, MPI_REQUEST_GET_STATUS_SOME, (MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *outcount, MPI_Fint *array_of_indices,  MPI_Fint *array_of_statuses, MPI_Fint *ierr));
 PN2(void, MPI_Rget, mpi_rget, MPI_RGET, (char *origin_addr, MPI_Fint *origin_count, MPI_Fint *origin_datatype, MPI_Fint *target_rank, MPI_Aint *target_disp, MPI_Fint *target_count, MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *request, MPI_Fint *ierr));
 PN2(void, MPI_Rget_accumulate, mpi_rget_accumulate, MPI_RGET_ACCUMULATE, (char *origin_addr, MPI_Fint *origin_count, MPI_Fint *origin_datatype, char *result_addr, MPI_Fint *result_count, MPI_Fint *result_datatype, MPI_Fint *target_rank, MPI_Aint *target_disp, MPI_Fint *target_count, MPI_Fint *target_datatype, MPI_Fint *op, MPI_Fint *win, MPI_Fint *request, MPI_Fint *ierr));
 PN2(void, MPI_Rput, mpi_rput, MPI_RPUT, (char *origin_addr, MPI_Fint *origin_count, MPI_Fint *origin_datatype, MPI_Fint *target_rank, MPI_Aint *target_disp, MPI_Fint *target_count, MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *request, MPI_Fint *ierr));

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

@@ -0,0 +1,122 @@
+/*
+ * Copyright (c) 2004-2005 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) 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      Triad National Security, LLC.  All rights reserved.
+ *
+ * $COPYRIGHT$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+#include "ompi_config.h"
+
+#include "ompi/mpi/fortran/mpif-h/bindings.h"
+#include "ompi/mpi/fortran/base/constants.h"
+#include "ompi/errhandler/errhandler.h"
+#include "ompi/communicator/communicator.h"
+
+#if OMPI_BUILD_MPI_PROFILING
+#if OPAL_HAVE_WEAK_SYMBOLS
+#pragma weak PMPI_REQUEST_GET_STATUS_ALL = ompi_request_get_status_all_f
+#pragma weak pmpi_request_get_status_all = ompi_request_get_status_all_f
+#pragma weak pmpi_request_get_status_all_ = ompi_request_get_status_all_f
+#pragma weak pmpi_request_get_status_all__ = ompi_request_get_status_all_f
+
+#pragma weak PMPI_Request_get_status_all_f = ompi_request_get_status_all_f
+#pragma weak PMPI_Request_get_status_all_f08 = ompi_request_get_status_all_f
+#else
+OMPI_GENERATE_F77_BINDINGS (PMPI_REQUEST_GET_STATUS_ALL,
+                           pmpi_request_get_status_all,
+                           pmpi_request_get_status_all_,
+                           pmpi_request_get_status_all__,
+                           pompi_request_get_status_all_f,
+                           (MPI_Fint *count, MPI_Fint *array_of_requests, ompi_fortran_logical_t *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr),
+                           (count, array_of_requests, flag, array_of_statuses, ierr) )
+#endif
+#endif
+
+#if OPAL_HAVE_WEAK_SYMBOLS
+#pragma weak MPI_REQUEST_GET_STATUS_ALL = ompi_request_get_status_all_f
+#pragma weak mpi_request_get_status_all = ompi_request_get_status_all_f
+#pragma weak mpi_request_get_status_all_ = ompi_request_get_status_all_f
+#pragma weak mpi_request_get_status_all__ = ompi_request_get_status_all_f
+
+#pragma weak MPI_Request_get_status_all_f = ompi_request_get_status_all_f
+#pragma weak MPI_Request_get_status_all_f08 = ompi_request_get_status_all_f
+#else
+#if ! OMPI_BUILD_MPI_PROFILING
+OMPI_GENERATE_F77_BINDINGS (MPI_REQUEST_GET_STATUS_ALL,
+                           mpi_request_get_status_all,
+                           mpi_request_get_status_all_,
+                           mpi_request_get_status_all__,
+                           ompi_request_get_status_all_f,
+                           (MPI_Fint *count, MPI_Fint *array_of_requests, ompi_fortran_logical_t *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr),
+                           (count, array_of_requests, flag, array_of_statuses, ierr) )
+#else
+#define ompi_request_get_status_all_f pompi_request_get_status_all_f
+#endif
+#endif
+
+
+static const char FUNC_NAME[] = "MPI_REQUEST_GET_STATUS_ALL";
+
+
+void ompi_request_get_status_all_f(MPI_Fint *count, MPI_Fint *array_of_requests,
+ 		                   ompi_fortran_logical_t *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr)
+{
+    MPI_Request *c_req;
+    MPI_Status *c_status;
+    int i, c_ierr;
+    OMPI_LOGICAL_NAME_DECL(flag);
+
+    /* Shortcut to avoid malloc(0) if *count==0.  We're intentionally
+       skipping other parameter error checks. */
+    if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*count))) {
+        *ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
+        *flag = OMPI_FORTRAN_VALUE_TRUE;
+        return;
+    }
+
+    c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*count) *
+                   (sizeof(MPI_Request) + sizeof(MPI_Status)));
+    if (NULL == c_req) {
+        c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(
+                                        MPI_ERR_NO_MEM,
+                                        FUNC_NAME);
+        if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+        return;
+    }
+    c_status = (MPI_Status*) (c_req + OMPI_FINT_2_INT(*count));
+
+    for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) {
+        c_req[i] = PMPI_Request_f2c(array_of_requests[i]);
+    }
+
+    c_ierr = PMPI_Request_get_status_all(OMPI_FINT_2_INT(*count), c_req, OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag), c_status);
+    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+
+    if (MPI_SUCCESS == c_ierr) {
+        OMPI_SINGLE_INT_2_LOGICAL(flag);
+        for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) {
+            array_of_requests[i] = c_req[i]->req_f_to_c_index;
+            if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses) &&
+                !OMPI_IS_FORTRAN_STATUS_IGNORE(&array_of_statuses[i])) {
+                PMPI_Status_c2f( &c_status[i], &array_of_statuses[i * (sizeof(MPI_Status) / sizeof(int))]);
+            }
+        }
+    }
+    free(c_req);
+}

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

@@ -0,0 +1,129 @@
+/*
+ * Copyright (c) 2004-2005 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) 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      Triad National Security, LLC.  All rights reserved.
+ *
+ * $COPYRIGHT$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+#include "ompi_config.h"
+
+#include "ompi/mpi/fortran/mpif-h/bindings.h"
+#include "ompi/mpi/fortran/base/constants.h"
+#include "ompi/errhandler/errhandler.h"
+#include "ompi/communicator/communicator.h"
+
+#if OMPI_BUILD_MPI_PROFILING
+#if OPAL_HAVE_WEAK_SYMBOLS
+#pragma weak PMPI_REQUEST_STATUS_GET_ANY = ompi_request_get_status_any_f
+#pragma weak pmpi_request_get_status_any = ompi_request_get_status_any_f
+#pragma weak pmpi_request_get_status_any_ = ompi_request_get_status_any_f
+#pragma weak pmpi_request_get_status_any__ = ompi_request_get_status_any_f
+
+#pragma weak PMPI_Request_get_status_any_f = ompi_request_get_status_any_f
+#pragma weak PMPI_Request_get_status_any_f08 = ompi_request_get_status_any_f
+#else
+OMPI_GENERATE_F77_BINDINGS (PMPI_REQUEST_STATUS_GET_ANY,
+                           pmpi_request_get_status_any,
+                           pmpi_request_get_status_any_,
+                           pmpi_request_get_status_any__,
+                           pompi_request_get_status_any_f,
+                           (MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *indx, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr),
+                           (count, array_of_requests, indx, flag, status, ierr))
+#endif
+#endif
+
+#if OPAL_HAVE_WEAK_SYMBOLS
+#pragma weak MPI_REQUEST_STATUS_GET_ANY = ompi_request_get_status_any_f
+#pragma weak mpi_request_get_status_any = ompi_request_get_status_any_f
+#pragma weak mpi_request_get_status_any_ = ompi_request_get_status_any_f
+#pragma weak mpi_request_get_status_any__ = ompi_request_get_status_any_f
+
+#pragma weak MPI_Request_get_status_any_f = ompi_request_get_status_any_f
+#pragma weak MPI_Request_get_status_any_f08 = ompi_request_get_status_any_f
+#else
+#if ! OMPI_BUILD_MPI_PROFILING
+OMPI_GENERATE_F77_BINDINGS (MPI_REQUEST_STATUS_GET_ANY,
+                           mpi_request_get_status_any,
+                           mpi_request_get_status_any_,
+                           mpi_request_get_status_any__,
+                           ompi_request_get_status_any_f,
+                           (MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *indx, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr),
+                           (count, array_of_requests, indx, flag, status, ierr))
+#else
+#define ompi_request_get_status_any_f pompi_request_get_status_any_f
+#endif
+#endif
+
+
+static const char FUNC_NAME[] = "MPI_REQUEST_STATUS_GET_ANY";
+
+
+void ompi_request_get_status_any_f(MPI_Fint *count, MPI_Fint *array_of_requests,
+		   MPI_Fint *indx, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr)
+{
+    MPI_Request *c_req;
+    MPI_Status c_status;
+    int i, c_ierr;
+    OMPI_LOGICAL_NAME_DECL(flag);
+    OMPI_SINGLE_NAME_DECL(indx);
+
+    /* Shortcut to avoid malloc(0) if *count==0.  We're intentionally
+       skipping other parameter error checks. */
+    if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*count))) {
+        *indx = OMPI_INT_2_FINT(MPI_UNDEFINED);
+        PMPI_Status_c2f(&ompi_status_empty, status);
+        *ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
+        return;
+    }
+
+    c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*count) * sizeof(MPI_Request));
+    if (NULL == c_req) {
+        c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM,
+                                        FUNC_NAME);
+        if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+        return;
+    }
+
+    for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) {
+        c_req[i] = PMPI_Request_f2c(array_of_requests[i]);
+    }
+
+    c_ierr = PMPI_Request_get_status_any(OMPI_FINT_2_INT(*count), c_req,
+                         OMPI_SINGLE_NAME_CONVERT(indx), OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag),
+                         &c_status);
+    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+
+    if (MPI_SUCCESS == c_ierr) {
+
+        OMPI_SINGLE_INT_2_LOGICAL(flag);
+
+        /* Increment index by one for fortran conventions */
+
+        OMPI_SINGLE_INT_2_FINT(indx);
+        if (MPI_UNDEFINED != *(OMPI_SINGLE_NAME_CONVERT(indx))) {
+            array_of_requests[OMPI_INT_2_FINT(*indx)] =
+                c_req[OMPI_INT_2_FINT(*indx)]->req_f_to_c_index;
+            ++(*indx);
+        }
+        if (!OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
+            PMPI_Status_c2f(&c_status, status);
+        }
+    }
+    free(c_req);
+}