Skip to content

Commit 57d271e

Browse files
hppritchahppritcha
committed
add f90 and f08 interfaces
Signed-off-by: Howard Pritchard <[email protected]>
1 parent 09504c3 commit 57d271e

File tree

7 files changed

+126
-3
lines changed

7 files changed

+126
-3
lines changed

‎ompi/mpi/fortran/mpif-h/Makefile.am‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -476,6 +476,7 @@ lib@OMPI_LIBMPI_NAME@_mpifh_la_SOURCES += \
476476
type_get_name_f.c \
477477
type_get_true_extent_f.c \
478478
type_get_true_extent_x_f.c \
479+
type_get_value_index_f.c \
479480
type_indexed_f.c \
480481
type_match_size_f.c \
481482
type_set_attr_f.c \

‎ompi/mpi/fortran/mpif-h/profile/Makefile.am‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -387,6 +387,7 @@ linked_files = \
387387
ptype_get_name_f.c \
388388
ptype_get_true_extent_f.c \
389389
ptype_get_true_extent_x_f.c \
390+
ptype_get_value_index_f.c \
390391
ptype_indexed_f.c \
391392
ptype_match_size_f.c \
392393
ptype_set_attr_f.c \

‎ompi/mpi/fortran/mpif-h/prototypes_mpi.h‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -444,6 +444,7 @@ PN2(void, MPI_Type_get_extent_x, mpi_type_get_extent_x, MPI_TYPE_GET_EXTENT_X, (
444444
PN2(void, MPI_Type_get_name, mpi_type_get_name, MPI_TYPE_GET_NAME, (MPI_Fint *type, char *type_name, MPI_Fint *resultlen, MPI_Fint *ierr, int name_len));
445445
PN2(void, MPI_Type_get_true_extent, mpi_type_get_true_extent, MPI_TYPE_GET_TRUE_EXTENT, (MPI_Fint *datatype, MPI_Aint *true_lb, MPI_Aint *true_extent, MPI_Fint *ierr));
446446
PN2(void, MPI_Type_get_true_extent_x, mpi_type_get_true_extent_x, MPI_TYPE_GET_TRUE_EXTENT_X, (MPI_Fint *datatype, MPI_Count *true_lb, MPI_Count *true_extent, MPI_Fint *ierr));
447+
PN2(void, MPI_Type_get_value_index, mpi_type_get_value_index, MPI_TYPE_GET_VALUE_INDEX, (MPI_Fint *value_type, MPI_Fint *index_type, MPI_Fint *pair_type, MPI_Fint *ierr));
447448
PN2(void, MPI_Type_hindexed, mpi_type_hindexed, MPI_TYPE_HINDEXED, (MPI_Fint *count, MPI_Fint *array_of_blocklengths, MPI_Fint *array_of_displacements, MPI_Fint *oldtype, MPI_Fint *newtype, MPI_Fint *ierr));
448449
PN2(void, MPI_Type_hvector, mpi_type_hvector, MPI_TYPE_HVECTOR, (MPI_Fint *count, MPI_Fint *blocklength, MPI_Fint *stride, MPI_Fint *oldtype, MPI_Fint *newtype, MPI_Fint *ierr));
449450
PN2(void, MPI_Type_indexed, mpi_type_indexed, MPI_TYPE_INDEXED, (MPI_Fint *count, MPI_Fint *array_of_blocklengths, MPI_Fint *array_of_displacements, MPI_Fint *oldtype, MPI_Fint *newtype, MPI_Fint *ierr));

‎ompi/mpi/fortran/mpif-h/type_get_value_index_f.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 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+
26+
#if OMPI_BUILD_MPI_PROFILING
27+
#if OPAL_HAVE_WEAK_SYMBOLS
28+
#pragma weak PMPI_TYPE_GET_VALUE_INDEX = ompi_type_get_value_index_f
29+
#pragma weak pmpi_type_get_value_index = ompi_type_get_value_index_f
30+
#pragma weak pmpi_type_get_value_index_ = ompi_type_get_value_index_f
31+
#pragma weak pmpi_type_get_value_index__ = ompi_type_get_value_index_f
32+
33+
#pragma weak PMPI_Type_get_value_index_f = ompi_type_get_value_index_f
34+
#pragma weak PMPI_Type_get_value_index_f08 = ompi_type_get_value_index_f
35+
#else
36+
OMPI_GENERATE_F77_BINDINGS (PMPI_TYPE_GET_VALUE_INDEX,
37+
pmpi_type_get_value_index,
38+
pmpi_type_get_value_index_,
39+
pmpi_type_get_value_index__,
40+
pompi_type_get_value_index_f,
41+
(MPI_Fint *value_type, MPI_Fint *index_type, MPI_Fint *pair_type, MPI_Fint *ierr),
42+
(value_type, index_type, pair_type, ierr) )
43+
#endif
44+
#endif
45+
46+
#if OPAL_HAVE_WEAK_SYMBOLS
47+
#pragma weak MPI_TYPE_GET_VALUE_INDEX = ompi_type_get_value_index_f
48+
#pragma weak mpi_type_get_value_index = ompi_type_get_value_index_f
49+
#pragma weak mpi_type_get_value_index_ = ompi_type_get_value_index_f
50+
#pragma weak mpi_type_get_value_index__ = ompi_type_get_value_index_f
51+
52+
#pragma weak MPI_Type_get_value_index_f = ompi_type_get_value_index_f
53+
#pragma weak MPI_Type_get_value_index_f08 = ompi_type_get_value_index_f
54+
#else
55+
#if ! OMPI_BUILD_MPI_PROFILING
56+
OMPI_GENERATE_F77_BINDINGS (MPI_TYPE_GET_VALUE_INDEX,
57+
mpi_type_get_value_index,
58+
mpi_type_get_value_index_,
59+
mpi_type_get_value_index__,
60+
ompi_type_get_value_index_f,
61+
(MPI_Fint *value_type, MPI_Fint *index_type, MPI_Fint *pair_type, MPI_Fint *ierr),
62+
(value_type, index_type, pair_type, ierr) )
63+
#else
64+
#define ompi_type_get_value_index_f pompi_type_get_value_index_f
65+
#endif
66+
#endif
67+
68+
69+
void ompi_type_get_value_index_f(MPI_Fint *value_type, MPI_Fint *index_type, MPI_Fint *pair_type, MPI_Fint *ierr)
70+
{
71+
int c_ierr;
72+
MPI_Datatype c_value_type = PMPI_Type_f2c(*value_type);
73+
MPI_Datatype c_index_type = PMPI_Type_f2c(*index_type);
74+
MPI_Datatype c_new;
75+
76+
c_ierr = PMPI_Type_get_value_index(c_value_type, c_index_type, &c_new);
77+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
78+
79+
if (MPI_SUCCESS == c_ierr) {
80+
*pair_type = PMPI_Type_c2f(c_new);
81+
}
82+
}

‎ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -160,6 +160,7 @@ prototype_files = \
160160
type_create_struct.c.in \
161161
type_create_subarray.c.in \
162162
type_get_true_extent.c.in \
163+
type_get_value_index.c.in \
163164
type_indexed.c.in \
164165
type_size.c.in \
165166
type_vector.c.in \

‎ompi/mpi/fortran/use-mpi-f08/type_get_value_index.c.in‎

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
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 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+
PROTOTYPE VOID type_get_value_index(DATATYPE value_type, DATATYPE index_type, DATATYPE_OUT pair_type)
23+
{
24+
int c_ierr;
25+
MPI_Datatype c_value_type = PMPI_Type_f2c(*value_type);
26+
MPI_Datatype c_index_type = PMPI_Type_f2c(*index_type);
27+
MPI_Datatype c_pair_type;
28+
29+
c_ierr = @INNER_CALL@(c_value_type, c_index_type, &c_pair_type);
30+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
31+
32+
if (MPI_SUCCESS == c_ierr) {
33+
*pair_type = PMPI_Type_c2f(c_pair_type);
34+
}
35+
}
36+

‎ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.prototype_files‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44

55
prototype_files = \
66
request_get_status.c.in \
7-
request_get_status_all.c.in \
8-
request_get_status_any.c.in \
9-
request_get_status_some.c.in
7+
request_get_status_all.c.in \
8+
request_get_status_any.c.in \
9+
request_get_status_some.c.in \
10+
type_get_value_index.c.in

0 commit comments

Comments
 (0)