open-mpi · hppritcha · May 1, 2025 · Apr 8, 2025
diff --git a/ompi/mpi/bindings/ompi_bindings/fortran.py b/ompi/mpi/bindings/ompi_bindings/fortran.py
@@ -179,10 +179,11 @@ def print_c_source(self):
         c_func = self.c_func_name
         self.dump(f'void {c_func}({parameters});')
         self.dump(f'void {c_func}({parameters})')
-        count_type, disp_type = ('MPI_Count', 'MPI_Aint') if self.bigcount else ('int', 'int')
+        count_type, disp_type, count_fint_type = ('MPI_Count', 'MPI_Aint', 'MPI_Count') if self.bigcount else ('int', 'int', 'MPI_Fint')
         self.template.print_body(c_func, out=self.out,
                                  replacements={'INNER_CALL': self.inner_call,
                                                'COUNT_TYPE': count_type,
+                                               'COUNT_FINT_TYPE': count_fint_type,
                                                'DISP_TYPE': disp_type})
 
     def print_interface(self):

diff --git a/ompi/mpi/fortran/use-mpi-f08/allgather_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/allgather_init_ts.c.in
@@ -12,7 +12,7 @@
  * Copyright (c) 2011-2012 Cisco Systems, Inc.  All rights reserved.
  * Copyright (c) 2015-2021 Research Organization for Information Science
  *                         and Technology (RIST).  All rights reserved.
- * Copyright (c) 2024      Triad National Security, LLC. All rights
+ * Copyright (c) 2024-2025 Triad National Security, LLC. All rights
  *                         reserved.
  * $COPYRIGHT$
  *
@@ -33,6 +33,7 @@ PROTOTYPE VOID allgather_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtyp
     MPI_Info c_info;
     void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
     @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount;
+    @COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@) *recvcount;
 
     OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr);
     if (MPI_SUCCESS != c_ierr) {
@@ -66,7 +67,7 @@ PROTOTYPE VOID allgather_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtyp
                           c_sendcount,
                           c_senddatatype,
                           recvbuf,
-                          (@COUNT_TYPE@) *recvcount,
+                          c_recvcount,
                           c_recvtype, c_comm, c_info, &c_req);
 
     if (c_senddatatype != c_sendtype) {

diff --git a/ompi/mpi/fortran/use-mpi-f08/allgather_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/allgather_ts.c.in
@@ -12,7 +12,7 @@
  * 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 (c) 2024      Triad National Security, LLC. All rights
+ * Copyright (c) 2024-2025 Triad National Security, LLC. All rights
  *                         reserved.
  * $COPYRIGHT$
  *
@@ -28,7 +28,8 @@ PROTOTYPE VOID allgather(BUFFER x1, COUNT sendcount, DATATYPE sendtype,
 {
     int c_ierr;
     MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
-    int c_sendcount = 0;
+    @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@)*sendcount;
+    @COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@)*recvcount;
     MPI_Datatype c_sendtype = NULL, c_senddatatype = NULL;
     MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype);
     void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
@@ -60,7 +61,7 @@ PROTOTYPE VOID allgather(BUFFER x1, COUNT sendcount, DATATYPE sendtype,
                           c_sendcount,
                           c_senddatatype,
                           recvbuf,
-                          OMPI_FINT_2_INT(*recvcount),
+                          c_recvcount,
                           c_recvtype, c_comm);
 
     if (c_senddatatype != c_sendtype) {

diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoall_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoall_init_ts.c.in
@@ -32,6 +32,8 @@ PROTOTYPE VOID alltoall_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype
     MPI_Datatype c_sendtype, c_recvtype;
     MPI_Info c_info;
     void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
+    @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@)*sendcount;
+    @COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@)*recvcount;
 
     c_comm = PMPI_Comm_f2c(*comm);
     c_sendtype = PMPI_Type_f2c(*sendtype);
@@ -61,10 +63,10 @@ PROTOTYPE VOID alltoall_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype
     recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
 
     c_ierr = @INNER_CALL@(sendbuf,
-                          (@COUNT_TYPE@) *sendcount,
+                          c_sendcount,
                           c_sendtype,
                           recvbuf,
-                          (@COUNT_TYPE@) *recvcount,
+                          c_recvcount,
                           c_recvtype, c_comm, c_info, &c_req);
     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 

diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoall_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoall_ts.c.in
@@ -12,7 +12,7 @@
  * 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 (c) 2024      Triad National Security, LLC. All rights
+ * Copyright (c) 2024-2025 Triad National Security, LLC. All rights
  *                         reserved.
  * $COPYRIGHT$
  *
@@ -30,11 +30,11 @@ PROTOTYPE VOID alltoall(BUFFER x1, COUNT sendcount, DATATYPE sendtype,
     MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
     MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype);
     void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
-    int c_sendcount = 0, c_recvcount =  OMPI_FINT_2_INT(*recvcount);
+    @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@)(*sendcount);
+    @COUNT_TYPE@ c_recvcount =  (@COUNT_TYPE@)(*recvcount);
 
     if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
         c_sendtype = PMPI_Type_f2c(*sendtype);
-        c_sendcount = OMPI_FINT_2_INT(*sendcount);
         OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr);
         if (MPI_SUCCESS != c_ierr) {
             if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);

diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallv_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoallv_init_ts.c.in
@@ -62,8 +62,6 @@ PROTOTYPE VOID alltoallv_init(BUFFER_ASYNC x1, COUNT_ARRAY sendcounts, DISP_ARRA
         OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
         return;
     }
-    OMPI_ARRAY_FINT_2_INT(sendcounts, size);
-    OMPI_ARRAY_FINT_2_INT(sdispls, size);
     OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size);
     OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(rdispls, tmp_rdispls, size);
 

diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoallv_ts.c.in
@@ -12,7 +12,7 @@
  * 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 (c) 2024      Triad National Security, LLC. All rights
+ * Copyright (c) 2024-2025 Triad National Security, LLC. All rights
  *                         reserved.
  * $COPYRIGHT$
  *
@@ -72,10 +72,9 @@ PROTOTYPE VOID alltoallv(BUFFER x1, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls,
                           c_recvtype, c_comm);
 
     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
-    if (MPI_IN_PLACE == sendbuf) {
-        OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts);
-        OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls);
-    }
+
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts);
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls);
     OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts);
     OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(rdispls, tmp_rdispls);
 }
diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallw_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoallw_ts.c.in
@@ -12,7 +12,7 @@
  * 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 (c) 2024      Triad National Security, LLC. All rights
+ * Copyright (c) 2024-2025 Triad National Security, LLC. All rights
  *                         reserved.
  * $COPYRIGHT$
  *
@@ -27,42 +27,42 @@ PROTOTYPE VOID alltoallw(BUFFER x1, COUNT_ARRAY sendcounts,
                          DISP_ARRAY rdispls, DATATYPE_ARRAY recvtypes,
                          COMM comm)
 {
-    MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
-    MPI_Datatype *c_sendtypes = NULL, *c_recvtypes;
     int size, c_ierr;
+    MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
     char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
+    MPI_Datatype *c_sendtypes = NULL, *c_recvtypes;
+    @COUNT_TYPE@ *tmp_sendcounts = NULL;
+    @DISP_TYPE@ *tmp_sdispls = NULL;
+    @COUNT_TYPE@ *tmp_recvcounts = NULL;
+    @DISP_TYPE@ *tmp_rdispls = NULL;
 
-    OMPI_ARRAY_NAME_DECL(sendcounts);
-    OMPI_ARRAY_NAME_DECL(sdispls);
-    OMPI_ARRAY_NAME_DECL(recvcounts);
-    OMPI_ARRAY_NAME_DECL(rdispls);
+    size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm);
 
-    OMPI_CFI_CHECK_CONTIGUOUS(x1, 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;
+    if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
+        OMPI_CFI_CHECK_CONTIGUOUS(x1, 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_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
+        for (int i=0; i<size; i++) {
+            c_sendtypes[i] = PMPI_Type_f2c(sendtypes[i]);
+        }
+        OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size);
+        OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sdispls, tmp_sdispls, size);
+    } else {
+        sendbuf = MPI_IN_PLACE;
     }
+
     OMPI_CFI_CHECK_CONTIGUOUS(x2, 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;
     }
-    size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm);
-
-    if (!OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
-        c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
-        OMPI_ARRAY_FINT_2_INT(sendcounts, size);
-        OMPI_ARRAY_FINT_2_INT(sdispls, size);
-        for (int i=0; i<size; i++) {
-            c_sendtypes[i] = PMPI_Type_f2c(sendtypes[i]);
-        }
-    }
 
     c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
-    OMPI_ARRAY_FINT_2_INT(recvcounts, size);
-    OMPI_ARRAY_FINT_2_INT(rdispls, size);
     for (int i=0; i<size; i++) {
         c_recvtypes[i] = PMPI_Type_f2c(recvtypes[i]);
     }
@@ -71,20 +71,24 @@ PROTOTYPE VOID alltoallw(BUFFER x1, COUNT_ARRAY sendcounts,
     sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
     recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
 
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size);
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(rdispls, tmp_rdispls, size);
+
     c_ierr = @INNER_CALL@(sendbuf,
-                          OMPI_ARRAY_NAME_CONVERT(sendcounts),
-                          OMPI_ARRAY_NAME_CONVERT(sdispls),
+                          tmp_sendcounts,
+                          tmp_sdispls,
                           c_sendtypes,
                           recvbuf,
-                          OMPI_ARRAY_NAME_CONVERT(recvcounts),
-                          OMPI_ARRAY_NAME_CONVERT(rdispls),
+                          tmp_recvcounts,
+                          tmp_rdispls,
                           c_recvtypes, c_comm);
     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 
-    OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts);
-    OMPI_ARRAY_FINT_2_INT_CLEANUP(sdispls);
-    OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
-    OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls);
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts);
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls);
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts);
+    OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(rdispls, tmp_rdispls);
+
     if (NULL != c_sendtypes) {
         free(c_sendtypes);
     }

diff --git a/ompi/mpi/fortran/use-mpi-f08/base/bigcount.h b/ompi/mpi/fortran/use-mpi-f08/base/bigcount.h
@@ -15,7 +15,7 @@
 #define OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(array, tmp_array, n) \
     do { \
         if (sizeof(*(array)) == sizeof(*(tmp_array))) { \
-            (tmp_array) = (array); \
+            (tmp_array) = (void *)(array); \
         } else { \
             (tmp_array) = malloc(sizeof(*tmp_array) * n); \
             for (int bigcount_array_i = 0; bigcount_array_i < n; ++bigcount_array_i) { \
@@ -24,9 +24,19 @@
         } \
     } while (0)
 
-#define OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(array, tmp_array) \
+#define OMPI_FORTRAN_BIGCOUNT_ARRAY_COPYOUT(array, tmp_array, n) \
     do { \
         if ((array) != (tmp_array) && NULL != (tmp_array)) { \
+            for (int bigcount_array_i = 0; bigcount_array_i < n; ++bigcount_array_i) { \
+                (array)[bigcount_array_i] = (tmp_array)[bigcount_array_i]; \
+            } \
+        } \
+    } while (0)
+
+
+#define OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(array, tmp_array) \
+    do { \
+        if ((void *)(array) != (void *)(tmp_array) && NULL != (tmp_array)) { \
             free(tmp_array); \
             tmp_array = NULL; \
         } \
@@ -36,7 +46,7 @@
     do { \
         if (MPI_SUCCESS == (c_ierr)) { \
             ompi_coll_base_nbc_request_t* nb_request = (ompi_coll_base_nbc_request_t*)c_request; \
-            if ((array) != (tmp_array) && (tmp_array) != NULL) { \
+            if ((void *)(array) != (void *)(tmp_array) && (tmp_array) != NULL) { \
                 nb_request->data.release_arrays[(idx)++] = tmp_array; \
             } \
             nb_request->data.release_arrays[idx] = NULL; \