fortran/use-mpi-f08: add CFI support for isendrecv

hppritcha · hppritcha · commit 22e2b20478c1 · 2022-04-27T11:47:41.000-06:00
and isendrecv_replace

Signed-off-by: Howard Pritchard &lt;howardp@lanl.gov&gt;
diff --git a/ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h.in b/ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h.in
@@ -273,7 +273,7 @@ end subroutine ompi_isend_f
 
 subroutine ompi_isendrecv_f(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf, &
                            recvcount,recvtype,source,recvtag,comm,request,ierror) &
-   BIND(C, name="ompi_isendrecv_f")
+   BIND(C, name="ompi_isendrecv_@OMPI_F08_BINDINGS_EXTENSION@")
    implicit none
    OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
    OMPI_F08_IGNORE_TKR_TYPE :: recvbuf
@@ -287,7 +287,7 @@ end subroutine ompi_isendrecv_f
 
 subroutine ompi_isendrecv_replace_f(buf,count,datatype,dest,sendtag,source, &
                                    recvtag,comm,request,ierror) &
-   BIND(C, name="ompi_isendrecv_replace_f")
+   BIND(C, name="ompi_isendrecv_replace_@OMPI_F08_BINDINGS_EXTENSION@")
    implicit none
    OMPI_F08_IGNORE_TKR_TYPE :: buf
    INTEGER, INTENT(IN) :: count, dest, sendtag, source, recvtag
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
@@ -155,7 +155,7 @@ end subroutine MPI_Isend_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 end interface  MPI_Isend
 
 interface  MPI_Isendrecv
-subroutine MPI_Isendrecv_f08(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf, &
+subroutine MPI_Isendrecv_f08@OMPI_F08_BINDINGS_TS_SUFFIX@(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf, &
                             recvcount,recvtype,source,recvtag,comm,request,ierror)
    use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request
    implicit none
@@ -167,11 +167,11 @@ subroutine MPI_Isendrecv_f08(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf, &
    TYPE(MPI_Comm), INTENT(IN) :: comm
    TYPE(MPI_Request), INTENT(OUT) :: request
    INTEGER, OPTIONAL, INTENT(OUT) :: ierror
-end subroutine MPI_Isendrecv_f08
+end subroutine MPI_Isendrecv_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 end interface  MPI_Isendrecv
 
 interface  MPI_Isendrecv_replace
-subroutine MPI_Isendrecv_replace_f08(buf,count,datatype,dest,sendtag,source,recvtag, &
+subroutine MPI_Isendrecv_replace_f08@OMPI_F08_BINDINGS_TS_SUFFIX@(buf,count,datatype,dest,sendtag,source,recvtag, &
                                     comm,request,ierror)
    use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request
    implicit none
@@ -182,7 +182,7 @@ subroutine MPI_Isendrecv_replace_f08(buf,count,datatype,dest,sendtag,source,recv
    TYPE(MPI_Comm), INTENT(IN) :: comm
    TYPE(MPI_Request), INTENT(OUT) :: request
    INTEGER, OPTIONAL, INTENT(OUT) :: ierror
-end subroutine MPI_Isendrecv_replace_f08
+end subroutine MPI_Isendrecv_replace_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 end interface  MPI_Isendrecv_replace
 
 interface  MPI_Issend
diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h.in b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h.in
@@ -35,9 +35,11 @@
 #define MPI_Isend_f08 PMPI_Isend_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_Isend_f08ts PMPI_Isend_f08ts
 #define MPI_Isendrecv PMPI_Isendrecv
-#define MPI_Isendrecv_f08 PMPI_Isendrecv_f08
+#define MPI_Isendrecv_f08 PMPI_Isendrecv_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Isendrecv_f08ts PMPI_Isendrecv_f08ts
 #define MPI_Isendrecv_replace PMPI_Isendrecv_replace
-#define MPI_Isendrecv_replace_f08 PMPI_Isendrecv_replace_f08
+#define MPI_Isendrecv_replace_f08 PMPI_Isendrecv_replace_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Isendrecv_replace_f08ts PMPI_Isendrecv_replace_f08ts
 #define MPI_Issend PMPI_Issend
 #define MPI_Issend_f08 PMPI_Issend_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_Issend_f08ts PMPI_Issend_f08ts
@@ -916,6 +918,8 @@
 #define MPI_Irecv_f08 MPI_Irecv_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_Irsend_f08 MPI_Irsend_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_Isend_f08 MPI_Isend_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Isendrecv_f08 MPI_Isendrecv_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
+#define MPI_Isendrecv_replace_f08 MPI_Isendrecv_replace_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_Issend_f08 MPI_Issend_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_Recv_f08 MPI_Recv_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
 #define MPI_Recv_init_f08 MPI_Recv_init_f08@OMPI_F08_BINDINGS_TS_SUFFIX@
diff --git a/ompi/mpi/fortran/use-mpi-f08/ts/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/ts/Makefile.am
@@ -115,6 +115,8 @@ libusempif08_ts_la_SOURCES = \
         iscatter_ts.c \
         iscatterv_ts.c \
         isend_ts.c \
+        isendrecv_ts.c \
+        isendrecv_replace_ts.c \
         issend_ts.c \
         mrecv_ts.c \
         neighbor_allgather_ts.c \
diff --git a/ompi/mpi/fortran/use-mpi-f08/ts/bindings.h b/ompi/mpi/fortran/use-mpi-f08/ts/bindings.h
@@ -43,6 +43,17 @@ void ompi_isend_ts(CFI_cdesc_t *x, MPI_Fint *count, MPI_Fint *datatype,
                    MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm,
                    MPI_Fint *request, MPI_Fint *ierr);
 
+void ompi_isendrecv_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype,
+                       MPI_Fint *dest, MPI_Fint *sendtag, CFI_cdesc_t* x2,
+                       MPI_Fint *recvcount, MPI_Fint *recvtype,
+                       MPI_Fint *source, MPI_Fint *recvtag, MPI_Fint *comm,
+                       MPI_Fint *request, MPI_Fint *ierr);
+
+void ompi_isendrecv_replace_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype,
+                               MPI_Fint *dest, MPI_Fint *sendtag,
+                               MPI_Fint *source, MPI_Fint *recvtag,
+                               MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr);
+
 void ompi_issend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype,
                     MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm,
                     MPI_Fint *request, MPI_Fint *ierr);
diff --git a/ompi/mpi/fortran/use-mpi-f08/ts/isendrecv_replace_ts.c b/ompi/mpi/fortran/use-mpi-f08/ts/isendrecv_replace_ts.c
@@ -0,0 +1,68 @@
+/*
+ * 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-2019 Research Organization for Information Science
+ *                         and Technology (RIST). All rights reserved.
+ * $COPYRIGHT$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+#include "ompi_config.h"
+
+#include "ompi/communicator/communicator.h"
+#include "ompi/errhandler/errhandler.h"
+#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h"
+#include "ompi/mpi/fortran/base/constants.h"
+
+static const char FUNC_NAME[] = "MPI_Isendrecv_replace";
+
+void ompi_isendrecv_replace_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype,
+                               MPI_Fint *dest, MPI_Fint *sendtag,
+                               MPI_Fint *source, MPI_Fint *recvtag,
+                               MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr)
+{
+    int c_ierr;
+    MPI_Request c_req;
+    MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype);
+    MPI_Comm c_comm = PMPI_Comm_f2c (*comm);
+
+    MPI_Status c_status;
+    void *buf = x->base_addr;
+    int c_count =  OMPI_FINT_2_INT(*count);
+
+    OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr);
+    if (MPI_SUCCESS != c_ierr) {
+        if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+        OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME);
+        return;
+    }
+
+    c_ierr = PMPI_Isendrecv_replace(OMPI_F2C_BOTTOM(buf),
+                                    OMPI_FINT_2_INT(*count),
+                                    c_datatype,
+                                    OMPI_FINT_2_INT(*dest),
+                                    OMPI_FINT_2_INT(*sendtag),
+                                    OMPI_FINT_2_INT(*source),
+                                    OMPI_FINT_2_INT(*recvtag),
+                                   c_comm, &c_req);
+    if (c_datatype != c_type) {
+        ompi_datatype_destroy(&c_datatype);
+    }
+    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+
+    if (MPI_SUCCESS == c_ierr) {
+       *request = PMPI_Request_c2f(c_req);
+    }
+}
diff --git a/ompi/mpi/fortran/use-mpi-f08/ts/isendrecv_ts.c b/ompi/mpi/fortran/use-mpi-f08/ts/isendrecv_ts.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-2019 Research Organization for Information Science
+ *                         and Technology (RIST). All rights reserved.
+ * $COPYRIGHT$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+#include "ompi_config.h"
+
+#include "ompi/communicator/communicator.h"
+#include "ompi/errhandler/errhandler.h"
+#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h"
+#include "ompi/mpi/fortran/base/constants.h"
+
+static const char FUNC_NAME[] = "MPI_Isendrecv";
+
+void ompi_isendrecv_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype,
+                       MPI_Fint *dest, MPI_Fint *sendtag, CFI_cdesc_t* x2,
+                       MPI_Fint *recvcount, MPI_Fint *recvtype,
+                       MPI_Fint *source, MPI_Fint *recvtag, MPI_Fint *comm,
+                       MPI_Fint *request, MPI_Fint *ierr)
+{
+    int c_ierr;
+    MPI_Comm c_comm = PMPI_Comm_f2c (*comm);
+    MPI_Request c_req;
+    MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype);
+    MPI_Datatype c_recvdatatype, c_recvtype = PMPI_Type_f2c(*recvtype);
+    void *sendbuf = x1->base_addr;
+    int c_sendcount =  OMPI_FINT_2_INT(*sendcount);
+    void *recvbuf = x2->base_addr;
+    int c_recvcount =  OMPI_FINT_2_INT(*recvcount);
+
+    OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr);
+    if (MPI_SUCCESS != c_ierr) {
+        if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+        OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME);
+        return;
+    }
+    OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr);
+    if (MPI_SUCCESS != c_ierr) {
+        if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+        if (c_senddatatype != c_sendtype) {
+            ompi_datatype_destroy(&c_senddatatype);
+        }
+        OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME);
+        return;
+    }
+
+    c_ierr = PMPI_Isendrecv(OMPI_F2C_BOTTOM(sendbuf), c_sendcount,
+                            c_senddatatype,
+                            OMPI_FINT_2_INT(*dest),
+                            OMPI_FINT_2_INT(*sendtag),
+                            OMPI_F2C_BOTTOM(recvbuf), c_recvcount,
+                            c_recvdatatype, OMPI_FINT_2_INT(*source),
+                            OMPI_FINT_2_INT(*recvtag),
+                            c_comm, &c_req);
+    if (c_senddatatype != c_sendtype) {
+        ompi_datatype_destroy(&c_senddatatype);
+    }
+    if (c_recvdatatype != c_recvtype) {
+        ompi_datatype_destroy(&c_recvdatatype);
+    }
+    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+
+    if (MPI_SUCCESS == c_ierr) {
+       *request = PMPI_Request_c2f(c_req);
+    }
+}
