Convert MPI_Neighbor_allgather* functions for Fortran

Signed-off-by: Jake Tronge <jtronge@lanl.gov>
open-mpi · Sep 17, 2024 · d4fe783 · d4fe783
1 parent 30e6da6
commit d4fe783
Show file tree

Hide file tree

Showing 7 changed files with 33 additions and 148 deletions.
diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/Makefile.am
@@ -264,9 +264,7 @@ mpi_api_files = \
         is_thread_main_f08.F90 \
         lookup_name_f08.F90 \
         mprobe_f08.F90 \
-        neighbor_allgather_f08.F90 \
         neighbor_allgather_init_f08.F90 \
-        neighbor_allgatherv_f08.F90 \
         neighbor_allgatherv_init_f08.F90 \
         neighbor_alltoall_f08.F90 \
         neighbor_alltoall_init_f08.F90 \

diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files b/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files
@@ -6,8 +6,6 @@
 # $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/f_sync_reg_ts.c.in
 
 incomplete_prototype_files = \
-        $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_ts.c.in \
-        $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_ts.c.in \
         $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_ts.c.in \
         $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_ts.c.in \
         $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_ts.c.in \
@@ -116,6 +114,8 @@ complete_prototype_files = \
         $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/isend_ts.c.in \
         $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/issend_ts.c.in \
         $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/mrecv_ts.c.in \
+        $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_ts.c.in \
+        $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_ts.c.in \
         $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/recv_ts.c.in \
         $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/reduce_ts.c.in \
         $(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/send_ts.c.in \

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
@@ -3172,21 +3172,6 @@ subroutine MPI_Improbe_f08(source,tag,comm,flag,message,status,ierror)
 end subroutine MPI_Improbe_f08
 end interface  MPI_Improbe
 
-interface  MPI_Neighbor_allgather
-subroutine MPI_Neighbor_allgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, &
-                             comm,ierror)
-   use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm
-   implicit none
-   @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf
-   INTEGER, INTENT(IN) :: sendcount, recvcount
-   TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype
-   TYPE(MPI_Comm), INTENT(IN) :: comm
-   INTEGER, OPTIONAL, INTENT(OUT) :: ierror
-end subroutine MPI_Neighbor_allgather_f08
-end interface  MPI_Neighbor_allgather
-
 interface  MPI_Neighbor_allgather_init
 subroutine MPI_Neighbor_allgather_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, &
                              comm,info,request,ierror)
@@ -3204,22 +3189,6 @@ subroutine MPI_Neighbor_allgather_init_f08(sendbuf,sendcount,sendtype,recvbuf,re
 end subroutine MPI_Neighbor_allgather_init_f08
 end interface  MPI_Neighbor_allgather_init
 
-interface  MPI_Neighbor_allgatherv
-subroutine MPI_Neighbor_allgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, &
-                              recvtype,comm,ierror)
-   use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm
-   implicit none
-   @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf
-   @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf
-   INTEGER, INTENT(IN) :: sendcount
-   INTEGER, INTENT(IN) :: recvcounts(*), displs(*)
-   TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype
-   TYPE(MPI_Comm), INTENT(IN) :: comm
-   INTEGER, OPTIONAL, INTENT(OUT) :: ierror
-end subroutine MPI_Neighbor_allgatherv_f08
-end interface  MPI_Neighbor_allgatherv
-
 interface  MPI_Neighbor_allgatherv_init
 subroutine MPI_Neighbor_allgatherv_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, &
                               recvtype,comm,info,request,ierror)

diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_f08.F90
diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_ts.c.in
@@ -22,27 +22,18 @@
  * $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_Neighbor_allgather";
-
-void ompi_neighbor_allgather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype,
-                                CFI_cdesc_t *x2, MPI_Fint *recvcount, MPI_Fint *recvtype,
-                                MPI_Fint *comm, MPI_Fint *ierr)
+PROTOTYPE VOID neighbor_allgather(BUFFER x1, COUNT sendcount, DATATYPE sendtype,
+                                  BUFFER_OUT x2, COUNT recvcount, DATATYPE recvtype,
+                                  COMM comm)
 {
     int c_ierr;
     MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
     MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype);
     void *sendbuf = OMPI_CFI_BASE_ADDR(x1);
-    int c_sendcount =  OMPI_FINT_2_INT(*sendcount);
+    @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount;
     MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype);
     void *recvbuf = OMPI_CFI_BASE_ADDR(x2);
-    int c_recvcount =  OMPI_FINT_2_INT(*recvcount);
+    @COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@) *recvcount;
 
     OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr);
     if (MPI_SUCCESS != c_ierr) {
@@ -64,12 +55,14 @@ void ompi_neighbor_allgather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *
     sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
     recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
 
-    c_ierr = PMPI_Neighbor_allgather(sendbuf,
-                                     c_sendcount,
-                                     c_sendtype,
-                                     recvbuf,
-                                     c_recvcount,
-                                     c_recvtype, c_comm);
+    c_ierr = @INNER_CALL@(sendbuf,
+                          c_sendcount,
+                          c_sendtype,
+                          recvbuf,
+                          c_recvcount,
+                          c_recvtype, c_comm);
+
+    /* TODO: Created type c_senddatatype is not being used above */
 
     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 }
diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_f08.F90
diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_ts.c.in
@@ -22,27 +22,18 @@
  * $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_Neighbor_allgatherv";
-
-void ompi_neighbor_allgatherv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype,
-                                 CFI_cdesc_t *x2, MPI_Fint *recvcounts, MPI_Fint *displs,
-                                 MPI_Fint *recvtype, MPI_Fint *comm, MPI_Fint *ierr)
+PROTOTYPE VOID neighbor_allgatherv(BUFFER x1, COUNT sendcount, DATATYPE sendtype,
+                                   BUFFER_OUT x2, COUNT_ARRAY recvcounts, DISP_ARRAY displs,
+                                   DATATYPE recvtype, COMM comm)
 {
     MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
     MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype);
     char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
-    int c_sendcount =  OMPI_FINT_2_INT(*sendcount);
+    @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount;
     MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype);
     int size, c_ierr;
-    OMPI_ARRAY_NAME_DECL(recvcounts);
-    OMPI_ARRAY_NAME_DECL(displs);
+    @COUNT_TYPE@ *tmp_recvcounts = NULL;
+    @DISP_TYPE@ *tmp_displs = NULL;
 
     OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr);
     if (MPI_SUCCESS != c_ierr) {
@@ -61,25 +52,25 @@ void ompi_neighbor_allgatherv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint
     c_recvtype = PMPI_Type_f2c(*recvtype);
 
     PMPI_Comm_size(c_comm, &size);
-    OMPI_ARRAY_FINT_2_INT(recvcounts, size);
-    OMPI_ARRAY_FINT_2_INT(displs, size);
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size);
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size);
 
     sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
     sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
     recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
 
-    c_ierr = PMPI_Neighbor_allgatherv(sendbuf,
-                                      c_sendcount,
-                                      c_sendtype,
-                                      recvbuf,
-                                      OMPI_ARRAY_NAME_CONVERT(recvcounts),
-                                      OMPI_ARRAY_NAME_CONVERT(displs),
-                                      c_recvtype, c_comm);
+    c_ierr = @INNER_CALL@(sendbuf,
+                          c_sendcount,
+                          c_sendtype,
+                          recvbuf,
+                          tmp_recvcounts,
+                          tmp_displs,
+                          c_recvtype, c_comm);
 
-    /* TODO: Free datatypes */
+    /* TODO: Free datatypes (note: it also looks like the code above is not using the datatypes) */
 
     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 
-    OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
-    OMPI_ARRAY_FINT_2_INT_CLEANUP(displs);
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts);
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(displs, tmp_displs);
 }