Skip to content

Commit 0edc5cb

Browse files
ggouaillardethppritcha
ggouaillardet
authored and
hppritcha
committed
checkpoint
1 parent b3229fa commit 0edc5cb

File tree

4 files changed

+134
-16
lines changed

4 files changed

+134
-16
lines changed

‎ompi/mpi/fortran/use-mpi-f08/ts/bcast_ts.c‎

Lines changed: 13 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -35,13 +35,17 @@ void ompi_bcast_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype,
3535
MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
3636
MPI_Datatype c_datatype = NULL, c_type = NULL;
3737
int c_root = OMPI_FINT_2_INT(*root);
38-
void *buffer = x->base_addr;
38+
void *buffer = NULL;
3939
int c_count = 0;
4040

4141
if (OMPI_COMM_IS_INTRA(c_comm) || MPI_PROC_NULL != c_root) {
4242
c_type = PMPI_Type_f2c(*datatype);
4343
c_count = OMPI_FINT_2_INT(*count);
44-
OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr);
44+
if ((OMPI_COMM_IS_INTER(c_comm) && MPI_PROC_NULL == c_root) || (ompi_comm_rank(c_comm) == c_root)) {
45+
OMPI_CFI_2_C_COPY(x, buffer, c_count, c_type, c_datatype, c_ierr);
46+
} else {
47+
OMPI_CFI_2_C_ALLOC(x, buffer, c_count, c_type, c_datatype, c_ierr);
48+
}
4549
if (MPI_SUCCESS != c_ierr) {
4650
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
4751
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
@@ -54,8 +58,12 @@ void ompi_bcast_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype,
5458
c_datatype,
5559
c_root,
5660
c_comm);
57-
if (c_datatype != c_type) {
58-
ompi_datatype_destroy(&c_datatype);
59-
}
6061
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
62+
if (OMPI_COMM_IS_INTRA(c_comm) || MPI_PROC_NULL != c_root) {
63+
if ((OMPI_COMM_IS_INTER(c_comm) && MPI_ROOT == c_root) || (ompi_comm_rank(c_comm) == c_root)) {
64+
OMPI_C_2_CFI_FREE(x, buffer, c_count, c_type, c_datatype, c_ierr);
65+
} else {
66+
OMPI_C_2_CFI_COPY(x, buffer, c_count, c_type, c_datatype, c_ierr);
67+
}
68+
}
6169
}

‎ompi/mpi/fortran/use-mpi-f08/ts/gather_ts.c‎

Lines changed: 15 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -37,8 +37,8 @@ void ompi_gather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype,
3737
MPI_Datatype c_senddatatype = NULL, c_sendtype = NULL;
3838
void *sendbuf = x1->base_addr;
3939
int c_sendcount = 0, c_recvcount = 0;
40-
MPI_Datatype c_recvtype = NULL;
41-
void *recvbuf = x2->base_addr;
40+
MPI_Datatype c_recvtype = NULL, c_recvdatatype = NULL;
41+
char *recvbuf = NULL;
4242

4343
c_comm = PMPI_Comm_f2c(*comm);
4444
c_root = OMPI_FINT_2_INT(*root);
@@ -47,7 +47,7 @@ void ompi_gather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype,
4747
if (MPI_ROOT == c_root) {
4848
c_recvtype = PMPI_Type_f2c(*recvtype);
4949
c_recvcount = OMPI_FINT_2_INT(*recvcount);
50-
OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr);
50+
OMPI_CFI_2_C_ALLOC(x2, recvbuf, c_recvcount, c_recvtype, c_recvdatatype, c_ierr);
5151
if (MPI_SUCCESS != c_ierr) {
5252
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
5353
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
@@ -67,16 +67,19 @@ void ompi_gather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype,
6767
if (ompi_comm_rank(c_comm) == c_root) {
6868
c_recvtype = PMPI_Type_f2c(*recvtype);
6969
c_recvcount = OMPI_FINT_2_INT(*recvcount);
70-
OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr);
70+
if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
71+
sendbuf = MPI_IN_PLACE;
72+
OMPI_CFI_2_C_COPY(x2, recvbuf, c_recvcount, c_recvtype, c_recvdatatype, c_ierr);
73+
} else {
74+
OMPI_CFI_2_C_ALLOC(x2, recvbuf, c_recvcount, c_recvtype, c_recvdatatype, c_ierr);
75+
}
7176
if (MPI_SUCCESS != c_ierr) {
7277
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
7378
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
7479
return;
7580
}
7681
}
77-
if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
78-
sendbuf = MPI_IN_PLACE;
79-
} else {
82+
if (!OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
8083
c_sendtype = PMPI_Type_f2c(*sendtype);
8184
c_sendcount = OMPI_FINT_2_INT(*sendcount);
8285
OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr);
@@ -95,11 +98,15 @@ void ompi_gather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype,
9598
c_ierr = PMPI_Gather(sendbuf, c_sendcount,
9699
c_senddatatype, recvbuf,
97100
c_recvcount,
98-
c_recvtype,
101+
c_recvdatatype,
99102
c_root,
100103
c_comm);
101104
if (c_senddatatype != c_sendtype) {
102105
ompi_datatype_destroy(&c_senddatatype);
103106
}
104107
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
108+
if ((OMPI_COMM_IS_INTER(c_comm) && (MPI_ROOT == c_root)) ||
109+
(!OMPI_COMM_IS_INTER(c_comm) && (ompi_comm_rank(c_comm) == c_root))) {
110+
OMPI_C_2_CFI_COPY(x2, recvbuf, c_recvcount, c_recvtype, c_recvdatatype, c_ierr);
111+
}
105112
}

‎ompi/mpi/fortran/use-mpi-f08/ts/ts.c‎

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -92,3 +92,47 @@ int ompi_ts_create_datatype(CFI_cdesc_t *cdesc, int oldcount, MPI_Datatype oldty
9292
PMPI_Type_free(&types[j]);
9393
return mpi_errno;
9494
}
95+
96+
static void copy(CFI_dim_t *dim, int rank, char * base, char **dest, size_t len) {
97+
for (size_t i=0; i<dim->extent; i++) {
98+
if (rank > 1) {
99+
copy(dim-1, rank-1, base, dest, len);
100+
} else {
101+
int v;
102+
memcpy(*dest, base, len);
103+
*dest += len;
104+
}
105+
base += dim->sm;
106+
}
107+
}
108+
109+
int ompi_ts_copy(CFI_cdesc_t *cdesc, char *buffer) {
110+
copy(&cdesc->dim[cdesc->rank - 1], cdesc->rank, cdesc->base_addr, &buffer, cdesc->elem_len);
111+
return OMPI_SUCCESS;
112+
}
113+
114+
static void copy_back(CFI_dim_t *dim, int rank, char * base, char **source, size_t len) {
115+
for (size_t i=0; i<dim->extent; i++) {
116+
if (rank > 1) {
117+
copy_back(dim-1, rank-1, base, source, len);
118+
} else {
119+
int v;
120+
memcpy(base, *source, len);
121+
*source += len;
122+
}
123+
base += dim->sm;
124+
}
125+
}
126+
127+
int ompi_ts_copy_back(char *buffer, CFI_cdesc_t *cdesc) {
128+
copy_back(&cdesc->dim[cdesc->rank - 1], cdesc->rank, cdesc->base_addr, &buffer, cdesc->elem_len);
129+
return OMPI_SUCCESS;
130+
}
131+
132+
size_t ompi_ts_size(CFI_cdesc_t *cdesc) {
133+
size_t res = cdesc->elem_len;
134+
for (int i=0; i<cdesc->rank; i++) {
135+
res *= cdesc->dim[i].extent;
136+
}
137+
return res;
138+
}

‎ompi/mpi/fortran/use-mpi-f08/ts/ts.h‎

Lines changed: 62 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -19,21 +19,80 @@
1919

2020
extern int ompi_ts_create_datatype(CFI_cdesc_t *cdesc, int oldcount, MPI_Datatype oldtype, MPI_Datatype *newtype);
2121

22+
extern size_t ompi_ts_size(CFI_cdesc_t *cdesc);
23+
24+
extern int ompi_ts_copy_back(char *buffer, CFI_cdesc_t *cdesc);
25+
26+
extern int ompi_ts_copy(CFI_cdesc_t *cdesc, char *buffer);
27+
2228
#define OMPI_CFI_2_C(x, count, type, datatype, rc) \
2329
do { \
2430
datatype = type; \
2531
if (x->rank != 0 && !CFI_is_contiguous(x)) { \
2632
rc = ompi_ts_create_datatype(x, count, type, &datatype); \
27-
if (MPI_SUCCESS != rc) { \
28-
return; \
29-
} else { \
33+
if (MPI_SUCCESS == rc) { \
3034
count = 1; \
3135
} \
3236
} else { \
3337
rc = MPI_SUCCESS; \
3438
} \
3539
} while (0)
3640

41+
#define OMPI_CFI_2_C_ALLOC(x, buffer, count, type, datatype, rc) \
42+
do { \
43+
datatype = type; \
44+
if (x->rank != 0 && !CFI_is_contiguous(x)) { \
45+
size_t size = ompi_ts_size(x); \
46+
buffer = malloc(size); \
47+
if (NULL == buffer) { \
48+
rc = MPI_ERR_NO_MEM; \
49+
} else { \
50+
rc = MPI_SUCCESS; \
51+
} \
52+
} else { \
53+
buffer = x->base_addr; \
54+
rc = MPI_SUCCESS; \
55+
} \
56+
} while (0)
57+
58+
#define OMPI_CFI_2_C_COPY(x, buffer, count, type, datatype, rc) \
59+
do { \
60+
datatype = type; \
61+
if (x->rank != 0 && !CFI_is_contiguous(x)) { \
62+
size_t size = ompi_ts_size(x); \
63+
buffer = malloc(size); \
64+
if (NULL == buffer) { \
65+
rc = MPI_ERR_NO_MEM; \
66+
} else { \
67+
rc = ompi_ts_copy(x, buffer); \
68+
} \
69+
} else { \
70+
buffer = x->base_addr; \
71+
rc = MPI_SUCCESS; \
72+
} \
73+
} while (0)
74+
75+
#define OMPI_C_2_CFI_FREE(x, buffer, count, type, datatype, rc) \
76+
do { \
77+
if (buffer != x->base_addr) { \
78+
free(buffer); \
79+
} \
80+
if (type != datatype) { \
81+
rc = PMPI_Type_free(&datatype); \
82+
} \
83+
} while (0)
84+
85+
#define OMPI_C_2_CFI_COPY(x, buffer, count, type, datatype, rc) \
86+
do { \
87+
if (buffer != x->base_addr) { \
88+
rc = ompi_ts_copy_back(buffer, x); \
89+
free(buffer); \
90+
} \
91+
if (type != datatype) { \
92+
rc = PMPI_Type_free(&datatype); \
93+
} \
94+
} while (0)
95+
3796
#define OMPI_CFI_IS_CONTIGUOUS(x) \
3897
(0 == x->rank || CFI_is_contiguous(x))
3998

0 commit comments

Comments
 (0)