|
| 1 | +/* |
| 2 | + * Copyright (c) 2010-2022 The University of Tennessee and the University |
| 3 | + * of Tennessee Research Foundation. All rights |
| 4 | + * reserved. |
| 5 | + * $COPYRIGHT$ |
| 6 | + * |
| 7 | + * Additional copyrights may follow |
| 8 | + * |
| 9 | + * $HEADER$ |
| 10 | + */ |
| 11 | +#include "ompi_config.h" |
| 12 | + |
| 13 | +#include "ompi/mpi/fortran/mpif-h/bindings.h" |
| 14 | +#include "ompi/mpi/fortran/base/constants.h" |
| 15 | + |
| 16 | +#include "ompi/mpiext/ftmpi/c/mpiext_ftmpi_c.h" |
| 17 | +#include "ompi/mpiext/ftmpi/mpif-h/prototypes_mpi.h" |
| 18 | + |
| 19 | +#include "ompi/communicator/communicator.h" |
| 20 | +#include "ompi/request/request.h" |
| 21 | +#include "ompi/mpi/fortran/base/fint_2_int.h" |
| 22 | + |
| 23 | +#if OPAL_HAVE_WEAK_SYMBOLS |
| 24 | +#pragma weak PMPIX_COMM_ISHRINK = ompix_comm_ishrink_f |
| 25 | +#pragma weak pmpix_comm_ishrink = ompix_comm_ishrink_f |
| 26 | +#pragma weak pmpix_comm_ishrink_ = ompix_comm_ishrink_f |
| 27 | +#pragma weak pmpix_comm_ishrink__ = ompix_comm_ishrink_f |
| 28 | +#pragma weak PMPIX_Comm_ishrink_f = ompix_comm_ishrink_f |
| 29 | +#pragma weak PMPIX_Comm_ishrink_f08 = ompix_comm_ishrink_f |
| 30 | + |
| 31 | +#pragma weak MPIX_COMM_ISHRINK = ompix_comm_ishrink_f |
| 32 | +#pragma weak mpix_comm_ishrink = ompix_comm_ishrink_f |
| 33 | +#pragma weak mpix_comm_ishrink_ = ompix_comm_ishrink_f |
| 34 | +#pragma weak mpix_comm_ishrink__ = ompix_comm_ishrink_f |
| 35 | +#pragma weak MPIX_Comm_ishrink_f = ompix_comm_ishrink_f |
| 36 | +#pragma weak MPIX_Comm_ishrink_f08 = ompix_comm_ishrink_f |
| 37 | + |
| 38 | +#else /* No weak symbols */ |
| 39 | +OMPI_GENERATE_F77_BINDINGS(PMPIX_COMM_ISHRINK, |
| 40 | + pmpix_comm_ishrink, |
| 41 | + pmpix_comm_ishrink_, |
| 42 | + pmpix_comm_ishrink__, |
| 43 | + ompix_comm_ishrink_f, |
| 44 | + (MPI_Fint *comm, MPI_Fint *newcomm, MPI_Fint *request, MPI_Fint *ierr), |
| 45 | + (comm, newcomm, request, ierr)) |
| 46 | + |
| 47 | +OMPI_GENERATE_F77_BINDINGS(MPIX_COMM_ISHRINK, |
| 48 | + mpix_comm_ishrink, |
| 49 | + mpix_comm_ishrink_, |
| 50 | + mpix_comm_ishrink__, |
| 51 | + ompix_comm_ishrink_f, |
| 52 | + (MPI_Fint *comm, MPI_Fint *newcomm, MPI_Fint *request, MPI_Fint *ierr), |
| 53 | + (comm, newcomm, request, ierr)) |
| 54 | +#endif |
| 55 | + |
| 56 | +void ompix_comm_ishrink_f(MPI_Fint *comm, MPI_Fint *newcomm, MPI_Fint *request, MPI_Fint *ierr) |
| 57 | +{ |
| 58 | + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); |
| 59 | + MPI_Request c_req; |
| 60 | + MPI_Comm c_newcomm; |
| 61 | + |
| 62 | + *ierr = OMPI_INT_2_FINT(MPIX_Comm_ishrink(c_comm, |
| 63 | + &c_newcomm, |
| 64 | + &c_req)); |
| 65 | + |
| 66 | + if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) { |
| 67 | + *request = PMPI_Request_c2f(c_req); |
| 68 | + *newcomm = PMPI_Comm_c2f(c_newcomm); |
| 69 | + } |
| 70 | + else { |
| 71 | + *newcomm = PMPI_Comm_c2f(&ompi_mpi_comm_null.comm); |
| 72 | + } |
| 73 | +} |
0 commit comments