Skip to content

Commit a391063

Browse files
hppritchahppritcha
committed
request_get_status_mult: add f77 functions
Signed-off-by: Howard Pritchard <howardp@lanl.gov>
1 parent fb2e098 commit a391063

File tree

6 files changed

+401
-1
lines changed

6 files changed

+401
-1
lines changed

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

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@
1818
# and Technology (RIST). All rights reserved.
1919
# Copyright (c) 2016 IBM Corporation. All rights reserved.
2020
# Copyright (c) 2018 FUJITSU LIMITED. All rights reserved.
21-
# Copyright (c) 2021-2022 Triad National Security, LLC. All rights
21+
# Copyright (c) 2021-2025 Triad National Security, LLC. All rights
2222
# reserved.
2323
# Copyright (c) 2025 Jeffrey M. Squyres. All rights reserved.
2424
#
@@ -410,6 +410,9 @@ lib@OMPI_LIBMPI_NAME@_mpifh_la_SOURCES += \
410410
register_datarep_f.c \
411411
request_free_f.c \
412412
request_get_status_f.c \
413+
request_get_status_all_f.c \
414+
request_get_status_any_f.c \
415+
request_get_status_some_f.c \
413416
rsend_f.c \
414417
rsend_init_f.c \
415418
scan_f.c \

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -321,6 +321,9 @@ linked_files = \
321321
preduce_scatter_block_init_f.c \
322322
prequest_free_f.c \
323323
prequest_get_status_f.c \
324+
prequest_get_status_all_f.c \
325+
prequest_get_status_any_f.c \
326+
prequest_get_status_some_f.c \
324327
prsend_f.c \
325328
prsend_init_f.c \
326329
pscan_f.c \

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -374,6 +374,9 @@ PN2(void, MPI_Reduce_scatter_block_init, mpi_reduce_scatter_block_init, MPI_REDU
374374
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));
375375
PN2(void, MPI_Request_free, mpi_request_free, MPI_REQUEST_FREE, (MPI_Fint *request, MPI_Fint *ierr));
376376
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));
377+
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));
378+
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));
379+
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));
377380
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));
378381
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));
379382
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

Lines changed: 122 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,122 @@
1+
/*
2+
* Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
3+
* University Research and Technology
4+
* Corporation. All rights reserved.
5+
* Copyright (c) 2004-2020 The University of Tennessee and The University
6+
* of Tennessee Research Foundation. All rights
7+
* reserved.
8+
* Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
9+
* University of Stuttgart. All rights reserved.
10+
* Copyright (c) 2004-2005 The Regents of the University of California.
11+
* All rights reserved.
12+
* Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved.
13+
* Copyright (c) 2015 Research Organization for Information Science
14+
* and Technology (RIST). All rights reserved.
15+
* Copyright (c) 2025 Triad National Security, LLC. All rights reserved.
16+
*
17+
* $COPYRIGHT$
18+
*
19+
* Additional copyrights may follow
20+
*
21+
* $HEADER$
22+
*/
23+
24+
#include "ompi_config.h"
25+
26+
#include "ompi/mpi/fortran/mpif-h/bindings.h"
27+
#include "ompi/mpi/fortran/base/constants.h"
28+
#include "ompi/errhandler/errhandler.h"
29+
#include "ompi/communicator/communicator.h"
30+
31+
#if OMPI_BUILD_MPI_PROFILING
32+
#if OPAL_HAVE_WEAK_SYMBOLS
33+
#pragma weak PMPI_REQUEST_GET_STATUS_ALL = ompi_request_get_status_all_f
34+
#pragma weak pmpi_request_get_status_all = ompi_request_get_status_all_f
35+
#pragma weak pmpi_request_get_status_all_ = ompi_request_get_status_all_f
36+
#pragma weak pmpi_request_get_status_all__ = ompi_request_get_status_all_f
37+
38+
#pragma weak PMPI_Request_get_status_all_f = ompi_request_get_status_all_f
39+
#pragma weak PMPI_Request_get_status_all_f08 = ompi_request_get_status_all_f
40+
#else
41+
OMPI_GENERATE_F77_BINDINGS (PMPI_REQUEST_GET_STATUS_ALL,
42+
pmpi_request_get_status_all,
43+
pmpi_request_get_status_all_,
44+
pmpi_request_get_status_all__,
45+
pompi_request_get_status_all_f,
46+
(MPI_Fint *count, MPI_Fint *array_of_requests, ompi_fortran_logical_t *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr),
47+
(count, array_of_requests, flag, array_of_statuses, ierr) )
48+
#endif
49+
#endif
50+
51+
#if OPAL_HAVE_WEAK_SYMBOLS
52+
#pragma weak MPI_REQUEST_GET_STATUS_ALL = ompi_request_get_status_all_f
53+
#pragma weak mpi_request_get_status_all = ompi_request_get_status_all_f
54+
#pragma weak mpi_request_get_status_all_ = ompi_request_get_status_all_f
55+
#pragma weak mpi_request_get_status_all__ = ompi_request_get_status_all_f
56+
57+
#pragma weak MPI_Request_get_status_all_f = ompi_request_get_status_all_f
58+
#pragma weak MPI_Request_get_status_all_f08 = ompi_request_get_status_all_f
59+
#else
60+
#if ! OMPI_BUILD_MPI_PROFILING
61+
OMPI_GENERATE_F77_BINDINGS (MPI_REQUEST_GET_STATUS_ALL,
62+
mpi_request_get_status_all,
63+
mpi_request_get_status_all_,
64+
mpi_request_get_status_all__,
65+
ompi_request_get_status_all_f,
66+
(MPI_Fint *count, MPI_Fint *array_of_requests, ompi_fortran_logical_t *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr),
67+
(count, array_of_requests, flag, array_of_statuses, ierr) )
68+
#else
69+
#define ompi_request_get_status_all_f pompi_request_get_status_all_f
70+
#endif
71+
#endif
72+
73+
74+
static const char FUNC_NAME[] = "MPI_REQUEST_GET_STATUS_ALL";
75+
76+
77+
void ompi_request_get_status_all_f(MPI_Fint *count, MPI_Fint *array_of_requests,
78+
ompi_fortran_logical_t *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr)
79+
{
80+
MPI_Request *c_req;
81+
MPI_Status *c_status;
82+
int i, c_ierr;
83+
OMPI_LOGICAL_NAME_DECL(flag);
84+
85+
/* Shortcut to avoid malloc(0) if *count==0. We're intentionally
86+
skipping other parameter error checks. */
87+
if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*count))) {
88+
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
89+
*flag = OMPI_FORTRAN_VALUE_TRUE;
90+
return;
91+
}
92+
93+
c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*count) *
94+
(sizeof(MPI_Request) + sizeof(MPI_Status)));
95+
if (NULL == c_req) {
96+
c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(
97+
MPI_ERR_NO_MEM,
98+
FUNC_NAME);
99+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
100+
return;
101+
}
102+
c_status = (MPI_Status*) (c_req + OMPI_FINT_2_INT(*count));
103+
104+
for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) {
105+
c_req[i] = PMPI_Request_f2c(array_of_requests[i]);
106+
}
107+
108+
c_ierr = PMPI_Request_get_status_all(OMPI_FINT_2_INT(*count), c_req, OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag), c_status);
109+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
110+
111+
if (MPI_SUCCESS == c_ierr) {
112+
OMPI_SINGLE_INT_2_LOGICAL(flag);
113+
for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) {
114+
array_of_requests[i] = c_req[i]->req_f_to_c_index;
115+
if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses) &&
116+
!OMPI_IS_FORTRAN_STATUS_IGNORE(&array_of_statuses[i])) {
117+
PMPI_Status_c2f( &c_status[i], &array_of_statuses[i * (sizeof(MPI_Status) / sizeof(int))]);
118+
}
119+
}
120+
}
121+
free(c_req);
122+
}

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

Lines changed: 129 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,129 @@
1+
/*
2+
* Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
3+
* University Research and Technology
4+
* Corporation. All rights reserved.
5+
* Copyright (c) 2004-2020 The University of Tennessee and The University
6+
* of Tennessee Research Foundation. All rights
7+
* reserved.
8+
* Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
9+
* University of Stuttgart. All rights reserved.
10+
* Copyright (c) 2004-2005 The Regents of the University of California.
11+
* All rights reserved.
12+
* Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved.
13+
* Copyright (c) 2015 Research Organization for Information Science
14+
* and Technology (RIST). All rights reserved.
15+
* Copyright (c) 2025 Triad National Security, LLC. All rights reserved.
16+
*
17+
* $COPYRIGHT$
18+
*
19+
* Additional copyrights may follow
20+
*
21+
* $HEADER$
22+
*/
23+
24+
#include "ompi_config.h"
25+
26+
#include "ompi/mpi/fortran/mpif-h/bindings.h"
27+
#include "ompi/mpi/fortran/base/constants.h"
28+
#include "ompi/errhandler/errhandler.h"
29+
#include "ompi/communicator/communicator.h"
30+
31+
#if OMPI_BUILD_MPI_PROFILING
32+
#if OPAL_HAVE_WEAK_SYMBOLS
33+
#pragma weak PMPI_REQUEST_STATUS_GET_ANY = ompi_request_get_status_any_f
34+
#pragma weak pmpi_request_get_status_any = ompi_request_get_status_any_f
35+
#pragma weak pmpi_request_get_status_any_ = ompi_request_get_status_any_f
36+
#pragma weak pmpi_request_get_status_any__ = ompi_request_get_status_any_f
37+
38+
#pragma weak PMPI_Request_get_status_any_f = ompi_request_get_status_any_f
39+
#pragma weak PMPI_Request_get_status_any_f08 = ompi_request_get_status_any_f
40+
#else
41+
OMPI_GENERATE_F77_BINDINGS (PMPI_REQUEST_STATUS_GET_ANY,
42+
pmpi_request_get_status_any,
43+
pmpi_request_get_status_any_,
44+
pmpi_request_get_status_any__,
45+
pompi_request_get_status_any_f,
46+
(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *indx, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr),
47+
(count, array_of_requests, indx, flag, status, ierr))
48+
#endif
49+
#endif
50+
51+
#if OPAL_HAVE_WEAK_SYMBOLS
52+
#pragma weak MPI_REQUEST_STATUS_GET_ANY = ompi_request_get_status_any_f
53+
#pragma weak mpi_request_get_status_any = ompi_request_get_status_any_f
54+
#pragma weak mpi_request_get_status_any_ = ompi_request_get_status_any_f
55+
#pragma weak mpi_request_get_status_any__ = ompi_request_get_status_any_f
56+
57+
#pragma weak MPI_Request_get_status_any_f = ompi_request_get_status_any_f
58+
#pragma weak MPI_Request_get_status_any_f08 = ompi_request_get_status_any_f
59+
#else
60+
#if ! OMPI_BUILD_MPI_PROFILING
61+
OMPI_GENERATE_F77_BINDINGS (MPI_REQUEST_STATUS_GET_ANY,
62+
mpi_request_get_status_any,
63+
mpi_request_get_status_any_,
64+
mpi_request_get_status_any__,
65+
ompi_request_get_status_any_f,
66+
(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *indx, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr),
67+
(count, array_of_requests, indx, flag, status, ierr))
68+
#else
69+
#define ompi_request_get_status_any_f pompi_request_get_status_any_f
70+
#endif
71+
#endif
72+
73+
74+
static const char FUNC_NAME[] = "MPI_REQUEST_STATUS_GET_ANY";
75+
76+
77+
void ompi_request_get_status_any_f(MPI_Fint *count, MPI_Fint *array_of_requests,
78+
MPI_Fint *indx, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr)
79+
{
80+
MPI_Request *c_req;
81+
MPI_Status c_status;
82+
int i, c_ierr;
83+
OMPI_LOGICAL_NAME_DECL(flag);
84+
OMPI_SINGLE_NAME_DECL(indx);
85+
86+
/* Shortcut to avoid malloc(0) if *count==0. We're intentionally
87+
skipping other parameter error checks. */
88+
if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*count))) {
89+
*indx = OMPI_INT_2_FINT(MPI_UNDEFINED);
90+
PMPI_Status_c2f(&ompi_status_empty, status);
91+
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
92+
return;
93+
}
94+
95+
c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*count) * sizeof(MPI_Request));
96+
if (NULL == c_req) {
97+
c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM,
98+
FUNC_NAME);
99+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
100+
return;
101+
}
102+
103+
for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) {
104+
c_req[i] = PMPI_Request_f2c(array_of_requests[i]);
105+
}
106+
107+
c_ierr = PMPI_Request_get_status_any(OMPI_FINT_2_INT(*count), c_req,
108+
OMPI_SINGLE_NAME_CONVERT(indx), OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag),
109+
&c_status);
110+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
111+
112+
if (MPI_SUCCESS == c_ierr) {
113+
114+
OMPI_SINGLE_INT_2_LOGICAL(flag);
115+
116+
/* Increment index by one for fortran conventions */
117+
118+
OMPI_SINGLE_INT_2_FINT(indx);
119+
if (MPI_UNDEFINED != *(OMPI_SINGLE_NAME_CONVERT(indx))) {
120+
array_of_requests[OMPI_INT_2_FINT(*indx)] =
121+
c_req[OMPI_INT_2_FINT(*indx)]->req_f_to_c_index;
122+
++(*indx);
123+
}
124+
if (!OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
125+
PMPI_Status_c2f(&c_status, status);
126+
}
127+
}
128+
free(c_req);
129+
}

0 commit comments

Comments
 (0)