Skip to content

Commit d7e3600

Browse files
ggouaillardetggouaillardet
committed
fortran/use-mpi-f08: add CFI support for (blocking) collective subroutines
Signed-off-by: Gilles Gouaillardet <gilles@rist.or.jp>
1 parent 0fe17a1 commit d7e3600

29 files changed

+759
-103
lines changed

‎ompi/mpi/fortran/use-mpi-f08/allgather_f08.F90‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved.
44
! Copyright (c) 2009-2012 Los Alamos National Security, LLC.
55
! All rights reserved.
6-
! Copyright (c) 2018 Research Organization for Information Science
6+
! Copyright (c) 2018-2019 Research Organization for Information Science
77
! and Technology (RIST). All rights reserved.
88
! $COPYRIGHT$
99

@@ -13,8 +13,8 @@ subroutine MPI_Allgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvty
1313
use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm
1414
use :: ompi_mpifh_bindings, only : ompi_allgather_f
1515
implicit none
16-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
17-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf
16+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
17+
OMPI_F08_IGNORE_TKR_TYPE :: recvbuf
1818
INTEGER, INTENT(IN) :: sendcount, recvcount
1919
TYPE(MPI_Datatype), INTENT(IN) :: sendtype
2020
TYPE(MPI_Datatype), INTENT(IN) :: recvtype

‎ompi/mpi/fortran/use-mpi-f08/allgatherv_f08.F90‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved.
44
! Copyright (c) 2009-2012 Los Alamos National Security, LLC.
55
! All rights reserved.
6-
! Copyright (c) 2018 Research Organization for Information Science
6+
! Copyright (c) 2018-2019 Research Organization for Information Science
77
! and Technology (RIST). All rights reserved.
88
! $COPYRIGHT$
99

@@ -14,8 +14,8 @@ subroutine MPI_Allgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,&
1414
use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm
1515
use :: ompi_mpifh_bindings, only : ompi_allgatherv_f
1616
implicit none
17-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
18-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf
17+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
18+
OMPI_F08_IGNORE_TKR_TYPE :: recvbuf
1919
INTEGER, INTENT(IN) :: sendcount
2020
INTEGER, INTENT(IN) :: recvcounts(*), displs(*)
2121
TYPE(MPI_Datatype), INTENT(IN) :: sendtype

‎ompi/mpi/fortran/use-mpi-f08/alltoall_f08.F90‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved.
44
! Copyright (c) 2009-2012 Los Alamos National Security, LLC.
55
! All rights reserved.
6-
! Copyright (c) 2018 Research Organization for Information Science
6+
! Copyright (c) 2018-2019 Research Organization for Information Science
77
! and Technology (RIST). All rights reserved.
88
! $COPYRIGHT$
99

@@ -14,8 +14,8 @@ subroutine MPI_Alltoall_f08(sendbuf,sendcount,sendtype,recvbuf,&
1414
use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm
1515
use :: ompi_mpifh_bindings, only : ompi_alltoall_f
1616
implicit none
17-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
18-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf
17+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
18+
OMPI_F08_IGNORE_TKR_TYPE :: recvbuf
1919
INTEGER, INTENT(IN) :: sendcount, recvcount
2020
TYPE(MPI_Datatype), INTENT(IN) :: sendtype
2121
TYPE(MPI_Datatype), INTENT(IN) :: recvtype

‎ompi/mpi/fortran/use-mpi-f08/bcast_f08.F90‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved.
44
! Copyright (c) 2009-2012 Los Alamos National Security, LLC.
55
! All rights reserved.
6-
! Copyright (c) 2018 Research Organization for Information Science
6+
! Copyright (c) 2018-2019 Research Organization for Information Science
77
! and Technology (RIST). All rights reserved.
88
! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved.
99
! $COPYRIGHT$
@@ -14,7 +14,7 @@ subroutine MPI_Bcast_f08(buffer,count,datatype,root,comm,ierror)
1414
use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm
1515
use :: ompi_mpifh_bindings, only : ompi_bcast_f
1616
implicit none
17-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: buffer
17+
OMPI_F08_IGNORE_TKR_TYPE :: buffer
1818
INTEGER, INTENT(IN) :: count, root
1919
TYPE(MPI_Datatype), INTENT(IN) :: datatype
2020
TYPE(MPI_Comm), INTENT(IN) :: comm

‎ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h.in‎

Lines changed: 22 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -800,10 +800,10 @@ end subroutine ompi_unpack_external_f
800800

801801
subroutine ompi_allgather_f(sendbuf,sendcount,sendtype,recvbuf, &
802802
recvcount,recvtype,comm,ierror) &
803-
BIND(C, name="ompi_allgather_f")
803+
BIND(C, name="ompi_allgather_@OMPI_F08_BINDINGS_EXTENSION@")
804804
implicit none
805-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
806-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf
805+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
806+
OMPI_F08_IGNORE_TKR_TYPE :: recvbuf
807807
INTEGER, INTENT(IN) :: sendcount, recvcount
808808
INTEGER, INTENT(IN) :: sendtype
809809
INTEGER, INTENT(IN) :: recvtype
@@ -827,10 +827,10 @@ end subroutine ompi_iallgather_f
827827

828828
subroutine ompi_allgatherv_f(sendbuf,sendcount,sendtype,recvbuf, &
829829
recvcounts,displs,recvtype,comm,ierror) &
830-
BIND(C, name="ompi_allgatherv_f")
830+
BIND(C, name="ompi_allgatherv_@OMPI_F08_BINDINGS_EXTENSION@")
831831
implicit none
832-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
833-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf
832+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
833+
OMPI_F08_IGNORE_TKR_TYPE :: recvbuf
834834
INTEGER, INTENT(IN) :: sendcount
835835
INTEGER, INTENT(IN) :: recvcounts(*), displs(*)
836836
INTEGER, INTENT(IN) :: sendtype
@@ -881,10 +881,10 @@ end subroutine ompi_iallreduce_f
881881

882882
subroutine ompi_alltoall_f(sendbuf,sendcount,sendtype,recvbuf, &
883883
recvcount,recvtype,comm,ierror) &
884-
BIND(C, name="ompi_alltoall_f")
884+
BIND(C, name="ompi_alltoall_@OMPI_F08_BINDINGS_EXTENSION@")
885885
implicit none
886-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
887-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf
886+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
887+
OMPI_F08_IGNORE_TKR_TYPE :: recvbuf
888888
INTEGER, INTENT(IN) :: sendcount, recvcount
889889
INTEGER, INTENT(IN) :: sendtype
890890
INTEGER, INTENT(IN) :: recvtype
@@ -976,9 +976,9 @@ subroutine ompi_ibarrier_f(comm,request,ierror) &
976976
end subroutine ompi_ibarrier_f
977977

978978
subroutine ompi_bcast_f(buffer,count,datatype,root,comm,ierror) &
979-
BIND(C, name="ompi_bcast_f")
979+
BIND(C, name="ompi_bcast_@OMPI_F08_BINDINGS_EXTENSION@")
980980
implicit none
981-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: buffer
981+
OMPI_F08_IGNORE_TKR_TYPE :: buffer
982982
INTEGER, INTENT(IN) :: count, root
983983
INTEGER, INTENT(IN) :: datatype
984984
INTEGER, INTENT(IN) :: comm
@@ -1023,10 +1023,10 @@ end subroutine ompi_iexscan_f
10231023

10241024
subroutine ompi_gather_f(sendbuf,sendcount,sendtype,recvbuf, &
10251025
recvcount,recvtype,root,comm,ierror) &
1026-
BIND(C, name="ompi_gather_f")
1026+
BIND(C, name="ompi_gather_@OMPI_F08_BINDINGS_EXTENSION@")
10271027
implicit none
1028-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
1029-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf
1028+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
1029+
OMPI_F08_IGNORE_TKR_TYPE :: recvbuf
10301030
INTEGER, INTENT(IN) :: sendcount, recvcount, root
10311031
INTEGER, INTENT(IN) :: sendtype
10321032
INTEGER, INTENT(IN) :: recvtype
@@ -1050,10 +1050,10 @@ end subroutine ompi_igather_f
10501050

10511051
subroutine ompi_gatherv_f(sendbuf,sendcount,sendtype,recvbuf, &
10521052
recvcounts,displs,recvtype,root,comm,ierror) &
1053-
BIND(C, name="ompi_gatherv_f")
1053+
BIND(C, name="ompi_gatherv_@OMPI_F08_BINDINGS_EXTENSION@")
10541054
implicit none
1055-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
1056-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf
1055+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
1056+
OMPI_F08_IGNORE_TKR_TYPE :: recvbuf
10571057
INTEGER, INTENT(IN) :: sendcount, root
10581058
INTEGER, INTENT(IN) :: recvcounts(*), displs(*)
10591059
INTEGER, INTENT(IN) :: sendtype
@@ -1201,10 +1201,10 @@ end subroutine ompi_iscan_f
12011201

12021202
subroutine ompi_scatter_f(sendbuf,sendcount,sendtype,recvbuf, &
12031203
recvcount,recvtype,root,comm,ierror) &
1204-
BIND(C, name="ompi_scatter_f")
1204+
BIND(C, name="ompi_scatter_@OMPI_F08_BINDINGS_EXTENSION@")
12051205
implicit none
1206-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
1207-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf
1206+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
1207+
OMPI_F08_IGNORE_TKR_TYPE :: recvbuf
12081208
INTEGER, INTENT(IN) :: sendcount, recvcount, root
12091209
INTEGER, INTENT(IN) :: sendtype
12101210
INTEGER, INTENT(IN) :: recvtype
@@ -1228,10 +1228,10 @@ end subroutine ompi_iscatter_f
12281228

12291229
subroutine ompi_scatterv_f(sendbuf,sendcounts,displs,sendtype, &
12301230
recvbuf,recvcount,recvtype,root,comm,ierror) &
1231-
BIND(C, name="ompi_scatterv_f")
1231+
BIND(C, name="ompi_scatterv_@OMPI_F08_BINDINGS_EXTENSION@")
12321232
implicit none
12331233
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf
1234-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf
1234+
OMPI_F08_IGNORE_TKR_TYPE :: recvbuf
12351235
INTEGER, INTENT(IN) :: recvcount, root
12361236
INTEGER, INTENT(IN) :: sendcounts(*), displs(*)
12371237
INTEGER, INTENT(IN) :: sendtype

‎ompi/mpi/fortran/use-mpi-f08/cdesc/Makefile.am‎

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -66,6 +66,15 @@ libforce_usempif08_internal_cdesc_to_be_built_la_SOURCES = \
6666
pack_cdesc.c \
6767
pack_external_cdesc.c \
6868
unpack_cdesc.c \
69-
unpack_external_cdesc.c
69+
unpack_external_cdesc.c \
70+
\
71+
bcast_cdesc.c \
72+
gather_cdesc.c \
73+
gatherv_cdesc.c \
74+
allgather_cdesc.c \
75+
allgatherv_cdesc.c \
76+
scatter_cdesc.c \
77+
scatterv_cdesc.c \
78+
alltoall_cdesc.c
7079

7180
endif

‎ompi/mpi/fortran/use-mpi-f08/cdesc/allgather_cdesc.c‎

Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
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-2005 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-2019 Research Organization for Information Science
14+
* and Technology (RIST). All rights reserved.
15+
* $COPYRIGHT$
16+
*
17+
* Additional copyrights may follow
18+
*
19+
* $HEADER$
20+
*/
21+
22+
#include "ompi_config.h"
23+
24+
#include "ompi/mpi/fortran/mpif-h/bindings.h"
25+
#include "ompi/mpi/fortran/use-mpi-f08/cdesc/bindings.h"
26+
#include "ompi/mpi/fortran/base/constants.h"
27+
28+
29+
void ompi_allgather_cdesc(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype,
30+
CFI_cdesc_t* x2, MPI_Fint *recvcount, MPI_Fint *recvtype,
31+
MPI_Fint *comm, MPI_Fint *ierr)
32+
{
33+
int c_ierr;
34+
MPI_Comm c_comm;
35+
MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype);
36+
void *sendbuf = x1->base_addr;
37+
int c_sendcount = OMPI_FINT_2_INT(*sendcount);
38+
MPI_Datatype c_recvdatatype, c_recvtype = PMPI_Type_f2c(*recvtype);
39+
void *recvbuf = x2->base_addr;
40+
int c_recvcount = OMPI_FINT_2_INT(*recvcount);
41+
42+
c_comm = PMPI_Comm_f2c(*comm);
43+
44+
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
45+
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
46+
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
47+
48+
c_senddatatype = c_sendtype;
49+
if (x1->rank != 0 && !CFI_is_contiguous(x1)) {
50+
c_ierr = cdesc_create_datatype(x1, c_sendcount, c_sendtype, &c_senddatatype);
51+
if (MPI_SUCCESS != c_ierr) {
52+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
53+
return;
54+
}
55+
c_sendcount = 1;
56+
}
57+
c_recvdatatype = c_recvtype;
58+
if (x2->rank != 0 && !CFI_is_contiguous(x2)) {
59+
c_ierr = cdesc_create_datatype(x2, c_recvcount, c_recvtype, &c_recvdatatype);
60+
if (MPI_SUCCESS != c_ierr) {
61+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
62+
if (c_senddatatype != c_sendtype) {
63+
ompi_datatype_destroy(&c_senddatatype);
64+
}
65+
return;
66+
}
67+
c_recvcount = 1;
68+
}
69+
c_ierr = PMPI_Allgather(sendbuf,
70+
c_sendcount,
71+
c_sendtype,
72+
recvbuf,
73+
c_recvcount,
74+
c_recvtype, c_comm);
75+
if (c_senddatatype != c_sendtype) {
76+
ompi_datatype_destroy(&c_senddatatype);
77+
}
78+
if (c_recvdatatype != c_recvtype) {
79+
ompi_datatype_destroy(&c_recvdatatype);
80+
}
81+
82+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
83+
}

‎ompi/mpi/fortran/use-mpi-f08/cdesc/allgatherv_cdesc.c‎

Lines changed: 76 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,76 @@
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-2005 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-2019 Research Organization for Information Science
14+
* and Technology (RIST). All rights reserved.
15+
* $COPYRIGHT$
16+
*
17+
* Additional copyrights may follow
18+
*
19+
* $HEADER$
20+
*/
21+
22+
#include "ompi_config.h"
23+
24+
#include "ompi/mpi/fortran/mpif-h/bindings.h"
25+
#include "ompi/mpi/fortran/use-mpi-f08/cdesc/bindings.h"
26+
#include "ompi/mpi/fortran/base/constants.h"
27+
28+
29+
void ompi_allgatherv_cdesc(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype,
30+
char *recvbuf, MPI_Fint *recvcounts, MPI_Fint *displs,
31+
MPI_Fint *recvtype, MPI_Fint *comm, MPI_Fint *ierr)
32+
{
33+
MPI_Comm c_comm;
34+
MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype);
35+
void *sendbuf = x1->base_addr;
36+
int c_sendcount = OMPI_FINT_2_INT(*sendcount);
37+
MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype);
38+
int size, c_ierr;
39+
OMPI_ARRAY_NAME_DECL(recvcounts);
40+
OMPI_ARRAY_NAME_DECL(displs);
41+
42+
c_comm = PMPI_Comm_f2c(*comm);
43+
44+
PMPI_Comm_size(c_comm, &size);
45+
OMPI_ARRAY_FINT_2_INT(recvcounts, size);
46+
OMPI_ARRAY_FINT_2_INT(displs, size);
47+
48+
sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
49+
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
50+
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
51+
52+
c_senddatatype = c_sendtype;
53+
if (x1->rank != 0 && !CFI_is_contiguous(x1)) {
54+
c_ierr = cdesc_create_datatype(x1, c_sendcount, c_sendtype, &c_senddatatype);
55+
if (MPI_SUCCESS != c_ierr) {
56+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
57+
return;
58+
}
59+
c_sendcount = 1;
60+
}
61+
c_ierr = PMPI_Allgatherv(sendbuf,
62+
OMPI_FINT_2_INT(*sendcount),
63+
c_sendtype,
64+
recvbuf,
65+
OMPI_ARRAY_NAME_CONVERT(recvcounts),
66+
OMPI_ARRAY_NAME_CONVERT(displs),
67+
c_recvtype, c_comm);
68+
if (c_senddatatype != c_sendtype) {
69+
ompi_datatype_destroy(&c_senddatatype);
70+
}
71+
72+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
73+
74+
OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
75+
OMPI_ARRAY_FINT_2_INT_CLEANUP(displs);
76+
}

0 commit comments

Comments
 (0)