Skip to content

Commit 5bf3286

Browse files
ggouaillardetjtronge
ggouaillardet
authored and
jtronge
committed
fortran/use-mpi-f08: add CFI support for pack subroutines
1 parent 43096fb commit 5bf3286

File tree

9 files changed

+317
-975
lines changed

9 files changed

+317
-975
lines changed

‎ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h.in

Lines changed: 0 additions & 967 deletions
This file was deleted.

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,8 @@ subroutine MPI_Pack_external_f08(datarep,inbuf,incount,datatype,outbuf,outsize,
1818
use :: ompi_mpifh_bindings, only : ompi_pack_external_f
1919
implicit none
2020
CHARACTER(LEN=*), INTENT(IN) :: datarep
21-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
22-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
21+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
22+
OMPI_F08_IGNORE_TKR_TYPE :: outbuf
2323
INTEGER, INTENT(IN) :: incount
2424
TYPE(MPI_Datatype), INTENT(IN) :: datatype
2525
INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: outsize

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -16,8 +16,8 @@ subroutine MPI_Pack_f08(inbuf,incount,datatype,outbuf,outsize,position,comm,ierr
1616
use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm
1717
use :: ompi_mpifh_bindings, only : ompi_pack_f
1818
implicit none
19-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
20-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
19+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
20+
OMPI_F08_IGNORE_TKR_TYPE :: outbuf
2121
INTEGER, INTENT(IN) :: incount, outsize
2222
TYPE(MPI_Datatype), INTENT(IN) :: datatype
2323
INTEGER, INTENT(INOUT) :: position

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

Lines changed: 82 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,82 @@
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/communicator/communicator.h"
25+
#include "ompi/errhandler/errhandler.h"
26+
#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h"
27+
#include "ompi/constants.h"
28+
#include "ompi/mpi/fortran/base/constants.h"
29+
#include "ompi/mpi/fortran/base/fortran_base_strings.h"
30+
31+
static const char FUNC_NAME[] = "MPI_Pack_external";
32+
33+
void ompi_pack_external_ts(char *datarep, CFI_cdesc_t* x1, MPI_Fint *incount,
34+
MPI_Fint *datatype, CFI_cdesc_t* x2,
35+
MPI_Aint *outsize, MPI_Aint *position,
36+
MPI_Fint *ierr, int datarep_len)
37+
{
38+
int ret, c_ierr;
39+
char *c_datarep;
40+
MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype);
41+
void *inbuf = x1->base_addr;
42+
char *outbuf = x2->base_addr;
43+
int c_incount = OMPI_FINT_2_INT(*incount);
44+
45+
/* Convert the fortran string */
46+
47+
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len,
48+
&c_datarep))) {
49+
c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, ret, FUNC_NAME);
50+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
51+
return;
52+
}
53+
54+
OMPI_CFI_2_C(x1, c_incount, c_type, c_datatype, c_ierr);
55+
if (MPI_SUCCESS != c_ierr) {
56+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
57+
OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME);
58+
return;
59+
}
60+
61+
OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr);
62+
if (MPI_SUCCESS != c_ierr) {
63+
if (c_datatype != c_type) {
64+
ompi_datatype_destroy(&c_datatype);
65+
}
66+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
67+
OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME);
68+
return;
69+
}
70+
71+
c_ierr = PMPI_Pack_external(c_datarep, OMPI_F2C_BOTTOM(inbuf),
72+
c_incount,
73+
c_datatype, outbuf,
74+
*outsize,
75+
position);
76+
if (c_datatype != c_type) {
77+
ompi_datatype_destroy(&c_datatype);
78+
}
79+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
80+
81+
free(c_datarep);
82+
}

‎ompi/mpi/fortran/use-mpi-f08/ts/pack_ts.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/communicator/communicator.h"
25+
#include "ompi/errhandler/errhandler.h"
26+
#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h"
27+
#include "ompi/mpi/fortran/base/constants.h"
28+
29+
static const char FUNC_NAME[] = "MPI_Pack";
30+
31+
void ompi_pack_ts(CFI_cdesc_t* x1, MPI_Fint *incount, MPI_Fint *datatype,
32+
CFI_cdesc_t *x2, MPI_Fint *outsize, MPI_Fint *position,
33+
MPI_Fint *comm, MPI_Fint *ierr)
34+
{
35+
int c_ierr;
36+
MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
37+
MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype);
38+
OMPI_SINGLE_NAME_DECL(position);
39+
void *inbuf = x1->base_addr;
40+
char *outbuf = x2->base_addr;
41+
int c_incount = OMPI_FINT_2_INT(*incount);
42+
int c_outsize = OMPI_FINT_2_INT(*outsize);
43+
44+
OMPI_SINGLE_FINT_2_INT(position);
45+
46+
OMPI_CFI_2_C(x1, c_incount, c_type, c_datatype, c_ierr);
47+
if (MPI_SUCCESS != c_ierr) {
48+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
49+
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME);
50+
return;
51+
}
52+
53+
OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr);
54+
if (MPI_SUCCESS != c_ierr) {
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+
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
60+
return;
61+
}
62+
63+
c_ierr = PMPI_Pack(OMPI_F2C_BOTTOM(inbuf), c_incount,
64+
c_datatype, outbuf,
65+
c_outsize,
66+
OMPI_SINGLE_NAME_CONVERT(position),
67+
c_comm);
68+
if (c_datatype != c_type) {
69+
ompi_datatype_destroy(&c_datatype);
70+
}
71+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
72+
73+
if (MPI_SUCCESS == c_ierr) {
74+
OMPI_SINGLE_INT_2_FINT(position);
75+
}
76+
}

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

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

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

Lines changed: 70 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,70 @@
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/communicator/communicator.h"
25+
#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h"
26+
#include "ompi/mpi/fortran/base/constants.h"
27+
28+
static const char FUNC_NAME[] = "MPI_Unpack";
29+
30+
void ompi_unpack_ts(CFI_cdesc_t* x1, MPI_Fint *insize, MPI_Fint *position,
31+
CFI_cdesc_t* x2, MPI_Fint *outcount, MPI_Fint *datatype,
32+
MPI_Fint *comm, MPI_Fint *ierr)
33+
{
34+
int c_ierr;
35+
MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
36+
MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype);
37+
OMPI_SINGLE_NAME_DECL(position);
38+
char *inbuf = x1->base_addr;
39+
void *outbuf = x2->base_addr;
40+
int c_outcount = OMPI_FINT_2_INT(*outcount);
41+
42+
OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr);
43+
if (MPI_SUCCESS != c_ierr) {
44+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
45+
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME);
46+
return;
47+
}
48+
49+
OMPI_CFI_2_C(x2, c_outcount, c_type, c_datatype, c_ierr);
50+
if (MPI_SUCCESS != c_ierr) {
51+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
52+
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME);
53+
return;
54+
}
55+
56+
OMPI_SINGLE_FINT_2_INT(position);
57+
58+
c_ierr = PMPI_Unpack(inbuf, OMPI_FINT_2_INT(*insize),
59+
OMPI_SINGLE_NAME_CONVERT(position),
60+
OMPI_F2C_BOTTOM(outbuf), c_outcount,
61+
c_datatype, c_comm);
62+
if (c_datatype != c_type) {
63+
ompi_datatype_destroy(&c_datatype);
64+
}
65+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
66+
67+
if (MPI_SUCCESS == c_ierr) {
68+
OMPI_SINGLE_INT_2_FINT(position);
69+
}
70+
}

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,8 @@ subroutine MPI_Unpack_external_f08(datarep,inbuf,insize,position,outbuf,outcount
1717
use :: ompi_mpifh_bindings, only : ompi_unpack_external_f
1818
implicit none
1919
CHARACTER(LEN=*), INTENT(IN) :: datarep
20-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
21-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
20+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
21+
OMPI_F08_IGNORE_TKR_TYPE :: outbuf
2222
INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: insize
2323
INTEGER(MPI_ADDRESS_KIND), INTENT(INOUT) :: position
2424
INTEGER, INTENT(IN) :: outcount

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -16,8 +16,8 @@ subroutine MPI_Unpack_f08(inbuf,insize,position,outbuf,outcount,datatype,comm,ie
1616
use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm
1717
use :: ompi_mpifh_bindings, only : ompi_unpack_f
1818
implicit none
19-
OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
20-
OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf
19+
OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
20+
OMPI_F08_IGNORE_TKR_TYPE :: outbuf
2121
INTEGER, INTENT(IN) :: insize, outcount
2222
INTEGER, INTENT(INOUT) :: position
2323
TYPE(MPI_Datatype), INTENT(IN) :: datatype

0 commit comments

Comments
 (0)