Skip to content

Commit 3b85b4f

Browse files
ggouaillardetggouaillardet
committed
fortran/use-mpi-f08: add CFI support for pack subroutines
Signed-off-by: Gilles Gouaillardet <[email protected]>
1 parent e613a6a commit 3b85b4f

17 files changed

+351
-46
lines changed

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

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -496,10 +496,10 @@ end subroutine ompi_get_elements_x_f
496496

497497
subroutine ompi_pack_f(inbuf,incount,datatype,outbuf,outsize, &
498498
position,comm,ierror) &
499-
BIND(C, name="ompi_pack_f")
499+
BIND(C, name="ompi_pack_@OMPI_F08_BINDINGS_EXTENSION@")
500500
implicit none
501-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
502-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
501+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
502+
OMPI_F08_IGNORE_TKR_TYPE :: outbuf
503503
INTEGER, INTENT(IN) :: incount, outsize
504504
INTEGER, INTENT(IN) :: datatype
505505
INTEGER, INTENT(INOUT) :: position
@@ -509,13 +509,13 @@ end subroutine ompi_pack_f
509509

510510
subroutine ompi_pack_external_f(datarep,inbuf,incount,datatype, &
511511
outbuf,outsize,position,ierror,datarep_len) &
512-
BIND(C, name="ompi_pack_external_f")
512+
BIND(C, name="ompi_pack_external_@OMPI_F08_BINDINGS_EXTENSION@")
513513
use, intrinsic :: ISO_C_BINDING, only : C_CHAR
514514
use :: mpi_f08_types, only : MPI_ADDRESS_KIND
515515
implicit none
516516
CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: datarep
517-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
518-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
517+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
518+
OMPI_F08_IGNORE_TKR_TYPE :: outbuf
519519
INTEGER, INTENT(IN) :: incount
520520
INTEGER, INTENT(IN) :: datatype
521521
INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: outsize
@@ -770,10 +770,10 @@ end subroutine ompi_type_vector_f
770770

771771
subroutine ompi_unpack_f(inbuf,insize,position,outbuf,outcount, &
772772
datatype,comm,ierror) &
773-
BIND(C, name="ompi_unpack_f")
773+
BIND(C, name="ompi_unpack_@OMPI_F08_BINDINGS_EXTENSION@")
774774
implicit none
775-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
776-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
775+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
776+
OMPI_F08_IGNORE_TKR_TYPE :: outbuf
777777
INTEGER, INTENT(IN) :: insize, outcount
778778
INTEGER, INTENT(INOUT) :: position
779779
INTEGER, INTENT(IN) :: datatype
@@ -783,13 +783,13 @@ end subroutine ompi_unpack_f
783783

784784
subroutine ompi_unpack_external_f(datarep,inbuf,insize,position, &
785785
outbuf,outcount,datatype,ierror,datarep_len) &
786-
BIND(C, name="ompi_unpack_external_f")
786+
BIND(C, name="ompi_unpack_external_@OMPI_F08_BINDINGS_EXTENSION@")
787787
use, intrinsic :: ISO_C_BINDING, only : C_CHAR
788788
use :: mpi_f08_types, only : MPI_ADDRESS_KIND
789789
implicit none
790790
CHARACTER(KIND=C_CHAR), DIMENSION(*), INTENT(IN) :: datarep
791-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
792-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
791+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
792+
OMPI_F08_IGNORE_TKR_TYPE :: outbuf
793793
INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: insize
794794
INTEGER(MPI_ADDRESS_KIND), INTENT(INOUT) :: position
795795
INTEGER, INTENT(IN) :: outcount

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

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,12 @@ libusempif08_cdesc_la_SOURCES = \
5858
sendrecv_cdesc.c \
5959
sendrecv_replace_cdesc.c \
6060
ssend_cdesc.c \
61-
ssend_init_cdesc.c
61+
ssend_init_cdesc.c \
62+
\
63+
pack_cdesc.c \
64+
pack_external_cdesc.c \
65+
unpack_cdesc.c \
66+
unpack_external_cdesc.c
6267

6368
noinst_LTLIBRARIES = $(module_sentinel_file)
6469

‎ompi/mpi/fortran/use-mpi-f08/cdesc/bindings.h

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -94,4 +94,21 @@ void ompi_ssend_init_cdesc(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype,
9494
MPI_Fint *dest, MPI_Fint *tag,
9595
MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr);
9696

97+
void ompi_pack_cdesc(CFI_cdesc_t* x, MPI_Fint *incount, MPI_Fint *datatype,
98+
char *outbuf, MPI_Fint *outsize, MPI_Fint *position,
99+
MPI_Fint *comm, MPI_Fint *ierr);
100+
101+
void ompi_pack_external_cdesc(char *datarep, CFI_cdesc_t* x, MPI_Fint *incount,
102+
MPI_Fint *datatype, char *outbuf,
103+
MPI_Aint *outsize, MPI_Aint *position,
104+
MPI_Fint *ierr, int datarep_len);
105+
106+
void ompi_unpack_cdesc(char *inbuf, MPI_Fint *insize, MPI_Fint *position,
107+
CFI_cdesc_t* x, MPI_Fint *outcount, MPI_Fint *datatype,
108+
MPI_Fint *comm, MPI_Fint *ierr);
109+
110+
void ompi_unpack_external_cdesc(char *datarep, char *inbuf, MPI_Aint *insize,
111+
MPI_Aint *position, CFI_cdesc_t* x,
112+
MPI_Fint *outcount, MPI_Fint *datatype,
113+
MPI_Fint *ierr, int datarep_len);
97114
#endif /* OMPI_CDESC_BINDINGS_H */

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

Lines changed: 65 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
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+
void ompi_pack_cdesc(CFI_cdesc_t* x, MPI_Fint *incount, MPI_Fint *datatype,
29+
char *outbuf, MPI_Fint *outsize, MPI_Fint *position,
30+
MPI_Fint *comm, MPI_Fint *ierr)
31+
{
32+
int c_ierr;
33+
MPI_Comm c_comm;
34+
MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype);
35+
OMPI_SINGLE_NAME_DECL(position);
36+
void *inbuf = x->base_addr;
37+
int c_incount = OMPI_FINT_2_INT(*incount);
38+
int c_outsize = OMPI_FINT_2_INT(*outsize);
39+
40+
c_datatype = c_type;
41+
if (x->rank != 0 && !CFI_is_contiguous(x)) {
42+
c_ierr = ompi_cdesc_create_datatype(x, c_incount, c_type, &c_datatype);
43+
if (MPI_SUCCESS != c_ierr) {
44+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
45+
return;
46+
}
47+
c_incount = 1;
48+
}
49+
c_comm = PMPI_Comm_f2c(*comm);
50+
OMPI_SINGLE_FINT_2_INT(position);
51+
52+
c_ierr = PMPI_Pack(OMPI_F2C_BOTTOM(inbuf), c_incount,
53+
c_datatype, outbuf,
54+
c_outsize,
55+
OMPI_SINGLE_NAME_CONVERT(position),
56+
c_comm);
57+
if (c_datatype != c_type) {
58+
ompi_datatype_destroy(&c_datatype);
59+
}
60+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
61+
62+
if (MPI_SUCCESS == c_ierr) {
63+
OMPI_SINGLE_INT_2_FINT(position);
64+
}
65+
}

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

Lines changed: 72 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,72 @@
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/constants.h"
27+
#include "ompi/communicator/communicator.h"
28+
#include "ompi/mpi/fortran/base/constants.h"
29+
#include "ompi/mpi/fortran/base/fortran_base_strings.h"
30+
31+
void ompi_pack_external_cdesc(char *datarep, CFI_cdesc_t* x, MPI_Fint *incount,
32+
MPI_Fint *datatype, char *outbuf,
33+
MPI_Aint *outsize, MPI_Aint *position,
34+
MPI_Fint *ierr, int datarep_len)
35+
{
36+
int ret, c_ierr;
37+
char *c_datarep;
38+
MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype);
39+
void *inbuf = x->base_addr;
40+
int c_incount = OMPI_FINT_2_INT(*incount);
41+
42+
/* Convert the fortran string */
43+
44+
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len,
45+
&c_datarep))) {
46+
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret,
47+
"MPI_PACK_EXTERNAL");
48+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
49+
return;
50+
}
51+
52+
c_datatype = c_type;
53+
if (x->rank != 0 && !CFI_is_contiguous(x)) {
54+
c_ierr = ompi_cdesc_create_datatype(x, c_incount, c_type, &c_datatype);
55+
if (MPI_SUCCESS != c_ierr) {
56+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
57+
return;
58+
}
59+
c_incount = 1;
60+
}
61+
c_ierr = PMPI_Pack_external(c_datarep, OMPI_F2C_BOTTOM(inbuf),
62+
c_incount,
63+
c_type, outbuf,
64+
*outsize,
65+
position);
66+
if (c_datatype != c_type) {
67+
ompi_datatype_destroy(&c_datatype);
68+
}
69+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
70+
71+
free(c_datarep);
72+
}

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

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,63 @@
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+
void ompi_unpack_cdesc(char *inbuf, MPI_Fint *insize, MPI_Fint *position,
29+
CFI_cdesc_t* x, MPI_Fint *outcount, MPI_Fint *datatype,
30+
MPI_Fint *comm, MPI_Fint *ierr)
31+
{
32+
int c_ierr;
33+
MPI_Comm c_comm;
34+
MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype);
35+
OMPI_SINGLE_NAME_DECL(position);
36+
void *outbuf = x->base_addr;
37+
int c_outcount = OMPI_FINT_2_INT(*outcount);
38+
39+
c_datatype = c_type;
40+
if (x->rank != 0 && !CFI_is_contiguous(x)) {
41+
c_ierr = ompi_cdesc_create_datatype(x, c_outcount, c_type, &c_datatype);
42+
if (MPI_SUCCESS != c_ierr) {
43+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
44+
return;
45+
}
46+
c_outcount = 1;
47+
}
48+
c_comm = PMPI_Comm_f2c(*comm);
49+
OMPI_SINGLE_FINT_2_INT(position);
50+
51+
c_ierr = PMPI_Unpack(inbuf, OMPI_FINT_2_INT(*insize),
52+
OMPI_SINGLE_NAME_CONVERT(position),
53+
OMPI_F2C_BOTTOM(outbuf), c_outcount,
54+
c_datatype, c_comm);
55+
if (c_datatype != c_type) {
56+
ompi_datatype_destroy(&c_datatype);
57+
}
58+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
59+
60+
if (MPI_SUCCESS == c_ierr) {
61+
OMPI_SINGLE_INT_2_FINT(position);
62+
}
63+
}

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

Lines changed: 75 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,75 @@
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/constants.h"
27+
#include "ompi/communicator/communicator.h"
28+
#include "ompi/mpi/fortran/base/constants.h"
29+
#include "ompi/mpi/fortran/base/fortran_base_strings.h"
30+
31+
void ompi_unpack_external_cdesc(char *datarep, char *inbuf, MPI_Aint *insize,
32+
MPI_Aint *position, CFI_cdesc_t* x,
33+
MPI_Fint *outcount, MPI_Fint *datatype,
34+
MPI_Fint *ierr, int datarep_len)
35+
{
36+
int ret, c_ierr;
37+
char *c_datarep;
38+
MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype);
39+
void *outbuf = x->base_addr;
40+
int c_outcount = OMPI_FINT_2_INT(*outcount);
41+
42+
c_type = PMPI_Type_f2c(*datatype);
43+
44+
/* Convert the fortran string */
45+
46+
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len,
47+
&c_datarep))) {
48+
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret,
49+
"MPI_PACK_EXTERNAL");
50+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
51+
return;
52+
}
53+
54+
c_datatype = c_type;
55+
if (x->rank != 0 && !CFI_is_contiguous(x)) {
56+
c_ierr = ompi_cdesc_create_datatype(x, c_outcount, c_type, &c_datatype);
57+
if (MPI_SUCCESS != c_ierr) {
58+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
59+
return;
60+
}
61+
c_outcount = 1;
62+
}
63+
c_ierr = PMPI_Unpack_external(c_datarep, inbuf,
64+
*insize,
65+
position,
66+
OMPI_F2C_BOTTOM(outbuf),
67+
c_outcount,
68+
c_datatype);
69+
if (c_datatype != c_type) {
70+
ompi_datatype_destroy(&c_datatype);
71+
}
72+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
73+
74+
free(c_datarep);
75+
}

0 commit comments

Comments
 (0)